*PROCESS MACRO;
/*Module/File Name: IBMMSGS */
CE92MSG: PROC OPTIONS(MAIN);
%INCLUDE CEEIBMAW;
%INCLUDE CEEIBMCT;
/*************************************************************/
/* */
/* FUNCTION : CEEMOUT - dispatch a message to message file */
/* : CEENCOD - construct a condition token */
/* : CEEMGET - retrieve, format and store a message */
/* : CEEDCOD - decode an existing condition token */
/* : CEEMSG - retrieve, format, and dispatch a */
/* message to message file */
/* */
/* This example illustrates the invocation of the Language */
/* Environment message and condition handling services. */
/* It contructs a conditon token, retrieves the associated */
/* message, and outputs the message to the message file. */
/* */
/* This example program outputs the Language Environment */
/* message, "CEE0260S" */
/* */
/*************************************************************/
DCL MSGSTR CHAR(255) VARYING;
DCL MSGDEST REAL FIXED BINARY(31,0);
DCL MSGNUM REAL FIXED BINARY(15,0);
DCL CASE REAL FIXED BINARY(15,0);
DCL SEV REAL FIXED BINARY(15,0);
DCL SEV2 REAL FIXED BINARY(15,0);
DCL CNTRL REAL FIXED BINARY(15,0);
DCL FACID CHARACTER ( 3 );
DCL ISINFO REAL FIXED BINARY(31,0);
DCL MSGINDX REAL FIXED BINARY(31,0);
DCL 01 CTOK, /* Feedback token */
03 MsgSev REAL FIXED BINARY(15,0),
03 MsgNo REAL FIXED BINARY(15,0),
03 Flags,
05 Case BIT(2),
05 Severity BIT(3),
05 Control BIT(3),
03 FacID CHAR(3), /* Facility ID */
03 ISI /* Instance-Specific Information */
REAL FIXED BINARY(31,0);
DCL 01 FC, /* Feedback token */
03 MsgSev REAL FIXED BINARY(15,0),
03 MsgNo REAL FIXED BINARY(15,0),
03 Flags,
05 Case BIT(2),
05 Severity BIT(3),
05 Control BIT(3),
03 FacID CHAR(3), /* Facility ID */
03 ISI /* Instance-Specific Information */
REAL FIXED BINARY(31,0); DCL 01 MGETFC,
/* Feedback token */
03 MsgSev REAL FIXED BINARY(15,0),
03 MsgNo REAL FIXED BINARY(15,0),
03 Flags,
05 Case BIT(2),
05 Severity BIT(3),
05 Control BIT(3),
03 FacID CHAR(3), /* Facility ID */
03 ISI /* Instance-Specific Information */
REAL FIXED BINARY(31,0);
DCL MSGAREA CHAR(80);
PUT SKIP LIST('PL/I message example is now in motion');
MSGSTR = 'The following message, CEE0260S, is expected';
MSGDEST = 2;
/*************************************************************/
/* Call CEEMOUT to output informational message. */
/* Call CEEMSG to output error message if CEEMOUT fails. */
/*************************************************************/
CALL CEEMOUT ( MSGSTR, MSGDEST, FC );
IF ¬ FBCHECK( FC, CEE000 ) THEN
CALL CEEMSG( FC, MSGDEST, MGETFC );
/*************************************************************/
/* Set up token fields for creation of a condition token */
/*************************************************************/
SEV = 3;
MSGNUM = 260;
CASE = 1;
SEV2 = 3;
CNTRL = 1;
FACID = 'CEE';
ISINFO = 0;
/*************************************************************/
/* Call CEENCOD to construct a condition token */
/*************************************************************/
CALL CEENCOD ( SEV, MSGNUM, CASE, SEV2, CNTRL, FACID,
ISINFO, CTOK, FC );
IF FBCHECK( FC, CEE000) THEN DO;
MSGINDX = 0;
MSGAREA = ' ';
/**********************************************************/
/* Call CEEMGET to retrieve message 260. Since */
/* message 260 is longer than the length of MSGAREA, */
/* a DO UNTIL statement loop is used to call CEEMGET */
/* multiple times until the message index is zero. */
/**********************************************************/
Retrieve_Message:
DO UNTIL( MSGINDX = 0 );
CALL CEEMGET ( CTOK, MSGAREA, MSGINDX, MGETFC );
IF ¬ FBCHECK( MGETFC, CEE000) THEN DO;
/****************************************************/
/*Call CEEDCOD to decode CEEMGET's feedback token */
/****************************************************/
CALL CEEDCOD ( MGETFC, SEV, MSGNUM,
CASE, SEV2, CNTRL, FACID, ISINFO, FC );
IF ¬ FBCHECK( FC, CEE000) THEN DO;
/*************************************************/
/* Call CEEMSG to output the error message */
/* associated with feedback token from CEEMGET. */
/*************************************************/
CALL CEEMSG ( MGETFC, MSGDEST, FC );
IF ¬ FBCHECK( FC, CEE000) THEN DO;
PUT SKIP LIST ('Error ' || FC.MsgNo
|| ' from CEEMSG');
STOP;
END;
/*************************************************/
/* If decoded message number is not 455, */
/* then CEEMGET actually failed with error. */
/*************************************************/
IF ( MGETFC.MsgNo ¬= 455) THEN DO;
PUT SKIP LIST( 'Error ' || MGETFC.MsgNo
|| ' retrieving message CEE0260S');
STOP;
END;
END;
END;
/*******************************************************/
/* Call CEEMOUT to output each portion of message 260 */
/*******************************************************/
MSGSTR = MSGAREA;
CALL CEEMOUT ( MSGSTR, MSGDEST, FC );
IF (MSGINDX = 0) THEN DO;
PUT SKIP LIST ('**********************************');
PUT SKIP LIST ('PL/I message example program ended');
PUT SKIP LIST ('**********************************');
END;
END Retrieve_Message /* END DO UNTIL MSGINDX = 0 */;
END /* CEENCOD successful */;
ELSE DO;
PUT SKIP LIST ('Error ' || FC.MsgNo
|| ' in encoding condition token');
END;
END CE92MSG;