RE: *TERMSR (was: *INZSR - I still love you!!!)

No, that's needed too, what I mean is something that is called during a
normal end.


Bob Cozzi
Cozzi Consulting
www.rpgiv.com


-----Original Message-----
From: rpg400-l-bounces@xxxxxxxxxxxx [mailto:rpg400-l-bounces@xxxxxxxxxxxx]
On Behalf Of Buck
Sent: Tuesday, January 13, 2004 10:34 AM
To: rpg400-l@xxxxxxxxxxxx
Subject: *TERMSR (was: *INZSR - I still love you!!!)

Bob wrote:

> I also think *INZSR is a great feature and wish dearly that a *TERMSR
would
> have been implemented in RPG IV (I could still use it today, even more
so.)

Hi Bob!

I'm guessing that you mean something to get control on an abnormal end.  If
so, CEERTX can do that.  For the archives, here's a simplistic example.
  --buck

d regExitProc     pr                  extproc('CEERTX')
d  usrExitProc                    *   procptr const
d  inpData                        *   const options(*omit)
d  fc                           12          options(*omit)

d decodeFC        pr                  extproc('CEEDCOD')
d  fcInp                        12    const
d  msgSev                       10i 0
d  msgNo                        10i 0
d  case                         10i 0
d  severity                     10i 0
d  control                       2
d  facilityID                    3
d  isInfo                        4
d  fcOut                        12          options(*omit)

d usrExitProc     pr
d  inpData                        *   const options(*omit)

d syscall         pr            10i 0 extproc('system')
d   cmd                           *   value options(*string)

d OK              c                   0
d ErrorCode       s              7A   import('_EXCP_MSGID')

d token           s             48    inz('Test data from register
d                                          procedure')
d fc              s             12
d dummyAnswer     s              1
d msgSev          s             10i 0
d msgNo           s             10i 0
d case            s             10i 0
d severity        s             10i 0
d control         s              2
d facilityID      s              3
d isInfo          s              4

c* Change the job to log no commands
c                   if        syscall('chgjob log(0 99 *msg)') <> OK
c     'chgjob 0'    dump
c                   endif

c* Register the exit handler
c                   callp     regExitProc(%paddr('USREXITPROC'):
c                                         %addr(token):
c                                         fc)

c* Did that cause an error?
c                   callp     decodeFC(fc:
c                                      msgSev:
c                                      msgNo:
c                                      case:
c                                      severity:
c                                      control:
c                                      facilityID:
c                                      isInfo:
c                                      *omit)

c* Ask the user to kill the job stack entry
c* when you see this prompt, system request-2 to end the program
c     'endrqs'      dsply                   dummyAnswer       1

c                   seton                                        lr

p usrExitProc     b                   export
d usrExitProc     pi
d  inpData                        *   const options(*omit)

c     'Before chg'  dump

c                   if        syscall('chgjob log(4 0 *seclvl)') <> OK
c     'chgjob 1'    dump
c                   endif

p                 e



_______________________________________________
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.