Re: Open Source discussion on error handling was: RPGIII/RPG400 ERRORMONITORING

Just a few changes.
PgmStatus is an externally described program status data structure just
to keep from coding the same crap all the time. you can roll your own or
download mine from
http://www.springfieldtn.net/users/leslier/downloads.html

Compiles on V4R3     

     HDebug
      * Sample code to demonstrate use of *PSSR directing
      * traffic after an error occurs

      * Global declarations
     DErrFlag          S                   Like(*IN) Inz(*off)
     DErrorId          S              7A   Inz(*blanks)
     DErrorAct         S              6A   Inz('*DETC ')

      * Test numbers
     D POSITIVE        S              5S 0 Inz(15)
     D NEGATIVE        S              5S 0 Inz(-15)
     D ZERO            S              5S 0 Inz(0)
     D PI              S             10S 9 Inz(3.141592654)
     D Result          S              3S 0 Inz(0)

     DPgmStatus      ESDS                  ExtName(PGMSTATUS)

      *main()
     C                   if        not ErrFlag
     C                   exsr      RTNADD
     C                   exsr      RTNSUB
     C                   exsr      RTNMUL
     C                   exsr      RTNDIV

     C     Result        dsply
     C                   endif

     C                   Eval      *InLR=*On
     C                   return

     CSR   RTNADD        begsr
     C                   Eval      Result=ZERO+1
     C                   endsr

     CSR   RTNSUB        begsr
     C                   Eval      Result=ZERO-1
     C                   endsr

     CSR   RTNMUL        begsr
     C                   Eval      Result=ZERO*1
     C                   endsr

     CSR   RTNDIV        begsr
     C                   Eval      Result=PI/ZERO
     C                   endsr

     C     *PSSR         BegSR
     C                   eval      ErrFlag = *on
     C     ErrTyp        cat       CPFNUM:0      ErrorID

     C                   Select
     C                   when      ErrorId = 'MCH1211'
     C                   eval      Result = 0
     C                   EndSl

     C                   EndSR     ErrorAct

--
L. S. Russell Programmer/Analyst
Datrek Professional Bags, Inc.
2413 Industrial Drive
Springfield, TN. 37172
mailto:leslier@datrek.com
http://www.datrek.com
--
+---
| 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
+---