Figure 152 shows an example of a payment update program, PAYUPDT. For the related DDS, see Figure 150 and Figure 151. For the related display-screen examples, see page Customer Payment Display. For the DDS for the customer master file, CUSMSTP, refer to Figure 132.
In this example, payments from customers are registered. The clerk is prompted to enter one or more customer numbers and the amount of money to be credited to each customer's account. The program checks the customer number and unconditionally accepts any payment for an existing customer who has invoices outstanding. If an overpayment will result from the amount of the payment from a customer, the clerk is given the option of accepting or rejecting the payment. If no customer record exists for a customer number, an error message is issued. Payments can be entered until the clerk ends the program by pressing F12.
....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+.... A** THIS IS THE ORDER HEADER LOGICAL FILE ** ORDHDRL A A A UNIQUE A R ORDHDR PFILE(ORDHDRP) A* A CUST A INVNUM A ORDERN A ORDDAT A CUSORD A SHPVIA A ORDSTS A OPRNAM A ORDAMT A CUSTYP A PRTDAT A OPNSTS A TOTLIN A ACTMTH A ACTYR A STATE A AMPAID A K CUST A K INVNUM |
....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+.... A* THIS IS THE DISPLAY DEVICE FILE FOR PAYUPDT ** PAYUPDTD A* ACCOUNTS RECEIVABLE INTERACTIVE PAYMENT UPDATE A* A A R SUBFILE1 SFL A TEXT('SUBFILE FOR CUSTOMER PAYMENT' A* A ACPPMT 4A I 5 4TEXT('ACCEPT PAYMENT') A VALUES('*YES' '*NO') A 51 DSPATR(RI MDT) A N51 DSPATR(ND PR) A* A CUST 5 B 5 15TEXT('CUSTOMER NUMBER') A 52 DSPATR(RI) A 53 DSPATR(ND) A 54 DSPATR(PR) A* A AMPAID 8 02B 5 24TEXT('AMOUNT PAID') A CHECK(FE) A AUTO(RAB) A CMP(GT 0) A 52 DSPATR(RI) A 53 DSPATR(ND) A 54 DSPATR(PR) A* A ECPMSG 31A O 5 37TEXT('EXCEPTION MESSAGE') A 52 DSPATR(RI) A 53 DSPATR(ND) A 54 DSPATR(BL) A* A OVRPMT 8Y 2O 5 70TEXT('OVERPAYMENT') A EDTCDE(1) A 55 DSPATR(BL) A N56 DSPATR(ND) A* A STSCDE 1A H TEXT('STATUS CODE') A R CONTROL1 TEXT('SUBFILE CONTROL') A SFLCTL(SUBFILE1) A SFLSIZ(17) A SFLPAG(17) A 61 SFLCLR A 62 SFLDSP A 62 SFLDSPCTL A OVERLAY A LOCK A* A HELP(99 'HELP KEY') A CA12(98 'END PAYMENT UPDATE') A CA11(97 'IGNORE INPUT') A* A 99 SFLMSG(' F11 - IGNORE INVALID INPUT+ A F12 - END PAYMENT + A UPDATE') A* A 1 2'CUSTOMER PAYMENT UPDATE PROMPT' A 1 65'DATE' A 1 71DATE EDTCDE(Y) A 63 3 2'ACCEPT' A 63 4 2'PAYMENT' A 3 14'CUSTOMER' A 3 26'PAYMENT' A 64 3 37'EXCEPTION MESSAGE' A* A R MESSAGE1 TEXT('MESSAGE RECORD') A OVERLAY A LOCK A* A 71 24 2' ACCEPT PAYMENT VALUES: (*NO *YES) DSPATR(RI) |
Figure 152. Source Listing of a Payment Update Program Example
5722WDS V5R3M0 030905 LN IBM ILE COBOL CBLGUIDE/PAYUPDT ISERIES1 03/09/15 15:08:37 Page 2 S o u r c e STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S COPYNAME CHG DATE 000100 PROCESS APOST 1 000200 IDENTIFICATION DIVISION. 2 000300 PROGRAM-ID. PAYUPDT. 000400 3 000500 ENVIRONMENT DIVISION. 4 000600 CONFIGURATION SECTION. 5 000700 SOURCE-COMPUTER. IBM-ISERIES 6 000800 OBJECT-COMPUTER. IBM-ISERIES 7 000900 INPUT-OUTPUT SECTION. 8 001000 FILE-CONTROL. 9 001100 SELECT CUSTOMER-INVOICE-FILE 10 001200 ASSIGN TO DATABASE-ORDHDRL 11 001300 ORGANIZATION IS INDEXED 12 001400 ACCESS MODE IS SEQUENTIAL 13 001500 RECORD KEY IS COMP-KEY 14 001600 FILE STATUS IS STATUS-CODE-ONE. 15 001700 SELECT CUSTOMER-MASTER-FILE 16 001800 ASSIGN TO DATABASE-CUSMSTP 17 001900 ORGANIZATION IS INDEXED 18 002000 ACCESS IS RANDOM 19 002100 RECORD KEY IS CUST OF CUSTOMER-MASTER-RECORD. 20 002200 SELECT PAYMENT-UPDATE-DISPLAY-FILE 21 002300 ASSIGN TO WORKSTATION-PAYUPDTD 22 002400 ORGANIZATION IS TRANSACTION 23 002500 ACCESS IS DYNAMIC 24 002600 RELATIVE KEY IS REL-NUMBER 25 002700 FILE STATUS IS STATUS-CODE-ONE 26 002800 CONTROL-AREA IS WS-CONTROL. 002900 27 003000 DATA DIVISION. 28 003100 FILE SECTION. 29 003200 FD CUSTOMER-INVOICE-FILE. 30 003300 01 CUSTOMER-INVOICE-RECORD. 003400 COPY DDS-ORDHDR OF ORDHDRL. +000001* I-O FORMAT:ORDHDR FROM FILE ORDHDRL OF LIBRARY CBLGUIDE ORDHDR +000002* ORDHDR +000003* USER SUPPLIED KEY BY RECORD KEY CLAUSE ORDHDR 31 +000004 05 ORDHDR. ORDHDR 32 +000005 06 CUST PIC X(5). ORDHDR +000006* CUSTOMER NUMBER ORDHDR 33 +000007 06 INVNUM PIC S9(5) COMP-3. ORDHDR +000008* INVOICE NUMBER ORDHDR 34 +000009 06 ORDERN PIC S9(5) COMP-3. ORDHDR +000010* ORDER NUMBER ORDHDR 35 +000011 06 ORDDAT PIC S9(6) COMP-3. ORDHDR +000012* DATE ORDER ENTERED ORDHDR 36 +000013 06 CUSORD PIC X(15). ORDHDR +000014* CUSTOMER PURCHASE ORDER NUMBER ORDHDR 37 +000015 06 SHPVIA PIC X(15). ORDHDR +000016* SHIPPING INSTRUCTIONS ORDHDR 38 +000017 06 ORDSTS PIC S9(1) COMP-3. ORDHDR +000018* ORDER SATAUS 1PCS 2CNT 3CHK 4RDY 5PRT 6PCK ORDHDR 39 +000019 06 OPRNAM PIC X(10). ORDHDR 5722WDS V5R3M0 030905 LN IBM ILE COBOL CBLGUIDE/PAYUPDT ISERIES1 03/09/15 15:08:37 Page 3 STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S COPYNAME CHG DATE +000020* OPERATOR WHO ENTERED ORD ORDHDR 40 +000021 06 ORDAMT PIC S9(6)V9(2) COMP-3. ORDHDR +000022* DOLLAR AMOUNT OF ORDER ORDHDR 41 +000023 06 CUSTYP PIC S9(1) COMP-3. ORDHDR +000024* CUSTOMER TYPE 1=GOV 2=SCH 3=BUS 4=PVT 5=OT ORDHDR 42 +000025 06 PRTDAT PIC S9(6) COMP-3. ORDHDR +000026* DATE ORDER WAS PRINTED ORDHDR 43 +000027 06 OPNSTS PIC S9(1) COMP-3. ORDHDR +000028* ORDER OPEN STATUS 1=OPEN 2= CLOSE 3=CANCEL ORDHDR 44 +000029 06 TOTLIN PIC S9(3) COMP-3. ORDHDR +000030* TOTAL LINE ITEMS IN ORDER ORDHDR 45 +000031 06 ACTMTH PIC S9(2) COMP-3. ORDHDR +000032* ACCOUNTING MONTH OF SALE ORDHDR 46 +000033 06 ACTYR PIC S9(2) COMP-3. ORDHDR +000034* ACCOUNTING YEAR OF SALE ORDHDR 47 +000035 06 STATE PIC X(2). ORDHDR +000036* STATE ORDHDR 48 +000037 06 AMPAID PIC S9(6)V9(2) COMP-3. ORDHDR +000038* AMOUNT PAID ORDHDR 49 003500 66 COMP-KEY RENAMES CUST THRU INVNUM. 003600 50 003700 FD CUSTOMER-MASTER-FILE. 51 003800 01 CUSTOMER-MASTER-RECORD. 003900 COPY DDS-CUSMST OF CUSMSTP. +000001* I-O FORMAT:CUSMST FROM FILE CUSMSTP OF LIBRARY CBLGUIDE CUSMST +000002* CUSTOMER MASTER RECORD CUSMST +000003* USER SUPPLIED KEY BY RECORD KEY CLAUSE CUSMST 52 +000004 05 CUSMST. CUSMST 53 +000005 06 CUST PIC X(5). CUSMST +000006* CUSTOMER NUMBER CUSMST 54 +000007 06 NAME PIC X(25). CUSMST +000008* CUSTOMER NAME CUSMST 55 +000009 06 ADDR PIC X(20). CUSMST +000010* CUSTOMER ADDRESS CUSMST 56 +000011 06 CITY PIC X(20). CUSMST +000012* CUSTOMER CITY CUSMST 57 +000013 06 STATE PIC X(2). CUSMST +000014* STATE CUSMST 58 +000015 06 ZIP PIC S9(5) COMP-3. CUSMST +000016* ZIP CODE CUSMST 59 +000017 06 SRHCOD PIC X(6). CUSMST +000018* CUSTOMER NUMBER SEARCH CODE CUSMST 60 +000019 06 CUSTYP PIC S9(1) COMP-3. CUSMST +000020* CUSTOMER TYPE 1=GOV 2=SCH 3=BUS 4=PVT 5=OT CUSMST 61 +000021 06 ARBAL PIC S9(6)V9(2) COMP-3. CUSMST +000022* ACCOUNTS REC. BALANCE CUSMST 62 +000023 06 ORDBAL PIC S9(6)V9(2) COMP-3. CUSMST +000024* A/R AMT. IN ORDER FILE CUSMST 63 +000025 06 LSTAMT PIC S9(6)V9(2) COMP-3. CUSMST +000026* LAST AMT. PAID IN A/R CUSMST 64 +000027 06 LSTDAT PIC S9(6) COMP-3. CUSMST +000028* LAST DATE PAID IN A/R CUSMST 65 +000029 06 CRDLMT PIC S9(6)V9(2) COMP-3. CUSMST +000030* CUSTOMER CREDIT LIMIT CUSMST 66 +000031 06 SLSYR PIC S9(8)V9(2) COMP-3. CUSMST 5722WDS V5R3M0 030905 LN IBM ILE COBOL CBLGUIDE/PAYUPDT ISERIES1 03/09/15 15:08:37 Page 4 STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S COPYNAME CHG DATE +000032* CUSTOMER SALES THIS YEAR CUSMST 67 +000033 06 SLSLYR PIC S9(8)V9(2) COMP-3. CUSMST +000034* CUSTOMER SALES LAST YEAR CUSMST 004000 68 004100 FD PAYMENT-UPDATE-DISPLAY-FILE. 69 004200 01 PAYMENT-UPDATE-DISPLAY-RECORD. 004300 COPY DDS-ALL-FORMATS OF PAYUPDTD. 70 +000001 05 PAYUPDTD-RECORD PIC X(59). <-ALL-FMTS +000002* INPUT FORMAT:SUBFILE1 FROM FILE PAYUPDTD OF LIBRARY CBLGUIDE <-ALL-FMTS +000003* SUBFILE FOR CUSTOMER PAYMENT <-ALL-FMTS 71 +000004 05 SUBFILE1-I REDEFINES PAYUPDTD-RECORD. <-ALL-FMTS 72 +000005 06 ACPPMT PIC X(4). <-ALL-FMTS +000006* ACCEPT PAYMENT <-ALL-FMTS 73 +000007 06 CUST PIC X(5). <-ALL-FMTS +000008* CUSTOMER NUMBER <-ALL-FMTS 74 +000009 06 AMPAID PIC S9(6)V9(2). <-ALL-FMTS +000010* AMOUNT PAID <-ALL-FMTS 75 +000011 06 ECPMSG PIC X(31). <-ALL-FMTS +000012* EXCEPTION MESSAGE <-ALL-FMTS 76 +000013 06 OVRPMT PIC S9(6)V9(2). <-ALL-FMTS +000014* OVERPAYMENT <-ALL-FMTS 77 +000015 06 STSCDE PIC X(1). <-ALL-FMTS +000016* STATUS CODE <-ALL-FMTS +000017* OUTPUT FORMAT:SUBFILE1 FROM FILE PAYUPDTD OF LIBRARY CBLGUIDE <-ALL-FMTS +000018* SUBFILE FOR CUSTOMER PAYMENT <-ALL-FMTS 78 +000019 05 SUBFILE1-O REDEFINES PAYUPDTD-RECORD. <-ALL-FMTS 79 +000020 06 SUBFILE1-O-INDIC. <-ALL-FMTS 80 +000021 07 IN51 PIC 1 INDIC 51. <-ALL-FMTS 81 +000022 07 IN52 PIC 1 INDIC 52. <-ALL-FMTS 82 +000023 07 IN53 PIC 1 INDIC 53. <-ALL-FMTS 83 +000024 07 IN54 PIC 1 INDIC 54. <-ALL-FMTS 84 +000025 07 IN55 PIC 1 INDIC 55. <-ALL-FMTS 85 +000026 07 IN56 PIC 1 INDIC 56. <-ALL-FMTS 86 +000027 06 CUST PIC X(5). <-ALL-FMTS +000028* CUSTOMER NUMBER <-ALL-FMTS 87 +000029 06 AMPAID PIC S9(6)V9(2). <-ALL-FMTS +000030* AMOUNT PAID <-ALL-FMTS 88 +000031 06 ECPMSG PIC X(31). <-ALL-FMTS +000032* EXCEPTION MESSAGE <-ALL-FMTS 89 +000033 06 OVRPMT PIC S9(6)V9(2). <-ALL-FMTS +000034* OVERPAYMENT <-ALL-FMTS 90 +000035 06 STSCDE PIC X(1). <-ALL-FMTS +000036* STATUS CODE <-ALL-FMTS +000037* INPUT FORMAT:CONTROL1 FROM FILE PAYUPDTD OF LIBRARY CBLGUIDE <-ALL-FMTS +000038* SUBFILE CONTROL <-ALL-FMTS 91 +000039 05 CONTROL1-I REDEFINES PAYUPDTD-RECORD. <-ALL-FMTS 92 +000040 06 CONTROL1-I-INDIC. <-ALL-FMTS 93 +000041 07 IN99 PIC 1 INDIC 99. <-ALL-FMTS +000042* HELP KEY <-ALL-FMTS 94 +000043 07 IN98 PIC 1 INDIC 98. <-ALL-FMTS +000044* END PAYMENT UPDATE <-ALL-FMTS 95 +000045 07 IN97 PIC 1 INDIC 97. <-ALL-FMTS +000046* IGNORE INPUT <-ALL-FMTS +000047* OUTPUT FORMAT:CONTROL1 FROM FILE PAYUPDTD OF LIBRARY CBLGUIDE <-ALL-FMTS +000048* SUBFILE CONTROL <-ALL-FMTS 5722WDS V5R3M0 030905 LN IBM ILE COBOL CBLGUIDE/PAYUPDT ISERIES1 03/09/15 15:08:37 Page 5 STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S COPYNAME CHG DATE 96 +000049 05 CONTROL1-O REDEFINES PAYUPDTD-RECORD. <-ALL-FMTS 97 +000050 06 CONTROL1-O-INDIC. <-ALL-FMTS 98 +000051 07 IN61 PIC 1 INDIC 61. <-ALL-FMTS 99 +000052 07 IN62 PIC 1 INDIC 62. <-ALL-FMTS 100 +000053 07 IN99 PIC 1 INDIC 99. <-ALL-FMTS +000054* HELP KEY <-ALL-FMTS 101 +000055 07 IN63 PIC 1 INDIC 63. <-ALL-FMTS 102 +000056 07 IN64 PIC 1 INDIC 64. <-ALL-FMTS +000057* INPUT FORMAT:MESSAGE1 FROM FILE PAYUPDTD OF LIBRARY CBLGUIDE <-ALL-FMTS +000058* MESSAGE RECORD <-ALL-FMTS +000059* 05 MESSAGE1-I REDEFINES PAYUPDTD-RECORD. <-ALL-FMTS +000060* OUTPUT FORMAT:MESSAGE1 FROM FILE PAYUPDTD OF LIBRARY CBLGUIDE <-ALL-FMTS +000061* MESSAGE RECORD <-ALL-FMTS 103 +000062 05 MESSAGE1-O REDEFINES PAYUPDTD-RECORD. <-ALL-FMTS 104 +000063 06 MESSAGE1-O-INDIC. <-ALL-FMTS 105 +000064 07 IN71 PIC 1 INDIC 71. <-ALL-FMTS 004400 106 004500 WORKING-STORAGE SECTION. 004600 107 004700 01 REL-NUMBER PIC 9(05) 004800 VALUE ZEROS. 004900 108 005000 01 WS-CONTROL. 109 005100 05 WS-IND PIC X(02). 110 005200 05 WS-FORMAT PIC X(10). 111 005300 01 SYSTEM-DATE. 112 005400 05 SYSTEM-YEAR PIC 99. 113 005500 05 SYSTEM-MONTH PIC 99. 114 005600 05 SYSTEM-DAY PIC 99. 115 005700 01 PROGRAM-DATE. 116 005800 05 PROGRAM-MONTH PIC 99. 117 005900 05 PROGRAM-DAY PIC 99. 118 006000 05 PROGRAM-YEAR PIC 99. 119 006100 01 FILE-DATE REDEFINES PROGRAM-DATE 006200 PIC S9(6). 120 006300 01 EXCEPTION-STATUS. 121 006400 05 STATUS-CODE-ONE PIC XX. 122 006500 88 SUBFILE-IS-FULL VALUE '0M'. 123 006600 01 EXCEPTION-MESSAGES. 124 006700 05 MESSAGE-ONE PIC X(31) 006800 VALUE 'CUSTOMER DOES NOT EXIST '. 125 006900 05 MESSAGE-TWO PIC X(31) 007000 VALUE 'NO INVOICES EXIST FOR CUSTOMER '. 126 007100 05 MESSAGE-THREE PIC X(31) 007200 VALUE 'CUSTOMER HAS AN OVER PAYMENT OF'. 127 007300 01 PROGRAM-VARIABLES. 128 007400 05 AMOUNT-OWED PIC S9(6)V99. 129 007500 05 AMOUNT-PAID PIC S9(6)V99. 130 007600 05 INVOICE-BALANCE PIC S9(6)V99. 131 007700 01 ERRPGM-PARAMETERS. 132 007800 05 DISPLAY-PARAMETER PIC X(8) 007900 VALUE 'PAYUPDTD'. 133 008000 05 DUMMY-ONE PIC X(6) 008100 VALUE SPACES. 134 008200 05 DUMMY-TWO PIC X(6) 5722WDS V5R3M0 030905 LN IBM ILE COBOL CBLGUIDE/PAYUPDT ISERIES1 03/09/15 15:08:37 Page 6 STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S COPYNAME CHG DATE 008300 VALUE SPACES. 135 008400 05 STATUS-CODE-TWO. 136 008500 10 PRIMARY PIC X(1). 137 008600 10 SECONDARY PIC X(1). 138 008700 10 FILLER PIC X(5) 008800 VALUE SPACES. 139 008900 05 DUMMY-THREE PIC X(10) 009000 VALUE SPACES. 009100 140 009200 01 SWITCH-AREA. 141 009300 05 SW01 PIC 1. 142 009400 88 WRITE-DISPLAY VALUE B'1'. 143 009500 88 READ-DISPLAY VALUE B'0'. 144 009600 05 SW02 PIC 1. 145 009700 88 SUBFILE1-FORMAT VALUE B'1'. 146 009800 88 NOT-SUBFILE1-FORMAT VALUE B'0'. 147 009900 05 SW03 PIC 1. 148 010000 88 CONTROL1-FORMAT VALUE B'1'. 149 010100 88 NOT-CONTROL1-FORMAT VALUE B'0'. 150 010200 05 SW04 PIC 1. 151 010300 88 NO-MORE-TRANSACTIONS-EXIST VALUE B'1'. 152 010400 88 TRANSACTIONS-EXIST VALUE B'0'. 153 010500 05 SW05 PIC 1. 154 010600 88 CUSTOMER-NOT-FOUND VALUE B'1'. 155 010700 88 CUSTOMER-EXIST VALUE B'0'. 156 010800 05 SW06 PIC 1. 157 010900 88 NO-MORE-INVOICES-EXIST VALUE B'1'. 158 011000 88 CUSTOMER-INVOICE-EXIST VALUE B'0'. 159 011100 05 SW07 PIC 1. 160 011200 88 NO-MORE-PAYMENT-EXIST VALUE B'1'. 161 011300 88 PAYMENT-EXIST VALUE B'0'. 162 011400 05 SW08 PIC 1. 163 011500 88 INPUT-ERRORS-EXIST VALUE B'1'. 164 011600 88 NO-INPUT-ERRORS-EXIST VALUE B'0'. 165 011700 05 SW09 PIC 1. 166 011800 88 OVER-PAYMENT-DISPLAYED-ONCE VALUE B'1'. 167 011900 88 OVER-PAYMENT-NOT-DISPLAYED VALUE B'0'. 012000 168 012100 01 INDICATOR-AREA. 169 012200 05 IN99 PIC 1 INDIC 99. 170 012300 88 HELP-IS-NEEDED VALUE B'1'. 171 012400 88 HELP-IS-NOT-NEEDED VALUE B'0'. 172 012500 05 IN98 PIC 1 INDIC 98. 173 012600 88 END-OF-PAYMENT-UPDATE VALUE B'1'. 174 012700 05 IN97 PIC 1 INDIC 97. 175 012800 88 IGNORE-INPUT VALUE B'1'. 176 012900 05 IN51 PIC 1 INDIC 51. 177 013000 88 DISPLAY-ACCEPT-PAYMENT VALUE B'1'. 178 013100 88 DO-NOT-DISPLAY-ACCEPT-PAYMENT VALUE B'0'. 179 013200 05 IN52 PIC 1 INDIC 52. 180 013300 88 REVERSE-FIELD-IMAGE VALUE B'1'. 181 013400 88 DO-NOT-REVERSE-FIELD-IMAGE VALUE B'0'. 182 013500 05 IN53 PIC 1 INDIC 53. 183 013600 88 DO-NOT-DISPLAY-FIELD VALUE B'1'. 184 013700 88 DISPLAY-FIELD VALUE B'0'. 5722WDS V5R3M0 030905 LN IBM ILE COBOL CBLGUIDE/PAYUPDT ISERIES1 03/09/15 15:08:37 Page 7 STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S COPYNAME CHG DATE 185 013800 05 IN54 PIC 1 INDIC 54. 186 013900 88 PROTECT-INPUT-FIELD VALUE B'1'. 187 014000 88 DO-NOT-PROTECT-INPUT-FIELD VALUE B'0'. 188 014100 05 IN55 PIC 1 INDIC 55. 189 014200 88 MAKE-FIELD-BLINK VALUE B'1'. 190 014300 88 DO-NOT-MAKE-FIELD-BLINK VALUE B'0'. 191 014400 05 IN56 PIC 1 INDIC 56. 192 014500 88 DISPLAY-OVER-PAYMENT VALUE B'1'. 193 014600 88 DO-NOT-DISPLAY-OVER-PAYMENT VALUE B'0'. 194 014700 05 IN61 PIC 1 INDIC 61. 195 014800 88 CLEAR-SUBFILE VALUE B'1'. 196 014900 88 DO-NOT-CLEAR-SUBFILE VALUE B'0'. 197 015000 05 IN62 PIC 1 INDIC 62. 198 015100 88 DISPLAY-SCREEN VALUE B'1'. 199 015200 88 DO-NOT-DISPLAY-SCREEN VALUE B'0'. 200 015300 05 IN63 PIC 1 INDIC 63. 201 015400 88 DISPLAY-ACCEPT-HEADING VALUE B'1'. 202 015500 88 DO-NOT-DISPLAY-ACCEPT-HEADING VALUE B'0'. 203 015600 05 IN64 PIC 1 INDIC 64. 204 015700 88 DISPLAY-EXCEPTION VALUE B'1'. 205 015800 88 DO-NOT-DISPLAY-EXCEPTION VALUE B'0'. 206 015900 05 IN71 PIC 1 INDIC 71. 207 016000 88 DISPLAY-ACCEPT-MESSAGE VALUE B'1'. 208 016100 88 DO-NOT-DISPLAY-ACCEPT-MESSAGE VALUE B'0'. 016200 209 016300 PROCEDURE DIVISION. 016400 210 016500 DECLARATIVES. 016600 016700 TRANSACTION-ERROR SECTION. 016800 USE AFTER STANDARD ERROR PROCEDURE 016900 PAYMENT-UPDATE-DISPLAY-FILE. 017000 WORK-STATION-ERROR-HANDLER. 211 017100 IF NOT (SUBFILE-IS-FULL) THEN 212 017200 DISPLAY 'ERROR IN PAYMENT-UPDATE' STATUS-CODE-ONE 017300 END-IF. 017400 END DECLARATIVES. 017500 017600 MAIN-PROGRAM SECTION. 017700 MAINLINE. 213 017800 OPEN I-O CUSTOMER-INVOICE-FILE 017900 CUSTOMER-MASTER-FILE 018000 PAYMENT-UPDATE-DISPLAY-FILE. 018100 214 018200 MOVE ALL B'0' TO INDICATOR-AREA 018300 SWITCH-AREA. 215 018400 ACCEPT SYSTEM-DATE FROM DATE 018500 END-ACCEPT. 216 018600 MOVE SYSTEM-YEAR TO PROGRAM-YEAR. 217 018700 MOVE SYSTEM-MONTH TO PROGRAM-MONTH. 218 018800 MOVE SYSTEM-DATE TO PROGRAM-DAY. 219 018900 SET WRITE-DISPLAY 019000 CONTROL1-FORMAT 019100 DO-NOT-DISPLAY-OVER-PAYMENT 019200 DO-NOT-PROTECT-INPUT-FIELD 5722WDS V5R3M0 030905 LN IBM ILE COBOL CBLGUIDE/PAYUPDT ISERIES1 03/09/15 15:08:37 Page 8 STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S COPYNAME CHG DATE 019300 DO-NOT-REVERSE-FIELD-IMAGE 019400 DO-NOT-MAKE-FIELD-BLINK 019500 CLEAR-SUBFILE TO TRUE. 220 019600 MOVE CORR INDICATOR-AREA TO CONTROL1-O-INDIC. *** CORRESPONDING items for statement 220: *** IN99 *** IN61 *** IN62 *** IN63 *** IN64 *** End of CORRESPONDING items for statement 220 221 019700 WRITE PAYMENT-UPDATE-DISPLAY-RECORD 019800 FORMAT IS 'CONTROL1' 019900 END-WRITE. 222 020000 SET DO-NOT-CLEAR-SUBFILE TO TRUE. 223 020100 PERFORM INITIALIZE-SUBFILE-RECORD 17 TIMES. 224 020200 SET DISPLAY-SCREEN TO TRUE. 225 020300 MOVE CORR INDICATOR-AREA TO CONTROL1-O-INDIC. *** CORRESPONDING items for statement 225: *** IN99 *** IN61 *** IN62 *** IN63 *** IN64 *** End of CORRESPONDING items for statement 225 226 020400 WRITE PAYMENT-UPDATE-DISPLAY-RECORD 020500 FORMAT IS 'CONTROL1' 020600 END-WRITE. 227 020700 READ PAYMENT-UPDATE-DISPLAY-FILE RECORD 020800 FORMAT IS 'CONTROL1' 020900 END-READ. 228 021000 MOVE CORR CONTROL1-I-INDIC TO INDICATOR-AREA. *** CORRESPONDING items for statement 228: *** IN99 *** IN98 *** IN97 *** End of CORRESPONDING items for statement 228 021100 229 021200 PERFORM PROCESS-TRANSACTION-FILE 021300 UNTIL END-OF-PAYMENT-UPDATE. 021400 230 021500 CLOSE CUSTOMER-INVOICE-FILE 021600 CUSTOMER-MASTER-FILE 021700 PAYMENT-UPDATE-DISPLAY-FILE. 231 021800 STOP RUN. 021900 022000 PROCESS-TRANSACTION-FILE. 232 022100 IF HELP-IS-NOT-NEEDED THEN 233 022200 IF IGNORE-INPUT THEN 234 022300 SET WRITE-DISPLAY 022400 CONTROL1-FORMAT 022500 CLEAR-SUBFILE 022600 DISPLAY-FIELD 022700 DO-NOT-DISPLAY-OVER-PAYMENT 022800 DO-NOT-PROTECT-INPUT-FIELD 5722WDS V5R3M0 030905 LN IBM ILE COBOL CBLGUIDE/PAYUPDT ISERIES1 03/09/15 15:08:37 Page 9 STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S COPYNAME CHG DATE 022900 DO-NOT-REVERSE-FIELD-IMAGE 023000 DO-NOT-DISPLAY-ACCEPT-PAYMENT 023100 DO-NOT-DISPLAY-ACCEPT-HEADING 023200 DO-NOT-DISPLAY-ACCEPT-MESSAGE 023300 DO-NOT-MAKE-FIELD-BLINK TO TRUE 235 023400 MOVE CORR INDICATOR-AREA TO CONTROL1-O-INDIC *** CORRESPONDING items for statement 235: *** IN99 *** IN61 *** IN62 *** IN63 *** IN64 *** End of CORRESPONDING items for statement 235 236 023500 WRITE PAYMENT-UPDATE-DISPLAY-RECORD 023600 FORMAT IS 'CONTROL1' 023700 END-WRITE 237 023800 SET DO-NOT-CLEAR-SUBFILE TO TRUE 238 023900 MOVE 0 TO REL-NUMBER 239 024000 PERFORM INITIALIZE-SUBFILE-RECORD 17 TIMES 024100 ELSE 240 024200 SET TRANSACTIONS-EXIST 024300 DO-NOT-DISPLAY-ACCEPT-HEADING 024400 DO-NOT-DISPLAY-ACCEPT-MESSAGE 024500 DO-NOT-DISPLAY-EXCEPTION TO TRUE 241 024600 PERFORM READ-MODIFIED-SUBFILE-RECORD 242 024700 PERFORM TRANSACTION-VALIDATION 024800 UNTIL NO-MORE-TRANSACTIONS-EXIST 243 024900 SET NO-INPUT-ERRORS-EXIST TO TRUE 244 025000 PERFORM TEST-FOR-RECORD-INPUT-ERRORS 025100 VARYING REL-NUMBER 025200 FROM 1 025300 BY 1 025400 UNTIL REL-NUMBER IS GREATER THAN 17 025500 OR INPUT-ERRORS-EXIST 245 025600 IF NO-INPUT-ERRORS-EXIST THEN 246 025700 IF OVER-PAYMENT-DISPLAYED-ONCE THEN 247 025800 SET WRITE-DISPLAY 025900 CONTROL1-FORMAT 026000 DO-NOT-DISPLAY-OVER-PAYMENT 026100 DO-NOT-PROTECT-INPUT-FIELD 026200 DO-NOT-REVERSE-FIELD-IMAGE 026300 DO-NOT-MAKE-FIELD-BLINK 026400 DO-NOT-DISPLAY-ACCEPT-PAYMENT 026500 DO-NOT-DISPLAY-ACCEPT-HEADING 026600 DO-NOT-DISPLAY-ACCEPT-MESSAGE 026700 DO-NOT-DISPLAY-EXCEPTION 026800 CLEAR-SUBFILE 026900 DISPLAY-FIELD 027000 TO TRUE 248 027100 MOVE CORR INDICATOR-AREA TO CONTROL1-O-INDIC *** CORRESPONDING items for statement 248: *** IN99 *** IN61 *** IN62 *** IN63 5722WDS V5R3M0 030905 LN IBM ILE COBOL CBLGUIDE/PAYUPDT ISERIES1 03/09/15 15:08:37 Page 10 STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S COPYNAME CHG DATE *** IN64 *** End of CORRESPONDING items for statement 248 249 027200 WRITE PAYMENT-UPDATE-DISPLAY-RECORD 027300 FORMAT IS 'CONTROL1' 027400 END-WRITE 250 027500 SET DO-NOT-CLEAR-SUBFILE TO TRUE 251 027600 MOVE 0 TO REL-NUMBER 252 027700 PERFORM INITIALIZE-SUBFILE-RECORD 17 TIMES 027800 ELSE 253 027900 SET OVER-PAYMENT-DISPLAYED-ONCE TO TRUE 028000 END-IF 028100 END-IF 028200 END-IF 028300 END-IF. 254 028400 SET WRITE-DISPLAY, DISPLAY-SCREEN TO TRUE. 255 028500 MOVE CORR INDICATOR-AREA TO MESSAGE1-O-INDIC. *** CORRESPONDING items for statement 255: *** IN71 *** End of CORRESPONDING items for statement 255 256 028600 WRITE PAYMENT-UPDATE-DISPLAY-RECORD 028700 FORMAT IS 'MESSAGE1' 028800 END-WRITE. 257 028900 SET WRITE-DISPLAY, CONTROL1-FORMAT TO TRUE. 258 029000 MOVE CORR INDICATOR-AREA TO CONTROL1-O-INDIC. *** CORRESPONDING items for statement 258: *** IN99 *** IN61 *** IN62 *** IN63 *** IN64 *** End of CORRESPONDING items for statement 258 259 029100 WRITE PAYMENT-UPDATE-DISPLAY-RECORD 029200 FORMAT IS 'CONTROL1' 029300 END-WRITE. 260 029400 READ PAYMENT-UPDATE-DISPLAY-FILE RECORD 029500 FORMAT IS 'CONTROL1' 029600 END-READ. 261 029700 MOVE CORR CONTROL1-I-INDIC TO INDICATOR-AREA. *** CORRESPONDING items for statement 261: *** IN99 *** IN98 *** IN97 *** End of CORRESPONDING items for statement 261 029800 029900 READ-MODIFIED-SUBFILE-RECORD. 262 030000 READ SUBFILE PAYMENT-UPDATE-DISPLAY-FILE 030100 NEXT MODIFIED RECORD FORMAT IS 'SUBFILE1' 263 030200 AT END SET NO-MORE-TRANSACTIONS-EXIST TO TRUE 030300 END-READ. 030400 030500 TEST-FOR-RECORD-INPUT-ERRORS. 264 030600 READ SUBFILE PAYMENT-UPDATE-DISPLAY-FILE RECORD 030700 FORMAT IS 'SUBFILE1' 030800 END-READ. 265 030900 IF STSCDE OF SUBFILE1-I IS EQUAL TO '1' THEN 5722WDS V5R3M0 030905 LN IBM ILE COBOL CBLGUIDE/PAYUPDT ISERIES1 03/09/15 15:08:37 Page 11 STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S COPYNAME CHG DATE 266 031000 SET INPUT-ERRORS-EXIST TO TRUE 031100 END-IF. 031200 031300 TRANSACTION-VALIDATION. 267 031400 MOVE CUST OF SUBFILE1-I OF PAYMENT-UPDATE-DISPLAY-RECORD 031500 TO CUST OF CUSTOMER-MASTER-RECORD. 268 031600 SET CUSTOMER-EXIST TO TRUE. 269 031700 READ CUSTOMER-MASTER-FILE 270 031800 INVALID KEY SET CUSTOMER-NOT-FOUND TO TRUE 031900 END-READ. 271 032000 IF CUSTOMER-EXIST THEN 272 032100 MOVE CUST OF CUSMST TO CUST OF ORDHDR 273 032200 MOVE ZEROES TO INVNUM 274 032300 SET CUSTOMER-INVOICE-EXIST TO TRUE 275 032400 PERFORM START-ON-CUSTOMER-INVOICE-FILE 276 032500 IF CUSTOMER-INVOICE-EXIST THEN 277 032600 PERFORM READ-CUSTOMER-INVOICE-RECORD 278 032700 IF CUSTOMER-INVOICE-EXIST THEN 279 032800 PERFORM CUSTOMER-MASTER-FILE-UPDATE 280 032900 MOVE AMPAID OF SUBFILE1-I TO AMOUNT-PAID 281 033000 SET PAYMENT-EXIST TO TRUE 282 033100 PERFORM PAYMENT-UPDATE 033200 UNTIL NO-MORE-INVOICES-EXIST 033300 OR NO-MORE-PAYMENT-EXIST 283 033400 IF ARBAL OF CUSTOMER-MASTER-RECORD IS NEGATIVE 284 033500 SET MAKE-FIELD-BLINK 033600 DISPLAY-FIELD 033700 DO-NOT-REVERSE-FIELD-IMAGE 033800 OVER-PAYMENT-NOT-DISPLAYED 033900 DISPLAY-OVER-PAYMENT 034000 DISPLAY-EXCEPTION 034100 DO-NOT-DISPLAY-ACCEPT-PAYMENT 034200 PROTECT-INPUT-FIELD TO TRUE 285 034300 MOVE ARBAL TO OVRPMT OF SUBFILE1-O 286 034400 MOVE MESSAGE-THREE TO ECPMSG OF SUBFILE1-O 287 034500 MOVE '0' TO STSCDE OF SUBFILE1-O 288 034600 PERFORM REWRITE-DISPLAY-SUBFILE-RECORD 034700 ELSE 289 034800 SET DO-NOT-DISPLAY-FIELD 034900 DO-NOT-DISPLAY-OVER-PAYMENT 035000 DO-NOT-REVERSE-FIELD-IMAGE 035100 DO-NOT-MAKE-FIELD-BLINK 035200 DO-NOT-DISPLAY-ACCEPT-PAYMENT 035300 PROTECT-INPUT-FIELD TO TRUE 290 035400 MOVE SPACES TO ECPMSG OF SUBFILE1-O 291 035500 MOVE ZEROES TO OVRPMT OF SUBFILE1-O 292 035600 MOVE '0' TO STSCDE OF SUBFILE1-O 293 035700 PERFORM REWRITE-DISPLAY-SUBFILE-RECORD 035800 END-IF 035900 ELSE 294 036000 PERFORM NO-CUSTOMER-INVOICE-ROUTINE 036100 END-IF 036200 ELSE 295 036300 PERFORM NO-CUSTOMER-INVOICE-ROUTINE 036400 END-IF 5722WDS V5R3M0 030905 LN IBM ILE COBOL CBLGUIDE/PAYUPDT ISERIES1 03/09/15 15:08:37 Page 12 STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S COPYNAME CHG DATE 036500 ELSE 296 036600 SET REVERSE-FIELD-IMAGE 036700 DO-NOT-PROTECT-INPUT-FIELD 036800 DISPLAY-FIELD 036900 DO-NOT-DISPLAY-OVER-PAYMENT 037000 DO-NOT-MAKE-FIELD-BLINK 037100 DISPLAY-EXCEPTION 037200 DO-NOT-DISPLAY-ACCEPT-PAYMENT 037300 DO-NOT-PROTECT-INPUT-FIELD TO TRUE 297 037400 MOVE ZEROES TO OVRPMT OF SUBFILE1-O 298 037500 MOVE MESSAGE-ONE TO ECPMSG OF SUBFILE1-O 299 037600 MOVE '1' TO STSCDE OF SUBFILE1-O 300 037700 PERFORM REWRITE-DISPLAY-SUBFILE-RECORD 037800 END-IF. 301 037900 PERFORM READ-MODIFIED-SUBFILE-RECORD. 038000 038100 START-ON-CUSTOMER-INVOICE-FILE. 302 038200 START CUSTOMER-INVOICE-FILE 038300 KEY IS GREATER THAN COMP-KEY 303 038400 INVALID KEY SET NO-MORE-INVOICES-EXIST TO TRUE 038500 END-START. 038600 038700 READ-CUSTOMER-INVOICE-RECORD. 304 038800 READ CUSTOMER-INVOICE-FILE NEXT RECORD 305 038900 AT END SET NO-MORE-INVOICES-EXIST TO TRUE 039000 END-READ. 306 039100 IF CUST OF CUSTOMER-MASTER-RECORD 039200 IS NOT EQUAL TO CUST OF CUSTOMER-INVOICE-RECORD THEN 307 039300 SET NO-MORE-INVOICES-EXIST TO TRUE 039400 END-IF. 039500 039600 CUSTOMER-MASTER-FILE-UPDATE. 308 039700 MOVE FILE-DATE TO LSTDAT OF CUSTOMER-MASTER-RECORD. 309 039800 MOVE AMPAID OF SUBFILE1-I 039900 TO LSTAMT OF CUSTOMER-MASTER-RECORD. 310 040000 SUBTRACT AMPAID OF SUBFILE1-I 040100 FROM ARBAL OF CUSTOMER-MASTER-RECORD. 311 040200 REWRITE CUSTOMER-MASTER-RECORD 040300 INVALID KEY 312 040400 DISPLAY 'ERROR IN REWRITE OF CUSTOMER MASTER' 040500 END-REWRITE. 040600 040700 REWRITE-DISPLAY-SUBFILE-RECORD. 313 040800 MOVE AMPAID OF SUBFILE1-I TO AMPAID OF SUBFILE1-O. 314 040900 MOVE CUST OF SUBFILE1-I TO CUST OF SUBFILE1-O. 315 041000 SET WRITE-DISPLAY TO TRUE. 316 041100 SET SUBFILE1-FORMAT TO TRUE. 317 041200 MOVE CORR INDICATOR-AREA TO SUBFILE1-O-INDIC. *** CORRESPONDING items for statement 317: *** IN51 *** IN52 *** IN53 *** IN54 *** IN55 *** IN56 5722WDS V5R3M0 030905 LN IBM ILE COBOL CBLGUIDE/PAYUPDT ISERIES1 03/09/15 15:08:37 Page 13 STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S COPYNAME CHG DATE *** End of CORRESPONDING items for statement 317 318 041300 REWRITE SUBFILE PAYMENT-UPDATE-DISPLAY-RECORD 041400 FORMAT IS 'SUBFILE1' 041500 END-REWRITE. 041600 041700 NO-CUSTOMER-INVOICE-ROUTINE. 319 041800 IF STSCDE OF SUBFILE1-I IS EQUAL TO '1' THEN 320 041900 IF ACPPMT OF SUBFILE1-I IS EQUAL TO '*NO' THEN 321 042000 SET DO-NOT-DISPLAY-FIELD 042100 DO-NOT-DISPLAY-OVER-PAYMENT 042200 DO-NOT-REVERSE-FIELD-IMAGE 042300 DO-NOT-MAKE-FIELD-BLINK 042400 DO-NOT-DISPLAY-ACCEPT-PAYMENT 042500 PROTECT-INPUT-FIELD 042600 TO TRUE 322 042700 MOVE SPACES TO ECPMSG OF SUBFILE1-O 323 042800 MOVE ZEROES TO OVRPMT OF SUBFILE1-O 324 042900 MOVE '0' TO STSCDE OF SUBFILE1-O 325 043000 PERFORM REWRITE-DISPLAY-SUBFILE-RECORD 043100 ELSE 326 043200 PERFORM CUSTOMER-MASTER-FILE-UPDATE 327 043300 SET MAKE-FIELD-BLINK 043400 DISPLAY-FIELD 043500 DO-NOT-REVERSE-FIELD-IMAGE 043600 OVER-PAYMENT-NOT-DISPLAYED 043700 DISPLAY-OVER-PAYMENT 043800 DISPLAY-EXCEPTION 043900 DO-NOT-DISPLAY-ACCEPT-PAYMENT 044000 PROTECT-INPUT-FIELD 044100 TO TRUE 328 044200 MOVE ARBAL TO OVRPMT OF SUBFILE1-O 329 044300 MOVE MESSAGE-THREE TO ECPMSG OF SUBFILE1-O 330 044400 MOVE '0' TO STSCDE OF SUBFILE1-O 331 044500 PERFORM REWRITE-DISPLAY-SUBFILE-RECORD 044600 END-IF 044700 ELSE 332 044800 SET REVERSE-FIELD-IMAGE 044900 DISPLAY-FIELD 045000 DO-NOT-PROTECT-INPUT-FIELD 045100 DO-NOT-DISPLAY-OVER-PAYMENT 045200 DISPLAY-EXCEPTION 045300 DISPLAY-ACCEPT-PAYMENT 045400 DISPLAY-ACCEPT-HEADING 045500 DISPLAY-ACCEPT-MESSAGE 045600 DO-NOT-MAKE-FIELD-BLINK 045700 TO TRUE 333 045800 MOVE ZEROS TO OVRPMT OF SUBFILE1-O 334 045900 MOVE MESSAGE-TWO TO ECPMSG OF SUBFILE1-O 335 046000 MOVE '1' TO STSCDE OF SUBFILE1-O 336 046100 PERFORM REWRITE-DISPLAY-SUBFILE-RECORD 046200 END-IF. 046300 046400 PAYMENT-UPDATE. 337 046500 SUBTRACT AMPAID OF CUSTOMER-INVOICE-RECORD 046600 FROM ORDAMT OF CUSTOMER-INVOICE-RECORD 5722WDS V5R3M0 030905 LN IBM ILE COBOL CBLGUIDE/PAYUPDT ISERIES1 03/09/15 15:08:37 Page 14 STMT PL SEQNBR -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S COPYNAME CHG DATE 046700 GIVING AMOUNT-OWED. 338 046800 SUBTRACT AMOUNT-PAID 046900 FROM AMOUNT-OWED 047000 GIVING INVOICE-BALANCE. 339 047100 IF INVOICE-BALANCE IS LESS THAN 0.01 THEN 340 047200 MOVE 2 TO OPNSTS OF CUSTOMER-INVOICE-RECORD 341 047300 MOVE ORDAMT OF CUSTOMER-INVOICE-RECORD 047400 TO AMPAID OF CUSTOMER-INVOICE-RECORD 342 047500 SUBTRACT AMOUNT-OWED 047600 FROM AMOUNT-PAID 047700 ELSE 343 047800 ADD AMOUNT-PAID TO AMPAID OF CUSTOMER-INVOICE-RECORD 344 047900 SET NO-MORE-PAYMENT-EXIST TO TRUE 048000 END-IF. 345 048100 REWRITE CUSTOMER-INVOICE-RECORD 048200 INVALID KEY 346 048300 DISPLAY 'ERROR IN REWRITE OF CUSTOMER INVOICE' 048400 END-REWRITE. 347 048500 IF PAYMENT-EXIST THEN 348 048600 PERFORM READ-CUSTOMER-INVOICE-RECORD 048700 END-IF. 048800 048900 INITIALIZE-SUBFILE-RECORD. 349 049000 MOVE SPACES TO CUST OF SUBFILE1-O. 350 049100 MOVE SPACES TO ECPMSG OF SUBFILE1-O. 351 049200 MOVE '0' TO STSCDE OF SUBFILE1-O. 352 049300 MOVE ZEROS TO AMPAID OF SUBFILE1-O. 353 049400 MOVE ZEROS TO OVRPMT OF SUBFILE1-O. 354 049500 ADD 1 TO REL-NUMBER. 355 049600 MOVE CORR INDICATOR-AREA TO SUBFILE1-O-INDIC. *** CORRESPONDING items for statement 355: *** IN51 *** IN52 *** IN53 *** IN54 *** IN55 *** IN56 *** End of CORRESPONDING items for statement 355 356 049700 WRITE SUBFILE PAYMENT-UPDATE-DISPLAY-RECORD 049800 FORMAT IS 'SUBFILE1' 049900 END-WRITE. * * * * * E N D O F S O U R C E * * * * * |
This is the initial display that is written to the work station to prompt you to enter the customer number and payment:
+--------------------------------------------------------------------------------+ | | | | |Customer Payment Update Prompt Date 11/08/96 | | | | Customer Payment | | | | | | ______ _________ | | ______ _________ | | ______ _________ | | ______ _________ | | ______ _________ | | ______ _________ | | ______ _________ | | ______ _________ | | ______ _________ | | ______ _________ | | | | ______ _________ | | ______ _________ | | ______ _________ | | ______ _________ | | ______ _________ | | | | | +--------------------------------------------------------------------------------+
Enter the customer numbers and payments:
+--------------------------------------------------------------------------------+ | | | | |Customer Payment Update Prompt Date 11/08/96 | | | | Customer Payment | | | | | | 34500 2000 | | 40500 30000 | | 36000 2500 | | 12500 200 | | 22799 4500 | | 41900 7500 | | 10001 5000 | | 49500 2500 | | 13300 3500 | | 56900 4000 | | | | | | | | | | | | | | | | | | | | | +--------------------------------------------------------------------------------+
Payments that would result in overpayments or that have incorrect customer numbers are left on the display and appropriate messages are added:
+--------------------------------------------------------------------------------+ |Customer Payment Update Prompt Date 11/08/96 | |Accept Customer Payment Exception Message | |Payment | | | |_____ 40500 30000 NO INVOICES EXIST FOR CUSTOMER | | | |_____ 12500 200 NO INVOICES EXIST FOR CUSTOMER | | | |_____ 41900 7500 NO INVOICES EXIST FOR CUSTOMER | | 10001 5000 CUSTOMER DOES NOT EXIST | | | |_____ 13300 3500 NO INVOICES EXIST FOR CUSTOMER | | | | | | | | | | | | | | | | | | | |Accept payment values: (*NO *YES) | | | +--------------------------------------------------------------------------------+
Indicate which payments to accept:
+--------------------------------------------------------------------------------+ |Customer Payment Update Prompt Date 11/08/96 | | | |Accept Customer Payment Exception Message | |Payment | | | | *NO 40500 30000 NO INVOICES EXIST FOR CUSTOMER | | | | *YES 12500 200 NO INVOICES EXIST FOR CUSTOMER | | | | *NO 41900 7500 NO INVOICES EXIST FOR CUSTOMER | | 10001 5000 CUSTOMER DOES NOT EXIST | | | | *NO 13300 3500 NO INVOICES EXIST FOR CUSTOMER | | | | | | | | | | | | | | | | | | | |Accept payment values: (*NO *YES) | | | +--------------------------------------------------------------------------------+
The accepted payments are processed, and overpayment information is displayed:
+--------------------------------------------------------------------------------+ |Customer Payment Update Prompt Date 11/08/96 | |Accept Customer Payment Exception Message | |Payment | | | | 12500 200 CUSTOMER HAS AN OVERPAYMENT OF 58.50 | | | | 10001 5000 CUSTOMER DOES NOT EXIST | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | +--------------------------------------------------------------------------------+
(C) Copyright IBM Corporation 1992, 2005. All Rights Reserved.