|
CBL XOPTS(ANSI85)
CBL NODYNAM,LIB,OBJECT,RENT,RES,APOST
* ------------------------------------------------------------- *
IDENTIFICATION DIVISION.
* ------------------------------------------------------------- *
PROGRAM-ID. CSQ4CVB1.
*REMARKS
*****************************************************************
* @START_COPYRIGHT@ *
* Statement: Licensed Materials - Property of IBM *
* *
* 5695-137 *
* (C) Copyright IBM Corporation. 1993, 1997 *
* *
* Status: Version 1 Release 2 *
* @END_COPYRIGHT@ *
* *
* Module Name : CSQ4CVB1 *
* *
* Environment : CICS/ESA Version 3.3; COBOL II *
* *
* CICS Transaction Name : MVB1 *
* *
* Description : Sample program to handle screen interface and *
* message generation and recovery for the *
* credit check sample *
* *
* Function : This program provides the user interface *
* function for the credit check sample *
* See IBM MQSeries for MVS/ESA Application *
* Programming Reference for details. *
* *
* ************************************************************* *
* *
* Program logic *
* ------------- *
* *
* Start (A-MAIN SECTION) *
* ----- *
* *
* Clear the output message field and screen map *
* Inquire depth of response queue *
* If depth cannot be obtained *
* Exit program with error message *
* End-if *
* Display the screen map and wait for input data *
* *
* Do while PF3 key is not pressed *
* *
* If Help (PF1) key pressed *
* Display the help screen while PF12 not pressed *
* Else if Enter key pressed *
* Evaluate request *
* When '1' Perform IMMEDIATE-INQUIRY *
* When '2' Perform BATCH-INQUIRY *
* When '3' If messages available *
* Perform BATCH-RESPONSE *
* Else *
* Build message *
* End-if *
* Otherwise build error message *
* End-evaluate *
* Else *
* Do nothing *
* End-if *
* *
* Move message to screen map *
* Inquire depth of response queue *
* Display the screen map and wait for input data *
* End-do *
* *
* Clear screen *
* Return to CICS *
* *
* *
* INQUIRE-DEPTH SECTION *
* --------------------- *
* Open response queue for inquiry *
* If open is successful *
* Inquire depth of response queue *
* If inquire unsuccessful *
* Build error message *
* Else *
* Update queue depth on screen map *
* End-if *
* End-if *
* *
* *
* IMMEDIATE-INQUIRY SECTION *
* ------------------------- *
* Open the inquiry queue (Perform OPEN-INQUIRY-QUEUE) *
* If open unsuccessful *
* Build error message *
* Goto Immediate-Inquiry-Exit *
* End-if *
* *
* Clear the output message field and screen map *
* Display the screen map and wait for input data, here *
* and throughout this section by performing DISPLAY-MAPID2 *
* *
* Do while PF3 key is not pressed *
* *
* If Help (PF1) key pressed *
* Display the help screen while PF12 not pressed *
* Else if PF5 key pressed *
* Clear the screen map *
* Put the previous inquiry data back into the *
* screen map (Perform REBUILD-IIM-IMMEDIATE) *
* Display the screen map *
* Else if Enter key pressed *
* Build the inquiry message *
* (Perform BUILD-IIM-IMMEDIATE) *
* Validate the user input (Perform VALIDATE-INPUT) *
* If input not ok *
* Display error message *
* Else *
* Make the inquiry and obtain the result *
* (Perform PROCESS-SCREEN-IMMEDIATE) *
* Syncpoint *
* Move message to screen map *
* Do while PF3 or PF5 key is not pressed *
* If Help (PF1) key pressed *
* Display the help screen while PF12 not *
* pressed *
* Else *
* Display the screen map *
* Move new messsage to screen map *
* End-if *
* End-do *
* Move the response message to the screen map *
* (Perform BUILD-MSG-OUTPUT) *
* End-if *
* Else *
* Display screen map *
* End-if *
* *
* End-do *
* *
* Close the inquiry queue, without updating the message *
* if there has been a problem earlier *
* *
* Immediate-Inquiry-Exit *
* *
* Set EIBAID to prevent calling program terminating *
* Return to performing section *
* *
* *
* BATCH-INQUIRY SECTION *
* --------------------- *
* Open the inquiry queue (Perform OPEN-INQUIRY-QUEUE) *
* If open unsuccessful *
* Build error message *
* Goto Batch-Inquiry-Exit *
* End-if *
* *
* Clear the output message field and screen map *
* Display the screen map and wait for input data, here *
* and throughout this section by performing DISPLAY-MAPID3 *
* *
* Do while PF3 key is not pressed *
* *
* If Help (PF1) key pressed *
* Display the help screen while PF12 not pressed *
* Else if PF5 key pressed *
* Clear the screen map *
* Put the previous inquiry data back into the *
* screen map (Perform REBUILD-IIM-BATCH) *
* Display the screen map *
* Else if Enter key pressed *
* Build the inquiry message *
* (Perform BUILD-IIM-BATCH) *
* Validate the user input (Perform VALIDATE-INPUT) *
* If input not ok *
* Display error message *
* Else *
* Make the inquiry (Perform PROCESS-SCREEN-BATCH) *
* Syncpoint *
* Move message to screen map *
* Display the screen map *
* Do while PF3 or PF5 key is not pressed *
* If Help (PF1) key pressed *
* Display the help screen while PF12 not *
* pressed *
* Else *
* Move new messsage to screen map *
* Display the screen map *
* End-if *
* End-do *
* End-if *
* Else *
* Display screen map *
* End-if *
* *
* End-do *
* *
* Close the inquiry queue *
* If close unsuccessful, build an error message *
* *
* Batch-Inquiry-Exit *
* *
* Set EIBAID to prevent calling program terminating *
* Return to performing section *
* *
* *
* BATCH-RESPONSE SECTION *
* ---------------------- *
* Open the response queue (Perform OPEN-RESPONSE-QUEUE) *
* If open unsuccessful *
* Build error message *
* Goto Batch-Response-Exit *
* End-if *
* *
* Clear the output message field and screen map *
* *
* Get a response message (Perform PROCESS-SCREEN-RESPONSE) *
* Move the message to the screen map field *
* *
* Display the screen map, here and throughout this *
* section by performing DISPLAY-MAPID4 *
* *
* Do while PF3 key is not pressed *
* *
* If Help (PF1) key pressed *
* Display the help screen while PF12 not pressed *
* Else if PF5 key pressed *
* Clear the message field *
* If PF8 key is pressed *
* Syncpoint *
* Get a response message *
* Move the message to the screen map field *
* End-if *
* Display the screen map *
* End-if *
* *
* End-do *
* *
* Close the response queue *
* If close unsuccessful, build an error message *
* *
* Batch-Response-Exit *
* *
* Set EIBAID to prevent calling program terminating *
* Return to performing section *
* *
* *
* PROCESS-IMMEDIATE-SCREEN SECTION *
* -------------------------------- *
* Create the temporary response queue *
* (Perform OPEN-TEMP-RESPONSE-QUEUE) *
* If open unsuccessful *
* Build error message *
* Goto Process-Immediate-Screen-Exit *
* End-if *
* *
* Set the message descriptor and put message options *
* for the immediate inquiry put *
* *
* Put the inquiry message on the queue *
* If put not successful *
* Build an error message *
* Clear the response area of the screen *
* Goto Process-Immediate-Screen-Exit-2 *
* End-if *
* *
* Set the message descriptor and get message options *
* to get the message from the temporary response queue *
* *
* Get the response message *
* If message received *
* Move response data from message to screen map by *
* performing BUILD-MSG-OUTPUT *
* Build 'inquiry complete' message *
* Else if no message received *
* Build 'no response' message *
* Clear the response area of the screen *
* Else *
* Build 'no response' message *
* Clear the response area of the screen *
* End-if *
* *
* Process-Immediate-Screen-Exit-2 *
* *
* Close the temporary dynamic queue *
* *
* Process-Immediate-Screen-Exit *
* *
* Return to performing section *
* *
* *
* PROCESS-INQUIRY-SCREEN SECTION *
* ------------------------------ *
* Set the message descriptor and put message options *
* for the batch inquiry put *
* *
* Put the inquiry message on the queue *
* If put not successful *
* Build an error message *
* Clear the response area of the screen *
* Else *
* Build 'inquiry sumitted' message *
* End-if *
* *
* Return to performing section *
* *
* *
* PROCESS-RESPONSE SCREEN SECTION *
* ------------------------------- *
* Set the message descriptor and get message options to *
* get a message from the response queue *
* *
* Get the response message *
* If message received *
* Move response data from message to screen map *
* Else if no message received *
* Build 'no more responses' message *
* Clear the response area of the screen *
* Else *
* Build error message *
* Clear the response area of the screen *
* End-if *
* *
* Return to performing section *
* *
* *
* DISPLAY-MAPID2 SECTION *
* ---------------------- *
* Exec CICS send immediate inquiry screen map *
* Exec CICS receive immediate inquiry screen map *
* Return to performing section *
* *
* *
* DISPLAY-MAPID3 SECTION *
* ---------------------- *
* Exec CICS send batch inquiry screen map *
* Exec CICS receive batch inquiry screen map *
* Return to performing section *
* *
* *
* DISPLAY-MAPID4 SECTION *
* ---------------------- *
* Exec CICS send batch response screen map *
* Exec CICS receive batch response screen map *
* Return to performing section *
* *
* *
* DISPLAY-HELP SECTION *
* -------------------- *
* Do until PF12 key is pressed *
* Exec CICS send help screen map *
* Exec CICS receive help screen map *
* End-do *
* *
* Return to performing section *
* *
* *
* VALDATE-INPUT SECTION *
* --------------------- *
* If amount requested is numeric *
* Set input-ok *
* Else *
* Set input-invalid *
* Build 'input-invalid' message *
* End-do *
* *
* Return to performing section *
* *
* *
* BUILD-IIM-IMMEDIATE SECTION *
* --------------------------- *
* Move data from screen map to initial inquiry message *
* Return to performing section *
* *
* *
* BUILD-IIM-BATCH SECTION *
* ----------------------- *
* Move data from screen map to initial inquiry message *
* Return to performing section *
* *
* *
* REBUILD-IIM-IMMEDIATE SECTION *
* ----------------------------- *
* Move data from inquiry message to screen map (MAPID2) *
* Return to performing section *
* *
* *
* REBUILD-IIM-BATCH SECTION *
* ------------------------- *
* Move data from inquiry message to screen map (MAPID3) *
* Return to performing section *
* *
* *
* BUILD-MESSAGE-OUTPUT *
* -------------------- *
* Move data from response message to screen map (MAPID2) *
* Return to performing section *
* *
* *
* CLEAR-RESPONSE-SCREEN SECTION *
* ----------------------------- *
* Clear all data from the response screen map (MAPID4) *
* Return to performing section *
* *
* *
* OPEN-RESPONSEQ-FOR-INQ SECTION *
* ------------------------------ *
* Set the object descriptor and open options to open the *
* response queue for inquiry *
* *
* Open the queue *
* If open unsuccessful *
* Build error message *
* End-if *
* *
* Return to performing section *
* *
* *
* OPEN-TEMP-RESPONSE-QUEUE SECTION *
* -------------------------------- *
* Set the object descriptor and open options to create *
* and open the temporary response queue *
* *
* Open the queue *
* If open unsuccessful *
* Build error message *
* Else *
* Save the temporary queue name *
* End-if *
* *
* Return to performing section *
* *
* *
* OPEN-INQUIRY-QUEUE SECTION *
* -------------------------- *
* Set the object descriptor and open options to open the *
* inquiry queue for output *
* *
* Open the queue *
* If open unsuccessful *
* Build error message *
* End-if *
* *
* Return to performing section *
* *
* *
* OPEN-RESPONSE-QUEUE SECTION *
* --------------------------- *
* Set the object descriptor and open options to open the *
* inquiry queue for input shared *
* *
* Open the queue *
* If open unsuccessful *
* Build error message *
* End-if *
* *
* Return to performing section *
* *
* *
* CLOSE-RESPONSE-QUEUE SECTION *
* ---------------------------- *
* Close the queue *
* If close unsuccessful *
* Build error message *
* End-if *
* *
* Return to performing section *
* *
* *
* CLOSE-INQUIRY-QUEUE SECTION *
* --------------------------- *
* Close the queue *
* If close unsuccessful *
* Build error message *
* End-if *
* *
* Return to performing section *
* *
* *
* CLOSE-TEMP-RESPONSE-QUEUE SECTION *
* --------------------------------- *
* Close the queue *
* If close unsuccessful *
* Build error message *
* End-if *
* *
* Return to performing section *
* *
* *
* ************************************************************* *
* ------------------------------------------------------------- *
ENVIRONMENT DIVISION.
* ------------------------------------------------------------- *
* ------------------------------------------------------------- *
DATA DIVISION.
* ------------------------------------------------------------- *
* ------------------------------------------------------------- *
WORKING-STORAGE SECTION.
* ------------------------------------------------------------- *
*
* W00 - Screen map name definitions
*
01 W00-MAPSETID PIC X(08) VALUE 'CSQ4VBM'.
01 W00-MAPIDHLP PIC X(08) VALUE 'CSQ4VB5'.
01 W00-MAPID1 PIC X(08) VALUE 'CSQ4VB1'.
01 W00-MAPID2 PIC X(08) VALUE 'CSQ4VB2'.
01 W00-MAPID3 PIC X(08) VALUE 'CSQ4VB3'.
01 W00-MAPID4 PIC X(08) VALUE 'CSQ4VB4'.
*
* W01 - General work fields
*
01 W01-CURDEPTH-EDITED PIC 9(9).
*
01 W01-WAIT-INTERVAL PIC S9(09) BINARY VALUE 30000.
*
* W02 - Queues processed in this program
*
01 W02-INQUIRY-QNAME PIC X(48) VALUE
'CSQ4SAMP.B2.INQUIRY '.
01 W02-RESPONSE-QNAME PIC X(48) VALUE
'CSQ4SAMP.B2.RESPONSE '.
01 W02-MODEL-QNAME PIC X(48) VALUE
'CSQ4SAMP.B1.MODEL '.
01 W02-NAME-PREFIX PIC X(48) VALUE
'CSQ4SAMP.B1.* '.
01 W02-TEMPORARY-Q PIC X(48).
*
* W03 - MQM API fields
*
01 W03-HCONN PIC S9(9) BINARY VALUE ZERO.
01 W03-HOBJ-INQUIRY PIC S9(9) BINARY.
01 W03-HOBJ-RESPONSE PIC S9(9) BINARY.
01 W03-HOBJ-MODEL PIC S9(9) BINARY.
01 W03-OPTIONS PIC S9(9) BINARY.
01 W03-BUFFLEN PIC S9(9) BINARY.
01 W03-DATALEN PIC S9(9) BINARY.
01 W03-COMPCODE PIC S9(9) BINARY.
01 W03-REASON PIC S9(9) BINARY.
*
01 W03-SELECTORCOUNT PIC S9(9) BINARY VALUE 1.
01 W03-INTATTRCOUNT PIC S9(9) BINARY VALUE 1.
01 W03-CHARATTRLENGTH PIC S9(9) BINARY VALUE ZERO.
01 W03-CHARATTRS PIC X VALUE LOW-VALUES.
01 W03-SELECTORS PIC S9(9) BINARY.
01 W03-INTATTRS PIC S9(9) BINARY.
*
01 W03-GET-BUFFER.
05 W03-CSQ4BAM.
COPY CSQ4VB2.
*
01 W03-PUT-BUFFER.
*
05 W03-CSQ4BIIM.
COPY CSQ4VB1.
*
* W04 - Process flag
*
01 W04-INPUT-STATUS PIC X(3) VALUE 'OK'.
88 INPUT-INVALID VALUE 'BAD'.
88 INPUT-OK VALUE 'OK'.
*
* 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.
*
* MQV contains constants (for filling in the control blocks)
* and return codes (for testing the result of a call)
*
01 MQM-CONSTANTS.
COPY CMQV SUPPRESS.
*
* The following copy book contains messages that will be
* displayed to the user
*
COPY CSQ4VB0.
*
* Screen map definitions used by this sample program
*
COPY CSQ4VBM.
*
* DFHAID contains the constants used for checking for
* attention identifiers
*
COPY DFHAID SUPPRESS.
*
* ------------------------------------------------------------- *
LINKAGE SECTION.
* ------------------------------------------------------------- *
*
EJECT
* ------------------------------------------------------------- *
PROCEDURE DIVISION.
* ------------------------------------------------------------- *
* ------------------------------------------------------------- *
A-MAIN SECTION.
* ------------------------------------------------------------- *
* *
* This section handles the selection screen, CSQ4VB1, in a *
* loop. Handlers for the subsequent screens are called from *
* within the loop. *
* *
* The section updates the number of responses available *
* using the INQUIRE-DEPTH function. *
* *
* After exit from the loop, the section returns control to *
* CICS. *
* *
* ------------------------------------------------------------ *
*
* Clear the output message field and screen map
*
MOVE SPACES TO M00-MESSAGE.
MOVE LOW-VALUES TO CSQ4VB1O.
*
PERFORM INQUIRE-DEPTH
*
* If the depth cannot be obtained, there is no possibility
* that the program can work - so exit with a message
*
IF M00-MESSAGE NOT = SPACES THEN
STRING EIBTRNID
M01-MESSAGE-14
DELIMITED BY SIZE INTO M00-MESSAGE
GO TO A-MAIN-EXIT
END-IF.
*
EXEC CICS IGNORE CONDITION
MAPFAIL
END-EXEC.
*
* Send the screen map, then receive it
*
EXEC CICS SEND
MAP(W00-MAPID1)
MAPSET(W00-MAPSETID)
FROM(CSQ4VB1O)
ERASE
END-EXEC
*
EXEC CICS RECEIVE
MAP(W00-MAPID1)
MAPSET(W00-MAPSETID)
INTO(CSQ4VB1I)
END-EXEC
*
* Loop from here to END-PERFORM until the PF3 key is pressed
*
PERFORM WITH TEST BEFORE UNTIL (EIBAID = DFHPF3 OR
EIBAID = DFHPF15)
*
EVALUATE TRUE
WHEN EIBAID = DFHPF1 OR EIBAID = DFHPF13
PERFORM DISPLAY-HELP
*
WHEN EIBAID = DFHENTER
*
* Process depending on the action entered by the
* user
*
EVALUATE TRUE
WHEN OPTIONI = '1'
PERFORM IMMEDIATE-INQUIRY
WHEN OPTIONI = '2'
PERFORM BATCH-INQUIRY
WHEN OPTIONI = '3'
IF W01-CURDEPTH-EDITED > ZERO
PERFORM BATCH-RESPONSE
ELSE
MOVE M01-MESSAGE-2 TO M00-MESSAGE
END-IF
WHEN OTHER
MOVE M01-MESSAGE-1 TO M00-MESSAGE
MOVE -1 TO OPTIONL
END-EVALUATE
*
END-EVALUATE
*
* Move the message field into the corresponding
* screen map field and update the response messages
* available field
*
MOVE M00-MESSAGE TO VB1MSGO
PERFORM INQUIRE-DEPTH
*
* Send the screen map, then receive it
*
EXEC CICS SEND
MAP(W00-MAPID1)
MAPSET(W00-MAPSETID)
FROM(CSQ4VB1O)
ERASE
END-EXEC
*
EXEC CICS RECEIVE
MAP(W00-MAPID1)
MAPSET(W00-MAPSETID)
INTO(CSQ4VB1I)
END-EXEC
*
END-PERFORM.
*
* Clear the screen and reset the keyboard
*
MOVE SPACES TO M00-MESSAGE.
*
A-MAIN-EXIT.
*
EXEC CICS SEND
TEXT
FROM(M00-MESSAGE)
FREEKB
ERASE
END-EXEC.
*
* Return to CICS.
*
EXEC CICS RETURN
END-EXEC.
*
GOBACK.
EJECT
*
* ------------------------------------------------------------- *
INQUIRE-DEPTH SECTION.
* ------------------------------------------------------------- *
* *
* This section inquires the current depth of the response *
* queue and updates the appropriate field (CURDPTHO) on the *
* map *
* *
* ------------------------------------------------------------ *
*
PERFORM OPEN-RESPONSEQ-FOR-INQ.
*
* Test for an error. If an error occurred, exit
*
IF W03-COMPCODE NOT = MQCC-OK
GO TO INQUIRE-DEPTH-EXIT
END-IF.
*
* Set selectors to inquire on current depth
*
MOVE MQIA-CURRENT-Q-DEPTH TO W03-SELECTORS.
*
* Inquire on the attributes
*
CALL 'MQINQ' USING W03-HCONN
W03-HOBJ-RESPONSE
W03-SELECTORCOUNT
W03-SELECTORS
W03-INTATTRCOUNT
W03-INTATTRS
W03-CHARATTRLENGTH
W03-CHARATTRS
W03-COMPCODE
W03-REASON.
*
* Test the output from the inquiry:
*
* - If the completion code is not OK, display an error
* message showing the completion and reason codes
*
* - Otherwise, move the correct attribute status into
* the relevant screen map fields
*
IF W03-COMPCODE NOT = MQCC-OK
MOVE 'MQINQ' TO M01-MSG4-OPERATION
MOVE W03-COMPCODE TO M01-MSG4-COMPCODE
MOVE W03-REASON TO M01-MSG4-REASON
MOVE M01-MESSAGE-4 TO M00-MESSAGE
*
ELSE
MOVE W03-INTATTRS TO W01-CURDEPTH-EDITED
MOVE W01-CURDEPTH-EDITED TO CURDPTHO
END-IF.
*
PERFORM CLOSE-RESPONSE-QUEUE.
*
INQUIRE-DEPTH-EXIT.
*
* Return to performing section
*
EXIT.
EJECT
*
* ------------------------------------------------------------- *
IMMEDIATE-INQUIRY SECTION.
* ------------------------------------------------------------- *
* *
* This section contains a loop which does the following: *
* displays the immediate inquiry map, gets and validates *
* user input, sends an inquiry message, waits to receive *
* the response. Once an inquiry has been completed another *
* inquiry can be initiated by the user *
* The loop is terminated by the user and a help panel is *
* available. *
* *
* Any errors occurring are reported to the user *
* *
* ------------------------------------------------------------ *
*
* Open inquiry queue
*
PERFORM OPEN-INQUIRY-QUEUE.
IF W03-COMPCODE NOT = MQCC-OK
GO TO IMMEDIATE-INQUIRY-EXIT
END-IF.
*
* Clear the output message field and screen map
*
MOVE SPACES TO M00-MESSAGE.
MOVE LOW-VALUES TO CSQ4VB2O.
*
PERFORM DISPLAY-MAPID2.
*
* Loop from here to END-PERFORM until the PF3 key is pressed
*
PERFORM WITH TEST BEFORE UNTIL (EIBAID = DFHPF3 OR
EIBAID = DFHPF15)
*
EVALUATE TRUE
WHEN EIBAID = DFHPF1 OR EIBAID = DFHPF13
PERFORM DISPLAY-HELP
*
WHEN EIBAID = DFHPF5 OR EIBAID = DFHPF17
*
* Clear the previous inquiry response, reset the
* data
*
MOVE LOW-VALUES TO CSQ4VB2O
PERFORM REBUILD-IIM-IMMEDIATE
MOVE SPACES TO CSQ4BAM-MSG
*
PERFORM DISPLAY-MAPID2
*
WHEN EIBAID = DFHENTER
*
PERFORM BUILD-IIM-IMMEDIATE
PERFORM VALIDATE-INPUT
*
IF NOT INPUT-OK THEN
*
* Move the message field into the
* corresponding screen map field
*
MOVE M00-MESSAGE TO VB2MSGO
*
PERFORM DISPLAY-MAPID2
*
ELSE
*
PERFORM PROCESS-IMMEDIATE-SCREEN
*
EXEC CICS SYNCPOINT END-EXEC
*
* Move the message field into the
* corresponding screen map field
*
MOVE M00-MESSAGE TO VB2MSGO
*
* Loop from here to END-PERFORM until
* the PF5 or PF3 is pressed
*
PERFORM WITH TEST BEFORE UNTIL
(EIBAID = DFHPF3 OR
EIBAID = DFHPF5 OR
EIBAID = DFHPF15 OR
EIBAID = DFHPF17)
*
IF EIBAID = DFHPF1 OR
EIBAID = DFHPF13 THEN
PERFORM DISPLAY-HELP
*
ELSE
PERFORM DISPLAY-MAPID2
*
* Move the message field into the
* corresponding screen map field
*
MOVE M01-MESSAGE-3 TO M00-MESSAGE
MOVE M00-MESSAGE TO VB2MSGO
*
END-IF
*
PERFORM BUILD-MSG-OUTPUT
*
END-PERFORM
*
END-IF
*
WHEN OTHER
*
PERFORM DISPLAY-MAPID2
*
END-EVALUATE
*
END-PERFORM.
*
* Close the inquiry queue
*
PERFORM CLOSE-INQUIRY-QUEUE
IF W03-COMPCODE = MQCC-OK
MOVE M01-MESSAGE-5 TO M00-MESSAGE
END-IF.
*
IMMEDIATE-INQUIRY-EXIT.
*
* Reset EIBAID to enable the previous screen to be displayed
*
MOVE DFHENTER TO EIBAID.
*
* Return to performing section
*
EXIT.
EJECT
* ------------------------------------------------------------- *
BATCH-INQUIRY SECTION.
* ------------------------------------------------------------- *
* *
* This section contains a loop which does the following: *
* displays the batch inquiry map, gets and validates *
* user input, sends an inquiry message. Once an inquiry *
* has been made, another inquiry can be initiated by the *.
* user. *
* The loop is terminated by the user and a help panel is *
* available. *
* *
* Prior to displaying the map for the first time the inquiry *
* queue is opened for output. *
* *
* Any errors occurring are reported to the user *
* *
* ------------------------------------------------------------ *
*
* open inquiry queue
*
PERFORM OPEN-INQUIRY-QUEUE.
IF W03-COMPCODE NOT = MQCC-OK
GO TO BATCH-INQUIRY-EXIT
END-IF.
*
* Clear the output message field and screen map
*
MOVE SPACES TO M00-MESSAGE.
MOVE LOW-VALUES TO CSQ4VB3O.
*
PERFORM DISPLAY-MAPID3.
*
* Loop from here to END-PERFORM until the PF3 key is pressed
*
PERFORM WITH TEST BEFORE UNTIL (EIBAID = DFHPF3 OR
EIBAID = DFHPF15)
*
EVALUATE TRUE
WHEN EIBAID = DFHPF1 OR EIBAID = DFHPF13
PERFORM DISPLAY-HELP
*
WHEN EIBAID = DFHPF5 OR EIBAID = DFHPF17
*
* Clear the previous inquiry response, reset the
* data
*
MOVE LOW-VALUES to CSQ4VB3O
PERFORM REBUILD-IIM-BATCH
*
PERFORM DISPLAY-MAPID3
*
WHEN EIBAID = DFHENTER
PERFORM BUILD-IIM-BATCH
PERFORM VALIDATE-INPUT
*
IF NOT INPUT-OK THEN
*
* Move the message field into the
* corresponding screen map field.
*
MOVE M00-MESSAGE TO VB3MSGO
*
PERFORM DISPLAY-MAPID3
*
ELSE
PERFORM PROCESS-INQUIRY-SCREEN
*
EXEC CICS SYNCPOINT END-EXEC
*
* Move the message field into the
* corresponding screen map field
*
MOVE M00-MESSAGE TO VB3MSGO
*
PERFORM DISPLAY-MAPID3
*
* Loop from here to END-PERFORM until
* the PF3 or PF5 key is pressed
*
PERFORM WITH TEST BEFORE UNTIL
(EIBAID = DFHPF3 OR
EIBAID = DFHPF5 OR
EIBAID = DFHPF15 OR
EIBAID = DFHPF17)
IF EIBAID = DFHPF1 OR
EIBAID = DFHPF13 THEN
PERFORM DISPLAY-HELP
*
ELSE
*
* Move the message field into the
* corresponding screen map field
*
MOVE M01-MESSAGE-3 TO M00-MESSAGE
MOVE M00-MESSAGE TO VB3MSGO
*
PERFORM DISPLAY-MAPID3
END-IF
*
END-PERFORM
*
END-IF
*
WHEN OTHER
PERFORM DISPLAY-MAPID3
*
END-EVALUATE
*
END-PERFORM.
*
*
*
PERFORM CLOSE-INQUIRY-QUEUE.
IF W03-COMPCODE = MQCC-OK
MOVE M01-MESSAGE-6 TO M00-MESSAGE
END-IF.
*
*
BATCH-INQUIRY-EXIT.
*
* Reset EIBAID to enable the previous screen to be displayed
*
MOVE DFHENTER TO EIBAID.
*
* Return to performing section
*
EXIT.
EJECT
* ------------------------------------------------------------- *
BATCH-RESPONSE SECTION.
* ------------------------------------------------------------- *
* *
* This section contains a loop which does the following: *
* displays the batch response map, receives a message from *
* the response queue and displays its content. Display *
* of another response can be initiated by the user. *
* The loop is terminated by the user and a help panel is *
* available. *
* *
* Prior to displaying the map for the first time the response *
* queue is opened for input. *
* *
* Any errors occurring are reported to the user *
* *
* ------------------------------------------------------------ *
*
* open response queue
*
PERFORM OPEN-RESPONSE-QUEUE.
IF W03-COMPCODE NOT = MQCC-OK
GO TO BATCH-RESPONSE-EXIT
END-IF.
*
* Clear the output message field and screen map
*
MOVE SPACES TO M00-MESSAGE.
MOVE LOW-VALUES TO CSQ4VB4O.
*
* Get first message
*
PERFORM PROCESS-RESPONSE-SCREEN.
*
* Move the message field into the corresponding
* screen map field
*
MOVE M00-MESSAGE TO VB4MSGO.
*
PERFORM DISPLAY-MAPID4.
*
* Loop from here to END-PERFORM until the PF3 key is pressed
*
PERFORM WITH TEST BEFORE UNTIL (EIBAID = DFHPF3 OR
EIBAID = DFHPF15)
*
IF EIBAID = DFHPF1 OR EIBAID = DFHPF13 THEN
PERFORM DISPLAY-HELP
*
ELSE
MOVE SPACES TO M00-MESSAGE
*
* Process depending on the action entered by the user
*
IF EIBAID = DFHPF8 OR EIBAID = DFHPF20
*
EXEC CICS SYNCPOINT END-EXEC
*
* Get the next message
*
PERFORM PROCESS-RESPONSE-SCREEN
*
* Move the message field into the corresponding
* screen map field
*
MOVE M00-MESSAGE TO VB4MSGO
END-IF
*
PERFORM DISPLAY-MAPID4
END-IF
*
END-PERFORM.
*
PERFORM CLOSE-RESPONSE-QUEUE.
IF W03-COMPCODE = MQCC-OK
MOVE M01-MESSAGE-7 TO M00-MESSAGE
END-IF.
*
* Reset EIBAID to enable the previous screen to be displayed
*
MOVE DFHENTER TO EIBAID.
*
BATCH-RESPONSE-EXIT.
*
* Return to performing section
*
EXIT.
EJECT
*
* ------------------------------------------------------------- *
PROCESS-IMMEDIATE-SCREEN SECTION.
* ------------------------------------------------------------- *
* *
* This section creates the temporary dynamic queue to receive *
* the response, sends a message to the inquiry queue and *
* waits for a response on the temporary dynamic queue. *
* *
* When a response is received it is transferred to the *
* map for display, otherwise an error message is built. *
* *
* Finally the temporary dynamic queue is deleted *
* *
* Note: Inquiry message is built prior to this section *
* being called *
* *
* ------------------------------------------------------------ *
*
* Open model queue, to create the temporary response queue
*
PERFORM OPEN-TEMP-RESPONSE-QUEUE.
IF W03-COMPCODE NOT = MQCC-OK
GO TO PROCESS-IMMEDIATE-SCREEN-EXIT
END-IF.
*
* Set the message descriptor and put message options to
* the values required to create the message.
* Set the length of the message
*
MOVE MQMT-REQUEST TO MQMD-MSGTYPE.
MOVE MQCI-NONE TO MQMD-CORRELID.
MOVE MQMI-NONE TO MQMD-MSGID.
MOVE W02-TEMPORARY-Q TO MQMD-REPLYTOQ.
MOVE SPACES TO MQMD-REPLYTOQMGR.
MOVE 5 TO MQMD-PRIORITY.
MOVE MQPER-NOT-PERSISTENT TO MQMD-PERSISTENCE.
COMPUTE MQPMO-OPTIONS = MQPMO-NO-SYNCPOINT +
MQPMO-DEFAULT-CONTEXT.
MOVE LENGTH OF CSQ4BIIM-MSG TO W03-BUFFLEN.
*
CALL 'MQPUT' USING W03-HCONN
W03-HOBJ-INQUIRY
MQMD
MQPMO
W03-BUFFLEN
W03-PUT-BUFFER
W03-COMPCODE
W03-REASON.
IF W03-COMPCODE NOT = MQCC-OK
MOVE 'MQPUT ' TO M01-MSG4-OPERATION
MOVE W03-COMPCODE TO M01-MSG4-COMPCODE
MOVE W03-REASON TO M01-MSG4-REASON
MOVE M01-MESSAGE-4 TO M00-MESSAGE
MOVE SPACES TO RESP01O RESP02O RESP03O RESP04O
RESP05O RESP06O RESP07O RESP08O
RESP09O RESP10O RESP11O RESP12O
GO TO PROCESS-IMMEDIATE-EXIT-2
END-IF.
*
*
*
* Set get message options field to wait within syncpoint
* Set interval for wait for 30 seconds
*
COMPUTE MQGMO-OPTIONS = MQGMO-SYNCPOINT +
MQGMO-WAIT.
MOVE W01-WAIT-INTERVAL TO MQGMO-WAITINTERVAL.
*
* Set msgid and correlid in md to nulls so that any message
* will qualify. Set the length to the available buffer
* length
*
MOVE MQMI-NONE TO MQMD-MSGID.
MOVE MQCI-NONE TO MQMD-CORRELID.
MOVE LENGTH OF W03-GET-BUFFER TO W03-BUFFLEN.
*
CALL 'MQGET' USING W03-HCONN,
W03-HOBJ-MODEL,
MQMD,
MQGMO,
W03-BUFFLEN,
W03-GET-BUFFER,
W03-DATALEN,
W03-COMPCODE,
W03-REASON.
EVALUATE TRUE
WHEN (W03-COMPCODE = MQCC-OK AND
W03-REASON = MQRC-NONE)
* Message received
PERFORM BUILD-MSG-OUTPUT
MOVE M01-MESSAGE-10 TO M00-MESSAGE
WHEN (W03-COMPCODE = MQCC-FAILED AND
W03-REASON = MQRC-NO-MSG-AVAILABLE)
* Wait timed out with no message received
MOVE M01-MESSAGE-11 TO M00-MESSAGE
MOVE SPACES TO RESP01O RESP02O RESP03O RESP04O
RESP05O RESP06O RESP07O RESP08O
RESP09O RESP10O RESP11O RESP12O
WHEN OTHER
* Unexpected result, report it
MOVE 'MQGETW ' TO M01-MSG4-OPERATION
MOVE W03-COMPCODE TO M01-MSG4-COMPCODE
MOVE W03-REASON TO M01-MSG4-REASON
MOVE M01-MESSAGE-4 TO M00-MESSAGE
MOVE SPACES TO RESP01O RESP02O RESP03O RESP04O
RESP05O RESP06O RESP07O RESP08O
RESP09O RESP10O RESP11O RESP12O
END-EVALUATE.
*
PROCESS-IMMEDIATE-EXIT-2.
*
PERFORM CLOSE-TEMP-RESPONSE-QUEUE.
*
PROCESS-IMMEDIATE-SCREEN-EXIT.
*
* Return to performing section.
*
EXIT.
EJECT
*
* ------------------------------------------------------------- *
PROCESS-INQUIRY-SCREEN SECTION.
* ------------------------------------------------------------- *
* *
* This section sends a message to the inquiry queue. It does *
* not wait for a response. *
* *
* Note: Inquiry message is built prior to this section *
* being called *
* *
* ------------------------------------------------------------ *
*
* Set the message descriptor and put message options to
* the values required to create the message.
* Set the length of the message
*
MOVE MQMT-REQUEST TO MQMD-MSGTYPE.
--> --------------------
--> maximum size reached
--> --------------------
¤ Dauer der Verarbeitung: 0.69 Sekunden
(vorverarbeitet)
¤
|
Laden
Fehler beim Verzeichnis:
in der Quellcodebibliothek suchen
Die farbliche Syntaxdarstellung ist noch experimentell.
|
