One of the main methods of validating entered data is to look up the information in another file that contains correct information. In today's lesson, you learn about the following topics:
Today, you learn how to use the state code file created in Day 15, "Data Integrity," to check the VENDOR-STATE for correctness when the user is entering data into the vendor file. Listing 16.1 shows a new FD for the vendor file.
000100*-------------------------------- 000200* FDVND03.CBL 000300* Primary Key - VENDOR-NUMBER 000400* 000500* NAME, ADDRESS-1, CITY, STATE, 000600* and PHONE are required fields. 000700* 000800* VENDOR-STATE must be looked up 000900* and must exist in the STATE-FILE 001000* to be valid. 001100* VENDOR-ADDRESS-2 not always used 001200* so may be SPACES 001300* VENDOR-PHONE is usually the 001400* number for VENDOR-CONTACT 001500* All fields should be entered in 001600* UPPER case. 001700*-------------------------------- 001800 FD VENDOR-FILE 001900 LABEL RECORDS ARE STANDARD. 002000 01 VENDOR-RECORD. 002100 05 VENDOR-NUMBER PIC 9(5). 002200 05 VENDOR-NAME PIC X(30). 002300 05 VENDOR-ADDRESS-1 PIC X(30). 002400 05 VENDOR-ADDRESS-2 PIC X(30). 002500 05 VENDOR-CITY PIC X(20). 002600 05 VENDOR-STATE PIC X(2). 002700 05 VENDOR-ZIP PIC X(10). 002800 05 VENDOR-CONTACT PIC X(30). 002900 05 VENDOR-PHONE PIC X(15). 003000
ANALYSIS: There is no change in the file layout, but there is a change in the comments indicating which fields are required. The comments indicate that all fields should be uppercase, and all fields are required except for VENDOR-ADDRESS-2 and VENDOR-CONTACT. The VENDOR-STATE also must be looked up in the state codes file.
The original version of vndmnt01.cbl does not include these validations, so today you add those validations, including looking up the state code.
You already are familiar with the uppercase and required validations. Listing 16.2 shows an example of the validation logic for the VENDOR-ADDRESS-1 field using the standard field-entry routine developed on Day 15.
030100 ENTER-VENDOR-ADDRESS-1. 030200 PERFORM ACCEPT-VENDOR-ADDRESS-1. 030300 PERFORM RE-ACCEPT-VENDOR-ADDRESS-1 030400 UNTIL VENDOR-ADDRESS-1 NOT = SPACE. 030500 030600 ACCEPT-VENDOR-ADDRESS-1. 030700 DISPLAY "ENTER VENDOR ADDRESS-1". 030800 ACCEPT VENDOR-ADDRESS-1. 030900 INSPECT VENDOR-ADDRESS-1 031000 CONVERTING LOWER-ALPHA 031100 TO UPPER-ALPHA. 031200 031300 RE-ACCEPT-VENDOR-ADDRESS-1. 031400 DISPLAY "VENDOR ADDRESS-1 MUST BE ENTERED". 031500 PERFORM ACCEPT-VENDOR-ADDRESS-1. 031600
VENDOR-ADDRESS-2 is not a required field, so the entry routine is much simpler, as shown in Listing 16.3.
031700 ENTER-VENDOR-ADDRESS-2. 031800 DISPLAY "ENTER VENDOR ADDRESS-2". 031900 ACCEPT VENDOR-ADDRESS-2. 032000 INSPECT VENDOR-ADDRESS-2 032100 CONVERTING LOWER-ALPHA 032200 TO UPPER-ALPHA.
This type of logic can be repeated for all fields in the vendor file. VENDOR-ZIP and VENDOR-PHONE can be validated the same way. Postal codes might contain letters when they are outside the United States, such as the Canadian Postal Code system. Phone numbers rarely contain letters, but using this approach enables you to enter gimmick phone numbers that contain letters.
This works fine until you get to VENDOR-STATE. This field is a required entry field that must be uppercase but also must be tested against the state codes file to ensure that it already exists in that file.
Listing 16.4, vndmnt02.cbl, includes the validations discussed so far. The analysis concentrates particularly on the changes made for handling the VENDOR-STATE.
000100 IDENTIFICATION DIVISION. 000200 PROGRAM-ID. VNDMNT02. 000300*-------------------------------- 000400* Add, Change, Inquire and Delete 000500* for the Vendor File. 000600*-------------------------------- 000700 ENVIRONMENT DIVISION. 000800 INPUT-OUTPUT SECTION. 000900 FILE-CONTROL. 001000 001100 COPY "SLVND01.CBL". 001200 001300 COPY "SLSTATE.CBL". 001400 001500 DATA DIVISION. 001600 FILE SECTION. 001700 001800 COPY "FDVND03.CBL". 001900 002000 COPY "FDSTATE.CBL". 002100 002200 WORKING-STORAGE SECTION. 002300 002400 77 MENU-PICK PIC 9. 002500 88 MENU-PICK-IS-VALID VALUES 0 THRU 4. 002600 002700 77 THE-MODE PIC X(7). 002800 77 WHICH-FIELD PIC 9. 002900 77 OK-TO-DELETE PIC X. 003000 77 VENDOR-RECORD-FOUND PIC X. 003100 77 STATE-RECORD-FOUND PIC X. 003200 003300 003400 77 VENDOR-NUMBER-FIELD PIC Z(5). 003500 003600 77 ERROR-MESSAGE PIC X(79) VALUE SPACE. 003700 003800 77 UPPER-ALPHA PIC X(26) VALUE 003900 "ABCDEFGHIJKLMNOPQRSTUVWXYZ". 004000 77 LOWER-ALPHA PIC X(26) VALUE 004100 "abcdefghijklmnopqrstuvwxyz". 004200 004300 PROCEDURE DIVISION. 004400 PROGRAM-BEGIN. 004500 PERFORM OPENING-PROCEDURE. 004600 PERFORM MAIN-PROCESS. 004700 PERFORM CLOSING-PROCEDURE. 004800 004900 PROGRAM-DONE. 005000 STOP RUN. 005100 005200 OPENING-PROCEDURE. 005300 OPEN I-O VENDOR-FILE. 005400 OPEN I-O STATE-FILE. 005500 005600 CLOSING-PROCEDURE. 005700 CLOSE VENDOR-FILE. 005800 CLOSE STATE-FILE. 005900 006000 MAIN-PROCESS. 006100 PERFORM GET-MENU-PICK. 006200 PERFORM MAINTAIN-THE-FILE 006300 UNTIL MENU-PICK = 0. 006400 006500*-------------------------------- 006600* MENU 006700*-------------------------------- 006800 GET-MENU-PICK. 006900 PERFORM DISPLAY-THE-MENU. 007000 PERFORM ACCEPT-MENU-PICK. 007100 PERFORM RE-ACCEPT-MENU-PICK 007200 UNTIL MENU-PICK-IS-VALID. 007300 007400 DISPLAY-THE-MENU. 007500 PERFORM CLEAR-SCREEN. 007600 DISPLAY " PLEASE SELECT:". 007700 DISPLAY " ". 007800 DISPLAY " 1. ADD RECORDS". 007900 DISPLAY " 2. CHANGE A RECORD". 008000 DISPLAY " 3. LOOK UP A RECORD". 008100 DISPLAY " 4. DELETE A RECORD". 008200 DISPLAY " ". 008300 DISPLAY " 0. EXIT". 008400 PERFORM SCROLL-LINE 8 TIMES. 008500 008600 ACCEPT-MENU-PICK. 008700 DISPLAY "YOUR CHOICE (0-4)?". 008800 ACCEPT MENU-PICK. 008900 009000 RE-ACCEPT-MENU-PICK. 009100 DISPLAY "INVALID SELECTION - PLEASE RE-TRY.". 009200 PERFORM ACCEPT-MENU-PICK. 009300 009400 CLEAR-SCREEN. 009500 PERFORM SCROLL-LINE 25 TIMES. 009600 009700 SCROLL-LINE. 009800 DISPLAY " ". 009900 010000 MAINTAIN-THE-FILE. 010100 PERFORM DO-THE-PICK. 010200 PERFORM GET-MENU-PICK. 010300 010400 DO-THE-PICK. 010500 IF MENU-PICK = 1 010600 PERFORM ADD-MODE 010700 ELSE 010800 IF MENU-PICK = 2 010900 PERFORM CHANGE-MODE 011000 ELSE 011100 IF MENU-PICK = 3 011200 PERFORM INQUIRE-MODE 011300 ELSE 011400 IF MENU-PICK = 4 011500 PERFORM DELETE-MODE. 011600 011700*-------------------------------- 011800* ADD 011900*-------------------------------- 012000 ADD-MODE. 012100 MOVE "ADD" TO THE-MODE. 012200 PERFORM GET-NEW-RECORD-KEY. 012300 PERFORM ADD-RECORDS 012400 UNTIL VENDOR-NUMBER = ZEROES. 012500 012600 GET-NEW-RECORD-KEY. 012700 PERFORM ACCEPT-NEW-RECORD-KEY. 012800 PERFORM RE-ACCEPT-NEW-RECORD-KEY 012900 UNTIL VENDOR-RECORD-FOUND = "N" OR 013000 VENDOR-NUMBER = ZEROES. 013100 013200 ACCEPT-NEW-RECORD-KEY. 013300 PERFORM INIT-VENDOR-RECORD. 013400 PERFORM ENTER-VENDOR-NUMBER. 013500 IF VENDOR-NUMBER NOT = ZEROES 013600 PERFORM READ-VENDOR-RECORD. 013700 013800 RE-ACCEPT-NEW-RECORD-KEY. 013900 DISPLAY "RECORD ALREADY ON FILE" 014000 PERFORM ACCEPT-NEW-RECORD-KEY. 014100 014200 ADD-RECORDS. 014300 PERFORM ENTER-REMAINING-FIELDS. 014400 PERFORM WRITE-VENDOR-RECORD. 014500 PERFORM GET-NEW-RECORD-KEY. 014600 014700 ENTER-REMAINING-FIELDS. 014800 PERFORM ENTER-VENDOR-NAME. 014900 PERFORM ENTER-VENDOR-ADDRESS-1. 015000 PERFORM ENTER-VENDOR-ADDRESS-2. 015100 PERFORM ENTER-VENDOR-CITY. 015200 PERFORM ENTER-VENDOR-STATE. 015300 PERFORM ENTER-VENDOR-ZIP. 015400 PERFORM ENTER-VENDOR-CONTACT. 015500 PERFORM ENTER-VENDOR-PHONE. 015600 015700*-------------------------------- 015800* CHANGE 015900*-------------------------------- 016000 CHANGE-MODE. 016100 MOVE "CHANGE" TO THE-MODE. 016200 PERFORM GET-EXISTING-RECORD. 016300 PERFORM CHANGE-RECORDS 016400 UNTIL VENDOR-NUMBER = ZEROES. 016500 016600 CHANGE-RECORDS. 016700 PERFORM GET-FIELD-TO-CHANGE. 016800 PERFORM CHANGE-ONE-FIELD 016900 UNTIL WHICH-FIELD = ZERO. 017000 PERFORM GET-EXISTING-RECORD. 017100 017200 GET-FIELD-TO-CHANGE. 017300 PERFORM DISPLAY-ALL-FIELDS. 017400 PERFORM ASK-WHICH-FIELD. 017500 017600 ASK-WHICH-FIELD. 017700 PERFORM ACCEPT-WHICH-FIELD. 017800 PERFORM RE-ACCEPT-WHICH-FIELD 017900 UNTIL WHICH-FIELD < 9. 018000 018100 ACCEPT-WHICH-FIELD. 018200 DISPLAY "ENTER THE NUMBER OF THE FIELD". 018300 DISPLAY "TO CHANGE (1-8) OR 0 TO EXIT". 018400 ACCEPT WHICH-FIELD. 018500 018600 RE-ACCEPT-WHICH-FIELD. 018700 DISPLAY "INVALID ENTRY". 018800 PERFORM ACCEPT-WHICH-FIELD. 018900 019000 CHANGE-ONE-FIELD. 019100 PERFORM CHANGE-THIS-FIELD. 019200 PERFORM GET-FIELD-TO-CHANGE. 019300 019400 CHANGE-THIS-FIELD. 019500 IF WHICH-FIELD = 1 019600 PERFORM ENTER-VENDOR-NAME. 019700 IF WHICH-FIELD = 2 019800 PERFORM ENTER-VENDOR-ADDRESS-1. 019900 IF WHICH-FIELD = 3 020000 PERFORM ENTER-VENDOR-ADDRESS-2. 020100 IF WHICH-FIELD = 4 020200 PERFORM ENTER-VENDOR-CITY. 020300 IF WHICH-FIELD = 5 020400 PERFORM ENTER-VENDOR-STATE. 020500 IF WHICH-FIELD = 6 020600 PERFORM ENTER-VENDOR-ZIP. 020700 IF WHICH-FIELD = 7 020800 PERFORM ENTER-VENDOR-CONTACT. 020900 IF WHICH-FIELD = 8 021000 PERFORM ENTER-VENDOR-PHONE. 021100 021200 PERFORM REWRITE-VENDOR-RECORD. 021300 021400*-------------------------------- 021500* INQUIRE 021600*-------------------------------- 021700 INQUIRE-MODE. 021800 MOVE "DISPLAY" TO THE-MODE. 021900 PERFORM GET-EXISTING-RECORD. 022000 PERFORM INQUIRE-RECORDS 022100 UNTIL VENDOR-NUMBER = ZEROES. 022200 022300 INQUIRE-RECORDS. 022400 PERFORM DISPLAY-ALL-FIELDS. 022500 PERFORM GET-EXISTING-RECORD. 022600 022700*-------------------------------- 022800* DELETE 022900*-------------------------------- 023000 DELETE-MODE. 023100 MOVE "DELETE" TO THE-MODE. 023200 PERFORM GET-EXISTING-RECORD. 023300 PERFORM DELETE-RECORDS 023400 UNTIL VENDOR-NUMBER = ZEROES. 023500 023600 DELETE-RECORDS. 023700 PERFORM DISPLAY-ALL-FIELDS. 023800 023900 PERFORM ASK-OK-TO-DELETE. 024000 024100 IF OK-TO-DELETE = "Y" 024200 PERFORM DELETE-VENDOR-RECORD. 024300 024400 PERFORM GET-EXISTING-RECORD. 024500 024600 ASK-OK-TO-DELETE. 024700 PERFORM ACCEPT-OK-TO-DELETE. 024800 024900 PERFORM RE-ACCEPT-OK-TO-DELETE 025000 UNTIL OK-TO-DELETE = "Y" OR "N". 025100 025200 ACCEPT-OK-TO-DELETE. 025300 DISPLAY "DELETE THIS RECORD (Y/N)?". 025400 ACCEPT OK-TO-DELETE. 025500 INSPECT OK-TO-DELETE 025600 CONVERTING LOWER-ALPHA TO UPPER-ALPHA. 025700 025800 RE-ACCEPT-OK-TO-DELETE. 025900 DISPLAY "YOU MUST ENTER YES OR NO". 026000 PERFORM ACCEPT-OK-TO-DELETE. 026100 026200*-------------------------------- 026300* Routines shared by all modes 026400*-------------------------------- 026500 INIT-VENDOR-RECORD. 026600 MOVE SPACE TO VENDOR-RECORD. 026700 MOVE ZEROES TO VENDOR-NUMBER. 026800 026900 ENTER-VENDOR-NUMBER. 027000 DISPLAY " ". 027100 DISPLAY "ENTER VENDOR NUMBER OF THE VENDOR" . 027200 DISPLAY "TO " THE-MODE " (1-99999)". 027300 DISPLAY "ENTER 0 TO STOP ENTRY". 027400 ACCEPT VENDOR-NUMBER-FIELD. 027500*OR ACCEPT VENDOR-NUMBER-FIELD WITH CONVERSION. 027600 027700 MOVE VENDOR-NUMBER-FIELD TO VENDOR-NUMBER. 027800 027900*-------------------------------- 028000* Routines shared Add and Change 028100*-------------------------------- 028200 ENTER-VENDOR-NAME. 028300 PERFORM ACCEPT-VENDOR-NAME. 028400 PERFORM RE-ACCEPT-VENDOR-NAME 028500 UNTIL VENDOR-NAME NOT = SPACE. 028600 028700 ACCEPT-VENDOR-NAME. 028800 DISPLAY "ENTER VENDOR NAME". 028900 ACCEPT VENDOR-NAME. 029000 INSPECT VENDOR-NAME 029100 CONVERTING LOWER-ALPHA 029200 TO UPPER-ALPHA. 029300 029400 RE-ACCEPT-VENDOR-NAME. 029500 DISPLAY "VENDOR NAME MUST BE ENTERED". 029600 PERFORM ACCEPT-VENDOR-NAME. 029700 029800 ENTER-VENDOR-ADDRESS-1. 029900 PERFORM ACCEPT-VENDOR-ADDRESS-1. 030000 PERFORM RE-ACCEPT-VENDOR-ADDRESS-1 030100 UNTIL VENDOR-ADDRESS-1 NOT = SPACE. 030200 030300 ACCEPT-VENDOR-ADDRESS-1. 030400 DISPLAY "ENTER VENDOR ADDRESS-1". 030500 ACCEPT VENDOR-ADDRESS-1. 030600 INSPECT VENDOR-ADDRESS-1 030700 CONVERTING LOWER-ALPHA 030800 TO UPPER-ALPHA. 030900 031000 RE-ACCEPT-VENDOR-ADDRESS-1. 031100 DISPLAY "VENDOR ADDRESS-1 MUST BE ENTERED". 031200 PERFORM ACCEPT-VENDOR-ADDRESS-1. 031300 031400 ENTER-VENDOR-ADDRESS-2. 031500 DISPLAY "ENTER VENDOR ADDRESS-2". 031600 ACCEPT VENDOR-ADDRESS-2. 031700 INSPECT VENDOR-ADDRESS-2 031800 CONVERTING LOWER-ALPHA 031900 TO UPPER-ALPHA. 032000 032100 ENTER-VENDOR-CITY. 032200 PERFORM ACCEPT-VENDOR-CITY. 032300 PERFORM RE-ACCEPT-VENDOR-CITY 032400 UNTIL VENDOR-CITY NOT = SPACE. 032500 032600 ACCEPT-VENDOR-CITY. 032700 DISPLAY "ENTER VENDOR CITY". 032800 ACCEPT VENDOR-CITY. 032900 INSPECT VENDOR-CITY 033000 CONVERTING LOWER-ALPHA 033100 TO UPPER-ALPHA. 033200 033300 RE-ACCEPT-VENDOR-CITY. 033400 DISPLAY "VENDOR CITY MUST BE ENTERED". 033500 PERFORM ACCEPT-VENDOR-CITY. 033600 033700 ENTER-VENDOR-STATE. 033800 PERFORM ACCEPT-VENDOR-STATE. 033900 PERFORM RE-ACCEPT-VENDOR-STATE 034000 UNTIL VENDOR-STATE NOT = SPACES AND 034100 STATE-RECORD-FOUND = "Y". 034200 034300 ACCEPT-VENDOR-STATE. 034400 DISPLAY "ENTER VENDOR STATE". 034500 ACCEPT VENDOR-STATE. 034600 PERFORM EDIT-CHECK-VENDOR-STATE. 034700 034800 RE-ACCEPT-VENDOR-STATE. 034900 DISPLAY ERROR-MESSAGE. 035000 PERFORM ACCEPT-VENDOR-STATE. 035100 035200 EDIT-CHECK-VENDOR-STATE. 035300 PERFORM EDIT-VENDOR-STATE. 035400 PERFORM CHECK-VENDOR-STATE. 035500 035600 EDIT-VENDOR-STATE. 035700 INSPECT VENDOR-STATE 035800 CONVERTING LOWER-ALPHA 035900 TO UPPER-ALPHA. 036000 036100 CHECK-VENDOR-STATE. 036200 PERFORM VENDOR-STATE-REQUIRED. 036300 IF VENDOR-STATE NOT = SPACES 036400 PERFORM VENDOR-STATE-ON-FILE. 036500 036600 VENDOR-STATE-REQUIRED. 036700 IF VENDOR-STATE = SPACE 036800 MOVE "VENDOR STATE MUST BE ENTERED" 036900 TO ERROR-MESSAGE. 037000 037100 VENDOR-STATE-ON-FILE. 037200 MOVE VENDOR-STATE TO STATE-CODE. 037300 PERFORM READ-STATE-RECORD. 037400 IF STATE-RECORD-FOUND = "N" 037500 MOVE "STATE CODE NOT FOUND IN CODES FILE" 037600 TO ERROR-MESSAGE. 037700 037800 ENTER-VENDOR-ZIP. 037900 PERFORM ACCEPT-VENDOR-ZIP. 038000 PERFORM RE-ACCEPT-VENDOR-ZIP 038100 UNTIL VENDOR-ZIP NOT = SPACE. 038200 038300 ACCEPT-VENDOR-ZIP. 038400 DISPLAY "ENTER VENDOR ZIP". 038500 ACCEPT VENDOR-ZIP. 038600 INSPECT VENDOR-ZIP 038700 CONVERTING LOWER-ALPHA 038800 TO UPPER-ALPHA. 038900 039000 RE-ACCEPT-VENDOR-ZIP. 039100 DISPLAY "VENDOR ZIP MUST BE ENTERED". 039200 PERFORM ACCEPT-VENDOR-ZIP. 039300 039400 ENTER-VENDOR-CONTACT. 039500 DISPLAY "ENTER VENDOR CONTACT". 039600 ACCEPT VENDOR-CONTACT. 039700 INSPECT VENDOR-CONTACT 039800 CONVERTING LOWER-ALPHA 039900 TO UPPER-ALPHA. 040000 040100 ENTER-VENDOR-PHONE. 040200 PERFORM ACCEPT-VENDOR-PHONE. 040300 PERFORM RE-ACCEPT-VENDOR-PHONE 040400 UNTIL VENDOR-PHONE NOT = SPACE. 040500 040600 ACCEPT-VENDOR-PHONE. 040700 DISPLAY "ENTER VENDOR PHONE". 040800 ACCEPT VENDOR-PHONE. 040900 INSPECT VENDOR-PHONE 041000 CONVERTING LOWER-ALPHA 041100 TO UPPER-ALPHA. 041200 041300 RE-ACCEPT-VENDOR-PHONE. 041400 DISPLAY "VENDOR PHONE MUST BE ENTERED". 041500 PERFORM ACCEPT-VENDOR-PHONE. 041600 041700*-------------------------------- 041800* Routines shared by Change, 041900* Inquire and Delete 042000*-------------------------------- 042100 GET-EXISTING-RECORD. 042200 PERFORM ACCEPT-EXISTING-KEY. 042300 PERFORM RE-ACCEPT-EXISTING-KEY 042400 UNTIL VENDOR-RECORD-FOUND = "Y" OR 042500 VENDOR-NUMBER = ZEROES. 042600 042700 ACCEPT-EXISTING-KEY. 042800 PERFORM INIT-VENDOR-RECORD. 042900 PERFORM ENTER-VENDOR-NUMBER. 043000 IF VENDOR-NUMBER NOT = ZEROES 043100 PERFORM READ-VENDOR-RECORD. 043200 043300 RE-ACCEPT-EXISTING-KEY. 043400 DISPLAY "RECORD NOT FOUND" 043500 PERFORM ACCEPT-EXISTING-KEY. 043600 043700 DISPLAY-ALL-FIELDS. 043800 DISPLAY " ". 043900 PERFORM DISPLAY-VENDOR-NUMBER. 044000 PERFORM DISPLAY-VENDOR-NAME. 044100 PERFORM DISPLAY-VENDOR-ADDRESS-1. 044200 PERFORM DISPLAY-VENDOR-ADDRESS-2. 044300 PERFORM DISPLAY-VENDOR-CITY. 044400 PERFORM DISPLAY-VENDOR-STATE. 044500 PERFORM DISPLAY-VENDOR-ZIP. 044600 PERFORM DISPLAY-VENDOR-CONTACT. 044700 PERFORM DISPLAY-VENDOR-PHONE. 044800 DISPLAY " ". 044900 045000 DISPLAY-VENDOR-NUMBER. 045100 DISPLAY " VENDOR NUMBER: " VENDOR-NUMBER. 045200 045300 DISPLAY-VENDOR-NAME. 045400 DISPLAY "1. VENDOR NAME: " VENDOR-NAME. 045500 045600 DISPLAY-VENDOR-ADDRESS-1. 045700 DISPLAY "2. VENDOR ADDRESS-1: " VENDOR-ADDRESS-1. 045800 045900 DISPLAY-VENDOR-ADDRESS-2. 046000 DISPLAY "3. VENDOR ADDRESS-2: " VENDOR-ADDRESS-2. 046100 046200 DISPLAY-VENDOR-CITY. 046300 DISPLAY "4. VENDOR CITY: " VENDOR-CITY. 046400 046500 DISPLAY-VENDOR-STATE. 046600 PERFORM VENDOR-STATE-ON-FILE. 046700 IF STATE-RECORD-FOUND = "N" 046800 MOVE "**Not found**" TO STATE-NAME. 046900 DISPLAY "5. VENDOR STATE: " 047000 VENDOR-STATE " " 047100 STATE-NAME. 047200 047300 DISPLAY-VENDOR-ZIP. 047400 DISPLAY "6. VENDOR ZIP: " VENDOR-ZIP. 047500 047600 DISPLAY-VENDOR-CONTACT. 047700 DISPLAY "7. VENDOR CONTACT: " VENDOR-CONTACT. 047800 047900 DISPLAY-VENDOR-PHONE. 048000 DISPLAY "8. VENDOR PHONE: " VENDOR-PHONE. 048100 048200*-------------------------------- 048300* File I-O Routines 048400*-------------------------------- 048500 READ-VENDOR-RECORD. 048600 MOVE "Y" TO VENDOR-RECORD-FOUND. 048700 READ VENDOR-FILE RECORD 048800 INVALID KEY 048900 MOVE "N" TO VENDOR-RECORD-FOUND. 049000 049100*or READ VENDOR-FILE RECORD WITH LOCK 049200* INVALID KEY 049300* MOVE "N" TO VENDOR-RECORD-FOUND. 049400 049500*or READ VENDOR-FILE RECORD WITH HOLD 049600* INVALID KEY 049700* MOVE "N" TO VENDOR-RECORD-FOUND. 049800 049900 WRITE-VENDOR-RECORD. 050000 WRITE VENDOR-RECORD 050100 INVALID KEY 050200 DISPLAY "RECORD ALREADY ON FILE". 050300 050400 REWRITE-VENDOR-RECORD. 050500 REWRITE VENDOR-RECORD 050600 INVALID KEY 050700 DISPLAY "ERROR REWRITING VENDOR RECORD". 050800 050900 DELETE-VENDOR-RECORD. 051000 DELETE VENDOR-FILE RECORD 051100 INVALID KEY 051200 DISPLAY "ERROR DELETING VENDOR RECORD". 051300 051400 READ-STATE-RECORD. 051500 MOVE "Y" TO STATE-RECORD-FOUND. 051600 READ STATE-FILE RECORD 051700 INVALID KEY 051800 MOVE "N" TO STATE-RECORD-FOUND. 051900
The new vndmnt02.cbl limits you to valid state codes, but the original vndmnt01.cbl did not. If you entered an invalid state code using vndmnt01.cbl, vndmnt02.cbl would pick this up and display it.
The sample output illustrates the messages received when a user displays a record containing an invalid state code, attempts to change it to spaces, and then attempts to change it to an invalid state:
OUTPUT:
ENTER VENDOR NUMBER OF THE VENDOR TO CHANGE (1-99999) ENTER 0 TO STOP ENTRY 1 VENDOR NUMBER: 00001 1. VENDOR NAME: AERIAL SIGNS 2. VENDOR ADDRESS-1: BURBANK AIRPORT 3. VENDOR ADDRESS-2: HANGAR 305 4. VENDOR CITY: BURBANK 5. VENDOR STATE: WX **Not Found** 6. VENDOR ZIP: 90016 7. VENDOR CONTACT: HENRIETTA MARKSON 8. VENDOR PHONE: (818) 555-6066 ENTER THE NUMBER OF THE FIELD TO CHANGE (1-8) OR 0 TO EXIT 5 ENTER VENDOR STATE
(User pressed Enter here with no entry.1)
VENDOR-STATE-MUST BE ENTERED ENTER VENDOR STATE ww STATE CODE NOT FOUND IN CODES FILE ENTER VENDOR STATE ca VENDOR NUMBER: 00001 1. VENDOR NAME: AERIAL SIGNS 2. VENDOR ADDRESS-1: BURBANK AIRPORT 3. VENDOR ADDRESS-2: HANGAR 305 4. VENDOR CITY: BURBANK 5. VENDOR STATE: CA CALIFORNIA 6. VENDOR ZIP: 90016 7. VENDOR CONTACT: HENRIETTA MARKSON 8. VENDOR PHONE: (818) 555-6066 ENTER THE NUMBER OF THE FIELD TO CHANGE (1-8) OR 0 TO EXIT
ANALYSIS: In order to look up anything in the state code file, you have to include the file in the program, and the file will have to be opened in the program. Lines 001300 and 002000 include the SELECT and FD for the STATE-FILE. At lines 005400 and 005800, the state file is opened and closed as part of OPENING-PROCEDURE and CLOSING-PROCEDURE.
The STATE-FILE has to be read, so you need a RECORD-FOUND flag for the STATE-FILE. The flag with this name already is used for reading the VENDOR-FILE, so to avoid confusion, the RECORD-FOUND variable is replaced with a VENDOR-RECORD-FOUND and a STATE-RECORD-FOUND at lines 003000 and 003100, respectively. The VENDOR-FILE uses the VENDOR-RECORD-FOUND flag during reads, and the STATE-FILE uses the STATE-RECORD-FOUND flag during reads.
The READ-STATE-RECORD routine appears at lines 051400 through 051800, and the modified READ-VENDOR-RECORD routine appears at lines 048500 through 048900.
The entry and validation of VENDOR-STATE appears at lines 033700 through 037600. The VENDOR-STATE field requires multiple validations because two conditions must be true for the field to be correct. The field must not be spaces, and a record for that state must be found in the state code file.
The ENTER-VENDOR-STATE paragraph at line 034000 has been coded to test for both of these things. In the ACCEPT-VENDOR-STATE paragraph, the editing and checking (validating) of VENDOR-STATE has been broken into a separate paragraph performed at line 034600. The EDIT-CHECK-VENDOR-STATE paragraph at line 035200 is in turn broken into separate routines to edit VENDOR-STATE and check (validate) VENDOR-STATE. In EDIT-VENDOR-STATE at line 035600, the field is converted to uppercase.
The checking (validating) of VENDOR-STATE in CHECK-VENDOR-STATE at line 036100 is broken into two separate paragraphs. At line 036200, the VENDOR-STATE-REQUIRED paragraph is performed. This routine, at line 036600, checks that the field has been entered and sets up an error message for the user if it has not. If the validation of VENDOR-STATE-REQUIRED is passed, at line 036400, the VENDOR-STATE-ON-FILE routine is performed to check that the entered state code appears in the state file.
The VENDOR-STATE-ON-FILE paragraph at line 037100 is fairly straightforward. It moves the VENDOR-STATE to the STATE-CODE and then reads the state code file. If the record is not found, another error message is set up.
The RE-ACCEPT-VENDOR-STATE paragraph at line 034800 could have displayed "INVALID ENTRY" as a catchall error message, but it is helpful to the user to have a more detailed error message. An ERROR-MESSAGE variable is defined at line 003600, filled in at line 036800 or 037500 (depending on the type of error), and then displayed at line 034900. This gives the user a better idea of the problem with the data.
Of course, this assumes that the STATE-FILE contains all the valid states that might be used in vendor addresses, and that these were entered correctly in the first place.
The VENDOR-STATE-ON-FILE routine also can be used to improve the information that is displayed on the screen for the user. At line 046500, the DISPLAY-VENDOR-STATE routine has been modified to display the name of the state, as well as the two-character abbreviation.
At line 046600, VENDOR-STATE-ON-FILE is performed. If the record is not found, the literal "**Not found**" is moved to STATE-NAME. If a record was found, STATE-NAME includes the state name from STATE-FILE. If not found, it includes the message "**Not found**". At lines 046900 through 047100, "5. VENDOR STATE: ", VENDOR-STATE, and STATE-NAME are displayed.
Another new piece of coding worth looking at starts at line 012600 with the GET-NEW-RECORD-KEY paragraph. This logic replaces the GET-NEW-VENDOR logic in vndmnt01.cbl. It is designed to work as a standard field-entry routine, as shown in Figure 16.1.
Figure 16.1.
GET-NEW-RECORD-KEY as a standard field-entry routine.
A similar arrangement begins at line 042100 in the GET-EXISTING-RECORD routine, which is compared to the standard field-entry routine in Figure 16.2.
Figure 16.2.
GET-EXISTING-RECORD as a standard field-entry routine.
The new version of vndmnt02.cbl forces uppercase entry, but vndmnt01.cbl did not. It is possible for your data file to contain values that are in lowercase if you used vndmnt01.cbl to add records.
If you have entered everything in uppercase, take the time to run vndmnt01.cbl once again, and add a record with lowercase fields in it. You also might want to enter one record that contains an invalid VENDOR-STATE--one that does not appear in the state code file.
In Figure 16.3, the state name has been added to the report immediately after the state code, and part of the report has been moved to the right to make room for the extra 20 characters of state name. A report such as this can be used to identify vendor records that contain fields in lowercase and vendor records that contain invalid state codes.
Figure 16.3.
Spacing chart for vndrpt02.cbl.
In Listing 16.5, the state code is looked up using logic similar to that used in vndmnt02.cbl.
000100 IDENTIFICATION DIVISION. 000200 PROGRAM-ID. VNDRPT02. 000300*-------------------------------- 000400* Report on the Vendor File. 000500*-------------------------------- 000600 ENVIRONMENT DIVISION. 000700 INPUT-OUTPUT SECTION. 000800 FILE-CONTROL. 000900 001000 COPY "SLVND01.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 "FDVND02.CBL". 002200 002300 COPY "FDSTATE.CBL". 002400 002500 FD PRINTER-FILE 002600 LABEL RECORDS ARE OMITTED. 002700 01 PRINTER-RECORD PIC X(80). 002800 002900 WORKING-STORAGE SECTION. 003000 003100 01 DETAIL-LINE. 003200 05 PRINT-NUMBER PIC 9(5). 003300 05 FILLER PIC X VALUE SPACE. 003400 05 PRINT-NAME PIC X(30). 003500 05 FILLER PIC X(15) VALUE SPACE. 003600 05 PRINT-CONTACT PIC X(30). 003700 003800 01 CITY-STATE-LINE. 003900 05 FILLER PIC X(6) VALUE SPACE. 004000 05 PRINT-CITY PIC X(20). 004100 05 FILLER PIC X VALUE SPACE. 004200 05 PRINT-STATE PIC X(2). 004300 05 FILLER PIC X VALUE SPACE. 004400 05 PRINT-STATE-NAME PIC X(20). 004500 05 FILLER PIC X(1) VALUE SPACE. 004600 05 PRINT-ZIP PIC X(10). 004700 004800 01 COLUMN-LINE. 004900 05 FILLER PIC X(2) VALUE "NO". 005000 05 FILLER PIC X(4) VALUE SPACE. 005100 05 FILLER PIC X(12) VALUE "NAME-ADDRESS". 005200 05 FILLER PIC X(33) VALUE SPACE. 005300 05 FILLER PIC X(17) VALUE "CONTACT-PHONE-ZIP". 005400 005500 01 TITLE-LINE. 005600 05 FILLER PIC X(25) VALUE SPACE. 005700 05 FILLER PIC X(11) 005800 VALUE "VENDOR LIST". 005900 05 FILLER PIC X(19) VALUE SPACE. 006000 05 FILLER PIC X(5) VALUE "PAGE:". 006100 05 FILLER PIC X(1) VALUE SPACE. 006200 05 PRINT-PAGE-NUMBER PIC ZZZZ9. 006300 006400 77 FILE-AT-END PIC X. 006500 77 STATE-RECORD-FOUND PIC X VALUE "N". 006600 77 LINE-COUNT PIC 999 VALUE ZERO. 006700 77 PAGE-NUMBER PIC 99999 VALUE ZERO. 006800 77 MAXIMUM-LINES PIC 999 VALUE 55. 006900 007000 PROCEDURE DIVISION. 007100 PROGRAM-BEGIN. 007200 007300 PERFORM OPENING-PROCEDURE. 007400 MOVE ZEROES TO LINE-COUNT 007500 PAGE-NUMBER. 007600 007700 PERFORM START-NEW-PAGE. 007800 007900 MOVE "N" TO FILE-AT-END. 008000 PERFORM READ-NEXT-RECORD. 008100 IF FILE-AT-END = "Y" 008200 MOVE "NO RECORDS FOUND" TO PRINTER-RECORD 008300 PERFORM WRITE-TO-PRINTER 008400 ELSE 008500 PERFORM PRINT-VENDOR-FIELDS 008600 UNTIL FILE-AT-END = "Y". 008700 008800 PERFORM CLOSING-PROCEDURE. 008900 009000 PROGRAM-DONE. 009100 STOP RUN. 009200 009300 OPENING-PROCEDURE. 009400 OPEN I-O VENDOR-FILE. 009500 OPEN I-O STATE-FILE. 009600 OPEN OUTPUT PRINTER-FILE. 009700 009800 CLOSING-PROCEDURE. 009900 CLOSE VENDOR-FILE. 010000 CLOSE STATE-FILE. 010100 PERFORM END-LAST-PAGE. 010200 CLOSE PRINTER-FILE. 010300 010400 PRINT-VENDOR-FIELDS. 010500 IF LINE-COUNT > MAXIMUM-LINES 010600 PERFORM START-NEXT-PAGE. 010700 PERFORM PRINT-THE-RECORD. 010800 PERFORM READ-NEXT-RECORD. 010900 011000 PRINT-THE-RECORD. 011100 PERFORM PRINT-LINE-1. 011200 PERFORM PRINT-LINE-2. 011300 PERFORM PRINT-LINE-3. 011400 PERFORM PRINT-LINE-4. 011500 PERFORM LINE-FEED. 011600 011700 PRINT-LINE-1. 011800 MOVE SPACE TO DETAIL-LINE. 011900 MOVE VENDOR-NUMBER TO PRINT-NUMBER. 012000 MOVE VENDOR-NAME TO PRINT-NAME. 012100 MOVE VENDOR-CONTACT TO PRINT-CONTACT. 012200 MOVE DETAIL-LINE TO PRINTER-RECORD. 012300 PERFORM WRITE-TO-PRINTER. 012400 012500 PRINT-LINE-2. 012600 MOVE SPACE TO DETAIL-LINE. 012700 MOVE VENDOR-ADDRESS-1 TO PRINT-NAME. 012800 MOVE VENDOR-PHONE TO PRINT-CONTACT. 012900 MOVE DETAIL-LINE TO PRINTER-RECORD. 013000 PERFORM WRITE-TO-PRINTER. 013100 013200 PRINT-LINE-3. 013300 MOVE SPACE TO DETAIL-LINE. 013400 MOVE VENDOR-ADDRESS-2 TO PRINT-NAME. 013500 IF VENDOR-ADDRESS-2 NOT = SPACE 013600 MOVE DETAIL-LINE TO PRINTER-RECORD 013700 PERFORM WRITE-TO-PRINTER. 013800 013900 PRINT-LINE-4. 014000 MOVE SPACE TO CITY-STATE-LINE. 014100 MOVE VENDOR-CITY TO PRINT-CITY. 014200 MOVE VENDOR-STATE TO PRINT-STATE. 014300 014400 MOVE VENDOR-STATE TO STATE-CODE. 014500 PERFORM READ-STATE-RECORD. 014600 IF STATE-RECORD-FOUND = "N" 014700 MOVE "***Not Found***" TO STATE-NAME. 014800 MOVE STATE-NAME TO PRINT-STATE-NAME. 014900 015000 MOVE VENDOR-ZIP TO PRINT-ZIP. 015100 MOVE CITY-STATE-LINE TO PRINTER-RECORD. 015200 PERFORM WRITE-TO-PRINTER. 015300 015400 READ-NEXT-RECORD. 015500 READ VENDOR-FILE NEXT RECORD 015600 AT END MOVE "Y" TO FILE-AT-END. 015700 015800 WRITE-TO-PRINTER. 015900 WRITE PRINTER-RECORD BEFORE ADVANCING 1. 016000 ADD 1 TO LINE-COUNT. 016100 016200 LINE-FEED. 016300 MOVE SPACE TO PRINTER-RECORD. 016400 PERFORM WRITE-TO-PRINTER. 016500 016600 START-NEXT-PAGE. 016700 PERFORM END-LAST-PAGE. 016800 PERFORM START-NEW-PAGE. 016900 017000 START-NEW-PAGE. 017100 ADD 1 TO PAGE-NUMBER. 017200 MOVE PAGE-NUMBER TO PRINT-PAGE-NUMBER. 017300 MOVE TITLE-LINE TO PRINTER-RECORD. 017400 PERFORM WRITE-TO-PRINTER. 017500 PERFORM LINE-FEED. 017600 MOVE COLUMN-LINE TO PRINTER-RECORD. 017700 PERFORM WRITE-TO-PRINTER. 017800 PERFORM LINE-FEED. 017900 018000 END-LAST-PAGE. 018100 PERFORM FORM-FEED. 018200 MOVE ZERO TO LINE-COUNT. 018300 018400 FORM-FEED. 018500 MOVE SPACE TO PRINTER-RECORD. 018600 WRITE PRINTER-RECORD BEFORE ADVANCING PAGE. 018700 018800 READ-STATE-RECORD. 018900 MOVE "Y" TO STATE-RECORD-FOUND. 019000 READ STATE-FILE RECORD 019100 INVALID KEY 019200 MOVE "N" TO STATE-RECORD-FOUND. 019300
An example of the output from vndrpt02.cbl shows one record containing an invalid state code and a few records containing lowercase values. These are records that must be fixed so that the information in the file is valid:
OUTPUT:
VENDOR LIST PAGE: 1 NO NAME-ADDRESS CONTACT-PHONE-ZIP 00001 AERIAL SIGNS HENRIETTA MARKSON BURBANK AIRPORT (818) 555-6066 HANGAR 305 BURBANK WX ***Not Found*** 90016 00002 ABC PRINTING CHARLES JOHANSSEN 1624 Foothill Blvd (818) 555-4321 SUITE 34 LOS ANGELES CA CALIFORNIA 91042 00003 CHARLES SMITH AND SONS Martha Harrison 1435 SOUTH STREET (213) 555-4432 LOS ANGELES CA CALIFORNIA 90064 00005 ALIAS SMITH AND JONES ROBIN COUSINS 1216 Main Street 415 555-9203 PALO ALTO CA CALIFORNIA 90061 00014 RANIER GRAPHICS JULIA SIMPSON 4433 WASHINGTON ST (213) 555-6789 LOS ANGELES CA CALIFORNIA 90032 00022 ARTFUL DODGER 123 UNDERWOOD LANE 202 555-1234 MARKHAM WA WASHINGTON 40466 01176 ABERCROMBIE AND OTHERS 1234 45TH ST. (213) 555-6543 SUITE 17 LOS ANGELES CA CALIFORNIA 92345 01440 ZINZINDORFF INC. 1604 7TH ST (213) 555-7234 LOS ANGELES CA CALIFORNIA 90404
ANALYSIS: A SELECT and FD are added for the STATE-FILE. A routine to read the state record, READ-STATE-RECORD, is included at line 018800, and a STATE-RECORD-FOUND variable used in that routine is defined in WORKING-STORAGE at line 006500.
The details for print line 4 containing the city, state code, state, and zip code no longer fit within DETAIL-LINE. Therefore, an additional line, CITY-STATE-LINE, is defined at line 003800 and is used in PRINT-LINE-4, which begins at line 013900.
The logic that uses the state file begins at line 014400 by moving the VENDOR-STATE to STATE-CODE and then reading the record. If the record is not found, the STATE-NAME is filled in with "***Not Found***". The value in STATE-NAME (either the state name or the value "***Not Found***") is moved to PRINT-STATE-NAME. This is part of CITY-STATE-LINE, which also is filled in with the zip code, and then finally printed at line 015200.
On Day 15, you learned that if you are working with a file that contains invalid data, you should track down the program or programs that are putting invalid data in the file and correct the programs. Then correct the data in the file. vndmnt02.cbl fixes the problem in vndmnt01.cbl, but now it is necessary to correct the data.
In order to correct the data, you need to convert the data in the vendor file to uppercase. Once again, you use LOWER-ALPHA and UPPER-ALPHA to do this. You already used them in three or four programs. Listing 16.6, wscase01.cbl, is a COPY file that can be used in any program that has to perform case conversion. It saves having to retype LOWER-ALPHA and UPPER-ALPHA each time they are used and includes comments on how to use them. Remember that the COPY file is included by the compiler, as if you had typed it all.
000100*-------------------------------- 000200* Can be used for case conversion 000300* Ex: 000400* INSPECT data-field 000500* CONVERTING LOWER-ALPHA 000600* TO UPPER-ALPHA. 000700*-------------------------------- 000800 000900 77 UPPER-ALPHA PIC X(26) VALUE 001000 "ABCDEFGHIJKLMNOPQRSTUVWXYZ". 001100 77 LOWER-ALPHA PIC X(26) VALUE 001200 "abcdefghijklmnopqrstuvwxyz". 001300 001400
Listing 16.7 is a program to convert all the fields in the vendor file to uppercase.
000100 IDENTIFICATION DIVISION. 000200 PROGRAM-ID. VNDFIX01. 000300*-------------------------------- 000400* Repairs any lowercase errors in 000500* the vendor file by converting the 000600* the whole record to uppercase. 000700*-------------------------------- 000800 ENVIRONMENT DIVISION. 000900 INPUT-OUTPUT SECTION. 001000 FILE-CONTROL. 001100 001200 COPY "SLVND01.CBL". 001300 001400 DATA DIVISION. 001500 FILE SECTION. 001600 001700 COPY "FDVND03.CBL". 001800 001900 WORKING-STORAGE SECTION. 002000 002100 77 VENDOR-AT-END PIC X VALUE "N". 002200 002300 COPY "WSCASE01.CBL". 002400 002500 PROCEDURE DIVISION. 002600 PROGRAM-BEGIN. 002700 PERFORM OPENING-PROCEDURE. 002800 PERFORM MAIN-PROCESS. 002900 PERFORM CLOSING-PROCEDURE. 003000 003100 PROGRAM-DONE. 003200 STOP RUN. 003300 003400 OPENING-PROCEDURE. 003500 OPEN I-O VENDOR-FILE. 003600 003700 CLOSING-PROCEDURE. 003800 CLOSE VENDOR-FILE. 003900 004000 MAIN-PROCESS. 004100 PERFORM READ-NEXT-VENDOR-RECORD. 004200 PERFORM FIX-VENDOR-RECORDS 004300 UNTIL VENDOR-AT-END = "Y". 004400 004500 FIX-VENDOR-RECORDS. 004600 INSPECT VENDOR-RECORD 004700 CONVERTING LOWER-ALPHA 004800 TO UPPER-ALPHA. 004900 PERFORM REWRITE-VENDOR-RECORD. 005000 005100 PERFORM READ-NEXT-VENDOR-RECORD. 005200 005300 READ-NEXT-VENDOR-RECORD. 005400 MOVE "N" TO VENDOR-AT-END. 005500 READ VENDOR-FILE NEXT RECORD 005600 AT END MOVE "Y" TO VENDOR-AT-END. 005700 005800*or READ VENDOR-FILE NEXT RECORD WITH LOCK 005900* AT END MOVE "Y" TO VENDOR-AT-END. 006000 006100*or READ VENDOR-FILE NEXT RECORD WITH HOLD 006200* AT END MOVE "Y" TO VENDOR-AT-END. 006300 006400 REWRITE-VENDOR-RECORD. 006500 REWRITE VENDOR-RECORD 006600 INVALID KEY 006700 DISPLAY "ERROR REWRITING VENDOR RECORD". 006800
The output of vndrpt02.cbl after vndfix01.cbl has been run verifies that all fields have been converted to uppercase:
OUTPUT:
VENDOR LIST PAGE: 1 NO NAME-ADDRESS CONTACT-PHONE-ZIP 00001 AERIAL SIGNS HENRIETTA MARKSON BURBANK AIRPORT (818) 555-6066 HANGAR 305 BURBANK WX ***Not Found*** 90016 00002 ABC PRINTING CHARLES JOHANSSEN 1624 FOOTHILL BLVD (818) 555-4321 SUITE 34 LOS ANGELES CA CALIFORNIA 91042 00003 CHARLES SMITH AND SONS MARTHA HARRISON 1435 SOUTH STREET (213) 555-4432 LOS ANGELES CA CALIFORNIA 90064 00005 ALIAS SMITH AND JONES ROBIN COUSINS 1216 MAIN STREET 415 555-9203 PALO ALTO CA CALIFORNIA 90061 00014 RANIER GRAPHICS JULIA SIMPSON 4433 WASHINGTON ST (213) 555-6789 LOS ANGELES CA CALIFORNIA 90032 00022 ARTFUL DODGER 123 UNDERWOOD LANE 202 555-1234 MARKHAM WA WASHINGTON 40466 01176 ABERCROMBIE AND OTHERS 1234 45TH ST. (213) 555-6543 SUITE 17 LOS ANGELES CA CALIFORNIA 92345 01440 ZINZINDORFF INC. 1604 7TH ST (213) 555-7234 LOS ANGELES CA CALIFORNIA 90404
The final error in vendor number 00001 is an invalid state code. This should be corrected manually. Determine the correct code and enter it manually using vndmnt02.cbl. The final corrected output of vndrpt02.cbl shows a clean file with all data corrected:
OUTPUT:
VENDOR LIST PAGE: 1 NO NAME-ADDRESS CONTACT-PHONE-ZIP 00001 AERIAL SIGNS HENRIETTA MARKSON BURBANK AIRPORT (818) 555-6066 HANGAR 305 BURBANK CA CALIFORNIA 90016 00002 ABC PRINTING CHARLES JOHANSSEN 1624 FOOTHILL BLVD (818) 555-4321 SUITE 34 LOS ANGELES CA CALIFORNIA 91042 00003 CHARLES SMITH AND SONS MARTHA HARRISON 1435 SOUTH STREET (213) 555-4432 LOS ANGELES CA CALIFORNIA 90064 00005 ALIAS SMITH AND JONES ROBIN COUSINS 1216 MAIN STREET 415 555-9203 PALO ALTO CA CALIFORNIA 90061 00014 RANIER GRAPHICS JULIA SIMPSON 4433 WASHINGTON ST (213) 555-6789 LOS ANGELES CA CALIFORNIA 90032 00022 ARTFUL DODGER 123 UNDERWOOD LANE 202 555-1234 MARKHAM WA WASHINGTON 40466 01176 ABERCROMBIE AND OTHERS 1234 45TH ST. (213) 555-6543 SUITE 17 LOS ANGELES CA CALIFORNIA 92345 01440 ZINZINDORFF INC. 1604 7TH ST (213) 555-7234 LOS ANGELES CA CALIFORNIA 90404
ANALYSIS: This program performs a simple task. It reads each vendor record, converts the whole record to uppercase, and then rewrites the record.
At line 002300, the COPY file for case conversions, wscase01.cbl, is included. The MAIN-PROCESS at line 004000 uses the standard file processing loop of reading the first record and then processing the record until the file ends. The main processing loop is FIX-VENDOR-RECORDS at line 004500. This applies the case conversion to the entire vendor record and then rewrites the record. At the end of the loop at line 005100, the next record is read.
On large systems that require a lock or a hold before a record can be changed, READ NEXT also comes with a LOCK or HOLD version. These versions appear commented out at lines 005800 through 006200 in case you need to use them.
Code, compile, and run vndfix01.cbl to correct the vendor file. Use vndrpt02.cbl to verify that the case conversions have occurred.
The vndrpt02.cbl program performs file I/O (Input/Output) operations on two different files: the vendor file and the state code file. File I/O operations take time. Disk drives are very slow compared to main memory.
For a small vendor file, this is not particularly a problem. If the vendor file contains 80,000 records, however, the program will have to perform 160,000 file I/O operations--one for each vendor record and one for each state code associated with each vendor record.
Whenever you can avoid performing file operations you should do so, but it is unavoidable that files will be accessed by a computer program. Otherwise, a program would have no way of storing and retrieving information. Although the vndrpt02.cbl program has to read through the vendor file to extract all of the information for the report, it is possible to avoid having to read the state code file so many times.
The state code file is small enough (probably 50 records minimum) that it could all be loaded into memory once, and then the state codes could be looked up in memory. It would take 50 file I/O operations to load the state code file into memory and 80,000 file I/O operations to read the vendor file. No additional file I/O operations are needed to look up the state codes in memory. This total of 80,050 operations is close to half of the original 160,000 and represents a substantial increase in the speed of the program.
In order to do this, you use a table or an array to load a file into memory.
New Term: A table or an array is an area of memory that has been set aside and organized in such a way that it can hold multiple occurrences of the same type of information.
Returning to the file card analogy, using a table in a program is equivalent to pulling the cards out of a card file box and laying them out on the desk, as shown in Figure 16.4. This analogy doesn't hold up completely, because you can't actually pull records out of a file and arrange them in memory, but you can read each record in a file and arrange the data from each record in memory.
Figure 16.4.
Turning a file into a table.
Listing 16.8 is the record for the state code file. What you need is a place in memory to hold 50 occurrences of the data in the STATE-RECORD.
000100*-------------------------------- 000200* FDSTATE.CBL 000300* Primary Key - STATE-CODE 000400* NAME is required 000500* NAME and CODE should be uppercase 000600*-------------------------------- 000700 FD STATE-FILE 000800 LABEL RECORDS ARE STANDARD. 000900 01 STATE-RECORD. 001000 05 STATE-CODE PIC X(2). 001100 05 STATE-NAME PIC X(20). 001200
Listing 16.9 can be set up in working storage and contains fields that are the same size as the state code and state name fields of the state code file. You load this into memory by reading the state record and then moving STATE-CODE to TABLE-STATE-CODE and STATE-NAME to TABLE-STATE-NAME.
007000 01 TABLE-STATE-RECORD. 007100 05 TABLE-STATE-CODE PIC XX. 007200 05 TABLE-STATE-NAME PIC X(20).
Listing 16.9 allows for only one occurrence of the state information--and you need 50 occurrences. This is handled by adding an OCCURS clause after the TABLE-STATE-RECORD, as shown in Listing 16.10. This creates space in memory for 50 occurrences of TABLE-STATE-RECORD. The TABLE-STATE-RECORD is 22 bytes long, so this reserves 1,100 bytes (50x22).
007000 01 TABLE-STATE-RECORD OCCURS 50 TIMES. 007100 05 TABLE-STATE-CODE PIC XX. 007200 05 TABLE-STATE-NAME PIC X(20).
ANALYSIS: Adding the OCCURS 50 TIMES works as if you had typed lines 007000 through 007200 in Listing 16.9 50 times. This creates 50 occurrences of TABLE-STATE-RECORD. It also creates multiple occurrences of all the subordinate variables, so 50 occurrences of TABLE-STATE-CODE and TABLE-STATE-NAME are also within the 50 occurrences of TABLE-STATE-RECORD.
If you move something to or from a table variable TABLE-STATE-RECORD (or TABLE-STATE-CODE or TABLE-STATE-NAME), you must add some additional information to identify to or from which occurrence you are moving. You single out a specific variable in a table by adding a number in parentheses after the variable name. This number is called an index or a subscript. This is not the same index as the index to a file, but it is a number that identifies which occurrence of the variable is being referenced. Several examples of this are given in Listing 16.11.
018000 MOVE SPACE TO TABLE-STATE-RECORD(5). 018100 MOVE STATE-CODE TO TABLE-STATE-CODE(1). 018200 MOVE STATE-NAME TO TABLE-STATE-NAME(15). 018300 DISPLAY TABLE-STATE-NAME(23). 018400 MOVE TABLE-STATE-CODE(43) TO PRINT-CODE.
The examples in Listing 16.11 are not from a real program and don't do anything; they are only examples of the syntax for accessing a table variable with an index or subscript. The index itself can be a variable, as in lines 018500 and 018600 of Listing 16.12.
018500 MOVE 53 TO STATE-INDEX. 018600 DISPLAY TABLE-STATE-CODE(STATE-INDEX).
New Term: When you define a table (array), you also can (and usually should) define a variable that specifically is intended to be used as the index for that table. This is called an index variable. Listing 16.13 shows an example of the syntax for a table in which STATE-INDEX is the index variable for the TABLE-STATE-RECORD.
Several special commands can be used on tables if the table is given an index. An index variable is given a special status in COBOL programs. It requires no picture or definition other than what is shown in Listing 16.13 at line 007100, but it cannot be used for anything other than as an index to variables in the table.
007000 01 TABLE-STATE-RECORD OCCURS 50 TIMES 007100 INDEXED BY STATE-INDEX. 007200 05 TABLE-STATE-CODE PIC XX. 007300 05 TABLE-STATE-NAME PIC X(20).
Although an index variable such as STATE-INDEX is used as a number that indicates the occurrence of a variable, you can't treat it like a numeric variable. You can't use the COBOL math verbs on it, so you cannot ADD, SUBTRACT, MULTIPLY, or DIVIDE with it.
In order to manipulate an index variable, you must use the SET command. Here is the syntax:
SET index variable TO value
SET index variable UP
BY value
SET index variable DOWN
BY value
The following are examples:
SET STATE-INDEX TO 1
SET STATE-INDEX TO A-VALUE
SET STATE-INDEX UP BY 1
SET STATE-INDEX UP
BY NEXT-AMOUNT
SET STATE-INDEX DOWN BY 1
SET STATE-INDEX DOWN
BY LAST-AMOUNT
You can use an index variable in a PERFORM VARYING command. Use this syntax:
PERFORM paragraph
VARYING index variable
FROM value BY value
UNTIL condition.
The following is an example:
PERFORM CLEAR-TABLE
VARYING STATE-INDEX
FROM 1 BY 1
UNTIL STATE-INDEX > 50.
Listing 16.14 is sttbrp01.cbl (state code table report). It is based on stcrpt01.cbl, but it prints a report in the state code file by first loading a table of all the state codes and then printing the codes from the table. (In practice, you usually wouldn't use this approach because it doesn't save any time, but I want you to gain some familiarity with table basics before going on to the next topic.)
000100 IDENTIFICATION DIVISION. 000200 PROGRAM-ID. STTBRP01. 000300*-------------------------------- 000400* Report on the STATE File. 000500*-------------------------------- 000600 ENVIRONMENT DIVISION. 000700 INPUT-OUTPUT SECTION. 000800 FILE-CONTROL. 000900 001000 COPY "SLSTATE.CBL". 001100 001200 SELECT PRINTER-FILE 001300 ASSIGN TO PRINTER 001400 ORGANIZATION IS LINE SEQUENTIAL. 001500 001600 DATA DIVISION. 001700 FILE SECTION. 001800 001900 COPY "FDSTATE.CBL". 002000 002100 FD PRINTER-FILE 002200 LABEL RECORDS ARE OMITTED. 002300 01 PRINTER-RECORD PIC X(80). 002400 002500 WORKING-STORAGE SECTION. 002600 002700 01 DETAIL-LINE. 002800 05 PRINT-CODE PIC XX. 002900 05 FILLER PIC XXXX VALUE SPACE. 003000 05 PRINT-NAME PIC X(20). 003100 003200 01 COLUMN-LINE. 003300 05 FILLER PIC X(4) VALUE "CODE". 003400 05 FILLER PIC X(2) VALUE SPACE. 003500 05 FILLER PIC X(4) VALUE "NAME". 003600 003700 01 TITLE-LINE. 003800 05 FILLER PIC X(25) VALUE SPACE. 003900 05 FILLER PIC X(11) 004000 VALUE "STATE CODES". 004100 05 FILLER PIC X(15) VALUE SPACE. 004200 05 FILLER PIC X(5) VALUE "PAGE:". 004300 05 FILLER PIC X(1) VALUE SPACE. 004400 05 PRINT-PAGE-NUMBER PIC ZZZZ9. 004500 004600 77 FILE-AT-END PIC X. 004700 77 LINE-COUNT PIC 999 VALUE ZERO. 004800 77 PAGE-NUMBER PIC 99999 VALUE ZERO. 004900 77 MAXIMUM-LINES PIC 999 VALUE 55. 005000 005100 01 TABLE-STATE-RECORD OCCURS 50 TIMES 005200 INDEXED BY STATE-INDEX. 005300 05 TABLE-STATE-CODE PIC XX. 005400 05 TABLE-STATE-NAME PIC X(20). 005500 005600 PROCEDURE DIVISION. 005700 PROGRAM-BEGIN. 005800 005900 PERFORM OPENING-PROCEDURE. 006000 MOVE ZEROES TO LINE-COUNT 006100 PAGE-NUMBER. 006200 006300 PERFORM START-NEW-PAGE. 006400 006500 SET STATE-INDEX TO 1. 006600 PERFORM PRINT-STATE-FIELDS 006700 UNTIL STATE-INDEX > 50 OR 006800 TABLE-STATE-RECORD(STATE-INDEX) = SPACE. 006900 007000 PERFORM CLOSING-PROCEDURE. 007100 007200 PROGRAM-DONE. 007300 STOP RUN. 007400 007500 OPENING-PROCEDURE. 007600 007700 OPEN I-O STATE-FILE. 007800 PERFORM LOAD-STATE-TABLE. 007900 CLOSE STATE-FILE. 008000 008100 OPEN OUTPUT PRINTER-FILE. 008200 008300 LOAD-STATE-TABLE. 008400 PERFORM CLEAR-TABLE. 008500 SET STATE-INDEX TO 1. 008600 PERFORM READ-NEXT-RECORD. 008700 PERFORM LOAD-ONE-STATE-RECORD 008800 UNTIL FILE-AT-END = "Y" OR 008900 STATE-INDEX > 50. 009000 009100 CLEAR-TABLE. 009200 PERFORM CLEAR-ONE-TABLE-ROW 009300 VARYING STATE-INDEX FROM 1 BY 1 009400 UNTIL STATE-INDEX > 50. 009500 009600 CLEAR-ONE-TABLE-ROW. 009700 MOVE SPACE TO TABLE-STATE-RECORD(STATE-INDEX). 009800 009900 LOAD-ONE-STATE-RECORD. 010000 MOVE STATE-CODE TO TABLE-STATE-CODE(STATE-INDEX). 010100 MOVE STATE-NAME TO TABLE-STATE-NAME(STATE-INDEX). 010200 010300 PERFORM READ-NEXT-RECORD. 010400 010500 IF FILE-AT-END NOT = "Y" 010600 SET STATE-INDEX UP BY 1 010700 IF STATE-INDEX > 50 010800 DISPLAY "TABLE FULL". 010900 011000 CLOSING-PROCEDURE. 011100 PERFORM END-LAST-PAGE. 011200 CLOSE PRINTER-FILE. 011300 011400 PRINT-STATE-FIELDS. 011500 IF LINE-COUNT > MAXIMUM-LINES 011600 PERFORM START-NEXT-PAGE. 011700 PERFORM PRINT-THE-RECORD. 011800 SET STATE-INDEX UP BY 1. 011900 012000 PRINT-THE-RECORD. 012100 MOVE SPACE TO DETAIL-LINE. 012200 MOVE TABLE-STATE-CODE(STATE-INDEX) TO PRINT-CODE. 012300 MOVE TABLE-STATE-NAME(STATE-INDEX) TO PRINT-NAME. 012400 MOVE DETAIL-LINE TO PRINTER-RECORD. 012500 PERFORM WRITE-TO-PRINTER. 012600 012700 READ-NEXT-RECORD. 012800 READ STATE-FILE NEXT RECORD 012900 AT END MOVE "Y" TO FILE-AT-END. 013000 013100 WRITE-TO-PRINTER. 013200 WRITE PRINTER-RECORD BEFORE ADVANCING 1. 013300 ADD 1 TO LINE-COUNT. 013400 013500 LINE-FEED. 013600 MOVE SPACE TO PRINTER-RECORD. 013700 PERFORM WRITE-TO-PRINTER. 013800 013900 START-NEXT-PAGE. 014000 014100 PERFORM END-LAST-PAGE. 014200 PERFORM START-NEW-PAGE. 014300 014400 START-NEW-PAGE. 014500 ADD 1 TO PAGE-NUMBER. 014600 MOVE PAGE-NUMBER TO PRINT-PAGE-NUMBER. 014700 MOVE TITLE-LINE TO PRINTER-RECORD. 014800 PERFORM WRITE-TO-PRINTER. 014900 PERFORM LINE-FEED. 015000 MOVE COLUMN-LINE TO PRINTER-RECORD. 015100 PERFORM WRITE-TO-PRINTER. 015200 PERFORM LINE-FEED. 015300 015400 END-LAST-PAGE. 015500 PERFORM FORM-FEED. 015600 MOVE ZERO TO LINE-COUNT. 015700 015800 FORM-FEED. 015900 MOVE SPACE TO PRINTER-RECORD. 016000 WRITE PRINTER-RECORD BEFORE ADVANCING PAGE. 016100
The output report of sttbrp01.cbl should be identical to the output report created by stcrpt01.cbl:
OUTPUT:
STATE CODES PAGE: 1 CODE NAME AK ARKANSAS AL ALASKA AZ ARIZONA CA CALIFORNIA FL FLORIDA LA LOUISIANA NC NORTH CAROLINA NH NEW HAMPSHIRE NM NEW MEXICO NY NEW YORK SC SOUTH CAROLINA WA WASHINGTON WI WISCONSIN
ANALYSIS: The table is defined at line 005100 in WORKING-STORAGE.
The state code file is opened, loaded into the table, and closed--all within the OPENING-PROCEDURE, which starts at line 007500.
The LOAD-STATE-TABLE paragraph at line 008300 starts by clearing the table, using the CLEAR-TABLE routine at lines 009100 through 009800. This is a simple routine that moves spaces to each occurrence of TABLE-STATE-RECORD by varying the STATE-INDEX from 1 through 50.
Back at LOAD-STATE-TABLE, at lines 008500 through 008900, the STATE-INDEX is set to 1, the first record in the STATE-FILE is read, and then the table is loaded one record at a time by performing LOAD-ONE-STATE-RECORD until the state file reaches an end or the STATE-INDEX exceeds 50.
LOAD-ONE-STATE-RECORD at line 009900 loads the table elements from the fields in the record and then, at the bottom of the loop (line 010300), reads the next record. If the read is successful, the STATE-INDEX is set up by 1, and if the STATE-INDEX has exceeded 50, an error message is displayed.
This error check is important. If by some accident the state file contained more than 50 records, the records would not load correctly into memory. If the index variable is set to 51, and only 50 elements are in the table, moving a value to TABLE-STATE-CODE(STATE-INDEX) or TABLE-STATE-NAME(STATE-INDEX) has completely unpredictable results. Under some conditions, the program will abort with a warning that an attempt was made to move a value outside the boundaries of the table. Under other conditions, the move succeeds and the values will corrupt some other memory in the program.
If the state file does exceed 50 entries and they are legitimate, you must edit the program so that the table is larger by changing the OCCURS count at line 005100. You will also need to change the value 50 where it occurs in lines 006700, 008900, 009400, and 010700.
The main program loop is set up at line 006500 by setting the STATE-INDEX to 1, and then the main loop is performed until STATE-INDEX > 50 or TABLE-STATE-RECORD(STATE-INDEX) = SPACES. A STATE-TABLE-RECORD might be SPACES if the file did not contain a full 50 records, so printing is stopped as if the whole array had been printed.
The main loop is at line 011400, which is PRINT-STATE-FIELDS. At the end of the loop at line 011800, the loop control variable STATE-INDEX is set UP BY 1.
The printing portion of the program at begins at line 012000. PRINT-THE-RECORD fills in the print line by moving TABLE-STATE-CODE(STATE-INDEX) to PRINT-CODE and TABLE-STATE-NAME(STATE-INDEX) to PRINT-NAME.
You should be able to create sttbrp01.cbl fairly easily by copying stcrpt01.cbl and making modifications to it to match Listing 16.14.
Code, compile, and run sttbrp01.cbl and then rerun stcrpt01.cbl. The output from both programs should be identical. Remember that you usually would not use this style of table operation for a report of this nature. The next example is a much better use of tables.
The real power of tables (arrays) is that they can be searched very quickly for values, and COBOL provides a special command to do it. If a table has been defined with an index variable, the SEARCH command can be used to search the table for a specific piece of information.
The SEARCH command starts from the current value of the index variable, so it is important to remember to set the index to 1 before the search begins.
The search syntax includes an AT END clause that is optional. The COBOL program knows the size of the table, and it knows whether the index has reached the limit of the table. If this occurs, the command following AT END is executed. Otherwise, the SEARCH command starts from the current index variable value and performs the test described by the WHEN condition. If the condition is true, the command associated with the WHEN is executed and the search is ended. The following is the syntax:
SEARCH table name
[AT END
do something ]
WHEN condition
do something.
Here is an example:
SET STATE-INDEX TO 1.
SEARCH TABLE-STATE-RECORD
AT END
PERFORM SEARCH-FAILED
WHEN
VENDOR-STATE =
TABLE-STATE-CODE(STATE-INDEX)
PERFORM SEARCH-SUCCEEDED
Listing 16.15, vndrpt03.cbl, is a modified version of vndrpt02.cbl, and it uses a table for the state codes.
000100 IDENTIFICATION DIVISION. 000200 PROGRAM-ID. VNDRPT03. 000300*-------------------------------- 000400* Report on the Vendor File. 000500*-------------------------------- 000600 ENVIRONMENT DIVISION. 000700 INPUT-OUTPUT SECTION. 000800 FILE-CONTROL. 000900 001000 COPY "SLVND01.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 "FDVND02.CBL". 002200 002300 COPY "FDSTATE.CBL". 002400 002500 FD PRINTER-FILE 002600 LABEL RECORDS ARE OMITTED. 002700 01 PRINTER-RECORD PIC X(80). 002800 002900 WORKING-STORAGE SECTION. 003000 003100 01 DETAIL-LINE. 003200 05 PRINT-NUMBER PIC 9(5). 003300 05 FILLER PIC X VALUE SPACE. 003400 05 PRINT-NAME PIC X(30). 003500 05 FILLER PIC X(15) VALUE SPACE. 003600 05 PRINT-CONTACT PIC X(30). 003700 003800 01 CITY-STATE-LINE. 003900 05 FILLER PIC X(6) VALUE SPACE. 004000 05 PRINT-CITY PIC X(20). 004100 05 FILLER PIC X VALUE SPACE. 004200 05 PRINT-STATE PIC X(2). 004300 05 FILLER PIC X VALUE SPACE. 004400 05 PRINT-STATE-NAME PIC X(20). 004500 05 FILLER PIC X(1) VALUE SPACE. 004600 05 PRINT-ZIP PIC X(10). 004700 004800 01 COLUMN-LINE. 004900 05 FILLER PIC X(2) VALUE "NO". 005000 05 FILLER PIC X(4) VALUE SPACE. 005100 05 FILLER PIC X(12) VALUE "NAME-ADDRESS". 005200 05 FILLER PIC X(33) VALUE SPACE. 005300 05 FILLER PIC X(17) VALUE "CONTACT-PHONE-ZIP". 005400 005500 01 TITLE-LINE. 005600 05 FILLER PIC X(25) VALUE SPACE. 005700 05 FILLER PIC X(11) 005800 VALUE "VENDOR LIST". 005900 05 FILLER PIC X(19) VALUE SPACE. 006000 05 FILLER PIC X(5) VALUE "PAGE:". 006100 05 FILLER PIC X(1) VALUE SPACE. 006200 05 PRINT-PAGE-NUMBER PIC ZZZZ9. 006300 006400 77 FILE-AT-END PIC X. 006500 77 STATE-FILE-AT-END PIC X VALUE "N". 006600 77 LINE-COUNT PIC 999 VALUE ZERO. 006700 77 PAGE-NUMBER PIC 99999 VALUE ZERO. 006800 77 MAXIMUM-LINES PIC 999 VALUE 55. 006900 007000 01 TABLE-STATE-RECORD OCCURS 50 TIMES 007100 INDEXED BY STATE-INDEX. 007200 05 TABLE-STATE-CODE PIC XX. 007300 05 TABLE-STATE-NAME PIC X(20). 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. 009700 009800 OPENING-PROCEDURE. 009900 OPEN I-O VENDOR-FILE. 010000 010100 OPEN I-O STATE-FILE. 010200 PERFORM LOAD-STATE-TABLE. 010300 CLOSE STATE-FILE. 010400 010500 OPEN OUTPUT PRINTER-FILE. 010600 010700 LOAD-STATE-TABLE. 010800 PERFORM CLEAR-TABLE. 010900 SET STATE-INDEX TO 1. 011000 PERFORM READ-NEXT-STATE-RECORD. 011100 PERFORM LOAD-ONE-STATE-RECORD 011200 UNTIL STATE-FILE-AT-END = "Y" OR 011300 STATE-INDEX > 50. 011400 011500 CLEAR-TABLE. 011600 PERFORM CLEAR-ONE-TABLE-ROW 011700 VARYING STATE-INDEX FROM 1 BY 1 011800 UNTIL STATE-INDEX > 50. 011900 012000 CLEAR-ONE-TABLE-ROW. 012100 MOVE SPACE TO TABLE-STATE-RECORD(STATE-INDEX). 012200 012300 LOAD-ONE-STATE-RECORD. 012400 MOVE STATE-CODE TO TABLE-STATE-CODE(STATE-INDEX). 012500 MOVE STATE-NAME TO TABLE-STATE-NAME(STATE-INDEX). 012600 012700 PERFORM READ-NEXT-STATE-RECORD. 012800 012900 IF STATE-FILE-AT-END NOT = "Y" 013000 SET STATE-INDEX UP BY 1 013100 IF STATE-INDEX > 50 013200 DISPLAY "TABLE FULL". 013300 013400 CLOSING-PROCEDURE. 013500 CLOSE VENDOR-FILE. 013600 PERFORM END-LAST-PAGE. 013700 CLOSE PRINTER-FILE. 013800 013900 PRINT-VENDOR-FIELDS. 014000 IF LINE-COUNT > MAXIMUM-LINES 014100 PERFORM START-NEXT-PAGE. 014200 PERFORM PRINT-THE-RECORD. 014300 PERFORM READ-NEXT-RECORD. 014400 014500 PRINT-THE-RECORD. 014600 PERFORM PRINT-LINE-1. 014700 PERFORM PRINT-LINE-2. 014800 PERFORM PRINT-LINE-3. 014900 PERFORM PRINT-LINE-4. 015000 PERFORM LINE-FEED. 015100 015200 PRINT-LINE-1. 015300 MOVE SPACE TO DETAIL-LINE. 015400 MOVE VENDOR-NUMBER TO PRINT-NUMBER. 015500 MOVE VENDOR-NAME TO PRINT-NAME. 015600 MOVE VENDOR-CONTACT TO PRINT-CONTACT. 015700 MOVE DETAIL-LINE TO PRINTER-RECORD. 015800 PERFORM WRITE-TO-PRINTER. 015900 016000 PRINT-LINE-2. 016100 MOVE SPACE TO DETAIL-LINE. 016200 MOVE VENDOR-ADDRESS-1 TO PRINT-NAME. 016300 MOVE VENDOR-PHONE TO PRINT-CONTACT. 016400 MOVE DETAIL-LINE TO PRINTER-RECORD. 016500 PERFORM WRITE-TO-PRINTER. 016600 016700 PRINT-LINE-3. 016800 MOVE SPACE TO DETAIL-LINE. 016900 MOVE VENDOR-ADDRESS-2 TO PRINT-NAME. 017000 IF VENDOR-ADDRESS-2 NOT = SPACE 017100 MOVE DETAIL-LINE TO PRINTER-RECORD 017200 PERFORM WRITE-TO-PRINTER. 017300 017400 PRINT-LINE-4. 017500 MOVE SPACE TO CITY-STATE-LINE. 017600 MOVE VENDOR-CITY TO PRINT-CITY. 017700 MOVE VENDOR-STATE TO PRINT-STATE. 017800 017900 PERFORM LOOK-UP-STATE-CODE. 018000 018100 MOVE VENDOR-ZIP TO PRINT-ZIP. 018200 MOVE CITY-STATE-LINE TO PRINTER-RECORD. 018300 PERFORM WRITE-TO-PRINTER. 018400 018500 LOOK-UP-STATE-CODE. 018600 SET STATE-INDEX TO 1. 018700 SEARCH TABLE-STATE-RECORD 018800 AT END 018900 MOVE "***Not Found***" TO PRINT-STATE-NAME 019000 WHEN VENDOR-STATE = TABLE-STATE-CODE(STATE-INDEX) 019100 MOVE TABLE-STATE-NAME(STATE-INDEX) 019200 TO PRINT-STATE-NAME. 019300 019400 IF STATE-NAME = SPACE 019500 MOVE "*State is Blank*" TO PRINT-STATE-NAME. 019600 019700 READ-NEXT-RECORD. 019800 READ VENDOR-FILE NEXT RECORD 019900 AT END MOVE "Y" TO FILE-AT-END. 020000 020100 WRITE-TO-PRINTER. 020200 WRITE PRINTER-RECORD BEFORE ADVANCING 1. 020300 ADD 1 TO LINE-COUNT. 020400 020500 LINE-FEED. 020600 MOVE SPACE TO PRINTER-RECORD. 020700 PERFORM WRITE-TO-PRINTER. 020800 020900 START-NEXT-PAGE. 021000 PERFORM END-LAST-PAGE. 021100 PERFORM START-NEW-PAGE. 021200 021300 START-NEW-PAGE. 021400 ADD 1 TO PAGE-NUMBER. 021500 MOVE PAGE-NUMBER TO PRINT-PAGE-NUMBER. 021600 MOVE TITLE-LINE TO PRINTER-RECORD. 021700 PERFORM WRITE-TO-PRINTER. 021800 PERFORM LINE-FEED. 021900 MOVE COLUMN-LINE TO PRINTER-RECORD. 022000 PERFORM WRITE-TO-PRINTER. 022100 PERFORM LINE-FEED. 022200 022300 END-LAST-PAGE. 022400 PERFORM FORM-FEED. 022500 MOVE ZERO TO LINE-COUNT. 022600 022700 FORM-FEED. 022800 MOVE SPACE TO PRINTER-RECORD. 022900 WRITE PRINTER-RECORD BEFORE ADVANCING PAGE. 023000 023100 READ-NEXT-STATE-RECORD. 023200 MOVE "N" TO STATE-FILE-AT-END. 023300 READ STATE-FILE NEXT RECORD 023400 AT END 023500 MOVE "Y" TO STATE-FILE-AT-END. 023600
ANALYSIS: The definition of the TABLE-STATE-RECORD occurs at lines 007000 through 007300.
At lines 009800 through 010500, the opening procedure has been modified to open the STATE-FILE, load it into a table, and then close the file. The STATE-FILE itself is no longer needed in the program because all the information has been pulled into memory.
The LOAD-STATE-TABLE paragraph, at line 010700, starts by clearing the table using the CLEAR-TABLE routine at lines 011500 through 012100. This is a simple routine that moves spaces to each occurrence of TABLE-STATE-RECORD by varying the STATE-INDEX from 1 through 50.
Back at LOAD-STATE-TABLE, at lines 010900 through 011300, the STATE-INDEX is set to 1, the first record in the STATE-FILE is read, and then the table is loaded one record at a time by performing LOAD-ONE-STATE-RECORD until the state file reaches an end or the STATE-INDEX exceeds 50.
LOAD-ONE-STATE-RECORD at line 012300 loads the table elements from the fields in the record and then, at the bottom of the loop (line 012700), reads the next record. If the read is successful, the STATE-INDEX is set up by 1, and if the STATE-INDEX has exceeded 50, an error message is displayed.
If the state file does exceed 50 entries and they are legitimate, it is necessary to edit the program so that the table is larger by changing the OCCURS count at line 007000. You will also need to change the value 50 at lines 011300, 011330, 011800, and 013100.
The logic for using the table begins in PRINT-LINE-4 at line 017400, where LOOK-UP-STATE-CODE is performed in order to locate the state name.
LOOK-UP-STATE-CODE at line 018500 starts by setting the state index to 1, and then the search is performed at lines 018700 through 019200. The search attempts to match the VENDOR-STATE to the TABLE-STATE-CODE(STATE-INDEX) and, if successful, the TABLE-STATE-NAME(STATE-INDEX) is moved to PRINT-STATE-NAME.
If the match fails, the AT END logic at lines 018800 and 018900 takes over, and a "***Not Found***" message is moved to PRINT-STATE-NAME.
At line 019400, one final test is made to check whether the PRINT-STATE-NAME field is still blank. This is a case of being extra safe. If the state file does not contain all 50 states, some of the table entries will contain spaces. If a vendor record contains a VENDOR-STATE that is spaces (which is invalid), the search will find a match, because somewhere in the table after the actual entries, VENDOR-STATE = TABLE-STATE-CODE(STATE-INDEX) will be true because both variables contain spaces. This is caused by invalid data in the vendor file, so an extra message is displayed.
Code, compile, and run vndrpt03.cbl. The output should be identical to vndrpt02.cbl. You probably won't notice a speed difference unless you have many records in your vendor file, but you will know how to use tables.
The code in vndrpt03.cbl can be improved even more, by creating an additional variable containing NUMBER-OF-STATES as in the following:
01 NUMBER-OF-STATES PIC 99 VALUE 50.
When 50 is used in the code, use the variable instead, as in the following two examples.
011200 UNTIL STATE-FILE-AT-END = "Y" OR 011300 STATE-INDEX > NUMBER-OF-STATES. 013100 IF STATE-INDEX > NUMBER-OF-STATES 013200 DISPLAY "TABLE FULL".
The advantage of this is that if the number of states is increased by adding DC, VI for Virgin Islands, PR for Puerto Rico and so on, it is possible to modify the program to accommodate the larger table by changing only two lines of code.
007000 01 TABLE-STATE-RECORD OCCURS 50 TIMES 007100 INDEXED BY STATE-INDEX.
becomes
007000 01 TABLE-STATE-RECORD OCCURS 60 TIMES 007100 INDEXED BY STATE-INDEX.
and
01 NUMBER-OF-STATES PIC 99 VALUE 50.
becomes
01 NUMBER-OF-STATES PIC 99 VALUE 60.
One of the main methods of validating entered data is to look up the information in another file that contains correct information. Today, you learned the following basics:
012400 MOVE STATE-CODE TO TABLE-STATE-CODE(STATE-INDEX). 012500 MOVE STATE-NAME TO TABLE-STATE-NAME(STATE-INDEX).
A Yes. STATE-RECORD and STATE-TABLE-RECORD(STATE-INDEX) are both alphanumeric variables, and you always can move one to the other:
012400 MOVE STATE-RECORD TO TABLE-STATE-RECORD(STATE-INDEX).
000900 01 STATE-RECORD. 001000 05 STATE-CODE PIC X(2). 001100 05 STATE-NAME PIC X(20).
007000 01 TABLE-STATE-RECORD OCCURS 50 TIMES 007100 INDEXED BY STATE-INDEX. 007200 05 TABLE-STATE-CODE PIC XX. 007300 05 TABLE-STATE-NAME PIC X(20).
018300 MOVE 14 TO STATE-INDEX. 018400 MOVE "XX" TO TABLE-STATE-CODE(STATE-INDEX).
002000 01 VENDOR-RECORD. 002100 05 VENDOR-NUMBER PIC 9(5). 002200 05 VENDOR-NAME PIC X(30). 002300 05 VENDOR-ADDRESS-1 PIC X(30). 002400 05 VENDOR-ADDRESS-2 PIC X(30). 002500 05 VENDOR-CITY PIC X(20). 002600 05 VENDOR-STATE PIC X(2). 002700 05 VENDOR-ZIP PIC X(10). 002800 05 VENDOR-CONTACT PIC X(30). 002900 05 VENDOR-PHONE PIC X(15).
© Copyright, Macmillan Computer Publishing. All rights reserved.