Subfile

The DDS for the 3-Column Subfile
     A*%%TS  SD  20000615  210349  BOOTH       REL-V4R4M0  5769-PW1   
     A*                                                               
     A*%%EC                                                           
     A                                      DSPSIZ(24 80 *DS3)        
     A                                      CHGINPDFT(HI UL)          
     A                                      CSRINPONLY                
     A                                      ERRSFL                    
     A                                      CF03(03 'Exit')           
     A                                      CF05(05 'Refresh')        
     A                                      CF10(10 'Run')            
     A                                      CF11(11 'Toggle field')   
     A                                      CF12(12 'Exit')           
     A                                      MOUBTN(*ULD CF11)         
     A          R SFLA                      SFL                       
     A*%%TS  SD  20000613  195723  BOOTH       REL-V4R4M0  5769-PW1   
     A            COL1O          1A  B 11  4SFLCSRPRG                 
     A            COL1          20A  O 11  6DSPATR(HI)                
     A            COL2O          1A  B 11 29SFLCSRPRG                 
     A            COL2          20A  O 11 31DSPATR(HI)                
     A            COL3O          1A  B 11 54SFLCSRPRG               
     A            COL3          20A  O 11 56DSPATR(HI)              
     A            COL1H          2A  H                              
     A            COL2H          2A  H                              
     A            COL3H          2A  H                              
     A          R FMT01                     SFLCTL(SFLA)            
     A*%%TS  SD  20000615  210349  BOOTH       REL-V4R4M0  5769-PW1 
     A                                      SFLPAG(0011)            
     A                                      SFLSIZ(&NBRREC)         
     A                                      OVERLAY                 
     A                                      RTNCSRLOC(&REC &FLD)    
     A                                      SFLCSRRRN(&RELRCD)      
     A  90                                  SFLDSP                  
     A  90                                  SFLDSPCTL               
     A N90                                  SFLCLR                  
     A  91                                  SFLEND(*SCRBAR *MORE)   
     A            RELRCD         5S 0H                              
     A            NBRREC         5S 0P                              
     A            REC           10A  H                              
     A            FLD           10A  H                              
     A                                  1 69DATE                        
     A                                      EDTCDE(Y)                   
     A                                  2 69TIME                        
     A                                  3 69SYSNAME                     
     A                                  4 69'Filter'                    
     A                                  5 69USER                        
     A                                  7  4'Filter by these fields'    
     A                                      DSPATR(HI)                  
     A                                 10  4'  Type                '    
     A                                      DSPATR(UL)                  
     A                                      COLOR(BLU)                  
     A                                 10 29'  State               '    
     A                                      DSPATR(UL)                  
     A                                      COLOR(BLU)                  
     A                                 10 54'  Country             '    
     A                                      DSPATR(UL)                  
     A                                      COLOR(BLU)                  
     A                                  7 49'Select for printing = "Y"' 
     A                                  8 49'Print report = Run, or F10'
     A                                      DSPATR(BL)                  
     A                                      COLOR(GRN)                           
     A                                  1  3'   ____    _____     __           - 
     A                                             ____     __   ____ __   '     
     A                                  2  3'  |_  /___/ ___/__  / /_ ____ _  _- 
     A                                      __    / __/_ __/ /  / _(_) /__ '     
     A                                  3  3' _/_ <___/ /__/ _ \/ / // /    \/ - 
     A                                      _ \  _\ \/ // / _ \/ _/ / / -_)'     
     A                                  4  3'/____/   \___/\___/_/\_,_/_/_/_/_/- 
     A                                      /_/ /___/\_,_/_.__/_//_/_/\__/ '     
     A          R FOOTER                                                         
     A            PB1            2Y 0B 23  3PSHBTNFLD                            
     A                                      PSHBTNCHC(1 'Refresh (F5) ' CF05)    
     A                                      PSHBTNCHC(2 'Run (F10) ' CF10)       
     A                                      PSHBTNCHC(3 'Cancel (F12) ' CF12)    

This program will display data from three files and would be useful for setting complex filters.

This is the RPGIV for the 3-Column Subfile

      *************************************************************     
      * A program to select from 3 different files                *     
      *    6/00  Booth Martin                                     *     
      *                                                           *     
      *                                                           *     
      *************************************************************     
     FSFL3ColFM CF   E             WORKSTN                              
     F                                     SFILE(SFLA:RRN)              
     FFilters1P IF   E             DISK                                 
     FFilters2P IF   E             DISK                                 
     FFilters3P IF   E             DISK                                 
                                                                        
     D ReadFilters1P   S              3    INZ('Yes')                   
     D ReadFilters2P   S              3    INZ('Yes')                   
     D ReadFilters3P   S              3    INZ('Yes')                   
                                                                        
      * Arrays of Selected Items                                        
     D Inx             S              3S 0                              
     D Inx1            S              3S 0                              
     D AR1             S              2    DIM(60)                       
     D Inx2            S              3S 0                               
     D AR2             S              2    DIM(60)                       
     D Inx3            S              3S 0                               
     D AR3             S              2    DIM(60)                       
                                                                         
      *  ..................................................              
                                                                         
     C                   Z-ADD     1             RRN               4 0   
                                                                         
      * Clear subfile & screen, prepare to re-fill or fill:              
     C                   Eval      *IN90=*OFF                            
     C                   Clear                   SFLA                    
     C                   Write     FOOTer                                
     C                   Write     FMT01                                 
     C                   EXSR      FillSubfileSR                         
                                                                         
      **                                                                 
     C     RRN           IFLT      11                                    
     C                   MOVE      *ON           *IN91                   
     C                   END                                    
     C                   MOVE      *ON           *IN90          
     C                   WRITE     FOOTer                       
                                                                
     C                   DoW       *INLR = *Off                 
     C                   EXFMT     FMT01                        
     C                   Read      Footer                       
                                                                
     C                   Select                                 
                                                                
      * Footer Push button Choices:                             
      * Refresh Subfile:                                        
     C                   When      PB1 = 1 Or *INKE = *On       
     C                   Eval      ReadFilters1P = 'Yes'        
     C                   Eval      ReadFilters2P = 'Yes'        
     C                   Eval      ReadFilters3P = 'Yes'        
     C                   GOTO      RefreshTag                   
      * Run the job                                             
     C                   When      PB1 = 2 Or *INKJ             
     C                   Exsr      AcceptSR                     
     C                   Eval      *INLR = *ON                                   
      * end the job                                                              
     C                   When      PB1 = 3 or *INKC Or *INKL                     
     C                   Eval      *INLR = *ON                                   
                                                                                 
      * Mouse clicked in Column 1, toggle the field                              
      *  (Note: The DDS has a mouse button click = F11.  The reason for this is  
      *         so that a regular Enter while the cursor is in a Filter field    
      *         won't toggle the field's value.  F11=*INKK)                      
                                                                                 
     C                   When      FLD = 'COL1O' And *INKK                       
     C     Relrcd        Chain     SFLA                                          
     C                   If        Col1o = 'Y'                                   
     C                   Eval      Col1o = ' '                                   
     C                   Else                                                    
     C                   Eval      Col1o = 'Y'                                   
     C                   End                                                     
     C                   Update    Sfla                                          
                                                                                 
      * Mouse clicked in Column 2, toggle the field                              
     C                   When      FLD = 'COL2O' And *INKK       
     C     Relrcd        Chain     SFLA                          
     C                   If        Col2o = 'Y'                   
     C                   Eval      Col2o = ' '                   
     C                   Else                                    
     C                   Eval      Col2o = 'Y'                   
     C                   End                                     
     C                   Update    Sfla                          
                                                                 
      * Mouse clicked in Column 3, toggle the field              
     C                   When      FLD = 'COL3O' And *INKK       
     C     Relrcd        Chain     SFLA                          
     C                   If        Col3o = 'Y'                   
     C                   Eval      Col3o = ' '                   
     C                   Else                                    
     C                   Eval      Col3o = 'Y'                   
     C                   End                                     
     C                   Update    Sfla                          
                                                                 
     C                   EndSL                                   
     C                   END                                              
                                                                          
     C     RefreshTag    Tag                                              
      *  _________________________________________________________________
     C     AcceptSR      BegSR                                            
      * If a choice was made, then do the required action:                
     C                   Eval      Inx  = 1                               
     C                   Eval      Inx1 = 1                               
     C                   Eval      Inx2 = 1                               
     C                   Eval      Inx3 = 1                               
                                                                          
     C     Inx           Chain     SFLA                                   
                                                                          
     C                   If        %Found                                 
     C                   DoU       %EOF or Not %Found                     
                                                                          
     C                   If        Col1o = 'Y'                            
     C                   Eval      Ar1(Inx1) = Col1H                      
     C                   Eval      Inx1 = Inx1 + 1                        
     C                   End                                              
                                                        
     C                   If        Col2o = 'Y'          
     C                   Eval      Ar2(Inx2) = Col2H    
     C                   Eval      Inx2 = Inx2 + 1      
     C                   End                            
                                                        
     C                   If        Col3o = 'Y'          
     C                   Eval      Ar3(Inx3) = Col3H    
     C                   Eval      Inx3 = Inx3 + 1      
     C                   End                            
                                                        
     C                   Eval      Inx = Inx + 1        
     C     Inx           Chain     SFLA                 
     C                   EndDo                          
     C                   EndIf                          
      * Sort the arrays so we can do look ups:          
     C                   Sorta     AR1                  
     C                   Sorta     AR2                  
     C                   Sorta     AR3                  
                                                        
      * Write a file of records for printing the report(s):                    
     C                   Exsr      WriteRecordSR                               
                                                                               
     C                   EndSR                                                 
      *  _________________________________________________________________     
     C     WriteRecordSR BegSR                                                 
      * This sub routine is blank.  It is trivial to add whatever code is      
      * needed to make the filters selected be useful.  The purpose of this    
      * exercise is to show the 3-column subfile and the toggling of the values
     C                   EndSR                                                 
      *  _________________________________________________________________     
     C     FillSubfileSR BegSR                                                 
                                                                               
     C     1             Setll     Filters1P                                   
     C     1             Setll     Filters2P                                   
     C     1             Setll     Filters3P                                   
                                                                               
     C                   DoW       ReadFilters1P = 'Yes' Or                    
     C                             ReadFilters2P = 'Yes' Or                    
     C                             ReadFilters3P = 'Yes'                       
     C                   Exsr      WriteLineSR                             
     C                   Write     SFLA                                    
     C                   Eval      RRN = RRN + 1                           
     C                   End                                               
                                                                           
     C                   Eval      NBRREC = RRN                            
     C                   EndSR                                             
      *  _________________________________________________________________ 
      * Write the line in the subfile:                                     
     C     WriteLineSR   BegSR                                             
                                                                           
      * Column 1: Status                                                   
     C                   Eval      Col1O = ' '                             
     C                   Eval      Col2O = ' '                             
     C                   Eval      Col3O = ' '                             
                                                                           
      * Column 1: Filters 1                                                
     C                   Eval      Col1  =*Blanks                          
     C                   Eval      Col1H =' '                              
     C                   If        ReadFilters1P = 'Yes'                   
     C                   Read      Filters1P                               
                                                                           
     C                   If        Not %EOF                                
     C                   Eval      Col1  = TypeID + ' ' + TYPEDS           
     C                   Eval      Col1H = TypeID                          
     C                   Eval      Col1O = 'Y'                             
     C                   Else                                              
     C                   Eval      ReadFilters1P = 'No '                   
     C                   End                                               
                                                                           
     C                   End                                               
                                                                           
      * Column 2: Filters2P                                                
     C                   Eval      Col2  =*Blanks                          
     C                   Eval      Col2H =' '                              
                                                                           
     C                   If        ReadFilters2P = 'Yes'                   
     C                   Read      Filters2P                               
                                                                           
     C                   If        Not %EOF                           
     C                   Eval      Col2  = ST + ' ' + STATE           
     C                   Eval      Col2H = ST                         
     C                   Eval      Col2O = 'Y'                        
     C                   Else                                         
     C                   Eval      ReadFilters2P = 'No '              
     C                   End                                          
                                                                      
     C                   End                                          
                                                                      
      * Column 3: FiltersP                                            
     C                   Eval      Col3  =*Blanks                     
     C                   Eval      Col3H =' '                         
                                                                      
     C                   If        ReadFilters3P = 'Yes'              
     C                   Read      Filters3P                          
                                                                      
     C                   If        Not %EOF                           
     C                   Eval      Col3  = CNTRY + ' ' + COUNTRY      
     C                   Eval      Col3H = CNTRY                      
     C                   Eval      Col3O = 'Y'                
     C                   Else                                 
     C                   Eval      ReadFilters3P = 'No '      
     C                   End                                  
                                                              
     C                   End                                  
                                                              
     C                   EndSR                                
      *  _____________________________________________________