IDENTIFICATION DIVISION. PROGRAM-ID. CSSTOT, VERSION-5, EDIT-5. AUTHOR. BOB CONLON. DATE-WRITTEN. 29-OCT-75, MODIFIED 04-FEB-81. DATE-COMPILED. REMARKS. THIS MODULE CREATES A COBOL SOURCE FILE BASED ON THE EQUATIONS QUERIED FROM THE TTY. IT WILL IN TURN PERFORM THAT MATHEMATICAL OPERATION ON THE 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 VALID-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 PIC X(4035). FD VALID-FILE; VALUE OF IDENTIFICATION IS VLD-NAME. 01 VALID-RECORD. 02 VB OCCURS 4000 TIMES PIC X. FD SOURCE-FILE; VALUE OF IDENTIFICATION IS SOURCE-NAME. 01 SOURCE-RECORD PIC X(84). WORKING-STORAGE SECTION. 77 LINE-NUM PIC S9(3); COMP. 77 D-LINE-NUM PIC Z(3). 77 EXTRA-IND PIC S9(6); COMP. 77 IR-IND PIC S9(3); COMP. 77 IA-IND PIC S9(3); COMP. 77 DONE-FLAG PIC 9; COMP. 77 VLD-IND PIC S9(3); COMP. 77 WR-IND PIC S9(3); COMP. 77 PROMPT-IND PIC S9(3); COMP. 77 USER-PASSWORD PIC X(6). 77 A PIC X(24); VALUE "IDENTIFICATION DIVISION.". 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 PIC X(39); VALUE "FD FORMAT-FILE COPY FDFMT.". 77 T PIC X(24); VALUE "WORKING-STORAGE SECTION.". 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 PRCHKPV2.". 77 A5 PIC X(31); VALUE "OPEN-IT. COPY PRORD.". 77 A6 PIC X(33); VALUE "CONT. COPY PRREWIT.". 77 A7 PIC X(34); VALUE " MOVE OP-PAGE TO OVERLAY-ARRAY.". 77 A8 PIC X(9); VALUE "TOTAL-UP.". 77 BEF-DEC PIC S9(3); COMP. 77 OP-FLAG PIC 9; VALUE ZERO. 77 OL-ARRAY PIC X(18); VALUE "01 OVERLAY-ARRAY.". 77 POUND PIC X(34); VALUE "##################################". 77 REC-TYPE PIC S9(3); COMP. 01 ZERO-LINE. 02 FILLER PIC X(17); VALUE " MOVE ZERO TO ". 02 ZL-NUM PIC Z(3). 02 FILLER PIC X(5); VALUE "HOLD.". 01 TOTAL-UP-LINE-1. 02 FILLER PIC X(36); VALUE " PERFORM TOTAL-UP VARYING I FROM ". 02 FILLER PIC X(17); VALUE "1 BY 1 UNTIL I > ". 02 TUL1-NUM PIC Z(3). 02 FILLER PIC X; VALUE ".". 01 C. 02 FILLER PIC X(8);VALUE "AUTHOR. ". 02 AUTH-NAME PIC X(32). 02 FILLER PIC X; VALUE ".". 01 TOTAL-UP-LINE-2. 02 FILLER PIC X(12); VALUE " COMPUTE ". 02 TUL2-NUM1 PIC Z(3). 02 FILLER PIC X(7); VALUE "HOLD = ". 02 TUL2-NUM2 PIC Z(3). 02 FILLER PIC X(7); VALUE "HOLD + ". 02 TUL2-NUM3 PIC Z(3). 02 FILLER PIC X(6); VALUE "IN(I).". 01 IND. 02 FILLER PIC X(29); VALUE "77 I". 02 FILLER PIC X(16); VALUE "PIC S9(4); COMP.". 01 03-SYM. 02 FILLER PIC X(10); VALUE " 03 ". 02 03-ISYM-NUM1 PIC Z(3). 02 FILLER PIC X(20); VALUE "INN". 02 FILLER PIC X(4); VALUE "PIC ". 02 03-ISYM-TYPE PIC X(2). 02 FILLER PIC X; VALUE "(". 02 03-ISYM-NUM2 PIC 9(3). 02 FILLER PIC X; VALUE ")". 02 03-ISYM-PIC-INFO. 03 03-ISYM-P-OR-V PIC X(3). 03 03-ISYM-NUM3 PIC 9(3). 03 03-ISYM-PAREN2 PIC XX. 03 03-ISYM-LIT PIC X(17). 01 77-LINE. 02 FILLER PIC X(4); VALUE "77 ". 02 77-NUM1 PIC Z(3). 02 FILLER PIC X(22); VALUE "HOLD". 02 FILLER PIC X(7); VALUE "PIC S9(". 02 77-NUM2 PIC 9(3). 02 FILLER PIC X; VALUE ")". 02 77-PIC-INFO. 03 77-P-OR-V PIC X(3). 03 77-NUM3 PIC 9(3). 03 77-PAREN2 PIC X(8). 01 OA-LINE. 02 FILLER PIC X(17); VALUE " 02 OA OCCURS ". 02 OAL-NUM1 PIC Z(3). 02 FILLER PIC X(7); VALUE " TIMES.". 01 OA-LINE-OUT. 02 FILLER PIC X(10); VALUE " 03 ". 02 OALO-NUM1 PIC Z(3). 02 FILLER PIC X(16); VALUE "IN". 02 FILLER PIC X(4); VALUE "PIC ". 02 OALO-TYPE PIC X(3). 02 OALO-NUM2 PIC 9(3). 02 FILLER PIC X; VALUE ")". 02 OALO-PIC-INFO. 03 OALO-P-OR-V PIC X(3). 03 OALO-NUM3 PIC 9(3). 03 OALO-PAREN2 PIC X(2). 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 CSSTOT.". 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. 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 FILLER 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 X; VALUE ")". 02 IS-PIC-INFO. 03 IP-PERIOD-OR-V PIC X(3). 03 IP-NUM1 PIC 9(3). 03 IP-PAREN2 PIC XX. 03 IP-LIT PIC X(17). 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 IA-BUFFER. 02 IA-1 PIC X(12); VALUE " COMPUTE ". 02 IA-2 PIC X(72). 01 LEDFMT-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. 01 WORK-RECORD. 02 WR-BUFF OCCURS 34 TIMES PIC X. 01 INPUT-REGISTER. 02 IR-BUFF OCCURS 72 TIMES PIC X. 01 INPUT-ARRAY. 02 IA-BUFF OCCURS 31 TIMES PIC X(72). 01 IN-HOLD. 02 IN1 PIC 9. 02 IN2 PIC 9. 02 IN3 PIC 9. 01 IN-HOLD1 REDEFINES IN-HOLD PIC 9(3). 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 FILLER PIC X(3); VALUE "TOT". 03 S-NAME PIC X(3). 02 SEXT PIC X(3); VALUE "CBL". 01 VLD-NAME. 02 VLDNAME PIC X(6). 02 FILLER PIC X(3); VALUE "VLD". 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. MOVE FORMAT-RECORD TO LEDFMT-RECORD. IF SPC = "(" MOVE 0 TO REC-TYPE, ENTER MACRO UNSSCR USING REC-TYPE, LEDFMT-RECORD. IF VAL-ID NOT = "Y" DISPLAY "YOU MUST HAVE A VALIDATION FILE TO RUN CSSTOT" ,STOP RUN. 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. DISPLAY " ". IF PRIV(PROMPT-IND) < 3 DISPLAY "NO PRIVILEGES TO RUN THIS PROGRAM" ,STOP RUN. MOVE F-NAME TO VLDNAME. DISPLAY "CSS ARITHMETIC PROCESSOR CSSTOT(V05-5)". DISPLAY " ". DISPLAY "TYPE A 3 CHARACTER IDENTIFIER FOR THIS APPLICATION: "; WITH NO ADVANCING. ACCEPT S-NAME. GET-AUTH. DISPLAY " ". DISPLAY "TYPE IN YOUR NAME: "; WITH NO ADVANCING. ACCEPT AUTH-NAME. IF AUTH-NAME = SPACES GO TO GET-AUTH. OPEN INPUT VALID-FILE. READ VALID-FILE; AT END STOP RUN. MOVE ZERO TO IR-IND, IA-IND, LINE-NUM. DISPLAY "TYPE IN UP TO 30 EQUATIONS; TERMINATE EACH WITH A .". DISPLAY " ". LOOP2. IF DONE-FLAG = 1 SET LINE-NUM TO IA-IND. SET LINE-NUM UP BY 1. MOVE LINE-NUM TO D-LINE-NUM. DISPLAY D-LINE-NUM " : "; WITH NO ADVANCING. ACCEPT INPUT-REGISTER. IF INPUT-REGISTER NOT = "L" GO TO LOOP2-CONT. DISPLAY "#"; WITH NO ADVANCING. ACCEPT LINE-NUM. SET LINE-NUM DOWN BY 1. MOVE LINE-NUM TO IA-IND. GO TO LOOP2. LOOP2-CONT. IF INPUT-REGISTER = SPACES GO TO NEW-PROGRAM. MOVE ZERO TO DONE-FLAG. PERFORM CHK-NUM THRU CN-EXIT VARYING IR-IND FROM 1 ,BY 1 UNTIL IR-IND > 72. IF DONE-FLAG = 1 , GO TO LOOP2. EXAMINE INPUT-REGISTER TALLYING ALL "@". IF TALLY = ZERO GO TO NO-AT. IF OVER-LAY-PAGE > ZERO GO TO NO-AT. DISPLAY "YOUR DATA BASE HAS NO OVERLAY PAGE CAPABILITIES". DISPLAY "@ IS ILLEGAL". SET DONE-FLAG TO 1. GO TO LOOP2. NO-AT. EXAMINE INPUT-REGISTER TALLYING ALL "(". MOVE TALLY TO EXTRA-IND. EXAMINE INPUT-REGISTER TALLYING ALL ")". IF TALLY NOT = EXTRA-IND DISPLAY "WRONG NUMBER OF PARENTHESIS" ,SET DONE-FLAG TO 1, GO TO LOOP2. EXAMINE INPUT-REGISTER TALLYING ALL ".". IF TALLY NOT = 1 DISPLAY "WRONG NUMBER OF PERIODS IN STATEMENT" ,SET DONE-FLAG TO 1, GO TO LOOP2. SET IA-IND UP BY 1. IF IA-IND > 30 GO TO NEW-PROGRAM. PERFORM GET-AT THRU GA-EXIT VARYING IR-IND FROM 1 BY 1 ,UNTIL IR-IND > 72. MOVE INPUT-REGISTER TO IA-BUFF(IA-IND). GO TO LOOP2. CHK-NUM. IF DONE-FLAG = 1 GO TO CN-EXIT. MOVE ZEROES TO IN-HOLD. IF IR-BUFF(IR-IND) NOT = "I" GO TO CN-EXIT. MOVE IR-IND TO EXTRA-IND. SET EXTRA-IND DOWN BY 1. IF EXTRA-IND = ZERO DISPLAY "INVALID SYMBOL 0INN" ,SET DONE-FLAG TO 1, GO TO CN-EXIT. IF IR-BUFF(EXTRA-IND) NOT NUMERIC DISPLAY "INVALID SYMBOL INN" ,SET DONE-FLAG TO 1, GO TO CN-EXIT. MOVE IR-BUFF(EXTRA-IND) TO IN3. IF EXTRA-IND = 1 PERFORM CHK-P-IND THRU CP-EXIT, GO TO CN-EXIT. SET EXTRA-IND DOWN BY 1. IF IR-BUFF(EXTRA-IND) NOT NUMERIC PERFORM CHK-P-IND THRU CP-EXIT, GO TO CN-EXIT. MOVE IR-BUFF(EXTRA-IND) TO IN2. IF EXTRA-IND = 1 PERFORM CHK-P-IND THRU CP-EXIT, GO TO CN-EXIT. SET EXTRA-IND DOWN BY 1. IF IR-BUFF(EXTRA-IND) NOT NUMERIC PERFORM CHK-P-IND THRU CP-EXIT, GO TO CN-EXIT. MOVE IR-BUFF(EXTRA-IND) TO IN1. PERFORM CHK-P-IND THRU CP-EXIT. CN-EXIT. CHK-P-IND. IF IN-HOLD1 > NUMBER-FIELDS DISPLAY IN-HOLD1 "INN DOESN'T EXIST" ,GO TO CP-EXIT. MOVE ZERO TO VLD-IND. PERFORM TOTAL-UP VARYING PROMPT-IND FROM 1 BY 1 UNTIL PROMPT-IND = IN-HOLD1. MOVE POUND TO WORK-RECORD. ADD 1 TO VLD-IND. MOVE ZERO TO WR-IND. PERFORM GET-VLD VARYING VLD-IND FROM VLD-IND BY 1 UNTIL ,WR-IND = LENGTH-OF-FIELD(IN-HOLD1). EXAMINE WORK-RECORD TALLYING ALL SPACES. IF TALLY = LENGTH-OF-FIELD(IN-HOLD1) GO TO CP-EXIT. EXAMINE WORK-RECORD TALLYING ALL "N". IF TALLY NOT = LENGTH-OF-FIELD(IN-HOLD1) ,DISPLAY IN-HOLD1 "INN IS NOT NUMERIC IN THE VALIDATION FILE" ,SET DONE-FLAG TO 1. CP-EXIT. EXIT. TOTAL-UP. COMPUTE VLD-IND = VLD-IND + LENGTH-OF-FIELD(PROMPT-IND). GET-VLD. SET WR-IND UP BY 1. MOVE VB(VLD-IND) TO WR-BUFF(WR-IND). GET-AT. IF IR-BUFF(IR-IND) NOT = "@" GO TO GA-EXIT. MOVE "D" TO IR-BUFF(IR-IND). COMPUTE EXTRA-IND = IR-IND - 1. MOVE "L" TO IR-BUFF(EXTRA-IND). SET EXTRA-IND DOWN BY 1. MOVE "O" TO IR-BUFF(EXTRA-IND). SET EXTRA-IND DOWN BY 1. MOVE "H" TO IR-BUFF(EXTRA-IND). GA-EXIT. EXIT. NEW-PROGRAM SECTION. NP-OPENERS. 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 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. SET VLD-IND TO 1. PERFORM RO-SETUP THRU RO-EXIT VARYING PROMPT-IND FROM 1 BY 1 ,UNTIL LENGTH-OF-FIELD(PROMPT-IND) = ZERO. MOVE SPACES TO SOURCE-RECORD. WRITE SOURCE-RECORD BEFORE ADVANCING 2 LINES. WRITE SOURCE-RECORD FROM S BEFORE ADVANCING 3 LINES. WRITE SOURCE-RECORD FROM T. IF OVER-LAY-PAGE = ZERO GO TO NO-OVERLAY-1. MOVE TOP-LINE(OVER-LAY-PAGE) TO PROMPT-IND. MOVE ZERO TO VLD-IND. PERFORM TOTAL-UP VARYING PROMPT-IND FROM 1 BY 1 ,UNTIL PROMPT-IND = TOP-LINE(OVER-LAY-PAGE). SET VLD-IND UP BY 1. COMPUTE IR-IND = OVER-LAY-PAGE + 1. PERFORM 77-SETUP THRU 77-DONE VARYING PROMPT-IND FROM PROMPT-IND ,BY 1 UNTIL PROMPT-IND = TOP-LINE(IR-IND). WRITE SOURCE-RECORD FROM IND. NO-OVERLAY-1. MOVE VERSION-NUMBER TO U-NUM. WRITE SOURCE-RECORD FROM U. 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. IF OVER-LAY-PAGE = ZERO GO TO NO-OVERLAY-2. WRITE SOURCE-RECORD FROM OL-ARRAY. COMPUTE IR-IND = (NUM-PAGES - OVER-LAY-PAGE) + 1. MOVE IR-IND TO OAL-NUM1, TUL1-NUM. WRITE SOURCE-RECORD FROM OA-LINE. MOVE ZERO TO VLD-IND. PERFORM TOTAL-UP VARYING PROMPT-IND FROM 1 BY 1 ,UNTIL PROMPT-IND = TOP-LINE(OVER-LAY-PAGE). SET VLD-IND UP BY 1. MOVE TOP-LINE(OVER-LAY-PAGE) TO PROMPT-IND. COMPUTE IR-IND = OVER-LAY-PAGE + 1. PERFORM OA-SETUP THRU OA-EXIT VARYING PROMPT-IND FROM PROMPT-IND ,BY 1 UNTIL PROMPT-IND = TOP-LINE(IR-IND). MOVE SPACES TO SOURCE-RECORD. WRITE SOURCE-RECORD. NO-OVERLAY-2. 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. WRITE SOURCE-RECORD FROM A5. PERFORM DUMP-IA THRU DIA-CONT VARYING IA-IND FROM 1 BY 1 ,UNTIL IA-BUFF(IA-IND) = SPACES. WRITE SOURCE-RECORD FROM A6. MOVE "WRONG. COPY PRRTWR." TO SOURCE-RECORD, WRITE SOURCE-RECORD. IF OVER-LAY-PAGE = ZERO GO TO NO-OVERLAY-4. WRITE SOURCE-RECORD FROM A8. MOVE ZERO TO VLD-IND. PERFORM TOTAL-UP VARYING PROMPT-IND FROM 1 BY 1 ,UNTIL PROMPT-IND = TOP-LINE(OVER-LAY-PAGE). SET VLD-IND UP BY 1. COMPUTE IR-IND = OVER-LAY-PAGE + 1. PERFORM TOT-LIN-SETUP THRU TL-EXIT VARYING PROMPT-IND FROM PROMPT-IND ,BY 1 UNTIL PROMPT-IND = TOP-LINE(IR-IND). NO-OVERLAY-4. CLOSE SOURCE-FILE, FORMAT-FILE, VALID-FILE. STOP RUN. RO-SETUP. MOVE "." TO IS-PIC-INFO, 03-ISYM-PIC-INFO. MOVE LENGTH-OF-FIELD(PROMPT-IND) TO IS-NUM2, 03-ISYM-NUM2. PERFORM GET-PIC THRU GP-DONE. MOVE SPACES TO IS-REDEF. IF PROMPT-IND = POS-KEY PERFORM GET-REC-KEY. MOVE PROMPT-IND TO IS-NUM1, 03-ISYM-NUM1. IF OVER-LAY-PAGE = ZERO GO TO RO-WRITE. IF PROMPT-IND < TOP-LINE(OVER-LAY-PAGE) GO TO RO-WRITE. IF OP-FLAG = 1 GO TO RO-WRITE-03. MOVE " 02 OP-PAGE." TO SOURCE-RECORD. WRITE SOURCE-RECORD. SET OP-FLAG TO 1. RO-WRITE-03. WRITE SOURCE-RECORD FROM 03-SYM. GO TO RO-EXIT. RO-WRITE. WRITE SOURCE-RECORD FROM IN-SYM. RO-EXIT. EXIT. GET-PIC. MOVE " X" TO IS-PIC, RK-PIC, 03-ISYM-TYPE. MOVE POUND TO WORK-RECORD. MOVE ZERO TO WR-IND. PERFORM GET-VLD VARYING VLD-IND FROM VLD-IND BY 1 ,UNTIL WR-IND = LENGTH-OF-FIELD(PROMPT-IND). EXAMINE WORK-RECORD TALLYING ALL SPACES. IF TALLY = LENGTH-OF-FIELD(PROMPT-IND) GO TO GP-NUM. EXAMINE WORK-RECORD TALLYING ALL "N". IF TALLY NOT = LENGTH-OF-FIELD(PROMPT-IND) GO TO GP-DONE. GP-NUM. *** THE NEXT TWO STATEMENTS WERE MODIFIED TO ALWAYS CAUSE THE KEY *** *** PICTURE STATEMENTS TO BE DEFINED AS PIC X *** IF PROMPT-IND = POS-KEY GO TO GP-DONE. MOVE "S9" TO IS-PIC, 03-ISYM-TYPE. *** THE NEXT STATEMENT REMOVES THE "BLANK WHEN ZERO" FROM NON-DECIMAL ITEMS. *** THE STATEMENT FOLLOWING WILL INCLUDE "BLANK WHEN ZERO" IF EXECUTED. IF DECIMAL-POSIT(PROMPT-IND) = ZERO GO TO GP-DONE. * IF DECIMAL-POSIT(PROMPT-IND) = ZERO PERFORM LIT-SETUP, GO TO GP-DONE. COMPUTE BEF-DEC = LENGTH-OF-FIELD(PROMPT-IND) - DECIMAL-POSIT(PROMPT-IND). MOVE BEF-DEC TO IS-NUM2, 03-ISYM-NUM2. MOVE "V9(" TO IP-PERIOD-OR-V, 03-ISYM-P-OR-V. MOVE DECIMAL-POSIT(PROMPT-IND) TO IP-NUM1, 03-ISYM-NUM3. *** REMOVAL OF THE NEXT 2 STATEMENTS ELIMINATES "BLANK WHEN ZERO" *** STATEMENTS ON ELEMENTS WITH DECIMALS. * MOVE ");" TO IP-PAREN2, 03-ISYM-PAREN2. * MOVE " BLANK WHEN ZERO." TO IP-LIT, 03-ISYM-LIT. MOVE ")." TO IP-PAREN2, 03-ISYM-PAREN2. GP-DONE. EXIT. 77-SETUP. MOVE POUND TO WORK-RECORD. MOVE ZERO TO WR-IND. PERFORM GET-VLD VARYING VLD-IND FROM VLD-IND BY 1 ,UNTIL WR-IND = LENGTH-OF-FIELD(PROMPT-IND). EXAMINE WORK-RECORD TALLYING ALL SPACES. IF TALLY = LENGTH-OF-FIELD(PROMPT-IND) GO TO 77-NUM. EXAMINE WORK-RECORD TALLYING ALL "N". IF TALLY NOT = LENGTH-OF-FIELD(PROMPT-IND) GO TO 77-DONE. 77-NUM. MOVE LENGTH-OF-FIELD(PROMPT-IND) TO 77-NUM2. MOVE PROMPT-IND TO 77-NUM1. MOVE "; COMP." TO 77-PIC-INFO. IF DECIMAL-POSIT(PROMPT-IND) = ZERO GO TO 77-WRITE. COMPUTE BEF-DEC = LENGTH-OF-FIELD(PROMPT-IND) - DECIMAL-POSIT(PROMPT-IND). MOVE "V9(" TO 77-P-OR-V. MOVE BEF-DEC TO 77-NUM2. MOVE DECIMAL-POSIT(PROMPT-IND) TO 77-NUM3. MOVE "); COMP." TO 77-PAREN2. 77-WRITE. WRITE SOURCE-RECORD FROM 77-LINE. 77-DONE. EXIT. OA-SETUP. MOVE POUND TO WORK-RECORD. SET WR-IND TO ZERO. PERFORM GET-VLD VARYING VLD-IND FROM VLD-IND BY 1 ,UNTIL WR-IND = LENGTH-OF-FIELD(PROMPT-IND). MOVE PROMPT-IND TO OALO-NUM1. MOVE " X(" TO OALO-TYPE. MOVE LENGTH-OF-FIELD(PROMPT-IND) TO OALO-NUM2. MOVE "." TO OALO-PIC-INFO. EXAMINE WORK-RECORD TALLYING ALL SPACES. IF TALLY = LENGTH-OF-FIELD(PROMPT-IND) GO TO OA-NUM. EXAMINE WORK-RECORD TALLYING ALL "N". IF TALLY NOT = LENGTH-OF-FIELD(PROMPT-IND) GO TO OA-EXIT. OA-NUM. MOVE "S9(" TO OALO-TYPE. IF DECIMAL-POSIT(PROMPT-IND) = ZERO GO TO OA-EXIT. COMPUTE BEF-DEC = LENGTH-OF-FIELD(PROMPT-IND) - DECIMAL-POSIT(PROMPT-IND). MOVE BEF-DEC TO OALO-NUM2. MOVE DECIMAL-POSIT(PROMPT-IND) TO OALO-NUM3. MOVE "V9(" TO OALO-P-OR-V. MOVE ")." TO OALO-PAREN2. OA-EXIT. WRITE SOURCE-RECORD FROM OA-LINE-OUT. 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. MOVE " X" TO SK-PIC. *** THIS PREVIOUS PARAGRAPH WAS MODIFIED DELETING 4 LINES OF CODE *** *** WHICH CHECKED AND CHANGED THE SYMBOLIC PICTURE STATEMENT IF *** *** VALIDATION DATA SHOWED THE KEY TO BE NUMERIC *** DUMP-IA. EXAMINE IA-BUFF(IA-IND) TALLYING ALL "H". IF TALLY = 0 GO TO DIA-CONT. *** FROM HERE TO DIA-CONT WAS MOVED SO THAT THE COLLECTIVE COMPUTATION *** *** WILL BE DONE AFTER EVERYTHING IS COMPUTED. *** IF OVER-LAY-PAGE = ZERO GO TO DIA-CONT. MOVE ZERO TO VLD-IND. PERFORM TOTAL-UP VARYING PROMPT-IND FROM 1 BY 1 ,UNTIL PROMPT-IND = TOP-LINE(OVER-LAY-PAGE). SET VLD-IND UP BY 1. COMPUTE IR-IND = OVER-LAY-PAGE + 1. PERFORM Z-LINE-SETUP THRU ZL-EXIT VARYING PROMPT-IND FROM PROMPT-IND ,BY 1 UNTIL PROMPT-IND = TOP-LINE(IR-IND). MOVE " MOVE OP-PAGE TO OVERLAY-ARRAY." TO SOURCE-RECORD. WRITE SOURCE-RECORD. WRITE SOURCE-RECORD FROM TOTAL-UP-LINE-1. DIA-CONT. MOVE IA-BUFF(IA-IND) TO IA-2. WRITE SOURCE-RECORD FROM IA-BUFFER. Z-LINE-SETUP. MOVE POUND TO WORK-RECORD. MOVE ZERO TO WR-IND. PERFORM GET-VLD VARYING VLD-IND FROM VLD-IND BY 1 ,UNTIL WR-IND = LENGTH-OF-FIELD(PROMPT-IND). EXAMINE WORK-RECORD TALLYING ALL SPACES. IF TALLY = LENGTH-OF-FIELD(PROMPT-IND) GO TO Z-NUM. EXAMINE WORK-RECORD TALLYING ALL "N". IF TALLY NOT = LENGTH-OF-FIELD(PROMPT-IND) GO TO ZL-EXIT. Z-NUM. MOVE PROMPT-IND TO ZL-NUM. WRITE SOURCE-RECORD FROM ZERO-LINE. ZL-EXIT. EXIT. TOT-LIN-SETUP. MOVE POUND TO WORK-RECORD. MOVE ZERO TO WR-IND. PERFORM GET-VLD VARYING VLD-IND FROM VLD-IND BY 1 ,UNTIL WR-IND = LENGTH-OF-FIELD(PROMPT-IND). EXAMINE WORK-RECORD TALLYING ALL SPACES. IF TALLY = LENGTH-OF-FIELD(PROMPT-IND) GO TO TOT-NUM. EXAMINE WORK-RECORD TALLYING ALL "N". IF TALLY NOT = LENGTH-OF-FIELD(PROMPT-IND) GO TO TL-EXIT. TOT-NUM. MOVE PROMPT-IND TO TUL2-NUM1, TUL2-NUM2, TUL2-NUM3. WRITE SOURCE-RECORD FROM TOTAL-UP-LINE-2. TL-EXIT. EXIT. LIT-SETUP. MOVE "; BLANK WHEN ZERO." TO IS-PIC-INFO, 03-ISYM-PIC-INFO.