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 " IF NEXT NEW FIELD CORRESPONDS TO THE NEXT". DISPLAY " SUCCESSIVE FIELD IN YOUR OLD RECORD.". DISPLAY Q-LINE. DISPLAY " ANY INPUT FIELD NUMBER".