CBL NODYNAM,LIB,OBJECT,RENT,RES,APOST * ------------------------------------------------------------- * IDENTIFICATIONDIVISION. * ------------------------------------------------------------- * 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 * * * * * * ************************************************************* * * ------------------------------------------------------------- * ENVIRONMENTDIVISION. * ------------------------------------------------------------- * * ------------------------------------------------------------- * DATADIVISION. * ------------------------------------------------------------- * * ------------------------------------------------------------- * WORKING-STORAGESECTION. * ------------------------------------------------------------- * * * W00 - General work fields *
01 W00-GET-WAIT-30SECS PIC S9(09) BINARYVALUE 30000.
01 W00-DATA-LENGTH PIC S9(09) BINARY.
01 W00-MESSAGE-DATA PIC X(80) VALUESPACES.
01 W00-CREATE-WORKED PIC X. * * W01 - Queue name fields *
01 W01-REPLY-QNAME PIC X(48) VALUESPACES.
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) VALUESPACES.
10 PIC X(23) VALUESPACES.
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) BINARYVALUE 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 VALUEZERO.
01 N PIC X VALUEZERO. * * 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 * ------------------------------------------------------------- * PROCEDUREDIVISION. * ------------------------------------------------------------- *
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 * MOVELENGTHOF W02-DEFINE-COMMAND TO W02-DEFINE-LENGTH. MOVELENGTHOF W02-COMMAND-REPLY TO W02-REPLY-LENGTH. MOVEZEROTO HCONN. MOVE USERID TO MAILQ-USER. * * If the user has not tailored the JCL - use the default * IF SUBSYS = 'QMGR'THEN MOVESPACESTO 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 GOTO 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 GOTO 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 GOTO 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 * MOVESPACETO 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 * PERFORMWITHTESTBEFOREUNTILRETURN-CODENOT = ZERO * MOVESPACESTO MSG * * Process depending on the action entered by the user * EVALUATETRUE 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 WHENOTHER 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 * IFRETURN-CODENOT = 8 THEN MOVE VD1-DISPLAY TO VD0-MSG16-CALL MOVERETURN-CODETO VD0-MSG16-RETURN MOVE VD0-MESSAGE-16 TO MSG CALL'ISPLINK'USING VD1-VPUT VD1-MSG CALL'ISPLINK'USING VD1-SETMSG VD1-MSGFILE-1 MOVESPACESTO 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 = SPACESTHEN CALL'ISPLINK'USING VD1-VPUT VD1-MSG CALL'ISPLINK'USING VD1-SETMSG VD1-MSGFILE-1 END-IF. * * Return to ISPF * STOPRUN.
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. MOVESPACESTO MQOD-OBJECTNAME. MOVESPACESTO MQOD-DYNAMICQNAME. MOVEZEROTO 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 GOTO GET-QMGR-NAME-EXIT END-IF. * * Set selectors to inquire on queue manager name * MOVE MQCA-Q-MGR-NAME TO W03-SELECTORS. MOVEZEROTO 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 MOVESPACESTO SUBSYS ELSE MOVESPACESTO 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. * * * * ------------------------------------------------------------ * * MOVESPACESTO 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. MOVEZEROTO 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 MOVEZEROTO 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. * * * * ------------------------------------------------------------ * * MOVESPACETO 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. MOVEZEROTO 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 GOTO 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 GOTO 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. * PERFORMWITHTESTAFTERUNTIL ( (COMPCODE NOT = MQCC-OK) OR
(W00-CREATE-WORKED NOT = SPACE) ) * MOVE MQMI-NONE TO MQMD-MSGID MOVE MQCI-NONE TO MQMD-CORRELID MOVESPACESTO 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. MOVEZEROTO 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 MOVEZEROTO 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 * ---------------------------------------------------------------
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.
