Teach Yourself COBOL in 21 days, Second Edition

Previous chapterNext chapterContents


- Day 11 -
Indexed File I/O

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:

What Is an Indexed File?

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.

TYPE: Listing 11.1. A customer record.

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

TYPE: Listing 11.2. Adding a customer number.

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.

Indexed Files in COBOL

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.

TYPE: Listing 11.3. FD for a keyed file.

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.

TYPE: Listing 11.4. A SELECT statement for 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.

TYPE: Listing 11.5. A SELECT statement for a keyed file.

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.

TYPE: Listing 11.6. Creating an empty vendor file.

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

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.

TYPE: Listing 11.7. Adding indexed records.

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.

Handling File Errors

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

TYPE: Listing 11.8. Creating an error at the end of the file.

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.

TYPE: Listing 11.9. Fixing vnderr02.cbl.

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.

TYPE: Listing 11.10. Improving additions to the vendor file.

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.

Retrieving Records in Key Order

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.

TYPE: Listing 11.11. Showing the records.

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.

Formatting Long Records for Display

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.

TYPE: Listing 11.12. Displaying the vendor records.

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.

TYPE: Listing 11.13. A second detail line for vnddsp01.cbl.

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.

TYPE: Listing 11.14. Using 2ND-DETAIL-LINE.

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.

Summary

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:

Q&A

Q Does a primary key have to be numeric?

A No. An alphanumeric field can be used as a primary key.

Q If it doesn't have to be numeric, what order does it use?

A It usually uses the collating sequence of the machine on which the program was compiled. For minicomputers and PCs, this is ASCII sequence, shown in Appendix B, "ASCII." Basically, numbers appear before alphabetic characters, and uppercase alphabet characters appear before lowercase ones.

Workshop

Quiz

1. A salesperson's contact file is organized with records using the FD in the following code:
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).
The contact file also is organized as an indexed file using a SELECT statement, as in the following code:
000300     SELECT CONTACT-FILE
000400         ASSIGN TO "contact"
000500         ORGANIZATION IS INDEXED
000600         RECORD KEY IS CONTACT-BIRTH-DATE
000700         ACCESS MODE IS DYNAMIC.
If the file is expected to have hundreds of entries, what is wrong with CONTACT-BIRTH-DATE as a primary key?

2. Of the existing fields in the CONTACT-RECORD, which one has a better chance than CONTACT-BIRTH-DATE of being unique?

Exercises

1. Design a better way of defining the contact file so that you can create a unique key within the record.

2. Another way of handling the city, state, and zip code lines in vnddsp01.cbl is to use a DETAIL-LINE, as shown in the following code:
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).
Also, you should change DISPLAY-LINE-4 by removing the code at line 014400, as in the following code:
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.
Can you explain why?

3. Print out copies of phnprt02.cbl from Day 10, "Printing," and vnddsp01.cbl. Mark out sections of the two programs that behave in similar ways. Although one prints to a printer and the other displays on-screen, the basic logical design of the two programs is similar. You can print these most simply in MS-DOS by entering the following:
PRINT phnprt02.cbl
PRINT vnddsp01.cbl
If you are using another type of computer, consult your manual.


Previous chapterNext chapterContents


© Copyright, Macmillan Computer Publishing. All rights reserved.