***********************************************************       
       *THIS PROGRAM DISPLAYS THE CUSTOMER MASTER FILE BY ZIP CODE       
       *PROGRAM ID:      CUSTSFL1B                               *       
       *PROGRAM NAME:    CUSTOMER MASTER SEARCH                  *       
       *AUTHOR:          Martin O'Sullivan
       *DATE WRITTEN     FEBRUARY, 1999                                  
       *DATE MODIFIED:                                                   
       *INSTALLATION:    LIMERICK INSTITUTE OF TECHNOLOGY                
       ***********************************************************       
       ***         INDICATORS   =  03 END THE JOB                        
       ***                         04 RESTART THE ZIP CODE               
       ***                         20 INDEX VALUE EXISTS                 
       ***                         21 SUBFILE FULL                       
       ***                         55 CLEARS SUBFILE                     
       ***                         61 CHAIN ( NOT FOUND)                 
       ***                         71 EOF                                
       ***                         95 ROLL UP KEY PRESSED                
       ******************* FILE SPECIFICATION ************************** 
      FCUSZIPL IF  E           K        DISK                             
      FCUSSRC  CF  E                    WORKSTN                          
      F                                        RECNUMKSFILE SUBFILE      
      C******************* CALCULATIONS ******************************** 
      C           CSTKEY    KLIST                                        
      C                     KFLD           ZIP                           
      C***************************************************************** 
      C*                MAINLINE                                         
      C***************************************************************** 
      C                     WRITEFOOT1                                   
      C                     WRITEHEAD                                    
      C                     EXFMTPROMPT                                  
      C*                                                                 
      C           *IN03     DOWEQ'0'                                     
      C           CSTKEY    SETLLCUSREC                   20             
      C           *IN20     IFEQ *ZERO                                   
      C                     MOVE '1'       *IN61                         
      C                     ELSE                                         
      C                     EXSR SFLPRC                                  
      C                     MOVE '0'       *IN61                         
      C                     END                                          
      C           *IN03     IFEQ '0'                                     
      C           *IN04     IFEQ '0'                                     
      C           *IN61     IFEQ '0'                                     
      C                     WRITEFOOT1                                   
      C                     WRITEHEAD                                    
      C                     END                                          
      C                     EXFMTPROMPT                                  
      C                     END                                          
      C                     END                                          
      C                     END                                          
      C                     MOVE '1'       *INLR                         
      C************************************************************      
      C*      SUBROUTINE - SFLPRC                                        
      C*      PURPOSE - PROCESS SUBFILE AND DISPLAY                      
      C************************************************************      
      C           SFLPRC    BEGSR                                        
      C                     EXSR START                                   
      C                     EXSR CONTIN                                  
      C           *IN95     IFEQ '1'                                     
      C           *IN71     IFEQ '0'                                     
      C                     EXSR START                                   
      C                     ENDIF                                        
      C                     EXSR CONTIN                                  
      C                     END                                          
      C                     ENDSR                                        
      C**********************************************************        
      C*    SUBROUTINE - START                                           
      C*    PURPOSE    - TO START SUBFILE ACTIVITIES (CLEAR AND FILL)    
      C**********************************************************        
      C           START     BEGSR                                        
      C                     EXSR SFLCLR                                  
      C                     EXSR SFLFIL                                  
      C                     ENDSR                                        
      C**********************************************************        
      C*    SUBROUTINE - CONTINUE                                        
      C*    PURPOSE    - TO DISPLAY SUBFILE (HEADINGS ETC.)              
      C**********************************************************        
      C           CONTIN    BEGSR                                        
      C                     WRITEFOOT2                                   
      C                     WRITEHEAD                                    
      C                     EXFMTSUBCTL                                  
      C                     ENDSR                                        
      C**********************************************************        
      C*    SUBROUTINE - SFLFIL                                          
      C*    PURPOSE    - FILL SUBFILE                                    
      C**********************************************************        
      C           SFLFIL    BEGSR                                        
      C           *IN21     DOWEQ'0'                                     
      C           ZIP       READECUSREC                   71             
      C           *IN71     IFEQ '1'                                     
      C                     MOVE '1'       *IN21                         
      C                     ELSE                                         
      C                     ADD  1         RECNUM                        
      C                     WRITESUBFILE                  21             
      C                     END                                          
      C                     END                                          
      C                     ENDSR                                        
      C***************************************************************   
      C*   SUBROUTINE - SFLCLR                                           
      C*   PURPOSE    -  CLEAR SUBFILE RECORDS                           
      C***************************************************************   
      C           SFLCLR    BEGSR                                        
      C                     MOVE '1'       *IN55                         
      C                     WRITESUBCTL                                  
      C                     MOVE '0'       *IN55                         
      C                     MOVE '0'       *IN21                         
      C                     Z-ADD*ZERO     RECNUM  50                    
      C                     ENDSR                                        


back to RPG page