MFmainframe-rea
WS carddemo · 26f629ef

cobol · 524 lines · sha256 97fcba3faa272c98 · guides at columns 7 and 72app/app-vsam-mq/cbl/CODATE01.cbl

1000100 IDENTIFICATION DIVISION. 00010012
2000200 PROGRAM-ID. CODATE01 IS INITIAL. 00020012
3000300 AUTHOR. AWS. 00030012
4000400 DATE-WRITTEN. 03/21. 00040012
5000500 DATE-COMPILED. 00050012
6000600 00060012
7000700 ENVIRONMENT DIVISION. 00070012
8000800 00080012
9000900 DATA DIVISION. 00090012
10001000 00100012
11001100 WORKING-STORAGE SECTION. 00110012
12001700 00120012
13001800 01 WS-MQ-MSG-FLAG PIC X(01) VALUE 'N'. 00130012
14001900 88 NO-MORE-MSGS VALUE 'Y'. 00140012
15002000 00150012
16002100 01 WS-RESP-QUEUE-STS PIC X(01) VALUE 'N'. 00160012
17002200 88 RESP-QUEUE-OPEN VALUE 'Y'. 00170012
18002300 00180012
19002400 01 WS-ERR-QUEUE-STS PIC X(01) VALUE 'N'. 00190012
20002500 88 ERR-QUEUE-OPEN VALUE 'Y'. 00200012
21002600 00210012
22002700 01 WS-REPLY-QUEUE-STS PIC X(01) VALUE 'N'. 00220012
23002800 88 REPLY-QUEUE-OPEN VALUE 'Y'. 00230012
24002900 00240012
25003700 00250012
26003800 01 WS-CICS-RESP-CDS. 00260012
27003900 05 WS-CICS-RESP1-CD PIC S9(08) COMP VALUE ZERO. 00270012
28004000 05 WS-CICS-RESP2-CD PIC S9(08) COMP VALUE ZERO. 00280012
29004300 05 WS-CICS-RESP1-CD-D PIC 9(08) VALUE ZERO. 00290012
30004400 05 WS-CICS-RESP2-CD-D PIC 9(08) VALUE ZERO. 00300012
31004500 00310012
32004600*********************************************** 00320012
33004700** DATE FIELDS ** 00330012
34004800*********************************************** 00340012
35004900 01 WS-DATE-TIME. 00350012
36005000 10 WS-ABS-TIME PIC S9(15) COMP-3 VALUE ZERO. 00360012
37005100 10 WS-MMDDYYYY PIC X(10) VALUE SPACES. 00370012
38005200 10 WS-TIME PIC X(8) VALUE SPACES. 00380012
39004600*********************************************** 00390012
40004700** MQ FIELDS ** 00400012
41004800*********************************************** 00410012
42005000 01 MQ-QUEUE PIC X(48). 00420012
43005100 01 MQ-QUEUE-REPLY PIC X(48). 00430012
44005200 01 MQ-HCONN PIC S9(09) BINARY VALUE 0. 00440012
45005300 01 MQ-CONDITION-CODE PIC S9(09) BINARY VALUE 0. 00450012
46005400 01 MQ-REASON-CODE PIC S9(09) BINARY VALUE 0. 00460012
47005500 01 MQ-HOBJ PIC S9(09) BINARY VALUE 0. 00470012
48005600 01 MQ-OPTIONS PIC S9(09) BINARY VALUE 0. 00480012
49005700 01 MQ-BUFFER-LENGTH PIC S9(09) BINARY. 00490012
50005800 01 MQ-BUFFER PIC X(1000). 00500012
51005900 01 MQ-DATA-LENGTH PIC S9(09) BINARY. 00510012
52006000 01 MQ-CORRELID PIC X(24). 00520012
53006100 01 MQ-MSG-ID PIC X(24). 00530012
54006200 01 MQ-MSG-COUNT PIC 9(09). 00540012
55006300 01 SAVE-CORELID PIC X(24). 00550012
56006400 01 SAVE-MSGID PIC X(24). 00560012
57006500 01 SAVE-REPLY2Q PIC X(48). 00570012
58006600 01 MQ-ERR-DISPLAY. 00580012
59006700 05 MQ-ERROR-PARA PIC X(25) . 00590012
60006800 05 FILLER PIC X(02) VALUE SPACES. 00600012
61006900 05 MQ-APPL-RETURN-MESSAGE PIC X(25). 00610012
62007000 05 FILLER PIC X(02) VALUE SPACES. 00620012
63007100 05 MQ-APPL-CONDITION-CODE PIC 9(02). 00630012
64007200 05 FILLER PIC X(02) VALUE SPACES. 00640012
65007300 05 MQ-APPL-REASON-CODE PIC 9(05). 00650012
66007400 05 FILLER PIC X(02) VALUE SPACES. 00660012
67007500 05 MQ-APPL-QUEUE-NAME PIC X(48). 00670012
68007600 00680012
69007700 00690012
70007800 01 MQ-GET-MESSAGE-OPTIONS. 00700012
71007900 COPY CMQGMOV. 00710012
72008000 00720012
73008100 00730012
74008200 01 MQ-PUT-MESSAGE-OPTIONS. 00740012
75008300 COPY CMQPMOV. 00750012
76008400 00760012
77008500 00770012
78008600 01 MQ-MESSAGE-DESCRIPTOR. 00780012
79008700 COPY CMQMDV. 00790012
80008800 00800012
81008900 00810012
82009000 01 MQ-OBJECT-DESCRIPTOR. 00820012
83009100 COPY CMQODV. 00830012
84009200 00840012
85009300 00850012
86009400 01 MQ-CONSTANTS. 00860012
87009500 COPY CMQV. 00870012
88009600 00880012
89009700 01 MQ-GET-QUEUE-MESSAGE. 00890012
90009800 COPY CMQTML. 00900012
91009900 00910012
92010000 01 QUEUE-INFO. 00920012
93010100 05 QMGR-NAME PIC X(48) VALUE SPACES. 00930012
94010200 05 INPUT-QUEUE-NAME PIC X(48) VALUE SPACES. 00940012
95010300 05 REPLY-QUEUE-NAME PIC X(48) VALUE SPACES. 00950012
96010400 05 ERROR-QUEUE-NAME PIC X(48) VALUE SPACES. 00960012
97010500 00970012
98010600 01 INPUT-QUEUE-HANDLE PIC S9(09) BINARY VALUE 0. 00980012
99010700 00990012
100010800 01 OUTPUT-QUEUE-HANDLE PIC S9(09) BINARY VALUE 0. 01000012
101010900 01010012
102011000 01 ERROR-QUEUE-HANDLE PIC S9(09) BINARY VALUE 0. 01020012
103011100 01030012
104011200 01 QMGR-HANDLE-CONN PIC S9(09) BINARY VALUE 0. 01040012
105011300 01 QUEUE-MESSAGE PIC X(1000). 01050012
106011400 01 REQUEST-MESSAGE PIC X(1000). 01060012
107011500 01 REPLY-MESSAGE PIC X(1000). 01070012
108011600 01 ERROR-MESSAGE PIC X(1000). 01080012
109011700 01 REQUEST-MSG-COPY. 01090012
110011700 10 WS-FUNC PIC X(04) VALUE SPACES. 01100012
111011700 10 WS-KEY PIC 9(11) VALUE ZEROES. 01110012
112011700 10 WS-FILLER PIC X(985) VALUE SPACES. 01120012
113011800 01130012
114 01 WS-VARIABLES. 01140012
115 05 LIT-ACCTFILENAME PIC X(8) 01150012
116 VALUE 'ACCTDAT '. 01160012
117 05 WS-RESP-CD PIC S9(09) COMP 01170012
118 VALUE ZEROS. 01180012
119 05 WS-REAS-CD PIC S9(09) COMP 01190012
120 VALUE ZEROS. 01200012
121 01210012
122011900 01220012
123012000 LINKAGE SECTION. 01230012
124012100 01240012
125012200 PROCEDURE DIVISION. 01250012
126012300 01260012
127012400 1000-CONTROL. 01270012
128012500 01280012
129013600 MOVE SPACES TO 01290012
130013700 INPUT-QUEUE-NAME 01300012
131013800 QMGR-NAME 01310012
132013900 QUEUE-MESSAGE 01320012
133014000 01330012
134014100 INITIALIZE MQ-ERR-DISPLAY 01340012
135014200 01350012
136014600 PERFORM 2100-OPEN-ERROR-QUEUE 01360012
137015300******************************************************************01370012
138015400* GET THE QUEUE NAME WHICH STARTED THE TRANSACTION *01380012
139015500******************************************************************01390012
140015600 EXEC CICS RETRIEVE 01400012
141015700 INTO(MQTM) 01410012
142015800 RESP(WS-CICS-RESP1-CD) 01420012
143015900 RESP2(WS-CICS-RESP2-CD) 01430012
144016000 END-EXEC 01440012
145016100 IF WS-CICS-RESP1-CD = DFHRESP(NORMAL) 01450012
146016200 MOVE MQTM-QNAME TO INPUT-QUEUE-NAME 01460012
147016300 MOVE 'CARD.DEMO.REPLY.DATE' TO REPLY-QUEUE-NAME 01470012
148016400 ELSE 01480012
149016500 MOVE 'CICS RETRIEVE' TO MQ-ERROR-PARA 01490012
150016600 MOVE WS-CICS-RESP1-CD TO WS-CICS-RESP1-CD-D 01500012
151016700 MOVE WS-CICS-RESP2-CD TO WS-CICS-RESP2-CD 01510012
152016800 STRING 'RESP: ', WS-CICS-RESP1-CD-D , WS-CICS-RESP2-CD-D, 01520012
153016900 'END' DELIMITED BY SIZE 01530012
154017000 INTO MQ-APPL-RETURN-MESSAGE 01540012
155017100 END-STRING 01550012
156017200 01560012
157 PERFORM 9000-ERROR 01570012
158017400 PERFORM 8000-TERMINATION 01580012
159017500 END-IF 01590012
160014500 01600012
161014800 PERFORM 2300-OPEN-INPUT-QUEUE 01610012
162014900 PERFORM 2400-OPEN-OUTPUT-QUEUE 01620012
163012700 PERFORM 3000-GET-REQUEST 01630012
164012800 PERFORM 4000-MAIN-PROCESS UNTIL 01640012
165012900 NO-MORE-MSGS 01650012
166013000 01660012
167013100 PERFORM 8000-TERMINATION. 01670012
168013200 01680012
169015000 . 01690012
170015100 01700012
171017800 2300-OPEN-INPUT-QUEUE. 01710012
172017900* OPEN-INPUT WILL OPEN A QUEUE FOR GET PROCESSING 01720012
173018000 01730012
174018400 01740012
175018500 MOVE SPACES TO MQOD-OBJECTQMGRNAME 01750012
176018600 MOVE INPUT-QUEUE-NAME TO MQOD-OBJECTNAME 01760012
177018700 01770012
178018800 COMPUTE MQ-OPTIONS = MQOO-INPUT-SHARED 01780012
179018900 + MQOO-SAVE-ALL-CONTEXT 01790012
180019000 + MQOO-FAIL-IF-QUIESCING 01800012
181019100 01810012
182019200 CALL 'MQOPEN' USING QMGR-HANDLE-CONN 01820012
183019300 MQ-OBJECT-DESCRIPTOR 01830012
184019400 MQ-OPTIONS 01840012
185019500 MQ-HOBJ 01850012
186019600 MQ-CONDITION-CODE 01860012
187019700 MQ-REASON-CODE 01870012
188019800 01880012
189019900 EVALUATE MQ-CONDITION-CODE 01890012
190020000 WHEN MQCC-OK 01900012
191020100 MOVE MQ-CONDITION-CODE TO MQ-APPL-CONDITION-CODE 01910012
192020200 MOVE MQ-REASON-CODE TO MQ-APPL-REASON-CODE 01920012
193020300 MOVE MQ-HOBJ TO INPUT-QUEUE-HANDLE 01930012
194020400 SET REPLY-QUEUE-OPEN TO TRUE 01940012
195020500 WHEN OTHER 01950012
196020600 MOVE MQ-CONDITION-CODE TO MQ-APPL-CONDITION-CODE 01960012
197020700 MOVE MQ-REASON-CODE TO MQ-APPL-REASON-CODE 01970012
198020800 MOVE INPUT-QUEUE-NAME TO MQ-APPL-QUEUE-NAME 01980012
199020900 MOVE 'INP MQOPEN ERR' TO MQ-APPL-RETURN-MESSAGE 01990012
200021000 PERFORM 9000-ERROR 02000012
201021100 PERFORM 8000-TERMINATION 02010012
202021200 END-EVALUATE. 02020012
203021300 02030012
204021400 2400-OPEN-OUTPUT-QUEUE. 02040012
205021500 02050012
206021600* OPEN-OUTPUT WILL OPEN A QUEUE FOR PUT PROCESSING 02060012
207021700 02070012
208022100 02080012
209022200 MOVE SPACES TO MQOD-OBJECTQMGRNAME 02090012
210022300 MOVE REPLY-QUEUE-NAME TO MQOD-OBJECTNAME 02100012
211022400 02110012
212022500 COMPUTE MQ-OPTIONS = MQOO-OUTPUT 02120012
213022600 + MQOO-PASS-ALL-CONTEXT 02130012
214022700 + MQOO-FAIL-IF-QUIESCING 02140012
215022800 02150012
216022900 CALL 'MQOPEN' USING QMGR-HANDLE-CONN 02160012
217023000 MQ-OBJECT-DESCRIPTOR 02170012
218023100 MQ-OPTIONS 02180012
219023200 MQ-HOBJ 02190012
220023300 MQ-CONDITION-CODE 02200012
221023400 MQ-REASON-CODE 02210012
222023500 02220012
223023600 EVALUATE MQ-CONDITION-CODE 02230012
224023700 WHEN MQCC-OK 02240012
225023800 MOVE MQ-CONDITION-CODE TO MQ-APPL-CONDITION-CODE 02250012
226023900 MOVE MQ-REASON-CODE TO MQ-APPL-REASON-CODE 02260012
227024000 MOVE MQ-HOBJ TO OUTPUT-QUEUE-HANDLE 02270012
228024100 SET RESP-QUEUE-OPEN TO TRUE 02280012
229024200 WHEN OTHER 02290012
230024300 MOVE MQ-CONDITION-CODE TO MQ-APPL-CONDITION-CODE 02300012
231024400 MOVE MQ-REASON-CODE TO MQ-APPL-REASON-CODE 02310012
232024500 MOVE REPLY-QUEUE-NAME TO MQ-APPL-QUEUE-NAME 02320012
233024600 MOVE 'OUT MQOPEN ERR' TO MQ-APPL-RETURN-MESSAGE 02330012
234024700 PERFORM 9000-ERROR 02340012
235024800 PERFORM 8000-TERMINATION 02350012
236024900 END-EVALUATE. 02360012
237025000 02370012
238025100 2100-OPEN-ERROR-QUEUE. 02380012
239025200 02390012
240025300* OPEN-OUTPUT WILL OPEN A QUEUE FOR PUT PROCESSING 02400012
241025400 02410012
242025800 02420012
243025900 MOVE 'CARD.DEMO.ERROR' TO ERROR-QUEUE-NAME 02430012
244026000 MOVE SPACES TO MQOD-OBJECTQMGRNAME 02440012
245026100 MOVE ERROR-QUEUE-NAME TO MQOD-OBJECTNAME 02450012
246026200 02460012
247026300 COMPUTE MQ-OPTIONS = MQOO-OUTPUT 02470012
248026400 + MQOO-PASS-ALL-CONTEXT 02480012
249026500 + MQOO-FAIL-IF-QUIESCING 02490012
250026600 02500012
251026700 CALL 'MQOPEN' USING QMGR-HANDLE-CONN 02510012
252026800 MQ-OBJECT-DESCRIPTOR 02520012
253026900 MQ-OPTIONS 02530012
254027000 MQ-HOBJ 02540012
255027100 MQ-CONDITION-CODE 02550012
256027200 MQ-REASON-CODE 02560012
257027300 02570012
258027400 EVALUATE MQ-CONDITION-CODE 02580012
259027500 WHEN MQCC-OK 02590012
260027600 MOVE MQ-CONDITION-CODE TO MQ-APPL-CONDITION-CODE 02600012
261027700 MOVE MQ-REASON-CODE TO MQ-APPL-REASON-CODE 02610012
262027800 MOVE MQ-HOBJ TO ERROR-QUEUE-HANDLE 02620012
263027900 SET ERR-QUEUE-OPEN TO TRUE 02630012
264028000 WHEN OTHER 02640012
265028100 MOVE MQ-CONDITION-CODE TO MQ-APPL-CONDITION-CODE 02650012
266028200 MOVE MQ-REASON-CODE TO MQ-APPL-REASON-CODE 02660012
267028300 MOVE ERROR-QUEUE-NAME TO MQ-APPL-QUEUE-NAME 02670012
268028400 MOVE 'ERR MQOPEN ERR' TO MQ-APPL-RETURN-MESSAGE 02680012
269028500 DISPLAY MQ-ERR-DISPLAY 02690012
270028600 PERFORM 8000-TERMINATION 02700012
271028700 END-EVALUATE. 02710012
272028800 02720012
273028900 02730012
274029000 4000-MAIN-PROCESS. 02740012
275029100 EXEC CICS 02750012
276029200 SYNCPOINT 02760012
277029300 END-EXEC 02770012
278029400 02780012
279029500 PERFORM 3000-GET-REQUEST 02790012
280029600 . 02800012
281029700 02810012
282029800 02820012
283029900 3000-GET-REQUEST. 02830012
284030000* GET WILL GET A MESSAGE FROM THE QUEUE 02840012
285030700*** ADDED 5000 MS (5 SECS) AS THE WAIT INTERVAL FOR GET 02850012
286030800 MOVE 5000 TO MQGMO-WAITINTERVAL 02860012
287030900 MOVE SPACES TO MQ-CORRELID 02870012
288031000 MOVE SPACES TO MQ-MSG-ID 02880012
289031100 MOVE INPUT-QUEUE-NAME TO MQ-QUEUE 02890012
290031200 MOVE INPUT-QUEUE-HANDLE TO MQ-HOBJ 02900012
291031300 MOVE 1000 TO MQ-BUFFER-LENGTH 02910012
292031400 MOVE MQMI-NONE TO MQMD-MSGID 02920012
293031500 MOVE MQCI-NONE TO MQMD-CORRELID 02930012
294031500 INITIALIZE REQUEST-MSG-COPY REPLACING NUMERIC BY ZEROES 02940012
295031600 02950012
296031700 COMPUTE MQGMO-OPTIONS = MQGMO-SYNCPOINT 02960012
297031800 + MQGMO-FAIL-IF-QUIESCING 02970012
298031900 + MQGMO-CONVERT 02980012
299032000 + MQGMO-WAIT 02990012
300032100 03000012
301032200 CALL 'MQGET' USING MQ-HCONN 03010012
302032300 MQ-HOBJ 03020012
303032400 MQ-MESSAGE-DESCRIPTOR 03030012
304032500 MQ-GET-MESSAGE-OPTIONS 03040012
305032600 MQ-BUFFER-LENGTH 03050012
306032700 MQ-BUFFER 03060012
307032800 MQ-DATA-LENGTH 03070012
308032900 MQ-CONDITION-CODE 03080012
309033000 MQ-REASON-CODE 03090012
310033100 03100012
311033200 03110012
312033300 IF MQ-CONDITION-CODE = MQCC-OK 03120012
313033400 MOVE MQMD-MSGID TO MQ-MSG-ID 03130012
314033500 MOVE MQMD-CORRELID TO MQ-CORRELID 03140012
315033600 MOVE MQMD-REPLYTOQ TO MQ-QUEUE-REPLY 03150012
316033700 MOVE MQ-CONDITION-CODE TO MQ-APPL-CONDITION-CODE 03160012
317033800 MOVE MQ-REASON-CODE TO MQ-APPL-REASON-CODE 03170012
318033900 MOVE MQ-BUFFER TO REQUEST-MESSAGE 03180012
319034000 MOVE MQ-CORRELID TO SAVE-CORELID 03190012
320034100 MOVE MQ-QUEUE-REPLY TO SAVE-REPLY2Q 03200012
321034200 MOVE MQ-MSG-ID TO SAVE-MSGID 03210012
322034300 MOVE REQUEST-MESSAGE TO REQUEST-MSG-COPY 03220012
323034400 PERFORM 4000-PROCESS-REQUEST-REPLY 03230012
324034500 ADD 1 TO MQ-MSG-COUNT 03240012
325034600 ELSE 03250012
326034700 IF MQ-REASON-CODE = MQRC-NO-MSG-AVAILABLE 03260012
327034800 SET NO-MORE-MSGS TO TRUE 03270012
328034900 03280012
329035000 ELSE 03290012
330035100 MOVE MQ-CONDITION-CODE TO MQ-APPL-CONDITION-CODE 03300012
331035200 MOVE MQ-REASON-CODE TO MQ-APPL-REASON-CODE 03310012
332035300 MOVE INPUT-QUEUE-NAME TO MQ-APPL-QUEUE-NAME 03320012
333035400 MOVE 'INP MQGET ERR:' TO MQ-APPL-RETURN-MESSAGE 03330012
334035500 PERFORM 9000-ERROR 03340012
335035600 PERFORM 8000-TERMINATION 03350012
336035700 END-IF 03360012
337035800 END-IF. 03370012
338035900 03380012
339036000 4000-PROCESS-REQUEST-REPLY. 03390012
340036100 MOVE SPACES TO REPLY-MESSAGE 03400012
341036100 INITIALIZE WS-DATE-TIME REPLACING NUMERIC BY ZEROES 03410012
342036100 03420012
343036100 EXEC CICS ASKTIME 03430012
344036100 ABSTIME (WS-ABS-TIME) 03440012
345036100 END-EXEC 03450012
346036100 03460012
347036100 EXEC CICS FORMATTIME 03470012
348036100 ABSTIME(WS-ABS-TIME) 03480012
349036100 MMDDYYYY(WS-MMDDYYYY) 03490012
350036100 DATESEP('-') 03500012
351036100 TIME(WS-TIME) 03510012
352036100 TIMESEP 03520012
353036100 END-EXEC 03530012
354036100 03540012
355036200 STRING 'SYSTEM DATE : ' WS-MMDDYYYY 03550012
356036200 'SYSTEM TIME : ' WS-TIME 03560012
357036200 DELIMITED BY SIZE 03570012
358036400 INTO 03580012
359036500 REPLY-MESSAGE 03590012
360036600 END-STRING 03600012
361 PERFORM 4100-PUT-REPLY 03610012
362036100 03620012
363036100 03630012
364036800 . 03640012
365036900 03650012
366037000 4100-PUT-REPLY. 03660012
367037100 03670012
368037200* PUT WILL PUT A MESSAGE ON THE QUEUE AND CONVERT IT TO A STRING 03680012
369037300 03690012
370037600 03700012
371037700 MOVE REPLY-MESSAGE TO MQ-BUFFER 03710012
372037800 MOVE 1000 TO MQ-BUFFER-LENGTH 03720012
373037900 MOVE SAVE-MSGID TO MQMD-MSGID 03730012
374038000 MOVE SAVE-CORELID TO MQMD-CORRELID 03740012
375038100 MOVE MQFMT-STRING TO MQMD-FORMAT 03750012
376038200 03760012
377038300 COMPUTE MQMD-CODEDCHARSETID = MQCCSI-Q-MGR 03770012
378038400 03780012
379038500 COMPUTE MQPMO-OPTIONS = MQPMO-SYNCPOINT 03790012
380038600 + MQPMO-DEFAULT-CONTEXT 03800012
381038700 + MQPMO-FAIL-IF-QUIESCING 03810012
382038800 03820012
383038900 CALL 'MQPUT' USING MQ-HCONN 03830012
384039000 OUTPUT-QUEUE-HANDLE 03840012
385039100 MQ-MESSAGE-DESCRIPTOR 03850012
386039200 MQ-PUT-MESSAGE-OPTIONS 03860012
387039300 MQ-BUFFER-LENGTH 03870012
388039400 MQ-BUFFER 03880012
389039500 MQ-CONDITION-CODE 03890012
390039600 MQ-REASON-CODE 03900012
391039700 03910012
392039800 EVALUATE MQ-CONDITION-CODE 03920012
393039900 WHEN MQCC-OK 03930012
394040000 MOVE MQ-CONDITION-CODE TO MQ-APPL-CONDITION-CODE 03940012
395040100 MOVE MQ-REASON-CODE TO MQ-APPL-REASON-CODE 03950012
396040200 WHEN OTHER 03960012
397040300 MOVE MQ-CONDITION-CODE TO MQ-APPL-CONDITION-CODE 03970012
398040400 MOVE MQ-REASON-CODE TO MQ-APPL-REASON-CODE 03980012
399040500 MOVE REPLY-QUEUE-NAME TO MQ-APPL-QUEUE-NAME 03990012
400040600 MOVE 'MQPUT ERR' TO MQ-APPL-RETURN-MESSAGE 04000012
401040700 PERFORM 9000-ERROR 04010012
402040800 PERFORM 8000-TERMINATION 04020012
403040900 END-EVALUATE. 04030012
404041000 04040012
405041100 9000-ERROR. 04050012
406041200* PUT WILL PUT A MESSAGE ON THE QUEUE AND CONVERT IT TO A STRING 04060012
407041300 04070012
408041600 04080012
409041700 MOVE MQ-ERR-DISPLAY TO ERROR-MESSAGE, 04090012
410041800 MOVE ERROR-MESSAGE TO MQ-BUFFER 04100012
411041900 MOVE 1000 TO MQ-BUFFER-LENGTH 04110012
412042200 MOVE MQFMT-STRING TO MQMD-FORMAT 04120012
413042300 04130012
414042400 COMPUTE MQMD-CODEDCHARSETID = MQCCSI-Q-MGR 04140012
415042500 04150012
416042600 COMPUTE MQPMO-OPTIONS = MQPMO-SYNCPOINT 04160012
417042700 + MQPMO-DEFAULT-CONTEXT 04170012
418042800 + MQPMO-FAIL-IF-QUIESCING 04180012
419042900 04190012
420043000 CALL 'MQPUT' USING MQ-HCONN 04200012
421043100 ERROR-QUEUE-HANDLE 04210012
422043200 MQ-MESSAGE-DESCRIPTOR 04220012
423043300 MQ-PUT-MESSAGE-OPTIONS 04230012
424043400 MQ-BUFFER-LENGTH 04240012
425043500 MQ-BUFFER 04250012
426043600 MQ-CONDITION-CODE 04260012
427043700 MQ-REASON-CODE 04270012
428043800 04280012
429043900 EVALUATE MQ-CONDITION-CODE 04290012
430044000 WHEN MQCC-OK 04300012
431044100 MOVE MQ-CONDITION-CODE TO MQ-APPL-CONDITION-CODE 04310012
432044200 MOVE MQ-REASON-CODE TO MQ-APPL-REASON-CODE 04320012
433044300 WHEN OTHER 04330012
434044400 MOVE MQ-CONDITION-CODE TO MQ-APPL-CONDITION-CODE 04340012
435044500 MOVE MQ-REASON-CODE TO MQ-APPL-REASON-CODE 04350012
436044600 MOVE ERROR-QUEUE-NAME TO MQ-APPL-QUEUE-NAME 04360012
437044700 MOVE 'MQPUT ERR' TO MQ-APPL-RETURN-MESSAGE 04370012
438044800 DISPLAY MQ-ERR-DISPLAY 04380012
439044900 PERFORM 8000-TERMINATION 04390012
440045000 END-EVALUATE. 04400012
441045100 . 04410012
442045200 8000-TERMINATION. 04420012
443045300 04430012
444045400 IF REPLY-QUEUE-OPEN 04440012
445045500 PERFORM 5000-CLOSE-INPUT-QUEUE 04450012
446045600 END-IF 04460012
447045700 IF RESP-QUEUE-OPEN 04470012
448045800 PERFORM 5100-CLOSE-OUTPUT-QUEUE 04480012
449045900 END-IF 04490012
450046000 IF ERR-QUEUE-OPEN 04500012
451046100 PERFORM 5200-CLOSE-ERROR-QUEUE 04510012
452046200 END-IF 04520012
453046300 EXEC CICS RETURN END-EXEC 04530012
454046400 GOBACK. 04540012
455046500 04550012
456046600 5000-CLOSE-INPUT-QUEUE. 04560012
457046700 MOVE INPUT-QUEUE-NAME TO MQ-QUEUE 04570012
458046800 MOVE INPUT-QUEUE-HANDLE TO MQ-HOBJ 04580012
459046900 COMPUTE MQ-OPTIONS = MQCO-NONE 04590012
460047000 04600012
461047100 CALL 'MQCLOSE' USING MQ-HCONN 04610012
462047200 MQ-HOBJ 04620012
463047300 MQ-OPTIONS 04630012
464047400 MQ-CONDITION-CODE 04640012
465047500 MQ-REASON-CODE 04650012
466047600 04660012
467047700 EVALUATE MQ-CONDITION-CODE 04670012
468047800 WHEN MQCC-OK 04680012
469047900 MOVE MQ-CONDITION-CODE TO MQ-APPL-CONDITION-CODE 04690012
470048000 MOVE MQ-REASON-CODE TO MQ-APPL-REASON-CODE 04700012
471048100 WHEN OTHER 04710012
472048200 MOVE MQ-CONDITION-CODE TO MQ-APPL-CONDITION-CODE 04720012
473048300 MOVE MQ-REASON-CODE TO MQ-APPL-REASON-CODE 04730012
474048400 MOVE INPUT-QUEUE-NAME TO MQ-APPL-QUEUE-NAME 04740012
475048500 MOVE 'MQCLOSE ERR' TO MQ-APPL-RETURN-MESSAGE 04750012
476048600 PERFORM 8000-TERMINATION 04760012
477048700 END-EVALUATE. 04770012
478048800 5100-CLOSE-OUTPUT-QUEUE. 04780012
479048900 MOVE REPLY-QUEUE-NAME TO MQ-QUEUE 04790012
480049000 MOVE OUTPUT-QUEUE-HANDLE TO MQ-HOBJ 04800012
481049100 COMPUTE MQ-OPTIONS = MQCO-NONE 04810012
482049200 04820012
483049300 CALL 'MQCLOSE' USING MQ-HCONN 04830012
484049400 MQ-HOBJ 04840012
485049500 MQ-OPTIONS 04850012
486049600 MQ-CONDITION-CODE 04860012
487049700 MQ-REASON-CODE 04870012
488049800 04880012
489049900 EVALUATE MQ-CONDITION-CODE 04890012
490050000 WHEN MQCC-OK 04900012
491050100 MOVE MQ-CONDITION-CODE TO MQ-APPL-CONDITION-CODE 04910012
492050200 MOVE MQ-REASON-CODE TO MQ-APPL-REASON-CODE 04920012
493050300 WHEN OTHER 04930012
494050400 MOVE MQ-CONDITION-CODE TO MQ-APPL-CONDITION-CODE 04940012
495050500 MOVE MQ-REASON-CODE TO MQ-APPL-REASON-CODE 04950012
496050600 MOVE INPUT-QUEUE-NAME TO MQ-APPL-QUEUE-NAME 04960012
497050700 MOVE 'MQCLOSE ERR' TO MQ-APPL-RETURN-MESSAGE 04970012
498050800 PERFORM 8000-TERMINATION 04980012
499050900 END-EVALUATE. 04990012
500051000 05000012
501051100 5200-CLOSE-ERROR-QUEUE. 05010012
502051200 MOVE ERROR-QUEUE-NAME TO MQ-QUEUE 05020012
503051300 MOVE ERROR-QUEUE-HANDLE TO MQ-HOBJ 05030012
504051400 COMPUTE MQ-OPTIONS = MQCO-NONE 05040012
505051500 05050012
506051600 CALL 'MQCLOSE' USING MQ-HCONN 05060012
507051700 MQ-HOBJ 05070012
508051800 MQ-OPTIONS 05080012
509051900 MQ-CONDITION-CODE 05090012
510052000 MQ-REASON-CODE 05100012
511052100 05110012
512052200 EVALUATE MQ-CONDITION-CODE 05120012
513052300 WHEN MQCC-OK 05130012
514052400 MOVE MQ-CONDITION-CODE TO MQ-APPL-CONDITION-CODE 05140012
515052500 MOVE MQ-REASON-CODE TO MQ-APPL-REASON-CODE 05150012
516052600 WHEN OTHER 05160012
517052700 MOVE MQ-CONDITION-CODE TO MQ-APPL-CONDITION-CODE 05170012
518052800 MOVE MQ-REASON-CODE TO MQ-APPL-REASON-CODE 05180012
519052900 MOVE ERROR-QUEUE-NAME TO MQ-APPL-QUEUE-NAME 05190012
520053000 MOVE 'MQCLOSE ERR' TO MQ-APPL-RETURN-MESSAGE 05200012
521053100 PERFORM 9000-ERROR 05210012
522053200 PERFORM 8000-TERMINATION 05220012
523053300 END-EVALUATE. 05230012
524053400 05240012