|
CBL XOPTS(ANSI85)
CBL NODYNAM,LIB,OBJECT,RENT,RES,APOST
* ------------------------------------------------------------- *
IDENTIFICATION DIVISION.
* ------------------------------------------------------------- *
PROGRAM-ID. CSQ4CVB5.
*REMARKS
*****************************************************************
* @START_COPYRIGHT@ *
* Statement: Licensed Materials - Property of IBM *
* *
* 5695-137 *
* (C) Copyright IBM Corporation. 1993, 1997 *
* *
* Status: Version 1 Release 2 *
* @END_COPYRIGHT@ *
* *
* Product Number : 5695-137 *
* *
* Module Name : CSQ4CVB5 *
* *
* Environment : CICS/ESA Version 3.3; COBOL II *
* *
* CICS Transaction Name : MVB5 *
* *
* Description : Sample program to show a reply being developed *
* and sent in response to an input message. *
* The queue on which the input message is to be *
* found is identified in the trigger information *
* available to the program. *
* *
* Function : This program provides the other account query *
* function for the credit check sample *
* See IBM MQSeries for MVS/ESA Application *
* Programming Reference for details. *
* *
* ************************************************************* *
EJECT
* ************************************************************* *
* *
* Program logic *
* ------------- *
* *
* Start (A-MAIN SECTION) *
* ----- *
* Check the program is started with data. *
* If no go to invalid-start-routine *
* End-if *
* Retrieve input queue name from trigger data *
* *
* Open the input queue *
* If open unsuccessful *
* Record error and exit from program *
* End-if *
* *
* Set the call parameters *
* Get a message from the input queue with wait *
* *
* Do while messages are retrieved *
* If expected message type *
* Perform PROCESS-QUERY *
* Else *
* Perform CHECKQ-UNKNOWN-MSG *
* End-if *
* Reset the call parameters *
* Get the next message from the input queue with wait *
* End-do *
* *
* If loop has not ended because no message is available *
* Record the reason *
* End-If *
* *
* Close the queues *
* Return to CICS *
* *
* *
* PROCESS-QUERY SECTION *
* --------------------- *
* Build the reply message *
* Add credit rating message (Perform FIND-CREDIT-INDEX) *
* *
* Set the parameters for the reply message *
* *
* Put message to queue *
* If put unsuccessful *
* Record the error *
* Forward the message to the samples dead queue *
* End-if *
* *
* Return to performing section *
* *
* *
* FIND-CREDIT-INDEX *
* ----------------- *
* Get time from CICS *
* Divide time by 100 to obtain remainder *
* Use remainder to determine credit index *
* Put credit rating in reply message *
* *
* Return to performing section *
* *
* *
* CLOSE-QUEUES *
* ------------ *
* Close the input queue *
* If close unsuccessful *
* Record the error *
* End-if *
* *
* Return to performing section *
* *
* *
* CHECKQ-UNKNOWN-MSG *
* ------------------ *
* Record the error *
* Forward the message to the samples dead queue *
* *
* Return to performing section *
* *
* *
* RECORD-CALL-ERROR *
* ----------------- *
* Get the time from CICS *
* Get the time formatted by CICS *
* Build the output message data *
* *
* Write the call error message to CICS TS queue CSQ4SAMP *
* Write the log error message to CICS TD queue CSML *
* *
* Return to performing section *
* *
* *
* FORWARD-MSG-TO-DLQ *
* ------------------ *
* Set the object descriptor, open options, and message *
* descriptor to enable the message to be put to the *
* samples dead letter queue *
* *
* If message to be sent is longer than buffer *
* Set message length to send the full buffer *
* End-if *
* *
* Put the message (using MQPUT1) to the queue *
* If put successful *
* Record the fact *
* Else *
* Record the error *
* End-if *
* *
* Return to performing section *
* *
* *
* INVALID-START-ROUTINE *
* --------------------- *
* Build error message *
* Send message *
* Return to cics. *
* *
* ------------------------------------------------------------- *
ENVIRONMENT DIVISION.
* ------------------------------------------------------------- *
* ------------------------------------------------------------- *
DATA DIVISION.
* ------------------------------------------------------------- *
* ------------------------------------------------------------- *
WORKING-STORAGE SECTION.
* ------------------------------------------------------------- *
*
* W00 - General work fields
*
01 W00-MESSAGE PIC X(70).
01 W00-STARTCODE PIC X(02).
01 W00-WAIT-INTERVAL PIC S9(09) BINARY VALUE 30000.
01 W00-TIME PIC S9(15) COMP-3.
01 W00-FILLER PIC S9(15) COMP-3.
*
01 W00-CREDIT-INDEX PIC 99 VALUE 0.
88 CREDIT-BAD VALUE 0 THRU 20.
88 CREDIT-POOR VALUE 21 THRU 30.
88 CREDIT-FAIR VALUE 31 THRU 40.
88 CREDIT-GOOD VALUE 41 THRU 50.
88 CREDIT-EXCELLENT VALUE 51 THRU 99.
*
* W01 - Queue names
*
01 W01-QUEUE-NAMES.
05 W01-DEAD-QNAME PIC X(48) VALUE
'CSQ4SAMP.DEAD.QUEUE '.
*
* CSQ4VB7 contains W02 messages sent in reply messages
*
COPY CSQ4VB7.
*
* W03 - API fields
*
01 W03-HCONN PIC S9(9) BINARY VALUE ZERO.
01 W03-OPTIONS PIC S9(9) BINARY.
01 W03-HOBJ-CHECKQ PIC S9(9) BINARY.
01 W03-COMPCODE PIC S9(9) BINARY.
01 W03-REASON PIC S9(9) BINARY.
01 W03-DATALEN PIC S9(9) BINARY.
01 W03-BUFFLEN PIC S9(9) BINARY.
*
01 W03-MSG-BUFFER.
05 W03-CSQ4BCAQ.
COPY CSQ4VB3.
*
01 W03-PUT-BUFFER.
05 W03-CSQ4BQRM.
COPY CSQ4VB4.
*
* API control blocks
*
01 MQM-OBJECT-DESCRIPTOR.
COPY CMQODV.
01 MQM-MESSAGE-DESCRIPTOR.
COPY CMQMDV.
01 MQM-PUT-MESSAGE-OPTIONS.
COPY CMQPMOV.
01 MQM-GET-MESSAGE-OPTIONS.
COPY CMQGMOV.
01 TRIGGER-MESSAGE.
COPY CMQTML.
*
* CSQ4VB8 contains error messages used in this program
*
COPY CSQ4VB8.
*
* Error message handling fields
*
01 W05-TD-MESSAGE-LENGTH PIC S9(4) BINARY.
01 W05-TS-MESSAGE-LENGTH PIC S9(4) BINARY.
01 W05-ABSTIME PIC S9(15) COMP-3.
*
* CMQV contains constants (for filling in the control blocks)
* and return codes (for testing the result of a call)
*
01 W99-MQV.
COPY CMQV SUPPRESS.
*
* DFHAID contains the constants used for checking for
* attention identifiers
*
COPY DFHAID SUPPRESS.
*
* ------------------------------------------------------------- *
LINKAGE SECTION.
* ------------------------------------------------------------- *
*
EJECT
* ------------------------------------------------------------- *
PROCEDURE DIVISION.
* ------------------------------------------------------------- *
* ------------------------------------------------------------- *
A-MAIN SECTION.
* ------------------------------------------------------------- *
* *
* This section initializes and controls the program flow *
* *
* After opening the input queue, the program enters a loop *
* getting and processing messages. Once no more messages *
* are available, shown by the program timing out, control is *
* returned to CICS *
* *
* ------------------------------------------------------------ *
*
* Check that the program has been started with data
*
EXEC CICS ASSIGN
STARTCODE(W00-STARTCODE)
END-EXEC.
*
IF W00-STARTCODE NOT = 'SD'
PERFORM INVALID-START-ROUTINE
* No return from INVALID-START-ROUTINE
END-IF.
*
* Retrieve the trigger data for this transaction
*
EXEC CICS RETRIEVE
INTO(MQTM)
END-EXEC.
*
* At this point the data retrieved has name of the queue
* which has caused this program to be triggered
*
* Open the queue
*
MOVE MQOT-Q TO MQOD-OBJECTTYPE.
MOVE MQTM-QNAME TO MQOD-OBJECTNAME.
*
* Initialize options and open the queue for input
*
COMPUTE W03-OPTIONS = MQOO-INPUT-SHARED +
MQOO-SAVE-ALL-CONTEXT.
*
CALL 'MQOPEN' USING W03-HCONN
MQOD
W03-OPTIONS
W03-HOBJ-CHECKQ
W03-COMPCODE
W03-REASON.
*
* Test the output from the open, if
* not ok then exit program
*
IF W03-COMPCODE NOT = MQCC-OK THEN
MOVE 'MQOPEN' TO M02-OPERATION
MOVE MQOD-OBJECTNAME TO M02-OBJECTNAME
PERFORM RECORD-CALL-ERROR
GO TO A-MAIN-EXIT.
*
* Now get and process messages
*
COMPUTE MQGMO-OPTIONS = MQGMO-WAIT +
MQGMO-ACCEPT-TRUNCATED-MSG +
MQGMO-SYNCPOINT.
MOVE LENGTH OF W03-MSG-BUFFER TO W03-BUFFLEN.
MOVE W00-WAIT-INTERVAL TO MQGMO-WAITINTERVAL.
MOVE MQMI-NONE TO MQMD-MSGID.
MOVE MQCI-NONE TO MQMD-CORRELID.
*
* Make the first MQGET call outside the loop
*
CALL 'MQGET' USING W03-HCONN
W03-HOBJ-CHECKQ
MQMD
MQGMO
W03-BUFFLEN
W03-MSG-BUFFER
W03-DATALEN
W03-COMPCODE
W03-REASON.
*
* Test the output of the MQGET call using the PERFORM loop
* that follows
*
*
* Loop from here to END-PERFORM until the MQGET call fails
*
PERFORM WITH TEST BEFORE
UNTIL W03-COMPCODE = MQCC-FAILED
*
* Perform the message received
*
EVALUATE TRUE
WHEN ACCOUNT-QUERY-MESSAGE
PERFORM PROCESS-QUERY
WHEN OTHER
PERFORM CHECKQ-UNKNOWN-MSG
END-EVALUATE
*
EXEC CICS SYNCPOINT END-EXEC
*
* Reset parameters for the next call
*
MOVE MQMI-NONE TO MQMD-MSGID
MOVE MQCI-NONE TO MQMD-CORRELID
*
* Get the next message
*
CALL 'MQGET' USING W03-HCONN
W03-HOBJ-CHECKQ
MQMD
MQGMO
W03-BUFFLEN
W03-MSG-BUFFER
W03-DATALEN
W03-COMPCODE
W03-REASON
*
* Test the output of the MQGET call at the top of the loop.
* Exit the loop if an error occurs
*
END-PERFORM.
*
* Test the output of the MQGET call. If the call failed,
* send an error message showing the completion code and
* reason code, unless the completion code is NO-MSG-AVAILABLE
*
IF (W03-COMPCODE NOT = MQCC-FAILED) OR
(W03-REASON NOT = MQRC-NO-MSG-AVAILABLE)
MOVE 'MQGET ' TO M02-OPERATION
MOVE MQOD-OBJECTNAME TO M02-OBJECTNAME
PERFORM RECORD-CALL-ERROR
END-IF.
*
PERFORM CLOSE-QUEUES.
*
A-MAIN-EXIT.
*
* Return to CICS
*
EXEC CICS RETURN
END-EXEC.
*
GOBACK.
EJECT
*
* ------------------------------------------------------------- *
PROCESS-QUERY SECTION.
* ------------------------------------------------------------- *
* *
* This section develops a reply message and puts it onto *
* the reply queue of the input message. If the put to the *
* reply queue fails, this is recorded and the message *
* forwarded to the dead queue *
* *
* ------------------------------------------------------------ *
*
* Build the reply message
*
MOVE SPACES TO CSQ4BQRM-MSG.
SET QUERY-RESPONSE-MESSAGE TO TRUE.
MOVE CSQ4BCAQ-CHARGING TO CSQ4BQRM-CHARGING.
MOVE CSQ4BCAQ-GROUP TO CSQ4BQRM-GROUP.
*
MOVE MQTM-QNAME TO W02-MSG4-QNAME.
MOVE W02-MESSAGE-4 TO CSQ4BQRM-LINE(1).
MOVE CSQ4BCAQ-LOANREQ TO W02-MSG5-AMOUNT.
MOVE CSQ4BCAQ-NAME TO W02-MSG5-NAME.
MOVE W02-MESSAGE-5 TO CSQ4BQRM-LINE(2).
PERFORM FIND-CREDIT-INDEX.
*
* Set the object descriptor, message descriptor and put
* message options to the values reuqired to create the
* message.
* Set the length of the message
*
MOVE MQMD-REPLYTOQ TO MQOD-OBJECTNAME.
MOVE MQMD-REPLYTOQMGR TO MQOD-OBJECTQMGRNAME.
MOVE MQMT-REPLY TO MQMD-MSGTYPE.
MOVE MQRO-NONE TO MQMD-REPORT.
MOVE SPACES TO MQMD-REPLYTOQ.
MOVE SPACES TO MQMD-REPLYTOQMGR.
MOVE LOW-VALUES TO MQMD-MSGID.
COMPUTE MQPMO-OPTIONS = MQPMO-SYNCPOINT +
MQPMO-PASS-IDENTITY-CONTEXT.
MOVE W03-HOBJ-CHECKQ TO MQPMO-CONTEXT.
MOVE LENGTH OF CSQ4BQRM-MSG TO W03-BUFFLEN.
*
CALL 'MQPUT1' USING W03-HCONN
MQOD
MQMD
MQPMO
W03-BUFFLEN
W03-PUT-BUFFER
W03-COMPCODE
W03-REASON.
IF W03-COMPCODE NOT = MQCC-OK
MOVE 'MQPUT1' TO M02-OPERATION
MOVE MQOD-OBJECTNAME TO M02-OBJECTNAME
PERFORM RECORD-CALL-ERROR
PERFORM FORWARD-MSG-TO-DLQ
END-IF.
*
PROCESS-QUERY-EXIT.
*
* Return to performing section
*
EXIT.
EJECT
*
* ------------------------------------------------------------- *
FIND-CREDIT-INDEX SECTION.
* ------------------------------------------------------------- *
* *
* This section computes a random 'credit index' based on *
* the time, which is obtained from CICS. The resulting *
* message line is added to the response message *
* *
* ------------------------------------------------------------ *
*
EXEC CICS ASKTIME ABSTIME(W00-TIME) END-EXEC.
*
DIVIDE W00-TIME BY 100 GIVING W00-FILLER
REMAINDER W00-CREDIT-INDEX.
*
EVALUATE TRUE
WHEN CREDIT-BAD
MOVE 'BAD ' TO W02-MSG6-INDEX
WHEN CREDIT-POOR
MOVE 'POOR ' TO W02-MSG6-INDEX
WHEN CREDIT-FAIR
MOVE 'FAIR ' TO W02-MSG6-INDEX
WHEN CREDIT-GOOD
MOVE 'GOOD ' TO W02-MSG6-INDEX
WHEN CREDIT-EXCELLENT
MOVE 'EXCELLENT' TO W02-MSG6-INDEX
WHEN OTHER
MOVE 'TRY AGAIN' TO W02-MSG6-INDEX
END-EVALUATE.
*
MOVE W02-MESSAGE-6 TO CSQ4BQRM-LINE(3).
*
FIND-CREDIT-INDEX-EXIT.
*
* Return to performing section
*
EXIT.
EJECT
*
* ------------------------------------------------------------- *
CLOSE-QUEUES SECTION.
* ------------------------------------------------------------- *
* *
* This section closes the input queue. All output from this *
* program uses MQPUT1, so no output queues are open *
* *
* ------------------------------------------------------------ *
*
CALL 'MQCLOSE' USING W03-HCONN
W03-HOBJ-CHECKQ
MQCO-NONE
W03-COMPCODE
W03-REASON.
IF W03-COMPCODE NOT = MQCC-OK
MOVE 'MQCLOSE' TO M02-OPERATION
MOVE MQTM-QNAME TO M02-OBJECTNAME
PERFORM RECORD-CALL-ERROR
END-IF.
*
CLOSE-QUEUES-EXIT.
*
* Return to performing section
*
EXIT.
EJECT
*
* ------------------------------------------------------------- *
CHECKQ-UNKNOWN-MSG SECTION.
* ------------------------------------------------------------- *
* *
* This section handles unexpected messages by recording the *
* error and forwarding the message to the dead queue *
* *
* ------------------------------------------------------------ *
*
MOVE 'UNKNOWN MSG DETECTED' TO M02-OPERATION.
MOVE MQOD-OBJECTNAME TO M02-OBJECTNAME.
*
PERFORM RECORD-CALL-ERROR.
*
PERFORM FORWARD-MSG-TO-DLQ.
*
CHECKQ-UNKNOWN-MSG-EXIT.
*
EXIT.
EJECT
*
* ------------------------------------------------------------- *
RECORD-CALL-ERROR SECTION.
* ------------------------------------------------------------- *
* *
* This section writes an error message to the CICS td queue *
* 'CSML' and the CICS ts queue 'CSQ4SAMP'. *
* The failing operation and object name fields are completed *
* by the calling application. The remaining fields of the *
* message are completed by this routine *
* *
* ------------------------------------------------------------ *
*
EXEC CICS ASKTIME
ABSTIME(W05-ABSTIME)
END-EXEC.
EXEC CICS FORMATTIME
ABSTIME(W05-ABSTIME)
DATE(M02-DATE) DATESEP
TIME(M02-TIME) TIMESEP
END-EXEC.
*
MOVE EIBTRNID TO M02-TRANSACTION
M03-TRANSACTION.
MOVE EIBTASKN TO M02-TASK-NUMBER
M03-TASK-NUMBER.
MOVE W03-COMPCODE TO M02-COMPCODE
MOVE W03-REASON TO M02-REASON
MOVE M02-DATE TO M03-DATE.
MOVE M02-TIME TO M03-TIME.
MOVE LENGTH OF M02-CALL-ERROR-MSG
TO W05-TS-MESSAGE-LENGTH
MOVE LENGTH OF M03-CSML-ERROR-MSG
TO W05-TD-MESSAGE-LENGTH.
*
EXEC CICS WRITEQ TS
QUEUE('CSQ4SAMP')
FROM (M02-CALL-ERROR-MSG)
LENGTH(W05-TS-MESSAGE-LENGTH)
END-EXEC.
*
EXEC CICS WRITEQ TD
QUEUE('CSML')
FROM (M03-CSML-ERROR-MSG)
LENGTH(W05-TD-MESSAGE-LENGTH)
END-EXEC.
*
RECORD-CALL-ERROR-EXIT.
*
* Return to performing section
*
EXIT.
EJECT
*
* ------------------------------------------------------------- *
FORWARD-MSG-TO-DLQ SECTION.
* ------------------------------------------------------------- *
* *
* This section forwards a message to the samples dead queue. *
* A message is written using RECORD-CALL-ERROR, the content *
* of the message shows whether the message was put to the *
* dead queue successfully *
* *
* ------------------------------------------------------------ *
*
MOVE MQOT-Q TO MQOD-OBJECTTYPE.
MOVE W01-DEAD-QNAME TO MQOD-OBJECTNAME.
*
MOVE MQPER-PERSISTENCE-AS-Q-DEF TO MQMD-PERSISTENCE.
*
* Use syncpoint option to avoid possible duplicate messages
* on dead queue
*
COMPUTE MQPMO-OPTIONS = MQPMO-SYNCPOINT +
MQPMO-PASS-IDENTITY-CONTEXT.
MOVE W03-HOBJ-CHECKQ TO MQPMO-CONTEXT.
*
* Send as many bytes of the message as possible
*
IF W03-DATALEN IS LESS THAN W03-BUFFLEN
MOVE W03-DATALEN TO W03-BUFFLEN
END-IF.
*
CALL 'MQPUT1' USING W03-HCONN
MQOD
MQMD
MQPMO
W03-BUFFLEN
W03-MSG-BUFFER
W03-COMPCODE
W03-REASON.
*
EVALUATE TRUE
WHEN (W03-COMPCODE = MQCC-OK AND
W03-REASON = MQRC-NONE)
MOVE 'MSG PUT TO DLQ' TO M02-OPERATION
MOVE W01-DEAD-QNAME TO M02-OBJECTNAME
PERFORM RECORD-CALL-ERROR
WHEN OTHER
MOVE 'MQPUT1' TO M02-OPERATION
MOVE W01-DEAD-QNAME TO M02-OBJECTNAME
PERFORM RECORD-CALL-ERROR
END-EVALUATE.
*
FORWARD-MSG-TO-DLQ-EXIT.
*
* Return to performing section
*
EXIT.
*
* ------------------------------------------------------------- *
INVALID-START-ROUTINE SECTION.
* ------------------------------------------------------------- *
* *
* This section sets sends an error message to a terminal if *
* the program is started without data. *
* *
* ------------------------------------------------------------ *
*
MOVE SPACES TO W00-MESSAGE.
STRING EIBTRNID
M04-STARTUP-ERROR
DELIMITED BY SIZE INTO W00-MESSAGE.
EXEC CICS SEND
TEXT
FROM(W00-MESSAGE)
FREEKB
ERASE
END-EXEC.
*
INVALID-START-ROUTINE-EXIT.
*
* Return to CICS
*
EXEC CICS RETURN
END-EXEC.
*
*
* ------------------------------------------------------------- *
* End of program *
* ------------------------------------------------------------- *
¤ Dauer der Verarbeitung: 0.35 Sekunden
(vorverarbeitet)
¤
|
Laden
Fehler beim Verzeichnis:
in der Quellcodebibliothek suchen
Die farbliche Syntaxdarstellung ist noch experimentell.
|
