RE: The ILE Question I Forgot to Ask

[rob@xxxxxxxxx]

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