Writing an Add/Change/Delete/Inquiry maintenance program in RPG III

This is the RPG III source code for the Add/Change/Delete program named CUSTR01.

 
     FCUSTD01 CF  E                    WORKSTN                         
     FCUST    UF  E           K        DISK                      A     
      *----------------------------------------------------------------
      * Define error messages here                                     
     I              'RECORD ALREADY ON FI-C         ERR1               
     I              'LE'                                               
     I              'RECORD IS NOT ON FIL-C         ERR2               
     I              'E'                                                
     I              'NO MORE RECORDS'     C         ERR3               
     I              'ZIP CANNOT BE ZERO'  C         ERR6               
     I              'NAME  MUST NOT BE BL-C         ERR7               
     I              'ANK'                                              
     I              'STATE MUST NOT BE BL-C         ERR8               
     I              'ANK'                                              
     I              'ACTION MUST BE A, U,-C         ERR9               
     I              ' D OR I'                                          
     I              'RECORD ADDED SUCCE-  C         MSG1               
     I              'SSFULLY'                                          
     I              'RECORD UPDATED SUC-  C         MSG2               
     I              'CESSFULLY'                                        
     I              'RECORD DELETED SUC-  C         MSG3               
     I              'CESSFULLY'                                        
     I              'HIT F9 TO DELETE'    C         MSG4               
     I              'NO ACTION TAKEN'     C         MSG9               
      *----------------------------------------------------------------
      * Key List for customer file                                     
      *     (a key list is not needed since this file has only 1 key   
      *      field, but this makes the program easier to modify if     
      *      the file has multiple key fields)                         
     C           KEYLST    KLIST                                       
     C                     KFLD           CSNBR
      *----------------------------------------------------------------
      * Stay in Main DO LOOP until F3 is hit from SCR1                 
      *----------------------------------------------------------------
     C           *IN03     DOWEQ*OFF                                   
      * Show main ADD/UPD/INQ/DLT screen                               
     C                     EXFMTSCR1                                   
     C                     CLEARERRLIN                                 
     C                     MOVE *OFF      *IN90                        
      * If user didn't hit F3, process screen based on action          
     C           *IN03     IFEQ *OFF                                   
     C                     SELEC                                   
     C           ACTION    WHEQ 'A'                                
     C                     EXSR ADDREC                             
     C           ACTION    WHEQ 'D'                                
     C                     EXSR DLTREC                             
     C           ACTION    WHEQ 'I'                                
     C                     EXSR INQREC                             
     C           ACTION    WHEQ 'N'                                
     C                     EXSR NXTREC                             
     C           ACTION    WHEQ 'U'                                
     C                     EXSR UPDREC                             
     C                     OTHER                                   
     C                     CLEARERRLIN                             
     C                     MOVELERR9      ERRLIN                   
     C                     MOVE *ON       *IN90                    
     C                     ENDSL                                   
     C                     ENDIF                                   
     C                     ENDDO                                   
      *                                                            
     C                     MOVE *ON       *INLR                    
     C                     RETRN                                   
      *----------------------------------------------------------------
     C           ADDREC    BEGSR                                       
      * Unprotect fields but setting *in80 off                         
     C                     MOVE *OFF      *IN80                        
     C                     MOVE '  ADD  ' MODE                         
      * See if customer # is already in CUST file                      
     C           KEYLST    CHAINCUST                 91                
     C           *IN91     IFEQ *OFF                                   
      * If customer # is already in cust file, load up ERR MSG         
     C                     CLEARERRLIN                                 
     C                     MOVELERR1      ERRLIN                       
     C                     MOVE *ON       *IN90                        
     C                     ELSE                                        
     C                     EXSR ADDSCR                                 
     C                     ENDIF                                       
     C                     ENDSR                                       
      *----------------------------------------------------------------
      * SHOW ADD SCREEN                                                
      *----------------------------------------------------------------
     C           ADDSCR    BEGSR                                       
      * Clear customer record except for key field(s)                  
     C           *NOKEY    CLEARCSREC
     C                     MOVE 'N'       RECOK   1                 
      * Keep showing screen until record passes edit or F3 is hit   
     C           RECOK     DOWEQ'N'                                 
     C           *IN03     ANDEQ*OFF                                
     C                     EXFMTSCR2                                
      *                                                             
     C           *IN03     IFEQ *OFF                                
     C                     EXSR EDTCUS                              
     C           RECOK     IFEQ 'Y'                                 
     C                     WRITECSREC
      * Show messaage that ADD was successful                       
     C                     CLEARERRLIN                              
     C                     MOVELMSG1      ERRLIN                    
     C                     ENDIF                                    
     C                     ELSE                                     
      * Show message that no action was taken because F3 was hit    
     C                     CLEARERRLIN                              
     C                     MOVELMSG9      ERRLIN                    
     C                     ENDIF                                    
     C                     ENDDO                                    
      *                                                                
     C                     MOVE *OFF      *IN03                        
      *                                                                
     C                     ENDSR                                       
      *----------------------------------------------------------------
     C           DLTREC    BEGSR                                       
      * Disable fields for entry by setting *IN80 on                   
     C                     MOVE *ON       *IN80                        
     C                     MOVE 'DELETE'  MODE                         
     C                     CLEARERRLIN                                 
     C                     MOVELMSG4      ERRLIN                       
     C                     MOVE *ON       *IN90                        
      * See if customer # is in CUST file                              
     C           KEYLST    CHAINCUST                 91                
     C           *IN91     IFEQ *ON                                    
      * If customer # is not in CUST file, show ERR MSG                
     C                     CLEARERRLIN                                 
     C                     MOVELERR2      ERRLIN                       
     C                     MOVE *ON       *IN90                        
     C                     ELSE                                        
     C                     EXFMTSCR2                                   
     C                     MOVE *OFF      *IN90                        
     C           *IN09     IFEQ *ON                                    
     C                     DELETCSREC
     C                     CLEARERRLIN                                 
     C                     MOVELMSG3      ERRLIN                       
     C                     ELSE                                        
     C                     CLEARERRLIN                                 
     C                     MOVELMSG9      ERRLIN                       
     C                     ENDIF                                       
     C                     ENDIF                                       
      *                                                                
     C                     MOVE *OFF      *IN03                        
      *                                                                
     C                     ENDSR                                       
      *----------------------------------------------------------------
     C           INQREC    BEGSR                                       
      * Disable fields for entry by setting *IN80 on                   
     C                     MOVE *ON       *IN80                        
     C                     MOVE 'INQUIRY' MODE                         
      * See if customer # is in CUST file                              
     C           KEYLST    CHAINCUST                 91                
     C           *IN91     IFEQ *ON                                    
      * If customer # is not in CUST file, show ERR MSG                
     C                     CLEARERRLIN                                 
     C                     MOVELERR2      ERRLIN                       
     C                     MOVE *ON       *IN90                        
     C                     ELSE                                        
      * Show Inquiry Screen                                            
     C                     EXFMTSCR2                                   
     C                     ENDIF                                       
      *                                                                
     C                     MOVE *OFF      *IN03                        
      *                                                                
     C                     ENDSR                                       
      *----------------------------------------------------------------
     C           NXTREC    BEGSR                                       
      *                                                                
     C                     MOVE *ON       *IN80                        
     C                     MOVE 'INQUIRY' MODE                         
     C                     CLEARERRLIN                                 
      * Go forward in the file to the next record                      
     C           KEYLST    SETLLCUST                 92  93       
      * If *in92 is on, we have reached end of file               
     C           *IN92     IFEQ *ON                               
     C                     MOVELERR3      ERRLIN                  
     C                     MOVE *ON       *IN90                   
     C                     ENDIF                                  
      * Read next record                                          
     C           ERRLIN    IFEQ *BLANKS                           
     C                     READ CUST                     90       
      * If *in90 is on, we have reached end of file               
     C           *IN92     IFEQ *ON                               
     C                     MOVELERR3      ERRLIN                  
     C                     MOVE *ON       *IN90                   
     C                     ENDIF                                  
     C                     ENDIF                                  
      * If *in93 is on, we are at an existing record and we need  
      *    to read past it                                        
     C           ERRLIN    IFEQ *BLANKS                           
     C           *IN93     IFEQ *ON                               
     C                     READ CUST                     90       
      * If *in90 is on, we have reached end of file               
     C           *IN90     IFEQ *ON                                    
     C                     MOVELERR3      ERRLIN                       
     C                     MOVE *ON       *IN90                        
     C                     ENDIF                                       
     C                     ENDIF                                       
     C                     ENDIF                                       
      *                                                                
     C           ERRLIN    IFEQ *BLANKS                                
     C                     EXFMTSCR2                                   
     C                     ENDIF                                       
      *                                                                
     C                     MOVE *OFF      *IN03                        
      *                                                                
     C                     ENDSR                                       
      *----------------------------------------------------------------
     C           UPDREC    BEGSR                                       
      * Unprotect fields but setting *in80 off                         
     C                     MOVE *OFF      *IN80                        
     C                     MOVE 'UPDATE ' MODE                         
      * See if customer # is already in CUST file                      
     C           KEYLST    CHAINCUST                 91                
     C           *IN91     IFEQ *ON                                    
      * If customer # is not in cust file, load up ERR MSG             
     C                     CLEARERRLIN                                 
     C                     MOVELERR2      ERRLIN                       
     C                     MOVE *ON       *IN90                        
     C                     ELSE                                        
     C                     EXSR UPDSCR                                 
     C                     ENDIF                                       
     C                     ENDSR                                       
      *----------------------------------------------------------------
      * SHOW UPDATE SCREEN                                             
      *----------------------------------------------------------------
     C           UPDSCR    BEGSR                                       
     C                     MOVE 'N'       RECOK   1                    
      * Keep showing screen until record passes edit or F3 is hit      
     C           RECOK     DOWEQ'N'                                    
     C           *IN03     ANDEQ*OFF                                   
     C                     EXFMTSCR2                                   
      *                                                                
     C           *IN03     IFEQ *OFF                                   
     C                     EXSR EDTCUS                                 
     C           RECOK     IFEQ 'Y'                                    
     C                     UPDATCSREC
      * Show messaage that UPDATE was successful                       
     C                     CLEARERRLIN                                 
     C                     MOVELMSG2      ERRLIN                       
     C                     ENDIF                                       
     C                     ELSE                                        
      * Show message that no action was taken because F3 was hit       
     C                     CLEARERRLIN                                 
     C                     MOVELMSG9      ERRLIN                       
     C                     ENDIF                                       
     C                     ENDDO                                       
      *                                                                
     C                     MOVE *OFF      *IN03                        
      *                                                                
     C                     ENDSR                                       
      *----------------------------------------------------------------
     C           EDTCUS    BEGSR                                       
      * First, set error switch that record is OK                      
     C                     MOVE 'Y'       RECOK                        
      * Now, perform each edit                                 
     C           CSNAME    IFEQ *BLANKS
     C                     MOVE 'N'       RECOK                   
     C                     CLEARERRLIN                            
     C                     MOVELERR7      ERRLIN                  
     C                     MOVE *ON       *IN90                   
     C                     ENDIF                                  
      *                                                           
     C           CSSTE     IFEQ *BLANKS
     C                     MOVE 'N'       RECOK                   
     C                     CLEARERRLIN                            
     C                     MOVELERR8      ERRLIN                  
     C                     MOVE *ON       *IN90                   
     C                     ENDIF                                  
      *                                                           
     C           CSZIP     IFEQ *ZERO
     C                     MOVE 'N'       RECOK                   
     C                     CLEARERRLIN                            
     C                     MOVELERR6      ERRLIN                  
     C                     MOVE *ON       *IN90                   
     C                     ENDIF                                  
      *                                                           
     C                     ENDSR                                       
      *----------------------------------------------------------------

 

Back to Source Code Page   |   Basic 400 Skills   |   Main Page