Trailing-Edge
-
PDP-10 Archives
-
decuslib10-11
-
43,50534/cssrpt.cbl
There is 1 other file named cssrpt.cbl in the archive. Click here to see a list.
IDENTIFICATION DIVISION.
PROGRAM-ID. CSSRPT, VERSION-5, EDIT-10.
AUTHOR. BOB CONLON.
DATE-WRITTEN. 03-FEB-75, MODIFIED 05-FEB-81.
DATE-COMPILED.
REMARKS. THIS PROGRAM GENERATES REPORTS IN THE FORM OF CBL SOURCES
BASED ON THE FORMAT FILE FROM CSSDBW. IT REQUIRES NO
PROGRAMMING EXPERTISE TO RUN.
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.
SELECT RPTDAT-FILE ASSIGN TO DSK.
DATA DIVISION.
FILE SECTION.
FD FORMAT-FILE; VALUE OF IDENTIFICATION IS FORMAT-NAME
USER-NUMBER IS OCTAL-PPN.
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 PRG-FLAG PIC X.
02 FILLER PIC X(2).
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(74).
FD RPTDAT-FILE; VALUE OF IDENTIFICATION IS RPTDAT-NAME.
01 RPTDAT-RECORD.
02 DR-TYPE PIC 9.
02 DR-REST PIC X(433).
WORKING-STORAGE SECTION.
77 REC-TYPE PIC S9(3); COMP.
77 SORT-KEEPER PIC S9(3); COMP.
77 LINE-COUNT PIC S9(3); COMP.
77 SUP-IND1 PIC S9(2); COMP.
77 SUP-IND2 PIC S9(6); COMP.
77 IA1-IND PIC S9(6); COMP.
77 IA2-IND PIC S9(6); COMP.
77 HOLD1 PIC S9(3); COMP.
77 HOLD2 PIC 9; COMP.
77 HOLD3 PIC 9(3); COMP.
77 NUM-LINES PIC 9; VALUE 2.
77 TOF PIC A.
77 DUBSPA PIC A.
77 CHK-03-CNT PIC 9; COMP.
77 NEW-IND PIC S9(4); COMP.
77 FLD-IND PIC S9(3); COMP.
77 H-IND PIC S9(4); COMP.
77 SRT-IND PIC S9(3); COMP.
77 PROMPT-IND PIC S9(3); COMP.
77 TTY-IND PIC S9(3); COMP.
77 WR-IND PIC S9(3); COMP.
77 OUT-FIL PIC S9(3); COMP.
77 IV-IND PIC S9(3); COMP.
77 RESP PIC A.
77 USER-PASSWORD PIC X(6).
77 WORK-REC-SAVE PIC X(132).
77 1A PIC X(60); VALUE "IDENTIFICATION DIVISION.".
77 1C PIC X(60); VALUE "DATE-COMPILED.".
77 1D PIC X(60); VALUE "REMARKS. WRITTEN BY CSSRPT(V05).".
77 1E PIC X(60); VALUE "ENVIRONMENT DIVISION.".
77 1F PIC X(60); VALUE "CONFIGURATION SECTION.".
77 1G PIC X(60); VALUE "SOURCE-COMPUTER. DECSYSTEM-10.".
77 1H PIC X(60); VALUE "OBJECT-COMPUTER. DECSYSTEM-10.".
77 1I PIC X(60); VALUE "SPECIAL-NAMES.".
77 1J PIC X(60); VALUE " CHANNEL (1) IS TOP-OF-FORM.".
77 1K PIC X(60); VALUE "INPUT-OUTPUT SECTION.".
77 1L PIC X(60); VALUE "FILE-CONTROL.".
77 1M PIC X(60); VALUE " SELECT FILE-IN ASSIGN TO DSK".
77 1N PIC X(60); VALUE " ACCESS MODE IS INDEXED".
77 1O PIC X(60); VALUE " SYMBOLIC KEY IS SYM-KEY".
77 1P PIC X(60); VALUE " RECORD KEY IS REC-KEY.".
77 1Q PIC X(60); VALUE " SELECT TEMP ASSIGN TO DSK,DSK,DSK.".
77 1S PIC X(60); VALUE "DATA DIVISION.".
77 1T PIC X(60); VALUE "FILE SECTION.".
77 1U PIC X(60); VALUE "FD FILE-IN".
77 1V PIC X(60); VALUE "01 REC-IN.".
77 1W PIC X(60); VALUE "SD TEMP.".
77 1X PIC X(60); VALUE "01 REC-SORT.".
77 1Y PIC X(60); VALUE "FD FILE-OUT".
77 2A PIC X(60); VALUE "WORKING-STORAGE SECTION.".
77 2B PIC X(60); VALUE "77 LINE-COUNT PIC S9(3); COMP.".
77 2C PIC X(60); VALUE "77 PAGE-COUNT PIC S9(3); COMP.".
77 2D PIC X(60); VALUE "01 LINE-OUT.".
77 2E PIC X(60); VALUE "01 HEADER-1.".
77 2F PIC X(60); VALUE " 02 PAGE-NUM PIC ZZ9.".
77 2G PIC X(60); VALUE "01 HEADER-3.".
77 2H PIC X(60); VALUE "01 HEADER-4.".
77 2I PIC X(60); VALUE "01 P-TODAY COPY RPTWS1.".
77 2J PIC X(60); VALUE "PROCEDURE DIVISION.".
77 HS-IND PIC S9(3); COMP.
77 TOT-FLAG PIC 9; VALUE ZERO.
77 N PIC S9(3); COMP.
77 2K PIC X(60); VALUE "01 ACC-1.".
77 2L PIC X(60); VALUE "01 ACC-2.".
77 2M PIC X(60); VALUE " IF I = 1 READ FILE-IN; INVALID KEY GO TO ALL-DONE.".
77 2N PIC X(60); VALUE " IF I = 1 READ FILE-IN; INVALID KEY GO TO NS-DONE.".
77 2S PIC X(60); VALUE " IF PAGE1(I) = SPACES SET I TO 1.".
77 OV-FLAG PIC 9; COMP.
77 I2 PIC X(60); VALUE "01 P-TODAY COPY RPTWS2.".
77 OVERLAY-PAGE PIC 999; COMP.
77 I PIC X(60); VALUE "77 I PIC S9(3); COMP.".
77 OP-RESP PIC A.
77 TTY-OP-DEV PIC A.
77 FMTSEL PIC X(60); VALUE " SELECT FORMAT-FILE ASSIGN TO DSK.".
77 FMTFD PIC X(60); VALUE "FD FORMAT-FILE COPY FDFMT.".
77 FMTFD1 PIC X(60); VALUE "FD FORMAT-FILE COPY FDFMT1.".
77 FI-NAME PIC X(60); VALUE "01 FILE-IN-NAME.".
77 PI PIC X(60); VALUE "01 PROMPT-INFO COPY WSFMT1.".
77 CI PIC X(60); VALUE "CHECK-IT. COPY PRCHKPW.".
77 PC-0 PIC X(60); VALUE "PRIV-CHK. COPY PRCHKPV0.".
77 PC-1 PIC X(60); VALUE "PRIV-CHK. COPY PRCHKPV1.".
77 PC-2 PIC X(60); VALUE "PRIV-CHK. COPY PRCHKPV2.".
77 PC-3 PIC X(60); VALUE "PRIV-CHK. COPY PRCHKPV3.".
77 OVR-LAY PIC A.
77 DECIMAL-FLAG PIC S9; COMP.
77 BEF-DECIMAL PIC 9(3); COMP.
77 DL-ASTER PIC X(3); VALUE "/*/".
77 CODE-RESP PIC 9.
77 PP-I PIC S9(3); COMP.
77 ERR-FLAG PIC 9; COMP.
77 HALF-NUM PIC S9(7); COMP.
77 OCTAL-PPN PIC S9(10); COMP.
77 DR-N-O PIC A.
77 DR-C-U PIC A.
77 DR-FLAG PIC S9; COMP VALUE 0.
77 DR-IND PIC S9(3); COMP.
77 CHANGE-RESP PIC X.
77 INP-WRK PIC X(3).
77 DO-RIGHT PIC X(18); VALUE " PERFORM RIGHT.".
77 PR-RT PIC X(20); VALUE "WRONG. COPY PRRTWR.".
77 DO-RIGHT1 PIC X(27); VALUE " IF I = 1 PERFORM RIGHT.".
01 INP-RESP.
02 IR-1 PIC X.
02 FILLER PIC XX.
01 CHANGE-DISPLAY-LINE.
02 CDL-RPT-POSIT PIC Z(5).
02 FILLER PIC X(3); VALUE "...".
02 CDL-FIELD-NAME PIC X(20).
02 FILLER PIC X(2); VALUE "..".
02 CDL-A-N PIC XX.
02 FILLER PIC XX; VALUE "..".
02 CDL-TOT PIC X.
02 FILLER PIC XX; VALUE "..".
02 CDL-RPT-SIZE PIC Z(6).
02 FILLER PIC X(2); VALUE "..".
02 CDL-BREAKDOWN OCCURS 5 TIMES.
03 CDL-BD PIC Z(2).
03 CDL-FILLER PIC X(2).
02 FILLER PIC XX; VALUE ": ".
01 RPTDAT-NAME.
02 RPT-N-001.
03 RN-001 PIC X(3).
03 RN-002 PIC X(3).
02 FILLER PIC X(3); VALUE "HLD".
01 DR-R2-ARRAY.
02 DR-RT-BUFF OCCURS 10 TIMES PIC X(36).
01 RPTDAT-RECORD1.
02 DR-RUN-PRIV PIC 9.
02 DR-PPN.
03 DR-PROJ PIC 9(6).
03 DR-PROG PIC 9(6).
02 DR-OUTDEV PIC X(3).
02 DR-VT05 PIC A.
02 DR-OVERLAY PIC A.
02 DR-NEED-HDRS PIC X.
02 DR-AUTHOR PIC X(32).
02 DR-RPT-TITLE PIC X(66).
02 DR-SORTING-SEQUENCE PIC X(43).
02 DR-DOUBLE-SPACE PIC X.
02 DR-NEWPAGE-BREAK PIC X.
02 DR-NOLINES-BREAK PIC X.
02 DR-HEADER-1.
03 DR-H1 OCCURS 132 TIMES PIC X.
02 DR-HEADER-2.
03 DR-H2 OCCURS 132 TIMES PIC X.
02 DR-RPT-VERS PIC X(3).
02 DR-RPT-NAME PIC X(3).
01 RPTDAT-RECORD2.
02 DR-OREC OCCURS 40 TIMES.
03 DR-IN-FLD PIC S9(3); COMP.
03 DR-A-OR-N PIC A.
03 DR-TOT-SIZE PIC S9(3); COMP.
03 DR-DECIMAL-PLACES PIC 99.
03 DR-FLD-REGISTER OCCURS 5 TIMES.
05 DR-FLD-ARRAY PIC 9(3).
03 DR-TOT PIC A.
01 RPTDAT-RECORD3.
02 DR-SUPPRESS-ARRAY OCCURS 10 TIMES.
03 DR-SA-SYMBOL PIC X(7).
03 DR-SA-IND PIC X(3).
03 DR-SA-SIGN PIC X(3).
03 DR-SA-LITERAL OCCURS 10 TIMES PIC X(36).
01 SRT-ARRAY.
02 SRT-INP-FLD OCCURS 10 TIMES PIC 9(3).
02 SRT-INP-SUB OCCURS 10 TIMES PIC 9.
01 MOV-SRT-LINE.
02 FILLER PIC X(9); VALUE " MOVE ".
02 MS-NUM1 PIC Z(3).
02 FILLER PIC X(3); VALUE "INN".
02 MS-NUM-IND.
03 MS-NUM2 PIC Z.
03 MS-IND PIC X(3).
02 FILLER PIC X(4); VALUE " TO ".
02 MS-NUM3 PIC Z(3).
02 FILLER PIC X(3); VALUE "SRT".
02 MS-NUM4 PIC Z.
02 FILLER PIC X; VALUE ".".
01 SRT-ITEMS.
02 FILLER PIC X(7); VALUE " 02 ".
02 SI-NAME PIC X(30).
02 FILLER PIC X(4); VALUE "PIC ".
02 SI-PIC-TYPE PIC X(3).
02 SI-NUM1 PIC 9(3).
02 SI-DOT-OR-CONT.
03 SI-PAREN1 PIC X(4).
03 SI-NUM2 PIC 9(3).
03 SI-PAREN2 PIC XX.
01 SRT-ITM.
02 SI-IT-001 PIC Z(3).
02 FILLER PIC X(3); VALUE "SRT".
02 SI-IT-002 PIC Z.
01 MOV-DAT-LINE1.
02 FILLER PIC X(9); VALUE " MOVE ".
02 MDL1-SYM PIC Z(3).
02 FILLER PIC X(3); VALUE "INN".
02 MDL1-IND PIC X(3).
02 FILLER PIC X(16); VALUE " TO DATE-BUFFER.".
01 MOV-DAT-LINE2.
02 FILLER PIC X(21); VALUE " MOVE DATE-FMT TO ".
02 MDL2-SYM PIC Z(3).
02 FILLER PIC X(4); VALUE "OUT.".
01 WORK-REC1.
02 WR1 OCCURS 9 TIMES PIC X.
01 WORK-REC2.
02 WR2 OCCURS 4 TIMES PIC X.
01 USR-PPN.
02 FILLER PIC X(19); VALUE " USER-NUMBER IS ".
02 USR-DR-PPN.
03 UP-PROJ PIC Z(4).
03 FILLER PIC XX; VALUE ", ".
03 UP-PROG PIC Z(4).
02 FILLER PIC X; VALUE ".".
01 PP-NUMBER.
02 PROJ-NUMBER PIC 9(6).
02 PROG-NUMBER PIC 9(6).
02 EITHER-NUM PIC 9(6).
02 X REDEFINES EITHER-NUM.
03 PP-DIGIT OCCURS 6 TIMES PIC 9.
01 FMT1-01.
02 FILLER PIC X(38); VALUE "01 FORMAT-REC PIC X(4035); DISPLAY-6.".
01 DISPLAY-LINE.
02 FILLER PIC X(12); VALUE " DISPLAY".
02 DL-FILL PIC X(36).
02 FILLER PIC X(19); VALUE ";WITH NO ADVANCING.".
01 D-ACC-LIN.
02 FILLER PIC X(11); VALUE " ACCEPT ".
02 DL-VAR.
03 DAL-1 PIC Z9.
03 FILLER PIC X(3); VALUE "VAR".
03 DAL-2 PIC X.
02 FILLER PIC X; VALUE ".".
01 FI-FIN.
02 FILLER PIC X(20); VALUE " 02 FIN".
02 FILLER PIC X(16); VALUE "PIC X(6); VALUE ".
02 FILLER PIC X; VALUE QUOTE.
02 FI-FN.
03 FIF-1 PIC X(3).
03 FIF-2 PIC X(3).
02 FILLER PIC X; VALUE QUOTE.
02 FILLER PIC X; VALUE ".".
01 FI-EXT.
02 FILLER PIC X(20); VALUE " 02 FILLER".
02 FILLER PIC X(16); VALUE "PIC X(3); VALUE ".
02 FILLER PIC X; VALUE QUOTE.
02 FI-EX PIC X(3).
02 FILLER PIC X; VALUE QUOTE.
02 FILLER PIC X; VALUE ".".
01 VERS.
02 FILLER PIC X(20); VALUE "77 VERS-NUM".
02 FILLER PIC X(16); VALUE "PIC 9(3); VALUE ".
02 VER-NUM PIC 9(3).
02 FILLER PIC X; VALUE ".".
01 SAVE06.
02 FILLER PIC X(20); VALUE "77 SAVE-06".
02 FILLER PIC X(6); VALUE "PIC X(".
02 S06-NUM PIC 9(3).
02 FILLER PIC XX; VALUE ").".
01 MOV-SPA.
02 FILLER PIC X(19); VALUE " MOVE SPACES TO ".
02 MOV-SPA-NUM PIC ZZ9.
02 FILLER PIC X(4); VALUE "INN.".
01 IF-LINE.
02 FILLER PIC X(7); VALUE " IF ".
02 IL-NUM1 PIC Z(3).
02 FILLER PIC X(23); VALUE "INN NOT = SAVE-06 MOVE ".
02 IL-NUM2 PIC Z(3).
02 FILLER PIC X(28); VALUE "INN TO SAVE-06, GO TO CONT1.".
01 MOVE-06.
02 FILLER PIC X(9); VALUE " MOVE ".
02 MOVE-06-NUM PIC Z(3).
02 FILLER PIC X(15); VALUE "INN TO SAVE-06.".
01 VAR-IAB.
02 FILLER PIC X(4); VALUE "77 ".
02 VAR-PRIME PIC Z9.
02 FILLER PIC X(3); VALUE "VAR".
02 VAR-SEC PIC 9.
02 FILLER PIC X(10); VALUE SPACES.
02 FILLER PIC X(4); VALUE "PIC ".
02 VAR-TYPE PIC XX.
02 FILLER PIC X; VALUE "(".
02 VAR-NUM1 PIC 9(3).
02 FILLER PIC X; VALUE ")".
02 VAR-PERIOD-OR-V.
03 VAR-V PIC X(3).
03 VAR-NUM3 PIC 9(3).
03 VAR-CL-PAR PIC X(3).
01 1R.
02 FILLER PIC X(35); VALUE " SELECT FILE-OUT ASSIGN TO ".
02 1R-DEV PIC X(3).
02 FILLER PIC X; VALUE ".".
01 1Z.
02 FILLER PIC X(30); VALUE "01 REC-OUT; DISPLAY-7 PIC X(".
02 1Z-NUM PIC 9(3).
02 FILLER PIC XX; VALUE ").".
01 INPUT-ARRAY1.
02 IA1 OCCURS 34 TIMES PIC X.
01 IA-REGIS REDEFINES INPUT-ARRAY1.
02 IAR PIC X(7).
02 FILLER PIC X(27).
01 INPUT-ARRAY2.
02 IA2 OCCURS 36 TIMES PIC X.
01 IN-AR REDEFINES INPUT-ARRAY2.
02 INAR PIC 999.
02 FILLER PIC X(33).
01 SUPPRESS-LINE1.
02 FILLER PIC X(7); VALUE " IF ".
02 SL1-SYM PIC X(7).
02 SL1-IND PIC X(3).
02 FILLER PIC X; VALUE SPACE.
02 SL1-SIGN PIC X(3).
02 FILLER PIC X; VALUE SPACE.
02 SL1-LITERAL PIC X(36).
02 FILLER PIC X(7); VALUE " GO TO ".
02 SL1-TAG.
03 SL1-TAG1 PIC X(3).
03 SL-NUM1 PIC XX.
03 SL-PERIOD PIC X.
03 FILLER PIC X(3).
02 SL-TAG1 REDEFINES SL1-TAG.
03 FILLER PIC X(9).
01 SUPPRESS-REGISTER.
02 SUPPRESS-ARRAY OCCURS 10 TIMES.
03 SA-SYMBOL PIC X(7).
03 SA-IND PIC X(3).
03 SA-SIGN PIC X(3).
03 SA-LITERAL OCCURS 10 TIMES PIC X(36).
01 N-LINE.
02 FILLER PIC X(36); VALUE "77 N PIC 9; VALUE ".
02 N-LINE-NUM PIC 9.
02 FILLER PIC X; VALUE ".".
01 SORT-SYM.
02 SS-1 PIC 9.
02 SS2 PIC 9.
02 SS3 PIC 9.
01 SAVE01.
02 FILLER PIC X(29); VALUE "77 SAVE-01 PIC X(".
02 SAVE-NUM PIC 999.
02 FILLER PIC X(2); VALUE ").".
01 S-LINE-1.
02 FILLER PIC X(17); VALUE " IF SAVE-01 = ".
02 SL1-NUM PIC ZZ9.
02 FILLER PIC X(3); VALUE "INN".
02 SL1-NUM2 PIC Z.
02 SL-1-IND PIC X(3).
02 FILLER PIC X(12); VALUE " GO TO CONT.".
01 S-LINE-2.
02 FILLER PIC X(12); VALUE " COMPUTE ".
02 SL2-NUM1 PIC ZZ9.
02 FILLER PIC X(15); VALUE "ACS OF ACC-2 = ".
02 SL2-NUM2 PIC ZZ9.
02 FILLER PIC X(15); VALUE "ACS OF ACC-2 + ".
02 SL2-NUM3 PIC ZZ9.
02 FILLER PIC X(13); VALUE "ACS OF ACC-1.".
01 S-LINE-3.
02 FILLER PIC X(9); VALUE " MOVE ".
02 SL3-NUM1 PIC ZZ9.
02 FILLER PIC X(11); VALUE "ACS OF ACC-".
02 SL3-NUM1A PIC 9; VALUE 1.
02 FILLER PIC X(4); VALUE " TO ".
02 SL3-NUM2 PIC ZZ9.
02 FILLER PIC X(4); VALUE "TOT.".
01 S-LINE-4.
02 FILLER PIC X(8); VALUE " ADD ".
02 SL4-NUM1 PIC ZZ9.
02 FILLER PIC X(3); VALUE "INN".
02 SL4-IND PIC X(3).
02 FILLER PIC X(4); VALUE " TO ".
02 SL4-NUM2 PIC ZZ9.
02 FILLER PIC X(13); VALUE "ACS OF ACC-1.".
01 S-LINE-5.
02 FILLER PIC X(9); VALUE " MOVE ".
02 SL5-NUM1 PIC ZZ9.
02 FILLER PIC X(3); VALUE "INN".
02 SL5-NUM2 PIC Z.
02 SL-5-IND PIC X(3).
02 FILLER PIC X(12); VALUE " TO SAVE-01.".
01 1B.
02 FILLER PIC X(8); VALUE "AUTHOR. ".
02 AUTH-NAME PIC X(32).
02 FILLER PIC X; VALUE ".".
01 AC-REGISTER.
02 FILLER PIC X(7); VALUE " 02 ".
02 ACR1 PIC ZZ9.
02 FILLER PIC X(3); VALUE "ACS".
02 FILLER PIC X(12); VALUE SPACES.
02 FILLER PIC X(7); VALUE "PIC S9(".
02 ACR3 PIC 999.
02 FILLER PIC X; VALUE ")".
02 ACR-PIC-INFO.
03 ACR-PERIOD-OR-V PIC X.
03 ACR-DPAR1 PIC XX.
03 ACR-NUM2 PIC 9(3).
03 ACR-DPAR2 PIC X(8).
01 TALLY-HOLD.
02 TH1 PIC 9(5).
02 TH2 PIC 9(3).
01 TOT-CHARS; COMP.
02 TC1 PIC S9(3).
02 TC2 PIC S9(3).
01 SYMB-KEY.
02 FILLER PIC X(29); VALUE "77 SYM-KEY PIC X(".
02 SK-NUM PIC 999.
02 FILLER PIC X(2); VALUE ").".
01 SORT-STATEMENT.
02 FILLER PIC X(4); VALUE SPACES.
02 FILLER PIC X(27); VALUE "SORT TEMP ON ASCENDING KEY ".
02 SS1 PIC X(43).
01 MOVE-LINE.
02 FILLER PIC X(9); VALUE " MOVE ".
02 ML-1 PIC ZZ9.
02 FILLER PIC X(3); VALUE "INN".
02 ML-2 PIC Z.
02 ML-2A PIC X(3).
02 FILLER PIC X(4); VALUE " TO ".
02 ML-3 PIC ZZ9.
02 FILLER PIC X(4); VALUE "OUT.".
01 TITLE-ARRAY.
02 TA OCCURS 66 TIMES PIC X.
01 TITLE-ARRAY1.
02 TA1 PIC X(33).
02 TA2 PIC X(33).
01 HEADER-INFO1.
02 FILLER PIC X(20); VALUE " 02 FILLER PIC X(".
02 HI-NUM PIC 999.
02 FILLER PIC X(9); VALUE "); VALUE ".
02 REST PIC X(39).
01 QUOTE-1.
02 FILLER PIC X; VALUE QUOTE.
02 Q1 PIC X(33).
02 FILLER PIC X; VALUE QUOTE.
02 FILLER PIC X; VALUE ".".
01 QUOTE-2.
02 FILLER PIC X; VALUE QUOTE.
02 FILLER PIC X(5); VALUE "PAGE ".
02 FILLER PIC X; VALUE QUOTE.
02 FILLER PIC X; VALUE ".".
01 QUOTE-3.
02 FILLER PIC X; VALUE QUOTE.
02 Q3 PIC X(36).
02 FILLER PIC X; VALUE QUOTE.
02 FILLER PIC X; VALUE ".".
01 PRG-ID.
02 FILLER PIC X(12); VALUE "PROGRAM-ID. ".
02 PRG-NAME PIC X(6).
02 FILLER PIC X(21); VALUE ", VERSION-5B, EDIT-1.".
01 WRT-DATE.
02 FILLER PIC X(15); VALUE "DATE-WRITTEN. ".
02 WD-DAY PIC 99.
02 FILLER PIC X; VALUE "-".
02 WD-MON PIC X(3).
02 FILLER PIC X; VALUE "-".
02 WD-YR PIC 99.
02 FILLER PIC X; VALUE ".".
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 P-TODAY.
02 TOD.
03 P-YR PIC 99.
03 P-MO PIC 99.
03 P-DA PIC 99.
02 FILLER PIC X(6).
01 INPUT-VERIFIER.
02 IV OCCURS 60 TIMES.
03 IV-FLD-NUM PIC 9(3); COMP.
03 IV-INN PIC X(3).
03 IV-BD PIC 9(3); COMP.
01 REC-CONT.
02 FILLER PIC X(12); VALUE SPACES.
02 FILLER PIC X(16); VALUE "RECORD CONTAINS ".
02 RC-NUM PIC 9(4).
02 FILLER PIC X(11); VALUE " CHARACTERS".
01 BLOCK-CONT.
02 FILLER PIC X(12); VALUE SPACES.
02 FILLER PIC X(15); VALUE "BLOCK CONTAINS ".
02 BC-NUM PIC 9(3).
02 FILLER PIC X(8); VALUE " RECORDS".
01 VID.
02 FILLER PIC X(12); VALUE SPACES.
02 FILLER PIC X(27); VALUE "VALUE OF IDENTIFICATION IS ".
02 FILLER PIC X(12); VALUE "FILE-IN-NAME".
02 VI-DOT PIC X; VALUE ".".
01 VID-NAME.
02 FILLER PIC X(12); VALUE SPACES.
02 FILLER PIC X(27); VALUE "VALUE OF IDENTIFICATION IS ".
02 FILLER PIC X; VALUE QUOTE.
02 VI-FN PIC X(6).
02 VI-EX PIC X(3).
02 FILLER PIC X; VALUE QUOTE.
02 FILLER PIC X; VALUE ".".
01 FILL-REC.
02 FILLER PIC X(13); VALUE " 02 FILLER".
02 FILLER PIC X(20); VALUE SPACES.
02 FILLER PIC X(6); VALUE "PIC X(".
02 FR-NUM PIC 9(4).
02 FILLER PIC X(2); VALUE ").".
01 REC-KEY.
02 FILLER PIC X(14); VALUE " 02 REC-KEY".
02 FILLER PIC X(19); VALUE SPACES.
02 FILLER PIC X(6); VALUE "PIC X(".
02 RK-NUM PIC 9(3).
02 FILLER PIC X(2); VALUE ").".
01 LINE-OUT.
02 FILLER PIC X(7); VALUE " 02 ".
02 LO-NUM PIC ZZZ.
02 LO-NAME PIC X(3).
02 LO-FILL PIC X(20).
02 FILLER PIC X(4); VALUE "PIC ".
02 LO-TYPE PIC X(2).
02 FILLER PIC X; VALUE "(".
02 LO-SIZE PIC 9(4).
02 FILLER PIC X; VALUE ")".
02 LO-PIC-INFO.
03 LO-PERIOD-OR-V PIC X.
03 LO-DPAR1 PIC XX.
03 LO-NUM2 PIC 9(3).
03 LO-DPAR2 PIC XX.
01 LINE-05.
02 FILLER PIC X(10); VALUE SPACES.
02 FILLER PIC X(3); VALUE "05 ".
02 L05A PIC ZZ9.
02 L05B PIC X(3).
02 L05C PIC X.
02 FILLER PIC X(13); VALUE SPACES.
02 FILLER PIC X(4); VALUE "PIC ".
02 L05D PIC X(2).
02 FILLER PIC X; VALUE "(".
02 L05E PIC 999.
02 FILLER PIC XX; VALUE ").".
01 LINE-03.
02 FILLER PIC X(10); VALUE " 03 ".
02 L03A PIC ZZ9.
02 L03B PIC X(3).
02 LI-03.
03 L03C PIC X.
03 LI-03A PIC X(16); VALUE SPACES.
03 LI-03B PIC X(4); VALUE "PIC ".
03 L03D PIC X(2).
03 LI-03C PIC X; VALUE "(".
03 L03E PIC 999.
03 LI-03D PIC X; VALUE ")".
03 L03-PIC-INFO.
05 L03-PERIOD-OR-V PIC X.
05 L03-DPAR1 PIC XX.
05 L03-NUM2 PIC 9(3).
05 L03-DPAR2 PIC XX.
01 LINE-02.
02 FILLER PIC X(7); VALUE " 02 ".
02 L02A PIC ZZ9.
02 L02B PIC X(3).
02 L02C PIC X(20).
01 PAGE1-LINE.
02 FILLER PIC X(20); VALUE " 02 PAGE1 OCCURS ".
02 PAGE1-NUM PIC Z(3).
02 FILLER PIC X(7); VALUE " TIMES.".
01 IF-LINE1.
02 FILLER PIC X(11); VALUE " IF I > ".
02 IF-L1-NUM PIC 999.
02 FILLER PIC X(12); VALUE " SET I TO 1.".
01 WORK-RECORD.
02 WR OCCURS 132 TIMES PIC X.
01 DISPL-RECORD.
02 DIS-REC.
03 DR1 PIC X(22).
03 DR2 PIC X.
02 DR3 PIC X(132).
01 HEADER1.
02 H1 OCCURS 132 TIMES PIC X.
01 HEADER2.
02 H2 OCCURS 132 TIMES PIC X.
01 HEADER-1.
02 HEAD-1A PIC X(33).
02 HEAD-1B PIC X(33).
02 HEAD-1C PIC X(33).
02 HEAD-1D PIC X(33).
01 TERM-HDR-1 REDEFINES HEADER-1.
02 T-H1A PIC X(36).
02 T-H1B PIC X(36).
02 FILLER PIC X(60).
01 HEADER-2.
02 HEAD-2A PIC X(33).
02 HEAD-2B PIC X(33).
02 HEAD-2C PIC X(33).
02 HEAD-2D PIC X(33).
01 TERM-HDR-2 REDEFINES HEADER-2.
02 T-H2A PIC X(36).
02 T-H2B PIC X(36).
02 FILLER PIC X(60).
01 INPUT-BUFFER.
02 IB PIC X.
02 FILLER PIC X(29).
01 TTY-HEADER1.
02 TH-1 PIC X(35); VALUE " FLD FIELD FIELD :".
02 FILLER PIC X(35); VALUE " FLD FIELD FIELD :".
01 TTY-HEADER2.
02 TH-2 PIC X(35); VALUE " NUM NAME SIZE :".
02 FILLER PIC X(35); VALUE " NUM NAME SIZE :".
01 OUTPUT-REGISTER.
02 OREC OCCURS 40 TIMES.
03 IN-FLD PIC S9(3);COMP.
03 A-OR-N PIC A.
03 TOT-SIZE PIC S9(3); COMP.
03 DECIMAL-PLACES PIC 99.
03 FLD-REGISTER.
05 FLD-ARRAY OCCURS 5 TIMES PIC 9(3).
03 TOT PIC A.
01 REPORT-INFO.
02 RPT-TITLE.
03 RT OCCURS 66 TIMES PIC X.
02 SORTING-SEQUENCE.
03 SS OCCURS 43 TIMES PIC X.
01 TTY-LINE.
02 TTY-ARRAY OCCURS 2 TIMES.
03 FILLER PIC X.
03 TL-NUM PIC ZZ9.
03 TL-DOTS1 PIC XX.
03 TL-NAME PIC X(20).
03 TL-DOTS2 PIC XX.
03 TL-SIZE PIC ZZZ9.
03 FILLER PIC X(2).
03 TL-COLON PIC X.
01 RE-MOVE.
02 FILLER PIC X(20);VALUE " MOVE SAVE-06 TO".
02 RM-NUM PIC ZZ9.
02 FILLER PIC X(4); VALUE "INN.".
01 SOURCE-NAME.
02 S-NAME.
03 FILLER PIC X(3); VALUE "RPT".
03 S-NAM PIC X(3).
02 FILLER PIC X(3); VALUE "CBL".
01 FORMAT-NAME.
02 F-NAME.
03 FNAME PIC X(3).
03 FILLER PIC X(3).
02 FILLER PIC X(3); VALUE "FMT".
PROCEDURE DIVISION.
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.
INIT-PPN.
MOVE SPACES TO WORK-REC1, WORK-REC2.
MOVE ZEROES TO IA1-IND, IA2-IND, TC1.
DISPLAY " ".
DISPLAY "ENTER DATA BASE PROJECT PROGRAMMER NUMBER".
DISPLAY "OR <CR> IF DATA BASE IS ON THIS AREA".
DISPLAY "PPN: "; WITH NO ADVANCING.
ACCEPT WORK-REC1.
IF WORK-REC1 = SPACES ENTER MACRO PPNO USING OCTAL-PPN, GO TO HAVE-PPN.
EXAMINE WORK-REC1 TALLYING UNTIL FIRST ",".
IF TALLY = 9 DISPLAY "ILLEGAL PPN" GO TO INIT-PPN.
MOVE ZERO TO IA2-IND.
PERFORM PP-SETUP VARYING IA1-IND FROM 1 BY 1 UNTIL IA1-IND > TALLY.
MOVE WORK-REC2 TO USER-PASSWORD.
EXAMINE USER-PASSWORD REPLACING ALL SPACES BY ZEROES.
IF USER-PASSWORD NOT NUMERIC DISPLAY "ILLEGAL PPN" GO TO INIT-PPN.
MOVE WORK-REC2 TO PROJ-NUMBER.
MOVE SPACES TO WORK-REC2.
MOVE ZERO TO IA2-IND.
COMPUTE IA1-IND = TALLY + 2.
PERFORM PP-SETUP VARYING IA1-IND FROM IA1-IND BY 1 UNTIL IA2-IND = 4.
MOVE WORK-REC2 TO USER-PASSWORD.
EXAMINE USER-PASSWORD REPLACING ALL SPACES BY ZEROES.
IF USER-PASSWORD NOT NUMERIC DISPLAY "ILLEGAL PPN" GO TO INIT-PPN.
MOVE WORK-REC2 TO PROG-NUMBER.
SET ERR-FLAG TO ZERO.
MOVE PROJ-NUMBER TO EITHER-NUM.
MOVE ZERO TO HALF-NUM.
PERFORM CONVERT VARYING PP-I FROM 1 BY 1 UNTIL PP-I > 6.
IF HALF-NUM > 32767, SET ERR-FLAG UP BY 1.
COMPUTE OCTAL-PPN = HALF-NUM * 262144.
MOVE PROG-NUMBER TO EITHER-NUM.
MOVE ZERO TO HALF-NUM.
PERFORM CONVERT VARYING PP-I FROM 1 BY 1 UNTIL PP-I > 6.
COMPUTE OCTAL-PPN = OCTAL-PPN + HALF-NUM.
IF ERR-FLAG NOT = 0 DISPLAY "PPN ERROR"; STOP RUN.
HAVE-PPN.
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.
DISPLAY " ".
IF PRIV(PROMPT-IND) < 2 DISPLAY "NO PRIVILEGES TO CREATE REPORTS", STOP RUN.
DISPLAY "CSS REPORT GENERATOR CSSRPT(V05-10)".
DR-INIT-001.
IF PRG-FLAG NOT = "Y" MOVE F-NAME TO FI-FN, GO TO GOT-FN.
DISPLAY " ".
DISPLAY "INPUT FILE FOR THIS REPORT IS: "; WITH NO ADVANCING.
ACCEPT FI-FN.
IF FI-FN = SPACES MOVE F-NAME TO FI-FN, GO TO GOT-FN.
IF FIF-1 = "DBM" OR "PRG" GO TO GOT-FN.
DISPLAY "INVALID FILE NAME".
GO TO DR-INIT-001.
GOT-FN.
DISPLAY " ".
DISPLAY "NEW OR OLD: "; WITH NO ADVANCING.
ACCEPT DR-N-O.
IF DR-N-O = "N" GO TO DR-NEW.
IF DR-N-O NOT = "O" DISPLAY "INVALID RESPONSE", GO TO GOT-FN.
DR-INIT-002.
DISPLAY " ".
DISPLAY "ENTER OLD REPORT NAME: "; WITH NO ADVANCING.
ACCEPT RPT-N-001.
IF RN-001 NOT = "RPT" DISPLAY "ILLEGAL REPORT NAME" , GO TO DR-INIT-002.
OPEN INPUT RPTDAT-FILE.
MOVE ZERO TO TTY-IND, SUP-IND1, IV-IND.
MOVE SPACES TO RPTDAT-RECORD1, RPTDAT-RECORD2, RPTDAT-RECORD3.
DR-LOOP-001.
READ RPTDAT-FILE; AT END GO TO DR-TABS-LOADED.
IF DR-TYPE = 1, MOVE DR-REST TO RPTDAT-RECORD1, GO TO DR-LOOP-001.
IF DR-TYPE = 2, PERFORM DR-TTY-IN, GO TO DR-LOOP-001.
IF DR-TYPE = 3, SET SUP-IND1 UP BY 1, MOVE DR-REST TO DR-SUPPRESS-ARRAY(SUP-IND1).
GO TO DR-LOOP-001.
DR-TABS-LOADED.
CLOSE RPTDAT-FILE.
DISPLAY " ".
DISPLAY "CHANGE OR UPDATE: "; WITH NO ADVANCING.
ACCEPT DR-C-U.
IF DR-C-U = "U", PERFORM UPDATE-SETUP, GO TO SORT-SYM-SET.
IF DR-C-U NOT = "C" DISPLAY "INVALID RESPONSE", GO TO DR-TABS-LOADED.
DR-NEW.
DISPLAY " ".
DISPLAY "DO YOU WANT TO SEE YOUR INPUT BEFORE PROCEEDING".
LOOP2.
DISPLAY "(Y OR N): "; WITH NO ADVANCING.
ACCEPT INPUT-BUFFER.
IF IB = "N" GO TO BREAK2.
IF IB = "Y" PERFORM SHOW-INPUT, GO TO BREAK2.
GO TO LOOP2.
BREAK2.
DISPLAY " ".
DISPLAY "ENTER PRIVILEGE REQUIRED TO RUN THIS REPORT: "; WITH NO ADVANCING.
ACCEPT CODE-RESP.
IF CODE-RESP > 3 DISPLAY "MUST BE (O-3)", GO TO BREAK2.
BREAK-Z.
DISPLAY " ".
DISPLAY "TYPE IN YOUR NAME: "; WITH NO ADVANCING.
ACCEPT AUTH-NAME.
IF AUTH-NAME = SPACES GO TO BREAK-Z.
DISPLAY " ".
DISPLAY "OUTPUT DEVICE(DSK OR TTY): "; WITH NO ADVANCING.
ACCEPT 1R-DEV.
IF 1R-DEV NOT = "TTY" GO TO BREAK-2.
SET N TO 72.
DISPLAY "OUTPUT TO A VT05: "; WITH NO ADVANCING.
ACCEPT TTY-OP-DEV.
GO TO DEV-SET.
BREAK-2.
MOVE "DSK" TO 1R-DEV.
SET N TO 132.
DISPLAY "WILL OUTPUT TO DSK".
DEV-SET.
MOVE N TO 1Z-NUM.
DISPLAY " ".
DISPLAY "LONG OR SHORT DIALOG: "; WITH NO ADVANCING.
ACCEPT INPUT-BUFFER.
MOVE ZERO TO TC2, IV-IND.
IF IB = "S" SET TTY-IND TO ZERO, GO TO GET-NEW-OR-OLD.
IF IB = "L" GO TO GET-NEW-OR-OLD.
GO TO DEV-SET.
GET-NEW-OR-OLD.
DISPLAY " ".
DISPLAY "ANSWER THE FOLLOWING ABOUT YOUR OUTPUT:".
MOVE 0 TO TTY-IND, DR-IND.
IF DR-C-U = "C" GO TO CH-DIS.
GNO-1.
SET TTY-IND UP BY 1.
IF TTY-IND > 40 DISPLAY "ONLY 40 OUTPUT FIELDS ALLOWEED", GO TO BREAK3.
GNO-2.
PERFORM GET-OREC THRU GOREC-EXIT.
IF ERR-FLAG = 0 GO TO GNO-1.
IF ERR-FLAG = 2 GO TO GNO-2.
IF IR-1 = "S", GO TO BREAK3.
DISPLAY "ILLEGAL COMMAND (" IR-1 "), REINPUT LAST ENTRY".
GO TO GNO-2.
CH-DIS.
DISPLAY " ".
DISPLAY " AL T".
DISPLAY "INPUT FIELD NU O FIELD FIELD".
DISPLAY "FLD # NAME DA T SIZE BREAKDOWN".
DISPLAY "==================================================================".
CH-DIS-001.
SET TTY-IND UP BY 1.
SET DR-IND UP BY 1.
IF TTY-IND > 40 GO TO BREAK3.
IF DR-IND > 40 GO TO BREAK3.
MOVE DR-IN-FLD(DR-IND) TO PROMPT-IND.
IF PROMPT-IND = 0 GO TO BREAK3.
MOVE PROMPT-IND TO CDL-RPT-POSIT.
MOVE PROMPT-TABLE(PROMPT-IND) TO CDL-FIELD-NAME.
MOVE DR-A-OR-N(DR-IND) TO CDL-A-N.
MOVE DR-TOT(DR-IND) TO CDL-TOT.
MOVE DR-TOT-SIZE(DR-IND) TO FLD-IND.
IF DR-A-OR-N(DR-IND) = "D" SET FLD-IND DOWN BY 3, GO TO FI-DONE.
IF DR-A-OR-N(DR-IND) NOT = "N" GO TO FI-DONE.
IF DR-FLD-ARRAY(DR-IND,1) = 0 SET FLD-IND DOWN BY 1.
FI-DONE.
MOVE FLD-IND TO CDL-RPT-SIZE.
SET FLD-IND TO ZERO.
CH-DIS-001A.
SET FLD-IND UP BY 1.
IF FLD-IND > 5 GO TO CH-DIS-001B.
MOVE DR-FLD-ARRAY(DR-IND, FLD-IND) TO CDL-BD(FLD-IND).
MOVE ", " TO CDL-FILLER(FLD-IND).
GO TO CH-DIS-001A.
CH-DIS-001B.
DISPLAY CHANGE-DISPLAY-LINE; WITH NO ADVANCING.
ACCEPT CHANGE-RESP.
IF CHANGE-RESP NOT = SPACE, GO TO CH-DIS-001B1.
MOVE DR-OREC(DR-IND) TO OREC(TTY-IND).
PERFORM CSTOR-SYM THRU CSTOR-SYM-EXIT.
MOVE ZERO TO TC1.
*** THIS LINE OF CODE WAS INSTALLED TO RECTIFY THE PROBLEM WITH ***
*** TTY MIS-CALCULATION OF APPROXIMATE # OF CHARACTERS WHILE ***
*** IN CHANGE MODE.
SET TC2 UP BY 1.
PERFORM TOT-FLDS THRU TF-EXIT.
GO TO CH-DIS-001.
CH-DIS-001B1.
IF CHANGE-RESP = "S" GO TO BREAK3.
IF CHANGE-RESP = "O" PERFORM GET-OREC THRU GOREC-EXIT, GO TO CH-DIS-001.
IF CHANGE-RESP = "I" SET DR-IND DOWN BY 1, PERFORM GET-OREC THRU
GOREC-EXIT, GO TO CH-DIS-001.
IF CHANGE-RESP = "D", SET TTY-IND DOWN BY 1, GO TO CH-DIS-001.
IF CHANGE-RESP NOT = "F" DISPLAY "ILLEGAL COMMAND, TRY AGAIN"
, SET TTY-IND DOWN BY 1, SET DR-IND DOWN BY 1, GO TO CH-DIS-001.
CH-DIS-001C.
IF DR-OREC(DR-IND) = LOW-VALUES GO TO BREAK3.
MOVE DR-OREC(DR-IND) TO OREC(TTY-IND).
PERFORM CSTOR-SYM THRU CSTOR-SYM-EXIT.
MOVE ZERO TO TC1.
PERFORM TOT-FLDS THRU TF-EXIT.
IF TC2 > N DISPLAY N " CHARACTERS EXCEEDED", STOP RUN.
ADD 1 TO TTY-IND, DR-IND.
IF TTY-IND < 41 GO TO CH-DIS-001C.
IF DR-IND < 41 GO TO CH-DIS-001C.
DISPLAY "GREATER THAN 40 ENTRIES ON REPORT".
STOP RUN.
BREAK3.
IF OVER-LAY-PAGE = ZERO GO TO GET-NAME-1.
DISPLAY " ".
DISPLAY "OVERLAY PAGE (Y OR N):" DR-OVERLAY ":" ; WITH NO ADVANCING.
ACCEPT OVR-LAY.
IF OVR-LAY = SPACE, MOVE DR-OVERLAY TO OVR-LAY.
IF OVR-LAY = "Y" MOVE OVER-LAY-PAGE TO OVERLAY-PAGE, GO TO WNT-HDR.
IF OVR-LAY = "N" MOVE ZERO TO OVERLAY-PAGE, GO TO GET-NAME-1.
DISPLAY "(Y OR N)".
GO TO BREAK3.
WNT-HDR.
IF OVER-LAY-PAGE = ZERO GO TO GET-NAME-1.
DISPLAY "DO YOU WANT HEADER FIELDS AFTER FIRST PRINTING:"
DR-NEED-HDRS ":" ; WITH NO ADVANCING.
ACCEPT OP-RESP.
IF OP-RESP = SPACE, MOVE DR-NEED-HDRS TO OP-RESP.
GET-NAME-1.
DISPLAY " ".
DISPLAY "TYPE 3 CHAR REPORT CODE NAME: "; WITH NO ADVANCING.
ACCEPT S-NAM.
IF S-NAME = SPACES DISPLAY "INVALID FILE NAME", GO TO GET-NAME-1.
DISPLAY "TYPE REPORT TITLE (FOR TOP OF EACH PAGE)".
IF DR-C-U = "C" DISPLAY DR-RPT-TITLE.
DISPLAY "*"; WITH NO ADVANCING.
ACCEPT RPT-TITLE.
IF RPT-TITLE = SPACES MOVE DR-RPT-TITLE TO RPT-TITLE.
IF RPT-TITLE = "BLANK" MOVE SPACES TO RPT-TITLE.
MOVE SPACES TO SUPPRESS-REGISTER.
MOVE ZERO TO SUP-IND1, SUP-IND2.
DISPLAY " ".
DISPLAY "SUPPRESS: <CR> IF NONE OR WHEN SELECTION IS COMPLETE".
SUP-INP.
MOVE SPACES TO INPUT-ARRAY1, INPUT-ARRAY2.
MOVE ZEROES TO HOLD1, HOLD2, HOLD3.
SET SUP-IND1 UP BY 1.
IF SUP-IND1 > 10 GO TO BREAK3A.
IF DR-C-U = "C" GO TO CH-DIS-005.
DISPLAY " ".
DISPLAY "INPUT SYMBOL: "; WITH NO ADVANCING.
ACCEPT INPUT-ARRAY1.
GO TO NO-CH-005.
CH-DIS-005.
DISPLAY "INPUT SYMBOL:" DR-SA-SYMBOL(SUP-IND1) ":"; WITH NO ADVANCING.
ACCEPT INPUT-ARRAY1.
IF INPUT-ARRAY1 = SPACES MOVE DR-SA-SYMBOL(SUP-IND1) TO INPUT-ARRAY1.
IF INPUT-ARRAY1 = "BLANK" MOVE SPACES TO INPUT-ARRAY1.
NO-CH-005.
IF INPUT-ARRAY1 = SPACES GO TO BREAK3A.
EXAMINE INPUT-ARRAY1 TALLYING ALL "I".
IF TALLY NOT = 1 PERFORM BAD-SYM, GO TO SUP-INP.
EXAMINE INPUT-ARRAY1 TALLYING ALL "N".
IF TALLY NOT = 2 PERFORM BAD-SYM, GO TO SUP-INP.
EXAMINE INPUT-ARRAY1 TALLYING UNTIL FIRST SPACE.
IF TALLY < 4 PERFORM BAD-SYM, GO TO SUP-INP.
IF TALLY > 9 PERFORM BAD-SYM, GO TO SUP-INP.
SET IA2-IND TO ZERO.
PERFORM FIND-NUM VARYING IA1-IND FROM 1 BY 1 UNTIL IA1(IA1-IND) = "I".
MOVE INAR TO HOLD1.
IF HOLD1 > NUMBER-FIELDS PERFORM BAD-SYM, GO TO SUP-INP.
DISPLAY HOLD1 ".." PROMPT-TABLE(HOLD1).
MOVE ZERO TO HOLD2.
SET IA1-IND UP BY 3.
IF IA1(IA1-IND) NOT NUMERIC, SET IV-IND TO 1, GO TO SUP-INP-CONT.
MOVE ZERO TO TTY-IND, IV-IND.
MOVE IA1(IA1-IND) TO HOLD2.
SI-LOOP1.
SET TTY-IND UP BY 1.
IF TTY-IND > 60 GO TO SUP-INP-CONT.
IF IV-FLD-NUM(TTY-IND) NOT = HOLD1 GO TO SI-LOOP1.
IF IV-BD(TTY-IND) NOT = HOLD2 GO TO SI-LOOP1.
SET IV-IND TO 1.
SUP-INP-CONT.
IF IV-IND = ZERO PERFORM BAD-SYM, GO TO SUP-INP.
MOVE IAR TO SA-SYMBOL(SUP-IND1).
MOVE SPACES TO SA-IND(SUP-IND1).
IF OVERLAY-PAGE = 0 GO TO SI-LOOP2.
IF HOLD1 = TOP-LINE(OVERLAY-PAGE) MOVE "(I)" TO SA-IND(SUP-IND1).
IF HOLD1 > TOP-LINE(OVERLAY-PAGE) MOVE "(I)" TO SA-IND(SUP-IND1).
SI-LOOP2.
IF DR-C-U = "C" GO TO CH-DIS-006.
DISPLAY "SIGN: "; WITH NO ADVANCING.
ACCEPT SA-SIGN(SUP-IND1).
GO TO NO-CH-006.
CH-DIS-006.
DISPLAY "SIGN:" DR-SA-SIGN(SUP-IND1) ":"; WITH NO ADVANCING.
ACCEPT SA-SIGN(SUP-IND1).
IF SA-SIGN(SUP-IND1) = SPACES MOVE DR-SA-SIGN(SUP-IND1) TO SA-SIGN(SUP-IND1).
NO-CH-006.
IF SA-SIGN(SUP-IND1) = "RES" SET SUP-IND1 DOWN BY 1, GO TO SUP-INP.
IF SA-SIGN(SUP-IND1) = "=" GO TO SI-CONT2.
IF SA-SIGN(SUP-IND1) = "NOT" GO TO SI-CONT2.
IF SA-SIGN(SUP-IND1) = ">" GO TO CHK-NUMERIC.
IF SA-SIGN(SUP-IND1) = "<" GO TO CHK-NUMERIC.
DISPLAY "MUST BE EITHER NOT, =, >, OR <".
GO TO SI-LOOP2.
CHK-NUMERIC.
MOVE ZERO TO LINE-COUNT, TTY-IND.
CN-LOOP.
SET TTY-IND UP BY 1.
IF TTY-IND > 40 GO TO CN-CONT.
IF IN-FLD(TTY-IND) NOT = HOLD1, GO TO CN-LOOP.
SET LINE-COUNT TO 1.
CN-CONT.
IF LINE-COUNT = ZERO PERFORM NOT-DEFINED, GO TO SUP-INP.
IF A-OR-N(TTY-IND) = "N" GO TO SI-CONT2.
IF A-OR-N(TTY-IND) = "D" GO TO SI-CONT2.
PERFORM NOT-NUMERIC.
GO TO SUP-INP.
SI-CONT2.
MOVE SPACES TO INPUT-ARRAY1, INPUT-ARRAY2.
MOVE ZEROES TO IA1-IND, IA2-IND, SUP-IND2.
SI-LOOP3.
SET SUP-IND2 UP BY 1.
IF SUP-IND2 > 10 GO TO SUP-INP.
IF DR-C-U = "C" GO TO CH-DIS-007.
DISPLAY "LITERAL: "; WITH NO ADVANCING.
ACCEPT INPUT-ARRAY1.
GO TO NO-CH-007.
CH-DIS-007.
DISPLAY "LITERAL:" DR-SA-LITERAL(SUP-IND1, SUP-IND2) ":"; WITH NO ADVANCING.
ACCEPT INPUT-ARRAY1.
IF INPUT-ARRAY1 = SPACES MOVE DR-SA-LITERAL(SUP-IND1, SUP-IND2)
TO INPUT-ARRAY1.
IF INPUT-ARRAY1 = "BLANK" MOVE SPACES TO INPUT-ARRAY1.
NO-CH-007.
*** THE NEXT TWO STATEMENTS FIX THE CHARACTER SHIFTING BUG WHILE IN ***
*** CHANGE MODE OF THE SUPPRESSION LITERALS. ***
EXAMINE INPUT-ARRAY1 TALLYING ALL QUOTES.
IF TALLY = 2 MOVE INPUT-ARRAY1 TO SA-LITERAL(SUP-IND1, SUP-IND2)
,GO TO SI-LOOP3.
EXAMINE INPUT-ARRAY1 TALLYING ALL "/".
IF TALLY = 2 MOVE INPUT-ARRAY1 TO SA-LITERAL(SUP-IND1,SUP-IND2)
,GO TO SI-LOOP3.
IF INPUT-ARRAY1 = "BLANK" MOVE "SPACES" TO SA-LITERAL(SUP-IND1, SUP-IND2)
,GO TO SI-LOOP3.
IF INPUT-ARRAY1 = SPACES GO TO SUP-INP.
SET TTY-IND TO ZERO.
SI-LOOP3A.
SET TTY-IND UP BY 1.
IF TTY-IND > 40 GO TO SIL3A.
IF IN-FLD(TTY-IND) NOT = HOLD1 GO TO SI-LOOP3A.
IF HOLD2 = ZERO GO TO SIL3A.
MOVE FLD-ARRAY(TTY-IND,HOLD2) TO HOLD3, GO TO SI-CONT3.
SIL3A.
MOVE LENGTH-OF-FIELD(HOLD1) TO HOLD3.
SI-CONT3.
IF TTY-IND > 40 GO TO SI-CONT3-1.
IF A-OR-N(TTY-IND) = "N" GO TO SI-CONT3A.
IF A-OR-N(TTY-IND) = "D" GO TO SI-CONT3A.
GO TO SI-CONT3-1.
SI-CONT3A.
SET IA2-IND TO ZERO.
PERFORM FIND-NUM VARYING IA1-IND FROM 1 BY 1 UNTIL IA1-IND > HOLD3.
MOVE INPUT-ARRAY2 TO SA-LITERAL(SUP-IND1,SUP-IND2).
GO TO SI-LOOP3.
SI-CONT3-1.
MOVE QUOTE TO IA2(1).
SET IA2-IND TO 1.
PERFORM FIND-NUM VARYING IA1-IND FROM 1 BY 1 UNTIL IA1-IND > HOLD3.
SET IA2-IND UP BY 1.
MOVE QUOTE TO IA2(IA2-IND).
MOVE INPUT-ARRAY2 TO SA-LITERAL(SUP-IND1, SUP-IND2).
GO TO SI-LOOP3.
BREAK3A.
DISPLAY " ".
DISPLAY "TYPE SORT SEQUENCE <CR> IF NO SORT".
IF DR-C-U = "C" GO TO CH-DIS-008.
DISPLAY "*"; WITH NO ADVANCING.
ACCEPT SORTING-SEQUENCE.
GO TO SORT-SYM-SET.
CH-DIS-008.
DISPLAY DR-SORTING-SEQUENCE.
DISPLAY "*"; WITH NO ADVANCING.
ACCEPT SORTING-SEQUENCE.
IF SORTING-SEQUENCE = SPACES MOVE DR-SORTING-SEQUENCE TO SORTING-SEQUENCE.
IF SORTING-SEQUENCE = "BLANK" MOVE SPACES TO SORTING-SEQUENCE.
SORT-SYM-SET.
IF SS(1) = SPACE GO TO BREAK3B.
MOVE ZEROES TO SORT-SYM.
IF SS(3) NOT NUMERIC GO TO SS-TAG1.
MOVE SS(3) TO SS3.
MOVE SS(2) TO SS2.
MOVE SS(1) TO SS-1.
GO TO SS-CONT.
SS-TAG1.
IF SS(2) NOT NUMERIC GO TO SS-TAG2.
MOVE SS(2) TO SS3.
MOVE SS(1) TO SS2.
GO TO SS-CONT.
SS-TAG2.
IF SS(1) NOT NUMERIC GO TO SS-TAG3.
MOVE SS(1) TO SS3.
GO TO SS-CONT.
SS-TAG3.
IF SS(1) NOT NUMERIC DISPLAY "INVALID SORT SYMBOL", GO TO BREAK3A.
SS-CONT.
SET HOLD3 TO ZERO.
EXAMINE SORTING-SEQUENCE TALLYING UNTIL FIRST "N".
SET TALLY UP BY 3.
IF TALLY > 43 DISPLAY "INVALID SORT SEQUENCE", GO TO BREAK3A.
IF SS(TALLY) NOT NUMERIC, GO TO NO-SEC.
MOVE SS(TALLY) TO HOLD2, SL1-NUM2, SL5-NUM2.
MOVE SORT-SYM TO HOLD1.
MOVE ZERO TO TTY-IND.
FIND-SIZE.
SET TTY-IND UP BY 1.
IF TTY-IND > 40 GO TO FS-BREAK.
IF IN-FLD(TTY-IND) = ZEROES GO TO FS-BREAK.
IF IN-FLD(TTY-IND) NOT = HOLD1 GO TO FIND-SIZE.
IF FLD-ARRAY(TTY-IND,HOLD2) = ZERO DISPLAY "NON-EXISTANT SYMBOL"
,GO TO BREAK3A.
MOVE FLD-ARRAY(TTY-IND,HOLD2) TO SAVE-NUM.
SET HOLD3 TO 1.
FS-BREAK.
IF HOLD3 = ZERO DISPLAY "NON-EXISTANT SYMBOL"
,GO TO BREAK3A.
NO-SEC.
MOVE SORT-SYM TO PROMPT-IND, SORT-KEEPER.
MOVE PROMPT-IND TO SL1-NUM, SL5-NUM1.
IF HOLD3 = ZERO, MOVE LENGTH-OF-FIELD(PROMPT-IND) TO SAVE-NUM.
IF DR-C-U = "U" GO TO CONT3.
DISPLAY "WILL BREAK ON " PROMPT-TABLE(PROMPT-IND).
BREAK3B.
IF DR-C-U = "U" GO TO CONT3.
DISPLAY " ".
IF DR-C-U = "C" GO TO CH-DIS-009.
DISPLAY "DO YOU WANT DOUBLE SPACING: "; WITH NO ADVANCING.
ACCEPT DUBSPA.
IF SORTING-SEQUENCE = SPACES GO TO NO-CH-009.
DISPLAY " ".
DISPLAY "DO YOU WANT A NEW PAGE ON THE BREAK: "; WITH NO ADVANCING.
ACCEPT TOF.
IF TOF = "Y" GO TO NO-CH-009.
DISPLAY " ".
DISPLAY "TYPE NUMBER OF LINES TO SKIP AFTER A BREAK: "; WITH NO ADVANCING.
ACCEPT NUM-LINES.
GO TO NO-CH-009.
CH-DIS-009.
DISPLAY "DO YOU WANT DOUBLE SPACING:" DR-DOUBLE-SPACE
":"; WITH NO ADVANCING.
ACCEPT DUBSPA.
IF DUBSPA = SPACE MOVE DR-DOUBLE-SPACE TO DUBSPA.
IF SORTING-SEQUENCE = SPACES GO TO NO-CH-009.
DISPLAY " ".
DISPLAY "DO YOU WANT A NEW PAGE ON THE BREAK:" DR-NEWPAGE-BREAK
":"; WITH NO ADVANCING.
ACCEPT TOF.
IF TOF = SPACE MOVE DR-NEWPAGE-BREAK TO TOF.
IF TOF = "Y" GO TO NO-CH-009.
DISPLAY "TYPE NUMBER OF LINES TO SKIP AFTER A BREAK:" DR-NOLINES-BREAK
":"; WITH NO ADVANCING.
ACCEPT NUM-LINES.
IF NUM-LINES = 0 MOVE DR-NOLINES-BREAK TO NUM-LINES.
NO-CH-009.
IF DUBSPA = SPACE MOVE "N" TO DUBSPA.
IF TOF = SPACE MOVE "N" TO TOF.
CONT3.
MOVE ZERO TO TC2, TC1.
PERFORM TOT-FLDS THRU TF-EXIT VARYING TTY-IND FROM 1 BY 1 UNTIL TOT-SIZE
,OF OREC(TTY-IND) = ZERO.
IF TC2 > N PERFORM OUT-TOO-BIG, STOP RUN.
SET TTY-IND DOWN BY 1.
COMPUTE OUT-FIL = N - TC2.
DDT1.
COMPUTE OUT-FIL = OUT-FIL / TTY-IND.
IF OUT-FIL < 1 DISPLAY "NO ROOM TO FILL OUTPUT", STOP RUN.
IF DR-C-U = "U" GO TO NEWRPT.
MOVE ZERO TO H-IND.
DISPLAY "OUTPUT FIELD COLUMN INFORMATION".
DISPLAY " ".
PERFORM HEAD-SETUP THRU HS-EXIT VARYING TTY-IND FROM 1 BY 1 UNTIL
,IN-FLD(TTY-IND) = ZERO.
DDT2.
MOVE HEADER1 TO HEADER-1.
MOVE HEADER2 TO HEADER-2.
MOVE S-NAME TO RPT-N-001.
OPEN OUTPUT RPTDAT-FILE.
MOVE SPACES TO RPTDAT-RECORD, RPTDAT-RECORD1, RPTDAT-RECORD2, RPTDAT-RECORD3.
MOVE CODE-RESP TO DR-RUN-PRIV.
MOVE PROJ-NUMBER TO DR-PROJ.
MOVE PROG-NUMBER TO DR-PROG.
MOVE 1R-DEV TO DR-OUTDEV.
IF 1R-DEV = "TTY" MOVE TTY-OP-DEV TO DR-VT05.
MOVE OVR-LAY TO DR-OVERLAY.
MOVE OP-RESP TO DR-NEED-HDRS.
MOVE AUTH-NAME TO DR-AUTHOR.
MOVE RPT-TITLE TO DR-RPT-TITLE.
MOVE SORTING-SEQUENCE TO DR-SORTING-SEQUENCE.
MOVE DUBSPA TO DR-DOUBLE-SPACE.
MOVE TOF TO DR-NEWPAGE-BREAK.
MOVE NUM-LINES TO DR-NOLINES-BREAK.
MOVE HEADER1 TO DR-HEADER-1.
MOVE HEADER2 TO DR-HEADER-2.
MOVE VERSION-NUMBER TO DR-RPT-VERS.
MOVE RN-002 TO DR-RPT-NAME.
MOVE 1 TO DR-TYPE.
MOVE RPTDAT-RECORD1 TO DR-REST.
WRITE RPTDAT-RECORD.
MOVE LOW-VALUES TO DR-R2-ARRAY.
MOVE ZERO TO IV-IND, DR-FLAG.
PERFORM DR-TTY-OUT THRU DR-TTY-DONE VARYING TTY-IND FROM 1 BY 1
,UNTIL TTY-IND > 40.
IF IV-IND > 0 MOVE 2 TO DR-TYPE, MOVE DR-R2-ARRAY TO DR-REST
,WRITE RPTDAT-RECORD.
MOVE 0 TO DR-FLAG.
PERFORM DR-SUP-OUT THRU DR-SUP-DONE VARYING TTY-IND FROM 1 BY 1
,UNTIL TTY-IND > 10.
CLOSE RPTDAT-FILE.
GO TO NEWRPT.
GET-OREC.
MOVE ZERO TO ERR-FLAG.
DISPLAY " ".
IF IB = "S" DISPLAY "#"; WITH NO ADVANCING
;ELSE DISPLAY "INPUT FIELD NUMBER: "; WITH NO ADVANCING.
ACCEPT INP-RESP.
MOVE INP-RESP TO INP-WRK.
EXAMINE INP-WRK REPLACING ALL SPACES BY ZEROES.
IF INP-WRK NOT NUMERIC SET ERR-FLAG TO 1, GO TO GOREC-EXIT.
MOVE INP-RESP TO IN-FLD(TTY-IND).
IF IN-FLD(TTY-IND) > NUMBER-FIELDS DISPLAY "FIELD NUMBER TOO GREAT"
,SET ERR-FLAG TO 2, GO TO GOREC-EXIT.
IF IN-FLD(TTY-IND) < 1 DISPLAY "ILLEGAL FIELD NUMBER", SET ERR-FLAG TO 2
,GO TO GOREC-EXIT.
MOVE IN-FLD(TTY-IND) TO PROMPT-IND.
MOVE ZERO TO H-IND.
MOVE SPACE TO RESP.
GET-OREC-1.
SET H-IND UP BY 1.
IF H-IND > 60 GO TO GET-OREC-2.
IF IV-FLD-NUM(H-IND) = ZERO GO TO GET-OREC-2.
IF IV-FLD-NUM(H-IND) NOT = IN-FLD(TTY-IND) GO TO GET-OREC-1.
DISPLAY "FIELD USED BEFORE. PROCEED?(Y OR N): "; WITH NO ADVANCING.
ACCEPT RESP.
IF RESP = "Y" GO TO GET-OREC-2.
GO TO GET-OREC.
GET-OREC-2.
IF IB NOT = "S" DISPLAY " ", DISPLAY TH-1, DISPLAY TH-2.
DISPLAY " ".
MOVE PROMPT-TABLE(PROMPT-IND) TO TL-NAME(1).
MOVE LENGTH-OF-FIELD(PROMPT-IND) TO TL-SIZE(1).
MOVE PROMPT-IND TO TL-NUM(1).
MOVE ".." TO TL-DOTS1(1), TL-DOTS2(1).
MOVE ":" TO TL-COLON(1).
DISPLAY TTY-ARRAY(1).
IF IB = "S" DISPLAY "(A, N, OR D):"; WITH NO ADVANCING
;ELSE DISPLAY "FIELD ALPHA, NUMERIC OR DATE (A, N OR D): "; WITH NO ADVANCING.
ACCEPT A-OR-N(TTY-IND).
MOVE LENGTH-OF-FIELD(PROMPT-IND) TO TOT-SIZE(TTY-IND).
IF A-OR-N(TTY-IND) = SPACE OR "A" MOVE "A" TO A-OR-N(TTY-IND)
,GO TO GET-OREC-2A.
IF A-OR-N(TTY-IND) = "D" MOVE 9 TO TOT-SIZE(TTY-IND) GO TO GET-OREC-5.
IF A-OR-N(TTY-IND) NOT = "N", MOVE "A" TO A-OR-N(TTY-IND), GO TO GET-OREC-2A.
MOVE DECIMAL-POSIT(PROMPT-IND) TO DECIMAL-PLACES(TTY-IND).
DISPLAY "DO YOU WANT TO TOTAL THIS FIELD:"; WITH NO ADVANCING.
ACCEPT TOT(TTY-IND).
IF TOT(TTY-IND) = "Y" GO TO GET-OREC-4.
IF DECIMAL-PLACES(TTY-IND) NOT = 0 GO TO GET-OREC-4.
GET-OREC-2A.
DISPLAY " ".
IF IB = "S" DISPLAY "SIZE: "; WITH NO ADVANCING
;ELSE DISPLAY "TYPE TOTAL OUTPUT FIELD SIZE: "; WITH NO ADVANCING.
ACCEPT TOT-SIZE(TTY-IND).
IF TOT-SIZE(TTY-IND) > LENGTH-OF-FIELD(PROMPT-IND)
DISPLAY "LARGER THAN INPUT FIELD, REINPUT LAST ENTRY"
,SET ERR-FLAG TO 2, GO TO GOREC-EXIT.
IF TOT-SIZE(TTY-IND) = ZERO, MOVE LENGTH-OF-FIELD(PROMPT-IND) TO TOT-SIZE(TTY-IND).
MOVE ZERO TO FLD-IND, OUT-FIL.
IF IB NOT = "S" DISPLAY "FIELD BREAKDOWN EXTRA <CR> WHEN DONE".
GET-OREC-3.
DISPLAY "*"; WITH NO ADVANCING.
ACCEPT PP-I.
IF PP-I = 0 GO TO GET-OREC-4.
SET FLD-IND UP BY 1.
IF FLD-IND > 5 DISPLAY "ONLY 5 BREAKDOWNS ALLOWED, REENTER AGAIN"
,MOVE 0 TO FLD-IND, OUT-FIL, GO TO GET-OREC-3.
COMPUTE OUT-FIL = OUT-FIL + PP-I.
IF OUT-FIL > LENGTH-OF-FIELD(PROMPT-IND)
DISPLAY "BREAKDOWN CHARACTER SUM EXCEEDS FIELD SIZE REENTER AGAIN"
,MOVE ZERO TO FLD-IND, OUT-FIL, GO TO GET-OREC-3.
MOVE PP-I TO FLD-ARRAY(TTY-IND,FLD-IND).
IF RESP NOT = "Y" PERFORM STOR-INPUT.
GO TO GET-OREC-3.
GET-OREC-4.
IF TOT-SIZE(TTY-IND) = LENGTH-OF-FIELD(PROMPT-IND), GO TO GET-OREC-5.
IF FLD-ARRAY(TTY-IND,1) NOT = 0, GO TO GET-OREC-5.
*** THESE NEXT 6 LINES OF CODE ARE INTENDED TO FIX THE PROBLEM OF ***
*** NOT STORING BREAKDOWNS ON FIELD TRUNCATION ***
MOVE 1 TO FLD-IND.
MOVE TOT-SIZE(TTY-IND) TO FLD-ARRAY(TTY-IND,FLD-IND).
PERFORM STOR-INPUT.
MOVE 2 TO FLD-IND.
COMPUTE FLD-ARRAY(TTY-IND,FLD-IND) = LENGTH-OF-FIELD(PROMPT-IND) - TOT-SIZE(TTY-IND).
PERFORM STOR-INPUT.
GET-OREC-5.
IF FLD-ARRAY(TTY-IND,1) NOT = 0 GO TO GET-OREC-6.
IF RESP = "Y" GO TO GET-OREC-6.
PERFORM STOR-INPUT.
GET-OREC-6.
SET TC1 TO 1.
PERFORM TOT-FLDS THRU TF-EXIT.
DISPLAY TC2 " CHARACTERS APPROXIMATELY".
IF TC2 < N GO TO GOREC-EXIT.
IF TC2 = N GO TO GOREC-EXIT.
DISPLAY "YOU HAVE EXCEEDED " N " CHARACTERS".
DISPLAY "REINPUT LAST ENTRY".
COMPUTE TC2 = TC2 - TOT-SIZE(TTY-IND).
SET ERR-FLAG TO 2.
MOVE LOW-VALUES TO IV(IV-IND), OREC(TTY-IND).
SET IV-IND DOWN BY 1.
GO TO GET-OREC.
GOREC-EXIT. EXIT.
DR-TTY-OUT.
IF DR-FLAG NOT = 0 GO TO DR-TTY-DONE.
IF OREC(TTY-IND) = LOW-VALUES SET DR-FLAG TO 1, GO TO DR-TTY-DONE.
SET IV-IND UP BY 1.
IF IV-IND > 10, SET IV-IND TO 1, MOVE 2 TO DR-TYPE
,MOVE DR-R2-ARRAY TO DR-REST, WRITE RPTDAT-RECORD, MOVE SPACES TO DR-R2-ARRAY.
MOVE OREC(TTY-IND) TO DR-RT-BUFF(IV-IND).
DR-TTY-DONE. EXIT.
DR-SUP-OUT.
IF DR-FLAG NOT = 0 GO TO DR-SUP-DONE.
IF SUPPRESS-ARRAY(TTY-IND) = SPACES SET DR-FLAG TO 1
,GO TO DR-SUP-DONE.
MOVE 3 TO DR-TYPE.
MOVE SUPPRESS-ARRAY(TTY-IND) TO DR-REST.
WRITE RPTDAT-RECORD.
DR-SUP-DONE. EXIT.
DR-TTY-IN.
MOVE DR-REST TO DR-R2-ARRAY.
PERFORM DR-TI-LOOP1 THRU DR-TI-DONE1 VARYING TTY-IND FROM 1
,BY 1 UNTIL TTY-IND > 10.
DR-TI-LOOP1.
SET IV-IND UP BY 1.
IF IV-IND > 40 GO TO DR-TI-DONE1.
MOVE DR-RT-BUFF(TTY-IND) TO DR-OREC(IV-IND).
DR-TI-DONE1. EXIT.
UPDATE-SETUP.
MOVE RPTDAT-RECORD2 TO OUTPUT-REGISTER.
MOVE RPTDAT-RECORD3 TO SUPPRESS-REGISTER.
MOVE DR-RUN-PRIV TO CODE-RESP.
MOVE DR-PROJ TO PROJ-NUMBER.
MOVE DR-PROG TO PROG-NUMBER.
MOVE DR-OUTDEV TO 1R-DEV.
MOVE 132 TO N.
IF DR-OUTDEV = "TTY", MOVE 72 TO N, MOVE DR-VT05 TO TTY-OP-DEV.
MOVE N TO 1Z-NUM.
MOVE 0 TO OVERLAY-PAGE.
IF DR-OVERLAY = "Y" MOVE OVER-LAY-PAGE TO OVERLAY-PAGE.
MOVE DR-NEED-HDRS TO OP-RESP.
MOVE DR-AUTHOR TO AUTH-NAME.
MOVE RN-002 TO S-NAM.
MOVE DR-RPT-TITLE TO RPT-TITLE.
MOVE DR-SORTING-SEQUENCE TO SORTING-SEQUENCE.
MOVE DR-DOUBLE-SPACE TO DUBSPA.
MOVE DR-NEWPAGE-BREAK TO TOF.
MOVE DR-NOLINES-BREAK TO NUM-LINES.
MOVE DR-HEADER-1 TO HEADER-1.
MOVE DR-HEADER-2 TO HEADER-2.
MOVE DR-RPT-VERS TO VER-NUM.
NOT-DEFINED.
DISPLAY "CANNOT USE NUMERIC CONDITIONAL".
DISPLAY "SYMBOL NOT DEFINED ABOVE".
SET SUP-IND1 DOWN BY 1.
NOT-NUMERIC.
DISPLAY "CANNOT USE ARITHMETIC CONDITIONAL SIGN".
DISPLAY "BECAUSE YOU DID NOT DEFINE THIS FIELD ABOVE AS NUMERIC".
SET SUP-IND1 DOWN BY 1.
BAD-SYM.
DISPLAY "NOT A VALID INPUT SYMBOL".
SET SUP-IND1 DOWN BY 1.
FIND-NUM.
SET IA2-IND UP BY 1.
IF IA1(IA1-IND) NOT = QUOTE, MOVE IA1(IA1-IND) TO IA2(IA2-IND).
CONVERT.
IF PP-DIGIT(PP-I) = 8 OR 9, SET ERR-FLAG UP BY 1.
COMPUTE HALF-NUM = 8 * HALF-NUM + PP-DIGIT(PP-I).
SHOW-INPUT.
DISPLAY " ".
DISPLAY TTY-HEADER1.
DISPLAY TTY-HEADER2.
DISPLAY TTY-LINE.
SET TTY-IND TO ZERO.
PERFORM SHOW-PROMPTS VARYING PROMPT-IND FROM 1 BY 1
,UNTIL LENGTH-OF-FIELD(PROMPT-IND) = ZEROES.
PERFORM SHOW-IT.
CSTOR-SYM.
SET IV-IND UP BY 1.
IF IV-IND > 60 DISPLAY "?SYMBOL TABLE OVERFLOW", STOP RUN.
MOVE IN-FLD(TTY-IND) TO IV-FLD-NUM(IV-IND).
MOVE "INN" TO IV-INN(IV-IND).
MOVE ZERO TO FLD-IND.
CSTOR-SYM-1.
SET FLD-IND UP BY 1.
IF FLD-IND > 5 GO TO CSTOR-SYM-EXIT.
IF FLD-ARRAY(TTY-IND, FLD-IND) = 0 GO TO CSTOR-SYM-EXIT.
PERFORM STOR-INPUT.
GO TO CSTOR-SYM-1.
CSTOR-SYM-EXIT. EXIT.
STOR-INPUT.
SET IV-IND UP BY 1.
MOVE "INN" TO IV-INN(IV-IND).
MOVE IN-FLD(TTY-IND) TO IV-FLD-NUM(IV-IND).
MOVE FLD-IND TO IV-BD(IV-IND).
SHOW-PROMPTS.
SET TTY-IND UP BY 1.
IF TTY-IND > 2 PERFORM SHOW-IT.
MOVE PROMPT-IND TO TL-NUM OF TTY-ARRAY(TTY-IND).
MOVE ".." TO TL-DOTS1 OF TTY-ARRAY(TTY-IND).
MOVE PROMPT-TABLE(PROMPT-IND) TO TL-NAME OF TTY-ARRAY(TTY-IND).
MOVE ".." TO TL-DOTS2 OF TTY-ARRAY(TTY-IND).
MOVE LENGTH-OF-FIELD(PROMPT-IND) TO TL-SIZE OF TTY-ARRAY(TTY-IND).
MOVE ":" TO TL-COLON OF TTY-ARRAY(TTY-IND).
SHOW-IT.
DISPLAY TTY-LINE.
MOVE SPACES TO TTY-LINE.
SET TTY-IND TO 1.
PP-SETUP.
SET IA2-IND UP BY 1.
MOVE WR1(IA1-IND) TO WR2(IA2-IND).
HEAD-SETUP.
MOVE SPACES TO WORK-RECORD.
MOVE 0 TO H-IND.
PERFORM HEAD-TOT VARYING SUP-IND1 FROM 1 BY 1 UNTIL SUP-IND1 = TTY-IND.
COMPUTE HS-IND = TOT-SIZE OF OREC(TTY-IND) + OUT-FIL.
IF DECIMAL-PLACES(TTY-IND) NOT = 0 SET HS-IND UP BY 1.
IF HS-IND < 4 SET HS-IND DOWN BY 1 ;ELSE COMPUTE HS-IND = HS-IND - 2.
IF DR-C-U = "C" GO TO CH-DIS-010.
PERFORM MOV-DASHES VARYING WR-IND FROM 1 BY 1 UNTIL WR-IND > HS-IND.
GO TO NO-CH-010.
CH-DIS-010.
PERFORM MOVE-HEAD2 VARYING WR-IND FROM 1 BY 1 UNTIL WR-IND > HS-IND.
SET H-IND DOWN BY HS-IND.
NO-CH-010.
MOVE ":" TO WR(WR-IND).
MOVE SPACES TO DISPL-RECORD.
MOVE WORK-RECORD TO DR3, WORK-REC-SAVE.
MOVE ":" TO DR2.
DISPLAY DISPL-RECORD.
MOVE IN-FLD OF OREC(TTY-IND) TO PROMPT-IND.
MOVE PROMPT-TABLE(PROMPT-IND) TO DR1.
MOVE SPACES TO WORK-RECORD.
DISPLAY DIS-REC; WITH NO ADVANCING.
ACCEPT WORK-RECORD.
IF DR-C-U NOT = "C" GO TO NOTC-001.
IF WORK-RECORD = "BLANK" MOVE SPACES TO WORK-RECORD, GO TO NOTC-001.
IF WORK-RECORD = SPACES MOVE WORK-REC-SAVE TO WORK-RECORD.
NOTC-001.
PERFORM MOVE-HEAD VARYING WR-IND FROM 1 BY 1 UNTIL WR-IND > HS-IND.
SET H-IND DOWN BY HS-IND.
MOVE SPACES TO WORK-RECORD.
IF DR-C-U = "C" GO TO CH-DIS-011.
PERFORM MOV-DASHES VARYING WR-IND FROM 1 BY 1 UNTIL WR-IND > HS-IND.
GO TO NO-CH-011.
CH-DIS-011.
PERFORM MOVE-HEAD3 VARYING WR-IND FROM 1 BY 1 UNTIL WR-IND > HS-IND.
SET H-IND DOWN BY HS-IND.
NO-CH-011.
MOVE ":" TO WR(WR-IND).
MOVE SPACES TO DISPL-RECORD.
MOVE WORK-RECORD TO DR3, WORK-REC-SAVE.
MOVE ":" TO DR2.
DISPLAY DISPL-RECORD.
MOVE PROMPT-TABLE(PROMPT-IND) TO DR1.
MOVE SPACES TO WORK-RECORD.
DISPLAY DIS-REC; WITH NO ADVANCING.
ACCEPT WORK-RECORD.
IF DR-C-U NOT = "C" GO TO NOTC-002.
IF WORK-RECORD = "BLANK" MOVE SPACES TO WORK-RECORD, GO TO NOTC-002.
IF WORK-RECORD = SPACES MOVE WORK-REC-SAVE TO WORK-RECORD.
NOTC-002.
PERFORM MOVE-HEAD1 VARYING WR-IND FROM 1 BY 1 UNTIL WR-IND > HS-IND.
HS-EXIT. EXIT.
TOT-FLDS.
COMPUTE TC2 = TC2 + TOT-SIZE OF OREC(TTY-IND).
IF TC1 = 1, SET TC2 UP BY 1.
IF A-OR-N(TTY-IND) NOT = "N" GO TO TF-EXIT.
IF FLD-ARRAY(TTY-IND,1) NOT = 0 GO TO TF-EXIT.
IF TC1 = 1, SET TOT-SIZE(TTY-IND) UP BY 1.
*** SIGN SPACE BEING RECALCULATED ON FILLER CALCULATION AFTER ***
*** IT HAD BEEN PROVIDED FOR EARLIER ***
IF TC1 = 1, SET TC2 UP BY 1.
IF DECIMAL-PLACES(TTY-IND) NOT = ZERO SET TC2 UP BY 1.
TF-EXIT. EXIT.
OUT-TOO-BIG.
COMPUTE OUT-FIL = TC2 - N.
DISPLAY "OUTPUT RECORD EXCEEDS " N " CHARACTERS BY " OUT-FIL.
MOV-DASHES.
MOVE "-" TO WR(WR-IND).
MOVE-HEAD.
SET H-IND UP BY 1.
MOVE WR(WR-IND) TO H1(H-IND).
MOVE-HEAD1.
SET H-IND UP BY 1.
MOVE WR(WR-IND) TO H2(H-IND).
MOVE-HEAD2.
SET H-IND UP BY 1.
MOVE DR-H1(H-IND) TO WR(WR-IND).
MOVE-HEAD3.
SET H-IND UP BY 1.
MOVE DR-H2(H-IND) TO WR(WR-IND).
HEAD-TOT.
COMPUTE H-IND = (TOT-SIZE(SUP-IND1) + OUT-FIL) + H-IND.
IF DECIMAL-PLACES(SUP-IND1) NOT = 0 SET H-IND UP BY 1.
NEWRPT SECTION.
SET OV-FLAG TO ZERO.
IF OVERLAY-PAGE = ZERO GO TO NRBE1.
IF SORTING-SEQUENCE = SPACES GO TO NRBE1.
SET OV-FLAG TO 1.
NRBE1.
OPEN OUTPUT SOURCE-FILE.
DISPLAY " CREATING " S-NAME ".CBL ... "; WITH NO ADVANCING.
MOVE 1A TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE S-NAME TO PRG-NAME.
MOVE PRG-ID TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE 1B TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE TODAY TO P-TODAY.
MOVE P-YR TO WD-YR.
MOVE M-BUFF(P-MO) TO WD-MON.
MOVE P-DA TO WD-DAY.
MOVE WRT-DATE TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE 1C TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE 1D TO SOURCE-RECORD.
WRITE SOURCE-RECORD BEFORE ADVANCING 2 LINES.
MOVE 1E TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE 1F TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE 1G TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE 1H TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE 1I TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE 1J TO SOURCE-RECORD.
WRITE SOURCE-RECORD BEFORE ADVANCING 2 LINES.
MOVE 1K TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE 1L TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE 1M TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE 1N TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE 1O TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE 1P TO SOURCE-RECORD.
WRITE SOURCE-RECORD BEFORE ADVANCING 2 LINES.
IF SORTING-SEQUENCE NOT = SPACES PERFORM NEED-TMP.
MOVE 1R TO SOURCE-RECORD.
WRITE SOURCE-RECORD BEFORE ADVANCING 2 LINES.
WRITE SOURCE-RECORD FROM FMTSEL BEFORE ADVANCING 2 LINES.
MOVE 1S TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE 1T TO SOURCE-RECORD.
WRITE SOURCE-RECORD BEFORE ADVANCING 2 LINES.
MOVE 1U TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE NUM-CHARS TO RC-NUM.
MOVE REC-CONT TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE BLOCKING-FACTOR TO BC-NUM.
MOVE BLOCK-CONT TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE VID TO SOURCE-RECORD.
IF PROJ-NUMBER = 0 WRITE SOURCE-RECORD BEFORE ADVANCING 2 LINES
,GO TO NOPPN-001.
MOVE SPACE TO VI-DOT.
MOVE VID TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE PROJ-NUMBER TO UP-PROJ.
MOVE PROG-NUMBER TO UP-PROG.
WRITE SOURCE-RECORD FROM USR-PPN BEFORE ADVANCING 2 LINES.
NOPPN-001.
MOVE 1V TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
IF OVERLAY-PAGE = ZERO GO TO NRB1.
COMPUTE TTY-IND = (NUM-PAGES - OVERLAY-PAGE) + 1.
MOVE TTY-IND TO PAGE1-NUM.
COMPUTE HOLD3 = OVERLAY-PAGE + 1.
NRB1.
MOVE ZERO TO PROMPT-IND, DECIMAL-FLAG.
MOVE "INN" TO LO-NAME, L02B, L03B, L05B.
NR-LOOP.
SET DECIMAL-FLAG TO ZERO.
SET PROMPT-IND UP BY 1.
MOVE "." TO LO-PIC-INFO, L03-PIC-INFO.
IF PROMPT-IND > 150 GO TO NR-BREAK1.
IF LENGTH-OF-FIELD(PROMPT-IND) = ZERO GO TO NR-BREAK1.
IF OVERLAY-PAGE = ZERO GO TO NRL1.
IF PROMPT-IND = TOP-LINE(OVERLAY-PAGE) PERFORM OVERLAY-SETUP THRU OS-EXIT
,GO TO NR-BREAK1.
NRL1.
IF PROMPT-IND NOT = POS-KEY GO TO NR-CONT1.
MOVE LENGTH-OF-FIELD(PROMPT-IND) TO RK-NUM.
MOVE REC-KEY TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE " REDEFINES REC-KEY " TO LO-FILL.
NR-CONT1.
SET CHK-03-CNT TO ZERO.
MOVE " X" TO LO-TYPE, L03D.
PERFORM CHECK-03 THRU CHK-03-EXIT VARYING TTY-IND FROM 1 BY 1
,UNTIL TTY-IND > 40.
IF CHK-03-CNT = 1 GO TO NR-CONT2.
MOVE PROMPT-IND TO LO-NUM.
IF DECIMAL-FLAG = ZERO, MOVE LENGTH-OF-FIELD(PROMPT-IND) TO LO-SIZE.
MOVE LINE-OUT TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
NR-CONT2.
MOVE SPACES TO LO-FILL.
GO TO NR-LOOP.
NR-BREAK1.
MOVE SPACES TO SOURCE-RECORD.
WRITE SOURCE-RECORD BEFORE ADVANCING 2 LINES.
IF SORTING-SEQUENCE = SPACES GO TO NSO-DONE.
MOVE SPACES TO SOURCE-RECORD.
WRITE SOURCE-RECORD BEFORE ADVANCING 2 LINES.
WRITE SOURCE-RECORD FROM 1W BEFORE ADVANCING 2 LINES.
WRITE SOURCE-RECORD FROM 1X.
MOVE "KSRT" TO SI-NAME.
MOVE " X(" TO SI-PIC-TYPE.
MOVE LENGTH-OF-FIELD(POS-KEY) TO SI-NUM1.
MOVE ")." TO SI-DOT-OR-CONT.
WRITE SOURCE-RECORD FROM SRT-ITEMS.
IF OV-FLAG = ZERO GO TO NO-SRT-OVR.
MOVE "OP-NO" TO SI-NAME.
MOVE "S9(" TO SI-PIC-TYPE.
MOVE 003 TO SI-NUM1.
MOVE ")." TO SI-DOT-OR-CONT.
WRITE SOURCE-RECORD FROM SRT-ITEMS.
NO-SRT-OVR.
MOVE ZERO TO IA1-IND, SRT-IND.
NSO-001.
SET IA1-IND UP BY 1.
IF IA1-IND > 43 GO TO NSO-DONE.
IF SS(IA1-IND) NOT = "I" GO TO NSO-001.
MOVE ZERO TO SORT-SYM, HOLD1, HOLD2.
MOVE IA1-IND TO IA2-IND.
SET IA2-IND DOWN BY 1.
IF IA2-IND NOT POSITIVE GO TO SITEM-COMP.
IF SS(IA2-IND) NOT NUMERIC GO TO SITEM-COMP.
MOVE SS(IA2-IND) TO SS3.
SET IA2-IND DOWN BY 1.
IF IA2-IND NOT POSITIVE GO TO SITEM-COMP.
IF SS(IA2-IND) NOT NUMERIC GO TO SITEM-COMP.
MOVE SS(IA2-IND) TO SS2.
SET IA2-IND DOWN BY 1.
IF IA2-IND NOT POSITIVE GO TO SITEM-COMP.
IF SS(IA2-IND) NOT NUMERIC GO TO SITEM-COMP.
MOVE SS(IA2-IND) TO SS1.
SITEM-COMP.
MOVE SORT-SYM TO HOLD1.
MOVE ZERO TO HOLD2.
SET SRT-IND UP BY 1.
MOVE HOLD1 TO SRT-INP-FLD(SRT-IND).
SET IA1-IND UP BY 3.
IF IA1-IND > 43 GO TO S-ITEM-LOOKUP.
IF SS(IA1-IND) IS NUMERIC MOVE SS(IA1-IND) TO HOLD2.
MOVE HOLD2 TO SRT-INP-SUB(SRT-IND).
S-ITEM-LOOKUP.
SET TTY-IND TO ZERO.
MOVE HOLD1 TO SI-IT-001.
MOVE HOLD2 TO SI-IT-002.
MOVE SRT-ITM TO SI-NAME.
MOVE LENGTH-OF-FIELD(HOLD1) TO SI-NUM1.
MOVE " X(" TO SI-PIC-TYPE.
MOVE ")." TO SI-DOT-OR-CONT.
SIL-001.
SET TTY-IND UP BY 1.
IF TTY-IND > 40 GO TO SIL-SEE-BRKDWN.
IF IN-FLD(TTY-IND) NOT = HOLD1 GO TO SIL-001.
IF A-OR-N(TTY-IND) NOT = "N" GO TO SIL-SEE-BRKDWN.
MOVE "S9(" TO SI-PIC-TYPE.
IF DECIMAL-POSIT(PROMPT-IND) = 0 GO TO SIL-SEE-BRKDWN.
COMPUTE WR-IND = LENGTH-OF-FIELD(HOLD1) - DECIMAL-POSIT(HOLD1).
MOVE WR-IND TO SI-NUM1.
MOVE ")V9(" TO SI-PAREN1.
MOVE DECIMAL-POSIT(HOLD1) TO SI-NUM2.
MOVE ")." TO SI-PAREN2.
WRITE SOURCE-RECORD FROM SRT-ITEMS.
GO TO S-ITEM-DONE.
SIL-SEE-BRKDWN.
IF HOLD2 = 0 WRITE SOURCE-RECORD FROM SRT-ITEMS, GO TO S-ITEM-DONE.
MOVE FLD-ARRAY(TTY-IND, HOLD2) TO SI-NUM1.
WRITE SOURCE-RECORD FROM SRT-ITEMS.
S-ITEM-DONE.
GO TO NSO-001.
NSO-DONE.
MOVE 1Y TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE S-NAME TO VI-FN.
MOVE "LPT" TO VI-EX.
MOVE VID-NAME TO SOURCE-RECORD.
WRITE SOURCE-RECORD BEFORE ADVANCING 2 LINES.
MOVE 1Z TO SOURCE-RECORD.
WRITE SOURCE-RECORD BEFORE ADVANCING 2 LINES.
IF PROJ-NUMBER = 0 WRITE SOURCE-RECORD FROM FMTFD BEFORE ADVANCING 2 LINES
,GO TO NOPPN-002.
WRITE SOURCE-RECORD FROM FMTFD1.
WRITE SOURCE-RECORD FROM USR-PPN BEFORE ADVANCING 2 LINES.
WRITE SOURCE-RECORD FROM FMT1-01 BEFORE ADVANCING 2 LINES.
NOPPN-002.
MOVE 2A TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE LENGTH-OF-FIELD(POS-KEY) TO SK-NUM, S06-NUM.
MOVE SYMB-KEY TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
WRITE SOURCE-RECORD FROM SAVE06.
MOVE 2B TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE 2C TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE I TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE NUM-LINES TO N-LINE-NUM.
MOVE N-LINE TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
IF SORTING-SEQUENCE NOT = SPACES MOVE SAVE01 TO SOURCE-RECORD
,WRITE SOURCE-RECORD.
MOVE "77 P PIC 9; VALUE 0." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE VERSION-NUMBER TO VER-NUM.
WRITE SOURCE-RECORD FROM VERS.
PERFORM VAR-SETUP THRU VS-EXIT VARYING SUP-IND1 FROM 1 BY 1
,UNTIL SUP-IND1 > 10.
MOVE SPACES TO SOURCE-RECORD.
WRITE SOURCE-RECORD BEFORE ADVANCING 3 LINES.
MOVE "IDX" TO FI-EX.
WRITE SOURCE-RECORD FROM FI-NAME.
WRITE SOURCE-RECORD FROM FI-FIN.
WRITE SOURCE-RECORD FROM FI-EXT BEFORE ADVANCING 2 LINES.
WRITE SOURCE-RECORD FROM PI BEFORE ADVANCING 2 LINES.
MOVE 2D TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
SET TTY-IND TO ZERO.
MOVE "OUT" TO LO-NAME.
MOVE OUT-FIL TO FR-NUM.
NR-LOOP2.
SET TTY-IND UP BY 1.
IF TTY-IND > 40 GO TO NR-BREAK2.
IF TOT-SIZE OF OREC(TTY-IND) = ZERO GO TO NR-BREAK2.
MOVE TTY-IND TO LO-NUM.
MOVE TOT-SIZE OF OREC(TTY-IND) TO LO-SIZE.
MOVE " X" TO LO-TYPE.
IF A-OR-N(TTY-IND) NOT = "N" GO TO NR2-CONTIN.
*
* REMOVING THE FOLLOWING LINE ELIMINATES NEGATIVE SIGNS PROBLEM
* MOVE " -" TO LO-TYPE.
MOVE " Z" TO LO-TYPE.
IF FLD-ARRAY(TTY-IND,1) NOT = 0 MOVE " Z" TO LO-TYPE.
NR2-CONTIN.
MOVE "." TO LO-PIC-INFO.
IF DECIMAL-PLACES(TTY-IND) NOT = ZERO PERFORM HAVE-DEC-PLACE.
MOVE LINE-OUT TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE FILL-REC TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
GO TO NR-LOOP2.
NR-BREAK2.
MOVE SPACES TO SOURCE-RECORD.
WRITE SOURCE-RECORD BEFORE ADVANCING 2 LINES.
MOVE 2E TO SOURCE-RECORD.
EXAMINE RPT-TITLE TALLYING ALL SPACES.
MOVE SPACES TO TITLE-ARRAY.
COMPUTE H-IND = (TALLY / 2) - 2.
PERFORM HEADER-SETUP VARYING FLD-IND FROM 1 BY 1 UNTIL H-IND = 66.
MOVE TITLE-ARRAY TO TITLE-ARRAY1.
MOVE 2E TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
IF N = 72 MOVE 3 TO HI-NUM; ELSE MOVE 33 TO HI-NUM.
MOVE "SPACES." TO REST.
MOVE HEADER-INFO1 TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE 33 TO HI-NUM.
MOVE TA1 TO Q1.
MOVE QUOTE-1 TO REST.
MOVE HEADER-INFO1 TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE TA2 TO Q1.
MOVE QUOTE-1 TO REST.
MOVE HEADER-INFO1 TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
IF N = 72 MOVE SPACES TO SOURCE-RECORD, GO TO ITS-TTY1.
MOVE 25 TO HI-NUM.
MOVE "SPACES." TO REST.
MOVE HEADER-INFO1 TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE QUOTE-2 TO REST.
MOVE 5 TO HI-NUM.
MOVE HEADER-INFO1 TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE 2F TO SOURCE-RECORD.
ITS-TTY1.
WRITE SOURCE-RECORD BEFORE ADVANCING 2 LINES.
MOVE 2G TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
IF N NOT = 72 GO TO NOT-TTY-1.
MOVE 36 TO HI-NUM.
MOVE T-H1A TO Q3.
MOVE QUOTE-3 TO REST.
WRITE SOURCE-RECORD FROM HEADER-INFO1.
MOVE T-H1B TO Q3.
MOVE QUOTE-3 TO REST.
WRITE SOURCE-RECORD FROM HEADER-INFO1.
MOVE SPACES TO SOURCE-RECORD.
GO TO ITS-TTY2.
NOT-TTY-1.
MOVE 33 TO HI-NUM.
MOVE HEAD-1A TO Q1.
MOVE QUOTE-1 TO REST.
MOVE HEADER-INFO1 TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE HEAD-1B TO Q1.
MOVE QUOTE-1 TO REST.
MOVE HEADER-INFO1 TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE HEAD-1C TO Q1.
MOVE QUOTE-1 TO REST.
MOVE HEADER-INFO1 TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE HEAD-1D TO Q1.
MOVE QUOTE-1 TO REST.
MOVE HEADER-INFO1 TO SOURCE-RECORD.
ITS-TTY2.
WRITE SOURCE-RECORD BEFORE ADVANCING 3 LINES.
MOVE 2H TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
IF N NOT = 72 GO TO NOT-TTY-2.
MOVE T-H2A TO Q3.
MOVE QUOTE-3 TO REST.
WRITE SOURCE-RECORD FROM HEADER-INFO1.
MOVE T-H2B TO Q3.
MOVE QUOTE-3 TO REST.
WRITE SOURCE-RECORD FROM HEADER-INFO1.
MOVE SPACES TO SOURCE-RECORD.
GO TO ITS-TTY3.
NOT-TTY-2.
MOVE HEAD-2A TO Q1.
MOVE QUOTE-1 TO REST.
MOVE HEADER-INFO1 TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE HEAD-2B TO Q1.
MOVE QUOTE-1 TO REST.
MOVE HEADER-INFO1 TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE HEAD-2C TO Q1.
MOVE QUOTE-1 TO REST.
MOVE HEADER-INFO1 TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE HEAD-2D TO Q1.
MOVE QUOTE-1 TO REST.
MOVE HEADER-INFO1 TO SOURCE-RECORD.
ITS-TTY3.
WRITE SOURCE-RECORD BEFORE ADVANCING 3 LINES.
IF N = 72 MOVE I2 TO SOURCE-RECORD; ELSE MOVE 2I TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE ZERO TO TTY-IND, TC2.
NR-LOOP2A.
SET TTY-IND UP BY 1.
IF TTY-IND > 40 GO TO NR-BREAK2A.
IF IN-FLD(TTY-IND) = ZERO GO TO NR-BREAK2A.
IF SORTING-SEQUENCE = SPACES GO TO NR-NOT-NUM.
IF TOT(TTY-IND) = "Y" GO TO NR-LOOP2A1.
NR-NOT-NUM.
COMPUTE TC2 = TC2 + TOT-SIZE(TTY-IND) + OUT-FIL.
IF A-OR-N(TTY-IND) NOT = "N" GO TO NR-LOOP2A.
IF FLD-ARRAY(TTY-IND,1) NOT = 0 GO TO NR-LOOP2A.
IF DECIMAL-PLACES(TTY-IND) NOT = ZERO SET TC2 UP BY 1.
GO TO NR-LOOP2A.
NR-LOOP2A1.
SET TC2 DOWN BY 1.
MOVE TC2 TO FR-NUM.
MOVE FILL-REC TO SOURCE-RECORD.
IF TC2 > 0 WRITE SOURCE-RECORD.
MOVE TOT-SIZE(TTY-IND) TO TC2.
SET TC2 UP BY 1.
MOVE TTY-IND TO LO-NUM.
MOVE "TOT" TO LO-NAME.
* THE NEXT LINE FIXES "-" PROBLEM
* MOVE " -" TO LO-TYPE.
MOVE " Z" TO LO-TYPE.
MOVE TC2 TO LO-SIZE.
MOVE "." TO LO-PIC-INFO.
IF DECIMAL-PLACES(TTY-IND) = ZERO GO TO NR-WRT-LO.
COMPUTE BEF-DECIMAL = (TOT-SIZE(TTY-IND) - DECIMAL-PLACES(TTY-IND)) + 1.
MOVE BEF-DECIMAL TO LO-SIZE.
MOVE "." TO LO-PERIOD-OR-V.
MOVE "9(" TO LO-DPAR1.
MOVE DECIMAL-PLACES(TTY-IND) TO LO-NUM2.
MOVE ")." TO LO-DPAR2.
NR-WRT-LO.
MOVE LINE-OUT TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
SET TOT-FLAG TO 1.
MOVE OUT-FIL TO TC2.
GO TO NR-LOOP2A.
NR-BREAK2A.
IF TC2 > ZERO MOVE TC2 TO FR-NUM, MOVE FILL-REC TO SOURCE-RECORD
,WRITE SOURCE-RECORD BEFORE ADVANCING 3 LINES.
IF TOT-FLAG = ZERO GO TO ACS-DONE.
MOVE 2K TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
PERFORM GET-ACS THRU GA-EXIT VARYING TTY-IND FROM 1 BY 1 UNTIL TTY-IND > 40.
MOVE SPACES TO SOURCE-RECORD.
WRITE SOURCE-RECORD BEFORE ADVANCING 3 LINES.
MOVE 2L TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
PERFORM GET-ACS THRU GA-EXIT VARYING TTY-IND FROM 1 BY 1 UNTIL TTY-IND > 40.
ACS-DONE.
MOVE 2J TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
IF SORTING-SEQUENCE NOT = SPACES PERFORM NEED-SORT THRU NS-DONE, GO TO NR-LOOP3.
MOVE "OPENING SECTION." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
PERFORM PW-SETUP.
MOVE " MOVE 0 TO I." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
PERFORM DISP-VAR-SETUP VARYING SUP-IND1 FROM 1 BY 1
,UNTIL SUP-IND1 > 10.
MOVE "SETUP. COPY PRSETUP." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE " MOVE LOW-VALUES TO SYM-KEY." TO SOURCE-RECORD.
WRITE SOURCE-RECORD BEFORE ADVANCING 2 LINES.
MOVE "LOOP." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
IF OVERLAY-PAGE NOT = ZERO PERFORM GT-OV, GO TO AD1.
MOVE " READ FILE-IN; INVALID KEY GO TO ALL-DONE." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
IF SPC = "Y" WRITE SOURCE-RECORD FROM DO-RIGHT.
AD1.
IF SA-SYMBOL(1) NOT = SPACES PERFORM SUPPRESS-IT THRU SUP-EXIT
,VARYING SUP-IND1 FROM 1 BY 1 UNTIL SUP-IND1 > 10.
SET TTY-IND TO ZERO.
NR-LOOP3.
IF OVERLAY-PAGE = ZERO GO TO CLR-IND-1.
IF OP-RESP NOT = "N" GO TO CLR-IND-1.
MOVE POS-KEY TO IL-NUM1, IL-NUM2, MOVE-06-NUM, RM-NUM.
WRITE SOURCE-RECORD FROM IF-LINE.
WRITE SOURCE-RECORD FROM MOVE-06.
PERFORM MOVE-SPA VARYING PROMPT-IND FROM 1 BY 1
,UNTIL PROMPT-IND = TOP-LINE(OVERLAY-PAGE).
MOVE "CONT1." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
CLR-IND-1.
IF TOT-FLAG = 1 PERFORM ADD-LINE THRU AL-EXIT
,VARYING TTY-IND FROM 1 BY 1 UNTIL TTY-IND > 40.
MOVE ZERO TO TTY-IND, PROMPT-IND.
NR-LOOP3-1.
SET TTY-IND UP BY 1.
IF TTY-IND > 40 GO TO NR-BREAK3.
IF TOT-SIZE OF OREC(TTY-IND) = ZERO GO TO NR-BREAK3.
IF A-OR-N(TTY-IND) = "D" PERFORM DATE-CONV THRU DC-CONT, GO TO NR-LOOP3-1.
MOVE IN-FLD OF OREC(TTY-IND) TO ML-1, PROMPT-IND.
MOVE SPACES TO ML-2.
IF LENGTH-OF-FIELD(PROMPT-IND) > TOT-SIZE OF OREC(TTY-IND), MOVE 1 TO ML-2.
MOVE SPACES TO ML-2A.
IF OVERLAY-PAGE = ZERO GO TO NRL3A.
IF PROMPT-IND < TOP-LINE(OVERLAY-PAGE) GO TO NRL3A.
MOVE "(I)" TO ML-2A.
NRL3A.
MOVE TTY-IND TO ML-3.
MOVE MOVE-LINE TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
GO TO NR-LOOP3-1.
NR-BREAK3.
MOVE " MOVE LINE-OUT TO REC-OUT." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE " PERFORM PRINT-1 THRU PL-EXIT." TO SOURCE-RECORD.
IF DUBSPA = "Y" MOVE " PERFORM PRINT-2 THRU PL-EXIT." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
IF OP-RESP = "N" WRITE SOURCE-RECORD FROM RE-MOVE.
IF SORTING-SEQUENCE = SPACES GO TO NR-TAG1.
MOVE " MOVE 1 TO P." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
NR-TAG1.
MOVE " GO TO LOOP." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE SPACES TO SOURCE-RECORD.
WRITE SOURCE-RECORD BEFORE ADVANCING 3 LINES.
IF TOT-FLAG = 1 PERFORM GET-TOT-UP, THRU GT-CONT.
MOVE "PRINT-2. COPY PRPRIN." TO SOURCE-RECORD.
IF TTY-OP-DEV = "Y" MOVE "PRINT-2. COPY PRPRN2." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
IF SPC = "Y" WRITE SOURCE-RECORD FROM PR-RT.
IF SORTING-SEQUENCE NOT = SPACES PERFORM NS-2 THRU NS-2-EXIT, GO TO NR-CONT3.
MOVE "ALL-DONE. COPY PRDONE." TO SOURCE-RECORD.
WRITE SOURCE-RECORD BEFORE ADVANCING 3 LINES.
NR-CONT3.
STOP RUN.
MOVE-SPA.
MOVE PROMPT-IND TO MOV-SPA-NUM.
WRITE SOURCE-RECORD FROM MOV-SPA.
OVERLAY-SETUP.
WRITE SOURCE-RECORD FROM PAGE1-LINE.
OS-LOOP.
MOVE ZERO TO CHK-03-CNT, DECIMAL-FLAG.
MOVE "." TO L03-PIC-INFO.
MOVE " X" TO L03D.
PERFORM CHECK-03 THRU CHK-03-EXIT VARYING TTY-IND FROM 1 BY 1
,UNTIL TTY-IND > 40.
IF CHK-03-CNT = 1 GO TO OS-CONT.
MOVE PROMPT-IND TO L03A.
MOVE SPACE TO L03C.
IF DECIMAL-FLAG = ZERO, MOVE LENGTH-OF-FIELD(PROMPT-IND) TO L03E.
MOVE LINE-03 TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
OS-CONT.
SET PROMPT-IND UP BY 1.
IF PROMPT-IND NOT = TOP-LINE(HOLD3) GO TO OS-LOOP.
OS-EXIT. EXIT.
GET-ACS.
IF TOT(TTY-IND) NOT = "Y" GO TO GA-EXIT.
MOVE TTY-IND TO ACR1.
MOVE TOT-SIZE(TTY-IND) TO ACR3.
MOVE "; COMP." TO ACR-PIC-INFO.
IF DECIMAL-PLACES(TTY-IND) = ZERO GO TO N-AC-DEC.
MOVE "V" TO ACR-PERIOD-OR-V.
MOVE "9(" TO ACR-DPAR1.
COMPUTE ACR3 = TOT-SIZE(TTY-IND) - DECIMAL-PLACES(TTY-IND).
MOVE DECIMAL-PLACES(TTY-IND) TO ACR-NUM2.
MOVE "); COMP." TO ACR-DPAR2.
N-AC-DEC.
MOVE AC-REGISTER TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
GA-EXIT. EXIT.
DATE-CONV.
MOVE IN-FLD(TTY-IND) TO MDL1-SYM.
MOVE SPACES TO MDL1-IND.
IF OVERLAY-PAGE = 0 GO TO DC-CONT.
IF IN-FLD(TTY-IND) < TOP-LINE(OVERLAY-PAGE) GO TO DC-CONT.
MOVE "(I)" TO MDL1-IND.
DC-CONT.
WRITE SOURCE-RECORD FROM MOV-DAT-LINE1.
MOVE " PERFORM DATE-CONVER THRU DC-EXIT." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE TTY-IND TO MDL2-SYM.
WRITE SOURCE-RECORD FROM MOV-DAT-LINE2.
VAR-SETUP.
IF SUPPRESS-ARRAY(SUP-IND1) = SPACES GO TO VS-EXIT.
MOVE ZEROES TO SORT-SYM.
MOVE SA-SYMBOL(SUP-IND1) TO INPUT-ARRAY2.
EXAMINE INPUT-ARRAY2 TALLYING UNTIL FIRST "I".
MOVE TALLY TO IA1-IND.
IF IA2(TALLY) NOT NUMERIC GO TO HAV-VAR-SYM.
MOVE IA2(TALLY) TO SS3.
SET TALLY DOWN BY 1.
IF TALLY = ZERO GO TO HAV-VAR-SYM.
IF IA2(TALLY) NOT NUMERIC GO TO HAV-VAR-SYM.
MOVE IA2(TALLY) TO SS2.
SET TALLY DOWN BY 1.
IF TALLY = ZERO GO TO HAV-VAR-SYM.
IF IA2(TALLY) NOT NUMERIC GO TO HAV-VAR-SYM.
MOVE IA2(TALLY) TO SS-1.
HAV-VAR-SYM.
MOVE ZERO TO HOLD2, HOLD3.
MOVE SORT-SYM TO HOLD1.
MOVE " X" TO VAR-TYPE.
MOVE "." TO VAR-PERIOD-OR-V.
ADD 4 TO IA1-IND.
IF IA2(IA1-IND) IS NUMERIC MOVE IA2(IA1-IND) TO HOLD2.
PERFORM GET-VAR-SYM THRU GVS-EXIT VARYING PROMPT-IND FROM 1 BY 1
,UNTIL PROMPT-IND > 40.
IF HOLD3 = ZERO MOVE LENGTH-OF-FIELD(HOLD1) TO VAR-NUM1
,GO TO VAR-LIT-SET.
MOVE HOLD3 TO PROMPT-IND.
IF A-OR-N(PROMPT-IND) = "N" MOVE "S9" TO VAR-TYPE.
IF HOLD2 NOT = ZERO MOVE FLD-ARRAY(PROMPT-IND, HOLD2) TO VAR-NUM1
,GO TO VAR-LIT-SET.
IF DECIMAL-PLACES(PROMPT-IND) = ZERO MOVE TOT-SIZE(PROMPT-IND) TO VAR-NUM1
,GO TO VAR-LIT-SET.
COMPUTE VAR-NUM1 = TOT-SIZE(PROMPT-IND) - DECIMAL-PLACES(PROMPT-IND).
MOVE DECIMAL-PLACES(PROMPT-IND) TO VAR-NUM3.
MOVE "V9(" TO VAR-V.
MOVE ")." TO VAR-CL-PAR.
VAR-LIT-SET.
PERFORM VAR-LIT THRU VL-EXIT VARYING SUP-IND2 FROM 1 BY 1
,UNTIL SUP-IND2 > 10.
VS-EXIT. EXIT.
VAR-LIT.
IF SA-LITERAL(SUP-IND1,SUP-IND2) = SPACES GO TO VL-EXIT.
EXAMINE SA-LITERAL(SUP-IND1, SUP-IND2) TALLYING ALL "/".
IF TALLY NOT = 2 GO TO VL-EXIT.
MOVE SUP-IND1 TO VAR-PRIME.
MOVE SUP-IND2 TO VAR-SEC.
WRITE SOURCE-RECORD FROM VAR-IAB.
VL-EXIT. EXIT.
GET-VAR-SYM.
IF IN-FLD(PROMPT-IND) NOT = HOLD1 GO TO GVS-EXIT.
MOVE PROMPT-IND TO HOLD3.
GVS-EXIT. EXIT.
NEED-TMP.
MOVE 1Q TO SOURCE-RECORD.
WRITE SOURCE-RECORD BEFORE ADVANCING 2 LINES.
TOTAL-UP.
COMPUTE NUM-CHARS = NUM-CHARS + LENGTH-OF-FIELD(PROMPT-IND).
CHECK-03.
IF IN-FLD OF OREC(TTY-IND) NOT = PROMPT-IND GO TO CHK-03-EXIT.
MOVE "." TO LO-PIC-INFO, L03-PIC-INFO.
IF A-OR-N(TTY-IND) = "A" MOVE " X" TO L03D, L05D, LO-TYPE, GO TO CHK-FLD-ARRAY.
IF A-OR-N(TTY-IND) = "N" OR "D" MOVE "S9" TO L03D, L05D, LO-TYPE.
IF FLD-ARRAY(TTY-IND, 1) NOT = ZERO GO TO CHK-FLD-ARRAY.
IF DECIMAL-PLACES(TTY-IND) = ZERO GO TO CHK-03-EXIT.
COMPUTE BEF-DECIMAL = LENGTH-OF-FIELD(PROMPT-IND) - DECIMAL-PLACES(TTY-IND).
MOVE "V" TO LO-PERIOD-OR-V, L03-PERIOD-OR-V.
MOVE "9(" TO LO-DPAR1, L03-DPAR1.
MOVE BEF-DECIMAL TO LO-SIZE, L03E.
MOVE DECIMAL-PLACES(TTY-IND) TO LO-NUM2, L03-NUM2.
MOVE ")." TO LO-DPAR2, L03-DPAR2.
SET DECIMAL-FLAG TO 1.
GO TO CHK-03-EXIT.
CHK-FLD-ARRAY.
IF FLD-ARRAY(TTY-IND,1) = ZERO GO TO CHK-03-EXIT.
MOVE PROMPT-IND TO L02A, L03A, L05A.
MOVE "." TO LI-03, L02C.
IF PROMPT-IND = POS-KEY MOVE " REDEFINES REC-KEY." TO L02C.
MOVE LINE-02 TO SOURCE-RECORD.
IF OVERLAY-PAGE = ZERO GO TO C03-CONT.
MOVE LINE-03 TO SOURCE-RECORD.
IF PROMPT-IND < TOP-LINE(OVERLAY-PAGE) MOVE LINE-02 TO SOURCE-RECORD.
C03-CONT.
WRITE SOURCE-RECORD.
MOVE SPACES TO L03C.
MOVE SPACES TO LI-03A.
MOVE "PIC " TO LI-03B.
IF A-OR-N OF OREC(TTY-IND) = "N" MOVE " 9" TO L03D, L05D, LO-TYPE.
IF A-OR-N OF OREC(TTY-IND) = "A" MOVE " X" TO L03D, L05D, LO-TYPE.
MOVE "(" TO LI-03C.
MOVE ")" TO LI-03D.
MOVE "." TO L03-PIC-INFO.
SET FLD-IND TO ZERO.
C03-LOOP.
SET FLD-IND UP BY 1.
IF FLD-IND > 5 GO TO CHK-03-EXIT.
IF FLD-ARRAY(TTY-IND, FLD-IND) = ZERO GO TO CHK-03-EXIT.
IF A-OR-N(TTY-IND) = "N" MOVE " 9" TO L03D, L05D.
MOVE FLD-IND TO L03C, L05C.
MOVE FLD-ARRAY(TTY-IND, FLD-IND) TO L03E, L05E.
MOVE LINE-03 TO SOURCE-RECORD.
IF OVERLAY-PAGE = ZERO GO TO C03L-CONT.
MOVE LINE-05 TO SOURCE-RECORD.
IF PROMPT-IND < TOP-LINE(OVERLAY-PAGE) MOVE LINE-03 TO SOURCE-RECORD.
C03L-CONT.
WRITE SOURCE-RECORD.
MOVE SPACES TO L03C, L05C.
SET CHK-03-CNT TO 1.
GO TO C03-LOOP.
CHK-03-EXIT. EXIT.
HEADER-SETUP.
SET H-IND UP BY 1.
MOVE RT(FLD-IND) TO TA(H-IND).
NEED-SORT.
MOVE "SORTING SECTION." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
PERFORM PW-SETUP.
MOVE "SORT1." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
SET IA1-IND TO ZERO.
SRT-SEQ-PARSE.
SET IA1-IND UP BY 1.
IF IA1-IND > 43 GO TO SPARS-DONE.
IF SS(IA1-IND) NOT = "I" GO TO SRT-SEQ-PARSE.
MOVE "S" TO SS(IA1-IND).
SET IA1-IND UP BY 1.
MOVE "R" TO SS(IA1-IND).
SET IA1-IND UP BY 1.
MOVE "T" TO SS(IA1-IND).
SET IA1-IND UP BY 1.
IF IA1-IND > 43 GO TO SPARS-DONE.
GO TO SRT-SEQ-PARSE.
SPARS-DONE.
MOVE SORTING-SEQUENCE TO SS1.
MOVE SORT-STATEMENT TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE " ;INPUT PROCEDURE IS NEW-SORT" TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE " ;OUTPUT PROCEDURE IS NEW-REPORT." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE " STOP RUN." TO SOURCE-RECORD.
WRITE SOURCE-RECORD BEFORE ADVANCING 3 LINES.
MOVE "NEW-SORT SECTION." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE " OPEN INPUT FILE-IN." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE " MOVE LOW-VALUES TO SYM-KEY." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
PERFORM DISP-VAR-SETUP VARYING SUP-IND1 FROM 1 BY 1
,UNTIL SUP-IND1 > 10.
MOVE " MOVE ZERO TO I." TO SOURCE-RECORD.
WRITE SOURCE-RECORD BEFORE ADVANCING 2 LINES.
MOVE "NS-LOOP." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
IF OVERLAY-PAGE NOT = ZERO PERFORM GT-OV, GO TO NS1.
MOVE " READ FILE-IN; INVALID KEY GO TO NS-DONE." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
IF SPC = "Y" WRITE SOURCE-RECORD FROM DO-RIGHT.
NS1.
IF SA-SYMBOL(1) NOT = SPACES PERFORM SUPPRESS-IT THRU SUP-EXIT
,VARYING SUP-IND1 FROM 1 BY 1 UNTIL SUP-IND1 > 10.
IF OVERLAY-PAGE = ZERO GO TO NS2.
NS2.
MOVE " MOVE REC-KEY TO KSRT." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
IF OV-FLAG = 1 MOVE " MOVE I TO OP-NO." TO SOURCE-RECORD
,WRITE SOURCE-RECORD.
SET SRT-IND TO ZERO.
NS-TAB-LOOP.
SET SRT-IND UP BY 1.
IF SRT-IND > 10 GO TO NS-TAB-BREAK.
IF SRT-INP-FLD(SRT-IND) = ZERO GO TO NS-TAB-BREAK.
MOVE SPACES TO MS-NUM-IND.
MOVE SRT-INP-FLD(SRT-IND) TO MS-NUM1, MS-NUM3.
MOVE SRT-INP-SUB(SRT-IND) TO MS-NUM2, MS-NUM4.
IF OV-FLAG = 0 GO TO NS-WRITE.
IF SRT-INP-FLD(SRT-IND) < TOP-LINE(OVER-LAY-PAGE) GO TO NS-WRITE.
MOVE "(I)" TO MS-NUM-IND.
IF SRT-INP-SUB(SRT-IND) = ZERO GO TO NS-WRITE.
MOVE SRT-INP-SUB(SRT-IND) TO MS-NUM2.
MOVE "(I)" TO MS-IND.
NS-WRITE.
WRITE SOURCE-RECORD FROM MOV-SRT-LINE.
GO TO NS-TAB-LOOP.
NS-TAB-BREAK.
MOVE " RELEASE REC-SORT." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE " GO TO NS-LOOP." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE "NS-DONE." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE " CLOSE FILE-IN." TO SOURCE-RECORD.
WRITE SOURCE-RECORD BEFORE ADVANCING 2 LINES.
MOVE "NEW-REPORT SECTION." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE "NR-OPENERS. COPY PRSETUP." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
IF TOT-FLAG = 1 MOVE " MOVE LOW-VALUES TO ACC-1, ACC-2." TO SOURCE-RECORD.
IF TOT-FLAG = 1 WRITE SOURCE-RECORD.
MOVE " MOVE SPACES TO SAVE-01." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE SPACES TO SOURCE-RECORD.
WRITE SOURCE-RECORD BEFORE ADVANCING 2 LINES.
MOVE "LOOP." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
IF TOT-FLAG = ZERO MOVE " RETURN TEMP; AT END GO TO ALL-DONE." TO SOURCE-RECORD
,WRITE SOURCE-RECORD, GO TO NS-1.
MOVE " RETURN TEMP; AT END PERFORM TOTAL-UP GO TO ALL-DONE." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
NS-1.
MOVE " MOVE KSRT TO SYM-KEY." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE " READ FILE-IN; INVALID KEY STOP RUN." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
IF SPC = "Y" WRITE SOURCE-RECORD FROM DO-RIGHT.
IF OV-FLAG = 1 MOVE " MOVE OP-NO TO I." TO SOURCE-RECORD
,WRITE SOURCE-RECORD.
MOVE SORT-KEEPER TO PROMPT-IND.
MOVE SPACES TO SL-1-IND.
IF OVERLAY-PAGE = ZERO GO TO NS-1A.
IF PROMPT-IND < TOP-LINE(OVERLAY-PAGE) GO TO NS-1A.
MOVE "(I)" TO SL-1-IND, SL-5-IND.
NS-1A.
MOVE S-LINE-1 TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE " IF P = 0 GO TO CONT." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
IF TOT-FLAG = 1 MOVE " PERFORM TOTAL-UP." TO SOURCE-RECORD.
IF TOT-FLAG = 1 WRITE SOURCE-RECORD.
IF TOT-FLAG = 0 PERFORM NEED-BREAK, THRU GT-CONT.
MOVE "CONT." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE S-LINE-5 TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
NS-DONE.
SET TTY-IND TO ZERO.
NS-2.
MOVE "ALL-DONE." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
IF TOT-FLAG = ZERO MOVE " EXIT." TO SOURCE-RECORD
,WRITE SOURCE-RECORD.
IF TOT-FLAG = ZERO GO TO NS-2-EXIT.
MOVE " MOVE SPACES TO REC-OUT." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE " PERFORM PRINT-2 THRU PL-EXIT." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE " MOVE BREAK-LINE2 TO REC-OUT." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE " PERFORM PRINT-1 THRU PL-EXIT." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE 2 TO SL3-NUM1A.
PERFORM COM-LINE THRU CL-EXIT VARYING TTY-IND FROM 1 BY 1
,UNTIL TTY-IND > 40.
MOVE " MOVE BREAK-LINE1 TO REC-OUT." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE " PERFORM PRINT-1 THRU PL-EXIT." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
NS-2-EXIT. EXIT.
GT-OV.
MOVE " SET I UP BY 1." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
COMPUTE WR-IND = NUM-PAGES - OVERLAY-PAGE.
SET WR-IND UP BY 1.
MOVE WR-IND TO IF-L1-NUM.
MOVE IF-LINE1 TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
WRITE SOURCE-RECORD FROM 2S.
IF SORTING-SEQUENCE = SPACES MOVE 2M TO SOURCE-RECORD
;ELSE MOVE 2N TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
IF SPC = "Y" WRITE SOURCE-RECORD FROM DO-RIGHT1.
COMP-LINE.
IF TOT(TTY-IND) NOT = "Y" GO TO CL-EXIT.
MOVE TTY-IND TO SL2-NUM1, SL2-NUM2, SL2-NUM3.
MOVE S-LINE-2 TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
COM-LINE.
IF TOT(TTY-IND) NOT = "Y" GO TO CL-EXIT.
MOVE TTY-IND TO SL3-NUM1, SL3-NUM2.
MOVE S-LINE-3 TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
CL-EXIT. EXIT.
ADD-LINE.
IF TOT(TTY-IND) NOT = "Y" GO TO AL-EXIT.
MOVE SPACES TO SL4-IND.
IF OVERLAY-PAGE = 0 GO TO AL1-CONT.
IF IN-FLD(TTY-IND) < TOP-LINE(OVERLAY-PAGE) GO TO AL1-CONT.
MOVE "(I)" TO SL4-IND.
AL1-CONT.
MOVE IN-FLD(TTY-IND) TO SL4-NUM1.
MOVE TTY-IND TO SL4-NUM2.
MOVE S-LINE-4 TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
AL-EXIT. EXIT.
DISP-VAR-SETUP.
PERFORM LITERAL-CONVER THRU LC-EXIT VARYING SUP-IND2 FROM 1 BY 1
,UNTIL SUP-IND2 > 10.
LITERAL-CONVER.
IF SA-LITERAL(SUP-IND1, SUP-IND2) = SPACES GO TO LC-EXIT.
EXAMINE SA-LITERAL(SUP-IND1, SUP-IND2) TALLYING ALL "/".
IF TALLY NOT = 2 GO TO LC-EXIT.
MOVE SA-LITERAL(SUP-IND1, SUP-IND2) TO INPUT-ARRAY2.
IF INPUT-ARRAY2 NOT = "//" GO TO NO-ASTERISK.
MOVE DL-ASTER TO DL-FILL.
PERFORM WRITE-DL.
GO TO LC-EXIT.
NO-ASTERISK.
MOVE INPUT-ARRAY2 TO DL-FILL.
PERFORM WRITE-DL.
LC-EXIT. EXIT.
WRITE-DL.
EXAMINE DL-FILL REPLACING ALL "/" BY QUOTES.
WRITE SOURCE-RECORD FROM DISPLAY-LINE.
MOVE SUP-IND1 TO DAL-1.
MOVE SUP-IND2 TO DAL-2.
WRITE SOURCE-RECORD FROM D-ACC-LIN.
GET-TOT-UP.
MOVE "TOTAL-UP." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE " MOVE SPACES TO REC-OUT." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE " PERFORM PRINT-1 THRU PL-EXIT." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
PERFORM COMP-LINE THRU CL-EXIT VARYING TTY-IND FROM 1 BY 1
,UNTIL TTY-IND > 40.
MOVE " MOVE SAVE-01 TO BL-NAME." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE " MOVE BREAK-LINE TO REC-OUT." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE " PERFORM PRINT-1 THRU PL-EXIT." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
NEED-BREAK.
IF NUM-LINES = ZERO GO TO GT-CONT.
MOVE " MOVE BREAK-LINE1 TO REC-OUT." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE " PERFORM PRINT-3 THRU PL-EXIT." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
IF TOF = "Y" PERFORM RESET-PAGE.
GT-CONT.
IF TOT-FLAG = 1 MOVE " MOVE LOW-VALUES TO ACC-1." TO SOURCE-RECORD.
IF TOT-FLAG = 1 WRITE SOURCE-RECORD.
RESET-PAGE.
MOVE " SET PAGE-COUNT TO ZERO." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE " PERFORM PL-HDR THRU PL-EXIT." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
SUPPRESS-IT.
IF SA-SYMBOL(SUP-IND1) = SPACES GO TO SUP-EXIT.
MOVE SA-SYMBOL(SUP-IND1) TO SL1-SYM.
MOVE SPACES TO SL1-IND.
MOVE SA-IND(SUP-IND1) TO SL1-IND.
MOVE SA-SIGN(SUP-IND1) TO SL1-SIGN.
IF SA-SIGN(SUP-IND1) = "NOT" PERFORM NEED-NOT THRU NN-EXIT, GO TO SUP-EXIT.
PERFORM NEED-EQUAL THRU NE-EXIT.
SUP-EXIT. EXIT.
NEED-EQUAL.
SET SUP-IND2 TO ZERO.
IF SORTING-SEQUENCE = SPACES MOVE "LOOP." TO SL-TAG1
;ELSE MOVE "NS-LOOP." TO SL-TAG1.
NE-LOOP.
SET SUP-IND2 UP BY 1.
IF SUP-IND2 > 10 GO TO NE-EXIT.
IF SA-LITERAL(SUP-IND1, SUP-IND2) = SPACES GO TO NE-EXIT.
MOVE SA-LITERAL(SUP-IND1, SUP-IND2) TO SL1-LITERAL.
PERFORM NOT-LIT THRU NL-FIN.
MOVE SUPPRESS-LINE1 TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
GO TO NE-LOOP.
NE-EXIT. EXIT.
NEED-NOT.
MOVE "=" TO SL1-SIGN.
MOVE SPACES TO SL1-TAG.
SET SUP-IND2 TO ZERO.
MOVE "TAG" TO SL1-TAG1.
MOVE SUP-IND1 TO SL-NUM1.
MOVE "." TO SL-PERIOD.
NN-LOOP.
SET SUP-IND2 UP BY 1.
IF SUP-IND2 > 10 GO TO NN-EXIT.
IF SA-LITERAL(SUP-IND1, SUP-IND2) = SPACES GO TO NN-EXIT.
MOVE SA-LITERAL(SUP-IND1, SUP-IND2) TO SL1-LITERAL.
PERFORM NOT-LIT THRU NL-FIN.
MOVE SUPPRESS-LINE1 TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
GO TO NN-LOOP.
HAVE-DEC-PLACE.
COMPUTE BEF-DECIMAL = TOT-SIZE(TTY-IND) - DECIMAL-PLACES(TTY-IND).
MOVE BEF-DECIMAL TO LO-SIZE.
MOVE "." TO LO-PERIOD-OR-V.
MOVE "9(" TO LO-DPAR1.
MOVE DECIMAL-PLACES(TTY-IND) TO LO-NUM2.
MOVE ")." TO LO-DPAR2.
NN-EXIT.
IF SORTING-SEQUENCE = SPACES MOVE " GO TO LOOP." TO SOURCE-RECORD
;ELSE MOVE " GO TO NS-LOOP." TO SOURCE-RECORD.
WRITE SOURCE-RECORD BEFORE ADVANCING 2 LINES.
MOVE SL1-TAG TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
PW-SETUP.
WRITE SOURCE-RECORD FROM CI BEFORE ADVANCING 2 LINES.
MOVE PC-2 TO SOURCE-RECORD.
IF CODE-RESP = 0 MOVE PC-0 TO SOURCE-RECORD.
IF CODE-RESP = 1 MOVE PC-1 TO SOURCE-RECORD.
IF CODE-RESP = 3 MOVE PC-3 TO SOURCE-RECORD.
WRITE SOURCE-RECORD BEFORE ADVANCING 2 LINES.
NOT-LIT.
EXAMINE SA-LITERAL(SUP-IND1, SUP-IND2) TALLYING ALL "/".
IF TALLY NOT = 2 GO TO NL-FIN.
MOVE SUP-IND1 TO DAL-1.
MOVE SUP-IND2 TO DAL-2.
MOVE DL-VAR TO SL1-LITERAL.
NL-FIN. EXIT.