Teach Yourself COBOL in 21 days, Second Edition

Previous chapterNext chapterContents


- Day 20 -
More Complex Data Entry

You now have mastered some of the complex data entry problems that a program might have to tackle. It is time to put this new knowledge to use. Today and in Day 21, "Selecting, Sorting, and Reporting," you will complete all the pieces needed for the bills payment system described in Day 19, "Complex Data Entry Problems."

Today, you learn about the following parts of the bills payment system:

Maintaining the Voucher File

Figure 20.1 highlights the parts of the bills payment system that will be covered today--steps 2, 7, and 12. This section of the chapter deals with step 2 of the process.

A voucher is created every time a bill arrives. The voucher record contains important information needed for selecting the bill for payment and for tracking the bill, such as due date, vendor, amount, and invoice number.

Voucher Entry, highlighted as step 2 of Figure 20.1, really is a maintenance program with a few extra features. Listing 20.1 is vchmnt01.cbl. When an invoice is received, the voucher entry cycle begins, starting with adding a voucher for the invoice to the system. Although the primary use of vchmnt01.cbl is to add new vouchers to the voucher file, it is possible at any time in the life of a voucher that it might have to be changed or deleted. vchmnt01.cbl is a complete maintenance module that primarily is used in add mode.

Figure 20.1.
The bills payment system with steps 2, 7, and 12 highlighted.

TYPE: Listing 20.1. Voucher entry.

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

Here is the sample output of vchmnt01.cbl as new vouchers are added:

OUTPUT:

PLEASE SELECT:
1.  ADD RECORDS
2.  CHANGE A RECORD
3.  LOOK UP A RECORD
4.  DELETE A RECORD
0.  EXIT
YOUR CHOICE (0-4)?
1

VOUCHER NUMBER: 00004
ENTER VENDOR
2

1. VENDOR: 00002 ABC PRINTING
ENTER INVOICE NUMBER
cx-5055
WHAT FOR?
letter head
ENTER INVOICE AMOUNT
104.19
ENTER INVOICE DATE(MM/DD/CCYY)?
01/07/1997
ENTER DUE DATE(MM/DD/CCYY)?
02/07/1997
IS THIS TAX DEDUCTIBLE?
y
ADD ANOTHER VOUCHER(Y/N)?
n

PLEASE SELECT:
1.  ADD RECORDS
2.  CHANGE A RECORD
3.  LOOK UP A RECORD
4.  DELETE A RECORD
0.  EXIT
YOUR CHOICE (0-4)?

ANALYSIS: At lines 001200 through 002800, the file definitions for the control file, the voucher file, and the vendor file are included. OPENING-PROCEDURE and CLOSING-PROCEDURE, at lines 006500 and 007300, respectively, appropriately open and close these three files. The voucher file is the main file that is being modified. The vendor file is used to look up vendors when they are entered, and the control file is used to generate new voucher numbers in add mode.

The first big difference occurs in ACCEPT-NEW-RECORD-KEY at line 014900. Rather than ask the user to enter a new voucher number, one is generated automatically by performing RETRIEVE-NEXT-VOUCHER-NUMBER. The RETRIEVE-NEXT-VOUCHER-NUMBER routine at line 015800 reads the control file, adds 1 to the CONTROL-LAST-VOUCHER, and moves the new value to VOUCHER-NUMBER. The routine then rewrites the CONTROL-RECORD, causing the control file to be updated with the last used number. At line 015300, the voucher record is read. This loop, at lines 014900 through 015400, is performed at lines 014200 through 014500 until a voucher number is generated that is not on file. This logic is used in the event that the control file and voucher file get out of synch with each other. By repeating the logic until an unused voucher number is found, the two files become synchronized. This also is useful in multiuser systems where two or more people might be adding to a file at once.

After the new voucher number is generated successfully, it is displayed at line 014700. Usually, a data entry operator writes this voucher number at the top of the physical invoice received so that the invoice is associated with its voucher tracking number.

The data entry for the invoice date begins at line 040700. This routine uses GET-A-DATE in pldate01.cbl (which is included by a COPY statement at line 058800). At line 040800, a zero date is prevented; at lines 040900 through 041200, a special prompt and error message are set up, and then GET-A-DATE is performed. After returning from GET-A-DATE at line 041400, the entered date in DATE-CCYYMMDD is moved to VOUCHER-DATE.

The data entry for the invoice due date begins at line 041600 and uses the identical style of logic to get a valid date for VOUCHER-DUE.

ENTER-VOUCHER-VENDOR at line 032200 looks up the vendor that is entered in the vendor file. The vendor must be on file to be valid.

There is another difference from a standard maintenance module. Four of the fields are reserved to be entered by other programs. These are VOUCHER-SELECTED, VOUCHER-PAID-AMOUNT, VOUCHER-PAID-DATE, and VOUCHER-CHECK-NO.

VOUCHER-SELECTED is a flag that is set when a voucher is selected for payment. The remaining three fields are set when a voucher actually is paid. VOUCHER-SELECTED will be modified by steps 6 and 7 in Figure 20.1, and the other three fields will be modified by step 12 of Figure 20.1. However, there is no reason that the user should not be allowed to see these fields. When deleting records or changing values in the fields that can be modified, it might help if the user can see the selected and paid status of the voucher. In DISPLAY-ALL-FIELDS at line 047000, this program displays the four fields that cannot be modified by the program.

If a voucher is paid, the paid date will not be zeroes, and the VOUCHER-SELECTED field is irrelevant because the voucher obviously has been selected for payment as it has been paid. So, at line 048000, the VOUCHER-SELECTED field is displayed only if the VOUCHER-PAID-DATE is zeroes. Because the voucher has not been paid, the user might want to know whether it has been selected for payment.

If a voucher has been paid, the paid date, amount, and check number all have values. So, at lines 048200 through 048500, VOUCHER-PAID-AMOUNT, VOUCHER-PAID-DATE, and VOUCHER-CHECK-NO are displayed when the VOUCHER-PAID-DATE is not zero.

Code and compile vchmnt01.cbl. Print a list of vendors using the vendor report programs from earlier lessons, and then run vchmnt01.cbl and enter some vouchers as if real invoices had been received.

Selecting Individual Vouchers

The selection of individual vouchers to pay is performed by a maintenance program that runs in change mode only and allows only one field, VOUCHER-SELECTED, to be modified. Listing 20.2 is vchpic01.cbl and allows single vouchers to be selected and the VOUCHER-SELECTED flag to be entered to a yes or no. Step 7 of the flowchart shows where individual selection of bills fits into the flow of activities in the bills payment system. (Refer to Figure 20.1.)

TYPE: Listing 20.2. Selecting records to be paid.

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. VCHPIC01.
000300*--------------------------------
000400* Change only.
000500* Allows the user to change
000600* the VOUCHER-SELECTED flag
000700* for unpaid vouchers
000800*--------------------------------
000900 ENVIRONMENT DIVISION.
001000 INPUT-OUTPUT SECTION.
001100 FILE-CONTROL.
001200
001300     COPY "SLVND02.CBL".
001400
001500     COPY "SLVOUCH.CBL".
001600
001700     COPY "SLCONTRL.CBL".
001800
001900 DATA DIVISION.
002000 FILE SECTION.
002100
002200     COPY "FDVND04.CBL".
002300
002400     COPY "FDVOUCH.CBL".
002500
002600     COPY "FDCONTRL.CBL".
002700
002800 WORKING-STORAGE SECTION.
002900
003000 77  MENU-PICK                    PIC 9.
003100     88  MENU-PICK-IS-VALID       VALUES 0 THRU 4.
003200
003300 77  WHICH-FIELD                  PIC 9.
003400 77  VOUCHER-RECORD-FOUND         PIC X.
003500 77  VENDOR-RECORD-FOUND          PIC X.
003600
003700 77  VOUCHER-NUMBER-FIELD         PIC Z(5).
003800 77  VOUCHER-AMOUNT-FIELD         PIC ZZZ,ZZ9.99-.
003900 77  VOUCHER-PAID-AMOUNT-FIELD    PIC ZZZ,ZZ9.99-.
004000
004100 77  ERROR-MESSAGE                PIC X(79) VALUE SPACE.
004200
004300     COPY "WSCASE01.CBL".
004400
004500     COPY "WSDATE01.CBL".
004600
004700 PROCEDURE DIVISION.
004800 PROGRAM-BEGIN.
004900     PERFORM OPENING-PROCEDURE.
005000     PERFORM MAIN-PROCESS.
005100     PERFORM CLOSING-PROCEDURE.
005200
005300 PROGRAM-EXIT.
005400     EXIT PROGRAM.
005500
005600 PROGRAM-DONE.
005700     STOP RUN.
005800
005900 OPENING-PROCEDURE.
006000     OPEN I-O VOUCHER-FILE.
006100     OPEN I-O VENDOR-FILE.
006200
006300 CLOSING-PROCEDURE.
006400     CLOSE VOUCHER-FILE.
006500     CLOSE VENDOR-FILE.
006600
006700 MAIN-PROCESS.
006800     PERFORM CHANGE-MODE.
006900
007000*--------------------------------
007100* CHANGE
007200*--------------------------------
007300 CHANGE-MODE.
007400     PERFORM GET-EXISTING-RECORD.
007500     PERFORM CHANGE-RECORDS
007600        UNTIL VOUCHER-NUMBER = ZEROES.
007700
007800 CHANGE-RECORDS.
007900     PERFORM GET-FIELD-TO-CHANGE.
008000     IF VOUCHER-PAID-DATE = ZEROES
008100         PERFORM CHANGE-ONE-FIELD.
008200     PERFORM GET-EXISTING-RECORD.
008300
008400 GET-FIELD-TO-CHANGE.
008500     PERFORM DISPLAY-ALL-FIELDS.
008600     PERFORM ASK-WHICH-FIELD.
008700
008800 ASK-WHICH-FIELD.
008900     MOVE 1 TO WHICH-FIELD.
009000
009100 CHANGE-ONE-FIELD.
009200     PERFORM CHANGE-THIS-FIELD.
009300
009400 CHANGE-THIS-FIELD.
009500     IF WHICH-FIELD = 1
009600         PERFORM ENTER-VOUCHER-SELECTED.
009700
009800     PERFORM REWRITE-VOUCHER-RECORD.
009900
010000*--------------------------------
010100* Routines shared by all modes
010200*--------------------------------
010300 INIT-VOUCHER-RECORD.
010400     MOVE SPACE TO VOUCHER-INVOICE
010500                   VOUCHER-FOR
010600                   VOUCHER-DEDUCTIBLE
010700                   VOUCHER-SELECTED.
010800     MOVE ZEROES TO VOUCHER-NUMBER
010900                    VOUCHER-VENDOR
011000                    VOUCHER-AMOUNT
011100                    VOUCHER-DATE
011200                    VOUCHER-DUE
011300                    VOUCHER-PAID-AMOUNT
011400                    VOUCHER-PAID-DATE
011500                    VOUCHER-CHECK-NO.
011600
011700*--------------------------------
011800* Routines shared Add and Change
011900*--------------------------------
012000 ENTER-VOUCHER-SELECTED.
012100     PERFORM ACCEPT-VOUCHER-SELECTED.
012200     PERFORM RE-ACCEPT-VOUCHER-SELECTED
012300         UNTIL VOUCHER-SELECTED = "Y" OR "N".
012400
012500 ACCEPT-VOUCHER-SELECTED.
012600     DISPLAY "SELECT THIS VOUCHER (Y/N)?".
012700     ACCEPT VOUCHER-SELECTED.
012800
012900     INSPECT VOUCHER-SELECTED
013000        CONVERTING LOWER-ALPHA
013100        TO UPPER-ALPHA.
013200
013300 RE-ACCEPT-VOUCHER-SELECTED.
013400     DISPLAY "YOU MUST ENTER YES OR NO".
013500     PERFORM ACCEPT-VOUCHER-SELECTED.
013600
013700*--------------------------------
013800* Routines shared by Change,
013900* Inquire and Delete
014000*--------------------------------
014100 GET-EXISTING-RECORD.
014200     PERFORM ACCEPT-EXISTING-KEY.
014300     PERFORM RE-ACCEPT-EXISTING-KEY
014400         UNTIL VOUCHER-RECORD-FOUND = "Y" OR
014500               VOUCHER-NUMBER = ZEROES.
014600
014700 ACCEPT-EXISTING-KEY.
014800     PERFORM INIT-VOUCHER-RECORD.
014900     PERFORM ENTER-VOUCHER-NUMBER.
015000     IF VOUCHER-NUMBER NOT = ZEROES
015100         PERFORM READ-VOUCHER-RECORD.
015200
015300 RE-ACCEPT-EXISTING-KEY.
015400     DISPLAY "RECORD NOT FOUND".
015500     PERFORM ACCEPT-EXISTING-KEY.
015600
015700 ENTER-VOUCHER-NUMBER.
015800     DISPLAY "ENTER VOUCHER NUMBER TO SELECT OR CLEAR ".
015900     ACCEPT VOUCHER-NUMBER.
016000
016100 DISPLAY-ALL-FIELDS.
016200     DISPLAY " ".
016300     IF VOUCHER-PAID-DATE NOT = ZEROES
016400         DISPLAY " !!! THIS VOUCHER IS ALREADY PAID !!!".
016500     PERFORM DISPLAY-VOUCHER-NUMBER.
016600     PERFORM DISPLAY-VOUCHER-VENDOR.
016700     PERFORM DISPLAY-VOUCHER-INVOICE.
016800     PERFORM DISPLAY-VOUCHER-FOR.
016900     PERFORM DISPLAY-VOUCHER-AMOUNT.
017000     PERFORM DISPLAY-VOUCHER-DATE.
017100     PERFORM DISPLAY-VOUCHER-DUE.
017200     PERFORM DISPLAY-VOUCHER-DEDUCTIBLE.
017300     IF VOUCHER-PAID-DATE = ZEROES
017400         PERFORM DISPLAY-VOUCHER-SELECTED.
017500     IF VOUCHER-PAID-DATE NOT = ZEROES
017600         PERFORM DISPLAY-VOUCHER-PAID-AMOUNT
017700         PERFORM DISPLAY-VOUCHER-PAID-DATE
017800         PERFORM DISPLAY-VOUCHER-CHECK-NO.
017900     DISPLAY " ".
018000
018100 DISPLAY-VOUCHER-NUMBER.
018200     DISPLAY "   VOUCHER NUMBER: " VOUCHER-NUMBER.
018300
018400 DISPLAY-VOUCHER-VENDOR.
018500     PERFORM VOUCHER-VENDOR-ON-FILE.
018600     IF VENDOR-RECORD-FOUND = "N"
018700         MOVE "**Not found**" TO VENDOR-NAME.
018800     DISPLAY "   VENDOR: "
018900             VOUCHER-VENDOR " "
019000             VENDOR-NAME.
019100
019200 VOUCHER-VENDOR-ON-FILE.
019300     MOVE VOUCHER-VENDOR TO VENDOR-NUMBER.
019400     PERFORM READ-VENDOR-RECORD.
019500     IF VENDOR-RECORD-FOUND = "N"
019600         MOVE "VENDOR NOT ON FILE"
019700           TO ERROR-MESSAGE.
019800
019900 DISPLAY-VOUCHER-INVOICE.
020000     DISPLAY "   INVOICE: " VOUCHER-INVOICE.
020100
020200 DISPLAY-VOUCHER-FOR.
020300     DISPLAY "   FOR: " VOUCHER-FOR.
020400
020500 DISPLAY-VOUCHER-AMOUNT.
020600     MOVE VOUCHER-AMOUNT TO VOUCHER-AMOUNT-FIELD.
020700     DISPLAY "   AMOUNT: " VOUCHER-AMOUNT-FIELD.
020800
020900 DISPLAY-VOUCHER-DATE.
021000     MOVE VOUCHER-DATE TO DATE-CCYYMMDD.
021100     PERFORM FORMAT-THE-DATE.
021200     DISPLAY "   INVOICE DATE: " FORMATTED-DATE.
021300
021400 DISPLAY-VOUCHER-DUE.
021500     MOVE VOUCHER-DUE TO DATE-CCYYMMDD.
021600     PERFORM FORMAT-THE-DATE.
021700     DISPLAY "   DUE DATE: " FORMATTED-DATE.
021800
021900 DISPLAY-VOUCHER-DEDUCTIBLE.
022000     DISPLAY "   DEDUCTIBLE: " VOUCHER-DEDUCTIBLE.
022100
022200 DISPLAY-VOUCHER-SELECTED.
022300     DISPLAY "1. SELECTED FOR PAYMENT: " VOUCHER-SELECTED.
022400
022500 DISPLAY-VOUCHER-PAID-AMOUNT.
022600     MOVE VOUCHER-PAID-AMOUNT TO VOUCHER-PAID-AMOUNT-FIELD.
022700     DISPLAY "   PAID: " VOUCHER-PAID-AMOUNT-FIELD.
022800
022900 DISPLAY-VOUCHER-PAID-DATE.
023000     MOVE VOUCHER-PAID-DATE TO DATE-CCYYMMDD.
023100     PERFORM FORMAT-THE-DATE.
023200     DISPLAY "   PAID ON: " FORMATTED-DATE.
023300
023400 DISPLAY-VOUCHER-CHECK-NO.
023500     DISPLAY "   CHECK: " VOUCHER-CHECK-NO.
023600
023700*--------------------------------
023800* File I-O Routines
023900*--------------------------------
024000 READ-VOUCHER-RECORD.
024100     MOVE "Y" TO VOUCHER-RECORD-FOUND.
024200     READ VOUCHER-FILE RECORD
024300       INVALID KEY
024400          MOVE "N" TO VOUCHER-RECORD-FOUND.
024500
024600*or  READ VOUCHER-FILE RECORD WITH LOCK
024700*      INVALID KEY
024800*         MOVE "N" TO VOUCHER-RECORD-FOUND.
024900
025000*or  READ VOUCHER-FILE RECORD WITH HOLD
025100*      INVALID KEY
025200*         MOVE "N" TO VOUCHER-RECORD-FOUND.
025300
025400 REWRITE-VOUCHER-RECORD.
025500     REWRITE VOUCHER-RECORD
025600         INVALID KEY
025700         DISPLAY "ERROR REWRITING VENDOR RECORD".
025800
025900 READ-VENDOR-RECORD.
026000     MOVE "Y" TO VENDOR-RECORD-FOUND.
026100     READ VENDOR-FILE RECORD
026200       INVALID KEY
026300          MOVE "N" TO VENDOR-RECORD-FOUND.
026400
026500     COPY "PLDATE01.CBL".
026600

The output of vchpic01.cbl for a paid and an unpaid voucher follows:

OUTPUT:

ENTER VOUCHER NUMBER TO SELECT OR CLEAR
2
!!! THIS VOUCHER IS ALREADY PAID !!!
VOUCHER NUMBER: 00002
VENDOR: 00002 ABC PRINTING
INVOICE: CX-1407
FOR: BUSINESS CARDS
AMOUNT:      98.97
INVOICE DATE:  1/22/1997
DUE DATE:  2/22/1997
DEDUCTIBLE: Y
PAID:   98.97
PAID ON:  1/28/1997
CHECK: 000466
ENTER VOUCHER NUMBER TO SELECT OR CLEAR
3
VOUCHER NUMBER: 00003
VENDOR: 00003 CHARLES SMITH AND SONS
INVOICE: 5057
FOR: OFFICE SUPPLIES
AMOUNT:      27.76
INVOICE DATE:  1/15/1997
DUE DATE:  1/31/1997
DEDUCTIBLE: Y
1. SELECTED FOR PAYMENT: N
SELECT THIS VOUCHER (Y/N)?
Y

ANALYSIS: The vchpic01.cbl program is a cross between vchmnt01.cbl and a single-field maintenance program such as stcmnt04.cbl--with an extra feature. The user is asked to select a voucher to change. The voucher information is displayed, and the user is asked to enter yes or no for the VOUCHER-SELECTED field.

The extra feature ensures that if the voucher is paid, the record is displayed with a warning message that it has been paid, and the user is not asked to enter the VOUCHER-SELECTED field.

The warning message appears in DISPLAY-ALL-FIELDS at lines 016300 and 016400. The program tests whether VOUCHER-PAID-DATE NOT = ZEROES and displays the warning before displaying the rest of the record.

Data entry for the selected field is prevented at lines 008000 and 008100 in CHANGE-RECORDS. CHANGE-ONE-FIELD is performed only if VOUCHER-PAID-DATE = ZEROES.

A couple of minor changes exist, such as the prompt for the voucher number at line 015800.

Completing the Payment Cycle on a Voucher

It might seem odd to skip to step 12 of the bills payment flowchart at this point, but the programs needed for steps 2, 7, and 12 are closely related. Refer to Figure 20.1 and note the last step of the bills payment cycle. In this section, you look at vchpay01.cbl, the program that flags vouchers as paid.

You might have noticed that programs that allow changes to one or more fields in a file tend to be based on standard add, change, inquire, or delete maintenance modes. The vchpay01.cbl program in Listing 20.3 is no exception.

TYPE: Listing 20.3. Paying vouchers.

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. VCHPAY01.
000300*--------------------------------
000400* Change only.
000500* User can request a voucher.
000600* If the voucher is already paid,
000700* the user is asked if they
000800* would like 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 RE OPENED".
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/CCYY)?"
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
019800* the exact amount of the voucher.
019900* If it is, VOUCHER-AMOUNT
020000* is 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
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           AND VOUCHER-PAID-AMOUNT NOT > VOUCHER-AMOUNT.
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 THAT IS".
027000     DISPLAY "NOT GREATER THAN " 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 sample output for vchpay01.cbl shows voucher 2 being processed as a partial payment of $50.00 on an invoice that was for $98.97. The program indicates that voucher 10 was generated for the balance. Voucher 10 then is processed, and the display confirms that a voucher was created for the balance of the original invoice, $48.97. Voucher 10 is not processed. Finally, voucher 3 is reopened. Here is the output:

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/1997
DUE DATE:  2/22/1997
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/CCYY)?
1/27/1997
PAY THE EXACT AMOUNT      98.97  (Y/N)?
n
ENTER AMOUNT PAID
50
GENERATE A NEW VOUCHER
FOR THE BALANCE (Y/N)?
y
ENTER THE CHECK NUMBER
ENTER 0 FOR CASH PAYMENT
107
VOUCHER    10 CREATED FOR      48.97
ENTER VOUCHER NUMBER TO PROCESS
10
VOUCHER NUMBER: 00010
VENDOR: 00002 ABC PRINTING
INVOICE: CX-1407
FOR: BUSINESS CARDS
AMOUNT:      48.97
INVOICE DATE:  1/22/1997
DUE DATE:  2/22/1997
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)?
n
ENTER VOUCHER NUMBER TO PROCESS
3
VOUCHER NUMBER: 00003
VENDOR: 00003 CHARLES SMITH AND SONS
INVOICE: 5057
FOR: OFFICE SUPPLIES
AMOUNT:      27.76
INVOICE DATE:  1/15/1997
DUE DATE:  1/31/1997
DEDUCTIBLE: Y
SELECTED FOR PAYMENT: N
1. PAID ON:  1/22/1997
2. PAID:      27.76
3. CHECK: 000106
RE-OPEN THIS VOUCHER (Y/N)?
y
VOUCHER HAS BEEN RE OPENED
ENTER VOUCHER NUMBER TO PROCESS

ANALYSIS: Before you look in detail at the analysis of the program, you need to know about some differences between vchpay01.cbl and a standard maintenance module.

The program is in change mode only, but within change mode a user could be making two possible changes. The user could be intending to change a voucher from unpaid to paid, which would be the usual action of the program.

The user might also want to change the status from paid to unpaid for various reasons, such as, if a voucher were flagged as paid in error, or for some reason the actual payment was not valid (because the check bounced or all the cash was counterfeit).

The program also has a special feature that allows the user to enter a partial payment on a voucher. When a partial payment is entered, the voucher is flagged as paid, and a new voucher is written for the balance unpaid. This creates an add records action in the middle of change mode. This is described in more detail in the analysis of the program, and in the description that follows here.

Change mode actually is broken into two different types of changes to handle this: CHANGE-TO-PAID and CHANGE-TO-UNPAID. Either one affects three fields--VOUCHER-PAID-DATE, VOUCHER-PAID-AMOUNT, and VOUCHER-CHECK-NO--but in slightly different ways.

In changing a voucher from unpaid to paid, the user must enter values for all three of these fields. It would be incorrect to enter a paid date, but no paid amount or check number. The user must be forced to enter all three fields and cannot be given the usual choice in change mode of selecting which field to modify.

Reversing the process reopens a voucher by resetting the paid date, paid amount, and check number to zeroes. There is no point in asking the user to enter zeroes for each of these fields, so this is done automatically in the program if reopening of a voucher is selected.

The usual process of the program, changing a voucher from unpaid to paid, is more complicated than just accepting entry of the three fields. On any voucher, you might want to pay the exact amount, overpay the amount (because of late charges), or underpay the amount (as a partial payment).

Rather than directly asking for the amount to be paid, the program first asks the user whether the exact amount of the voucher is to be paid. If so, VOUCHER-AMOUNT is moved to VOUCHER-PAID-AMOUNT, and the user is not required to enter the amount. Otherwise, the user must enter the amount.

In a full accounts payable system (a bills payment system with accounting functions), overpayment probably would not be allowed. If late charges or additional charges were created for an invoice, either the original voucher would have to be modified, or a new voucher would have to be created with the additional charges. The original voucher and the late charges voucher could be paid by the same check. The vchpay01.cbl program also will not allow overpayment.

The last feature of vchpay01.cbl is designed to handle underpayment. The program assumes that underpayment is a partial payment and asks the user whether a new voucher should be generated automatically for the balance of the voucher that was just paid.

This new voucher will sit in the voucher file waiting for the next bills payment cycle. The automated generation saves the user having to hand-enter another copy of the same voucher with the new balance now owing on the invoice and, in the process, also reduces potential data error entries.

Now that you know what to expect in the way of differences, you can look at the program in some detail.

The first difference is apparent in CHANGE-RECORDS, which begins at line 009100. At this point, the voucher record has been read and is displayed at line 009200. If VOUCHER-PAID-DATE = ZEROES, the voucher is unpaid, and the logic performs CHANGE-TO-PAID. Otherwise, the voucher is paid, and presumably the user wants to CHANGE-TO-UNPAID, which is performed at line 009600.

The CHANGE-TO-UNPAID logic is the simpler of the two types of logic. The user has just seen the voucher displayed on-screen, and you cannot assume that it must be changed. The user could have typed the wrong voucher number accidentally, and to move straight into the logic to clear the fields would cause a voucher to be modified incorrectly.

CHANGE-TO-UNPAID and its related paragraphs extend from lines 014100 through 015900. The first action at line 014200 is to ask the user whether it is okay to reopen this voucher (ASK-OK-TO-OPEN). If the user says yes, zeroes are moved to VOUCHER-PAID-DATE, VOUCHER-PAID-AMOUNT, and VOUCHER-CHECK-NO. The voucher record is rewritten and the user is given a message saying "VOUCHER HAS BEEN RE OPENED".

CHANGE-TO-PAID and its related paragraphs extend from lines 010700 through 013400, and it is a bit more complicated. At line 010800, the user immediately is asked whether this is the voucher to pay. If so, CHANGE-ALL-FIELDS at line 011700 asks for an entry for each of the fields by performing CHANGE-THIS-FIELD while varying WHICH-FIELD from 1 through 3. CHANGE-THIS-FIELD at line 012700 performs the data entry routines for each field.

In CHANGE-ALL-FIELDS at line 012200, the record is rewritten. At lines 012400 and 012500, a test is done to see whether NEW-VOUCHER = "Y". If so, the GENERATE-NEW-VOUCHER routine is performed.

The field-entry routines start at line 018300 and extend to line 028100. ENTER-VOUCHER-PAID-DATE at line 018600 is a standard date-entry routine that does not allow a zero date to be entered.

At line 027300, ENTER-VOUCHER-CHECK-NO is another simple entry routine for the check number. The user is allowed to enter a zero check number to signal that payment is by cash (or at least not by check).

The meatiest data entry routine starts at line 021100, ENTER-VOUCHER-PAYMENT. The routine starts by setting the NEW-VOUCHER flag to "N" and performing ASK-FULL-PAYMENT. This routine at line 022100 asks the user whether the voucher payment is for the exact amount of the voucher. If the user answers yes, at line 021500, the VOUCHER-AMOUNT is moved to the VOUCHER-PAID-AMOUNT, and the user is not required to enter the amount to be paid. Otherwise, at line 021700, the user is asked to ENTER-VOUCHER-PAID-AMOUNT. This routine at line 025600 requires that the user enter an amount greater than zero, but not greater than VOUCHER-AMOUNT. Upon return to line 021800, IF VOUCHER-PAID-AMOUNT < VOUCHER-AMOUNT, the user is asked whether a new voucher should be created. ASK-NEW-VOUCHER at line 023900 is a simple yes/no entry routine that accepts a value into NEW-VOUCHER.

The last key part of the program begins at line 030200, the routine to GENERATE-NEW-VOUCHER. A new voucher is generated by creating a new voucher with all the same information as the original voucher, a new voucher number, and a voucher amount that is the original amount minus the amount just paid.

Most of the information that is needed to create the new voucher record is in the VOUCHER-RECORD, but you do need to locate a new voucher number that can be used. The GET-NEW-RECORD-KEY routine, taken from vchmnt01.cbl, locates a usable voucher number, but in the process might destroy the needed information in the VOUCHER-RECORD. To preserve the values in VOUCHER-RECORD, at line 030300, it is moved to a SAVE-VOUCHER-RECORD. This is defined in WORKING-STORAGE at line 005200 and is a space set aside for saving a copy of the voucher record. When the voucher record is preserved, it is possible to perform GET-NEW-RECORD-KEY, which returns a new voucher number in VOUCHER-NUMBER and in CONTROL-LAST-VOUCHER.

The next step is CREATE-NEW-VOUCHER-RECORD at line 030800. This routine moves the SAVE-VOUCHER-RECORD back to the VOUCHER-RECORD. This destroys the new voucher number that was set up in VOUCHER-NUMBER, but another copy of that number is available in CONTROL-LAST-VOUCHER. This is moved to VOUCHER-NUMBER.

At this point, the voucher record contains all the information that was placed in the record after the voucher was entered as paid but also contains the new voucher number. To set up the record so that the VOUCHER-AMOUNT is correct, it is necessary to subtract the VOUCHER-PAID-AMOUNT from the VOUCHER-AMOUNT. The voucher is flagged as not selected for payment at the VOUCHER-PAID-AMOUNT, and VOUCHER-PAID-DATE and VOUCHER-CHECK-NO are reset to zero. Finally, this new voucher record is written at line 031400.

Follow thoroughly what is happening in CREATE-NEW-VOUCHER-RECORD because it contains much that is new to you.

The last routine in this series, DISPLAY-NEW-VOUCHER at line 031600, informs the user that a new voucher has been created for the balance, and what the new voucher number is.

Code, compile, and run vchpay01.cbl against some trial vouchers created with vchmnt01.cbl. Pay some in full, and make some partial payments. Then try reopening some of those vouchers.

Summary

Today, you created a maintenance module that actually is used as a voucher-entry program. This used a control file to generate the new voucher number in add mode, thus avoiding the step of having the user look up the next voucher number each time a voucher needs to be added. You also explored the following:

Q&A

Q Why add all these features to a maintenance module?

A There are two answers to this. A computer is supposed to take the workload off the user. The more it can do so, the better the program is. The second part of the answer has to do with data accuracy. In vchpay01.cbl, a new voucher is generated automatically on an underpayment. The computer easily can calculate the difference between the amount paid and the amount owed and generate a voucher for the new amount. A user would have to do this subtraction by hand or with an adding machine, opening up the possibility of an error. When thinking about features for a program, always think in terms of whether it gets more work done and whether it achieves more accuracy.

Workshop

Quiz

1. The original routine to enter the paid amount in vchpay01.cbl (shown in Listing 20.3) allowed the entry of only a voucher amount less than or equal to the voucher amount. The program has been modified as shown in the following listing:
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
Compare this to lines 025600 through 027100 in vchpay01.cbl (shown in Listing 20.3). What is the effect of this change?

Exercise

Copy vchpay01.cbl to vchpay02.cbl and using the listing in Quiz question 1, make the changes indicated. Compile and run the program and try some overpayments and underpayments. Make sure the program works correctly. The vchpay02.cbl program will be used in the next chapter, Day 21, "Selecting, Sorting, and Reporting," so be sure to complete this exercise.


Previous chapterNext chapterContents


© Copyright, Macmillan Computer Publishing. All rights reserved.