RE: exit the program from the subprocedure

["Lim Hock-Chai" <Lim.Hock-Chai@xxxxxxxx>]

Buck:  Would the method mentioned below still work if I need to exit the 
program with *inlr off?  Another word, I need the storage to stay as it was if 
the program happen to be called again.

thanks for the tip.

-----Original Message-----
From: Buck [mailto:buck.calabro@xxxxxxxxxxxx]
Sent: Wednesday, June 18, 2003 10:34 AM
To: rpg400-l@xxxxxxxxxxxx
Subject: Re: exit the program from the subprocedure


> is there an easy way to exit the program from a subprocedure?

This list gave me the answer; I am happy to return something useful to the
list.
Send an escape message to the calling program.  This will cause an exception
(you need to trap it) in the calling program farther up the stack.

 * send the escape message that will terminate the caller
PescMsg           b
DescMsg           pi
D inpText                       80    const

 * Send message API parameters
D msgID           s              7    inz('CPF9898')
D msgFil          s             20    inz('QCPFMSG   *LIBL     ')
D msgData         s                   like(inpText)
D msgDataLen      s             10i 0 inz(%size(msgData))
D msgType         s             10    inz('*ESCAPE')
D msgStackEnt     s             10    inz('*CTLBDY')
D msgStackCnt     s             10i 0 inz(1)
D msgKey          s              4
D msgErrStruc     s                   like(ErrStruc)

 * API error structure
D errStruc        DS                  inz
D  errSSize                     10i 0 inz(%len(errStruc))
D  errSUse                      10i 0
D  errSmsgID                     7
D  errSResrv                     1
D  errSData                     80

C                   eval      msgData = inpText
C                   eval      msgErrStruc = errStruc

C                   Call(e)   'QMHSNDPM'
C                   Parm                    msgID
C                   Parm                    msgFil
C                   Parm                    msgData
C                   Parm                    msgDataLen
C                   Parm                    msgType
C                   Parm                    msgStackEnt
C                   Parm                    msgStackCnt
C                   Parm                    msgKey
C                   Parm                    msgErrStruc

C                   Eval      errStruc = msgErrStruc

 * last chance trap for proc
 * swallow errors without worry.  I don't care if sndmsg didn't work.
c     *pssr         begsr
c                   return
c                   endsr

PescMsg           e

c                   callp(e)  escMsg('RPG ABEND from main')

  --buck




_______________________________________________
This is the RPG programming on the AS400 / iSeries (RPG400-L) mailing list
To post a message email: RPG400-L@xxxxxxxxxxxx
To subscribe, unsubscribe, or change list options,
visit: http://lists.midrange.com/mailman/listinfo/rpg400-l
or email: RPG400-L-request@xxxxxxxxxxxx
Before posting, please take a moment to review the archives
at http://archive.midrange.com/rpg400-l.