*************                                                     
       *  PROGRAM ID    : CUSTSFL2B                                      
       *  PROG NAME     : CUSTOMER MASTER SEARCH                         
       *  AUTHORS       : MARTIN O'SULLIVAN                              
       *  DATE          : APRIL 1998                                     
       *  INSTALLATION  : LIT                                            
       ***************************************************************** 
      FSTUDENTLIF  E           K        DISK                             
      FSTUDSRC CF  E                    WORKSTN                          
      F                                        RECNUMKSFILE SUBFILE      
       ****************************************************************  
      C           STDKEY    KLIST                                        
      C                     KFLD           STUDNO                        
      C                     KFLD           COURSN                        
      C                     KFLD           DATET                         
      C           CRSKEY    KLIST                                        
      C                     KFLD           SSNO                          
      C                     KFLD           COURS#                        
      C                     KFLD           TDATE                         
       ***************************************************************** 
       *MAIN CODE                                                        
      C                     WRITEFOOT1                                   
      C                     WRITEHEAD                                    
      C                     EXFMTPROMPT                                  
      C           *IN03     DOWEQ'0'                                     
      C           STDKEY    SETLLSTDREC                   20             
      C           *IN20     IFEQ *ZERO                                   
      C                     MOVE '1'       *IN61                         
      C                     ELSE                                         
      C                     EXSR SFLPRC                                  
      C                     EXSR SFLCHG                                  
      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           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           START     BEGSR                                        
      C                     EXSR SFLCLR                                  
      C                     EXSR SFLFIL                                  
      C                     ENDSR                                        
      C******************************************                        
      C           CONTIN    BEGSR                                        
      C                     WRITEFOOT2                                   
      C                     WRITEHEAD                                    
      C                     EXFMTSUBCTL                                  
      C                     ENDSR                                        
      C******************************************                        
      C           SFLFIL    BEGSR                                        
      C           *IN21     DOWEQ'0'                                     
      C                     READ STDREC                   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           SFLCLR    BEGSR                                        
      C                     MOVE '1'       *IN55                         
      C                     WRITESUBCTL                                  
      C                     MOVE '0'       *IN55                         
      C                     MOVE '0'       *IN21                         
      C                     Z-ADD*ZERO     RECNUM  50                    
      C                     ENDSR                                        
       ****************************************************************  
      C           SFLCHG    BEGSR                                        
      C                     READCSUBFILE                  98             
      C           *IN98     IFEQ '0'                                     
      C           CRSKEY    CHAINSTDREC               71                 
      C                     WRITEFOOT1                                   
      C                     WRITEHEAD                                    
      C                     EXFMTCUSDSP                                  
      C                     ENDIF                                        
      C                     ENDSR                                        

back to RPG page