Trailing-Edge
-
PDP-10 Archives
-
decuslib20-07
-
decus/20-0168/cssdbw.cbl
There is 1 other file named cssdbw.cbl in the archive. Click here to see a list.
IDENTIFICATION DIVISION.
PROGRAM-ID. CSSDBW, VERSION-5, EDIT-12.
AUTHOR. BOB CONLON.
DATE-WRITTEN. 10-AUG-74, MODIFIED 05-FEB-81.
DATE-COMPILED.
REMARKS. THIS PROGRAM IS THE ADMINISTRATIVE ROUTINE
NECESSARY TO USE THE CORRESPONDING DATA
BASE MANAGEMENT SYSTEM. IT WILL OUTPUT
TWO FILES: A FORMAT FILE, AND A SOURCE.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. DECSYSTEM-10.
OBJECT-COMPUTER. DECSYSTEM-10.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT SOURCE-FILE ASSIGN TO DSK.
SELECT FORMAT-FILE ASSIGN TO DSK.
DATA DIVISION.
FILE SECTION.
FD SOURCE-FILE; VALUE OF IDENTIFICATION IS SOURCE-NAME.
01 SOURCE-RECORD; DISPLAY-7 PIC X(60).
FD FORMAT-FILE; VALUE OF IDENTIFICATION IS FORMAT-NAME.
01 FORMAT-REC; DISPLAY-6 PIC X(4035).
WORKING-STORAGE SECTION.
77 REC-TYPE PIC S9(3); COMP.
77 LINE-COUNT PIC S9(3); COMP.
77 SPC-HOLD PIC X.
77 FMT-HOLD PIC X(4035).
77 DT PIC 9(6).
77 TERM-TYPE PIC X(5).
77 SAVE-01 PIC X(20).
77 POS-IND PIC S99; COMP.
77 EXTRA-IND PIC S9(3); COMP.
77 NEW-IND PIC S9(3); COMP.
77 PROMPT-IND PIC S9(3); COMP.
77 A PIC X(60); VALUE "IDENTIFICATION DIVISION.".
77 D PIC X(60); VALUE "DATE-COMPILED. ".
77 E PIC X(60); VALUE "ENVIRONMENT DIVISION.".
77 F PIC X(60); VALUE "INPUT-OUTPUT SECTION.".
77 G PIC X(60); VALUE "FILE-CONTROL.".
77 H PIC X(60); VALUE " SELECT FILE-IN ASSIGN TO DSK".
77 I PIC X(60); VALUE " ACCESS MODE IS INDEXED".
77 J PIC X(60); VALUE " SYMBOLIC KEY IS SYM-KEY".
77 K PIC X(60); VALUE " RECORD KEY IS REC-KEY".
77 KA PIC X(60); VALUE " FILE STATUS IS FILSTAT, ERRNUM, ACTCODE.".
77 K1 PIC X(60); VALUE " SELECT VLD-FILE ASSIGN TO DSK.".
77 L PIC X(60); VALUE " SELECT FORMAT-FILE ASSIGN TO DSK.".
77 M PIC X(60); VALUE "DATA DIVISION.".
77 N PIC X(60); VALUE "FILE SECTION.".
77 O PIC X(60); VALUE "FD FORMAT-FILE COPY FDFMT.".
77 O1 PIC X(60); VALUE "FD VLD-FILE; VALUE OF IDENTIFICATION IS VLD-NAME.".
77 O2 PIC X(60); VALUE "01 VLD-RECORD; DISPLAY-6.".
77 P PIC X(60); VALUE "WORKING-STORAGE SECTION.".
77 P1 PIC X(60); VALUE "01 P-TODAY COPY WSTODAY.".
77 Q PIC X(60); VALUE "01 PROMPT-INFO COPY WSLEDFMT.".
77 R PIC X(60); VALUE "01 REC-IN1.".
77 S PIC X(60); VALUE "01 REC-CHECK.".
77 T PIC X(60); VALUE "PROCEDURE DIVISION.".
77 U PIC X(60); VALUE "OPENING SECTION.".
77 V PIC X(60); VALUE "OPENERS. COPY PROPENERS.".
77 IN-NAME1 PIC X(12); VALUE "01 IN-NAME.".
77 VERS-IND PIC S9(3); COMP.
77 USER-PASSWORD PIC X(6).
77 KD PIC S9(4); COMP.
77 DASH-COUNT PIC S9(3); COMP.
77 OP-FIR-NO PIC S9(3); COMP.
77 OP-LAS-NO PIC S9(3); COMP.
77 OP-NO PIC S9(3); COMP.
77 TOT-OP PIC S99; COMP.
77 OP-SUM PIC S9(4); COMP.
77 TP-IND PIC S9(3); COMP.
77 TOTAL-CHAR PIC S9(4); COMP.
77 FI PIC X(11); VALUE "FD FILE-IN".
77 AUD-SEL PIC X(60); VALUE " SELECT AUD-FILE ASSIGN TO DSK".
77 AUD-SEL1 PIC X(60); VALUE " SYMBOLIC KEY IS AUD-SKEY".
77 AUD-SEL2 PIC X(60); VALUE " RECORD KEY IS AUD-DATE".
77 AUDFD PIC X(60); VALUE "FD AUD-FILE COPY FDAUD.".
77 BUFFER-SIZE PIC 99; VALUE 8.
77 RECORD-SIZE PIC 9(4); COMP.
77 UPD-FLAG PIC 9; VALUE ZERO.
77 NA-HOLD PIC X(168).
77 PRI-HOLD PIC X(84).
01 BLOCKING-ADDRESSES.
02 TEMP-HOLD PIC S9(3)V99; COMP.
02 RECORD-WORDS PIC 9(3); COMP.
02 PHYSICAL-BLOCKS PIC 9(3)V99; COMP.
02 RECORDS-PER-BLOCK PIC 9(3)V99; COMP.
02 TEMP-HOLD1 PIC 9(3); COMP.
02 PER-WASTE-PHYS-BLOCK PIC V9(2); COMP.
02 WORDS-WASTED PIC 9(3); COMP.
02 EXTRA-RECORDS PIC 9(3); COMP.
01 O3.
02 FILLER PIC X(26); VALUE " 02 VLD-CHR OCCURS 4000".
02 FILLER PIC X(13); VALUE " TIMES PIC X.".
01 INPUT-BUFFER.
02 IB PIC X.
02 FILLER PIC X(19).
01 SOURCE-NAME.
02 S-NAME.
03 SN2 PIC X(3); VALUE "DBM".
03 SN1 PIC X(3).
02 FILLER PIC X(3); VALUE "CBL".
01 FORMAT-NAME.
02 FN1.
03 FN1A PIC X(3).
03 FILLER PIC X(3).
02 FN2 PIC X(3); VALUE "FMT".
01 VID.
02 FILLER PIC X(10); VALUE SPACES.
02 FILLER PIC X(35); VALUE "VALUE OF IDENTIFICATION IS IN-NAME.".
01 RECORD-CONTAINS.
02 FILLER PIC X(26); VALUE " RECORD CONTAINS ".
02 RC1 PIC 9(4).
02 FILLER PIC X(11); VALUE " CHARACTERS".
01 BLOCK-CONTAINS.
02 FILLER PIC X(25); VALUE " BLOCK CONTAINS ".
02 BC1 PIC 9(4).
02 FILLER PIC X(8); VALUE " RECORDS".
01 TERM-LINES.
02 FILLER PIC X(51); VALUE "77 TERM-LINES PIC S9(3); COMP VALUE ".
02 TER-NO PIC 9(3).
02 FILLER PIC X; VALUE ".".
01 KEY-DESCRIPTOR.
02 FILLER PIC X; VALUE "X".
02 KD-NUM1 PIC Z(4).
02 FILLER PIC X; VALUE ".".
02 KD-NUM2 PIC ZZZ.
01 C.
02 FILLER PIC X(8); VALUE "AUTHOR. ".
02 AUTH-NAME PIC X(32).
02 FILLER PIC X; VALUE ".".
01 GET-DATE.
02 FILLER PIC X(22); VALUE "77 GET-DATE".
02 FILLER PIC X(13); VALUE "PIC A; VALUE ".
02 FILLER PIC X; VALUE QUOTE.
02 GD PIC A.
02 FILLER PIC X; VALUE QUOTE.
02 FILLER PIC X; VALUE ".".
01 B.
02 FILLER PIC X(12); VALUE "PROGRAM-ID. ".
02 B1 PIC X(6).
02 FILLER PIC X(21); VALUE ", VERSION-5B, EDIT-1.".
01 IN-NAME2.
02 FILLER PIC X(4); VALUE SPACES.
02 FILLER PIC X(26); VALUE "02 IN-NAME1".
02 FILLER PIC X(16); VALUE "PIC X(6); VALUE ".
02 FILLER PIC X; VALUE QUOTE.
02 IN2A PIC X(6).
02 FILLER PIC X; VALUE QUOTE.
02 FILLER PIC X; VALUE ".".
01 IN-NAME3.
02 FILLER PIC X(4); VALUE SPACES.
02 FILLER PIC X(26); VALUE "02 FILLER".
02 FILLER PIC X(16); VALUE "PIC X(3); VALUE ".
02 FILLER PIC X; VALUE QUOTE.
02 FILLER PIC X(3); VALUE "IDX".
02 FILLER PIC X; VALUE QUOTE.
02 FILLER PIC X; VALUE ".".
01 REC-KEY1.
02 FILLER PIC X(14); VALUE " 02 REC-KEY".
02 FILLER PIC X(39); VALUE " PIC X(".
02 RK1 PIC 9(3).
02 FILLER PIC X(3); VALUE ").".
01 II.
02 II1 PIC X(30); VALUE "77 I PIC 9(".
02 FILLER PIC X(10); VALUE "3); VALUE ".
02 II2 PIC 9(2).
02 FILLER PIC X; VALUE ".".
01 RI.
02 FILLER PIC X(18); VALUE " 02 RI1 OCCURS ".
02 RI1 PIC 9(4).
02 FILLER PIC X(32); VALUE " TIMES PIC X.".
01 77-WS.
02 FILLER PIC X(4); VALUE "77 ".
02 77-FN PIC X(9).
02 FILLER PIC X(17); VALUE SPACES.
02 77-PIC PIC X(10).
01 FORMAT-HOLD.
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 NA.
03 NAMES OCCURS 28 TIMES PIC X(6).
02 VAL-ID PIC X.
02 AC-DAT PIC X.
02 SPC PIC X.
02 AUD-RESP PIC X.
02 FILLER PIC X(2).
02 IND-BLOCK-FACT PIC 9(3).
02 OVER-LAY-PAGE PIC 9(3).
02 BLOCKING-FACTOR PIC 9(3).
02 PRI.
03 PRIV OCCURS 28 TIMES PIC 9(3).
02 FILLER PIC X(3).
02 VERSION-NUMBER PIC 9(3).
02 NUM-CHARS PIC 9(4).
02 POS-KEY PIC 99.
02 NUM-PAGES PIC 9(3).
02 TOP-LINE OCCURS 50 TIMES PIC 9(3).
02 DECIMAL-POSIT OCCURS 150 TIMES PIC 9.
01 DW.
02 DW1 PIC X(15); VALUE "DATE-WRITTEN. ".
02 DW2 PIC 99.
02 FILLER PIC X; VALUE "-".
02 DW3 PIC X(3).
02 FILLER PIC X; VALUE "-".
02 DW4 PIC 99.
02 FILLER PIC X(35); VALUE ".".
01 MONTHS PIC X(36); VALUE "JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC".
01 MONTH-ARRAY REDEFINES MONTHS.
02 M-BUFF OCCURS 12 TIMES PIC X(3).
01 P-TODAY.
02 TOD.
03 YR PIC 99.
03 MO PIC 99.
03 DA PIC 99.
02 FILLER PIC X(6).
01 SK.
02 FILLER PIC X(30); VALUE "77 SYM-KEY PIC X(".
02 SK1 PIC 999.
02 FILLER PIC X(12); VALUE ").".
01 VALIDAT-CHK.
02 FILLER PIC X(37); VALUE "77 VALIDAT PIC X; VALUE ".
02 FILLER PIC X; VALUE QUOTE.
02 V-Y-N PIC A.
02 FILLER PIC X; VALUE QUOTE.
02 FILLER PIC X; VALUE ".".
01 VERS-TAG.
02 FILLER PIC X(8); VALUE "77 VERS".
02 FILLER PIC X(16); VALUE SPACES.
02 FILLER PIC X(16); VALUE "PIC 9(3); VALUE ".
02 VER-NUM PIC ZZ9.
02 FILLER PIC X; VALUE ".".
01 RCL1.
02 FILLER PIC X(36); VALUE " 02 REC-NUM PIC X(".
02 RCL1A PIC 999.
02 FILLER PIC X(21); VALUE ").".
01 RCL2.
02 FILLER PIC X(35); VALUE " 02 FILLER PIC X(".
02 RCL2A PIC 9(4).
02 FILLER PIC X(21); VALUE ").".
PROCEDURE DIVISION.
OPENING SECTION.
BEGINNER.
ENTER MACRO NAMDAT.
DISPLAY "CSS DATA BASE WRITER CSSDBW(V05-12)".
BEG-1.
DISPLAY " ".
DISPLAY "NEW OR OLD: "; WITH NO ADVANCING.
ACCEPT INPUT-BUFFER.
IF IB = "N" GO TO PW-OK-1.
IF IB = "O" GO TO BEG-LOOP.
GO TO BEG-1.
BEG-LOOP.
DISPLAY " ".
DISPLAY "CHANGE OR UPDATE: "; WITH NO ADVANCING.
ACCEPT IB.
IF IB = "U" SET UPD-FLAG TO 1, GO TO CHK-PW.
IF IB = "C" GO TO CHK-PW.
GO TO BEG-LOOP.
CHK-PW.
PERFORM BEG-OPEN-CLOSE.
MOVE PRI TO PRI-HOLD.
MOVE 7 TO PROMPT-IND.
ENTER MACRO NOECHO USING PROMPT-IND, CHK-AUD, PRI, USER-PASSWORD, SPC.
SET PROMPT-IND TO ZERO.
CP-LOOP.
SET PROMPT-IND UP BY 1.
IF PROMPT-IND > 28 DISPLAY "INVALID PASSWORD", STOP RUN.
IF NAMES(PROMPT-IND) NOT = USER-PASSWORD GO TO CP-LOOP.
CHK-AUD.
IF PRIV(PROMPT-IND) < 3
,DISPLAY "NO PRIVILEGES TO MODIFY THE DATA BASE FORMAT FILE"
,STOP RUN.
PW-OK-1.
MOVE PRI-HOLD TO PRI.
IF IB = "N" GO TO OPENERS.
MOVE SPC TO SPC-HOLD.
IF IB = "U" GO TO LOOP4.
BEG-CONT.
DISPLAY " ".
DISPLAY "IN THE FOLLOWING DIALOG ALL PROMPT INFORMATION".
DISPLAY "AND FIELD SIZES WILL BE DISPLAYED".
DISPLAY "TYPE <CR> IF OK AS IS".
DISPLAY " I TO INSERT A NEW FIELD NAME BEFORE THE CURRENTLY DISPLAYED FIELD".
DISPLAY " D TO DELETE THE CURRENTLY DISPLAYED FIELD".
DISPLAY " O TO OVERWRITE THE CURRENTLY DISPLAYED FIELD".
DISPLAY " F IF ALL REMAINING FIELDS ARE TO STAY THE SAME".
DISPLAY " OVERLAY TO MAKE ALL FOLLOWING OVERLAY PAGES IDENTICAL".
PERFORM SPACIT.
MOVE ZERO TO VERS-IND, PROMPT-IND.
LOOP.
SET PROMPT-IND UP BY 1.
IF PROMPT-IND > 150 GO TO BREAK1.
IF LENGTH-OF-FIELD(PROMPT-IND) = ZEROES GO TO BREAK1.
PERFORM SPACIT.
DISPLAY PROMPT-IND "..." PROMPT-TABLE(PROMPT-IND) " " LENGTH-OF-FIELD(PROMPT-IND)
" :"; WITH NO ADVANCING.
ACCEPT INPUT-BUFFER.
IF INPUT-BUFFER = "OVERLAY" PERFORM OP-SETUP, GO TO BREAK1.
IF INPUT-BUFFER = "F" GO TO BREAK1.
PERFORM CHANGIT THRU CHANGIT-EXIT.
GO TO LOOP.
BREAK1.
DISPLAY "DO YOU WANT TO SEE CURRENT NAMES + PRIVILEGES: "; WITH NO ADVANCING.
ACCEPT INPUT-BUFFER.
SET PROMPT-IND TO ZERO.
SEE-NAMES.
SET PROMPT-IND UP BY 1.
IF PROMPT-IND > 28 GO TO BEG-CONT1.
IF NAMES(PROMPT-IND) = "STOP " SET PROMPT-IND DOWN BY 1, GO TO BEG-CONT1.
IF IB = "Y" DISPLAY NAMES(PROMPT-IND) ":.." PRIV(PROMPT-IND).
GO TO SEE-NAMES.
BEG-CONT1.
DISPLAY "DO YOU WANT TO KEEP PRESENT CODES: "; WITH NO ADVANCING.
ACCEPT INPUT-BUFFER.
IF IB = "Y" GO TO L2.
IF IB = "N", SET PROMPT-IND TO ZERO, GO TO B1-LOOP.
GO TO BEG-CONT1.
B1-LOOP.
SET PROMPT-IND UP BY 1.
IF PROMPT-IND > 28 GO TO B1-CONT.
MOVE SPACES TO NAMES(PROMPT-IND).
MOVE ZEROES TO PRIV(PROMPT-IND).
GO TO B1-LOOP.
B1-CONT.
GO TO LOOP2.
CHANGIT.
IF INPUT-BUFFER = SPACES GO TO CHANGIT-EXIT.
SET VERS-IND TO 1.
IF INPUT-BUFFER = "D" MOVE PROMPT-IND TO NEW-IND
;PERFORM DEL-THIS THRU DEL-EXIT, GO TO CHANGIT-EXIT.
IF INPUT-BUFFER = "I" PERFORM NEW-FIELD THRU NF-EXIT
;GO TO CHANGIT-EXIT.
IF INPUT-BUFFER = "O" PERFORM NF-CONT THRU NF-EXIT.
CHANGIT-EXIT. EXIT.
DEL-THIS.
SET NEW-IND UP BY 1.
COMPUTE EXTRA-IND = NEW-IND - 1.
IF LENGTH-OF-FIELD(NEW-IND) = ZEROES GO TO DEL-EXIT.
IF NEW-IND > 150 GO TO DEL-EXIT.
MOVE SPACES TO SAVE-01.
MOVE PROMPT-TABLE(NEW-IND) TO SAVE-01.
MOVE SAVE-01 TO PROMPT-TABLE(EXTRA-IND).
MOVE LENGTH-OF-FIELD(NEW-IND) TO LENGTH-OF-FIELD(EXTRA-IND).
MOVE DECIMAL-POSIT(NEW-IND) TO DECIMAL-POSIT(EXTRA-IND).
GO TO DEL-THIS.
DEL-EXIT.
SET PROMPT-IND DOWN BY 1.
SET NEW-IND DOWN BY 1.
MOVE SPACES TO PROMPT-TABLE(NEW-IND).
MOVE ZEROES TO LENGTH-OF-FIELD(NEW-IND), DECIMAL-POSIT(NEW-IND).
NEW-FIELD.
MOVE PROMPT-IND TO EXTRA-IND.
PERFORM FIND-LAST VARYING EXTRA-IND FROM PROMPT-IND BY 1
;UNTIL LENGTH-OF-FIELD(EXTRA-IND) = ZEROES.
NF-LOOP.
IF EXTRA-IND > 150 GO TO NF-EXIT.
MOVE SPACES TO SAVE-01, PROMPT-TABLE(EXTRA-IND).
MOVE ZEROES TO LENGTH-OF-FIELD(EXTRA-IND), DECIMAL-POSIT(EXTRA-IND).
MOVE PROMPT-TABLE(NEW-IND) TO SAVE-01.
MOVE SAVE-01 TO PROMPT-TABLE(EXTRA-IND).
MOVE LENGTH-OF-FIELD(NEW-IND) TO LENGTH-OF-FIELD(EXTRA-IND).
MOVE DECIMAL-POSIT(NEW-IND) TO DECIMAL-POSIT(EXTRA-IND).
SUBTRACT 1 FROM EXTRA-IND.
SUBTRACT 1 FROM NEW-IND.
IF NEW-IND < PROMPT-IND GO TO NF-CONT.
GO TO NF-LOOP.
NF-CONT.
DISPLAY "FIELD NAME: "; WITH NO ADVANCING.
ACCEPT PROMPT-TABLE(PROMPT-IND).
NF-CONT-1.
DISPLAY "SIZE OF FIELD: "; WITH NO ADVANCING.
ACCEPT LENGTH-OF-FIELD(PROMPT-IND).
IF LENGTH-OF-FIELD(PROMPT-IND) < 33 GO TO NF-EXIT.
DISPLAY "MAXIMUM FIELD SIZE IS 32 CHARACTERS".
GO TO NF-CONT-1.
NF-EXIT.
DISPLAY "NUMBER OF DECIMAL PLACES FROM RIGHT: "; WITH NO ADVANCING.
ACCEPT DECIMAL-POSIT(PROMPT-IND).
FIND-LAST.
MOVE EXTRA-IND TO NEW-IND.
BEG-OPEN-CLOSE.
DISPLAY "TYPE NAME OF FORMAT FILE: "; WITH NO ADVANCING.
ACCEPT FN1.
IF FN1A NOT = "DBM" DISPLAY "INVALID FORMAT NAME", GO TO BEG-OPEN-CLOSE.
OPEN INPUT FORMAT-FILE.
READ FORMAT-FILE; AT END STOP RUN.
MOVE FORMAT-REC TO FORMAT-HOLD.
IF SPC = "(" MOVE 0 TO REC-TYPE, ENTER MACRO UNSSCR USING REC-TYPE, FORMAT-HOLD.
CLOSE FORMAT-FILE.
MOVE FN1 TO S-NAME.
OPEN OUTPUT SOURCE-FILE.
MOVE ZERO TO PROMPT-IND.
OPENERS.
DISPLAY "TYPE IN A 3 CHARACTER FILE CODE: "; WITH NO ADVANCING.
ACCEPT SN1.
IF SN1 = SPACES GO TO OP-ERR.
MOVE S-NAME TO FN1.
IF FN1A = "DBM" OPEN OUTPUT SOURCE-FILE, GO TO CHECK-SEQ.
OP-ERR.
DISPLAY "INVALID FILE NAME".
DISPLAY " ".
GO TO OPENERS.
CHECK-SEQ.
PERFORM SPACIT.
DISPLAY "DO YOU ALREADY HAVE A SEQUENTIAL FILE: "; WITH NO ADVANCING.
ACCEPT IB.
IF IB = "N" GO TO NOSEQ.
IF IB = "Y" GO TO NOSEQ-DONE.
DISPLAY "(Y OR N)".
GO TO CHECK-SEQ.
NOSEQ.
MOVE "SEQ" TO FN2.
OPEN OUTPUT FORMAT-FILE.
CLOSE FORMAT-FILE.
MOVE "FMT" TO FN2.
NOSEQ-DONE.
MOVE SPACES TO FORMAT-REC.
SET PROMPT-IND TO ZERO.
LOOP1.
SET PROMPT-IND UP BY 1.
IF PROMPT-IND > 150 GO TO LOOP2.
DISPLAY PROMPT-IND "...FIELD NAME: "; WITH NO ADVANCING.
ACCEPT PROMPT-TABLE(PROMPT-IND).
IF PROMPT-TABLE(PROMPT-IND) = SPACES DISPLAY "MUST HAVE A FIELD PROMPT"
,SET PROMPT-IND DOWN BY 1, GO TO LOOP1.
IF PROMPT-TABLE(PROMPT-IND) = "STOP" GO TO LOOP2.
IF PROMPT-TABLE(PROMPT-IND) = "OVERLAY" PERFORM OP-SETUP, GO TO LOOP2.
L1.
DISPLAY "....SIZE OF FIELD: "; WITH NO ADVANCING.
ACCEPT LENGTH-OF-FIELD(PROMPT-IND).
IF LENGTH-OF-FIELD(PROMPT-IND) < 1 DISPLAY "ZERO FIELD SIZE", GO TO L1.
IF LENGTH-OF-FIELD(PROMPT-IND) > 32
,DISPLAY "MAXIMUM FIELD SIZE IS 32 CHARACTERS", GO TO L1.
DISPLAY "....NUMBER OF DECIMAL PLACES FROM RIGHT: "; WITH NO ADVANCING.
ACCEPT DECIMAL-POSIT(PROMPT-IND).
PERFORM SPACIT.
GO TO LOOP1.
LOOP2.
SET PROMPT-IND TO ZERO.
L2.
SET PROMPT-IND UP BY 1.
IF PROMPT-IND > 28 GO TO LOOP3.
PERFORM SPACIT.
DISPLAY "USER'S NAME: "; WITH NO ADVANCING.
ACCEPT NAMES(PROMPT-IND).
IF NAMES(PROMPT-IND) = SPACES DISPLAY "INVALID", SET PROMPT-IND DOWN BY 1, GO TO L2.
IF NAMES(PROMPT-IND) = "STOP" GO TO LOOP3.
L2A.
DISPLAY "THIS USER'S PRIVILEGES: "; WITH NO ADVANCING.
ACCEPT PRIV(PROMPT-IND).
IF PRIV(PROMPT-IND) > 3 DISPLAY "INVALID CODE" GO TO L2A.
GO TO L2.
LOOP3.
SET PROMPT-IND TO ZERO.
DISPLAY "IN THE FOLLOWING DIALOG TYPE <CR> IF SETTING IS OK".
DISPLAY "OR A NEW NUMBER TO CHANGE IT.".
DISPLAY " ".
DISPLAY "NUMBER OF PAGES: " NUM-PAGES " : "; WITH NO ADVANCING.
ACCEPT EXTRA-IND.
IF EXTRA-IND > 50 DISPLAY "ONLY 50 PAGES ALLOWED", GO TO LOOP3.
IF EXTRA-IND NOT = 0 MOVE EXTRA-IND TO PROMPT-IND, GO TO CLR-TL.
IF NUM-PAGES NOT = 0 GO TO L3.
MOVE 1 TO NUM-PAGES, PROMPT-IND, EXTRA-IND.
CLR-TL.
SET PROMPT-IND UP BY 1.
IF PROMPT-IND > 50 GO TO CLR-TL-DONE.
MOVE ZERO TO TOP-LINE(PROMPT-IND).
GO TO CLR-TL.
CLR-TL-DONE.
MOVE EXTRA-IND TO NUM-PAGES.
SET PROMPT-IND TO ZERO.
L3.
SET PROMPT-IND UP BY 1.
IF PROMPT-IND > 50 GO TO LOOP4.
IF PROMPT-IND > NUM-PAGES GO TO LOOP4.
DISPLAY "TOP LINE OF PAGE " PROMPT-IND " : " TOP-LINE(PROMPT-IND) " : "; WITH NO ADVANCING.
ACCEPT EXTRA-IND.
IF EXTRA-IND NOT = ZERO, SET VERS-IND TO 1, MOVE EXTRA-IND TO TOP-LINE(PROMPT-IND).
IF TOP-LINE(PROMPT-IND) = 0 MOVE 1 TO TOP-LINE(PROMPT-IND).
GO TO L3.
LOOP4.
MOVE ZERO TO TOTAL-CHAR.
PERFORM TOTAL-UP VARYING PROMPT-IND FROM 1 BY 1 UNTIL LENGTH-OF-FIELD(PROMPT-IND) = ZEROES.
MOVE TOTAL-CHAR TO NUM-CHARS.
SET PROMPT-IND DOWN BY 1.
MOVE PROMPT-IND TO NUMBER-FIELDS.
L4A.
DISPLAY " ".
DISPLAY "DO YOU WANT ON-LINE VALIDATION ( Y OR N )[" VAL-ID "]: "; WITH NO ADVANCING.
ACCEPT V-Y-N.
IF V-Y-N = SPACE MOVE VAL-ID TO V-Y-N.
IF V-Y-N = "Y" GO TO L4A-CONT1.
IF V-Y-N = "N" GO TO L4A-CONT1.
DISPLAY "TYPE (Y OR N)".
GO TO L4A.
L4A-CONT1.
MOVE V-Y-N TO VAL-ID.
L4B.
DISPLAY " ".
DISPLAY "DO YOU WANT RECORD CREATION + ACCESS DATES"
DISPLAY "PLACED IN FIELDS 1 AND 2 RESPECTIVELY [" AC-DAT "]: "; WITH NO ADVANCING.
ACCEPT GD.
IF GD = SPACE MOVE AC-DAT TO GD.
IF GD = "Y" GO TO L4B-CONT1.
IF GD = "N" GO TO L4B-CONT1.
DISPLAY "TYPE (Y OR N)".
GO TO L4B.
L4B-CONT1.
MOVE GD TO AC-DAT.
L4A-CONT.
DISPLAY " ".
DISPLAY "DO YOU WANT AN AUDIT TRAIL ( Y OR N )[" AUD-RESP "]: "; WITH NO ADVANCING.
ACCEPT GD.
IF GD = SPACE MOVE AUD-RESP TO GD.
IF GD = "Y" GO TO L4A-CONT2.
IF GD = "N" GO TO L4A-CONT2.
DISPLAY "TYPE (Y OR N)".
GO TO L4A-CONT.
L4A-CONT2.
MOVE GD TO AUD-RESP.
L5.
DISPLAY " ".
DISPLAY "TYPE IN YOUR NAME: ";WITH NO ADVANCING.
ACCEPT AUTH-NAME.
IF AUTH-NAME = SPACES DISPLAY "MUST HAVE A NAME", GO TO L5.
DISPLAY " ".
DISPLAY "TERMINAL TYPE TO BE USED".
DISPLAY "(VT05, VT50, VT52, VT61, VT100, OTHER): "; WITH NO ADVANCING.
ACCEPT TERM-TYPE.
IF TERM-TYPE = "VT50" MOVE 11 TO TER-NO, GO TO TERM-DONE.
IF TERM-TYPE = "VT52" MOVE 23 TO TER-NO, GO TO TERM-DONE.
IF TERM-TYPE = "VT60" MOVE 23 TO TER-NO, GO TO TERM-DONE.
IF TERM-TYPE = "VT61" MOVE 23 TO TER-NO, GO TO TERM-DONE.
IF TERM-TYPE = "VT100" MOVE 23 TO TER-NO, GO TO TERM-DONE.
MOVE 19 TO TER-NO.
TERM-DONE.
MOVE NUM-CHARS TO RECORD-SIZE.
PERFORM GET-BF THRU HAVE-BF.
MOVE RECORDS-PER-BLOCK TO BLOCKING-FACTOR.
MOVE ZERO TO POS-IND.
IF POS-KEY = 0 MOVE 1 TO POS-KEY.
DISPLAY "KEY FIELD NUMBER IS: " POS-KEY " : "; WITH NO ADVANCING.
IF UPD-FLAG = 1 DISPLAY " ", GO TO UPD-TAG.
ACCEPT POS-IND.
UPD-TAG.
IF POS-IND NOT = ZERO MOVE POS-IND TO POS-KEY.
IF POS-KEY < TOP-LINE(1) DISPLAY "KEY LESS THAT FIRST LINE OF PAGE 1".
MOVE LENGTH-OF-FIELD(POS-KEY) TO RECORD-SIZE.
PERFORM GET-BF THRU HAVE-BF.
MOVE RECORDS-PER-BLOCK TO IND-BLOCK-FACT.
COMPUTE VERSION-NUMBER = VERSION-NUMBER + VERS-IND.
IF VERSION-NUMBER = ZERO SET VERSION-NUMBER TO 1.
MOVE VERSION-NUMBER TO VER-NUM.
OPEN OUTPUT FORMAT-FILE.
MOVE FORMAT-HOLD TO FORMAT-REC, FMT-HOLD.
IF SPC NOT = "Y" GO TO UPD-CONT.
MOVE 0 TO REC-TYPE.
ENTER MACRO SCRREC USING REC-TYPE, FORMAT-REC.
UPD-CONT.
WRITE FORMAT-REC.
CLOSE FORMAT-FILE.
IF AUD-RESP NOT = "Y" GO TO NO-AUD-1.
MOVE NA TO NA-HOLD.
MOVE PRI TO PRI-HOLD.
MOVE SPACES TO FORMAT-HOLD.
MOVE "DATE/TIME/LINE #" TO PROMPT-TABLE(1).
MOVE 15 TO LENGTH-OF-FIELD(1).
MOVE "TRANSACTION CODE" TO PROMPT-TABLE(2).
MOVE 1 TO LENGTH-OF-FIELD(2).
MOVE "PASSWORD USED" TO PROMPT-TABLE(3).
MOVE 6 TO LENGTH-OF-FIELD(3).
MOVE "RECORD KEY" TO PROMPT-TABLE(4).
MOVE 32 TO LENGTH-OF-FIELD(4).
MOVE "FIELD NUMBER" TO PROMPT-TABLE(5).
MOVE 3 TO LENGTH-OF-FIELD(5).
MOVE "FIELD NAME" TO PROMPT-TABLE(6).
MOVE 20 TO LENGTH-OF-FIELD(6).
MOVE "OLD DATA" TO PROMPT-TABLE(7).
MOVE 32 TO LENGTH-OF-FIELD(7).
MOVE "NEW DATA" TO PROMPT-TABLE(8).
MOVE 32 TO LENGTH-OF-FIELD(8).
MOVE 8 TO NUMBER-FIELDS.
MOVE NA-HOLD TO NA.
MOVE 64 TO IND-BLOCK-FACT.
MOVE 0 TO OVER-LAY-PAGE, VERSION-NUMBER.
MOVE 35 TO BLOCKING-FACTOR.
MOVE PRI-HOLD TO PRI.
MOVE 141 TO NUM-CHARS.
MOVE 1 TO POS-KEY.
MOVE 1 TO NUM-PAGES.
MOVE 1 TO TOP-LINE(1).
MOVE SPC-HOLD TO SPC.
MOVE "DBMAUD" TO FN1.
OPEN OUTPUT FORMAT-FILE.
MOVE FORMAT-HOLD TO FORMAT-REC.
IF SPC NOT = "Y" GO TO AUD-CONT.
MOVE 0 TO REC-TYPE.
ENTER MACRO SCRREC USING REC-TYPE, FORMAT-REC.
AUD-CONT.
WRITE FORMAT-REC.
CLOSE FORMAT-FILE.
MOVE FMT-HOLD TO FORMAT-HOLD.
MOVE S-NAME TO FN1.
NO-AUD-1.
MOVE A TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE S-NAME TO B1.
MOVE B TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE C TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE TODAY TO P-TODAY.
MOVE DA TO DW2.
MOVE M-BUFF(MO) TO DW3.
MOVE YR TO DW4.
MOVE DW TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE D TO SOURCE-RECORD.
WRITE SOURCE-RECORD BEFORE ADVANCING 3 LINES.
MOVE E TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE F TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE G TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE H TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE I TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE J TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
WRITE SOURCE-RECORD FROM K.
WRITE SOURCE-RECORD FROM KA BEFORE ADVANCING 2 LINES.
MOVE K1 TO SOURCE-RECORD.
WRITE SOURCE-RECORD BEFORE ADVANCING 2 LINES.
MOVE L TO SOURCE-RECORD.
WRITE SOURCE-RECORD BEFORE ADVANCING 3 LINES.
IF AUD-RESP NOT = "Y" GO TO NEXT-AUD1.
WRITE SOURCE-RECORD FROM AUD-SEL.
WRITE SOURCE-RECORD FROM I.
WRITE SOURCE-RECORD FROM AUD-SEL1.
WRITE SOURCE-RECORD FROM AUD-SEL2.
WRITE SOURCE-RECORD FROM KA BEFORE ADVANCING 3 LINES.
NEXT-AUD1.
MOVE M TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE N TO SOURCE-RECORD.
WRITE SOURCE-RECORD BEFORE ADVANCING 2 LINES.
MOVE FI TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE NUM-CHARS TO RC1.
MOVE RECORD-CONTAINS TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE BLOCKING-FACTOR TO BC1.
MOVE BLOCK-CONTAINS TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE VID TO SOURCE-RECORD.
WRITE SOURCE-RECORD BEFORE ADVANCING 3 LINES.
MOVE "01 REC-IN." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE ZERO TO TOTAL-CHAR.
PERFORM TOTAL-UP VARYING PROMPT-IND FROM 1 BY 1 UNTIL PROMPT-IND = POS-KEY.
COMPUTE KD = TOTAL-CHAR + 1.
MOVE KD TO KD-NUM1.
MOVE LENGTH-OF-FIELD(POS-KEY) TO KD-NUM2.
IF TOTAL-CHAR = ZERO GO TO LOOP4-CONT.
MOVE TOTAL-CHAR TO RCL2A.
MOVE RCL2 TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
LOOP4-CONT.
MOVE LENGTH-OF-FIELD(POS-KEY) TO RK1.
MOVE REC-KEY1 TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
SET PROMPT-IND UP BY 1.
MOVE ZERO TO TOTAL-CHAR.
IF LENGTH-OF-FIELD(PROMPT-IND) = ZERO GO TO LOOP4-BREAK.
PERFORM TOTAL-UP VARYING PROMPT-IND FROM PROMPT-IND BY 1
,UNTIL LENGTH-OF-FIELD(PROMPT-IND) = ZERO.
MOVE TOTAL-CHAR TO RCL2A.
MOVE RCL2 TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
LOOP4-BREAK.
MOVE SPACES TO SOURCE-RECORD.
WRITE SOURCE-RECORD BEFORE ADVANCING 2 LINES.
MOVE O TO SOURCE-RECORD.
WRITE SOURCE-RECORD BEFORE ADVANCING 2 LINES.
MOVE O1 TO SOURCE-RECORD.
WRITE SOURCE-RECORD BEFORE ADVANCING 2 LINES.
MOVE O2 TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE O3 TO SOURCE-RECORD.
WRITE SOURCE-RECORD BEFORE ADVANCING 3 LINES.
IF AUD-RESP = "Y" WRITE SOURCE-RECORD FROM AUDFD BEFORE ADVANCING 3 LINES.
MOVE P TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
WRITE SOURCE-RECORD FROM TERM-LINES.
LOOP4A.
MOVE POS-KEY TO II2.
MOVE II TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE LENGTH-OF-FIELD(II2) TO SK1.
MOVE SK TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE VAL-ID TO V-Y-N.
MOVE VALIDAT-CHK TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE VERS-TAG TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE AC-DAT TO GD.
WRITE SOURCE-RECORD FROM GET-DATE.
MOVE "FILSTAT" TO 77-FN.
MOVE "PIC 9(2)." TO 77-PIC.
WRITE SOURCE-RECORD FROM 77-WS.
MOVE "ERRNUM" TO 77-FN.
MOVE "PIC 9(10)." TO 77-PIC.
WRITE SOURCE-RECORD FROM 77-WS.
MOVE "ACTCODE" TO 77-FN.
MOVE "INDEX." TO 77-PIC.
WRITE SOURCE-RECORD FROM 77-WS.
IF AUD-RESP NOT = "Y" GO TO NEXT-AUD2.
MOVE "AUD-SKEY" TO 77-FN.
MOVE "PIC X(15)." TO 77-PIC.
WRITE SOURCE-RECORD FROM 77-WS.
MOVE "AUD-HOLD" TO 77-FN.
MOVE "PIC X(32)." TO 77-PIC.
WRITE SOURCE-RECORD FROM 77-WS.
NEXT-AUD2.
MOVE "GOOD-FLAG" TO 77-FN.
MOVE "PIC 9." TO 77-PIC.
WRITE SOURCE-RECORD FROM 77-WS BEFORE ADVANCING 3 LINES.
MOVE IN-NAME1 TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE S-NAME TO IN2A.
MOVE IN-NAME2 TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE IN-NAME3 TO SOURCE-RECORD.
WRITE SOURCE-RECORD BEFORE ADVANCING 2 LINES.
MOVE P1 TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE Q TO SOURCE-RECORD.
WRITE SOURCE-RECORD BEFORE ADVANCING 2 LINES.
MOVE R TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE NUM-CHARS TO RI1.
MOVE RI TO SOURCE-RECORD.
WRITE SOURCE-RECORD BEFORE ADVANCING 2 LINES.
MOVE S TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE SK1 TO RCL1A.
COMPUTE RCL2A = 34 - SK1.
MOVE RCL1 TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE RCL2 TO SOURCE-RECORD.
WRITE SOURCE-RECORD BEFORE ADVANCING 4 LINES.
MOVE T TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE "DECLARATIVES." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE "DEC-1 SECTION." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE " USE AFTER STANDARD ERROR PROCEDURE ON FILE-IN." TO SOURCE-RECORD.
IF AUD-RESP = "Y" MOVE " USE AFTER STANDARD ERROR PROCEDURE ON FILE-IN, AUD-FILE."
TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE "I-O-PARA. COPY PRDEC." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE U TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
MOVE V TO SOURCE-RECORD.
IF AUD-RESP = "Y" MOVE "OPENERS. COPY ALOPENERS." TO SOURCE-RECORD.
WRITE SOURCE-RECORD.
ALL-DONE.
DISPLAY "SOURCE IS CALLED : " SOURCE-NAME.
PERFORM SPACIT.
DISPLAY "FORMAT IS CALLED : " FORMAT-NAME.
PERFORM SPACIT.
DISPLAY "VERSION NUMBER : " VERSION-NUMBER.
PERFORM SPACIT.
DISPLAY "OVERLAY PAGE NO. : " OVER-LAY-PAGE.
PERFORM SPACIT.
DISPLAY "I S A M R E S P O N S E S".
DISPLAY "- - - - - - - - - - - - -".
PERFORM SPACIT.
DISPLAY "MAXIMUM RECORD SIZE: " NUM-CHARS.
PERFORM SPACIT.
DISPLAY "KEY DESCRIPTOR: " KEY-DESCRIPTOR.
PERFORM SPACIT.
DISPLAY "TOTAL RECORDS PER DATA BLOCK: " BLOCKING-FACTOR.
PERFORM SPACIT.
DISPLAY "TOTAL ENTRIES PER INDEX BLOCK: " IND-BLOCK-FACT.
STOP RUN.
OP-SETUP.
DISPLAY " ".
DISPLAY "TYPE IN FIRST LINE NUMBER OF FIRST OVERLAY PAGE: "; WITH NO ADVANCING.
ACCEPT OP-FIR-NO.
DISPLAY " ".
DISPLAY "TYPE IN LAST LINE NUMBER OF FIRST OVERLAY PAGE: "; WITH NO ADVANCING.
ACCEPT OP-LAS-NO.
DISPLAY " ".
DISPLAY "TYPE IN FIRST OVERLAY PAGE NUMBER: "; WITH NO ADVANCING.
ACCEPT OP-NO.
MOVE OP-NO TO OVER-LAY-PAGE.
DISPLAY " ".
DISPLAY "TYPE IN TOTAL NUMBER OF OVERLAY PAGES IN DATA BASE: "; WITH NO ADVANCING.
ACCEPT TOT-OP.
MOVE ZERO TO TOTAL-CHAR.
PERFORM TOTAL-UP VARYING PROMPT-IND FROM 1 BY 1
,UNTIL PROMPT-IND = OP-FIR-NO.
MOVE TOTAL-CHAR TO OP-SUM.
MOVE ZERO TO TOTAL-CHAR.
PERFORM TOTAL-UP VARYING PROMPT-IND FROM OP-FIR-NO BY 1
,UNTIL PROMPT-IND > OP-LAS-NO.
COMPUTE TOTAL-CHAR = TOTAL-CHAR * TOT-OP.
COMPUTE OP-SUM = OP-SUM + TOTAL-CHAR.
IF OP-SUM > 3834 DISPLAY "RECORD GREATER THAN 3834 CHARACTERS", STOP RUN.
COMPUTE OP-SUM = (OP-LAS-NO - OP-FIR-NO) + 1.
COMPUTE OP-SUM = OP-SUM * TOT-OP.
COMPUTE OP-SUM = (OP-SUM + OP-FIR-NO) - 1.
IF OP-SUM > 150 DISPLAY "MORE THAN 150 FIELDS", STOP RUN.
COMPUTE NUM-PAGES = (OP-NO + TOT-OP) - 1.
MOVE OP-NO TO TP-IND.
MOVE OP-FIR-NO TO PROMPT-IND.
COMPUTE EXTRA-IND = OP-LAS-NO + 1.
MOVE OP-FIR-NO TO TOP-LINE(TP-IND).
COMPUTE OP-SUM = (OP-LAS-NO - OP-FIR-NO) + 1.
SET TP-IND UP BY 1.
PERFORM TP-SETUP VARYING TP-IND FROM TP-IND BY 1
,UNTIL TP-IND > NUM-PAGES.
PERFORM CLR-PT VARYING EXTRA-IND FROM EXTRA-IND BY 1
,UNTIL EXTRA-IND > 150.
TP-SETUP.
MOVE EXTRA-IND TO TOP-LINE(TP-IND).
PERFORM MOVE-PAGES OP-SUM TIMES.
MOVE-PAGES.
MOVE PROMPT-TABLE(PROMPT-IND) TO PROMPT-TABLE(EXTRA-IND).
MOVE LENGTH-OF-FIELD(PROMPT-IND) TO LENGTH-OF-FIELD(EXTRA-IND).
MOVE DECIMAL-POSIT(PROMPT-IND) TO DECIMAL-POSIT(EXTRA-IND).
SET PROMPT-IND UP BY 1.
SET EXTRA-IND UP BY 1.
CLR-PT.
MOVE SPACES TO PROMPT-TABLE(EXTRA-IND).
MOVE ZEROES TO LENGTH-OF-FIELD(EXTRA-IND), DECIMAL-POSIT(EXTRA-IND).
SPACIT.
DISPLAY " ".
TOTAL-UP.
COMPUTE TOTAL-CHAR = TOTAL-CHAR + LENGTH-OF-FIELD(PROMPT-IND).
GET-BF.
MOVE LOW-VALUES TO BLOCKING-ADDRESSES.
COMPUTE TEMP-HOLD = (RECORD-SIZE / 6) + 1.
MOVE TEMP-HOLD TO RECORD-WORDS.
IF RECORD-WORDS NOT = TEMP-HOLD, SET RECORD-WORDS UP BY 1.
MOVE 128 TO RECORDS-PER-BLOCK.
MOVE RECORD-WORDS TO PHYSICAL-BLOCKS.
GB-LOOP.
COMPUTE PHYSICAL-BLOCKS = PHYSICAL-BLOCKS / 2.
COMPUTE RECORDS-PER-BLOCK = RECORDS-PER-BLOCK / 2.
IF PHYSICAL-BLOCKS < BUFFER-SIZE GO TO GB-BREAK.
GO TO GB-LOOP.
GB-BREAK.
MOVE PHYSICAL-BLOCKS TO TEMP-HOLD1.
IF PHYSICAL-BLOCKS = TEMP-HOLD1 GO TO HAVE-BF.
SET TEMP-HOLD1 UP BY 1.
COMPUTE PER-WASTE-PHYS-BLOCK = TEMP-HOLD1 - PHYSICAL-BLOCKS.
COMPUTE WORDS-WASTED = 128 * PER-WASTE-PHYS-BLOCK.
IF RECORD-WORDS > WORDS-WASTED GO TO HAVE-BF.
COMPUTE EXTRA-RECORDS = WORDS-WASTED / RECORD-WORDS.
COMPUTE RECORDS-PER-BLOCK = RECORDS-PER-BLOCK + EXTRA-RECORDS.
HAVE-BF. EXIT.