Example of an Invited Display file with a Subfile

Resolving The Problem

This document contains an example of an Invited Display file with a Subfile. The code is shown below; however, a save file that includes all of the code is attached.

Physical File named TESTADD:
*************** Beginning of data **************************
                R FMT1                          
                  ZIP            5A            
                  CUST          20A            
                  NAME          20A            
                  ADDR1         20A            
                  ADDR2         20A            
                  CITY          20A            
                  STATE          2A            
                  DATEOB         6  0          
****************** End of data ******************************
                                               
Logical File named TESTLF:
*************** Beginning of data ***************************
                R FMT1                      PFILE(TESTADD)  
                K NAME                                      
****************** End of data ******************************
                                                             
Display File named EXPSFL3:
On the compile you must specify MAXDEV (greater than 1) and WAITRCD (number of seconds to wait for input)
*************** Beginning of data ***************************************
     A                                      DSPSIZ(24 80 *DS3)          
     A                                      PRINT                        
     A                                      CF03(03)                    
     A                                      HELP                        
     A****************************************************************  
     A*  HEADER RECORD TO BE AT TOP OF DISPLAY                          
     A****************************************************************  
     A          R HEADER                                                
     A                                      OVERLAY                      
     A                                  2  3'HEADER'                    
     A                                  2 70DATE EDTWRD('  /  /  ')      
     A                                  3 70TIME EDTWRD('  :  :  ')      
     A****************************************************************  
     A*  SUBFILE RECORD                                                  
     A****************************************************************  
     A          R SF                        SFL                          
     A                                      LOGOUT                      
     A                                      LOGINP                      
     A            OPT            1A  B 10  3                            
     A            ZIP            5A  O 10 12                                
     A            CUST          20A  O 10 27                                
     A            NAME          20A  O 10 53                                
     A****************************************************************      
     A*  SUBFILE CONTROL RECORD                                              
     A****************************************************************      
     A          R SCTL                      SFLCTL(SF)                      
     A                                      SFLSIZ(0007)                    
     A                                      SFLPAG(0007)                    
     A                                      OVERLAY          
     A  31                                  INVITE                        
     A  31                                  SFLDSP                        
     A  32                                  SFLDSPCTL                      
     A  33                                  SFLEND                        
     A  34                                  SFLCLR                        
     A                                  5  2'TYPE OPTIONS, PRESS ENTER'    
     A                                      COLOR(BLU)                    
     A                                  6  2'2=CHANGE     5=DISPLAY'      
     A                                      COLOR(BLU)                    
     A                                  8  2'OPT'                          
     A                                      DSPATR(HI)                    
     A                                  9  2'---'                        
     A                                      DSPATR(HI)                    
     A                                  8 12'ZIP'                        
     A                                      DSPATR(HI)                    
     A                                  9 12'-----'                      
     A                                      DSPATR(HI)                    
     A                                  8 27'CUSTOMER'                    
     A                                      DSPATR(HI)                    
     A                                  9 27'--------------------'        
     A                                      DSPATR(HI)                        
     A                                  8 53'CONTACT NAME'                    
     A                                      DSPATR(HI)                        
     A                                  9 53'--------------------'            
     A                                      DSPATR(HI)                        
     A****************************************************************        
     A*  WRITE IF SUBFILE IS EMPTY                                            
     A****************************************************************        
     A          R EMPTY                                                      
     A                                      OVERLAY                                                                                                                           A                                 23  3'F3=EXIT'                              
     A          R CHANGE                                                          
     A                                  1 23'CHANGE CUSTOMER RECORD'              
     A                                      DSPATR(HI)                            
     A                                  4  4'MAKE CHANGES AND PRESS ENTER, TO C-  
     A                                      ANCEL CHANGES PRESS F3.'              
     A                                      DSPATR(BL)                            
     A                                      COLOR(BLU)                            
     A                                  7  4'CUSTOMER NAME . . .:'                
     A                                  8  4'CONTACT NAME  . . .:'                
     A                                  9  4'ADDRESS LINE 1  . .:'                
     A                                 10  4'ADDRESS LINE 2  . .:'                
     A                                 11  4'CITY  . . . . . . .:'                
     A                                 12  4'STATE . . . . . . .:'                
     A                                 13  4'DATE OF BIRTH . . .:'              
     A            CUST      R        B  7 26REFFLD(FMT1/CUST *LIBL/TESTADD)    
     A                                      CHECK(LC)                          
     A            NAME      R        B  8 26REFFLD(FMT1/NAME *LIBL/TESTADD)    
     A                                      CHECK(LC)                          
     A            ADDR1     R        B  9 26REFFLD(FMT1/ADDR1 *LIBL/TESTADD)    
     A                                      CHECK(LC)                          
     A            ADDR2     R        B 10 26REFFLD(FMT1/ADDR2 *LIBL/TESTADD)    
     A                                      CHECK(LC)                          
     A            CITY      R        B 11 26REFFLD(FMT1/CITY *LIBL/TESTADD)    
     A                                      CHECK(LC)                          
     A            STATE     R        B 12 26REFFLD(FMT1/STATE *LIBL/TESTADD)    
     A            DATEOB    R        B 13 26REFFLD(FMT1/DATEOB *LIBL/TESTADD)  
     A                                      EDTCDE(Y)                          
     A                                 23  4'F3 = EXIT'                        
     A                                      COLOR(BLU)                          
     A          R DISPLAY                                                      
     A*%%TS  SD  19970421  104010  *LIBL       REL-V2R3M0  5738-PW1            
     A                                  1 23'CHANGE CUSTOMER RECORD'            
     A                                      DSPATR(HI)                          
     A                                  4  4'MAKE CHANGES AND PRESS ENTER, TO C-  
     A                                      ANCEL CHANGES PRESS F3.'              
     A                                      DSPATR(BL)                            
     A                                      COLOR(BLU)                            
     A                                  7  4'CUSTOMER NAME . . .:'                
     A                                  8  4'CONTACT NAME  . . .:'                
     A                                  9  4'ADDRESS LINE 1  . .:'                
     A                                 10  4'ADDRESS LINE 2  . .:'                
     A                                 11  4'CITY  . . . . . . .:'                
     A                                 12  4'STATE . . . . . . .:'                
     A                                 13  4'DATE OF BIRTH . . .:'                
     A                                 23  4'F3 = EXIT'                          
     A                                      COLOR(BLU)                            
     A            CUST      R        O  7 26REFFLD(FMT1/CUST *LIBL/TESTADD)      
     A            NAME      R        O  8 26REFFLD(FMT1/NAME *LIBL/TESTADD)      
     A            ADDR1     R        O  9 26REFFLD(FMT1/ADDR1 *LIBL/TESTADD)      
     A            ADDR2     R        O 10 26REFFLD(FMT1/ADDR2 *LIBL/TESTADD)      
     A            CITY      R        O 11 26REFFLD(FMT1/CITY *LIBL/TESTADD)      
     A            STATE     R        O 12 26REFFLD(FMT1/STATE *LIBL/TESTADD)      
     A            DATEOB    R        O 13 26REFFLD(FMT1/DATEOB *LIBL/TESTADD)    
     A                                      EDTCDE(Y)                              
****************** End of data *****************************************************
                                                                                   
RPGLE Program named TESTSFLR:
 *************** Beginning of data **************************************
 FTESTLF    UF   E           K DISK                                      
 FEXPSFL3   CF   E             WORKSTN                                  
 F                                     SFILE(SF:RRN)                    
 F                                     INFDS(FILEINFS)                  
 F                                     MAXDEV(*FILE)                    
 DFILEINFS         DS                                                    
 DSTATUS             *STATUS                                            
  *                                                                      
  **********************************************************************      
  *                                                                      
  * CLEAR SFL                                                            
  *                                                                      
  **********************************************************************      
 C                   MOVEA     '0001'        *IN(31)                    
 C                   WRITE     SCTL                                      
 C                   MOVEA     '0100'        *IN(31)                    
  *                                                                      
  ***********************************************************************      
  *                                                                      
  * LOAD SUBFILE                                                  
  *    THIS PROGRAM LOADS THE ENTIRE SUBFILE.  THIS IS NOT VERY  
  *    EFFICIENT IF THERE ARE MORE THAN A COUPLE SUBFILE PAGES    
 C                   MOVEA     '0100'        *IN(31)              
  *                                                              
  ************************************************************************
  *                                                              
  * LOAD SUBFILE                                                  
  *    THIS PROGRAM LOADS THE ENTIRE SUBFILE.  THIS IS NOT VERY  
  *    EFFICIENT IF THERE ARE MORE THAN A COUPLE SUBFILE PAGES    
  *    OF DATA IN THE DATABASE FILE.  IF THERE IS TOO MUCH DATA  
  *    YOU SHOULD CONSIDER LOADING THE SUBFILE ONE PAGE AT A TIME.
  *                                                              
  *    NOTICE THE READ WITH NO LOCK SO THAT NO RECORDS HAVE A    
  *    LOCK AFTER LOADING THE SUBFILE.                            
  *                                                              
  *************************************************************************
  * INITIALIZE SFL RRN                                            
 C                   Z-ADD     0             RRN               4 0
  *                                                              
 C                   READ(N)   FMT1                                   90  
 C     *IN90         DOWEQ     '0'                                        
 C     RRN           ANDLE     9998                                        
 C                   ADD       1             RRN                          
 C                   SETON                                        25      
 C                   WRITE     SF                                          
 C                   READ(N)   FMT1                                   90  
 C                   ENDDO                                                
 C                   SETON                                        33      
  **********************************************************************        
  *                                                                        
  * CHECK TO SEE IF SUBFILE HAS ANY RECORDS.                              
  *    IF THERE ARE RECORDS THEN SET ON THE SFLDSP INDICATOR.              
  *                                                                        
  *    IF THERE ARE NOT ANY RECORDS IN THE SUBFILE THEN WRITE              
  *    THE EMPTY RECORD FORMAT.                                            
  *                                                                        
  **********************************************************************        
 C     RRN           IFGT      0                                          
 C                   SETON                                        31      
 C                   ELSE                                                
 C                   WRITE     EMPTY                                      
 C                   END                                                  
  **********************************************************************        
  *                                                                      
  * WRITE EVERYTHING TO THE DISPLAY.                                      
  *                                                                      
  **********************************************************************        
 C     *IN03         DOWEQ     '0'                                        
 c     again         tag                                                  
 C                   WRITE     HEADER                                    
 C                   WRITE     FOOTER                                    
  * POSITION THE SUBFILE TO THE PAGE THAT CONTAINS RELATIVE              
  * RECORD NUMBER 1.                                                      
 C                   write     SCTL                                      
 c                   read      expsfl3                              9950  
 c     STATUS        IFEQ      1331                                      
 c                   GOTO      again                                      
 c                   END                                                  
 C     *IN03         IFEQ      '0'                                        
 C                   READC     SF                                     80  
 C     *IN80         DOWEQ     '0'                                        
 C     OPT           IFEQ      '2'                                        
 C                   EXSR      CHNG                                      
 C                   ELSE                                                
 C     OPT           IFEQ      '5'                                        
 C                   EXSR      DISP                                      
 C                   ELSE                                                
 C* SEND OUT ERROR                                                        
 C                   END                                                  
 C                   END                                                  
 C                   MOVE      ' '           OPT                          
 C                   SETON                                            30  
 C                   UPDATE    SF                                        
 C                   READC     SF                                     80  
 C                   ENDDO                                                
 C                   END                                                  
 C                   ENDDO                                                
 c*    ENDIT         TAG                                                  
 C                   MOVE      '1'           *INLR                                                                                                    *************************************************************************    
 C     CHNG          BEGSR                                            
 C     NAME          CHAIN     FMT1                               60  
 C     *IN60         IFEQ      '0'                                    
 C                   EXFMT     CHANGE                                  
 C     *IN03         IFEQ      '0'                                    
 C                   UPDATE    FMT1                                    
 C                   ELSE                                              
 C                   SETOFF                                       03  
 C                   END                                              
 C                   END                                              
 C                   ENDSR                                            
  ************************************************************************    
 C     DISP          BEGSR                                            
 C     NAME          CHAIN     FMT1                               60  
 C     *IN60         IFEQ      '0'                                    
 C                   EXFMT     DISPLAY                                
 C                   SETOFF                                       03  
 C                   END                                              
 C                   ENDSR                                            
  ****************** End of data ******************************************