|
CBL NODYNAM,LIB,OBJECT,RENT,RES,APOST
* ------------------------------------------------------------- *
IDENTIFICATION DIVISION.
* ------------------------------------------------------------- *
PROGRAM-ID. CSQ4TVD2.
*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 : CSQ4TVD2 *
* *
* Environment : MVS TSO/ISPF; COBOL II *
* *
* Function : This program provides display mail *
* awaiting and display chosen message *
* function for the mail manager sample. *
* See IBM MQSeries for MVS/ESA *
* Application Programming Reference, *
* for further details. *
* *
* Description : This program displays a list of the *
* messages on a users mail queue using *
* panel CSQ4VDP2. When a user selects a *
* specific message, its contents are *
* displayed on panel CSQ4VDP3. *
* *
* ************************************************************* *
* *
* Program Logic *
* ------------- *
* *
* Start (A-MAIN SECTION) *
* ----- *
* *
* Define required variables to ISPF *
* *
* Perform LIST-MESSAGES-ON-MAIL-Q *
* *
* If ISPF return code is zero and get-browse finished *
* because no message available *
* Set pointer to top of table *
* Display the ISPF table on panel CSQ4VDP3 *
* *
* Do while ISPF return code is zero (until PF3 pressed)*
* Perform DISPLAY-CHOSEN-MESSAGE *
* Redisplay the ISPF table *
* End-do *
* End-if *
* *
* Close the ISPF table *
* *
* Return to ISPF *
* *
* *
* LIST-MESSAGES-ON-MAIL-Q SECTION *
* ------------------------------- *
* *
* Create a memory resident ISPF table *
* If create not successful *
* Build error message and exit *
* End-if *
* *
* Initialize the variables for the get browse call *
* Browse the first message on the users mail queue *
* Set line number to zero *
* Do while return code from ISPF is zero and get calls *
* are successful and less than 99 messages retrieved *
* Add one to line number *
* Write the message information to the table row *
* Add the row to the ISPF table *
* If ISPF return code is zero *
* Browse the next message on the queue *
* End-if *
* End-do *
* *
* If the ISPF return code is not zero *
* Build an error message *
* Display it using ISPF SETMSG *
* Else *
* If 99 messages retrieved - set message to tell user *
* Else *
* If the reason for get failing is not no-msg-available*
* Build an error message *
* Display it using ISPF SETMSG *
* End-if *
* End-if *
* *
* Set maxlines to current line number *
* Put the value of maxlines in the ISPF shared pool *
* *
* Return to performing section *
* *
* *
* DISPLAY-CHOSEN-MESSAGE SECTION *
* ------------------------------ *
* *
* Move the user selection number to the table row number *
* Get the row from the ISPF table *
* If the ISPF return code is not zero *
* Build an error message *
* Else *
* If the message has not already been deleted *
* Initialize the variables to get the message *
* Get the chosen message *
* If the call is unsuccessful *
* Build an error message *
* Else *
* Perform SHOW-MESSAGE *
* Commit the message get *
* If commit not successful *
* Build an error message *
* Else *
* Update the table row (message deleted) *
* Put the updated row in the ISPF table *
* If the ISPF put not successful *
* Build an error message *
* End-if *
* End-if *
* End-if *
* Else *
* Set 'message already deleted' message *
* End-if *
* End-if *
* *
* Put the message in the ISPF shared pool *
* *
* Return to performing section *
* *
* *
* SHOW-MESSAGE SECTION *
* -------------------- *
* *
* Do until ISPF return code not zero *
* Display panel CSQ4VDP3 *
* End-do *
* *
* Return to performing section *
* *
*****************************************************************
ENVIRONMENT DIVISION.
* ------------------------------------------------------------- *
* ------------------------------------------------------------- *
DATA DIVISION.
* ------------------------------------------------------------- *
WORKING-STORAGE SECTION.
* ------------------------------------------------------------- *
*
* W00 - General work fields
*
01 W00-RECD-MAILQ.
05 PIC X(17).
05 W00-SENT-FROM PIC X(08) VALUE SPACES.
05 PIC X(23).
*
01 W00-DATA-LENGTH PIC S9(09) BINARY.
01 W00-LINE-NUMBER PIC S9(09) BINARY VALUE ZERO.
*
01 W00-QUEUE-DATE.
05 W00-Q-YEAR PIC 9(04) VALUE ZERO.
05 W00-Q-MONTH PIC 9(02) VALUE ZERO.
05 W00-Q-DAY PIC 9(02) VALUE ZERO.
01 W00-DISPLAY-DATE.
05 W00-D-MONTH PIC 9(02) VALUE ZERO.
05 PIC X VALUE '/'.
05 W00-D-DAY PIC 9(02) VALUE ZERO.
05 PIC X VALUE '/'.
05 W00-D-YEAR PIC 9(04) VALUE ZERO.
*
01 W00-QUEUE-TIME.
05 W00-Q-HOUR PIC 9(02) VALUE ZERO.
05 W00-Q-MINUTE PIC 9(02) VALUE ZERO.
05 W00-Q-SEC PIC 9(02) VALUE ZERO.
05 W00-Q-100SEC PIC 9(02) VALUE ZERO.
01 W00-DISPLAY-TIME.
05 W00-D-HOUR PIC 9(02) VALUE ZERO.
05 PIC X VALUE ':'.
05 W00-D-MINUTE PIC 9(02) VALUE ZERO.
05 PIC X VALUE ':'.
05 W00-D-SEC PIC 9(02) VALUE ZERO.
*
* The following copy book contains messages that will be
* displayed to the user
*
COPY CSQ4VD0.
*
* ISPF definitions used in this program
*
COPY CSQ4VD1.
*
01 W01-MSGID PIC X(08) VALUE 'MSGID'.
01 W01-CORRELID PIC X(08) VALUE 'CORRELID'.
01 W01-MSGFROM PIC X(08) VALUE 'MSGFROM'.
01 W01-MSGDATE PIC X(08) VALUE 'MSGDATE'.
01 W01-MSGTIME PIC X(08) VALUE 'MSGTIME'.
01 W01-MAXLINES PIC X(08) VALUE 'MAXLINES'.
01 W01-LINENO PIC X(08) VALUE 'LINENO'.
01 W01-SN PIC X(08) VALUE 'SN'.
01 W01-PANEL2 PIC X(08) VALUE 'CSQ4VDP2'.
01 W01-PANEL3 PIC X(08) VALUE 'CSQ4VDP3'.
*
* ISPF variable definitions used in this program
*
COPY CSQ4VD2.
*
01 LINENO PIC 9(02) VALUE ZERO.
01 MAXLINES PIC 9(04) VALUE ZERO.
01 SN PIC 9(02) VALUE ZERO.
01 QMGR PIC X(48) VALUE SPACES.
*
* Mail manager message definition
*
COPY CSQ4VD4.
*
* API control blocks
*
01 MQM-OBJECT-DESCRIPTOR.
COPY CMQODV SUPPRESS.
01 MQM-MESSAGE-DESCRIPTOR.
COPY CMQMDV 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.
* ------------------------------------------------------------- *
EJECT
* ------------------------------------------------------------- *
PROCEDURE DIVISION.
* ------------------------------------------------------------- *
* ------------------------------------------------------------- *
A-MAIN SECTION.
* ------------------------------------------------------------- *
* *
* This section initializes the ISPF variables, calls *
* LIST-MESSAGES-ON-MAIL-Q to build list of messages on a users *
* mail queue in an ISPF table and then displays the table. *
* The section then enters a loop displaying a chosen message *
* and redisplaying the ISPF table until the user presses PF3 *
* or until an ISPF error occurs. *
* Finally the table is closed and thus deleted. *
* *
* ------------------------------------------------------------- *
*
* 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 W01-CORRELID CORRELID
VD1-CHAR VD1-LENGTH24 .
CALL 'ISPLINK' USING VD1-VDEFINE W01-LINENO LINENO
VD1-CHAR VD1-LENGTH2 .
CALL 'ISPLINK' USING VD1-VDEFINE W01-MAXLINES MAXLINES
VD1-CHAR VD1-LENGTH4 .
CALL 'ISPLINK' USING VD1-VDEFINE W01-MSGDATE MSGDATE
VD1-CHAR VD1-LENGTH10 .
CALL 'ISPLINK' USING VD1-VDEFINE W01-MSGFROM MSGFROM
VD1-CHAR VD1-LENGTH8 .
CALL 'ISPLINK' USING VD1-VDEFINE W01-MSGID MSGID
VD1-CHAR VD1-LENGTH24 .
CALL 'ISPLINK' USING VD1-VDEFINE W01-MSGTIME MSGTIME
VD1-CHAR VD1-LENGTH8 .
CALL 'ISPLINK' USING VD1-VDEFINE VD1-QMGR QMGR
VD1-CHAR VD1-LENGTH48.
CALL 'ISPLINK' USING VD1-VDEFINE W01-SN SN
VD1-CHAR VD1-LENGTH2 .
*
CALL 'ISPLINK' USING VD1-VDEFINE
VD1-DISPLAYLINES
VD4-MESSAGE
VD1-DISPLAYLINES-TYPE
VD1-DISPLAYLINES-LENGTH
VD1-LIST.
*
CALL 'ISPLINK' USING VD1-VDEFINE VD1-HCONN HCONN
VD1-CHAR VD1-LENGTH4 VD1-COPY .
CALL 'ISPLINK' USING VD1-VDEFINE VD1-HOBJ HOBJ
VD1-CHAR VD1-LENGTH4 VD1-COPY .
CALL 'ISPLINK' USING VD1-VDEFINE VD1-MSG MSG
VD1-CHAR VD1-LENGTH60 VD1-COPY .
*
* Initialize variables
*
MOVE LENGTH OF VD4-MESSAGE TO VD4-MSG-LENGTH.
MOVE SPACES TO MSG.
*
* Get list of messages on user's mail queue
*
PERFORM LIST-MESSAGES-ON-MAIL-Q.
*
* If this is successful -
* display the selection panel to allow the user to choose
* a message
*
IF ( (RETURN-CODE = ZERO) AND
( (REASON = MQRC-NO-MSG-AVAILABLE) OR
(MAXLINES = 99) ) ) THEN
*
CALL 'ISPLINK' USING VD1-TBTOP VD1-TABLE-NAME
CALL 'ISPLINK' USING VD1-TBDISPLAY
VD1-TABLE-NAME
W01-PANEL2
*
* Loop 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
*
PERFORM DISPLAY-CHOSEN-MESSAGE
*
CALL 'ISPLINK' USING VD1-TBDISPLAY
VD1-TABLE-NAME
W01-PANEL2
*
END-PERFORM
*
END-IF.
*
CALL 'ISPLINK' USING VD1-TBCLOSE
VD1-TABLE-NAME.
*
A-MAIN-EXIT.
*
* Return to ISPF
*
STOP RUN.
EJECT
*
* ------------------------------------------------------------- *
LIST-MESSAGES-ON-MAIL-Q SECTION.
* ------------------------------------------------------------- *
* *
* This section creates a memory resident ISPF table. The *
* users mail queue is then browsed, a table row being *
* completed for each message on the queue. *
* *
* If any error (other than no-msg-available from the get call)*
* occurs a message is sent for display on the next ISPF panel *
* (using ISPF SETMSG) and control is returned to the *
* performing section. *
* *
* ------------------------------------------------------------ *
*
*
CALL 'ISPLINK' USING VD1-TBCREATE
VD1-TABLE-NAME
VD1-TABLE-KEY
VD1-TABLE-FIELDS
VD1-NOWRITE
VD1-REPLACE.
*
* Test the output of the table create
*
IF RETURN-CODE NOT = 0 THEN
MOVE VD1-TBCREATE 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
GO TO LIST-MESSAGES-ON-MAIL-Q-EXIT
END-IF.
*
* Initialize the variables for the first browse call
*
MOVE MQGMO-BROWSE-FIRST TO MQGMO-OPTIONS.
ADD MQGMO-NO-WAIT TO MQGMO-OPTIONS.
*
MOVE SPACES TO VD4-MESSAGE.
MOVE MQMI-NONE TO MQMD-MSGID.
MOVE MQCI-NONE TO MQMD-CORRELID.
*
* Browse the first message
*
CALL 'MQGET' USING HCONN
HOBJ
MQMD
MQGMO
VD4-MSG-LENGTH
VD4-MESSAGE
W00-DATA-LENGTH
COMPCODE
REASON.
*
* Test the output of the call with the perform loop
*
MOVE ZERO TO W00-LINE-NUMBER.
*
MOVE ZERO TO RETURN-CODE.
*
MOVE MQGMO-BROWSE-NEXT TO MQGMO-OPTIONS.
*
PERFORM WITH TEST BEFORE UNTIL ((COMPCODE NOT = MQCC-OK) OR
(RETURN-CODE NOT = 0) OR
(W00-LINE-NUMBER >= 99))
*
ADD 1 TO W00-LINE-NUMBER
*
* Write the message information to the table row
*
MOVE W00-LINE-NUMBER TO LINENO
MOVE MQMD-MSGID TO MSGID
MOVE MQMD-CORRELID TO CORRELID
MOVE MQMD-REPLYTOQ TO W00-RECD-MAILQ
MOVE W00-SENT-FROM TO MSGFROM
MOVE MQMD-PUTDATE TO W00-QUEUE-DATE
MOVE W00-Q-YEAR TO W00-D-YEAR
MOVE W00-Q-MONTH TO W00-D-MONTH
MOVE W00-Q-DAY TO W00-D-DAY
MOVE W00-DISPLAY-DATE TO MSGDATE
MOVE MQMD-PUTTIME TO W00-QUEUE-TIME
MOVE W00-Q-HOUR TO W00-D-HOUR
MOVE W00-Q-MINUTE TO W00-D-MINUTE
MOVE W00-Q-SEC TO W00-D-SEC
MOVE W00-DISPLAY-TIME TO MSGTIME
*
CALL 'ISPLINK' USING VD1-TBADD VD1-TABLE-NAME
*
* If adding this data to the table was ok browse the
* next message
*
IF RETURN-CODE = ZERO THEN
MOVE MQMI-NONE TO MQMD-MSGID
MOVE MQCI-NONE TO MQMD-CORRELID
*
CALL 'MQGET' USING HCONN
HOBJ
MQMD
MQGMO
VD4-MSG-LENGTH
VD4-MESSAGE
W00-DATA-LENGTH
COMPCODE
REASON
*
MOVE ZERO TO RETURN-CODE
END-IF
*
END-PERFORM.
*
* Test the output of the table add
*
IF RETURN-CODE NOT = 0 THEN
MOVE VD1-TBADD 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
ELSE
*
IF (COMPCODE = MQCC-OK) AND
(W00-LINE-NUMBER = 99) THEN
MOVE VD0-MESSAGE-8 TO MSG
*
ELSE
*
IF (COMPCODE NOT = MQCC-FAILED) AND
(REASON NOT = MQRC-NO-MSG-AVAILABLE) THEN
MOVE 'LIST MSGS' TO VD0-MSG1-TYPE
MOVE COMPCODE TO VD0-MSG1-COMPCODE
MOVE REASON TO VD0-MSG1-REASON
MOVE VD0-MESSAGE-1 TO MSG
CALL 'ISPLINK' USING VD1-VPUT VD1-MSG
CALL 'ISPLINK' USING VD1-SETMSG VD1-MSGFILE-1
END-IF
END-IF
END-IF.
*
MOVE W00-LINE-NUMBER TO MAXLINES.
CALL 'ISPLINK' USING VD1-VPUT W01-MAXLINES.
*
LIST-MESSAGES-ON-MAIL-Q-EXIT.
*
* Return to performing section
*
EXIT.
EJECT
*
* ------------------------------------------------------------- *
DISPLAY-CHOSEN-MESSAGE SECTION.
* ------------------------------------------------------------- *
* *
* This section obtains details of the chosen message from the *
* ISPF table and, using these, gets the message and displays *
* it to the user. Once the user has finshed viewing the *
* message the removal of the message from the queue is *
* committed and the ISPF table is updated. *
* *
* ------------------------------------------------------------ *
*
MOVE SN TO LINENO.
CALL 'ISPLINK' USING VD1-TBGET VD1-TABLE-NAME.
*
IF RETURN-CODE NOT = 0 THEN
MOVE VD1-TBGET TO VD0-MSG16-CALL
MOVE RETURN-CODE TO VD0-MSG16-RETURN
MOVE VD0-MESSAGE-16 TO MSG
*
ELSE
IF MSGFROM NOT = 'Deleted'
*
* Get the message
*
MOVE MQGMO-SYNCPOINT TO MQGMO-OPTIONS
ADD MQGMO-NO-WAIT TO MQGMO-OPTIONS
MOVE MSGID TO MQMD-MSGID
MOVE CORRELID TO MQMD-CORRELID
*
CALL 'MQGET' USING HCONN
HOBJ
MQMD
MQGMO
VD4-MSG-LENGTH
VD4-MESSAGE
W00-DATA-LENGTH
COMPCODE
REASON
*
IF COMPCODE NOT = MQCC-OK
MOVE 'GET MSG' TO VD0-MSG1-TYPE
MOVE COMPCODE TO VD0-MSG1-COMPCODE
MOVE REASON TO VD0-MSG1-REASON
MOVE VD0-MESSAGE-1 TO MSG
ELSE
*
* The table and message retrieval have set the
* variables - so display the panel
*
MOVE MQMD-REPLYTOQMGR TO QMGR
*
PERFORM SHOW-MESSAGE
*
* Complete retrieval of the message
*
CALL 'MQCMIT' USING HCONN
COMPCODE
REASON
*
IF COMPCODE NOT = MQCC-OK
MOVE 'MQCMIT' TO VD0-MSG1-TYPE
MOVE COMPCODE TO VD0-MSG1-COMPCODE
MOVE REASON TO VD0-MSG1-REASON
MOVE VD0-MESSAGE-1 TO MSG
ELSE
*
* The get has been committed
*
MOVE 'Deleted' TO MSGFROM
MOVE SPACES TO MSGDATE
MOVE SPACES TO MSGTIME
*
CALL 'ISPLINK' USING VD1-TBPUT
VD1-TABLE-NAME
*
IF RETURN-CODE NOT = 0 THEN
MOVE VD1-TBPUT TO VD0-MSG16-CALL
MOVE RETURN-CODE TO VD0-MSG16-RETURN
MOVE VD0-MESSAGE-16 TO MSG
END-IF
*
END-IF
END-IF
ELSE
* Message already deleted
MOVE VD0-MESSAGE-5 TO MSG
END-IF
END-IF.
*
CALL 'ISPLINK' USING VD1-VPUT VD1-MSG.
*
DISPLAY-CHOSEN-MESSAGE-EXIT.
*
* Return to performing section
*
EXIT.
EJECT
*
* ------------------------------------------------------------- *
SHOW-MESSAGE SECTION.
* ------------------------------------------------------------- *
* *
* This section displays the chosen message until the user *
* presses PF3 or until an ISPF error occurs *
* *
* ------------------------------------------------------------ *
*
*
PERFORM WITH TEST AFTER UNTIL RETURN-CODE NOT = 0
CALL 'ISPLINK' USING VD1-DISPLAY W01-PANEL3
END-PERFORM.
*
SHOW-MESSAGE-EXIT.
*
* Return to performing section
*
EXIT.
EJECT
*
* ---------------------------------------------------------------
* End of program
* ---------------------------------------------------------------
¤ Dauer der Verarbeitung: 0.45 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.
|
