Control Subfile

 * Control Subfile 01       
     C           CTSF01    BEGSR                           
B001 C           *IN03     DOUEQ*ON                        
     C           *IN12     OREQ *ON                        
	* Clear prompts       
     C                      CLEARC1CUST                      
     C                     CLEARC1LNAM                     
     C                     CLEARC1FNAM                     
     C                     WRITECMD01                      
	* Write command keys       
B002 C           S1LST     IFLT 1                           
      * No records in subfile, display empty records       
	* where subfile would be         
     C                     WRITEEMP01                      
     C                     MOVE *OFF      *IN41            
      * Disable Subfile Display       
E002 C                     END                
     C                     EXFMTSFC01                     
     C                     CLEARERRMSG        
B002 C           *IN26     IFEQ *OFF          
      *--------------------                   
      *  Enter key                            
      *--------------------                   
B003 C           S1LST     IFGT *ZEROS        
	*       
B004 C           C1CUST    IFGT *ZEROS        
     C           C1LNAM    ORGT *BLANKS       
     C           C1FNAM    ORGT *BLANKS       
	* Position based on user input         
     C                     EXSR LDSF01             
X004 C                     ELSE                   
	* Read selections       
     C                     EXSR RDSF01            
E004 C                     END                    
E003 C                     END                    
X002 C                     ELSE                   
B003 C           *IN27     IFEQ *ON                    
      *--------------------                            
      *  Roll requested                                
      *--------------------                            
     C                     MOVE *ON       ROLLUP       
     C                     EXSR LDSF01                 
     C                     MOVE *OFF      ROLLUP       
X003 C                     ELSE                        
	* Function keys (Except 03/12), which will fall out       
E003 C                     END              
E002 C                     END              
E001 C                     END              
     C                     ENDSR            
      
                     
     C           LDSF01    BEGSR        
	* Check to see if the rollup key was used:      
B001 C           ROLLUP    IFEQ *OFF                      
	* Clear the subfile        
     C                     MOVE *ON       *IN40          
	* SFLCLEAR        
     C                     MOVE *OFF      *IN41          
     C                     MOVE *OFF      *IN42          
     C                     MOVE *OFF      *IN44          
     C                     CLEARCURRRN                   
     C                     Z-ADD1         S1RRN          
     C                     WRITESFC01                    
     C                     CLEARS1RRN                    
     C                     MOVE *ON       *IN42          
	* SFLDSPCTL       
	* Check the sorting order       
B002 C           *IN26     IFEQ *OFF       
      * Sort Client by Client Number       
     C                     MOVE *ON       *IN31          
     C           CLNKY2    SETLLRKCLNT                           
     C                     READ RKCLNT                   44       
X002 C                     ELSE                                  
      * Sort Client by Client Name        
     C                     MOVE *OFF      *IN31                   
     C           CL1KY1    SETLLRKCLNTL1                         
     C                     READ RKCLNTL1                 44       
E002 C                     END                                   
X001 C                     ELSE                             
	* Rollup used       
	* Restart loading more records to the subfile       
B002 C           *IN44     IFEQ *OFF                       
     C                     CLEARCURRRN                     
     C                     Z-ADDS1LST     S1RRN            
E002 C                     END                             
E001 C                     END                             
B001 C           *IN44     DOWEQ*OFF                  
     C           CURRRN    ANDLTS1MAX       
	* Maximum records on a page        
B002 C           CLSTUS    IFEQ 'A'                   
	* Record Active       
      * Move data to subfile fields                  
     C                     EXSR LDCL01                
      *  Output a sub-file record                     
     C                     CLEARS1OPT                 
     C                     ADD  1         S1RRN       
     C                     ADD  1         CURRRN        
     C                     WRITESFL01                 
     C                     MOVE *ON       *IN41        
	* SFLDSP       
E002 C                     END                                      
B002 C           *IN31     IFEQ *ON                                 
     C                     READ RKCLNT                   44         
X002 C                     ELSE                                    
     C                     READ RKCLNTL1                 44        
E002 C                     END                                     
E001 C                     END                                     
     C                     Z-ADDS1RRN     S1LST       
B001 C           CURRRN    IFGT *ZEROS                
	* Reposition to the last visible page by setting       
	* S1RRN to the top of the page       
     C           S1LST     SUB  CURRRN    S1RRN       
     C                     ADD  1         S1RRN       
E001 C                     END            
     C                     ENDSR      

Now you know all my secrets. John

0 comments

Oldest 

Forgot Password?

No problem! Submit your e-mail address below. We'll send you an email containing your password.

Your password has been sent to:

-ADS BY GOOGLE

SearchEnterpriseLinux

SearchDataCenter

Close