Send Progarm Message

Hello all,

I've been trying to write a service program that wraps the QMHSNDPM and
QMHRMVPM API's. I've copied the code from the Doug Pence/Ron Hawkins
article from MC Press Online from a few years ago. No luck. It's like the
subfile is never being cleared. When I look at the job log, I get a Call
Stack Entry Not Found error. Here is the send code.

     Hnomain

     DsndErrMsg        PR                  opdesc
     D pMsgId                        10    const
     D pMsgData                   32766    const options(*varsize:*nopass)
     D pMsgInType                    10    const options(*nopass)
     D pMsgFile                      10    const options(*nopass)
     D pMsgLib                       10    const options(*nopass)

     PsndErrMsg        B                   export
     DsndErrMsg        PI                  opdesc
     D  MsgInId                      10    const
     D  MsgInData                 32766    const options(*varsize:*nopass)
     D  MsgInType                    10    const options(*nopass)
     D  MsgFile                      10    const options(*nopass)
     D  MsgLib                       10    const options(*nopass)

     DdefMsgFile       S             10    inz('QCPFMSG')
     DdefMsgLib        S             10    inz('QSYS')
     DdefMsgType       S             10    inz('*DIAG')
     DmsgFileLib       S             20
     DmsgData          S                   like(MsgInData)
     DmsgDataLen       S              6  0
     DmsgId            S             10
     DmsgKey           S              9b 0
     DmsgPgmQ          S             10
     DmsgQueNbr        S              9b 0
     DmsgType          S             10

     DerrorDS          DS                  inz
     D bytesProv               1      4b 0 inz(116)
     D bytesAval               5      8b 0
     D messageId               9     15
     D err###                 16     16
     D messageDta             17    116

     DCEEDOD           PR
     D parmNum                       10i 0 const
     D                               10i 0
     D                               10i 0
     D                               10i 0
     D                               10i 0
     D                               10i 0
     D                               12a   options(*omit)

     DdescType         S             10i 0
     DdataType         S             10i 0
     DdescInfo1        S             10i 0
     DdescInfo2        S             10i 0
     DinLen            S             10i 0
     DhexLen           S             10i 0

      /free
        msgid = msgInId;

        if %parms > 1;
           callp CEEDOD(2:
                        descType:
                        dataType:
                        descInfo1:
                        descInfo2:
                        inLen:
                        *omit);
           msgDataLen = inLen;
           msgData = msgInData;
        else;
           clear msgDataLen;
           clear msgData;
        endif;

        if %parms >= 3;
           msgType = msgInType;
        else;
           msgType = defMsgType;
        endif;

        if %parms >= 4;
           msgFIleLib = msgFIle;
        else;
           msgFileLib = defMsgFile;
        endif;

        if %parms >= 5;
           %subst(msgFileLib:11:10) = msgLib;
        else;
           %subst(msgFileLib:11:10) = defMsgLib;
        endif;

      /end-free

     C                   call      'QMHSNDPM'
     c                   parm                    msgId
     c                   parm                    msgFIleLib
     C                   parm                    msgdata
     c                   parm                    msgdatalen
     c                   parm                    msgtype
     c                   parm      '*'           msgPgmQ
     c                   parm      1             msgQueNbr
     c                   parm                    msgKey
     C                   parm                    errords

     c                   return
     P                 E

And here is the code to test.

     HOPTION(*NODEBUGIO:*SRCSTMT)

     Ftestilemsgcf   e             workstn

     D/copy *libl/qrpglesrc,errmsgpr

     Dproc1            PR
     Dproc2            PR
     Dproc3            PR

     Dx                S              1  0

      /free


        rmvErrMsg();
        sndErrMsg('CPF9898':'Message from mainline');

        for x = 1 to 3;

           write msgctl;
           exfmt record;
           rmvErrMsg();

           select;
           when x = 1;
              proc1();
           when x = 2;
              proc2();
           when x = 3;
              proc3();
           other;
              leave;
           endsl;
        endfor;

        *inlr = *on;

      /end-free

     Pproc1            B
     Dproc1            PI
      /free
        sndErrMsg('CPF9898':'Message from Proc 1');
      /end-free
     P                 e

     Pproc2            B
     Dproc2            PI
      /free
        sndErrMsg('CPF9898':'Message from Proc 2');
      /end-free
     P                 e

     Pproc3            B
     Dproc3            PI
      /free
        sndErrMsg('CPF9898':'Message from Proc 3');
      /end-free
     P                 e

Thanks,

Mark

Mark D. Walter
Senior Programmer/Analyst
CCX, Inc.
mwalter@xxxxxxxxxx
http://www.ccxinc.com