stcmntxx.cbl ctlmntxx.cbl
000100 IDENTIFICATION DIVISION. 000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. STCMNTXX. 000200 PROGRAM-ID. CTLMNTXX.
000300*------------------------------ 000300*----------------------------
000400* Add, Change, Inquire and 000400* Change and Inquire only
000500* Delete for the State Code. 000500* for the bills system control
000600* Calls the State Codes Report. 000600* file.
000700*------------------------------ 000700*----------------------------
000800 ENVIRONMENT DIVISION. 000800 ENVIRONMENT DIVISION.
000900 INPUT-OUTPUT SECTION. 000900 INPUT-OUTPUT SECTION.
001000 FILE-CONTROL. 001000 FILE-CONTROL.
001100 001100
001200 COPY "SLSTATE.CBL". 001200 COPY "SLCONTRL.CBL".
001300 001300
001400 DATA DIVISION. 001400 DATA DIVISION.
001500 FILE SECTION. 001500 FILE SECTION.
001600 001600
001700 COPY "FDSTATE.CBL". 001700 COPY "FDCONTRL.CBL".
001800 001800
001900 WORKING-STORAGE SECTION. 001900 WORKING-STORAGE SECTION.
002000 002000
002100 77 MENU-PICK PIC 9. 002100 77 MENU-PICK PIC 9.
002200 88 PICK-IS-VALID 002200 88 PICK-IS-VALID
002300 VALUES 0 THRU 5. 002300 VALUES 0 THRU 2.
002400 002400
002500 77 THE-MODE PIC X(7). 002500 77 THE-MODE PIC X(7).
002600 77 OK-TO-DELETE PIC X. 002600 77 RECORD-FOUND PIC X.
002700 77 RECORD-FOUND PIC X. 002700 77 WHICH-FIELD PIC 9.
002800 77 WHICH-FIELD PIC 9. 002800 77 A-DUMMY PIC X.
002900 002900
003000 COPY "WSCASE01.CBL".
003100
003200 PROCEDURE DIVISION. 003000 PROCEDURE DIVISION.
003300 PROGRAM-BEGIN. 003100 PROGRAM-BEGIN.
003400 PERFORM OPENING-PROCEDURE. 003200 PERFORM OPENING-PROCEDURE.
003500 PERFORM MAIN-PROCESS. 003300 PERFORM MAIN-PROCESS.
003600 PERFORM CLOSING-PROCEDURE. 003400 PERFORM CLOSING-PROCEDURE.
003700 003500
003800 PROGRAM-EXIT. 003600 PROGRAM-EXIT.
003900 EXIT PROGRAM. 003700 EXIT PROGRAM.
004000 003800
004100 PROGRAM-DONE. 003900 PROGRAM-DONE.
004200 STOP RUN. 004000 STOP RUN.
004300 004100
004400 OPENING-PROCEDURE. 004200 OPENING-PROCEDURE.
004500 OPEN I-O STATE-FILE. 004300 OPEN I-O CONTROL-FILE.
004600 004400
004700 CLOSING-PROCEDURE. 004500 CLOSING-PROCEDURE.
004800 CLOSE STATE-FILE. 004600 CLOSE CONTROL-FILE.
004900 004700
005000
005100 MAIN-PROCESS. 004800 MAIN-PROCESS.
005200 PERFORM GET-MENU-PICK. 004900 PERFORM GET-MENU-PICK.
005300 PERFORM MAINTAIN-THE-FILE 005000 PERFORM MAINTAIN-THE-FILE
005400 UNTIL MENU-PICK = 0. 005100 UNTIL MENU-PICK = 0.
005500 005200
005600*------------------------------ 005300*----------------------------
005700* MENU 005400* MENU
005800*------------------------------ 005500*----------------------------
005900 GET-MENU-PICK. 005600 GET-MENU-PICK.
006000 PERFORM DISPLAY-THE-MENU. 005700 PERFORM DISPLAY-THE-MENU.
006100 PERFORM ACCEPT-MENU-PICK. 005800 PERFORM ACCEPT-MENU-PICK.
006200 PERFORM RE-ACCEPT-MENU-PICK 005900 PERFORM RE-ACCEPT-MENU-PICK
006300 UNTIL PICK-IS-VALID. 006000 UNTIL PICK-IS-VALID.
006400 006100
006500 DISPLAY-THE-MENU. 006200 DISPLAY-THE-MENU.
006600 PERFORM CLEAR-SCREEN. 006300 PERFORM CLEAR-SCREEN.
006700 DISPLAY 006400 DISPLAY
006800 " PLEASE SELECT:". 006500 " PLEASE SELECT:".
006900 DISPLAY " ". 006600 DISPLAY " ".
007000 DISPLAY " " 006700 DISPLAY " "
007100 "1. ADD RECORDS". 006800 "1. CHANGE CONTROL "
007200 DISPLAY " " 006900 "INFORMATION".
007300 "2. CHANGE A " 007000 DISPLAY " "
007400 "RECORD". 007100 "2. DISPLAY "
007500 DISPLAY " " 007200 "CONTROL INFORMATION".
007600 "3. LOOK UP A " 007300 DISPLAY " ".
007700 "RECORD". 007400 DISPLAY " 0. EXIT".
007800 DISPLAY " " 007500 PERFORM SCROLL-LINE 8 TIMES.
007900 "4. DELETE A " 007600
008000 "RECORD".
008100 DISPLAY " "
008200 "5. PRINT RECORDS".
008300 DISPLAY " ".
008400 DISPLAY " "
008500 "0. EXIT".
008600 PERFORM SCROLL-LINE 8 TIMES.
008700
008800 ACCEPT-MENU-PICK. 007700 ACCEPT-MENU-PICK.
008900 DISPLAY 007800 DISPLAY "YOUR CHOICE "
009000 "YOUR CHOICE (0-5)?". 007900 "(0-2)?".
009100 ACCEPT MENU-PICK. 008000 ACCEPT MENU-PICK.
009200 008100
009300 RE-ACCEPT-MENU-PICK. 008200 RE-ACCEPT-MENU-PICK.
009400 DISPLAY 008300 DISPLAY "INVALID SELECTION "
009500 "INVALID SELECTION - " 008400 "- PLEASE RE-TRY.".
009600 "PLEASE RE-TRY.". 008500 PERFORM ACCEPT-MENU-PICK.
009700 PERFORM ACCEPT-MENU-PICK. 008600
009800
009900 CLEAR-SCREEN. 008700 CLEAR-SCREEN.
010000 PERFORM SCROLL-LINE 008800 PERFORM SCROLL-LINE
010100 25 TIMES. 008900 25 TIMES.
010200 009000
010300 SCROLL-LINE. 009100 SCROLL-LINE.
010400 DISPLAY " ". 009200 DISPLAY " ".
010500 009300
010600 MAINTAIN-THE-FILE. 009400 MAINTAIN-THE-FILE.
010700 PERFORM DO-THE-PICK. 009500 PERFORM DO-THE-PICK.
010800 PERFORM GET-MENU-PICK. 009600 PERFORM GET-MENU-PICK.
010900 009700
011000 DO-THE-PICK. 009800 DO-THE-PICK.
011100 IF MENU-PICK = 1 009900 IF MENU-PICK = 1
011200 PERFORM ADD-MODE 010000 PERFORM CHANGE-MODE
011300 ELSE 010100 ELSE
011400 IF MENU-PICK = 2 010200 IF MENU-PICK = 2
011500 PERFORM CHANGE-MODE 010300 PERFORM INQUIRE-MODE.
011600 ELSE 010400
011700 IF MENU-PICK = 3
011800 PERFORM INQUIRE-MODE
011900 ELSE
012000 IF MENU-PICK = 4
012100 PERFORM DELETE-MODE
012200 ELSE
012300 IF MENU-PICK = 5
012400 PERFORM PRINT-THE-RECORDS.
012500
012600*------------------------------
012700* ADD
012800*------------------------------
012900 ADD-MODE.
013000 MOVE "ADD" TO THE-MODE.
013100 PERFORM GET-NEW-STATE-CODE.
013200 PERFORM ADD-RECORDS
013300 UNTIL STATE-CODE = "ZZ".
013400
013500 GET-NEW-STATE-CODE.
013600 PERFORM INIT-STATE-RECORD.
013700 PERFORM ENTER-STATE-CODE.
013800 MOVE "Y" TO RECORD-FOUND.
013900 PERFORM
014000 FIND-NEW-STATE-RECORD
014100 UNTIL
014200 RECORD-FOUND = "N" OR
014300 STATE-CODE = "ZZ".
014400
014500 FIND-NEW-STATE-RECORD.
014600 PERFORM READ-STATE-RECORD.
014700 IF RECORD-FOUND = "Y"
014800 DISPLAY "RECORD ALREADY "
014900 "ON FILE"
015000 PERFORM ENTER-STATE-CODE.
015100
015200 ADD-RECORDS.
015300 PERFORM
015400 ENTER-REMAINING-FIELDS.
015500 PERFORM WRITE-STATE-RECORD.
015600 PERFORM GET-NEW-STATE-CODE.
015700
015800 ENTER-REMAINING-FIELDS.
015900 PERFORM ENTER-STATE-NAME.
016000
016100*---------------------------- 010500*----------------------------
016200* CHANGE 010600* CHANGE
016300*---------------------------- 010700*----------------------------
016400 CHANGE-MODE. 010800 CHANGE-MODE.
016500 MOVE "CHANGE" TO THE-MODE. 010900 MOVE "CHANGE" TO THE-MODE.
016600 PERFORM GET-STATE-RECORD. 011000 PERFORM GET-CONTROL-RECORD.
016700 PERFORM CHANGE-RECORDS 011100 IF RECORD-FOUND = "Y"
016800 UNTIL STATE-CODE = "ZZ". 011200 PERFORM CHANGE-RECORDS.
016900 011300
017000 CHANGE-RECORDS. 011400 CHANGE-RECORDS.
017100 PERFORM GET-FIELD-TO-CHANGE. 011500 PERFORM GET-FIELD-TO-CHANGE.
017200* PERFORM CHANGE-ONE-FIELD 011600 PERFORM CHANGE-ONE-FIELD.
017300* UNTIL WHICH-FIELD = ZERO. 011700
017400 PERFORM CHANGE-ONE-FIELD. 011800 PERFORM GET-CONTROL-RECORD.
017500 011900
017600 PERFORM GET-STATE-RECORD.
017700
017800 GET-FIELD-TO-CHANGE. 012000 GET-FIELD-TO-CHANGE.
017900 PERFORM DISPLAY-ALL-FIELDS. 012100 PERFORM DISPLAY-ALL-FIELDS.
018000 PERFORM ASK-WHICH-FIELD. 012200 PERFORM ASK-WHICH-FIELD.
018100 012300
018200 ASK-WHICH-FIELD. 012400 ASK-WHICH-FIELD.
018300* PERFORM ACCEPT-WHICH-FIELD. 012500 MOVE 1 TO WHICH-FIELD.
018400* PERFORM 012600
018500* RE-ACCEPT-WHICH-FIELD
018600* UNTIL WHICH-FIELD NOT > 1.
018700 MOVE 1 TO WHICH-FIELD.
018800
018900*ACCEPT-WHICH-FIELD.
019000* DISPLAY "ENTER THE "
019100* "NUMBER OF THE FIELD".
019200* DISPLAY "TO CHANGE (1) "
019300* "OR 0 TO EXIT".
019400* ACCEPT WHICH-FIELD.
019500*
019600*RE-ACCEPT-WHICH-FIELD.
019700* DISPLAY "INVALID ENTRY".
019800* PERFORM ACCEPT-WHICH-FIELD.
019900
020000 CHANGE-ONE-FIELD. 012700 CHANGE-ONE-FIELD.
020100 PERFORM CHANGE-THIS-FIELD. 012800 PERFORM CHANGE-THIS-FIELD.
020200* PERFORM GET-FIELD-TO-CHANGE. 012900
020300 013000 CHANGE-THIS-FIELD.
020400 CHANGE-THIS-FIELD. 013100 IF WHICH-FIELD = 1
020500 IF WHICH-FIELD = 1 013200 PERFORM
020600 PERFORM ENTER-STATE-NAME. 013300 ENTER-CONTROL-LAST-VOUCHER.
020700 013400
020800 PERFORM 013500 PERFORM
020900 REWRITE-STATE-RECORD. 013600 REWRITE-CONTROL-RECORD.
021000 013700
021100*---------------------------- 013800*----------------------------
021200* INQUIRE 013900* INQUIRE
021300*---------------------------- 014000*----------------------------
021400 INQUIRE-MODE. 014100 INQUIRE-MODE.
021500 MOVE "DISPLAY" TO THE-MODE. 014200 MOVE "DISPLAY" TO THE-MODE.
021600 PERFORM GET-STATE-RECORD. 014300 PERFORM GET-CONTROL-RECORD.
021700 PERFORM INQUIRE-RECORDS 014400 IF RECORD-FOUND = "Y"
021800 UNTIL STATE-CODE = "ZZ". 014500 PERFORM INQUIRE-RECORDS.
021900 014600
022000 INQUIRE-RECORDS. 014700 INQUIRE-RECORDS.
022100 PERFORM DISPLAY-ALL-FIELDS. 014800 PERFORM DISPLAY-ALL-FIELDS.
022200 PERFORM GET-STATE-RECORD. 014900 PERFORM PRESS-ENTER.
022300 015000
015100 PRESS-ENTER.
015200 DISPLAY " ".
015300 DISPLAY "PRESS ENTER "
015400 "TO CONTINUE".
015500 ACCEPT A-DUMMY.
015600
022400*----------------------------
022500* DELETE
022600*----------------------------
022700 DELETE-MODE.
022800 MOVE "DELETE" TO THE-MODE.
022900 PERFORM GET-STATE-RECORD.
023000 PERFORM DELETE-RECORDS
023100 UNTIL STATE-CODE = "ZZ".
023200
023300 DELETE-RECORDS.
023400 PERFORM DISPLAY-ALL-FIELDS.
023500
023600 PERFORM ASK-OK-TO-DELETE
023700 IF OK-TO-DELETE = "Y"
023800 PERFORM
023900 DELETE-STATE-RECORD.
024000
024100 PERFORM GET-STATE-RECORD.
024200
024300 ASK-OK-TO-DELETE.
024400 PERFORM ACCEPT-OK-TO-DELETE.
024500 PERFORM
024600 RE-ACCEPT-OK-TO-DELETE
024700 UNTIL OK-TO-DELETE = "Y"
024800 OR "N".
024900
025000 ACCEPT-OK-TO-DELETE.
025100 DISPLAY "DELETE THIS "
025200 "RECORD (Y/N)?".
025300 ACCEPT OK-TO-DELETE.
025400
025500 INSPECT OK-TO-DELETE
025600 CONVERTING LOWER-ALPHA
025700 TO UPPER-ALPHA.
025800
025900 RE-ACCEPT-OK-TO-DELETE.
026000 DISPLAY "YOU MUST ENTER "
026100 "YES OR NO".
026200 PERFORM ACCEPT-OK-TO-DELETE.
026300
026400*----------------------------
026500* PRINT
026600*----------------------------
026700 PRINT-THE-RECORDS.
026800 CLOSE STATE-FILE.
026900 DISPLAY "REPORT IN "
027000 "PROGRESS".
027100 CALL "STCRPT02".
027200 OPEN I-O STATE-FILE.
027300
027400*---------------------------- 015700*----------------------------
027500* Routines shared by all modes 015800* Routines shared by
027600*---------------------------- 015900* Change and Inquire
027700 INIT-STATE-RECORD. 016000*----------------------------
027800 MOVE SPACE TO STATE-RECORD. 016100 INIT-CONTROL-RECORD.
027900 016200 MOVE ZEROES
028000 ENTER-STATE-CODE. 016300 TO CONTROL-RECORD.
028100 PERFORM ACCEPT-STATE-CODE. 016400
028200 PERFORM RE-ACCEPT-STATE-CODE 016500 ENTER-CONTROL-KEY.
028300 UNTIL STATE-CODE 016600 MOVE 1 TO CONTROL-KEY.
028400 NOT = SPACE. 016700
028500
028600 ACCEPT-STATE-CODE.
028700 DISPLAY " ".
028800 DISPLAY "ENTER STATE CODE "
028900 "OF THE STATE" .
029000 DISPLAY "TO " THE-MODE
029100 "(2 UPPER CASE CHARACTERS)".
029200 DISPLAY "ENTER ZZ TO "
029300 "STOP ENTRY".
029400 ACCEPT STATE-CODE.
029500
029600 INSPECT STATE-CODE
029700 CONVERTING LOWER-ALPHA
029800 TO UPPER-ALPHA.
029900
030000 RE-ACCEPT-STATE-CODE.
030100 DISPLAY "STATE CODE MUST "
030200 "BE ENTERED".
030300 PERFORM ACCEPT-STATE-CODE.
030400
030500 GET-STATE-RECORD. 016800 GET-CONTROL-RECORD.
030600 PERFORM INIT-STATE-RECORD. 016900 PERFORM INIT-CONTROL-RECORD.
030700 PERFORM ENTER-STATE-CODE. 017000 PERFORM ENTER-CONTROL-KEY.
030800 MOVE "N" TO RECORD-FOUND. 017100 MOVE "N" TO RECORD-FOUND.
030900 PERFORM FIND-STATE-RECORD 017200 PERFORM FIND-CONTROL-RECORD.
031000 UNTIL RECORD-FOUND = "Y" OR 017300
031100 STATE-CODE = "ZZ".
031200
031300*----------------------------
031400* Routines for Add and Change
031500*----------------------------
031600 FIND-STATE-RECORD. 017400 FIND-CONTROL-RECORD.
031700 PERFORM READ-STATE-RECORD. 017500 PERFORM READ-CONTROL-RECORD.
031800 IF RECORD-FOUND = "N" 017600 IF RECORD-FOUND = "N"
031900 DISPLAY "RECORD NOT FOUND" 017700 DISPLAY "RECORD NOT FOUND"
032000 PERFORM ENTER-STATE-CODE. 017800 "FOUND"
032100 017900 DISPLAY "YOU MUST RUN "
018000 "CTLBLD01"
018100 DISPLAY "TO CREATE "
018200 "THIS FILE".
018300
018400*----------------------------
018500* Routines for Change
018600*----------------------------
032200 ENTER-STATE-NAME. 018700 ENTER-CONTROL-LAST-VOUCHER.
032300 PERFORM ACCEPT-STATE-NAME. 018800 PERFORM
032400 PERFORM RE-ACCEPT-STATE-NAME 018900 ACCEPT-CONTROL-LAST-VOUCHER.
032500 UNTIL 019000
032600 STATE-NAME NOT = SPACES. 019100 ACCEPT-CONTROL-LAST-VOUCHER.
032700 019200 DISPLAY "ENTER LAST "
032800 ACCEPT-STATE-NAME. 019300 "VOUCHER NUMBER".
032900 DISPLAY "ENTER STATE NAME". 019400 ACCEPT CONTROL-LAST-VOUCHER.
033000 ACCEPT STATE-NAME. 019500
033100
033200 INSPECT STATE-NAME
033300 CONVERTING LOWER-ALPHA
033400 TO UPPER-ALPHA.
033500
033600 RE-ACCEPT-STATE-NAME.
033700 DISPLAY "STATE NAME "
033800 "MUST BE ENTERED".
033900 PERFORM ACCEPT-STATE-NAME.
034000
034100*----------------------------
034200* Routines shared by Change,
034300* Inquire and Delete
034400*----------------------------
034500 DISPLAY-ALL-FIELDS. 019600 DISPLAY-ALL-FIELDS.
034600 DISPLAY " ". 019700 DISPLAY " ".
034700 PERFORM DISPLAY-STATE-CODE. 019800 PERFORM
034800 PERFORM DISPLAY-STATE-NAME. 019900 DISPLAY-CTRL-LAST-VOUCHER
034900 DISPLAY " ". 020000
035000 020100 DISPLAY " ".
035100 DISPLAY-STATE-CODE. 020200
035200 DISPLAY 020300 DISPLAY-CTRL-LAST-VOUCHER.
035300 " STATE CODE: " 020400 DISPLAY
035400 STATE-CODE. 020500 "1. LAST VOUCHER NUMBER: "
035500 020600 CONTROL-LAST-VOUCHER.
035600 DISPLAY-STATE-NAME. 020700
035700 DISPLAY
035800 "1. STATE NAME: "
035900 STATE-NAME.
036000
036100*---------------------------- 020800*----------------------------
036200* File I-O Routines 020900* File I-O Routines
036300*---------------------------- 021000*----------------------------
036400 READ-STATE-RECORD. 021100 READ-CONTROL-RECORD.
036500 MOVE "Y" TO RECORD-FOUND. 021200 MOVE "Y" TO RECORD-FOUND.
036600 READ STATE-FILE RECORD 021300 READ CONTROL-FILE RECORD
036700 INVALID KEY 021400 INVALID KEY
036800 MOVE "N" TO RECORD-FOUND. 021500 MOVE "N" TO RECORD-FOUND.
036900 021600
037000*or READ STATE-FILE RECORD 021700*or READ CONTROL-FILE RECORD
037100* WITH LOCK 021800* WITH LOCK
037200* INVALID KEY 021900* INVALID KEY
037300* MOVE "N" TO RECORD-FOUND. 022000* MOVE "N" TO RECORD-FOUND.
037400 022100
037500*or READ STATE-FILE RECORD 022200*or READ CONTROL-FILE RECORD
037600* WITH HOLD 022300* WITH HOLD
037700* INVALID KEY 022400* INVALID KEY
037800* MOVE "N" TO RECORD-FOUND. 022500* MOVE "N" TO RECORD-FOUND.
037900 022600
038000 WRITE-STATE-RECORD.
038100 WRITE STATE-RECORD
038200 INVALID KEY
038300 DISPLAY "RECORD ALREADY "
038400 "ON FILE".
038500
038600 REWRITE-STATE-RECORD. 022700 REWRITE-CONTROL-RECORD.
038700 REWRITE STATE-RECORD 022800 REWRITE CONTROL-RECORD
038800 INVALID KEY 022900 INVALID KEY
038900 DISPLAY "ERROR REWRITING " 023000 DISPLAY "ERROR REWRITING "
039000 "STATE RECORD". 023100 "CONTROL RECORD".
039100
039200 DELETE-STATE-RECORD.
039300 DELETE STATE-FILE RECORD
039400 INVALID KEY
039500 DISPLAY "ERROR DELETING "
039600 "STATE RECORD".