Get Message Text
From MidrangeWiki
Summary
The following are the RPG/LE fully free-form definitions and instructions needed for using the Get Message Text service procedure. This service procedure simply allows the caller to retrieve the 1st and 2nd-level message text for a message id. Message substitution data may also be supplied.
By Dave Clark
Service Prototype
Place the following in a separate copybook for inclusion in both the caller and the service program source members.
**free //============================================================================== // This routine returns 1st and 2nd-level message texts for a specified message // file message id -- merging any substitution data, if supplied. // Note that any supplied substitution data must be a single string of data // with individual elements appropriately left-zeroed or right-blank padded and // then concatenated together in the format expected by the parameters of the // message definiton for the associated message id. //============================================================================== dcl-pr GenUtl_GetMessageText ind; pMsgId char(7) const; pMsgData varchar(3000) const options(*omit); pMsgText varchar(300); pHelpText varchar(3000) options(*nopass:*omit); pMsgFile char(10) const options(*nopass); pMsgLib char(10) const options(*nopass); end-pr;
Service Procedure
Place the following in a service program source member.
**free
ctl-opt NoMain AlwNull(*UsrCtl) Debug Option(*SrcStmt:*NoDebugIo)
DatFmt(*ISO) TimFmt(*ISO);
//==============================================================================
// This routine returns 1st and 2nd-level message texts for a specified message
// file message id -- merging any substitution data, if supplied.
// Note that any supplied substitution data must be a single string of data
// with individual elements appropriately left-zeroed or right-blank padded and
// then concatenated together in the format expected by the parameters of the
// message definiton for the associated message id.
//==============================================================================
dcl-proc GenUtl_GetMessageText export;
dcl-pi *n ind;
pMsgId char(7) const;
pMsgData varchar(3000) const options(*omit);
pMsgText varchar(300);
pHelpText varchar(3000) options(*nopass:*omit);
pMsgFile char(10) const options(*nopass);
pMsgLib char(10) const options(*nopass);
end-pi;
dcl-s Success ind inz(*on); // default to success
dcl-s iMsgData like(pMsgData) inz; // initialize length prefix
dcl-s iMsgFile like(pMsgFile) inz('WSMSGF'); // your default
dcl-s iMsgLib like(pMsgLib) inz('*LIBL'); // your default
dcl-s iMsgBufr char(4096); // API buffer area
dcl-s cSubReplData char(10) inz('*YES'); // replace data
if %parms > %parmnum(pMsgId) // if parm was passed
and %addr(pMsgData) <> *null // and not omitted
and pMsgData > *blanks; // and not blank
iMsgData = pMsgData; // use it
Else; // else
cSubReplData = '*NO'; // return substitution variables (&1)
endif;
if %parms > %parmnum(pHelpText) // if parm was passed
and %addr(pMsgFile) <> *null // and not omitted
and pMsgFile > *blanks; // and not blank
iMsgFile = pMsgFile; // use it
endif;
if %parms > %parmnum(pMsgFile) // if parm was passed
and %addr(pMsgLib) <> *null // and not omitted
and pMsgLib > *blanks; // and not blank
iMsgLib = pMsgLib; // use it
endif;
callp IBMAPI_RtvMsgDesc( iMsgBufr: %len(iMsgBufr): 'RTVM0100': pMsgId
: iMsgFile + iMsgLib: iMsgData: %len(iMsgData)
: cSubReplData: '*YES': ApiErrC ); // retrieve message
if ApiErrC.BytAvail > *zero; // if error information returned
Success = *off; // indicate message retrieval has failed
callp IBMAPI_RtvMsgDesc( iMsgBufr: %len(iMsgBufr): 'RTVM0100'
: ApiErrC.MsgId: 'QCPFMSG *LIBL': ApiErrC.MsgData
: %subst(ApiErrC.MsgData: 1: ApiErrC.BytAvail - 16)
: '*YES': '*YES': ApiErrC ); // retrieve message
if ApiErrC.BytAvail > *zero; // if there is still an error
pMsgText = 'Message id ' + ApiErrC.MsgId + ' encountered while'
+ ' retrieving error message from system message file.';
if %parms > %parmnum(pMsgText) // if parm for 2nd-level text passed
and %addr(pHelpText) <> *null; // and not as *omit
pHelpText = ''; // pass back empty 2nd-level text
endif;
return Success; // return indication to caller
endif;
endif;
QMHM010004 = iMsgBufr; // map the message buffer header
pMsgText = %subst( iMsgBufr: %len(QMHM010004) + 1
: QMHLMRTN02 ); // pass back 1st-level text
if %parms > %parmnum(pMsgText) // if parm for 2nd-level text passed
and %addr(pHelpText) <> *null; // and not as *omit
pHelpText = %subst( iMsgBufr: %len(QMHM010004) + QMHLMRTN02 + 1
: QMHLHRTN02 ); // pass back 2nd-level text
endif;
return Success; // return indication to caller
end-proc;
