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.