|
CBL XOPTS(ANSI85)
CBL NODYNAM,LIB,OBJECT,RENT,RES,APOST,NUMPROC(NOPFD)
* ------------------------------------------------------------- *
IDENTIFICATION DIVISION.
* ------------------------------------------------------------- *
PROGRAM-ID. CSQ4CVD5.
*REMARKS
* ************************************************************* *
* @START_COPYRIGHT@ *
* Statement: Licensed Materials - Property of IBM *
* *
* 5695-137 *
* (C) Copyright IBM Corporation. 1993, 1996 *
* *
* Status: Version 1 Release 1 *
* @END_COPYRIGHT@ *
* ************************************************************* *
* *
* Product Number : 5695-137 *
* *
* Module Name : CSQ4CVD5 *
* *
* Environment : CICS/ESA Version 3.3; COBOL II *
* *
* Function : This program provides nickname creation *
* function for the mail manager sample. *
* See IBM MQSeries for MVS/ESA *
* Application Programming Reference, *
* for further details. *
* *
* Description : This program will allow the user to define*
* nicknames for users of the system *
* that are commonly contacted. This program *
* will put all requests on to the *
* SYSTEM.COMMAND.INPUT queue to be processed*
* by the command server. All replies will *
* be returned to a temporary dynamic queue *
* based on the model queue *
* SYSTEM.DEFAULT.MODEL.QUEUE. *
* *
* ************************************************************* *
* *
* Program Logic *
* ------------- *
* *
* Start (A-MAIN SECTION) *
* ----- *
* Display the create nickname panel (MAIL-VD5) *
* *
* Do while PF3 is not pressed *
* If help key (PF1) pressed *
* Display help screen until PF12 pressed *
* Else if PF4 pressed *
* Clear the entered data from the screen *
* Else if enter pressed *
* Perform VALIDATE-USER-ENTRY *
* If valid user entry *
* Perform CREATE-NICKNAME *
* End-if *
* End-if *
* Display the create nickname panel *
* End-do *
* *
* Return to CICS *
* *
* *
* VALIDATE-USER-ENTRY SECTION *
* --------------------------- *
* If no nickname has been entered *
* Build 'enter valid nickname' message *
* Else *
* Check that nickname entered starts in the first *
* position of the variable and contains no spaces *
* If check fails *
* Build 'enter valid nickname' message *
* Else *
* If no userid has been entered *
* Build 'Enter valid userid' message *
* Else *
* Check that userid entered starts in the first *
* position of the variable and contains no spaces*
* If check fails *
* Build 'enter valid userid' message *
* End-if *
* End-if *
* End-if *
* End-if *
* *
* Return to performing section *
* *
* *
* SET-UP-NICKNAME-FIELDS SECTION *
* ------------------------------ *
* Put the information from screen map variables *
* into the program variables to be used for nickname *
* checking and creation *
* *
* Return to performing section *
* *
* *
* CREATE-NICKNAME SECTION *
* ----------------------- *
* Perform SET-UP-NICKNAME-FIELDS *
* Perform CHECK-NICKNAME *
* Evaluate *
* When message not spaces *
* do nothing (because there is an error) *
* When user has not entered a queue manager name *
* Perform CREATE-ALIAS-QUEUE *
* Otherwise *
* If queue manager name is not local queue manager *
* Perform CREATE-REMOTE-QUEUE *
* Else *
* Perform CREATE-ALIAS-QUEUE *
* End-if *
* End-evaluate *
* *
* Return to performing section *
* *
* *
* CHECK-NICKNAME SECTION *
* ---------------------- *
* Set the variables for the open call *
* Open the nickname queue for inquire *
* If the call is successful *
* Build 'nickname already exists' message *
* Else *
* If reason for call failure is not unknown object name*
* Build error message *
* Else *
* Set message to spaces *
* End-if *
* End-if *
* *
* Return to performing section *
* *
* *
* CREATE-REMOTE-QUEUE SECTION *
* --------------------------- *
* Perform CREATE-TEMP-DYNAMIC-QUEUE *
* If the queue is not created successfully *
* Build an error message *
* Go to CREATE-REMOTE-QUEUE-EXIT *
* End-if *
* *
* Initialize the variables for the put1 call *
* Put the define queue message on the system command queue*
* If the put1 is not successful *
* Build an error message *
* Else *
* Perform GET-COMMAND-SERVER-RESP *
* End-if *
* *
* Perform CLOSE-TEMP-DYNAMIC-QUEUE *
* *
* CREATE-REMOTE-QUEUE-EXIT *
* *
* Return to performing section *
* *
* *
* CREATE-ALIAS-QUEUE SECTION *
* -------------------------- *
* Perform CREATE-TEMP-DYNAMIC-QUEUE *
* If the queue is not created successfully *
* Build an error message *
* Go to CREATE-ALIAS-QUEUE-EXIT *
* End-if *
* *
* Initialize the variables for the put1 call *
* Put the define queue message on the system command queue*
* If the put1 is not successful *
* Build an error message *
* Else *
* Perform GET-COMMAND-SERVER-RESP *
* End-if *
* *
* Perform CLOSE-TEMP-DYNAMIC-QUEUE *
* *
* CREATE-ALIAS-QUEUE-EXIT *
* *
* Return to performing section *
* *
* *
* CREATE-TEMP-DYNAMIC-QUEUE SECTION *
* --------------------------------- *
* Initialize the variables for the open call *
* Create the temporary dynamic queue by opening the model *
* queue *
* *
* Return to performing section *
* *
* *
* GET-COMMAND-SERVER-RESPONSE SECTION *
* ----------------------------------- *
* Initialize the variables for the get call *
* Do until expected response message received or get fails*
* Get the message *
* If compcode not ok *
* If not no message available *
* Build an error message *
* End-if *
* Else *
* If expected message received *
* If queue was created successfully *
* Set create-worked to Y *
* Else *
* Set create-worked to N *
* Perform GET-ERROR-DETAILS *
* End-if *
* End-if *
* End-if *
* End-do *
* *
* If create queue worked *
* Set 'nickname created' message *
* End-if *
* *
* Return to performing section *
* *
* *
* CLOSE-TEMP-DYNAMIC-QUEUE SECTION *
* -------------------------------- *
* Close the queue *
* *
* Return to performing section *
* *
* *
* GET-ERROR-DETAILS SECTION *
* ------------------------- *
* Initialize the variables for the get call *
* Get the next message from the temporary queue *
* Move the message received to the display message 2 line *
* *
* Initialize the variables for the get call *
* Get the next message from the temporary queue *
* Move the message received to the display message 3 line *
* *
* 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 *
* *
* *
* DISPLAY-MAPVD5 SECTION *
* ---------------------- *
* Exec CICS send create nickname screen map *
* Exec CICS receive create nickname screen map *
* *
* Return to performing section *
* *
* *
* ************************************************************* *
* ------------------------------------------------------------- *
ENVIRONMENT DIVISION.
* ------------------------------------------------------------- *
DATA DIVISION.
* ------------------------------------------------------------- *
WORKING-STORAGE SECTION.
* ------------------------------------------------------------- *
*
* W00 - General work fields
*
01 W00-NICKNAME PIC X(08) VALUE SPACES.
01 W00-USERQ PIC X(08) VALUE SPACES.
01 W00-VALIDATE PIC X(01) VALUE SPACES.
*
01 W00-QNAME PIC X(48) VALUE SPACES.
01 W00-Q-PREFIX PIC X(17) VALUE
'CSQ4SAMP.MAILMGR.'.
01 W00-SYSTEM-REPLY-MODEL PIC X(26) VALUE
'SYSTEM.DEFAULT.MODEL.QUEUE'.
01 W00-SYSTEM-COMMAND-QUEUE PIC X(20) VALUE
'SYSTEM.COMMAND.INPUT'.
01 W00-SYSTEM-REPLY-INITIAL PIC X(10) VALUE
'CSQ4SAMP.*'.
*
01 W00-GET-WAIT-30SECS PIC S9(09) BINARY VALUE 30000.
01 W00-GET-WAIT-2SECS PIC S9(09) BINARY VALUE 2000.
*
01 W00-DEFINE-ALIAS-COMMAND.
05 PIC X(14) VALUE
'DEFINE QALIAS('.
05 W00-ALIAS-QNAME PIC X(48).
05 PIC X(63) VALUE
') LIKE(CSQ4SAMP.MAILMGR.ALIAS.TEM
- 'PLATE) TARGQ(CSQ4SAMP.MAILMGR.'.
05 W00-TARGQ-QNAME PIC X(08) VALUE SPACES.
05 PIC X VALUE
')'.
01 W00-DEFINE-REMOTE-COMMAND.
05 PIC X(16) VALUE
'DEFINE QREMOTE('.
05 W00-LOCAL-QNAME PIC X(48).
05 PIC X(63) VALUE
') PUT(ENABLED) DEFPRTY(2) DEFPSIS
- 'T(YES) RNAME(CSQ4SAMP.MAILMGR.'.
05 W00-REMOTE-QNAME PIC X(08) VALUE SPACES.
05 PIC X(10) VALUE
') RQMNAME('.
05 W00-REMOTE-QMGR PIC X(48) VALUE SPACES.
05 PIC X(08) VALUE
') XMITQ('.
05 W00-XMIT-QNAME PIC X(48) VALUE SPACES.
05 PIC X VALUE
')'.
01 W00-DEFINE-ALIAS-LENGTH PIC S9(09) BINARY.
01 W00-DEFINE-REMOTE-LENGTH PIC S9(09) BINARY.
01 W00-REPLY-LENGTH PIC S9(09) BINARY VALUE 100.
01 W00-COMMAND-REPLY.
05 W00-REPLY-NUM PIC X(08).
05 PIC X(26).
05 W00-RETURN PIC X(08).
05 PIC X(09).
05 W00-REASON PIC X(08).
05 PIC X(41).
01 W00-CREATE-WORKED PIC X.
*
* W01 - API fields
*
01 W01-DATA-LENGTH PIC S9(9) BINARY.
01 W01-OPTIONS PIC S9(9) BINARY VALUE ZERO.
01 W01-HOBJ PIC S9(9) BINARY VALUE ZERO.
01 W01-COMPCODE PIC S9(9) BINARY VALUE ZERO.
01 W01-REASON PIC S9(9) BINARY VALUE ZERO.
*
* W02 - Screen map name definitions
*
01 W02-MAPSET-NAME PIC X(08) VALUE 'CSQ4VDM'.
01 W02-CSQ4VD5 PIC X(08) VALUE 'CSQ4VD5'.
01 W02-CSQ4VD6 PIC X(08) VALUE 'CSQ4VD6'.
*
* Fields used for communication between programs in mail
* manager sample
*
COPY CSQ4VD3.
*
* The following copy book contains messages that will be
* displayed to the user
*
COPY CSQ4VD0.
*
* Screen map definitions used by this sample program
*
COPY CSQ4VDM.
*
* DFHAID contains the constants used for checking for
* attention identifiers
*
COPY DFHAID SUPPRESS.
*
* API control blocks
*
01 MQM-OBJECT-DESCRIPTOR.
COPY CMQODV SUPPRESS.
01 MQM-MESSAGE-DESCRIPTOR.
COPY CMQMDV SUPPRESS.
01 MQM-PUT-MESSAGE-OPTIONS.
COPY CMQPMOV SUPPRESS.
01 MQM-GET-MESSAGE-OPTIONS.
COPY CMQGMOV SUPPRESS.
*
* Copy book of constants (for filling in the control blocks)
* and return codes (for testing the result of a call)
*
01 CMQV.
COPY CMQV SUPPRESS.
EJECT
* ------------------------------------------------------------- *
LINKAGE SECTION.
01 DFHCOMMAREA PIC X(200).
* ------------------------------------------------------------- *
EJECT
* ------------------------------------------------------------- *
PROCEDURE DIVISION.
* ------------------------------------------------------------- *
A-MAIN SECTION.
* ------------------------------------------------------------- *
* *
* This section displays the create nickname panel in a loop. *
* Once the user has entered data a check is made to validate *
* that the nickname does not already exist. If it does not exist*
* it will be created by sending a message to the system command *
* input queue. *
* *
* Errors are reported to the user. The program terminates when *
* the user presses PF3. *
* *
* ------------------------------------------------------------- *
*
* Get the commarea passed
*
IF EIBCALEN = 0 THEN
MOVE VD0-MESSAGE-27 TO VD3-MSG
GO TO A-MAIN-EXIT
END-IF.
MOVE DFHCOMMAREA TO VD3-MAIL-COMMAREA.
*
EXEC CICS IGNORE CONDITION
MAPFAIL
END-EXEC.
*
* Display first page of messages
*
MOVE LOW-VALUES TO CSQ4VD5O.
MOVE VD3-MSG TO VD5MSG1O.
MOVE VD3-USERID TO VD5IDO.
MOVE VD3-SUBSYS TO VD5QMO.
*
PERFORM DISPLAY-MAPVD5
*
* Loop from here to END-PERFORM until the PF3 key is pressed
*
PERFORM WITH TEST BEFORE UNTIL (EIBAID = DFHPF3 OR
EIBAID = DFHPF15)
MOVE SPACES TO VD5MSG1O
*
EVALUATE TRUE
WHEN EIBAID = DFHPF1 OR EIBAID = DFHPF13
PERFORM DISPLAY-HELP
*
WHEN EIBAID = DFHENTER
PERFORM VALIDATE-USER-ENTRY
IF VD5MSG1O = SPACES THEN
PERFORM CREATE-NICKNAME
END-IF
*
WHEN EIBAID = DFHPF3 OR EIBAID = DFHPF15
CONTINUE
*
WHEN EIBAID = DFHPF4 OR EIBAID = DFHPF16
MOVE LOW-VALUES TO CSQ4VD5O
*
END-EVALUATE
*
MOVE VD3-USERID TO VD5IDO
MOVE VD3-SUBSYS TO VD5QMO
PERFORM DISPLAY-MAPVD5
*
END-PERFORM.
*
A-MAIN-EXIT.
*
* Return to calling function
*
EXEC CICS RETURN
END-EXEC.
*
EJECT
*
* ------------------------------------------------------------- *
VALIDATE-USER-ENTRY SECTION.
* ------------------------------------------------------------- *
* *
* Validate that both alias and user mail queue names have *
* been entered. *
* *
* ------------------------------------------------------------- *
*
IF ((VD5ALASI = SPACES) OR (VD5ALASI = LOW-VALUES)) THEN
MOVE VD0-MESSAGE-10 TO VD5MSG1O
ELSE
MOVE SPACES TO W00-NICKNAME W00-VALIDATE
UNSTRING VD5ALASI DELIMITED BY ALL SPACE
INTO W00-NICKNAME W00-VALIDATE
IF ((W00-NICKNAME = SPACES) OR
(W00-VALIDATE NOT = SPACE))
MOVE VD0-MESSAGE-10 TO VD5MSG1O
ELSE
IF ((VD5USERI = SPACES) OR
(VD5USERI = LOW-VALUES)) THEN
MOVE VD0-MESSAGE-11 TO VD5MSG1O
ELSE
MOVE SPACES TO W00-USERQ W00-VALIDATE
UNSTRING VD5USERI DELIMITED BY ALL SPACE
INTO W00-USERQ W00-VALIDATE
IF ((W00-NICKNAME = SPACES) OR
(W00-VALIDATE NOT = SPACE))
MOVE VD0-MESSAGE-11 TO VD5MSG1O
END-IF
END-IF
END-IF
END-IF.
*
VALIDATE-USER-ENTRY-EXIT.
*
* Return to performing section
*
EXIT.
EJECT
*
* ------------------------------------------------------------- *
SET-UP-NICKNAME-FIELDS SECTION.
* ------------------------------------------------------------- *
* *
* This section puts the information from screen variables *
* into the program variables to be used for nickname *
* checking and creation. *
* *
* ------------------------------------------------------------ *
*
MOVE VD5USERI TO W00-TARGQ-QNAME
W00-REMOTE-QNAME.
MOVE VD5QMGRI TO W00-REMOTE-QMGR
W00-XMIT-QNAME.
*
MOVE SPACES TO W00-QNAME.
STRING W00-Q-PREFIX VD3-USERID '.' VD5ALASI
DELIMITED BY SPACES
INTO W00-QNAME.
*
MOVE W00-QNAME TO W00-ALIAS-QNAME
W00-LOCAL-QNAME.
*
*
SET-UP-NICKNAME-FIELDS-EXIT.
*
* Return to performing section
*
EXIT.
EJECT
*
* ------------------------------------------------------------- *
CREATE-NICKNAME SECTION.
* ------------------------------------------------------------- *
* *
* This section checks whether the nickname to be created *
* already exists, if it does the program returns to the *
* calling section. Otherwise a nickname will be created. *
* *
* If the target queue is on the local queue manager, an alias *
* queue is created by performing CREATE-ALIAS-QUEUE. If the *
* target queue is on another queue manager, a remote queue *
* is created by performing CREATE-REMOTE-QUEUE. *
* *
* Error messages are set by performed sections and displayed *
* by the performing section. *
* *
* ------------------------------------------------------------ *
*
PERFORM SET-UP-NICKNAME-FIELDS.
*
PERFORM CHECK-NICKNAME.
*
* Test for an error in CHECK-NICKNAME
* If an error has occurred - return to report it
* If no error has occurred - create the nickname
*
EVALUATE TRUE
WHEN VD5MSG1O NOT = SPACES
CONTINUE
*
WHEN VD5QMGRI = SPACES
WHEN VD5QMGRI = LOW-VALUES
PERFORM CREATE-ALIAS-QUEUE
*
WHEN OTHER
IF (VD5QMGRI NOT = VD3-SUBSYS)
PERFORM CREATE-REMOTE-QUEUE
ELSE
PERFORM CREATE-ALIAS-QUEUE
END-IF
*
END-EVALUATE.
*
CREATE-NICKNAME-EXIT.
*
EXIT.
EJECT
*
* ------------------------------------------------------------- *
CHECK-NICKNAME SECTION.
* ------------------------------------------------------------- *
* *
* This section checks whether a nickname exists by trying to *
* open the queue corresponding to the nickname for inquiry. *
* *
* If the open fails for unknown object name the nickname does *
* not exist (so no error message is set). If the open succeeds *
* or fails for any other reason an error message is set for *
* display to the user by the calling section. If the *
* queue was opened it is closed. *
* *
* ------------------------------------------------------------ *
*
* Set up the MQSeries API control blocks.
* Apart from the following values, all other values in the
* control blocks will be set to their default values
*
MOVE MQOT-Q TO MQOD-OBJECTTYPE.
MOVE W00-QNAME TO MQOD-OBJECTNAME.
*
* W01-OPTIONS is set to open the queue for INQUIRE
* NOTE: The open option is irrelevant to this
* program. The open is only used to
* validate if the nickname already
* exists
*
MOVE MQOO-INQUIRE TO W01-OPTIONS.
*
* Open the queue
*
CALL 'MQOPEN' USING VD3-HCONN
MQOD
W01-OPTIONS
W01-HOBJ
W01-COMPCODE
W01-REASON.
*
* Test the output of the open call.
*
* If the open succeeds, the queue already exists. Move an
* error message to the panel, close the queue.
*
* If the open fails and the reason is not UNKNOWN-OBJECT-NAME
* move an error message showing the completion and reason codes
* to the panel.
*
* If the open fails with UNKNOWN-OBJECT-NAME, set the message
* to blanks
*
IF W01-COMPCODE = MQCC-OK THEN
MOVE VD0-MESSAGE-12 TO VD5MSG1O
CALL 'MQCLOSE' USING VD3-HCONN
W01-HOBJ
MQCO-NONE
W01-COMPCODE
W01-REASON
ELSE
IF (W01-REASON NOT = MQRC-UNKNOWN-OBJECT-NAME) THEN
MOVE 'OPEN NICKQ' TO VD0-MSG1-TYPE
MOVE W01-COMPCODE TO VD0-MSG1-COMPCODE
MOVE W01-REASON TO VD0-MSG1-REASON
MOVE VD0-MESSAGE-1 TO VD5MSG1O
ELSE
MOVE SPACES TO VD5MSG1O
END-IF
END-IF.
*
CHECK-NICKNAME-EXIT.
*
* Return to performing section
*
EXIT.
EJECT
*
* ------------------------------------------------------------- *
CREATE-REMOTE-QUEUE SECTION.
* ------------------------------------------------------------- *
* *
* This section creates a remote queue by sending a command to *
* the queue manager system command input queue. A temporary *
* dynamic queue is created to receive the command server *
* responses and these responses are checked to determine if *
* the queue has been successfully created. *
* Status and error messages are prepared for display by the *
* calling section. *
* *
* ------------------------------------------------------------ *
*
PERFORM CREATE-TEMP-DYNAMIC-QUEUE.
*
* Test the output of the open call. If the call failed,
* build an error message showing the completion code and
* reason, and return to the performing section to allow
* it to be displayed
*
IF (W01-COMPCODE NOT = MQCC-OK) THEN
MOVE 'OPEN TEMPDQ-R' TO VD0-MSG1-TYPE
MOVE W01-COMPCODE TO VD0-MSG1-COMPCODE
MOVE W01-REASON TO VD0-MSG1-REASON
MOVE VD0-MESSAGE-1 TO VD5MSG1O
GO TO CREATE-REMOTE-QUEUE-EXIT
END-IF.
*
* Save the queue name and also place it in the REPLYTOQ field.
* Use the REQUEST message type to ensure that the Command
* Server sends back all reply messages. The define remote queue
* message is then written to the SYSTEM-COMMAND-INPUT queue to
* be processed
*
MOVE MQOD-OBJECTNAME TO MQMD-REPLYTOQ.
MOVE MQMT-REQUEST TO MQMD-MSGTYPE.
MOVE MQPER-NOT-PERSISTENT TO MQMD-PERSISTENCE.
MOVE MQOT-Q TO MQOD-OBJECTTYPE.
MOVE W00-SYSTEM-COMMAND-QUEUE TO MQOD-OBJECTNAME.
MOVE MQPMO-NO-SYNCPOINT TO MQPMO-OPTIONS.
*
MOVE LENGTH OF W00-DEFINE-REMOTE-COMMAND
TO W00-DEFINE-REMOTE-LENGTH.
*
* Put the define remote command
*
CALL 'MQPUT1' USING VD3-HCONN
MQOD
MQMD
MQPMO
W00-DEFINE-REMOTE-LENGTH
W00-DEFINE-REMOTE-COMMAND
W01-COMPCODE
W01-REASON.
*
* If the compcode is not ok after the put1 request
* display an error message and return
*
IF (W01-COMPCODE NOT = MQCC-OK) THEN
MOVE 'MQPUT1-R ' TO VD0-MSG1-TYPE
MOVE W01-COMPCODE TO VD0-MSG1-COMPCODE
MOVE W01-REASON TO VD0-MSG1-REASON
MOVE VD0-MESSAGE-1 TO VD5MSG1O
ELSE
PERFORM GET-COMMAND-SERVER-RESP
*
* The response messages are set in the function, no
* testing is done after return
*
END-IF.
*
PERFORM CLOSE-TEMP-DYNAMIC-QUEUE.
*
CREATE-REMOTE-QUEUE-EXIT.
*
* Return to performing section
*
EXIT.
EJECT
*
* ------------------------------------------------------------- *
CREATE-ALIAS-QUEUE SECTION.
* ------------------------------------------------------------- *
* *
* This section creates an alias queue by sending a command to *
* the queue manager system command input queue. A temporary *
* dynamic queue is created to receive the command server *
* responses and these responses are checked to determine if *
* the queue has been successfully created. *
* Status and error messages are prepared for display by the *
* performing section. *
* *
* ------------------------------------------------------------ *
*
PERFORM CREATE-TEMP-DYNAMIC-QUEUE.
*
* Test the output of the open call. If the call failed,
* build an error message showing the completion code and
* reason, and return to the performing section to allow
* it to be displayed
*
IF (W01-COMPCODE NOT = MQCC-OK) THEN
MOVE 'OPEN TEMPDQ-A' TO VD0-MSG1-TYPE
MOVE W01-COMPCODE TO VD0-MSG1-COMPCODE
MOVE W01-REASON TO VD0-MSG1-REASON
MOVE VD0-MESSAGE-1 TO VD5MSG1O
GO TO CREATE-ALIAS-QUEUE-EXIT
END-IF.
*
* Save the queue name and also place it in the REPLYTOQ field.
* Use the REQUEST message type to ensure that the Command
* Server sends back all reply messages. The define alias queue
* message is then written to the SYSTEM-COMMAND-INPUT queue to
* be processed.
*
MOVE MQOD-OBJECTNAME TO MQMD-REPLYTOQ.
MOVE MQMT-REQUEST TO MQMD-MSGTYPE.
MOVE MQPER-NOT-PERSISTENT TO MQMD-PERSISTENCE.
MOVE MQOT-Q TO MQOD-OBJECTTYPE.
MOVE W00-SYSTEM-COMMAND-QUEUE TO MQOD-OBJECTNAME.
MOVE MQPMO-NO-SYNCPOINT TO MQPMO-OPTIONS.
*
MOVE LENGTH OF W00-DEFINE-ALIAS-COMMAND
TO W00-DEFINE-ALIAS-LENGTH.
*
* Put the define alias command
*
CALL 'MQPUT1' USING VD3-HCONN
MQOD
MQMD
MQPMO
W00-DEFINE-ALIAS-LENGTH
W00-DEFINE-ALIAS-COMMAND
W01-COMPCODE
W01-REASON.
*
* If the compcode is not ok after the put1 request
* display an error message and return.
*
IF (W01-COMPCODE NOT = MQCC-OK) THEN
MOVE 'MQPUT1-A ' TO VD0-MSG1-TYPE
MOVE W01-COMPCODE TO VD0-MSG1-COMPCODE
MOVE W01-REASON TO VD0-MSG1-REASON
MOVE VD0-MESSAGE-1 TO VD5MSG1O
ELSE
PERFORM GET-COMMAND-SERVER-RESP
*
* The response messages are set in the function, no
* testing is done after return
*
END-IF.
*
* Return to performing section
*
CREATE-ALIAS-QUEUE-EXIT.
*
* Return to performing section
*
EXIT.
EJECT
*
* ------------------------------------------------------------- *
CREATE-TEMP-DYNAMIC-QUEUE SECTION.
* ------------------------------------------------------------- *
* This section creates a temporary dynamic queue using a *
* model queue. *
* *
* ------------------------------------------------------------ *
*
* Initialize the Object Descriptor (MQOD) control block.
* (The remaining fields are already initialized)
*
* OBJECTNAME - Contains the name of the model queue that is
* to be used to create the Temporary Dynamic
* queue name.
* DYNAMICQNAME - Contains the characters that the queue name
* is to begin with.
*
MOVE MQOT-Q TO MQOD-OBJECTTYPE.
MOVE W00-SYSTEM-REPLY-MODEL TO MQOD-OBJECTNAME.
MOVE W00-SYSTEM-REPLY-INITIAL TO MQOD-DYNAMICQNAME.
MOVE ZERO TO W01-HOBJ.
MOVE MQOO-INPUT-AS-Q-DEF TO W01-OPTIONS.
*
* Open the queue and, therefore, create the queue
*
CALL 'MQOPEN' USING VD3-HCONN
MQOD
W01-OPTIONS
W01-HOBJ
W01-COMPCODE
W01-REASON.
*
CREATE-TEMP-DYNAMIC-QUEUE-EXIT.
*
* Return to performing section
*
EXIT.
*
* ------------------------------------------------------------- *
GET-COMMAND-SERVER-RESP SECTION.
* ------------------------------------------------------------- *
* *
* This section gets the command server responses in a loop *
* until the right message (CSQN205I) arrives or an error *
* occurs. *
* When the message is received it is checked to see if the *
* queue creation was successful - if it was an appropriate *
* message is prepared for display by the calling section, *
* otherwise GET-ERROR-DETAILS is called to get the reasons *
* for the error. *
* If any errors occur, appropriate messages are prepared for *
* display by the calling section. *
* *
* ------------------------------------------------------------ *
*
* Set up the options for the get-wait call
*
MOVE MQGMO-ACCEPT-TRUNCATED-MSG TO MQGMO-OPTIONS.
ADD MQGMO-WAIT TO MQGMO-OPTIONS.
ADD MQGMO-NO-SYNCPOINT TO MQGMO-OPTIONS.
MOVE W00-GET-WAIT-30SECS TO MQGMO-WAITINTERVAL.
*
* Loop around until an error occurs or until the right
* message arrives
*
MOVE SPACES TO W00-CREATE-WORKED
PERFORM WITH TEST AFTER UNTIL ((W01-COMPCODE NOT = MQCC-OK)
OR (W00-CREATE-WORKED NOT = SPACES))
*
MOVE MQMI-NONE TO MQMD-MSGID
MOVE MQMI-NONE TO MQMD-CORRELID
MOVE SPACES TO W00-COMMAND-REPLY
*
CALL 'MQGET' USING VD3-HCONN
W01-HOBJ
MQMD
MQGMO
W00-REPLY-LENGTH
W00-COMMAND-REPLY
W01-DATA-LENGTH
W01-COMPCODE
W01-REASON
*
* If the compcode is not ok after the get, and the reason
* is not NO-MSG-AVAILABLE, build an error message.
* If the reason is NO-MSG-AVAILABLE exit the loop.
* Otherwise each message is checked to locate the command
* server reply (CSQN205I). When this is located the return
* code is checked. Depending on the return code received
* the create worked flag is set. If the create failed,
* the error details are retrieved and built for display
*
IF (W01-COMPCODE NOT = MQCC-OK) THEN
IF (W01-REASON NOT = MQRC-NO-MSG-AVAILABLE) THEN
MOVE 'MQGET ' TO VD0-MSG1-TYPE
MOVE W01-COMPCODE TO VD0-MSG1-COMPCODE
MOVE W01-REASON TO VD0-MSG1-REASON
MOVE VD0-MESSAGE-1 TO VD5MSG1O
MOVE 'N' TO W00-CREATE-WORKED
END-IF
ELSE
IF W00-REPLY-NUM = 'CSQN205I' THEN
* Validate the response from the create queue section.
* Move either a 'success' or 'fail' message to the
* panel dependant on W00-CREATE-WORKED
*
IF W00-RETURN = '00000000' THEN
MOVE 'Y' TO W00-CREATE-WORKED
MOVE VD0-MESSAGE-14 TO VD5MSG1O
ELSE
MOVE 'N' TO W00-CREATE-WORKED
MOVE VD0-MESSAGE-13 TO VD5MSG0O
*
* The next two messages should contain
* details of the failure. GET-ERROR-DETAILS
* puts them in the screen message fields
*
PERFORM GET-ERROR-DETAILS
*
END-IF
END-IF
END-IF
*
END-PERFORM.
*
IF W00-CREATE-WORKED = SPACES THEN
MOVE VD0-MESSAGE-26 TO VD5MSG1O
END-IF.
*
GET-COMMAND-SERVER-RESP-EXIT.
*
* Return to performing section
*
EXIT.
*
* ------------------------------------------------------------- *
CLOSE-TEMP-DYNAMIC-QUEUE SECTION.
* ------------------------------------------------------------- *
* *
* This section closes, and thus deletes, the temporary *
* dynamic queue. *
* *
* ------------------------------------------------------------ *
*
*
* Close the reply queue and purge it
*
CALL 'MQCLOSE' USING VD3-HCONN
W01-HOBJ
MQCO-NONE
W01-COMPCODE
W01-REASON.
*
CLOSE-TEMP-DYNAMIC-QUEUE-EXIT.
*
*
* Return to performing section
*
EXIT.
*
* ------------------------------------------------------------- *
GET-ERROR-DETAILS SECTION.
* ------------------------------------------------------------- *
* *
* This section get two messages from the queue and puts the *
* message data into message fields for display by the calling *
* section. If errors occur in getting these messages, no *
* additional data will be available to the user. No error *
* checking is done on the calls. *
* *
* ------------------------------------------------------------ *
*
* Get the next message on the queue which should
* contain a displayable message of what went wrong
*
MOVE W00-GET-WAIT-2SECS TO MQGMO-WAITINTERVAL.
MOVE MQMI-NONE TO MQMD-MSGID.
MOVE MQMI-NONE TO MQMD-CORRELID.
MOVE SPACES TO W00-COMMAND-REPLY.
*
CALL 'MQGET' USING VD3-HCONN
W01-HOBJ
MQMD
MQGMO
W00-REPLY-LENGTH
W00-COMMAND-REPLY
W01-DATA-LENGTH
W01-COMPCODE
W01-REASON.
*
MOVE W00-COMMAND-REPLY TO VD5MSG1O.
*
* Get the next message on the queue which should
* contain another displayable message of what went wrong
*
MOVE MQMI-NONE TO MQMD-MSGID.
MOVE MQMI-NONE TO MQMD-CORRELID.
MOVE SPACES TO W00-COMMAND-REPLY.
*
CALL 'MQGET' USING VD3-HCONN
W01-HOBJ
MQMD
MQGMO
W00-REPLY-LENGTH
W00-COMMAND-REPLY
W01-DATA-LENGTH
W01-COMPCODE
W01-REASON.
*
MOVE W00-COMMAND-REPLY TO VD5MSG2O.
*
*
GET-ERROR-DETAILS-EXIT.
*
*
* Return to performing section
*
EXIT.
*
* ------------------------------------------------------------- *
DISPLAY-HELP SECTION.
* ------------------------------------------------------------- *
* *
* This section displays the help panel until PF12 is pressed *
* *
* ------------------------------------------------------------ *
*
PERFORM WITH TEST BEFORE UNTIL EIBAID = DFHPF12
OR EIBAID = DFHPF24
*
EXEC CICS SEND
MAP(W02-CSQ4VD6)
MAPSET(W02-MAPSET-NAME)
FROM(CSQ4VD6O)
ERASE
END-EXEC
*
EXEC CICS RECEIVE
MAP(W02-CSQ4VD6)
MAPSET(W02-MAPSET-NAME)
INTO(CSQ4VD6I)
END-EXEC
*
END-PERFORM.
*
DISPLAY-HELP-EXIT.
*
* Return to performing section
*
EXIT.
EJECT
*
* ------------------------------------------------------------- *
DISPLAY-MAPVD5 SECTION.
* ------------------------------------------------------------- *
* *
* This section sends the create nickname screen (MAIL-VD5) *
* to the terminal and returns once the receive is complete *
* *
* ------------------------------------------------------------ *
*
EXEC CICS SEND
MAP(W02-CSQ4VD5)
MAPSET(W02-MAPSET-NAME)
FROM(CSQ4VD5O)
ERASE
END-EXEC.
*
EXEC CICS RECEIVE
MAP(W02-CSQ4VD5)
MAPSET(W02-MAPSET-NAME)
INTO(CSQ4VD5O)
END-EXEC.
*
DISPLAY-MAPVD5-EXIT.
*
* Return to performing section
*
EXIT.
*
* ---------------------------------------------------------------
* End of program
* ---------------------------------------------------------------
¤ Dauer der Verarbeitung: 0.137 Sekunden
(vorverarbeitet)
¤
|
schauen Sie vor die Tür
Fenster
Die Firma ist wie angegeben erreichbar.
Die farbliche Syntaxdarstellung ist noch experimentell.
|
