| |
|
RSS Feed - WebSphere MQ Support
|
RSS Feed - Message Broker Support
|
  |
|
| mq get with syncpoint |
« View previous topic :: View next topic » |
| Author |
Message
|
| avigosa |
 Posted: Thu Mar 20, 2003 8:02 pm Post subject: mq get with syncpoint |
 |
|
Newbie
Joined: 20 Mar 2003
Posts: 9
Location: Singapore
|
Hi there
I have written a program in cobol to read message from a queue with syncpoint. which means the message is not deleted from the queue till the transaction is commited or backed out.
In one of the scenario I am crashing the program after the csqbget and the message is getting lost from the queue.. in actaul fact it should reinstate the message in the queue...
any help is greatly appreciated....
thanks |
|
| Back to top |
|
 |
| nimconsult |
| Posted: Thu Mar 20, 2003 11:31 pm Post subject: |
|
|
Master
Joined: 22 May 2002
Posts: 268
Location: NIMCONSULT - Belgium
|
Can you describe the scenario?
_________________
Nicolas Maréchal
Senior Architect - Partner
NIMCONSULT Software Architecture Services (Belgium)
http://www.nimconsult.be |
|
| Back to top |
|
|
| avigosa |
| Posted: Fri Mar 21, 2003 4:11 am Post subject: |
|
|
Newbie
Joined: 20 Mar 2003
Posts: 9
Location: Singapore
|
The complete scenario is :
1. I am making connection,opening a queue and enquiring the queue. This is a persistant queue.
2. getting the message from the queue with the following option.
(a) gmo wait, quescecing, convert, syncpoint. here wait period is unlimited.
(b) make a call to the idms routine to update the db.
(c) commit
(d) if error backout
(e) disconnect.
I am putting a junk message so that before idms db update is performed the job fails with system abend. due to this abend the job crashes. this is happening after the get and before commit or rollback step.
Rightfully the message should go back to the local queue. But in this scenario the message is not going to the local queue neither backout queue.
All the call are dynamic calls. using csqbget etc..
_________________
contact admin
HCL Perot Systems Pte. Ltd. |
|
| Back to top |
|
|
| mqonnet |
| Posted: Fri Mar 21, 2003 6:39 am Post subject: |
|
|
Grand Master
Joined: 18 Feb 2002
Posts: 1114
Location: Boston, Ma, Usa.
|
I am not sure what your csqbget is doing, but under normal circumstances the message should go back to the queue. Be it a persistent or a non-persistent message.
Check to see if you have any other getters aginst this queue running simultaneously that might pull of this message which you think is lost, which in fact was backed out.
I dont see any other scenario other than this. Would be of help if you posted your code here. Also did you check that there is ONLY 1 and ONLY 1 ipprocs when you are doing all this.
Cheers
Kumar
_________________
IBM Certified WebSphere MQ V5.3 Developer
IBM Certified WebSphere MQ V5.3 Solution Designer
IBM Certified WebSphere MQ V5.3 System Administrator |
|
| Back to top |
|
|
| avigosa |
| Posted: Mon Mar 24, 2003 1:42 am Post subject: |
|
|
Newbie
Joined: 20 Mar 2003
Posts: 9
Location: Singapore
|
Heres the code:
| Quote: |
**********************************************************
* 100-MAIN-MODULE - MAIN PROGRAM LOGIC *
**********************************************************
100-MAIN-MODULE.
DISPLAY 'IN MAIN AREA PROGRAM, RCRPAPP '.
PERFORM 800-INITIALIZATION THRU 800-EXIT.
PERFORM 200-MQ-CONNECT THRU 200-EXIT.
PERFORM 300-MQ-OPEN THRU 300-EXIT.
PERFORM 400-MQ-GET-MSGS THRU 400-EXIT UNTIL NO-MORE-MSGS.
PERFORM 600-MQ-CLOSE THRU 600-EXIT.
PERFORM 700-MQ-DISCONN THRU 700-EXIT.
100-MAIN-EXIT.
EXIT PROGRAM.
***********************************************************
* 200-MQ-CONNECT - PERFORMED FROM 100-MAIN-MODULE. *
* CONNECTS TO THE LOCAL QUEUE MANAGER *
***********************************************************
200-MQ-CONNECT.
MOVE 0 TO MQ-HCONN
MQ-COMPCODE
MQ-REASON.
MOVE 'CSQBCONN' TO WS-MQ-PROGRAM.
CALL WS-MQ-PROGRAM USING MQ-QM-NAME
MQ-HCONN
MQ-COMPCODE
MQ-REASON.
EVALUATE MQ-REASON
WHEN 0
DISPLAY 'CONNECTED TO QM : ', MQ-QM-NAME
WHEN OTHER
MOVE 'RCRPAPP' TO LK-ERR-PROGRAM OF
LK-ERROR-DETAILS
MOVE '200-MQ-CONNECT' TO LK-ERR-LOC OF
LK-ERROR-DETAILS
MOVE 'CSQBCONN' TO LK-MQ-CALL OF
LK-MQ-ERROR-DETAILS
MOVE MQ-COMPCODE TO LK-MQ-CC OF
LK-MQ-ERROR-DETAILS
MOVE MQ-REASON TO LK-MQ-RC OF
LK-MQ-ERROR-DETAILS
MOVE '8888' TO LK-RESPONSE-CODE
SET LK-MQ-ERROR TO TRUE
PERFORM 999-ABNORMAL-EXIT
END-EVALUATE.
200-EXIT.
EXIT.
***********************************************************
* 300-MQ-OPEN - PERFORMED FROM 100-MAIN-MODULE. *
* OPENS THE LOCAL QUEUE BEFORE GETTING THE MESSAGES *
***********************************************************
300-MQ-OPEN.
MOVE MQM-OBJECT-DESCRIPTOR-I TO MQM-OBJECT-DESCRIPTOR.
INITIALIZE MQ-OPEN-OPTIONS
MQ-QLHOBJ
MQ-COMPCODE
MQ-REASON.
COMPUTE MQ-OPEN-OPTIONS = MQOO-INPUT-AS-Q-DEF
+ MQOO-INQUIRE +
+ MQOO-FAIL-IF-QUIESCING.
MOVE MQOT-Q TO MQOD-OBJECTTYPE
OF MQOD OF MQM-OBJECT-DESCRIPTOR.
MOVE MQ-Q-NAME TO MQOD-OBJECTNAME
OF MQOD OF MQM-OBJECT-DESCRIPTOR.
MOVE 'CSQBOPEN' TO WS-MQ-PROGRAM.
CALL WS-MQ-PROGRAM USING MQ-HCONN
MQOD OF MQM-OBJECT-DESCRIPTOR
MQ-OPEN-OPTIONS
MQ-QLHOBJ
MQ-COMPCODE
MQ-REASON.
EVALUATE MQ-REASON
WHEN 0
MOVE MQ-QLHOBJ TO MQ-INPUT-QUEUE-HOBJ
MOVE 'Q OPENED' TO WS-INFO
MOVE MQ-Q-NAME TO WS-QMNAME
DISPLAY WS-HEADER
PERFORM 310-INQUIRE-ALIAS
PERFORM 320-OPEN-BASE-QUEUE
WHEN OTHER
MOVE 'RCRPAPP' TO LK-ERR-PROGRAM OF
LK-ERROR-DETAILS
MOVE '300-MQ-OPEN' TO LK-ERR-LOC OF
LK-ERROR-DETAILS
MOVE MQ-Q-NAME TO LK-Q-NAME
MOVE MQ-QM-NAME TO LK-QM-NAME
MOVE 'CSQBOPEN' TO LK-MQ-CALL OF
LK-MQ-ERROR-DETAILS
MOVE MQ-COMPCODE TO LK-MQ-CC OF
LK-MQ-ERROR-DETAILS
MOVE MQ-REASON TO LK-MQ-RC OF
LK-MQ-ERROR-DETAILS
MOVE '8888' TO LK-RESPONSE-CODE
SET LK-MQ-ERROR TO TRUE
PERFORM 990-MQ-BACKOUT THRU 990-EXIT
PERFORM 999-ABNORMAL-EXIT
END-EVALUATE.
MOVE MQCA-BACKOUT-REQ-Q-NAME TO MQ-SELECTOR(1).
MOVE MQIA-BACKOUT-THRESHOLD TO MQ-SELECTOR(2).
MOVE 2 TO MQ-SELCOUNT.
MOVE 1 TO MQ-INTATTRCOUNT.
MOVE LENGTH OF MQ-BACKOUT-QUEUE TO MQ-CHARATTRLEN.
MOVE 'CSQBINQ' TO WS-MQ-PROGRAM.
CALL WS-MQ-PROGRAM USING MQ-HCONN
MQ-BASE-QUEUE-HOBJ
MQ-SELCOUNT
MQ-SELECTORS
MQ-INTATTRCOUNT
MQ-INTATTRS
MQ-CHARATTRLEN
MQ-BACKOUT-QUEUE
MQ-COMPCODE
MQ-REASON.
EVALUATE MQ-REASON
WHEN 0
MOVE MQ-INTATTR(1) TO MQ-BACKOUT-THRESHOLD
MOVE 'Q INQUIRED' TO WS-INFO
DISPLAY 'MQ-BACKOUT-QUEUE: ', MQ-BACKOUT-QUEUE
DISPLAY 'MQ-BACKOUT-THRESHOLD: ', MQ-BACKOUT-THRESHOLD
WHEN OTHER
MOVE 'RCRPAPP' TO LK-ERR-PROGRAM OF
LK-ERROR-DETAILS
MOVE '300-MQ-OPEN' TO LK-ERR-LOC OF
LK-ERROR-DETAILS
MOVE 'CSQBINQ' TO LK-MQ-CALL OF
LK-MQ-ERROR-DETAILS
MOVE MQ-COMPCODE TO LK-MQ-CC OF
LK-MQ-ERROR-DETAILS
MOVE MQ-REASON TO LK-MQ-RC OF
LK-MQ-ERROR-DETAILS
MOVE '8888' TO LK-RESPONSE-CODE
SET LK-MQ-ERROR TO TRUE
PERFORM 999-ABNORMAL-EXIT
END-EVALUATE.
300-EXIT.
EXIT.
**********************************************************
* 310-INQUIRE-ALIAS-PERFORMED FROM 300-MQ-OPEN. *
* INQUIRES ALIAS QUEUE TO GET BASE QUEUE NAME *
**********************************************************
310-INQUIRE-ALIAS.
MOVE MQCA-BASE-Q-NAME TO MQ-SELECTOR(1).
MOVE 1 TO MQ-SELCOUNT.
MOVE 0 TO MQ-INTATTRCOUNT.
MOVE MQ-Q-NAME-LENGTH TO MQ-CHARATTRLEN.
MOVE 'CSQBINQ' TO WS-MQ-PROGRAM.
CALL WS-MQ-PROGRAM USING MQ-HCONN
MQ-INPUT-QUEUE-HOBJ
MQ-SELCOUNT
MQ-SELECTORS
MQ-INTATTRCOUNT
MQ-INTATTRS
MQ-CHARATTRLEN
MQ-BASE-QUEUE
MQ-COMPCODE
MQ-REASON.
EVALUATE MQ-REASON
WHEN 0
MOVE 'Q INQUIRED' TO WS-INFO
WHEN OTHER
MOVE 'RCRPAPP' TO LK-ERR-PROGRAM OF
LK-ERROR-DETAILS
MOVE '310-INQUIRE-BASE' TO LK-ERR-LOC OF
LK-ERROR-DETAILS
MOVE 'CSQBINQ' TO LK-MQ-CALL OF
LK-MQ-ERROR-DETAILS
MOVE MQ-COMPCODE TO LK-MQ-CC OF
LK-MQ-ERROR-DETAILS
MOVE MQ-REASON TO LK-MQ-RC OF
LK-MQ-ERROR-DETAILS
MOVE '8888' TO LK-RESPONSE-CODE
SET LK-MQ-ERROR TO TRUE
PERFORM 999-ABNORMAL-EXIT
END-EVALUATE.
310-EXIT.
EXIT.
**********************************************************
* 320-OPEN-BASE-QUEUE. PERFORMED FROM 300-MQ-OPEN. *
* OPENS BASE QUEUE TO INQUIRE. *
**********************************************************
320-OPEN-BASE-QUEUE.
MOVE MQM-OBJECT-DESCRIPTOR-I TO MQM-OBJECT-DESCRIPTOR.
INITIALIZE MQ-OPEN-OPTIONS
MQ-QLHOBJ
MQ-COMPCODE
MQ-REASON.
COMPUTE MQ-OPEN-OPTIONS = MQOO-INQUIRE
+ MQOO-FAIL-IF-QUIESCING.
MOVE MQOT-Q TO MQOD-OBJECTTYPE
OF MQOD OF MQM-OBJECT-DESCRIPTOR.
MOVE MQ-BASE-QUEUE TO MQOD-OBJECTNAME
OF MQOD OF MQM-OBJECT-DESCRIPTOR.
MOVE 'CSQBOPEN' TO WS-MQ-PROGRAM.
CALL WS-MQ-PROGRAM USING MQ-HCONN
MQOD OF MQM-OBJECT-DESCRIPTOR
MQ-OPEN-OPTIONS
MQ-QLHOBJ
MQ-COMPCODE
MQ-REASON.
EVALUATE MQ-REASON
WHEN 0
MOVE MQ-QLHOBJ TO MQ-BASE-QUEUE-HOBJ
MOVE 'Q OPENED' TO WS-INFO
WHEN OTHER
MOVE 'RCRPAPP' TO LK-ERR-PROGRAM OF
LK-ERROR-DETAILS
MOVE '320-OPEN-BASE-QUEUE' TO LK-ERR-LOC OF
LK-ERROR-DETAILS
MOVE MQ-BASE-QUEUE TO LK-Q-NAME
MOVE MQ-QM-NAME TO LK-QM-NAME
MOVE 'CSQBOPEN' TO LK-MQ-CALL OF
LK-MQ-ERROR-DETAILS
MOVE MQ-COMPCODE TO LK-MQ-CC OF
LK-MQ-ERROR-DETAILS
MOVE MQ-REASON TO LK-MQ-RC OF
LK-MQ-ERROR-DETAILS
MOVE '8888' TO LK-RESPONSE-CODE
SET LK-MQ-ERROR TO TRUE
PERFORM 990-MQ-BACKOUT THRU 990-EXIT
PERFORM 999-ABNORMAL-EXIT
END-EVALUATE.
320-EXIT.
EXIT.
**********************************************************
* 400-MQ-GET-MSGS -PERFORMED FROM 100-MAIN-MODULE. *
* RETRIEVES MESSAGES FROM LOCAL QUEUE. *
**********************************************************
400-MQ-GET-MSGS.
MOVE MQM-MESSAGE-DESCRIPTOR-I
TO MQM-MESSAGE-DESCRIPTOR.
MOVE MQM-GET-MESSAGE-OPTIONS-I
TO MQM-GET-MESSAGE-OPTIONS.
INITIALIZE MQ-QLHOBJ
MQ-ACTUAL-GET-LENGTH
MQ-COMPCODE
MQ-REASON.
MOVE MQ-INPUT-QUEUE-HOBJ TO MQ-QLHOBJ.
COMPUTE MQGMO-OPTIONS OF MQM-GET-MESSAGE-OPTIONS =
MQGMO-WAIT +
MQGMO-FAIL-IF-QUIESCING +
MQGMO-CONVERT +
MQGMO-SYNCPOINT.
MOVE MQWI-UNLIMITED TO MQGMO-WAITINTERVAL OF
MQM-GET-MESSAGE-OPTIONS.
MOVE 'CSQBGET' TO WS-MQ-PROGRAM.
CALL WS-MQ-PROGRAM USING MQ-HCONN
MQ-QLHOBJ
MQMD OF MQM-MESSAGE-DESCRIPTOR
MQGMO OF MQM-GET-MESSAGE-OPTIONS
WS-MAX-MESSAGE-LENGTH
WS-REQUEST-MESSAGE
MQ-ACTUAL-GET-LENGTH
MQ-COMPCODE
MQ-REASON.
EVALUATE MQ-REASON
WHEN 0
MOVE FUNCTION CURRENT-DATE TO TEST-DATE
DISPLAY 'REQUEST MSG READ AT : ', TEST-DATE
MOVE MQ-ACTUAL-GET-LENGTH TO WS-REQUEST-DATA-LENGTH
MOVE FUNCTION UPPER-CASE(WS-REQUEST-MESSAGE) TO
WS-REQUEST-MESSAGE-U-CASE
MOVE WS-REQUEST-MESSAGE-U-CASE TO WS-REQUEST-MESSAGE
DISPLAY 'REQUEST-MESSAGE: ', WS-REQUEST-MESSAGE
DISPLAY 'BACKOUT COUNT FOR MSG: '
DISPLAY MQMD-BACKOUTCOUNT OF MQMD
OF MQM-MESSAGE-DESCRIPTOR
DISPLAY 'REQUEST MSG LENGTH: ',WS-REQUEST-DATA-LENGTH
IF MQMD-BACKOUTCOUNT OF MQMD
OF MQM-MESSAGE-DESCRIPTOR >= MQ-BACKOUT-THRESHOLD
SET ERROR-IN-DATA TO TRUE
END-IF
IF WS-REQUEST-MESSAGE(1: = "TIME-OUT"
SET NO-MORE-MSGS TO TRUE
DISPLAY 'TIME-OUT MESSAGE RECEIVED'
DISPLAY 'APPLICATION JOB SHUTTING DOWN'
ELSE
MOVE MQM-MESSAGE-DESCRIPTOR TO
MQM-MESSAGE-DESCRIPTOR-BACKOUT
MOVE MQMD-MSGID OF MQMD
OF MQM-MESSAGE-DESCRIPTOR
TO WS-MQ-MSGID
MOVE MQMD-CORRELID OF MQMD
OF MQM-MESSAGE-DESCRIPTOR
TO WS-MQ-CORRLID
MOVE MQMD-REPLYTOQ
OF MQMD OF MQM-MESSAGE-DESCRIPTOR
TO WS-REPLY-QNAME
MOVE MQMD-REPLYTOQMGR
OF MQMD OF MQM-MESSAGE-DESCRIPTOR
TO WS-REPLY-QMNAME
EVALUATE WS-REPLY-QMNAME(1:6)
WHEN 'RPSNT1'
MOVE 'AQ01' TO WS-QUEUE-TP-CD
MOVE 'OQ' TO WS-QUEUE-DIRECTION
WHEN 'RPSNT2'
MOVE 'AQ02' TO WS-QUEUE-TP-CD
MOVE 'OQ' TO WS-QUEUE-DIRECTION
WHEN 'RPSNT3'
MOVE 'AQ03' TO WS-QUEUE-TP-CD
MOVE 'OQ' TO WS-QUEUE-DIRECTION
WHEN 'RPSNT4'
MOVE 'AQ04' TO WS-QUEUE-TP-CD
MOVE 'OQ' TO WS-QUEUE-DIRECTION
WHEN OTHER
MOVE 'XXXX' TO WS-QUEUE-TP-CD
END-EVALUATE
DISPLAY 'REPLY TO QUEUE: ', WS-REPLY-QNAME
END-IF
WHEN OTHER
MOVE 'RCRPAPP' TO LK-ERR-PROGRAM OF
LK-ERROR-DETAILS
MOVE '400-MQ-GET-MSGS' TO LK-ERR-LOC OF
LK-ERROR-DETAILS
MOVE MQ-BASE-QUEUE TO LK-Q-NAME
MOVE MQ-QM-NAME TO LK-QM-NAME
MOVE 'CSQBGET' TO LK-MQ-CALL OF
LK-MQ-ERROR-DETAILS
MOVE MQ-COMPCODE TO LK-MQ-CC OF
LK-MQ-ERROR-DETAILS
MOVE MQ-REASON TO LK-MQ-RC OF
LK-MQ-ERROR-DETAILS
MOVE '8888' TO LK-RESPONSE-CODE
SET LK-MQ-ERROR TO TRUE
PERFORM 990-MQ-BACKOUT THRU 990-EXIT
PERFORM 999-ABNORMAL-EXIT
END-EVALUATE.
BIND RUN-UNIT ON ANY-ERROR-STATUS
MOVE '9999' TO LK-RESPONSE-CODE
MOVE 'BIND RUN UNIT FAILED,ERROR-STATUS IS : ' TO WS-MSG1
MOVE ERROR-STATUS TO WS-MSG2
MOVE WS-MSG TO
LK-ERROR-MESSAGE OF LK-USER-ERROR-DETAILS
MOVE 'RCRPAPP' TO LK-ERR-PROGRAM OF
LK-ERROR-DETAILS
MOVE '400-MQ-GET-MSGS' TO LK-ERR-LOC OF
LK-ERROR-DETAILS
PERFORM 990-MQ-BACKOUT THRU 990-EXIT
PERFORM 999-ABNORMAL-EXIT.
IF NOT NO-MORE-MSGS
PERFORM 410-PROCESS-PARA THRU 410-EXIT
UNTIL WS-RETRY-FLAG = 'NO'
END-IF.
MOVE 'YES' TO WS-RETRY-FLAG.
MOVE 1 TO WS-RETRY-COUNT.
400-EXIT.
EXIT.
***********************************************************
* 410-PROCESS-PARA - PERFORMED FROM 400-MQ-GET-MSGS *
* EVALUATES THE MESSAGE TYPE AND THEN CALL *
* CORRESPONDING IDMS ROUTINE TO PROCESS THE MESSAGE*
***********************************************************
410-PROCESS-PARA.
IF ERROR-IN-DATA
DISPLAY 'PERFORMING BACKOUT PROCESS'
MOVE 'NO' TO WS-BACKOUT-FLAG
MOVE MQ-BACKOUT-QUEUE TO WS-REPLY-QNAME
DISPLAY 'BACKOUT QUEUE : ', WS-REPLY-QNAME
PERFORM 411-OPEN-RESPONSE-QUEUE-PARA THRU 411-EXIT
PERFORM 414-MQ-PUT-MSGS-BACKOUT THRU 414-EXIT
PERFORM 500-MQ-COMMIT-PARA THRU 500-EXIT
MOVE 'NO' TO WS-RETRY-FLAG
FINISH
ELSE
MOVE WS-REQUEST-MESSAGE(1: TO WS-MESSAGE-NAME
DISPLAY 'MESSAGE TYPE :', WS-MESSAGE-NAME
EVALUATE WS-MESSAGE-NAME
WHEN 'RPSAP01 '
MOVE 'RCRPFMD' TO WS-IDMS-PROGRAM
DISPLAY 'CALLING: ', WS-IDMS-PROGRAM
MOVE FUNCTION CURRENT-DATE TO TEST-DATE
DISPLAY 'CALLING IDMS PGM AT : ', TEST-DATE
CALL WS-IDMS-PROGRAM USING WS-MESSAGE-DETAILS
SUBSCHEMA-CTRL
MOVE FUNCTION CURRENT-DATE TO TEST-DATE
DISPLAY 'AFTER CALLING IDMS PGM : ', TEST-DATE
DISPLAY 'RETURNING FROM : ', WS-IDMS-PROGRAM
DISPLAY 'REPLY MESSAGE : ', WS-REPLY-MESSAGE
DISPLAY 'REPLY DATA LENGTH : ',WS-REPLY-DATA-LENGTH
DISPLAY 'ERROR-STATUS RETURNED FROM IDMS ROUTINE',
ERROR-STATUS
IF WS-REPLY-MESSAGE(21:2) = '90'
IF ERROR-STATUS(3:2) = '29' OR '69'
BIND RUN-UNIT
DISPLAY ' RETURN CODE = 90'
ADD 1 TO WS-RETRY-COUNT
DISPLAY 'IDMS ROLLBACK, RETRY-COUNT',WS-RETRY-COUNT
ELSE
MOVE '9999' TO LK-RESPONSE-CODE
MOVE 'RETURN CODE IS 90, ABNORMAL EXIT' TO
LK-ERROR-MESSAGE OF LK-USER-ERROR-DETAILS
MOVE 'RCRPAPP' TO LK-ERR-PROGRAM OF
LK-ERROR-DETAILS
MOVE '410-PROCESS-PARA' TO LK-ERR-LOC OF
LK-ERROR-DETAILS
PERFORM 990-MQ-BACKOUT THRU 990-EXIT
PERFORM 999-ABNORMAL-EXIT
END-IF
ELSE
IF WS-REPLY-MESSAGE(21:2) NOT = '00'
ROLLBACK
DISPLAY 'NON ZERO RC FROM IDMS ROUTINE'
BIND RUN-UNIT
END-IF
END-IF
IF (WS-REPLY-MESSAGE(21:2) NOT = '90') OR
WS-RETRY-COUNT > 2
DISPLAY 'PROCESSING RESPONSE'
FINISH
SET INQUIRY TO TRUE
PERFORM 411-OPEN-RESPONSE-QUEUE-PARA THRU 411-EXIT
PERFORM 413-MQ-PUT-MSGS THRU 413-EXIT
PERFORM 500-MQ-COMMIT-PARA THRU 500-EXIT
MOVE 'NO' TO WS-RETRY-FLAG
END-IF
WHEN 'RPSAP02 '
MOVE 'RCRPBCF ' TO WS-IDMS-PROGRAM
PERFORM 420-UPDATE-2-PHASE-COMMIT
WHEN 'RPSAP03 '
MOVE 'RCRPFHD' TO WS-IDMS-PROGRAM
DISPLAY 'CALLING: ', WS-IDMS-PROGRAM
MOVE FUNCTION CURRENT-DATE TO TEST-DATE
DISPLAY 'CALLING IDMS PGM AT : ', TEST-DATE
CALL WS-IDMS-PROGRAM USING WS-MESSAGE-DETAILS
SUBSCHEMA-CTRL
MOVE FUNCTION CURRENT-DATE TO TEST-DATE
DISPLAY 'AFTER CALLING IDMS PGM : ', TEST-DATE
DISPLAY 'RETURNING FROM : ', WS-IDMS-PROGRAM
DISPLAY 'REPLY MESSAGE : ', WS-REPLY-MESSAGE
DISPLAY 'REPLY DATA LENGTH : ',WS-REPLY-DATA-LENGTH
DISPLAY 'ERROR-STATUS RETURNED FROM IDMS ROUTINE',
ERROR-STATUS
IF WS-REPLY-MESSAGE(21:2) = '90'
IF ERROR-STATUS(3:2) = '29' OR '69'
BIND RUN-UNIT
DISPLAY ' RETURN CODE = 90'
ADD 1 TO WS-RETRY-COUNT
DISPLAY 'IDMS ROLLBACK, RETRY-COUNT',WS-RETRY-COUNT
ELSE
MOVE '9999' TO LK-RESPONSE-CODE
MOVE 'RETURN CODE IS 90, ABNORMAL EXIT' TO
LK-ERROR-MESSAGE OF LK-USER-ERROR-DETAILS
MOVE 'RCRPAPP' TO LK-ERR-PROGRAM OF
LK-ERROR-DETAILS
MOVE '410-PROCESS-PARA' TO LK-ERR-LOC OF
LK-ERROR-DETAILS
PERFORM 990-MQ-BACKOUT THRU 990-EXIT
PERFORM 999-ABNORMAL-EXIT
END-IF
ELSE
IF WS-REPLY-MESSAGE(21:2) NOT = '00'
ROLLBACK
DISPLAY 'NON ZERO RC FROM IDMS ROUTINE'
BIND RUN-UNIT
END-IF
END-IF
IF (WS-REPLY-MESSAGE(21:2) NOT = '90') OR
WS-RETRY-COUNT > 2
DISPLAY 'PROCESSING RESPONSE'
FINISH
SET INQUIRY TO TRUE
PERFORM 411-OPEN-RESPONSE-QUEUE-PARA THRU 411-EXIT
PERFORM 413-MQ-PUT-MSGS THRU 413-EXIT
PERFORM 500-MQ-COMMIT-PARA THRU 500-EXIT
MOVE 'NO' TO WS-RETRY-FLAG
END-IF
WHEN 'RPSAP04 '
MOVE 'RCRPMHD ' TO WS-IDMS-PROGRAM
PERFORM 420-UPDATE-2-PHASE-COMMIT
WHEN 'RPSAP05 '
MOVE 'RCRPCHA ' TO WS-IDMS-PROGRAM
PERFORM 420-UPDATE-2-PHASE-COMMIT
WHEN 'RPSAP06 '
MOVE 'RCRPCIE ' TO WS-IDMS-PROGRAM
PERFORM 420-UPDATE-2-PHASE-COMMIT
WHEN 'RPSAP07 '
MOVE 'RCRPVMB' TO WS-IDMS-PROGRAM
DISPLAY 'CALLING RCRPVMB'
MOVE FUNCTION CURRENT-DATE TO TEST-DATE
DISPLAY 'CALLING IDMS PGM AT : ', TEST-DATE
CALL WS-IDMS-PROGRAM USING WS-MESSAGE-DETAILS
SUBSCHEMA-CTRL
MOVE FUNCTION CURRENT-DATE TO TEST-DATE
DISPLAY 'AFTER CALLING IDMS PGM : ', TEST-DATE
DISPLAY 'RETURNING FROM : ', WS-IDMS-PROGRAM
DISPLAY 'REPLY MESSAGE : ', WS-REPLY-MESSAGE
DISPLAY 'REPLY DATA LENGTH : ',WS-REPLY-DATA-LENGTH
DISPLAY 'ERROR-STATUS RETURNED FROM IDMS ROUTINE',
ERROR-STATUS
IF WS-REPLY-MESSAGE(21:2) = '90'
IF ERROR-STATUS(3:2) = '29' OR '69'
BIND RUN-UNIT
DISPLAY ' RETURN CODE = 90'
ADD 1 TO WS-RETRY-COUNT
DISPLAY 'IDMS ROLLBACK, RETRY-COUNT',WS-RETRY-COUNT
ELSE
MOVE '9999' TO LK-RESPONSE-CODE
MOVE 'RETURN CODE IS 90, ABNORMAL EXIT' TO
LK-ERROR-MESSAGE OF LK-USER-ERROR-DETAILS
MOVE 'RCRPAPP' TO LK-ERR-PROGRAM OF
LK-ERROR-DETAILS
MOVE '410-PROCESS-PARA' TO LK-ERR-LOC OF
LK-ERROR-DETAILS
PERFORM 990-MQ-BACKOUT THRU 990-EXIT
PERFORM 999-ABNORMAL-EXIT
END-IF
ELSE
IF WS-REPLY-MESSAGE(21:2) NOT = '00'
ROLLBACK
DISPLAY 'IDMS ROUTINE RETURNED 99'
BIND RUN-UNIT
END-IF
END-IF
IF (WS-REPLY-MESSAGE(21:2) NOT= '90') OR
WS-RETRY-COUNT > 2
DISPLAY 'PROCESSING RESPONSE'
FINISH
SET INQUIRY TO TRUE
PERFORM 411-OPEN-RESPONSE-QUEUE-PARA THRU 411-EXIT
PERFORM 413-MQ-PUT-MSGS THRU 413-EXIT
PERFORM 500-MQ-COMMIT-PARA THRU 500-EXIT
MOVE 'NO' TO WS-RETRY-FLAG
END-IF
WHEN 'RPSAP08 '
MOVE 'RCRPLBS' TO WS-IDMS-PROGRAM
DISPLAY 'CALLING RCRPLBS'
MOVE FUNCTION CURRENT-DATE TO TEST-DATE
DISPLAY 'CALLING IDMS PGM AT : ', TEST-DATE
CALL WS-IDMS-PROGRAM USING WS-MESSAGE-DETAILS
SUBSCHEMA-CTRL
MOVE FUNCTION CURRENT-DATE TO TEST-DATE
DISPLAY 'AFTER CALLING IDMS PGM : ', TEST-DATE
DISPLAY 'RETURNING FROM : ', WS-IDMS-PROGRAM
DISPLAY 'REPLY MESSAGE : ', WS-REPLY-MESSAGE
DISPLAY 'REPLY DATA LENGTH : ',WS-REPLY-DATA-LENGTH
DISPLAY 'ERROR-STATUS RETURNED FROM IDMS ROUTINE',
ERROR-STATUS
IF WS-REPLY-MESSAGE(21:2) = '90'
IF ERROR-STATUS(3:2) = '29' OR '69'
BIND RUN-UNIT
DISPLAY ' RETURN CODE = 90'
ADD 1 TO WS-RETRY-COUNT
DISPLAY 'IDMS ROLLBACK, RETRY-COUNT',WS-RETRY-COUNT
ELSE
MOVE '9999' TO LK-RESPONSE-CODE
MOVE 'RETURN CODE IS 90, ABNORMAL EXIT' TO
LK-ERROR-MESSAGE OF LK-USER-ERROR-DETAILS
MOVE 'RCRPAPP' TO LK-ERR-PROGRAM OF
LK-ERROR-DETAILS
MOVE '410-PROCESS-PARA' TO LK-ERR-LOC OF
LK-ERROR-DETAILS
PERFORM 990-MQ-BACKOUT THRU 990-EXIT
PERFORM 999-ABNORMAL-EXIT
END-IF
ELSE
IF WS-REPLY-MESSAGE(21:2) NOT = '00'
ROLLBACK
DISPLAY 'IDMS ROUTINE RETURNED 99'
BIND RUN-UNIT
END-IF
END-IF
IF (WS-REPLY-MESSAGE(21:2) NOT = '90') OR
WS-RETRY-COUNT > 2
DISPLAY 'PROCESSING RESPONSE'
FINISH
SET INQUIRY TO TRUE
PERFORM 411-OPEN-RESPONSE-QUEUE-PARA THRU 411-EXIT
PERFORM 413-MQ-PUT-MSGS THRU 413-EXIT
PERFORM 500-MQ-COMMIT-PARA THRU 500-EXIT
MOVE 'NO' TO WS-RETRY-FLAG
END-IF
WHEN 'RPSAP09 '
MOVE 'RCRPHWA' TO WS-IDMS-PROGRAM
DISPLAY 'CALLING RCRPHWA'
MOVE FUNCTION CURRENT-DATE TO TEST-DATE
DISPLAY 'CALLING IDMS PGM AT : ', TEST-DATE
CALL WS-IDMS-PROGRAM USING WS-MESSAGE-DETAILS
SUBSCHEMA-CTRL
MOVE FUNCTION CURRENT-DATE TO TEST-DATE
DISPLAY 'AFTER CALLING IDMS PGM : ', TEST-DATE
DISPLAY 'RETURNING FROM : ', WS-IDMS-PROGRAM
DISPLAY 'REPLY MESSAGE : ', WS-REPLY-MESSAGE
DISPLAY 'REPLY DATA LENGTH : ',WS-REPLY-DATA-LENGTH
DISPLAY 'ERROR-STATUS RETURNED FROM IDMS ROUTINE',
ERROR-STATUS
IF WS-REPLY-MESSAGE(21:2) = '90'
IF ERROR-STATUS(3:2) = '29' OR '69'
BIND RUN-UNIT
DISPLAY ' RETURN CODE = 90'
ADD 1 TO WS-RETRY-COUNT
DISPLAY 'IDMS ROLLBACK, RETRY-COUNT',WS-RETRY-COUNT
ELSE
MOVE '9999' TO LK-RESPONSE-CODE
MOVE 'RETURN CODE IS 90, ABNORMAL EXIT' TO
LK-ERROR-MESSAGE OF LK-USER-ERROR-DETAILS
MOVE 'RCRPAPP' TO LK-ERR-PROGRAM OF
LK-ERROR-DETAILS
MOVE '410-PROCESS-PARA' TO LK-ERR-LOC OF
LK-ERROR-DETAILS
PERFORM 990-MQ-BACKOUT THRU 990-EXIT
PERFORM 999-ABNORMAL-EXIT
END-IF
ELSE
IF WS-REPLY-MESSAGE(21:2) NOT = '00'
ROLLBACK
DISPLAY 'IDMS ROUTINE RETURNED 99'
BIND RUN-UNIT
END-IF
END-IF
IF (WS-REPLY-MESSAGE(21:2) NOT = '90') OR
WS-RETRY-COUNT > 2
DISPLAY 'PROCESSING RESPONSE'
FINISH
SET INQUIRY TO TRUE
PERFORM 411-OPEN-RESPONSE-QUEUE-PARA THRU 411-EXIT
PERFORM 413-MQ-PUT-MSGS THRU 413-EXIT
PERFORM 500-MQ-COMMIT-PARA THRU 500-EXIT
MOVE 'NO' TO WS-RETRY-FLAG
END-IF
WHEN OTHER
DISPLAY 'ERROR MESSAGE RECEIVED: ', WS-MESSAGE-NAME
MOVE 'NO' TO WS-RETRY-FLAG
FINISH
END-EVALUATE
END-IF.
410-EXIT.
EXIT.
**********************************************************
* 411-OPEN-RESPONSE-QUEUE-PARA - PERFORMED FROM *
* 410-PROCESS-PARA. *
* PUTS THE RESPONSE MESSAGE IF THE REMOTE QUEUE IS *
* ALREADY OPEN OTHERWISE OPENS THE Q AND PUTS THE MESSAGE*
**********************************************************
411-OPEN-RESPONSE-QUEUE-PARA.
MOVE 'Y' TO WS-Q-HANDLE-EXIST.
SET MQ-REPLY-INX TO 1.
SEARCH WS-MQ-REPLY-QUEUE
AT END
CONTINUE
WHEN (MQ-REPLY-QNAME(MQ-REPLY-INX) = WS-REPLY-QNAME
AND MQ-REPLY-QMNAME(MQ-REPLY-INX) = WS-REPLY-QMNAME)
MOVE 'N' TO WS-Q-HANDLE-EXIST
END-SEARCH.
IF WS-Q-HANDLE-EXIST ='Y'
SET MQ-REPLY-INX TO 1
SEARCH WS-MQ-REPLY-QUEUE
AT END
MOVE '9999' TO LK-RESPONSE-CODE
DISPLAY 'ALL Qs ARE OPENED'
MOVE 'ALL Qs ARE OPENED' TO LK-ERROR-MESSAGE
OF LK-USER-ERROR-DETAILS
PERFORM 999-ABNORMAL-EXIT
WHEN (MQ-REPLY-QNAME(MQ-REPLY-INX) = SPACES
AND MQ-REPLY-QMNAME(MQ-REPLY-INX)= SPACES)
PERFORM 412-MQ-REPLY-Q-OPEN THRU 412-EXIT
END-SEARCH
END-IF.
411-EXIT.
EXIT.
**********************************************************
* 412-MQ-REPLY-Q-OPEN - PERFORMED FROM *
* 411-OPEN-RESPONSE-QUEUE-PARA. *
* IT OPENS THE REPLY Q *
**********************************************************
412-MQ-REPLY-Q-OPEN.
MOVE MQM-OBJECT-DESCRIPTOR-I TO MQM-OBJECT-DESCRIPTOR.
INITIALIZE MQ-OPEN-OPTIONS
MQ-QLHOBJ
MQ-COMPCODE
MQ-REASON.
COMPUTE MQ-OPEN-OPTIONS = MQOO-OUTPUT
+ MQOO-FAIL-IF-QUIESCING.
* assuming as of now that reply-q-name = remote qname on OS/390
MOVE MQOT-Q TO MQOD-OBJECTTYPE
OF MQOD OF MQM-OBJECT-DESCRIPTOR.
MOVE WS-REPLY-QNAME TO MQOD-OBJECTNAME
OF MQOD OF MQM-OBJECT-DESCRIPTOR.
DISPLAY "OPENING REPLY QUEUE : ", WS-REPLY-QNAME.
MOVE 'CSQBOPEN' TO WS-MQ-PROGRAM.
CALL WS-MQ-PROGRAM USING MQ-HCONN
MQOD OF MQM-OBJECT-DESCRIPTOR
MQ-OPEN-OPTIONS
MQ-QLHOBJ
MQ-COMPCODE
MQ-REASON.
EVALUATE MQ-REASON
WHEN 0
MOVE WS-REPLY-QNAME TO MQ-REPLY-QNAME(MQ-REPLY-INX)
MOVE WS-REPLY-QMNAME TO MQ-REPLY-QMNAME(MQ-REPLY-INX)
MOVE MQ-QLHOBJ TO MQ-REPLY-HOBJ(MQ-REPLY-INX)
WHEN OTHER
MOVE 'RCRPAPP' TO LK-ERR-PROGRAM OF
LK-ERROR-DETAILS
MOVE '400-MQ-GET-MSGS' TO LK-ERR-LOC OF
LK-ERROR-DETAILS
MOVE WS-REPLY-QNAME TO LK-Q-NAME
MOVE MQ-QM-NAME TO LK-QM-NAME
MOVE 'CSQBOPEN' TO LK-MQ-CALL OF
LK-MQ-ERROR-DETAILS
MOVE MQ-COMPCODE TO LK-MQ-CC OF
LK-MQ-ERROR-DETAILS
MOVE MQ-REASON TO LK-MQ-RC OF
LK-MQ-ERROR-DETAILS
MOVE '8888' TO LK-RESPONSE-CODE
SET LK-MQ-ERROR TO TRUE
PERFORM 990-MQ-BACKOUT THRU 990-EXIT
PERFORM 999-ABNORMAL-EXIT
END-EVALUATE.
412-EXIT.
EXIT.
**********************************************************
* 413-MQ-PUT-MSGS - PERFORMED FROM 410-PROCESS-PARA *
* IT PUTS THE MESSAGE IN THE REPLY Q *
* *
**********************************************************
413-MQ-PUT-MSGS.
MOVE MQM-MESSAGE-DESCRIPTOR-I TO MQM-MESSAGE-DESCRIPTOR.
MOVE MQM-PUT-MESSAGE-OPTIONS-I TO MQM-PUT-MESSAGE-OPTIONS.
INITIALIZE MQ-QLHOBJ
MQ-COMPCODE
MQ-REASON.
MOVE MQ-REPLY-HOBJ(MQ-REPLY-INX) TO MQ-QLHOBJ.
IF INQUIRY
MOVE WS-MQ-MSGID TO MQMD-CORRELID OF MQMD OF
MQM-MESSAGE-DESCRIPTOR
MOVE MQ-MSG-EXPIRY TO MQMD-EXPIRY OF MQMD OF
MQM-MESSAGE-DESCRIPTOR
ELSE
MOVE WS-MQ-CORRLID TO MQMD-CORRELID OF MQMD OF
MQM-MESSAGE-DESCRIPTOR
END-IF.
MOVE MQFMT-STRING TO MQMD-FORMAT OF MQMD OF
MQM-MESSAGE-DESCRIPTOR.
COMPUTE MQPMO-OPTIONS OF MQM-PUT-MESSAGE-OPTIONS =
MQPMO-FAIL-IF-QUIESCING +
MQPMO-SYNCPOINT.
MOVE 'CSQBPUT' TO WS-MQ-PROGRAM.
CALL WS-MQ-PROGRAM USING MQ-HCONN
MQ-QLHOBJ
MQMD OF MQM-MESSAGE-DESCRIPTOR
MQPMO OF MQM-PUT-MESSAGE-OPTIONS
WS-REPLY-DATA-LENGTH
WS-REPLY-MESSAGE
MQ-COMPCODE
MQ-REASON.
EVALUATE MQ-REASON
WHEN 0
CONTINUE
MOVE FUNCTION CURRENT-DATE TO TEST-DATE
DISPLAY 'REPLY MESSAGE SENT AT : ', TEST-DATE
WHEN OTHER
MOVE 'RCRPAPP' TO LK-ERR-PROGRAM OF
LK-ERROR-DETAILS
MOVE '413-MQ-PUT-MSGS' TO LK-ERR-LOC OF
LK-ERROR-DETAILS
MOVE WS-REPLY-QNAME TO LK-Q-NAME
MOVE MQ-QM-NAME TO LK-QM-NAME
MOVE 'CSQBPUT' TO LK-MQ-CALL OF
LK-MQ-ERROR-DETAILS
MOVE MQ-COMPCODE TO LK-MQ-CC OF
LK-MQ-ERROR-DETAILS
MOVE MQ-REASON TO LK-MQ-RC OF
LK-MQ-ERROR-DETAILS
MOVE '8888' TO LK-RESPONSE-CODE
SET LK-MQ-ERROR TO TRUE
PERFORM 990-MQ-BACKOUT THRU 990-EXIT
PERFORM 999-ABNORMAL-EXIT
END-EVALUATE.
413-EXIT.
EXIT.
*************************************************************
* 414-MQ-PUT-MSGS-BACKOUT - PERFORMED FROM 410-PROCESS-PARA *
* IT PUTS THE MESSAGE IN THE BACKOUT QUEUE *
* *
*************************************************************
414-MQ-PUT-MSGS-BACKOUT.
MOVE MQM-MESSAGE-DESCRIPTOR-BACKOUT
TO MQM-MESSAGE-DESCRIPTOR.
MOVE MQM-PUT-MESSAGE-OPTIONS-I TO MQM-PUT-MESSAGE-OPTIONS.
INITIALIZE MQ-QLHOBJ
MQ-COMPCODE
MQ-REASON.
MOVE MQ-REPLY-HOBJ(MQ-REPLY-INX) TO MQ-QLHOBJ.
COMPUTE MQPMO-OPTIONS OF MQM-PUT-MESSAGE-OPTIONS =
MQPMO-FAIL-IF-QUIESCING +
MQPMO-SYNCPOINT.
MOVE 'CSQBPUT' TO WS-MQ-PROGRAM.
CALL WS-MQ-PROGRAM USING MQ-HCONN
MQ-QLHOBJ
MQMD OF MQM-MESSAGE-DESCRIPTOR
MQPMO OF MQM-PUT-MESSAGE-OPTIONS
WS-REQUEST-DATA-LENGTH
WS-REQUEST-MESSAGE
MQ-COMPCODE
MQ-REASON.
EVALUATE MQ-REASON
WHEN 0
CONTINUE
MOVE FUNCTION CURRENT-DATE TO TEST-DATE
DISPLAY 'BACKOUT MESSAGE SENT AT : ', TEST-DATE
WHEN OTHER
MOVE 'RCRPAPP' TO LK-ERR-PROGRAM OF
LK-ERROR-DETAILS
MOVE '414-MQ-PUT-MSGS-BACKOUT' TO LK-ERR-LOC OF
LK-ERROR-DETAILS
MOVE WS-REPLY-QNAME TO LK-Q-NAME
MOVE MQ-QM-NAME TO LK-QM-NAME
MOVE 'CSQBPUT' TO LK-MQ-CALL OF
LK-MQ-ERROR-DETAILS
MOVE MQ-COMPCODE TO LK-MQ-CC OF
LK-MQ-ERROR-DETAILS
MOVE MQ-REASON TO LK-MQ-RC OF
LK-MQ-ERROR-DETAILS
MOVE '8888' TO LK-RESPONSE-CODE
SET LK-MQ-ERROR TO TRUE
PERFORM 990-MQ-BACKOUT THRU 990-EXIT
PERFORM 999-ABNORMAL-EXIT
END-EVALUATE.
414-EXIT.
EXIT.
**********************************************************
* 420-UPDATE-2-PHASE-COMMIT - PERFORMED FROM *
* 410-PROCESS-PARA *
* IT UPDATE THE MESSAGE IN IDMS AND BUILD THE 2-PHASE *
* COMMIT LOGIC. *
**********************************************************
420-UPDATE-2-PHASE-COMMIT.
SET UPDATE TO TRUE
MOVE WS-REPLY-QMNAME TO MQSCTL-MSG-Q-MGR-CODE
MOVE 'ARP0002' TO MQSCTL-MSG-APP-CODE
MOVE 'RPS IMAGING' TO MQSCTL-MSG-STD-CODE
MOVE WS-MQ-CORRLID TO MQSCTL-MSG-ID
DISPLAY 'OBTAINING MQSCTL-8460 WITH MSG-ID: ',MQSCTL-MSG-ID
BIND MQSCTL-8460
OBTAIN CALC MQSCTL-8460 ON DB-REC-NOT-FOUND
MOVE 'NO' TO WS-MQCTL-FLAG.
IF MQCTL-NOT-FOUND
DISPLAY 'CALLING: ', WS-IDMS-PROGRAM
CALL WS-IDMS-PROGRAM USING WS-MESSAGE-DETAILS
SUBSCHEMA-CTRL
DISPLAY 'RETURNING FROM : ', WS-IDMS-PROGRAM
DISPLAY 'REPLY MESSAGE : ', WS-REPLY-MESSAGE
DISPLAY 'REPLY DATA LENGTH : ',WS-REPLY-DATA-LENGTH
DISPLAY 'ERROR-STATUS RETURNED FROM IDMS ROUTINE',
ERROR-STATUS
IF WS-REPLY-MESSAGE(21:2) = '90'
IF ERROR-STATUS(3:2) = '29' OR '69'
BIND RUN-UNIT
DISPLAY ' RETURN CODE = 90'
ADD 1 TO WS-RETRY-COUNT
DISPLAY 'IDMS ROLLBACK, RETRY-COUNT',WS-RETRY-COUNT
ELSE
MOVE '9999' TO LK-RESPONSE-CODE
MOVE 'RETURN CODE IS 90, ABNORMAL EXIT' TO
LK-ERROR-MESSAGE OF LK-USER-ERROR-DETAILS
MOVE 'RCRPAPP' TO LK-ERR-PROGRAM OF
LK-ERROR-DETAILS
MOVE '420-PROCESS-PARA' TO LK-ERR-LOC OF
LK-ERROR-DETAILS
PERFORM 990-MQ-BACKOUT THRU 990-EXIT
PERFORM 999-ABNORMAL-EXIT
END-IF
ELSE
IF WS-REPLY-MESSAGE(21:2) NOT = '00'
ROLLBACK
DISPLAY 'NON ZERO RC FROM IDMS ROUTINE'
BIND RUN-UNIT
END-IF
END-IF
IF WS-REPLY-MESSAGE(21:2) NOT = '90'
OR WS-RETRY-COUNT > 2
BIND MQSCTL-8460
PERFORM 425-STORE-IDMS-PARA THRU 425-EXIT
DISPLAY 'MQ CTL STORED FOR MESSAGE ID: ',WS-MQ-MSGID
PERFORM 411-OPEN-RESPONSE-QUEUE-PARA THRU 411-EXIT
PERFORM 413-MQ-PUT-MSGS THRU 413-EXIT
DISPLAY 'REPLY SENT TO REPLY-TO-QUEUE: ',WS-REPLY-QNAME
COMMIT
FINISH
DISPLAY 'IDMS COMMIT DONE '
***** Added to test 2 phase algorithm
* DIVIDE 25 BY X-ZERO GIVING X-REM
**** Added to test 2 phase algorithm
IF DB-STATUS-OK
DISPLAY 'CALLING MQCOMMIT'
PERFORM 500-MQ-COMMIT-PARA THRU 500-EXIT
ELSE
PERFORM IDMS-STATUS
END-IF
MOVE 'NO' TO WS-RETRY-FLAG
END-IF
ELSE
DISPLAY 'MQS CTL EXISTS FOR THIS MSG-ID'
MOVE MQSCTL-MSG-RESP-Q-DATA
TO WS-REPLY-MESSAGE
MOVE MQSCTL-MSG-RESP-Q-NAME
TO WS-REPLY-QNAME
MOVE MQSCTL-MSG-RESP-Q-MGR-NAME
TO WS-REPLY-QMNAME
PERFORM 411-OPEN-RESPONSE-QUEUE-PARA THRU 411-EXIT
PERFORM 413-MQ-PUT-MSGS THRU 413-EXIT
PERFORM 500-MQ-COMMIT-PARA THRU 500-EXIT
MOVE 'NO' TO WS-RETRY-FLAG
END-IF.
420-EXIT.
EXIT.
****************************************************************
* 425-STOTE-IDMS-PARA- PERFORMED FROM 420-UPDATE-2-PHASE-COMMIT*
* IT STORES THE RECORD IN IDMS *
****************************************************************
425-STORE-IDMS-PARA.
MOVE WS-REPLY-QMNAME TO MQSCTL-MSG-Q-MGR-CODE
MOVE 'ARP0002' TO MQSCTL-MSG-APP-CODE
MOVE 'RCRPAPP' TO MQSCTL-MSG-REQ-PRG
MOVE 'RPS IMAGING' TO MQSCTL-MSG-STD-CODE
MOVE WS-MQ-CORRLID TO MQSCTL-MSG-ID.
MOVE FUNCTION CURRENT-DATE(1: TO MQSCTL-MSG-CTL-DTE.
MOVE FUNCTION CURRENT-DATE(9: TO MQSCTL-MSG-CTL-TIME.
MOVE WS-REPLY-QNAME TO MQSCTL-MSG-RESP-Q-NAME.
MOVE WS-REPLY-QMNAME TO MQSCTL-MSG-RESP-Q-MGR-NAME.
MOVE WS-REPLY-MESSAGE TO MQSCTL-MSG-RESP-Q-DATA.
DISPLAY 'STORING MQ CTL RECORD WITH MSG-ID : ',MQSCTL-MSG-ID.
STORE MQSCTL-8460.
425-EXIT.
EXIT.
****************************************************************
* 500-MQ-COMMIT-PARA - PERFORMED FROM 420-UPDATE-2-PHASE-COMMIT*
* AND 410-PROCESS-PARA *
* IT PERFORMS MQCOMMIT *
****************************************************************
500-MQ-COMMIT-PARA.
MOVE 0 TO MQ-COMPCODE.
MOVE 0 TO MQ-REASON.
MOVE 'CSQBCOMM' TO WS-MQ-PROGRAM.
CALL WS-MQ-PROGRAM USING MQ-HCONN
MQ-COMPCODE
MQ-REASON.
EVALUATE MQ-REASON
WHEN 0
CONTINUE
WHEN OTHER
PERFORM 990-MQ-BACKOUT THRU 990-EXIT
END-EVALUATE.
500-EXIT.
EXIT.
****************************************************************
* 600-MQ-CLOSE - PERFORMED FROM 100-MAIN-MODULE *
* IT QUITS THE ACCESS TO INPUT Q, AND OUPUT Q *
* *
****************************************************************
600-MQ-CLOSE.
INITIALIZE MQ-QLHOBJ
MQ-COMPCODE
MQ-REASON.
MOVE MQ-INPUT-QUEUE-HOBJ TO MQ-QLHOBJ.
MOVE 'CSQBCLOS' TO WS-MQ-PROGRAM.
CALL WS-MQ-PROGRAM USING MQ-HCONN
MQ-QLHOBJ
MQCO-NONE
MQ-COMPCODE
MQ-REASON
DISPLAY 'CLOSING,MQ-INPUT-QUEUE-HOBJ: ', MQ-INPUT-QUEUE-HOBJ
EVALUATE MQ-REASON
WHEN 0
DISPLAY 'CLOSED: ', MQ-INPUT-QUEUE-HOBJ
CONTINUE
WHEN OTHER
DISPLAY 'ERROR CLOSING : ', MQ-COMPCODE
MOVE 'RCRPAPP' TO LK-ERR-PROGRAM OF
LK-ERROR-DETAILS
MOVE '600-MQ-CLOSE(INPUT Q)' TO LK-ERR-LOC OF
LK-ERROR-DETAILS
MOVE MQ-Q-NAME TO LK-Q-NAME
MOVE MQ-QM-NAME TO LK-QM-NAME
MOVE 'CSQBCLOS' TO LK-MQ-CALL OF
LK-MQ-ERROR-DETAILS
MOVE MQ-COMPCODE TO LK-MQ-CC OF
LK-MQ-ERROR-DETAILS
MOVE MQ-REASON TO LK-MQ-RC OF
LK-MQ-ERROR-DETAILS
MOVE '8888' TO LK-RESPONSE-CODE
SET LK-MQ-ERROR TO TRUE
PERFORM 999-ABNORMAL-EXIT
END-EVALUATE.
PERFORM VARYING MQ-REPLY-INX FROM 1 BY 1 UNTIL
MQ-REPLY-INX > WS-MAX-MQ-Q
INITIALIZE MQ-QLHOBJ
MQ-COMPCODE
MQ-REASON
MOVE MQ-REPLY-HOBJ(MQ-REPLY-INX) TO MQ-QLHOBJ
DISPLAY MQ-QLHOBJ
IF MQ-QLHOBJ NOT = 0
MOVE 'CSQBCLOS' TO WS-MQ-PROGRAM
CALL WS-MQ-PROGRAM USING MQ-HCONN
MQ-QLHOBJ
MQCO-NONE
MQ-COMPCODE
MQ-REASON
EVALUATE MQ-REASON
WHEN 0
CONTINUE
WHEN OTHER
MOVE 'RCRPAPP' TO LK-ERR-PROGRAM OF
LK-ERROR-DETAILS
MOVE '600-MQ-CLOSE' TO LK-ERR-LOC OF
LK-ERROR-DETAILS
MOVE 'CSQBCLOS(OUTPUT Q)' TO LK-MQ-CALL OF
LK-MQ-ERROR-DETAILS
MOVE MQ-COMPCODE TO LK-MQ-CC OF
LK-MQ-ERROR-DETAILS
MOVE MQ-REASON TO LK-MQ-RC OF
LK-MQ-ERROR-DETAILS
MOVE '8888' TO LK-RESPONSE-CODE
SET LK-MQ-ERROR TO TRUE
PERFORM 999-ABNORMAL-EXIT
END-EVALUATE
END-IF
END-PERFORM
DISPLAY 'CLOSE PARA FINISHED'.
600-EXIT.
EXIT.
****************************************************************
* 700-MQ-DISCONN - PERFORMED FROM 100-MAIN-MODELE *
* IT DISCONNECTS THE Q MANAGER *
****************************************************************
700-MQ-DISCONN.
MOVE 0 TO MQ-COMPCODE.
MOVE 0 TO MQ-REASON.
MOVE 'CSQBDISC' TO WS-MQ-PROGRAM
CALL WS-MQ-PROGRAM USING MQ-HCONN
MQ-COMPCODE
MQ-REASON.
EVALUATE MQ-REASON
WHEN 0
DISPLAY 'DISCONNECT SUCCESSFUL'
CONTINUE
WHEN OTHER
MOVE 'RCRPAPP' TO LK-ERR-PROGRAM OF
LK-ERROR-DETAILS
MOVE '700-MQ-DISCONN ' TO LK-ERR-LOC OF
LK-ERROR-DETAILS
MOVE 'CSQBDISC' TO LK-MQ-CALL OF
LK-MQ-ERROR-DETAILS
MOVE MQ-COMPCODE TO LK-MQ-CC OF
LK-MQ-ERROR-DETAILS
MOVE MQ-REASON TO LK-MQ-RC OF
LK-MQ-ERROR-DETAILS
MOVE '8888' TO LK-RESPONSE-CODE
SET LK-MQ-ERROR TO TRUE
PERFORM 999-ABNORMAL-EXIT
END-EVALUATE.
700-EXIT.
EXIT.
****************************************************************
* 800-INITIALIZATION - PERFORMED FROM 100-MAIN-MODULE. *
* IT INTILIAZE THE REPLY QUEQE TABLE AND LINKAGE QM, Q *
* TO WORK VARIABLES. *
****************************************************************
800-INITIALIZATION.
MOVE 5 TO WS-MAX-MQ-Q.
PERFORM VARYING MQ-REPLY-INX FROM 1 BY 1 UNTIL
MQ-REPLY-INX > WS-MAX-MQ-Q
INITIALIZE WS-MQ-REPLY-QUEUE (MQ-REPLY-INX)
END-PERFORM.
MOVE LK-QM-NAME TO MQ-QM-NAME
WS-QMNAME.
MOVE LK-Q-NAME TO MQ-Q-NAME.
800-EXIT.
EXIT.
****************************************************************
* 990-MQBACK-PARA - PERFORMED FROM 500-MQ-COMMIT-PARA
* IT PERFORMS MQROLLBACK.
****************************************************************
990-MQ-BACKOUT.
MOVE 0 TO MQ-COMPCODE.
MOVE 0 TO MQ-REASON.
MOVE 'CSQBBACK' TO WS-MQ-PROGRAM.
CALL WS-MQ-PROGRAM USING MQ-HCONN
MQ-COMPCODE
MQ-REASON.
EVALUATE MQ-REASON
WHEN 0
DISPLAY ' MQ ROLLED BACK'
CONTINUE
WHEN OTHER
MOVE 'RCRPAPP' TO LK-ERR-PROGRAM OF
LK-ERROR-DETAILS
MOVE '990-MQBACK-PARA' TO LK-ERR-LOC OF
LK-ERROR-DETAILS
MOVE 'CSQBBACK' TO LK-MQ-CALL OF
LK-MQ-ERROR-DETAILS
MOVE MQ-COMPCODE TO LK-MQ-CC OF
LK-MQ-ERROR-DETAILS
MOVE MQ-REASON TO LK-MQ-RC OF
LK-MQ-ERROR-DETAILS
MOVE '8888' TO LK-RESPONSE-CODE
SET LK-MQ-ERROR TO TRUE
PERFORM 999-ABNORMAL-EXIT.
990-EXIT.
EXIT.
999-ABNORMAL-EXIT.
EXIT PROGRAM.
IDMS-ABORT SECTION.
IDMS-ABORT-EXIT.
EXIT.
COPY IDMS IDMS-STATUS.
|
_________________
contact admin
HCL Perot Systems Pte. Ltd. |
|
| Back to top |
|
|
| avigosa |
| Posted: Wed Mar 26, 2003 4:54 am Post subject: |
|
|
Newbie
Joined: 20 Mar 2003
Posts: 9
Location: Singapore
|
anybody..there..pl.help....on this issue...
_________________
contact admin
HCL Perot Systems Pte. Ltd. |
|
| Back to top |
|
|
| oz1ccg |
| Posted: Wed Mar 26, 2003 8:04 am Post subject: |
|
|
Yatiri
Joined: 10 Feb 2002
Posts: 628
Location: Denmark
|
|
| Back to top |
|
|
| bower5932 |
| Posted: Wed Mar 26, 2003 12:42 pm Post subject: |
|
|
Jedi Knight
Joined: 27 Aug 2001
Posts: 3023
Location: Dallas, TX, USA
|
I'll start by saying that I didn't look at your code.... However, there are a couple of situations which can account for messages going away. One of them is in the client scenario when not using syncpoint:
http://www.mqseries.net/phpBB/viewtopic.php?t=8183
The other situation is when your program dies and doesn't issue an MQDISC. There is a discussion of this under the MQCMIT API in the Application Programming Guide. The behavior varies by platform. You might be running into this situation. |
|
| Back to top |
|
|
|
|
|
| |
|
Page 1 of 1 |
|
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum
|
|
|
|
