Teach Yourself COBOL in 21 days, Second Edition

- A -
Answers

Answers to Day 1, "Your First COBOL Program"

Quiz

1. The output of the sample program BYEBYE is the following:

Bye bye birdie

2. The byebye.cbl program contains four divisions: the IDENTIFICATION DIVISION, the ENVIRONMENT DIVISION, the DATA DIVISION, and the PROCEDURE DIVISION.

3. The program contains three paragraphs: PROGRAM-ID in the IDENTIFICATION DIVISION, PROGRAM-BEGIN in the PROCEDURE DIVISION, and PROGRAM-STOP in the PROCEDURE DIVISION.

4. The program contains two sentences: DISPLAY "Bye bye birdie" and STOP RUN. It also is possible to consider BYEBYE (the PROGRAM-ID) a sentence.

5. The bad01.cbl program contains no DATA DIVISION and, therefore, is missing one of the four standard divisions. ANSI-85 COBOL allows the ENVIRONMENT DIVISION and the DATA DIVISION to be omitted if there is nothing to put in them. Do not get into a habit of leaving these out, as your code might have to run on a version of COBOL that does not allow this option.

6. The bad02.cbl program contains a sentence, DISPLAY "I'm bad!", that begins in Area A.

7. The bad03.cbl program contains a comment, but there is no asterisk in column 7. The compiler will attempt to compile the comment "This program displays a message." and will fail because it is not in COBOL syntax.

Exercises

1. One method of solving the problem is shown in Listing A.1, iam.cbl.

TYPE: Listing A.1. Another simple display.

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. IAM.
000300 ENVIRONMENT DIVISION.
000400 DATA DIVISION.
000500 PROCEDURE DIVISION.
000600
000700 PROGRAM-BEGIN.
000800     DISPLAY "I am a COBOL programmer".
000900 PROGRAM-DONE.
001000     STOP RUN.

2. Make a note of the errors.

3. Add a DATA DIVISION under the ENVIRONMENT DIVISION:

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. BAD01FIX.
000300 ENVIRONMENT DIVISION.
000400 DATA DIVISION.
000500 PROCEDURE DIVISION.
000600
000700 PROGRAM-BEGIN.
000800     DISPLAY "I'm bad!".
000900 PROGRAM-DONE.
001000     STOP RUN.

4. Move the DISPLAY statement to the right so that it begins in column 12 or higher:

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. BAD01FIX.
000300 ENVIRONMENT DIVISION.
000400 DATA DIVISION.
000500 PROCEDURE DIVISION.
000600
000700 PROGRAM-BEGIN.
000800     DISPLAY "I'm bad!".
000900 PROGRAM-DONE.
001000     STOP RUN.

5. Place an asterisk in column 7 of a line containing a comment:

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. BAD03FIX.
000300 ENVIRONMENT DIVISION.
000400 DATA DIVISION.
000500 PROCEDURE DIVISION.
000600*    This program displays a message.
000700 PROGRAM-BEGIN.
000800     DISPLAY "I'm really bad!".
000900 PROGRAM-DONE.
001100     STOP RUN.

Answers to Day 2, "Using Variables and Constants"

Quiz

1. 30 bytes.

2. Alphanumeric data.

3. The remaining character positions are filled with spaces by the MOVE verb.

4. The largest value is 9,999.

5. The smallest value is 0, which would be stored as 0000.

6. The four places are filled with 0012.

Exercises

1. Adding a one-line DISPLAY informs the user of what's happening (as shown in Listing A.2).

TYPE: Listing A.2. Keeping the user informed.

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. ADD03.
000300 ENVIRONMENT DIVISION.
000400 DATA DIVISION.
000500
000600 WORKING-STORAGE SECTION.
000700
000800 01  FIRST-NUMBER      PICTURE IS 99.
000900 01  SECOND-NUMBER     PICTURE IS 99.
001000 01  THE-RESULT        PICTURE IS 999.
001100
001200 PROCEDURE DIVISION.
001300
001400 PROGRAM-BEGIN.
001500     DISPLAY "This program will add 2 numbers.".
001600     DISPLAY "Enter the first number.".
001700
001800     ACCEPT FIRST-NUMBER.
001900
002000     DISPLAY "Enter the second number.".
002100
002200     ACCEPT SECOND-NUMBER.
002300
002400     COMPUTE THE-RESULT = FIRST-NUMBER + SECOND-NUMBER.
002500
002600     DISPLAY "The result is " THE-RESULT.
002700
002800
002900 PROGRAM-DONE.
003000     STOP RUN.
003100

The following is sample output for Listing A.2:

OUTPUT:

C>pcobrun add03
This program will add 2 numbers.
Enter the first number.
16
Enter the second number.
44
The result is 060

C>

2. For my selection of a verse, I have chosen the sad tale of the Lady of Eiger, which is recounted with numbered lines in Listing A.3. Of course, your program will contain a verse of your own choosing.

TYPE: Listing A.3. Numbering a longer phrase.

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. EIGER01.
000300 ENVIRONMENT DIVISION.
000400 DATA DIVISION.
000500
000600 WORKING-STORAGE SECTION.
000700
000800 01  THE-MESSAGE      PIC X(50).
000900 01  THE-NUMBER       PIC 9(2).
001000 01  A-SPACE          PIC X.
001100
001200 PROCEDURE DIVISION.
001300 PROGRAM-BEGIN.
001400
001500* Initialize the space variable
001600     MOVE " " TO A-SPACE.
001700
001800* Set up and display line 1
001900     MOVE 1 TO THE-NUMBER.
002000     MOVE "There once was a lady from Eiger,"
002100         TO THE-MESSAGE.
002200     DISPLAY
002300         THE-NUMBER
002400         A-SPACE
002500         THE-MESSAGE.
002600
002700* Set up and Display line 2
002800     ADD 1 TO THE-NUMBER.
002900     MOVE "Who smiled and rode forth on a tiger."
003000         TO THE-MESSAGE.
003100     DISPLAY
003200         THE-NUMBER
003300         A-SPACE
003400         THE-MESSAGE.
003500
003600* Set up and display line 3
003700     ADD 1 TO THE-NUMBER.
003800     MOVE "They returned from the ride" TO THE-MESSAGE.
003900     DISPLAY
004000         THE-NUMBER
004100         A-SPACE
004200         THE-MESSAGE.
004300
004400* Set up and display line 4
004500     ADD 1 TO THE-NUMBER.
004600     MOVE "With the lady inside," TO THE-MESSAGE.
004700     DISPLAY
004800         THE-NUMBER
004900         A-SPACE
005000         THE-MESSAGE.
005100
005200* Set up and display line 5
005300     ADD 1 TO THE-NUMBER.
005400     MOVE "And the smile on the face of the tiger."
005500         TO THE-MESSAGE.
005600     DISPLAY
005700         THE-NUMBER
005800         A-SPACE
005900         THE-MESSAGE.
006000
006100
006200 PROGRAM-DONE.
006300     STOP RUN.
006400

The following is sample output for Listing A.3:

OUTPUT:

01 There once was a lady from Eiger,
02 Who smiled and rode forth on a tiger.
03 They returned from the ride
04 With the lady inside,
05 And the smile on the face of the tiger.
C>
C>

3. Listing A.4 reprises the sad tale with line numbers in increments of 5.

TYPE: Listing A.4. Incrementing by 5.

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. EIGER02.
000300 ENVIRONMENT DIVISION.
000400 DATA DIVISION.
000500
000600 WORKING-STORAGE SECTION.
000700
000800 01  THE-MESSAGE      PIC X(50).
000900 01  THE-NUMBER       PIC 9(2).
001000 01  A-SPACE          PIC X.
001100
001200 PROCEDURE DIVISION.
001300 PROGRAM-BEGIN.
001400
001500* Initialize the space variable
001600     MOVE " " TO A-SPACE.
001700
001800* Set up and display line 1
001900     MOVE 5 TO THE-NUMBER.
002000     MOVE "There once was a lady from Eiger,"
002100         TO THE-MESSAGE.
002200     DISPLAY
002300         THE-NUMBER
002400         A-SPACE
002500         THE-MESSAGE.
002600
002700* Set up and Display line 2
002800     ADD 5 TO THE-NUMBER.
002900     MOVE "Who smiled and rode forth on a tiger."
003000         TO THE-MESSAGE.
003100     DISPLAY
003200         THE-NUMBER
003300         A-SPACE
003400         THE-MESSAGE.
003500
003600* Set up and display line 3
003700     ADD 5 TO THE-NUMBER.
003800     MOVE "They returned from the ride" TO THE-MESSAGE.
003900     DISPLAY
004000         THE-NUMBER
004100         A-SPACE
004200         THE-MESSAGE.
004300
004400* Set up and display line 4
004500     ADD 5 TO THE-NUMBER.
004600     MOVE "With the lady inside," TO THE-MESSAGE.
004700     DISPLAY
004800         THE-NUMBER
004900         A-SPACE
005000         THE-MESSAGE.
005100
005200* Set up and display line 5
005300     ADD 5 TO THE-NUMBER.
005400     MOVE "And the smile on the face of the tiger."
005500         TO THE-MESSAGE.
005600     DISPLAY
005700         THE-NUMBER
005800         A-SPACE
005900         THE-MESSAGE.
006000
006100
006200 PROGRAM-DONE.
006300     STOP RUN.
006400

The following is sample output for Listing A.4:

OUTPUT:

05 There once was a lady from Eiger,
10 Who smiled and rode forth on a tiger.
15 They returned from the ride
20 With the lady inside,
25 And the smile on the face of the tiger.
C>
C>

Answers to Day 3, "A First Look at Structured COBOL"

Quiz

1. c. LOCATE-OVERDUE-CUSTOMERS best describes the function of the paragraph.

2. There are two ways to number the program. In the first example, the paragraph names as well as the sentences being executed are numbered:

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. MSG01.
000300
000400 ENVIRONMENT DIVISION.
000500 DATA DIVISION.
000600
000700 WORKING-STORAGE SECTION.
000800
000900 PROCEDURE DIVISION.
001000
001100 PROGRAM-BEGIN.                         
001200
001300     PERFORM MAIN-LOGIC.                
001400
001500 PROGRAM-DONE.                          
001600     STOP RUN.                          
001700
001800 MAIN-LOGIC.                            
001900     PERFORM DISPLAY-MSG-1.             
002000     PERFORM DISPLAY-MSG-2.             
002100
002200 DISPLAY-MSG-1.                         
002300     DISPLAY "This is message 1.".      
002400
002500 DISPLAY-MSG-2.                         
002600     DISPLAY "This is message 2.".      
002700

In this example, only the sentences are numbered:

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. MSG01.
000300
000400 ENVIRONMENT DIVISION.
000500 DATA DIVISION.
000600
000700 WORKING-STORAGE SECTION.
000800
000900 PROCEDURE DIVISION.
001000
001100 PROGRAM-BEGIN.
001200
001300     PERFORM MAIN-LOGIC.                
001400
001500 PROGRAM-DONE.
001600     STOP RUN.                          
001700
001800 MAIN-LOGIC.
001900     PERFORM DISPLAY-MSG-1.             
002000     PERFORM DISPLAY-MSG-2.             
002100
002200 DISPLAY-MSG-1.
002300     DISPLAY "This is message 1.".      
002400
002500 DISPLAY-MSG-2.
002600     DISPLAY "This is message 2.".      
002700

Exercises

1. In Listing A.5, PROGRAM-DONE and STOP RUN have been removed.

TYPE: Listing A.5. Missing a `STOP RUN`.

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. HELLO06.
000300
000400* This program illustrates the use of a PERFORM
000500
000600 ENVIRONMENT DIVISION.
000700 DATA DIVISION.
000800 PROCEDURE DIVISION.
000900
001000 PROGRAM-BEGIN.
001100     DISPLAY "Today's message is:".
001200     PERFORM SAY-HELLO.
001300
001400 SAY-HELLO.
001500     DISPLAY "Hello world".
001600

The following output from hello06.cbl is similar to the output of hello05.cbl in Day 3:

OUTPUT:

Today's message is:
Hello world
Hello world
C>
C>

You must have a STOP RUN in your program that appears before any paragraphs that are PERFORMed.

2. The flow of hello06.cbl is the following:

Line 001000. Internally note that the PROGRAM-BEGIN paragraph has started.

Line 001100. Display "Today's message is:" on-screen.

Line 001200. Jump to line 001400, the beginning of SAY-HELLO.

Line 001400. Internally note that the SAY-HELLO paragraph has started.

Line 001500. Display "Hello world" on-screen.

End of file. Recognize that the SAY-HELLO paragraph has ended. Because this is in the middle of a PERFORM requested on line 001200, return to the end of line 001200, where no further actions are requested.

Line 001200. No other actions on this line.

Line 001400. Internally note that the SAY-HELLO paragraph has started.

Line 001500. Display "Hello world" on-screen. End of file. Recognize that the SAY-HELLO paragraph has ended. There is no active PERFORM requested, so the program ends here. The end of the program might cause an error in your version of COBOL after this display.

3. Insert a STOP RUN at line 001300 to prevent this problem.

4. Listing A.6, add08.cbl, adds three numbers together and displays the result.

TYPE: Listing A.6. Adding three numbers.

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. ADD08.
000300 ENVIRONMENT DIVISION.
000400 DATA DIVISION.
000500
000600 WORKING-STORAGE SECTION.
000700
000800 01  FIRST-NUMBER      PICTURE IS 99.
000900 01  SECOND-NUMBER     PICTURE IS 99.
001000 01  THIRD-NUMBER      PICTURE IS 99.
001100 01  THE-RESULT        PICTURE IS 999.
001200
001300 PROCEDURE DIVISION.
001400
001500 PROGRAM-BEGIN.
001600
001700     PERFORM ADVISE-THE-USER.
001800     PERFORM GET-FIRST-NUMBER.
001900     PERFORM GET-SECOND-NUMBER.
002000     PERFORM GET-THIRD-NUMBER.
002100     PERFORM COMPUTE-AND-DISPLAY.
002200
002300 PROGRAM-DONE.
002400     STOP RUN.
002500
002600 ADVISE-THE-USER.
002700     DISPLAY "This program will add 3 numbers.".
002800
002900 GET-FIRST-NUMBER.
003000
003100     DISPLAY "Enter the first number.".
003200     ACCEPT FIRST-NUMBER.
003300
003400 GET-SECOND-NUMBER.
003500
003600     DISPLAY "Enter the second number.".
003700     ACCEPT SECOND-NUMBER.
003800
003900 GET-THIRD-NUMBER.
004000
004100     DISPLAY "Enter the third number.".
004200     ACCEPT THIRD-NUMBER.
004300
004400 COMPUTE-AND-DISPLAY.
004500
004600     COMPUTE THE-RESULT = FIRST-NUMBER +
004700                          SECOND-NUMBER +
004800                          THIRD-NUMBER.
004900     DISPLAY "The result is " THE-RESULT.
005000

The following is sample output for Listing A.6:

OUTPUT:

This program will add 3 numbers.
Enter the first number.
12
Enter the second number.
64
Enter the third number.
99
The result is 175
C>
C>

5. Listing A.7, add09.cbl, provides a sample method of breaking add02.cbl into performed paragraphs.

TYPE: Listing A.7. Adding two numbers using `PERFORM`.

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. ADD09.
000300 ENVIRONMENT DIVISION.
000400 DATA DIVISION.
000500
000600 WORKING-STORAGE SECTION.
000700
000800 01  FIRST-NUMBER      PICTURE IS 99.
000900 01  SECOND-NUMBER     PICTURE IS 99.
001000 01  THE-RESULT        PICTURE IS 999.
001100
001200 PROCEDURE DIVISION.
001300
001400 PROGRAM-BEGIN.
001500
001600     PERFORM ENTER-THE-FIRST-NUMBER.
001700     PERFORM ENTER-THE-SECOND-NUMBER.
001800     PERFORM COMPUTE-AND-DISPLAY.
001900
002000 PROGRAM-DONE.
002100     STOP RUN.
002200
002300 ENTER-THE-FIRST-NUMBER.
002400
002500     DISPLAY "Enter the first number.".
002600
002700     ACCEPT FIRST-NUMBER.
002800
002900 ENTER-THE-SECOND-NUMBER.
003000
003100     DISPLAY "Enter the second number.".
003200
003300     ACCEPT SECOND-NUMBER.
003400
003500 COMPUTE-AND-DISPLAY.
003600
003700     COMPUTE THE-RESULT = FIRST-NUMBER + SECOND-NUMBER.
003800
003900     DISPLAY "The result is " THE-RESULT.
004000

Answers to Day 4, "Decision Making"

Quiz

1. Lines 005500 and 005600.

2. Line 005800.

3. Lines 005500 and 005600.

4. Line 005800.

Exercises

1. Listing A.8 shows one method of providing for three possible answers.

TYPE: Listing A.8. Allowing for three valid answers.

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. MAYBE01.
000300*--------------------------------------------------
000400* This program asks for a Y or N answer, and then
000500* displays whether the user chose yes or no.
000600* The edit logic allows for entry of Y, y, N, or n.
000700*--------------------------------------------------
000800 ENVIRONMENT DIVISION.
000900 DATA DIVISION.
001000 WORKING-STORAGE SECTION.
001100
001200 01  YES-OR-NO      PIC X.
001300
001400 PROCEDURE DIVISION.
001500 PROGRAM-BEGIN.
001600
001700     PERFORM GET-THE-ANSWER.
001800
001900     PERFORM EDIT-THE-ANSWER.
002000
002100     PERFORM DISPLAY-THE-ANSWER.
002200
002300 PROGRAM-DONE.
002400     STOP RUN.
002500
002600 GET-THE-ANSWER.
002700
002800     DISPLAY "Is the answer Yes, No or Maybe? (Y/N/M)".
002900     ACCEPT YES-OR-NO.
003000
003100 EDIT-THE-ANSWER.
003200
003300     IF YES-OR-NO = "y"
003400         MOVE "Y" TO YES-OR-NO.
003500
003600     IF YES-OR-NO = "n"
003700         MOVE "N" TO YES-OR-NO.
003800
003900     IF YES-OR-NO = "m"
004000         MOVE "M" TO YES-OR-NO.
004100
004200 DISPLAY-THE-ANSWER.
004300     IF YES-OR-NO = "Y"
004400         DISPLAY "You answered Yes.".
004500
004600     IF YES-OR-NO = "N"
004700         DISPLAY "You answered No.".
004800
004900     IF YES-OR-NO = "M"
005000         DISPLAY "You answered Maybe.".

2. Listing A.9 shows one way of adding Maybe as an option. You can test three conditions as well as two, as in this example.

TYPE: Listing A.9. Using `OR` to test three conditions.

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. MAYBE02.
000300*--------------------------------------------------
000400* This program asks for a Y, N, or M answer, and
000500* displays the user's choice.
000600* The edit allows for Y, y, N, n, M, or m.
000700*--------------------------------------------------
000800 ENVIRONMENT DIVISION.
000900 DATA DIVISION.
001000 WORKING-STORAGE SECTION.
001100
001200 01  YES-OR-NO      PIC X.
001300
001400 PROCEDURE DIVISION.
001500 PROGRAM-BEGIN.
001600
001700     PERFORM GET-THE-ANSWER.
001800
001900     PERFORM EDIT-THE-ANSWER.
002000
002100     PERFORM DISPLAY-THE-ANSWER.
002200
002300 PROGRAM-DONE.
002400     STOP RUN.
002500
002600 GET-THE-ANSWER.
002700
002800     DISPLAY "Is the answer Yes, No or Maybe? (Y/N/M)".
002900     ACCEPT YES-OR-NO.
003000
003100 EDIT-THE-ANSWER.
003200
003300     IF YES-OR-NO = "y"
003400         MOVE "Y" TO YES-OR-NO.
003500
003600     IF YES-OR-NO = "n"
003700         MOVE "N" TO YES-OR-NO.
003800
003900     IF YES-OR-NO = "m"
004000         MOVE "M" TO YES-OR-NO.
004100
004200 DISPLAY-THE-ANSWER.
004300
004400     IF YES-OR-NO = "Y" OR
004500        YES-OR-NO = "N" OR
004600        YES-OR-NO = "M"
004700         PERFORM DISPLAY-YES-NO-OR-MAYBE
004800     ELSE
004900         DISPLAY "Your answer was invalid.".
005000
005100 DISPLAY-YES-NO-OR-MAYBE.
005200     IF YES-OR-NO = "Y"
005300         DISPLAY "You answered Yes.".
005400
005500     IF YES-OR-NO = "N"
005600         DISPLAY "You answered No.".
005700
005800     IF YES-OR-NO = "M"
005900         DISPLAY "You answered Maybe.".
006000

Answers to Day 5, "Using `PERFORM`, `GO TO`, and `IF` to Control Programs"

Quiz

1. Assuming that the program contains the correct structure, with a STOP RUN located in the correct place in the code, 10 times.

2. 5 times.

3. In the listing for question 1, the loop control is at line 003600 and the processing loop is at lines 003800 through 003900:

003600     PERFORM DISPLAY-HELLO 10 TIMES.
003700
003800 DISPLAY-HELLO.
003900     DISPLAY "hello".
004000

In the listing for question 2, the loop control is at lines 003600 through 003800. The processing loop is at lines 004000 through 004100:

003600     PERFORM DISPLAY-HELLO
003700         VARYING THE-COUNT FROM 1 BY 1
003800         UNTIL THE-COUNT > 5.
003900
004000 DISPLAY-HELLO.
004100     DISPLAY "hello".
004200

Exercise

There are several ways to do this. The following are four possible examples.

The following uses the TIMES option of the PERFORM verb.

003900     PERFORM A-PARAGRAPH 8 TIMES.

The following example uses THE-COUNT as a variable that is controlled by a VARYING option of the PERFORM verb.

003900     PERFORM A-PARAGRAPH
004000         VARYING THE-COUNT FROM 1 BY 1
004100           UNTIL THE-COUNT > 8.

The following example uses THE-COUNT as a variable that is tested with the UNTIL option of the PERFORM verb. The value of the variable is changed in the paragraph that is being PERFORMed.

003800     MOVE 1 TO THE-COUNT.
003900     PERFORM A-PARAGRAPH
004000           UNTIL THE-COUNT > 8.
......
......
005600 A-PARAGRAPH.
005700* Some processing code goes here
......
......
006500     ADD 1 TO THE-COUNT.

This example uses a GO TO and will be frowned on by some:

003800     MOVE 1 TO THE-COUNT.
003900     PERFORM A-PARAGRAPH.
......
......
005600 A-PARAGRAPH.
005700* Some processing code goes here
......
......
006500     ADD 1 TO THE-COUNT.
006600     IF THE-COUNT NOT > 8
006700         GO TO A-PARAGRAPH.
006800

Answers to Day 6, "Using Data and COBOL Operators"

Quiz

1. 04976.

2. 76.

3. The integer portion of the value, 1000, is too large to fit in a PIC 999, so the 1 is truncated, resulting in a value of 000. The decimal portion .001 is truncated on the right when it is moved to the V99 portion of the picture. The overall result is that the far left 1 and the far right 1 are both truncated in the move, leaving a 000.00 in the variable.

Exercises

1. Note any errors or warnings and look them up.

2. Note the errors and look them up.

Answers to Day 7, "Basics of Design"

Quiz

1. The step to be performed to continue the design is to break the job description into smaller tasks.

2. The first six steps of design are as follows:

1. Create a job description for the program.

2. Break the job description into tasks until the tasks approximate what the computer will do.

3. Identify the processing loops.

4. Identify the main processing loop if it has not become apparent during step 3.

5. Write the program in pseudocode.

6. Convert the pseudocode into actual code.

Exercises

1. The design steps for a sales tax calculator are as follows:

a. Job: Ask the user for sales amounts and sales tax rates, and use these values to calculate the sales tax on the amount.

b. Tasks: Ask the user for a sales amount, ask the user for a sales tax percentage, and calculate the sales tax (over and over).

c. Processing loops: There is only one processing loop in the task list, calculate the sales tax (over and over).

d. Main loop: The main loop is the loop for calculating the sales tax.

e. Pseudocode:

THE-PROGRAM
    MOVE "Y" TO YES-NO.
    PERFORM CALCULATE-SALES-TAX
       UNTIL YES-NO = "N".

CALCULATE-SALES-TAX.
    PERFORM GET-SALES-AMOUNT.
    PERFORM GET-TAX-PERCENT.
    PERFORM CALCULATE-TAX-AMOUNT.
    PERFORM DISPLAY-TAX-AMOUNT.
    PERFORM GO-AGAIN.

GET-SALES-AMOUNT.
    (between 0.01 and 9999.99)

GET-TAX-PERCENT.
    (between 0.1% and 20.0%)

CALCULATE-TAX-AMOUNT.
    COMPUTE SALES-TAX ROUNDED =
        SALES-AMOUNT * TAX-AS-DECIMAL.

DISPLAY-TAX-AMOUNT.
    (sales tax = SALES-TAX)

GO-AGAIN.
    (yes or no)

f. Code. Listing A.10 is an example of the code that could result from this design. Remember to adjust the ACCEPT WITH CONVERSION statements at lines 004700 and 005800. Listing A.10 is coded for versions of COBOL that require ACCEPT WITH CONVERSION. If you are using Micro Focus Personal COBOL, just use ACCEPT.

TYPE: Listing A.10. A sales tax calculator.

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. SLSTAX01.
000300*------------------------------------------------
000400* Calculates sales tax based on entered sales
000500* amounts and tax rates.
000600*------------------------------------------------
000700 ENVIRONMENT DIVISION.
000800 DATA DIVISION.
000900 WORKING-STORAGE SECTION.
001000
001100 01  YES-NO           PIC X.
001200 01  ENTRY-OK         PIC X.
001300 01  TAX-PERCENT      PIC 99V99.
001400 01  TAX-AS-DECIMAL   PIC V9999.
001500
001600 01  SALES-AMOUNT     PIC 9(4)V99.
001700 01  SALES-TAX        PIC 9(4)V99.
001800
001900 01  ENTRY-FIELD      PIC Z(4).ZZ.
002000 01  DISPLAY-SALES-TAX PIC Z,ZZ9.99.
002100
002200
002300 PROCEDURE DIVISION.
002400 PROGRAM-BEGIN.
002500
002600     MOVE "Y" TO YES-NO.
002700     PERFORM CALCULATE-SALES-TAX
002800        UNTIL YES-NO = "N".
002900
003000 PROGRAM-DONE.
003100     STOP RUN.
003200
003300 CALCULATE-SALES-TAX.
003400     PERFORM GET-SALES-AMOUNT.
003500     PERFORM GET-TAX-PERCENT.
003600     PERFORM CALCULATE-TAX-AMOUNT.
003700     PERFORM DISPLAY-TAX-AMOUNT.
003800     PERFORM GO-AGAIN.
003900
004000 GET-SALES-AMOUNT.
004100     MOVE "N" TO ENTRY-OK.
004200     PERFORM ENTER-SALES-AMOUNT
004300         UNTIL ENTRY-OK = "Y".
004400
004500 ENTER-SALES-AMOUNT.
004600     DISPLAY "SALES AMOUNT (0.01 TO 9999.99)?".
004700     ACCEPT ENTRY-FIELD WITH CONVERSION.
004800     MOVE ENTRY-FIELD TO SALES-AMOUNT.
004900     IF SALES-AMOUNT < .01 OR
005000        SALES-AMOUNT > 9999.99
005100         DISPLAY "INVALID ENTRY"
005200     ELSE
005300         MOVE "Y" TO ENTRY-OK.
005400
005500 GET-TAX-PERCENT.
005600     DISPLAY "SALES TAX PERCENT (.01% TO 20.00%)?".
005700     ACCEPT ENTRY-FIELD WITH CONVERSION.
005800     MOVE ENTRY-FIELD TO TAX-PERCENT.
005900     IF TAX-PERCENT < .01 OR
006000        TAX-PERCENT > 20.0
006100         DISPLAY "INVALID ENTRY"
006200     ELSE
006300         MOVE "Y" TO ENTRY-OK
006400         COMPUTE TAX-AS-DECIMAL = TAX-PERCENT / 100.
006500
006600 CALCULATE-TAX-AMOUNT.
006700     COMPUTE SALES-TAX ROUNDED =
006800         SALES-AMOUNT * TAX-AS-DECIMAL.
006900
007000 DISPLAY-TAX-AMOUNT.
007100     MOVE SALES-TAX TO DISPLAY-SALES-TAX.
007200     DISPLAY "SALES TAX = " DISPLAY-SALES-TAX.
007300
007400 GO-AGAIN.
007500     DISPLAY "GO AGAIN?".
007600     ACCEPT YES-NO.
007700     IF YES-NO = "y"
007800         MOVE "Y" TO YES-NO.
007900     IF YES-NO NOT = "Y"
008000         MOVE "N" TO YES-NO.
008100

The sample output for slstax01.cbl is as follows:

OUTPUT:

SALES AMOUNT (0.01 TO 9999.99)?
22.95
SALES TAX PERCENT (.01% TO 20.00%)?
8.25
SALES TAX =     1.89
GO AGAIN?
y
SALES AMOUNT (0.01 TO 9999.99)?
432.17
SALES TAX PERCENT (.01% TO 20.00%)?
6.5
SALES TAX =    28.09
GO AGAIN?

2. Get the program working correctly before proceeding to the next exercise. Refer to the previous example for tips on how to do this.

3. Listing A.11 is an example of one way to change the program to ask for the sales tax rate only once. Study the difference between slstax01.cbl and slstax02.cbl--in particular, the fact that the sales tax percentage is asked for outside of the main loop. Remember the rule for a processing loop: You set up any values needed for the first entry into the loop. This applies even if setting up the initial value requires a DISPLAY and ACCEPT statement or even more complicated logic. Remember to change the ACCEPT WITH CONVERSION statements to ACCEPT statements as necessary.

TYPE: Listing A.11. Asking for the tax rate once.

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. SLSTAX02.
000300*------------------------------------------------
000400* Accepts tax rate from the user and then
000500* calculates sales tax over and over based on
000600* entered sales amounts.
000700*------------------------------------------------
000800 ENVIRONMENT DIVISION.
000900 DATA DIVISION.
001000 WORKING-STORAGE SECTION.
001100
001200 01  YES-NO           PIC X.
001300 01  ENTRY-OK         PIC X.
001400 01  TAX-PERCENT      PIC 99V99.
001500 01  TAX-AS-DECIMAL   PIC V9999.
001600
001700 01  SALES-AMOUNT     PIC 9(4)V99.
001800 01  SALES-TAX        PIC 9(4)V99.
001900
002000 01  ENTRY-FIELD      PIC Z(4).ZZ.
002100 01  DISPLAY-SALES-TAX PIC Z,ZZ9.99.
002200
002300 PROCEDURE DIVISION.
002400 PROGRAM-BEGIN.
002500
002600     PERFORM GET-TAX-PERCENT.
002700     MOVE "Y" TO YES-NO.
002800     PERFORM CALCULATE-SALES-TAX
002900        UNTIL YES-NO = "N".
003000
003100 PROGRAM-DONE.
003200     STOP RUN.
003300
003400 CALCULATE-SALES-TAX.
003500     PERFORM GET-SALES-AMOUNT.
003600     PERFORM CALCULATE-TAX-AMOUNT.
003700     PERFORM DISPLAY-TAX-AMOUNT.
003800     PERFORM GO-AGAIN.
003900
004000 GET-SALES-AMOUNT.
004100     MOVE "N" TO ENTRY-OK.
004200     PERFORM ENTER-SALES-AMOUNT
004300         UNTIL ENTRY-OK = "Y".
004400
004500 ENTER-SALES-AMOUNT.
004600     DISPLAY "SALES AMOUNT (0.01 TO 9999.99)?".
004700     ACCEPT ENTRY-FIELD WITH CONVERSION.
004800     MOVE ENTRY-FIELD TO SALES-AMOUNT.
004900     IF SALES-AMOUNT < .01 OR
005000        SALES-AMOUNT > 9999.99
005100         DISPLAY "INVALID ENTRY"
005200     ELSE
005300         MOVE "Y" TO ENTRY-OK.
005400
005500 GET-TAX-PERCENT.
005600     DISPLAY "SALES TAX PERCENT (.01% TO 20.00%)?".
005700     ACCEPT ENTRY-FIELD WITH CONVERSION.
005800     MOVE ENTRY-FIELD TO TAX-PERCENT.
005900     IF TAX-PERCENT < .01 OR
006000        TAX-PERCENT > 20.0
006100         DISPLAY "INVALID ENTRY"
006200     ELSE
006300         MOVE "Y" TO ENTRY-OK
006400         COMPUTE TAX-AS-DECIMAL = TAX-PERCENT / 100.
006500
006600 CALCULATE-TAX-AMOUNT.
006700     COMPUTE SALES-TAX ROUNDED =
006800         SALES-AMOUNT * TAX-AS-DECIMAL.
006900
007000 DISPLAY-TAX-AMOUNT.
007100     MOVE SALES-TAX TO DISPLAY-SALES-TAX.
007200     DISPLAY "SALES TAX = " DISPLAY-SALES-TAX.
007300
007400 GO-AGAIN.
007500     DISPLAY "GO AGAIN?".
007600     ACCEPT YES-NO.
007700     IF YES-NO = "y"
007800         MOVE "Y" TO YES-NO.
007900     IF YES-NO NOT = "Y"
008000         MOVE "N" TO YES-NO.
008100

Here is the output:

OUTPUT:

SALES TAX PERCENT (.01% TO 20.00%)?
8.75
SALES AMOUNT (0.01 TO 9999.99)?
312.95
SALES TAX =    27.38
GO AGAIN?
y
SALES AMOUNT (0.01 TO 9999.99)?
419.15
SALES TAX =    36.68
GO AGAIN?

Answers to Day 8, "Structured Data"

Quiz

1. THE-WHOLE-MESSAGE is 53 bytes long.

2. The implied PICTURE for THE-WHOLE-MESSAGE is PIC X(53).

3. A data structure is a method of combining several variables into one larger variable, frequently for display purposes.

4. The values are destroyed and replaced by whatever was moved into the structure.

5. 004600 IF ANSWER-IS-YES

6. 004600 IF ANSWER-IS-VALID

7. 001800 01 YES-NO PIC X. 001900 88 ANSWER-IS-VALID VALUES "Y", "y", "N", "n". 004600 IF ANSWER-IS-VALID 004700 PERFORM DO-SOMETHING.

Exercises

1. Listing A.12 is one possible way of setting up a structure to display the results.

TYPE: Listing A.12. Displaying multiplication tables with a structure.

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. MULT09.
000300*--------------------------------------------------
000400* This program asks the user for a number for a
000500* multiplication table, and a table size
000600* and then displays a table for that number
000700* times the values 1 through HOW-MANY.
000800*
000900* The display is paused after each 15 lines.
001000*--------------------------------------------------
001100 ENVIRONMENT DIVISION.
001200 DATA DIVISION.
001300 WORKING-STORAGE SECTION.
001400
001500 01  THE-TABLE          PIC 99.
001600 01  THE-ENTRY          PIC 999.
001700 01  THE-PRODUCT        PIC 9999.
001800 01  HOW-MANY-ENTRIES   PIC 99.
001900 01  SCREEN-LINES       PIC 99.
002000
002100 01  A-DUMMY            PIC X.
002200
002300 01  YES-NO             PIC X VALUE "Y".
002400
002500 01 THE-TABLE-LINE.
002600    05  DISPLAY-THE-TABLE   PIC ZZ9.
002700    05  FILLER              PIC XXX VALUE " * ".
002800    05  DISPLAY-THE-ENTRY   PIC ZZ9.
002900    05  FILLER              PIC XXX VALUE " = ".
003000    05  DISPLAY-THE-PRODUCT PIC ZZZ9.
003100
003200
003300 PROCEDURE DIVISION.
003400
003500 PROGRAM-BEGIN.
003600     MOVE "Y" TO YES-NO.
003700     PERFORM DISPLAY-ONE-TABLE
003800         UNTIL YES-NO = "N".
003900
004000 PROGRAM-DONE.
004100     STOP RUN.
004200
004300 DISPLAY-ONE-TABLE.
004400     PERFORM GET-WHICH-TABLE.
004500     PERFORM DISPLAY-TABLE.
004600     PERFORM GO-AGAIN.
004700
004800 GET-WHICH-TABLE.
004900     DISPLAY
005000      "Which multiplication table(01-99)?".
005100     ACCEPT THE-TABLE.
005200
005300 DISPLAY-TABLE.
005400     PERFORM GET-HOW-MANY-ENTRIES.
005500
005600     MOVE 0 TO SCREEN-LINES.
005700
005800     PERFORM DISPLAY-ONE-ENTRY
005900         VARYING THE-ENTRY
006000           FROM 1 BY 1
006100           UNTIL THE-ENTRY > HOW-MANY-ENTRIES.
006200
006300 GO-AGAIN.
006400     DISPLAY "Go Again (Y/N)?".
006500     ACCEPT YES-NO.
006600     IF YES-NO = "y"
006700         MOVE "Y" TO YES-NO.
006800     IF YES-NO NOT = "Y"
006900         MOVE "N" TO YES-NO.
007000
007100 GET-HOW-MANY-ENTRIES.
007200     DISPLAY
007300      "How many entries would you like (01-99)?".
007400     ACCEPT HOW-MANY-ENTRIES.
007500
007600 DISPLAY-ONE-ENTRY.
007700
007800     IF SCREEN-LINES = 15
007900         PERFORM PRESS-ENTER.
008000     COMPUTE THE-PRODUCT = THE-TABLE * THE-ENTRY.
008100     MOVE THE-TABLE TO DISPLAY-THE-TABLE.
008200     MOVE THE-ENTRY TO DISPLAY-THE-ENTRY.
008300     MOVE THE-PRODUCT TO DISPLAY-THE-PRODUCT.
008400     DISPLAY THE-TABLE-LINE.
008500
008600     ADD 1 TO SCREEN-LINES.
008700
008800 PRESS-ENTER.
008900     DISPLAY "Press ENTER to continue . . .".
009000     ACCEPT A-DUMMY.
009100     MOVE 0 TO SCREEN-LINES.
009200

The following is the first screen of output of mult09.cbl:

Which multiplication table(01-99)?
15
How many entries would you like (01-99)?
33
15 *   1 =   15
15 *   2 =   30
15 *   3 =   45
15 *   4 =   60
15 *   5 =   75
15 *   6 =   90
15 *   7 =  105
15 *   8 =  120
15 *   9 =  135
15 *  10 =  150
15 *  11 =  165
15 *  12 =  180
15 *  13 =  195
15 *  14 =  210
15 *  15 =  225
Press ENTER to continue . . .

2. 001100 01 CUST-DATA. 001200 05 CUST-NUMBER PIC 9(5). 001300 05 CUST-NAME PIC X(30). 001400 05 CUST-ADDRESS PIC X(50). 001500 05 CUST-ZIP PIC 9(5).

3. 001100 01 CUST-DATA. 001200 05 CUST-NUMBER PIC 9(5) VALUE ZEROES. 001300 05 CUST-NAME PIC X(30) VALUE SPACES. 001400 05 CUST-ADDRESS PIC X(50) VALUE SPACES. 001500 05 CUST-ZIP PIC 9(5) VALUE ZEROES.

Answers to Day 9, "File I/O"

Quiz

No, the file must be opened with the same logical and physical definition that was used to create the file. In this case, the file definition is longer than the actual physical records in the file.

Exercises

1. Listing A.13 adds the extra field, and it prompts for the extension.

TYPE: Listing A.13. Adding a phone extension.

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. PHNADD02.
000300*--------------------------------------------------
000400* This program creates a new data file if necessary
000500* and adds records to the file from user entered
000600* data.
000700*--------------------------------------------------
000800 ENVIRONMENT DIVISION.
000900 INPUT-OUTPUT SECTION.
001000 FILE-CONTROL.
001100     SELECT OPTIONAL PHONE-FILE
001200*or  SELECT PHONE-FILE
001300         ASSIGN TO "phone.dat"
001400*or      ASSIGN TO "phone"
001500         ORGANIZATION IS SEQUENTIAL.
001600
001700 DATA DIVISION.
001800 FILE SECTION.
001900 FD  PHONE-FILE
002000     LABEL RECORDS ARE STANDARD.
002100 01  PHONE-RECORD.
002200     05  PHONE-LAST-NAME      PIC X(20).
002300     05  PHONE-FIRST-NAME     PIC X(20).
002400     05  PHONE-NUMBER         PIC X(15).
002500     05  PHONE-EXTENSION      PIC X(5).
002600
002700 WORKING-STORAGE SECTION.
002800
002900* Variables for SCREEN ENTRY
003000 01  PROMPT-1               PIC X(9) VALUE "Last Name".
003100 01  PROMPT-2               PIC X(10) VALUE "First Name".
003200 01  PROMPT-3               PIC X(6) VALUE "Number".
003300 01  PROMPT-4               PIC X(9) VALUE "Extension".
003400
003500 01  YES-NO                 PIC X.
003600 01  ENTRY-OK               PIC X.
003700
003800 PROCEDURE DIVISION.
003900 MAIN-LOGIC SECTION.
004000 PROGRAM-BEGIN.
004100
004200     PERFORM OPENING-PROCEDURE.
004300     MOVE "Y" TO YES-NO.
004400     PERFORM ADD-RECORDS
004500         UNTIL YES-NO = "N".
004600     PERFORM CLOSING-PROCEDURE.
004700
004800 PROGRAM-DONE.
004900     STOP RUN.
005000
005100* OPENING AND CLOSING
005200
005300 OPENING-PROCEDURE.
005400     OPEN EXTEND PHONE-FILE.
005500
005600 CLOSING-PROCEDURE.
005700     CLOSE PHONE-FILE.
005800
005900 ADD-RECORDS.
006000     MOVE "N" TO ENTRY-OK.
006100     PERFORM GET-FIELDS
006200        UNTIL ENTRY-OK = "Y".
006300     PERFORM ADD-THIS-RECORD.
006400     PERFORM GO-AGAIN.
006500
006600 GET-FIELDS.
006700     MOVE SPACE TO PHONE-RECORD.
006800     DISPLAY PROMPT-1 " ? ".
006900     ACCEPT PHONE-LAST-NAME.
007000     DISPLAY PROMPT-2 " ? ".
007100     ACCEPT PHONE-FIRST-NAME.
007200     DISPLAY PROMPT-3 " ? ".
007300     ACCEPT PHONE-NUMBER.
007400     DISPLAY PROMPT-4 " ? ".
007500     ACCEPT PHONE-EXTENSION.
007600     PERFORM VALIDATE-FIELDS.
007700
007800 VALIDATE-FIELDS.
007900     MOVE "Y" TO ENTRY-OK.
008000     IF PHONE-LAST-NAME = SPACE
008100         DISPLAY "LAST NAME MUST BE ENTERED"
008200         MOVE "N" TO ENTRY-OK.
008300
008400 ADD-THIS-RECORD.
008500     WRITE PHONE-RECORD.
008600
008700 GO-AGAIN.
008800     DISPLAY "GO AGAIN?".
008900     ACCEPT YES-NO.
009000     IF YES-NO = "y"
009100         MOVE "Y" TO YES-NO.
009200     IF YES-NO NOT = "Y"
009300         MOVE "N" TO YES-NO.
009400

Here is the output of phnadd02.cbl:

OUTPUT:

Last Name  ?
KARENINA
First Name ?
ANA
Number     ?
 (818) 555-4567
Extension ?
123
GO AGAIN?
Y
Last Name  ?
SMITH
First Name ?
MICHAEL VALENTINE
Number     ?
 (415) 555-1234
Extension ?
6065
GO AGAIN?

2. Listing A.14 displays the extra field. Note that the prompts at lines 003000, 003200, 003400, and 003600 had to be shortened to enable the record to fit on an 80-column screen.

TYPE: Listing A.14. Displaying the extension.

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. PHNLST02.
000300*--------------------------------------------------
000400* This program displays the contents of the
000500* phone file.
000600*--------------------------------------------------
000700 ENVIRONMENT DIVISION.
000800 INPUT-OUTPUT SECTION.
000900 FILE-CONTROL.
001000     SELECT OPTIONAL PHONE-FILE
001100*or  SELECT PHONE-FILE
001200         ASSIGN TO "phone.dat"
001300*or      ASSIGN TO "phone"
001400         ORGANIZATION IS SEQUENTIAL.
001500
001600 DATA DIVISION.
001700 FILE SECTION.
001800 FD  PHONE-FILE
001900     LABEL RECORDS ARE STANDARD.
002000 01  PHONE-RECORD.
002100     05  PHONE-LAST-NAME      PIC X(20).
002200     05  PHONE-FIRST-NAME     PIC X(20).
002300     05  PHONE-NUMBER         PIC X(15).
002400     05  PHONE-EXTENSION      PIC X(5).
002500
002600 WORKING-STORAGE SECTION.
002700
002800* Structure for SCREEN DISPLAY
002900 01  FIELDS-TO-DISPLAY.
003000     05  PROMPT-1             PIC X(4) VALUE "Lst:".
003100     05  DISPLAY-LAST-NAME    PIC X(20).
003200     05  PROMPT-2             PIC X(4) VALUE "1st:".
003300     05  DISPLAY-FIRST-NAME   PIC X(20).
003400     05  PROMPT-3             PIC X(3) VALUE "NO:".
003500     05  DISPLAY-NUMBER       PIC X(15).
003600     05  PROMPT-4             PIC X(4) VALUE "Xtn:".
003700     05  DISPLAY-EXTENSION    PIC X(5).
003800
003900 01  END-OF-FILE            PIC X.
004000
004100 01  SCREEN-LINES           PIC 99.
004200 01  A-DUMMY                PIC X.
004300
004400 PROCEDURE DIVISION.
004500 MAIN-LOGIC SECTION.
004600 PROGRAM-BEGIN.
004700
004800     PERFORM OPENING-PROCEDURE.
004900     MOVE ZEROES TO SCREEN-LINES.
005000     MOVE "N" TO END-OF-FILE.
005100     PERFORM READ-NEXT-RECORD.
005200     PERFORM DISPLAY-RECORDS
005300         UNTIL END-OF-FILE = "Y".
005400     PERFORM CLOSING-PROCEDURE.
005500
005600 PROGRAM-DONE.
005700     STOP RUN.
005800
005900 OPENING-PROCEDURE.
006000     OPEN INPUT PHONE-FILE.
006100
006200 CLOSING-PROCEDURE.
006300     CLOSE PHONE-FILE.
006400
006500 DISPLAY-RECORDS.
006600     PERFORM DISPLAY-FIELDS.
006700     PERFORM READ-NEXT-RECORD.
006800
006900 DISPLAY-FIELDS.
007000     IF SCREEN-LINES = 15
007100         PERFORM PRESS-ENTER.
007200     MOVE PHONE-LAST-NAME TO DISPLAY-LAST-NAME.
007300     MOVE PHONE-FIRST-NAME TO DISPLAY-FIRST-NAME.
007400     MOVE PHONE-NUMBER TO DISPLAY-NUMBER.
007500     MOVE PHONE-EXTENSION TO DISPLAY-EXTENSION.
007600     DISPLAY FIELDS-TO-DISPLAY.
007700
007800     ADD 1 TO SCREEN-LINES.
007900
008000 READ-NEXT-RECORD.
008100     READ PHONE-FILE NEXT RECORD
008200        AT END
008300        MOVE "Y" TO END-OF-FILE.
008400
008500 PRESS-ENTER.
008600     DISPLAY "Press ENTER to continue . . ".
008700     ACCEPT A-DUMMY.
008800     MOVE ZEROES TO SCREEN-LINES.
008900

The output of phnlst02.cbl follows:

OUTPUT:

C>pcobrun phnlst01
Personal COBOL version 2.0 from Micro Focus
PCOBRUN V2.0.02  Copyright (C) 1983-1993 Micro Focus Ltd.
Lst:KARENINA         1st:ANA             NO:555-4567        Xtn:
Lst:ARBUTHNOT        1st:ARTHUR          NO:(515) 555-1234  Xtn:
Lst:BUDLONG          1st:MO              NO:(818) 555-4444  Xtn:
Lst:WRIGHT           1st:ORVILLE         NO:606-555-7777    Xtn:23
Lst:ZERILDA          1st:MARSHA          NO:555-4567        Xtn:
Lst:WAYNE            1st:BOB             NO:555-4332        Xtn:
Lst:ADALE            1st:ALAN            NO:415-555 6666    Xtn:4466
Lst:NOTTINGHAM       1st:SHERIFF         NO:415-555-6789    Xtn:
Lst:TUCK             1st:FRIAR           NO:213-5552345     Xtn:
Lst:SCARLET          1st:WILL            NO:202-5556789     Xtn:
Lst:PLUM             1st:PROFESSOR       NO:202-555-5678    Xtn:802
Lst:RED              1st:ERIC THE        NO:424-555-3456    Xtn:
Lst:SCOTT            1st:W.R.            NO:616-555-2345    Xtn:297
Lst:BACH             1st:J.S.            NO:555-6789        Xtn:
Lst:RUTH             1st:BABE            NO:555-9876        Xtn:12
Press ENTER to continue . .

Answers to Day 10, "Printing"

Quiz

Using NEXT-PAGE at the start of the report usually causes a blank page to be fed out of the printer before the first page of the report is printed. Some modern printers, particularly laser and inkjet/bubble-jet types, might not eject the initial blank page.

Exercises

1. All the changes are in COLUMN-HEADINGS and DETAIL-LINE, and involve increasing the FILLER between the headings and the detail fields by 1 (as shown in Listing A.15).

The printer spacing sheet for the modified report is shown in Figure A.1.

Figure A.1.
A printer spacing sheet for the modified report.

TYPE: Listing A.15. Two spaces between fields.

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. PHNPRT03.
000300*--------------------------------------------------
000400* This program prints the contents of the
000500* phone file.
000600*--------------------------------------------------
000700 ENVIRONMENT DIVISION.
000800 INPUT-OUTPUT SECTION.
000900 FILE-CONTROL.
001000     SELECT OPTIONAL PHONE-FILE
001100*or  SELECT PHONE-FILE
001200         ASSIGN TO "phone.dat"
001300*or      ASSIGN TO "phone"
001400         ORGANIZATION IS SEQUENTIAL.
001500
001600     SELECT PRINTER-FILE
001700         ASSIGN TO PRINTER
001800         ORGANIZATION IS LINE SEQUENTIAL.
001900
002000 DATA DIVISION.
002100 FILE SECTION.
002200 FD  PHONE-FILE
002300     LABEL RECORDS ARE STANDARD.
002400 01  PHONE-RECORD.
002500     05  PHONE-LAST-NAME      PIC X(20).
002600     05  PHONE-FIRST-NAME     PIC X(20).
002700     05  PHONE-NUMBER         PIC X(15).
002800     05  PHONE-EXTENSION      PIC X(5).
002900
003000 FD  PRINTER-FILE
003100     LABEL RECORDS ARE OMITTED.
003200 01  PRINTER-RECORD           PIC X(80).
003300
003400 WORKING-STORAGE SECTION.
003500
003600* Structure for printing a title line
003700 01  TITLE-LINE.
003800     05  FILLER               PIC X(21) VALUE SPACE.
003900     05  FILLER               PIC X(17) VALUE
004000     "PHONE BOOK REPORT".
004100     05  FILLER              PIC X(15) VALUE SPACE.
004200     05  FILLER              PIC X(5) VALUE "Page:".
004300     05  PRINT-PAGE-NUMBER   PIC ZZZZ9.
004400
004500* Structure for printing a column heading
004600 01  COLUMN-HEADINGS.
004700     05  FILLER               PIC X(9)  VALUE "Last Name".
004800     05  FILLER               PIC X(13) VALUE SPACE.
004900     05  FILLER               PIC X(10) VALUE "First Name".
005000     05  FILLER               PIC X(12) VALUE SPACE.
005100     05  FILLER               PIC X(6)  VALUE "Number".
005200     05  FILLER               PIC X(11) VALUE SPACE.
005300     05  FILLER               PIC X(4)  VALUE "Ext.".
005400
005500 01 DETAIL-LINE.
005600     05  PRINT-LAST-NAME      PIC X(20).
005700     05  FILLER               PIC X(2) VALUE SPACE.
005800     05  PRINT-FIRST-NAME     PIC X(20).
005900     05  FILLER               PIC X(2) VALUE SPACE.
006000     05  PRINT-NUMBER         PIC X(15).
006100     05  FILLER               PIC X(2) VALUE SPACE.
006200     05  PRINT-EXTENSION      PIC X(5).
006300
006400 01  END-OF-FILE            PIC X.
006500
006600 01  PRINT-LINES           PIC 99.
006700 01  PAGE-NUMBER           PIC 9(5).
006800
006900 PROCEDURE DIVISION.
007000 MAIN-LOGIC SECTION.
007100 PROGRAM-BEGIN.
007200
007300     PERFORM OPENING-PROCEDURE.
007400     MOVE ZEROES TO PRINT-LINES
007500                    PAGE-NUMBER.
007600     PERFORM START-NEW-PAGE.
007700     MOVE "N" TO END-OF-FILE.
007800     PERFORM READ-NEXT-RECORD.
007900     IF END-OF-FILE = "Y"
008000         MOVE "No records found" TO PRINTER-RECORD
008100         WRITE PRINTER-RECORD BEFORE ADVANCING 1.
008200     PERFORM PRINT-RECORDS
008300         UNTIL END-OF-FILE = "Y".
008400     PERFORM CLOSING-PROCEDURE.
008500
008600 PROGRAM-DONE.
008700     STOP RUN.
008800
008900 OPENING-PROCEDURE.
009000     OPEN INPUT PHONE-FILE.
009100     OPEN OUTPUT PRINTER-FILE.
009200
009300 CLOSING-PROCEDURE.
009400     CLOSE PHONE-FILE.
009500     PERFORM END-LAST-PAGE.
009600     CLOSE PRINTER-FILE.
009700
009800 PRINT-RECORDS.
009900     PERFORM PRINT-FIELDS.
010000     PERFORM READ-NEXT-RECORD.
010100
010200 PRINT-FIELDS.
010300     IF PRINT-LINES NOT < 55
010400         PERFORM NEXT-PAGE.
010500     MOVE PHONE-LAST-NAME TO PRINT-LAST-NAME.
010600     MOVE PHONE-FIRST-NAME TO PRINT-FIRST-NAME.
010700     MOVE PHONE-NUMBER TO PRINT-NUMBER.
010800     MOVE PHONE-EXTENSION TO PRINT-EXTENSION.
010900     MOVE DETAIL-LINE TO PRINTER-RECORD.
011000     WRITE PRINTER-RECORD BEFORE ADVANCING 1.
011100
011200     ADD 1 TO PRINT-LINES.
011300
011400 READ-NEXT-RECORD.
011500     READ PHONE-FILE NEXT RECORD
011600        AT END
011700        MOVE "Y" TO END-OF-FILE.
011800
011900 NEXT-PAGE.
012000     PERFORM END-LAST-PAGE.
012100     PERFORM START-NEW-PAGE.
012200
012300 START-NEW-PAGE.
012400     ADD 1 TO PAGE-NUMBER.
012500     MOVE PAGE-NUMBER TO PRINT-PAGE-NUMBER.
012600     MOVE TITLE-LINE TO PRINTER-RECORD.
012700     WRITE PRINTER-RECORD BEFORE ADVANCING 2.
012800     MOVE COLUMN-HEADINGS TO PRINTER-RECORD.
012900     WRITE PRINTER-RECORD BEFORE ADVANCING 2.
013000     MOVE 4 TO PRINT-LINES.
013100
013200 END-LAST-PAGE.
013300     MOVE SPACE TO PRINTER-RECORD.
013400     WRITE PRINTER-RECORD BEFORE ADVANCING PAGE.
013500     MOVE ZEROES TO PRINT-LINES.
013600

2. Figure A.2 is one example of a possible layout for the customer report.

Figure A.2.
A possible customer report layout.

Answers to Day 11, "Indexed File I/O"

Quiz

1. CONTACT-BIRTH-DATE will not be unique. Even with as few as 200 records, the chance of a duplicate birth date is very high. Once you start putting hundreds of records in a file, birth dates won't stay unique.

2. The CONTACT-PHONE-NUMBER has a better chance of being unique, but there is still a possibility of having two contacts at the same phone number. The best solution is to create an additional numeric field in the record called CONTACT-NUMBER. Each contact added to the file is assigned a new number.

Exercises

1. Listings A.16 and A.17 present a better way of defining the record, and CONTACT-NUMBER will be assigned during data entry to ensure that it is unique.

TYPE: Listing A.16. The `FD` for a contact file.

000900 FD  CONTACT-FILE
001000     LABEL RECORDS ARE STANDARD.
001100 01  CONTACT-RECORD.
001200     05  CONTACT-NUMBER          PIC 9(5).
001300     05  CONTACT-BIRTH-DATE      PIC 9(6).
001400     05  CONTACT-NAME            PIC X(20).
001500     05  CONTACT-ADDRESS-1       PIC X(20).
001600     05  CONTACT-ADDRESS-2       PIC X(20).
001700     05  CONTACT-ZIP             PIC 9(5).
001800     05  CONTACT-PHONE.
001900         10  CONTACT-AREA-CODE   PIC 9(3).
002000         10  CONTACT-PREFIX      PIC 9(3).
002200         10  CONTACT-PHONE-NO    PIC 9(4).

TYPE: Listing A.17. The `SELECT` statement for a contact file.

000300     SELECT CONTACT-FILE
000400         ASSIGN TO "contact"
000500         ORGANIZATION IS INDEXED
000600         RECORD KEY IS CONTACT-NUMBER
000700         ACCESS MODE IS DYNAMIC.

2. DISPLAY-NAME is 30 bytes long with an implied picture of X and is therefore a PIC X(30). Everywhere it is used in the program, it is unaffected by the fact that subordinate variables are within DISPLAY-NAME. DISPLAY-CITY and DISPLAY-STATE are now within DISPLAY-NAME, and consequently within DETAIL-LINE, so the move that used to exist at line 014400 is no longer needed.

3. Listings A.18 and A.19 compare PHNPRT02 and VNDDSP01. I have inserted comments without line numbers so that they will stand out in the listings. The comments provide the comparisons between the two programs.

TYPE: Listing A.18. `PHNPRT02` compared to `VNDDSP01`.

      * PHNPRT02 prints records to paper
000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. PHNPRT02.
000300*------------------------------------------
000400* This program prints the contents of the
000500* phone file.
000600*------------------------------------------
000700 ENVIRONMENT DIVISION.
000800 INPUT-OUTPUT SECTION.
000900 FILE-CONTROL.
001000     SELECT OPTIONAL PHONE-FILE
001100*or  SELECT PHONE-FILE
001200         ASSIGN TO "phone.dat"
001300*or      ASSIGN TO "phone"
001400         ORGANIZATION IS SEQUENTIAL.
001500
001600     SELECT PRINTER-FILE
001700         ASSIGN TO PRINTER
001800         ORGANIZATION IS LINE SEQUENTIAL.
001900
002000 DATA DIVISION.
002100 FILE SECTION.
002200 FD  PHONE-FILE
002300     LABEL RECORDS ARE STANDARD.
002400 01  PHONE-RECORD.
002500     05  PHONE-LAST-NAME      PIC X(20).
002600     05  PHONE-FIRST-NAME     PIC X(20).
002700     05  PHONE-NUMBER         PIC X(15).
002800     05  PHONE-EXTENSION      PIC X(5).
002900
003000 FD  PRINTER-FILE
003100     LABEL RECORDS ARE OMITTED.
003200 01  PRINTER-RECORD           PIC X(80).
003300
003400 WORKING-STORAGE SECTION.
003500
003600* Structure for printing a title line
003700 01  TITLE-LINE.
003800     05  FILLER               PIC X(21) VALUE SPACE.
003900     05  FILLER               PIC X(17) VALUE
004000     "PHONE BOOK REPORT".
004100     05  FILLER              PIC X(15) VALUE SPACE.
004200     05  FILLER              PIC X(5) VALUE "Page:".
004300     05  PRINT-PAGE-NUMBER   PIC ZZZZ9.
004400
004500* Structure for printing a column heading
004600 01  COLUMN-HEADINGS.
004700     05  FILLER               PIC X(9)  VALUE "Last Name".
004800     05  FILLER               PIC X(12) VALUE SPACE.
004900     05  FILLER               PIC X(10) VALUE "First Name".
005000     05  FILLER               PIC X(11) VALUE SPACE.
005100     05  FILLER               PIC X(6)  VALUE "Number".
005200     05  FILLER               PIC X(10) VALUE SPACE.
005300     05  FILLER               PIC X(4)  VALUE "Ext.".
005400
005500 01 DETAIL-LINE.
005600     05  PRINT-LAST-NAME      PIC X(20).
005700     05  FILLER               PIC X(1) VALUE SPACE.
005800     05  PRINT-FIRST-NAME     PIC X(20).
005900     05  FILLER               PIC X(1) VALUE SPACE.
006000     05  PRINT-NUMBER         PIC X(15).
006100     05  FILLER               PIC X(1) VALUE SPACE.
006200     05  PRINT-EXTENSION      PIC X(5).
006300
006400 01  END-OF-FILE            PIC X.
006500
006600 01  PRINT-LINES           PIC 99.
006700 01  PAGE-NUMBER           PIC 9(5).
006800
006900 PROCEDURE DIVISION.
007000 MAIN-LOGIC SECTION.

      * The main logic at lines 007100 through 007800 is almost
      * identical to the same logic at lines 007600 through
      * 008500 of VNDDSP01.
007100 PROGRAM-BEGIN.
007200
007300     PERFORM OPENING-PROCEDURE.
007400     MOVE ZEROES TO PRINT-LINES
007500                    PAGE-NUMBER.
007600     PERFORM START-NEW-PAGE.
007700     MOVE "N" TO END-OF-FILE.
007800     PERFORM READ-NEXT-RECORD.

      * The logic at lines 007900 through 008300 prints a message
      * if no records are found in the file. This is similar to
      * lines 008600 through 009100 in VNDDSP01 which display a
      * message if no records are found.
007900     IF END-OF-FILE = "Y"
008000         MOVE "No records found" TO PRINTER-RECORD
008100         WRITE PRINTER-RECORD BEFORE ADVANCING 1.
008200     PERFORM PRINT-RECORDS
008300         UNTIL END-OF-FILE = "Y".
008400     PERFORM CLOSING-PROCEDURE.
008500
008600 PROGRAM-DONE.
008700     STOP RUN.
008800
008900 OPENING-PROCEDURE.
009000     OPEN INPUT PHONE-FILE.
009100     OPEN OUTPUT PRINTER-FILE.
009200
009300 CLOSING-PROCEDURE.
009400     CLOSE PHONE-FILE.
009500     PERFORM END-LAST-PAGE.
009600     CLOSE PRINTER-FILE.
009700

      * Lines 009800 through 011200 start a new page when needed,
      * print records one at a time and read the next record.
      * VNDDSP01 does the same functions at lines 010500 through
      * 015200. The big difference in VNDDSP01 is that vendor
      * information is displayed on multiple lines.
009800 PRINT-RECORDS.
009900     PERFORM PRINT-FIELDS.
010000     PERFORM READ-NEXT-RECORD.
010100
010200 PRINT-FIELDS.
010300     IF PRINT-LINES NOT < 55
010400         PERFORM NEXT-PAGE.
010500     MOVE PHONE-LAST-NAME TO PRINT-LAST-NAME.
010600     MOVE PHONE-FIRST-NAME TO PRINT-FIRST-NAME.
010700     MOVE PHONE-NUMBER TO PRINT-NUMBER.
010800     MOVE PHONE-EXTENSION TO PRINT-EXTENSION.
010900     MOVE DETAIL-LINE TO PRINTER-RECORD.
011000     WRITE PRINTER-RECORD BEFORE ADVANCING 1.
011100
011200     ADD 1 TO PRINT-LINES.
011300
011400 READ-NEXT-RECORD.
011500     READ PHONE-FILE NEXT RECORD
011600        AT END
011700        MOVE "Y" TO END-OF-FILE.
011800

      * The logic at lines 011900 through 013500 controls what to
      * do when a new page is needed and special processing to
      * handle the last page. VNDDSP01 does the same sort of
      * processing but for the display at lines 016100
      * through 018200.
011900 NEXT-PAGE.
012000     PERFORM END-LAST-PAGE.
012100     PERFORM START-NEW-PAGE.
012200
012300 START-NEW-PAGE.
012400     ADD 1 TO PAGE-NUMBER.
012500     MOVE PAGE-NUMBER TO PRINT-PAGE-NUMBER.
012600     MOVE TITLE-LINE TO PRINTER-RECORD.
012700     WRITE PRINTER-RECORD BEFORE ADVANCING 2.
012800     MOVE COLUMN-HEADINGS TO PRINTER-RECORD.
012900     WRITE PRINTER-RECORD BEFORE ADVANCING 2.
013000     MOVE 4 TO PRINT-LINES.
013100
013200 END-LAST-PAGE.
013300     MOVE SPACE TO PRINTER-RECORD.
013400     WRITE PRINTER-RECORD BEFORE ADVANCING PAGE.
013500     MOVE ZEROES TO PRINT-LINES.
013600

TYPE: Listing A.19. `VNDDSP01` compared to `PHNPRT02`.

      * VNDDSP01 displays records on a screen.
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.

      * The main logic at lines 007600 through 008500 is almost
      * identical to the same logic at lines 007100 through
      * 007800 of PHNPRT02.
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.

12345678901234567890123456789012345678901234567890123456789012345
      * The logic at lines 008600 through 009100 displays a message
      * if no records are found in the file. This is similar to
      * lines 007900 through 008300 in PHNPRT02 which prints a
      * message if no records are found.
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

      * Lines 010500 through 015200 start a new screen's worth
      * of display information when needed,
      * display records one at a time and read the next record.
      * PHNPRT02 does the same functions at lines 009800 through
      * 011200. The big difference in PHNPRT02 is that phone
      * information is printed on a sinlge line.
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

      * The logic at lines 016100 through 018200 controls what to
      * do when a new screen is needed and special processing to
      * handle the last screen. PHNPRT02 does the same sort of
      * processing but for printed pages at lines 011900
      * through 013500.
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

Answers to Day 12, "More on Indexed Files"

Quiz

The example reproduced in Listing A.20 has a bug at line 003800. The logic is set up so that if a record is not found, an attempt is made to change the record; and, if the record is found, an attempt is made to add the record. This is the reverse of what was intended. Line 003800 should read as follows:

003800     IF RECORD-FOUND-FLAG = "Y"

TYPE: Listing A.20. Reading a record in a file.

003200 ADD-OR-UPDATE.
003300     MOVE "Y" TO RECORD-FOUND-FLAG.
003400     MOVE NEW-NUMBER TO VENDOR-NUMBER.
003500     READ VENDOR-RECORD
003600         INVALID KEY
003700         MOVE "N" TO RECORD-FOUND-FLAG.
003800     IF RECORD-FOUND-FLAG = "N"
003900         PERFORM CHANGE-THIS-RECORD
004000     ELSE
004100         PERFORM ADD-THIS-RECORD.
004200
004300 CHANGE-THIS-RECORD.
004400     PERFORM LOAD-RECORD-VALUES.
004500     REWRITE VENDOR-RECORD
004600         INVALID KEY
004700         DISPLAY "ERROR CHANGING THE RECORD".
004800
004900 ADD-THIS-RECORD.
005000     PERFORM LOAD-RECORD-VALUES.
005100     WRITE VENDOR-RECORD
005200        INVALID KEY
005300        DISPLAY "ERROR ADDING THE RECORD".
005400
005500 LOAD-RECORD-VALUES.
005600     MOVE NEW-NAME TO VENDOR-NAME.
005700     MOVE NEW-ADDRESS-1 TO VENDOR-ADDRESS-1.
005800     MOVE NEW-ADDRESS-2 TO VENDOR-ADDRESS-2.
005900     MOVE NEW-CITY TO VENDOR-CITY.
006000     MOVE NEW-STATE TO VENDOR-STATE.
006100     MOVE NEW-ZIP TO VENDOR-ZIP.
006200     MOVE NEW-CONTACT TO VENDOR-CONTACT.
006300     MOVE NEW-PHONE TO VENDOR-PHONE.
006400

Exercises

1. The IF test is wrong, causing the program to attempt to change a record when it doesn't exist and add a record when it does exist.

2. The correction is shown in Listing A.21.

TYPE: Listing A.21. Correcting the bug.

003200 ADD-OR-UPDATE.
003300     MOVE "Y" TO RECORD-FOUND-FLAG.
003400     MOVE NEW-NUMBER TO VENDOR-NUMBER.
003500     READ VENDOR-RECORD
003600         INVALID KEY
003700         MOVE "N" TO RECORD-FOUND-FLAG.
003800     IF RECORD-FOUND-FLAG = "Y"
003900         PERFORM CHANGE-THIS-RECORD
004000     ELSE
004100         PERFORM ADD-THIS-RECORD.
004200
004300 CHANGE-THIS-RECORD.
004400     PERFORM LOAD-RECORD-VALUES.
004500     REWRITE VENDOR-RECORD
004600         INVALID KEY
004700         DISPLAY "ERROR CHANGING THE RECORD".
004800
004900 ADD-THIS-RECORD.
005000     PERFORM LOAD-RECORD-VALUES.
005100     WRITE VENDOR-RECORD
005200        INVALID KEY
005300        DISPLAY "ERROR ADDING THE RECORD".
005400
005500 LOAD-RECORD-VALUES.
005600     MOVE NEW-NAME TO VENDOR-NAME.
005700     MOVE NEW-ADDRESS-1 TO VENDOR-ADDRESS-1.
005800     MOVE NEW-ADDRESS-2 TO VENDOR-ADDRESS-2.
005900     MOVE NEW-CITY TO VENDOR-CITY.
006000     MOVE NEW-STATE TO VENDOR-STATE.
006100     MOVE NEW-ZIP TO VENDOR-ZIP.
006200     MOVE NEW-CONTACT TO VENDOR-CONTACT.
006300     MOVE NEW-PHONE TO VENDOR-PHONE.
006400

Answers to Day 13, "Deleting Records and Other Indexed File Operations"

Quiz

1. c. Change, inquire, and delete modes frequently are similar.

2. Change, inquire, and delete modes all require the user to enter a key value of a record that is looked up in the file. This record must be found before the remainder of the change, inquire, or delete action is undertaken.

Exercise

Listing A.22 uses COPY directives.

TYPE: Listing A.22. Using `COPY` directives.

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. VNDDSP02.
000300*------------------------------------------------
000400* Display records in the Vendor File.
000500*------------------------------------------------
000600 ENVIRONMENT DIVISION.
000700 INPUT-OUTPUT SECTION.
000800 FILE-CONTROL.
000900
001000     COPY "SLVND01.CBL".
001100
001200 DATA DIVISION.
001300 FILE SECTION.
001400
001500     COPY "FDVND02.CBL".
001600
001700 WORKING-STORAGE SECTION.
001800
001900 01  DETAIL-LINE.
002000     05  DISPLAY-NUMBER      PIC 9(5).
002100     05  FILLER              PIC X     VALUE SPACE.
002200     05  DISPLAY-NAME        PIC X(30).
002300     05  FILLER              PIC X     VALUE SPACE.
002400     05  DISPLAY-CONTACT     PIC X(30).
002500
002600 01  CITY-STATE-DETAIL.
002700     05  DISPLAY-CITY        PIC X(20).
002800     05  FILLER              PIC X VALUE SPACE.
002900     05  DISPLAY-STATE       PIC X(2).
003000
003100 01  COLUMN-LINE.
003200     05  FILLER         PIC X(2)  VALUE "NO".
003300     05  FILLER         PIC X(4) VALUE SPACE.
003400     05  FILLER         PIC X(12) VALUE "NAME-ADDRESS".
003500     05  FILLER         PIC X(19) VALUE SPACE.
003600     05  FILLER         PIC X(17) VALUE "CONTACT-PHONE-ZIP".
003700
003800 01  TITLE-LINE.
003900     05  FILLER              PIC X(15) VALUE SPACE.
004000     05  FILLER              PIC X(11)
004100         VALUE "VENDOR LIST".
004200     05  FILLER              PIC X(15) VALUE SPACE.
004300     05  FILLER              PIC X(5) VALUE "PAGE:".
004400     05  FILLER              PIC X(1) VALUE SPACE.
004500     05  DISPLAY-PAGE-NUMBER PIC ZZZZ9.
004600
004700 77  FILE-AT-END             PIC X.
004800 77  A-DUMMY                 PIC X.
004900 77  LINE-COUNT              PIC 999 VALUE ZERO.
005000 77  PAGE-NUMBER             PIC 99999 VALUE ZERO.
005100 77  MAXIMUM-LINES           PIC 999 VALUE 15.
005200
005300 77  DISPLAY-RECORD          PIC X(79).
005400
005500 PROCEDURE DIVISION.
005600 PROGRAM-BEGIN.
005700
005800     PERFORM OPENING-PROCEDURE.
005900     MOVE ZEROES TO LINE-COUNT
006000                    PAGE-NUMBER.
006100
006200     PERFORM START-NEW-PAGE.
006300
006400     MOVE "N" TO FILE-AT-END.
006500     PERFORM READ-NEXT-RECORD.
006600     IF FILE-AT-END = "Y"
006700         MOVE "NO RECORDS FOUND" TO DISPLAY-RECORD
006800         PERFORM WRITE-DISPLAY-RECORD
006900     ELSE
007000         PERFORM DISPLAY-VENDOR-FIELDS
007100             UNTIL FILE-AT-END = "Y".
007200
007300     PERFORM CLOSING-PROCEDURE.
007400
007500
007600 PROGRAM-DONE.
007700     STOP RUN.
007800
007900 OPENING-PROCEDURE.
008000     OPEN I-O VENDOR-FILE.
008100
008200 CLOSING-PROCEDURE.
008300     CLOSE VENDOR-FILE.
008400
008500 DISPLAY-VENDOR-FIELDS.
008600     IF LINE-COUNT > MAXIMUM-LINES
008700         PERFORM START-NEXT-PAGE.
008800     PERFORM DISPLAY-THE-RECORD.
008900     PERFORM READ-NEXT-RECORD.
009000
009100 DISPLAY-THE-RECORD.
009200     PERFORM DISPLAY-LINE-1.
009300     PERFORM DISPLAY-LINE-2.
009400     PERFORM DISPLAY-LINE-3.
009500     PERFORM DISPLAY-LINE-4.
009600     PERFORM LINE-FEED.
009700
009800 DISPLAY-LINE-1.
009900     MOVE SPACE TO DETAIL-LINE.
010000     MOVE VENDOR-NUMBER TO DISPLAY-NUMBER.
010100     MOVE VENDOR-NAME TO DISPLAY-NAME.
010200     MOVE VENDOR-CONTACT TO DISPLAY-CONTACT.
010300     MOVE DETAIL-LINE TO DISPLAY-RECORD.
010400     PERFORM WRITE-DISPLAY-RECORD.
010500
010600 DISPLAY-LINE-2.
010700     MOVE SPACE TO DETAIL-LINE.
010800     MOVE VENDOR-ADDRESS-1 TO DISPLAY-NAME.
010900     MOVE VENDOR-PHONE TO DISPLAY-CONTACT.
011000     MOVE DETAIL-LINE TO DISPLAY-RECORD.
011100     PERFORM WRITE-DISPLAY-RECORD.
011200
011300 DISPLAY-LINE-3.
011400     MOVE SPACE TO DETAIL-LINE.
011500     MOVE VENDOR-ADDRESS-2 TO DISPLAY-NAME.
011600     IF VENDOR-ADDRESS-2 NOT = SPACE
011700         MOVE DETAIL-LINE TO DISPLAY-RECORD
011800         PERFORM WRITE-DISPLAY-RECORD.
011900
012000 DISPLAY-LINE-4.
012100     MOVE SPACE TO DETAIL-LINE.
012200     MOVE VENDOR-CITY TO DISPLAY-CITY.
012300     MOVE VENDOR-STATE TO DISPLAY-STATE.
012400     MOVE CITY-STATE-DETAIL TO DISPLAY-NAME.
012500     MOVE VENDOR-ZIP TO DISPLAY-CONTACT.
012600     MOVE DETAIL-LINE TO DISPLAY-RECORD.
012700     PERFORM WRITE-DISPLAY-RECORD.
012800
012900 READ-NEXT-RECORD.
013000     READ VENDOR-FILE NEXT RECORD
013100         AT END MOVE "Y" TO FILE-AT-END.
013200
013300 WRITE-DISPLAY-RECORD.
013400     DISPLAY DISPLAY-RECORD.
013500     ADD 1 TO LINE-COUNT.
013600
013700 LINE-FEED.
013800     MOVE SPACE TO DISPLAY-RECORD.
013900     PERFORM WRITE-DISPLAY-RECORD.
014000
014100 START-NEXT-PAGE.
014200
014300     PERFORM END-LAST-PAGE.
014400     PERFORM START-NEW-PAGE.
014500
014600 START-NEW-PAGE.
014700     ADD 1 TO PAGE-NUMBER.
014800     MOVE PAGE-NUMBER TO DISPLAY-PAGE-NUMBER.
014900     MOVE TITLE-LINE TO DISPLAY-RECORD.
015000     PERFORM WRITE-DISPLAY-RECORD.
015100     PERFORM LINE-FEED.
015200     MOVE COLUMN-LINE TO DISPLAY-RECORD.
015300     PERFORM WRITE-DISPLAY-RECORD.
015400     PERFORM LINE-FEED.
015500
015600 END-LAST-PAGE.
015700     PERFORM PRESS-ENTER.
015800     MOVE ZERO TO LINE-COUNT.
015900
016000 PRESS-ENTER.
016100     DISPLAY "PRESS ENTER TO CONTINUE. . .".
016200     ACCEPT A-DUMMY.
016300

Answers to Day 14, "A Review of Indexed Files"

Quiz

1. Remember: Write or rewrite a record; do everything else to a file. The correct command for reading a record in the file is b:

READ CUSTOMER-FILE RECORD
    INVALID KEY MOVE "N" TO RECORD-FOUND.

2. Remember: Write or rewrite a record; do everything else to a file. The correct command for writing a new record to the file is a:

WRITE CUSTOMER-RECORD
    INVALID KEY
     DISPLAY "RECORD ALREADY ON FILE".

Exercises

1. Listings A.23, A.24, A.25, and A.26 are each highlighted in bold type for add, change, inquire, and delete mode, respectively.

TYPE: Listing A.23. Add mode.

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

TYPE: Listing A.24. Change mode.

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. VNDMNT01.
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 DATA DIVISION.
001400 FILE SECTION.
001500
001600     COPY "FDVND02.CBL".
001700
001800 WORKING-STORAGE SECTION.
001900
002000 77  MENU-PICK                    PIC 9.
002100     88  MENU-PICK-IS-VALID       VALUES 0 THRU 4.
002200
002300 77  THE-MODE                     PIC X(7).
002400 77  WHICH-FIELD                  PIC 9.
002500 77  OK-TO-DELETE                 PIC X.
002600 77  RECORD-FOUND                 PIC X.
002700 77  VENDOR-NUMBER-FIELD          PIC Z(5).
002800
002900 PROCEDURE DIVISION.
003000 PROGRAM-BEGIN.
003100     PERFORM OPENING-PROCEDURE.
003200     PERFORM MAIN-PROCESS.
003300     PERFORM CLOSING-PROCEDURE.
003400
003500 PROGRAM-DONE.
003600     STOP RUN.
003700
003800 OPENING-PROCEDURE.
003900     OPEN I-O VENDOR-FILE.
004000
004100 CLOSING-PROCEDURE.
004200     CLOSE VENDOR-FILE.
004300
004400
004500 MAIN-PROCESS.
004600     PERFORM GET-MENU-PICK.
004700     PERFORM MAINTAIN-THE-FILE
004800         UNTIL MENU-PICK = 0.
004900
005000*--------------------------------
005100* MENU
005200*--------------------------------
005300 GET-MENU-PICK.
005400     PERFORM DISPLAY-THE-MENU.
005500     PERFORM GET-THE-PICK.
005600     PERFORM MENU-RETRY
005700         UNTIL MENU-PICK-IS-VALID.
005800
005900 DISPLAY-THE-MENU.
006000     PERFORM CLEAR-SCREEN.
006100     DISPLAY "    PLEASE SELECT:".
006200     DISPLAY " ".
006300     DISPLAY "          1.  ADD RECORDS".
006400     DISPLAY "          2.  CHANGE A RECORD".
006500     DISPLAY "          3.  LOOK UP A RECORD".
006600     DISPLAY "          4.  DELETE A RECORD".
006700     DISPLAY " ".
006800     DISPLAY "          0.  EXIT".
006900     PERFORM SCROLL-LINE 8 TIMES.
007000
007100 GET-THE-PICK.
007200     DISPLAY "YOUR CHOICE (0-4)?".
007300     ACCEPT MENU-PICK.
007400 MENU-RETRY.
007500     DISPLAY "INVALID SELECTION - PLEASE RE-TRY.".
007600     PERFORM GET-THE-PICK.
007700 CLEAR-SCREEN.
007800     PERFORM SCROLL-LINE 25 TIMES.
007900
008000 SCROLL-LINE.
008100     DISPLAY " ".
008200
008300 MAINTAIN-THE-FILE.
008400     PERFORM DO-THE-PICK.
008500     PERFORM GET-MENU-PICK.
008600
008700 DO-THE-PICK.
008800     IF MENU-PICK = 1
008900         PERFORM ADD-MODE
009000     ELSE
009100     IF MENU-PICK = 2
009200         PERFORM CHANGE-MODE
009300     ELSE
009400     IF MENU-PICK = 3
009500         PERFORM INQUIRE-MODE
009600     ELSE
009700     IF MENU-PICK = 4
009800         PERFORM DELETE-MODE.
009900
010000*--------------------------------
010100* ADD
010200*--------------------------------
010300 ADD-MODE.
010400     MOVE "ADD" TO THE-MODE.
010500     PERFORM GET-NEW-VENDOR-NUMBER.
010600     PERFORM ADD-RECORDS
010700        UNTIL VENDOR-NUMBER = ZEROES.
010800
010900 GET-NEW-VENDOR-NUMBER.
011000     PERFORM INIT-VENDOR-RECORD.
011100     PERFORM ENTER-VENDOR-NUMBER.
011200     MOVE "Y" TO RECORD-FOUND.
011300     PERFORM FIND-NEW-VENDOR-RECORD
011400         UNTIL RECORD-FOUND = "N" OR
011500               VENDOR-NUMBER = ZEROES.
011600
011700 FIND-NEW-VENDOR-RECORD.
011800     PERFORM READ-VENDOR-RECORD.
011900     IF RECORD-FOUND = "Y"
012000         DISPLAY "RECORD ALREADY ON FILE"
012100         PERFORM ENTER-VENDOR-NUMBER.
012200
012300 ADD-RECORDS.
012400     PERFORM ENTER-REMAINING-FIELDS.
012500     PERFORM WRITE-VENDOR-RECORD.
012600     PERFORM GET-NEW-VENDOR-NUMBER.
012700
012800 ENTER-REMAINING-FIELDS.
012900     PERFORM ENTER-VENDOR-NAME.
013000     PERFORM ENTER-VENDOR-ADDRESS-1.
013100     PERFORM ENTER-VENDOR-ADDRESS-2.
013200     PERFORM ENTER-VENDOR-CITY.
013300     PERFORM ENTER-VENDOR-STATE.
013400     PERFORM ENTER-VENDOR-ZIP.
013500     PERFORM ENTER-VENDOR-CONTACT.
013600     PERFORM ENTER-VENDOR-PHONE.
013700
013800*--------------------------------
013900* CHANGE
014000*--------------------------------
014100 CHANGE-MODE.
014200     MOVE "CHANGE" TO THE-MODE.
014300     PERFORM GET-VENDOR-RECORD.
014400     PERFORM CHANGE-RECORDS
014500        UNTIL VENDOR-NUMBER = ZEROES.
014600
014700 CHANGE-RECORDS.
014800     PERFORM GET-FIELD-TO-CHANGE.
014900     PERFORM CHANGE-ONE-FIELD
015000         UNTIL WHICH-FIELD = ZERO.
015100     PERFORM GET-VENDOR-RECORD.
015200
015300 GET-FIELD-TO-CHANGE.
015400     PERFORM DISPLAY-ALL-FIELDS.
015500     PERFORM ASK-WHICH-FIELD.
015600
015700 ASK-WHICH-FIELD.
015800     DISPLAY "ENTER THE NUMBER OF THE FIELD".
015900     DISPLAY "TO CHANGE (1-8) OR 0 TO EXIT".
016000     ACCEPT WHICH-FIELD.
016100     IF WHICH-FIELD > 8
016200         DISPLAY "INVALID ENTRY".
016300
016400 CHANGE-ONE-FIELD.
016500     PERFORM CHANGE-THIS-FIELD.
016600     PERFORM GET-FIELD-TO-CHANGE.
016700
016800 CHANGE-THIS-FIELD.
016900     IF WHICH-FIELD = 1
017000         PERFORM ENTER-VENDOR-NAME.
017100     IF WHICH-FIELD = 2
017200         PERFORM ENTER-VENDOR-ADDRESS-1.
017300     IF WHICH-FIELD = 3
017400         PERFORM ENTER-VENDOR-ADDRESS-2.
017500     IF WHICH-FIELD = 4
017600         PERFORM ENTER-VENDOR-CITY.
017700     IF WHICH-FIELD = 5
017800         PERFORM ENTER-VENDOR-STATE.
017900     IF WHICH-FIELD = 6
018000         PERFORM ENTER-VENDOR-ZIP.
018100     IF WHICH-FIELD = 7
018200         PERFORM ENTER-VENDOR-CONTACT.
018300     IF WHICH-FIELD = 8
018400         PERFORM ENTER-VENDOR-PHONE.
018500
018600     PERFORM REWRITE-VENDOR-RECORD.
018700
018800*--------------------------------
018900* INQUIRE
019000*--------------------------------
019100 INQUIRE-MODE.
019200     MOVE "DISPLAY" TO THE-MODE.
019300     PERFORM GET-VENDOR-RECORD.
019400     PERFORM INQUIRE-RECORDS
019500        UNTIL VENDOR-NUMBER = ZEROES.
019600
019700 INQUIRE-RECORDS.
019800     PERFORM DISPLAY-ALL-FIELDS.
019900     PERFORM GET-VENDOR-RECORD.
020000
020100*--------------------------------
020200* DELETE
020300*--------------------------------
020400 DELETE-MODE.
020500     MOVE "DELETE" TO THE-MODE.
020600     PERFORM GET-VENDOR-RECORD.
020700     PERFORM DELETE-RECORDS
020800        UNTIL VENDOR-NUMBER = ZEROES.
020900
021000 DELETE-RECORDS.
021100     PERFORM DISPLAY-ALL-FIELDS.
021200     MOVE "X" TO OK-TO-DELETE.
021300
021400     PERFORM ASK-TO-DELETE
021500        UNTIL OK-TO-DELETE = "Y" OR "N".
021600
021700     IF OK-TO-DELETE = "Y"
021800         PERFORM DELETE-VENDOR-RECORD.
021900
022000     PERFORM GET-VENDOR-RECORD.
022100
022200 ASK-TO-DELETE.
022300     DISPLAY "DELETE THIS RECORD (Y/N)?".
022400     ACCEPT OK-TO-DELETE.
022500     IF OK-TO-DELETE = "y"
022600         MOVE "Y" TO OK-TO-DELETE.
022700     IF OK-TO-DELETE = "n"
022800         MOVE "N" TO OK-TO-DELETE.
022900     IF OK-TO-DELETE NOT = "Y" AND
023000        OK-TO-DELETE NOT = "N"
023100         DISPLAY "YOU MUST ENTER YES OR NO".
023200
023300*--------------------------------
023400* Routines shared by all modes
023500*--------------------------------
023600 INIT-VENDOR-RECORD.
023700     MOVE SPACE TO VENDOR-RECORD.
023800     MOVE ZEROES TO VENDOR-NUMBER.
023900
024000 ENTER-VENDOR-NUMBER.
024100     DISPLAY " ".
024200     DISPLAY "ENTER VENDOR NUMBER OF THE VENDOR" .
024300     DISPLAY "TO " THE-MODE " (1-99999)".
024400     DISPLAY "ENTER 0 TO STOP ENTRY".
024500     ACCEPT VENDOR-NUMBER-FIELD.
024600*OR  ACCEPT VENDOR-NUMBER-FIELD WITH CONVERSION.
024700
024800     MOVE VENDOR-NUMBER-FIELD TO VENDOR-NUMBER.
024900
025000 GET-VENDOR-RECORD.
025100     PERFORM INIT-VENDOR-RECORD.
025200     PERFORM ENTER-VENDOR-NUMBER.
025300     MOVE "N" TO RECORD-FOUND.
025400     PERFORM FIND-VENDOR-RECORD
025500         UNTIL RECORD-FOUND = "Y" OR
025600               VENDOR-NUMBER = ZEROES.
025700
025800*--------------------------------
025900* Routines shared by Add and Change
026000*--------------------------------
026100 FIND-VENDOR-RECORD.
026200     PERFORM READ-VENDOR-RECORD.
026300     IF RECORD-FOUND = "N"
026400         DISPLAY "RECORD NOT FOUND"
026500         PERFORM ENTER-VENDOR-NUMBER.
026600
026700 ENTER-VENDOR-NAME.
026800     DISPLAY "ENTER VENDOR NAME".
026900     ACCEPT VENDOR-NAME.
027000
027100 ENTER-VENDOR-ADDRESS-1.
027200     DISPLAY "ENTER VENDOR ADDRESS-1".
027300     ACCEPT VENDOR-ADDRESS-1.
027400
027500 ENTER-VENDOR-ADDRESS-2.
027600     DISPLAY "ENTER VENDOR ADDRESS-2".
027700     ACCEPT VENDOR-ADDRESS-2.
027800
027900 ENTER-VENDOR-CITY.
028000     DISPLAY "ENTER VENDOR CITY".
028100     ACCEPT VENDOR-CITY.
028200
028300 ENTER-VENDOR-STATE.
028400     DISPLAY "ENTER VENDOR STATE".
028500     ACCEPT VENDOR-STATE.
028600
028700 ENTER-VENDOR-ZIP.
028800     DISPLAY "ENTER VENDOR ZIP".
028900     ACCEPT VENDOR-ZIP.
029000
029100 ENTER-VENDOR-CONTACT.
029200     DISPLAY "ENTER VENDOR CONTACT".
029300     ACCEPT VENDOR-CONTACT.
029400
029500 ENTER-VENDOR-PHONE.
029600     DISPLAY "ENTER VENDOR PHONE".
029700     ACCEPT VENDOR-PHONE.
029800
029900*--------------------------------
030000* Routines shared by Change,
030100* Inquire and Delete
030200*--------------------------------
030300 DISPLAY-ALL-FIELDS.
030400     DISPLAY " ".
030500     PERFORM DISPLAY-VENDOR-NUMBER.
030600     PERFORM DISPLAY-VENDOR-NAME.
030700     PERFORM DISPLAY-VENDOR-ADDRESS-1.
030800     PERFORM DISPLAY-VENDOR-ADDRESS-2.
030900     PERFORM DISPLAY-VENDOR-CITY.
031000     PERFORM DISPLAY-VENDOR-STATE.
031100     PERFORM DISPLAY-VENDOR-ZIP.
031200     PERFORM DISPLAY-VENDOR-CONTACT.
031300     PERFORM DISPLAY-VENDOR-PHONE.
031400     DISPLAY " ".
031500
031600 DISPLAY-VENDOR-NUMBER.
031700     DISPLAY "   VENDOR NUMBER: " VENDOR-NUMBER.
031800
031900 DISPLAY-VENDOR-NAME.
032000     DISPLAY "1. VENDOR NAME: " VENDOR-NAME.
032100</

Teach Yourself COBOL in 21 days, Second Edition

- A - Answers

Answers to Day 1, "Your First COBOL Program"

Quiz

Exercises

TYPE: Listing A.1. Another simple display.

Answers to Day 2, "Using Variables and Constants"

Quiz

Exercises

TYPE: Listing A.2. Keeping the user informed.

TYPE: Listing A.3. Numbering a longer phrase.

TYPE: Listing A.4. Incrementing by 5.

Answers to Day 3, "A First Look at Structured COBOL"

Quiz

Exercises

TYPE: Listing A.5. Missing a STOP RUN.

TYPE: Listing A.6. Adding three numbers.

TYPE: Listing A.7. Adding two numbers using PERFORM.

Answers to Day 4, "Decision Making"

Quiz

Exercises

TYPE: Listing A.8. Allowing for three valid answers.

TYPE: Listing A.9. Using OR to test three conditions.

Answers to Day 5, "Using PERFORM, GO TO, and IF to Control Programs"

Quiz

Exercise

Answers to Day 6, "Using Data and COBOL Operators"

Quiz

Exercises

Answers to Day 7, "Basics of Design"

Quiz

Exercises

TYPE: Listing A.10. A sales tax calculator.

TYPE: Listing A.11. Asking for the tax rate once.

Answers to Day 8, "Structured Data"

Quiz

Exercises

TYPE: Listing A.12. Displaying multiplication tables with a structure.

Answers to Day 9, "File I/O"

Quiz

Exercises

TYPE: Listing A.13. Adding a phone extension.

TYPE: Listing A.14. Displaying the extension.

Answers to Day 10, "Printing"

Quiz

Exercises

TYPE: Listing A.15. Two spaces between fields.

Answers to Day 11, "Indexed File I/O"

Quiz

Exercises

TYPE: Listing A.16. The FD for a contact file.

TYPE: Listing A.17. The SELECT statement for a contact file.

TYPE: Listing A.18. PHNPRT02 compared to VNDDSP01.

TYPE: Listing A.19. VNDDSP01 compared to PHNPRT02.

Answers to Day 12, "More on Indexed Files"

Quiz

TYPE: Listing A.20. Reading a record in a file.

Exercises

TYPE: Listing A.21. Correcting the bug.

Answers to Day 13, "Deleting Records and Other Indexed File Operations"

Quiz

Exercise

TYPE: Listing A.22. Using COPY directives.

Answers to Day 14, "A Review of Indexed Files"

Quiz

Exercises

TYPE: Listing A.23. Add mode.

TYPE: Listing A.24. Change mode.

- A -
Answers

TYPE: Listing A.5. Missing a `STOP RUN`.

TYPE: Listing A.7. Adding two numbers using `PERFORM`.

TYPE: Listing A.9. Using `OR` to test three conditions.

Answers to Day 5, "Using `PERFORM`, `GO TO`, and `IF` to Control Programs"

TYPE: Listing A.16. The `FD` for a contact file.

TYPE: Listing A.17. The `SELECT` statement for a contact file.

TYPE: Listing A.18. `PHNPRT02` compared to `VNDDSP01`.

TYPE: Listing A.19. `VNDDSP01` compared to `PHNPRT02`.

TYPE: Listing A.22. Using `COPY` directives.