RE: The ILE Question I Forgot to Ask

Really catching up on some old RPG list email...

We use a couple of subprocedures from a service program to handle this.
One is used to percolate up the message stack to find the "significant"
message. The other sends off the message to the staff as an email
displaying extensive fields from the program status data structure.

/eject
P*--------------------------------------
P* Procedure name: EXCPHDLR01
P* Purpose: Send a message to the programming staff to fix a bug.
P* Returns: Nothing.
P* Parameter: Subject of email
P* Initial body of email
P* Copy of the Program Status Data Structure
P* Stack count of program message queue (optional)
P*--------------------------------------
P EXCPHDLR01 B EXPORT
D EXCPHDLR01 PI
D Subject like(eSubject) const
D InitialBody like(eMessage) const
D ParmPSDS likeds(mypsds) const
D StackCount like(stackCnt) options(*nopass)
const
D LocalPSDS ds likeds(mypsds)
D Cmd2 s like(cmd)
D ds
D data 14a inz('CPF0001+
D CPF0006')
D TooGeneric 7a overlay(data) dim(2)
D lStackCnt s like(stackCnt)
/free
LocalPSDS=ParmPSDS;
// Generally this will be called by another program. Default the
message stack
// up two. One for the stack for FNDSIGMSG to EXCPHDLR01. Another one

// for EXCPHDLR01 to whomever called it.
Select;
When %parms<4;
lStackCnt=2;
Other;
lStackCnt=StackCount;
EndSl;
// We executed QCMDEXC. Often the exception id returned by the psds,

// Excp_Msg, was too generic and we needed to chase further up the
// sequence to find the 'real' message.
LocalPSDS=FndSigMsg(LocalPSDS:lStackcnt);
// Possible future enhancement. Use the API QMHRTVM to include first,
// any maybe even the second level text of the message.
cmd2='SNDEMEMC GROUP(PROGRAMING) SUBJECT(' + apos +
Subject + apos + ') MESSAGE(' + apos +
InitialBody + '<EOL>' +
'Msg_Id : ' + %trim(LocalPSDS.Excp_Msg) + '<EOL>' +
'Msg_Data: ' + %trim(LocalPSDS.Excp_Data) + '<EOL>' +
'Job : ' + %trim(LocalPSDS.Job_Name) + '<EOL>' +
'User : ' + %trim(LocalPSDS.User) + '<EOL>' +
'Number : ' + %trim(LocalPSDS.Job_NumA) + '<EOL>' +
'Routine : ' + %trim(LocalPSDS.Routine) + '<EOL>' +
'Module : ' + %trim(LocalPSDS.Proc_Mod) + '<EOL>' +
'Program : ' + %trim(LocalPSDS.Proc_Pgm) + '<EOL>' +
'Src_Lib : ' + %trim(LocalPSDS.Src_Lib) + '<EOL>' +
'Src_File: ' + %trim(LocalPSDS.Src_File) + '<EOL>' +
'Src_Mbr : ' + %trim(LocalPSDS.Src_Mbr) +
apos + ')';
// replace nulls with blanks otherwise system() assumes that the first
// null indicates the end of the command. Excp_Data often contains
// nulls and this was a kick in the groin.
cmd2=%xlate(x'00':' ':%trim(cmd2));
ErrorFlag=system(%trim(cmd2));
return;
/end-free
P EXCPHDLR01 E


P*--------------------------------------
P* Procedure name: FNDSIGMSG
P* Purpose: Find the significant message.
P* Returns: Copy of PSDS
P* Parameter: Copy of PSDS
P* Stack count of program message queue (optional)
P*--------------------------------------
P FNDSIGMSG B EXPORT
D FNDSIGMSG PI like(mypsds)
D ParmPSDS likeds(mypsds) const
D StackCount like(stackCnt) options(*nopass)
const
D ReturnPSDS ds likeds(mypsds)
D ds
D data 14a inz('CPF0001+
D CPF0006')
D TooGeneric 7a overlay(data) dim(2)
D lStackCnt s like(stackCnt)
/free
ReturnPSDS=ParmPSDS;
// Generally this will be called by another program. Default the
message stack
// up one.
Select;
When %parms<2;
lStackCnt=1;
Other;
lStackCnt=StackCount;
EndSl;
// We executed QCMDEXC. Often the exception id returned by the psds,
// Excp_Msg, was too generic and we needed to chase further up the
// sequence to find the 'real' message.
if %lookup(ParmPSDS.Excp_Msg : TooGeneric)>0;
MsgKey=*allx'00'; // initialize to nulls
Reset ERRC0100;
Reset RCVM0200;
Dow ExceptData=*blanks; // We will probably LEAVE out.
qmhrcvpm(rcvm0200:%len(rcvm0200):'RCVM0200':'*':lStackCnt:'*PRV':
MsgKey:0:'*SAME':ERRC0100);
Select;
When ExceptData<>*blanks;
Leave;
When %lookup(rcvm0200.MsgId : TooGeneric)>0;
// Skip these meaningless messages and find the 'meat'.
MsgKey=rcvm0200.MsgKey;
Iter;
Other;
ReturnPSDS.Excp_Msg=rcvm0200.MsgId;
ReturnPSDS.Excp_Data=%subst(rcvm0200.MsgTxt:
1:rcvm0200.LenTxtRet);
Leave;
EndSl;
EndDo;
EndIf;
return ReturnPSDS;
/end-free
P FNDSIGMSG E

Rob Berendt