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

["Buck" <buck.calabro@xxxxxxxxxxxx>]

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