図 152 に示すのは、支払更新プログラムの例 PAYUPDT です。 これに関連する DDS については 図 150 および 図 151 を参照してください。 関連した表示画面の例については 得意先支払い表示画面を参照してください。 得意先マスター・ファイル CUSMSTP の DDS については 図 132 を参照してください。
この例では、得意先からの支払いが登録されます。 オペレーターに対して、1 つまたは複数の得意先番号を入力して、各得意先の口座に入れる金額を入力するようにプロンプトが出されます。 プログラムは得意先番号を調べて、送り状が未処理になっている既存の得意先の支払いであれば、無条件に受け入れます。 得意先からの支払額によって過剰支払いが起きた場合、オペレーターはその支払いを受け取るか受け取らないかを選択できます。 得意先番号に対する得意先レコードが存在していない場合は、エラー・メッセージが出されます。 オペレーターが 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)
5722WDS V5R4M0 060210 LN IBM ILE COBOL CBLGUIDE/PAYUPDT ISERIES1 06/02/15 15:08:37 ページ 2
ソ ー ス
STMT PL SEQNO -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S コピー名 変更日付
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 V5R4M0 060210 LN IBM ILE COBOL CBLGUIDE/PAYUPDT ISERIES1 06/02/15 15:08:37 ページ 3
STMT PL SEQNO -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S コピー名 変更日付
+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 V5R4M0 060210 LN IBM ILE COBOL CBLGUIDE/PAYUPDT ISERIES1 06/02/15 15:08:37 ページ 4
STMT PL SEQNO -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S コピー名 変更日付
+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 V5R4M0 060210 LN IBM ILE COBOL CBLGUIDE/PAYUPDT ISERIES1 06/02/15 15:08:37 ページ 5
STMT PL SEQNO -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S コピー名 変更日付
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 V5R4M0 060210 LN IBM ILE COBOL CBLGUIDE/PAYUPDT ISERIES1 06/02/15 15:08:37 ページ 6
STMT PL SEQNO -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S コピー名 変更日付
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 V5R4M0 060210 LN IBM ILE COBOL CBLGUIDE/PAYUPDT ISERIES1 06/02/15 15:08:37 ページ 7
STMT PL SEQNO -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S コピー名 変更日付
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 V5R4M0 060210 LN IBM ILE COBOL CBLGUIDE/PAYUPDT ISERIES1 06/02/15 15:08:37 ページ 8
STMT PL SEQNO -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S コピー名 変更日付
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 V5R4M0 060210 LN IBM ILE COBOL CBLGUIDE/PAYUPDT ISERIES1 06/02/15 15:08:37 ページ 9
STMT PL SEQNO -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S コピー名 変更日付
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 V5R4M0 060210 LN IBM ILE COBOL AS400 用 CBLGUIDE/PAYUPDT ISERIES1 06/02/15 15:08:37 ページ 10
STMT PL SEQNO -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S コピー名 変更日付
*** 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 V5R4M0 060210 LN IBM ILE COBOL CBLGUIDE/PAYUPDT ISERIES1 06/02/15 15:08:37 ページ 11
STMT PL SEQNO -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S コピー名 変更日付
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 V5R4M0 060210 LN IBM ILE COBOL CBLGUIDE/PAYUPDT ISERIES1 06/02/15 15:08:37 ページ 12
STMT PL SEQNO -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S コピー名 変更日付
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 V5R4M0 060210 LN IBM ILE COBOL CBLGUIDE/PAYUPDT ISERIES1 06/02/15 15:08:37 ページ 13
STMT PL SEQNO -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S コピー名 変更日付
*** 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 V5R4M0 060210 LN IBM ILE COBOL CBLGUIDE/PAYUPDT ISERIES1 06/02/15 15:08:37 ページ 14
STMT PL SEQNO -A 1 B..+....2....+....3....+....4....+....5....+....6....+....7..IDENTFCN S コピー名 変更日付
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.
* * * * * ソ ー ス 仕 様 の 終 わ り * * * * *
これは、得意先番号と支払額の入力を要求するためにワークステーションに表示される最初の表示画面です。
Customer Payment Update Prompt Date 11/08/96 Customer Payment ______ _________ ______ _________ ______ _________ ______ _________ ______ _________ ______ _________ ______ _________ ______ _________ ______ _________ ______ _________ ______ _________ ______ _________ ______ _________ ______ _________ ______ _________
次のように、得意先番号と支払額を入力します。
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
支払過剰になるものや得意先番号が正しくないものは、次に示すように画面に残り、そのことを示すメッセージが表示されます。
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)
次のようにして、どの支払いを受け付けるかを指定します。
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)
受け付けられた支払いは処理され、支払過剰が次にように表示されます。
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, 2006. All Rights Reserved.