       IDENTIFICATION   DIVISION.
       PROGRAM-ID.      EW032.
       AUTHOR.          DOE.
      *****************************************************************
      *                         COST ANALYSIS                         *
      *                                                               *
      * *NOTE: THIS VERSION OF THE REPORT INCLUDES FUNCTION 7600 AND  *
      *        7800 IN THE SCHOOL & DISTRICT INDIRECT TOTALS.  THE    *
      *        DOE VERSION OF THIS REPORT DOES NOT INCLUDE THOSE      *
      *        FUNCTIONS.                                             *
      *                                                               *
      *                                                               *
      *****************************************************************
      * DATE CREATED:   06/26/95                                      *
      *****************************************************************
      * CALL #  - MMDDYY - PURPOSE                                    *
      * 9511051 - 112895 - RENAME PERCENTAGE HEADERS                  *
      * FIX9710 - 042697 - CORRECT CALC OF INDIRECT COST              *
      * FIX0001 - 051100 - SKIP CHARTER SCHOOL RECORDS(FORM 7)        *
      * 2006001 - 042506 - ADD FUNCTIONS 6500 & 8200.                 *
      *                  - CORRECT POTENTIAL DIVISION BY ZERO PROBLEM *
      * 2009001 - 050709 - ALLOW FUNDS 5,6,7 FOR AARA MONEY           *
      * 2011001 - 020411 - ADD ARRA FUNDS 8 & 9                       *
      * 2011002 - 020511 - CORRECT PRECISION TO CORRECT TOTALS        *
      *****************************************************************


       ENVIRONMENT DIVISION.

       INPUT-OUTPUT SECTION.
       FILE-CONTROL.

           SELECT    CRD-CARD          ASSIGN       DATABASE-EWCRDI.           1
                                                                               0
           SELECT    SRT-SORT          ASSIGN       WORKSTATION-SORT.

           SELECT    PR1-PRNT          ASSIGN       PRINTER-EWPRT01.

           SELECT    CRF-DISK          ASSIGN       DATABASE-EWCRFI
                                       ORGANIZATION INDEXED
                                       ACCESS       DYNAMIC
                                       RECORD KEY   CRFDK
                                       FILE STATUS  RETCRF.

           SELECT    RWF-DISK          ASSIGN       DATABASE-EWRWFI
                                       ORGANIZATION INDEXED
                                       ACCESS       SEQUENTIAL
                                       RECORD KEY   RWFDK
                                       FILE STATUS  RETRWF.

           SELECT    ABF-DISK          ASSIGN       DATABASE-EWABFI
                                       ORGANIZATION INDEXED
                                       ACCESS       DYNAMIC
                                       RECORD KEY   ABFDK
                                       FILE STATUS  RETABF.

       DATA DIVISION.
       FILE SECTION.

       FD  CRD-CARD
           RECORD    CONTAINS   80  CHARACTERS
           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
           RECORD    CONTAINS  132  CHARACTERS
           LABEL     RECORDS   ARE  OMITTED
           DATA      RECORDS   ARE  LNM  LN1  LN2  LN3.

       01  LNM.
001        05        LNMMSG            PIC  X(20).
021        05        FILLER            PIC  X(02).
023        05        LNMVALUE1         PIC  X(02).
025        05        FILLER            PIC  X(01).
026        05        LNMVALUE2         PIC  X(80).
106        05        FILLER            PIC  X(27).

       01            LN1.
001        05        LN1PGM            PIC  X(04).
005        05        LN1DSAL           PIC  ZZZZZZZZZ-.
015        05        LN1DBEN           PIC  ZZZZZZZZZ-.
025        05        LN1DPRCH          PIC  ZZZZZZZZZ-.
035        05        LN1DMATSUP        PIC  ZZZZZZZZZ-.
045        05        LN1DOTHER         PIC  ZZZZZZZZZ-.
055        05        LN1DCAP           PIC  ZZZZZZZZZ-.
065        05        LN1SIND           PIC  ZZZZZZZZZ-.
075        05        LN1DIND           PIC  ZZZZZZZZZ-.
085        05        LN1TOTAL          PIC  ZZZZZZZZZZ-.
096        05        LN1STAFF          PIC  ZZZZZ.ZZZ-.
106        05        LN1SSAL           PIC  ZZZZZZZZZ-.
112895     05        FILLER            PIC  X(01).
116        05        LN1CEIND          PIC  ZZZ.
112895*    05        FILLER            PIC  X(01).
112895     05        FILLER            PIC  X(02).
120        05        LN1CEDIST         PIC  ZZZ.
112895*    05        FILLER            PIC  X(10).
112895     05        FILLER            PIC  X(08).

       01            LN2.
001        05        FILLER            PIC  X(68).
069        05        LN2MSG1           PIC  X(05).
074        05        LN2RCD1           PIC  X(05).
079        05        LN2MSG2           PIC  X(06).
085        05        LN2TOT            PIC  ZZZZZZZZZZ-.
096        05        LN2STAFF          PIC  ZZZZZ.ZZZ-.
106        05        FILLER            PIC  X(27).

       01            LN3.
001        05        FILLER            PIC  X(105).
106        05        LN3ESSAL          PIC  X(09).
115        05        FILLER            PIC  X(01).
112895     05        FILLER            PIC  X(01).
116        05        LN3ECEIND         PIC  X(03).
119        05        FILLER            PIC  X(01).
112895     05        FILLER            PIC  X(01).
120        05        LN3ECEDIST        PIC  X(03).
112895*    05        LN3EMSG           PIC  X(10).
112895     05        LN3EMSG           PIC  X(08).

           COPY                        EWCRFD             OF   CPYSRC.
           COPY                        EWRWFD             OF   CPYSRC.
           COPY                        EWABFD             OF   CPYSRC.

       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.
020511*      10      SRTDSAL           PIC  S9(09).
020511*      10      SRTDBEN           PIC  S9(09).
020511*      10      SRTDPRCH          PIC  S9(09).
020511*      10      SRTDMATSUP        PIC  S9(09).
020511*      10      SRTDOTHER         PIC  S9(09).
020511*      10      SRTDCAP           PIC  S9(09).
020511*      10      SRTSIND           PIC  S9(09).
020511*      10      SRTDIND           PIC  S9(09).
020511*      10      SRTTOTAL          PIC  S9(10).
020511       10      SRTDSAL           PIC  S9(09)V9(07).
020511       10      SRTDBEN           PIC  S9(09)V9(07).
020511       10      SRTDPRCH          PIC  S9(09)V9(07).
020511       10      SRTDMATSUP        PIC  S9(09)V9(07).
020511       10      SRTDOTHER         PIC  S9(09)V9(07).
020511       10      SRTDCAP           PIC  S9(09)V9(07).
020511       10      SRTSIND           PIC  S9(09)V9(07).
020511       10      SRTDIND           PIC  S9(09)V9(07).
020511       10      SRTTOTAL          PIC  S9(10)V9(07).
             10      SRTPRT            PIC  X(01).
             10      SRTRPT            PIC  X(01).

       WORKING-STORAGE SECTION.

       01            WSC.
020511*    05        WSCSIND           PIC  S9(09).
020511*    05        WSCDIND           PIC  S9(09).
020511*    05        WSCTOTAL          PIC  S9(09).
020511*    05        WSCSDIND          PIC  S9(09).
020511     05        WSCSIND           PIC  S9(09)V9(07).
020511     05        WSCDIND           PIC  S9(09)V9(07).
020511     05        WSCTOTAL          PIC  S9(09)V9(07).
020511     05        WSCSDIND          PIC  S9(09)V9(07).
           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.
020511*    05        CTRPTOTAL         PIC  S9(09)     COMP-3 VALUE +0.
020511     05        CTRPTOTAL         PIC  S9(09)V9(07)
020511                                                 COMP-3 VALUE +0.
           05        CTRPSTAFF         PIC  S9(09)V9(03)
                                                       COMP-3 VALUE +0.
020511*    05        CTRSTOTAL         PIC  S9(09)     COMP-3 VALUE +0.
020511     05        CTRSTOTAL         PIC  S9(09)V9(07)
020511                                                 COMP-3 VALUE +0.
           05        CTRSSTAFF         PIC  S9(09)V9(03)
                                                       COMP-3 VALUE +0.
020511*    05        CTRRTOTAL         PIC  S9(09)     COMP-3 VALUE +0.
020511     05        CTRRTOTAL         PIC  S9(09)V9(07)
020511                                                 COMP-3 VALUE +0.
           05        CTRRSTAFF         PIC  S9(09)V9(03)
                                                       COMP-3 VALUE +0.
020511*    05        CTRDSAL           PIC  S9(09).
020511*    05        CTRDBEN           PIC  S9(09).
020511*    05        CTRDPRCH          PIC  S9(09).
020511*    05        CTRDMATSUP        PIC  S9(09).
020511*    05        CTRDOTHER         PIC  S9(09).
020511*    05        CTRDCAP           PIC  S9(09).
020511*    05        CTRSIND           PIC  S9(09).
020511*    05        CTRDIND           PIC  S9(09).
020511*    05        CTRTOTAL          PIC  S9(10).
020511     05        CTRDSAL           PIC  S9(09)V9(07).
020511     05        CTRDBEN           PIC  S9(09)V9(07).
020511     05        CTRDPRCH          PIC  S9(09)V9(07).
020511     05        CTRDMATSUP        PIC  S9(09)V9(07).
020511     05        CTRDOTHER         PIC  S9(09)V9(07).
020511     05        CTRDCAP           PIC  S9(09)V9(07).
020511     05        CTRSIND           PIC  S9(09)V9(07).
020511     05        CTRDIND           PIC  S9(09)V9(07).
020511     05        CTRTOTAL          PIC  S9(10)V9(07).
           05        CTRSTAFF          PIC  S9(07)V9(03).
           05        CTRSSAL           PIC  S9(07).

       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        OF          CPYSRC.
           COPY                        EWIOP        OF          CPYSRC.
           COPY                        EWRWF        OF          CPYSRC.
           COPY                        EWABF        OF          CPYSRC.
           COPY                        EWFPG        OF          CPYSRC.

       01            OLDLN             PIC  X(133).

       01      HD1.
001        05  FILLER  PIC X(06) VALUE 'EW032 '.
           05  HD1ABBR.
007         10 HD1B    OCCURS 22 TIMES INDEXED BY HD11 PIC X(01).
029        05  FILLER  PIC X(32) VALUE SPACES.
061        05  FILLER  PIC X(13) VALUE 'COST ANALYSIS'.
074        05  FILLER  PIC X(25) VALUE SPACES.
099        05  HD1USER PIC X(09) VALUE SPACES.
108        05  HD1MM   PIC X(02) VALUE SPACES.
110        05  FILLER  PIC X(01) VALUE '/'.
111        05  HD1DD   PIC X(02) VALUE SPACES.
113        05  FILLER  PIC X(01) VALUE '/'.
114        05  HD1YY   PIC X(02) VALUE SPACES.
116        05  FILLER  PIC X(01) VALUE SPACES.
117        05  HD1HR   PIC X(02) VALUE SPACES.
119        05  FILLER  PIC X(01) VALUE ':'.
120        05  HD1MN   PIC X(02) VALUE SPACES.
122        05  FILLER  PIC X(07) VALUE '  PAGE-'.
129        05  HD1PG   PIC ZZZ9.

       01      HD2.
001        05  FILLER  PIC X(41) VALUE SPACES.
           05  HD2HEAD.
042         10 HD2B    OCCURS 50 TIMES INDEXED BY HD21 PIC X(01).
092        05  FILLER  PIC X(41) VALUE SPACES.

       01      HD3.
001        05  FILLER  PIC X(41) VALUE SPACES.
           05  HD3HEAD.
042         10 HD3B    OCCURS 50 TIMES INDEXED BY HD31 PIC X(01).
092        05  FILLER  PIC X(41) VALUE SPACES.

       01      HD4.
001        05  FILLER  PIC X(06)  VALUE 'FUND- '.
007        05  HD4FND  PIC X(01)  VALUE SPACES.
008        05  FILLER  PIC X(125) VALUE SPACES.

       01      HD5.
001        05  FILLER  PIC X(06) VALUE 'SCHL- '.
007        05  HD5SCHL PIC X(04) VALUE SPACES.
011        05  FILLER  PIC X(01) VALUE SPACES.
012        05  HD5DESC PIC X(30) VALUE SPACES.
042        05  FILLER  PIC X(91) VALUE SPACES.

       01      HD6.
001        05  FILLER  PIC X(29) VALUE 'PGM  SALARIES  BENEFITS PURCH'.
030        05  FILLER  PIC X(29) VALUE ' SRV   MAT&SUP     OTHER   CA'.
059        05  FILLER  PIC X(29) VALUE 'PITAL  SCHL IND  DIST IND    '.
088        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(115) VALUE SPACES.
112895     05  FILLER  PIC X(17) VALUE 'TOT  DIST'.

       LINKAGE       SECTION.

           COPY                       EWBJR                OF CPYSRC.

       PROCEDURE DIVISION USING BJR.
      ******************************************************************
       DECLARATIVES.
       000-ERROR     SECTION.
           USE AFTER STANDARD ERROR PROCEDURE ON CRD-CARD
                                                 RWF-DISK
                                                 ABF-DISK
                                                 CRF-DISK.
       000-ENCOUNTERED.
           CONTINUE.
       END DECLARATIVES.

      ******************************************************************
           SORT    SRT-SORT            ASCENDING KEY       SRTKEY
                                       INPUT     PROCEDURE 000-INPUT
                                       OUTPUT    PROCEDURE 500-OUTPUT.
           GOBACK.

      ******************************************************************
       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

           INITIALIZE    SRT
           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
           SET     RQH1                TO   +1
           MOVE    HIGH-VALUES         TO   RQR           RQH.
           IF      BJR                 >    SPACES
             PERFORM 495-LOAD          THRU 495-EXIT
             GO                        TO   490-TEST.
       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
050709            (CRDFUND             NOT  =   '5')               AND
050709            (CRDFUND             NOT  =   '6')               AND
050709            (CRDFUND             NOT  =   '7')               AND
020411            (CRDFUND             NOT  =   '8')               AND
020411            (CRDFUND             NOT  =   '9')               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.
           INSPECT RWFKEY       REPLACING   ALL  ' ' BY HIGH-VALUES
           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.

      ******************************************************************
       495-LOAD.
           MOVE    BJRCARD1            TO   CRD
           MOVE    SPACES              TO   ERR
           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
050709            (CRDFUND             NOT  =   '5')               AND
050709            (CRDFUND             NOT  =   '6')               AND
050709            (CRDFUND             NOT  =   '7')               AND
020411            (CRDFUND             NOT  =   '8')               AND
020411            (CRDFUND             NOT  =   '9')               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   495-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.
           INSPECT RWFKEY       REPLACING   ALL  ' ' BY HIGH-VALUES
           IF     (RWFKEY              >    ENDKEY)
             MOVE  RWFKEY              TO   ENDKEY.

           MOVE    BJRREQ1             TO   CRHREQ
           MOVE    BJRID1              TO   CRHID
           MOVE    BJRUSER1            TO   CRHUSER
           MOVE    BJRHEAD1            TO   CRHHEAD.
       495-HEAD.
           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.
       495-HEAD1.
           IF      CRHB         (CRH1) =    SPACES
             IF      CRH1              >    +2
               ADD   -1                TO   CTRIDX
               SET   CRH1              DOWN BY  +1
               GO                      TO   495-HEAD1.
           SUBTRACT +1                 FROM CTRIDX
           COMPUTE CTRIDX      ROUNDED =    (50  - CTRIDX) / 2
           SET     RQH2                TO   CTRIDX
           SET     CRH1                TO   +1.
       495-HEAD2.
           MOVE    CRHB         (CRH1) TO   RQHB         (RQH1 RQH2)
           IF      RQH2                <    +50
             SET   RQH2  CRH1          UP   BY  +1
             GO                        TO   495-HEAD2.
           IF      BJRHEAD2            NOT  =   SPACES              AND
                   RQH1                =    +1
             SET   RQH1                UP   BY  +1
             MOVE  BJRREQ2             TO   CRHREQ
             MOVE  BJRID2              TO   CRHID
             MOVE  BJRUSER2            TO   CRHUSER
             MOVE  BJRHEAD2            TO   CRHHEAD
             GO                        TO   495-HEAD.
       495-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   SCLDIST
           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'
             INITIALIZE                     IOPDATA
           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.
