|
CBL XOPTS(ANSI85)
CBL NODYNAM,LIB,OBJECT,RENT,RES,APOST
* ------------------------------------------------------------- *
IDENTIFICATION DIVISION.
* ------------------------------------------------------------- *
PROGRAM-ID. CSQ4CVB3.
*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 : CSQ4CVB3 *
* *
* Environment : CICS/ESA Version 3.3; COBOL II *
* *
* CICS Transaction Name : MVB3 *
* *
* Description : Sample program to show a reply being developed *
* and sent in response to an input message. *
* The account file is read; if the account is *
* known, data from the file is used in the reply,*
* if the account is not known, an appropriate *
* response is sent. *
* *
* 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 checking account *
* query function for the credit check sample *
* See IBM MQSeries for MVS/ESA Application *
* Programming Reference for details. *
* *
* Dependency : Uses VSAM file known to CICS as 'CSQ4FIL' *
* *
* ************************************************************* *
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 *
* --------------------- *
* Initialize the reply message with query information *
* *
* Look for the account number in the file *
* Evaluate the response to the file read *
* When record found *
* Build reply message data, using data from file *
* When record not found *
* Build reply message data, indicating 'not known' *
* When other *
* Record the error *
* Build reply message data, indicating file read *
* error *
* End-evaluate *
* *
* 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 *
* *
* *
* 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. *
* *
* ************************************************************* *
EJECT
* ------------------------------------------------------------- *
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-RESPONSE PIC S9(09) BINARY.
*
* 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 W04-CSQ4BCAQ.
COPY CSQ4VB3.
*
01 W03-PUT-BUFFER.
05 W04-CSQ4BQRM.
COPY CSQ4VB4.
*
* W04 - File handling fields
*
01 W04-FILE-BUFFER.
05 W04-CSQ4CAQ.
COPY CSQ4VB6.
*
01 W04-READ-MESSAGE-LENGTH PIC S9(4) BINARY.
*
* 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 MQM-TRIGGER-MESSAGE.
COPY CMQTML.
*
* CICS ts queue 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.
*
* CSQ4VB8 contains error messages used in this program
*
COPY CSQ4VB8.
*
* 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 *
* *
* To develop the reply message the section uses the data in *
* the input message to obtain information from a file. If no *
* relevant record is found in the file an 'unknown' message *
* is returned. *
* *
* ------------------------------------------------------------ *
*
* Initialize the reply message with details from the
* query message
*
MOVE SPACES TO CSQ4BQRM-MSG.
SET QUERY-RESPONSE-MESSAGE TO TRUE.
MOVE CSQ4BCAQ-CHARGING TO CSQ4BQRM-CHARGING.
MOVE CSQ4BCAQ-GROUP TO CSQ4BQRM-GROUP.
*
* Look for the account number in the file
*
MOVE LENGTH OF W04-CSQ4CAQ TO W04-READ-MESSAGE-LENGTH.
*
EXEC CICS READ
FILE('CSQ4FIL')
INTO(W04-CSQ4CAQ)
LENGTH(W04-READ-MESSAGE-LENGTH)
RIDFLD(CSQ4BCAQ-BANKACNUM)
KEYLENGTH(10)
RESP(W00-RESPONSE)
END-EXEC.
*
* Examine the response to the file read
*
EVALUATE TRUE
WHEN (W00-RESPONSE = DFHRESP(NORMAL))
* Account number found
MOVE CSQ4CAQ-NAME TO W02-MSG1-NAME
MOVE W02-MESSAGE-1 TO CSQ4BQRM-LINE(1)
MOVE CSQ4CAQ-DATE-OPENED TO W02-MSG2-OPENED
MOVE CSQ4CAQ-AVERAGE-BAL TO W02-MSG2-BALANCE
MOVE W02-MESSAGE-2 TO CSQ4BQRM-LINE(2)
MOVE CSQ4CAQ-CREDIT-INDEX TO W02-MSG6-INDEX
MOVE W02-MESSAGE-6 TO CSQ4BQRM-LINE(3)
*
WHEN (W00-RESPONSE = DFHRESP(NOTFND))
* No record of account number found
MOVE CSQ4BCAQ-NAME TO W02-MSG1-NAME
MOVE W02-MESSAGE-1 TO CSQ4BQRM-LINE(1)
MOVE W02-MESSAGE-3 TO CSQ4BQRM-LINE(2)
MOVE 'NOT KNOWN' TO W02-MSG6-INDEX
MOVE W02-MESSAGE-6 TO CSQ4BQRM-LINE(3)
*
WHEN OTHER
* Error reading file - record and feedback error
MOVE 'FILE READ ERROR' TO M02-OPERATION
MOVE W00-RESPONSE TO M02-OBJECTNAME
PERFORM RECORD-CALL-ERROR
MOVE CSQ4BCAQ-NAME TO W02-MSG1-NAME
MOVE W02-MESSAGE-1 TO CSQ4BQRM-LINE(1)
MOVE W02-MESSAGE-3 TO CSQ4BQRM-LINE(2)
MOVE W00-RESPONSE TO W02-MSG7-RESP
MOVE W02-MESSAGE-7 TO CSQ4BQRM-LINE(3)
END-EVALUATE.
*
* Set the object descriptor, message descriptor and put
* message options to the values required 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
*
* ------------------------------------------------------------- *
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.75 Sekunden
(vorverarbeitet)
¤
|
Haftungshinweis
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:
Die farbliche Syntaxdarstellung ist noch experimentell.
|
