Get Message Text

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;

References

• API Error Code Structure (ApiErrC)
• Retrieve Message (QMHRTVM) API