Trailing-Edge
-
PDP-10 Archives
-
decuslib20-07
-
decus/20-0168/dbmdmp.cbl
There is 1 other file named dbmdmp.cbl in the archive. Click here to see a list.
IDENTIFICATION DIVISION.
PROGRAM-ID. DBMDMP, VERSION-5, EDIT-7.
AUTHOR. BOB CONLON.
DATE-WRITTEN. 17-APR-75, MODIFIED 27-APR-81.
DATE-COMPILED.
REMARKS. THIS PROGRAM DUMPS OUT A FILE DESCRIPTION OF ANY
FORMAT FILE BEING USED BY CSSDBM.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. DECSYSTEM-10.
OBJECT-COMPUTER. DECSYSTEM-10.
SPECIAL-NAMES.
CHANNEL (1) IS TOP-OF-FORM.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT FORMAT-FILE ASSIGN TO DSK.
SELECT INPUT-FILE ASSIGN TO DSK.
SELECT FILE-OUT ASSIGN TO DSK.
SELECT RPTDAT-FILE ASSIGN TO DSK.
DATA DIVISION.
FILE SECTION.
FD FORMAT-FILE; VALUE OF IDENTIFICATION IS FORMAT-NAME.
01 FORMAT-RECORD.
02 PROMPT-TABLE OCCURS 150 TIMES PIC X(20).
02 LENGTH-OF-FIELD OCCURS 150 TIMES PIC 9(3).
02 NUMBER-FIELDS PIC 9(3).
02 NAMES OCCURS 28 TIMES PIC X(6).
02 VAL-ID PIC X.
02 AC-DAT PIC X.
02 SPC PIC X.
02 FILLER PIC X(3).
02 IND-BLOCK-FACT PIC 9(3).
02 OVER-LAY-PAGE PIC 9(3).
02 BLOCKING-FACTOR PIC 9(3).
02 PRIV OCCURS 28 TIMES PIC 9(3).
02 FILLER PIC X(3).
02 VERSION-NUMBER PIC 9(3).
02 NUM-CHARS PIC 9(4).
02 POS-KEY PIC 99.
02 NUM-PAGES PIC 9(3).
02 TOP-LINE OCCURS 50 TIMES PIC 9(3).
02 DECIMAL-POSIT OCCURS 150 TIMES PIC 9.
FD INPUT-FILE; VALUE OF IDENTIFICATION IS "DBMDMPINP".
01 INPUT-REC; DISPLAY-7 PIC X(66).
FD FILE-OUT; VALUE OF IDENTIFICATION IS FD-NAME.
01 REC-OUT; DISPLAY-7.
02 RO1 PIC X(60).
02 FILLER PIC X(6).
02 RO2 PIC X(66).
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 F1 PIC S9(3); COMP.
77 F2 PIC S9(3); COMP.
77 F3 PIC S9(3); COMP VALUE 0.
77 E PIC S9(3); COMP.
77 I PIC S9(3); COMP.
77 TP-IND PIC S9(2); COMP.
77 NUM-HOLD PIC Z(3).
77 NUM-KEEPER PIC Z(4).
77 TOT-CHRS PIC 9(4); COMP.
77 TTY-IND PIC S9(3); COMP.
77 SUP-IND1 PIC S9(3); COMP.
77 IV-IND PIC S9(3); COMP.
77 F004-ACCUM PIC S9(3); COMP VALUE 0.
77 REC-TYPE PIC S9(3); COMP.
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 FORM-001.
02 FILLER PIC X(47); VALUE "OUTPUT INPUT ALPHA T OUTPUT TOTAL INPUT".
01 FORM-002.
02 FILLER PIC X(47); VALUE "FIELD FIELD OR O FIELD OUTPUT FIELD".
01 FORM-003.
02 FILLER PIC X(26); VALUE "NUMBER NUMBER NUMERIC T ".
02 FILLER PIC X(25); VALUE " SIZE CHAR. BREAKDOWN".
01 FORM-004.
02 F004-NUM PIC X(4).
02 FILLER PIC X(6); VALUE SPACES.
02 F004-INFLD PIC X(3).
02 FILLER PIC X(5); VALUE SPACES.
02 F004-AN PIC X.
02 FILLER PIC X(5); VALUE SPACES.
02 F004-TOT PIC X.
02 FILLER PIC X(3); VALUE SPACES.
02 F004-OFS PIC X(3).
02 FILLER PIC X(3); VALUE SPACES.
02 F004-TOC PIC X(3).
02 FILLER PIC X(5); VALUE SPACES.
02 F004-BD1 PIC X(3).
02 FILLER PIC X; VALUE ":".
02 F004-BD2 PIC X(3).
02 FILLER PIC X; VALUE ":".
02 F004-BD3 PIC X(3).
02 FILLER PIC X; VALUE ":".
02 F004-BD4 PIC X(3).
02 FILLER PIC X; VALUE ":".
02 F004-BD5 PIC X(3).
02 FILLER PIC X; VALUE ":".
01 FORM-005.
02 FILLER PIC X(24); VALUE "OVERLAY PAGE: (Y OR N):".
02 F005-Y-N PIC X.
01 FORM-006.
02 FILLER PIC X(13); VALUE "REPORT NAME: ".
02 FILLER PIC X(3); VALUE "RPT".
02 F006-FN PIC X(3).
01 FORM-008.
02 FILLER PIC X(15); VALUE SPACES.
02 FILLER PIC X(6); VALUE "IF ITS".
01 FORM-009.
02 FILLER PIC X(35); VALUE "INPUT SYMBOL:(=,NOT,<,>): LITERAL:".
01 FORM-010.
02 F010-NUM PIC XX.
02 FILLER PIC X(3); VALUE "..".
02 F010-SYM PIC X(7).
02 FILLER PIC X(6); VALUE SPACES.
02 F010-SIGN PIC X(3).
02 FILLER PIC X(6); VALUE SPACES.
02 F010-NUM1 PIC XX.
02 FILLER PIC X(3); VALUE "..".
02 F010-LIT PIC X(32).
01 FORM-011.
02 FILLER PIC X(27); VALUE SPACES.
02 F011-NUM PIC XX.
02 FILLER PIC X(3); VALUE "..".
02 F011-LIT PIC X(32).
01 FORM-012.
02 FILLER PIC X(18); VALUE "SORTING SEQUENCE: ".
02 F012-SS PIC X(43).
01 FORM-013.
02 FILLER PIC X(38); VALUE "DO YOU WANT DOUBLE SPACING: (Y OR N):".
02 F013-YN PIC X.
01 FORM-014.
02 FILLER PIC X(38); VALUE "DO YOU WANT A NEW PAGE ON THE BREAK:".
02 F014-YN PIC X.
01 FORM-015.
02 FILLER PIC X(38); VALUE "NUMBER OF LINES TO SKIP AFTER BREAK: ".
02 F015-NUM PIC Z.
01 FORM-016.
02 FILLER PIC X(24); VALUE "TOTAL NUMBER OF PAGES: ".
02 F016-NUM PIC Z(3).
01 FORM-017.
02 FILLER PIC X(17); VALUE "TOP LINE OF PAGE".
02 F017-NUM PIC Z(3).
02 FILLER PIC XX; VALUE "..".
02 F017-NUM1 PIC Z(3).
01 FORM-018.
02 F018-PROMPT PIC X(19).
02 FILLER PIC X(9); VALUE ":".
02 F018-NUM PIC Z(3).
02 FILLER PIC XX; VALUE SPACES.
02 F018-PROMPT1 PIC X(20).
01 FORM-019.
02 F019-PROMPT PIC X(29).
02 FILLER PIC X(3); VALUE ":".
02 F019-NUM PIC X(10).
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 PIC X(132).
02 DR-HEADER-2 PIC X(132).
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 OOR.
02 FILLER PIC X(20); VALUE "OUTLINE OF REPORT: ".
02 OR-R-NAME PIC X(6).
01 WT-BY.
02 FILLER PIC X(13); VALUE "WRITTEN BY: ".
02 WT-AUTHOR PIC X(32).
01 OP-DEV.
02 FILLER PIC X(27); VALUE "OUTPUT DEVICE(DSK OR TTY): ".
02 O-DEV PIC X(3).
01 GEN-FROM.
02 FILLER PIC X(20); VALUE "GENERATED FROM FILE:".
02 GF-FN PIC X(6).
01 DB-INFO.
02 DB-1 PIC X(19).
02 FILLER PIC X(3); VALUE ": ".
02 DB-2 PIC X(9).
02 FILLER PIC XX; VALUE SPACES.
02 DB-3 PIC X(20).
01 DB-ISAM-INFO.
02 DBI-1 PIC X(29).
02 FILLER PIC X(3); VALUE ": ".
02 DBI-2 PIC X(9).
01 KEY-DES.
02 FILLER PIC X; VALUE "X".
02 KD-NUM-1 PIC Z(4).
02 FILLER PIC X; VALUE ".".
02 KD-NUM-2 PIC Z(3).
01 KD-ARRAY REDEFINES KEY-DES.
02 KD1 OCCURS 9 TIMES PIC X.
01 KD-ARRAY2.
02 KD2 OCCURS 9 TIMES PIC X.
01 TP-DELIM.
02 FILLER PIC X(9); VALUE SPACES.
02 FILLER PIC X(10); VALUE "P A G E : ".
02 TP-NUM PIC Z9.
01 TPD1.
02 FILLER PIC X(9); VALUE SPACES.
02 FILLER PIC X(7); VALUE "- - - -".
01 TNP.
02 FILLER PIC X(24); VALUE "TOTAL NUMBER OF PAGES: ".
02 TNP-NUM PIC ZZ9.
01 TL.
02 FILLER PIC X(17); VALUE "TOP LINE OF PAGE ".
02 TL-NUM1 PIC ZZ9.
02 FILLER PIC XX; VALUE "..".
02 TL-NUM2 PIC ZZ9.
01 FORMAT-NAME.
02 FORMAT-FN.
03 FF-FN1 PIC X(3).
03 FF-FN2 PIC X(3).
02 FILLER PIC X(3); VALUE "FMT".
01 FD-NAME.
02 FILLER PIC X(3); VALUE "DMP".
02 FD-FN PIC X(3).
02 FILLER PIC X(3); VALUE "LPT".
01 LINE-OUT.
02 FILLER PIC X(3); VALUE SPACES.
02 LO-2 PIC ZZ9.
02 FILLER PIC XX; VALUE "..".
02 LO-4 PIC X(20).
02 FILLER PIC XX; VALUE SPACES.
02 LO-6 PIC ZZ9.
02 FILLER PIC X(9); VALUE SPACES.
02 LO-8 PIC 9.
01 HEADER-1 PIC X(43); VALUE "FIELD FIELD FLD DECIMAL".
01 HEADER-2 PIC X(43); VALUE "NUMBER NAME SIZE PLACES".
PROCEDURE DIVISION.
OPENING SECTION.
OPENERS.
ENTER MACRO NAMDAT.
MOVE ZERO TO F1, F2.
DISPLAY "TYPE NAME OF FORMAT FILE: "; WITH NO ADVANCING.
ACCEPT FORMAT-FN.
IF FF-FN1 NOT = "DBM" DISPLAY "ILLEGAL FORMAT FILE NAME"
,GO TO OPENERS.
MOVE FF-FN2 TO FD-FN.
OPEN INPUT FORMAT-FILE, OUTPUT FILE-OUT.
READ FORMAT-FILE; AT END STOP RUN.
IF SPC = "(" MOVE 0 TO REC-TYPE, ENTER MACRO UNSSCR USING REC-TYPE, FORMAT-RECORD.
GET-RPT-NAME.
DISPLAY " ".
DISPLAY "REPORT NAME OR <CR> IF NOT A REPORT DUMP: "; WITH NO ADVANCING.
ACCEPT RPT-N-001.
IF RPT-N-001 = SPACES OPEN INPUT INPUT-FILE, GO TO NO-RPT.
IF RN-001 NOT = "RPT" DISPLAY "ILLEGAL REPORT NAME", GO TO GET-RPT-NAME.
OPEN INPUT RPTDAT-FILE.
MOVE ZERO TO TTY-IND, SUP-IND1, IV-IND.
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.
MOVE ZERO TO I, F1, F2.
MOVE HEADER-1 TO RO1.
MOVE RPT-N-001 TO OR-R-NAME.
MOVE OOR TO RO2.
PERFORM WRITE-REC-1.
MOVE HEADER-2 TO RO1.
MOVE SPACES TO RO2.
PERFORM WRITE-REC-1.
MOVE FORMAT-FN TO GF-FN.
MOVE GEN-FROM TO RO2.
PERFORM WRITE-REC-1.
MOVE 1 TO TP-IND.
PERFORM B.
MOVE DR-AUTHOR TO WT-AUTHOR.
MOVE WT-BY TO RO2.
PERFORM B.
MOVE SPACES TO RO2, PERFORM B.
MOVE FORM-001 TO RO2, PERFORM B.
MOVE FORM-002 TO RO2, PERFORM B.
MOVE FORM-003 TO RO2, PERFORM B.
PERFORM DMP-REC-2 THRU DMP-R2-EXIT VARYING E FROM 1 BY 1 UNTIL E > 40.
PERFORM B.
MOVE DR-OVERLAY TO F005-Y-N.
MOVE FORM-005 TO RO2.
PERFORM B 2 TIMES.
MOVE RN-002 TO F006-FN.
MOVE FORM-006 TO RO2.
PERFORM B 2 TIMES.
MOVE "TITLE:" TO RO2.
PERFORM B 2 TIMES.
MOVE DR-RPT-TITLE TO RO2.
PERFORM B 2 TIMES.
MOVE "SUPPRESS:" TO RO2.
PERFORM B.
PERFORM SUP-DUMP THRU SD001 VARYING E FROM 1 BY 1 UNTIL E > 10.
PERFORM B.
MOVE DR-SORTING-SEQUENCE TO F012-SS.
MOVE FORM-012 TO RO2.
PERFORM B 2 TIMES.
MOVE DR-DOUBLE-SPACE TO F013-YN.
MOVE FORM-013 TO RO2.
PERFORM B 2 TIMES.
MOVE DR-NEWPAGE-BREAK TO F014-YN.
MOVE FORM-014 TO RO2.
PERFORM B 2 TIMES.
MOVE 2 TO F015-NUM.
IF DR-NOLINES-BREAK NOT = "0" MOVE DR-NOLINES-BREAK TO F015-NUM.
MOVE FORM-015 TO RO2.
PERFORM B 2 TIMES.
SET F3 TO 1.
PERFORM DMPFMT THRU DMPFMT-EXIT UNTIL F2 = 999.
MOVE SPACES TO REC-OUT.
WRITE REC-OUT BEFORE ADVANCING 2 LINES.
WRITE REC-OUT FROM DR-HEADER-1.
WRITE REC-OUT FROM DR-HEADER-2.
GO TO JOB-DONE.
NO-RPT.
MOVE HEADER-1 TO RO1.
PERFORM READ-IT THRU R-EXIT.
PERFORM WRITE-IT.
MOVE HEADER-2 TO RO1.
PERFORM READ-IT THRU R-EXIT.
PERFORM WRITE-IT.
MOVE SPACES TO RO1.
PERFORM READ-IT THRU R-EXIT.
PERFORM WRITE-IT.
MOVE 1 TO TP-IND.
PERFORM WRITE-FD VARYING I FROM 1 BY 1 UNTIL LENGTH-OF-FIELD(I) = ZEROES.
MOVE SPACES TO RO1.
PERFORM READ-IT THRU R-EXIT.
PERFORM WRITE-IT.
PERFORM READ-IT THRU R-EXIT.
PERFORM WRITE-IT.
PERFORM READ-IT THRU R-EXIT.
PERFORM WRITE-IT.
MOVE NUM-PAGES TO TNP-NUM.
MOVE TNP TO RO1.
PERFORM READ-IT THRU R-EXIT.
PERFORM WRITE-IT.
MOVE SPACES TO RO1.
PERFORM READ-IT THRU R-EXIT.
PERFORM WRITE-IT.
SET I TO ZERO.
LOOP.
SET I UP BY 1.
IF I > NUM-PAGES GO TO CONT.
IF TOP-LINE(I) = ZERO GO TO CONT.
MOVE I TO TL-NUM1.
MOVE TOP-LINE(I) TO TL-NUM2.
MOVE TL TO RO1.
PERFORM READ-IT THRU R-EXIT.
PERFORM WRITE-IT.
GO TO LOOP.
CONT.
MOVE SPACES TO RO1.
PERFORM A 3 TIMES.
MOVE "KEY FIELD IS" TO DB-1.
MOVE POS-KEY TO NUM-HOLD.
MOVE NUM-HOLD TO DB-2.
MOVE PROMPT-TABLE(POS-KEY) TO DB-3.
MOVE DB-INFO TO RO1.
PERFORM A.
MOVE SPACES TO RO1, DB-3.
PERFORM A.
MOVE "VERSION NUMBER" TO DB-1.
MOVE VERSION-NUMBER TO NUM-HOLD.
MOVE NUM-HOLD TO DB-2.
MOVE DB-INFO TO RO1.
PERFORM A.
MOVE SPACES TO RO1.
PERFORM A.
MOVE "OVERLAY PAGE NUMBER" TO DB-1.
MOVE OVER-LAY-PAGE TO NUM-HOLD.
MOVE NUM-HOLD TO DB-2.
MOVE DB-INFO TO RO1.
PERFORM A.
MOVE SPACES TO RO1.
PERFORM A.
MOVE "I S A M R E S P O N S E S" TO RO1.
PERFORM A.
MOVE "- - - - - - - - - - - - -" TO RO1.
PERFORM A.
MOVE SPACES TO RO1.
PERFORM A.
MOVE "MAXIMUM RECORD SIZE" TO DBI-1.
MOVE NUM-CHARS TO NUM-KEEPER.
MOVE NUM-KEEPER TO DBI-2.
MOVE DB-ISAM-INFO TO RO1.
PERFORM A.
MOVE SPACES TO RO1.
PERFORM A.
MOVE "KEY DESCRIPTOR" TO DBI-1.
MOVE ZERO TO TOT-CHRS, TP-IND.
PERFORM TOTAL-UP VARYING I FROM 1 BY 1 UNTIL I = POS-KEY.
SET TOT-CHRS UP BY 1.
MOVE TOT-CHRS TO KD-NUM-1.
MOVE LENGTH-OF-FIELD(POS-KEY) TO KD-NUM-2.
MOVE SPACES TO KD-ARRAY2.
PERFORM KD-SETUP THRU KD-EXIT VARYING I FROM 1 BY 1 UNTIL I > 9.
MOVE KD-ARRAY2 TO DBI-2.
MOVE DB-ISAM-INFO TO RO1.
PERFORM A.
MOVE SPACES TO RO1.
PERFORM A.
MOVE "TOTAL RECORDS PER DATA BLOCK" TO DBI-1.
MOVE BLOCKING-FACTOR TO NUM-HOLD.
MOVE NUM-HOLD TO DBI-2.
MOVE DB-ISAM-INFO TO RO1.
PERFORM A.
MOVE SPACES TO RO1.
PERFORM A.
MOVE "TOTAL ENTRIES PER INDEX BLOCK" TO DBI-1.
MOVE IND-BLOCK-FACT TO NUM-HOLD.
MOVE NUM-HOLD TO DBI-2.
MOVE DB-ISAM-INFO TO RO1.
PERFORM A.
MOVE SPACES TO RO1.
PERFORM READ-IT THRU R-EXIT.
PERFORM WRITE-IT.
SET F1 TO 1.
PERFORM READ-IT THRU R-EXIT.
JOB-DONE.
MOVE SPACES TO REC-OUT.
WRITE REC-OUT BEFORE ADVANCING 2 LINES.
MOVE "[END]" TO REC-OUT.
WRITE REC-OUT.
CLOSE FORMAT-FILE, FILE-OUT.
STOP RUN.
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.
DMPFMT.
IF F2 > 0, GO TO DMPFMT-DONE.
IF F1 = 0 GO TO DF-CONT-001.
PERFORM GET-PAGE-BREAK THRU GPB-EXIT.
GO TO DMPFMT-EXIT.
DF-CONT-001.
SET I UP BY 1.
IF I > NUMBER-FIELDS, SET F2 TO 1, MOVE ZERO TO TP-IND, GO TO DMPFMT-EXIT.
IF I NOT = TOP-LINE(TP-IND) GO TO DF-CONT-002.
SET F1 TO 1.
PERFORM GET-PAGE-BREAK THRU GPB-EXIT.
SET I DOWN BY 1.
GO TO DMPFMT-EXIT.
DF-CONT-002.
MOVE I TO LO-2.
MOVE PROMPT-TABLE(I) TO LO-4.
MOVE LENGTH-OF-FIELD(I) TO LO-6.
MOVE DECIMAL-POSIT(I) TO LO-8.
MOVE LINE-OUT TO RO1.
GO TO DMPFMT-EXIT.
DMPFMT-DONE.
IF F2 < 4, PERFORM JAKUP, GO TO DMPFMT-EXIT.
IF F2 = 4, MOVE NUM-PAGES TO F016-NUM, MOVE FORM-016 TO RO1
,SET F2 UP BY 1, GO TO DMPFMT-EXIT.
IF F2 = 5, PERFORM JAKUP, GO TO DMPFMT-EXIT.
IF F2 = 6 PERFORM TL-SETUP THRU TL-EXIT.
IF F2 = 7 PERFORM JAKUP, GO TO DMPFMT-EXIT.
IF F2 = 8 PERFORM JAKUP, GO TO DMPFMT-EXIT.
IF F2 = 9 PERFORM JAKUP, GO TO DMPFMT-EXIT.
IF F2 = 10 MOVE "KEY FIELD IS" TO F018-PROMPT, MOVE POS-KEY TO F018-NUM
,MOVE PROMPT-TABLE(POS-KEY) TO F018-PROMPT1, SET F2 UP BY 1
,MOVE FORM-018 TO RO1, GO TO DMPFMT-EXIT.
IF F2 = 11 PERFORM JAKUP, GO TO DMPFMT-EXIT.
IF F2 = 12 MOVE "VERSION NUMBER" TO F018-PROMPT, MOVE VERSION-NUMBER
TO F018-NUM, MOVE SPACES TO F018-PROMPT1, SET F2 UP BY 1
,MOVE FORM-018 TO RO1, GO TO DMPFMT-EXIT.
IF F2 = 13 PERFORM JAKUP, GO TO DMPFMT-EXIT.
IF F2 = 14 MOVE "OVERLAY PAGE NUMBER" TO F018-PROMPT, MOVE OVER-LAY-PAGE TO F018-NUM
,MOVE FORM-018 TO RO1, SET F2 UP BY 1, GO TO DMPFMT-EXIT.
IF F2 = 15 PERFORM JAKUP, GO TO DMPFMT-EXIT.
IF F2 = 16 MOVE "I S A M R E S P O N S E S" TO RO1, SET F2 UP BY 1
,GO TO DMPFMT-EXIT.
IF F2 = 17 MOVE "- - - - - - - - - - - - -" TO RO1, SET F2 UP BY 1
,GO TO DMPFMT-EXIT.
IF F2 = 18 PERFORM JAKUP, GO TO DMPFMT-EXIT.
IF F2 = 19 MOVE "MAXIMUM RECORD SIZE" TO F019-PROMPT, MOVE NUM-CHARS
TO F019-NUM, MOVE FORM-019 TO RO1, SET F2 UP BY 1, GO TO DMPFMT-EXIT.
IF F2 = 20 PERFORM JAKUP, GO TO DMPFMT-EXIT.
IF F2 NOT = 21 GO TO DF-CONT-003.
MOVE "KEY DESCRIPTOR" TO F019-PROMPT.
MOVE ZERO TO TOT-CHRS, TP-IND.
PERFORM TOTAL-UP VARYING I FROM 1 BY 1 UNTIL I = POS-KEY.
SET TOT-CHRS UP BY 1.
MOVE TOT-CHRS TO KD-NUM-1.
MOVE LENGTH-OF-FIELD(POS-KEY) TO KD-NUM-2.
MOVE SPACES TO KD-ARRAY2.
PERFORM KD-SETUP THRU KD-EXIT VARYING I FROM 1 BY 1 UNTIL I > 9.
MOVE KD-ARRAY2 TO F019-NUM.
MOVE FORM-019 TO RO1.
SET F2 UP BY 1.
GO TO DMPFMT-EXIT.
DF-CONT-003.
IF F2 = 22 PERFORM JAKUP, GO TO DMPFMT-EXIT.
IF F2 = 23 MOVE "TOTAL RECORDS PER DATA BLOCK" TO F019-PROMPT
,MOVE BLOCKING-FACTOR TO F019-NUM, MOVE FORM-019 TO RO1
,SET F2 UP BY 1, GO TO DMPFMT-EXIT.
IF F2 = 24 PERFORM JAKUP, GO TO DMPFMT-EXIT.
IF F2 = 25 MOVE "TOTAL ENTRIES PER INDEX BLOCK" TO F019-PROMPT
,MOVE IND-BLOCK-FACT TO F019-NUM, MOVE FORM-019 TO RO1
,MOVE 999 TO F2 , GO TO DMPFMT-EXIT.
DMPFMT-EXIT.
IF F3 = 1 PERFORM WRITE-REC-1.
GET-PAGE-BREAK.
IF F1 = 1 MOVE SPACES TO RO1, SET F1 TO 2, GO TO GPB-EXIT.
IF F1 NOT = 2 GO TO GPB-CONT-001.
MOVE TP-IND TO TP-NUM.
MOVE TP-DELIM TO RO1.
SET F1 TO 3.
GO TO GPB-EXIT.
GPB-CONT-001.
IF F1 = 3, MOVE TPD1 TO RO1, SET F1 TO 4, GO TO GPB-EXIT.
IF F1 = 4, SET TP-IND UP BY 1, MOVE SPACES TO RO1, SET F1 TO 0.
GPB-EXIT. EXIT.
WRITE-REC-1.
WRITE REC-OUT.
MOVE SPACES TO REC-OUT.
WRITE-FD.
IF I = TOP-LINE(TP-IND) PERFORM PAGE-IT.
MOVE I TO LO-2.
MOVE PROMPT-TABLE(I) TO LO-4.
MOVE LENGTH-OF-FIELD(I) TO LO-6.
MOVE DECIMAL-POSIT(I) TO LO-8.
MOVE LINE-OUT TO RO1.
PERFORM READ-IT THRU R-EXIT.
PERFORM WRITE-IT.
WRITE-IT.
WRITE REC-OUT.
READ-IT.
MOVE SPACES TO RO2.
IF F2 = 1, GO TO R-EXIT.
READ INPUT-FILE; AT END SET F2 TO 1, GO TO R-EXIT.
MOVE INPUT-REC TO RO2.
IF F1 = ZERO GO TO R-EXIT.
MOVE SPACES TO RO1.
PERFORM WRITE-IT.
GO TO READ-IT.
R-EXIT. EXIT.
PAGE-IT.
MOVE SPACES TO RO1.
PERFORM A.
MOVE TP-IND TO TP-NUM.
MOVE TP-DELIM TO RO1.
PERFORM A.
MOVE TPD1 TO RO1.
PERFORM A.
MOVE SPACES TO RO1.
PERFORM A.
SET TP-IND UP BY 1.
A.
PERFORM READ-IT THRU R-EXIT.
PERFORM WRITE-IT.
TOTAL-UP.
COMPUTE TOT-CHRS = TOT-CHRS + LENGTH-OF-FIELD(I).
KD-SETUP.
IF KD1(I) = SPACE GO TO KD-EXIT.
SET TP-IND UP BY 1.
MOVE KD1(I) TO KD2(TP-IND).
KD-EXIT. EXIT.
JAKUP.
SET F2 UP BY 1.
MOVE SPACES TO RO1.
TL-SETUP.
SET TP-IND UP BY 1.
IF TP-IND > NUM-PAGES SET F2 TO 7, GO TO TL-EXIT.
IF TP-IND > 50 SET F2 TO 7, GO TO TL-EXIT.
IF TOP-LINE(TP-IND) = 0 SET F2 TO 7, GO TO TL-EXIT.
MOVE TP-IND TO F017-NUM.
MOVE TOP-LINE(TP-IND) TO F017-NUM1.
MOVE FORM-017 TO RO1.
TL-EXIT. EXIT.
B.
IF F2 NOT = 999 PERFORM DMPFMT THRU DMPFMT-EXIT.
PERFORM WRITE-REC-1.
DMP-REC-2.
MOVE "---" TO F004-INFLD, F004-OFS, F004-TOC, F004-BD1, F004-BD2
,F004-BD3, F004-BD4, F004-BD5.
MOVE "-" TO F004-AN, F004-TOT.
MOVE E TO NUM-HOLD.
MOVE NUM-HOLD TO F004-NUM.
IF DR-IN-FLD(E) = 0 GO TO DMP-R2-EXIT.
MOVE DR-IN-FLD(E) TO NUM-HOLD.
MOVE NUM-HOLD TO F004-INFLD.
MOVE DR-A-OR-N(E) TO F004-AN.
IF DR-TOT(E) = "Y" MOVE "Y" TO F004-TOT.
MOVE DR-TOT-SIZE(E) TO NUM-HOLD.
MOVE NUM-HOLD TO F004-OFS.
ADD DR-TOT-SIZE(E) TO F004-ACCUM.
SET F004-ACCUM UP BY 1.
IF DR-A-OR-N(E) NOT = "N" GO TO DR2-BREAK.
IF DR-FLD-ARRAY(E,1) NOT = 0 GO TO DR2-BREAK.
SET DR-TOT-SIZE(E) DOWN BY 1.
MOVE DR-TOT-SIZE(E) TO NUM-HOLD.
MOVE NUM-HOLD TO F004-OFS.
IF DR-DECIMAL-PLACES(E) NOT = 0 SET F004-ACCUM UP BY 1.
DR2-BREAK.
MOVE F004-ACCUM TO NUM-HOLD.
MOVE NUM-HOLD TO F004-TOC.
PERFORM DMP-R2BD THRU DMP-R2BD-EXIT VARYING TTY-IND FROM 1 BY 1
,UNTIL TTY-IND > 5.
DMP-R2-EXIT.
MOVE FORM-004 TO RO2.
PERFORM B.
DMP-R2BD.
IF DR-FLD-ARRAY(E,TTY-IND) = 0 GO TO DMP-R2BD-EXIT.
MOVE DR-FLD-ARRAY(E,TTY-IND) TO NUM-HOLD.
IF TTY-IND = 1 MOVE NUM-HOLD TO F004-BD1.
IF TTY-IND = 2 MOVE NUM-HOLD TO F004-BD2.
IF TTY-IND = 3 MOVE NUM-HOLD TO F004-BD3.
IF TTY-IND = 4 MOVE NUM-HOLD TO F004-BD4.
IF TTY-IND = 5 MOVE NUM-HOLD TO F004-BD5.
DMP-R2BD-EXIT. EXIT.
SUP-DUMP.
PERFORM B.
MOVE FORM-008 TO RO2.
PERFORM B.
MOVE FORM-009 TO RO2.
PERFORM B.
MOVE E TO F010-NUM.
MOVE "-------" TO F010-SYM.
MOVE "---" TO F010-SIGN.
MOVE "--------------------------------" TO F010-LIT.
MOVE "01" TO F010-NUM1.
IF DR-SA-SYMBOL(E) = SPACES GO TO SD001.
MOVE DR-SA-SYMBOL(E) TO F010-SYM.
MOVE DR-SA-SIGN(E) TO F010-SIGN.
MOVE DR-SA-LITERAL(E,1) TO F010-LIT.
SD001.
MOVE FORM-010 TO RO2.
PERFORM B.
PERFORM DMP-SA-LIT VARYING SUP-IND1 FROM 2 BY 1 UNTIL SUP-IND1 > 10.
DMP-SA-LIT.
MOVE SUP-IND1 TO F011-NUM.
MOVE "--------------------------------" TO F011-LIT.
IF DR-SA-LITERAL(E,SUP-IND1) NOT = SPACES
,MOVE DR-SA-LITERAL(E, SUP-IND1) TO F011-LIT.
MOVE FORM-011 TO RO2.
PERFORM B.