Re: Return error to FTP RCMD

On Wed, 29 Nov 2000, Steve Moland wrote:

((( SNIP )))

> I've tried used Qcmdexc from with the RPG pgm to do the following
> SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG)  MSGDTA('THIS PGM FAILED')
> MSGTYPE(*ESCAPE)
> 
> After executing this I ended the RPG pgm normally. FTP got a 250 message for
> a successful execution. I put the SNDPGMMSG in a CL pgm and called it
> directly from FTP and my error text message appeared in an FTP 550 message.
>  
> Any ideas on why I can't accomplish sending back the error message
> from within the RPG pgm. 
>  
> Steve Moland 
>  

First of all... you didn't send this message from within your RPG program,
you sent it from within the QCMDEXC program.  If SNDPGMMSG worked from
QCMDEXC the message would be returned to your RPG program, not to the FTP
server... :)

Secondly, SNDPGMMSG can't be run from QCMDEXC.  Your job log should show
a "CPD0031" message that states "Command SNDPGMMSG not allowed in this
setting."

Instead of trying QCMDEXC, try the Send Program Message API, "QMHSNDPM",
which is documented in the "Message Handling API's Manual".

Here's a quick example:

     D*****************************************************
     D* API error code data structure
     D*****************************************************
     D dsEC            DS
     D*                                    Bytes Provided (size of struct)
     D  dsECBytesP             1      4B 0 INZ(256)
     D*                                    Bytes Available (returned by API)
     D  dsECBytesA             5      8B 0 INZ(0)
     D*                                    Msg ID of Error Msg Returned
     D  dsECMsgID              9     15
     D*                                    Reserved
     D  dsECReserv            16     16
     D*                                    Msg Data of Error Msg Returned
     D  dsECMsgDta            17    256

     D*****************************************************
     D* Prototype for Send Program Message API
     D*****************************************************
     D SndPgmMsg       PR                  ExtPgm('QMHSNDPM')
     D   MessageID                    7A   Const
     D   QualMsgF                    20A   Const
     D   MsgData                  32766A   options(*varsize) const
     D   MsgDtaLen                   10I 0 Const
     D   MsgType                     10A   Const
     D   CallStkEnt                  10A   Const
     D   CallStkCnt                  10I 0 Const
     D   MessageKey                   4A
     D   ErrorCode                32766A   options(*varsize)

     D MsgKey          S              4A
     D Msg             S             50A

     c                   callp     SndPgmMsg('CPF9897': 'QCPFMSG   *LIBL':
     c                                'This is an ESCAPE message!': 26:
     c                                '*ESCAPE': '*PGMBDY': 1: MsgKey: dsEC)

     c                   if        dsECBytesA > 0
     c                   eval      Msg = 'QMHSNDPM failed with ' + dsECMsgID
     c                   dsply                   Msg
     c                   endif

     c                   eval      *inlr = *on

+---
| This is the RPG/400 Mailing List!
| To submit a new message, send your mail to RPG400-L@midrange.com.
| To subscribe to this list send email to RPG400-L-SUB@midrange.com.
| To unsubscribe from this list send email to RPG400-L-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator: david@midrange.com
+---