|
CBL NODYNAM,LIB,OBJECT,RENT,RES,APOST
* ------------------------------------------------------------- *
IDENTIFICATION DIVISION.
* ------------------------------------------------------------- *
PROGRAM-ID. CSQ4TVD1.
*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 : CSQ4TVD1 *
* *
* Environment : MVS TSO/ISPF; COBOL II *
* *
* Function : This program provides initiation and *
* option menu for the mail manager sample. *
* See IBM MQSeries for MVS/ESA *
* Application Programming Reference, *
* for further details. *
* *
* Description : This program opens a users mail queue, *
* (creating it if it does not exist) *
* It then displays panel CSQ4VDP1 and *
* initiates the other programs in suite to *
* perform the user selected function. *
* *
* ************************************************************* *
* *
* Program Logic *
* ------------- *
* *
* Start (A-MAIN SECTION) *
* ----- *
* Define required variables to ISPF *
* Connect to the queue manager *
* If connect not successful *
* Build error message and exit *
* End-if *
* Perform GET-QMGR-NAME *
* If the queue manager name cannot be obtained *
* Build error message and exit *
* End-if *
* Perform OPEN-USERS-MAIL-QUEUE *
* If open not successful *
* Build error message and exit *
* End-if *
* Perform FIND-MAIL-QUEUE-DEPTH *
* Perform PUT-TO-SHARED-POOL *
* *
* Display the main menu panel (CSQ4VDP1) *
* Do while return code from ISPF is zero *
* Evaluate user request *
* When '1' Perform FIND-MAIL-QUEUE-DEPTH *
* If messages available *
* Perform READ-MAIL *
* Else *
* Build message *
* End-if *
* When '2' Perform SEND-MAIL *
* When '3' Perform CREATE-NICKNAME *
* Otherwise build error message *
* End-evaluate *
* Perform FIND-MAIL-QUEUE-DEPTH *
* Display the main menu panel *
* End-do *
* *
* If return code does not indicate PF3 pressed *
* Build an error message *
* End-if *
* Close the users mail queue *
* If close not successful *
* Build error message *
* End-if *
* Disconnect from the queue manager *
* If unsuccessful *
* Build error message *
* End-if *
* If there is an error message to display *
* Display it using ISPF SETMSG *
* End-if *
* *
* Return to ISPF *
* *
* *
* GET-QMGR-NAME SECTION *
* --------------------- *
* Initialize the variables for the open call *
* Open the queue manager for inquiry *
* If open not successful *
* Build an error message *
* Else *
* Initialize the variables for the inquire call *
* If inquire not successful *
* Build an error message *
* Else *
* Save the queue manager name *
* End-if *
* Close the queue manager *
* End-if *
* *
* Return to performing section *
* *
* *
* OPEN-USERS-MAIL-QUEUE SECTION *
* ----------------------------- *
* Initialize the variables for the open call *
* Open the users mail queue *
* If open not successful *
* If the queue does not exist *
* Perform CREATE-MAIL-QUEUE *
* Set number of messages to zero *
* If create queue was unsuccessful *
* Build an error message *
* End-if *
* Else *
* Build an error message *
* End-if *
* End-if *
* *
* Return to performing section *
* *
* *
* CREATE-MAIL-QUEUE SECTION *
* ------------------------- *
* Initialize the variables for the open call *
* Open the temporary queue *
* If open not successful *
* Build error message *
* Go to CREATE-MAIL-QUEUE-EXIT *
* End-if *
* *
* Initialize the variables for the put1 call *
* Put1 the define queue message *
* If put1 not successful *
* Build error message *
* Go to CREATE-MAIL-QUEUE-TEMPQ-CLOSE *
* End-if *
* *
* Initialize the variables for the get call *
* Do until expected response message received or get fails*
* Get the message *
* If compcode ok *
* If expected message received *
* If queue was created successfully *
* Set create-worked to Y *
* Else *
* Set create-worked to N *
* End-if *
* End-if *
* Else *
* If no message available *
* Set 'unable to create mail queue' message *
* Else *
* Build error message *
* End-if *
* End-if *
* End-do *
* *
* CREATE-MAIL-QUEUE-TEMPQ-CLOSE *
* Close the temporary queue *
* *
* If create-worked = Y *
* Initialize the variables for the open call *
* Open the users mail queue *
* If the open is not successful *
* Build an error message *
* End-if *
* End-if *
* *
* CREATE-MAIL-QUEUE-EXIT *
* Return to performing section *
* *
* *
* FIND-MAIL-QUEUE-DEPTH SECTION *
* ----------------------------- *
* Initialize the variables for the inquire call *
* Inquire on the users mail queue depth *
* If inquire not successful *
* Build an error message *
* Set number of messages to zero *
* Else *
* Set number of messages to queue depth *
* End-if *
* *
* Return to performing section *
* *
* *
* PUT-TO-SHARED-POOL SECTION *
* -------------------------- *
* Copy the ISPF variables required for display and *
* the other programs to the shared pool *
* *
* Return to performing section *
* *
* *
* READ-MAIL SECTION *
* ----------------- *
* Call ISPLINK to initiate the receive mail program *
* *
* Return to performing section *
* *
* *
* SEND-MAIL SECTION *
* ----------------- *
* Call ISPLINK to initiate the send mail program *
* *
* Return to performing section *
* *
* *
* CREATE-NICKNAME SECTION *
* ----------------------- *
* Call ISPLINK to initiate the create nickname program *
* *
* Return to performing section *
* *
* *
* ************************************************************* *
* ------------------------------------------------------------- *
ENVIRONMENT DIVISION.
* ------------------------------------------------------------- *
* ------------------------------------------------------------- *
DATA DIVISION.
* ------------------------------------------------------------- *
* ------------------------------------------------------------- *
WORKING-STORAGE SECTION.
* ------------------------------------------------------------- *
*
* W00 - General work fields
*
01 W00-GET-WAIT-30SECS PIC S9(09) BINARY VALUE 30000.
01 W00-DATA-LENGTH PIC S9(09) BINARY.
01 W00-MESSAGE-DATA PIC X(80) VALUE SPACES.
01 W00-CREATE-WORKED PIC X.
*
* W01 - Queue name fields
*
01 W01-REPLY-QNAME PIC X(48) VALUE SPACES.
01 W01-SYSTEM-REPLY-MODEL PIC X(26) VALUE
'SYSTEM.DEFAULT.MODEL.QUEUE'.
01 W01-SYSTEM-COMMAND-QUEUE PIC X(20) VALUE
'SYSTEM.COMMAND.INPUT'.
01 W01-SYSTEM-REPLY-INITIAL PIC X(10) VALUE
'CSQ4SAMP.*'.
*
* W02 - Command server query and response fields
*
01 W02-DEFINE-COMMAND.
05 PIC X(14) VALUE
'DEFINE QLOCAL('.
05 MAILQ.
10 PIC X(17) VALUE
'CSQ4SAMP.MAILMGR.'.
10 MAILQ-USER PIC X(08) VALUE SPACES.
10 PIC X(23) VALUE SPACES.
05 PIC X(39) VALUE
') LIKE(CSQ4SAMP.MAILMGR.QUEUE.TEMPLATE)'.
01 W02-DEFINE-LENGTH PIC S9(09) BINARY.
*
01 W02-COMMAND-REPLY.
05 W02-REPLY-NUM PIC X(08).
05 PIC X(26).
05 W02-RETURN-NUM PIC X(08).
05 PIC X(09).
05 W02-REASON-NUM PIC X(08).
05 PIC X(41).
01 W02-REPLY-LENGTH PIC S9(09) BINARY.
*
* W03 - MQM API fields
*
01 W03-OPTIONS PIC S9(09) BINARY.
01 W03-SELECTORCOUNT PIC S9(09) BINARY VALUE 1.
01 W03-INTATTRCOUNT PIC S9(09) BINARY.
01 W03-CHARATTRLENGTH PIC S9(09) BINARY.
01 W03-CHARATTRS PIC X(48) VALUE LOW-VALUES.
01 W03-SELECTORS-TABLE.
05 W03-SELECTORS PIC S9(09) BINARY.
01 W03-INTATTRS-TABLE.
05 W03-INTATTRS PIC S9(09) BINARY.
*
* The following copy book contains messages that will be
* displayed to the user
*
COPY CSQ4VD0.
*
* ISPF definitions used in this program
*
COPY CSQ4VD1.
*
01 W04-CSQ4TVD2 PIC X(13) VALUE
'PGM(CSQ4TVD2)'.
01 W04-CSQ4TVD4 PIC X(13) VALUE
'PGM(CSQ4TVD4)'.
01 W04-CSQ4TVD5 PIC X(13) VALUE
'PGM(CSQ4TVD5)'.
01 W04-PANEL1 PIC X(15) VALUE 'CSQ4VDP1'.
*
* ISPF variable definitions used in this program
*
COPY CSQ4VD2.
*
01 NUMMSG PIC ZZZ9 VALUE ZERO.
01 N PIC X VALUE ZERO.
*
* API control blocks
*
01 MQM-OBJECT-DESCRIPTOR.
COPY CMQODV.
01 MQM-MESSAGE-DESCRIPTOR.
COPY CMQMDV.
01 MQM-GET-MESSAGE-OPTIONS.
COPY CMQGMOV.
01 MQM-PUT-MESSAGE-OPTIONS.
COPY CMQPMOV.
*
* 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
* ------------------------------------------------------------- *
PROCEDURE DIVISION.
* ------------------------------------------------------------- *
A-MAIN SECTION.
* ------------------------------------------------------------- *
* *
* This section receives the queue manager and userid. *
* *
* The section then displays the mail manager main menu screen *
* in a loop and calls other programs to process the options *
* entered by the user. The number of messages in the mail *
* queue is updated within the loop. *
* *
* After exit from the loop the users mail queue is closed and *
* control returned to the calling CLIST. *
* *
* ------------------------------------------------------------ *
*
*
* Define the variables to ISPF
* - this also copies current values into the program of
* those variables already known to ISPF
*
CALL 'ISPLINK' USING VD1-VDEFINE VD1-HCONN HCONN
VD1-CHAR VD1-LENGTH4 .
CALL 'ISPLINK' USING VD1-VDEFINE VD1-HOBJ HOBJ
VD1-CHAR VD1-LENGTH4 .
CALL 'ISPLINK' USING VD1-VDEFINE VD1-MSG MSG
VD1-CHAR VD1-LENGTH60 .
CALL 'ISPLINK' USING VD1-VDEFINE VD1-N N
VD1-CHAR VD1-LENGTH .
CALL 'ISPLINK' USING VD1-VDEFINE VD1-NUMMSG NUMMSG
VD1-CHAR VD1-LENGTH4 .
*
CALL 'ISPLINK' USING VD1-VDEFINE VD1-USERID USERID
VD1-CHAR VD1-LENGTH8 VD1-COPY .
CALL 'ISPLINK' USING VD1-VDEFINE VD1-SUBSYS SUBSYS
VD1-CHAR VD1-LENGTH48 VD1-COPY .
*
* Initialize variables
*
MOVE LENGTH OF W02-DEFINE-COMMAND TO W02-DEFINE-LENGTH.
MOVE LENGTH OF W02-COMMAND-REPLY TO W02-REPLY-LENGTH.
MOVE ZERO TO HCONN.
MOVE USERID TO MAILQ-USER.
*
* If the user has not tailored the JCL - use the default
*
IF SUBSYS = 'QMGR' THEN
MOVE SPACES TO SUBSYS
END-IF.
*
* Connect to the queue manager
*
CALL 'MQCONN' USING SUBSYS
HCONN
COMPCODE
REASON.
*
* Test the output of the connect call. If the call failed,
* set up an error message showing the completion code and
* reason code and exit
*
IF (COMPCODE NOT = MQCC-OK) THEN
MOVE 'MQCONN' TO VD0-MSG1-TYPE
MOVE COMPCODE TO VD0-MSG1-COMPCODE
MOVE REASON TO VD0-MSG1-REASON
MOVE VD0-MESSAGE-1 TO MSG
GO TO A-MAIN-EXIT
END-IF.
*
PERFORM GET-QMGR-NAME.
*
* If the queue manager name could not be read, exit
* displaying the message set by GET-QMGR-NAME
*
IF (MSG NOT = SPACES) THEN
GO TO A-MAIN-DISCONNECT
END-IF.
*
* Open the users mail queue
*
PERFORM OPEN-USERS-MAIL-QUEUE.
*
* If the open was unsuccessful, exit
* displaying the message set by OPEN-USERS-MAIL-QUEUE
*
IF (MSG NOT = SPACES) THEN
GO TO A-MAIN-DISCONNECT
END-IF.
*
PERFORM FIND-MAIL-QUEUE-DEPTH.
*
PERFORM PUT-TO-SHARED-POOL.
*
* Update the relevant screen fields. If an error occurred
* it is recorded in MSG
*
MOVE SPACE TO N.
*
CALL 'ISPLINK' USING VD1-DISPLAY W04-PANEL1.
*
* Loop from here to END-PERFORM until the PF3 key is pressed
* or until an ISPF error occurs
*
PERFORM WITH TEST BEFORE UNTIL RETURN-CODE NOT = ZERO
*
MOVE SPACES TO MSG
*
* Process depending on the action entered by the user
*
EVALUATE TRUE
WHEN N = '1'
PERFORM FIND-MAIL-QUEUE-DEPTH
IF NUMMSG NOT = ' 0' THEN
PERFORM READ-MAIL
ELSE
MOVE VD0-MESSAGE-17 TO MSG
END-IF
WHEN N = '2'
PERFORM SEND-MAIL
WHEN N = '3'
PERFORM CREATE-NICKNAME
WHEN OTHER
MOVE VD0-MESSAGE-18 TO MSG
END-EVALUATE
*
PERFORM FIND-MAIL-QUEUE-DEPTH
*
CALL 'ISPLINK' USING VD1-DISPLAY W04-PANEL1
*
END-PERFORM.
*
* Check the return code after the loop ends, if it does
* not correspond to PF3 having been pressed, build an
* error message
*
IF RETURN-CODE NOT = 8 THEN
MOVE VD1-DISPLAY TO VD0-MSG16-CALL
MOVE RETURN-CODE TO VD0-MSG16-RETURN
MOVE VD0-MESSAGE-16 TO MSG
CALL 'ISPLINK' USING VD1-VPUT VD1-MSG
CALL 'ISPLINK' USING VD1-SETMSG VD1-MSGFILE-1
MOVE SPACES TO MSG
END-IF.
*
* Close the queue.
*
MOVE MQCO-NONE TO W03-OPTIONS.
*
CALL 'MQCLOSE' USING HCONN
HOBJ
W03-OPTIONS
COMPCODE
REASON.
*
* Test the output of the close call. If the call failed,
* build an error message showing the completion code and
* reason
*
IF (COMPCODE = MQCC-FAILED) THEN
MOVE 'MQCLOSE' TO VD0-MSG1-TYPE
MOVE COMPCODE TO VD0-MSG1-COMPCODE
MOVE REASON TO VD0-MSG1-REASON
MOVE VD0-MESSAGE-1 TO MSG
END-IF.
*
A-MAIN-DISCONNECT.
*
* Disconnect from the queue manager.
*
CALL 'MQDISC' USING HCONN
COMPCODE
REASON.
*
* Test the output of the disconnect call. If the call failed,
* build an error message showing the completion code and
* reason
*
IF (COMPCODE = MQCC-FAILED) THEN
MOVE 'MQDISC' TO VD0-MSG1-TYPE
MOVE COMPCODE TO VD0-MSG1-COMPCODE
MOVE REASON TO VD0-MSG1-REASON
MOVE VD0-MESSAGE-1 TO MSG
END-IF.
*
*
A-MAIN-EXIT.
*
* If there is an error message display it to the user
*
IF MSG NOT = SPACES THEN
CALL 'ISPLINK' USING VD1-VPUT VD1-MSG
CALL 'ISPLINK' USING VD1-SETMSG VD1-MSGFILE-1
END-IF.
*
* Return to ISPF
*
STOP RUN.
EJECT
*
* ------------------------------------------------------------- *
GET-QMGR-NAME SECTION.
* ------------------------------------------------------------- *
* *
* This section gets the name of the queue manager the *
* system is attached to. *
* *
* ------------------------------------------------------------ *
*
* Initialize the Object Descriptor (MQOD) control block.
* (The copy book initializes remaining fields)
*
MOVE MQOT-Q-MGR TO MQOD-OBJECTTYPE.
MOVE SPACES TO MQOD-OBJECTNAME.
MOVE SPACES TO MQOD-DYNAMICQNAME.
MOVE ZERO TO HOBJ.
*
MOVE MQOO-INQUIRE TO W03-OPTIONS.
*
* Open the queue manager
*
CALL 'MQOPEN' USING HCONN
MQOD
W03-OPTIONS
HOBJ
COMPCODE
REASON.
*
* Test the output of the open call. If the call failed, build
* an error message showing the completion code and reason code
*
IF (COMPCODE NOT = MQCC-OK) THEN
MOVE 'OPEN QMGR' TO VD0-MSG1-TYPE
MOVE COMPCODE TO VD0-MSG1-COMPCODE
MOVE REASON TO VD0-MSG1-REASON
MOVE VD0-MESSAGE-1 TO MSG
GO TO GET-QMGR-NAME-EXIT
END-IF.
*
* Set selectors to inquire on queue manager name
*
MOVE MQCA-Q-MGR-NAME TO W03-SELECTORS.
MOVE ZERO TO W03-INTATTRCOUNT.
MOVE MQ-Q-MGR-NAME-LENGTH TO W03-CHARATTRLENGTH.
*
* Inquire on the attributes
*
CALL 'MQINQ' USING HCONN
HOBJ
W03-SELECTORCOUNT
W03-SELECTORS
W03-INTATTRCOUNT
W03-INTATTRS
W03-CHARATTRLENGTH
W03-CHARATTRS
COMPCODE
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, store the queue manager name
*
IF COMPCODE NOT = MQCC-OK
MOVE 'MQINQ QMGR' TO VD0-MSG1-TYPE
MOVE COMPCODE TO VD0-MSG1-COMPCODE
MOVE REASON TO VD0-MSG1-REASON
MOVE VD0-MESSAGE-1 TO MSG
MOVE SPACES TO SUBSYS
ELSE
MOVE SPACES TO MSG
MOVE W03-CHARATTRS TO SUBSYS
END-IF.
*
CALL 'MQCLOSE' USING HCONN
HOBJ
MQCO-NONE
COMPCODE
REASON.
*
GET-QMGR-NAME-EXIT.
*
* Return to performing section
*
EXIT.
EJECT
*
* ------------------------------------------------------------- *
OPEN-USERS-MAIL-QUEUE SECTION.
* ------------------------------------------------------------- *
* *
* This section opens the user's mail queue - if this queue *
* does not exist the section calls CREATE-MAIL-QUEUE to *
* create the queue. *
* If the open fails a message is built indicating the reason. *
* *
* ------------------------------------------------------------ *
*
MOVE SPACES TO MSG
*
* Initialize the Object Descriptor (MQOD) control block.
* (The remaining fields are already initialized)
*
MOVE MQOT-Q TO MQOD-OBJECTTYPE.
MOVE MAILQ TO MQOD-OBJECTNAME.
*
MOVE MQOO-INQUIRE TO W03-OPTIONS.
ADD MQOO-BROWSE TO W03-OPTIONS.
ADD MQOO-INPUT-SHARED TO W03-OPTIONS.
ADD MQOO-OUTPUT TO W03-OPTIONS.
MOVE ZERO TO HOBJ.
*
* Open the mail queue
*
CALL 'MQOPEN' USING HCONN
MQOD
W03-OPTIONS
HOBJ
COMPCODE
REASON.
*
* Test the output of the open call.
* If the call failed for unknown object name - create
* the queue
* Else build an error message showing the completion
* code and reason
*
IF (COMPCODE NOT = MQCC-OK) THEN
IF (REASON = MQRC-UNKNOWN-OBJECT-NAME) THEN
* Queue doesn't exist - create it
PERFORM CREATE-MAIL-QUEUE
MOVE ZERO TO NUMMSG
IF W00-CREATE-WORKED = 'N' THEN
* Couldn't create it - report it
MOVE VD0-MESSAGE-2 TO MSG
END-IF
ELSE
* Something else is wrong - report it
MOVE 'OPEN MAILQ' TO VD0-MSG1-TYPE
MOVE COMPCODE TO VD0-MSG1-COMPCODE
MOVE REASON TO VD0-MSG1-REASON
MOVE VD0-MESSAGE-1 TO MSG
END-IF
END-IF.
*
OPEN-USERS-MAIL-QUEUE-EXIT.
*
* Return to performing section
*
EXIT.
EJECT
*
* ------------------------------------------------------------- *
CREATE-MAIL-QUEUE SECTION.
* ------------------------------------------------------------- *
* *
* This section creates the users mail queue. If the create *
* fails, a message is built indicating the reason. *
* *
* ------------------------------------------------------------ *
*
MOVE SPACE TO W00-CREATE-WORKED.
*
* Initialize the Object Descriptor (MQOD) control block.
* (The remaining fields are already initialized)
*
MOVE MQOT-Q TO MQOD-OBJECTTYPE.
MOVE W01-SYSTEM-REPLY-MODEL TO MQOD-OBJECTNAME.
MOVE W01-SYSTEM-REPLY-INITIAL TO MQOD-DYNAMICQNAME.
MOVE ZERO TO HOBJ.
*
MOVE MQOO-INPUT-AS-Q-DEF TO W03-OPTIONS.
*
* Open the temporary queue
*
CALL 'MQOPEN' USING HCONN
MQOD
W03-OPTIONS
HOBJ
COMPCODE
REASON.
*
* Test the output of the open call. If the call failed, build
* an error message showing the completion code and reason
*
IF (COMPCODE NOT = MQCC-OK) THEN
MOVE 'OPEN TEMPQ' TO VD0-MSG1-TYPE
MOVE COMPCODE TO VD0-MSG1-COMPCODE
MOVE REASON TO VD0-MSG1-REASON
MOVE VD0-MESSAGE-1 TO MSG
GO TO CREATE-MAIL-QUEUE-EXIT
END-IF.
*
* Send a 'define queue' message to the system command
* input queue
*
MOVE MQOD-OBJECTNAME TO W01-REPLY-QNAME
MQMD-REPLYTOQ.
MOVE MQMT-REQUEST TO MQMD-MSGTYPE.
MOVE MQPER-NOT-PERSISTENT TO MQMD-PERSISTENCE.
MOVE MQOT-Q TO MQOD-OBJECTTYPE.
MOVE W01-SYSTEM-COMMAND-QUEUE TO MQOD-OBJECTNAME.
MOVE MQPMO-NO-SYNCPOINT TO MQPMO-OPTIONS.
*
CALL 'MQPUT1' USING HCONN
MQOD
MQMD
MQPMO
W02-DEFINE-LENGTH
W02-DEFINE-COMMAND
COMPCODE
REASON.
*
IF (COMPCODE NOT = MQCC-OK) THEN
MOVE 'DEFINE PUT' TO VD0-MSG1-TYPE
MOVE COMPCODE TO VD0-MSG1-COMPCODE
MOVE REASON TO VD0-MSG1-REASON
MOVE VD0-MESSAGE-1 TO MSG
GO TO CREATE-MAIL-QUEUE-TEMPQ-CLOSE
END-IF.
*
MOVE MQGMO-ACCEPT-TRUNCATED-MSG TO MQGMO-OPTIONS.
ADD MQGMO-WAIT TO MQGMO-OPTIONS.
MOVE W00-GET-WAIT-30SECS TO MQGMO-WAITINTERVAL.
*
PERFORM WITH TEST AFTER UNTIL ( (COMPCODE NOT = MQCC-OK) OR
(W00-CREATE-WORKED NOT = SPACE) )
*
MOVE MQMI-NONE TO MQMD-MSGID
MOVE MQCI-NONE TO MQMD-CORRELID
MOVE SPACES TO W02-COMMAND-REPLY
*
CALL 'MQGET' USING HCONN
HOBJ
MQMD
MQGMO
W02-REPLY-LENGTH
W02-COMMAND-REPLY
W00-DATA-LENGTH
COMPCODE
REASON
*
IF (COMPCODE = MQCC-OK) THEN
IF W02-REPLY-NUM = 'CSQN205I' THEN
IF W02-RETURN-NUM = '00000000' THEN
MOVE 'Y' TO W00-CREATE-WORKED
ELSE
MOVE 'N' TO W00-CREATE-WORKED
END-IF
* else
* Do nothing with this message
END-IF
ELSE
IF (REASON = MQRC-NO-MSG-AVAILABLE) THEN
MOVE VD0-MESSAGE-2 TO MSG
ELSE
MOVE 'DEFINE GET' TO VD0-MSG1-TYPE
MOVE COMPCODE TO VD0-MSG1-COMPCODE
MOVE REASON TO VD0-MSG1-REASON
MOVE VD0-MESSAGE-1 TO MSG
END-IF
END-IF
*
END-PERFORM.
*
CREATE-MAIL-QUEUE-TEMPQ-CLOSE.
*
* Close, and thus delete, the temporary queue
*
CALL 'MQCLOSE' USING HCONN
HOBJ
MQCO-NONE
COMPCODE
REASON.
*
* If the mail queue was created, open it
*
IF W00-CREATE-WORKED = 'Y' THEN
*
* Initialize the Object Descriptor (MQOD) control block
* (The remaining fields are already initialized)
*
MOVE MQOT-Q TO MQOD-OBJECTTYPE
MOVE MAILQ TO MQOD-OBJECTNAME
*
* Initialize the working storage fields required to open
* the queue
*
MOVE MQOO-INQUIRE TO W03-OPTIONS
ADD MQOO-BROWSE TO W03-OPTIONS
ADD MQOO-INPUT-SHARED TO W03-OPTIONS
ADD MQOO-OUTPUT TO W03-OPTIONS
ADD MQOO-SAVE-ALL-CONTEXT TO W03-OPTIONS
*
* Open the queue
*
CALL 'MQOPEN' USING HCONN
MQOD
W03-OPTIONS
HOBJ
COMPCODE
REASON
*
* Test the output of the open call. If the call failed
* build an error message showing the completion code
* and reason
*
IF (COMPCODE NOT = MQCC-OK) THEN
MOVE 'OPEN MAILQ' TO VD0-MSG1-TYPE
MOVE COMPCODE TO VD0-MSG1-COMPCODE
MOVE REASON TO VD0-MSG1-REASON
MOVE VD0-MESSAGE-1 TO MSG
END-IF
*
END-IF.
*
CREATE-MAIL-QUEUE-EXIT.
*
* Return to performing section
*
EXIT.
EJECT
*
* ------------------------------------------------------------- *
FIND-MAIL-QUEUE-DEPTH SECTION.
* ------------------------------------------------------------- *
* *
* This section inquires on the users mail queue to find the *
* number of messages on the queue. *
* It updates NUMMSG with this number *
* *
* ------------------------------------------------------------ *
*
* Initialize the variables for the inquire call
*
MOVE MQIA-CURRENT-Q-DEPTH TO W03-SELECTORS.
MOVE 1 TO W03-SELECTORCOUNT.
MOVE 1 TO W03-INTATTRCOUNT.
MOVE ZERO TO W03-CHARATTRLENGTH.
*
* Inquire on the attributes
*
CALL 'MQINQ' USING HCONN
HOBJ
W03-SELECTORCOUNT
W03-SELECTORS-TABLE
W03-INTATTRCOUNT
W03-INTATTRS-TABLE
W03-CHARATTRLENGTH
W03-CHARATTRS
COMPCODE
REASON.
*
* Test the output
* - If the completion code is not OK, build an error
* message showing the completion and reason codes
* - Otherwise, update the number of messages
*
IF COMPCODE NOT = MQCC-OK THEN
MOVE 'INQ DEPTH' TO VD0-MSG1-TYPE
MOVE COMPCODE TO VD0-MSG1-COMPCODE
MOVE REASON TO VD0-MSG1-REASON
MOVE VD0-MESSAGE-1 TO MSG
MOVE ZERO TO NUMMSG
ELSE
MOVE W03-INTATTRS TO NUMMSG
END-IF.
*
FIND-MAIL-QUEUE-DEPTH-EXIT.
*
* Return to performing section
*
EXIT.
EJECT
*
* ------------------------------------------------------------- *
PUT-TO-SHARED-POOL SECTION.
* ------------------------------------------------------------- *
* *
* This section copies the variables to the ISPF shared pool *
* *
* ------------------------------------------------------------ *
*
CALL 'ISPLINK' USING VD1-VPUT VD1-USERID VD1-SHARED.
CALL 'ISPLINK' USING VD1-VPUT VD1-SUBSYS VD1-SHARED.
CALL 'ISPLINK' USING VD1-VPUT VD1-MSG VD1-SHARED.
CALL 'ISPLINK' USING VD1-VPUT VD1-NUMMSG VD1-SHARED.
CALL 'ISPLINK' USING VD1-VPUT VD1-N VD1-SHARED.
CALL 'ISPLINK' USING VD1-VPUT VD1-HCONN VD1-SHARED.
CALL 'ISPLINK' USING VD1-VPUT VD1-HOBJ VD1-SHARED.
*
PUT-TO-SHARED-POOL-EXIT.
*
* Return to performing section
*
EXIT.
*
* ------------------------------------------------------------- *
READ-MAIL SECTION.
* ------------------------------------------------------------- *
* *
* This section calls the program which allows the user to *
* handle incoming mail *
* *
* ------------------------------------------------------------ *
*
CALL 'ISPLINK' USING VD1-SELECT
VD1-SELECT-LENGTH
W04-CSQ4TVD2.
*
*
READ-MAIL-EXIT.
*
* Return to performing section
*
EXIT.
EJECT
*
* ------------------------------------------------------------- *
SEND-MAIL SECTION.
* ------------------------------------------------------------- *
* *
* This section calls the program which sends mail *
* *
* ------------------------------------------------------------ *
*
CALL 'ISPLINK' USING VD1-SELECT
VD1-SELECT-LENGTH
W04-CSQ4TVD4.
*
*
SEND-MAIL-EXIT.
*
* Return to performing section
*
EXIT.
EJECT
*
* ------------------------------------------------------------- *
CREATE-NICKNAME SECTION.
* ------------------------------------------------------------- *
* *
* This section calls the program which controls nickname *
* creation *
* *
* ------------------------------------------------------------ *
*
CALL 'ISPLINK' USING VD1-SELECT
VD1-SELECT-LENGTH
W04-CSQ4TVD5.
*
*
CREATE-NICKNAME-EXIT.
*
* Return to performing section
*
EXIT.
EJECT
*
* ---------------------------------------------------------------
* End of program
* ---------------------------------------------------------------
¤ Dauer der Verarbeitung: 0.70 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.
|
