The real power of COBOL data processing lies in indexed files. They are the central repository of data for virtually every COBOL system in use. Today, you learn about the following topics:
From Day 9, "File I/O," and Day 10, "Printing," you learned that sequential files allow you to add records to the end of the file and you learned how to do that. You also learned that sequential files only allow you to process the file one record at a time, from beginning to end, and you learned some techniques to execute that style of file processing. This method is acceptable for small files, but businesses can process files containing thousands of customers and hundreds of thousands of parts. Imagine how many records the customer file of a large bank or the inventory file of a car parts store might have.
An indexed file can store the same information as a sequential file, but a separate index is created that keeps the records sorted in alphabetical or numerical order. When you create an indexed file, you specify which fields to use for the indexing. When you write records to an indexed file, the index in the file is kept sorted in order by the index. You can use these index fields to retrieve records rapidly in a sequence that is different from the actual order of the records in the file.
Listing 11.1 shows a customer record. This is a fairly straightforward record layout except that the phone number has been broken down into area code, prefix, and number.
001100 01 CUSTOMER-RECORD. 001200 05 CUSTOMER-NAME PIC X(20). 001300 05 CUSTOMER-ADDRESS-1 PIC X(20). 001400 05 CUSTOMER-ADDRESS-2 PIC X(20). 001500 05 CUSTOMER-ZIP PIC 9(5). 001600 05 CUSTOMER-PHONE. 001700 10 CUSTOMER-AREA-CODE PIC 9(3). 001800 10 CUSTOMER-PREFIX PIC 9(3). 001900 10 CUSTOMER-PHONE-NO PIC 9(4).
If you display the records in the order in which they were added to the file, the file might look like the example shown in Figure 11.1.
Figure 11.1.
Sample records for the customer file.
A field can be named as an index; as each record is added to the file, information also is stored in the index area of the file to indicate the correct order of records for that index.
For example, suppose you use the name field as an index and you want to see the records sorted by name. The records would appear as shown in Figure 11.2.
Figure 11.2.
Records sorted on the name field.
If you also specify the zip code and area code as indexes, you then could sort the records by zip code (as shown in Figure 11.3) or by area code (as shown in Figure 11.4).
Figure 11.3.
Records sorted on the zip code field.
Figure 11.4.
Records sorted on the area code field.
In these examples, the indexed fields are fields in which duplicates might occur, and in fact do occur. Amphora Inc. and Malio Bros. both have the same zip code and area code. In a large customer base, it also is possible that customer names would be duplicated.
The index allows you to retrieve records in sorted order, but if your record contains a field that is unique from record to record, you might use that index to retrieve an individual record, rather than just retrieving records in sorted order.
In business programming, it is common to add a customer number to the customer record that is used as an index containing unique values (as shown in Listing 11.2).
001100 01 CUSTOMER-RECORD. 001200 05 CUSTOMER-NUMBER PIC 9(4). 001300 05 CUSTOMER-NAME PIC X(20). 001400 05 CUSTOMER-ADDRESS-1 PIC X(20). 001500 05 CUSTOMER-ADDRESS-2 PIC X(20). 001600 05 CUSTOMER-ZIP PIC 9(5). 001700 05 CUSTOMER-PHONE. 001800 10 CUSTOMER-AREA-CODE PIC 9(3). 001900 10 CUSTOMER-PREFIX PIC 9(3). 002000 10 CUSTOMER-PHONE-NO PIC 9(4).
In Figure 11.5, records appear in the order of the unique index, but you also can request a read on a file to return a single record whose customer number is equal to a specific value.
Figure 11.5.
Records with a unique index.
If you have ever wondered why you are given an account number, customer number, or card number by the companies you deal with, the answer lies in the need to create a unique value that can be used to identify your individual record in a computer file.
New Term: In a COBOL indexed file, one field must be designed so that it will contain a unique value for each record. This field is set up as the primary index for the file. This primary index is called the primary key or sometimes simply the key.
Most companies and agencies opt for a numbering system to resolve the problem of creating a unique (and unchanging) field to identify an individual record. This is a workable compromise, although in some cases it creates an artificial piece of data (such as a customer number) associated with a record.
You establish a key (an index) in a file in the physical definition of the file (the SELECT statement). Listing 11.3 is a full FD statement for the customer file we've been working on in this chapter. From the file descriptor and record layout, there is no way to tell that the file is indexed or what the key is. All this information is taken care of in the SELECT statement.
000900 FD CUSTOMER-FILE 001000 LABEL RECORDS ARE STANDARD. 001100 01 CUSTOMER-RECORD. 001200 05 CUSTOMER-NUMBER PIC 9(4). 001300 05 CUSTOMER-NAME PIC X(20). 001400 05 CUSTOMER-ADDRESS-1 PIC X(20). 001500 05 CUSTOMER-ADDRESS-2 PIC X(20). 001600 05 CUSTOMER-ZIP PIC 9(5). 001700 05 CUSTOMER-PHONE. 001800 10 CUSTOMER-AREA-CODE PIC 9(3). 001900 10 CUSTOMER-PREFIX PIC 9(3). 002000 10 CUSTOMER-PHONE-NO PIC 9(4).
Listing 11.4 is a SELECT statement for the customer file as it would appear if the file were being treated as a sequential file.
000300 SELECT CUSTOMER-FILE 000400 ASSIGN TO "customer.dat" 000500 ORGANIZATION IS SEQUENTIAL.
Compare this to the SELECT statement for the customer file as an indexed file, as shown in Listing 11.5.
000300 SELECT CUSTOMER-FILE 000400 ASSIGN TO "customer.dat" 000500 ORGANIZATION IS INDEXED 000600 RECORD KEY IS CUSTOMER-NUMBER 000700 ACCESS MODE IS DYNAMIC.
ANALYSIS: At line 000500, the organization of the file is specified as INDEXED. After you have specified INDEXED for a file organization, you must name a field that appears in the file record as the key (primary index) to the file. At line 000600, this field is identified with the clause RECORD KEY IS CUSTOMER-NUMBER.
Line 000700 specifies the access mode DYNAMIC. You don't need to be too concerned about access modes--you almost always will use DYNAMIC--but a brief explanation is in order. The following are the three ways of accessing an indexed file:
SEQUENTIAL access is the default and indicates that records will be accessed one after the other in the order of the primary key. RANDOM access indicates that the file will be accessed one record at a time, and for each access, an exact value for the primary key will be specified. DYNAMIC access combines SEQUENTIAL and RANDOM, indicating that records can be accessed randomly, one at time, or one after the other in sequence. You usually will use DYNAMIC because most programs need to access records both ways.
The OPEN and CLOSE for an indexed file are identical to the OPEN and CLOSE that you already have seen for a sequential file. Listing 11.6 opens a vendor file in output mode and then closes it.
000100 IDENTIFICATION DIVISION. 000200 PROGRAM-ID. VNDBLD01. 000300*------------------------------------------------ 000400* Create an Empty Vendor File. 000500*------------------------------------------------ 000600 ENVIRONMENT DIVISION. 000700 INPUT-OUTPUT SECTION. 000800 FILE-CONTROL. 000900 001000 SELECT VENDOR-FILE 001100 ASSIGN TO "vendor" 001200 ORGANIZATION IS INDEXED 001300 RECORD KEY IS VENDOR-NUMBER 001400 ACCESS MODE IS DYNAMIC. 001500 001600 DATA DIVISION. 001700 FILE SECTION. 001800 001900 FD VENDOR-FILE 002000 LABEL RECORDS ARE STANDARD. 002100 01 VENDOR-RECORD. 002200 05 VENDOR-NUMBER PIC 9(5). 002300 05 VENDOR-NAME PIC X(30). 002400 05 VENDOR-ADDRESS-1 PIC X(30). 002500 05 VENDOR-ADDRESS-2 PIC X(30). 002600 05 VENDOR-CITY PIC X(20). 002700 05 VENDOR-STATE PIC X(2). 002800 05 VENDOR-ZIP PIC X(10). 002900 05 VENDOR-CONTACT PIC X(30). 003000 05 VENDOR-PHONE PIC X(15). 003100 003200 WORKING-STORAGE SECTION. 003300 003400 PROCEDURE DIVISION. 003500 PROGRAM-BEGIN. 003600 OPEN OUTPUT VENDOR-FILE. 003700 CLOSE VENDOR-FILE. 003800 003900 PROGRAM-DONE. 004000 STOP RUN. 004100
ANALYSIS: The SELECT statement has some differences that you need to study. The ASSIGN TO clause, at line 001100, assigns the physical filename as "vendor" with no extension. The extension is omitted deliberately. Different versions of COBOL create indexed files in different ways:
For systems that create two files, such as LPI COBOL, Micro Focus COBOL, and the upcoming version 4.0 of ACUCOBOL, you don't need to worry about the two files within your COBOL program. When you open the file, the COBOL version takes care of gathering together the data portion of the file and the index portion of the file and opening them for you as though they were one file.
Because these different conventions exist (and there are others), it is best to give indexed files a physical name that contains no extension and let the version of COBOL take care of adding whatever extensions it needs for internal housekeeping.
The vendor record itself at lines 002100 through 003000 lays out a record for a file containing vendor names and addresses, which will be used in an accounts payable system that you develop over this and the following chapters. The vendor contact field can be used to place the name of a contact.
New Term: A vendor is someone who sells you goods or services and to whom you end up paying money for those goods or services.
You use this file definition to create a bills tracking and payment system gradually.
New Term: An accounts payable system tracks the bills you have, their due dates, and what you've paid, and it gives you information on future cash requirements needed to pay bills as they come due.
Although this program doesn't appear to do anything useful, it does have a purpose. In Day 9, you learned that it is possible to create a new file where one did not exist previously by using the OPTIONAL clause in a SELECT statement:
SELECT OPTIONAL PHONE-FILE
It also is possible to create a file by opening the file in EXTEND mode. This applies to SEQUENTIAL files, but OPTIONAL and EXTEND modes, are sometimes unavailable for indexed files.
Because COBOL syntax varies in the use of OPTIONAL in the SELECT clause, and because OPEN EXTEND is sometimes unavailable for indexed files, a program such as vndbld01.cbl is one way of ensuring that the vendor file is created. It is not uncommon in COBOL systems to have a set of programs, such as vndbld01.cbl, that are used only once to create a new set of empty files when the system is first installed.
Code, compile, and run this program; then perform a directory display of files named vendor to see which files were actually created in response to this command.
Under MS-DOS, enter the following:
DIR VENDOR*
You might see one of the following three displays, depending on your version of COBOL (or possibly another naming convention):
Files Listed Under LPI COBOL | Files Listed Under MF COBOL | Files Listed Under ACUCOBOL |
VENDOR.DAT | VENDOR | VENDOR |
VENDOR.IDX | VENDOR.IDX |
Adding records to an indexed file is mechanically identical to adding records to a sequential file; you fill each of the fields of the record with a value and then write the record. Listing 11.7, vndnew01.cbl, is a rudimentary program that accepts input for all fields and writes (adds) one record to the file.
000100 IDENTIFICATION DIVISION. 000200 PROGRAM-ID. VNDNEW01. 000300*------------------------------------------------ 000400* Add a record to an indexed Vendor File. 000500*------------------------------------------------ 000600 ENVIRONMENT DIVISION. 000700 INPUT-OUTPUT SECTION. 000800 FILE-CONTROL. 000900 001000 SELECT VENDOR-FILE 001100 ASSIGN TO "vendor" 001200 ORGANIZATION IS INDEXED 001300 RECORD KEY IS VENDOR-NUMBER 001400 ACCESS MODE IS DYNAMIC. 001500 001600 DATA DIVISION. 001700 FILE SECTION. 001800 001900 FD VENDOR-FILE 002000 LABEL RECORDS ARE STANDARD. 002100 01 VENDOR-RECORD. 002200 05 VENDOR-NUMBER PIC 9(5). 002300 05 VENDOR-NAME PIC X(30). 002400 05 VENDOR-ADDRESS-1 PIC X(30). 002500 05 VENDOR-ADDRESS-2 PIC X(30). 002600 05 VENDOR-CITY PIC X(20). 002700 05 VENDOR-STATE PIC X(2). 002800 05 VENDOR-ZIP PIC X(10). 002900 05 VENDOR-CONTACT PIC X(30). 003000 05 VENDOR-PHONE PIC X(15). 003100 003200 WORKING-STORAGE SECTION. 003300 003400 PROCEDURE DIVISION. 003500 PROGRAM-BEGIN. 003600 OPEN I-O VENDOR-FILE. 003700 PERFORM MAIN-PROCESS. 003800 CLOSE VENDOR-FILE. 003900 004000 PROGRAM-DONE. 004100 STOP RUN. 004200 004300 MAIN-PROCESS. 004400 PERFORM INIT-VENDOR-RECORD. 004500 PERFORM ENTER-VENDOR-FIELDS. 004600 WRITE VENDOR-RECORD. 004700 004800 INIT-VENDOR-RECORD. 004900 MOVE SPACE TO VENDOR-RECORD. 005000 MOVE ZEROES TO VENDOR-NUMBER. 005100 005200 ENTER-VENDOR-FIELDS. 005300 PERFORM ENTER-VENDOR-NUMBER. 005400 PERFORM ENTER-VENDOR-NAME. 005500 PERFORM ENTER-VENDOR-ADDRESS-1. 005600 PERFORM ENTER-VENDOR-ADDRESS-2. 005700 PERFORM ENTER-VENDOR-CITY. 005800 PERFORM ENTER-VENDOR-STATE. 005900 PERFORM ENTER-VENDOR-ZIP. 006000 PERFORM ENTER-VENDOR-CONTACT. 006100 PERFORM ENTER-VENDOR-PHONE. 006200 006300 ENTER-VENDOR-NUMBER. 006400 DISPLAY "ENTER VENDOR NUMBER (00001-99999)". 006500 ACCEPT VENDOR-NUMBER. 006600 006700 ENTER-VENDOR-NAME. 006800 DISPLAY "ENTER VENDOR NAME". 006900 ACCEPT VENDOR-NAME. 007000 007100 ENTER-VENDOR-ADDRESS-1. 007200 DISPLAY "ENTER VENDOR ADDRESS-1". 007300 ACCEPT VENDOR-ADDRESS-1. 007400 007500 ENTER-VENDOR-ADDRESS-2. 007600 DISPLAY "ENTER VENDOR ADDRESS-2". 007700 ACCEPT VENDOR-ADDRESS-2. 007800 007900 ENTER-VENDOR-CITY. 008000 DISPLAY "ENTER VENDOR CITY". 008100 ACCEPT VENDOR-CITY. 008200 008300 ENTER-VENDOR-STATE. 008400 DISPLAY "ENTER VENDOR STATE". 008500 ACCEPT VENDOR-STATE. 008600 008700 ENTER-VENDOR-ZIP. 008800 DISPLAY "ENTER VENDOR ZIP". 008900 ACCEPT VENDOR-ZIP. 009000 009100 ENTER-VENDOR-CONTACT. 009200 DISPLAY "ENTER VENDOR CONTACT". 009300 ACCEPT VENDOR-CONTACT. 009400 009500 ENTER-VENDOR-PHONE. 009600 DISPLAY "ENTER VENDOR PHONE". 009700 ACCEPT VENDOR-PHONE. 009800
The following is the output for vndnew01.cbl after entering vendor number 00002, with user entries highlighted:
OUTPUT:
ENTER VENDOR NUMBER (ALL 5 DIGITS) 00001-99999 00002 ENTER VENDOR NAME ABC PRINTING ENTER VENDOR ADDRESS-1 1624 FOOTHILL BLVD ENTER VENDOR ADDRESS-2 SUITE 34 ENTER VENDOR CITY LOS ANGELES ENTER VENDOR STATE CA ENTER VENDOR ZIP 91042 ENTER VENDOR ATTENTION CHARLES JOHANSSEN ENTER VENDOR PHONE (818) 555-4321 C> C>
ANALYSIS: The MAIN-PROCESS at lines 004300 through 004600 initializes a vendor record, enters all the vendor fields, and then writes the record. You should have no trouble following the logic.
Code, compile, and run this program three times, each time adding a record for vendor numbers 00001, 00002, and 00003 to the file. You can enter anything you want for the other fields, but the VENDOR-NUMBER must be different for each entry. Before you go any further or experiment with this program or file, study the next section, which covers a problem with indexed files that you might bump into while trying to add these records.
Don't worry if you add some fields incorrectly. You tackle changing records in Day 12, "More on Indexed Files," and you will be able to correct any errors you make.
After you have entered vendors 00001, 00002, and 00003, run the program again and try to enter another vendor. Give this vendor one of the numbers that already has been used in the file.
The primary key must contain a value that is unique in each record, so attempting to add a record with a primary key value that already exists in the file will cause some sort of error. Most versions of COBOL end the program abruptly when a file error occurs, as in the following sample output for ACUCOBOL. This output error message is caused by attempting to add a record with a duplicate primary key value of 00002.
OUTPUT:
ENTER VENDOR NUMBER (ALL 5 DIGITS) 00001-99999 00002 ENTER VENDOR NAME ABC PRINTING ENTER VENDOR ADDRESS-1 1624 FOOTHILL BLVD ENTER VENDOR ADDRESS-2 SUITE 34 ENTER VENDOR CITY LOS ANGELES ENTER VENDOR STATE CA ENTER VENDOR ZIP 91042 ENTER VENDOR ATTENTION CHARLES JOHANSSEN ENTER VENDOR PHONE (818) 555-4321 File error 22 on vendor COBOL error at 000027 in vndnew01 C> C>
No error message occurs under Micro Focus Personal COBOL, but the record is not written to the file.
To give you a better idea of file errors, Listing 11.8, vnderr01.cbl, uses READ NEXT to create a different type of file error deliberately. (The program isn't particularly well designed; I'm only trying to illustrate an error condition.)
000100 IDENTIFICATION DIVISION. 000200 PROGRAM-ID. VNDERR01. 000300*-------------------------------------------------- 000400* Forces an error by reading past the end of a file. 000500*-------------------------------------------------- 000600 ENVIRONMENT DIVISION. 000700 INPUT-OUTPUT SECTION. 000800 FILE-CONTROL. 000900 001000 SELECT VENDOR-FILE 001100 ASSIGN TO "vendor" 001200 ORGANIZATION IS INDEXED 001300 RECORD KEY IS VENDOR-NUMBER 001400 ACCESS MODE IS DYNAMIC. 001500 001600 DATA DIVISION. 001700 FILE SECTION. 001800 001900 FD VENDOR-FILE 002000 LABEL RECORDS ARE STANDARD. 002100 01 VENDOR-RECORD. 002200 05 VENDOR-NUMBER PIC 9(5). 002300 05 VENDOR-NAME PIC X(30). 002400 05 VENDOR-ADDRESS-1 PIC X(30). 002500 05 VENDOR-ADDRESS-2 PIC X(30). 002600 05 VENDOR-CITY PIC X(20). 002700 05 VENDOR-STATE PIC X(2). 002800 05 VENDOR-ZIP PIC X(10). 002900 05 VENDOR-CONTACT PIC X(30). 003000 05 VENDOR-PHONE PIC X(15). 003100 003200 003300 WORKING-STORAGE SECTION. 003400 003500 77 FILE-AT-END PIC X. 003600 003700 PROCEDURE DIVISION. 003800 PROGRAM-BEGIN. 003900 PERFORM OPENING-PROCEDURE. 004000 PERFORM MAIN-PROCESS. 004100 PERFORM CLOSING-PROCEDURE. 004200 004300 PROGRAM-DONE. 004400 STOP RUN. 004500 004600 OPENING-PROCEDURE. 004700 OPEN I-O VENDOR-FILE. 004800 004900 CLOSING-PROCEDURE. 005000 CLOSE VENDOR-FILE. 005100 005200 MAIN-PROCESS. 005300 005400 MOVE "N" TO FILE-AT-END. 005500 PERFORM READ-NEXT-RECORD. 005600 PERFORM READ-AND-DISPLAY 005700 UNTIL FILE-AT-END = "Y". 005800 005900 READ-AND-DISPLAY. 006000 DISPLAY VENDOR-NUMBER. 006100 PERFORM READ-NEXT-RECORD. 006200 006300 READ-NEXT-RECORD. 006400 READ VENDOR-FILE NEXT RECORD. 006500* AT END MOVE "Y" TO FILE-AT-END. 006600
The output for two different versions of COBOL follows. Assume that the vendor file contains records with the key values 00001, 00002, and 00003. The following output shows an at-end error in Micro Focus Personal COBOL. The last vendor number is displayed twice before the actual error occurs:
OUTPUT:
C>pcobrun vnderr01 Personal COBOL version 2.0 from Micro Focus PCOBRUN V2.0.02 Copyright (C) 1983-1993 Micro Focus Ltd. 00001 00002 00003 00003 Error accessing file : vendor VNDERR01 Segment RT : Error 146 at COBOL PC 00AB Description : No current record defined for sequential read C> C>
The following output shows an at-end error in ACUCOBOL. The error occurs at the exact end of the file:
OUTPUT:
00001 00002 00003 File error 10 on vendor COBOL error at 000048 in VNDERR01 C> C>
ANALYSIS: At lines 005900 and 006000, the program reads through the vendor file, displaying the vendor number for each record as it is read.
At line 006500, the statement that should have trapped the AT END condition has been commented out, so the FILE-AT-END flag is never set to "Y" and the program just keeps trying to read records even though it has reached the end of the file.
The program automatically aborts with an error message after the end of file is reached.
After you've entered three records using vndnew01.cbl, code, compile, and run vnderr01.cbl to see the effects of the end-of-file condition for your particular version of COBOL.
Now copy vnderr01.cbl to vnderr02.cbl and rewrite vnderr02.cbl so that the final lines read as in Listing 11.9. Remove the period at the end of line 006400, and remove the asterisk on line 006500.
006300 READ-NEXT-RECORD. 006400 READ VENDOR-FILE NEXT RECORD 006500 AT END MOVE "Y" TO FILE-AT-END.
The following is the output of the repaired vnderr01.cbl:
OUTPUT:
00001 00002 00003
The usual behavior of a COBOL program performing input and output to a file is to abort if a file error is encountered. You can change this usual behavior if you provide some explicit step or steps to be taken in the event of a file error. In the case of a READ NEXT command, the explicit steps to take in the event of an error are given with the AT END clause.
The AT END clause in the READ NEXT statement actually does two things. First, it overrides the normal COBOL behavior of aborting on a file error. This is done out of sight and is built in as part of the behavior of the AT END clause. The second thing is explicitly stated by the commands that follow AT END. In this case, "Y" is moved to END-OF-FILE.
New Term: The AT END clause is called a file error condition clause.
The WRITE command for an indexed file includes a file error condition clause that can be used to trap duplicate key errors. This clause is INVALID KEY and has the following syntax:
WRITE file-record INVALID KEY do something
Here is an example of a file error condition clause:
WRITE VENDOR-RECORD INVALID KEY MOVE "Y" TO DUPLICATE-FLAG
DO/DON'T:
DO stay aware of file error conditions, and program so that you trap these conditions and handle them correctly.DON'T ever use a file error condition as the natural way to stop a program. It would be a poor design to print records until the program crashed. Yes, all the records would be printed, but the resulting error message would confuse the end user, and it is very sloppy style.
Now that you know how to handle duplicate key errors, look at Listing 11.10. It shows an improved version of a program to add records to the vendor file. It allows records to be added one after the other by asking for each field.
000100 IDENTIFICATION DIVISION. 000200 PROGRAM-ID. VNDNEW02. 000300*------------------------------------------------ 000400* Add a record to an indexed Vendor File. 000500*------------------------------------------------ 000600 ENVIRONMENT DIVISION. 000700 INPUT-OUTPUT SECTION. 000800 FILE-CONTROL. 000900 001000 SELECT VENDOR-FILE 001100 ASSIGN TO "vendor" 001200 ORGANIZATION IS INDEXED 001300 RECORD KEY IS VENDOR-NUMBER 001400 ACCESS MODE IS DYNAMIC. 001500 001600 DATA DIVISION. 001700 FILE SECTION. 001800 001900 FD VENDOR-FILE 002000 LABEL RECORDS ARE STANDARD. 002100 01 VENDOR-RECORD. 002200 05 VENDOR-NUMBER PIC 9(5). 002300 05 VENDOR-NAME PIC X(30). 002400 05 VENDOR-ADDRESS-1 PIC X(30). 002500 05 VENDOR-ADDRESS-2 PIC X(30). 002600 05 VENDOR-CITY PIC X(20). 002700 05 VENDOR-STATE PIC X(2). 002800 05 VENDOR-ZIP PIC X(10). 002900 05 VENDOR-CONTACT PIC X(30). 003000 05 VENDOR-PHONE PIC X(15). 003100 003200 WORKING-STORAGE SECTION. 003300 003400 01 VENDOR-NUMBER-FIELD PIC Z(5). 003500 003600 PROCEDURE DIVISION. 003700 PROGRAM-BEGIN. 003800 OPEN I-O VENDOR-FILE. 003900 PERFORM GET-NEW-VENDOR-NUMBER. 004000 PERFORM ADD-RECORDS 004100 UNTIL VENDOR-NUMBER = ZEROES. 004200 CLOSE VENDOR-FILE. 004300 004400 PROGRAM-DONE. 004500 STOP RUN. 004600 004700 GET-NEW-VENDOR-NUMBER. 004800 PERFORM INIT-VENDOR-RECORD. 004900 PERFORM ENTER-VENDOR-NUMBER. 005000 005100 INIT-VENDOR-RECORD. 005200 MOVE SPACE TO VENDOR-RECORD. 005300 MOVE ZEROES TO VENDOR-NUMBER. 005400 005500 ENTER-VENDOR-NUMBER. 005600 DISPLAY "ENTER VENDOR NUMBER (1-99999)". 005700 DISPLAY "ENTER 0 TO STOP ENTRY". 005800 ACCEPT VENDOR-NUMBER-FIELD. 005900*OR ACCEPT VENDOR-NUMBER-FIELD WITH CONVERSION. 006000 006100 MOVE VENDOR-NUMBER-FIELD TO VENDOR-NUMBER. 006200*OR MOVE WITH CONVERSION VENDOR-NUMBER-FIELD 006300* TO VENDOR-NUMBER. 006400 006500 ADD-RECORDS. 006600 PERFORM ENTER-REMAINING-FIELDS. 006700 PERFORM WRITE-VENDOR-RECORD. 006800 PERFORM GET-NEW-VENDOR-NUMBER. 006900 007000 WRITE-VENDOR-RECORD. 007100 WRITE VENDOR-RECORD 007200 INVALID KEY 007300 DISPLAY "RECORD ALREADY ON FILE". 007400 007500 ENTER-REMAINING-FIELDS. 007600 PERFORM ENTER-VENDOR-NAME. 007700 PERFORM ENTER-VENDOR-ADDRESS-1. 007800 PERFORM ENTER-VENDOR-ADDRESS-2. 007900 PERFORM ENTER-VENDOR-CITY. 008000 PERFORM ENTER-VENDOR-STATE. 008100 PERFORM ENTER-VENDOR-ZIP. 008200 PERFORM ENTER-VENDOR-CONTACT. 008300 PERFORM ENTER-VENDOR-PHONE. 008400 008500 ENTER-VENDOR-NAME. 008600 DISPLAY "ENTER VENDOR NAME". 008700 ACCEPT VENDOR-NAME. 008800 008900 ENTER-VENDOR-ADDRESS-1. 009000 DISPLAY "ENTER VENDOR ADDRESS-1". 009100 ACCEPT VENDOR-ADDRESS-1. 009200 009300 ENTER-VENDOR-ADDRESS-2. 009400 DISPLAY "ENTER VENDOR ADDRESS-2". 009500 ACCEPT VENDOR-ADDRESS-2. 009600 009700 ENTER-VENDOR-CITY. 009800 DISPLAY "ENTER VENDOR CITY". 009900 ACCEPT VENDOR-CITY. 010000 010100 ENTER-VENDOR-STATE. 010200 DISPLAY "ENTER VENDOR STATE". 010300 ACCEPT VENDOR-STATE. 010400 010500 ENTER-VENDOR-ZIP. 010600 DISPLAY "ENTER VENDOR ZIP". 010700 ACCEPT VENDOR-ZIP. 010800 010900 ENTER-VENDOR-CONTACT. 011000 DISPLAY "ENTER VENDOR CONTACT". 011100 ACCEPT VENDOR-CONTACT. 011200 011300 ENTER-VENDOR-PHONE. 011400 DISPLAY "ENTER VENDOR PHONE". 011500 ACCEPT VENDOR-PHONE. 011600
The following is the output of vndnew02.cbl when a duplicate key value is entered:
OUTPUT:
ENTER VENDOR NUMBER (1-99999) ENTER 0 TO STOP ENTRY 1 ENTER VENDOR NAME JOE DOAKS ENTER VENDOR ADDRESS-1 1212 FOURTH ST. ENTER VENDOR ADDRESS-2 ENTER VENDOR CITY LOS ANGELES ENTER VENDOR STATE CA ENTER VENDOR ZIP 94321 ENTER VENDOR CONTACT JOSEPH DOAKS ENTER VENDOR PHONE (213) 555-6543 RECORD ALREADY ON FILE ENTER VENDOR NUMBER (1-99999) ENTER 0 TO STOP ENTRY
ANALYSIS: The user first is asked for the VENDOR-NUMBER field; if the user enters a vendor number of 00000, this signals the end of data entry. This approach was used instead of asking the user for all the fields and then asking whether the user wants to go again. It works perfectly well, because you usually wouldn't want to put a vendor with the number 00000 in the file.
The data entry for the VENDOR-NUMBER is handled by accepting data into an edited numeric field, VENDOR-NUMBER-FIELD, and then moving the result to VENDOR-NUMBER. This saves the user from having to enter all five digits. This field is defined at line 003400, and the data entry is taken care of at lines 005500 through 006300 in the ENTER-VENDOR-NUMBER routine.
The program uses the VENDOR-NUMBER as the flag to stop the program. In this case, the VENDOR-NUMBER is not only a piece of data for the file; it is the variable that controls the main processing loop of the program. At line 003900, the user is asked to enter a new vendor number--GET-NEW-VENDOR-NUMBER. The user can enter 0 at this point, causing the program to stop immediately. If the user does not, the main processing loop, ADD-RECORDS, is performed at lines 004000 and 004100 until VENDOR-NUMBER = ZEROES.
The main processing loop, ADD-RECORDS (at lines 006500 through 006800) enters the remaining fields, writes the vendor record, and asks the user for another vendor number to add by performing GET-NEW-VENDOR-NUMBER. This sets up the loop control variable before going into the loop (line 003900) and then changes the loop control variable at the bottom of the loop (line 006800).
At line 005300, the VENDOR-NUMBER is initialized to a zero value. Then ADD-RECORDS is performed until the user enters a value of zeroes for a vendor number.
At lines 004700 through 004900, the GET-NEW-VENDOR-NUMBER paragraph takes care of initializing the vendor record--assuming that a new record will be added to the file--and then actually getting the user input of the vendor number.
The writing of the record in WRITE-VENDOR-RECORD at line 007000 uses INVALID KEY to trap the file error condition and displays "RECORD ALREADY ON FILE" at line 007300.
Use vndnew02.cbl to add some additional records to the vendor file. In particular, add them out of order. Add a vendor number 00022; then add vendor number 00006. You do not have to enter all the missing numbers between the vendor number values. An indexed file is quite comfortable with gaps in it, and a file could contain only vendor number 00001 and vendor number 08706 without causing any bad effects.
After you have entered some records out of order, you need to be able to display them. Listing 11.11 is a simple program. It is intended only to illustrate that regardless of the order you use to put records into the file, when you start retrieving them, they are returned from the file in primary key order.
000100 IDENTIFICATION DIVISION. 000200 PROGRAM-ID. VNDREC01. 000300*------------------------------------------------ 000400* Display vendor number and 000500* name in order. 000600*------------------------------------------------ 000700 ENVIRONMENT DIVISION. 000800 INPUT-OUTPUT SECTION. 000900 FILE-CONTROL. 001000 001100 SELECT VENDOR-FILE 001200 ASSIGN TO "vendor" 001300 ORGANIZATION IS INDEXED 001400 RECORD KEY IS VENDOR-NUMBER 001500 ACCESS MODE IS DYNAMIC. 001600 001700 DATA DIVISION. 001800 FILE SECTION. 001900 002000 FD VENDOR-FILE 002100 LABEL RECORDS ARE STANDARD. 002200 01 VENDOR-RECORD. 002300 05 VENDOR-NUMBER PIC 9(5). 002400 05 VENDOR-NAME PIC X(30). 002500 05 VENDOR-ADDRESS-1 PIC X(30). 002600 05 VENDOR-ADDRESS-2 PIC X(30). 002700 05 VENDOR-CITY PIC X(20). 002800 05 VENDOR-STATE PIC X(2). 002900 05 VENDOR-ZIP PIC X(10). 003000 05 VENDOR-CONTACT PIC X(30). 003100 05 VENDOR-PHONE PIC X(15). 003200 003300 WORKING-STORAGE SECTION. 003400 003500 77 FILE-AT-END PIC X. 003600 003700 PROCEDURE DIVISION. 003800 PROGRAM-BEGIN. 003900 004000 PERFORM OPENING-PROCEDURE. 004100 004200 MOVE "N" TO FILE-AT-END. 004300 PERFORM READ-NEXT-RECORD. 004400 IF FILE-AT-END = "Y" 004500 DISPLAY "NO RECORDS FOUND" 004600 ELSE 004700 PERFORM DISPLAY-VENDOR-FIELDS 004800 UNTIL FILE-AT-END = "Y". 004900 005000 PERFORM CLOSING-PROCEDURE. 005100 005200 005300 PROGRAM-DONE. 005400 STOP RUN. 005500 005600 OPENING-PROCEDURE. 005700 OPEN I-O VENDOR-FILE. 005800 005900 CLOSING-PROCEDURE. 006000 CLOSE VENDOR-FILE. 006100 006200 DISPLAY-VENDOR-FIELDS. 006300 DISPLAY "NO: " VENDOR-NUMBER 006400 " NAME: " VENDOR-NAME. 006500 006600 PERFORM READ-NEXT-RECORD. 006700 006800 READ-NEXT-RECORD. 006900 READ VENDOR-FILE NEXT RECORD 007000 AT END MOVE "Y" TO FILE-AT-END. 007100
OUTPUT:
NO: 00001 NAME: AERIAL SIGNS NO: 00002 NAME: ABC PRINTING NO: 00003 NAME: CHARLES SMITH AND SONS NO: 00014 NAME: RANIER GRAPHICS NO: 01176 NAME: ABERCROMBIE AND OTHERS NO: 01440 NAME: ZINZINDORFF INC. C> C>
ANALYSIS: This program opens the vendor file and displays the vendor number and vendor name for all the records.
The vendor record is too long to display on an 80-column screen. The next display program treats the screen as though it were a scrolling printer, so you have to resort to a printer spacing chart to work out the display. Some 80-column displays cause an extra line feed if a character is printed in position 80, so you'll work with only 79 columns.
Figure 11.6 shows the pattern for the layout.
Figure 11.6.
Spacing chart for the display.
Listing 11.12, vnddsp01.cbl, is a program to display the vendor records. Code, compile, and run vnddsp01.cbl. You will see that as the records are displayed, they are displayed in ascending VENDOR-NUMBER order, regardless of the order in which they originally were entered.
000100 IDENTIFICATION DIVISION. 000200 PROGRAM-ID. VNDDSP01. 000300*------------------------------------------------ 000400* Display records in the Vendor File. 000500*------------------------------------------------ 000600 ENVIRONMENT DIVISION. 000700 INPUT-OUTPUT SECTION. 000800 FILE-CONTROL. 000900 001000 SELECT VENDOR-FILE 001100 ASSIGN TO "vendor" 001200 ORGANIZATION IS INDEXED 001300 RECORD KEY IS VENDOR-NUMBER 001400 ACCESS MODE IS DYNAMIC. 001500 001600 DATA DIVISION. 001700 FILE SECTION. 001800 001900 FD VENDOR-FILE 002000 LABEL RECORDS ARE STANDARD. 002100 01 VENDOR-RECORD. 002200 05 VENDOR-NUMBER PIC 9(5). 002300 05 VENDOR-NAME PIC X(30). 002400 05 VENDOR-ADDRESS-1 PIC X(30). 002500 05 VENDOR-ADDRESS-2 PIC X(30). 002600 05 VENDOR-CITY PIC X(20). 002700 05 VENDOR-STATE PIC X(2). 002800 05 VENDOR-ZIP PIC X(10). 002900 05 VENDOR-CONTACT PIC X(30). 003000 05 VENDOR-PHONE PIC X(15). 003100 003200 003300 003400 003500 WORKING-STORAGE SECTION. 003600 003700 003800 003900 01 DETAIL-LINE. 004000 05 DISPLAY-NUMBER PIC 9(5). 004100 05 FILLER PIC X VALUE SPACE. 004200 05 DISPLAY-NAME PIC X(30). 004300 05 FILLER PIC X VALUE SPACE. 004400 05 DISPLAY-CONTACT PIC X(30). 004500 004600 01 CITY-STATE-DETAIL. 004700 05 DISPLAY-CITY PIC X(20). 004800 05 FILLER PIC X VALUE SPACE. 004900 05 DISPLAY-STATE PIC X(2). 005000 005100 01 COLUMN-LINE. 005200 05 FILLER PIC X(2) VALUE "NO". 005300 05 FILLER PIC X(4) VALUE SPACE. 005400 05 FILLER PIC X(12) VALUE "NAME-ADDRESS". 005500 05 FILLER PIC X(19) VALUE SPACE. 005600 05 FILLER PIC X(17) VALUE "CONTACT-PHONE-ZIP". 005700 005800 01 TITLE-LINE. 005900 05 FILLER PIC X(15) VALUE SPACE. 006000 05 FILLER PIC X(11) 006100 VALUE "VENDOR LIST". 006200 05 FILLER PIC X(15) VALUE SPACE. 006300 05 FILLER PIC X(5) VALUE "PAGE:". 006400 05 FILLER PIC X(1) VALUE SPACE. 006500 05 DISPLAY-PAGE-NUMBER PIC ZZZZ9. 006600 006700 77 FILE-AT-END PIC X. 006800 77 A-DUMMY PIC X. 006900 77 LINE-COUNT PIC 999 VALUE ZERO. 007000 77 PAGE-NUMBER PIC 99999 VALUE ZERO. 007100 77 MAXIMUM-LINES PIC 999 VALUE 15. 007200 007300 77 DISPLAY-RECORD PIC X(79). 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 DISPLAY-RECORD 008800 PERFORM WRITE-DISPLAY-RECORD 008900 ELSE 009000 PERFORM DISPLAY-VENDOR-FIELDS 009100 UNTIL FILE-AT-END = "Y". 009200 009300 PERFORM CLOSING-PROCEDURE. 009400 009500 009600 PROGRAM-DONE. 009700 STOP RUN. 009800 009900 OPENING-PROCEDURE. 010000 OPEN I-O VENDOR-FILE. 010100 010200 CLOSING-PROCEDURE. 010300 CLOSE VENDOR-FILE. 010400 010500 DISPLAY-VENDOR-FIELDS. 010600 IF LINE-COUNT > MAXIMUM-LINES 010700 PERFORM START-NEXT-PAGE. 010800 PERFORM DISPLAY-THE-RECORD. 010900 PERFORM READ-NEXT-RECORD. 011000 011100 DISPLAY-THE-RECORD. 011200 PERFORM DISPLAY-LINE-1. 011300 PERFORM DISPLAY-LINE-2. 011400 PERFORM DISPLAY-LINE-3. 011500 PERFORM DISPLAY-LINE-4. 011600 PERFORM LINE-FEED. 011700 011800 DISPLAY-LINE-1. 011900 MOVE SPACE TO DETAIL-LINE. 012000 MOVE VENDOR-NUMBER TO DISPLAY-NUMBER. 012100 MOVE VENDOR-NAME TO DISPLAY-NAME. 012200 MOVE VENDOR-CONTACT TO DISPLAY-CONTACT. 012300 MOVE DETAIL-LINE TO DISPLAY-RECORD. 012400 PERFORM WRITE-DISPLAY-RECORD. 012500 012600 DISPLAY-LINE-2. 012700 MOVE SPACE TO DETAIL-LINE. 012800 MOVE VENDOR-ADDRESS-1 TO DISPLAY-NAME. 012900 MOVE VENDOR-PHONE TO DISPLAY-CONTACT. 013000 MOVE DETAIL-LINE TO DISPLAY-RECORD. 013100 PERFORM WRITE-DISPLAY-RECORD. 013200 013300 DISPLAY-LINE-3. 013400 MOVE SPACE TO DETAIL-LINE. 013500 MOVE VENDOR-ADDRESS-2 TO DISPLAY-NAME. 013600 IF VENDOR-ADDRESS-2 NOT = SPACE 013700 MOVE DETAIL-LINE TO DISPLAY-RECORD 013800 PERFORM WRITE-DISPLAY-RECORD. 013900 014000 DISPLAY-LINE-4. 014100 MOVE SPACE TO DETAIL-LINE. 014200 MOVE VENDOR-CITY TO DISPLAY-CITY. 014300 MOVE VENDOR-STATE TO DISPLAY-STATE. 014400 MOVE CITY-STATE-DETAIL TO DISPLAY-NAME. 014500 MOVE VENDOR-ZIP TO DISPLAY-CONTACT. 014600 MOVE DETAIL-LINE TO DISPLAY-RECORD. 014700 PERFORM WRITE-DISPLAY-RECORD. 014800 014900 READ-NEXT-RECORD. 015000 READ VENDOR-FILE NEXT RECORD 015100 AT END MOVE "Y" TO FILE-AT-END. 015200 015300 WRITE-DISPLAY-RECORD. 015400 DISPLAY DISPLAY-RECORD. 015500 ADD 1 TO LINE-COUNT. 015600 015700 LINE-FEED. 015800 MOVE SPACE TO DISPLAY-RECORD. 015900 PERFORM WRITE-DISPLAY-RECORD. 016000 016100 START-NEXT-PAGE. 016200 016300 PERFORM END-LAST-PAGE. 016400 PERFORM START-NEW-PAGE. 016500 016600 START-NEW-PAGE. 016700 ADD 1 TO PAGE-NUMBER. 016800 MOVE PAGE-NUMBER TO DISPLAY-PAGE-NUMBER. 016900 MOVE TITLE-LINE TO DISPLAY-RECORD. 017000 PERFORM WRITE-DISPLAY-RECORD. 017100 PERFORM LINE-FEED. 017200 MOVE COLUMN-LINE TO DISPLAY-RECORD. 017300 PERFORM WRITE-DISPLAY-RECORD. 017400 PERFORM LINE-FEED. 017500 017600 END-LAST-PAGE. 017700 PERFORM PRESS-ENTER. 017800 MOVE ZERO TO LINE-COUNT. 017900 018000 PRESS-ENTER. 018100 DISPLAY "PRESS ENTER TO CONTINUE. . .". 018200 ACCEPT A-DUMMY. 018300
OUTPUT:
VENDOR LIST PAGE: 1 NO NAME-ADDRESS CONTACT-PHONE-ZIP 00001 CECILLE JOHNSON AND CO. CHARLES SMITH 1212 MAIN ST (213) 555-1234 LOS ANGELES CA 91042 00002 ABC PRINTING LINDA JOHANSSEN 1624 FOOTHILL BLVD (818) 555-4321 SUITE 34 LOS ANGELES CA 91042 00003 CHARLES SMITH AND SONS CHARLES SMITH 1453 SOUTH STREET (213) 555-4432 LOS ANGELES CA 92345 PRESS ENTER TO CONTINUE. . .
NOTE: A few level-77 data items are thrown into WORKING-STORAGE so that you will get accustomed to seeing them in programs. You could use 01 for these.
ANALYSIS: The organization of the program is similar to a report program. A DETAIL-LINE, COLUMN-LINE, and TITLE-LINE are defined at lines 003900, 005100, and 005800, respectively.
A programmer might use DETAIL-LINE for multiple purposes. Even though it is defined to contain DISPLAY-NUMBER, DISPLAY-NAME, and DISPLAY-CONTACT, the DISPLAY-NAME field will be used to display VENDOR-NAME, but it also will be used to display VENDOR-ADDRESS-1, VENDOR-ADDRESS-2, VENDOR-CITY, and VENDOR-STATE. The DISPLAY-CONTACT field will be used to display VENDOR-PHONE and VENDOR-ZIP, as well as VENDOR-CONTACT.
A 79-byte DISPLAY-RECORD at line 007300 is used throughout the program. Information to be displayed is moved to this field and then displayed by performing WRITE-DISPLAY-RECORD, a routine at line 015300 that displays the DISPLAY-RECORD and adds 1 to the LINE-COUNT. By forcing all displays to be performed using this same paragraph, it's possible to track accurately how many lines are displayed.
The main processing loop at line 010500 is DISPLAY-VENDOR-FIELDS. This checks to see whether a new page is needed, displays the record, and reads the next record.
DISPLAY-THE-RECORD at line 011100 has the task of displaying four separate lines in order to display all the fields of a single record. This is followed by a line feed. Displaying lines 1 and 2 at lines 011800 and 012600 is fairly straightforward.
In DISPLAY-LINE-3 at line 013300, I realized that not all vendors have two lines of address information, and that VENDOR-ADDRESS-2 could be blank. You can see examples of this in lines 7 and 17 of the output for Listing 11.12. Nothing else is formatted for this display line, so I decided to test the field and print the line only if it is not blank, rather than waste space on the screen. This test is at line 013600.
Displaying the fourth line of information presented an unusual problem. Up to this point, all the information to be displayed could fit very neatly within the single DETAIL-LINE defined at line 003900. Name, address 1, and address 2 all fit into the 30-character DISPLAY-NAME at line 004200. Contact and phone both fit into the 30-character DISPLAY-CONTACT at line 004400. The city, state, and zip code information didn't fit quite as neatly.
I could have added another detail line, as shown in Listing 11.13.
004500 01 2ND-DETAIL-LINE. 004600 05 FILLER PIC X(6) VALUE SPACE. 004700 05 DISPLAY-CITY PIC X(20). 004800 05 FILLER PIC X VALUE SPACE. 004900 05 DISPLAY-STATE PIC XX. 005000 05 FILLER PIC X(8) VALUE SPACE. 005100 05 DISPLAY-ZIP PIC X(10).
Using the 2ND-DETAIL-LINE, DISPLAY-LINE-4 changes to look like Listing 11.14.
014000 DISPLAY-LINE-4. 014100 MOVE SPACE TO 2ND-DETAIL-LINE. 014200 MOVE VENDOR-CITY TO DISPLAY-CITY. 014300 MOVE VENDOR-STATE TO DISPLAY-STATE. 014400 014500 MOVE VENDOR-ZIP TO DISPLAY-ZIP. 014600 MOVE 2ND-DETAIL-LINE TO DISPLAY-RECORD. 014700 PERFORM WRITE-DISPLAY-RECORD.
ANALYSIS: There was no need for a full second detail line, because VENDOR-ZIP still would fit within DISPLAY-CONTACT. A small formatting field, CITY-STATE-DETAIL at lines 004600 through 004900, was created to be used to format the 20 characters of city and two characters of state. At lines 014200 and 014300, values are moved into DISPLAY-CITY and DISPLAY-STATE, which are both with the structure variable CITY-STATE-DETAIL. At line 014400, this entire structure, now containing the values I have moved to it, is moved to DISPLAY-NAME.
COBOL data processing relies on indexed files. They are the central repository of data for virtually every COBOL system in use. Today, you learned the following basics about indexed files:
000900 FD CONTACT-FILE 001000 LABEL RECORDS ARE STANDARD. 001100 01 CONTACT-RECORD. 001200 05 CONTACT-BIRTH-DATE PIC 9(6). 001300 05 CONTACT-NAME PIC X(20). 001400 05 CONTACT-ADDRESS-1 PIC X(20). 001500 05 CONTACT-ADDRESS-2 PIC X(20). 001600 05 CONTACT-ZIP PIC 9(5). 001700 05 CONTACT-PHONE. 001800 10 CONTACT-AREA-CODE PIC 9(3). 001900 10 CONTACT-PREFIX PIC 9(3). 002000 10 CONTACT-PHONE-NO PIC 9(4).
000300 SELECT CONTACT-FILE 000400 ASSIGN TO "contact" 000500 ORGANIZATION IS INDEXED 000600 RECORD KEY IS CONTACT-BIRTH-DATE 000700 ACCESS MODE IS DYNAMIC.
003900 01 DETAIL-LINE. 004000 05 DISPLAY-NUMBER PIC 9(5). 004100 05 FILLER PIC X VALUE SPACE. 004200 05 DISPLAY-NAME. 004300 10 DISPLAY-CITY PIC X(20). 004400 10 FILLER PIC X(1) VALUE SPACE. 004500 10 DISPLAY-STATE PIC X(2). 004600 10 FILLER PIC X(7) VALUE SPACE. 004700 05 FILLER PIC X VALUE SPACE. 004800 05 DISPLAY-CONTACT PIC X(30).
014000 DISPLAY-LINE-4. 014100 MOVE SPACE TO DETAIL-LINE. 014200 MOVE VENDOR-CITY TO DISPLAY-CITY. 014300 MOVE VENDOR-STATE TO DISPLAY-STATE. 014400 014500 MOVE VENDOR-ZIP TO DISPLAY-CONTACT. 014600 MOVE DETAIL-LINE TO DISPLAY-RECORD. 014700 PERFORM WRITE-DISPLAY-RECORD.
PRINT phnprt02.cbl PRINT vnddsp01.cbl
© Copyright, Macmillan Computer Publishing. All rights reserved.