MFmainframe-rea
WS carddemo · 26f629ef

cobol · 620 lines · sha256 92776ed2801da114 · guides at columns 7 and 72app/app-vsam-mq/cbl/COACCT01.cbl

1000100 IDENTIFICATION DIVISION. 00010000
2000200 PROGRAM-ID. COACCT01 IS INITIAL. 00020001
3000300 AUTHOR. AWS. 00030000
4000400 DATE-WRITTEN. 03/21. 00040000
5000500 DATE-COMPILED. 00050000
6000600 00060000
7000700 ENVIRONMENT DIVISION. 00070000
8000800 00080000
9000900 DATA DIVISION. 00090000
10001000 00100000
11001100 WORKING-STORAGE SECTION. 00110000
12001700 00170000
13001800 01 WS-MQ-MSG-FLAG PIC X(01) VALUE 'N'. 00180007
14001900 88 NO-MORE-MSGS VALUE 'Y'. 00190007
15002000 00200000
16002100 01 WS-RESP-QUEUE-STS PIC X(01) VALUE 'N'. 00210007
17002200 88 RESP-QUEUE-OPEN VALUE 'Y'. 00220007
18002300 00230000
19002400 01 WS-ERR-QUEUE-STS PIC X(01) VALUE 'N'. 00240007
20002500 88 ERR-QUEUE-OPEN VALUE 'Y'. 00250007
21002600 00260000
22002700 01 WS-REPLY-QUEUE-STS PIC X(01) VALUE 'N'. 00270007
23002800 88 REPLY-QUEUE-OPEN VALUE 'Y'. 00280007
24002900 00290000
25003700 00370000
26003800 01 WS-CICS-RESP-CDS. 00380007
27003900 05 WS-CICS-RESP1-CD PIC S9(08) COMP VALUE ZERO. 00390007
28004000 05 WS-CICS-RESP2-CD PIC S9(08) COMP VALUE ZERO. 00400007
29004300 05 WS-CICS-RESP1-CD-D PIC 9(08) VALUE ZERO. 00430007
30004400 05 WS-CICS-RESP2-CD-D PIC 9(08) VALUE ZERO. 00440007
31004500 00450000
32004600*********************************************** 00460000
33004700** DATE FIELDS ** 00470000
34004800*********************************************** 00480000
35004900 01 WS-DATE-TIME. 00490000
36005000 10 WS-ABS-TIME PIC S9(15) COMP-3 VALUE ZERO. 00500000
37005100 10 WS-MMDDYYYY PIC X(10) VALUE SPACES. 00510000
38005200 10 WS-TIME PIC X(8) VALUE SPACES. 00520000
39004600*********************************************** 00530000
40004700** MQ FIELDS ** 00540000
41004800*********************************************** 00550000
42005000 01 MQ-QUEUE PIC X(48). 00570000
43005100 01 MQ-QUEUE-REPLY PIC X(48). 00580000
44005200 01 MQ-HCONN PIC S9(09) BINARY VALUE 0. 00590000
45005300 01 MQ-CONDITION-CODE PIC S9(09) BINARY VALUE 0. 00600000
46005400 01 MQ-REASON-CODE PIC S9(09) BINARY VALUE 0. 00610000
47005500 01 MQ-HOBJ PIC S9(09) BINARY VALUE 0. 00620000
48005600 01 MQ-OPTIONS PIC S9(09) BINARY VALUE 0. 00630000
49005700 01 MQ-BUFFER-LENGTH PIC S9(09) BINARY. 00640000
50005800 01 MQ-BUFFER PIC X(1000). 00650000
51005900 01 MQ-DATA-LENGTH PIC S9(09) BINARY. 00660000
52006000 01 MQ-CORRELID PIC X(24). 00670000
53006100 01 MQ-MSG-ID PIC X(24). 00680000
54006200 01 MQ-MSG-COUNT PIC 9(09). 00690000
55006300 01 SAVE-CORELID PIC X(24). 00700000
56006400 01 SAVE-MSGID PIC X(24). 00710000
57006500 01 SAVE-REPLY2Q PIC X(48). 00720000
58006600 01 MQ-ERR-DISPLAY. 00730000
59006700 05 MQ-ERROR-PARA PIC X(25) . 00740000
60006800 05 FILLER PIC X(02) VALUE SPACES. 00750000
61006900 05 MQ-APPL-RETURN-MESSAGE PIC X(25). 00760000
62007000 05 FILLER PIC X(02) VALUE SPACES. 00770000
63007100 05 MQ-APPL-CONDITION-CODE PIC 9(02). 00780000
64007200 05 FILLER PIC X(02) VALUE SPACES. 00790000
65007300 05 MQ-APPL-REASON-CODE PIC 9(05). 00800000
66007400 05 FILLER PIC X(02) VALUE SPACES. 00810000
67007500 05 MQ-APPL-QUEUE-NAME PIC X(48). 00820000
68007600 00830000
69007700 00840000
70007800 01 MQ-GET-MESSAGE-OPTIONS. 00850000
71007900 COPY CMQGMOV. 00860000
72008000 00870000
73008100 00880000
74008200 01 MQ-PUT-MESSAGE-OPTIONS. 00890000
75008300 COPY CMQPMOV. 00900000
76008400 00910000
77008500 00920000
78008600 01 MQ-MESSAGE-DESCRIPTOR. 00930000
79008700 COPY CMQMDV. 00940000
80008800 00950000
81008900 00960000
82009000 01 MQ-OBJECT-DESCRIPTOR. 00970000
83009100 COPY CMQODV. 00980000
84009200 00990000
85009300 01000000
86009400 01 MQ-CONSTANTS. 01010000
87009500 COPY CMQV. 01020000
88009600 01030000
89009700 01 MQ-GET-QUEUE-MESSAGE. 01040000
90009800 COPY CMQTML. 01050000
91009900 01060000
92010000 01 QUEUE-INFO. 01070000
93010100 05 QMGR-NAME PIC X(48) VALUE SPACES. 01080007
94010200 05 INPUT-QUEUE-NAME PIC X(48) VALUE SPACES. 01090000
95010300 05 REPLY-QUEUE-NAME PIC X(48) VALUE SPACES. 01100000
96010400 05 ERROR-QUEUE-NAME PIC X(48) VALUE SPACES. 01110000
97010500 01120000
98010600 01 INPUT-QUEUE-HANDLE PIC S9(09) BINARY VALUE 0. 01130000
99010700 01140000
100010800 01 OUTPUT-QUEUE-HANDLE PIC S9(09) BINARY VALUE 0. 01150000
101010900 01160000
102011000 01 ERROR-QUEUE-HANDLE PIC S9(09) BINARY VALUE 0. 01170000
103011100 01180000
104011200 01 QMGR-HANDLE-CONN PIC S9(09) BINARY VALUE 0. 01190000
105011300 01 QUEUE-MESSAGE PIC X(1000). 01200000
106011400 01 REQUEST-MESSAGE PIC X(1000). 01210000
107011500 01 REPLY-MESSAGE PIC X(1000). 01220000
108011600 01 ERROR-MESSAGE PIC X(1000). 01230000
109011700 01 REQUEST-MSG-COPY. 01240002
110011700 10 WS-FUNC PIC X(04) VALUE SPACES. 01241000
111011700 10 WS-KEY PIC 9(11) VALUE ZEROES. 01242000
112011700 10 WS-FILLER PIC X(985) VALUE SPACES. 01243000
113011800 01250000
114 01 WS-VARIABLES. 01251000
115 05 LIT-ACCTFILENAME PIC X(8) 01251100
116 VALUE 'ACCTDAT '. 01251200
117 05 WS-RESP-CD PIC S9(09) COMP 01251300
118 VALUE ZEROS. 01251400
119 05 WS-REAS-CD PIC S9(09) COMP 01251500
120 VALUE ZEROS. 01251600
121 05 WS-XREF-RID. 01251700
122 10 WS-CARD-RID-CARDNUM PIC X(16). 01252000
123 10 WS-CARD-RID-CUST-ID PIC 9(09). 01253000
124 10 WS-CARD-RID-CUST-ID-X REDEFINES 01254000
125 WS-CARD-RID-CUST-ID PIC X(09). 01255000
126 10 WS-CARD-RID-ACCT-ID PIC 9(11). 01256000
127 10 WS-CARD-RID-ACCT-ID-X REDEFINES 01257000
128 WS-CARD-RID-ACCT-ID PIC X(11). 01258000
129 01259000
130 01 WS-ACCT-RESPONSE. 01259107
131 01259207
132 05 WS-ACCT-LBL PIC X(13) VALUE 01259307
133 'ACCOUNT ID : '. 01259407
134 05 WS-ACCT-ID PIC 9(11) VALUE ZEROES.01259507
135 05 WS-STATUS-LBL PIC X(17) VALUE 01259608
136 'ACCOUNT STATUS : '. 01259707
137 05 WS-ACCT-ACTIVE-STATUS PIC X(01) VALUE SPACES.01259807
138 05 WS-CURR-BAL-LBL PIC X(10) VALUE 01259907
139 'BALANCE : '. 01260007
140 05 WS-ACCT-CURR-BAL PIC S9(10)V99 01260107
141 VALUE ZEROES.01260207
142 05 WS-CRDT-LMT-LBL PIC X(15) VALUE 01260307
143 'CREDIT LIMIT : '. 01260407
144 05 WS-ACCT-CREDIT-LIMIT PIC S9(10)V99 01260507
145 VALUE ZEROES.01260607
146 05 WS-CASH-LIMIT-LBL PIC X(13) VALUE 01260707
147 'CASH LIMIT : '. 01260807
148 05 WS-ACCT-CASH-CREDIT-LIMIT PIC S9(10)V99 01260909
149 VALUE ZEROES.01261007
150 05 WS-OPEN-DATE-LBL PIC X(12) VALUE 01261107
151 'OPEN DATE : '. 01261207
152 05 WS-ACCT-OPEN-DATE PIC X(10) VALUE SPACES.01261307
153 05 WS-EXPR-DATE-LBL PIC X(12) VALUE 01261407
154 'EXPR DATE : '. 01261507
155 05 WS-ACCT-EXPIRAION-DATE PIC X(10) VALUE SPACES.01261607
156 05 WS-REISSUE-DT-LBL PIC X(12) VALUE 01261707
157 'REIS DATE : '. 01261807
158 05 WS-ACCT-REISSUE-DATE PIC X(10) VALUE SPACES.01261907
159 05 WS-CURR-CYC-CREDIT-LBL PIC X(13) VALUE 01262007
160 'CREDIT BAL : '. 01262107
161 05 WS-ACCT-CURR-CYC-CREDIT PIC S9(10)V99 01262207
162 VALUE ZEROES.01262307
163 05 WS-CURR-CYC-DEBIT-LBL PIC X(12) VALUE 01262407
164 'DEBIT BAL : '. 01262507
165 05 WS-ACCT-CURR-CYC-DEBIT PIC S9(10)V99 01262607
166 VALUE ZEROES.01262707
167 05 WS-ACCT-GRP-LBL PIC X(11) VALUE 01262807
168 'GROUP ID : '. 01262907
169 05 WS-ACCT-GROUP-ID PIC X(10) VALUE SPACES.01263010
170 *ACCOUNT RECORD LAYOUT 01263107
171 COPY CVACT01Y. 01263207
172 01263307
173011900 01264000
174012000 LINKAGE SECTION. 01270000
175012100 01280000
176012200 PROCEDURE DIVISION. 01290000
177012300 01300000
178012400 1000-CONTROL. 01310007
179012500 01320000
180013600 MOVE SPACES TO 01321007
181013700 INPUT-QUEUE-NAME 01322007
182013800 QMGR-NAME 01323007
183013900 QUEUE-MESSAGE 01324007
184014000 01325007
185014100 INITIALIZE MQ-ERR-DISPLAY 01326007
186014200 01327007
187014600 PERFORM 2100-OPEN-ERROR-QUEUE 01327107
188015300******************************************************************01327207
189015400* GET THE QUEUE NAME WHICH STARTED THE TRANSACTION *01327307
190015500******************************************************************01327407
191015600 EXEC CICS RETRIEVE 01327507
192015700 INTO(MQTM) 01327607
193015800 RESP(WS-CICS-RESP1-CD) 01327707
194015900 RESP2(WS-CICS-RESP2-CD) 01327807
195016000 END-EXEC 01327907
196016100 IF WS-CICS-RESP1-CD = DFHRESP(NORMAL) 01328007
197016200 MOVE MQTM-QNAME TO INPUT-QUEUE-NAME 01328107
198016300 MOVE 'CARD.DEMO.REPLY.ACCT' TO REPLY-QUEUE-NAME 01328207
199016400 ELSE 01328307
200016500 MOVE 'CICS RETREIVE' TO MQ-ERROR-PARA 01328407
201016600 MOVE WS-CICS-RESP1-CD TO WS-CICS-RESP1-CD-D 01328507
202016700 MOVE WS-CICS-RESP2-CD TO WS-CICS-RESP2-CD 01328607
203016800 STRING 'RESP: ', WS-CICS-RESP1-CD-D , WS-CICS-RESP2-CD-D, 01328707
204016900 'END' DELIMITED BY SIZE 01328807
205017000 INTO MQ-APPL-RETURN-MESSAGE 01328907
206017100 END-STRING 01329007
207017200 01329107
208 PERFORM 9000-ERROR 01329207
209017400 PERFORM 8000-TERMINATION 01329307
210017500 END-IF 01329407
211014500 01329507
212014800 PERFORM 2300-OPEN-INPUT-QUEUE 01329807
213014900 PERFORM 2400-OPEN-OUTPUT-QUEUE 01329907
214012700 PERFORM 3000-GET-REQUEST 01340007
215012800 PERFORM 4000-MAIN-PROCESS UNTIL 01350007
216012900 NO-MORE-MSGS 01360007
217013000 01370000
218013100 PERFORM 8000-TERMINATION. 01380007
219013200 01390000
220015000 . 01570000
221015100 01580000
222017800 2300-OPEN-INPUT-QUEUE. 01850007
223017900* OPEN-INPUT WILL OPEN A QUEUE FOR GET PROCESSING 01860000
224018000 01870000
225018400 01910000
226018500 MOVE SPACES TO MQOD-OBJECTQMGRNAME 01920007
227018600 MOVE INPUT-QUEUE-NAME TO MQOD-OBJECTNAME 01930007
228018700 01940000
229018800 COMPUTE MQ-OPTIONS = MQOO-INPUT-SHARED 01950000
230018900 + MQOO-SAVE-ALL-CONTEXT 01960000
231019000 + MQOO-FAIL-IF-QUIESCING 01970007
232019100 01980000
233019200 CALL 'MQOPEN' USING QMGR-HANDLE-CONN 01990000
234019300 MQ-OBJECT-DESCRIPTOR 02000000
235019400 MQ-OPTIONS 02010000
236019500 MQ-HOBJ 02020000
237019600 MQ-CONDITION-CODE 02030000
238019700 MQ-REASON-CODE 02040007
239019800 02050000
240019900 EVALUATE MQ-CONDITION-CODE 02060000
241020000 WHEN MQCC-OK 02070000
242020100 MOVE MQ-CONDITION-CODE TO MQ-APPL-CONDITION-CODE 02080000
243020200 MOVE MQ-REASON-CODE TO MQ-APPL-REASON-CODE 02090000
244020300 MOVE MQ-HOBJ TO INPUT-QUEUE-HANDLE 02100000
245020400 SET REPLY-QUEUE-OPEN TO TRUE 02110007
246020500 WHEN OTHER 02120000
247020600 MOVE MQ-CONDITION-CODE TO MQ-APPL-CONDITION-CODE 02130000
248020700 MOVE MQ-REASON-CODE TO MQ-APPL-REASON-CODE 02140000
249020800 MOVE INPUT-QUEUE-NAME TO MQ-APPL-QUEUE-NAME 02150000
250020900 MOVE 'INP MQOPEN ERR' TO MQ-APPL-RETURN-MESSAGE 02160000
251021000 PERFORM 9000-ERROR 02170007
252021100 PERFORM 8000-TERMINATION 02180007
253021200 END-EVALUATE. 02190000
254021300 02200000
255021400 2400-OPEN-OUTPUT-QUEUE. 02210007
256021500 02220000
257021600* OPEN-OUTPUT WILL OPEN A QUEUE FOR PUT PROCESSING 02230000
258021700 02240000
259022100 02280000
260022200 MOVE SPACES TO MQOD-OBJECTQMGRNAME 02290007
261022300 MOVE REPLY-QUEUE-NAME TO MQOD-OBJECTNAME 02300007
262022400 02310000
263022500 COMPUTE MQ-OPTIONS = MQOO-OUTPUT 02320000
264022600 + MQOO-PASS-ALL-CONTEXT 02330000
265022700 + MQOO-FAIL-IF-QUIESCING 02340007
266022800 02350000
267022900 CALL 'MQOPEN' USING QMGR-HANDLE-CONN 02360000
268023000 MQ-OBJECT-DESCRIPTOR 02370000
269023100 MQ-OPTIONS 02380000
270023200 MQ-HOBJ 02390000
271023300 MQ-CONDITION-CODE 02400000
272023400 MQ-REASON-CODE 02410007
273023500 02420000
274023600 EVALUATE MQ-CONDITION-CODE 02430000
275023700 WHEN MQCC-OK 02440000
276023800 MOVE MQ-CONDITION-CODE TO MQ-APPL-CONDITION-CODE 02450000
277023900 MOVE MQ-REASON-CODE TO MQ-APPL-REASON-CODE 02460000
278024000 MOVE MQ-HOBJ TO OUTPUT-QUEUE-HANDLE 02470000
279024100 SET RESP-QUEUE-OPEN TO TRUE 02480007
280024200 WHEN OTHER 02490000
281024300 MOVE MQ-CONDITION-CODE TO MQ-APPL-CONDITION-CODE 02500000
282024400 MOVE MQ-REASON-CODE TO MQ-APPL-REASON-CODE 02510000
283024500 MOVE REPLY-QUEUE-NAME TO MQ-APPL-QUEUE-NAME 02520000
284024600 MOVE 'OUT MQOPEN ERR' TO MQ-APPL-RETURN-MESSAGE 02530000
285024700 PERFORM 9000-ERROR 02540007
286024800 PERFORM 8000-TERMINATION 02550007
287024900 END-EVALUATE. 02560000
288025000 02570000
289025100 2100-OPEN-ERROR-QUEUE. 02580007
290025200 02590000
291025300* OPEN-OUTPUT WILL OPEN A QUEUE FOR PUT PROCESSING 02600000
292025400 02610000
293025800 02650000
294025900 MOVE 'CARD.DEMO.ERROR' TO ERROR-QUEUE-NAME 02660000
295026000 MOVE SPACES TO MQOD-OBJECTQMGRNAME 02670007
296026100 MOVE ERROR-QUEUE-NAME TO MQOD-OBJECTNAME 02680007
297026200 02690000
298026300 COMPUTE MQ-OPTIONS = MQOO-OUTPUT 02700000
299026400 + MQOO-PASS-ALL-CONTEXT 02710000
300026500 + MQOO-FAIL-IF-QUIESCING 02720007
301026600 02730000
302026700 CALL 'MQOPEN' USING QMGR-HANDLE-CONN 02740000
303026800 MQ-OBJECT-DESCRIPTOR 02750000
304026900 MQ-OPTIONS 02760000
305027000 MQ-HOBJ 02770000
306027100 MQ-CONDITION-CODE 02780000
307027200 MQ-REASON-CODE 02790007
308027300 02800000
309027400 EVALUATE MQ-CONDITION-CODE 02810000
310027500 WHEN MQCC-OK 02820000
311027600 MOVE MQ-CONDITION-CODE TO MQ-APPL-CONDITION-CODE 02830000
312027700 MOVE MQ-REASON-CODE TO MQ-APPL-REASON-CODE 02840000
313027800 MOVE MQ-HOBJ TO ERROR-QUEUE-HANDLE 02850000
314027900 SET ERR-QUEUE-OPEN TO TRUE 02860007
315028000 WHEN OTHER 02870000
316028100 MOVE MQ-CONDITION-CODE TO MQ-APPL-CONDITION-CODE 02880000
317028200 MOVE MQ-REASON-CODE TO MQ-APPL-REASON-CODE 02890000
318028300 MOVE ERROR-QUEUE-NAME TO MQ-APPL-QUEUE-NAME 02900000
319028400 MOVE 'ERR MQOPEN ERR' TO MQ-APPL-RETURN-MESSAGE 02910000
320028500 DISPLAY MQ-ERR-DISPLAY 02920000
321028600 PERFORM 8000-TERMINATION 02930007
322028700 END-EVALUATE. 02940000
323028800 02950000
324028900 02960000
325029000 4000-MAIN-PROCESS. 02970007
326029100 EXEC CICS 02980000
327029200 SYNCPOINT 02990000
328029300 END-EXEC 03000000
329029400 03010000
330029500 PERFORM 3000-GET-REQUEST 03020007
331029600 . 03030000
332029700 03040000
333029800 03050000
334029900 3000-GET-REQUEST. 03060007
335030000* GET WILL GET A MESSAGE FROM THE QUEUE 03070012
336030700*** ADDED 5000 MS (5 SECS) AS THE WAIT INTERVAL FOR GET 03140000
337030800 MOVE 5000 TO MQGMO-WAITINTERVAL 03150000
338030900 MOVE SPACES TO MQ-CORRELID 03160000
339031000 MOVE SPACES TO MQ-MSG-ID 03170000
340031100 MOVE INPUT-QUEUE-NAME TO MQ-QUEUE 03180000
341031200 MOVE INPUT-QUEUE-HANDLE TO MQ-HOBJ 03190000
342031300 MOVE 1000 TO MQ-BUFFER-LENGTH 03200000
343031400 MOVE MQMI-NONE TO MQMD-MSGID 03210000
344031500 MOVE MQCI-NONE TO MQMD-CORRELID 03220000
345031500 INITIALIZE REQUEST-MSG-COPY REPLACING NUMERIC BY ZEROES 03221000
346031600 03230000
347031700 COMPUTE MQGMO-OPTIONS = MQGMO-SYNCPOINT 03240000
348031800 + MQGMO-FAIL-IF-QUIESCING 03250000
349031900 + MQGMO-CONVERT 03260000
350032000 + MQGMO-WAIT 03270000
351032100 03280000
352032200 CALL 'MQGET' USING MQ-HCONN 03290000
353032300 MQ-HOBJ 03300000
354032400 MQ-MESSAGE-DESCRIPTOR 03310000
355032500 MQ-GET-MESSAGE-OPTIONS 03320000
356032600 MQ-BUFFER-LENGTH 03330000
357032700 MQ-BUFFER 03340000
358032800 MQ-DATA-LENGTH 03350000
359032900 MQ-CONDITION-CODE 03360000
360033000 MQ-REASON-CODE 03370007
361033100 03380000
362033200 03390000
363033300 IF MQ-CONDITION-CODE = MQCC-OK 03400000
364033400 MOVE MQMD-MSGID TO MQ-MSG-ID 03410000
365033500 MOVE MQMD-CORRELID TO MQ-CORRELID 03420000
366033600 MOVE MQMD-REPLYTOQ TO MQ-QUEUE-REPLY 03430000
367033700 MOVE MQ-CONDITION-CODE TO MQ-APPL-CONDITION-CODE 03440000
368033800 MOVE MQ-REASON-CODE TO MQ-APPL-REASON-CODE 03450000
369033900 MOVE MQ-BUFFER TO REQUEST-MESSAGE 03460000
370034000 MOVE MQ-CORRELID TO SAVE-CORELID 03470000
371034100 MOVE MQ-QUEUE-REPLY TO SAVE-REPLY2Q 03480000
372034200 MOVE MQ-MSG-ID TO SAVE-MSGID 03490000
373034300 MOVE REQUEST-MESSAGE TO REQUEST-MSG-COPY 03500000
374034400 PERFORM 4000-PROCESS-REQUEST-REPLY 03510010
375034500 ADD 1 TO MQ-MSG-COUNT 03520000
376034600 ELSE 03530000
377034700 IF MQ-REASON-CODE = MQRC-NO-MSG-AVAILABLE 03540011
378034800 SET NO-MORE-MSGS TO TRUE 03550007
379034900 03560000
380035000 ELSE 03570000
381035100 MOVE MQ-CONDITION-CODE TO MQ-APPL-CONDITION-CODE 03580000
382035200 MOVE MQ-REASON-CODE TO MQ-APPL-REASON-CODE 03590000
383035300 MOVE INPUT-QUEUE-NAME TO MQ-APPL-QUEUE-NAME 03600000
384035400 MOVE 'INP MQGET ERR:' TO MQ-APPL-RETURN-MESSAGE 03610000
385035500 PERFORM 9000-ERROR 03620007
386035600 PERFORM 8000-TERMINATION 03630007
387035700 END-IF 03640000
388035800 END-IF. 03650000
389035900 03660000
390036000 4000-PROCESS-REQUEST-REPLY. 03670010
391036100 MOVE SPACES TO REPLY-MESSAGE 03680000
392036100 INITIALIZE WS-DATE-TIME REPLACING NUMERIC BY ZEROES 03690000
393036100 IF WS-FUNC = 'INQA' AND WS-KEY > ZEROES 03700000
394 MOVE WS-KEY TO WS-CARD-RID-ACCT-ID 03700106
395 03700206
396 EXEC CICS READ 03700306
397 DATASET (LIT-ACCTFILENAME) 03700406
398 RIDFLD (WS-CARD-RID-ACCT-ID-X) 03700506
399 KEYLENGTH (LENGTH OF WS-CARD-RID-ACCT-ID-X) 03700606
400 INTO (ACCOUNT-RECORD) 03700706
401 LENGTH (LENGTH OF ACCOUNT-RECORD) 03700806
402 RESP (WS-RESP-CD) 03700906
403 RESP2 (WS-REAS-CD) 03701006
404 END-EXEC 03701106
405 03701206
406 EVALUATE WS-RESP-CD 03701306
407 WHEN DFHRESP(NORMAL) 03701406
408 MOVE ACCT-ID TO WS-ACCT-ID 03701510
409 MOVE ACCT-ACTIVE-STATUS 03701610
410 TO WS-ACCT-ACTIVE-STATUS 03701710
411 MOVE ACCT-CURR-BAL TO WS-ACCT-CURR-BAL 03701810
412 MOVE ACCT-CREDIT-LIMIT 03701910
413 TO WS-ACCT-CREDIT-LIMIT 03702110
414 MOVE ACCT-CASH-CREDIT-LIMIT 03702210
415 TO WS-ACCT-CASH-CREDIT-LIMIT 03702310
416 MOVE ACCT-OPEN-DATE TO WS-ACCT-OPEN-DATE 03702410
417 MOVE ACCT-EXPIRAION-DATE 03702510
418 TO WS-ACCT-EXPIRAION-DATE 03702610
419 MOVE ACCT-REISSUE-DATE 03702710
420 TO WS-ACCT-REISSUE-DATE 03702810
421 MOVE ACCT-CURR-CYC-CREDIT 03702910
422 TO WS-ACCT-CURR-CYC-CREDIT 03703010
423 MOVE ACCT-CURR-CYC-DEBIT 03703110
424 TO WS-ACCT-CURR-CYC-DEBIT 03703210
425 MOVE ACCT-GROUP-ID TO WS-ACCT-GROUP-ID 03703310
426 MOVE WS-ACCT-RESPONSE TO REPLY-MESSAGE 03703510
427 PERFORM 4100-PUT-REPLY 03703610
428 WHEN DFHRESP(NOTFND) 03703710
429 STRING 'INVALID REQUEST PARAMETERS ' 03703810
430 'ACCT ID : 'WS-KEY 03703910
431 DELIMITED BY SIZE 03704010
432 INTO 03704110
433 REPLY-MESSAGE 03704210
434 END-STRING 03704310
435 PERFORM 4100-PUT-REPLY 03704410
436 * 03704510
437 WHEN OTHER 03704610
438017200 03704800
439035100 MOVE WS-RESP-CD TO MQ-APPL-CONDITION-CODE 03704903
440035200 MOVE WS-REAS-CD TO MQ-APPL-REASON-CODE 03705003
441035300 MOVE INPUT-QUEUE-NAME TO MQ-APPL-QUEUE-NAME 03705103
442035400 MOVE 'ERROR WHILE READING ACCTFILE' 03705204
443035400 TO MQ-APPL-RETURN-MESSAGE 03705303
444 PERFORM 9000-ERROR 03705407
445017400 PERFORM 8000-TERMINATION 03705507
446 * PERFORM SEND-LONG-TEXT 03705603
447 END-EVALUATE 03705703
448 ELSE 03705805
449 STRING 'INVALID REQUEST PARAMETERS ' 03705905
450 'ACCT ID : 'WS-KEY 03706005
451 'FUNCTION : 'WS-FUNC 03706105
452 DELIMITED BY SIZE 03706205
453 INTO 03706305
454 REPLY-MESSAGE 03706405
455 END-STRING 03706505
456 PERFORM 4100-PUT-REPLY 03706610
457036100 END-IF 03706705
458036100 03707005
459036100 03780000
460036800 . 03860000
461036900 03870000
462037000 4100-PUT-REPLY. 03880010
463037100 03890000
464037200* PUT WILL PUT A MESSAGE ON THE QUEUE AND CONVERT IT TO A STRING 03900000
465037300 03910000
466037600 03940000
467037700 MOVE REPLY-MESSAGE TO MQ-BUFFER 03950007
468037800 MOVE 1000 TO MQ-BUFFER-LENGTH 03960007
469037900 MOVE SAVE-MSGID TO MQMD-MSGID 03970007
470038000 MOVE SAVE-CORELID TO MQMD-CORRELID 03980007
471038100 MOVE MQFMT-STRING TO MQMD-FORMAT 03990007
472038200 04000000
473038300 COMPUTE MQMD-CODEDCHARSETID = MQCCSI-Q-MGR 04010007
474038400 04020000
475038500 COMPUTE MQPMO-OPTIONS = MQPMO-SYNCPOINT 04030000
476038600 + MQPMO-DEFAULT-CONTEXT 04040000
477038700 + MQPMO-FAIL-IF-QUIESCING 04050007
478038800 04060000
479038900 CALL 'MQPUT' USING MQ-HCONN 04070000
480039000 OUTPUT-QUEUE-HANDLE 04080000
481039100 MQ-MESSAGE-DESCRIPTOR 04090000
482039200 MQ-PUT-MESSAGE-OPTIONS 04100000
483039300 MQ-BUFFER-LENGTH 04110000
484039400 MQ-BUFFER 04120000
485039500 MQ-CONDITION-CODE 04130000
486039600 MQ-REASON-CODE 04140007
487039700 04150000
488039800 EVALUATE MQ-CONDITION-CODE 04160000
489039900 WHEN MQCC-OK 04170000
490040000 MOVE MQ-CONDITION-CODE TO MQ-APPL-CONDITION-CODE 04180000
491040100 MOVE MQ-REASON-CODE TO MQ-APPL-REASON-CODE 04190000
492040200 WHEN OTHER 04200000
493040300 MOVE MQ-CONDITION-CODE TO MQ-APPL-CONDITION-CODE 04210000
494040400 MOVE MQ-REASON-CODE TO MQ-APPL-REASON-CODE 04220000
495040500 MOVE REPLY-QUEUE-NAME TO MQ-APPL-QUEUE-NAME 04230000
496040600 MOVE 'MQPUT ERR' TO MQ-APPL-RETURN-MESSAGE 04240000
497040700 PERFORM 9000-ERROR 04250007
498040800 PERFORM 8000-TERMINATION 04260007
499040900 END-EVALUATE. 04270000
500041000 04280000
501041100 9000-ERROR. 04290007
502041200* PUT WILL PUT A MESSAGE ON THE QUEUE AND CONVERT IT TO A STRING 04300000
503041300 04310000
504041600 04340000
505041700 MOVE MQ-ERR-DISPLAY TO ERROR-MESSAGE, 04350000
506041800 MOVE ERROR-MESSAGE TO MQ-BUFFER 04360007
507041900 MOVE 1000 TO MQ-BUFFER-LENGTH 04370007
508042200 MOVE MQFMT-STRING TO MQMD-FORMAT 04400007
509042300 04410000
510042400 COMPUTE MQMD-CODEDCHARSETID = MQCCSI-Q-MGR 04420007
511042500 04430000
512042600 COMPUTE MQPMO-OPTIONS = MQPMO-SYNCPOINT 04440000
513042700 + MQPMO-DEFAULT-CONTEXT 04450000
514042800 + MQPMO-FAIL-IF-QUIESCING 04460007
515042900 04470000
516043000 CALL 'MQPUT' USING MQ-HCONN 04480000
517043100 ERROR-QUEUE-HANDLE 04490000
518043200 MQ-MESSAGE-DESCRIPTOR 04500000
519043300 MQ-PUT-MESSAGE-OPTIONS 04510000
520043400 MQ-BUFFER-LENGTH 04520000
521043500 MQ-BUFFER 04530000
522043600 MQ-CONDITION-CODE 04540000
523043700 MQ-REASON-CODE 04550007
524043800 04560000
525043900 EVALUATE MQ-CONDITION-CODE 04570000
526044000 WHEN MQCC-OK 04580000
527044100 MOVE MQ-CONDITION-CODE TO MQ-APPL-CONDITION-CODE 04590000
528044200 MOVE MQ-REASON-CODE TO MQ-APPL-REASON-CODE 04600000
529044300 WHEN OTHER 04610000
530044400 MOVE MQ-CONDITION-CODE TO MQ-APPL-CONDITION-CODE 04620000
531044500 MOVE MQ-REASON-CODE TO MQ-APPL-REASON-CODE 04630000
532044600 MOVE ERROR-QUEUE-NAME TO MQ-APPL-QUEUE-NAME 04640000
533044700 MOVE 'MQPUT ERR' TO MQ-APPL-RETURN-MESSAGE 04650000
534044800 DISPLAY MQ-ERR-DISPLAY 04660000
535044900 PERFORM 8000-TERMINATION 04670007
536045000 END-EVALUATE. 04680000
537045100 . 04690000
538045200 8000-TERMINATION. 04700007
539045300 04710000
540045400 IF REPLY-QUEUE-OPEN 04720007
541045500 PERFORM 5000-CLOSE-INPUT-QUEUE 04730010
542045600 END-IF 04740000
543045700 IF RESP-QUEUE-OPEN 04750007
544045800 PERFORM 5100-CLOSE-OUTPUT-QUEUE 04760010
545045900 END-IF 04770000
546046000 IF ERR-QUEUE-OPEN 04780007
547046100 PERFORM 5200-CLOSE-ERROR-QUEUE 04790010
548046200 END-IF 04800000
549046300 EXEC CICS RETURN END-EXEC 04810000
550046400 GOBACK. 04820000
551046500 04830000
552046600 5000-CLOSE-INPUT-QUEUE. 04840010
553046700 MOVE INPUT-QUEUE-NAME TO MQ-QUEUE 04850000
554046800 MOVE INPUT-QUEUE-HANDLE TO MQ-HOBJ 04860000
555046900 COMPUTE MQ-OPTIONS = MQCO-NONE 04870007
556047000 04880000
557047100 CALL 'MQCLOSE' USING MQ-HCONN 04890000
558047200 MQ-HOBJ 04900000
559047300 MQ-OPTIONS 04910000
560047400 MQ-CONDITION-CODE 04920000
561047500 MQ-REASON-CODE 04930007
562047600 04940000
563047700 EVALUATE MQ-CONDITION-CODE 04950000
564047800 WHEN MQCC-OK 04960000
565047900 MOVE MQ-CONDITION-CODE TO MQ-APPL-CONDITION-CODE 04970000
566048000 MOVE MQ-REASON-CODE TO MQ-APPL-REASON-CODE 04980000
567048100 WHEN OTHER 04990000
568048200 MOVE MQ-CONDITION-CODE TO MQ-APPL-CONDITION-CODE 05000000
569048300 MOVE MQ-REASON-CODE TO MQ-APPL-REASON-CODE 05010000
570048400 MOVE INPUT-QUEUE-NAME TO MQ-APPL-QUEUE-NAME 05020000
571048500 MOVE 'MQCLOSE ERR' TO MQ-APPL-RETURN-MESSAGE 05030000
572048600 PERFORM 8000-TERMINATION 05040007
573048700 END-EVALUATE. 05050000
574048800 5100-CLOSE-OUTPUT-QUEUE. 05060010
575048900 MOVE REPLY-QUEUE-NAME TO MQ-QUEUE 05070000
576049000 MOVE OUTPUT-QUEUE-HANDLE TO MQ-HOBJ 05080000
577049100 COMPUTE MQ-OPTIONS = MQCO-NONE 05090007
578049200 05100000
579049300 CALL 'MQCLOSE' USING MQ-HCONN 05110000
580049400 MQ-HOBJ 05120000
581049500 MQ-OPTIONS 05130000
582049600 MQ-CONDITION-CODE 05140000
583049700 MQ-REASON-CODE 05150007
584049800 05160000
585049900 EVALUATE MQ-CONDITION-CODE 05170000
586050000 WHEN MQCC-OK 05180000
587050100 MOVE MQ-CONDITION-CODE TO MQ-APPL-CONDITION-CODE 05190000
588050200 MOVE MQ-REASON-CODE TO MQ-APPL-REASON-CODE 05200000
589050300 WHEN OTHER 05210000
590050400 MOVE MQ-CONDITION-CODE TO MQ-APPL-CONDITION-CODE 05220000
591050500 MOVE MQ-REASON-CODE TO MQ-APPL-REASON-CODE 05230000
592050600 MOVE INPUT-QUEUE-NAME TO MQ-APPL-QUEUE-NAME 05240000
593050700 MOVE 'MQCLOSE ERR' TO MQ-APPL-RETURN-MESSAGE 05250000
594050800 PERFORM 8000-TERMINATION 05260007
595050900 END-EVALUATE. 05270000
596051000 05280000
597051100 5200-CLOSE-ERROR-QUEUE. 05290010
598051200 MOVE ERROR-QUEUE-NAME TO MQ-QUEUE 05300000
599051300 MOVE ERROR-QUEUE-HANDLE TO MQ-HOBJ 05310000
600051400 COMPUTE MQ-OPTIONS = MQCO-NONE 05320007
601051500 05330000
602051600 CALL 'MQCLOSE' USING MQ-HCONN 05340000
603051700 MQ-HOBJ 05350000
604051800 MQ-OPTIONS 05360000
605051900 MQ-CONDITION-CODE 05370000
606052000 MQ-REASON-CODE 05380007
607052100 05390000
608052200 EVALUATE MQ-CONDITION-CODE 05400000
609052300 WHEN MQCC-OK 05410000
610052400 MOVE MQ-CONDITION-CODE TO MQ-APPL-CONDITION-CODE 05420000
611052500 MOVE MQ-REASON-CODE TO MQ-APPL-REASON-CODE 05430000
612052600 WHEN OTHER 05440000
613052700 MOVE MQ-CONDITION-CODE TO MQ-APPL-CONDITION-CODE 05450000
614052800 MOVE MQ-REASON-CODE TO MQ-APPL-REASON-CODE 05460000
615052900 MOVE ERROR-QUEUE-NAME TO MQ-APPL-QUEUE-NAME 05470000
616053000 MOVE 'MQCLOSE ERR' TO MQ-APPL-RETURN-MESSAGE 05480000
617053100 PERFORM 9000-ERROR 05490007
618053200 PERFORM 8000-TERMINATION 05500007
619053300 END-EVALUATE. 05510000
620053400 05520000