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
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.25. Inquire 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.26. Delete 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

a. The routine that is incorrectly placed is GET-VENDOR-RECORD at line 025000 and FIND-VENDOR-RECORD at line 026100. GET-VENDOR-RECORD is placed in a section that is commented as a routine used in all modes, but it is not used in add mode. FIND-VENDOR-RECORD is placed in a section that is commented as a routine used in add and change mode, but it is not used in add mode.

b. These routines should be below line 030200 in the section for routines used in change, inquire, and delete modes because they are used in all of those modes.

c. All modes use READ-VENDOR-RECORD.

d. Add mode.

e. Change mode.

f. Delete mode.

2. Listing A.27 highlights in bold type the menu actions in vndmnt01.cbl.

TYPE: Listing A.27. Menu actions.

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

Answers to Day 15, "Data Integrity"

Quiz

1. a. Data always should be validated before it is put in a data file.

2. INSPECT CONVERTING can be used to convert a field to uppercase.

3. A field could be converted to lowercase by reversing the compare field and the replace field.

If Listing A.28 converts DATA-FIELD to uppercase, Listing A.29 will convert DATA-FIELD to lowercase.

TYPE: Listing A.28. Converting to uppercase.

010300     INSPECT DATA FIELD
010400       CONVERTING LOWER-ALPHA
010500       TO         UPPER-ALPHA.

TYPE: Listing A.29. Converting to lowercase.

010300     INSPECT DATA FIELD
010400       CONVERTING UPPER-ALPHA
010500       TO         LOWER-ALPHA.

Exercises

1. The routine in Listing A.30 is one way of entering and converting the vendor name.

TYPE: Listing A.30. Entering, validating, and converting a `VENDOR-NAME`.

ENTER-VENDOR-NAME.
    PERFORM ACCEPT-VENDOR-NAME.
    PERFORM RE-ACCEPT-VENDOR-NAME
      UNTIL VENDOR-NAME NOT = SPACES.

ACCEPT-VENDOR-NAME.
    DISPLAY "ENTER VENDOR NAME".
    ACCEPT VENDOR-NAME.

INSPECT VENDOR-NAME
    CONVERTING LOWER-ALPHA
    TO         UPPER-ALPHA.

RE-ACCEPT-VENDOR-NAME.
    DISPLAY "VENDOR NAME MUST BE ENTERED".
    PERFORM ACCEPT-VENDOR-NAME.

2. Figure A.3 compares ENTER-VENDOR-NAME to a standard field-entry routine.

Figure A.3. ENTER-VENDOR-NAME as a standard field-entry routine.

Answers to Day 16, "Using Look Up and Arrays"

Quiz

1. SET VENDOR-INDEX UP BY 1.

2. STATE-INDEX will contain 14.

3. TABLE-STATE-CODE(STATE-INDEX) will contain "XX".

Exercises

1. Listing A.31 would be a suitable table for 100 vendor records.

TYPE: Listing A.31. 100 vendors.

002000 01  TABLE-VENDOR-RECORD OCCURS 100 TIMES
002000     INDEXED BY VENDOR-INDEX.
002100     05  TABLE-VENDOR-NUMBER        PIC 9(5).
002200     05  TABLE-VENDOR-NAME          PIC X(30).
002300     05  TABLE-VENDOR-ADDRESS-1     PIC X(30).
002400     05  TABLE-VENDOR-ADDRESS-2     PIC X(30).
002500     05  TABLE-VENDOR-CITY          PIC X(20).
002600     05  TABLE-VENDOR-STATE         PIC X(2).
002700     05  TABLE-VENDOR-ZIP           PIC X(10).
002800     05  TABLE-VENDOR-CONTACT       PIC X(30).
002900     05  TABLE-VENDOR-PHONE         PIC X(15).

2. The size of the vendor table in exercise 1 would be 100 times the length of a single record. The record is 172 bytes long, so the whole table is 17,200 bytes.

Answers to Day 17, "Alternate Keys"

Quiz

1. OMEGA MANUFACTURING. The value "LINCOLN" in the VENDOR-NAME would not be matched by any vendor name on the file. The next key that is equal to or greater than "LINCOLN" is OMEGA MANUFACTURING.

2. The keys to the PART-FILE are the following:

PART-NUMBER
PART-VENDOR
PART-DEPARTMENT
PART-VENDOR-NUMBER

PART-NUMBER is the primary key.

3. Duplicate keys are allowed in the following:

PART-VENDOR
PART-DEPARTMENT

Duplicate keys are not allowed in the following:

PART-NUMBER
PART-VENDOR-NUMBER

Exercise

Listing A.32 defines the necessary keys.

TYPE: Listing A.32. Multiple keys for the customer file.

000400     SELECT CUSTOMER-FILE
000500         ASSIGN TO "CUST"
000600         ORGANIZATION IS INDEXED
000700         RECORD KEY IS CUSTOMER-NUMBER
000800         ALTERNATE KEY IS CUSTOMER-NAME WITH DUPLICATES
000900         ALTERNATE KEY IS CUSTOMER-ZIP WITH DUPLICATES
001000         ACCESS MODE IS DYNAMIC.
001100

Answers to Day 18, "Calling Other Programs"

Quiz

1. b. It remains in memory, but waits for the calling program to complete.

2. a. EXIT PROGRAM.

Exercises

1. Listing A.33 is a code fragment that includes all the changes you need to create vnddsp03.cbl.

TYPE: Listing A.33. Changes to `vnddsp03.cbl`.

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. VNDDSP03.
000300*------------------------------------------------
000400* Display records in the Vendor File.
000500*------------------------------------------------
000600 ENVIRONMENT DIVISION.
000700 INPUT-OUTPUT SECTION.
000800 FILE-CONTROL.
000900
001000     COPY "SLVND02.CBL".
001100
001200 DATA DIVISION.
001300 FILE SECTION.
001400
001500     COPY "FDVND04.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 PROGRAM-EXIT.
007600     EXIT PROGRAM.
007700
007800 PROGRAM-DONE.
007900     STOP RUN.
008000

2. Listing A.34 includes the changes for this exercise and the next.

3. Listing A.34 includes the changes for this exercise and the preceding one.

TYPE: Listing A.34. Changes for `vndmnt05.cbl`.

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. VNDMNT05.
000300*--------------------------------
000400* Add, Change, Inquire and Delete
000500* for the Vendor File.
000600* This includes Inquire by name
000700* The vendor report, and the vendor
000800* report in name order.
000900* Added Display all records.
001000*--------------------------------
001100 ENVIRONMENT DIVISION.
001200 INPUT-OUTPUT SECTION.
001300 FILE-CONTROL.
001400
001500     COPY "SLVND02.CBL".
001600
001700     COPY "SLSTATE.CBL".
001800
001900 DATA DIVISION.
002000 FILE SECTION.
002100
002200     COPY "FDVND04.CBL".
002300
002400     COPY "FDSTATE.CBL".
002500
002600 WORKING-STORAGE SECTION.
002700
002800 77  MENU-PICK                    PIC 9.
002900     88  MENU-PICK-IS-VALID       VALUES 0 THRU 8.
003000
003100 77  THE-MODE                     PIC X(7).
003200 77  WHICH-FIELD                  PIC 9.
003300 77  OK-TO-DELETE                 PIC X.
003400 77  VENDOR-RECORD-FOUND          PIC X.
003500 77  STATE-RECORD-FOUND           PIC X.
003600 77  A-DUMMY                      PIC X.
003700
003800 77  VENDOR-NUMBER-FIELD          PIC Z(5).
003900
004000 77  ERROR-MESSAGE                PIC X(79) VALUE SPACE.
004100
004200     COPY "WSCASE01.CBL".
004300
004400 PROCEDURE DIVISION.
004500 PROGRAM-BEGIN.
004600     PERFORM OPENING-PROCEDURE.
004700     PERFORM MAIN-PROCESS.
004800     PERFORM CLOSING-PROCEDURE.
004900
005000 PROGRAM-EXIT.
005100     EXIT PROGRAM.
005200
005300 PROGRAM-DONE.
005400     STOP RUN.
005500
005600 OPENING-PROCEDURE.
005700     OPEN I-O VENDOR-FILE.
005800     OPEN I-O STATE-FILE.
005900
006000 CLOSING-PROCEDURE.
006100     CLOSE VENDOR-FILE.
006200     CLOSE STATE-FILE.
006300
006400 MAIN-PROCESS.
006500     PERFORM GET-MENU-PICK.
006600     PERFORM MAINTAIN-THE-FILE
006700         UNTIL MENU-PICK = 0.
006800
006900*--------------------------------
007000* MENU
007100*--------------------------------
007200 GET-MENU-PICK.
007300     PERFORM DISPLAY-THE-MENU.
007400     PERFORM ACCEPT-MENU-PICK.
007500     PERFORM RE-ACCEPT-MENU-PICK
007600         UNTIL MENU-PICK-IS-VALID.
007700
007800 DISPLAY-THE-MENU.
007900     PERFORM CLEAR-SCREEN.
008000     DISPLAY "    PLEASE SELECT:".
008100     DISPLAY " ".
008200     DISPLAY "          1.  ADD RECORDS".
008300     DISPLAY "          2.  CHANGE A RECORD".
008400     DISPLAY "          3.  LOOK UP A RECORD".
008500     DISPLAY "          4.  DELETE A RECORD".
008600     DISPLAY "          5.  LOOK UP BY NAME".
008700     DISPLAY "          6.  PRINT RECORDS".
008800     DISPLAY "          7.  PRINT IN NAME ORDER".
008900     DISPLAY "          8.  DISPLAY ALL RECORDS".
009000     DISPLAY " ".
009100     DISPLAY "          0.  EXIT".
009200     PERFORM SCROLL-LINE 8 TIMES.
009300
009400 ACCEPT-MENU-PICK.
009500     DISPLAY "YOUR CHOICE (0-8)?".
009600     ACCEPT MENU-PICK.
009700
009800 RE-ACCEPT-MENU-PICK.
009900     DISPLAY "INVALID SELECTION - PLEASE RE-TRY.".
010000     PERFORM ACCEPT-MENU-PICK.
010100
010200 CLEAR-SCREEN.
010300     PERFORM SCROLL-LINE 25 TIMES.
010400
010500 SCROLL-LINE.
010600     DISPLAY " ".
010700
010800 MAINTAIN-THE-FILE.
010900     PERFORM DO-THE-PICK.
011000     PERFORM GET-MENU-PICK.
011100
011200 DO-THE-PICK.
011300     IF MENU-PICK = 1
011400         PERFORM ADD-MODE
011500     ELSE
011600     IF MENU-PICK = 2
011700         PERFORM CHANGE-MODE
011800     ELSE
011900     IF MENU-PICK = 3
012000         PERFORM INQUIRE-MODE
012100     ELSE
012200     IF MENU-PICK = 4
012300         PERFORM DELETE-MODE
012400     ELSE
012500     IF MENU-PICK = 5
012600         PERFORM INQUIRE-BY-NAME
012700     ELSE
012800     IF MENU-PICK = 6
012900         PERFORM PRINT-VENDOR-REPORT
013000     ELSE
013100     IF MENU-PICK = 7
013200         PERFORM PRINT-BY-NAME
013300     ELSE
013400     IF MENU-PICK = 8
013500         PERFORM DISPLAY-ALL.
013600
013700*--------------------------------
013800* ADD
013900*--------------------------------
014000 ADD-MODE.
014100     MOVE "ADD" TO THE-MODE.
014200     PERFORM GET-NEW-RECORD-KEY.
014300     PERFORM ADD-RECORDS
014400        UNTIL VENDOR-NUMBER = ZEROES.
014500
014600 GET-NEW-RECORD-KEY.
014700     PERFORM ACCEPT-NEW-RECORD-KEY.
014800     PERFORM RE-ACCEPT-NEW-RECORD-KEY
014900         UNTIL VENDOR-RECORD-FOUND = "N" OR
015000               VENDOR-NUMBER = ZEROES.
015100
015200 ACCEPT-NEW-RECORD-KEY.
015300     PERFORM INIT-VENDOR-RECORD.
015400     PERFORM ENTER-VENDOR-NUMBER.
015500     IF VENDOR-NUMBER NOT = ZEROES
015600         PERFORM READ-VENDOR-RECORD.
015700
015800 RE-ACCEPT-NEW-RECORD-KEY.
015900     DISPLAY "RECORD ALREADY ON FILE"
016000     PERFORM ACCEPT-NEW-RECORD-KEY.
016100
016200 ADD-RECORDS.
016300     PERFORM ENTER-REMAINING-FIELDS.
016400     PERFORM WRITE-VENDOR-RECORD.
016500     PERFORM GET-NEW-RECORD-KEY.
016600
016700 ENTER-REMAINING-FIELDS.
016800     PERFORM ENTER-VENDOR-NAME.
016900     PERFORM ENTER-VENDOR-ADDRESS-1.
017000     PERFORM ENTER-VENDOR-ADDRESS-2.
017100     PERFORM ENTER-VENDOR-CITY.
017200     PERFORM ENTER-VENDOR-STATE.
017300     PERFORM ENTER-VENDOR-ZIP.
017400     PERFORM ENTER-VENDOR-CONTACT.
017500     PERFORM ENTER-VENDOR-PHONE.
017600
017700*--------------------------------
017800* CHANGE
017900*--------------------------------
018000 CHANGE-MODE.
018100     MOVE "CHANGE" TO THE-MODE.
018200     PERFORM GET-EXISTING-RECORD.
018300     PERFORM CHANGE-RECORDS
018400        UNTIL VENDOR-NUMBER = ZEROES.
018500
018600 CHANGE-RECORDS.
018700     PERFORM GET-FIELD-TO-CHANGE.
018800     PERFORM CHANGE-ONE-FIELD
018900         UNTIL WHICH-FIELD = ZERO.
019000     PERFORM GET-EXISTING-RECORD.
019100
019200 GET-FIELD-TO-CHANGE.
019300     PERFORM DISPLAY-ALL-FIELDS.
019400     PERFORM ASK-WHICH-FIELD.
019500
019600 ASK-WHICH-FIELD.
019700     PERFORM ACCEPT-WHICH-FIELD.
019800     PERFORM RE-ACCEPT-WHICH-FIELD
019900         UNTIL WHICH-FIELD < 9.
020000
020100 ACCEPT-WHICH-FIELD.
020200     DISPLAY "ENTER THE NUMBER OF THE FIELD".
020300     DISPLAY "TO CHANGE (1-8) OR 0 TO EXIT".
020400     ACCEPT WHICH-FIELD.
020500
020600 RE-ACCEPT-WHICH-FIELD.
020700     DISPLAY "INVALID ENTRY".
020800     PERFORM ACCEPT-WHICH-FIELD.
020900
021000 CHANGE-ONE-FIELD.
021100     PERFORM CHANGE-THIS-FIELD.
021200     PERFORM GET-FIELD-TO-CHANGE.
021300
021400 CHANGE-THIS-FIELD.
021500     IF WHICH-FIELD = 1
021600         PERFORM ENTER-VENDOR-NAME.
021700     IF WHICH-FIELD = 2
021800         PERFORM ENTER-VENDOR-ADDRESS-1.
021900     IF WHICH-FIELD = 3
022000         PERFORM ENTER-VENDOR-ADDRESS-2.
022100     IF WHICH-FIELD = 4
022200         PERFORM ENTER-VENDOR-CITY.
022300     IF WHICH-FIELD = 5
022400         PERFORM ENTER-VENDOR-STATE.
022500     IF WHICH-FIELD = 6
022600         PERFORM ENTER-VENDOR-ZIP.
022700     IF WHICH-FIELD = 7
022800         PERFORM ENTER-VENDOR-CONTACT.
022900     IF WHICH-FIELD = 8
023000         PERFORM ENTER-VENDOR-PHONE.
023100
023200     PERFORM REWRITE-VENDOR-RECORD.
023300
023400*--------------------------------
023500* INQUIRE
023600*--------------------------------
023700 INQUIRE-MODE.
023800     MOVE "DISPLAY" TO THE-MODE.
023900     PERFORM GET-EXISTING-RECORD.
024000     PERFORM INQUIRE-RECORDS
024100        UNTIL VENDOR-NUMBER = ZEROES.
024200
024300 INQUIRE-RECORDS.
024400     PERFORM DISPLAY-ALL-FIELDS.
024500     PERFORM GET-EXISTING-RECORD.
024600
024700*--------------------------------
024800* DELETE
024900*--------------------------------
025000 DELETE-MODE.
025100     MOVE "DELETE" TO THE-MODE.
025200     PERFORM GET-EXISTING-RECORD.
025300     PERFORM DELETE-RECORDS
025400        UNTIL VENDOR-NUMBER = ZEROES.
025500
025600 DELETE-RECORDS.
025700     PERFORM DISPLAY-ALL-FIELDS.
025800
025900     PERFORM ASK-OK-TO-DELETE.
026000
026100     IF OK-TO-DELETE = "Y"
026200         PERFORM DELETE-VENDOR-RECORD.
026300
026400     PERFORM GET-EXISTING-RECORD.
026500
026600 ASK-OK-TO-DELETE.
026700     PERFORM ACCEPT-OK-TO-DELETE.
026800
026900     PERFORM RE-ACCEPT-OK-TO-DELETE
027000        UNTIL OK-TO-DELETE = "Y" OR "N".
027100
027200 ACCEPT-OK-TO-DELETE.
027300     DISPLAY "DELETE THIS RECORD (Y/N)?".
027400     ACCEPT OK-TO-DELETE.
027500     INSPECT OK-TO-DELETE
027600      CONVERTING LOWER-ALPHA TO UPPER-ALPHA.
027700
027800 RE-ACCEPT-OK-TO-DELETE.
027900     DISPLAY "YOU MUST ENTER YES OR NO".
028000     PERFORM ACCEPT-OK-TO-DELETE.
028100
028200*--------------------------------
028300* Routines shared by all modes
028400*--------------------------------
028500 INIT-VENDOR-RECORD.
028600     MOVE SPACE TO VENDOR-RECORD.
028700     MOVE ZEROES TO VENDOR-NUMBER.
028800
028900 ENTER-VENDOR-NUMBER.
029000     DISPLAY " ".
029100     DISPLAY "ENTER VENDOR NUMBER OF THE VENDOR" .
029200     DISPLAY "TO " THE-MODE " (1-99999)".
029300     DISPLAY "ENTER 0 TO STOP ENTRY".
029400     ACCEPT VENDOR-NUMBER-FIELD.
029500*OR  ACCEPT VENDOR-NUMBER-FIELD WITH CONVERSION.
029600
029700     MOVE VENDOR-NUMBER-FIELD TO VENDOR-NUMBER.
029800
029900*--------------------------------
030000* INQUIRE BY NAME
030100*--------------------------------
030200 INQUIRE-BY-NAME.
030300     PERFORM CLOSING-PROCEDURE.
030400     CALL "VNINNM03".
030500     PERFORM OPENING-PROCEDURE.
030600
030700*--------------------------------
030800* PRINT
030900*--------------------------------
031000 PRINT-VENDOR-REPORT.
031100     PERFORM CLOSING-PROCEDURE.
031200     DISPLAY "VENDOR REPORT IN PROGRESS".
031300     CALL "VNDRPT04".
031400     PERFORM OPENING-PROCEDURE.
031500
031600*--------------------------------
031700* PRINT BY NAME
031800*--------------------------------
031900 PRINT-BY-NAME.
032000     PERFORM CLOSING-PROCEDURE.
032100     DISPLAY " REPORT BY NAME IN PROGRESS".
032200     CALL "VNBYNM02".
032300     PERFORM OPENING-PROCEDURE.
032400
032500*--------------------------------
032600* DISPLAY ALL
032700*--------------------------------
032800 DISPLAY-ALL.
032900     PERFORM CLOSING-PROCEDURE.
033000     CALL "VNDDSP03".
033100     DISPLAY "DISPLAY COMPLETE".
033200     DISPLAY "PRESS ENTER TO CONTINUE".
033300     ACCEPT A-DUMMY.
033400     PERFORM OPENING-PROCEDURE.
033500
033600*--------------------------------
033700* Routines shared Add and Change
033800*--------------------------------
033900 ENTER-VENDOR-NAME.
034000     PERFORM ACCEPT-VENDOR-NAME.
034100     PERFORM RE-ACCEPT-VENDOR-NAME
034200         UNTIL VENDOR-NAME NOT = SPACE.
034300
034400 ACCEPT-VENDOR-NAME.
034500     DISPLAY "ENTER VENDOR NAME".
034600     ACCEPT VENDOR-NAME.
034700     INSPECT VENDOR-NAME
034800         CONVERTING LOWER-ALPHA
034900         TO         UPPER-ALPHA.
035000
035100 RE-ACCEPT-VENDOR-NAME.
035200     DISPLAY "VENDOR NAME MUST BE ENTERED".
035300     PERFORM ACCEPT-VENDOR-NAME.
035400
035500 ENTER-VENDOR-ADDRESS-1.
035600     PERFORM ACCEPT-VENDOR-ADDRESS-1.
035700     PERFORM RE-ACCEPT-VENDOR-ADDRESS-1
035800         UNTIL VENDOR-ADDRESS-1 NOT = SPACE.
035900
036000 ACCEPT-VENDOR-ADDRESS-1.
036100     DISPLAY "ENTER VENDOR ADDRESS-1".
036200     ACCEPT VENDOR-ADDRESS-1.
036300     INSPECT VENDOR-ADDRESS-1
036400         CONVERTING LOWER-ALPHA
036500         TO         UPPER-ALPHA.
036600
036700 RE-ACCEPT-VENDOR-ADDRESS-1.
036800     DISPLAY "VENDOR ADDRESS-1 MUST BE ENTERED".
036900     PERFORM ACCEPT-VENDOR-ADDRESS-1.
037000
037100 ENTER-VENDOR-ADDRESS-2.
037200     DISPLAY "ENTER VENDOR ADDRESS-2".
037300     ACCEPT VENDOR-ADDRESS-2.
037400     INSPECT VENDOR-ADDRESS-2
037500         CONVERTING LOWER-ALPHA
037600         TO         UPPER-ALPHA.
037700
037800 ENTER-VENDOR-CITY.
037900     PERFORM ACCEPT-VENDOR-CITY.
038000     PERFORM RE-ACCEPT-VENDOR-CITY
038100         UNTIL VENDOR-CITY NOT = SPACE.
038200
038300 ACCEPT-VENDOR-CITY.
038400     DISPLAY "ENTER VENDOR CITY".
038500     ACCEPT VENDOR-CITY.
038600     INSPECT VENDOR-CITY
038700         CONVERTING LOWER-ALPHA
038800         TO         UPPER-ALPHA.
038900
039000 RE-ACCEPT-VENDOR-CITY.
039100     DISPLAY "VENDOR CITY MUST BE ENTERED".
039200     PERFORM ACCEPT-VENDOR-CITY.
039300
039400 ENTER-VENDOR-STATE.
039500     PERFORM ACCEPT-VENDOR-STATE.
039600     PERFORM RE-ACCEPT-VENDOR-STATE
039700         UNTIL VENDOR-STATE NOT = SPACES AND
039800               STATE-RECORD-FOUND = "Y".
039900
040000 ACCEPT-VENDOR-STATE.
040100     DISPLAY "ENTER VENDOR STATE".
040200     ACCEPT VENDOR-STATE.
040300     PERFORM EDIT-CHECK-VENDOR-STATE.
040400
040500 RE-ACCEPT-VENDOR-STATE.
040600     DISPLAY ERROR-MESSAGE.
040700     PERFORM ACCEPT-VENDOR-STATE.
040800
040900 EDIT-CHECK-VENDOR-STATE.
041000     PERFORM EDIT-VENDOR-STATE.
041100     PERFORM CHECK-VENDOR-STATE.
041200
041300 EDIT-VENDOR-STATE.
041400     INSPECT VENDOR-STATE
041500         CONVERTING LOWER-ALPHA
041600         TO         UPPER-ALPHA.
041700
041800 CHECK-VENDOR-STATE.
041900     PERFORM VENDOR-STATE-REQUIRED.
042000     IF VENDOR-STATE NOT = SPACES
042100         PERFORM VENDOR-STATE-ON-FILE.
042200
042300 VENDOR-STATE-REQUIRED.
042400     IF VENDOR-STATE = SPACE
042500         MOVE "VENDOR STATE MUST BE ENTERED"
042600           TO ERROR-MESSAGE.
042700
042800 VENDOR-STATE-ON-FILE.
042900     MOVE VENDOR-STATE TO STATE-CODE.
043000     PERFORM READ-STATE-RECORD.
043100     IF STATE-RECORD-FOUND = "N"
043200         MOVE "STATE CODE NOT FOUND IN CODES FILE"
043300           TO ERROR-MESSAGE.
043400
043500 ENTER-VENDOR-ZIP.
043600     PERFORM ACCEPT-VENDOR-ZIP.
043700     PERFORM RE-ACCEPT-VENDOR-ZIP
043800         UNTIL VENDOR-ZIP NOT = SPACE.
043900
044000 ACCEPT-VENDOR-ZIP.
044100     DISPLAY "ENTER VENDOR ZIP".
044200     ACCEPT VENDOR-ZIP.
044300     INSPECT VENDOR-ZIP
044400         CONVERTING LOWER-ALPHA
044500         TO         UPPER-ALPHA.
044600
044700 RE-ACCEPT-VENDOR-ZIP.
044800     DISPLAY "VENDOR ZIP MUST BE ENTERED".
044900     PERFORM ACCEPT-VENDOR-ZIP.
045000
045100 ENTER-VENDOR-CONTACT.
045200     DISPLAY "ENTER VENDOR CONTACT".
045300     ACCEPT VENDOR-CONTACT.
045400     INSPECT VENDOR-CONTACT
045500         CONVERTING LOWER-ALPHA
045600         TO         UPPER-ALPHA.
045700
045800 ENTER-VENDOR-PHONE.
045900     PERFORM ACCEPT-VENDOR-PHONE.
046000     PERFORM RE-ACCEPT-VENDOR-PHONE
046100         UNTIL VENDOR-PHONE NOT = SPACE.
046200
046300 ACCEPT-VENDOR-PHONE.
046400     DISPLAY "ENTER VENDOR PHONE".
046500     ACCEPT VENDOR-PHONE.
046600     INSPECT VENDOR-PHONE
046700         CONVERTING LOWER-ALPHA
046800         TO         UPPER-ALPHA.
046900
047000 RE-ACCEPT-VENDOR-PHONE.
047100     DISPLAY "VENDOR PHONE MUST BE ENTERED".
047200     PERFORM ACCEPT-VENDOR-PHONE.
047300
047400*--------------------------------
047500* Routines shared by Change,
047600* Inquire and Delete
047700*--------------------------------
047800 GET-EXISTING-RECORD.
047900     PERFORM ACCEPT-EXISTING-KEY.
048000     PERFORM RE-ACCEPT-EXISTING-KEY
048100         UNTIL VENDOR-RECORD-FOUND = "Y" OR
048200               VENDOR-NUMBER = ZEROES.
048300
048400 ACCEPT-EXISTING-KEY.
048500     PERFORM INIT-VENDOR-RECORD.
048600     PERFORM ENTER-VENDOR-NUMBER.
048700     IF VENDOR-NUMBER NOT = ZEROES
048800         PERFORM READ-VENDOR-RECORD.
048900
049000 RE-ACCEPT-EXISTING-KEY.
049100     DISPLAY "RECORD NOT FOUND"
049200     PERFORM ACCEPT-EXISTING-KEY.
049300
049400 DISPLAY-ALL-FIELDS.
049500     DISPLAY " ".
049600     PERFORM DISPLAY-VENDOR-NUMBER.
049700     PERFORM DISPLAY-VENDOR-NAME.
049800     PERFORM DISPLAY-VENDOR-ADDRESS-1.
049900     PERFORM DISPLAY-VENDOR-ADDRESS-2.
050000     PERFORM DISPLAY-VENDOR-CITY.
050100     PERFORM DISPLAY-VENDOR-STATE.
050200     PERFORM DISPLAY-VENDOR-ZIP.
050300     PERFORM DISPLAY-VENDOR-CONTACT.
050400     PERFORM DISPLAY-VENDOR-PHONE.
050500     DISPLAY " ".
050600
050700 DISPLAY-VENDOR-NUMBER.
050800     DISPLAY "   VENDOR NUMBER: " VENDOR-NUMBER.
050900
051000 DISPLAY-VENDOR-NAME.
051100     DISPLAY "1. VENDOR NAME: " VENDOR-NAME.
051200
051300 DISPLAY-VENDOR-ADDRESS-1.
051400     DISPLAY "2. VENDOR ADDRESS-1: " VENDOR-ADDRESS-1.
051500
051600 DISPLAY-VENDOR-ADDRESS-2.
051700     DISPLAY "3. VENDOR ADDRESS-2: " VENDOR-ADDRESS-2.
051800
051900 DISPLAY-VENDOR-CITY.
052000     DISPLAY "4. VENDOR CITY: " VENDOR-CITY.
052100
052200 DISPLAY-VENDOR-STATE.
052300     PERFORM VENDOR-STATE-ON-FILE.
052400     IF STATE-RECORD-FOUND = "N"
052500         MOVE "**Not found**" TO STATE-NAME.
052600     DISPLAY "5. VENDOR STATE: "
052700             VENDOR-STATE " "
052800             STATE-NAME.
052900
053000 DISPLAY-VENDOR-ZIP.
053100     DISPLAY "6. VENDOR ZIP: " VENDOR-ZIP.
053200
053300 DISPLAY-VENDOR-CONTACT.
053400     DISPLAY "7. VENDOR CONTACT: " VENDOR-CONTACT.
053500
053600 DISPLAY-VENDOR-PHONE.
053700     DISPLAY "8. VENDOR PHONE: " VENDOR-PHONE.
053800
053900*--------------------------------
054000* File I-O Routines
054100*--------------------------------
054200 READ-VENDOR-RECORD.
054300     MOVE "Y" TO VENDOR-RECORD-FOUND.
054400     READ VENDOR-FILE RECORD
054500       INVALID KEY
054600          MOVE "N" TO VENDOR-RECORD-FOUND.
054700
054800*or  READ VENDOR-FILE RECORD WITH LOCK
054900*      INVALID KEY
055000*         MOVE "N" TO VENDOR-RECORD-FOUND.
055100
055200*or  READ VENDOR-FILE RECORD WITH HOLD
055300*      INVALID KEY
055400*         MOVE "N" TO VENDOR-RECORD-FOUND.
055500
055600 WRITE-VENDOR-RECORD.
055700     WRITE VENDOR-RECORD
055800         INVALID KEY
055900         DISPLAY "RECORD ALREADY ON FILE".
056000
056100 REWRITE-VENDOR-RECORD.
056200     REWRITE VENDOR-RECORD
056300         INVALID KEY
056400         DISPLAY "ERROR REWRITING VENDOR RECORD".
056500
056600 DELETE-VENDOR-RECORD.
056700     DELETE VENDOR-FILE RECORD
056800         INVALID KEY
056900         DISPLAY "ERROR DELETING VENDOR RECORD".
057000
057100 READ-STATE-RECORD.
057200     MOVE "Y" TO STATE-RECORD-FOUND.
057300     READ STATE-FILE RECORD
057400       INVALID KEY
057500          MOVE "N" TO STATE-RECORD-FOUND.

4. Listing A.35 includes the changes needed to create bilmnu02.cbl.

TYPE: Listing A.35. The changes for `bilmnu02.cbl`.

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. BILMNU02.
000300*--------------------------------
000400* Menu for the bill payment system.
000500*--------------------------------
000600 ENVIRONMENT DIVISION.
000700 INPUT-OUTPUT SECTION.
000800 FILE-CONTROL.
000900
001000 DATA DIVISION.
001100 FILE SECTION.
001200
001300 WORKING-STORAGE SECTION.
001400
001500 77  MENU-PICK                    PIC 9.
001600     88  MENU-PICK-IS-VALID       VALUES 0 THRU 2.
001700
001800 PROCEDURE DIVISION.
001900 PROGRAM-BEGIN.
002000     PERFORM OPENING-PROCEDURE.
002100     PERFORM MAIN-PROCESS.
002200     PERFORM CLOSING-PROCEDURE.
002300
002400 PROGRAM-EXIT.
002500     EXIT PROGRAM.
002600
002700 PROGRAM-DONE.
002800     STOP RUN.
002900
003000 OPENING-PROCEDURE.
003100
003200 CLOSING-PROCEDURE.
003300
003400 MAIN-PROCESS.
003500     PERFORM GET-MENU-PICK.
003600     PERFORM DO-THE-PICK
003700         UNTIL MENU-PICK = 0.
003800
003900*--------------------------------
004000* MENU
004100*--------------------------------
004200 GET-MENU-PICK.
004300     PERFORM DISPLAY-THE-MENU.
004400     PERFORM ACCEPT-MENU-PICK.
004500     PERFORM RE-ACCEPT-MENU-PICK
004600         UNTIL MENU-PICK-IS-VALID.
004700
004800 DISPLAY-THE-MENU.
004900     PERFORM CLEAR-SCREEN.
005000     DISPLAY "    PLEASE SELECT:".
005100     DISPLAY " ".
005200     DISPLAY "          1.  STATE CODE MAINTENANCE".
005300     DISPLAY "          2.  VENDOR MAINTENANCE".
005400     DISPLAY " ".
005500     DISPLAY "          0.  EXIT".
005600     PERFORM SCROLL-LINE 8 TIMES.
005700
005800 ACCEPT-MENU-PICK.
005900     DISPLAY "YOUR CHOICE (0-2)?".
006000     ACCEPT MENU-PICK.
006100
006200 RE-ACCEPT-MENU-PICK.
006300     DISPLAY "INVALID SELECTION - PLEASE RE-TRY.".
006400     PERFORM ACCEPT-MENU-PICK.
006500
006600 CLEAR-SCREEN.
006700     PERFORM SCROLL-LINE 25 TIMES.
006800
006900 SCROLL-LINE.
007000     DISPLAY " ".
007100
007200 DO-THE-PICK.
007300     IF MENU-PICK = 1
007400         PERFORM STATE-MAINTENANCE
007500     ELSE
007600     IF MENU-PICK = 2
007700         PERFORM VENDOR-MAINTENANCE.
007800
007900     PERFORM GET-MENU-PICK.
008000
008100*--------------------------------
008200* STATE
008300*--------------------------------
008400 STATE-MAINTENANCE.
008500     CALL "STCMNT04".
008600
008700*--------------------------------
008800* VENDOR
008900*--------------------------------
009000 VENDOR-MAINTENANCE.
009100     CALL "VNDMNT05".
009200

Answers to Day 19, "Complex Data Entry Problems"

Quiz

1. The variable represents six bytes of memory.

2. TIME-HHMMSS is six bytes long and will hold numeric data.

3. TIME-HH is two bytes long and will hold numeric data.

4. TIME-MM is two bytes long and will hold numeric data.

5. TIME-SS is two bytes long and will hold numeric data.

Exercises

1. Figure A.4 highlights the differences between a simple maintenance module such as stcmnt04.cbl and a control-file maintenance module such as ctlmnt01.cbl. Both of these listings had to be rewritten here to allow them to fit side by side within the 80-column limit of this book's layout. The new programs, stcmntxx.cbl and ctlmntxx.cbl, function in the same way as the originals, but the lines and line breaks have been extensively shifted to squeeze everything into the side-by-side format. You will recognize all the parts of the original programs as you review these two programs.

Figure A.4.
Comparing stcmntxx.cbl and ctlmntxx.cbl.

2. Listing A.36 makes it possible to directly test DATE-CCYY for a value, as shown in Listing A.37.

TYPE: Listing A.36. `REDEFINES` within a `REDEFINES`.

003200 01  DATE-CCYYMMDD      PIC 9(8).
003300 01  FILLER REDEFINES DATE-CCYYMMDD.
003400     05  DATE-CCYY      PIC 9999.
003500     05  FILLER REDEFINES DATE-CCYY.
003600         10  DATE-CC    PIC 99.
003700         10  DATE-YY    PIC 99.
003800     05  DATE-MM        PIC 99.
003900     05  DATE-DD        PIC 99.

TYPE: Listing A.37. Testing the whole year.

021500     MOVE "Y" TO VALID-DATE-FLAG.
021600     IF DATE-CCYYMMDD = ZEROES
021700         IF ZERO-DATE-IS-OK = "Y"
021800             MOVE "0" TO VALID-DATE-FLAG
021900         ELSE
022000             MOVE "N" TO VALID-DATE-FLAG
022100     ELSE
           IF DATE-CCYY < 1920 OR DATE-CCYY > 2150
               MOVE "N" TO VALID-DATE-FLAG
           ELSE
022200     IF DATE-MM < 1 OR DATE-MM > 12
022300         MOVE "N" TO VALID-DATE-FLAG
022400     ELSE
022500     IF DATE-DD < 1 OR DATE-DD > 31
022600         MOVE "N" TO VALID-DATE-FLAG
022700     ELSE
022800     IF (DATE-DD > 30) AND
022900        (DATE-MM = 2 OR 4 OR 6 OR 9 OR 11)
023000         MOVE "N" TO VALID-DATE-FLAG
023100     ELSE
023200     IF DATE-DD > 29 AND DATE-MM = 2
023300         MOVE "N" TO VALID-DATE-FLAG
023400     ELSE
023500     IF DATE-DD = 29 AND DATE-MM = 2
. . . . .
. . . . .
024100

3. One answer is shown in the following two listings, A.38 and A.39. A CHECK-TIME routine would use WORKING-STORAGE as in Listing A.38. Create this file and name it WSTIME01.CBL. The logic for checking the time is in Listing A.39, which you should create and call PLTIME01.CBL.

TYPE: Listing A.38. `WORKING-STORAGE` for `CHECK-TIME`.

000100*--------------------------------
000200* Fields for CHECK-TIME
000300*--------------------------------
000400 77  VALID-TIME-FLAG      PIC X.
000500     88  TIME-IS-INVALID  VALUE "N".
000600     88  TIME-IS-VALID    VALUE "Y".
000700
000800 01  TIME-HHMMSS        PIC 9(6).
000900 01  FILLER REDEFINES TIME-HHMMSS.
001000     05  TIME-HH        PIC 99.
001100     05  TIME-MM        PIC 99.
001200     05  TIME-SS        PIC 99.
001300

TYPE: Listing A.39. The `CHECK-TIME` routine.

000100*--------------------------------
000200* USAGE:
000300*   MOVE TIME(hhmmss) TO TIME-HHMMSS.
000400*   PERFORM CHECK-TIME.
000500*
000600* RETURNS:
000700*   TIME-IS-VALID   (VALID)
000800*   TIME-IS-INVALID (BAD TIME )
000900*
001000* Assume that the time is good, then
001100* test the time in the following
001200* steps. The routine stops if any
001300* of these conditions is true,
001400* and sets the valid time flag to "N".
001500* 1.  Hours > 23
001600* 2.  Minutes > 59
001700* 3.  Seconds > 59
001800*--------------------------------
001900 CHECK-TIME.
002000     MOVE "Y" TO VALID-TIME-FLAG.
002100     IF TIME-HH > 23
002200         MOVE "N" TO VALID-TIME-FLAG
002300     ELSE
002400     IF TIME-MM > 59
002500         MOVE "N" TO VALID-TIME-FLAG
002600     ELSE
002700     IF TIME-SS > 59
002800         MOVE "N" TO VALID-TIME-FLAG.
002900

You can use Listing A.40 to check your logic.

TYPE: Listing A.40. `TIME01` testing time logic.

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. TIME01.
000300*--------------------------------
000400* Testing CHECK-TIME
000500*--------------------------------
000600 ENVIRONMENT DIVISION.
000700 INPUT-OUTPUT SECTION.
000800 FILE-CONTROL.
000900
001000 DATA DIVISION.
001100 FILE SECTION.
001200
001300 WORKING-STORAGE SECTION.
001400
001500 77  ANY-TIME           PIC 9(6) VALUE ZEROES.
001600
001700 77  TIME-FIELD         PIC Z(6).
001800
001900     COPY "WSTIME01.CBL".
002000
002100 PROCEDURE DIVISION.
002200 PROGRAM-BEGIN.
002300     PERFORM OPENING-PROCEDURE.
002400     PERFORM MAIN-PROCESS.
002500     PERFORM CLOSING-PROCEDURE.
002600
002700 PROGRAM-EXIT.
002800     EXIT PROGRAM.
002900
003000 PROGRAM-DONE.
003100     STOP RUN.
003200
003300 OPENING-PROCEDURE.
003400
003500 CLOSING-PROCEDURE.
003600
003700 MAIN-PROCESS.
003800     PERFORM GET-A-TIME.
003900     PERFORM DISPLAY-AND-GET-TIME
004000         UNTIL ANY-TIME = 000001.
004100
004200 GET-A-TIME.
004300     PERFORM ACCEPT-A-TIME.
004400     PERFORM RE-ACCEPT-A-TIME
004500         UNTIL TIME-IS-VALID.
004600     MOVE TIME-HHMMSS TO ANY-TIME.
004700
004800 ACCEPT-A-TIME.
004900     DISPLAY "ENTER A TIME (HHMMSS)"
005000     ACCEPT TIME-FIELD.
005100     PERFORM EDIT-CHECK-TIME.
005200
005300 RE-ACCEPT-A-TIME.
005400     DISPLAY "INVALID TIME"
005500     PERFORM ACCEPT-A-TIME.
005600
005700 EDIT-CHECK-TIME.
005800     PERFORM EDIT-TIME.
005900     PERFORM CHECK-TIME.
006000
006100 EDIT-TIME.
006200     MOVE TIME-FIELD TO TIME-HHMMSS.
006300
006400 DISPLAY-AND-GET-TIME.
006500     PERFORM DISPLAY-THE-TIME.
006600     PERFORM GET-A-TIME.
006700
006800 DISPLAY-THE-TIME.
006900     DISPLAY "ANY TIME IS " ANY-TIME.
007000
007100     COPY "PLTIME01.CBL".
007200

Answers to Day 20, "More Complex Data Entry"

Quiz

The original routine prevented the entry of values greater than VOUCHER-AMOUNT by using this logic:

025600 ENTER-VOUCHER-PAID-AMOUNT.
025700     PERFORM ACCEPT-VOUCHER-PAID-AMOUNT.
025800     PERFORM RE-ACCEPT-VOUCHER-PAID-AMOUNT
025900         UNTIL VOUCHER-PAID-AMOUNT NOT = ZEROES
026000           AND VOUCHER-PAID-AMOUNT NOT > VOUCHER-AMOUNT.

The new logic prevents only a zero amount from being entered:

025600 ENTER-VOUCHER-PAID-AMOUNT.
025700     PERFORM ACCEPT-VOUCHER-PAID-AMOUNT.
025800     PERFORM RE-ACCEPT-VOUCHER-PAID-AMOUNT
025900         UNTIL VOUCHER-PAID-AMOUNT NOT = ZEROES.
026000

The user can enter any amount other than zero for the voucher paid amount.

Exercise

Listing A.41 implements the changes from the quiz question.

TYPE: Listing A.41. Allowing overpayment.

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. VCHPAY02.
000300*--------------------------------
000400* Change only.
000500* User can request a voucher.
000600* If the voucher is already paid,
000700* the user is asked whether
000800* to clear the payment
000900* and reopen the voucher.
001000* If the voucher is not paid,
001100* the user is required to enter
001200* a payment date, amount and check
001300* number.
001400* Only maintains PAID-DATE
001500* CHECK-NO and PAID-AMOUNT.
001600*--------------------------------
001700 ENVIRONMENT DIVISION.
001800 INPUT-OUTPUT SECTION.
001900 FILE-CONTROL.
002000
002100     COPY "SLVND02.CBL".
002200
002300     COPY "SLVOUCH.CBL".
002400
002500     COPY "SLCONTRL.CBL".
002600
002700 DATA DIVISION.
002800 FILE SECTION.
002900
003000     COPY "FDVND04.CBL".
003100
003200     COPY "FDVOUCH.CBL".
003300
003400     COPY "FDCONTRL.CBL".
003500
003600 WORKING-STORAGE SECTION.
003700
003800 77  WHICH-FIELD                  PIC 9.
003900 77  OK-TO-PROCESS                PIC X.
004000 77  FULL-PAYMENT                 PIC X.
004100 77  NEW-VOUCHER                  PIC X.
004200
004300 77  VOUCHER-RECORD-FOUND         PIC X.
004400 77  VENDOR-RECORD-FOUND          PIC X.
004500 77  CONTROL-RECORD-FOUND         PIC X.
004600 77  VOUCHER-NUMBER-FIELD         PIC Z(5).
004700 77  AN-AMOUNT-FIELD              PIC ZZZ,ZZ9.99-.
004800 77  CHECK-NO-FIELD               PIC Z(6).
004900
005000 77  PROCESS-MESSAGE              PIC X(79) VALUE SPACE.
005100
005200 77  SAVE-VOUCHER-RECORD          PIC X(103).
005300
005400     COPY "WSDATE01.CBL".
005500
005600     COPY "WSCASE01.CBL".
005700
005800 PROCEDURE DIVISION.
005900 PROGRAM-BEGIN.
006000     PERFORM OPENING-PROCEDURE.
006100     PERFORM MAIN-PROCESS.
006200     PERFORM CLOSING-PROCEDURE.
006300
006400 PROGRAM-EXIT.
006500     EXIT PROGRAM.
006600
006700 PROGRAM-DONE.
006800     STOP RUN.
006900
007000 OPENING-PROCEDURE.
007100     OPEN I-O VOUCHER-FILE.
007200     OPEN I-O VENDOR-FILE.
007300     OPEN I-O CONTROL-FILE.
007400
007500 CLOSING-PROCEDURE.
007600     CLOSE VOUCHER-FILE.
007700     CLOSE VENDOR-FILE.
007800     CLOSE CONTROL-FILE.
007900
008000 MAIN-PROCESS.
008100     PERFORM CHANGE-MODE.
008200
008300*--------------------------------
008400* CHANGE
008500*--------------------------------
008600 CHANGE-MODE.
008700     PERFORM GET-EXISTING-RECORD.
008800     PERFORM CHANGE-RECORDS
008900        UNTIL VOUCHER-NUMBER = ZEROES.
009000
009100 CHANGE-RECORDS.
009200     PERFORM DISPLAY-ALL-FIELDS.
009300     IF VOUCHER-PAID-DATE = ZEROES
009400         PERFORM CHANGE-TO-PAID
009500     ELSE
009600         PERFORM CHANGE-TO-UNPAID.
009700
009800     PERFORM GET-EXISTING-RECORD.
009900
010000*--------------------------------
010100* Ask if the user wants to pay this
010200* voucher and if so:
010300* Change the voucher to paid status
010400* by getting PAID-DATE, PAID-AMOUNT
010500* and CHECK-NO.
010600*--------------------------------
010700 CHANGE-TO-PAID.
010800     PERFORM ASK-OK-TO-PAY.
010900     IF OK-TO-PROCESS = "Y"
011000         PERFORM CHANGE-ALL-FIELDS.
011100
011200 ASK-OK-TO-PAY.
011300     MOVE "PROCESS THIS VOUCHER AS PAID (Y/N)?"
011400         TO PROCESS-MESSAGE.
011500     PERFORM ASK-OK-TO-PROCESS.
011600
011700 CHANGE-ALL-FIELDS.
011800     PERFORM CHANGE-THIS-FIELD
011900         VARYING WHICH-FIELD FROM 1 BY 1
012000          UNTIL WHICH-FIELD > 3.
012100
012200     PERFORM REWRITE-VOUCHER-RECORD.
012300
012400     IF NEW-VOUCHER = "Y"
012500         PERFORM GENERATE-NEW-VOUCHER.
012600
012700 CHANGE-THIS-FIELD.
012800     IF WHICH-FIELD = 1
012900         PERFORM ENTER-VOUCHER-PAID-DATE.
013000     IF WHICH-FIELD = 2
013100         PERFORM ENTER-VOUCHER-PAYMENT.
013200     IF WHICH-FIELD = 3
013300         PERFORM ENTER-VOUCHER-CHECK-NO.
013400
013500*--------------------------------
013600* Ask if the user wants to re-open
013700* this voucher and if so:
013800* Move zeroes to PAID-DATE,
013900* PAID-AMOUNT and CHECK-NO.
014000*--------------------------------
014100 CHANGE-TO-UNPAID.
014200     PERFORM ASK-OK-TO-OPEN.
014300     IF OK-TO-PROCESS = "Y"
014400         PERFORM CLEAR-PAID-AND-REWRITE
014500         DISPLAY "VOUCHER HAS BEEN REOPENED".
014600
014700 CLEAR-PAID-AND-REWRITE.
014800     PERFORM CLEAR-PAID-FIELDS.
014900     PERFORM REWRITE-VOUCHER-RECORD.
015000
015100 CLEAR-PAID-FIELDS.
015200     MOVE ZEROES TO VOUCHER-PAID-DATE
015300                    VOUCHER-PAID-AMOUNT
015400                    VOUCHER-CHECK-NO.
015500
015600 ASK-OK-TO-OPEN.
015700     MOVE "RE-OPEN THIS VOUCHER (Y/N)?" TO PROCESS-MESSAGE.
015800     PERFORM ASK-OK-TO-PROCESS.
015900
016000*--------------------------------
016100* This routine is used by both
016200* ASK-OK-TO-PAY which is part of
016300* the CHANGE-TO-PAID logic, and
016400* ASK-OK-TO-OPEN which is part
016500* of the CHANGE-TO-UNPAID LOGIC.
016600*--------------------------------
016700 ASK-OK-TO-PROCESS.
016800     PERFORM ACCEPT-OK-TO-PROCESS.
016900
017000     PERFORM RE-ACCEPT-OK-TO-PROCESS
017100        UNTIL OK-TO-PROCESS = "Y" OR "N".
017200
017300 ACCEPT-OK-TO-PROCESS.
017400     DISPLAY PROCESS-MESSAGE.
017500     ACCEPT OK-TO-PROCESS.
017600     INSPECT OK-TO-PROCESS
017700      CONVERTING LOWER-ALPHA TO UPPER-ALPHA.
017800
017900 RE-ACCEPT-OK-TO-PROCESS.
018000     DISPLAY "YOU MUST ENTER YES OR NO".
018100     PERFORM ACCEPT-OK-TO-PROCESS.
018200
018300*--------------------------------
018400* Field entry routines.
018500*--------------------------------
018600 ENTER-VOUCHER-PAID-DATE.
018700     MOVE "N" TO ZERO-DATE-IS-OK.
018800     MOVE "ENTER PAID DATE(MM/DD/YYYY)?"
018900            TO DATE-PROMPT.
019000     MOVE "A VALID PAID DATE IS REQUIRED"
019100            TO DATE-ERROR-MESSAGE.
019200     PERFORM GET-A-DATE.
019300     MOVE DATE-CCYYMMDD TO VOUCHER-PAID-DATE.
019400
019500*--------------------------------
019600* Voucher payment is entered by
019700* asking if the payment is for the
019800* the exact amount of the voucher.
019900* If it is, VOUCHER-AMOUNT is
020000* moved in to VOUCHER-PAID-AMOUNT.
020100* If it is not, then the user is
020200* asked to enter the amount
020300* to be paid.
020400* If the paid amount is less than
020500* the voucher amount, the user
020600* is also asked if a new voucher
020700* should be generated for the
020800* the balance. This allows
020900* for partial payments.
021000*--------------------------------
021100 ENTER-VOUCHER-PAYMENT.
021200     MOVE "N" TO NEW-VOUCHER.
021300     PERFORM ASK-FULL-PAYMENT.
021400     IF FULL-PAYMENT = "Y"
021500         MOVE VOUCHER-AMOUNT TO VOUCHER-PAID-AMOUNT
021600     ELSE
021700         PERFORM ENTER-VOUCHER-PAID-AMOUNT
021800         IF VOUCHER-PAID-AMOUNT < VOUCHER-AMOUNT
021900             PERFORM ASK-NEW-VOUCHER.
022000
022100 ASK-FULL-PAYMENT.
022200     PERFORM ACCEPT-FULL-PAYMENT.
022300     PERFORM RE-ACCEPT-FULL-PAYMENT
022400        UNTIL FULL-PAYMENT = "Y" OR "N".
022500
022600 ACCEPT-FULL-PAYMENT.
022700     MOVE VOUCHER-AMOUNT TO AN-AMOUNT-FIELD.
022800     DISPLAY "PAY THE EXACT AMOUNT "
022900             AN-AMOUNT-FIELD
023000             " (Y/N)?".
023100     ACCEPT FULL-PAYMENT.
023200     INSPECT FULL-PAYMENT
023300      CONVERTING LOWER-ALPHA TO UPPER-ALPHA.
023400
023500 RE-ACCEPT-FULL-PAYMENT.
023600     DISPLAY "YOU MUST ENTER YES OR NO".
023700     PERFORM ACCEPT-FULL-PAYMENT.
023800
023900 ASK-NEW-VOUCHER.
024000     PERFORM ACCEPT-NEW-VOUCHER.
024100     PERFORM RE-ACCEPT-NEW-VOUCHER
024200        UNTIL NEW-VOUCHER = "Y" OR "N".
024300
024400 ACCEPT-NEW-VOUCHER.
024500     MOVE VOUCHER-AMOUNT TO AN-AMOUNT-FIELD.
024600     DISPLAY "GENERATE A NEW VOUCHER".
024700     DISPLAY " FOR THE BALANCE (Y/N)?".
024800     ACCEPT NEW-VOUCHER.
024900     INSPECT NEW-VOUCHER
025000      CONVERTING LOWER-ALPHA TO UPPER-ALPHA.
025100
025200 RE-ACCEPT-NEW-VOUCHER.
025300     DISPLAY "YOU MUST ENTER YES OR NO".
025400     PERFORM ACCEPT-NEW-VOUCHER.
025500
025600 ENTER-VOUCHER-PAID-AMOUNT.
025700     PERFORM ACCEPT-VOUCHER-PAID-AMOUNT.
025800     PERFORM RE-ACCEPT-VOUCHER-PAID-AMOUNT
025900         UNTIL VOUCHER-PAID-AMOUNT NOT = ZEROES.
026000
026100
026200 ACCEPT-VOUCHER-PAID-AMOUNT.
026300     DISPLAY "ENTER AMOUNT PAID".
026400     ACCEPT AN-AMOUNT-FIELD.
026500     MOVE AN-AMOUNT-FIELD TO VOUCHER-PAID-AMOUNT.
026600
026700 RE-ACCEPT-VOUCHER-PAID-AMOUNT.
026800     MOVE VOUCHER-AMOUNT TO AN-AMOUNT-FIELD.
026900     DISPLAY "A PAYMENT MUST BE ENTERED".
027000     DISPLAY "AGAINST " AN-AMOUNT-FIELD.
027100     PERFORM ACCEPT-VOUCHER-PAID-AMOUNT.
027200
027300 ENTER-VOUCHER-CHECK-NO.
027400     PERFORM ACCEPT-VOUCHER-CHECK-NO.
027500
027600 ACCEPT-VOUCHER-CHECK-NO.
027700     DISPLAY "ENTER THE CHECK NUMBER".
027800     DISPLAY "ENTER 0 FOR CASH PAYMENT".
027900     ACCEPT CHECK-NO-FIELD.
028000     MOVE CHECK-NO-FIELD TO VOUCHER-CHECK-NO.
028100
028200*--------------------------------
028300* A new voucher is generated by
028400* 1. Saving the existing voucher
028500*    record.
028600* 2. Locating a new voucher number
028700*    that is not in use by using
028800*    the control file and attempting
028900*    to read a voucher with the
029000*    number offered by the control
029100*    file.
029200* 3. Restoring the saved voucher record
029300*    but using the new voucher number.
029400* 4. Setting the new voucher amount
029500*    to the original amount minus
029600*    the amount paid.
029700* 5. Resetting the paid date,
029800*    paid amount and check number
029900* 6. Setting the selected flag to "N".
030000* 7. Writing this new record.
030100*--------------------------------
030200 GENERATE-NEW-VOUCHER.
030300     MOVE VOUCHER-RECORD TO SAVE-VOUCHER-RECORD.
030400     PERFORM GET-NEW-RECORD-KEY.
030500     PERFORM CREATE-NEW-VOUCHER-RECORD.
030600     PERFORM DISPLAY-NEW-VOUCHER.
030700
030800 CREATE-NEW-VOUCHER-RECORD.
030900     MOVE SAVE-VOUCHER-RECORD TO VOUCHER-RECORD.
031000     MOVE CONTROL-LAST-VOUCHER TO VOUCHER-NUMBER.
031100     SUBTRACT VOUCHER-PAID-AMOUNT FROM VOUCHER-AMOUNT.
031200     MOVE "N" TO VOUCHER-SELECTED.
031300     PERFORM CLEAR-PAID-FIELDS.
031400     PERFORM WRITE-VOUCHER-RECORD.
031500
031600 DISPLAY-NEW-VOUCHER.
031700     MOVE VOUCHER-NUMBER TO VOUCHER-NUMBER-FIELD.
031800     MOVE VOUCHER-AMOUNT TO AN-AMOUNT-FIELD.
031900     DISPLAY "VOUCHER " VOUCHER-NUMBER-FIELD
032000             " CREATED FOR " AN-AMOUNT-FIELD.
032100
032200*--------------------------------
032300* Standard change mode routines to
032400* get a voucher number, read the
032500* voucher record.
032600*--------------------------------
032700 GET-NEW-RECORD-KEY.
032800     PERFORM ACCEPT-NEW-RECORD-KEY.
032900     PERFORM RE-ACCEPT-NEW-RECORD-KEY
033000         UNTIL VOUCHER-RECORD-FOUND = "N".
033100
033200
033300
033400 ACCEPT-NEW-RECORD-KEY.
033500     PERFORM INIT-VOUCHER-RECORD.
033600     PERFORM RETRIEVE-NEXT-VOUCHER-NUMBER.
033700
033800     PERFORM READ-VOUCHER-RECORD.
033900
034000 RE-ACCEPT-NEW-RECORD-KEY.
034100     PERFORM ACCEPT-NEW-RECORD-KEY.
034200
034300 RETRIEVE-NEXT-VOUCHER-NUMBER.
034400     PERFORM READ-CONTROL-RECORD.
034500     ADD 1 TO CONTROL-LAST-VOUCHER.
034600     MOVE CONTROL-LAST-VOUCHER TO VOUCHER-NUMBER.
034700     PERFORM REWRITE-CONTROL-RECORD.
034800
034900 GET-EXISTING-RECORD.
035000     PERFORM ACCEPT-EXISTING-KEY.
035100     PERFORM RE-ACCEPT-EXISTING-KEY
035200         UNTIL VOUCHER-RECORD-FOUND = "Y" OR
035300               VOUCHER-NUMBER = ZEROES.
035400
035500 ACCEPT-EXISTING-KEY.
035600     PERFORM INIT-VOUCHER-RECORD.
035700     PERFORM ENTER-VOUCHER-NUMBER.
035800     IF VOUCHER-NUMBER NOT = ZEROES
035900         PERFORM READ-VOUCHER-RECORD.
036000
036100 RE-ACCEPT-EXISTING-KEY.
036200     DISPLAY "RECORD NOT FOUND".
036300     PERFORM ACCEPT-EXISTING-KEY.
036400
036500 ENTER-VOUCHER-NUMBER.
036600     DISPLAY "ENTER VOUCHER NUMBER TO PROCESS".
036700     ACCEPT VOUCHER-NUMBER.
036800
036900*--------------------------------
037000* Standard routines to display
037100* voucher fields.
037200*--------------------------------
037300 DISPLAY-ALL-FIELDS.
037400     DISPLAY " ".
037500     PERFORM DISPLAY-VOUCHER-NUMBER.
037600     PERFORM DISPLAY-VOUCHER-VENDOR.
037700     PERFORM DISPLAY-VOUCHER-INVOICE.
037800     PERFORM DISPLAY-VOUCHER-FOR.
037900     PERFORM DISPLAY-VOUCHER-AMOUNT.
038000     PERFORM DISPLAY-VOUCHER-DATE.
038100     PERFORM DISPLAY-VOUCHER-DUE.
038200     PERFORM DISPLAY-VOUCHER-DEDUCTIBLE.
038300     PERFORM DISPLAY-VOUCHER-SELECTED.
038400     PERFORM DISPLAY-VOUCHER-PAID-DATE.
038500     PERFORM DISPLAY-VOUCHER-PAID-AMOUNT.
038600     PERFORM DISPLAY-VOUCHER-CHECK-NO.
038700     DISPLAY " ".
038800
038900 DISPLAY-VOUCHER-NUMBER.
039000     DISPLAY "   VOUCHER NUMBER: " VOUCHER-NUMBER.
039100
039200 DISPLAY-VOUCHER-VENDOR.
039300     PERFORM VOUCHER-VENDOR-ON-FILE.
039400     IF VENDOR-RECORD-FOUND = "N"
039500         MOVE "**Not found**" TO VENDOR-NAME.
039600     DISPLAY "   VENDOR: "
039700             VOUCHER-VENDOR " "
039800             VENDOR-NAME.
039900
040000 DISPLAY-VOUCHER-INVOICE.
040100     DISPLAY "   INVOICE: " VOUCHER-INVOICE.
040200
040300 DISPLAY-VOUCHER-FOR.
040400     DISPLAY "   FOR: " VOUCHER-FOR.
040500
040600 DISPLAY-VOUCHER-AMOUNT.
040700     MOVE VOUCHER-AMOUNT TO AN-AMOUNT-FIELD.
040800     DISPLAY "   AMOUNT: " AN-AMOUNT-FIELD.
040900
041000 DISPLAY-VOUCHER-DATE.
041100     MOVE VOUCHER-DATE TO DATE-CCYYMMDD.
041200     PERFORM FORMAT-THE-DATE.
041300     DISPLAY "   INVOICE DATE: " FORMATTED-DATE.
041400
041500 DISPLAY-VOUCHER-DUE.
041600     MOVE VOUCHER-DUE TO DATE-CCYYMMDD.
041700     PERFORM FORMAT-THE-DATE.
041800     DISPLAY "   DUE DATE: " FORMATTED-DATE.
041900
042000 DISPLAY-VOUCHER-DEDUCTIBLE.
042100     DISPLAY "   DEDUCTIBLE: " VOUCHER-DEDUCTIBLE.
042200
042300 DISPLAY-VOUCHER-SELECTED.
042400     DISPLAY "   SELECTED FOR PAYMENT: " VOUCHER-SELECTED.
042500
042600 DISPLAY-VOUCHER-PAID-DATE.
042700     MOVE VOUCHER-PAID-DATE TO DATE-CCYYMMDD.
042800     PERFORM FORMAT-THE-DATE.
042900     DISPLAY "1. PAID ON: " FORMATTED-DATE.
043000
043100 DISPLAY-VOUCHER-PAID-AMOUNT.
043200     MOVE VOUCHER-PAID-AMOUNT TO AN-AMOUNT-FIELD.
043300     DISPLAY "2. PAID: " AN-AMOUNT-FIELD.
043400
043500 DISPLAY-VOUCHER-CHECK-NO.
043600     DISPLAY "3. CHECK: " VOUCHER-CHECK-NO.
043700
043800*--------------------------------
043900* File activity Routines
044000*--------------------------------
044100 INIT-VOUCHER-RECORD.
044200     MOVE SPACE TO VOUCHER-INVOICE
044300                   VOUCHER-FOR
044400                   VOUCHER-DEDUCTIBLE
044500                   VOUCHER-SELECTED.
044600     MOVE ZEROES TO VOUCHER-NUMBER
044700                    VOUCHER-VENDOR
044800                    VOUCHER-AMOUNT
044900                    VOUCHER-DATE
045000                    VOUCHER-DUE
045100                    VOUCHER-PAID-AMOUNT
045200                    VOUCHER-PAID-DATE
045300                    VOUCHER-CHECK-NO.
045400
045500 READ-VOUCHER-RECORD.
045600     MOVE "Y" TO VOUCHER-RECORD-FOUND.
045700     READ VOUCHER-FILE RECORD
045800       INVALID KEY
045900          MOVE "N" TO VOUCHER-RECORD-FOUND.
046000
046100*or  READ VOUCHER-FILE RECORD WITH LOCK
046200*      INVALID KEY
046300*         MOVE "N" TO VOUCHER-RECORD-FOUND.
046400
046500*or  READ VOUCHER-FILE RECORD WITH HOLD
046600*      INVALID KEY
046700*         MOVE "N" TO VOUCHER-RECORD-FOUND.
046800
046900 WRITE-VOUCHER-RECORD.
047000     WRITE VOUCHER-RECORD
047100         INVALID KEY
047200         DISPLAY "RECORD ALREADY ON FILE".
047300
047400 REWRITE-VOUCHER-RECORD.
047500     REWRITE VOUCHER-RECORD
047600         INVALID KEY
047700         DISPLAY "ERROR REWRITING VENDOR RECORD".
047800
047900 VOUCHER-VENDOR-ON-FILE.
048000     MOVE VOUCHER-VENDOR TO VENDOR-NUMBER.
048100     PERFORM READ-VENDOR-RECORD.
048200
048300 READ-VENDOR-RECORD.
048400     MOVE "Y" TO VENDOR-RECORD-FOUND.
048500     READ VENDOR-FILE RECORD
048600       INVALID KEY
048700          MOVE "N" TO VENDOR-RECORD-FOUND.
048800
048900 READ-CONTROL-RECORD.
049000     MOVE 1 TO CONTROL-KEY.
049100     MOVE "Y" TO CONTROL-RECORD-FOUND.
049200     READ CONTROL-FILE RECORD
049300         INVALID KEY
049400          MOVE "N" TO CONTROL-RECORD-FOUND
049500          DISPLAY "CONTROL FILE IS INVALID".
049600
049700 REWRITE-CONTROL-RECORD.
049800     REWRITE CONTROL-RECORD
049900         INVALID KEY
050000         DISPLAY "ERROR REWRITING CONTROL RECORD".
050100
050200*--------------------------------
050300* General utility routines
050400*--------------------------------
050500     COPY "PLDATE01.CBL".
050600

The output of vchpay02.cbl allows overpayment:

OUTPUT:

ENTER VOUCHER NUMBER TO PROCESS
2

VOUCHER NUMBER: 00002
VENDOR: 00002 ABC PRINTING
INVOICE: CX-1407
FOR: BUSINESS CARDS
AMOUNT:      98.97
INVOICE DATE:  1/22/1994
DUE DATE:  2/22/1994
DEDUCTIBLE: Y
SELECTED FOR PAYMENT: N
1. PAID ON:  0/00/0000
2. PAID:       0.00
3. CHECK: 000000

PROCESS THIS VOUCHER AS PAID (Y/N)?
y
ENTER PAID DATE(MM/DD/YYYY)?
01/27/1994
PAY THE EXACT AMOUNT      98.97  (Y/N)?
n
ENTER AMOUNT PAID
105
ENTER THE CHECK NUMBER
ENTER 0 FOR CASH PAYMENT
207
ENTER VOUCHER NUMBER TO PROCESS
2

VOUCHER NUMBER: 00002
VENDOR: 00002 ABC PRINTING
INVOICE: CX-1407
FOR: BUSINESS CARDS
AMOUNT:      98.97
INVOICE DATE:  1/22/1994
DUE DATE:  2/22/1994
DEDUCTIBLE: Y
SELECTED FOR PAYMENT: N
1. PAID ON:  1/27/1994
2. PAID:     105.00
3. CHECK: 000207

RE-OPEN THIS VOUCHER (Y/N)?

Answers to Day 21, "Selecting, Sorting, and Reporting"

Quiz

1. The SORT command is used to sort a file on a field that is not a key to the file.

2. b. Closed.

Exercises

1. Listing A.42 is deduct01.cbl, a report on paid bills that are tax-deductible.

TYPE: Listing A.42. Deductibles report.

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. DEDUCT01.
000300*--------------------------------
000400* Deductibles Report
000500*--------------------------------
000600 ENVIRONMENT DIVISION.
000700 INPUT-OUTPUT SECTION.
000800 FILE-CONTROL.
000900
001000     COPY "SLVOUCH.CBL".
001100
001200     COPY "SLVND02.CBL".
001300
001400     COPY "SLSTATE.CBL".
001500
001600     SELECT WORK-FILE
001700         ASSIGN TO "WORK"
001800         ORGANIZATION IS SEQUENTIAL.
001900
002000     SELECT SORT-FILE
002100         ASSIGN TO "SORT".
002200
002300     SELECT PRINTER-FILE
002400         ASSIGN TO PRINTER
002500         ORGANIZATION IS LINE SEQUENTIAL.
002600
002700 DATA DIVISION.
002800 FILE SECTION.
002900
003000     COPY "FDVOUCH.CBL".
003100
003200     COPY "FDVND04.CBL".
003300
003400     COPY "FDSTATE.CBL".
003500
003600 FD  WORK-FILE
003700     LABEL RECORDS ARE STANDARD.
003800 01  WORK-RECORD.
003900     05  WORK-NUMBER           PIC 9(5).
004000     05  WORK-VENDOR           PIC 9(5).
004100     05  WORK-INVOICE          PIC X(15).
004200     05  WORK-FOR              PIC X(30).
004300     05  WORK-AMOUNT           PIC S9(6)V99.
004400     05  WORK-DATE             PIC 9(8).
004500     05  WORK-DUE              PIC 9(8).
004600     05  WORK-DEDUCTIBLE       PIC X.
004700     05  WORK-SELECTED         PIC X.
004800     05  WORK-PAID-AMOUNT      PIC S9(6)V99.
004900     05  WORK-PAID-DATE        PIC 9(8).
005000     05  WORK-CHECK-NO         PIC 9(6).
005100
005200 SD  SORT-FILE.
005300
005400 01  SORT-RECORD.
005500     05  SORT-NUMBER           PIC 9(5).
005600     05  SORT-VENDOR           PIC 9(5).
005700     05  SORT-INVOICE          PIC X(15).
005800     05  SORT-FOR              PIC X(30).
005900     05  SORT-AMOUNT           PIC S9(6)V99.
006000     05  SORT-DATE             PIC 9(8).
006100     05  SORT-DUE              PIC 9(8).
006200     05  SORT-DEDUCTIBLE       PIC X.
006300     05  SORT-SELECTED         PIC X.
006400     05  SORT-PAID-AMOUNT      PIC S9(6)V99.
006500     05  SORT-PAID-DATE        PIC 9(8).
006600     05  SORT-CHECK-NO         PIC 9(6).
006700
006800 FD  PRINTER-FILE
006900     LABEL RECORDS ARE OMITTED.
007000 01  PRINTER-RECORD             PIC X(80).
007100
007200 WORKING-STORAGE SECTION.
007300
007400 77  OK-TO-PROCESS         PIC X.
007500
007600     COPY "WSCASE01.CBL".
007700
007800 01  DETAIL-LINE.
007900     05  PRINT-NUMBER      PIC ZZZZ9.
008000     05  FILLER            PIC X(3) VALUE SPACE.
008100     05  PRINT-NAME        PIC X(30).
008200     05  FILLER            PIC X(1) VALUE SPACE.
008300     05  PRINT-DUE-DATE    PIC Z9/99/9999.
008400     05  FILLER            PIC X(1) VALUE SPACE.
008500     05  PRINT-AMOUNT      PIC ZZZ,ZZ9.99.
008600     05  FILLER            PIC X(1) VALUE SPACE.
008700     05  PRINT-INVOICE     PIC X(15).
008800
008900 01  TOTAL-THRU.
009000     05  FILLER            PIC X(20) VALUE SPACE.
009100     05  FILLER            PIC X(10) VALUE "TOTAL THRU".
009200
009300 01  COLUMN-LINE.
009400     05  FILLER         PIC X(7)  VALUE "VOUCHER".
009500     05  FILLER         PIC X(1)  VALUE SPACE.
009600     05  FILLER         PIC X(10) VALUE "VENDOR/For".
009700     05  FILLER         PIC X(23) VALUE SPACE.
009800     05  FILLER         PIC X(8)  VALUE "DATE".
009900     05  FILLER         PIC X(1)  VALUE SPACE.
010000     05  FILLER         PIC X(10) VALUE "    AMOUNT".
010100     05  FILLER         PIC X(1)  VALUE SPACE.
010200     05  FILLER         PIC X(7)  VALUE "INVOICE".
010300
010400 01  TITLE-LINE.
010500     05  FILLER              PIC X(31) VALUE SPACE.
010600     05  FILLER              PIC X(11)
010700         VALUE "DEDUCTIBLES".
010800     05  FILLER              PIC X(19) VALUE SPACE.
010900     05  FILLER              PIC X(5) VALUE "PAGE:".
011000     05  FILLER              PIC X(1) VALUE SPACE.
011100     05  PRINT-PAGE-NUMBER   PIC ZZZ9.
011200
011300 77  WORK-FILE-AT-END     PIC X.
011400 77  VENDOR-RECORD-FOUND     PIC X.
011500
011600 77  LINE-COUNT              PIC 999 VALUE ZERO.
011700 77  PAGE-NUMBER             PIC 9999 VALUE ZERO.
011800 77  MAXIMUM-LINES           PIC 999 VALUE 55.
011900
012000 77  RECORD-COUNT            PIC 9999 VALUE ZEROES.
012100
012200 77  SAVE-PAID-DATE          PIC 9(8).
012300
012400 77  RUNNING-TOTAL           PIC S9(6)V99.
012500
012600     COPY "WSDATE01.CBL".
012700
012800 PROCEDURE DIVISION.
012900 PROGRAM-BEGIN.
013000
013100     PERFORM OPENING-PROCEDURE.
013200     PERFORM MAIN-PROCESS.
013300     PERFORM CLOSING-PROCEDURE.
013400
013500 PROGRAM-EXIT.
013600     EXIT PROGRAM.
013700
013800 PROGRAM-DONE.
013900     STOP RUN.
014000
014100 OPENING-PROCEDURE.
014200     OPEN I-O VENDOR-FILE.
014300
014400     OPEN OUTPUT PRINTER-FILE.
014500
014600 MAIN-PROCESS.
014700     PERFORM GET-OK-TO-PROCESS.
014800     IF OK-TO-PROCESS = "Y"
014900         PERFORM SORT-DATA-FILE
015000         PERFORM PRINT-THE-REPORT.
015100
015200 CLOSING-PROCEDURE.
015300     CLOSE VENDOR-FILE.
015400     PERFORM END-LAST-PAGE.
015500     CLOSE PRINTER-FILE.
015600
015700 GET-OK-TO-PROCESS.
015800     PERFORM ACCEPT-OK-TO-PROCESS.
015900     PERFORM RE-ACCEPT-OK-TO-PROCESS
016000         UNTIL OK-TO-PROCESS = "Y" OR "N".
016100
016200 ACCEPT-OK-TO-PROCESS.
016300     DISPLAY "PRINT DEDUCTIBLES REPORT (Y/N)?".
016400     ACCEPT OK-TO-PROCESS.
016500     INSPECT OK-TO-PROCESS
016600       CONVERTING LOWER-ALPHA
016700       TO         UPPER-ALPHA.
016800
016900 RE-ACCEPT-OK-TO-PROCESS.
017000     DISPLAY "YOU MUST ENTER YES OR NO".
017100     PERFORM ACCEPT-OK-TO-PROCESS.
017200
017300*--------------------------------
017400* Sorting logic
017500*--------------------------------
017600 SORT-DATA-FILE.
017700     SORT SORT-FILE
017800         ON ASCENDING KEY SORT-PAID-DATE
017900          USING VOUCHER-FILE
018000          GIVING WORK-FILE.
018100
018200 PRINT-THE-REPORT.
018300     OPEN INPUT WORK-FILE.
018400     PERFORM START-ONE-REPORT.
018500     PERFORM PROCESS-VOUCHERS.
018600     PERFORM END-ONE-REPORT.
018700     CLOSE WORK-FILE.
018800
018900 START-ONE-REPORT.
019000     PERFORM INITIALIZE-REPORT.
019100     PERFORM START-NEW-PAGE.
019200     MOVE ZEROES TO RUNNING-TOTAL.
019300
019400 INITIALIZE-REPORT.
019500     MOVE ZEROES TO LINE-COUNT PAGE-NUMBER.
019600
019700 END-ONE-REPORT.
019800     IF RECORD-COUNT = ZEROES
019900         MOVE "NO RECORDS FOUND" TO PRINTER-RECORD
020000         PERFORM WRITE-TO-PRINTER.
020100
020200 PROCESS-VOUCHERS.
020300     PERFORM READ-FIRST-VALID-WORK.
020400     PERFORM PROCESS-ALL-DATES
020500         UNTIL WORK-FILE-AT-END = "Y".
020600
020700 PROCESS-ALL-DATES.
020800     PERFORM START-ONE-DATE.
020900
021000     PERFORM PROCESS-ALL-VOUCHERS
021100         UNTIL WORK-FILE-AT-END = "Y"
021200            OR WORK-PAID-DATE NOT = SAVE-PAID-DATE.
021300
021400     PERFORM END-ONE-DATE.
021500
021600 START-ONE-DATE.
021700     MOVE WORK-PAID-DATE TO SAVE-PAID-DATE.
021800
021900 END-ONE-DATE.
022000     PERFORM PRINT-RUNNING-TOTAL.
022100
022200 PRINT-RUNNING-TOTAL.
022300     MOVE SPACE TO DETAIL-LINE.
022400     MOVE SAVE-PAID-DATE TO DATE-CCYYMMDD.
022500     PERFORM CONVERT-TO-MMDDCCYY.
022600     MOVE DATE-MMDDCCYY TO PRINT-DUE-DATE.
022700     MOVE RUNNING-TOTAL TO PRINT-AMOUNT.
022800     MOVE TOTAL-THRU TO PRINT-NAME.
022900     MOVE DETAIL-LINE TO PRINTER-RECORD.
023000     PERFORM WRITE-TO-PRINTER.
023100     PERFORM LINE-FEED 2 TIMES.
023200
023300 PROCESS-ALL-VOUCHERS.
023400     PERFORM PROCESS-THIS-VOUCHER.
023500     PERFORM READ-NEXT-VALID-WORK.
023600
023700 PROCESS-THIS-VOUCHER.
023800     ADD 1 TO RECORD-COUNT.
023900     IF LINE-COUNT > MAXIMUM-LINES
024000         PERFORM START-NEXT-PAGE.
024100     PERFORM PRINT-THE-RECORD.
024200     ADD WORK-PAID-AMOUNT TO RUNNING-TOTAL.
024300
024400 PRINT-THE-RECORD.
024500     PERFORM PRINT-LINE-1.
024600     PERFORM PRINT-LINE-2.
024700     PERFORM LINE-FEED.
024800
024900 PRINT-LINE-1.
025000     MOVE SPACE TO DETAIL-LINE.
025100     MOVE WORK-NUMBER TO PRINT-NUMBER.
025200
025300     MOVE WORK-VENDOR TO VENDOR-NUMBER.
025400     PERFORM READ-VENDOR-RECORD.
025500     IF VENDOR-RECORD-FOUND = "Y"
025600         MOVE VENDOR-NAME TO PRINT-NAME
025700     ELSE
025800         MOVE "*VENDOR NOT ON FILE*" TO PRINT-NAME.
025900
026000     MOVE WORK-PAID-DATE TO DATE-CCYYMMDD.
026100     PERFORM CONVERT-TO-MMDDCCYY.
026200     MOVE DATE-MMDDCCYY TO PRINT-DUE-DATE.
026300
026400     MOVE WORK-PAID-AMOUNT TO PRINT-AMOUNT.
026500     MOVE WORK-INVOICE TO PRINT-INVOICE.
026600
026700     MOVE DETAIL-LINE TO PRINTER-RECORD.
026800     PERFORM WRITE-TO-PRINTER.
026900
027000 PRINT-LINE-2.
027100     MOVE SPACE TO DETAIL-LINE.
027200     MOVE WORK-FOR TO PRINT-NAME.
027300     MOVE DETAIL-LINE TO PRINTER-RECORD.
027400     PERFORM WRITE-TO-PRINTER.
027500
027600 WRITE-TO-PRINTER.
027700     WRITE PRINTER-RECORD BEFORE ADVANCING 1.
027800     ADD 1 TO LINE-COUNT.
027900
028000 LINE-FEED.
028100     MOVE SPACE TO PRINTER-RECORD.
028200     PERFORM WRITE-TO-PRINTER.
028300
028400 START-NEXT-PAGE.
028500     PERFORM END-LAST-PAGE.
028600     PERFORM START-NEW-PAGE.
028700
028800 START-NEW-PAGE.
028900     ADD 1 TO PAGE-NUMBER.
029000     MOVE PAGE-NUMBER TO PRINT-PAGE-NUMBER.
029100     MOVE TITLE-LINE TO PRINTER-RECORD.
029200     PERFORM WRITE-TO-PRINTER.
029300     PERFORM LINE-FEED.
029400     MOVE COLUMN-LINE TO PRINTER-RECORD.
029500     PERFORM WRITE-TO-PRINTER.
029600     PERFORM LINE-FEED.
029700
029800 END-LAST-PAGE.
029900     PERFORM FORM-FEED.
030000     MOVE ZERO TO LINE-COUNT.
030100
030200 FORM-FEED.
030300     MOVE SPACE TO PRINTER-RECORD.
030400     WRITE PRINTER-RECORD BEFORE ADVANCING PAGE.
030500
030600*--------------------------------
030700* Read first, read next routines
030800*--------------------------------
030900 READ-FIRST-VALID-WORK.
031000     PERFORM READ-NEXT-VALID-WORK.
031100
031200 READ-NEXT-VALID-WORK.
031300     PERFORM READ-NEXT-WORK-RECORD.
031400     PERFORM READ-NEXT-WORK-RECORD
031500         UNTIL WORK-FILE-AT-END = "Y"
031600            OR ( WORK-PAID-DATE NOT =  ZEROES AND
031700                 WORK-DEDUCTIBLE = "Y").
031800
031900 READ-NEXT-WORK-RECORD.
032000     MOVE "N" TO WORK-FILE-AT-END.
032100     READ WORK-FILE NEXT RECORD
032200         AT END MOVE "Y" TO WORK-FILE-AT-END.
032300
032400*--------------------------------
032500* Other File IO routines
032600*--------------------------------
032700 READ-VENDOR-RECORD.
032800     MOVE "Y" TO VENDOR-RECORD-FOUND.
032900     READ VENDOR-FILE RECORD
033000         INVALID KEY
033100         MOVE "N" TO VENDOR-RECORD-FOUND.
033200
033300*--------------------------------
033400* Utility Routines
033500*--------------------------------
033600     COPY "PLDATE01.CBL".
033700

2. The sample output of deduct01.cbl lists paid bills that were flagged as tax- deductible:

OUTPUT:

DEDUCTIBLES                   PAGE:    1

VOUCHER VENDOR/For                       DATE         AMOUNT INVOICE

2   ABC PRINTING                    1/27/1994     105.00 CX-1407
BUSINESS CARDS

11   ABC PRINTING                    1/27/1994      51.03 CX-1407
BUSINESS CARDS

12   ABC PRINTING                    1/27/1994       6.03 CX-1407
BUSINESS CARDS

TOTAL THRU  1/27/1994     162.06

3. Study the report from DEDUCT01. Frequently, an entry screen will be used to allow the user to print the same basic information in a variety of ways. For example, when the user runs a report program, the user could be asked SHOW ONLY UNPAID ITEMS (Y/N)? followed by SHOW ONLY DEDUCTIBLE ITEMS (Y/N)? After criteria such as these are added in to the report, the READ-NEXT-VALID logic can become complicated. In the following example, the next record is read and if no select criteria has been requested, the logic returns with the record just read. Otherwise, it tries to match one or the other of the selected criteria.

031200 READ-NEXT-VALID-WORK.
031300     PERFORM READ-NEXT-WORK-RECORD.
031400     IF SHOW-ONLY-UNPAID-ITEMS = "Y" OR
031500         SHOW-ONLY-DEDUCTIBLE-ITEMS = "Y"
031600         PERFORM READ-NEXT-WORK-RECORD
031700             UNTIL WORK-FILE-AT-END = "Y"
031800             OR ( WORK-PAID-DATE NOT =  ZEROES AND
031700                 SHOW-ONLY-UNPAID-ITEMS = "Y").
031900             OR ( WORK-DEDUCTIBLE = "Y" AND
032000                 SHOW-ONLY-DEDUCTIBLE = "Y").
032100

Answers to Bonus Day 1, "Control Breaks"

Quiz

1. A control break is a break inserted into the normal processing of a program (usually a report program) to cause groups of records to be processed together as one unit. The interruption of the normal printing of a report program to print a total or subtotal would be a control break or level break.

2. The control break field or control field is the field in the record that causes a control break to occur when the record changes.

3. The control break current value or control current value is a field created in WORKING-STORAGE that holds a copy of the control break field. The control break current value is filled in at the beginning of a control break level with the value in the control break field. As the processing continues, the control break field is compared to the control break current value to determine whether a control break has occurred.

4. Control break accumulators or control accumulators are variables used for summing or counting values within a control break.

5. A level 1 break varies from any other break because there is no true control break current value. The level 1 break starts at the beginning of the file and completes at the end of the file. The logic to start level 1 begins by executing a read-first valid record.

The end of a level 1 break does not add accumulators to the next higher level because there is no next higher level.

Exercises

1. Listing A.43 is slsrpt02.cbl, modified from slsrpt01.cbl. The lines that were moved have been commented out, and the changes are highlighted in the listing.

TYPE: Listing A.43. The changes needed to create `slsrpt02.cbl`.

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. SLSRPT02.
000300*--------------------------------
000400* Generate test sales data
000500*--------------------------------
000600 ENVIRONMENT DIVISION.
000700 INPUT-OUTPUT SECTION.
000800 FILE-CONTROL.
000900
001000*--------------------------------
001100* SLSALES.CBL
001200*--------------------------------
001300     SELECT SALES-FILE
001400         ASSIGN TO "SALES"
001500         ORGANIZATION IS SEQUENTIAL.
001600
001700     SELECT WORK-FILE
001800         ASSIGN TO "WORK"
001900         ORGANIZATION IS SEQUENTIAL.
002000
002100     SELECT SORT-FILE
002200         ASSIGN TO "SORT".
002300
002400     SELECT PRINTER-FILE
002500         ASSIGN TO PRINTER
002600         ORGANIZATION IS LINE SEQUENTIAL.
002700
002800 DATA DIVISION.
002900 FILE SECTION.
003000
003100*--------------------------------
003200* FDSALES.CBL
003300* Temporary daily sales file.
003400*--------------------------------
003500 FD  SALES-FILE
003600     LABEL RECORDS ARE STANDARD.
003700 01  SALES-RECORD.
003800     05  SALES-STORE              PIC 9(2).
003900     05  SALES-DIVISION           PIC 9(2).
004000     05  SALES-DEPARTMENT         PIC 9(2).
004100     05  SALES-CATEGORY           PIC 9(2).
004200     05  SALES-AMOUNT             PIC S9(6)V99.
004300
004400 FD  WORK-FILE
004500     LABEL RECORDS ARE STANDARD.
004600 01  WORK-RECORD.
004700     05  WORK-STORE              PIC 9(2).
004800     05  WORK-DIVISION           PIC 9(2).
004900     05  WORK-DEPARTMENT         PIC 9(2).
005000     05  WORK-CATEGORY           PIC 9(2).
005100     05  WORK-AMOUNT             PIC S9(6)V99.
005200
005300 SD  SORT-FILE
005400     LABEL RECORDS ARE STANDARD.
005500 01  SORT-RECORD.
005600     05  SORT-STORE              PIC 9(2).
005700     05  SORT-DIVISION           PIC 9(2).
005800     05  SORT-DEPARTMENT         PIC 9(2).
005900     05  SORT-CATEGORY           PIC 9(2).
006000     05  SORT-AMOUNT             PIC S9(6)V99.
006100
006200 FD  PRINTER-FILE
006300     LABEL RECORDS ARE OMITTED.
006400 01  PRINTER-RECORD              PIC X(80).
006500
006600 WORKING-STORAGE SECTION.
006700
006800 77  OK-TO-PROCESS         PIC X.
006900
007000     COPY "WSCASE01.CBL".
007100
007200 01  LEGEND-LINE.
007300     05  FILLER            PIC X(6) VALUE "STORE:".
007400     05  FILLER            PIC X(1) VALUE SPACE.
007500     05  PRINT-STORE       PIC Z9.
007600
007700 01  DETAIL-LINE.
007800     05  FILLER            PIC X(3) VALUE SPACE.
007900     05  PRINT-DIVISION    PIC Z9.
008000     05  FILLER            PIC X(4) VALUE SPACE.
008100     05  FILLER            PIC X(3) VALUE SPACE.
008200     05  PRINT-DEPARTMENT  PIC Z9.
008300     05  FILLER            PIC X(6) VALUE SPACE.
008400     05  FILLER            PIC X(3) VALUE SPACE.
008500     05  PRINT-CATEGORY    PIC Z9.
008600     05  FILLER            PIC X(4) VALUE SPACE.
008700     05  PRINT-AMOUNT      PIC ZZZ,ZZ9.99-.
008800
008900 01  COLUMN-LINE.
009000     05  FILLER         PIC X(8)  VALUE "DIVISION".
009100     05  FILLER         PIC X(1)  VALUE SPACE.
009200     05  FILLER         PIC X(10) VALUE "DEPARTMENT".
009300     05  FILLER         PIC X(1)  VALUE SPACE.
009400     05  FILLER         PIC X(8)  VALUE "CATEGORY".
009500     05  FILLER         PIC X(1)  VALUE SPACE.
009600     05  FILLER         PIC X(4)  VALUE SPACE.
009700     05  FILLER         PIC X(6)  VALUE "AMOUNT".
009800
009900 01  TITLE-LINE.
010000     05  FILLER              PIC X(30) VALUE SPACE.
010100     05  FILLER              PIC X(12)
010200         VALUE "SALES REPORT".
010300     05  FILLER              PIC X(16) VALUE SPACE.
010400     05  FILLER              PIC X(5) VALUE "PAGE:".
010500     05  FILLER              PIC X(1) VALUE SPACE.
010600     05  PRINT-PAGE-NUMBER   PIC ZZZ9.
010700
010800 01  TOTAL-LINE.
010900     05  FILLER              PIC X(11) VALUE SPACE.
011000     05  TOTAL-TYPE          PIC X(8).
011100     05  FILLER              PIC X(1) VALUE SPACE.
011200     05  TOTAL-NUMBER        PIC Z9.
011300     05  FILLER              PIC X(1) VALUE SPACE.
011400     05  TOTAL-LITERAL       PIC X(5) VALUE "TOTAL".
011500     05  FILLER              PIC X(1) VALUE SPACE.
011600     05  PRINT-TOTAL         PIC ZZZ,ZZ9.99-.
011700
011800 77  GRAND-TOTAL-LITERAL      PIC X(8) VALUE "   GRAND".
011900 77  STORE-TOTAL-LITERAL      PIC X(8) VALUE "   STORE".
012000 77  DIVISION-TOTAL-LITERAL   PIC X(8) VALUE "DIVISION".
012100 77  DEPARTMENT-TOTAL-LITERAL PIC X(8) VALUE "    DEPT".
012200
012300 77  WORK-FILE-AT-END        PIC X.
012400
012500 77  LINE-COUNT              PIC 999 VALUE ZERO.
012600 77  PAGE-NUMBER             PIC 9999 VALUE ZERO.
012700 77  MAXIMUM-LINES           PIC 999 VALUE 55.
012800
012900 77  RECORD-COUNT            PIC 9999 VALUE ZEROES.
013000
013100* Control break current values for store, division
013200* department.
013300 77  CURRENT-STORE          PIC 99.
013400 77  CURRENT-DIVISION       PIC 99.
013500 77  CURRENT-DEPARTMENT     PIC 99.
013600
013700* Control break accumulators
013800* GRAND TOTAL is the level 1 accumulator for the whole file
013900* STORE TOTAL is the level 2 accumulator
014000* DIVISION TOTAL is the level 3 accumulator
014100* DEPARTMENT TOTAL is the level 4 accumulator.
014200 77  GRAND-TOTAL            PIC S9(6)V99.
014300 77  STORE-TOTAL            PIC S9(6)V99.
014400 77  DIVISION-TOTAL         PIC S9(6)V99.
014500 77  DEPARTMENT-TOTAL       PIC S9(6)V99.
014600
014700 PROCEDURE DIVISION.
014800 PROGRAM-BEGIN.
014900
015000     PERFORM OPENING-PROCEDURE.
015100     PERFORM MAIN-PROCESS.
015200     PERFORM CLOSING-PROCEDURE.
015300
015400 PROGRAM-EXIT.
015500     EXIT PROGRAM.
015600
015700 PROGRAM-DONE.
015800     STOP RUN.
015900
016000 OPENING-PROCEDURE.
016100
016200     OPEN OUTPUT PRINTER-FILE.
016300
016400 MAIN-PROCESS.
016500     PERFORM GET-OK-TO-PROCESS.
016600     PERFORM PROCESS-THE-FILE
016700         UNTIL OK-TO-PROCESS = "N".
016800
016900 CLOSING-PROCEDURE.
017000     CLOSE PRINTER-FILE.
017100
017200 GET-OK-TO-PROCESS.
017300     PERFORM ACCEPT-OK-TO-PROCESS.
017400     PERFORM RE-ACCEPT-OK-TO-PROCESS
017500         UNTIL OK-TO-PROCESS = "Y" OR "N".
017600
017700 ACCEPT-OK-TO-PROCESS.
017800     DISPLAY "PRINT SALES REPORT (Y/N)?".
017900     ACCEPT OK-TO-PROCESS.
018000     INSPECT OK-TO-PROCESS
018100       CONVERTING LOWER-ALPHA
018200       TO         UPPER-ALPHA.
018300
018400 RE-ACCEPT-OK-TO-PROCESS.
018500     DISPLAY "YOU MUST ENTER YES OR NO".
018600     PERFORM ACCEPT-OK-TO-PROCESS.
018700
018800 PROCESS-THE-FILE.
018900     PERFORM START-THE-FILE.
019000     PERFORM PRINT-ONE-REPORT.
019100     PERFORM END-THE-FILE.
019200
019300*    PERFORM GET-OK-TO-PROCESS.
019400     MOVE "N" TO OK-TO-PROCESS.
019500
019600 START-THE-FILE.
019700     PERFORM SORT-DATA-FILE.
019800     OPEN INPUT WORK-FILE.
019900
020000 END-THE-FILE.
020100     CLOSE WORK-FILE.
020200
020300 SORT-DATA-FILE.
020400     SORT SORT-FILE
020500         ON ASCENDING KEY SORT-STORE
020600            ASCENDING KEY SORT-DIVISION
020700            ASCENDING KEY SORT-DEPARTMENT
020800            ASCENDING KEY SORT-CATEGORY
020900          USING SALES-FILE
021000          GIVING WORK-FILE.
021100
021200* LEVEL 1 CONTROL BREAK
021300 PRINT-ONE-REPORT.
021400     PERFORM START-ONE-REPORT.
021500     PERFORM PROCESS-ALL-STORES
021600         UNTIL WORK-FILE-AT-END = "Y".
021700     PERFORM END-ONE-REPORT.
021800
021900 START-ONE-REPORT.
022000     PERFORM READ-FIRST-VALID-WORK.
022100     MOVE ZEROES TO GRAND-TOTAL.
022200
022300     PERFORM START-NEW-REPORT.
022400
022500 START-NEW-REPORT.
022600     MOVE SPACE TO DETAIL-LINE.
022700     MOVE ZEROES TO LINE-COUNT PAGE-NUMBER.
022800
022900 END-ONE-REPORT.
023000     IF RECORD-COUNT = ZEROES
023100         MOVE "NO RECORDS FOUND" TO PRINTER-RECORD
023200         PERFORM WRITE-TO-PRINTER
023300     ELSE
023400         PERFORM PRINT-GRAND-TOTAL.
023500
023600     PERFORM END-LAST-PAGE.
023700
023800 PRINT-GRAND-TOTAL.
023900     MOVE SPACE TO TOTAL-LINE.
024000     MOVE GRAND-TOTAL TO PRINT-TOTAL.
024100     MOVE GRAND-TOTAL-LITERAL TO TOTAL-TYPE.
024200     MOVE "TOTAL" TO TOTAL-LITERAL.
024300     MOVE TOTAL-LINE TO PRINTER-RECORD.
024400     PERFORM WRITE-TO-PRINTER.
024500     PERFORM LINE-FEED 2 TIMES.
024600     MOVE SPACE TO DETAIL-LINE.
024700
024800* LEVEL 2 CONTROL BREAK
024900 PROCESS-ALL-STORES.
025000     PERFORM START-ONE-STORE.
025100
025200     PERFORM PROCESS-ALL-DIVISIONS
025300         UNTIL WORK-FILE-AT-END = "Y"
025400            OR WORK-STORE NOT = CURRENT-STORE.
025500
025600     PERFORM END-ONE-STORE.
025700
025800 START-ONE-STORE.
025900     MOVE WORK-STORE TO CURRENT-STORE.
026000     MOVE ZEROES TO STORE-TOTAL.
026100     MOVE WORK-STORE TO PRINT-STORE.
026200
026300     PERFORM START-NEXT-PAGE.
026400
026500 END-ONE-STORE.
026600     PERFORM PRINT-STORE-TOTAL.
026700     ADD STORE-TOTAL TO GRAND-TOTAL.
026800
026900 PRINT-STORE-TOTAL.
027000     MOVE SPACE TO TOTAL-LINE.
027100     MOVE STORE-TOTAL TO PRINT-TOTAL.
027200     MOVE CURRENT-STORE TO TOTAL-NUMBER.
027300     MOVE STORE-TOTAL-LITERAL TO TOTAL-TYPE.
027400     MOVE "TOTAL" TO TOTAL-LITERAL.
027500     MOVE TOTAL-LINE TO PRINTER-RECORD.
027600     PERFORM WRITE-TO-PRINTER.
027700     PERFORM LINE-FEED.
027800     MOVE SPACE TO DETAIL-LINE.
027900
028000* LEVEL 3 CONTROL BREAK
028100 PROCESS-ALL-DIVISIONS.
028200     PERFORM START-ONE-DIVISION.
028300
028400     PERFORM PROCESS-ALL-DEPARTMENTS
028500         UNTIL WORK-FILE-AT-END = "Y"
028600            OR WORK-STORE NOT = CURRENT-STORE
028700            OR WORK-DIVISION NOT = CURRENT-DIVISION.
028800
028900     PERFORM END-ONE-DIVISION.
029000
029100 START-ONE-DIVISION.
029200     MOVE WORK-DIVISION TO CURRENT-DIVISION.
029300     MOVE ZEROES TO DIVISION-TOTAL.
029400*    MOVE WORK-DIVISION TO PRINT-DIVISION.
029500
029600 END-ONE-DIVISION.
029700     PERFORM PRINT-DIVISION-TOTAL.
029800     ADD DIVISION-TOTAL TO STORE-TOTAL.
029900
030000 PRINT-DIVISION-TOTAL.
030100     MOVE SPACE TO TOTAL-LINE.
030200     MOVE DIVISION-TOTAL TO PRINT-TOTAL.
030300     MOVE CURRENT-DIVISION TO TOTAL-NUMBER.
030400     MOVE DIVISION-TOTAL-LITERAL TO TOTAL-TYPE.
030500     MOVE "TOTAL" TO TOTAL-LITERAL.
030600     MOVE TOTAL-LINE TO PRINTER-RECORD.
030700     PERFORM WRITE-TO-PRINTER.
030800     PERFORM LINE-FEED.
030900     MOVE SPACE TO DETAIL-LINE.
031000
031100* LEVEL 4 CONTROL BREAK
031200 PROCESS-ALL-DEPARTMENTS.
031300     PERFORM START-ONE-DEPARTMENT.
031400
031500     PERFORM PROCESS-ALL-CATEGORIES
031600         UNTIL WORK-FILE-AT-END = "Y"
031700            OR WORK-STORE NOT = CURRENT-STORE
031800            OR WORK-DIVISION NOT = CURRENT-DIVISION
031900            OR WORK-DEPARTMENT NOT = CURRENT-DEPARTMENT.
032000
032100     PERFORM END-ONE-DEPARTMENT.
032200
032300 START-ONE-DEPARTMENT.
032400     MOVE WORK-DEPARTMENT TO CURRENT-DEPARTMENT.
032500     MOVE ZEROES TO DEPARTMENT-TOTAL.
032600*    MOVE WORK-DEPARTMENT TO PRINT-DEPARTMENT.
032700
032800 END-ONE-DEPARTMENT.
032900     PERFORM PRINT-DEPARTMENT-TOTAL.
033000     ADD DEPARTMENT-TOTAL TO DIVISION-TOTAL.
033100
033200 PRINT-DEPARTMENT-TOTAL.
033300     MOVE SPACE TO TOTAL-LINE.
033400     MOVE DEPARTMENT-TOTAL TO PRINT-TOTAL.
033500     MOVE CURRENT-DEPARTMENT TO TOTAL-NUMBER.
033600     MOVE DEPARTMENT-TOTAL-LITERAL TO TOTAL-TYPE.
033700     MOVE "TOTAL" TO TOTAL-LITERAL.
033800     MOVE TOTAL-LINE TO PRINTER-RECORD.
033900     PERFORM WRITE-TO-PRINTER.
034000     PERFORM LINE-FEED.
034100     MOVE SPACE TO DETAIL-LINE.
034200
034300* PROCESS ONE RECORD LEVEL
034400 PROCESS-ALL-CATEGORIES.
034500     PERFORM PROCESS-THIS-CATEGORY.
034600     ADD WORK-AMOUNT TO DEPARTMENT-TOTAL.
034700     ADD 1 TO RECORD-COUNT.
034800     PERFORM READ-NEXT-VALID-WORK.
034900
035000 PROCESS-THIS-CATEGORY.
035100     IF LINE-COUNT > MAXIMUM-LINES
035200         PERFORM START-NEXT-PAGE.
035300     PERFORM PRINT-THE-RECORD.
035400
035500 PRINT-THE-RECORD.
035600     MOVE WORK-DIVISION TO PRINT-DIVISION.
035700     MOVE WORK-DEPARTMENT TO PRINT-DEPARTMENT.
035800     MOVE WORK-CATEGORY TO PRINT-CATEGORY.
035900
036000     MOVE WORK-AMOUNT TO PRINT-AMOUNT.
036100
036200     MOVE DETAIL-LINE TO PRINTER-RECORD.
036300     PERFORM WRITE-TO-PRINTER.
036400     MOVE SPACE TO DETAIL-LINE.
036500
036600* PRINTING ROUTINES
036700 WRITE-TO-PRINTER.
036800     WRITE PRINTER-RECORD BEFORE ADVANCING 1.
036900     ADD 1 TO LINE-COUNT.
037000
037100 LINE-FEED.
037200     MOVE SPACE TO PRINTER-RECORD.
037300     PERFORM WRITE-TO-PRINTER.
037400
037500 START-NEXT-PAGE.
037600     PERFORM END-LAST-PAGE.
037700     PERFORM START-NEW-PAGE.
037800
037900 START-NEW-PAGE.
038000     ADD 1 TO PAGE-NUMBER.
038100     MOVE PAGE-NUMBER TO PRINT-PAGE-NUMBER.
038200     MOVE TITLE-LINE TO PRINTER-RECORD.
038300     PERFORM WRITE-TO-PRINTER.
038400     PERFORM LINE-FEED.
038500     MOVE LEGEND-LINE TO PRINTER-RECORD.
038600     PERFORM WRITE-TO-PRINTER.
038700     PERFORM LINE-FEED.
038800     MOVE COLUMN-LINE TO PRINTER-RECORD.
038900     PERFORM WRITE-TO-PRINTER.
039000     PERFORM LINE-FEED.
039100
039200 END-LAST-PAGE.
039300     IF PAGE-NUMBER > 0
039400         PERFORM FORM-FEED.
039500     MOVE ZERO TO LINE-COUNT.
039600
039700 FORM-FEED.
039800     MOVE SPACE TO PRINTER-RECORD.
039900     WRITE PRINTER-RECORD BEFORE ADVANCING PAGE.
040000
040100*--------------------------------
040200* Read first, read next routines
040300*--------------------------------
040400 READ-FIRST-VALID-WORK.
040500     PERFORM READ-NEXT-VALID-WORK.
040600
040700 READ-NEXT-VALID-WORK.
040800     PERFORM READ-NEXT-WORK-RECORD.
040900
041000 READ-NEXT-WORK-RECORD.
041100     MOVE "N" TO WORK-FILE-AT-END.
041200     READ WORK-FILE NEXT RECORD
041300         AT END MOVE "Y" TO WORK-FILE-AT-END.
041400

The output of slsrpt02.cbl shows full detail on each line:

OUTPUT:

                              SALES REPORT                PAGE:    1

STORE:  1

DIVISION DEPARTMENT CATEGORY     AMOUNT

1        1          1        237.57
1        1          2        475.14
DEPT  1 TOTAL     712.71

1        2          3        712.71
1        2          4         50.28
DEPT  2 TOTAL     762.99

DIVISION  1 TOTAL   1,475.70

2        3          5        287.85
2        3          6        525.42
DEPT  3 TOTAL     813.27

2        4          7        762.99
2        4          8        100.56
DEPT  4 TOTAL     863.55

DIVISION  2 TOTAL   1,676.82

3        5          9        338.13
3        5         10        575.70
DEPT  5 TOTAL     913.83

3        6         11         86.73-
3        6         12        150.84
DEPT  6 TOTAL      64.11

DIVISION  3 TOTAL     977.94

STORE  1 TOTAL   4,130.46

----------------------<page break>--------------------------------


                              SALES REPORT               PAGE:    2

STORE:  2

DIVISION DEPARTMENT CATEGORY     AMOUNT

1        1          1        388.41
1        1          2        625.98
DEPT  1 TOTAL   1,014.39

1        2          3         36.45-
1        2          4        201.12
DEPT  2 TOTAL     164.67

DIVISION  1 TOTAL   1,179.06

2        3          5        438.69
2        3          6        676.26
DEPT  3 TOTAL   1,114.95

2        4          7         13.83
2        4          8        251.40
DEPT  4 TOTAL     265.23

DIVISION  2 TOTAL   1,380.18

3        5          9        488.97
3        5         10        726.54
DEPT  5 TOTAL   1,215.51

3        6         11         64.11
3        6         12        301.68
DEPT  6 TOTAL     365.79

DIVISION  3 TOTAL   1,581.30

STORE  2 TOTAL   4,140.54

----------------------<page break>--------------------------------


                              SALES REPORT               PAGE:    3

STORE:  3

DIVISION DEPARTMENT CATEGORY     AMOUNT

1        1          1        539.25
1        1          2        776.82
DEPT  1 TOTAL   1,316.07

1        2          3        114.39
1        2          4        351.96
DEPT  2 TOTAL     466.35

DIVISION  1 TOTAL   1,782.42

2        3          5        589.53
2        3          6         72.90-
DEPT  3 TOTAL     516.63

2        4          7        164.67
2        4          8        402.24
DEPT  4 TOTAL     566.91

DIVISION  2 TOTAL   1,083.54

3        5          9        639.81
3        5         10         22.62-
DEPT  5 TOTAL     617.19

3        6         11        214.95
3        6         12        452.52
DEPT  6 TOTAL     667.47

DIVISION  3 TOTAL   1,284.66

STORE  3 TOTAL   4,150.62

----------------------<page break>--------------------------------


                              SALES REPORT               PAGE:    4

STORE:  4

DIVISION DEPARTMENT CATEGORY     AMOUNT

1        1          1        690.09
1        1          2         27.66
DEPT  1 TOTAL     717.75

1        2          3        265.23
1        2          4        502.80
DEPT  2 TOTAL     768.03

DIVISION  1 TOTAL   1,485.78

2        3          5        740.37
2        3          6         77.94
DEPT  3 TOTAL     818.31

2        4          7        315.51
2        4          8        553.08
DEPT  4 TOTAL     868.59

DIVISION  2 TOTAL   1,686.90

3        5          9        790.65
3        5         10        128.22
DEPT  5 TOTAL     918.87

3        6         11        365.79
3        6         12        603.36
DEPT  6 TOTAL     969.15

DIVISION  3 TOTAL   1,888.02

STORE  4 TOTAL   5,060.70

----------------------<page break>--------------------------------


                              SALES REPORT               PAGE:    5

STORE:  5

DIVISION DEPARTMENT CATEGORY     AMOUNT

1        1          1         59.07-
1        1          2        178.50
DEPT  1 TOTAL     119.43

1        2          3        416.07
1        2          4        653.64
DEPT  2 TOTAL   1,069.71

DIVISION  1 TOTAL   1,189.14

2        3          5          8.79-
2        3          6        228.78
DEPT  3 TOTAL     219.99

2        4          7        466.35
2        4          8        703.92
DEPT  4 TOTAL   1,170.27

DIVISION  2 TOTAL   1,390.26

3        5          9         41.49
3        5         10        279.06
DEPT  5 TOTAL     320.55

3        6         11        516.63
3        6         12        754.20
DEPT  6 TOTAL   1,270.83

DIVISION  3 TOTAL   1,591.38

STORE  5 TOTAL   4,170.78

----------------------<page break>--------------------------------


                              SALES REPORT               PAGE:    6

STORE:  6

DIVISION DEPARTMENT CATEGORY     AMOUNT

1        1          1         91.77
1        1          2        329.34
DEPT  1 TOTAL     421.11

1        2          3        566.91
1        2          4         95.52-
DEPT  2 TOTAL     471.39

DIVISION  1 TOTAL     892.50

2        3          5        142.05
2        3          6        379.62
DEPT  3 TOTAL     521.67

2        4          7        617.19
2        4          8         45.24-
DEPT  4 TOTAL     571.95

DIVISION  2 TOTAL   1,093.62

3        5          9        192.33
3        5         10        429.90
DEPT  5 TOTAL     622.23

3        6         11        667.47
3        6         12          5.04
DEPT  6 TOTAL     672.51

DIVISION  3 TOTAL   1,294.74

STORE  6 TOTAL   3,280.86

GRAND    TOTAL  24,933.96

2. Listing A.44 removes all detail printing and prints only the control breaks. All changes are highlighted, but only the change of removing (by commenting out) lines 035300 through 036200 was necessary to remove the printing of the detail lines.

The key cosmetic change is the removal of lines 038600 through 038800, which print the column line. All other highlighted changes are the removal of things not needed for a summary version of the report, or small cosmetic changes such as the title of the report.

TYPE: Listing A.44. Printing control breaks only.

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. SLSSUM01.
000300*--------------------------------
000400* Generate test sales data
000500*--------------------------------
000600 ENVIRONMENT DIVISION.
000700 INPUT-OUTPUT SECTION.
000800 FILE-CONTROL.
000900
001000*--------------------------------
001100* SLSALES.CBL
001200*--------------------------------
001300     SELECT SALES-FILE
001400         ASSIGN TO "SALES"
001500         ORGANIZATION IS SEQUENTIAL.
001600
001700     SELECT WORK-FILE
001800         ASSIGN TO "WORK"
001900         ORGANIZATION IS SEQUENTIAL.
002000
002100     SELECT SORT-FILE
002200         ASSIGN TO "SORT".
002300
002400     SELECT PRINTER-FILE
002500         ASSIGN TO PRINTER
002600         ORGANIZATION IS LINE SEQUENTIAL.
002700
002800 DATA DIVISION.
002900 FILE SECTION.
003000
003100*--------------------------------
003200* FDSALES.CBL
003300* Temporary daily sales file.
003400*--------------------------------
003500 FD  SALES-FILE
003600     LABEL RECORDS ARE STANDARD.
003700 01  SALES-RECORD.
003800     05  SALES-STORE              PIC 9(2).
003900     05  SALES-DIVISION           PIC 9(2).
004000     05  SALES-DEPARTMENT         PIC 9(2).
004100     05  SALES-CATEGORY           PIC 9(2).
004200     05  SALES-AMOUNT             PIC S9(6)V99.
004300
004400 FD  WORK-FILE
004500     LABEL RECORDS ARE STANDARD.
004600 01  WORK-RECORD.
004700     05  WORK-STORE              PIC 9(2).
004800     05  WORK-DIVISION           PIC 9(2).
004900     05  WORK-DEPARTMENT         PIC 9(2).
005000     05  WORK-CATEGORY           PIC 9(2).
005100     05  WORK-AMOUNT             PIC S9(6)V99.
005200
005300 SD  SORT-FILE
005400     LABEL RECORDS ARE STANDARD.
005500 01  SORT-RECORD.
005600     05  SORT-STORE              PIC 9(2).
005700     05  SORT-DIVISION           PIC 9(2).
005800     05  SORT-DEPARTMENT         PIC 9(2).
005900     05  SORT-CATEGORY           PIC 9(2).
006000     05  SORT-AMOUNT             PIC S9(6)V99.
006100
006200 FD  PRINTER-FILE
006300     LABEL RECORDS ARE OMITTED.
006400 01  PRINTER-RECORD              PIC X(80).
006500
006600 WORKING-STORAGE SECTION.
006700
006800 77  OK-TO-PROCESS         PIC X.
006900
007000     COPY "WSCASE01.CBL".
007100
007200 01  LEGEND-LINE.
007300     05  FILLER            PIC X(6) VALUE "STORE:".
007400     05  FILLER            PIC X(1) VALUE SPACE.
007500     05  PRINT-STORE       PIC Z9.
007600
007700*01  DETAIL-LINE.
007800*    05  FILLER            PIC X(3) VALUE SPACE.
007900*    05  PRINT-DIVISION    PIC Z9.
008000*    05  FILLER            PIC X(4) VALUE SPACE.
008100*    05  FILLER            PIC X(3) VALUE SPACE.
008200*    05  PRINT-DEPARTMENT  PIC Z9.
008300*    05  FILLER            PIC X(6) VALUE SPACE.
008400*    05  FILLER            PIC X(3) VALUE SPACE.
008500*    05  PRINT-CATEGORY    PIC Z9.
008600*    05  FILLER            PIC X(4) VALUE SPACE.
008700*    05  PRINT-AMOUNT      PIC ZZZ,ZZ9.99-.
008800
008900*01  COLUMN-LINE.
009000*    05  FILLER         PIC X(8)  VALUE "DIVISION".
009100*    05  FILLER         PIC X(1)  VALUE SPACE.
009200*    05  FILLER         PIC X(10) VALUE "DEPARTMENT".
009300*    05  FILLER         PIC X(1)  VALUE SPACE.
009400*    05  FILLER         PIC X(8)  VALUE "CATEGORY".
009500*    05  FILLER         PIC X(1)  VALUE SPACE.
009600*    05  FILLER         PIC X(4)  VALUE SPACE.
009700*    05  FILLER         PIC X(6)  VALUE "AMOUNT".
009800
009900 01  TITLE-LINE.
010000     05  FILLER              PIC X(30) VALUE SPACE.
010100     05  FILLER              PIC X(13)
010200         VALUE "SALES SUMMARY".
010300     05  FILLER              PIC X(15) VALUE SPACE.
010400     05  FILLER              PIC X(5) VALUE "PAGE:".
010500     05  FILLER              PIC X(1) VALUE SPACE.
010600     05  PRINT-PAGE-NUMBER   PIC ZZZ9.
010700
010800 01  TOTAL-LINE.
010900     05  FILLER              PIC X(11) VALUE SPACE.
011000     05  TOTAL-TYPE          PIC X(8).
011100     05  FILLER              PIC X(1) VALUE SPACE.
011200     05  TOTAL-NUMBER        PIC Z9.
011300     05  FILLER              PIC X(1) VALUE SPACE.
011400     05  TOTAL-LITERAL       PIC X(5) VALUE "TOTAL".
011500     05  FILLER              PIC X(1) VALUE SPACE.
011600     05  PRINT-TOTAL         PIC ZZZ,ZZ9.99-.
011700
011800 77  GRAND-TOTAL-LITERAL      PIC X(8) VALUE "   GRAND".
011900 77  STORE-TOTAL-LITERAL      PIC X(8) VALUE "   STORE".
012000 77  DIVISION-TOTAL-LITERAL   PIC X(8) VALUE "DIVISION".
012100 77  DEPARTMENT-TOTAL-LITERAL PIC X(8) VALUE "    DEPT".
012200
012300 77  WORK-FILE-AT-END        PIC X.
012400
012500 77  LINE-COUNT              PIC 999 VALUE ZERO.
012600 77  PAGE-NUMBER             PIC 9999 VALUE ZERO.
012700 77  MAXIMUM-LINES           PIC 999 VALUE 55.
012800
012900 77  RECORD-COUNT            PIC 9999 VALUE ZEROES.
013000
013100* Control break current values for store, division
013200* department.
013300 77  CURRENT-STORE          PIC 99.
013400 77  CURRENT-DIVISION       PIC 99.
013500 77  CURRENT-DEPARTMENT     PIC 99.
013600
013700* Control break accumulators
013800* GRAND TOTAL is the level 1 accumulator for the whole file
013900* STORE TOTAL is the level 2 accumulator
014000* DIVISION TOTAL is the level 3 accumulator
014100* DEPARTMENT TOTAL is the level 4 accumulator.
014200 77  GRAND-TOTAL            PIC S9(6)V99.
014300 77  STORE-TOTAL            PIC S9(6)V99.
014400 77  DIVISION-TOTAL         PIC S9(6)V99.
014500 77  DEPARTMENT-TOTAL       PIC S9(6)V99.
014600
014700 PROCEDURE DIVISION.
014800 PROGRAM-BEGIN.
014900
015000     PERFORM OPENING-PROCEDURE.
015100     PERFORM MAIN-PROCESS.
015200     PERFORM CLOSING-PROCEDURE.
015300
015400 PROGRAM-EXIT.
015500     EXIT PROGRAM.
015600
015700 PROGRAM-DONE.
015800     STOP RUN.
015900
016000 OPENING-PROCEDURE.
016100
016200     OPEN OUTPUT PRINTER-FILE.
016300
016400 MAIN-PROCESS.
016500     PERFORM GET-OK-TO-PROCESS.
016600     PERFORM PROCESS-THE-FILE
016700         UNTIL OK-TO-PROCESS = "N".
016800
016900 CLOSING-PROCEDURE.
017000     CLOSE PRINTER-FILE.
017100
017200 GET-OK-TO-PROCESS.
017300     PERFORM ACCEPT-OK-TO-PROCESS.
017400     PERFORM RE-ACCEPT-OK-TO-PROCESS
017500         UNTIL OK-TO-PROCESS = "Y" OR "N".
017600
017700 ACCEPT-OK-TO-PROCESS.
017800     DISPLAY "PRINT SALES SUMMARY (Y/N)?".
017900     ACCEPT OK-TO-PROCESS.
018000     INSPECT OK-TO-PROCESS
018100       CONVERTING LOWER-ALPHA
018200       TO         UPPER-ALPHA.
018300
018400 RE-ACCEPT-OK-TO-PROCESS.
018500     DISPLAY "YOU MUST ENTER YES OR NO".
018600     PERFORM ACCEPT-OK-TO-PROCESS.
018700
018800 PROCESS-THE-FILE.
018900     PERFORM START-THE-FILE.
019000     PERFORM PRINT-ONE-REPORT.
019100     PERFORM END-THE-FILE.
019200
019300*    PERFORM GET-OK-TO-PROCESS.
019400     MOVE "N" TO OK-TO-PROCESS.
019500
019600 START-THE-FILE.
019700     PERFORM SORT-DATA-FILE.
019800     OPEN INPUT WORK-FILE.
019900
020000 END-THE-FILE.
020100     CLOSE WORK-FILE.
020200
020300 SORT-DATA-FILE.
020400     SORT SORT-FILE
020500         ON ASCENDING KEY SORT-STORE
020600            ASCENDING KEY SORT-DIVISION
020700            ASCENDING KEY SORT-DEPARTMENT
020800            ASCENDING KEY SORT-CATEGORY
020900          USING SALES-FILE
021000          GIVING WORK-FILE.
021100
021200* LEVEL 1 CONTROL BREAK
021300 PRINT-ONE-REPORT.
021400     PERFORM START-ONE-REPORT.
021500     PERFORM PROCESS-ALL-STORES
021600         UNTIL WORK-FILE-AT-END = "Y".
021700     PERFORM END-ONE-REPORT.
021800
021900 START-ONE-REPORT.
022000     PERFORM READ-FIRST-VALID-WORK.
022100     MOVE ZEROES TO GRAND-TOTAL.
022200
022300     PERFORM START-NEW-REPORT.
022400
022500 START-NEW-REPORT.
022600*    MOVE SPACE TO DETAIL-LINE.
022700     MOVE ZEROES TO LINE-COUNT PAGE-NUMBER.
022800
022900 END-ONE-REPORT.
023000     IF RECORD-COUNT = ZEROES
023100         MOVE "NO RECORDS FOUND" TO PRINTER-RECORD
023200         PERFORM WRITE-TO-PRINTER
023300     ELSE
023400         PERFORM PRINT-GRAND-TOTAL.
023500
023600     PERFORM END-LAST-PAGE.
023700
023800 PRINT-GRAND-TOTAL.
023900     MOVE SPACE TO TOTAL-LINE.
024000     MOVE GRAND-TOTAL TO PRINT-TOTAL.
024100     MOVE GRAND-TOTAL-LITERAL TO TOTAL-TYPE.
024200     MOVE "TOTAL" TO TOTAL-LITERAL.
024300     MOVE TOTAL-LINE TO PRINTER-RECORD.
024400     PERFORM WRITE-TO-PRINTER.
024500     PERFORM LINE-FEED 2 TIMES.
024600*    MOVE SPACE TO DETAIL-LINE.
024700
024800* LEVEL 2 CONTROL BREAK
024900 PROCESS-ALL-STORES.
025000     PERFORM START-ONE-STORE.
025100
025200     PERFORM PROCESS-ALL-DIVISIONS
025300         UNTIL WORK-FILE-AT-END = "Y"
025400            OR WORK-STORE NOT = CURRENT-STORE.
025500
025600     PERFORM END-ONE-STORE.
025700
025800 START-ONE-STORE.
025900     MOVE WORK-STORE TO CURRENT-STORE.
026000     MOVE ZEROES TO STORE-TOTAL.
026100     MOVE WORK-STORE TO PRINT-STORE.
026200
026300     PERFORM START-NEXT-PAGE.
026400
026500 END-ONE-STORE.
026600     PERFORM PRINT-STORE-TOTAL.
026700     ADD STORE-TOTAL TO GRAND-TOTAL.
026800
026900 PRINT-STORE-TOTAL.
027000     MOVE SPACE TO TOTAL-LINE.
027100     MOVE STORE-TOTAL TO PRINT-TOTAL.
027200     MOVE CURRENT-STORE TO TOTAL-NUMBER.
027300     MOVE STORE-TOTAL-LITERAL TO TOTAL-TYPE.
027400     MOVE "TOTAL" TO TOTAL-LITERAL.
027500     MOVE TOTAL-LINE TO PRINTER-RECORD.
027600     PERFORM WRITE-TO-PRINTER.
027700     PERFORM LINE-FEED.
027800*    MOVE SPACE TO DETAIL-LINE.
027900
028000* LEVEL 3 CONTROL BREAK
028100 PROCESS-ALL-DIVISIONS.
028200     PERFORM START-ONE-DIVISION.
028300
028400     PERFORM PROCESS-ALL-DEPARTMENTS
028500         UNTIL WORK-FILE-AT-END = "Y"
028600            OR WORK-STORE NOT = CURRENT-STORE
028700            OR WORK-DIVISION NOT = CURRENT-DIVISION.
028800
028900     PERFORM END-ONE-DIVISION.
029000
029100 START-ONE-DIVISION.
029200     MOVE WORK-DIVISION TO CURRENT-DIVISION.
029300     MOVE ZEROES TO DIVISION-TOTAL.
029400*    MOVE WORK-DIVISION TO PRINT-DIVISION.
029500
029600 END-ONE-DIVISION.
029700     PERFORM PRINT-DIVISION-TOTAL.
029800     ADD DIVISION-TOTAL TO STORE-TOTAL.
029900
030000 PRINT-DIVISION-TOTAL.
030100     MOVE SPACE TO TOTAL-LINE.
030200     MOVE DIVISION-TOTAL TO PRINT-TOTAL.
030300     MOVE CURRENT-DIVISION TO TOTAL-NUMBER.
030400     MOVE DIVISION-TOTAL-LITERAL TO TOTAL-TYPE.
030500     MOVE "TOTAL" TO TOTAL-LITERAL.
030600     MOVE TOTAL-LINE TO PRINTER-RECORD.
030700     PERFORM WRITE-TO-PRINTER.
030800     PERFORM LINE-FEED.
030900*    MOVE SPACE TO DETAIL-LINE.
031000
031100* LEVEL 4 CONTROL BREAK
031200 PROCESS-ALL-DEPARTMENTS.
031300     PERFORM START-ONE-DEPARTMENT.
031400
031500     PERFORM PROCESS-ALL-CATEGORIES
031600         UNTIL WORK-FILE-AT-END = "Y"
031700            OR WORK-STORE NOT = CURRENT-STORE
031800            OR WORK-DIVISION NOT = CURRENT-DIVISION
031900            OR WORK-DEPARTMENT NOT = CURRENT-DEPARTMENT.
032000
032100     PERFORM END-ONE-DEPARTMENT.
032200
032300 START-ONE-DEPARTMENT.
032400     MOVE WORK-DEPARTMENT TO CURRENT-DEPARTMENT.
032500     MOVE ZEROES TO DEPARTMENT-TOTAL.
032600*    MOVE WORK-DEPARTMENT TO PRINT-DEPARTMENT.
032700
032800 END-ONE-DEPARTMENT.
032900     PERFORM PRINT-DEPARTMENT-TOTAL.
033000     ADD DEPARTMENT-TOTAL TO DIVISION-TOTAL.
033100
033200 PRINT-DEPARTMENT-TOTAL.
033300     MOVE SPACE TO TOTAL-LINE.
033400     MOVE DEPARTMENT-TOTAL TO PRINT-TOTAL.
033500     MOVE CURRENT-DEPARTMENT TO TOTAL-NUMBER.
033600     MOVE DEPARTMENT-TOTAL-LITERAL TO TOTAL-TYPE.
033700     MOVE "TOTAL" TO TOTAL-LITERAL.
033800     MOVE TOTAL-LINE TO PRINTER-RECORD.
033900     PERFORM WRITE-TO-PRINTER.
034000     PERFORM LINE-FEED.
034100*    MOVE SPACE TO DETAIL-LINE.
034200
034300* PROCESS ONE RECORD LEVEL
034400 PROCESS-ALL-CATEGORIES.
034500     PERFORM PROCESS-THIS-CATEGORY.
034600     ADD WORK-AMOUNT TO DEPARTMENT-TOTAL.
034700     ADD 1 TO RECORD-COUNT.
034800     PERFORM READ-NEXT-VALID-WORK.
034900
035000 PROCESS-THIS-CATEGORY.
035100     IF LINE-COUNT > MAXIMUM-LINES
035200         PERFORM START-NEXT-PAGE.
035300*    PERFORM PRINT-THE-RECORD.
035400
035500*PRINT-THE-RECORD.
035600*    MOVE WORK-CATEGORY TO PRINT-CATEGORY.
035700*
035800*    MOVE WORK-AMOUNT TO PRINT-AMOUNT.
035900*
036000*    MOVE DETAIL-LINE TO PRINTER-RECORD.
036100*    PERFORM WRITE-TO-PRINTER.
036200*    MOVE SPACE TO DETAIL-LINE.
036300
036400* PRINTING ROUTINES
036500 WRITE-TO-PRINTER.
036600     WRITE PRINTER-RECORD BEFORE ADVANCING 1.
036700     ADD 1 TO LINE-COUNT.
036800
036900 LINE-FEED.
037000     MOVE SPACE TO PRINTER-RECORD.
037100     PERFORM WRITE-TO-PRINTER.
037200
037300 START-NEXT-PAGE.
037400     PERFORM END-LAST-PAGE.
037500     PERFORM START-NEW-PAGE.
037600
037700 START-NEW-PAGE.
037800     ADD 1 TO PAGE-NUMBER.
037900     MOVE PAGE-NUMBER TO PRINT-PAGE-NUMBER.
038000     MOVE TITLE-LINE TO PRINTER-RECORD.
038100     PERFORM WRITE-TO-PRINTER.
038200     PERFORM LINE-FEED.
038300     MOVE LEGEND-LINE TO PRINTER-RECORD.
038400     PERFORM WRITE-TO-PRINTER.
038500     PERFORM LINE-FEED.
038600*    MOVE COLUMN-LINE TO PRINTER-RECORD.
038700*    PERFORM WRITE-TO-PRINTER.
038800*    PERFORM LINE-FEED.
038900
039000 END-LAST-PAGE.
039100     IF PAGE-NUMBER > 0
039200         PERFORM FORM-FEED.
039300     MOVE ZERO TO LINE-COUNT.
039400
039500 FORM-FEED.
039600     MOVE SPACE TO PRINTER-RECORD.
039700     WRITE PRINTER-RECORD BEFORE ADVANCING PAGE.
039800
039900*--------------------------------
040000* Read first, read next routines
040100*--------------------------------
040200 READ-FIRST-VALID-WORK.
040300     PERFORM READ-NEXT-VALID-WORK.
040400
040500 READ-NEXT-VALID-WORK.
040600     PERFORM READ-NEXT-WORK-RECORD.
040700
040800 READ-NEXT-WORK-RECORD.
040900     MOVE "N" TO WORK-FILE-AT-END.
041000     READ WORK-FILE NEXT RECORD
041100         AT END MOVE "Y" TO WORK-FILE-AT-END.
041200

The output of slssum01.cbl prints only the control breaks and no detail lines:

OUTPUT:

                              SALES SUMMARY              PAGE:    1

STORE:  1

DEPT  1 TOTAL     712.71

DEPT  2 TOTAL     762.99

DIVISION  1 TOTAL   1,475.70

DEPT  3 TOTAL     813.27

DEPT  4 TOTAL     863.55

DIVISION  2 TOTAL   1,676.82

DEPT  5 TOTAL     913.83

DEPT  6 TOTAL      64.11

DIVISION  3 TOTAL     977.94

STORE  1 TOTAL   4,130.46

----------------------<page break>--------------------------------


                              SALES SUMMARY              PAGE:    2

STORE:  2

DEPT  1 TOTAL   1,014.39

DEPT  2 TOTAL     164.67

DIVISION  1 TOTAL   1,179.06

DEPT  3 TOTAL   1,114.95

DEPT  4 TOTAL     265.23

DIVISION  2 TOTAL   1,380.18

DEPT  5 TOTAL   1,215.51

DEPT  6 TOTAL     365.79

DIVISION  3 TOTAL   1,581.30

STORE  2 TOTAL   4,140.54

----------------------<page break>--------------------------------


                              SALES SUMMARY              PAGE:    3

STORE:  3

DEPT  1 TOTAL   1,316.07

DEPT  2 TOTAL     466.35

DIVISION  1 TOTAL   1,782.42

DEPT  3 TOTAL     516.63

DEPT  4 TOTAL     566.91

DIVISION  2 TOTAL   1,083.54

DEPT  5 TOTAL     617.19

DEPT  6 TOTAL     667.47

DIVISION  3 TOTAL   1,284.66

STORE  3 TOTAL   4,150.62

----------------------<page break>--------------------------------


                              SALES SUMMARY              PAGE:    4

STORE:  4

DEPT  1 TOTAL     717.75

DEPT  2 TOTAL     768.03

DIVISION  1 TOTAL   1,485.78

DEPT  3 TOTAL     818.31

DEPT  4 TOTAL     868.59

DIVISION  2 TOTAL   1,686.90

DEPT  5 TOTAL     918.87

DEPT  6 TOTAL     969.15

DIVISION  3 TOTAL   1,888.02

STORE  4 TOTAL   5,060.70

----------------------<page break>--------------------------------


                              SALES SUMMARY              PAGE:    5

STORE:  5

DEPT  1 TOTAL     119.43

DEPT  2 TOTAL   1,069.71

DIVISION  1 TOTAL   1,189.14

DEPT  3 TOTAL     219.99

DEPT  4 TOTAL   1,170.27

DIVISION  2 TOTAL   1,390.26

DEPT  5 TOTAL     320.55

DEPT  6 TOTAL   1,270.83

DIVISION  3 TOTAL   1,591.38

STORE  5 TOTAL   4,170.78

----------------------<page break>--------------------------------


                              SALES SUMMARY              PAGE:    6

STORE:  6

DEPT  1 TOTAL     421.11

DEPT  2 TOTAL     471.39

DIVISION  1 TOTAL     892.50

DEPT  3 TOTAL     521.67

DEPT  4 TOTAL     571.95

DIVISION  2 TOTAL   1,093.62

DEPT  5 TOTAL     622.23

DEPT  6 TOTAL     672.51

DIVISION  3 TOTAL   1,294.74

STORE  6 TOTAL   3,280.86

GRAND    TOTAL  24,933.96

Answers to Bonus Day 2, "Miscellaneous COBOL Syntax"

Quiz

1. The output will be the last name, a comma, a space, the first name, a space, and the middle name:

JONES, JOHN PAUL

2. FIRST-NAME will contain JANE with spaces to the end of the field. LAST-NAME will contain JOHANSEN with spaces to the end of the field.

Exercise

Listing A.45 is an example of how such a program might work.

TYPE: Listing A.45. A subroutine to get `YES` or `NO`.

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. YESORNO.
000300*--------------------------------
000400* Force user to enter yes or no
000500*--------------------------------
000600 ENVIRONMENT DIVISION.
000700 INPUT-OUTPUT SECTION.
000800 FILE-CONTROL.
000900
001000 DATA DIVISION.
001100 FILE SECTION.
001200
001300 WORKING-STORAGE SECTION.
001400
001500 LINKAGE SECTION.
001600*--------------------------------
001700* Field is filled in and returned
001800* to the calling program
001900*--------------------------------
002000 77  YES-OR-NO          PIC X.
002100
002200 PROCEDURE DIVISION
002300     USING YES-OR-NO.
002400
002500 PROGRAM-BEGIN.
002600     PERFORM OPENING-PROCEDURE.
002700     PERFORM MAIN-PROCESS.
002800     PERFORM CLOSING-PROCEDURE.
002900
003000 PROGRAM-EXIT.
003100     EXIT PROGRAM.
003200
003300 PROGRAM-DONE.
003400     STOP RUN.
003500
003600 OPENING-PROCEDURE.
003700
003800 CLOSING-PROCEDURE.
003900
004000 MAIN-PROCESS.
004100     PERFORM GET-YES-OR-NO.
004200
004300 GET-YES-OR-NO.
004400     PERFORM ACCEPT-YES-OR-NO.
004500     PERFORM RE-ACCEPT-YES-OR-NO
004600         UNTIL YES-OR-NO = "Y" OR "N".
004700
004800 ACCEPT-YES-OR-NO.
004900     DISPLAY "ENTER YES OR NO (Y/N)?".
005000
005100     ACCEPT YES-OR-NO.
005200
005300     PERFORM EDIT-CHECK-YES-OR-NO.
005400
005500 RE-ACCEPT-YES-OR-NO.
005600     DISPLAY "YOU MUST ENTER `Y' OR `N'".
005700
005800     PERFORM ACCEPT-YES-OR-NO.
005900
006000 EDIT-CHECK-YES-OR-NO.
006100     PERFORM EDIT-YES-OR-NO.
006200     PERFORM CHECK-YES-OR-NO.
006300     PERFORM FORMAT-YES-OR-NO.
006400
006500 EDIT-YES-OR-NO.
006600     IF YES-OR-NO = "y"
006700         MOVE "Y" TO YES-OR-NO.
006800
006900     IF YES-OR-NO = "n"
007000         MOVE "N" TO YES-OR-NO.
007100
007200 CHECK-YES-OR-NO.
007300* NO CHECKING NEEDED
007400
007500 FORMAT-YES-OR-NO.
007600* NO FORMATTING NEEDED.
007700

You can use listing A.46 to test yesorno.cbl. Code, compile, and link, if necessary, both programs. Then run yntest01.cbl.

TYPE: Listing A.46. Testing `yesorno.cbl`.

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. YNTEST01.
000300*--------------------------------
000400* Testing YESORNO Entry
000500*--------------------------------
000600 ENVIRONMENT DIVISION.
000700 INPUT-OUTPUT SECTION.
000800 FILE-CONTROL.
000900
001000 DATA DIVISION.
001100 FILE SECTION.
001200
001300 WORKING-STORAGE SECTION.
001400
001500 77  YES-NO         PIC X.
001600
001700 PROCEDURE DIVISION.
001800 PROGRAM-BEGIN.
001900     PERFORM OPENING-PROCEDURE.
002000     PERFORM MAIN-PROCESS.
002100     PERFORM CLOSING-PROCEDURE.
002200
002300 PROGRAM-EXIT.
002400     EXIT PROGRAM.
002500
002600 PROGRAM-DONE.
002700     STOP RUN.
002800
002900 OPENING-PROCEDURE.
003000
003100 CLOSING-PROCEDURE.
003200
003300 MAIN-PROCESS.
003400     PERFORM DO-WE-CONTINUE.
003500
003600     IF YES-NO = "Y"
003700         DISPLAY "YOU DO WANT TO CONTINUE"
003800     ELSE
003900         DISPLAY "YOU DON'T WANT TO CONTINUE".
004000
004100 DO-WE-CONTINUE.
004200     DISPLAY "SHALL I CONTINUE?".
004300     CALL "YESORNO" USING YES-NO.
004400

The output of yntest01.cbl and yesorno.cbl is marked to indicate which program is producing which part of the display:

OUTPUT:

SHALL I CONTINUE?                  <- yntest01.cbl
ENTER YES OR NO (Y/N)?             <- yesorno.cbl
X                                  <- user entry in yesorno.cbl
YOU MUST ENTER `Y' OR `N'          <- yesorno.cbl
ENTER YES OR NO (Y/N)?             <- yesorno.cbl
Y                                  <- user entry in yesorno.cbl
YOU DO WANT TO CONTINUE            <- yntest01.cbl

Answers to Bonus Day 3, "Full- Screen I/O"

Quiz

1. Lines 008300 and 008500 will create display fields that are not modifiable.

2. Line 008400 will create a display field that is modifiable.

Exercise

Listing A.47 will maintain the state code file using full screens.

TYPE: Listing A.47. State code maintenance.

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. STCMNT05.
000300*--------------------------------
000400* Add, Change, Inquire and Delete
000500* for the State Codes File.
000600* Calls the state codes report
000700* Uses full screen IO
000800*--------------------------------
000900 ENVIRONMENT DIVISION.
001000 INPUT-OUTPUT SECTION.
001100 FILE-CONTROL.
001200
001300     COPY "SLSTATE.CBL".
001400
001500 DATA DIVISION.
001600 FILE SECTION.
001700
001800     COPY "FDSTATE.CBL".
001900
002000 WORKING-STORAGE SECTION.
002100
002200 77  MENU-PICK                    PIC 9 VALUE ZERO.
002300     88  MENU-PICK-IS-VALID       VALUES 0 THRU 5.
002400
002500 77  STATE-RECORD-FOUND           PIC X.
002600
002700 77  SCREEN-ERROR                 PIC X.
002800 77  ERROR-MESSAGE                PIC X(79) VALUE SPACE.
002900
003000 77  CONTINUE-MESSAGE             PIC X(40) VALUE SPACE.
003100 77  OK-TO-CONTINUE               PIC X.
003200
003300 01  FOOTER-FIELD.
003400     05  FOOTER-1-FIELD           PIC X(40) VALUE SPACE.
003500     05  FOOTER-2-FIELD           PIC X(39) VALUE SPACE.
003600
003700     COPY "WSCASE01.CBL".
003800
003900 SCREEN SECTION.
004000 01  MENU-SCREEN.
004100     05  BLANK SCREEN.
004200     05  LINE  2 COLUMN 30 VALUE "STATE CODE MAINTENANCE".
004300     05  LINE  6 COLUMN 20 VALUE "PLEASE SELECT:".
004400     05  LINE  8 COLUMN 25 VALUE "1. ADD RECORDS".
004500     05  LINE  9 COLUMN 25 VALUE "2. CHANGE A RECORD".
004600     05  LINE 10 COLUMN 25 VALUE "3. LOOK UP A RECORD".
004700     05  LINE 11 COLUMN 25 VALUE "4. DELETE A RECORD".
004800     05  LINE 12 COLUMN 25 VALUE "5. PRINT RECORDS".
004900     05  LINE 14 COLUMN 25 VALUE "0. EXIT".
005000     05  LINE 20 COLUMN  1 VALUE "YOUR SELECTION? ".
005100     05  LINE 20 COLUMN 17 PIC Z USING MENU-PICK.
005200     05  LINE 24 COLUMN  1 PIC X(79) FROM ERROR-MESSAGE.
005300
005400 01  KEY-SCREEN.
005500     05  BLANK SCREEN.
005600     05  LINE  8 COLUMN 20 VALUE "STATE CODE:".
005700     05  LINE  8 COLUMN 40 PIC XX USING STATE-CODE.
005800     05  LINE 22 COLUMN  1 PIC X(79) FROM FOOTER-FIELD.
005900     05  LINE 24 COLUMN  1 PIC X(79) FROM ERROR-MESSAGE.
006000
006100 01  ENTRY-SCREEN.
006200     05  BLANK SCREEN.
006300     05  LINE  8 COLUMN 20 VALUE "STATE CODE:".
006400     05  LINE  8 COLUMN 40 PIC XX FROM STATE-CODE.
006500     05  LINE 10 COLUMN 20 VALUE "STATE NAME: ".
006600     05  LINE 10 COLUMN 40 PIC X(20) USING STATE-NAME.
006700     05  LINE 22 COLUMN  1 PIC X(79) FROM FOOTER-FIELD.
006800     05  LINE 23 COLUMN  1 PIC X(40) FROM CONTINUE-MESSAGE.
006900     05  LINE 23 COLUMN 41 PIC X USING OK-TO-CONTINUE.
007000     05  LINE 24 COLUMN  1 PIC X(79) FROM ERROR-MESSAGE.
007100
007200 01  DISPLAY-SCREEN.
007300     05  BLANK SCREEN.
007400     05  LINE  8 COLUMN 20 VALUE "STATE CODE:".
007500     05  LINE  8 COLUMN 40 PIC XX FROM STATE-CODE.
007600     05  LINE 10 COLUMN 20 VALUE "STATE NAME: ".
007700     05  LINE 10 COLUMN 40 PIC X(20) FROM STATE-NAME.
007800     05  LINE 23 COLUMN  1 PIC X(40) FROM CONTINUE-MESSAGE.
007900     05  LINE 23 COLUMN 41 PIC X USING OK-TO-CONTINUE.
008000     05  LINE 24 COLUMN  1 PIC X(79) FROM ERROR-MESSAGE.
008100
008200 PROCEDURE DIVISION.
008300 PROGRAM-BEGIN.
008400     PERFORM OPENING-PROCEDURE.
008500     PERFORM MAIN-PROCESS.
008600     PERFORM CLOSING-PROCEDURE.
008700
008800 PROGRAM-EXIT.
008900     EXIT PROGRAM.
009000
009100 PROGRAM-DONE.
009200     STOP RUN.
009300
009400 OPENING-PROCEDURE.
009500     OPEN I-O STATE-FILE.
009600
009700 CLOSING-PROCEDURE.
009800     CLOSE STATE-FILE.
009900
010000 MAIN-PROCESS.
010100     PERFORM GET-MENU-PICK.
010200     PERFORM MAINTAIN-THE-FILE
010300         UNTIL MENU-PICK = 0.
010400
010500*--------------------------------
010600* MENU
010700*--------------------------------
010800 GET-MENU-PICK.
010900     PERFORM INITIALIZE-MENU-PICK.
011000     PERFORM DISPLAY-ACCEPT-MENU.
011100     PERFORM RE-DISPLAY-ACCEPT-MENU
011200         UNTIL MENU-PICK-IS-VALID.
011300
011400 INITIALIZE-MENU-PICK.
011500     MOVE 0 TO MENU-PICK.
011600
011700 DISPLAY-ACCEPT-MENU.
011800     DISPLAY MENU-SCREEN.
011900     ACCEPT MENU-SCREEN.
012000     MOVE SPACE TO ERROR-MESSAGE.
012100
012200 RE-DISPLAY-ACCEPT-MENU.
012300     MOVE "INVALID SELECTION - PLEASE RE-TRY."
012400           TO ERROR-MESSAGE.
012500     PERFORM DISPLAY-ACCEPT-MENU.
012600
012700 MAINTAIN-THE-FILE.
012800     PERFORM DO-THE-PICK.
012900     PERFORM GET-MENU-PICK.
013000
013100 DO-THE-PICK.
013200     IF MENU-PICK = 1
013300         PERFORM ADD-MODE
013400     ELSE
013500     IF MENU-PICK = 2
013600         PERFORM CHANGE-MODE
013700     ELSE
013800     IF MENU-PICK = 3
013900         PERFORM INQUIRE-MODE
014000     ELSE
014100     IF MENU-PICK = 4
014200         PERFORM DELETE-MODE
014300     ELSE
014400     IF MENU-PICK = 5
014500         PERFORM PRINT-STATE-REPORT.
014600
014700*--------------------------------
014800* ADD
014900*--------------------------------
015000 ADD-MODE.
015100     PERFORM INITIALIZE-ADD-MODE.
015200     PERFORM GET-NEW-RECORD-KEY.
015300     PERFORM ADD-RECORDS
015400        UNTIL STATE-CODE = "ZZ".
015500
015600 INITIALIZE-ADD-MODE.
015700     MOVE "ENTER THE STATE CODE TO ADD"
015800       TO FOOTER-1-FIELD.
015900
016000 GET-NEW-RECORD-KEY.
016100     PERFORM ACCEPT-NEW-RECORD-KEY.
016200     PERFORM RE-ACCEPT-NEW-RECORD-KEY
016300        UNTIL STATE-CODE = "ZZ"
016400           OR STATE-RECORD-FOUND = "N".
016500
016600 ACCEPT-NEW-RECORD-KEY.
016700     PERFORM INITIALIZE-STATE-FIELDS.
016800     PERFORM ENTER-STATE-CODE.
016900     PERFORM ENTER-STATE-CODE
017000         UNTIL STATE-CODE NOT = SPACE.
017100     IF STATE-CODE NOT = "ZZ"
017200         PERFORM READ-STATE-RECORD.
017300
017400 RE-ACCEPT-NEW-RECORD-KEY.
017500     MOVE "RECORD ALREADY ON FILE" TO ERROR-MESSAGE.
017600     PERFORM ACCEPT-NEW-RECORD-KEY.
017700
017800 ADD-RECORDS.
017900     PERFORM INITIALIZE-TO-ADD-FIELDS.
018000     PERFORM ENTER-REMAINING-FIELDS.
018100     IF OK-TO-CONTINUE = "Y"
018200         PERFORM WRITE-STATE-RECORD.
018300     PERFORM GET-NEW-RECORD-KEY.
018400
018500 INITIALIZE-TO-ADD-FIELDS.
018600     MOVE "ADD NEW FIELDS" TO FOOTER-FIELD.
018700     MOVE "CONTINUE WITH ADDITIONS (Y/N)?"
018800         TO CONTINUE-MESSAGE.
018900     MOVE "Y" TO OK-TO-CONTINUE.
019000
019100*--------------------------------
019200* CHANGE
019300*--------------------------------
019400 CHANGE-MODE.
019500     PERFORM INITIALIZE-CHANGE-MODE.
019600     PERFORM GET-EXISTING-RECORD.
019700     PERFORM CHANGE-RECORDS
019800        UNTIL STATE-CODE = "ZZ".
019900
020000 INITIALIZE-CHANGE-MODE.
020100     MOVE "ENTER THE STATE CODE TO CHANGE"
020200        TO FOOTER-1-FIELD.
020300
020400 CHANGE-RECORDS.
020500     PERFORM INITIALIZE-TO-CHANGE-FIELDS.
020600     PERFORM ENTER-REMAINING-FIELDS.
020700     IF OK-TO-CONTINUE = "Y"
020800         PERFORM REWRITE-STATE-RECORD.
020900     PERFORM GET-EXISTING-RECORD.
021000
021100 INITIALIZE-TO-CHANGE-FIELDS.
021200     MOVE "CHANGE FIELDS" TO FOOTER-FIELD.
021300     MOVE "CONTINUE WITH CHANGES (Y/N)?"
021400        TO CONTINUE-MESSAGE.
021500     MOVE "Y" TO OK-TO-CONTINUE.
021600
021700*--------------------------------
021800* INQUIRE
021900*--------------------------------
022000 INQUIRE-MODE.
022100     PERFORM INITIALIZE-INQUIRE-MODE.
022200     PERFORM GET-EXISTING-RECORD.
022300     PERFORM INQUIRE-RECORDS
022400        UNTIL STATE-CODE = "ZZ".
022500
022600 INITIALIZE-INQUIRE-MODE.
022700     MOVE "ENTER THE STATE CODE TO DISPLAY"
022800        TO FOOTER-1-FIELD.
022900
023000 INQUIRE-RECORDS.
023100     PERFORM INITIALIZE-TO-INQUIRE.
023200     PERFORM DISPLAY-ACCEPT-ALL-FIELDS.
023300     PERFORM GET-EXISTING-RECORD.
023400
023500 INITIALIZE-TO-INQUIRE.
023600     MOVE "PRESS ENTER TO CONTINUE" TO CONTINUE-MESSAGE.
023700     MOVE SPACE TO OK-TO-CONTINUE.
023800
023900*--------------------------------
024000* DELETE
024100*--------------------------------
024200 DELETE-MODE.
024300     PERFORM INITIALIZE-DELETE-MODE.
024400     PERFORM GET-EXISTING-RECORD.
024500     PERFORM DELETE-RECORDS
024600        UNTIL STATE-CODE = "ZZ".
024700
024800 INITIALIZE-DELETE-MODE.
024900     MOVE "ENTER THE STATE CODE TO DELETE"
025000       TO FOOTER-1-FIELD.
025100
025200 DELETE-RECORDS.
025300     PERFORM INITIALIZE-TO-DELETE-RECORD.
025400     PERFORM ASK-OK-TO-DELETE.
025500     IF OK-TO-CONTINUE = "Y"
025600         PERFORM DELETE-STATE-RECORD.
025700     PERFORM GET-EXISTING-RECORD.
025800
025900 INITIALIZE-TO-DELETE-RECORD.
026000     MOVE "OK TO DELETE(Y/N)?" TO CONTINUE-MESSAGE.
026100     MOVE "N" TO OK-TO-CONTINUE.
026200
026300 ASK-OK-TO-DELETE.
026400     PERFORM DISPLAY-ACCEPT-ALL-FIELDS.
026500     PERFORM RE-DISPLAY-ACCEPT-ALL-FIELDS
026600        UNTIL OK-TO-CONTINUE = "Y" OR "N".
026700
026800 RE-DISPLAY-ACCEPT-ALL-FIELDS.
026900     MOVE "YOU MUST ENTER YES OR NO"
027000         TO ERROR-MESSAGE.
027100     PERFORM DISPLAY-ACCEPT-ALL-FIELDS.
027200
027300*--------------------------------
027400* Routines shared by all modes
027500*--------------------------------
027600 INITIALIZE-STATE-FIELDS.
027700     MOVE SPACE TO STATE-RECORD.
027800
027900 ENTER-STATE-CODE.
028000     MOVE "ENTER `ZZ' TO QUIT" TO FOOTER-2-FIELD.
028100     DISPLAY KEY-SCREEN.
028200     ACCEPT KEY-SCREEN.
028300     MOVE SPACE TO ERROR-MESSAGE.
028400
028500     INSPECT STATE-CODE
028600         CONVERTING LOWER-ALPHA
028700         TO         UPPER-ALPHA.
028800
028900     IF STATE-CODE = SPACE
029000         MOVE "YOU MUST ENTER STATE CODE"
029100           TO ERROR-MESSAGE.
029200
029300*--------------------------------
029400* Routines shared Add and Change
029500*--------------------------------
029600 ENTER-REMAINING-FIELDS.
029700     PERFORM DISPLAY-ACCEPT-ENTRY-SCREEN.
029800     PERFORM DISPLAY-ACCEPT-ENTRY-SCREEN
029900         UNTIL SCREEN-ERROR = "N"
030000            OR OK-TO-CONTINUE = "N".
030100
030200 DISPLAY-ACCEPT-ENTRY-SCREEN.
030300     DISPLAY ENTRY-SCREEN.
030400     ACCEPT ENTRY-SCREEN.
030500     MOVE SPACE TO ERROR-MESSAGE.
030600
030700     INSPECT OK-TO-CONTINUE
030800      CONVERTING LOWER-ALPHA TO UPPER-ALPHA.
030900
031000     IF OK-TO-CONTINUE = "Y"
031100         PERFORM EDIT-CHECK-FIELDS.
031200
031300 EDIT-CHECK-FIELDS.
031400     MOVE "N" TO SCREEN-ERROR.
031500     PERFORM EDIT-CHECK-STATE-NAME.
031600
031700 EDIT-CHECK-STATE-NAME.
031800     INSPECT STATE-NAME
031900         CONVERTING LOWER-ALPHA
032000         TO         UPPER-ALPHA.
032100
032200     IF STATE-NAME = SPACES
032300         MOVE "Y" TO SCREEN-ERROR
032400         MOVE "STATE NAME MUST BE ENTERED"
032500            TO ERROR-MESSAGE.
032600
032700*--------------------------------
032800* Routines shared by Change,
032900* Inquire and Delete
033000*--------------------------------
033100 GET-EXISTING-RECORD.
033200     PERFORM INITIALIZE-STATE-FIELDS.
033300     PERFORM ACCEPT-EXISTING-KEY.
033400     PERFORM RE-ACCEPT-EXISTING-KEY
033500         UNTIL STATE-RECORD-FOUND = "Y" OR
033600               STATE-CODE = "ZZ".
033700
033800 ACCEPT-EXISTING-KEY.
033900     PERFORM ENTER-STATE-CODE.
034000     PERFORM ENTER-STATE-CODE
034100         UNTIL STATE-CODE NOT = SPACE.
034200     IF STATE-CODE NOT = "ZZ"
034300         PERFORM READ-STATE-RECORD.
034400
034500 RE-ACCEPT-EXISTING-KEY.
034600     MOVE "RECORD NOT FOUND" TO ERROR-MESSAGE.
034700     PERFORM ACCEPT-EXISTING-KEY.
034800
034900*--------------------------------
035000* Routines shared by delete and inquire
035100*--------------------------------
035200 DISPLAY-ACCEPT-ALL-FIELDS.
035300     DISPLAY DISPLAY-SCREEN.
035400     ACCEPT DISPLAY-SCREEN.
035500     MOVE SPACE TO ERROR-MESSAGE.
035600     INSPECT OK-TO-CONTINUE
035700      CONVERTING LOWER-ALPHA TO UPPER-ALPHA.
035800
035900*--------------------------------
036000* File I-O Routines
036100*--------------------------------
036200 WRITE-STATE-RECORD.
036300     WRITE STATE-RECORD
036400         INVALID KEY
036500         DISPLAY "RECORD ALREADY ON FILE".
036600
036700 REWRITE-STATE-RECORD.
036800     REWRITE STATE-RECORD
036900         INVALID KEY
037000         DISPLAY "ERROR REWRITING STATE RECORD".
037100
037200 DELETE-STATE-RECORD.
037300     DELETE STATE-FILE RECORD
037400         INVALID KEY
037500         DISPLAY "ERROR DELETING STATE RECORD".
037600
037700 READ-STATE-RECORD.
037800     MOVE "Y" TO STATE-RECORD-FOUND.
037900     READ STATE-FILE RECORD
038000       INVALID KEY
038100          MOVE "N" TO STATE-RECORD-FOUND.
038200
038300*--------------------------------
038400* CALLS TO OTHER PROGRAMS
038500*--------------------------------
038600
038700*--------------------------------
038800* PRINT
038900*--------------------------------
039000 PRINT-STATE-REPORT.
039100     PERFORM CLOSING-PROCEDURE.
039200     DISPLAY "REPORT IN PROGRESS".
039300     CALL "STCRPT02".
039400     PERFORM OPENING-PROCEDURE.
039500

Sample output from stcmnt05.cbl illustrates some of the screens created by the program:

OUTPUT:

                             STATE CODE MAINTENANCE

                    PLEASE SELECT:

                         1. ADD RECORDS
                         2. CHANGE A RECORD
                         3. LOOK UP A RECORD
                         4. DELETE A RECORD
                         5. PRINT RECORDS

                         0. EXIT

YOUR SELECTION?

------------------------------<next screen>------------------------

                    STATE CODE:         __

ENTER THE STATE CODE TO CHANGE          ENTER `ZZ' TO QUIT

------------------------------<next screen>------------------------

                    STATE CODE:         wx

ENTER THE STATE CODE TO CHANGE          ENTER `ZZ' TO QUIT

RECORD NOT FOUND

Answers to Bonus Day 4, "Using a Symbolic Debugger"

Quiz

The value in A-NUMBER before Line 018500 will be 10. The value before line 018600 will be 11.

Exercises

1. No answer, just practice with the debugger.

2. No answer, just practice with the debugger.

Answers to Bonus Day 5, "Intrinsic Functions and the Year 2000"

Quiz

The value in RESULT will be the remainder of 15 divided by 4, which is 3.

Exercise

Listing A.48 is the original DATE-CHECK routine from PLDATE01.CBL. Listing A.49 is an alternative routine using the REM function. Listing A.50 provides another solution. In Listing A.50 the REM function is used directly to return a numeric value, and the DATE-REMAINDER field is not needed in WORKING-STORAGE.

TYPE: Listing A.48. The original `CHECK-DATE` routine.

021400 CHECK-DATE.
021500     MOVE "Y" TO VALID-DATE-FLAG.
021600     IF DATE-CCYYMMDD = ZEROES
021700         IF ZERO-DATE-IS-OK = "Y"
021800             MOVE "0" TO VALID-DATE-FLAG
021900         ELSE
022000             MOVE "N" TO VALID-DATE-FLAG
022100     ELSE
022200     IF DATE-MM < 1 OR DATE-MM > 12
022300         MOVE "N" TO VALID-DATE-FLAG
022400     ELSE
022500     IF DATE-DD < 1 OR DATE-DD > 31
022600         MOVE "N" TO VALID-DATE-FLAG
022700     ELSE
022800     IF (DATE-DD > 30) AND
022900        (DATE-MM = 2 OR 4 OR 6 OR 9 OR 11)
023000         MOVE "N" TO VALID-DATE-FLAG
023100     ELSE
023200     IF DATE-DD > 29 AND DATE-MM = 2
023300         MOVE "N" TO VALID-DATE-FLAG
023400     ELSE
023500     IF DATE-DD = 29 AND DATE-MM = 2
023600         DIVIDE DATE-CCYY BY 400 GIVING DATE-QUOTIENT
023700                REMAINDER DATE-REMAINDER
023800         IF DATE-REMAINDER = 0
023900             MOVE "Y" TO VALID-DATE-FLAG
024000         ELSE
024100             DIVIDE DATE-CCYY BY 100 GIVING DATE-QUOTIENT
024200                    REMAINDER DATE-REMAINDER
024300             IF DATE-REMAINDER = 0
024400                 MOVE "N" TO VALID-DATE-FLAG
024500             ELSE
024600                 DIVIDE DATE-CCYY BY 4 GIVING DATE-QUOTIENT
024700                        REMAINDER DATE-REMAINDER
024800                 IF DATE-REMAINDER = 0
024900                     MOVE "Y" TO VALID-DATE-FLAG
025000                 ELSE
025100                     MOVE "N" TO VALID-DATE-FLAG.

TYPE: Listing A.49. `CHECK-DATE` using the `REM` Function.

021400 CHECK-DATE.
021500     MOVE "Y" TO VALID-DATE-FLAG.
021600     IF DATE-CCYYMMDD = ZEROES
021700         IF ZERO-DATE-IS-OK = "Y"
021800             MOVE "0" TO VALID-DATE-FLAG
021900         ELSE
022000             MOVE "N" TO VALID-DATE-FLAG
022100     ELSE
022200     IF DATE-MM < 1 OR DATE-MM > 12
022300         MOVE "N" TO VALID-DATE-FLAG
022400     ELSE
022500     IF DATE-DD < 1 OR DATE-DD > 31
022600         MOVE "N" TO VALID-DATE-FLAG
022700     ELSE
022800     IF (DATE-DD > 30) AND
022900        (DATE-MM = 2 OR 4 OR 6 OR 9 OR 11)
023000         MOVE "N" TO VALID-DATE-FLAG
023100     ELSE
023200     IF DATE-DD > 29 AND DATE-MM = 2
023300         MOVE "N" TO VALID-DATE-FLAG
023400     ELSE
023500     IF DATE-DD = 29 AND DATE-MM = 2
023600         COMPUTE DATE-REMAINDER = FUNCTION REM(DATE-CCYY, 400)
023700
023800         IF DATE-REMAINDER = 0
023900             MOVE "Y" TO VALID-DATE-FLAG
024000         ELSE
024100             COMPUTE DATE-REMAINDER = FUNCTION REM(DATE-CCYY,100)
024200
024300             IF DATE-REMAINDER = 0
024400                 MOVE "N" TO VALID-DATE-FLAG
024500             ELSE
024600                 COMPUTE DATE-REMAINDER =
024700                             FUNCTION REM(DATE-CCYY,100)
024800                 IF DATE-REMAINDER = 0
024900                     MOVE "Y" TO VALID-DATE-FLAG
025000                 ELSE
025100                     MOVE "N" TO VALID-DATE-FLAG.

TYPE: Listing A.50. Another version of `CHECK-DATE`.

021400 CHECK-DATE.
021500     MOVE "Y" TO VALID-DATE-FLAG.
021600     IF DATE-CCYYMMDD = ZEROES
021700         IF ZERO-DATE-IS-OK = "Y"
021800             MOVE "0" TO VALID-DATE-FLAG
021900         ELSE
022000             MOVE "N" TO VALID-DATE-FLAG
022100     ELSE
022200     IF DATE-MM < 1 OR DATE-MM > 12
022300         MOVE "N" TO VALID-DATE-FLAG
022400     ELSE
022500     IF DATE-DD < 1 OR DATE-DD > 31
022600         MOVE "N" TO VALID-DATE-FLAG
022700     ELSE
022800     IF (DATE-DD > 30) AND
022900        (DATE-MM = 2 OR 4 OR 6 OR 9 OR 11)
023000         MOVE "N" TO VALID-DATE-FLAG
023100     ELSE
023200     IF DATE-DD > 29 AND DATE-MM = 2
023300         MOVE "N" TO VALID-DATE-FLAG
023400     ELSE
023500     IF DATE-DD = 29 AND DATE-MM = 2
023600         IF FUNCTION REM(DATE-CCYY, 400) = 0
023700             MOVE "Y" TO VALID-DATE-FLAG
023800         ELSE
023900             IF FUNCTION REM(DATE-CCYY,100) = 0
024000                 MOVE "N" TO VALID-DATE-FLAG
024100             ELSE
024200                 IF FUNCTION REM(DATE-CCYY,100) = 0
024300                     MOVE "Y" TO VALID-DATE-FLAG
024400                 ELSE
024500                     MOVE "N" TO VALID-DATE-FLAG.

Answers to Bonus Day 6, "Dates and the Year 2000"

Quiz

1. Lilian and ANSI days dating both use a base date and calculate dates as a number of days from the base date. Lilian uses Friday, October 15, 1582 as day 1; ANSI uses Monday, January 1, 1601 as day 1.

2. The remainder of 15 divided by 4 is 3, the value that will be stored in RESULT.

3. A year is a leap year if it is

Evenly divisible by 4
But not if it is evenly divisible by 100
Unless it is also evenly divisible by 400.

4. 1996, 2000, and 1600 are all leap years. 1700, 1901, and 1955 are not.

Exercise

Listing A.51 shows DDIF.CBL is one possible solution to the day difference problem.

TYPE: Listing A.51. `DDIF.CBL` calculating the number of days between two dates.

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. DDIF.
000300 AUTHOR. MO BUDLONG.
000400 INSTALLATION.
000500 DATE-WRITTEN. 09/07/96.
000600 DATE-COMPILED.
000700 SECURITY. NONE
000800 ENVIRONMENT DIVISION.
000900 INPUT-OUTPUT SECTION.
001000 FILE-CONTROL.
001100 DATA DIVISION.
001200 FILE SECTION.
001300 WORKING-STORAGE SECTION.
001400
001500 01  LARGER-DATE              PIC 9(8).
001600 01  SMALLER-DATE             PIC 9(8).
001700 01  LARGER-ANSI              PIC 9(8).
001800 01  SMALLER-ANSI             PIC 9(8).
001900 01  DAYS-DIFF                PIC S9(5).
002000 01  FORMAT-DAYS-DIFF         PIC ZZZZ9-.
002100
002200 01  DUMMY     PIC X.
002300
002400 PROCEDURE DIVISION.
002500 MAIN-LOGIC SECTION.
002600 PROGRAM-BEGIN.
002700
002800     PERFORM OPENING-PROCEDURE.
002900     PERFORM MAIN-PROCESS.
003000     PERFORM CLOSING-PROCEDURE.
003100
003200 EXIT-PROGRAM.
003300     EXIT PROGRAM.
003400 STOP-RUN.
003500     STOP RUN.
003600
003700
003800 THE-OTHER SECTION.
003900
004000 OPENING-PROCEDURE.
004100 CLOSING-PROCEDURE.
004200 MAIN-PROCESS.
004300     MOVE 1 TO LARGER-DATE, SMALLER-DATE.
004400     PERFORM ENTER-PARAMETERS.
004500     PERFORM TEST-DDIF UNTIL
004600            LARGER-DATE = 0
004700         OR SMALLER-DATE = 0.
004800
004900 ENTER-PARAMETERS.
005000     DISPLAY "ENTER LARGER DATE AS YYYYMMDD(0 TO QUIT)".
005100     ACCEPT LARGER-DATE.
005200     IF LARGER-DATE NOT = 0
005300         DISPLAY "ENTER SMALLER DATE AS YYYYMMDD (0 TO QUIT)"
005400         ACCEPT SMALLER-DATE.
005500
005600 TEST-DDIF.
005700     COMPUTE LARGER-ANSI =
005800      FUNCTION INTEGER-OF-DATE(LARGER-DATE).
005900     COMPUTE SMALLER-ANSI =
006000      FUNCTION INTEGER-OF-DATE(SMALLER-DATE).
006100
006200     COMPUTE DAYS-DIFF = LARGER-ANSI - SMALLER-ANSI.
006300     MOVE DAYS-DIFF TO FORMAT-DAYS-DIFF.
006400     DISPLAY
006500       "DIFFERENCE BETWEEN " LARGER-DATE
006600       " AND " SMALLER-DATE
006700       " IS " FORMAT-DAYS-DIFF.
006800
006900     PERFORM ENTER-PARAMETERS.
007000

The following is a sample output screen from the program, showing that the answer is still correct even if the user enters the information incorrectly.

OUTPUT:

* Accepted - CONFIRM
ENTER LARGER DATE AS YYYYMMDD(0 TO QUIT)
19970112
ENTER SMALLER DATE AS YYYYMMDD (0 TO QUIT)
19970110
DIFFERENCE BETWEEN 19970112 AND 19970110 IS     2
ENTER LARGER DATE AS YYYYMMDD(0 TO QUIT)
19970112
ENTER SMALLER DATE AS YYYYMMDD (0 TO QUIT)
19970114
DIFFERENCE BETWEEN 19970112 AND 19970114 IS     2-
ENTER LARGER DATE AS YYYYMMDD(0 TO QUIT)

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.

TYPE: Listing A.25. Inquire mode.

TYPE: Listing A.26. Delete mode.

TYPE: Listing A.27. Menu actions.

Answers to Day 15, "Data Integrity"

Quiz

TYPE: Listing A.28. Converting to uppercase.

TYPE: Listing A.29. Converting to lowercase.

Exercises

TYPE: Listing A.30. Entering, validating, and converting a VENDOR-NAME.

Answers to Day 16, "Using Look Up and Arrays"

Quiz

Exercises

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

TYPE: Listing A.30. Entering, validating, and converting a `VENDOR-NAME`.

TYPE: Listing A.33. Changes to `vnddsp03.cbl`.

TYPE: Listing A.34. Changes for `vndmnt05.cbl`.

TYPE: Listing A.35. The changes for `bilmnu02.cbl`.

TYPE: Listing A.36. `REDEFINES` within a `REDEFINES`.

TYPE: Listing A.38. `WORKING-STORAGE` for `CHECK-TIME`.

TYPE: Listing A.39. The `CHECK-TIME` routine.

TYPE: Listing A.40. `TIME01` testing time logic.

TYPE: Listing A.43. The changes needed to create `slsrpt02.cbl`.

TYPE: Listing A.45. A subroutine to get `YES` or `NO`.

TYPE: Listing A.46. Testing `yesorno.cbl`.

TYPE: Listing A.48. The original `CHECK-DATE` routine.

TYPE: Listing A.49. `CHECK-DATE` using the `REM` Function.

TYPE: Listing A.50. Another version of `CHECK-DATE`.

TYPE: Listing A.51. `DDIF.CBL` calculating the number of days between two dates.