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 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 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.