Re: removes a specific message from the program queue

On 10/4/2018 6:56 AM, gio.cot wrote:

I have a RPG that use QMHSNDPM and QMHRMVPM, to menage message in

display

file

Suppose that i don't want show same system messages like CPF5020

Subfile

record non found .. how can i do ? before run QMHSNDPM, is it possible

to

delete some message from program queue by message code ?

I have a service procedure which I created to allow RPG programs
to remove the last message from the queue for detected and handled errors.
I use the IBM QMHRCVPM API for this. For example:

monitor; // prevent errors
ExtDiff = ImLfDtl_View2.YtdItmExt - ImLfDtl_View2.BoyItmExt;
on-error; // variance too great?
if ImLfDtl_View2.YtdItmExt < ImLfDtl_View2.BoyItmExt;
ExtDiff = *loval; // set to minimum
else; // else
ExtDiff = *hival; // set to maximum
endif;
callp CrsApp_RemoveLastMessage();
endmon;


This is the prototype I created for that API:


*========================================================================*
* IBM API to Receive from a Program Message Queue
*
* EXAMPLE:
* callp IBMAPI_RecvPgmMsg( QMHM020000: %len(QMHM020000): 'RCVM0200'
* : '*': 0: '*LAST': ' ': 0: '*REMOVE': ApiErrC);
* if (ApiErrC.BytAvail > *zero); // if an error occurred
* // desired error handling goes here
* endif;
*
* DOCUMENTATION:
*
http://publib.boulder.ibm.com/infocenter/iseries/v6r1m0/topic/apis/QMHRCVPM.htm

*========================================================================*
D IBMAPI_RecvPgmMsg...
D PR ExtPgm('QMHRCVPM')
D MsgRcvr LikeDS(QMHM020000) Options(*Varsize)
D MsgRLen 10i 0 Const
D MsgRFmt 8a Const
D MsgCallStE 200a Const
D MsgCallStC 10i 0 Const
D MsgType 10a Const
D MsgKey 4a Const
D MsgWaitT 10i 0 Const
D MsgAction 10a Const
D MsgErrC LikeDS(ApiErrC) Options(*Varsize)
D MsgCallStL 10i 0 Const Options(*Nopass)
D MsgCallStQ 20a Const Options(*Nopass)
D MsgCallStT 10a Const Options(*Nopass)
D MsgCcsId 10i 0 Const Options(*Nopass)
D MsgDftRpyR 10a Const Options(*Nopass)


This is the service procedure -- which you would have to customize
for your own use.

*========================================================================*
* This procedure removes the last message from the caller's program *
* message queue. Optionally, a copy of the message is returned to the *
* caller in the message format requested (default is RCVM0200). If an *
* an error occurs, a "false" Boolean value is returned. *
*========================================================================*
dcl-proc CrsApp_RemoveLastMessage export;
dcl-pi *n like(boolean_t);
pMsgRcvr char(32767) options(*nopass:*omit:*varsize);
pMsgRLen like(integer_t) const options(*nopass:*omit);
pMsgFmt like(char8_t) const options(*nopass:*omit);
pMessages likeds(CrsApp_Message)
dim(1) options(*nopass);
end-pi;

dcl-s iMsgRcvr like(pMsgRcvr);
dcl-s iMsgRLen like(pMsgRLen) inz(%len(iMsgRcvr));
dcl-s iMsgFmt like(pMsgFmt) inz('RCVM0200');

GenUtl_CStkE = GenUtl_FindCallStackEntry('*PRV': PROC_PGM); // get
caller info

if %parms >= %parmnum(pMsgRcvr) // if data area was passed
and %addr(pMsgRcvr) <> *null // and not omitted
and (%parms < %parmnum(pMsgRLen) // but area length not passed
or %addr(pMsgRLen) = *null) // or was omitted
or %parms >= %parmnum(pMsgRLen) // or area length was passed
and %addr(pMsgRLen) <> *null // and not omitted
and (%parms < %parmnum(pMsgRcvr) // but data area not passed
or %addr(pMsgRcvr) = *null); // or was omitted
GenUtl_Escape( *omit: 'Receiver & length parms required together.'
: *omit: *omit: GenUtl_CStkE.QWVPGMN ); // raise
exception condition
endif;

if %parms < %parmnum(pMsgRLen) // if parm not passed
or %addr(pMsgRLen) = *null // or was omitted
or pMsgRLen <= *zero; // or not supplied
else; // skip it, else
iMsgRLen = pMsgRLen; // use i
endif;

if %parms < %parmnum(pMsgFmt) // if parm not passed
or %addr(pMsgFmt) = *null // or was omitted
or pMsgFmt <= *blanks; // or not supplied
else; // skip it, else
iMsgFmt = pMsgFmt; // use it
endif;

reset ApiErrC; // trap API errors

callp IBMAPI_RecvPgmMsg( iMsgRcvr: iMsgRLen: iMsgFmt
: GenUtl_CStkE.QWVPN: *zero: '*LAST'
: *blank: *zero: '*REMOVE': ApiErrC
: %len(GenUtl_CStkE.QWVPN)
: GenUtl_CStkE.QWVMN
+ GenUtl_CStkE.QWVPGMN ); // remove message

if ApiErrC.BytAvail > *zero;
if %parms < %parmnum(pMessages) // if parm not passed
or %addr(pMessages) = *null; // or was omitted
else; // skip it, else
pMessages(1).inUse = *on; // pass back error info
pMessages(1).Id = ApiErrC.MsgId;
pMessages(1).Type = '*ESCAPE';
pMessages(1).File = 'QCPFMSG';
pMessages(1).FLib = '*LIBL';
pMessages(1).Data = ApiErrC.MsgData;
endif;
return *off; // indicate failure to the caller
endif;

if %parms < %parmnum(pMsgRcvr) // if parm not passed
or %addr(pMsgRcvr) = *null; // or was omitted
else; // skip it, else pass it back
%subst(pMsgRcvr: 1: iMsgRLen) = %subst(iMsgRcvr: 1: iMsgRLen);
endif;

return *on; // indicate success to the caller
end-proc;

Sincerely,

Dave Clark