       IDENTIFICATION   DIVISION.                                               
       PROGRAM-ID.      EW032.                                                  
       AUTHOR.          DOE.                                                    
      *****************************************************************         
      *                         COST ANALYSIS                         *         
      *****************************************************************         
      * DATE CREATED:   06/26/95                                      *         
      *****************************************************************         
      * CALL #  - MMDDYY - PURPOSE                                    *         
      * 9511011 - 112295 - REPLACE GOBACK WITH STOP RUN.              *         
      * 9511051 - 112895 - RENAME PERCENTAGE HEADERS                  *         
      * FIX9710 - 042697 - CORRECT CALC OF INDIRECT COST              *         
      * JA      - 090597 - MOD TO CORRECT ROUNDING ERRORS             *         
      * FIX0001 - 051100 - SKIP CHARTER SCHOOL RECORDS(FORM 7)        *         
      * 2006001 - 042506 - ADD FUNCTIONS 6500 & 8200.                 *         
      *                  - CORRECT POTENTIAL DIVISION BY ZERO PROBLEM *         
      *****************************************************************         
                                                                                
       ENVIRONMENT DIVISION.                                                    
                                                                                
       INPUT-OUTPUT SECTION.                                                    
       FILE-CONTROL.                                                            
                                                                                
MVS        SELECT    CRD-CARD          ASSIGN    UT-S-CARDIN.               0021
                                                                               0
MVS        SELECT    SRT-SORT          ASSIGN    DA-SORTWK.                     
                                                                                
MVS        SELECT    PR1-PRNT          ASSIGN    UT-S-PRTOT1.                   
                                                                                
MVS        SELECT    CRF-DISK          ASSIGN       DA-EWCRF                    
                                       ORGANIZATION INDEXED                     
                                       ACCESS       DYNAMIC                     
                                       RECORD KEY   CRFDK                       
                                       FILE STATUS  RETCRF.                     
                                                                                
MVS        SELECT    RWF-DISK          ASSIGN       DA-EWRWF                    
                                       ORGANIZATION INDEXED                     
                                       ACCESS       SEQUENTIAL                  
                                       RECORD KEY   RWFDK                       
                                       FILE STATUS  RETRWF.                     
                                                                                
MVS        SELECT    ABF-DISK          ASSIGN       DA-EWABF                    
                                       ORGANIZATION INDEXED                     
                                       ACCESS       DYNAMIC                     
                                       RECORD KEY   ABFDK                       
                                       FILE STATUS  RETABF.                     
                                                                                
       DATA DIVISION.                                                           
       FILE SECTION.                                                            
                                                                                
       FD  CRD-CARD                                                             
           RECORDING MODE       IS  F                                       0033
           RECORD    CONTAINS   80  CHARACTERS                                  
MVS        BLOCK     CONTAINS    0  RECORDS                                 0034
           LABEL     RECORDS   ARE  OMITTED                                     
           DATA      RECORDS   ARE  CRD  CRH.                                   
                                                                                
       01            CRD.                                                       
001        05        CRDREQ            PIC  X(03).                              
004        05        FILLER            PIC  X(01).                              
005        05        CRDID             PIC  X(02).                              
007        05        FILLER            PIC  X(01).                              
008        05        CRDPRT            PIC  X(01).                              
009        05        FILLER            PIC  X(01).                              
010        05        CRDDIST           PIC  X(02).                              
012        05        FILLER            PIC  X(01).                              
013        05        CRDFY             PIC  X(02).                              
015        05        CRDFUND           PIC  X(01).                              
016        05        CRDSCHL           PIC  X(04).                              
020        05        CRDFSRV           PIC  9(09).                              
029        05        CRDTSCHL          PIC  9(09).                              
038        05        CRDTDIST          PIC  9(09).                              
047        05        CRDPREPD          PIC  9(09).                              
056        05        CRDPREPS          PIC  9(09).                              
065        05        CRDPREPT          PIC  9(09).                              
074        05        CRDSRC            PIC  X(01).                              
075        05        CRDRPT            PIC  X(01).                              
076        05        CRDPGM            PIC  X(05).                              
                                                                                
       01            CRH.                                                       
001        05        CRHREQ            PIC  X(03).                              
004        05        FILLER            PIC  X(01).                              
005        05        CRHID             PIC  X(02).                              
007        05        FILLER            PIC  X(01).                              
008        05        CRHUSER           PIC  X(08).                              
016        05        FILLER            PIC  X(01).                              
           05        CRHHEAD.                                                   
017          10      CRHB       OCCURS 050  TIMES  INDEXED BY CRH1              
                                       PIC  X(01).                              
067        05        FILLER            PIC  X(14).                              
                                                                                
       FD  PR1-PRNT                                                             
           RECORDING MODE       IS  F                                       0044
VSE        RECORD    CONTAINS  133  CHARACTERS                                  
MVS        BLOCK     CONTAINS    0  RECORDS                                     
           LABEL     RECORDS   ARE  OMITTED                                     
           DATA      RECORDS   ARE  LNM  LN1  LN2  LN3.                         
                                                                                
       01  LNM.                                                                 
VSE        05        FILLER            PIC  X(01).                              
002        05        LNMMSG            PIC  X(20).                              
022        05        FILLER            PIC  X(02).                              
024        05        LNMVALUE1         PIC  X(02).                              
026        05        FILLER            PIC  X(01).                              
027        05        LNMVALUE2         PIC  X(80).                              
107        05        FILLER            PIC  X(27).                              
                                                                                
       01            LN1.                                                       
VSE        05        FILLER            PIC  X(01).                              
002        05        LN1PGM            PIC  X(04).                              
006        05        LN1DSAL           PIC  ZZZZZZZZZ-.                         
016        05        LN1DBEN           PIC  ZZZZZZZZZ-.                         
026        05        LN1DPRCH          PIC  ZZZZZZZZZ-.                         
036        05        LN1DMATSUP        PIC  ZZZZZZZZZ-.                         
046        05        LN1DOTHER         PIC  ZZZZZZZZZ-.                         
056        05        LN1DCAP           PIC  ZZZZZZZZZ-.                         
066        05        LN1SIND           PIC  ZZZZZZZZZ-.                         
076        05        LN1DIND           PIC  ZZZZZZZZZ-.                         
086        05        LN1TOTAL          PIC  ZZZZZZZZZZ-.                        
097        05        LN1STAFF          PIC  ZZZZZ.ZZZ-.                         
107        05        LN1SSAL           PIC  ZZZZZZZZZ-.                         
112895     05        FILLER            PIC  X(01).                              
117        05        LN1CEIND          PIC  ZZZ.                                
120        05        FILLER            PIC  X(01).                              
112895     05        FILLER            PIC  X(01).                              
121        05        LN1CEDIST         PIC  ZZZ.                                
112895*    05        FILLER            PIC  X(10).                              
112895     05        FILLER            PIC  X(08).                              
                                                                                
       01            LN2.                                                       
VSE        05        FILLER            PIC  X(01).                              
002        05        FILLER            PIC  X(68).                              
070        05        LN2MSG1           PIC  X(05).                              
075        05        LN2RCD1           PIC  X(05).                              
080        05        LN2MSG2           PIC  X(06).                              
086        05        LN2TOT            PIC  ZZZZZZZZZZ-.                        
097        05        LN2STAFF          PIC  ZZZZZ.ZZZ-.                         
107        05        FILLER            PIC  X(27).                              
                                                                                
       01            LN3.                                                       
VSE        05        FILLER            PIC  X(01).                              
002        05        FILLER            PIC  X(105).                             
107        05        LN3ESSAL          PIC  X(09).                              
116        05        FILLER            PIC  X(01).                              
112895     05        FILLER            PIC  X(01).                              
117        05        LN3ECEIND         PIC  X(03).                              
120        05        FILLER            PIC  X(01).                              
112895     05        FILLER            PIC  X(01).                              
121        05        LN3ECEDIST        PIC  X(03).                              
112895*    05        LN3EMSG           PIC  X(10).                              
112895     05        LN3EMSG           PIC  X(08).                              
                                                                                
           COPY                        EWCRFD.                                  
           COPY                        EWRWFD.                                  
           COPY                        EWABFD.                                  
                                                                                
       SD  SRT-SORT.                                                            
                                                                                
       01            SRT.                                                       
           05        SRTKEY.                                                    
             10      SRTKDIST          PIC  X(02).                              
             10      SRTKREQ.                                                   
               15    SRTKREQ1          PIC  X(01).                              
               15    SRTKREQ2          PIC  X(01).                              
               15    SRTKREQ3          PIC  X(01).                              
             10      SRTKFY.                                                    
               15    SRTKFY1           PIC  X(01).                              
               15    SRTKFY2           PIC  X(01).                              
             10      SRTKFUND          PIC  X(01).                              
             10      SRTKSCHL          PIC  X(04).                              
             10      SRTKPGM           PIC  X(03).                              
           05        SRTDATA.                                                   
JA0997*      10      SRTDSAL           PIC  S9(09).                             
JA0997*      10      SRTDBEN           PIC  S9(09).                             
JA0997*      10      SRTDPRCH          PIC  S9(09).                             
JA0997*      10      SRTDMATSUP        PIC  S9(09).                             
JA0997*      10      SRTDOTHER         PIC  S9(09).                             
JA0997*      10      SRTDCAP           PIC  S9(09).                             
JA0997*      10      SRTSIND           PIC  S9(09).                             
JA0997*      10      SRTDIND           PIC  S9(09).                             
JA0997*      10      SRTTOTAL          PIC  S9(10).                             
JA0997       10      SRTDSAL           PIC  S9(09).                             
JA0997       10      SRTDBEN           PIC  S9(09).                             
JA0997       10      SRTDPRCH          PIC  S9(09).                             
JA0997       10      SRTDMATSUP        PIC  S9(09).                             
JA0997       10      SRTDOTHER         PIC  S9(09).                             
JA0997       10      SRTDCAP           PIC  S9(09).                             
JA0997       10      SRTSIND           PIC  S9(09).                             
JA0997       10      SRTDIND           PIC  S9(09).                             
JA0997       10      SRTTOTAL          PIC  S9(10).                             
             10      SRTPRT            PIC  X(01).                              
             10      SRTRPT            PIC  X(01).                              
                                                                                
       WORKING-STORAGE SECTION.                                                 
                                                                                
       01            WSC.                                                       
JA0997*    05        WSCSIND           PIC  S9(09).                             
JA0997*    05        WSCDIND           PIC  S9(09).                             
JA0997*    05        WSCTOTAL          PIC  S9(09).                             
JA0997*    05        WSCSDIND          PIC  S9(09).                             
JA0997     05        WSCSIND           PIC  S9(09)V9(7).                        
JA0997     05        WSCDIND           PIC  S9(09)V9(7).                        
JA0997     05        WSCTOTAL          PIC  S9(09)V9(7).                        
JA0997     05        WSCSDIND          PIC  S9(09)V9(7).                        
           05        WSCSPCT           PIC  S9(03)V9(02).                       
           05        WSCDPCT           PIC  S9(03)V9(02).                       
           05        WSCSPCT2          PIC  S9(01)V9(02).                       
           05        WSCDPCT2          PIC  S9(01)V9(02).                       
                                                                                
       01            RET.                                                       
           05        RETCRF            PIC  X(02) VALUE '00'.                   
           05        RETRWF            PIC  X(02) VALUE '00'.                   
           05        RETABF            PIC  X(02) VALUE '00'.                   
                                                                                
       01            SYS.                                                       
           05        SYSTIME.                                                   
             10      SYSHR             PIC  X(02).                              
             10      SYSMIN            PIC  X(02).                              
             10      SYSSEC            PIC  X(02).                              
           05        SYSDATE.                                                   
             10      SYSYY             PIC  9(02).                              
             10      SYSMM             PIC  X(02).                              
             10      SYSDD             PIC  X(02).                              
                                                                                
       01            CTLAREA.                                                   
           05        CTLCHAR           PIC  X(01) VALUE ' '.                    
           05        ERR.                                                       
             10      ERRREQ            PIC  X(03).                              
             10      FILLER            PIC  X(01).                              
             10      ERRID             PIC  X(02).                              
             10      FILLER            PIC  X(01).                              
             10      ERRPRT            PIC  X(01).                              
             10      FILLER            PIC  X(01).                              
             10      ERRDIST           PIC  X(02).                              
             10      FILLER            PIC  X(01).                              
             10      ERRFY             PIC  X(02).                              
             10      ERRFUND           PIC  X(01).                              
             10      ERRSCHL           PIC  X(04).                              
             10      FILLER            PIC  X(55).                              
             10      ERRRPT            PIC  X(01).                              
             10      ERRPGM            PIC  X(05).                              
                                                                                
       01            RQR.                                                       
           05        RQRREQ            PIC  X(03).                              
           05        RQRPRT            PIC  X(01).                              
           05        RQRDIST           PIC  X(02).                              
           05        RQRFY             PIC  X(02).                              
           05        RQRSEL.                                                    
             10      RQRFUND           PIC  X(01).                              
             10      RQRSCHL           PIC  X(04).                              
           05        RQRSELR    REDEFINES   RQRSEL.                             
             10      RQRB       OCCURS 005  TIMES INDEXED BY RQR1               
                                       PIC  X(01).                              
           05        RQRFSRV           PIC  9(09).                              
           05        RQRTSCHL          PIC  9(09).                              
           05        RQRTDIST          PIC  9(09).                              
           05        RQRPREPD          PIC  9(09).                              
           05        RQRPREPS          PIC  9(09).                              
           05        RQRPREPT          PIC  9(09).                              
           05        RQRSRC            PIC  X(01).                              
           05        RQRPGM            PIC  X(05).                              
           05        RQRRPT            PIC  X(01).                              
                                                                                
       01            SEL.                                                       
           05        SELFUND           PIC  X(01).                              
           05        SELSCHL           PIC  X(04).                              
       01            SELR       REDEFINES   SEL.                                
           05        SELB       OCCURS 005  TIMES INDEXED BY SEL1               
                                       PIC  X(01).                              
                                                                                
       01            RQH.                                                       
           05        RQHENTRY   OCCURS 100  TIMES INDEXED BY RQH1.              
             10      RQHREQ            PIC  X(03).                              
             10      RQHID             PIC  X(02).                              
             10      RQHUSER           PIC  X(08).                              
             10      RQHHEAD.                                                   
               15    RQHB       OCCURS 050  TIMES INDEXED BY RQH2               
                                       PIC  X(01).                              
                                                                                
       01            STRKEY.                                                    
           05        STRDIST           PIC  X(02) VALUE HIGH-VALUES.            
           05        STRFY             PIC  X(02) VALUE HIGH-VALUES.            
           05        STRFUND           PIC  X(01) VALUE HIGH-VALUES.            
           05        FILLER            PIC  X(12) VALUE HIGH-VALUES.            
                                                                                
       01            ENDKEY.                                                    
           05        ENDDIST           PIC  X(02) VALUE LOW-VALUES.             
           05        ENDFY             PIC  X(02) VALUE LOW-VALUES.             
           05        ENDFUND           PIC  X(01) VALUE LOW-VALUES.             
           05        FILLER            PIC  X(12) VALUE LOW-VALUES.             
                                                                                
       01            TBF.                                                       
           05        TBFENTRY          OCCURS     1000 TIMES                    
                                       ASCENDING   KEY TBFKEY                   
                                       INDEXED      BY TBF1.                    
             10      TBFKEY.                                                    
               15    TBFPGM            PIC  X(03).                              
             10      TBFDATA.                                                   
               15    TBFSTAFF          PIC S9(04)V9(03).                        
                                                                                
       01            CTR.                                                       
           05        CTRLN             PIC  S9(03)     COMP-3 VALUE +0.         
           05        CTRPG             PIC  S9(03)     COMP-3 VALUE +0.         
           05        CTRIDX            PIC  S9(05)     COMP-3 VALUE +0.         
JA0997*    05        CTRPTOTAL         PIC  S9(09)     COMP-3 VALUE +0.         
JA0997     05        CTRPTOTAL        PIC  S9(09)V9(7) COMP-3 VALUE +0.         
           05        CTRPSTAFF         PIC  S9(09)V9(03)                        
                                                       COMP-3 VALUE +0.         
JA0997*    05        CTRSTOTAL         PIC  S9(09)     COMP-3 VALUE +0.         
JA0997     05        CTRSTOTAL        PIC  S9(09)V9(7) COMP-3 VALUE +0.         
           05        CTRSSTAFF         PIC  S9(09)V9(03)                        
                                                       COMP-3 VALUE +0.         
JA0997*    05        CTRRTOTAL         PIC  S9(09)     COMP-3 VALUE +0.         
JA0997     05        CTRRTOTAL        PIC  S9(09)V9(7) COMP-3 VALUE +0.         
           05        CTRRSTAFF         PIC  S9(09)V9(03)                        
                                                       COMP-3 VALUE +0.         
JA0997*    05        CTRDSAL           PIC  S9(09).                             
JA0997*    05        CTRDBEN           PIC  S9(09).                             
JA0997*    05        CTRDPRCH          PIC  S9(09).                             
JA0997*    05        CTRDMATSUP        PIC  S9(09).                             
JA0997*    05        CTRDOTHER         PIC  S9(09).                             
JA0997*    05        CTRDCAP           PIC  S9(09).                             
JA0997*    05        CTRSIND           PIC  S9(09).                             
JA0997*    05        CTRDIND           PIC  S9(09).                             
JA0997*    05        CTRTOTAL          PIC  S9(10).                             
JA0997     05        CTRDSAL           PIC  S9(09)V9(7).                        
JA0997     05        CTRDBEN           PIC  S9(09)V9(7).                        
JA0997     05        CTRDPRCH          PIC  S9(09)V9(7).                        
JA0997     05        CTRDMATSUP        PIC  S9(09)V9(7).                        
JA0997     05        CTRDOTHER         PIC  S9(09)V9(7).                        
JA0997     05        CTRDCAP           PIC  S9(09)V9(7).                        
JA0997     05        CTRSIND           PIC  S9(09)V9(7).                        
JA0997     05        CTRDIND           PIC  S9(09)V9(7).                        
JA0997     05        CTRTOTAL          PIC  S9(10)V9(7).                        
           05        CTRSTAFF          PIC  S9(07)V9(03).                       
JA0997*    05        CTRSSAL           PIC  S9(07).                             
JA0997     05        CTRSSAL           PIC  S9(07)V9(7).                        
                                                                                
       01            OLD.                                                       
           05        OLDKEY.                                                    
             10      OLDKDIST          PIC  X(02).                              
             10      OLDKREQ           PIC  X(03).                              
             10      OLDKFY            PIC  X(02).                              
             10      OLDKFUND          PIC  X(01).                              
             10      OLDKSCHL          PIC  X(04).                              
             10      OLDKPGM           PIC  X(03).                              
           05        OLDPRT            PIC  X(01).                              
           05        OLDRPT            PIC  X(01).                              
                                                                                
                                                                                
           COPY                        EWSCL.                                   
           COPY                        EWIOP.                                   
           COPY                        EWRWF.                                   
           COPY                        EWABF.                                   
           COPY                        EWFPG.                                   
                                                                                
       01            OLDLN             PIC  X(133).                             
                                                                                
       01      HD1.                                                             
VSE        05  FILLER  PIC X(01) VALUE ' '.                                     
002        05  FILLER  PIC X(06) VALUE 'EW032 '.                                
           05  HD1ABBR.                                                         
008         10 HD1B    OCCURS 22 TIMES INDEXED BY HD11 PIC X(01).               
030        05  FILLER  PIC X(32) VALUE SPACES.                                  
062        05  FILLER  PIC X(13) VALUE 'COST ANALYSIS'.                         
075        05  FILLER  PIC X(25) VALUE SPACES.                                  
100        05  HD1USER PIC X(09) VALUE SPACES.                                  
109        05  HD1MM   PIC X(02) VALUE SPACES.                                  
111        05  FILLER  PIC X(01) VALUE '/'.                                     
112        05  HD1DD   PIC X(02) VALUE SPACES.                                  
114        05  FILLER  PIC X(01) VALUE '/'.                                     
115        05  HD1YY   PIC X(02) VALUE SPACES.                                  
117        05  FILLER  PIC X(01) VALUE SPACES.                                  
118        05  HD1HR   PIC X(02) VALUE SPACES.                                  
120        05  FILLER  PIC X(01) VALUE ':'.                                     
121        05  HD1MN   PIC X(02) VALUE SPACES.                                  
123        05  FILLER  PIC X(07) VALUE '  PAGE-'.                               
130        05  HD1PG   PIC ZZZ9.                                                
                                                                                
       01      HD2.                                                             
VSE        05  FILLER  PIC X(01) VALUE ' '.                                     
002        05  FILLER  PIC X(41) VALUE SPACES.                                  
           05  HD2HEAD.                                                         
043         10 HD2B    OCCURS 50 TIMES INDEXED BY HD21 PIC X(01).               
093        05  FILLER  PIC X(41) VALUE SPACES.                                  
                                                                                
       01      HD3.                                                             
VSE        05  FILLER  PIC X(01) VALUE ' '.                                     
002        05  FILLER  PIC X(41) VALUE SPACES.                                  
           05  HD3HEAD.                                                         
043         10 HD3B    OCCURS 50 TIMES INDEXED BY HD31 PIC X(01).               
093        05  FILLER  PIC X(41) VALUE SPACES.                                  
                                                                                
       01      HD4.                                                             
VSE        05  FILLER  PIC X(01) VALUE ' '.                                     
002        05  FILLER  PIC X(06)  VALUE 'FUND- '.                               
008        05  HD4FND  PIC X(01)  VALUE SPACES.                                 
009        05  FILLER  PIC X(125) VALUE SPACES.                                 
                                                                                
       01      HD5.                                                             
VSE        05  FILLER  PIC X(01) VALUE ' '.                                     
002        05  FILLER  PIC X(06) VALUE 'SCHL- '.                                
008        05  HD5SCHL PIC X(04) VALUE SPACES.                                  
012        05  FILLER  PIC X(01) VALUE SPACES.                                  
013        05  HD5DESC PIC X(30) VALUE SPACES.                                  
043        05  FILLER  PIC X(91) VALUE SPACES.                                  
                                                                                
       01      HD6.                                                             
VSE        05  FILLER  PIC X(01) VALUE ' '.                                     
002        05  FILLER  PIC X(29) VALUE 'PGM  SALARIES  BENEFITS PURCH'.         
031        05  FILLER  PIC X(29) VALUE ' SRV   MAT&SUP     OTHER   CA'.         
060        05  FILLER  PIC X(29) VALUE 'PITAL  SCHL IND  DIST IND    '.         
089        05  FILLER  PIC X(29) VALUE '  TOTAL     STAFF STAFF-SAL I'.         
112895*    05  FILLER  PIC X(17) VALUE 'D% DS%'.                                
112895     05  FILLER  PIC X(17) VALUE 'ND% IND%'.                              
                                                                                
112895 01      HD7.                                                             
112895     05  FILLER  PIC X(116) VALUE ' '.                                    
112895     05  FILLER  PIC X(17) VALUE 'TOT  DIST'.                             
                                                                                
       PROCEDURE DIVISION.                                                      
      ******************************************************************        
           SORT    SRT-SORT            ASCENDING KEY       SRTKEY               
                                       INPUT     PROCEDURE 000-INPUT            
                                       OUTPUT    PROCEDURE 500-OUTPUT.          
112295*    GOBACK.                                                              
112295     STOP                        RUN.                                     
                                                                                
      ******************************************************************        
       000-INPUT SECTION.                                                       
           PERFORM 490-HOUSEKEEPING    THRU 490-EXIT.                           
                                                                                
       005-LOOP.                                                                
           IF      RETRWF              NOT  =  '00'                             
             GO                        TO   499-EOJ.                            
           PERFORM 015-SELECT          THRU 015-EXIT                            
           PERFORM 010-READ            THRU 010-EXIT                            
           GO                          TO   005-LOOP.                           
                                                                                
      ******************************************************************        
       010-READ.                                                                
           READ    RWF-DISK           NEXT                                      
           IF     (RWFDK               >    ENDKEY)                  OR         
                  (RETRWF              NOT  =   '00')                           
             MOVE  '99'                TO   RETRWF                              
           ELSE                                                                 
             MOVE  RWFD                TO   RWF.                                
       010-EXIT.                                                                
           EXIT.                                                                
                                                                                
      ******************************************************************        
       015-SELECT.                                                              
           IF     (RQRREQ              =    HIGH-VALUES)                        
             GO                        TO   015-EXIT.                           
                                                                                
           MOVE    RWFFUND             TO   SELFUND                             
           MOVE    RWFSCHL             TO   SELSCHL                             
           SET     RQR1  SEL1          TO   +1.                                 
       015-MASK.                                                                
           IF      RQRB    (RQR1)      =    SPACES                              
             MOVE  ' '                 TO   SELB         (SEL1).                
           IF      RQR1                <    +5                                  
             SET   RQR1  SEL1          UP   BY  +1                              
             GO                        TO   015-MASK.                           
                                                                                
           IF     (RQRDIST             NOT  =  RWFDIST)      OR                 
                  (RQRFY               NOT  =  RWFFY)        OR                 
                  (RQRSEL              NOT  =  SEL)          OR                 
051100            (RWFTABLE            =    '99998')         OR                 
                  (RWFTABLE            =    '99999'       AND                   
                   RWFSCHL             =    '0000'        AND                   
                   RWFPGM              =    SPACES)                             
             GO                        TO   015-EXIT.                           
           MOVE    ZEROS               TO   WSCSIND        WSCDIND              
                                            WSCTOTAL                            
                                                                                
           MOVE    SPACES              TO   SRT                                 
           MOVE    ZEROS               TO   SRTDSAL        SRTDBEN              
                                            SRTDPRCH       SRTDMATSUP           
                                            SRTDOTHER      SRTDCAP              
                                            SRTSIND        SRTDIND              
                                            SRTTOTAL                            
           MOVE    RQRDIST             TO   SRTKDIST                            
           MOVE    RQRREQ              TO   SRTKREQ                             
           MOVE    RWFFY               TO   SRTKFY                              
           MOVE    RWFFUND             TO   SRTKFUND                            
           MOVE    RWFSCHL             TO   SRTKSCHL                            
           MOVE    RWFPGM              TO   SRTKPGM                             
           MOVE    RQRPRT              TO   SRTPRT                              
           MOVE    RQRRPT              TO   SRTRPT                              
           MOVE    RWFDSAL             TO   SRTDSAL                             
           ADD     RWFDSAL             TO   WSCTOTAL                            
           MOVE    RWFDBEN             TO   SRTDBEN                             
           ADD     RWFDBEN             TO   WSCTOTAL                            
           MOVE    RWFDPRCH            TO   SRTDPRCH                            
           ADD     RWFDPRCH            TO   WSCTOTAL                            
           MOVE    RWFDMATSUP          TO   SRTDMATSUP                          
           ADD     RWFDMATSUP          TO   WSCTOTAL                            
           MOVE    RWFDOTHER           TO   SRTDOTHER                           
           ADD     RWFDOTHER           TO   WSCTOTAL                            
           MOVE    RWFDCAP             TO   SRTDCAP                             
           ADD     RWFDCAP             TO   WSCTOTAL                            
           ADD     RWFSI6100           TO   WSCSIND                             
           ADD     RWFSI6200           TO   WSCSIND                             
           ADD     RWFSI6300           TO   WSCSIND                             
           ADD     RWFSI6400           TO   WSCSIND                             
042506     ADD     RWFSI6500           TO   WSCSIND                             
           ADD     RWFSI7300           TO   WSCSIND                             
           ADD     RWFSI7400           TO   WSCSIND                             
           ADD     RWFSI7600           TO   WSCSIND                             
           ADD     RWFSI7700           TO   WSCSIND                             
           ADD     RWFSI7800           TO   WSCSIND                             
           ADD     RWFSI7900           TO   WSCSIND                             
           ADD     RWFSI8100           TO   WSCSIND                             
042506     ADD     RWFSI8200           TO   WSCSIND                             
           MOVE    WSCSIND             TO   SRTSIND                             
           ADD     WSCSIND             TO   WSCTOTAL                            
           ADD     RWFDI6100           TO   WSCDIND                             
           ADD     RWFDI6200           TO   WSCDIND                             
           ADD     RWFDI6300           TO   WSCDIND                             
           ADD     RWFDI6400           TO   WSCDIND                             
042506     ADD     RWFDI6500           TO   WSCDIND                             
           ADD     RWFDI7100           TO   WSCDIND                             
           ADD     RWFDI7200           TO   WSCDIND                             
           ADD     RWFDI7400           TO   WSCDIND                             
           ADD     RWFDI7500           TO   WSCDIND                             
           ADD     RWFDI7600           TO   WSCDIND                             
           ADD     RWFDI7700           TO   WSCDIND                             
           ADD     RWFDI7800           TO   WSCDIND                             
           ADD     RWFDI7900           TO   WSCDIND                             
042697*    ADD     RWFDI7900           TO   WSCDIND                             
042697     ADD     RWFDI8100           TO   WSCDIND                             
042506     ADD     RWFDI8200           TO   WSCDIND                             
           MOVE    WSCDIND             TO   SRTDIND                             
           ADD     WSCDIND             TO   WSCTOTAL                            
           MOVE    WSCTOTAL            TO   SRTTOTAL                            
           RELEASE  SRT                                                         
           MOVE    '0000'              TO   SRTKSCHL                            
           RELEASE  SRT.                                                        
       015-EXIT.                                                                
           EXIT.                                                                
                                                                                
      ******************************************************************        
       490-HOUSEKEEPING.                                                        
           OPEN    INPUT                    CRD-CARD      CRF-DISK              
                                            RWF-DISK      ABF-DISK              
                   OUTPUT                   PR1-PRNT                            
           MOVE    SPACES              TO   LN1                                 
           MOVE    '1'                 TO   CTLCHAR                             
           MOVE    HIGH-VALUES         TO   RQR           RQH.                  
           SET     RQH1                TO   +1.                                 
       490-LOAD.                                                                
           READ    CRD-CARD            AT   END                                 
             GO                        TO   490-TEST.                           
           IF      CRDREQ              NOT  NUMERIC                             
             MOVE    CRD               TO   LNMVALUE2                           
             PERFORM 520-PRINT         THRU 520-EXIT                            
             GO                        TO   490-LOAD.                           
           MOVE    SPACES              TO   ERR                                 
           IF      CRDID               =    'SL'                                
             GO                        TO   490-REQ                             
           ELSE                                                                 
             IF     (CRDID             =    'H1')                    OR         
                    (CRDID             =    'H2')                               
               GO                      TO   490-HEAD                            
             ELSE                                                               
               GO                      TO   490-LOAD.                           
                                                                                
       490-REQ.                                                                 
           IF     (CRDPRT              NOT  =   'U')                 AND        
                  (CRDPRT              NOT  =   'T')                 AND        
                  (CRDPRT              NOT  =   'B')                 AND        
                  (CRDPRT              NOT  =   'N')                            
             MOVE  ALL '-'             TO   ERRPRT.                             
           IF     (CRDDIST             =    SPACES)                             
             MOVE  ALL '-'             TO   ERRDIST.                            
           IF     (CRDFY               NOT  NUMERIC)                            
             MOVE  ALL '-'             TO   ERRFY.                              
           IF     (CRDRPT              NOT  =   'D')                            
             MOVE  ALL '-'             TO   ERRRPT.                             
           IF     (CRDFUND             NOT  =   '1')             AND            
                  (CRDFUND             NOT  =   '4')             AND            
                  (CRDFUND             NOT  =   ' ')                            
             MOVE  ALL '-'             TO   ERRFUND.                            
           IF      ERR                 NOT  =   SPACES                          
             MOVE    'ERROR. BYPASSED' TO   LNMMSG                              
             MOVE    CRD               TO   LNMVALUE2                           
             PERFORM 520-PRINT         THRU 520-EXIT                            
             MOVE    ERR               TO   LNMVALUE2                           
             PERFORM 520-PRINT         THRU 520-EXIT                            
             GO                        TO   490-LOAD                            
           ELSE                                                                 
             MOVE    'REQUEST LOADED'  TO   LNMMSG                              
             MOVE    CRD               TO   LNMVALUE2                           
             PERFORM 520-PRINT         THRU 520-EXIT.                           
           MOVE    CRDREQ              TO   RQRREQ                              
           MOVE    CRDPRT              TO   RQRPRT                              
           MOVE    CRDDIST             TO   RQRDIST                             
           MOVE    CRDFY               TO   RQRFY                               
           MOVE    CRDFUND             TO   RQRFUND                             
           MOVE    CRDSCHL             TO   RQRSCHL                             
           MOVE    CRDFSRV             TO   RQRFSRV                             
           MOVE    CRDTSCHL            TO   RQRTSCHL                            
           MOVE    CRDTDIST            TO   RQRTDIST                            
           MOVE    CRDPREPD            TO   RQRPREPD                            
           MOVE    CRDPREPS            TO   RQRPREPS                            
           MOVE    CRDPREPT            TO   RQRPREPT                            
           MOVE    CRDSRC              TO   RQRSRC                              
           MOVE    CRDRPT              TO   RQRRPT                              
                                                                                
           MOVE    CRDDIST             TO   RWFKEY                              
           MOVE    CRDFY               TO   RWFFY                               
           MOVE    CRDFUND             TO   RWFFUND                             
           IF     (RWFKEY              <    STRKEY)                             
             MOVE  RWFKEY              TO   STRKEY.                             
           SET     RWF1                TO   +1.                                 
       490-SET.                                                                 
           IF      RWFB     (RWF1)     =    SPACES                              
             MOVE  HIGH-VALUES         TO   RWFB (RWF1).                        
           IF      RWF1                <    +17                                 
             SET   RWF1                UP   BY  +1                              
             GO                        TO   490-SET.                            
           IF     (RWFKEY              >    ENDKEY)                             
             MOVE  RWFKEY              TO   ENDKEY.                             
           GO                          TO   490-LOAD.                           
       490-HEAD.                                                                
           MOVE    CRD                 TO   LNMVALUE2                           
           PERFORM 520-PRINT           THRU 520-EXIT                            
           MOVE    CRHREQ              TO   RQHREQ       (RQH1)                 
           MOVE    CRHID               TO   RQHID        (RQH1)                 
           MOVE    CRHUSER             TO   RQHUSER      (RQH1)                 
           MOVE    SPACES              TO   RQHHEAD      (RQH1)                 
           MOVE    +50                 TO   CTRIDX                              
           SET     CRH1                TO   +50.                                
       490-HEAD1.                                                               
           IF      CRHB         (CRH1) =    SPACES                              
             IF      CRH1              >    +2                                  
               ADD   -1                TO   CTRIDX                              
               SET   CRH1              DOWN BY  +1                              
               GO                      TO   490-HEAD1.                          
           SUBTRACT +1                 FROM CTRIDX                              
           COMPUTE CTRIDX      ROUNDED =    (50  - CTRIDX) / 2                  
           SET     RQH2                TO   CTRIDX                              
           SET     CRH1                TO   +1.                                 
       490-HEAD2.                                                               
           MOVE    CRHB         (CRH1) TO   RQHB         (RQH1 RQH2)            
           IF      RQH2                <    +50                                 
             SET   RQH2  CRH1          UP   BY  +1                              
             GO                        TO   490-HEAD2.                          
           SET     RQH1             UP BY   +1                                  
           GO                          TO   490-LOAD.                           
                                                                                
       490-TEST.                                                                
           IF      RQR                 =    HIGH-VALUES                         
             MOVE    'EW032 NO REQUESTS *'   TO   LNMMSG                        
             PERFORM 520-PRINT         THRU 520-EXIT.                           
           IF      RETCRF              NOT  =   '00'                            
             MOVE    'CRF OPEN ERROR'  TO   LNMMSG                              
             MOVE    RETCRF            TO   LNMVALUE1                           
             PERFORM 520-PRINT         THRU 520-EXIT.                           
           IF      RETRWF              NOT  =   '00'                            
             MOVE    'RWF OPEN ERROR'  TO   LNMMSG                              
             MOVE    RETRWF            TO   LNMVALUE1                           
             PERFORM 520-PRINT         THRU 520-EXIT.                           
           IF      RETABF              NOT  =   '00'                            
             MOVE    'ABF OPEN ERROR'  TO   LNMMSG                              
             MOVE    RETABF            TO   LNMVALUE1                           
             PERFORM 520-PRINT         THRU 520-EXIT.                           
           IF     (RETCRF              NOT  =   '00')                OR         
                  (RETRWF              NOT  =   '00')                OR         
                  (RETABF              NOT  =   '00')                           
             GO                        TO   499-EOJ.                            
           MOVE    STRKEY              TO   RWFDK                               
           START   RWF-DISK        KEY >    RWFDK                               
           IF      RETRWF              =    '00'                                
             PERFORM 010-READ          THRU 010-EXIT.                           
       490-EXIT.                                                                
           EXIT.                                                                
                                                                                
      ******************************************************************        
       499-EOJ.                                                                 
       499-EXIT.                                                                
           EXIT.                                                                
                                                                                
      ******************************************************************        
       500-OUTPUT SECTION.                                                      
           PERFORM 990-HOUSEKEEPING    THRU 990-EXIT.                           
       505-LOOP.                                                                
             IF    (SRTKDIST           NOT  =   OLDKDIST)            OR         
                   (SRTKREQ            NOT  =   OLDKREQ)             OR         
                   (SRTKFY             NOT  =   OLDKFY)              OR         
                   (SRTKFUND           NOT  =   OLDKFUND)            OR         
                   (SRTKSCHL           NOT  =   OLDKSCHL)            OR         
                   (SRTKPGM            NOT  =   OLDKPGM)                        
               PERFORM 615-1TOT        THRU 615-EXIT                            
               IF  (SRTKDIST           NOT  =   OLDKDIST)            OR         
                   (SRTKREQ            NOT  =   OLDKREQ)             OR         
                   (SRTKFY             NOT  =   OLDKFY)              OR         
                   (SRTKFUND           NOT  =   OLDKFUND)            OR         
                   (SRTKSCHL           NOT  =   OLDKSCHL)                       
                 PERFORM 625-2TOT      THRU 625-EXIT                            
                 IF  (SRTKDIST         NOT  =   OLDKDIST)            OR         
                     (SRTKREQ          NOT  =   OLDKREQ)             OR         
                     (SRTKFY           NOT  =   OLDKFY)              OR         
                     (SRTKFUND         NOT  =   OLDKFUND)                       
                   PERFORM 635-3TOT    THRU 635-EXIT                            
                   IF  (SRTKDIST       NOT  =   OLDKDIST)            OR         
                       (SRTKREQ        NOT  =   OLDKREQ)             OR         
                       (SRTKFY         NOT  =   OLDKFY)                         
                     PERFORM 645-4TOT  THRU 645-EXIT                            
                     IF  (SRTKEY       =    HIGH-VALUES)                        
                       GO              TO   999-EOJ                             
                     ELSE                                                       
                       PERFORM 640-4CHG     THRU 640-EXIT                       
                   ELSE                                                         
                     PERFORM 630-3CHG       THRU 630-EXIT                       
                 ELSE                                                           
                   PERFORM 620-2CHG         THRU 620-EXIT                       
               ELSE                                                             
                 PERFORM 610-1CHG           THRU 610-EXIT.                      
                                                                                
           PERFORM 515-PROCESS         THRU 515-EXIT                            
           PERFORM 510-READ            THRU 510-EXIT                            
           GO                          TO   505-LOOP.                           
                                                                                
      ******************************************************************        
       510-READ.                                                                
           RETURN  SRT-SORT            AT   END                                 
             MOVE  HIGH-VALUES         TO   SRTKEY.                             
       510-EXIT.                                                                
           EXIT.                                                                
                                                                                
      ******************************************************************        
       515-PROCESS.                                                             
           ADD     SRTTOTAL            TO   CTRPTOTAL                           
           ADD     SRTDSAL             TO   CTRDSAL                             
           ADD     SRTDBEN             TO   CTRDBEN                             
           ADD     SRTDPRCH            TO   CTRDPRCH                            
           ADD     SRTDMATSUP          TO   CTRDMATSUP                          
           ADD     SRTDOTHER           TO   CTRDOTHER                           
           ADD     SRTDCAP             TO   CTRDCAP                             
           ADD     SRTSIND             TO   CTRSIND                             
           ADD     SRTDIND             TO   CTRDIND                             
           ADD     SRTTOTAL            TO   CTRTOTAL.                           
       515-EXIT.                                                                
           EXIT.                                                                
                                                                                
      ******************************************************************        
       520-PRINT.                                                               
           IF      CTRLN               >    +60                                 
             PERFORM 525-HEADS         THRU 525-EXIT.                           
           IF      CTLCHAR             =    '1'                                 
             WRITE LN1             AFTER    ADVANCING PAGE                      
           ELSE                                                                 
             IF      CTLCHAR           =    '0'                                 
               WRITE LN1           AFTER    ADVANCING  2  LINES                 
               ADD   +2                TO   CTRLN                               
             ELSE                                                               
               IF      CTLCHAR         =    ' '                                 
                 WRITE LN1         AFTER    ADVANCING  1  LINES                 
                 ADD   +1              TO   CTRLN                               
               ELSE                                                             
                 WRITE LN1         AFTER    ADVANCING  0  LINES                 
                 ADD   +0              TO   CTRLN.                              
           MOVE    SPACES              TO   LN1           CTLCHAR.              
       520-EXIT.                                                                
           EXIT.                                                                
                                                                                
       525-HEADS.                                                               
           MOVE    LN1                 TO   OLDLN                               
           MOVE    +0                  TO   CTRLN                               
           ADD     +1                  TO   CTRPG                               
           MOVE    CTRPG               TO   HD1PG                               
           MOVE    HD1                 TO   LN1                                 
           MOVE    '1'                 TO   CTLCHAR                             
           PERFORM 520-PRINT           THRU 520-EXIT                            
           IF      HD2                 NOT  =   SPACES                          
             MOVE    HD2               TO   LN1                                 
             PERFORM 520-PRINT         THRU 520-EXIT.                           
           IF      HD3                 NOT  =   SPACES                          
             MOVE    HD3               TO   LN1                                 
             PERFORM 520-PRINT         THRU 520-EXIT.                           
           MOVE    '0'                 TO   CTLCHAR                             
           MOVE    HD4                 TO   LN1                                 
           PERFORM 520-PRINT           THRU 520-EXIT                            
           MOVE    HD5                 TO   LN1                                 
           PERFORM 520-PRINT           THRU 520-EXIT                            
           MOVE    '0'                 TO   CTLCHAR                             
112895     MOVE    HD7                 TO   LN1                                 
112895     PERFORM 520-PRINT           THRU 520-EXIT                            
           MOVE    HD6                 TO   LN1                                 
           PERFORM 520-PRINT           THRU 520-EXIT                            
           MOVE    '0'                 TO   CTLCHAR                             
           MOVE    OLDLN               TO   LN1.                                
       525-EXIT.                                                                
           EXIT.                                                                
                                                                                
      ******************************************************************        
       610-1CHG.                                                                
           MOVE    SRTKPGM             TO   OLDKPGM                             
           MOVE    ZEROS               TO   CTRPTOTAL      CTRPSTAFF            
                                            CTRDSAL                             
                                            CTRDBEN        CTRDPRCH             
                                            CTRDMATSUP     CTRDOTHER            
                                            CTRDCAP        CTRSIND              
                                            CTRDIND        CTRTOTAL             
                                            CTRSTAFF       CTRSSAL              
                                            WSCSPCT        WSCDPCT              
                                            WSCSPCT2       WSCDPCT2.            
       610-EXIT.                                                                
           EXIT.                                                                
                                                                                
       615-1TOT.                                                                
           MOVE    OLDKPGM             TO   LN1PGM                              
           MOVE    CTRDSAL             TO   LN1DSAL                             
           MOVE    CTRDBEN             TO   LN1DBEN                             
           MOVE    CTRDPRCH            TO   LN1DPRCH                            
           MOVE    CTRDMATSUP          TO   LN1DMATSUP                          
           MOVE    CTRDOTHER           TO   LN1DOTHER                           
           MOVE    CTRDCAP             TO   LN1DCAP                             
           MOVE    CTRSIND             TO   LN1SIND                             
           MOVE    CTRDIND             TO   LN1DIND                             
           MOVE    CTRTOTAL            TO   LN1TOTAL                            
           IF      OLDKSCHL            =    '0000'                              
             PERFORM 790-TBF-READ      THRU 790-EXIT                            
           ELSE                                                                 
             PERFORM 795-ABF-READ      THRU 795-EXIT                            
             MOVE  ABFSTAFF            TO   CTRSTAFF.                           
           MOVE    CTRSTAFF            TO   LN1STAFF      CTRPSTAFF             
           IF      CTRSTAFF            =    ZEROS                               
             MOVE  ZEROS               TO   CTRSSAL                             
           ELSE                                                                 
             COMPUTE CTRSSAL   ROUNDED =    (CTRDSAL / CTRSTAFF).               
           MOVE    CTRSSAL             TO   LN1SSAL                             
           COMPUTE  WSCSDIND           =    CTRSIND + CTRDIND                   
042506     IF       CTRTOTAL           =    ZEROS                               
042506       MOVE   ZEROS              TO   WSCSPCT                             
042506     ELSE                                                                 
042506       COMPUTE  WSCSPCT  ROUNDED =    (WSCSDIND / CTRTOTAL).              
042506*    COMPUTE  WSCSPCT    ROUNDED =    (WSCSDIND / CTRTOTAL)               
           MOVE     WSCSPCT            TO   WSCSPCT2                            
           MULTIPLY 100                BY   WSCSPCT                             
           MOVE     WSCSPCT            TO   LN1CEIND                            
042506     IF       WSCSDIND           =    ZEROS                               
042506       MOVE  0                     TO WSCDPCT                             
042506     ELSE                                                                 
042506       COMPUTE  WSCDPCT    ROUNDED =  (CTRDIND / WSCSDIND).               
042506*    COMPUTE  WSCDPCT    ROUNDED =    (CTRDIND / WSCSDIND)                
           MOVE     WSCDPCT            TO   WSCDPCT2                            
           MULTIPLY 100                BY   WSCDPCT                             
           MOVE     WSCDPCT            TO   LN1CEDIST                           
           PERFORM 520-PRINT           THRU 520-EXIT                            
           MOVE    SPACES              TO   LN3                                 
           IF      CTRSSAL             <    IOPCEFSAL               OR          
                   CTRSSAL             >    IOPCETSAL                           
             MOVE  ALL '-'             TO   LN3ESSAL.                           
           IF      WSCSPCT2            >    IOPCEIND                            
             MOVE  ALL '-'             TO   LN3ECEIND.                          
           IF      WSCDPCT2            >    IOPCEDIST                           
             MOVE  ALL '-'             TO   LN3ECEDIST.                         
           IF      LN3                 >    SPACES                              
112895*      MOVE  ' * ERROR *'        TO   LN3EMSG                             
112895       MOVE  '  *ERR* '          TO   LN3EMSG                             
             PERFORM 520-PRINT         THRU 520-EXIT.                           
           ADD     CTRPTOTAL           TO   CTRSTOTAL                           
           ADD     CTRPSTAFF           TO   CTRSSTAFF.                          
       615-EXIT.                                                                
           EXIT.                                                                
                                                                                
       620-2CHG.                                                                
           MOVE    SRTKSCHL            TO   OLDKSCHL       HD5SCHL              
           MOVE    ZEROS               TO   CTRSTOTAL      CTRSSTAFF            
           MOVE    SRTKDIST            TO   SCLKEY                              
           MOVE    SRTKFY              TO   SCLFY                               
           MOVE    'SCL'               TO   SCLPREF                             
           MOVE    SRTKSCHL            TO   SCLSCL                              
           MOVE    SCLKEY              TO   CRFDK                               
           READ    CRF-DISK                                                     
           IF      RETCRF              NOT  =  '00'                             
             MOVE  'UNKNOWN'           TO   HD5DESC                             
           ELSE                                                                 
             MOVE  CRFD                TO   SCL                                 
             MOVE  SCLDESC             TO   HD5DESC.                            
           PERFORM 610-1CHG            THRU 610-EXIT.                           
       620-EXIT.                                                                
           EXIT.                                                                
                                                                                
       625-2TOT.                                                                
           IF      OLDKSCHL            =    '0000'                              
             ADD   CTRSTOTAL           TO   CTRRTOTAL                           
             ADD   CTRSSTAFF           TO   CTRRSTAFF.                          
           MOVE    '0'                 TO   CTLCHAR                             
           MOVE    'SCHL '             TO   LN2MSG1                             
           MOVE    OLDKSCHL            TO   LN2RCD1                             
           MOVE    'TOTAL '            TO   LN2MSG2                             
           MOVE    CTRSTOTAL           TO   LN2TOT                              
           MOVE    CTRSSTAFF           TO   LN2STAFF                            
           PERFORM 520-PRINT           THRU 520-EXIT                            
           MOVE    +61                 TO   CTRLN.                              
       625-EXIT.                                                                
           EXIT.                                                                
                                                                                
       630-3CHG.                                                                
           MOVE    SRTKFUND            TO   OLDKFUND       HD4FND               
           PERFORM 620-2CHG            THRU 620-EXIT.                           
       630-EXIT.                                                                
           EXIT.                                                                
                                                                                
       635-3TOT.                                                                
       635-EXIT.                                                                
           EXIT.                                                                
                                                                                
       640-4CHG.                                                                
           MOVE     ZEROS              TO   CTRLN          CTRPG                
                                            CTRRTOTAL      CTRRSTAFF            
           MOVE     SRTKREQ            TO   OLDKREQ                             
           MOVE     SRTKDIST           TO   OLDKDIST                            
           MOVE     SRTKFY             TO   OLDKFY                              
           MOVE     SRTPRT             TO   OLDPRT                              
           MOVE     SRTRPT             TO   OLDRPT                              
                                                                                
           MOVE     '    IOP'          TO   IOPKEY                              
           MOVE     SRTKDIST           TO   IOPDIST                             
           MOVE     SRTKFY             TO   IOPFY                               
           MOVE     IOPKEY             TO   CRFDK                               
           READ     CRF-DISK                                                    
           IF       RETCRF             NOT  =   '00'                            
             MOVE   SPACES             TO   IOPDATA                             
             MOVE   ZEROS              TO   IOPCEIND      IOPCEDIST             
                                            IOPCEFSAL     IOPCETSAL             
           ELSE                                                                 
             MOVE   CRFD               TO   IOP.                                
           MOVE     '    SCL0000'      TO   SCLKEY                              
           MOVE     SRTKDIST           TO   SCLDIST                             
           MOVE     SRTKFY             TO   SCLFY                               
           MOVE     SCLKEY             TO   CRFDK                               
           READ     CRF-DISK                                                    
           IF       RETCRF             NOT  =   '00'                            
             MOVE   'UNKNOWN'          TO   HD1ABBR                             
           ELSE                                                                 
             MOVE   CRFD               TO   SCL                                 
             MOVE   SCLABBR            TO   HD1ABBR.                            
           SET     HD11                TO   +15.                                
       640-REQ.                                                                 
           IF      HD1B         (HD11) =    SPACES                              
             SET   HD11                DOWN BY  +1                              
             GO                        TO   640-REQ.                            
           SET     HD11                UP   BY  +1                              
           MOVE    '-'                 TO   HD1B         (HD11)                 
           SET     HD11                UP   BY  +1                              
           MOVE    SRTKREQ1            TO   HD1B         (HD11)                 
           SET     HD11                UP   BY  +1                              
           MOVE    SRTKREQ2            TO   HD1B         (HD11)                 
           SET     HD11                UP   BY  +1                              
           MOVE    SRTKREQ3            TO   HD1B         (HD11)                 
           SET     HD11                UP   BY  +1                              
           MOVE    '-'                 TO   HD1B         (HD11)                 
           SET     HD11                UP   BY  +1                              
           MOVE    SRTKFY1             TO   HD1B         (HD11)                 
           SET     HD11                UP   BY  +1                              
           MOVE    SRTKFY2             TO   HD1B         (HD11).                
                                                                                
           SET     RQH1                TO   +1.                                 
       640-HEAD.                                                                
           IF      RQHREQ       (RQH1) NOT  =   HIGH-VALUES                     
             IF      RQHREQ     (RQH1) NOT  =   SRTKREQ                         
               SET   RQH1              UP   BY  +1                              
               GO                      TO   640-HEAD                            
             ELSE                                                               
               IF      RQHID    (RQH1) =    'H1'                                
                 MOVE  RQHHEAD  (RQH1) TO   HD2HEAD                             
                 MOVE  RQHUSER  (RQH1) TO   HD1USER                             
                 SET   RQH1            UP   BY  +1                              
                 GO                    TO   640-HEAD                            
               ELSE                                                             
                 IF      RQHID  (RQH1) =    'H2'                                
                   MOVE  RQHHEAD (RQH1) TO  HD3HEAD                             
                   SET   RQH1          UP   BY  +1                              
                   GO                  TO   640-HEAD.                           
           IF        OLDPRT            =    'N'                                 
             MOVE    SPACES            TO   HD2HEAD       HD1USER               
             MOVE    SPACES            TO   HD3HEAD                             
           ELSE                                                                 
             IF      OLDPRT            =    'U'                                 
               MOVE  SPACES            TO   HD2HEAD       HD3HEAD               
             ELSE                                                               
               IF    OLDPRT            =    'T'                                 
                 MOVE  SPACES          TO   HD1USER.                            
                                                                                
           PERFORM 630-3CHG            THRU 630-EXIT                            
           PERFORM 525-HEADS           THRU 525-EXIT.                           
       640-EXIT.                                                                
           EXIT.                                                                
                                                                                
       645-4TOT.                                                                
           MOVE    'REQ  '             TO   LN2MSG1                             
           MOVE    OLDKREQ             TO   LN2RCD1                             
           MOVE    'TOTAL '            TO   LN2MSG2                             
           MOVE    CTRRTOTAL           TO   LN2TOT                              
           MOVE    CTRRSTAFF           TO   LN2STAFF                            
           MOVE    +61                 TO   CTRLN                               
           PERFORM 520-PRINT           THRU 520-EXIT.                           
       645-EXIT.                                                                
           EXIT.                                                                
                                                                                
      ******************************************************************        
       790-TBF-READ.                                                            
           SEARCH  ALL                 TBFENTRY                                 
             AT    END                                                          
               MOVE  ZEROS             TO   CTRSTAFF                            
             WHEN  TBFKEY       (TBF1) =    OLDKPGM                             
               MOVE  TBFSTAFF   (TBF1) TO   CTRSTAFF.                           
       790-EXIT.                                                                
           EXIT.                                                                
                                                                                
      ******************************************************************        
       795-ABF-READ.                                                            
           MOVE    OLDKDIST            TO   ABFKEY                              
           MOVE    OLDKFY              TO   ABFFY                               
           MOVE    OLDKSCHL            TO   ABFSCHL                             
           MOVE    OLDKPGM             TO   ABFPGM                              
           MOVE    ABFKEY              TO   ABFDK                               
           READ    ABF-DISK                                                     
           IF      RETABF              =    '00'                                
             MOVE  ABFD                TO   ABF                                 
           ELSE                                                                 
             MOVE  SPACES              TO   ABFDATA                             
             MOVE  ZEROS               TO   ABFSTAFF       ABFSPACE             
                                            ABFSTDT.                            
       795-EXIT.                                                                
           EXIT.                                                                
                                                                                
      ******************************************************************        
       800-TBL-PGM.                                                             
           MOVE    HIGH-VALUES         TO   TBF                                 
           SET     TBF1                TO   +1                                  
           PERFORM 810-FPG-READ        THRU 810-EXIT                            
           MOVE    RQRDIST             TO   ABFKEY                              
           MOVE    RQRFY               TO   ABFFY                               
           MOVE    ABFKEY              TO   ABFDK                               
           START   ABF-DISK      KEY   >    ABFDK.                              
           IF      RETABF              NOT  =  '00'                             
             GO                        TO   800-EXIT.                           
       800-LOOP.                                                                
           READ    ABF-DISK            NEXT                                     
           MOVE    ABFD                TO   ABF                                 
           IF      RETABF              NOT  =   '00'            OR              
                   ABFDIST             NOT  =   RQRDIST         OR              
                   ABFFY               NOT  =   RQRFY                           
             GO                        TO   800-EXIT.                           
       800-LOOP2.                                                               
           SEARCH  ALL  TBFENTRY                                                
             AT  END                                                            
               MOVE  'PROGRAM NOT IN TABLE' TO  LNMMSG                          
               MOVE   ABFPGM           TO   LNMVALUE2                           
               PERFORM 520-PRINT       THRU 520-EXIT                            
               GO                      TO   800-LOOP                            
             WHEN    TBFKEY     (TBF1) =    ABFPGM                              
               ADD   ABFSTAFF          TO   TBFSTAFF       (TBF1)               
               GO                      TO   800-LOOP.                           
       800-EXIT.                                                                
           EXIT.                                                                
                                                                                
      ******************************************************************        
       810-FPG-READ.                                                            
           MOVE    RQRDIST             TO   FPGKEY                              
           MOVE    RQRFY               TO   FPGFY                               
           MOVE    'FPG'               TO   FPGPREF                             
           MOVE    FPGKEY              TO   CRFDK                               
           START   CRF-DISK      KEY   >    CRFDK.                              
           IF      RETCRF              NOT  =  '00'                             
             GO                        TO   810-EXIT.                           
       810-LOOP.                                                                
           READ    CRF-DISK            NEXT                                     
           IF      RETCRF              =    '00'                                
             MOVE  CRFD                TO   FPG                                 
             IF    FPGDIST             =    RQRDIST             AND             
                   FPGFY               =    RQRFY               AND             
                   FPGPREF             =    'FPG'                               
               MOVE FPGFPG             TO   TBFPGM         (TBF1)               
               MOVE ZEROS              TO   TBFSTAFF       (TBF1)               
               IF  TBF1                <    +1000                               
                 SET TBF1              UP   BY  +1                              
                 GO                    TO   810-LOOP.                           
       810-EXIT.                                                                
           EXIT.                                                                
                                                                                
      ******************************************************************        
       990-HOUSEKEEPING.                                                        
           PERFORM 510-READ            THRU 510-EXIT                            
           ACCEPT  SYSDATE             FROM DATE                                
           MOVE    SYSYY               TO   HD1YY                               
           MOVE    SYSMM               TO   HD1MM                               
           MOVE    SYSDD               TO   HD1DD                               
           ACCEPT  SYSTIME             FROM TIME                                
           MOVE    SYSHR               TO   HD1HR                               
           MOVE    SYSMIN              TO   HD1MN                               
           IF      SRTKEY              =    HIGH-VALUES                         
             MOVE  'EW032 NO DATA TO PROCESS'  TO  LNM                          
             PERFORM 520-PRINT         THRU 520-EXIT                            
             GO                        TO   999-EOJ.                            
           PERFORM 800-TBL-PGM         THRU 800-EXIT                            
           PERFORM 640-4CHG            THRU 640-EXIT.                           
       990-EXIT.                                                                
           EXIT.                                                                
                                                                                
      ******************************************************************        
       999-EOJ.                                                                 
           CLOSE                       CRD-CARD      CRF-DISK                   
                                       RWF-DISK      ABF-DISK                   
                                       PR1-PRNT.                                
       999-EXIT.                                                                
           EXIT.                                                                
