Trailing-Edge
-
PDP-10 Archives
-
decuslib20-07
-
decus/20-0168/csscng.cbl
There is 1 other file named csscng.cbl in the archive. Click here to see a list.
IDENTIFICATION DIVISION.
PROGRAM-ID. CSSCNG, VERSION-5, EDIT-2.
AUTHOR. BOB CONLON.
DATE-WRITTEN. 19-NOV-75, MODIFIED 22-NOV-78.
DATE-COMPILED.
REMARKS. THIS PROGRAM WRITES A COBOL SOURCE WHICH WILL
REARRANGE AN EXISTING DATA BASE.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. DECSYSTEM-10.
OBJECT-COMPUTER. DECSYSTEM-10.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT FORMAT-FILE ASSIGN TO DSK.
SELECT SOURCE-FILE ASSIGN TO DSK.
DATA DIVISION.
FILE SECTION.
FD FORMAT-FILE; VALUE OF IDENTIFICATION IS FORMAT-NAME.
01 FORMAT-RECORD.
02 PROMPT-TABLE OCCURS 150 TIMES PIC X(20).
02 LENGTH-OF-FIELD OCCURS 150 TIMES PIC 9(3).
02 NUMBER-FIELDS PIC 9(3).
02 NAMES OCCURS 28 TIMES PIC X(6).
02 VAL-ID PIC X.
02 AC-DAT PIC X.
02 SPC PIC X.
02 FILLER PIC X(3).
02 IND-BLOCK-FACT PIC 9(3).
02 OVER-LAY-PAGE PIC 9(3).
02 BLOCKING-FACTOR PIC 9(3).
02 PRI.
03 PRIV OCCURS 28 TIMES PIC 9(3).
02 FILLER PIC X(3).
02 VERSION-NUMBER PIC 9(3).
02 NUM-CHARS PIC 9(4).
02 POS-KEY PIC 99.
02 NUM-PAGES PIC 9(3).
02 TOP-LINE OCCURS 50 TIMES PIC 9(3).
02 DECIMAL-POSIT OCCURS 150 TIMES PIC 9.
FD SOURCE-FILE; VALUE OF IDENTIFICATION IS SOURCE-NAME.
01 SOURCE-RECORD; DISPLAY-7 PIC X(80).
WORKING-STORAGE SECTION.
77 Z-1 PIC S9(3); COMP.
77 USER-PASSWORD PIC X(6).
77 PROMPT-IND PIC S9(3); COMP.
77 IN-OP-NO PIC S9(3); COMP.
77 OUT-OP-NO PIC S9(3); COMP.
77 OUT-LA-NO PIC S9(3); COMP.
77 EXTRA-IND PIC S9(3); COMP.
77 OB-IND PIC S9(3); COMP.
77 SAVE-01 PIC X(3).
77 DIS PIC ZZZ.
77 A PIC X(24); VALUE "IDENTIFICATION DIVISION.".
77 C PIC X(19); VALUE "AUTHOR. BOB CONLON.".
77 E PIC X(15); VALUE "DATE-COMPILED.".
77 G PIC X(21); VALUE "ENVIRONMENT DIVISION.".
77 H PIC X(22); VALUE "CONFIGURATION SECTION.".
77 I PIC X(30); VALUE "SOURCE-COMPUTER. DECSYSTEM-10.".
77 J PIC X(30); VALUE "OBJECT-COMPUTER. DECSYSTEM-10.".
77 K PIC X(21); VALUE "INPUT-OUTPUT SECTION.".
77 L PIC X(13); VALUE "FILE-CONTROL.".
77 O PIC X(14); VALUE "DATA DIVISION.".
77 P PIC X(13); VALUE "FILE SECTION.".
77 R PIC X(11); VALUE "01 REC-IN.".
77 S-1 PIC X(60); VALUE "FD FILE-OUT; VALUE OF IDENTIFICATION IS OUT-NAME.".
77 S-2 PIC X(23); VALUE "01 REC-OUT; DISPLAY-7.".
77 S PIC X(39); VALUE "FD FORMAT-FILE COPY FDFMT.".
77 T PIC X(24); VALUE "WORKING-STORAGE SECTION.".
77 W-1 PIC X(60); VALUE "01 OUT-NAME COPY WSOUTNAM.".
77 W PIC X(17); VALUE "01 FILE-IN-NAME.".
77 Z PIC X(40); VALUE "01 PROMPT-INFO COPY WSFMT1.".
77 A1 PIC X(19); VALUE "PROCEDURE DIVISION.".
77 A2 PIC X(16); VALUE "OPENING SECTION.".
77 A3 PIC X(32); VALUE "CHECK-IT. COPY PRCHKPW.".
77 A4 PIC X(33); VALUE "PRIV-CHK. COPY PRCHKPV3.".
77 A5 PIC X(60); VALUE " PERFORM MOVE-PAGE VARYING I FROM 1 BY 1".
77 A7 PIC X(36); VALUE "77 I PIC S9(3); COMP.".
77 A10 PIC X(21); VALUE " PERFORM CLEAN-UP.".
77 NED-HLP PIC A.
77 REC-TYPE PIC S9(3); COMP.
01 PRG-NAM.
02 FILLER PIC X(20); VALUE "77 PRG-NAM".
02 FILLER PIC X(16); VALUE "PIC X(6); VALUE ".
02 FILLER PIC X; VALUE QUOTE.
02 PRG-NAME PIC X(6).
02 FILLER PIC X; VALUE QUOTE.
02 FILLER PIC X; VALUE ".".
01 A6.
02 FILLER PIC X(16); VALUE " UNTIL I > ".
02 A6-NUM PIC Z(3).
02 FILLER PIC X; VALUE ".".
01 A8.
02 FILLER PIC X(22); VALUE " 02 PAGEI-2 OCCURS ".
02 A8-NUM PIC Z(3).
02 FILLER PIC X(7); VALUE " TIMES.".
01 A9.
02 FILLER PIC X(22); VALUE " 02 PAGEO-2 OCCURS ".
02 A9-NUM PIC Z(3).
02 FILLER PIC X(7); VALUE " TIMES.".
01 DISPLAY-LINE.
02 FILLER PIC X(12); VALUE " DISPLAY ".
02 FILLER PIC X; VALUE QUOTE.
02 FILLER PIC X(20); VALUE "RECORDS CONVERTED: ".
02 FILLER PIC X; VALUE QUOTE.
02 FILLER PIC X(10); VALUE " IN-COUNT.".
01 MOVE-LINE1.
02 FILLER PIC X(9); VALUE " MOVE ".
02 FILLER PIC X; VALUE QUOTE.
02 ML1-NAME PIC X(3).
02 FILLER PIC X; VALUE QUOTE.
02 FILLER PIC X(12); VALUE " TO OUTNAM2.".
01 B.
02 FILLER PIC X(13); VALUE "PROGRAM-ID.".
02 B-NAME PIC X(6).
02 FILLER PIC X; VALUE ".".
01 D.
02 FILLER PIC X(14); VALUE "DATE-WRITTEN.".
02 D-DD PIC Z9.
02 FILLER PIC X; VALUE "-".
02 D-MON PIC X(3).
02 FILLER PIC X; VALUE "-".
02 D-YY PIC 99.
02 FILLER PIC X; VALUE ".".
01 F.
02 FILLER PIC X(21); VALUE "REMARKS. THIS PROGRA".
02 FILLER PIC X(21); VALUE "M WRITTEN BY CSSCNG.".
01 M.
02 FILLER PIC X(18); VALUE " SELECT FILE-IN".
02 FILLER PIC X(19); VALUE SPACES.
02 FILLER PIC X(13); VALUE "ASSIGN TO DSK".
01 M1.
02 FILLER PIC X(37); VALUE SPACES.
02 FILLER PIC X(22); VALUE "ACCESS MODE IS INDEXED".
01 M2.
02 FILLER PIC X(37); VALUE SPACES.
02 FILLER PIC X(23); VALUE "SYMBOLIC KEY IS SYM-KEY".
01 M3.
02 FILLER PIC X(37); VALUE SPACES.
02 FILLER PIC X(22); VALUE "RECORD KEY IS REC-KEY.".
01 N-1.
02 FILLER PIC X(22); VALUE " SELECT FILE-OUT".
02 FILLER PIC X(15); VALUE SPACES.
02 FILLER PIC X(14); VALUE "ASSIGN TO DSK.".
01 N.
02 FILLER PIC X(22); VALUE " SELECT FORMAT-FILE".
02 FILLER PIC X(15); VALUE SPACES.
02 FILLER PIC X(14); VALUE "ASSIGN TO DSK.".
01 Q.
02 FILLER PIC X(29); VALUE "FD FILE-IN; RECORD CONTAINS".
02 Q-NUM PIC Z(4).
02 FILLER PIC X(11); VALUE " CHARACTERS".
01 Q1.
02 FILLER PIC X(28); VALUE " BLOCK CONTAINS".
02 Q1-NUM PIC Z(3).
02 FILLER PIC X(8); VALUE " RECORDS".
01 Q2.
02 FILLER PIC X(13); VALUE SPACES.
02 FILLER PIC X(40); VALUE "VALUE OF IDENTIFICATION IS FILE-IN-NAME.".
01 U.
02 FILLER PIC X(13); VALUE "77 VERS-NUM".
02 FILLER PIC X(15); VALUE SPACES.
02 FILLER PIC X(16); VALUE "PIC 9(3); VALUE ".
02 U-NUM PIC Z(3).
02 FILLER PIC X; VALUE ".".
01 V.
02 FILLER PIC X(27); VALUE "77 SYM-KEY".
02 FILLER PIC X(4); VALUE "PIC ".
02 SK-PIC PIC XX.
02 FILLER PIC X; VALUE "(".
02 V-NUM PIC 9(3).
02 FILLER PIC XX; VALUE ").".
01 X.
02 FILLER PIC X(27); VALUE " 02 FIN".
02 FILLER PIC X(16); VALUE "PIC X(6); VALUE ".
02 FILLER PIC X; VALUE QUOTE.
02 X-FNAME PIC X(6).
02 FILLER PIC X; VALUE QUOTE.
02 FILLER PIC X; VALUE ".".
01 Y.
02 FILLER PIC X(27); VALUE " 02 FILLER".
02 FILLER PIC X(16); VALUE "PIC X(3); VALUE".
02 FILLER PIC X; VALUE QUOTE.
02 FILLER PIC X(3); VALUE "IDX".
02 FILLER PIC X; VALUE QUOTE.
02 FILLER PIC X; VALUE ".".
01 P-TODAY.
02 TOD.
03 P-YY PIC 99.
03 P-MM PIC 99.
03 P-DD PIC 99.
02 FILLER PIC X(6).
01 MONTH-REGISTER.
02 FILLER PIC X(36); VALUE "JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC".
01 MONTH-ARRAY REDEFINES MONTH-REGISTER.
02 M-BUFF OCCURS 12 TIMES PIC X(3).
01 IN-SYM.
02 FILLER PIC X(7); VALUE " 02 ".
02 IS-NUM1 PIC ZZ9.
02 IS1A PIC X(3); VALUE "INN".
02 IS-REDEF PIC X(20).
02 FILLER PIC X(4); VALUE "PIC".
02 IS-PIC PIC XX.
02 FILLER PIC X; VALUE "(".
02 IS-NUM2 PIC 9(3).
02 FILLER PIC XX; VALUE ").".
01 REC-K.
02 FILLER PIC X(33); VALUE " 02 REC-KEY".
02 FILLER PIC X(4); VALUE "PIC ".
02 RK-PIC PIC XX.
02 FILLER PIC X; VALUE "(".
02 RK-NUM PIC 9(3).
02 FILLER PIC XX; VALUE ").".
01 03-LINE.
02 FILLER PIC X(10); VALUE " 03 ".
02 03NUM1 PIC Z(3).
02 03SYM PIC X(20); VALUE "INN".
02 FILLER PIC X(6); VALUE "PIC X(".
02 03NUM2 PIC 9(3).
02 FILLER PIC XX; VALUE ").".
01 MOVE-LINE.
02 FILLER PIC X(9); VALUE " MOVE ".
02 ML-NUM1 PIC ZZ9.
02 FILLER PIC X(3); VALUE "INN".
02 ML-IND1 PIC X(3); VALUE SPACES.
02 FILLER PIC X(4); VALUE " TO ".
02 ML-NUM2 PIC ZZ9.
02 FILLER PIC X(3); VALUE "OUT".
02 ML-IND2 PIC X(3); VALUE SPACES.
02 FILLER PIC X; VALUE ".".
01 FORMAT-NAME.
02 F-NAME.
03 FNAME PIC X(3).
03 FNAME1 PIC X(3).
02 FILLER PIC X(3); VALUE "FMT".
01 SOURCE-NAME.
02 SNAME.
03 SNAME1 PIC X(3); VALUE "CNG".
03 SNAME2 PIC X(3).
02 SEXT PIC X(3); VALUE "CBL".
01 OUTPUT-ARRAY.
02 OUTPUT-BUFFER OCCURS 150 TIMES.
03 INPUT-FIELD PIC 9(3).
03 OR-SIZE PIC 9(3).
01 INPUT-RESP.
02 IR PIC X.
02 FILLER PIC XX.
01 Q-LINE.
02 FILLER PIC X(3); VALUE SPACES.
02 FILLER PIC X; VALUE QUOTE.
02 FILLER PIC X; VALUE "N".
02 FILLER PIC X; VALUE QUOTE.
02 FILLER PIC X(4); VALUE "...".
02 FILLER PIC X(41); VALUE "IN RESPONSE TO THE ASTERISK, N REPRESENTS".
PROCEDURE DIVISION.
OPENING SECTION.
CHECK-IT.
ENTER MACRO NAMDAT.
DISPLAY "TYPE NAME OF INPUT FORMAT FILE: "; WITH NO ADVANCING.
ACCEPT F-NAME.
IF FNAME NOT = "DBM" DISPLAY "ILLEGAL FILE NAME", GO TO CHECK-IT.
OPEN INPUT FORMAT-FILE.
READ FORMAT-FILE; AT END STOP RUN.
IF SPC = "(" MOVE 0 TO REC-TYPE, ENTER MACRO UNSSCR USING REC-TYPE, FORMAT-RECORD.
ENTER MACRO NOECHO USING PROMPT-IND, BREAK-1, PRI, USER-PASSWORD.
SET PROMPT-IND TO ZERO.
LOOP1.
SET PROMPT-IND UP BY 1.
IF PROMPT-IND > 28 GO TO BREAK-1.
IF USER-PASSWORD = NAMES(PROMPT-IND) GO TO BREAK-1.
GO TO LOOP1.
BREAK-1.
IF PROMPT-IND > 28 DISPLAY "CANNOT ACCESS THIS DATA", STOP RUN.
IF PRIV(PROMPT-IND) < 3 DISPLAY "NO PRIVILEGES TO RUN THIS PROGRAM"
,STOP RUN.
DISPLAY " ".
DISPLAY "CSS DATA BASE CONVERTER CSSCNG(V05-2)".
DISPLAY " ".
DISPLAY "DO YOU NEED TO SEE THE HELP DIALOG: "; WITH NO ADVANCING.
ACCEPT NED-HLP.
IF NED-HLP = "Y" PERFORM HELP-DIALOG.
DISPLAY " ".
DISPLAY "ANSWER THE FOLLOWING ABOUT YOUR NEW OUTPUT RECORD".
MOVE ZEROES TO OUTPUT-ARRAY, OB-IND, PROMPT-IND.
LOOP-01.
SET OB-IND UP BY 1.
MOVE OB-IND TO DIS.
DISPLAY " ".
DISPLAY "OUTPUT FIELD NUMBER" DIS.
DISPLAY "*"; WITH NO ADVANCING.
ACCEPT INPUT-RESP.
IF IR = "H" PERFORM HLP-FIL, SET OB-IND DOWN BY 1, GO TO LOOP-01.
IF IR = "S" GO TO NEW-PROGRAM.
IF IR = "O" GO TO OVERLAY-SETUP.
IF IR = "B" PERFORM NEW-FIELD, GO TO GET-SIZE.
IF IR = "F" PERFORM FINISH-UP, GO TO NEW-PROGRAM.
MOVE INPUT-RESP TO SAVE-01.
EXAMINE SAVE-01 REPLACING ALL SPACES BY ZEROES.
IF SAVE-01 NOT NUMERIC DISPLAY "NOT AN INPUT FIELD NUMBER"
,SET OB-IND DOWN BY 1, GO TO LOOP-01.
MOVE INPUT-RESP TO INPUT-FIELD(OB-IND).
IF INPUT-FIELD(OB-IND) NOT = ZERO MOVE INPUT-FIELD(OB-IND) TO PROMPT-IND
,GO TO SHOW-IN-REC.
SET PROMPT-IND UP BY 1.
IF LENGTH-OF-FIELD(PROMPT-IND) > ZERO GO TO GOOD-FIELD.
DISPLAY "NO REMAINING INPUT FIELDS".
SUBTRACT 1 FROM OB-IND, PROMPT-IND.
GO TO LOOP-01.
GOOD-FIELD.
MOVE PROMPT-IND TO INPUT-FIELD(OB-IND).
SHOW-IN-REC.
MOVE PROMPT-IND TO DIS.
DISPLAY DIS "..." PROMPT-TABLE(PROMPT-IND) " :" LENGTH-OF-FIELD(PROMPT-IND).
GET-SIZE.
DISPLAY " ".
DISPLAY "SIZE: "; WITH NO ADVANCING.
ACCEPT OR-SIZE(OB-IND).
IF OR-SIZE(OB-IND) NOT = ZERO GO TO LOOP-01.
IF INPUT-FIELD(OB-IND) = ZERO DISPLAY "ZERO FIELD SIZE", GO TO GET-SIZE.
MOVE LENGTH-OF-FIELD(PROMPT-IND) TO OR-SIZE(OB-IND).
GO TO LOOP-01.
OVERLAY-SETUP.
MOVE OVER-LAY-PAGE TO IN-OP-NO.
DISPLAY " ".
DISPLAY "TYPE FIRST LINE NUMBER OF FIRST OVERLAY PAGE IN".
DISPLAY "YOUR OUTPUT RECORD: "; WITH NO ADVANCING.
ACCEPT OUT-OP-NO.
DISPLAY " ".
DISPLAY "TYPE LAST LINE NUMBER OF THE FIRST OVERLAY PAGE IN".
DISPLAY "YOUR OUTPUT RECORD: "; WITH NO ADVANCING.
ACCEPT OUT-LA-NO.
GO TO NEW-PROGRAM.
MOVE-PR-TAB.
SET OB-IND UP BY 1.
MOVE PROMPT-IND TO INPUT-FIELD(OB-IND).
MOVE LENGTH-OF-FIELD(PROMPT-IND) TO OR-SIZE(OB-IND).
NEW-FIELD.
DISPLAY "NEW FIELD".
MOVE ZERO TO INPUT-FIELD(OB-IND).
FINISH-UP.
SET PROMPT-IND UP BY 1.
SET OB-IND DOWN BY 1.
PERFORM MOVE-PR-TAB VARYING PROMPT-IND FROM PROMPT-IND BY 1
,UNTIL LENGTH-OF-FIELD(PROMPT-IND) = ZERO.
NEW-PROGRAM SECTION.
NP-OPENERS.
MOVE FNAME1 TO SNAME2.
DISPLAY " CREATING " SNAME "." SEXT " ... "; WITH NO ADVANCING.
OPEN OUTPUT SOURCE-FILE.
WRITE SOURCE-RECORD FROM A.
MOVE SNAME TO B-NAME.
WRITE SOURCE-RECORD FROM B.
WRITE SOURCE-RECORD FROM C.
MOVE TODAY TO P-TODAY.
MOVE P-DD TO D-DD.
MOVE M-BUFF(P-MM) TO D-MON.
MOVE P-YY TO D-YY.
WRITE SOURCE-RECORD FROM D.
WRITE SOURCE-RECORD FROM E.
WRITE SOURCE-RECORD FROM F BEFORE ADVANCING 2 LINES.
WRITE SOURCE-RECORD FROM G.
WRITE SOURCE-RECORD FROM H.
WRITE SOURCE-RECORD FROM I.
WRITE SOURCE-RECORD FROM J BEFORE ADVANCING 2 LINES.
WRITE SOURCE-RECORD FROM K.
WRITE SOURCE-RECORD FROM L BEFORE ADVANCING 2 LINES.
WRITE SOURCE-RECORD FROM M.
WRITE SOURCE-RECORD FROM M1.
WRITE SOURCE-RECORD FROM M2.
WRITE SOURCE-RECORD FROM M3 BEFORE ADVANCING 2 LINES.
WRITE SOURCE-RECORD FROM N-1 BEFORE ADVANCING 2 LINES.
WRITE SOURCE-RECORD FROM N BEFORE ADVANCING 2 LINES.
WRITE SOURCE-RECORD FROM O.
WRITE SOURCE-RECORD FROM P BEFORE ADVANCING 3 LINES.
MOVE NUM-CHARS TO Q-NUM.
WRITE SOURCE-RECORD FROM Q.
MOVE BLOCKING-FACTOR TO Q1-NUM.
WRITE SOURCE-RECORD FROM Q1.
WRITE SOURCE-RECORD FROM Q2 BEFORE ADVANCING 2 LINES.
WRITE SOURCE-RECORD FROM R.
MOVE " X" TO IS-PIC, RK-PIC, SK-PIC.
IF IN-OP-NO = ZERO GO TO NO-OVERLAY-1.
COMPUTE EXTRA-IND = (NUM-PAGES - IN-OP-NO) + 1.
MOVE EXTRA-IND TO A8-NUM, A9-NUM, A6-NUM.
PERFORM GET-FD VARYING PROMPT-IND FROM 1 BY 1
,UNTIL PROMPT-IND = TOP-LINE(IN-OP-NO).
MOVE SPACES TO IS-REDEF.
WRITE SOURCE-RECORD FROM A8.
COMPUTE EXTRA-IND = IN-OP-NO + 1.
PERFORM GET-03 VARYING PROMPT-IND FROM PROMPT-IND BY 1
,UNTIL PROMPT-IND = TOP-LINE(EXTRA-IND).
GO TO NO-OVR-DONE.
NO-OVERLAY-1.
PERFORM GET-FD VARYING PROMPT-IND FROM 1 BY 1
,UNTIL LENGTH-OF-FIELD(PROMPT-IND) = ZERO.
MOVE SPACES TO IS-REDEF.
NO-OVR-DONE.
MOVE SPACES TO SOURCE-RECORD.
WRITE SOURCE-RECORD BEFORE ADVANCING 2 LINES.
WRITE SOURCE-RECORD FROM S-1 BEFORE ADVANCING 2 LINES.
WRITE SOURCE-RECORD FROM S-2 BEFORE ADVANCING 3 LINES.
MOVE "OUT" TO IS1A, 03SYM.
IF IN-OP-NO = ZERO GO TO NO-OVERLAY-2.
PERFORM GET-OUT-FD VARYING OB-IND FROM 1 BY 1
,UNTIL OB-IND = OUT-OP-NO.
WRITE SOURCE-RECORD FROM A9.
PERFORM GET-03-1 VARYING OB-IND FROM OB-IND BY 1
,UNTIL OB-IND > OUT-LA-NO.
GO TO NO-OVR-DONE2.
NO-OVERLAY-2.
PERFORM GET-OUT-FD VARYING OB-IND FROM 1 BY 1
,UNTIL OR-SIZE(OB-IND) = ZERO.
NO-OVR-DONE2.
WRITE SOURCE-RECORD FROM S BEFORE ADVANCING 3 LINES.
WRITE SOURCE-RECORD FROM T.
MOVE VERSION-NUMBER TO U-NUM.
WRITE SOURCE-RECORD FROM U.
MOVE SNAME TO PRG-NAME.
WRITE SOURCE-RECORD FROM PRG-NAM.
MOVE "77 IN-COUNT INDEX." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
WRITE SOURCE-RECORD FROM A7.
MOVE LENGTH-OF-FIELD(POS-KEY) TO V-NUM.
WRITE SOURCE-RECORD FROM V.
MOVE "77 LINE-COUNT PIC S9(3); COMP." TO SOURCE-RECORD.
WRITE SOURCE-RECORD BEFORE ADVANCING 3 LINES.
WRITE SOURCE-RECORD FROM W-1 BEFORE ADVANCING 2 LINES.
WRITE SOURCE-RECORD FROM W.
MOVE F-NAME TO X-FNAME.
WRITE SOURCE-RECORD FROM X.
WRITE SOURCE-RECORD FROM Y BEFORE ADVANCING 2 LINES.
WRITE SOURCE-RECORD FROM Z BEFORE ADVANCING 3 LINES.
WRITE SOURCE-RECORD FROM A1.
WRITE SOURCE-RECORD FROM A2.
WRITE SOURCE-RECORD FROM A3.
WRITE SOURCE-RECORD FROM A4 BEFORE ADVANCING 2 LINES.
MOVE " MOVE F-NAME TO OUTNAM1." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE " OPEN INPUT FILE-IN, OUTPUT FILE-OUT." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE " MOVE LOW-VALUES TO SYM-KEY." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE " MOVE ZERO TO IN-COUNT." TO SOURCE-RECORD.
WRITE SOURCE-RECORD BEFORE ADVANCING 3 LINES.
MOVE "LOOP." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE " READ FILE-IN; INVALID KEY GO TO ALL-DONE." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE " MOVE SPACES TO REC-OUT." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
IF IN-OP-NO = ZERO GO TO NO-OVERLAY-3.
MOVE SPACES TO ML-IND1, ML-IND2.
COMPUTE Z-1 = TOP-LINE(IN-OP-NO) - 1.
PERFORM ML-SETUP THRU ML-EXIT VARYING OB-IND FROM 1 BY 1
,UNTIL INPUT-FIELD(OB-IND) > Z-1.
WRITE SOURCE-RECORD FROM A5.
WRITE SOURCE-RECORD FROM A6.
GO TO NO-OVR-DONE3.
NO-OVERLAY-3.
PERFORM ML-SETUP THRU ML-EXIT VARYING OB-IND FROM 1 BY 1
,UNTIL OR-SIZE(OB-IND) = ZERO.
NO-OVR-DONE3.
MOVE " WRITE REC-OUT." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE " SET IN-COUNT UP BY 1." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE " GO TO LOOP." TO SOURCE-RECORD.
WRITE SOURCE-RECORD BEFORE ADVANCING 3 LINES.
MOVE "ALL-DONE." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
WRITE SOURCE-RECORD FROM DISPLAY-LINE.
MOVE " MOVE PRG-NAM TO OUTNAM1." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE " CLOSE FILE-OUT." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE "CBL" TO ML1-NAME.
WRITE SOURCE-RECORD FROM MOVE-LINE1.
WRITE SOURCE-RECORD FROM A10.
MOVE "REL" TO ML1-NAME.
WRITE SOURCE-RECORD FROM MOVE-LINE1.
WRITE SOURCE-RECORD FROM A10.
MOVE " STOP RUN." TO SOURCE-RECORD.
WRITE SOURCE-RECORD BEFORE ADVANCING 3 LINES.
MOVE "CLEAN-UP. COPY PRCLNUP." TO SOURCE-RECORD.
WRITE SOURCE-RECORD BEFORE ADVANCING 3 LINES.
IF IN-OP-NO = ZERO GO TO ALL-DONE.
MOVE "MOVE-PAGE." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE "(I)" TO ML-IND1, ML-IND2.
PERFORM ML-SETUP THRU ML-EXIT VARYING OB-IND FROM OB-IND BY 1
,UNTIL OB-IND > OUT-LA-NO.
ALL-DONE.
STOP RUN.
GET-FD.
MOVE SPACES TO IS-REDEF.
IF PROMPT-IND = POS-KEY PERFORM GET-REC-KEY.
MOVE PROMPT-IND TO IS-NUM1.
MOVE LENGTH-OF-FIELD(PROMPT-IND) TO IS-NUM2.
WRITE SOURCE-RECORD FROM IN-SYM.
GET-REC-KEY.
MOVE LENGTH-OF-FIELD(POS-KEY) TO RK-NUM.
WRITE SOURCE-RECORD FROM REC-K.
MOVE " REDEFINES REC-KEY" TO IS-REDEF.
GET-OUT-FD.
MOVE OB-IND TO IS-NUM1.
MOVE OR-SIZE(OB-IND) TO IS-NUM2.
WRITE SOURCE-RECORD FROM IN-SYM.
GET-03.
MOVE PROMPT-IND TO 03NUM1.
MOVE LENGTH-OF-FIELD(PROMPT-IND) TO 03NUM2.
WRITE SOURCE-RECORD FROM 03-LINE.
GET-03-1.
MOVE OB-IND TO 03NUM1.
MOVE OR-SIZE(OB-IND) TO 03NUM2.
WRITE SOURCE-RECORD FROM 03-LINE.
ML-SETUP.
IF INPUT-FIELD(OB-IND) = ZERO GO TO ML-EXIT.
MOVE INPUT-FIELD(OB-IND) TO ML-NUM1.
MOVE OB-IND TO ML-NUM2.
WRITE SOURCE-RECORD FROM MOVE-LINE.
ML-EXIT. EXIT.
HELP-DIALOG.
DISPLAY " ".
DISPLAY "IN THE FOLLWING DIALOG, YOU WILL BE CREATING A NEW".
DISPLAY "DATA FILE, WHICH CAN CONTAIN NEW FIELDS OF DATA AS".
DISPLAY "WELL AS AN OLD DATA FIELD. THIS CAN BE A COMPLETE".
DISPLAY "REARRANGEMENT OF YOUR OLD FILE IF DESIRED.".
PERFORM HLP-FIL.
HLP-FIL.
DISPLAY " ".
DISPLAY "COMMANDS ARE AS FOLLOWS: ".
DISPLAY " H.... FOR THIS LIST OF COMMANDS.".
DISPLAY " B.... TO PLACE A BLANK FIELD INTO YOUR OUTPUT RECORD.".
DISPLAY " O.... TO OVERLAY AFTER YOU HAVE COMPLETELY DEFINED".
DISPLAY " THE FIRST OVERLAY PAGE OF YOU NEW OUTPUT RECORD.".
DISPLAY " F.... IF REMAINING FIELDS IN OUTPUT RECORD ARE THE SAME".
DISPLAY " AS THE REMAINING FIELDS IN INPUT RECORD.".
DISPLAY " S.... IF YOUR NEW RECORD TERMINATES AFTER THE LAST".
DISPLAY " FIELD YOU HAVE DEFINED."
DISPLAY " <CR> IF NEXT NEW FIELD CORRESPONDS TO THE NEXT".
DISPLAY " SUCCESSIVE FIELD IN YOUR OLD RECORD.".
DISPLAY Q-LINE.
DISPLAY " ANY INPUT FIELD NUMBER".