Escape
From MidrangeWiki
Revision as of 19:39, 13 December 2018 by DaveLClarkI (talk | contribs)
Contents
Summary
The following are the RPG/LE fully free-form definitions and instructions needed for using the Escape service procedure. This service procedure simply allows the caller to send an escape message to a previous message queue in the call stack.
Service Procedure
**free //============================================================================== // Send an escape message to previous message queue in the caller's stack. // The returned value is the internal message key in the destination message // queue; else, high values in the case of an error situation. //============================================================================== dcl-pr GenUtl_Escape char(4); MsgId char(7) const options(*omit); MsgData varchar(3000) const options(*nopass:*omit); MsgFile char(10) const options(*nopass:*omit); MsgLib char(10) const options(*nopass:*omit); MsgCStkE char(10) const options(*nopass); MsgCStkC int(10:0) const options(*nopass); end-pr; //============================================================================== // Send an escape message to previous message queue in the caller's stack. // The returned value is the internal message key in the destination message // queue; else, high values in the case of an error situation. //============================================================================== dcl-proc GenUtl_Escape export; dcl-pi *n char(4); MsgId char(7) const options(*omit); MsgData varchar(3000) const options(*nopass:*omit); MsgFile char(10) const options(*nopass:*omit); MsgLib char(10) const options(*nopass:*omit); MsgCStkE char(10) const options(*nopass); MsgCStkC int(10:0) const options(*nopass); end-pi; dcl-s iMsgId char(7) inz('WSE9897'); // your default dcl-s iMsgFile char(10) inz('WSMSGF'); // your default dcl-s iMsgLib char(10) inz('*LIBL'); // your default dcl-s iMsgCStkE char(10) inz('*'); dcl-s iMsgCStkC int(10:0) inz(2); dcl-s iMsgKey char(4) inz(*hival); dcl-s iMsgCallStQ char(10) inz('*NONE'); dcl-s iMsgData varchar(3000) inz(''); if %parms() > *zero and %addr(MsgId) <> *null and MsgId > *blanks // message id required or %parms() > 1 // or and %addr(MsgData) <> *null and %len(MsgData) > *zero; // message data required if %parms() < %parmnum(MsgId) // if parm not passed or %addr(MsgId) = *null // or parm was omitted or MsgId <= *blanks; // or parm is blank else; // keep default, else iMsgId = MsgId; // use passed value endif; if %parms() < %parmnum(MsgData) // if parm not passed or %addr(MsgData) = *null // or parm was omitted or MsgData <= *blanks; // or parm is blank else; // keep default, else iMsgData = MsgData; // use passed value endif; if %parms() < %parmnum(MsgFile) // if parm not passed or %addr(MsgFile) = *null // or parm was omitted or MsgFile <= *blanks; // or parm is blank else; // keep default, else iMsgFile = MsgFile; // use passed value endif; if %parms() < %parmnum(MsgLib) // if parm not passed or %addr(MsgLib) = *null // or parm was omitted or MsgLib <= *blanks; // or parm is blank else; // keep default, else iMsgLib = MsgLib; // use passed value endif; if %parms() < %parmnum(MsgCStkE) // if parm not passed or %addr(MsgCStkE) = *null // or parm was omitted or MsgCStkE <= *blanks; // or parm is blank else; // keep default, else iMsgCStkE = MsgCStkE; // use passed value iMsgCStkC = *zero; endif; if %parms() < %parmnum(MsgCStkC) // if parm not passed or %addr(MsgCStkC) = *null; // or parm was omitted else; // keep default, else iMsgCStkC = MsgCStkC; // use passed value endif; reset ApiErrC; // reset any error if (GenUtl_LeftString(iMsgCStkE: 1) = '*'); // if not a program name callp IBMAPI_SendPgmMsg( iMsgId : iMsgFile + iMsgLib : iMsgData : %len(iMsgData) : '*ESCAPE' : iMsgCStkE : iMsgCStkC : iMsgKey : ApiErrC ); else; // else, use extended format callp IBMAPI_SendPgmMsg( iMsgId : iMsgFile + iMsgLib : iMsgData : %len(iMsgData) : '*ESCAPE' : '*PGMNAME' : iMsgCStkC : iMsgKey : ApiErrC : 10: iMsgCallStQ + iMsgCStkE: 0 ); endif; endif; return iMsgKey; // return to caller end-proc;
References
- ApiErrC — API Error Code
- GenUtl_LeftString service procedure
- Send Program Message (QMHSNDPM) API