| products/Sources/formale Sprachen/COBOL/verschiedene-Autoren/MQ-Series/ |
|
Quellcode-Bibliothek© Kompilation durch diese Firma[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]Datei: Kowalk-p39.cbl Sprache: CobolOriginal von: verschiedene© |
|
||||||
|
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.49 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.Bot Zugriff |
