In practice, a system is composed of many programs that work in concert. So far, you have worked with state codes, file maintenance and report programs, and vendor maintenance and report programs. To get these programs to work together for the user, you need to provide a menu with all these programs available as choices, and then provide the capability of executing these programs based on the user's choice.
Today, you learn about the following topics:
It is possible for one COBOL program to execute another program. The syntax for this is simple:
CALL "program name"
Here is an example:
CALL "VNDRPT03"
If a CALL is executed within a COBOL program, the calling program is suspended and the called program is executed. When the called program is finished, control is returned to the calling program and execution continues at the next line.
A CALL always is executed by calling the program using only the six- or eight-character program name without an extension. (Some systems allow only six-character filenames.)
A CALL works like a PERFORM, treating another program as if it were one large paragraph. The calling program still is loaded into memory and running, but it is waiting for the called program to complete before it resumes execution.
Although the syntax for calling another program is simple, there is a complication introduced by our old friend STOP RUN. STOP RUN stops all COBOL programs that you currently are running. If a STOP RUN is executed in a called program, it stops both the called program and the calling program, and control does not return to the calling program. This has not been a problem so far because you have been executing only a single COBOL program.
Listings 18.1 and 18.2 are fragments from a hypothetical vendor menu program and vndrpt03.cbl.
020300 CALL-VENDOR-REPORT. 020400 DISPLAY "REPORT IN PROGRESS". 020500 CALL "VNDRPT03". 020600 DISPLAY "REPORT FINISHED".
007400 007500 PROCEDURE DIVISION. 007600 PROGRAM-BEGIN. 007700 007800 PERFORM OPENING-PROCEDURE. 007900 MOVE ZEROES TO LINE-COUNT 008000 PAGE-NUMBER. 008100 008200 PERFORM START-NEW-PAGE. 008300 008400 MOVE "N" TO FILE-AT-END. 008500 PERFORM READ-NEXT-RECORD. 008600 IF FILE-AT-END = "Y" 008700 MOVE "NO RECORDS FOUND" TO PRINTER-RECORD 008800 PERFORM WRITE-TO-PRINTER 008900 ELSE 009000 PERFORM PRINT-VENDOR-FIELDS 009100 UNTIL FILE-AT-END = "Y". 009200 009300 PERFORM CLOSING-PROCEDURE. 009400 009500 PROGRAM-DONE. 009600 STOP RUN.
ANALYSIS: At line 020400 in Listing 18.1, a message that the report is underway is displayed for the user, and at line 020500, the report program is called. This transfers control to line 007500 in Listing 18.2 as if a PERFORM had been requested. At line 009500, the program is complete and the PROGRAM-DONE paragraph begins and immediately executes a STOP RUN at line 009600. You want control to return to line 020600 in Listing 18.1, but the STOP RUN brings everything to a halt.
There is another command that can be used to end a program: EXIT PROGRAM. This command checks whether the current program is a called program and, if it is, it returns to the calling program as though the end of a PERFORM had been reached. In most versions of COBOL, EXIT PROGRAM must appear in a paragraph by itself.
EXIT PROGRAM should be used to end a called program, and STOP RUN should be used to end a calling program.
When you write a program, you don't always know whether it will be a called or calling program; you can hedge your bets by including both commands in the program, as shown in Listing 18.3. At the end of each program, just before the paragraph containing STOP RUN, insert a paragraph containing EXIT PROGRAM.
DO/DON'T:
DO be sure to spell EXIT PROGRAM correctly and end it with a period.
DON'T put a hyphen in the command (EXIT-PROGRAM) because the COBOL compilers will mistake this for a paragraph name and will not execute the EXIT PROGRAM command.
007500 PROCEDURE DIVISION. 007600 PROGRAM-BEGIN. 007700 007800 PERFORM OPENING-PROCEDURE. 007900 MOVE ZEROES TO LINE-COUNT 008000 PAGE-NUMBER. 008100 008200 PERFORM START-NEW-PAGE. 008300 008400 MOVE "N" TO FILE-AT-END. 008500 PERFORM READ-NEXT-RECORD. 008600 IF FILE-AT-END = "Y" 008700 MOVE "NO RECORDS FOUND" TO PRINTER-RECORD 008800 PERFORM WRITE-TO-PRINTER 008900 ELSE 009000 PERFORM PRINT-VENDOR-FIELDS 009100 UNTIL FILE-AT-END = "Y". 009200 009300 PERFORM CLOSING-PROCEDURE. 009400 009500 PROGRAM-EXIT. 009600 EXIT PROGRAM. 009700 009800 PROGRAM-DONE. 009900 STOP RUN.
ANALYSIS: In Listing 18.3, after the main logic of the program is completed, the program executes the logic in the PROGRAM-EXIT paragraph at line 009500. This performs an EXIT PROGRAM at line 009600. The COBOL program checks to see whether it is a called program. If it is, it returns to the calling program immediately, and the paragraph at line 009800 containing STOP RUN is never executed.
If the program is not a called program, EXIT PROGRAM is ignored and the program continues to lines 009700 and 009800, where the STOP RUN is executed and the program halts.
This approach to exiting and stopping is so workable you can include it in your standard COBOL shell. It works for a called or calling program and you don't need to worry about how a program will be used. Listing 18.4 includes this logic, as well as dummy paragraphs, with the basic structure of a program. This is the last general COBOL shell and contains all the parts that you need for the work in the remainder of this book. In a real world work environment, a COBOL shell program will probably have a lot more information in it.
000100 IDENTIFICATION DIVISION. 000200 PROGRAM-ID. COBSHL04. 000300*-------------------------------- 000400* 000500*-------------------------------- 000600 ENVIRONMENT DIVISION. 000700 INPUT-OUTPUT SECTION. 000800 FILE-CONTROL. 000900 001000 DATA DIVISION. 001100 FILE SECTION. 001200 001300 WORKING-STORAGE SECTION. 001400 001500 PROCEDURE DIVISION. 001600 PROGRAM-BEGIN. 001700 PERFORM OPENING-PROCEDURE. 001800 PERFORM MAIN-PROCESS. 001900 PERFORM CLOSING-PROCEDURE. 002000 002100 PROGRAM-EXIT. 002200 EXIT PROGRAM. 002300 002400 PROGRAM-DONE. 002500 STOP RUN. 002600 002700 OPENING-PROCEDURE. 002800 002900 CLOSING-PROCEDURE. 003000 003100 MAIN-PROCESS. 003200
NOTE: You have a lot of programs that do not use the EXIT PROGRAM logic; in the subsequent examples, these will be corrected. When this is the only change in the program, only a fragment of the complete listing will be provided.
One final note on calling a program--it is important that your source code filename and program ID match. If the program filename is stcrpt02.cbl, the PROGRAM-ID inside the COBOL program must be STCRPT02. Some versions of COBOL, such as ACUCOBOL and Micro Focus Personal COBOL, don't care about this match, but many do. It's also good practice to ensure that these match.
DO/DON'T:
DO force the source code filename and PROGRAM-ID to match.
DON'T forget to double-check these, especially when you are creating programs by copying one file to another and then modifying the new file.
Listing 18.5 shows the corrections you need to make to stcrpt01.cbl for the next section of this book. Copy stcrpt01.cbl to stcrpt02.cbl and add the exit program logic shown at line 007100. Then recompile the program. Be sure to change the PROGRAM-ID to STCRPT02.
005100 PROCEDURE DIVISION. 005200 PROGRAM-BEGIN. 005300 005400 PERFORM OPENING-PROCEDURE. 005500 MOVE ZEROES TO LINE-COUNT 005600 PAGE-NUMBER. 005700 005800 PERFORM START-NEW-PAGE. 005900 006000 MOVE "N" TO FILE-AT-END. 006100 PERFORM READ-NEXT-RECORD. 006200 IF FILE-AT-END = "Y" 006300 MOVE "NO RECORDS FOUND" TO PRINTER-RECORD 006400 PERFORM WRITE-TO-PRINTER 006500 ELSE 006600 PERFORM PRINT-STATE-FIELDS 006700 UNTIL FILE-AT-END = "Y". 006800 006900 PERFORM CLOSING-PROCEDURE. 007000 007100 PROGRAM-EXIT. 007200 EXIT PROGRAM. 007300 007400 PROGRAM-DONE. 007500 STOP RUN. 007600
Listing 18.6 is stcmnt04.cbl, a modified version of state code maintenance, stcmnt03.cbl.
000100 IDENTIFICATION DIVISION. 000200 PROGRAM-ID. STCMNT04. 000300*-------------------------------- 000400* Add, Change, Inquire and Delete 000500* for the State Code. 000600* Calls the State Codes Report. 000700*-------------------------------- 000800 ENVIRONMENT DIVISION. 000900 INPUT-OUTPUT SECTION. 001000 FILE-CONTROL. 001100 001200 COPY "SLSTATE.CBL". 001300 001400 DATA DIVISION. 001500 FILE SECTION. 001600 001700 COPY "FDSTATE.CBL". 001800 001900 WORKING-STORAGE SECTION. 002000 002100 77 MENU-PICK PIC 9. 002200 88 MENU-PICK-IS-VALID VALUES 0 THRU 5. 002300 002400 77 THE-MODE PIC X(7). 002500 77 OK-TO-DELETE PIC X. 002600 77 RECORD-FOUND PIC X. 002700 77 WHICH-FIELD PIC 9. 002800 002900 COPY "WSCASE01.CBL". 003000 003100 PROCEDURE DIVISION. 003200 PROGRAM-BEGIN. 003300 PERFORM OPENING-PROCEDURE. 003400 PERFORM MAIN-PROCESS. 003500 PERFORM CLOSING-PROCEDURE. 003600 003700 PROGRAM-EXIT. 003800 EXIT PROGRAM. 003900 004000 PROGRAM-DONE. 004100 STOP RUN. 004200 004300 OPENING-PROCEDURE. 004400 OPEN I-O STATE-FILE. 004500 004600 CLOSING-PROCEDURE. 004700 CLOSE STATE-FILE. 004800 004900 005000 MAIN-PROCESS. 005100 PERFORM GET-MENU-PICK. 005200 PERFORM MAINTAIN-THE-FILE 005300 UNTIL MENU-PICK = 0. 005400 005500*-------------------------------- 005600* MENU 005700*-------------------------------- 005800 GET-MENU-PICK. 005900 PERFORM DISPLAY-THE-MENU. 006000 PERFORM ACCEPT-MENU-PICK. 006100 PERFORM RE-ACCEPT-MENU-PICK 006200 UNTIL MENU-PICK-IS-VALID. 006300 006400 DISPLAY-THE-MENU. 006500 PERFORM CLEAR-SCREEN. 006600 DISPLAY " PLEASE SELECT:". 006700 DISPLAY " ". 006800 DISPLAY " 1. ADD RECORDS". 006900 DISPLAY " 2. CHANGE A RECORD". 007000 DISPLAY " 3. LOOK UP A RECORD". 007100 DISPLAY " 4. DELETE A RECORD". 007200 DISPLAY " 5. PRINT RECORDS". 007300 DISPLAY " ". 007400 DISPLAY " 0. EXIT". 007500 PERFORM SCROLL-LINE 8 TIMES. 007600 007700 ACCEPT-MENU-PICK. 007800 DISPLAY "YOUR CHOICE (0-5)?". 007900 ACCEPT MENU-PICK. 008000 008100 RE-ACCEPT-MENU-PICK. 008200 DISPLAY "INVALID SELECTION - PLEASE RE-TRY.". 008300 PERFORM ACCEPT-MENU-PICK. 008400 008500 CLEAR-SCREEN. 008600 PERFORM SCROLL-LINE 25 TIMES. 008700 008800 SCROLL-LINE. 008900 DISPLAY " ". 009000 009100 MAINTAIN-THE-FILE. 009200 PERFORM DO-THE-PICK. 009300 PERFORM GET-MENU-PICK. 009400 009500 DO-THE-PICK. 009600 IF MENU-PICK = 1 009700 PERFORM ADD-MODE 009800 ELSE 009900 IF MENU-PICK = 2 010000 PERFORM CHANGE-MODE 010100 ELSE 010200 IF MENU-PICK = 3 010300 PERFORM INQUIRE-MODE 010400 ELSE 010500 IF MENU-PICK = 4 010600 PERFORM DELETE-MODE 010700 ELSE 010800 IF MENU-PICK = 5 010900 PERFORM PRINT-THE-RECORDS. 011000 011100*-------------------------------- 011200* ADD 011300*-------------------------------- 011400 ADD-MODE. 011500 MOVE "ADD" TO THE-MODE. 011600 PERFORM GET-NEW-STATE-CODE. 011700 PERFORM ADD-RECORDS 011800 UNTIL STATE-CODE = "ZZ". 011900 012000 GET-NEW-STATE-CODE. 012100 PERFORM INIT-STATE-RECORD. 012200 PERFORM ENTER-STATE-CODE. 012300 MOVE "Y" TO RECORD-FOUND. 012400 PERFORM FIND-NEW-STATE-RECORD 012500 UNTIL RECORD-FOUND = "N" OR 012600 STATE-CODE = "ZZ". 012700 012800 FIND-NEW-STATE-RECORD. 012900 PERFORM READ-STATE-RECORD. 013000 IF RECORD-FOUND = "Y" 013100 DISPLAY "RECORD ALREADY ON FILE" 013200 PERFORM ENTER-STATE-CODE. 013300 013400 ADD-RECORDS. 013500 PERFORM ENTER-REMAINING-FIELDS. 013600 PERFORM WRITE-STATE-RECORD. 013700 PERFORM GET-NEW-STATE-CODE. 013800 013900 ENTER-REMAINING-FIELDS. 014000 PERFORM ENTER-STATE-NAME. 014100 014200*-------------------------------- 014300* CHANGE 014400*-------------------------------- 014500 CHANGE-MODE. 014600 MOVE "CHANGE" TO THE-MODE. 014700 PERFORM GET-STATE-RECORD. 014800 PERFORM CHANGE-RECORDS 014900 UNTIL STATE-CODE = "ZZ". 015000 015100 CHANGE-RECORDS. 015200 PERFORM GET-FIELD-TO-CHANGE. 015300* PERFORM CHANGE-ONE-FIELD 015400* UNTIL WHICH-FIELD = ZERO. 015500 PERFORM CHANGE-ONE-FIELD. 015600 015700 PERFORM GET-STATE-RECORD. 015800 015900 GET-FIELD-TO-CHANGE. 016000 PERFORM DISPLAY-ALL-FIELDS. 016100 PERFORM ASK-WHICH-FIELD. 016200 016300 ASK-WHICH-FIELD. 016400* PERFORM ACCEPT-WHICH-FIELD. 016500* PERFORM RE-ACCEPT-WHICH-FIELD 016600* UNTIL WHICH-FIELD NOT > 1. 016700 MOVE 1 TO WHICH-FIELD. 016800 016900*ACCEPT-WHICH-FIELD. 017000* DISPLAY "ENTER THE NUMBER OF THE FIELD". 017100* DISPLAY "TO CHANGE (1) OR 0 TO EXIT". 017200* ACCEPT WHICH-FIELD. 017300* 017400*RE-ACCEPT-WHICH-FIELD. 017500* DISPLAY "INVALID ENTRY". 017600* PERFORM ACCEPT-WHICH-FIELD. 017700 017800 CHANGE-ONE-FIELD. 017900 PERFORM CHANGE-THIS-FIELD. 018000* PERFORM GET-FIELD-TO-CHANGE. 018100 018200 CHANGE-THIS-FIELD. 018300 IF WHICH-FIELD = 1 018400 PERFORM ENTER-STATE-NAME. 018500 018600 PERFORM REWRITE-STATE-RECORD. 018700 018800*-------------------------------- 018900* INQUIRE 019000*-------------------------------- 019100 INQUIRE-MODE. 019200 MOVE "DISPLAY" TO THE-MODE. 019300 PERFORM GET-STATE-RECORD. 019400 PERFORM INQUIRE-RECORDS 019500 UNTIL STATE-CODE = "ZZ". 019600 019700 INQUIRE-RECORDS. 019800 PERFORM DISPLAY-ALL-FIELDS. 019900 PERFORM GET-STATE-RECORD. 020000 020100*-------------------------------- 020200* DELETE 020300*-------------------------------- 020400 DELETE-MODE. 020500 MOVE "DELETE" TO THE-MODE. 020600 PERFORM GET-STATE-RECORD. 020700 PERFORM DELETE-RECORDS 020800 UNTIL STATE-CODE = "ZZ". 020900 021000 DELETE-RECORDS. 021100 PERFORM DISPLAY-ALL-FIELDS. 021200 021300 PERFORM ASK-OK-TO-DELETE 021400 IF OK-TO-DELETE = "Y" 021500 PERFORM DELETE-STATE-RECORD. 021600 021700 PERFORM GET-STATE-RECORD. 021800 021900 ASK-OK-TO-DELETE. 022000 PERFORM ACCEPT-OK-TO-DELETE. 022100 PERFORM RE-ACCEPT-OK-TO-DELETE 022200 UNTIL OK-TO-DELETE = "Y" OR "N". 022300 022400 ACCEPT-OK-TO-DELETE. 022500 DISPLAY "DELETE THIS RECORD (Y/N)?". 022600 ACCEPT OK-TO-DELETE. 022700 022800 INSPECT OK-TO-DELETE 022900 CONVERTING LOWER-ALPHA 023000 TO UPPER-ALPHA. 023100 023200 RE-ACCEPT-OK-TO-DELETE. 023300 DISPLAY "YOU MUST ENTER YES OR NO". 023400 PERFORM ACCEPT-OK-TO-DELETE. 023500 023600*-------------------------------- 023700* PRINT 023800*-------------------------------- 023900 PRINT-THE-RECORDS. 024000 CLOSE STATE-FILE. 024100 DISPLAY "REPORT IN PROGRESS". 024200 CALL "STCRPT02". 024300 OPEN I-O STATE-FILE. 024400 024500*-------------------------------- 024600* Routines shared by all modes 024700*-------------------------------- 024800 INIT-STATE-RECORD. 024900 MOVE SPACE TO STATE-RECORD. 025000 025100 ENTER-STATE-CODE. 025200 PERFORM ACCEPT-STATE-CODE. 025300 PERFORM RE-ACCEPT-STATE-CODE 025400 UNTIL STATE-CODE NOT = SPACE. 025500 025600 ACCEPT-STATE-CODE. 025700 DISPLAY " ". 025800 DISPLAY "ENTER STATE CODE OF THE STATE" . 025900 DISPLAY "TO " THE-MODE 026000 "(2 UPPER CASE CHARACTERS)". 026100 DISPLAY "ENTER ZZ TO STOP ENTRY". 026200 ACCEPT STATE-CODE. 026300 026400 INSPECT STATE-CODE 026500 CONVERTING LOWER-ALPHA 026600 TO UPPER-ALPHA. 026700 026800 RE-ACCEPT-STATE-CODE. 026900 DISPLAY "STATE CODE MUST BE ENTERED". 027000 PERFORM ACCEPT-STATE-CODE. 027100 027200 GET-STATE-RECORD. 027300 PERFORM INIT-STATE-RECORD. 027400 PERFORM ENTER-STATE-CODE. 027500 MOVE "N" TO RECORD-FOUND. 027600 PERFORM FIND-STATE-RECORD 027700 UNTIL RECORD-FOUND = "Y" OR 027800 STATE-CODE = "ZZ". 027900 028000*-------------------------------- 028100* Routines shared Add and Change 028200*-------------------------------- 028300 FIND-STATE-RECORD. 028400 PERFORM READ-STATE-RECORD. 028500 IF RECORD-FOUND = "N" 028600 DISPLAY "RECORD NOT FOUND" 028700 PERFORM ENTER-STATE-CODE. 028800 028900 ENTER-STATE-NAME. 029000 PERFORM ACCEPT-STATE-NAME. 029100 PERFORM RE-ACCEPT-STATE-NAME 029200 UNTIL STATE-NAME NOT = SPACES. 029300 029400 ACCEPT-STATE-NAME. 029500 DISPLAY "ENTER STATE NAME". 029600 ACCEPT STATE-NAME. 029700 029800 INSPECT STATE-NAME 029900 CONVERTING LOWER-ALPHA 030000 TO UPPER-ALPHA. 030100 030200 RE-ACCEPT-STATE-NAME. 030300 DISPLAY "STATE NAME MUST BE ENTERED". 030400 PERFORM ACCEPT-STATE-NAME. 030500 030600*-------------------------------- 030700* Routines shared by Change, 030800* Inquire and Delete 030900*-------------------------------- 031000 DISPLAY-ALL-FIELDS. 031100 DISPLAY " ". 031200 PERFORM DISPLAY-STATE-CODE. 031300 PERFORM DISPLAY-STATE-NAME. 031400 DISPLAY " ". 031500 031600 DISPLAY-STATE-CODE. 031700 DISPLAY " STATE CODE: " STATE-CODE. 031800 031900 DISPLAY-STATE-NAME. 032000 DISPLAY "1. STATE NAME: " STATE-NAME. 032100 032200*-------------------------------- 032300* File I-O Routines 032400*-------------------------------- 032500 READ-STATE-RECORD. 032600 MOVE "Y" TO RECORD-FOUND. 032700 READ STATE-FILE RECORD 032800 INVALID KEY 032900 MOVE "N" TO RECORD-FOUND. 033000 033100*or READ STATE-FILE RECORD WITH LOCK 033200* INVALID KEY 033300* MOVE "N" TO RECORD-FOUND. 033400 033500*or READ STATE-FILE RECORD WITH HOLD 033600* INVALID KEY 033700* MOVE "N" TO RECORD-FOUND. 033800 033900 WRITE-STATE-RECORD. 034000 WRITE STATE-RECORD 034100 INVALID KEY 034200 DISPLAY "RECORD ALREADY ON FILE". 034300 034400 REWRITE-STATE-RECORD. 034500 REWRITE STATE-RECORD 034600 INVALID KEY 034700 DISPLAY "ERROR REWRITING STATE RECORD". 034800 034900 DELETE-STATE-RECORD. 035000 DELETE STATE-FILE RECORD 035100 INVALID KEY 035200 DISPLAY "ERROR DELETING STATE RECORD". 035300
The output of stcmnt04.cbl includes a menu option for printing the file and a progress message while stcrpt02.cbl is running:
OUTPUT:
PLEASE SELECT:
1. ADD RECORDS
2. CHANGE A RECORD
3. LOOK UP A RECORD
4. DELETE A RECORD
5. PRINT RECORDS
0. EXIT
YOUR CHOICE (0-5)?
5
REPORT IN PROGRESS
ANALYSIS: Listing 18.6 adds a menu pick that enables you to print the file. The changes to the menu are at lines 002200, 007200, and 007800.
The DO-THE-PICK routine at line 009500 has had a selection added at lines 010800 and 010900 to perform PRINT-THE-RECORDS if MENU-PICK = 5. The PRINT-THE-RECORDS routine at line 023900 closes the state file, displays a message for the user, calls stcrpt02, and then opens the state file.
Closing and reopening the state file is a good practice. Some COBOL versions allow you to open a file more than once, but many do not. The state file already is open in stcmnt04.cbl and will be opened again in stcrpt02.cbl. If you close the state code file before calling STCRPT02, you can avoid any possible conflict.
Note that stcmnt04.cbl also has been changed at lines 003700 and 003800 to include the exit program logic.
If you are using Micro Focus Personal COBOL or ACUCOBOL, you can create this program by editing and compiling. Other versions of COBOL might require an additional step. If you have been using a version of COBOL that requires a link step, you need to link this program to stcrpt02.
For example, under VAX VMS enter the following:
LINK /EXE=STCMNT04 STCMNT04.OBJ STCRPT02.OBJ
This creates a program named STCMNT04.EXE by linking the two programs together. Consult your manual for how to link with other versions of COBOL.
After you have created this program, run it and select 5 to print the file; you should get a copy of the report produced by stcrpt02.cbl.
For the vendor file, you have several programs that could be added to the vendor maintenance menu. Copy vnbynm01.cbl to vnbynm02.cbl. Change the PROGRAM-ID and then make the changes in Listing 18.7 to include exit program logic. Compile the program so that it is ready to run.
007600 PROCEDURE DIVISION. 007700 PROGRAM-BEGIN. 007800 007900 PERFORM OPENING-PROCEDURE. 008000 MOVE ZEROES TO LINE-COUNT 008100 PAGE-NUMBER. 008200 008300 PERFORM START-NEW-PAGE. 008400 008500 MOVE "N" TO FILE-AT-END. 008600 PERFORM READ-FIRST-RECORD. 008700 IF FILE-AT-END = "Y" 008800 MOVE "NO RECORDS FOUND" TO PRINTER-RECORD 008900 PERFORM WRITE-TO-PRINTER 009000 ELSE 009100 PERFORM PRINT-VENDOR-FIELDS 009200 UNTIL FILE-AT-END = "Y". 009300 009400 PERFORM CLOSING-PROCEDURE. 009500 009600 PROGRAM-EXIT. 009700 EXIT PROGRAM. 009800 009900 PROGRAM-DONE. 010000 STOP RUN. 010100
Listing 18.8 is created by copying vninnm02.cbl to vninnm03.cbl and making the needed changes. Be sure to change the PROGRAM-ID.
003400 PROGRAM-BEGIN. 003500 PERFORM OPENING-PROCEDURE. 003600 PERFORM MAIN-PROCESS. 003700 PERFORM CLOSING-PROCEDURE. 003800 003900 PROGRAM-EXIT. 004000 EXIT PROGRAM. 004100 004200 PROGRAM-DONE. 004300 STOP RUN.
To modify vndrpt03.cbl, copy it to vndrpt04.cbl and make the changes shown in Listings 18.9 and 18.10. The vendor report program needs to be changed to use the new SELECT and FD for the vendor file. Be sure to change the PROGRAM-ID. Compile the program so that it is ready to run.
000100 IDENTIFICATION DIVISION. 000200 PROGRAM-ID. VNDRPT04. 000300*-------------------------------- 000400* Report on the Vendor File. 000500*-------------------------------- 000600 ENVIRONMENT DIVISION. 000700 INPUT-OUTPUT SECTION. 000800 FILE-CONTROL. 000900 001000 COPY "SLVND02.CBL". 001100 001200 COPY "SLSTATE.CBL". 001300 001400 SELECT PRINTER-FILE 001500 ASSIGN TO PRINTER 001600 ORGANIZATION IS LINE SEQUENTIAL. 001700 001800 DATA DIVISION. 001900 FILE SECTION. 002000 002100 COPY "FDVND04.CBL". 002200 002300 COPY "FDSTATE.CBL". 002400
007500 PROCEDURE DIVISION. 007600 PROGRAM-BEGIN. 007700 007800 PERFORM OPENING-PROCEDURE. 007900 MOVE ZEROES TO LINE-COUNT 008000 PAGE-NUMBER. 008100 008200 PERFORM START-NEW-PAGE. 008300 008400 MOVE "N" TO FILE-AT-END. 008500 PERFORM READ-NEXT-RECORD. 008600 IF FILE-AT-END = "Y" 008700 MOVE "NO RECORDS FOUND" TO PRINTER-RECORD 008800 PERFORM WRITE-TO-PRINTER 008900 ELSE 009000 PERFORM PRINT-VENDOR-FIELDS 009100 UNTIL FILE-AT-END = "Y". 009200 009300 PERFORM CLOSING-PROCEDURE. 009400 009500 PROGRAM-EXIT. 009600 EXIT PROGRAM. 009700 009800 PROGRAM-DONE. 009900 STOP RUN. 010000
These new programs can be called now by another program, and you can create a vendor maintenance program that gives the user any of these options.
Listing 18.11, vndmnt04.cbl, adds three more menu selections to the vendor maintenance menu. Menu pick 5 allows a look up by name and calls VNINNM03, menu pick 6 prints the vendor report and calls VNDRPT04, and menu pick 7 prints the vendor report by name and calls VNDBYNM02.
000100 IDENTIFICATION DIVISION. 000200 PROGRAM-ID. VNDMNT04. 000300*-------------------------------- 000400* Add, Change, Inquire and Delete 000500* for the Vendor File. 000600* Menu includes inquire by name, 000700* the vendor report, and the vendor 000800* report in name order. 000900*-------------------------------- 001000 ENVIRONMENT DIVISION. 001100 INPUT-OUTPUT SECTION. 001200 FILE-CONTROL. 001300 001400 COPY "SLVND02.CBL". 001500 001600 COPY "SLSTATE.CBL". 001700 001800 DATA DIVISION. 001900 FILE SECTION. 002000 002100 COPY "FDVND04.CBL". 002200 002300 COPY "FDSTATE.CBL". 002400 002500 WORKING-STORAGE SECTION. 002600 002700 77 MENU-PICK PIC 9. 002800 88 MENU-PICK-IS-VALID VALUES 0 THRU 7. 002900 003000 77 THE-MODE PIC X(7). 003100 77 WHICH-FIELD PIC 9. 003200 77 OK-TO-DELETE PIC X. 003300 77 VENDOR-RECORD-FOUND PIC X. 003400 77 STATE-RECORD-FOUND PIC X. 003500 003600 003700 77 VENDOR-NUMBER-FIELD PIC Z(5). 003800 003900 77 ERROR-MESSAGE PIC X(79) VALUE SPACE. 004000 004100 COPY "WSCASE01.CBL". 004200 004300 PROCEDURE DIVISION. 004400 PROGRAM-BEGIN. 004500 PERFORM OPENING-PROCEDURE. 004600 PERFORM MAIN-PROCESS. 004700 PERFORM CLOSING-PROCEDURE. 004800 004900 PROGRAM-EXIT. 005000 EXIT PROGRAM. 005100 005200 PROGRAM-DONE. 005300 STOP RUN. 005400 005500 OPENING-PROCEDURE. 005600 OPEN I-O VENDOR-FILE. 005700 OPEN I-O STATE-FILE. 005800 005900 CLOSING-PROCEDURE. 006000 CLOSE VENDOR-FILE. 006100 CLOSE STATE-FILE. 006200 006300 MAIN-PROCESS. 006400 PERFORM GET-MENU-PICK. 006500 PERFORM MAINTAIN-THE-FILE 006600 UNTIL MENU-PICK = 0. 006700 006800*-------------------------------- 006900* MENU 007000*-------------------------------- 007100 GET-MENU-PICK. 007200 PERFORM DISPLAY-THE-MENU. 007300 PERFORM ACCEPT-MENU-PICK. 007400 PERFORM RE-ACCEPT-MENU-PICK 007500 UNTIL MENU-PICK-IS-VALID. 007600 007700 DISPLAY-THE-MENU. 007800 PERFORM CLEAR-SCREEN. 007900 DISPLAY " PLEASE SELECT:". 008000 DISPLAY " ". 008100 DISPLAY " 1. ADD RECORDS". 008200 DISPLAY " 2. CHANGE A RECORD". 008300 DISPLAY " 3. LOOK UP A RECORD". 008400 DISPLAY " 4. DELETE A RECORD". 008500 DISPLAY " 5. LOOK UP BY NAME". 008600 DISPLAY " 6. PRINT RECORDS". 008700 DISPLAY " 7. PRINT IN NAME ORDER". 008800 DISPLAY " ". 008900 DISPLAY " 0. EXIT". 009000 PERFORM SCROLL-LINE 8 TIMES. 009100 009200 ACCEPT-MENU-PICK. 009300 DISPLAY "YOUR CHOICE (0-7)?". 009400 ACCEPT MENU-PICK. 009500 009600 RE-ACCEPT-MENU-PICK. 009700 DISPLAY "INVALID SELECTION - PLEASE RE-TRY.". 009800 PERFORM ACCEPT-MENU-PICK. 009900 010000 CLEAR-SCREEN. 010100 PERFORM SCROLL-LINE 25 TIMES. 010200 010300 SCROLL-LINE. 010400 DISPLAY " ". 010500 010600 MAINTAIN-THE-FILE. 010700 PERFORM DO-THE-PICK. 010800 PERFORM GET-MENU-PICK. 010900 011000 DO-THE-PICK. 011100 IF MENU-PICK = 1 011200 PERFORM ADD-MODE 011300 ELSE 011400 IF MENU-PICK = 2 011500 PERFORM CHANGE-MODE 011600 ELSE 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 INQUIRE-BY-NAME 012500 ELSE 012600 IF MENU-PICK = 6 012700 PERFORM PRINT-VENDOR-REPORT 012800 ELSE 012900 IF MENU-PICK = 7 013000 PERFORM PRINT-BY-NAME. 013100 013200*-------------------------------- 013300* ADD 013400*-------------------------------- 013500 ADD-MODE. 013600 MOVE "ADD" TO THE-MODE. 013700 PERFORM GET-NEW-RECORD-KEY. 013800 PERFORM ADD-RECORDS 013900 UNTIL VENDOR-NUMBER = ZEROES. 014000 014100 GET-NEW-RECORD-KEY. 014200 PERFORM ACCEPT-NEW-RECORD-KEY. 014300 PERFORM RE-ACCEPT-NEW-RECORD-KEY 014400 UNTIL VENDOR-RECORD-FOUND = "N" OR 014500 VENDOR-NUMBER = ZEROES. 014600 014700 ACCEPT-NEW-RECORD-KEY. 014800 PERFORM INIT-VENDOR-RECORD. 014900 PERFORM ENTER-VENDOR-NUMBER. 015000 IF VENDOR-NUMBER NOT = ZEROES 015100 PERFORM READ-VENDOR-RECORD. 015200 015300 RE-ACCEPT-NEW-RECORD-KEY. 015400 DISPLAY "RECORD ALREADY ON FILE" 015500 PERFORM ACCEPT-NEW-RECORD-KEY. 015600 015700 ADD-RECORDS. 015800 PERFORM ENTER-REMAINING-FIELDS. 015900 PERFORM WRITE-VENDOR-RECORD. 016000 PERFORM GET-NEW-RECORD-KEY. 016100 016200 ENTER-REMAINING-FIELDS. 016300 PERFORM ENTER-VENDOR-NAME. 016400 PERFORM ENTER-VENDOR-ADDRESS-1. 016500 PERFORM ENTER-VENDOR-ADDRESS-2. 016600 PERFORM ENTER-VENDOR-CITY. 016700 PERFORM ENTER-VENDOR-STATE. 016800 PERFORM ENTER-VENDOR-ZIP. 016900 PERFORM ENTER-VENDOR-CONTACT. 017000 PERFORM ENTER-VENDOR-PHONE. 017100 017200*-------------------------------- 017300* CHANGE 017400*-------------------------------- 017500 CHANGE-MODE. 017600 MOVE "CHANGE" TO THE-MODE. 017700 PERFORM GET-EXISTING-RECORD. 017800 PERFORM CHANGE-RECORDS 017900 UNTIL VENDOR-NUMBER = ZEROES. 018000 018100 CHANGE-RECORDS. 018200 PERFORM GET-FIELD-TO-CHANGE. 018300 PERFORM CHANGE-ONE-FIELD 018400 UNTIL WHICH-FIELD = ZERO. 018500 PERFORM GET-EXISTING-RECORD. 018600 018700 GET-FIELD-TO-CHANGE. 018800 PERFORM DISPLAY-ALL-FIELDS. 018900 PERFORM ASK-WHICH-FIELD. 019000 019100 ASK-WHICH-FIELD. 019200 PERFORM ACCEPT-WHICH-FIELD. 019300 PERFORM RE-ACCEPT-WHICH-FIELD 019400 UNTIL WHICH-FIELD < 9. 019500 019600 ACCEPT-WHICH-FIELD. 019700 DISPLAY "ENTER THE NUMBER OF THE FIELD". 019800 DISPLAY "TO CHANGE (1-8) OR 0 TO EXIT". 019900 ACCEPT WHICH-FIELD. 020000 020100 RE-ACCEPT-WHICH-FIELD. 020200 DISPLAY "INVALID ENTRY". 020300 PERFORM ACCEPT-WHICH-FIELD. 020400 020500 CHANGE-ONE-FIELD. 020600 PERFORM CHANGE-THIS-FIELD. 020700 PERFORM GET-FIELD-TO-CHANGE. 020800 020900 CHANGE-THIS-FIELD. 021000 IF WHICH-FIELD = 1 021100 PERFORM ENTER-VENDOR-NAME. 021200 IF WHICH-FIELD = 2 021300 PERFORM ENTER-VENDOR-ADDRESS-1. 021400 IF WHICH-FIELD = 3 021500 PERFORM ENTER-VENDOR-ADDRESS-2. 021600 IF WHICH-FIELD = 4 021700 PERFORM ENTER-VENDOR-CITY. 021800 IF WHICH-FIELD = 5 021900 PERFORM ENTER-VENDOR-STATE. 022000 IF WHICH-FIELD = 6 022100 PERFORM ENTER-VENDOR-ZIP. 022200 IF WHICH-FIELD = 7 022300 PERFORM ENTER-VENDOR-CONTACT. 022400 IF WHICH-FIELD = 8 022500 PERFORM ENTER-VENDOR-PHONE. 022600 022700 PERFORM REWRITE-VENDOR-RECORD. 022800 022900*-------------------------------- 023000* INQUIRE 023100*-------------------------------- 023200 INQUIRE-MODE. 023300 MOVE "DISPLAY" TO THE-MODE. 023400 PERFORM GET-EXISTING-RECORD. 023500 PERFORM INQUIRE-RECORDS 023600 UNTIL VENDOR-NUMBER = ZEROES. 023700 023800 INQUIRE-RECORDS. 023900 PERFORM DISPLAY-ALL-FIELDS. 024000 PERFORM GET-EXISTING-RECORD. 024100 024200*-------------------------------- 024300* DELETE 024400*-------------------------------- 024500 DELETE-MODE. 024600 MOVE "DELETE" TO THE-MODE. 024700 PERFORM GET-EXISTING-RECORD. 024800 PERFORM DELETE-RECORDS 024900 UNTIL VENDOR-NUMBER = ZEROES. 025000 025100 DELETE-RECORDS. 025200 PERFORM DISPLAY-ALL-FIELDS. 025300 025400 PERFORM ASK-OK-TO-DELETE. 025500 025600 IF OK-TO-DELETE = "Y" 025700 PERFORM DELETE-VENDOR-RECORD. 025800 025900 PERFORM GET-EXISTING-RECORD. 026000 026100 ASK-OK-TO-DELETE. 026200 PERFORM ACCEPT-OK-TO-DELETE. 026300 026400 PERFORM RE-ACCEPT-OK-TO-DELETE 026500 UNTIL OK-TO-DELETE = "Y" OR "N". 026600 026700 ACCEPT-OK-TO-DELETE. 026800 DISPLAY "DELETE THIS RECORD (Y/N)?". 026900 ACCEPT OK-TO-DELETE. 027000 INSPECT OK-TO-DELETE 027100 CONVERTING LOWER-ALPHA TO UPPER-ALPHA. 027200 027300 RE-ACCEPT-OK-TO-DELETE. 027400 DISPLAY "YOU MUST ENTER YES OR NO". 027500 PERFORM ACCEPT-OK-TO-DELETE. 027600 027700*-------------------------------- 027800* Routines shared by all modes 027900*-------------------------------- 028000 INIT-VENDOR-RECORD. 028100 MOVE SPACE TO VENDOR-RECORD. 028200 MOVE ZEROES TO VENDOR-NUMBER. 028300 028400 ENTER-VENDOR-NUMBER. 028500 DISPLAY " ". 028600 DISPLAY "ENTER VENDOR NUMBER OF THE VENDOR" . 028700 DISPLAY "TO " THE-MODE " (1-99999)". 028800 DISPLAY "ENTER 0 TO STOP ENTRY". 028900 ACCEPT VENDOR-NUMBER-FIELD. 029000*OR ACCEPT VENDOR-NUMBER-FIELD WITH CONVERSION. 029100 029200 MOVE VENDOR-NUMBER-FIELD TO VENDOR-NUMBER. 029300 029400*-------------------------------- 029500* INQUIRE BY NAME 029600*-------------------------------- 029700 INQUIRE-BY-NAME. 029800 PERFORM CLOSING-PROCEDURE. 029900 CALL "VNINNM03". 030000 PERFORM OPENING-PROCEDURE. 030100 030200*-------------------------------- 030300* PRINT 030400*-------------------------------- 030500 PRINT-VENDOR-REPORT. 030600 PERFORM CLOSING-PROCEDURE. 030700 DISPLAY "VENDOR REPORT IN PROGRESS". 030800 CALL "VNDRPT04". 030900 PERFORM OPENING-PROCEDURE. 031000 031100*-------------------------------- 031200* PRINT BY NAME 031300*-------------------------------- 031400 PRINT-BY-NAME. 031500 PERFORM CLOSING-PROCEDURE. 031600 DISPLAY " REPORT BY NAME IN PROGRESS". 031700 CALL "VNBYNM02". 031800 PERFORM OPENING-PROCEDURE. 031900 032000*-------------------------------- 032100* Routines shared Add and Change 032200*-------------------------------- 032300 ENTER-VENDOR-NAME. 032400 PERFORM ACCEPT-VENDOR-NAME. 032500 PERFORM RE-ACCEPT-VENDOR-NAME 032600 UNTIL VENDOR-NAME NOT = SPACE. 032700 032800 ACCEPT-VENDOR-NAME. 032900 DISPLAY "ENTER VENDOR NAME". 033000 ACCEPT VENDOR-NAME. 033100 INSPECT VENDOR-NAME 033200 CONVERTING LOWER-ALPHA 033300 TO UPPER-ALPHA. 033400 033500 RE-ACCEPT-VENDOR-NAME. 033600 DISPLAY "VENDOR NAME MUST BE ENTERED". 033700 PERFORM ACCEPT-VENDOR-NAME. 033800 033900 ENTER-VENDOR-ADDRESS-1. 034000 PERFORM ACCEPT-VENDOR-ADDRESS-1. 034100 PERFORM RE-ACCEPT-VENDOR-ADDRESS-1 034200 UNTIL VENDOR-ADDRESS-1 NOT = SPACE. 034300 034400 ACCEPT-VENDOR-ADDRESS-1. 034500 DISPLAY "ENTER VENDOR ADDRESS-1". 034600 ACCEPT VENDOR-ADDRESS-1. 034700 INSPECT VENDOR-ADDRESS-1 034800 CONVERTING LOWER-ALPHA 034900 TO UPPER-ALPHA. 035000 035100 RE-ACCEPT-VENDOR-ADDRESS-1. 035200 DISPLAY "VENDOR ADDRESS-1 MUST BE ENTERED". 035300 PERFORM ACCEPT-VENDOR-ADDRESS-1. 035400 035500 ENTER-VENDOR-ADDRESS-2. 035600 DISPLAY "ENTER VENDOR ADDRESS-2". 035700 ACCEPT VENDOR-ADDRESS-2. 035800 INSPECT VENDOR-ADDRESS-2 035900 CONVERTING LOWER-ALPHA 036000 TO UPPER-ALPHA. 036100 036200 ENTER-VENDOR-CITY. 036300 PERFORM ACCEPT-VENDOR-CITY. 036400 PERFORM RE-ACCEPT-VENDOR-CITY 036500 UNTIL VENDOR-CITY NOT = SPACE. 036600 036700 ACCEPT-VENDOR-CITY. 036800 DISPLAY "ENTER VENDOR CITY". 036900 ACCEPT VENDOR-CITY. 037000 INSPECT VENDOR-CITY 037100 CONVERTING LOWER-ALPHA 037200 TO UPPER-ALPHA. 037300 037400 RE-ACCEPT-VENDOR-CITY. 037500 DISPLAY "VENDOR CITY MUST BE ENTERED". 037600 PERFORM ACCEPT-VENDOR-CITY. 037700 037800 ENTER-VENDOR-STATE. 037900 PERFORM ACCEPT-VENDOR-STATE. 038000 PERFORM RE-ACCEPT-VENDOR-STATE 038100 UNTIL VENDOR-STATE NOT = SPACES AND 038200 STATE-RECORD-FOUND = "Y". 038300 038400 ACCEPT-VENDOR-STATE. 038500 DISPLAY "ENTER VENDOR STATE". 038600 ACCEPT VENDOR-STATE. 038700 PERFORM EDIT-CHECK-VENDOR-STATE. 038800 038900 RE-ACCEPT-VENDOR-STATE. 039000 DISPLAY ERROR-MESSAGE. 039100 PERFORM ACCEPT-VENDOR-STATE. 039200 039300 EDIT-CHECK-VENDOR-STATE. 039400 PERFORM EDIT-VENDOR-STATE. 039500 PERFORM CHECK-VENDOR-STATE. 039600 039700 EDIT-VENDOR-STATE. 039800 INSPECT VENDOR-STATE 039900 CONVERTING LOWER-ALPHA 040000 TO UPPER-ALPHA. 040100 040200 CHECK-VENDOR-STATE. 040300 PERFORM VENDOR-STATE-REQUIRED. 040400 IF VENDOR-STATE NOT = SPACES 040500 PERFORM VENDOR-STATE-ON-FILE. 040600 040700 VENDOR-STATE-REQUIRED. 040800 IF VENDOR-STATE = SPACE 040900 MOVE "VENDOR STATE MUST BE ENTERED" 041000 TO ERROR-MESSAGE. 041100 041200 VENDOR-STATE-ON-FILE. 041300 MOVE VENDOR-STATE TO STATE-CODE. 041400 PERFORM READ-STATE-RECORD. 041500 IF STATE-RECORD-FOUND = "N" 041600 MOVE "STATE CODE NOT FOUND IN CODES FILE" 041700 TO ERROR-MESSAGE. 041800 041900 ENTER-VENDOR-ZIP. 042000 PERFORM ACCEPT-VENDOR-ZIP. 042100 PERFORM RE-ACCEPT-VENDOR-ZIP 042200 UNTIL VENDOR-ZIP NOT = SPACE. 042300 042400 ACCEPT-VENDOR-ZIP. 042500 DISPLAY "ENTER VENDOR ZIP". 042600 ACCEPT VENDOR-ZIP. 042700 INSPECT VENDOR-ZIP 042800 CONVERTING LOWER-ALPHA 042900 TO UPPER-ALPHA. 043000 043100 RE-ACCEPT-VENDOR-ZIP. 043200 DISPLAY "VENDOR ZIP MUST BE ENTERED". 043300 PERFORM ACCEPT-VENDOR-ZIP. 043400 043500 ENTER-VENDOR-CONTACT. 043600 DISPLAY "ENTER VENDOR CONTACT". 043700 ACCEPT VENDOR-CONTACT. 043800 INSPECT VENDOR-CONTACT 043900 CONVERTING LOWER-ALPHA 044000 TO UPPER-ALPHA. 044100 044200 ENTER-VENDOR-PHONE. 044300 PERFORM ACCEPT-VENDOR-PHONE. 044400 PERFORM RE-ACCEPT-VENDOR-PHONE 044500 UNTIL VENDOR-PHONE NOT = SPACE. 044600 044700 ACCEPT-VENDOR-PHONE. 044800 DISPLAY "ENTER VENDOR PHONE". 044900 ACCEPT VENDOR-PHONE. 045000 INSPECT VENDOR-PHONE 045100 CONVERTING LOWER-ALPHA 045200 TO UPPER-ALPHA. 045300 045400 RE-ACCEPT-VENDOR-PHONE. 045500 DISPLAY "VENDOR PHONE MUST BE ENTERED". 045600 PERFORM ACCEPT-VENDOR-PHONE. 045700 045800*-------------------------------- 045900* Routines shared by Change, 046000* Inquire and Delete 046100*-------------------------------- 046200 GET-EXISTING-RECORD. 046300 PERFORM ACCEPT-EXISTING-KEY. 046400 PERFORM RE-ACCEPT-EXISTING-KEY 046500 UNTIL VENDOR-RECORD-FOUND = "Y" OR 046600 VENDOR-NUMBER = ZEROES. 046700 046800 ACCEPT-EXISTING-KEY. 046900 PERFORM INIT-VENDOR-RECORD. 047000 PERFORM ENTER-VENDOR-NUMBER. 047100 IF VENDOR-NUMBER NOT = ZEROES 047200 PERFORM READ-VENDOR-RECORD. 047300 047400 RE-ACCEPT-EXISTING-KEY. 047500 DISPLAY "RECORD NOT FOUND" 047600 PERFORM ACCEPT-EXISTING-KEY. 047700 047800 DISPLAY-ALL-FIELDS. 047900 DISPLAY " ". 048000 PERFORM DISPLAY-VENDOR-NUMBER. 048100 PERFORM DISPLAY-VENDOR-NAME. 048200 PERFORM DISPLAY-VENDOR-ADDRESS-1. 048300 PERFORM DISPLAY-VENDOR-ADDRESS-2. 048400 PERFORM DISPLAY-VENDOR-CITY. 048500 PERFORM DISPLAY-VENDOR-STATE. 048600 PERFORM DISPLAY-VENDOR-ZIP. 048700 PERFORM DISPLAY-VENDOR-CONTACT. 048800 PERFORM DISPLAY-VENDOR-PHONE. 048900 DISPLAY " ". 049000 049100 DISPLAY-VENDOR-NUMBER. 049200 DISPLAY " VENDOR NUMBER: " VENDOR-NUMBER. 049300 049400 DISPLAY-VENDOR-NAME. 049500 DISPLAY "1. VENDOR NAME: " VENDOR-NAME. 049600 049700 DISPLAY-VENDOR-ADDRESS-1. 049800 DISPLAY "2. VENDOR ADDRESS-1: " VENDOR-ADDRESS-1. 049900 050000 DISPLAY-VENDOR-ADDRESS-2. 050100 DISPLAY "3. VENDOR ADDRESS-2: " VENDOR-ADDRESS-2. 050200 050300 DISPLAY-VENDOR-CITY. 050400 DISPLAY "4. VENDOR CITY: " VENDOR-CITY. 050500 050600 DISPLAY-VENDOR-STATE. 050700 PERFORM VENDOR-STATE-ON-FILE. 050800 IF STATE-RECORD-FOUND = "N" 050900 MOVE "**Not found**" TO STATE-NAME. 051000 DISPLAY "5. VENDOR STATE: " 051100 VENDOR-STATE " " 051200 STATE-NAME. 051300 051400 DISPLAY-VENDOR-ZIP. 051500 DISPLAY "6. VENDOR ZIP: " VENDOR-ZIP. 051600 051700 DISPLAY-VENDOR-CONTACT. 051800 DISPLAY "7. VENDOR CONTACT: " VENDOR-CONTACT. 051900 052000 DISPLAY-VENDOR-PHONE. 052100 DISPLAY "8. VENDOR PHONE: " VENDOR-PHONE. 052200 052300*-------------------------------- 052400* File I-O Routines 052500*-------------------------------- 052600 READ-VENDOR-RECORD. 052700 MOVE "Y" TO VENDOR-RECORD-FOUND. 052800 READ VENDOR-FILE RECORD 052900 INVALID KEY 053000 MOVE "N" TO VENDOR-RECORD-FOUND. 053100 053200*or READ VENDOR-FILE RECORD WITH LOCK 053300* INVALID KEY 053400* MOVE "N" TO VENDOR-RECORD-FOUND. 053500 053600*or READ VENDOR-FILE RECORD WITH HOLD 053700* INVALID KEY 053800* MOVE "N" TO VENDOR-RECORD-FOUND. 053900 054000 WRITE-VENDOR-RECORD. 054100 WRITE VENDOR-RECORD 054200 INVALID KEY 054300 DISPLAY "RECORD ALREADY ON FILE". 054400 054500 REWRITE-VENDOR-RECORD. 054600 REWRITE VENDOR-RECORD 054700 INVALID KEY 054800 DISPLAY "ERROR REWRITING VENDOR RECORD". 054900 055000 DELETE-VENDOR-RECORD. 055100 DELETE VENDOR-FILE RECORD 055200 INVALID KEY 055300 DISPLAY "ERROR DELETING VENDOR RECORD". 055400 055500 READ-STATE-RECORD. 055600 MOVE "Y" TO STATE-RECORD-FOUND. 055700 READ STATE-FILE RECORD 055800 INVALID KEY 055900 MOVE "N" TO STATE-RECORD-FOUND. 056000
The output of vndmnt04.cbl includes a full menu with several options:
OUTPUT:
PLEASE SELECT:
1. ADD RECORDS
2. CHANGE A RECORD
3. LOOK UP A RECORD
4. DELETE A RECORD
5. LOOK UP BY NAME
6. PRINT RECORDS
7. PRINT IN NAME ORDER
0. EXIT
YOUR CHOICE (0-7)?
ANALYSIS: The calling routines are at lines 029400 through 031800, and they each use the method of closing the open files by performing CLOSING-PROCEDURE before calling their respective programs, and then calling OPENING-PROCEDURE on return. This is a handy way of closing all open files and reopening them on the way back.
Code and compile (and link if necessary) vndmnt04.cbl, and you will have a complete menu of the vendor file options.
Menu programs that call other programs are even easier to write. Because a menu program probably has no files open, there is no closing of files involved.
Listing 18.12 is bilmnu01.cbl. This will become the main menu for the bills processing system.
000100 IDENTIFICATION DIVISION. 000200 PROGRAM-ID. BILMNU01. 000300*-------------------------------- 000400* Menu for the bill payment system. 000500*-------------------------------- 000600 ENVIRONMENT DIVISION. 000700 INPUT-OUTPUT SECTION. 000800 FILE-CONTROL. 000900 001000 DATA DIVISION. 001100 FILE SECTION. 001200 001300 WORKING-STORAGE SECTION. 001400 001500 77 MENU-PICK PIC 9. 001600 88 MENU-PICK-IS-VALID VALUES 0 THRU 2. 001700 001800 PROCEDURE DIVISION. 001900 PROGRAM-BEGIN. 002000 PERFORM OPENING-PROCEDURE. 002100 PERFORM MAIN-PROCESS. 002200 PERFORM CLOSING-PROCEDURE. 002300 002400 PROGRAM-EXIT. 002500 EXIT PROGRAM. 002600 002700 PROGRAM-DONE. 002800 STOP RUN. 002900 003000 OPENING-PROCEDURE. 003100 003200 CLOSING-PROCEDURE. 003300 003400 MAIN-PROCESS. 003500 PERFORM GET-MENU-PICK. 003600 PERFORM DO-THE-PICK 003700 UNTIL MENU-PICK = 0. 003800 003900*-------------------------------- 004000* MENU 004100*-------------------------------- 004200 GET-MENU-PICK. 004300 PERFORM DISPLAY-THE-MENU. 004400 PERFORM ACCEPT-MENU-PICK. 004500 PERFORM RE-ACCEPT-MENU-PICK 004600 UNTIL MENU-PICK-IS-VALID. 004700 004800 DISPLAY-THE-MENU. 004900 PERFORM CLEAR-SCREEN. 005000 DISPLAY " PLEASE SELECT:". 005100 DISPLAY " ". 005200 DISPLAY " 1. STATE CODE MAINTENANCE". 005300 DISPLAY " 2. VENDOR MAINTENANCE". 005400 DISPLAY " ". 005500 DISPLAY " 0. EXIT". 005600 PERFORM SCROLL-LINE 8 TIMES. 005700 005800 ACCEPT-MENU-PICK. 005900 DISPLAY "YOUR CHOICE (0-2)?". 006000 ACCEPT MENU-PICK. 006100 006200 RE-ACCEPT-MENU-PICK. 006300 DISPLAY "INVALID SELECTION - PLEASE RE-TRY.". 006400 PERFORM ACCEPT-MENU-PICK. 006500 006600 CLEAR-SCREEN. 006700 PERFORM SCROLL-LINE 25 TIMES. 006800 006900 SCROLL-LINE. 007000 DISPLAY " ". 007100 007200 DO-THE-PICK. 007300 IF MENU-PICK = 1 007400 PERFORM STATE-MAINTENANCE 007500 ELSE 007600 IF MENU-PICK = 2 007700 PERFORM VENDOR-MAINTENANCE. 007800 007900 PERFORM GET-MENU-PICK. 008000 008100*-------------------------------- 008200* STATE 008300*-------------------------------- 008400 STATE-MAINTENANCE. 008500 CALL "STCMNT04". 008600 008700*-------------------------------- 008800* VENDOR 008900*-------------------------------- 009000 VENDOR-MAINTENANCE. 009100 CALL "VNDMNT04". 009200
The output of bilmnu01.cbl and the programs that it calls shows the user selecting menu options and descending into lower programs, and then exiting back to the top level:
OUTPUT:
PLEASE SELECT:
1. STATE CODE MAINTENANCE
2. VENDOR MAINTENANCE
0. EXIT
YOUR CHOICE (0-2)?
2
PLEASE SELECT:
1. ADD RECORDS
2. CHANGE A RECORD
3. LOOK UP A RECORD
4. DELETE A RECORD
5. LOOK UP BY NAME
6. PRINT RECORDS
7. PRINT IN NAME ORDER
0. EXIT
YOUR CHOICE (0-7)?
5
ENTER VENDOR NAME
abc
VENDOR NUMBER: 00002
1. VENDOR NAME: ABC PRINTING
2. VENDOR ADDRESS-1: 1624 FOOTHILL BLVD
3. VENDOR ADDRESS-2: SUITE 34
4. VENDOR CITY: LOS ANGELES
5. VENDOR STATE: CA CALIFORNIA
6. VENDOR ZIP: 91042
7. VENDOR CONTACT: CHARLES JOHANSSEN
8. VENDOR PHONE: (818) 555-4321
DISPLAY NEXT RECORD (Y/N)?
n
ENTER VENDOR NAME
(The user presses Enter here.)
PLEASE SELECT:
1. ADD RECORDS
2. CHANGE A RECORD
3. LOOK UP A RECORD
4. DELETE A RECORD
5. LOOK UP BY NAME
6. PRINT RECORDS
7. PRINT IN NAME ORDER
0. EXIT
YOUR CHOICE (0-7)?
0
PLEASE SELECT:
1. STATE CODE MAINTENANCE
2. VENDOR MAINTENANCE
0. EXIT
YOUR CHOICE (0-2)?
0
C>
ANALYSIS: You should recognize quickly that bilmnu01.cbl displays a menu and then calls an appropriate program based on the pick. Code and compile (and link if necessary) bilmnu01.cbl. Run the program and you should be able to select a menu option, descend to a lower-level menu such as vendor maintenance, execute an option from that menu, and return up the menu tree to this top menu.
One point worth noting is the difference in the manner of exiting from menus and maintenance programs. The menus all use zeroes to exit the current menu and return to the previous menu or exit the entire program. Vendor Maintenance exits when the user enters 0, but State Code Maintenance exits when the user enters ZZ. In practice, it is much better to keep a common style to all the programs in a system so that a common exit method is used. In Listing 18.6, stcmnt04.cbl, changing the exit message and the code that causes an exit to 0 would improve the overall interface so that the user could become familiar with the idea that 0 always means exit. The sample changes are as follows:
025600 ACCEPT-STATE-CODE. 025700 DISPLAY " ". 025800 DISPLAY "ENTER STATE CODE OF THE STATE" . 025900 DISPLAY "TO " THE-MODE 026000 "(2 UPPER CASE CHARACTERS)". 026100 DISPLAY "or ENTER 0 TO STOP ENTRY". 026200 ACCEPT STATE-CODE. 026300 . . . . . . . . 027200 GET-STATE-RECORD. 027300 PERFORM INIT-STATE-RECORD. 027400 PERFORM ENTER-STATE-CODE. 027500 MOVE "N" TO RECORD-FOUND. 027600 PERFORM FIND-STATE-RECORD 027700 UNTIL RECORD-FOUND = "Y" OR 027800 STATE-CODE = "0". 027900
In practice, a system is built of many programs that work in concert. In order to get these programs to work together for the user, you need to provide a menu with all the programs available as choices. Today, you learned the following basics:
PLEASE SELECT:
1. ADD RECORDS
2. CHANGE A RECORD
3. LOOK UP A RECORD
4. DELETE A RECORD
5. LOOK UP BY NAME
6. PRINT RECORDS
7. PRINT IN NAME ORDER
8. DISPLAY ALL RECORDS
0. EXIT
YOUR CHOICE (0-8)?
8
VENDOR LIST PAGE: 1
NO NAME-ADDRESS CONTACT-PHONE-ZIP
00001 AERIAL SIGNS HENRIETTA MARKSON
BURBANK AIRPORT (818) 555-6066
HANGAR 305
BURBANK CA 90016
00002 ABC PRINTING CHARLES JOHANSSEN
1624 FOOTHILL BLVD (818) 555-4321
SUITE 34
LOS ANGELES CA 91042
00003 CHARLES SMITH AND SONS MARTHA HARRISON
1435 SOUTH STREET (213) 555-4432
LOS ANGELES CA 90064
PRESS ENTER TO CONTINUE. . .
VENDOR LIST PAGE: 2
NO NAME-ADDRESS CONTACT-PHONE-ZIP
00005 ALIAS SMITH AND JONES ROBIN COUSINS
1216 MAIN STREET 415 555-9203
PALO ALTO CA 90061
00014 RANIER GRAPHICS JULIA SIMPSON
4433 WASHINGTON ST (213) 555-6789
LOS ANGELES CA 90032
00022 ARTFUL DODGER
123 UNDERWOOD LANE 202 555-1234
MARKHAM WA 40466
PRESS ENTER TO CONTINUE. . .
VENDOR LIST PAGE: 3
NO NAME-ADDRESS CONTACT-PHONE-ZIP
00067 ABC PRINTING HARRIET NELSON
1606 SOUTH 7TH (815) 555-2020
POMONA CA 90404
01176 ABERCROMBIE AND OTHERS
1234 45TH ST. (213) 555-6543
SUITE 17
LOS ANGELES CA 92345
01440 ZINZINDORFF INC.
1604 7TH ST (213) 555-7234
LOS ANGELES CA 90404
PLEASE SELECT:
1. ADD RECORDS
2. CHANGE A RECORD
3. LOOK UP A RECORD
4. DELETE A RECORD
5. LOOK UP BY NAME
6. PRINT RECORDS
7. PRINT IN NAME ORDER
8. DISPLAY ALL RECORDS
0. EXIT
YOUR CHOICE (0-8)?
© Copyright, Macmillan Computer Publishing. All rights reserved.