|
CBL NODYNAM,LIB,OBJECT,RENT,RES,APOST
* ------------------------------------------------------------- *
IDENTIFICATION DIVISION.
* ------------------------------------------------------------- *
PROGRAM-ID. CSQ4TVH2.
*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 : CSQ4TVH2 *
* *
* Environment : MVS TSO/ISPF; COBOL II *
* *
* Function : This program builds and displays the message *
* list for the Message Handler sample program. *
* See IBM Message Queue Manager MVS/ESA *
* Application Programming Reference, document *
* number SC33-1212, for further details. *
* *
* Description : This program is called from program CSQ4TVH1. *
* It displays the messages on the chosen queue *
* using panel CSQ4CHP2. If a message is to be *
* displayed then program CSQ4TVH3 is called. *
* *
*****************************************************************
* *
* Program Logic *
* *
*---------------------------------------------------------------*
* *
* A-MAIN SECTION *
* -------------- *
* *
* initialize variables used by ISPF *
* blank panel message line *
* set default message choice to first in table *
* loop getting message numbers until END command *
* call CSQ4TVH3 to display message contents *
* get message line from ISPF *
* endloop *
* exit program *
* *
*---------------------------------------------------------------*
* *
* DISPLAY-MESSAGE-LIST SECTION *
* -------------------------- *
* *
* if get current queue depth is unsuccessful *
* exit from section *
* endif *
* if creation of message table is unsuccessful *
* exit from section *
* endif *
* if move to top of message table failed *
* display error message *
* exit from section *
* endif *
* if display of ISPF panel with message table failed *
* exit from section *
* endif *
* get the chosen message number from table *
* if unsuccessful *
* display error message *
* exit from section *
* endif *
* put chosen message details to ISPF *
* exit from section *
* *
*---------------------------------------------------------------*
* *
* CREATE-MSG-TABLE SECTION *
* ------------------------ *
* *
* set number of messages in table to zero *
* browse the first message from queue (MQGET) *
* if successful *
* set the get options to browse next message *
* else *
* display appropriate error message *
* exit from section *
* endif *
* create ISPF table to hold message information *
* if unsuccessful *
* display error message *
* exit from section *
* endif *
* loop while there is still room left in message table *
* set up variables for new table entry *
* add new table entry *
* if unsuccessful *
* display error message *
* exit from section *
* endif *
* browse the next message from queue *
* if unsuccessful *
* if failed because no more message on queue *
* message table finished *
* set reason codes to no error *
* else *
* end the table creation *
* display error message *
* exit from section *
* endif *
* else *
* set reason codes to no error *
* endif *
* endloop *
* exit from section *
* *
*---------------------------------------------------------------*
* *
* CURRENT-Q-DEPTH SECTION *
* ----------------------- *
* *
* set inquire options for queue depth *
* call MQINQ to get the current queue depth *
* if successful *
* put current queue depth to ISPF *
* else *
* display error message *
* endif *
* exit from section *
* *
*---------------------------------------------------------------*
* *
* ERROR-MESSAGE SECTION *
* --------------------- *
* *
* copy error message into panel message line variable *
* exit from section *
* *
*---------------------------------------------------------------*
* *
* PRINT-MESSAGE SECTION *
* --------------------- *
* *
* copy message into panel message line variable *
* exit from section *
* *
*---------------------------------------------------------------*
* *
* ISFP-INIT SECTION *
* ----------------- *
* *
* call VDEFINE for all variables to go into ISPF *
* shared variable pool *
* exit from section *
* *
*****************************************************************
* ------------------------------------------------------------- *
ENVIRONMENT DIVISION.
* ------------------------------------------------------------- *
* ------------------------------------------------------------- *
DATA DIVISION.
* ------------------------------------------------------------- *
* ------------------------------------------------------------- *
WORKING-STORAGE SECTION.
* ------------------------------------------------------------- *
*
* W00 - General work fields
*
01 W00-ERRORMSG PIC X(40) VALUE SPACES.
01 W00-RETCODE PIC S9(09) BINARY.
01 W00-PUTAPPLTYPETEMP PIC S9(08) BINARY.
01 W00-TABLESIZE PIC S9(09) BINARY.
01 W00-TABLESIZE-CHAR PIC S9(02).
01 W00-TIME.
10 W00-HOUR PIC X(2) VALUE SPACES.
10 W00-MIN PIC X(2) VALUE SPACES.
10 W00-SEC PIC X(2) VALUE SPACES.
10 W00-MILLISEC PIC X(2) VALUE SPACES.
01 W00-DATE.
10 W00-CENTURY PIC X(2) VALUE SPACES.
10 W00-YEAR PIC X(2) VALUE SPACES.
10 W00-MONTH PIC X(2) VALUE SPACES.
10 W00-DAY PIC X(2) VALUE SPACES.
*
* W01 - ISPF Variables
*
01 W01-QMGRNAME PIC X(48) VALUE SPACES.
01 W01-QNAME PIC X(48) VALUE SPACES.
01 W01-HCONN PIC S9(09) BINARY.
01 W01-HOBJ PIC S9(09) BINARY.
01 W01-MESSAGE PIC X(79) VALUE SPACES.
*
01 W01-MSGNUM PIC X(2) VALUE '01'.
01 W01-NUMMSGS PIC X(2) VALUE SPACES.
01 W01-TOTALNUMMSGS PIC X(9) VALUE SPACES.
*
01 W01-LINENUM PIC X(2) VALUE SPACES.
01 W01-PUTTIME PIC X(8) VALUE SPACES.
01 W01-PUTDATE PIC X(8) VALUE SPACES.
01 W01-FORMATNAME PIC X(8) VALUE SPACES.
01 W01-USERID PIC X(12) VALUE SPACES.
01 W01-PUTAPPLTYPE PIC X(8) VALUE SPACES.
01 W01-PUTAPPLNAME PIC X(28) VALUE SPACES.
*
* W02 - MQAPI Variables
*
01 W02-COMPCODE PIC S9(09) BINARY.
01 W02-COMPCODE-CHAR PIC Z(1)9 VALUE SPACES.
01 W02-REASON PIC S9(09) BINARY.
01 W02-REASON-CHAR PIC Z(4)9 VALUE SPACES.
* MQINQ
01 W02-SELECTORS PIC S9(09) BINARY.
01 W02-SELECTORCOUNT PIC S9(09) BINARY.
01 W02-INTATTRS PIC S9(09) BINARY.
01 W02-INTATTRCOUNT PIC S9(09) BINARY.
01 W02-CHARATTRS PIC X(48) VALUE SPACES.
01 W02-CHARATTRLENGTH PIC S9(09) BINARY.
* MQOPEN
01 W02-OPENOPTIONS PIC S9(09) BINARY.
* MQGET
01 W02-MSGBUFFER PIC X(99) VALUE SPACES.
01 W02-DATALENGTH PIC S9(09) BINARY.
*
* API control blocks
*
01 MQM-OBJECT-DESCRIPTOR.
COPY CMQODV.
01 MQM-MESSAGE-DESCRIPTOR.
COPY CMQMDV.
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.
*
* ISPLINK Strings
*
01 IDISPLAY PIC X(8) VALUE 'DISPLAY '.
01 ISELECT PIC X(8) VALUE 'SELECT '.
01 ISHARED PIC X(8) VALUE 'SHARED '.
01 IVDEFINE PIC X(8) VALUE 'VDEFINE '.
01 IVPUT PIC X(8) VALUE 'VPUT '.
01 IVGET PIC X(8) VALUE 'VGET '.
01 ICOPY PIC X(8) VALUE 'COPY '.
01 ICHAR PIC X(8) VALUE 'CHAR '.
01 IFIXED PIC X(8) VALUE 'FIXED '.
01 IBIT PIC X(8) VALUE 'BIT '.
01 IPANEL2 PIC X(8) VALUE 'CSQ4CHP2'.
01 IPROG3 PIC X(13) VALUE 'PGM(CSQ4TVH3)'.
01 ITBTOP PIC X(8) VALUE 'TBTOP '.
01 ITBDISPL PIC X(8) VALUE 'TBDISPL '.
01 ITBGET PIC X(8) VALUE 'TBGET '.
01 ITBADD PIC X(8) VALUE 'TBADD '.
01 ITBEND PIC X(8) VALUE 'TBEND '.
01 ITBCREATE PIC X(8) VALUE 'TBCREATE'.
01 INOWRITE PIC X(8) VALUE 'NOWRITE '.
01 IREPLACE PIC X(8) VALUE 'REPLACE '.
01 I2 PIC 9(6) VALUE 2 COMP.
01 I4 PIC 9(6) VALUE 4 COMP.
01 I8 PIC 9(6) VALUE 8 COMP.
01 I9 PIC 9(6) VALUE 9 COMP.
01 I12 PIC 9(6) VALUE 12 COMP.
01 I13 PIC 9(6) VALUE 13 COMP.
01 I24 PIC 9(6) VALUE 24 COMP.
01 I28 PIC 9(6) VALUE 28 COMP.
01 I48 PIC 9(6) VALUE 48 COMP.
01 I79 PIC 9(6) VALUE 79 COMP.
01 I99 PIC 9(6) VALUE 99 COMP.
*
01 IMESSAGE PIC X(8) VALUE 'MSG '.
01 IHOBJ PIC X(8) VALUE 'HOBJ '.
01 IHCONN PIC X(8) VALUE 'HCONN '.
01 IQNAME PIC X(8) VALUE 'QNAME '.
01 IQMGRNAME PIC X(8) VALUE 'QMGRNAME'.
*
01 IMSGNUM PIC X(8) VALUE 'MN '.
01 INUMMSGS PIC X(8) VALUE 'NM '.
01 ITOTALNUMMSGS PIC X(8) VALUE 'TOTALNM '.
*
01 ILINENUM PIC X(8) VALUE 'LN '.
01 IMSGID PIC X(8) VALUE 'MSGID '.
01 ICORRELID PIC X(8) VALUE 'CORRELID'.
01 IPUTTIME PIC X(8) VALUE 'PUTTIME '.
01 IPUTDATE PIC X(8) VALUE 'PUTDATE '.
01 IFORMATNAME PIC X(8) VALUE 'FORMAT '.
01 IUSERID PIC X(8) VALUE 'USERID '.
01 IPUTAPPLTYPE PIC X(8) VALUE 'PUTATYPE'.
01 IPUTAPPLNAME PIC X(8) VALUE 'PUTANAME'.
*
01 IMSG-TABLE PIC X(8) VALUE 'MSGTABLE'.
01 IMSG-TABLE-KEY PIC X(4) VALUE '(LN)'.
01 IMSG-TABLE-FIELDS PIC X(64) VALUE
'(MSGID CORRELID PUTDATE PUTTIME FORMAT USERID
- ' PUTATYPE PUTANAME)'.
*
* ------------------------------------------------------------- *
LINKAGE SECTION.
* ------------------------------------------------------------- *
EJECT
* ------------------------------------------------------------- *
PROCEDURE DIVISION.
* ------------------------------------------------------------- *
* ------------------------------------------------------------- *
A-MAIN SECTION.
* ------------------------------------------------------------- *
* *
* Set up variables used with ISPF *
* *
PERFORM ISPF-INIT.
* *
* Blank ISPF panel message *
* *
MOVE SPACES TO W01-MESSAGE.
PERFORM PRINT-MESSAGE.
* *
* Set default message number to the first message in table *
* and place value into the ISPF shared variable pool. *
* *
MOVE '01' TO W01-MSGNUM.
CALL 'ISPLINK' USING IVPUT IMSGNUM ISHARED.
* *
* Loop until ready to quit the program. *
* *
PERFORM DISPLAY-MESSAGE-LIST.
PERFORM WITH TEST BEFORE UNTIL (W02-REASON NOT = 0)
* *
* Call the program to display the message chosen from *
* the message table. *
* *
CALL 'ISPLINK' USING ISELECT I13 IPROG3
CALL 'ISPLINK' USING IVGET IMESSAGE ISHARED
*
PERFORM DISPLAY-MESSAGE-LIST
*
END-PERFORM.
*
A-MAIN-EXIT.
*
GOBACK.
EJECT
*
*
*---------------------------------------------------------------*
DISPLAY-MESSAGE-LIST SECTION.
*---------------------------------------------------------------*
* This section creates a table of messages on the specified *
* queue. This table is then displayed and the number of a *
* desired message can be input. The details of the chosen *
* message are placed into the ISPF shared variable pool. *
*---------------------------------------------------------------*
*
* *
* Get the current queue depth. *
* Upon an error exit to calling section. *
* *
PERFORM CURRENT-Q-DEPTH.
IF (MQRC-NONE NOT = W02-REASON) THEN
GO TO DISPLAY-MESSAGE-LIST-EXIT
END-IF.
* *
* Create the message table to be displayed. *
* Upon an error exit to calling section. *
* *
PERFORM CREATE-MSG-TABLE.
IF (MQRC-NONE NOT = W02-REASON) THEN
GO TO DISPLAY-MESSAGE-LIST-EXIT
END-IF.
* *
* Set the table cursor to the first element in the table. *
* If this fails display an error message and exit to *
* the calling section. *
* *
CALL 'ISPLINK' USING ITBTOP IMSG-TABLE.
IF (0 NOT = RETURN-CODE) THEN
MOVE RETURN-CODE TO W02-REASON
MOVE W02-REASON TO W02-REASON-CHAR
STRING 'Message table handling error. Return Code : ',
W02-REASON-CHAR,
DELIMITED BY SIZE INTO W01-MESSAGE
PERFORM PRINT-MESSAGE
GO TO DISPLAY-MESSAGE-LIST-EXIT
END-IF.
* *
* Display the ISPF panel and message table. *
* Upon failure exit to calling section. *
* *
CALL 'ISPLINK' USING ITBDISPL IMSG-TABLE IPANEL2.
IF (0 NOT = RETURN-CODE) THEN
MOVE RETURN-CODE TO W02-REASON
GO TO DISPLAY-MESSAGE-LIST-EXIT
END-IF.
* *
* Get the chosen message number. *
* If an error occurs display *
* message and return. *
* *
CALL 'ISPLINK' USING IVGET IMSGNUM ISHARED.
MOVE W01-MSGNUM TO W01-LINENUM.
CALL 'ISPLINK' USING ITBGET IMSG-TABLE.
IF (0 NOT = RETURN-CODE) THEN
MOVE RETURN-CODE TO W02-REASON
MOVE W02-REASON TO W02-REASON-CHAR
STRING 'Message table handling error. Return Code : ',
W02-REASON-CHAR,
DELIMITED BY SIZE INTO W01-MESSAGE
PERFORM PRINT-MESSAGE
GO TO DISPLAY-MESSAGE-LIST-EXIT
END-IF.
* *
* Copy the chosen message details from table into *
* the ISPF shared variable pool. *
* *
CALL 'ISPLINK' USING IVPUT IMSGID ISHARED.
CALL 'ISPLINK' USING IVPUT ICORRELID ISHARED.
*
DISPLAY-MESSAGE-LIST-EXIT.
*
EXIT.
EJECT
*
*---------------------------------------------------------------*
CREATE-MSG-TABLE SECTION.
*---------------------------------------------------------------*
* This section tries to create an ISPF table with a maximum *
* length of 99. The table created consists of details of the *
* first 99, at most, messages browsed in the specified queue. *
*---------------------------------------------------------------*
*
* *
* Set the number of messages in table to zero. *
* *
MOVE '00' TO W01-NUMMSGS.
* *
* Set up MQGET variables and browse the first message. *
* *
MOVE MQMI-NONE TO MQMD-MSGID.
MOVE MQCI-NONE TO MQMD-CORRELID.
COMPUTE MQGMO-OPTIONS = MQGMO-BROWSE-FIRST +
MQGMO-NO-WAIT +
MQGMO-ACCEPT-TRUNCATED-MSG +
MQGMO-NO-SYNCPOINT.
*
CALL 'MQGET' USING W01-HCONN
W01-HOBJ
MQMD
MQGMO
I99
W02-MSGBUFFER
W02-DATALENGTH
W02-COMPCODE
W02-REASON.
* *
* If MQGET failed displayed an appropriate error message *
* and return to the calling section. *
* *
* If successful set the MQGET browse options for further *
* calls to MQGET. *
* *
IF (MQCC-FAILED NOT = W02-COMPCODE) THEN
COMPUTE MQGMO-OPTIONS = MQGMO-BROWSE-NEXT +
MQGMO-NO-WAIT +
MQGMO-ACCEPT-TRUNCATED-MSG +
MQGMO-NO-SYNCPOINT
ELSE
EVALUATE TRUE
WHEN (MQRC-GET-INHIBITED = W02-REASON)
MOVE 'Get Inhibited set on queue.' TO W00-ERRORMSG
WHEN (MQRC-NO-MSG-AVAILABLE = W02-REASON)
MOVE 'No messages on queue.' TO W00-ERRORMSG
WHEN OTHER
MOVE 'Get from queue failed.' TO W00-ERRORMSG
END-EVALUATE
PERFORM ERROR-MESSAGE
GO TO CREATE-MSG-TABLE-EXIT
END-IF.
* *
* Create an ISPF table to hold the message details. *
* If create failed display an error message and *
* exit from the section. *
* NB: a return code of 4 from TBCREATE means that *
* a new table has been created replacing an old *
* table of the same name. This is not an error. *
* *
CALL 'ISPLINK' USING ITBCREATE
IMSG-TABLE
IMSG-TABLE-KEY IMSG-TABLE-FIELDS
INOWRITE IREPLACE.
IF (4 = RETURN-CODE) THEN
MOVE 0 TO RETURN-CODE
END-IF.
IF (0 NOT = RETURN-CODE) THEN
MOVE RETURN-CODE TO W02-REASON
MOVE W02-REASON TO W02-REASON-CHAR
STRING
'Creation of message table failed. Return Code : ',
W02-REASON-CHAR,
DELIMITED BY SIZE INTO W01-MESSAGE
PERFORM PRINT-MESSAGE
GO TO CREATE-MSG-TABLE-EXIT
END-IF.
* *
* While there is still space remaining in the ISPF table *
* place the message details into the table and read the *
* next message from the queue. *
* *
PERFORM WITH TEST AFTER VARYING W00-TABLESIZE FROM 1 BY 1
UNTIL (W00-TABLESIZE >= 99)
*
* *
* Copy details read from queue into ISPF table variables. *
* *
MOVE W00-TABLESIZE TO W00-TABLESIZE-CHAR
MOVE W00-TABLESIZE-CHAR TO W01-LINENUM
MOVE MQMD-PUTTIME TO W00-TIME
STRING W00-HOUR, ':',
W00-MIN, ':',
W00-SEC
DELIMITED BY SIZE INTO W01-PUTTIME
MOVE MQMD-PUTDATE TO W00-DATE
STRING W00-MONTH, '/',
W00-DAY, '/',
W00-YEAR
DELIMITED BY SIZE INTO W01-PUTDATE
MOVE MQMD-FORMAT TO W01-FORMATNAME
MOVE MQMD-USERIDENTIFIER TO W01-USERID
MOVE MQMD-PUTAPPLTYPE TO W00-PUTAPPLTYPETEMP
MOVE W00-PUTAPPLTYPETEMP TO W01-PUTAPPLTYPE
MOVE MQMD-PUTAPPLNAME TO W01-PUTAPPLNAME
* *
* Add a new line of table details to the message table. *
* If a failure occurs then display an error message *
* and return to calling section. *
* *
CALL 'ISPLINK' USING ITBADD IMSG-TABLE
IF (0 NOT = RETURN-CODE) THEN
MOVE RETURN-CODE TO W02-REASON
MOVE W02-REASON TO W02-REASON-CHAR
CALL 'ISPLINK' USING ITBEND IMSG-TABLE
STRING 'Addition to message table failed. ',
'Return Code : ', W02-REASON-CHAR
DELIMITED BY SIZE INTO W01-MESSAGE
PERFORM PRINT-MESSAGE
GO TO CREATE-MSG-TABLE-EXIT
END-IF
* *
* Blank the MsgId and CorrelId so that any message on *
* the queue will qualify on the next call to MQGET. *
* *
MOVE MQMI-NONE TO MQMD-MSGID
MOVE MQCI-NONE TO MQMD-CORRELID
*
CALL 'MQGET' USING W01-HCONN
W01-HOBJ
MQMD
MQGMO
I99
W02-MSGBUFFER
W02-DATALENGTH
W02-COMPCODE
W02-REASON
*
* *
* Check for a failure with the previous MQGET call. *
* If the failure was caused by having no more *
* messages on the queue then reset the error codes *
* and break from while loop. *
* Otherwise delete the message table, display an *
* error message and return from section. *
* *
* MQCC_WARNINGs are in relation to truncated *
* messages which are accepted and hence ignored. *
* *
IF (MQCC-FAILED = W02-COMPCODE) THEN
*
IF (MQRC-NO-MSG-AVAILABLE = W02-REASON) THEN
ADD 100 TO W00-TABLESIZE
MOVE MQRC-NONE TO W02-REASON
MOVE MQCC-OK TO W02-COMPCODE
ELSE
CALL 'ISPLINK' USING ITBEND IMSG-TABLE
MOVE 'Get from queue failed.' TO W00-ERRORMSG
PERFORM ERROR-MESSAGE
END-IF
*
ELSE
MOVE MQRC-NONE TO W02-REASON
MOVE MQCC-OK TO W02-COMPCODE
END-IF
*
END-PERFORM.
* *
* Copy the number of entries in the message table *
* into the ISPF shared variable pool. Ensure that the *
* message number is set to a message which exists. *
* *
MOVE W01-LINENUM TO W01-NUMMSGS.
CALL 'ISPLINK' USING IVPUT INUMMSGS ISHARED.
IF W01-MSGNUM > W01-NUMMSGS THEN
MOVE W01-NUMMSGS TO W01-MSGNUM
CALL 'ISPLINK' USING IVPUT IMSGNUM ISHARED
END-IF.
*
CREATE-MSG-TABLE-EXIT.
*
EXIT.
EJECT
*
*---------------------------------------------------------------*
CURRENT-Q-DEPTH SECTION.
*---------------------------------------------------------------*
* This section inquires on the current queue depth for the *
* specified queue and returns the depth if successful. *
*---------------------------------------------------------------*
*
MOVE MQIA-CURRENT-Q-DEPTH TO W02-SELECTORS.
MOVE 1 TO W02-SELECTORCOUNT.
MOVE 1 TO W02-INTATTRCOUNT.
MOVE 0 TO W02-CHARATTRLENGTH.
* *
* Call MQINQ with variables set to inquire the queue depth *
* *
CALL 'MQINQ' USING W01-HCONN
W01-HOBJ
W02-SELECTORCOUNT
W02-SELECTORS
W02-INTATTRCOUNT
W02-INTATTRS
W02-CHARATTRLENGTH
W02-CHARATTRS
W02-COMPCODE
W02-REASON.
* *
* If the inquire was successful then copy the queue depth *
* to the ISPF shared variable pool. *
* *
* A failure will cause an error message to be displayed. *
* *
IF (MQCC-OK = W02-COMPCODE) THEN
MOVE W02-INTATTRS TO W01-TOTALNUMMSGS
CALL 'ISPLINK' USING IVPUT ITOTALNUMMSGS ISHARED
ELSE
MOVE 'Error finding queue depth.' TO W00-ERRORMSG
PERFORM ERROR-MESSAGE
END-IF.
*
CURRENT-Q-DEPTH-EXIT.
*
EXIT.
EJECT
*
*---------------------------------------------------------------*
ERROR-MESSAGE SECTION.
*---------------------------------------------------------------*
* This section puts an error message to the ISPF panel. *
* The message consists of some text message, a completion code *
* and a reason code. *
*---------------------------------------------------------------*
*
MOVE W02-COMPCODE TO W02-COMPCODE-CHAR.
MOVE W02-REASON TO W02-REASON-CHAR.
*
STRING W00-ERRORMSG, ' CompCode: ',
W02-COMPCODE-CHAR, ' Reason: ',
W02-REASON-CHAR, ' '
DELIMITED BY SIZE INTO W01-MESSAGE.
*
PERFORM PRINT-MESSAGE.
*
ERROR-MESSAGE-EXIT.
*
EXIT.
EJECT
*
*---------------------------------------------------------------*
PRINT-MESSAGE SECTION.
*---------------------------------------------------------------*
* This section places a message onto the ISPF panel. *
*---------------------------------------------------------------*
*
CALL 'ISPLINK' USING IVPUT IMESSAGE ISHARED.
*
PRINT-MESSAGE-EXIT.
*
EXIT.
EJECT
*
*---------------------------------------------------------------*
ISPF-INIT SECTION.
*---------------------------------------------------------------*
* This section declares all variables which are to be stored *
* in the ISPF shared variable pool. These variables are used *
* with the ISPF panels or passed to the programs called. *
*---------------------------------------------------------------*
*
CALL 'ISPLINK' USING
IVDEFINE IQMGRNAME W01-QMGRNAME ICHAR I48 ICOPY.
CALL 'ISPLINK' USING
IVDEFINE IQNAME W01-QNAME ICHAR I48 ICOPY.
CALL 'ISPLINK' USING
IVDEFINE IHCONN W01-HCONN IFIXED I4 ICOPY.
CALL 'ISPLINK' USING
IVDEFINE IHOBJ W01-HOBJ IFIXED I4 ICOPY.
CALL 'ISPLINK' USING
IVDEFINE IMESSAGE W01-MESSAGE ICHAR I79 ICOPY.
*
CALL 'ISPLINK' USING
IVDEFINE IMSGNUM W01-MSGNUM ICHAR I2.
CALL 'ISPLINK' USING
IVDEFINE INUMMSGS W01-NUMMSGS ICHAR I2.
CALL 'ISPLINK' USING
IVDEFINE ITOTALNUMMSGS W01-TOTALNUMMSGS ICHAR I9.
*
CALL 'ISPLINK' USING
IVDEFINE ILINENUM W01-LINENUM ICHAR I2.
CALL 'ISPLINK' USING
IVDEFINE IMSGID MQMD-MSGID IBIT I24.
CALL 'ISPLINK' USING
IVDEFINE ICORRELID MQMD-CORRELID IBIT I24.
CALL 'ISPLINK' USING
IVDEFINE IPUTTIME W01-PUTTIME ICHAR I8.
CALL 'ISPLINK' USING
IVDEFINE IPUTDATE W01-PUTDATE ICHAR I8.
CALL 'ISPLINK' USING
IVDEFINE IFORMATNAME W01-FORMATNAME ICHAR I8.
CALL 'ISPLINK' USING
IVDEFINE IUSERID W01-USERID ICHAR I12.
CALL 'ISPLINK' USING
IVDEFINE IPUTAPPLTYPE W01-PUTAPPLTYPE ICHAR I8.
CALL 'ISPLINK' USING
IVDEFINE IPUTAPPLNAME W01-PUTAPPLNAME ICHAR I28.
*
ISPF-INIT-EXIT.
*
EXIT.
EJECT
*
* ------------------------------------------------------------- *
* End of program *
* ------------------------------------------------------------- *
¤ Dauer der Verarbeitung: 0.42 Sekunden
(vorverarbeitet)
¤
|
schauen Sie vor die Tür
Fenster
Die Firma ist wie angegeben erreichbar.
Die farbliche Syntaxdarstellung ist noch experimentell.
|
