Now, Get RPG Codes in all three formats only on this website on every RPGLE related programming article.

Fixed, /Free and Fully Free RPG


Using INFDS with INFSR to catch file exception in RPG AS400

Using INFDS with INFSR to catch file exception in RPG AS400
Using INFDS with INFSR catch file exception in RPG AS400, INFSR, INFDS, file information data structure, data structure, ds, file exception in rpgle, exception handling in rpgle, error handling in rpgle, file errors in rpg, about, how, intorduction, as400,ibmi
Using INFDS with INFSR catch file exception in RPG AS400

File Information Data Structure (INFDS)

You can read more about INFDS in the following article.

  • File Information Data Structure (INFDS) in RPGLE
  • Using a File Error Subroutine (INFSR)

    We can write an INFSR subroutine to handle the file errors or exceptions. When a file error occurs following things happen.

  • The INFDS gets updated.
  • The control gets transferred to the INFSR subroutine.
  • Example of Using INFDS with INFSR to catch file exception in RPG AS400

    Here we will be going to perform the operation on a closed file. We will write code in Fixed format, /Free format, and Fully free format.

    RPG Code in Fixed format for Coding File Information Data Strucure (INFDS) in RPGLE AS400
          *_________________________________________________________________________                
          * The INFDS contains the following feedback information:        
    * File Feedback (length is 80) <-- This video talks about
    * Open Feedback (length is 160)
    * Input/Output Feedback (length is 126)
    * Device Specific Feedback (length is variable)
    * Get Attributes Feedback (length is variable)
    *_________________________________________________________________________
    FCLPF1A IF E K DISK INFDS(DS1) INFSR(*pssr) usropn D DS1 DS * File Feedback information (starts in position 1 and ends in position 80)
    * file name
    * record process
    * last operation
    * status code (>99 is exception)
    * RPG IV routine
    D FILE *FILE * File name D OPEN_IND 9 9N * File open D EOF_IND 10 10N * File at eof D STATUS *STATUS * Status code D OPCODE *OPCODE * Last opcode D ROUTINE *ROUTINE * RPG Routine D LIST_NUM 30 37 * Listing line D SPCL_STAT 38 42S 0 * SPECIAL status D RECORD *RECORD * Record name D MSGID 46 52 * Error MSGID D SCREEN *SIZE * Screen size D NLS_IN *INP * NLS Input D NLS_OUT *OUT * NLS Output D NLS_MODE *MODE * NLS Mode? *variable D uwrollno S 5P 0 INZ(3) D returncode S 6A C OPEN CLPF1A C CLOSE CLPF1A C uwrollno CHAIN CLPF1A C IF %FOUND C EVAL uwrollno = uwrollno + 1 C ELSE C EVAL uwrollno = 0 C ENDIF C EVAL *INLR = *ON C *PSSR BEGSR C IF STATUS = 01211 C EVAL returncode = ' ' C EVAL returncode = '*CANCL' C EVAL returncode = '*GETIN' C ENDIF C ENDSR returncode
    RPG Code in /Free format for Coding File Information Data Strucure (INFDS) in RPGLE AS400
                 
         FCLPF1A    IF   E           K DISK    INFDS(DS1) INFSR(*pssr) usropn                                                      
         D DS1             DS                                                                                                                                            
         D FILE              *FILE                                                  * File name     
         D OPEN_IND                9      9N                                        * File open     
         D EOF_IND                10     10N                                        * File at eof   
         D STATUS            *STATUS                                                * Status code   
         D OPCODE            *OPCODE                                                * Last opcode   
         D ROUTINE           *ROUTINE                                               * RPG Routine   
         D LIST_NUM               30     37                                         * Listing line  
         D SPCL_STAT              38     42S 0                                      * SPECIAL status
         D RECORD            *RECORD                                                * Record name   
         D MSGID                  46     52                                         * Error MSGID   
         D SCREEN            *SIZE                                                  * Screen size   
         D NLS_IN            *INP                                                   * NLS Input     
         D NLS_OUT           *OUT                                                   * NLS Output    
         D NLS_MODE          *MODE                                                  * NLS Mode?     
                                                                                                    
          /Free                                                               
              open clpf1a;                                                    
              close clpf1a;                                                   
              chain uwrollno clpf1a;                                          
              If %found;                                                      
                uwrollno = uwrollno + 1;                                      
              Else;                                                           
                uwrollno = 0;                                                 
              Endif;                                                          
              *INLR  = *ON;                                                   
                                                                              
               // Status code                                                 
               // 00000 --> No Exception/Error                                
               // 00011 --> End of file on a READ (input)                     
               // 01021 --> tried to write duplicate record on unique keys    
               // 01211 --> I/O opeartion to a closed file                    
               // 01215 --> OPEN issued to a file already opened              
               // 01218 --> Record already locked                                
               // 01221 --> update operation attempted without a prior read      
               // 01255 --> session or device error occurred                     
                                                                                 
              //________________________________________________________________ 
              Begsr *pssr;                                                       
                If STATUS = 01211;                                               
                //  returncode = ' ';                                            
                //returncode = '*CANCL';                                         
                  returncode = '*GETIN';                                         
                EndIf;                                                           
              endsr returncode;                                                  
              //________________________________________________________________ 
          /End-Free                                                                                                                                                                                                                        
    
    RPG Code in fully Free format for Coding File Information Data Strucure (INFDS) in RPGLE AS400
    **FREE
    DCL-F CLPF1A DISK(*EXT) USAGE(*INPUT) INFDS(DS1) keyed  INFSR(*pssr) usropn ;                                          
    DCL-DS DS1;
      FILE          *FILE;                  // File name
      OPEN_IND      IND        POS(9);      // File open
      EOF_IND       IND        POS(10);     // File at eof
      STATUS        *STATUS;                // Status code
      OPCODE        *OPCODE;                // Last opcode
      ROUTINE       *ROUTINE;               // RPG Routine
      LIST_NUM      CHAR(8)    POS(30);     // Listing line
      SPCL_STAT     ZONED(5)   POS(38);     // SPECIAL status
      RECORD        *RECORD;                // Record name
      MSGID         CHAR(7)    POS(46);     // Error MSGID
      SCREEN        *SIZE;                  // Screen size
      NLS_IN        *INP;                   // NLS Input
      NLS_OUT       *OUT;                   // NLS Output
      NLS_MODE      *MODE;                  // NLS Mode
    END-DS;                                                                               
              
    dcl-s uwrollno packed(5:0) inz(3);
    dcl-s returncode char(6);
    
    
    open clpf1a;              
    close clpf1a;             
    chain uwrollno clpf1a;    
    If %found;                
      uwrollno = uwrollno + 1;
    Else;                     
      uwrollno = 0;  
    Endif;           
    *INLR  = *ON;    
    
    Begsr *pssr;                    
      If STATUS = 01211;            
      //  returncode = ' ';         
      //returncode = '*CANCL';      
        returncode = '*GETIN';      
      EndIf;                        
    endsr returncode;               
                                                                                                                     
    
  • We define file CLPF1A as an externally described PF in input mode and keyed file associated file information data structure DS1 and file error subroutine *PSSR using INFSR and the file is USROPN.
  • Define the INFDS named DS1.
  • Declare uwrollno and returncode variable.
  • First, open file CLPF1A using OPEN opcode and then close the file CLPF1A using CLOSE opcode. After that chain uses uwrollno on file CLPF1A which is a closed file.
  • So, once that chain occurs on a closed file CLPF1A the control is transferred to the INFSR(*PSSR) subroutine and there it checks for status code 01211 i.e. I/O operation to a closed file. After that we can set the returncode variable either as BLANK (I/O operation was applied to closed file CLPF1A (C G D F). error occurs and user can reply C, G, D or F.), returncode variable either as *CANCL will end procedure. returncode variable either as *GETIN will skip reading the current record and will try to read the next record.
  • Related Post

    Post a Comment

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