TexAS400 Tutorial


TUTR010 in QRPGSRC in USER000



 *  Define the CUST file with file type U for UPDATE              
 *  (update means that you can read and re-write data)            
 *  and with record address type K for Keyed.                     
 *  (Keyed means the data can be directly read using the key field
FCUST    UF  E           K        DISK                            
 *  Next, define the display file. It must already exist.         
 *  The C indeicates combined input and output. WORKSTN is        
 *  always used to indicate a display file.                       
FTUTD010 CF  E                    WORKSTN                         
 *----------------------------------------------------------------
I* This next few statements define constants that will be used    
I* as error messages                                              
I              'You must enter A, C,-C         ERR1               
I              ' or D'                                            
I              'Customer # is not fo-C         ERR2               
I              'und'                                              
I              'Name cannot be blank'C         ERR3              
I              'Addr cannot be blank'C         ERR4              
I              'City cannot be blank'C         ERR5              
I              'State cannot be blan-C         ERR6              
I              'k'                                               
I              'Zip is invalid'      C         ERR7              
 *---------------------------------------------------------------
C* This is the main loop.                                        
C* It will continue to show the first screen until F3 is pressed. 
C* When F3 is pressed, *IN03 will be truned *ON                  
C           *IN03     DOWEQ*OFF                                  
C* The next statement, executes the format (EXFMT) for SCRN1.     
C* EXFMT displays the SCRN1 and waits until the user presses     
C* ENTER or F3. Then, it continues to the next statement.        
C                     EXFMTSCRN1                                 
C* If F3 was pressed, *IN03 will be *ON so the IF will go to     
C* ENDIF and the DO will go to ENDDO                             
C           *IN03     IFEQ *OFF                                   
C* EXSR is Execute Subroutine. It will process the subroutine     
C* named MAIN.                                                     
C                     EXSR MAIN                                   
C                     ENDIF                                       
C                     ENDDO                                       
C* The next 2 statements end the program.                           
C                     MOVE *ON       *INLR                        
C                     RETRN                                       
C*----------------------------------------------------------------
C* Subroutines begin with BEGSR and end with ENDSR.                
C*                                                                
C           MAIN      BEGSR                                       
C* Use the CHAIN instruction to look for the Cust# entered in     
C* the field DSPCST.                                               
C* This statement says to use the value in DSPACT to look up     
C* the value in CUST and to turn *IN90 to *ON if it is NOT found.  
C           DSPCST    CHAINCUST                 95                
C*                                                                
C                     MOVE *BLANKS   DSPMSG                       
C                     MOVE *OFF      *IN90                        
C*                                                                
C* Because this will eventually test for Add, Chg, Delete         
C* use the SELEC instead of IF.                                    
C                     SELEC                                       
C           DSPACT    WHEQ 'C'                                    
C* If user wants to Change the record but it was not found,       
C* show error message. Otherwise Execute Subroutine to change it. 
C           *IN95     IFEQ *ON                                    
C                     MOVELERR2      DSPMSG                       
C                     MOVE *ON       *IN90                        
C                     ELSE                                        
C                     EXSR CHG                                    
C                     ENDIF                                       
C*                                                                
C                     OTHER                                       
C* MOVEL is Move Left. It moves the value and justifies left.     
C                     MOVELERR1      DSPMSG                       
C* Setting *IN90 to *ON will cause the error message to be        
C* displayed in reverse image (see the DDS for DSPMSG).            
C                     MOVE *ON       *IN90                        
C                     ENDSL                                       
C*                                                                
C                     ENDSR                                       
C*----------------------------------------------------------------
C           CHG       BEGSR                                       
C*                                                                                    
C* Show SCRN2. The values will be loaded from the CHAIN.     
C* Continue showing SCRN2 until either F12 is pressed or    
C* the data entered is OK. The subroutine EDTVAL will put   
C* a message in DSPMSG if there is an error. If DSPMSG is   
C* still blank after EDTVAL, then data is OK.               
C*                                                          
C* This starts a DO loop that will continue to loop         
C* until DSPMSG is not blank OR *IN12 is *ON.                
C           DSPMSG    DOUNE*BLANKS                          
C           *IN12     OREQ *ON                              
C                     EXFMTSCRN2                            
C* If the user hits F12 do not process,                     
C* otherwise, Edit the values to see if they are OK.         
C           *IN12     IFEQ *OFF                             
C                     EXSR EDTVAL                           
C* If there are no errors, update the record. The UPDAT     
C* uses the record name for the CUST file.                  
C           DSPMSG    IFEQ *BLANK                                 
C* UPDAT rewrites the record in the database file. Since the      
C* field names in the display file are the same as in the         
C* database file, RPG synchronizes the values.                    
C                     UPDATCSREC                                  
C* LEAVE will go to the ENDDO.                                     
C                     LEAVE                                       
C                     ENDIF                                       
C                     ENDIF                                       
C*                                                                
C                     ENDDO                                       
C*                                                                
C                     ENDSR                                       
C*----------------------------------------------------------------
C           EDTVAL    BEGSR                                       
C* Make sure the values on the screen are OK.                      
C           CSNAME    IFEQ *BLANKS                                
C                     MOVELERR3      DSPMSG                
C                     MOVE *ON       *IN90                 
C                     ENDIF                                
C*                                                         
C           CSADR1    IFEQ *BLANKS                         
C                     MOVELERR4      DSPMSG                
C                     MOVE *ON       *IN90                 
C                     ENDIF                                
C*                                                         
C           CSCTY     IFEQ *BLANKS                         
C                     MOVELERR5      DSPMSG                
C                     MOVE *ON       *IN90                 
C                     ENDIF                                
C*                                                         
C           CSSTE     IFEQ *BLANKS                         
C                     MOVELERR6      DSPMSG                
C                     MOVE *ON       *IN90                 
C                     ENDIF                                  
C*                                                           
C           CSZIP     IFLT 10000000                          
C                     MOVELERR7      DSPMSG                  
C                     MOVE *ON       *IN90                   
C                     ENDIF                                  
C*                                                           
C                     ENDSR               

 

 

Back to Table of Contents   |   Main Page