PSDS with *PSSR to catch program exceptions in RPG AS400

PSDS with *PSSR to catch program exceptions in RPG AS400
PSDS with PSSR to catch program exceptions in RPG AS400, PSSR, error subroutine in rpgle, pssr subroutine, subroutine, psds, program status data strucure, ds, data structure, exception handling in rpgle, error handling in rpgle , as400, ibmi, how, about, introduction
PSDS with PSSR to catch program exceptions in RPG AS400

Program Status Data Structure (PSDS)

You can read more about PSDS by reading the following article.

  • Program Status Data Structure in RPGLE AS400
  • Using Program Error Subroutine (*PSSR)

    We can write *PSSR subroutine in our RPG program to handle the program errors/exception

    When any error/exception occurs in the RPG program following things happen if we coded PSDS and *PSSR in our RPG program.

  • PSDS gets updated.
  • If any error occurs the control transfer to the *PSSR subroutine.
  • You can code a *PSSR subroutine for all the subprocedures in the module and each *PSSR is local to the subprocedure in which it is coded.

    Example of PSDS with *PSSR to catch program exceptions in RPGLE

    Here in this example, we will divide a number by zero in RPGLE. We will write the code in Fixed format, /Free and Fully Free RPG.

    RPG Code in Fixed format for program status data structure in RPG AS400
          * Program status data structure                                                             
          * program exception available to rpg program (1 psds per module)                            
                                                                                                      
         D psds1          SDS                                                                         
         D proc_name         *proc                                                  * module/program  
          * 1 to 10 position, 10 chars                                                                
         D pgm_status        *status                                                * status code     
          * 11 to 15 position, (5,0) zoned decimal                                                    
         D pgm_prvstatus          16     20S 0                                      * Prev. status    
         D src_listing            21     28                                         * src. list line  
         D routine           *routine                                               * routine         
          * 29 to 36 position, 8 chars                                                                
          * *INIT  --> program initialization                                                         
          * *DETL  --> detail lines                                                                   
          * *GETIN --> get input record                                                               
          * *TOTC  --> Total calculations                                                             
          * *TOTL  --> Total lines                                                                    
          * *DETC  --> Detail calculations                                                            
          * *OFL   --> Overflow lines                                                                 
          * *TERM  --> Program ending                                                                    
          * *ROUTINE --> name of program or procedure called (first 8 chars)                             
         D parms             *parms                                                 * no. of parms pass  
          * 37 to 39 position, (3,0) zoned decimal                                                       
         D excptype               40     42                                         * exception type     
          * CPF --> operating system exception                                                           
          * MCH --> machine exception                                                                    
         D excpnum                43     46                                         * exception number   
          * CPF --> CPF message number                                                                   
          * MCH --> MCH message number                                                                   
         D reserved1              47     50                                         * reserved           
         D workarea               51     80                                         * internal use by    
                                                                                    * ILE RPG compiler   
         D pgmlib                 81     90                                         * prgram library     
         D excpdata               91    170                                         * exception data     
         D excpcause             171    174                                         * exception that     
                                                                                    * cause RNX9001      
         D filename              175    184                                         * file name on whic  
                                                                                    *h last file operati 
                                                                                    *on occur updated on 
                                                                                    *ly when error occur   
         D unused                185    190                                         * unused               
         D date                  191    198                                         * date(*date format)   
         D yy                    199    200S 0                                      * first two digits     
                                                                                    * of 4 digit year      
         D filenametrn           201    208                                         * file name truncate   
                                                                                    * (175-184 pos above   
         D statusinfo            209    243                                         * status info on las   
                                                                                    *t file used           
         D jobname               244    253                                         * job name             
         D username              254    263                                         * user name            
         D jobnumber             264    269                                         * job number           
         D date2                 270    275S 0                                      * date (udate format   
                                                                                    * pgm running          
                                                                                    * (191-198 pos above   
         D pgmrundate            276    281S 0                                      * date of pgm runnin   
         D time                  282    287S 0                                      * time (hhmmss)        
                                                                                    * pgm running          
         D date3                 288    293                                         * date (udate format   
                                                                                    * pgm compiled         
         D time2                 294    299                                         * time (hhmmss)      
                                                                                    * pgm compiled       
         D cmplevel              300    303                                         * compiler level     
         D srcfile               304    313                                         * src file name      
         D srclib                314    323                                         * src lib name       
         D srcmbr                324    333                                         * src file member    
         D pgmproc               334    343                                         * pgm containing     
                                                                                    * procedure          
         D modproc               344    353                                         * module containing  
                                                                                    * procedure          
         D srcid                 354    355B 0                                      * src id match the   
          * binary  2 (5i,0)                                                                             
                                                                                    * statement number   
                                                                                    * from pos 21-28     
         D srcid2                356    357B 0                                      * src id match the   
          * binary  2 (5i,0)                                                                             
                                                                                    * statement number   
                                                                                    * from pos 228-235   
         D curuserprf            358    367                                         * current user profi 
         D exterrorcd            368    371I 0                                      * external error cod 
          * Integer (10,0)                                                                                
         D elements              372    379I 0                                      * elements set by XM  
          * Integer (20,0)                                                                                
                                                                                    *L-INTO or DATA-INTO  
         D internaljobid         380    395                                         * internal job id     
         D systemname            396    403                                         * system name         
         D unused2               404    429                                         * unused              
     
          *variable                                                                                        
         D num1            S              1P 0 INZ(3)                                                      
         D num2            S              1P 0 INZ(0)                                                      
         D result          S              1P 0 INZ(0)                                                      
         D returncode      S              6A                                                               
         D DIVIDEBYZERO    S             20A   INZ('DIVIDE BY ZERO')                                       
         D STATUSCD        S             50A   INZ('ERROR OCCUR WITH STATUS CODE')                         
                                                                                                           
         C     num1          DIV       num2          result                                                
         C     RESULT        DSPLY                                                                         
         C                   EVAL      *INLR  =  *ON                 
                                                                     
         C     *PSSR         BEGSR                                   
         C                   IF        PGM_STATUS = 00102            
         C     DIVIDEBYZERO  DSPLY                                   
         C*                  EVAL      RETURNCODE = ' '              
         C                   EVAL      RETURNCODE = '*CANCL'         
         C*                  EVAL      RETURNCODE = '*GETIN'         
         C                   ELSE                                    
         C     STATUSCD      DSPLY                                   
         C     PGM_STATUS    DSPLY                                   
         C                   EVAL      RETURNCODE = '*CANCL'         
         C                   ENDIF                                   
         C                   ENDSR     returncode                                                                                                                     
                                                                                                                                                                                                                                                             
    
    RPG Code in /Free format for program status data structure in RPG AS400
                               
          * Program status data structure                                                             
          * program exception available to rpg program (1 psds per module)                            
                                                                                                      
         D psds1          SDS                                                                         
         D proc_name         *proc                                                  * module/program  
          * 1 to 10 position, 10 chars                                                                
         D pgm_status        *status                                                * status code     
          * 11 to 15 position, (5,0) zoned decimal                                                    
         D pgm_prvstatus          16     20S 0                                      * Prev. status    
         D src_listing            21     28                                         * src. list line  
         D routine           *routine                                               * routine         
          * 29 to 36 position, 8 chars                                                                
          * *INIT  --> program initialization                                                         
          * *DETL  --> detail lines                                                                   
          * *GETIN --> get input record                                                               
          * *TOTC  --> Total calculations                                                             
          * *TOTL  --> Total lines                                                                    
          * *DETC  --> Detail calculations                                                            
          * *OFL   --> Overflow lines                                                                 
          * *TERM  --> Program ending                                                                    
          * *ROUTINE --> name of program or procedure called (first 8 chars)                             
         D parms             *parms                                                 * no. of parms pass  
          * 37 to 39 position, (3,0) zoned decimal                                                       
         D excptype               40     42                                         * exception type     
          * CPF --> operating system exception                                                           
          * MCH --> machine exception                                                                    
         D excpnum                43     46                                         * exception number   
          * CPF --> CPF message number                                                                   
          * MCH --> MCH message number                                                                   
         D reserved1              47     50                                         * reserved           
         D workarea               51     80                                         * internal use by    
                                                                                    * ILE RPG compiler   
         D pgmlib                 81     90                                         * prgram library     
         D excpdata               91    170                                         * exception data     
         D excpcause             171    174                                         * exception that     
                                                                                    * cause RNX9001      
         D filename              175    184                                         * file name on whic  
                                                                                    *h last file operati 
                                                                                    *on occur updated on 
                                                                                    *ly when error occur   
         D unused                185    190                                         * unused               
         D date                  191    198                                         * date(*date format)   
         D yy                    199    200S 0                                      * first two digits     
                                                                                    * of 4 digit year      
         D filenametrn           201    208                                         * file name truncate   
                                                                                    * (175-184 pos above   
         D statusinfo            209    243                                         * status info on las   
                                                                                    *t file used           
         D jobname               244    253                                         * job name             
         D username              254    263                                         * user name            
         D jobnumber             264    269                                         * job number           
         D date2                 270    275S 0                                      * date (udate format   
                                                                                    * pgm running          
                                                                                    * (191-198 pos above   
         D pgmrundate            276    281S 0                                      * date of pgm runnin   
         D time                  282    287S 0                                      * time (hhmmss)        
                                                                                    * pgm running          
         D date3                 288    293                                         * date (udate format   
                                                                                    * pgm compiled         
         D time2                 294    299                                         * time (hhmmss)      
                                                                                    * pgm compiled       
         D cmplevel              300    303                                         * compiler level     
         D srcfile               304    313                                         * src file name      
         D srclib                314    323                                         * src lib name       
         D srcmbr                324    333                                         * src file member    
         D pgmproc               334    343                                         * pgm containing     
                                                                                    * procedure          
         D modproc               344    353                                         * module containing  
                                                                                    * procedure          
         D srcid                 354    355B 0                                      * src id match the   
          * binary  2 (5i,0)                                                                             
                                                                                    * statement number   
                                                                                    * from pos 21-28     
         D srcid2                356    357B 0                                      * src id match the   
          * binary  2 (5i,0)                                                                             
                                                                                    * statement number   
                                                                                    * from pos 228-235   
         D curuserprf            358    367                                         * current user profi 
         D exterrorcd            368    371I 0                                      * external error cod 
          * Integer (10,0)                                                                                
         D elements              372    379I 0                                      * elements set by XM  
          * Integer (20,0)                                                                                
                                                                                    *L-INTO or DATA-INTO  
         D internaljobid         380    395                                         * internal job id     
         D systemname            396    403                                         * system name         
         D unused2               404    429                                         * unused              
                                                                                                          
          *variable                                                         
         D num1            S              1P 0 INZ(3)                       
         D num2            S              1P 0 INZ(0)                       
         D result          S              1P 0 INZ(0)                       
         D returncode      S              6A                                
    
          /Free                                                                 
           // DSPMSGD RANGE(*FIRST *LAST) MSGF(QRNXMSG) DETAIL(*BASIC)          
              result = num1/num2;                                               
              DSPLY result;                                           
              *INLR  = *ON;                                                     
                                                                                
               // Normal Codes                                                  
               // 00000 --> No Exception/Error                                  
               // 00001 --> Called program returned with the LR indicator on.   
               // 00050 --> Conversion resulted in substitution.                              
                                                                                              
               // Exception/Error codes                                                       
               // 00100 --> Value out of range for string operation                           
               // 00102 --> Divide by zero                                                    
               // 00105 --> Invalid characters in character to numeric conversion functions.  
               // 00112 --> Invalid Date, Time or Timestamp value.                            
               // 00113 --> Date overflow or underflow.                                       
               // 00114 --> Date mapping errors                                               
               // 00120 --> Table or array out of sequence.                                   
               // 00121 --> Array index not valid                                             
               // 00122 --> OCCUR outside of range                                            
               // 00211 --> Error calling program or procedure                                
               // 00222 --> Pointer or parameter error                                        
               // 00333 --> Error on DSPLY operation                                          
               // 00351 --> Error parsing XML document                                        
               // 00352 --> Invalid option for %XML                                           
               // 00353 --> XML document does not match RPG variable                          
               // 00354 --> Error preparing for XML parsing                                   
               // 00401 --> Data area specified on IN/OUT not found                           
               // 00411 --> Data area type or length does not match                                      
               // 00412 --> Data area not locked for output                                              
               // 00413 --> Error on IN/OUT operation                                                    
               // 00414 --> User not authorized to use data area                                         
               // 00415 --> User not authorized to change data area                                      
               // 00421 --> Error on UNLOCK operation                                                    
               // 00425 --> Length requested for storage allocation is out of range                      
               // 00431 --> Data area previously locked by another program                               
               // 00432 --> Data area locked by program in the same process                              
               // 00450 --> Character field not entirely enclosed by shift-out and shift-in characters   
               // 00451 --> Conversion between two CCSIDs is not supported                               
               // 00452 --> Some characters could not be converted between two CCSIDs                    
               // 00453 --> An error occurred during conversion between two CCSIDs                       
               // 00803 --> Rollback operation failed.                                                   
               // 00804 --> Error occurred on COMMIT operation                                           
               // 00805 --> Error occurred on ROLBK operation                                            
               // 00907 --> Decimal data error (digit or sign not valid)                                 
               // 09999 --> Program exception in system routine.                                         
                                                                                                         
              //________________________________________________________________                         
              Begsr *pssr;                                                       
                If PGM_STATUS = 00102;                                           
                  DSPLY 'ERROR: DIVIDE BY ZERO';                                 
                    returncode = ' ';                                            
                     //returncode = '*CANCL';                                    
                    //returncode = '*GETIN';                                     
                Else;                                                            
                  DSPLY 'ERROR OCCURRED WITH STATUS CODE';                       
                  DSPLY PGM_STATUS;                                              
                  returncode = '*CANCL';                                         
                EndIf;                                                           
              endsr returncode;                                                  
              //________________________________________________________________ 
          /End-Free                                                                                                                                                                                                            
    
    RPG Code in Fully Free format for program status data structure in RPG AS400
    **FREE                                                              
      //Program status data structure                                   
      //program exception available to rpg program (1 psds per module)  
    dcl-ds psds1 psds;                                                  
      proc_name *proc; // module/program                                
          // 1 to 10 position, 10 chars                                 
      pgm_status *status;  // status code                               
          // 11 to 15 position, (5,0) zoned decimal                     
      pgm_prvstatus zoned(5);// Prev. status                            
      src_listing   char(8); // src. list line                          
      routine *routine; // routine                                      
         // 29 to 36 position, 8 chars                                  
         // *INIT  --> program initialization                           
         // *DETL  --> detail lines                                     
         // *GETIN --> get input record                                 
         // *TOTC  --> Total calculations                               
         // *TOTL  --> Total lines                                      
         // *DETC  --> Detail calculations                              
         // *OFL   --> Overflow lines                                   
         // *TERM  --> Program ending                                                                  
         // *ROUTINE --> name of program or procedure called (first 8 chars)                           
      parms *parms;  // no. of parms pass                                                              
         // 37 to 39 position, (3,0) zoned decimal                                                     
      excptype  char(3); //  exception type                                                            
         // CPF --> operating system exception                                                         
         // MCH --> machine exception                                                                  
      excpnum  char(4);//exception number                                                              
         // CPF --> CPF message number                                                                 
         // MCH --> MCH message number                                                                 
      reserved1 char(4);// reserved                                                                    
      workarea  char(30); // internal use by ILE RPG compiler                                          
      pgmlib  char(10);   // prgram library                                                            
      excpdata char(80);  // exception data                                                            
      excpcause char(4);  //exception that cause RNX9001                                               
      filcname char(10); // file name on whicc last file operation occur updated only when error occur 
      unused  char(6);   //unused                                                                      
      date char(8);    //date(*date format)                                                            
      yy zoned(2);    //first two digits of 4 digit year                                               
      filenametrn char(8); // file name truncate 175-184 pos above                                     
      statusinfo  char(35); // status info on last file used                      
      jobname     char(10);  // job name                                          
      username  char(10);  // user name                                           
      jobnumber zoned(6);  //job number                                           
      date2     zoned(6);  // date (udate format  pgm running (191-198 pos above  
      pgmrundate zoned(6); // date of pgm running                                 
      time zoned(6);   //  time (hhmmss) pgm running                              
      date3 char(6); // date (udate format  pgm compiled                          
      time2 char(6); // time (hhmmss) pgm compiled                                
      cmplevel char(4); // compiler level                                         
      srcfile char(10); // src file name                                          
      srclib  char(10); // src lib name                                           
      srcmbr  char(10); //src file member                                         
      pgmproc char(10); // pgm containing procedure                               
      modproc char(10); // module containing procedure                            
      srcid  bindec(2);  // src id match the statement number from pos 21-28      
      srcid2 bindec(2);  // src id match the statement number from pos 228-235    
         // binary  2 (5i,0)                                                      
      curuserprf char(10);  // current user profi                                 
      exterrorcd  int(10);  // external error cod                                 
         // Integer (10,0)                                       
      elements int(20);  //elements set by XML-INTO or DATA-INTO 
         // Integer (20,0)                                       
      internaljobid char(16); //internal job id                  
      systemname  char(8); // system name                        
      unused2 char(6); //unused                                  
    end-ds;                                                      
    
    dcl-s num1 packed(1:0) inz(3);
    dcl-s num2 packed(1:0) inz(0); 
    dcl-s result packed(1:0) inz(0); 
    dcl-s returncode char(6);       
    
    result = num1/num2;              
    DSPLY result;         
    *INLR  = *ON;                    
    
    Begsr *pssr;                                       
      If PGM_STATUS = 00102;                           
        DSPLY 'ERROR: DIVIDE BY ZERO';                 
          returncode = ' ';                            
           //returncode = '*CANCL';                    
          //returncode = '*GETIN';                     
      Else;                                            
        DSPLY 'ERROR OCCURRED WITH STATUS CODE';       
        DSPLY PGM_STATUS;                              
        returncode = '*CANCL';                         
      EndIf;                                           
    endsr returncode;                                                                                                               
    
  • In the above code in Fixed, /Free, and Fully free RPG we define the Program status data structure (PSDS) first.
  • Then we define, numbers and result varibale including the returncode variable.
  • Then we divide num1/num2 and evaluate the division in the result variable. Now at this point, if divide by zero error occurs which obviously occurs in this code as we initialized num2 as zero, the *PSSR subroutine gets called.
  • Now at this point, PGM_STATUS got checked, and if it's 00102 i.e. Divide by Zero then display error.
  • After this, we set the returncode which gets returned by the *PSSR subroutine. We can either set blank or *CANCL or *GETIN. Here In the case of Blank returncode, control goes back to the user and the system asks for an Attempt to divide by zero (C G D F). When returncode is *CANCL the procedure ends. When returncode is *GETIN, the processing continues with *GETIN by skipping that particular iteration and moving to the next. So in our case if we code *GETIN, here every time we face this error and we will be in the infinite loop in our program, not in all cases.
  • Related Post

    Post a Comment

    © AS400 and SQL Tricks. All rights reserved. Developed by Jago Desain