       IDENTIFICATION   DIVISION.
       PROGRAM-ID.      EW030.
       AUTHOR.          DOE.
      *****************************************************************
      *                       PC-3/4 REPORT                           *
      *****************************************************************
      * DATE CREATED:   06/24/95                                      *
      *****************************************************************
      * CALL #  - MMDDYY - PURPOSE                                    *
      * 9508182 - 083095 - CHANGE LAYOUT OF XCD FLAT FILE.            *
      * FIX9703 - 041397 - ADD RECONCILIATION RECORD MARKER           *
      * FIX9703 - 041497 - PRINT FOOD.SRVC.&TRANS. TOTALS ON DIF.LINES*
      * FIX9908 - 041499 - ADDED CHARTER SCHOOL PROCESSING            *
      * FIX9904 - 050399 - ADD PROCESSING FOR FORM 7                  *
      * 2001002 - 040301 - CORRECT PRINTING INDIRECT DOLLARS BEING    *
      *                    ROLLED INTO 6100 CONTROL TOTALS.           *
      * 2003001 - 101702 - CORRECT LOAD OF ABF TABLE                  *
      * 2003002 - 042203 - FIX ROUNDING TRUNCATION ERRORS             *
      * 2006001 - 041706 - ADD FUNCTIONS 6500 & 8200.                 *
      * 2007001 - 120506 - WRITE RECORDS 910(7600-FOOD SERVICE) AND
      *                    920(7800-TRANSPORTATION) TO XCD FLAT FILE
      *                    EVEN WHEN THEY ARE ZERO
      * 2009001 - 050409 - SHOW FUNDS 5,6,& 7 ALONG WITH THEIR 3      *
      *                    TABLES TO APPEAR AS THEIR OWN COST REPORT. *
      *                    ADD THE FOLLOWING RECORDS FORMATS:         *
      *                         FORMAT E - TABLE 43100 DISTRICT       *
      *                         FORMAT F - TABLE 43100 SCHOOL         *
      *                         FORMAT G - TABLE 43200 DISTRICT       *
      *                         FORMAT H - TABLE 43200 SCHOOL         *
      *                         FORMAT I - TABLE 43300 DISTRICT       *
      *                         FORMAT J - TABLE 43300 SCHOOL         *
      * 2009004 - 051109 - CORRECT $1 DIFFERENCE SHOWING AS $0        *
      * 2011001 - 020411 - ADD ARRA FUNDS 8 & 9                       *
      *                         FORMAT K - TABLE 43400 DISTRICT       *
      *                         FORMAT L - TABLE 43400 SCHOOL         *
      *                         FORMAT M - TABLE 43500 DISTRICT       *
      *                         FORMAT N - TABLE 43500 SCHOOL         *
      *****************************************************************


       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.

           SELECT    XCD-DISK          ASSIGN       DATABASE-EWXCDP
                                       ORGANIZATION SEQUENTIAL
                                       ACCESS       SEQUENTIAL
                                       FILE STATUS  RETXCD.

       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).
016        05        CRDFUND           PIC  X(01).
017        05        CRDSCHL           PIC  X(04).
021        05        CRDFSRV           PIC  9(09).
030        05        CRDTSCHL          PIC  9(09).
039        05        CRDTDIST          PIC  9(09).
048        05        CRDPREPD          PIC  9(09).
057        05        CRDPREPS          PIC  9(09).
066        05        CRDPREPT          PIC  9(09).
075        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  LN4  LN5.

       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        LN1MSG            PIC  X(15).
016        05        FILLER            PIC  X(01).
017        05        LN1NBR            PIC  X(03).
020        05        FILLER            PIC  X(01).
021        05        LN1AMT1           PIC  ZZZZZZZZZ-.
031        05        LN1AMT2           PIC  ZZZZZZZZZ-.
041        05        LN1AMT3           PIC  ZZZZZZZZZ-.
051        05        LN1AMT4           PIC  ZZZZZZZZZ-.
061        05        LN1AMT5           PIC  ZZZZZZZZZ-.
071        05        LN1AMT6           PIC  ZZZZZZZZZ-.
081        05        LN1AMT7           PIC  ZZZZZZZZZ-.
091        05        LN1AMT8           PIC  ZZZZZZZZZ-.
101        05        LN1AMT9           PIC  ZZZZZZZZZ-.
111        05        LN1AMT10          PIC  ZZZZZZZZZ-.
121        05        LN1TOTAL          PIC  ZZZZZZZZZZ-.
132        05        FILLER            PIC  X(01).

       01            LN2.
001        05        FILLER            PIC  X(04).
005        05        LN2FUNC1          PIC  X(04).
009        05        FILLER            PIC  X(01).
010        05        LN2DESC1          PIC  X(21).
031        05        FILLER            PIC  X(01).
032        05        LN2AMT1           PIC  ZZZZZZZZZ-.
042        05        FILLER            PIC  X(01).
043        05        LN2FUNC2          PIC  X(04).
047        05        FILLER            PIC  X(01).
048        05        LN2DESC2          PIC  X(21).
069        05        FILLER            PIC  X(01).
070        05        LN2AMT2           PIC  ZZZZZZZZZ-.
080        05        FILLER            PIC  X(01).
081        05        LN2FUNC3          PIC  X(04).
085        05        FILLER            PIC  X(01).
086        05        LN2DESC3          PIC  X(21).
107        05        FILLER            PIC  X(01).
108        05        LN2AMT3           PIC  ZZZZZZZZZ-.
118        05        FILLER            PIC  X(15).

       01            LN3.
001        05        FILLER            PIC  X(02).
003        05        LN3RECR           PIC  ZZZZZZZZZ-.
013        05        FILLER            PIC  X(01).
014        05        LN3OTHR           PIC  ZZZZZZZZZ-.
024        05        FILLER            PIC  X(01).
025        05        LN3CAP            PIC  ZZZZZZZZZ-.
035        05        FILLER            PIC  X(01).
036        05        LN3COMSRV         PIC  ZZZZZZZZZ-.
046        05        FILLER            PIC  X(01).
047        05        LN3DEBT           PIC  ZZZZZZZZZ-.
057        05        FILLER            PIC  X(01).
058        05        LN3FEDIND         PIC  ZZZZZZZZZ-.
068        05        FILLER            PIC  X(01).
041499     05        LN3CHRTR          PIC  ZZZZZZZZZ-.
041499     05        FILLER            PIC  X(01).
069        05        LN3TRPT           PIC  ZZZZZZZZZZ-.
080        05        FILLER            PIC  X(01).
083095*    05        LN3TAFR           PIC  ZZZZZZZZZZ-.
083095     05        LN3TAFR           PIC  ZZZZZZZZZZZ-.
083095*    05        FILLER            PIC  X(02).
083095     05        FILLER            PIC  X(01).
094        05        LN3DIF            PIC  ZZZZZZZZZ-.
041499*    05        FILLER            PIC  X(29).
041499     05        FILLER            PIC  X(18).

       01            LN4.
001        05        LN4MSG            PIC  X(15).
016        05        FILLER            PIC  X(04).
020        05        LN4AMT1           PIC  ZZZZZZZZZZ.
030        05        LN4AMT2           PIC  ZZZZZZZZZZ.
040        05        LN4AMT3           PIC  ZZZZZZZZZZ.
050        05        LN4AMT4           PIC  ZZZZZZZZZZ.
060        05        LN4AMT5           PIC  ZZZZZZZZZZ.
070        05        LN4AMT6           PIC  ZZZZZZZZZZ.
080        05        LN4AMT7           PIC  ZZZZZZZZZZ.
090        05        LN4AMT8           PIC  ZZZZZZZZZZ.
100        05        LN4AMT9           PIC  ZZZZZZZZZZ.
110        05        LN4AMT10          PIC  ZZZZZZZZZZ.
120        05        FILLER            PIC  X(01).
121        05        LN4TOTAL          PIC  ZZZZZZZZZZ.
131        05        FILLER            PIC  X(02).

       01  LN5.
001        05        LN5MSG            PIC  X(20).
021        05        FILLER            PIC  X(02).
023        05        LN5CNT            PIC  ZZZ,ZZ9.
030        05        FILLER            PIC  X(01).
031        05        LN5VALUE2         PIC  X(80).
111        05        FILLER            PIC  X(22).

           COPY                        EWCRFD             OF   CPYSRC.
           COPY                        EWRWFD             OF   CPYSRC.
           COPY                        EWABFD             OF   CPYSRC.
           COPY                        EWXCDD             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      SRTKSEQ           PIC  X(01).
             10      SRTKPGM           PIC  X(03).
           05        SRTDATA.
041706*      10      SRTENTRY          OCCURS 30 TIMES INDEXED BY SRT1.
041706       10      SRTENTRY          OCCURS 34 TIMES INDEXED BY SRT1.
042203*        15    SRTAMT            PIC  S9(09).
042203         15    SRTAMT            PIC  S9(10)V9(07).
             10      SRTRECON          PIC  X(01).
050399       10      SRTFORM7          PIC  X(01).
042203*      10      SRTTOT            PIC  S9(11).
042203       10      SRTTOT            PIC  S9(11)V9(07).
             10      SRTPRT            PIC  X(01).
             10      SRTRPT            PIC  X(01).

       WORKING-STORAGE SECTION.

       01            WSC.
           05        WSCFLG1           PIC  X(01) VALUE 'N'.
           05        WSCFLG4           PIC  X(01) VALUE 'N'.
050399     05        WSCFLG4XXX        PIC  X(01) VALUE 'N'.
           05        WSCLAST           PIC  X(01) VALUE 'N'.

       01            RET.
           05        RETCRF            PIC  X(02) VALUE '00'.
           05        RETCRFOLD         PIC  X(02) VALUE '00'.
           05        RETRWF            PIC  X(02) VALUE '00'.
           05        RETABF            PIC  X(02) VALUE '00'.
           05        RETABFOLD         PIC  X(02) VALUE '00'.
           05        RETXCD            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(03).
             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      ERRFSRV           PIC  X(09).
             10      ERRTSCHL          PIC  X(09).
             10      ERRTDIST          PIC  X(09).
             10      ERRPREPD          PIC  X(09).
             10      ERRPREPS          PIC  X(09).
             10      ERRPREPT          PIC  X(09).
             10      ERRSRC            PIC  X(01).
             10      ERRRPT            PIC  X(01).

       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        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            PGMTBL.
           05        PGMENTRY   OCCURS 1000 TIMES
                                       ASCENDING KEY IS PGMPGM
                                       INDEXED BY PGM1.
             10      PGMPGM            PIC  X(03).
             10      PGMSEQ            PIC  X(01).
             10      PGMSTF            PIC  S9(04)V9(03).

       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            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.
           05        CTRXCD           PIC S9(07)       COMP-3 VALUE +0.
042203*    05        CTRCOMP          PIC S9(11)       COMP-3 VALUE +0.
042203     05        CTRCOMP          PIC S9(11)V9(7)  COMP-3 VALUE +0.
           05        CTRRECON.
042203*      10      CTRRECR          PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTROTHR          PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRCAP           PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRCOMSRV        PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRDEBT          PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRFEDIND        PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRCHRTR         PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRTOT           PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRAFR           PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRDIFF          PIC S9(11)       COMP-3 VALUE +0.
042203       10      CTRRECR          PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTROTHR          PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRCAP           PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRCOMSRV        PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRDEBT          PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRFEDIND        PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRCHRTR         PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRTOT           PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRAFR           PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRDIFF          PIC S9(11)V9(7)  COMP-3 VALUE +0.
051109       10      CTRAFR-TRUNC     PIC S9(11)       COMP-3 VALUE +0.
051109       10      CTRTOT-TRUNC     PIC S9(11)       COMP-3 VALUE +0.
           05        CTRSIND.
042203*      10      CTRSI6100        PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRSI6200        PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRSI6300        PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRSI6400        PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRSI7300        PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRSI7400        PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRSI7600        PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRSI7700        PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRSI7800        PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRSI7900        PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRSI8100        PIC S9(11)       COMP-3 VALUE +0.
042203       10      CTRSI6100        PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRSI6200        PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRSI6300        PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRSI6400        PIC S9(11)V9(7)  COMP-3 VALUE +0.
041706       10      CTRSI6500        PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRSI7300        PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRSI7400        PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRSI7600        PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRSI7700        PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRSI7800        PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRSI7900        PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRSI8100        PIC S9(11)V9(7)  COMP-3 VALUE +0.
041706       10      CTRSI8200        PIC S9(11)V9(7)  COMP-3 VALUE +0.
           05        CTRDIND.
042203*      10      CTRDI6100        PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRDI6200        PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRDI6300        PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRDI6400        PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRDI7100        PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRDI7200        PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRDI7400        PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRDI7500        PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRDI7600        PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRDI7700        PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRDI7800        PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRDI7900        PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRDI8100        PIC S9(11)       COMP-3 VALUE +0.
042203       10      CTRDI6100        PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRDI6200        PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRDI6300        PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRDI6400        PIC S9(11)V9(7)  COMP-3 VALUE +0.
041706       10      CTRDI6500        PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRDI7100        PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRDI7200        PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRDI7400        PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRDI7500        PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRDI7600        PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRDI7700        PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRDI7800        PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRDI7900        PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRDI8100        PIC S9(11)V9(7)  COMP-3 VALUE +0.
041706       10      CTRDI8200        PIC S9(11)V9(7)  COMP-3 VALUE +0.
           05        CTRLVL1.
042203*      10      CTRSAMT1         PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRSAMT2         PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRSAMT3         PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRSAMT4         PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRSAMT5         PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRSAMT6         PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRLNDTOT        PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRSTOT          PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRSCOST         PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRDTOT          PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRLNTOTAL       PIC S9(11)       COMP-3 VALUE +0.
042203       10      CTRSAMT1         PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRSAMT2         PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRSAMT3         PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRSAMT4         PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRSAMT5         PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRSAMT6         PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRLNDTOT        PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRSTOT          PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRSCOST         PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRDTOT          PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRLNTOTAL       PIC S9(11)V9(7)  COMP-3 VALUE +0.
           05        CTRLVL2.
042203*      10      CTRSAL           PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRBEN           PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRPRCH          PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRMATSUP        PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRDOTHR         PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRDCAP          PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRTOTAL         PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRSEQSTOT       PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRSEQSCOST      PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRSEQDTOT       PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRSEQTOT        PIC S9(11)       COMP-3 VALUE +0.
042203       10      CTRSAL           PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRBEN           PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRPRCH          PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRMATSUP        PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRDOTHR         PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRDCAP          PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRTOTAL         PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRSEQSTOT       PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRSEQSCOST      PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRSEQDTOT       PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRSEQTOT        PIC S9(11)V9(7)  COMP-3 VALUE +0.
           05        CTRLVL3.
042203*      10      CTRAMT1          PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRAMT2          PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRAMT3          PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRAMT4          PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRAMT5          PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRAMT6          PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRAMT7          PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRAMT8          PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRAMT9          PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRAMT10         PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTRAMTTOT        PIC S9(11)       COMP-3 VALUE +0.
042203       10      CTRAMT1          PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRAMT2          PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRAMT3          PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRAMT4          PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRAMT5          PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRAMT6          PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRAMT7          PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRAMT8          PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRAMT9          PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRAMT10         PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTRAMTTOT        PIC S9(11)V9(7)  COMP-3 VALUE +0.
050399     05        CTR4XXX.
042203*      10      CTR4AMT1         PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTR4AMT2         PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTR4AMT3         PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTR4AMT4         PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTR4AMT5         PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTR4AMT6         PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTR4AMT7         PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTR4AMT8         PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTR4AMT9         PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTR4AMT10        PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTR4AMT11        PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTR4AMT12        PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTR4AMT13        PIC S9(11)       COMP-3 VALUE +0.
042203*      10      CTR4AMT14        PIC S9(11)       COMP-3 VALUE +0.
042203       10      CTR4AMT1         PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTR4AMT2         PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTR4AMT3         PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTR4AMT4         PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTR4AMT5         PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTR4AMT6         PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTR4AMT7         PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTR4AMT8         PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTR4AMT9         PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTR4AMT10        PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTR4AMT11        PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTR4AMT12        PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTR4AMT13        PIC S9(11)V9(7)  COMP-3 VALUE +0.
042203       10      CTR4AMT14        PIC S9(11)V9(7)  COMP-3 VALUE +0.
041706       10      CTR4AMT15        PIC S9(11)V9(7)  COMP-3 VALUE +0.
041706       10      CTR4AMT16        PIC S9(11)V9(7)  COMP-3 VALUE +0.

       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      OLDKSEQ           PIC  X(01).
             10      OLDKPGM           PIC  X(03).
           05        OLDPRT            PIC  X(01).
           05        OLDRPT            PIC  X(01).
050399     05        OLDFORM7          PIC  X(01).


           COPY                        EWSCL        OF          CPYSRC.
           COPY                        EWFPG        OF          CPYSRC.
           COPY                        EWFRS        OF          CPYSRC.
           COPY                        EWRWF        OF          CPYSRC.
           COPY                        EWABF        OF          CPYSRC.
           COPY                        EWXCD        OF          CPYSRC.
083095     COPY                        EWXRD        OF          CPYSRC.

       01            OLDLN             PIC  X(133).

       01      HD1.
001        05  FILLER  PIC X(06) VALUE 'EW030 '.
           05  HD1ABBR.
007         10 HD1B    OCCURS 22 TIMES INDEXED BY HD11 PIC X(01).
029        05  FILLER  PIC X(11) VALUE SPACES.
040        05  HD1MODE PIC X(08) VALUE SPACES.
048        05  FILLER  PIC X(13) VALUE SPACES.
061        05  FILLER  PIC X(13) VALUE 'PC-3/4 REPORT'.
074        05  FILLER  PIC X(24) VALUE SPACES.
098        05  HD1USER PIC X(09) VALUE SPACES.
107        05  HD1MM   PIC X(02) VALUE SPACES.
109        05  FILLER  PIC X(01) VALUE '/'.
110        05  HD1DD   PIC X(02) VALUE SPACES.
112        05  FILLER  PIC X(01) VALUE '/'.
113        05  HD1YY   PIC X(02) VALUE SPACES.
115        05  FILLER  PIC X(02) 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- '.
008        05  HD4FND  PIC X(01) VALUE SPACES.
009        05  FILLER  PIC X(124) 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.
050399*    05  FILLER  PIC X(91) VALUE SPACES.
050399     05  FILLER  PIC X(10) VALUE SPACES.
050399     05  HD5CHRT PIC X(20) VALUE SPACES.
050399     05  FILLER  PIC X(61) VALUE SPACES.

       01      HD6.
001        05  FILLER  PIC X(20) VALUE SPACES.
021        05  FILLER  PIC X(29) VALUE '-----------------------------'.
051        05  FILLER  PIC X(29) VALUE '-- DIRECT -------------------'.
081        05  FILLER  PIC X(11) VALUE '-----------'.
090        05  FILLER  PIC X(43) VALUE SPACES.

       01      HD7.
001        05  FILLER  PIC X(20) VALUE '----- PROGRAM ----- '.
021        05  FILLER  PIC X(20) VALUE SPACES.
041        05  FILLER  PIC X(29) VALUE 'PURCHASED  MATERIAL   OTHER  '.
070        05  FILLER  PIC X(29) VALUE '   CAPITAL     TOTAL   SCHOOL'.
099        05  FILLER  PIC X(21) VALUE '     SCHOOL  DISTRICT'.
120        05  FILLER  PIC X(13) VALUE SPACES.

       01      HD8.
001        05  FILLER  PIC X(20) VALUE 'CATEGORY        NBR '.
021        05  FILLER  PIC X(20) VALUE ' SALARIES  BENEFITS '.
041        05  FILLER  PIC X(20) VALUE ' SERVICES  SUPPLIES '.
061        05  FILLER  PIC X(20) VALUE ' EXPENSES    OUTLAY '.
081        05  FILLER  PIC X(20) VALUE '   DIRECT  INDIRECT '.
101        05  FILLER  PIC X(20) VALUE '     COST  INDIRECT '.
121        05  FILLER  PIC X(12) VALUE '     TOTAL  '.

       01      HD9.
001        05  FILLER  PIC X(04) VALUE SPACES.
005        05  FILLER  PIC X(47) VALUE
                     'THOSE COSTS REPORTED IN THE COLUMN TITLED -SCHO'.
052        05  FILLER  PIC X(47) VALUE
                     'OL INDIRECT- ARE DERIVED FROM TWO SOURCES: A) E'.
099        05  FILLER  PIC X(34) VALUE
                     'XPENDITURES RECORDED BY SCHOOL    '.

       01      HD10.
001        05  FILLER  PIC X(04) VALUE SPACES.
005        05  FILLER  PIC X(47) VALUE
                     'AND B) SCHOOL LEVEL EXPENDITURES CENTRALLY RECO'.
052        05  FILLER  PIC X(47) VALUE
                     'RDED.  FUNCTIONALLY DISTRIBUTED, THESE COSTS AR'.
099        05  FILLER  PIC X(34) VALUE
                     'E AS REPORTED BELOW.              '.

       01      HD12.
001        05  FILLER  PIC X(04) VALUE SPACES.
005        05  FILLER  PIC X(47) VALUE
                     'DISTRICT INDIRECT COSTS ARE FUNCTIONALLY DISTRI'.
052        05  FILLER  PIC X(47) VALUE
                     'BUTED AS REPORTED BELOW.                       '.
099        05  FILLER  PIC X(34) VALUE SPACES.

       01      HD13.
001        05  FILLER  PIC X(02) VALUE SPACES.
003        05  FILLER  PIC X(29) VALUE '-----------------------------'.
032        05  FILLER  PIC X(29) VALUE '------RECONCILIATION TO ANNUA'.
061        05  FILLER  PIC X(29) VALUE 'L FINANCIAL REPORT-----------'.
090        05  FILLER  PIC X(24) VALUE '------------------------'.
114        05  FILLER  PIC X(19) VALUE SPACES.

       01      HD14.
001        05  FILLER  PIC X(11) VALUE '  RECREAT &'.
012        05  FILLER  PIC X(15) VALUE SPACES.
027        05  FILLER  PIC X(29) VALUE 'NON-PGM  COMMUNITY     DEBT  '.
041499*    05  FILLER  PIC X(29) VALUE '    FEDERAL     TOTAL        '.
041499     05  FILLER  PIC X(29) VALUE '    FEDERAL     CHARTER    TO'.
041499     05  FILLER  PIC X(11) VALUE 'TAL        '.
083095*    05  FILLER  PIC X(18) VALUE ' AFR    ROUNDING /'.
083095     05  FILLER  PIC X(18) VALUE '   AFR  ROUNDING /'.
103        05  FILLER  PIC X(30) VALUE SPACES.

       01      HD15.
001        05  FILLER  PIC X(20) VALUE '  ENRICHMNT      OTH'.
021        05  FILLER  PIC X(20) VALUE 'ER    CAPITAL    SER'.
041        05  FILLER  PIC X(20) VALUE 'VICE    SERVICE   IN'.
041499*    05  FILLER  PIC X(20) VALUE 'DIRECT    REPORTED  '.
041499     05  FILLER  PIC X(20) VALUE 'DIRECT     SCHOOLS  '.
041499     05  FILLER  PIC X(11) VALUE ' REPORTED  '.
083095*    05  FILLER  PIC X(20) VALUE '     TOTAL  DIFFEREN'.
083095     05  FILLER  PIC X(20) VALUE '      TOTAL DIFFEREN'.
101        05  FILLER  PIC X(20) VALUE 'CE                  '.
121        05  FILLER  PIC X(11) VALUE SPACES.

050399 01      HD16.
050399     05  FILLER  PIC X(02) VALUE SPACES.
050399     05  FILLER  PIC X(29) VALUE 'Ctrl Function Amount    Funct'.
050399     05  FILLER  PIC X(29) VALUE 'ion Amount    Function Amount'.
050399     05  FILLER  PIC X(29) VALUE '    Function Amount          '.

050399 01      HD17.
050399     05  FILLER  PIC X(02) VALUE SPACES.
050399     05  FILLER  PIC X(11) VALUE '4000  6100 '.
050399     05  HD17AMT1  PIC ZZZZZZZZZ-.
050399     05  FILLER  PIC X(09) VALUE '    6200 '.
050399     05  HD17AMT2  PIC ZZZZZZZZZ-.
050399     05  FILLER  PIC X(09) VALUE '    6300 '.
050399     05  HD17AMT3  PIC ZZZZZZZZZ-.
050399     05  FILLER  PIC X(09) VALUE '    6400 '.
050399     05  HD17AMT4  PIC ZZZZZZZZZ-.

050399 01      HD18.
050399     05  FILLER  PIC X(02) VALUE SPACES.
050399     05  FILLER  PIC X(11) VALUE '4001  7100 '.
050399     05  HD18AMT1  PIC ZZZZZZZZZ-.
050399     05  FILLER  PIC X(09) VALUE '    7200 '.
050399     05  HD18AMT2  PIC ZZZZZZZZZ-.
050399     05  FILLER  PIC X(09) VALUE '    7300 '.
050399     05  HD18AMT3  PIC ZZZZZZZZZ-.
050399     05  FILLER  PIC X(09) VALUE '    7400 '.
050399     05  HD18AMT4  PIC ZZZZZZZZZ-.

050399 01      HD19.
050399     05  FILLER  PIC X(02) VALUE SPACES.
050399     05  FILLER  PIC X(11) VALUE '4002  7500 '.
050399     05  HD19AMT1  PIC ZZZZZZZZZ-.
050399     05  FILLER  PIC X(09) VALUE '    7600 '.
050399     05  HD19AMT2  PIC ZZZZZZZZZ-.
050399     05  FILLER  PIC X(09) VALUE '    7700 '.
050399     05  HD19AMT3  PIC ZZZZZZZZZ-.
050399     05  FILLER  PIC X(09) VALUE '    7800 '.
050399     05  HD19AMT4  PIC ZZZZZZZZZ-.

050399 01      HD20.
050399     05  FILLER  PIC X(02) VALUE SPACES.
050399     05  FILLER  PIC X(11) VALUE '4003  7900 '.
050399     05  HD20AMT1  PIC ZZZZZZZZZ-.
050399     05  FILLER  PIC X(09) VALUE '    8100 '.
050399     05  HD20AMT2  PIC ZZZZZZZZZ-.
041706     05  FILLER  PIC X(09) VALUE '    8200 '.
041706     05  HD20AMT3  PIC ZZZZZZZZZ-.
041706     05  FILLER  PIC X(09) VALUE '    6500 '.
041706     05  HD20AMT4  PIC ZZZZZZZZZ-.

       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
                                                 XCD-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                <    +10
             SET   RQR1  SEL1          UP   BY  +1
             GO                        TO   015-MASK.

           IF     (RQRDIST             NOT  =  RWFDIST)      OR
                  (RQRFY               NOT  =  RWFFY)        OR
                  (RQRSEL              NOT  =  SEL)
             GO                        TO   015-EXIT.

           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
           PERFORM 020-PGM             THRU 020-EXIT
           MOVE    FPGRPT              TO   SRTKSEQ
           MOVE    RQRPRT              TO   SRTPRT
           MOVE    RQRRPT              TO   SRTRPT
           IF      RWFTABLE            =    '99999'
             MOVE    RWFRRECEN         TO   SRTAMT   (01)
             MOVE    RWFROTHER         TO   SRTAMT   (02)
             MOVE    RWFRCAP           TO   SRTAMT   (03)
             MOVE    RWFRCMTYSRVC      TO   SRTAMT   (04)
             MOVE    RWFRDEBT          TO   SRTAMT   (05)
             MOVE    RWFRFEDIND        TO   SRTAMT   (06)
041499       MOVE    RWFRCHRTR         TO   SRTAMT   (07)
             MOVE    RWFTOTAL          TO   SRTTOT
             MOVE    'Y'               TO   SRTRECON
             GO                        TO   015-CONT
050399     ELSE
050399     IF      RWFTABLE            =    '99998'                AND
050399             RWFPGM              NOT  NUMERIC
050399       MOVE    SPACES            TO   SRTKPGM
050399       MOVE    RWFDI6100         TO   SRTAMT   (01)
050399       MOVE    RWFDI6200         TO   SRTAMT   (02)
050399       MOVE    RWFDI6300         TO   SRTAMT   (03)
050399       MOVE    RWFDI6400         TO   SRTAMT   (04)
050399       MOVE    RWFDI7100         TO   SRTAMT   (05)
050399       MOVE    RWFDI7200         TO   SRTAMT   (06)
050399       MOVE    RWFSI7300         TO   SRTAMT   (07)
050399       MOVE    RWFDI7400         TO   SRTAMT   (08)
050399       MOVE    RWFDI7500         TO   SRTAMT   (09)
050399       MOVE    RWFDI7600         TO   SRTAMT   (10)
050399       MOVE    RWFDI7700         TO   SRTAMT   (11)
050399       MOVE    RWFDI7800         TO   SRTAMT   (12)
050399       MOVE    RWFDI7900         TO   SRTAMT   (13)
050399       MOVE    RWFDI8100         TO   SRTAMT   (14)
041706       MOVE    RWFDI8200         TO   SRTAMT   (15)
041706       MOVE    RWFDI6500         TO   SRTAMT   (16)
050399       MOVE    'Y'               TO   SRTFORM7
050399       GO                        TO   015-CONT
050399     ELSE
050399     IF      RWFTABLE            =    '99998'                AND
050399             RWFPGM              IS   NUMERIC
050399       MOVE    RWFDSAL           TO   SRTAMT   (01)
050399       MOVE    RWFDBEN           TO   SRTAMT   (02)
050399       MOVE    RWFDPRCH          TO   SRTAMT   (03)
050399       MOVE    RWFDMATSUP        TO   SRTAMT   (04)
050399       MOVE    RWFDOTHER         TO   SRTAMT   (05)
050399       MOVE    RWFDCAP           TO   SRTAMT   (06)
050399       MOVE    'Y'               TO   SRTFORM7
           ELSE
             MOVE    RWFDSAL           TO   SRTAMT   (01)
             MOVE    RWFDBEN           TO   SRTAMT   (02)
             MOVE    RWFDPRCH          TO   SRTAMT   (03)
             MOVE    RWFDMATSUP        TO   SRTAMT   (04)
             MOVE    RWFDOTHER         TO   SRTAMT   (05)
             MOVE    RWFDCAP           TO   SRTAMT   (06).
           MOVE    RWFSI6100           TO   SRTAMT   (07)
           MOVE    RWFSI6200           TO   SRTAMT   (08)
           MOVE    RWFSI6300           TO   SRTAMT   (09)
           MOVE    RWFSI6400           TO   SRTAMT   (10)
041706     MOVE    RWFSI6500           TO   SRTAMT   (31)
           MOVE    RWFSI7300           TO   SRTAMT   (11)
           MOVE    RWFSI7400           TO   SRTAMT   (12)
           MOVE    RWFSI7600           TO   SRTAMT   (13)
           MOVE    RWFSI7700           TO   SRTAMT   (14)
           MOVE    RWFSI7800           TO   SRTAMT   (15)
           MOVE    RWFSI7900           TO   SRTAMT   (16)
           MOVE    RWFSI8100           TO   SRTAMT   (17)
041706     MOVE    RWFSI8200           TO   SRTAMT   (32)
           MOVE    RWFDI6100           TO   SRTAMT   (18)
           MOVE    RWFDI6200           TO   SRTAMT   (19)
           MOVE    RWFDI6300           TO   SRTAMT   (20)
           MOVE    RWFDI6400           TO   SRTAMT   (21)
041706     MOVE    RWFDI6500           TO   SRTAMT   (33)
           MOVE    RWFDI7100           TO   SRTAMT   (22)
           MOVE    RWFDI7200           TO   SRTAMT   (23)
           MOVE    RWFDI7400           TO   SRTAMT   (24)
           MOVE    RWFDI7500           TO   SRTAMT   (25)
           MOVE    RWFDI7600           TO   SRTAMT   (26)
           MOVE    RWFDI7700           TO   SRTAMT   (27)
           MOVE    RWFDI7800           TO   SRTAMT   (28)
           MOVE    RWFDI7900           TO   SRTAMT   (29)
           MOVE    RWFDI8100           TO   SRTAMT   (30).
041706     MOVE    RWFDI8200           TO   SRTAMT   (34).

       015-CONT.
           IF      SRTKFUND          =    '1'
             MOVE  'Y'               TO   WSCFLG1.
           IF      SRTKFUND          =    '4'
             MOVE  'Y'               TO   WSCFLG4.
           RELEASE SRT
050399*    IF      SRTRECON          NOT  =  'Y'
050399     IF      SRTRECON          NOT  =  'Y'                  AND
050399             SRTFORM7          NOT  =  'Y'
             MOVE  '0000'            TO   SRTKSCHL
             RELEASE  SRT.
       015-EXIT.
           EXIT.

       020-PGM.
           MOVE    RQRDIST             TO   FPGKEY
           MOVE    RQRFY               TO   FPGFY
           MOVE    'FPG'               TO   FPGPREF
           MOVE    RWFPGM              TO   FPGFPG
           MOVE    FPGKEY              TO   CRFDK
           READ    CRF-DISK
           IF      RETCRF              NOT  =  '00'
             MOVE  SPACES              TO   FPG
           ELSE
             MOVE  CRFD                TO   FPG.
       020-EXIT.
           EXIT.

      ******************************************************************
       490-HOUSEKEEPING.
           OPEN    INPUT                    CRD-CARD      CRF-DISK
                                            RWF-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  =   'A')               AND
                  (CRDRPT              NOT  =   'B')               AND
                  (CRDRPT              NOT  =   'C')               AND
                  (CRDRPT              NOT  =   'D')
             MOVE  ALL '-'             TO   ERRRPT.
           IF     (CRDSRC              NOT  =   ' ')
             MOVE  ALL '-'             TO   ERRSRC.
           IF     (CRDFUND             NOT  =   '1')               AND
                  (CRDFUND             NOT  =   '4')               AND
050409            (CRDFUND             NOT  =   '5')               AND
050409            (CRDFUND             NOT  =   '6')               AND
050409            (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    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    'EW030 NO REQUESTS *'   TO   LNMMSG
             PERFORM 520-PRINT         THRU 520-EXIT.
           IF      RQRRPT              =    'B'
             OPEN  OUTPUT              XCD-DISK
             OPEN  INPUT               ABF-DISK.
           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      RETXCD              NOT  =   '00'
             MOVE    'XCD OPEN ERROR'  TO   LNMMSG
             MOVE    RETXCD            TO   LNMVALUE1
             PERFORM 520-PRINT         THRU 520-EXIT.
           IF     (RETCRF              NOT  =   '00')                OR
                  (RETRWF              NOT  =   '00')                OR
                  (RETABF              NOT  =   '00')                OR
                  (RETXCD              NOT  =   '00')
             GO                        TO   499-EOJ.
           PERFORM 493-TBL-PGM         THRU 493-EXIT.
           IF      RQRRPT              =    'B'
             PERFORM 494-TBL-ABF       THRU 494-EXIT.
           MOVE    STRKEY              TO   RWFDK
           START   RWF-DISK        KEY >    RWFDK
           IF      RETRWF              =    '00'
             PERFORM 010-READ          THRU 010-EXIT.
       490-EXIT.
           EXIT.

      ******************************************************************
       493-TBL-PGM.
           MOVE    RETCRF              TO   RETCRFOLD
           MOVE    HIGH-VALUES         TO   PGMTBL
           SET     PGM1                TO   +1
           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'
             MOVE  RETCRFOLD           TO   RETCRF
             GO                        TO   493-EXIT.
       493-LOOP.
           READ    CRF-DISK            NEXT
           IF      RETCRF              =    '00'
             MOVE  CRFD                TO   FPG
             IF    FPGDIST             =    RQRDIST             AND
                   FPGFY               =    RQRFY               AND
                   FPGPREF             =    'FPG'
               MOVE FPGFPG             TO   PGMPGM  (PGM1)
               MOVE FPGRPT             TO   PGMSEQ  (PGM1)
               MOVE ZEROS              TO   PGMSTF  (PGM1)
               IF  PGM1                <    +1000
                 SET PGM1              UP   BY  +1
                 GO                    TO   493-LOOP.
           MOVE    RETCRFOLD           TO   RETCRF.
       493-EXIT.
           EXIT.

       494-TBL-ABF.
           MOVE    RETABF              TO   RETABFOLD
           MOVE    RQRDIST             TO   ABFKEY
           MOVE    RQRFY               TO   ABFFY
           MOVE    ABFKEY              TO   ABFDK
           START   ABF-DISK      KEY   >    ABFDK
           IF      RETABF              NOT  =  '00'
             MOVE  RETABFOLD           TO   RETABF
             GO                        TO   494-EXIT.
       494-LOOP1.
           READ    ABF-DISK            NEXT
101702     MOVE    ABFD                TO   ABF
           IF      RETABF              NOT  =  '00'             OR
                   ABFDIST             NOT  =   RQRDIST         OR
                   ABFFY               NOT  =   RQRFY
             MOVE  RETABFOLD           TO   RETABF
             GO                        TO   494-EXIT.
101702*    MOVE    ABFD                TO   ABF.
       494-LOOP2.
           SEARCH  ALL  PGMENTRY
             AT  END
               MOVE  '***PGM NOT IN TBL***' TO  LNMMSG
               MOVE   ABFPGM           TO   LNMVALUE2
               PERFORM 520-PRINT       THRU 520-EXIT
               GO                      TO   494-LOOP1
             WHEN    PGMPGM (PGM1)     =    ABFPGM
               ADD   ABFSTAFF          TO   PGMSTF  (PGM1)
               GO                      TO   494-LOOP1.
       494-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  =   'A')               AND
                  (CRDRPT              NOT  =   'B')               AND
                  (CRDRPT              NOT  =   'C')               AND
                  (CRDRPT              NOT  =   'D')
             MOVE  ALL '-'             TO   ERRRPT.
           IF     (CRDSRC              NOT  =   ' ')
             MOVE  ALL '-'             TO   ERRSRC.
           IF     (CRDFUND             NOT  =   '1')               AND
                  (CRDFUND             NOT  =   '4')               AND
050409            (CRDFUND             NOT  =   '5')               AND
050409            (CRDFUND             NOT  =   '6')               AND
050409            (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    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.
           INITIALIZE                  SRT
           IF      WSCFLG1             NOT  =   'Y'
             GO                        TO   499-FUND4.
           MOVE    RQRDIST             TO   SRTKDIST
           MOVE    RQRREQ              TO   SRTKREQ
           MOVE    RQRFY               TO   SRTKFY
           MOVE    '1'                 TO   SRTKFUND
           MOVE    '0000'              TO   SRTKSCHL
           MOVE    RQRPRT              TO   SRTPRT
           MOVE    RQRRPT              TO   SRTRPT
           SET     PGM1                TO   +1.
       499-LOOP1.
           IF      PGMENTRY (PGM1)     =    HIGH-VALUES
             SET   PGM1                TO   +1
             GO                        TO   499-FUND4.
           MOVE    PGMPGM (PGM1)       TO   SRTKPGM
           MOVE    PGMSEQ (PGM1)       TO   SRTKSEQ
           RELEASE SRT
           IF      PGM1                <    +1000
             SET   PGM1                UP   BY  +1
             GO                        TO   499-LOOP1.
       499-FUND4.
           IF      WSCFLG4             NOT  =   'Y'
             GO                        TO   499-EXIT.
           MOVE    RQRDIST             TO   SRTKDIST
           MOVE    RQRREQ              TO   SRTKREQ
           MOVE    RQRFY               TO   SRTKFY
           MOVE    '4'                 TO   SRTKFUND
           MOVE    '0000'              TO   SRTKSCHL
           MOVE    RQRPRT              TO   SRTPRT
           MOVE    RQRRPT              TO   SRTRPT
           SET     PGM1                TO   +1.
       499-LOOP2.
           IF      PGMENTRY (PGM1)     =    HIGH-VALUES
             SET   PGM1                TO   +1
             GO                        TO   499-EXIT.
           MOVE    PGMPGM (PGM1)       TO   SRTKPGM
           MOVE    PGMSEQ (PGM1)       TO   SRTKSEQ
           RELEASE SRT
           IF      PGM1                <    +1000
             SET   PGM1                UP   BY  +1
             GO                        TO   499-LOOP2.
       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
                   (SRTKSEQ            NOT  =   OLDKSEQ)             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)            OR
                   (SRTKSEQ            NOT  =   OLDKSEQ)
                 PERFORM 625-2TOT      THRU 625-EXIT
                 IF  (SRTKDIST         NOT  =   OLDKDIST)            OR
                     (SRTKREQ          NOT  =   OLDKREQ)             OR
                     (SRTKFY           NOT  =   OLDKFY)              OR
                     (SRTKFUND         NOT  =   OLDKFUND)            OR
                     (SRTKSCHL         NOT  =   OLDKSCHL)
                   PERFORM 635-3TOT    THRU 635-EXIT
                   IF  (SRTKDIST       NOT  =   OLDKDIST)            OR
                       (SRTKREQ        NOT  =   OLDKREQ)             OR
                       (SRTKFY         NOT  =   OLDKFY)              OR
                       (SRTKFUND       NOT  =   OLDKFUND)
                     PERFORM 645-4TOT  THRU 645-EXIT
                     IF  (SRTKDIST     NOT  =   OLDKDIST)            OR
                         (SRTKREQ      NOT  =   OLDKREQ)             OR
                         (SRTKFY       NOT  =   OLDKFY)
                       PERFORM 655-5TOT     THRU 655-EXIT
                       IF  (SRTKEY          =    HIGH-VALUES)
                         GO                 TO   999-EOJ
                       ELSE
                         PERFORM 650-5CHG   THRU 650-EXIT
                     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.
           IF       SRTRECON           =    'Y'
             ADD    SRTAMT  (01)       TO   CTRRECR     CTRTOT
             ADD    SRTAMT  (02)       TO   CTROTHR     CTRTOT
             ADD    SRTAMT  (03)       TO   CTRCAP      CTRTOT
             ADD    SRTAMT  (04)       TO   CTRCOMSRV   CTRTOT
             ADD    SRTAMT  (05)       TO   CTRDEBT     CTRTOT
             ADD    SRTAMT  (06)       TO   CTRFEDIND   CTRTOT
041499       ADD    SRTAMT  (07)       TO   CTRCHRTR    CTRTOT
             ADD    SRTTOT             TO   CTRAFR
             GO                        TO   515-EXIT.
050399     IF       SRTFORM7           =    'Y'                    AND
050399              SRTKPGM            =    SPACES
050399       ADD    SRTAMT  (01)       TO   CTR4AMT1
050399       ADD    SRTAMT  (02)       TO   CTR4AMT2
050399       ADD    SRTAMT  (03)       TO   CTR4AMT3
050399       ADD    SRTAMT  (04)       TO   CTR4AMT4
050399       ADD    SRTAMT  (05)       TO   CTR4AMT5
050399       ADD    SRTAMT  (06)       TO   CTR4AMT6
050399       ADD    SRTAMT  (07)       TO   CTR4AMT7
050399       ADD    SRTAMT  (08)       TO   CTR4AMT8
050399       ADD    SRTAMT  (09)       TO   CTR4AMT9
050399       ADD    SRTAMT  (10)       TO   CTR4AMT10
050399       ADD    SRTAMT  (11)       TO   CTR4AMT11
050399       ADD    SRTAMT  (12)       TO   CTR4AMT12
050399       ADD    SRTAMT  (13)       TO   CTR4AMT13
050399       ADD    SRTAMT  (14)       TO   CTR4AMT14
041706       ADD    SRTAMT  (15)       TO   CTR4AMT15
041706       ADD    SRTAMT  (16)       TO   CTR4AMT16
050399       GO                        TO   515-EXIT.
           ADD      SRTAMT  (01)       TO   CTRLNDTOT   CTRSAMT1
           ADD      SRTAMT  (02)       TO   CTRLNDTOT   CTRSAMT2
           ADD      SRTAMT  (03)       TO   CTRLNDTOT   CTRSAMT3
           ADD      SRTAMT  (04)       TO   CTRLNDTOT   CTRSAMT4
           ADD      SRTAMT  (05)       TO   CTRLNDTOT   CTRSAMT5
           ADD      SRTAMT  (06)       TO   CTRLNDTOT   CTRSAMT6
           ADD      SRTAMT  (07)       TO   CTRSI6100   CTRSTOT
           ADD      SRTAMT  (08)       TO   CTRSI6200   CTRSTOT
           ADD      SRTAMT  (09)       TO   CTRSI6300   CTRSTOT
           ADD      SRTAMT  (10)       TO   CTRSI6400   CTRSTOT
041706     ADD      SRTAMT  (31)       TO   CTRSI6500   CTRSTOT
           ADD      SRTAMT  (11)       TO   CTRSI7300   CTRSTOT
           ADD      SRTAMT  (12)       TO   CTRSI7400   CTRSTOT
           ADD      SRTAMT  (13)       TO   CTRSI7600
           ADD      SRTAMT  (14)       TO   CTRSI7700   CTRSTOT
           ADD      SRTAMT  (15)       TO   CTRSI7800
           ADD      SRTAMT  (16)       TO   CTRSI7900   CTRSTOT
           ADD      SRTAMT  (17)       TO   CTRSI8100   CTRSTOT
041706     ADD      SRTAMT  (32)       TO   CTRSI8200   CTRSTOT
           ADD      SRTAMT  (18)       TO   CTRDI6100   CTRDTOT
           ADD      SRTAMT  (19)       TO   CTRDI6200   CTRDTOT
           ADD      SRTAMT  (20)       TO   CTRDI6300   CTRDTOT
           ADD      SRTAMT  (21)       TO   CTRDI6400   CTRDTOT
041706     ADD      SRTAMT  (33)       TO   CTRDI6500   CTRDTOT
           ADD      SRTAMT  (22)       TO   CTRDI7100   CTRDTOT
           ADD      SRTAMT  (23)       TO   CTRDI7200   CTRDTOT
           ADD      SRTAMT  (24)       TO   CTRDI7400   CTRDTOT
           ADD      SRTAMT  (25)       TO   CTRDI7500   CTRDTOT
           ADD      SRTAMT  (26)       TO   CTRDI7600
           ADD      SRTAMT  (27)       TO   CTRDI7700   CTRDTOT
           ADD      SRTAMT  (28)       TO   CTRDI7800
           ADD      SRTAMT  (29)       TO   CTRDI7900   CTRDTOT
           ADD      SRTAMT  (30)       TO   CTRDI8100   CTRDTOT.
041706     ADD      SRTAMT  (34)       TO   CTRDI8200   CTRDTOT.
       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
           IF      OLDRPT              =    'A'
             MOVE  '* EDIT *'          TO   HD1MODE
           ELSE
             MOVE  '* POST *'          TO   HD1MODE.
           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
           IF      WSCLAST             =   'N'
             MOVE    HD4               TO   LN1
             PERFORM 520-PRINT         THRU 520-EXIT
             MOVE    HD5               TO   LN1
             PERFORM 520-PRINT         THRU 520-EXIT
             MOVE    '0'               TO   CTLCHAR
             MOVE    HD6               TO   LN1
             PERFORM 520-PRINT         THRU 520-EXIT
             MOVE    HD7               TO   LN1
             PERFORM 520-PRINT         THRU 520-EXIT
             MOVE    HD8               TO   LN1
             PERFORM 520-PRINT         THRU 520-EXIT
           ELSE
             MOVE   'N'                TO   WSCLAST.
050399     IF      OLDFORM7            =    'Y'                    AND
050399             WSCFLG4XXX          NOT  =  'Y'
050399       PERFORM  730-CHRTR-HDR    THRU 730-EXIT.
           MOVE    '0'                 TO   CTLCHAR
           MOVE    OLDLN               TO   LN1.
       525-EXIT.
           EXIT.

      ******************************************************************
       610-1CHG.
           MOVE    SRTKPGM             TO   OLDKPGM   LN1NBR
           MOVE    SRTKDIST            TO   FPGKEY
           MOVE    SRTKFY              TO   FPGFY
           MOVE    'FPG'               TO   FPGPREF
           MOVE    SRTKPGM             TO   FPGFPG
           MOVE    FPGKEY              TO   CRFDK
           READ    CRF-DISK
           IF      RETCRF              NOT  =  '00'
             MOVE  SPACES              TO   FPGABBR
           ELSE
             MOVE  CRFD                TO   FPG.
           MOVE    FPGABBR             TO   LN1MSG
           INITIALIZE                  CTRLVL1.
       610-EXIT.
           EXIT.

       615-1TOT.
           IF      OLDKPGM             =    SPACES
             GO                        TO   615-EXIT.
           MOVE    CTRSAMT1            TO   LN1AMT1
           MOVE    CTRSAMT2            TO   LN1AMT2
           MOVE    CTRSAMT3            TO   LN1AMT3
           MOVE    CTRSAMT4            TO   LN1AMT4
           MOVE    CTRSAMT5            TO   LN1AMT5
           MOVE    CTRSAMT6            TO   LN1AMT6
           MOVE    CTRLNDTOT           TO   LN1AMT7
           MOVE    CTRSTOT             TO   LN1AMT8
           COMPUTE CTRSCOST            =    CTRLNDTOT  +  CTRSTOT
           MOVE    CTRSCOST            TO   LN1AMT9
           MOVE    CTRDTOT             TO   LN1AMT10
           COMPUTE CTRLNTOTAL          =    CTRSCOST   +  CTRDTOT
           MOVE    CTRLNTOTAL          TO   LN1TOTAL
           PERFORM 520-PRINT           THRU 520-EXIT.
           ADD     CTRSAMT1            TO   CTRSAL
           ADD     CTRSAMT2            TO   CTRBEN
           ADD     CTRSAMT3            TO   CTRPRCH
           ADD     CTRSAMT4            TO   CTRMATSUP
           ADD     CTRSAMT5            TO   CTRDOTHR
           ADD     CTRSAMT6            TO   CTRDCAP
           ADD     CTRLNDTOT           TO   CTRTOTAL
           ADD     CTRSTOT             TO   CTRSEQSTOT
           ADD     CTRSCOST            TO   CTRSEQSCOST
           ADD     CTRDTOT             TO   CTRSEQDTOT
           ADD     CTRLNTOTAL          TO   CTRSEQTOT.
           IF      OLDRPT              NOT  =  'B'
             IF    CTRLNTOTAL          =    ZEROS
               GO                      TO   615-EXIT
             ELSE
083095*        ADD  +2                 TO   CTRXCD
083095         ADD  +1                 TO   CTRXCD
               GO                      TO   615-EXIT.
           IF      CTRLNTOTAL          =    ZEROS
             GO                        TO   615-EXIT.
           INITIALIZE  XCD
           MOVE    OLDKDIST            TO   XCDDIST
           MOVE    OLDKSCHL            TO   XCDSCHL
           MOVE    OLDKPGM             TO   XCDPGM
           IF      OLDKFUND            =    '1'
             IF    OLDKSCHL            =    '0000'
               MOVE 'A'                TO   XCDRTYPE
             ELSE
               MOVE 'B'                TO   XCDRTYPE
           ELSE
050409     IF      OLDKFUND            =    '5'
050409       IF    OLDKSCHL            =    '0000'
050409         MOVE 'E'                TO   XCDRTYPE
050409       ELSE
050409         MOVE 'F'                TO   XCDRTYPE
050409     ELSE
050409     IF      OLDKFUND            =    '6'
050409       IF    OLDKSCHL            =    '0000'
050409         MOVE 'G'                TO   XCDRTYPE
050409       ELSE
050409         MOVE 'H'                TO   XCDRTYPE
050409     ELSE
050409     IF      OLDKFUND            =    '7'
050409       IF    OLDKSCHL            =    '0000'
050409         MOVE 'I'                TO   XCDRTYPE
050409       ELSE
050409         MOVE 'J'                TO   XCDRTYPE
050409     ELSE
020411     IF      OLDKFUND            =    '8'
020411       IF    OLDKSCHL            =    '0000'
020411         MOVE 'K'                TO   XCDRTYPE
020411       ELSE
020411         MOVE 'L'                TO   XCDRTYPE
020411     ELSE
020411     IF      OLDKFUND            =    '9'
020411       IF    OLDKSCHL            =    '0000'
020411         MOVE 'M'                TO   XCDRTYPE
020411       ELSE
020411         MOVE 'N'                TO   XCDRTYPE
020411     ELSE
             IF    OLDKSCHL            =    '0000'
               MOVE 'C'                TO   XCDRTYPE
             ELSE
               MOVE 'D'                TO   XCDRTYPE.
083095*    MOVE    'D'                 TO   XCDDTYPE
           MOVE    CTRSAMT1            TO   XCDAMT1
           MOVE    CTRSAMT2            TO   XCDAMT2
           MOVE    CTRSAMT3            TO   XCDAMT3
           MOVE    CTRSAMT4            TO   XCDAMT4
           MOVE    CTRSAMT5            TO   XCDAMT5
           MOVE    CTRSAMT6            TO   XCDAMT6
083095     MOVE    CTRSTOT             TO   XCDAMT7
083095     MOVE    CTRDTOT             TO   XCDAMT8
           IF      OLDKSCHL            =    '0000'
             PERFORM 715-TBL-READ      THRU 715-EXIT
           ELSE
             PERFORM 720-ABF-READ      THRU 720-EXIT.
083095*    PERFORM 725-XCD-WRITE       THRU 725-EXIT
083095*    MOVE    'I'                 TO   XCDDTYPE
083095*    MOVE    CTRSTOT             TO   XCDAMT1
083095*    MOVE    CTRDTOT             TO   XCDAMT2
083095*    MOVE    ZEROS               TO   XCDAMT3  XCDAMT4
083095*                                     XCDAMT5  XCDAMT6
083095*                                     XCDAMT7
083095     PERFORM 725-XCD-WRITE       THRU 725-EXIT.
       615-EXIT.
           EXIT.

       620-2CHG.
           MOVE    SRTKSEQ             TO   OLDKSEQ
           INITIALIZE                  CTRLVL2
           PERFORM 610-1CHG            THRU 610-EXIT.
       620-EXIT.
           EXIT.

       625-2TOT.
           IF      OLDKSEQ             =    SPACES
             GO                        TO   625-EXIT.
           MOVE    OLDKDIST            TO   FRSKEY
           MOVE    OLDKFY              TO   FRSFY
           MOVE    'FRS'               TO   FRSPREF
           MOVE    OLDKSEQ             TO   FRSFRS
           MOVE    FRSKEY              TO   CRFDK
           READ    CRF-DISK
           IF      RETCRF              NOT  =  '00'
             MOVE  'UNKNOWN'           TO   FRSABBR
           ELSE
             MOVE  CRFD                TO   FRS.
           MOVE    '0'                 TO   CTLCHAR
           MOVE    FRSABBR             TO   LN4MSG
           MOVE    CTRSAL              TO   LN4AMT1
           MOVE    CTRBEN              TO   LN4AMT2
           MOVE    CTRPRCH             TO   LN4AMT3
           MOVE    CTRMATSUP           TO   LN4AMT4
           MOVE    CTRDOTHR            TO   LN4AMT5
           MOVE    CTRDCAP             TO   LN4AMT6
           MOVE    CTRTOTAL            TO   LN4AMT7
           MOVE    CTRSEQSTOT          TO   LN4AMT8
           MOVE    CTRSEQSCOST         TO   LN4AMT9
           MOVE    CTRSEQDTOT          TO   LN4AMT10
           MOVE    CTRSEQTOT           TO   LN4TOTAL
           PERFORM 520-PRINT           THRU 520-EXIT
           MOVE    '0'                 TO   CTLCHAR
           ADD     CTRSAL              TO   CTRAMT1
           ADD     CTRBEN              TO   CTRAMT2
           ADD     CTRPRCH             TO   CTRAMT3
           ADD     CTRMATSUP           TO   CTRAMT4
           ADD     CTRDOTHR            TO   CTRAMT5
           ADD     CTRDCAP             TO   CTRAMT6
           ADD     CTRTOTAL            TO   CTRAMT7
           ADD     CTRSEQSTOT          TO   CTRAMT8
           ADD     CTRSEQSCOST         TO   CTRAMT9
           ADD     CTRSEQDTOT          TO   CTRAMT10
           ADD     CTRSEQTOT           TO   CTRAMTTOT.
       625-EXIT.
           EXIT.

       630-3CHG.
           MOVE    SRTKSCHL            TO   OLDKSCHL  HD5SCHL
           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   SCLDESC
           ELSE
             MOVE  CRFD                TO   SCL.
           MOVE    SCLDESC             TO   HD5DESC
050399     IF      SCLCHRTR            =    'Y'
050399       MOVE  '** CHARTER SCHOOL **'   TO  HD5CHRT
050399     ELSE
050399       MOVE  SPACES              TO   HD5CHRT.
           INITIALIZE                  CTRLVL3     CTRDIND
                                       CTRSIND     CTRRECON
050399                                 CTR4XXX
050399     MOVE    'N'                 TO   WSCFLG4XXX
050399     MOVE    SRTFORM7            TO   OLDFORM7
           MOVE    +61                 TO   CTRLN
           PERFORM 620-2CHG            THRU 620-EXIT.
       630-EXIT.
           EXIT.

       635-3TOT.
           MOVE    '0'                 TO   CTLCHAR
           MOVE    'TOTAL FOR FEFP'    TO   LN4MSG
           MOVE    CTRAMT1             TO   LN4AMT1
           MOVE    CTRAMT2             TO   LN4AMT2
           MOVE    CTRAMT3             TO   LN4AMT3
           MOVE    CTRAMT4             TO   LN4AMT4
           MOVE    CTRAMT5             TO   LN4AMT5
           MOVE    CTRAMT6             TO   LN4AMT6
           MOVE    CTRAMT7             TO   LN4AMT7
           MOVE    CTRAMT8             TO   LN4AMT8
           MOVE    CTRAMT9             TO   LN4AMT9
           MOVE    CTRAMT10            TO   LN4AMT10
           MOVE    CTRAMTTOT           TO   LN4TOTAL
           ADD     CTRAMTTOT           TO   CTRTOT
           PERFORM 520-PRINT           THRU 520-EXIT
           IF      CTRLN               >    +58
             MOVE  +61                 TO   CTRLN.
           MOVE    '0'                 TO   CTLCHAR
           MOVE    'FOOD SERVICE'      TO   LN1MSG
041497     MOVE    CTRSI7600           TO   LN1AMT8
041497     ADD     CTRSI7600           TO   CTRTOT
041497     MOVE    CTRDI7600           TO   LN1AMT10
041497     ADD     CTRDI7600           TO   CTRTOT
           PERFORM 520-PRINT           THRU 520-EXIT
           MOVE    'TRANSPORTATION'    TO   LN1MSG
041497*    COMPUTE CTRCOMP             =    CTRSI7600 + CTRSI7800
041497*    MOVE    CTRCOMP             TO   LN1AMT8
041497*    ADD     CTRCOMP             TO   CTRTOT
041497*    COMPUTE CTRCOMP             =    CTRDI7600 + CTRDI7800
041497*    MOVE    CTRCOMP             TO   LN1AMT10
041497*    ADD     CTRCOMP             TO   CTRTOT
041497     MOVE    CTRSI7800           TO   LN1AMT8
041497     ADD     CTRSI7800           TO   CTRTOT
041497     MOVE    CTRDI7800           TO   LN1AMT10
041497     ADD     CTRDI7800           TO   CTRTOT
           PERFORM 520-PRINT           THRU 520-EXIT
           IF      OLDRPT              NOT  =  'B'
120506*      IF   (CTRSI7600           =    ZEROS           AND
120506*            CTRSI7800           =    ZEROS           AND
120506*            CTRDI7600           =    ZEROS           AND
120506*            CTRDI7800           =    ZEROS)
120506*        GO                      TO   635-CONT
120506*      ELSE
120506*        ADD   +2                TO   CTRXCD
120506*        GO                      TO   635-CONT.
120506       GO                        TO   635-CONT
120506     ELSE
120506       ADD     +2                TO   CTRXCD.

120506*    IF   (CTRSI7600             =    ZEROS           AND
120506*          CTRSI7800             =    ZEROS           AND
120506*          CTRDI7600             =    ZEROS           AND
120506*          CTRDI7800             =    ZEROS)
120506*      GO                        TO   635-CONT.
           INITIALIZE  XCD
           MOVE    OLDKDIST            TO   XCDDIST
           MOVE    OLDKSCHL            TO   XCDSCHL
           MOVE    '910'               TO   XCDPGM
           IF      OLDKFUND            =    '1'
             IF    OLDKSCHL            =    '0000'
               MOVE 'A'                TO   XCDRTYPE
             ELSE
               MOVE 'B'                TO   XCDRTYPE
050409     ELSE
050409     IF      OLDKFUND            =    '5'
050409       IF    OLDKSCHL            =    '0000'
050409         MOVE 'E'                TO   XCDRTYPE
050409       ELSE
050409         MOVE 'F'                TO   XCDRTYPE
050409     ELSE
050409     IF      OLDKFUND            =    '6'
050409       IF    OLDKSCHL            =    '0000'
050409         MOVE 'G'                TO   XCDRTYPE
050409       ELSE
050409         MOVE 'H'                TO   XCDRTYPE
050409     ELSE
050409     IF      OLDKFUND            =    '7'
050409       IF    OLDKSCHL            =    '0000'
050409         MOVE 'I'                TO   XCDRTYPE
050409       ELSE
050409         MOVE 'J'                TO   XCDRTYPE
020411     ELSE
020411     IF      OLDKFUND            =    '8'
020411       IF    OLDKSCHL            =    '0000'
020411         MOVE 'K'                TO   XCDRTYPE
020411       ELSE
020411         MOVE 'L'                TO   XCDRTYPE
020411     ELSE
020411     IF      OLDKFUND            =    '9'
020411       IF    OLDKSCHL            =    '0000'
020411         MOVE 'M'                TO   XCDRTYPE
020411       ELSE
020411         MOVE 'N'                TO   XCDRTYPE
           ELSE
             IF    OLDKSCHL            =    '0000'
               MOVE 'C'                TO   XCDRTYPE
             ELSE
               MOVE 'D'                TO   XCDRTYPE.
083095*    MOVE    'I'                 TO   XCDDTYPE
           MOVE    CTRSI7600           TO   XCDAMT1
           MOVE    CTRDI7600           TO   XCDAMT2
           PERFORM 725-XCD-WRITE       THRU 725-EXIT
           MOVE    '920'               TO   XCDPGM
           MOVE    CTRSI7800           TO   XCDAMT1
           MOVE    CTRDI7800           TO   XCDAMT2
           PERFORM 725-XCD-WRITE       THRU 725-EXIT.
       635-CONT.
           IF      OLDKSCHL            NOT  =  '0000'
             PERFORM 700-PC3           THRU 700-EXIT
           ELSE
             PERFORM 710-PC4           THRU 710-EXIT.
       635-EXIT.
           EXIT.

       640-4CHG.
           MOVE    SRTKFUND            TO   OLDKFUND  HD4FND
           PERFORM 630-3CHG            THRU 630-EXIT.
       640-EXIT.
           EXIT.

       645-4TOT.
       645-EXIT.
           EXIT.

       650-5CHG.
           MOVE     ZEROS              TO   CTRLN    CTRPG  CTRXCD
           MOVE     SRTKREQ            TO   OLDKREQ
           MOVE     SRTKDIST           TO   OLDKDIST
           MOVE     SRTKFY             TO   OLDKFY
           MOVE     SRTPRT             TO   OLDPRT
           MOVE     SRTRPT             TO   OLDRPT

           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.
       650-REQ.
           IF      HD1B         (HD11) =    SPACES
             SET   HD11                DOWN BY  +1
             GO                        TO   650-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.
       650-HEAD.
           IF      RQHREQ       (RQH1) NOT  =   HIGH-VALUES
             IF      RQHREQ     (RQH1) NOT  =   SRTKREQ
               SET   RQH1              UP   BY  +1
               GO                      TO   650-HEAD
             ELSE
               IF      RQHID    (RQH1) =    'H1'
                 MOVE  RQHHEAD  (RQH1) TO   HD2HEAD
                 MOVE  RQHUSER  (RQH1) TO   HD1USER
                 SET   RQH1            UP   BY  +1
                 GO                    TO   650-HEAD
               ELSE
                 IF      RQHID  (RQH1) =    'H2'
                   MOVE  RQHHEAD (RQH1) TO  HD3HEAD
                   SET   RQH1          UP   BY  +1
                   GO                  TO   650-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 640-4CHG            THRU 640-EXIT
           PERFORM 525-HEADS           THRU 525-EXIT.
       650-EXIT.
           EXIT.

       655-5TOT.
           MOVE    'Y'                 TO   WSCLAST
           MOVE    +61                 TO   CTRLN
           MOVE    'XCD RECORDS WRITTEN' TO  LN5MSG
           MOVE    CTRXCD              TO    LN5CNT
           PERFORM 520-PRINT           THRU 520-EXIT.
       655-EXIT.
           EXIT.

      ******************************************************************
       700-PC3.
           IF      CTRLN               >    +54
             MOVE  +61                 TO   CTRLN.
           MOVE    '0'                 TO   CTLCHAR
           MOVE    HD9                 TO   LN1
           PERFORM 520-PRINT           THRU 520-EXIT
           MOVE    HD10                TO   LN1
           PERFORM 520-PRINT           THRU 520-EXIT
           MOVE    '0'                 TO   CTLCHAR
           MOVE    '6100'              TO   LN2FUNC1
           MOVE    'PUPIL PERSONNEL'   TO   LN2DESC1
040301     IF      SCLCHRTR            =    'Y'
040301       MOVE  CTR4AMT1            TO   LN2AMT1
040301     ELSE
040301      MOVE   CTRSI6100           TO   LN2AMT1.
040301*    MOVE    CTRSI6100           TO   LN2AMT1
           MOVE    '6400'              TO   LN2FUNC2
           MOVE    'INSTR STAFF TRAINING'   TO   LN2DESC2
040301     IF      SCLCHRTR            =    'Y'
040301       MOVE  CTR4AMT4            TO   LN2AMT2
040301     ELSE
040301      MOVE   CTRSI6400           TO   LN2AMT2.
040301*    MOVE    CTRSI6400           TO   LN2AMT2
           MOVE    '7700'              TO   LN2FUNC3
           MOVE    'CENTRAL SERVICES'  TO   LN2DESC3
040301     IF      SCLCHRTR            =    'Y'
040301       MOVE  CTR4AMT11           TO   LN2AMT3
040301     ELSE
040301      MOVE   CTRSI7700           TO   LN2AMT3.
040301*    MOVE    CTRSI7700           TO   LN2AMT3
           PERFORM 520-PRINT           THRU 520-EXIT
           MOVE    '6200'              TO   LN2FUNC1
           MOVE    'INSTRUCTIONAL MEDIA'    TO   LN2DESC1
040301     IF      SCLCHRTR            =    'Y'
040301       MOVE  CTR4AMT2            TO   LN2AMT1
040301     ELSE
040301      MOVE   CTRSI6200           TO   LN2AMT1.
040301*    MOVE    CTRSI6200           TO   LN2AMT1
           MOVE    '7300'              TO   LN2FUNC2
           MOVE    'SCHOOL ADMINISTRATION'  TO   LN2DESC2
040301     IF      SCLCHRTR            =    'Y'
040301       MOVE  CTR4AMT7            TO   LN2AMT2
040301     ELSE
040301      MOVE   CTRSI7300           TO   LN2AMT2.
040301*    MOVE    CTRSI7300           TO   LN2AMT2
           MOVE    '7900'              TO   LN2FUNC3
           MOVE    'OPERATION OF PLANT'     TO   LN2DESC3
040301     IF      SCLCHRTR            =    'Y'
040301       MOVE  CTR4AMT13           TO   LN2AMT3
040301     ELSE
040301      MOVE   CTRSI7900           TO   LN2AMT3.
040301*    MOVE    CTRSI7900           TO   LN2AMT3
           PERFORM 520-PRINT           THRU 520-EXIT
           MOVE    '6300'              TO   LN2FUNC1
           MOVE    'INSTR & CURR DEVLPMNT'  TO   LN2DESC1
040301     IF      SCLCHRTR            =    'Y'
040301       MOVE  CTR4AMT3            TO   LN2AMT1
040301     ELSE
040301      MOVE   CTRSI6300           TO   LN2AMT1.
040301*    MOVE    CTRSI6300           TO   LN2AMT1
           MOVE    '7400'              TO   LN2FUNC2
           MOVE    'FACILITIES ACQ-CONSTR'  TO   LN2DESC2
040301     IF      SCLCHRTR            =    'Y'
040301       MOVE  CTR4AMT8            TO   LN2AMT2
040301     ELSE
040301      MOVE   CTRSI7400           TO   LN2AMT2.
040301*    MOVE    CTRSI7400           TO   LN2AMT2
           MOVE    '8100'              TO   LN2FUNC3
           MOVE    'MAINTENANCE OF PLANT'   TO   LN2DESC3
040301     IF      SCLCHRTR            =    'Y'
040301       MOVE  CTR4AMT14           TO   LN2AMT3
040301     ELSE
040301      MOVE   CTRSI8100           TO   LN2AMT3.
040301*    MOVE    CTRSI8100           TO   LN2AMT3
           PERFORM 520-PRINT           THRU 520-EXIT.
041706     MOVE    '8200'              TO   LN2FUNC3
041706     MOVE    'ADMIN. TECH. SERVICES'  TO   LN2DESC3
041706     IF      SCLCHRTR            =    'Y'
041706       MOVE  CTR4AMT15           TO   LN2AMT3
041706     ELSE
041706       MOVE  CTRSI8200           TO   LN2AMT3.
041706     PERFORM 520-PRINT           THRU 520-EXIT
041706     MOVE    '6500'              TO   LN2FUNC3
041706     MOVE    'INSTR. TECH. SERVICES'  TO   LN2DESC3
041706     IF      SCLCHRTR            =    'Y'
041706       MOVE  CTR4AMT16           TO   LN2AMT3
041706     ELSE
041706       MOVE  CTRSI6500           TO   LN2AMT3.
041706     PERFORM 520-PRINT           THRU 520-EXIT
           IF      OLDRPT              NOT  =  'B'
             IF    CTRAMT8             =    ZEROS
050399         GO                      TO   700-CONT
050399*        GO                      TO   700-EXIT
             ELSE
               ADD   +2                TO   CTRXCD
050399         GO                      TO   700-CONT.
050399*        GO                      TO   700-EXIT.
           IF    CTRAMT8               =    ZEROS
050399       GO                        TO   700-CONT.
050399*      GO                        TO   700-EXIT.
           INITIALIZE  XCD
           MOVE    OLDKDIST            TO   XCDDIST
           MOVE    OLDKSCHL            TO   XCDSCHL
           MOVE    '930'               TO   XCDPGM
           IF      OLDKFUND            =    '1'
             MOVE  'B'                 TO   XCDRTYPE
           ELSE
050409     IF      OLDKFUND            =    '5'
050409       MOVE  'F'                 TO   XCDRTYPE
050409     ELSE
050409     IF      OLDKFUND            =    '6'
050409       MOVE  'H'                 TO   XCDRTYPE
050409     ELSE
050409     IF      OLDKFUND            =    '7'
050409       MOVE  'J'                 TO   XCDRTYPE
050409     ELSE
020411     IF      OLDKFUND            =    '8'
020411       MOVE  'L'                 TO   XCDRTYPE
020411     ELSE
020411     IF      OLDKFUND            =    '9'
020411       MOVE  'N'                 TO   XCDRTYPE
020411     ELSE
             MOVE  'D'                 TO   XCDRTYPE.
083095*    MOVE    'I'                 TO   XCDDTYPE
           MOVE    CTRSI6100           TO   XCDAMT1
           MOVE    CTRSI6200           TO   XCDAMT2
           MOVE    CTRSI6300           TO   XCDAMT3
           MOVE    CTRSI6400           TO   XCDAMT4
           MOVE    ZEROS               TO   XCDAMT5
           MOVE    ZEROS               TO   XCDAMT6
           MOVE    CTRSI7300           TO   XCDAMT7
           PERFORM 725-XCD-WRITE       THRU 725-EXIT
           MOVE    '940'               TO   XCDPGM
           MOVE    CTRSI7400           TO   XCDAMT1
           MOVE    ZEROS               TO   XCDAMT2
           MOVE    ZEROS               TO   XCDAMT3
           MOVE    CTRSI7700           TO   XCDAMT4
           MOVE    ZEROS               TO   XCDAMT5
           MOVE    CTRSI7900           TO   XCDAMT6
           MOVE    CTRSI8100           TO   XCDAMT7
           PERFORM 725-XCD-WRITE       THRU 725-EXIT.
041706     MOVE    '945'               TO   XCDPGM
041706     MOVE    CTRSI8200           TO   XCDAMT1
041706     MOVE    CTRSI6500           TO   XCDAMT2
041706     MOVE    ZEROS               TO   XCDAMT3
041706     MOVE    ZEROS               TO   XCDAMT4
041706     MOVE    ZEROS               TO   XCDAMT5
041706     MOVE    ZEROS               TO   XCDAMT6
041706     MOVE    ZEROS               TO   XCDAMT7
041706     PERFORM 725-XCD-WRITE       THRU 725-EXIT.
050399 700-CONT.
050399     IF      OLDFORM7            NOT  =  'Y'
050399       GO                        TO   700-EXIT.
050399     IF      OLDRPT              NOT  =  'B'
050399       ADD   +2                  TO   CTRXCD
050399       GO                        TO   700-EXIT.
050399     INITIALIZE  XCD
050399     MOVE    OLDKDIST            TO   XCDDIST
050399     MOVE    OLDKSCHL            TO   XCDSCHL
050399     MOVE    '950'               TO   XCDPGM
050399     IF      OLDKFUND            =    '1'
050399       MOVE  'B'                 TO   XCDRTYPE
050399     ELSE
050409     IF      OLDKFUND            =    '5'
050409       MOVE  'F'                 TO   XCDRTYPE
050409     ELSE
050409     IF      OLDKFUND            =    '6'
050409       MOVE  'H'                 TO   XCDRTYPE
050409     ELSE
050409     IF      OLDKFUND            =    '7'
050409       MOVE  'J'                 TO   XCDRTYPE
020411     ELSE
020411     IF      OLDKFUND            =    '8'
020411       MOVE  'L'                 TO   XCDRTYPE
020411     ELSE
020411     IF      OLDKFUND            =    '9'
020411       MOVE  'N'                 TO   XCDRTYPE
050409     ELSE
050399       MOVE  'D'                 TO   XCDRTYPE.
050399     MOVE    CTR4AMT1            TO   XCDAMT1
050399     MOVE    CTR4AMT2            TO   XCDAMT2
050399     MOVE    CTR4AMT3            TO   XCDAMT3
050399     MOVE    CTR4AMT4            TO   XCDAMT4
050399     MOVE    CTR4AMT5            TO   XCDAMT5
050399     MOVE    CTR4AMT6            TO   XCDAMT6
050399     MOVE    CTR4AMT7            TO   XCDAMT7
050399     PERFORM 725-XCD-WRITE       THRU 725-EXIT
050399     MOVE    '960'               TO   XCDPGM
050399     MOVE    CTR4AMT8            TO   XCDAMT1
050399     MOVE    CTR4AMT9            TO   XCDAMT2
050399     MOVE    CTR4AMT10           TO   XCDAMT3
050399     MOVE    CTR4AMT11           TO   XCDAMT4
050399     MOVE    CTR4AMT12           TO   XCDAMT5
050399     MOVE    CTR4AMT13           TO   XCDAMT6
050399     MOVE    CTR4AMT14           TO   XCDAMT7
050399     PERFORM 725-XCD-WRITE       THRU 725-EXIT.
041706     MOVE    '965'               TO   XCDPGM
041706     MOVE    CTR4AMT15           TO   XCDAMT1
041706     MOVE    CTR4AMT16           TO   XCDAMT2
041706     MOVE    ZEROS               TO   XCDAMT3
041706     MOVE    ZEROS               TO   XCDAMT4
041706     MOVE    ZEROS               TO   XCDAMT5
041706     MOVE    ZEROS               TO   XCDAMT6
041706     MOVE    ZEROS               TO   XCDAMT7
041706     PERFORM 725-XCD-WRITE       THRU 725-EXIT.
       700-EXIT.
           EXIT.

       710-PC4.
           IF      CTRLN               >    +53
             MOVE  +61                 TO   CTRLN.
           MOVE    '0'                 TO   CTLCHAR
           MOVE    HD12                TO   LN1
           PERFORM 520-PRINT           THRU 520-EXIT
           MOVE    '0'                 TO   CTLCHAR
           MOVE    '6100'              TO   LN2FUNC1
           MOVE    'PUPIL PERSONNEL'   TO   LN2DESC1
           MOVE    CTRDI6100           TO   LN2AMT1
           MOVE    '7100'              TO   LN2FUNC2
           MOVE    'BOARD OF EDUCATION'     TO   LN2DESC2
           MOVE    CTRDI7100           TO   LN2AMT2
           MOVE    '7700'              TO   LN2FUNC3
           MOVE    'CENTRAL SERVICES'  TO   LN2DESC3
           MOVE    CTRDI7700           TO   LN2AMT3
           PERFORM 520-PRINT           THRU 520-EXIT
           MOVE    '6200'              TO   LN2FUNC1
           MOVE    'INSTRUCTIONAL MEDIA'    TO   LN2DESC1
           MOVE    CTRDI6200           TO   LN2AMT1
           MOVE    '7200'              TO   LN2FUNC2
           MOVE    'GENERAL ADMINISTRATION' TO   LN2DESC2
           MOVE    CTRDI7200           TO   LN2AMT2
           MOVE    '7900'              TO   LN2FUNC3
           MOVE    'OPERATION OF PLANT'     TO   LN2DESC3
           MOVE    CTRDI7900           TO   LN2AMT3
           PERFORM 520-PRINT           THRU 520-EXIT
           MOVE    '6300'              TO   LN2FUNC1
           MOVE    'INSTR & CURR DEVLPMNT'  TO   LN2DESC1
           MOVE    CTRDI6300           TO   LN2AMT1
           MOVE    '7400'              TO   LN2FUNC2
           MOVE    'FACILITIES ACQ-CONSTR'  TO   LN2DESC2
           MOVE    CTRDI7400           TO   LN2AMT2
           MOVE    '8100'              TO   LN2FUNC3
           MOVE    'MAINTENANCE OF PLANT'   TO   LN2DESC3
           MOVE    CTRDI8100           TO   LN2AMT3
           PERFORM 520-PRINT           THRU 520-EXIT
           MOVE    '6400'              TO   LN2FUNC1
           MOVE    'INSTR STAFF TRAINING'   TO   LN2DESC1
           MOVE    CTRDI6400           TO   LN2AMT1
           MOVE    '7500'              TO   LN2FUNC2
           MOVE    'FISCAL SERVICES'        TO   LN2DESC2
           MOVE    CTRDI7500           TO   LN2AMT2
041706     MOVE    '8200'              TO   LN2FUNC3
041706     MOVE    'ADMIN. TECH. SERVICES'  TO   LN2DESC3
041706     MOVE    CTRDI8200           TO   LN2AMT3
           PERFORM 520-PRINT           THRU 520-EXIT
041706     MOVE    '6500'              TO   LN2FUNC3
041706     MOVE    'INSTR. TECH. SERVICES'  TO   LN2DESC3
041706     MOVE    CTRDI6500           TO   LN2AMT3
041706     PERFORM 520-PRINT           THRU 520-EXIT
           IF      CTRLN               >    +55
             MOVE  +61                 TO   CTRLN.
           MOVE    '0'                 TO   CTLCHAR
           MOVE    HD13                TO   LN1
           PERFORM 520-PRINT           THRU 520-EXIT
           MOVE    HD14                TO   LN1
           PERFORM 520-PRINT           THRU 520-EXIT
           MOVE    HD15                TO   LN1
           PERFORM 520-PRINT           THRU 520-EXIT
           MOVE    '0'                 TO   CTLCHAR
           MOVE    CTRRECR             TO   LN3RECR
           MOVE    CTROTHR             TO   LN3OTHR
           MOVE    CTRCAP              TO   LN3CAP
           MOVE    CTRCOMSRV           TO   LN3COMSRV
           MOVE    CTRDEBT             TO   LN3DEBT
           MOVE    CTRFEDIND           TO   LN3FEDIND
041499     MOVE    CTRCHRTR            TO   LN3CHRTR
           MOVE    CTRTOT              TO   LN3TRPT
           MOVE    CTRAFR              TO   LN3TAFR
051109*    COMPUTE CTRCOMP             =    CTRAFR - CTRTOT
051109*    MOVE    CTRCOMP             TO   LN3DIF
051109     MOVE    CTRAFR              TO   CTRAFR-TRUNC
051109     MOVE    CTRTOT              TO   CTRTOT-TRUNC
051109     COMPUTE CTRDIFF             =    CTRAFR-TRUNC    -
051109                                      CTRTOT-TRUNC
051109     MOVE    CTRDIFF             TO   LN3DIF
           PERFORM 520-PRINT           THRU 520-EXIT.
           IF      OLDRPT              NOT  =  'B'
             IF    CTRAMT10            =    ZEROS
083095*        GO                      TO   710-EXIT
083095         GO                      TO   710-XRD
             ELSE
               ADD   +2                TO   CTRXCD
083095*        GO                      TO   710-EXIT.
083095         GO                      TO   710-XRD.
           IF    CTRAMT10              =    ZEROS
083095*      GO                        TO   710-EXIT.
083095       GO                        TO   710-XRD.
           INITIALIZE  XCD
           MOVE    OLDKDIST            TO   XCDDIST
           MOVE    OLDKSCHL            TO   XCDSCHL
           MOVE    '930'               TO   XCDPGM
           IF      OLDKFUND            =    '1'
             MOVE  'A'                 TO   XCDRTYPE
           ELSE
050409     IF      OLDKFUND            =    '5'
050409       MOVE  'E'                 TO   XCDRTYPE
050409     ELSE
050409     IF      OLDKFUND            =    '6'
050409       MOVE  'G'                 TO   XCDRTYPE
050409     ELSE
050409     IF      OLDKFUND            =    '7'
050409       MOVE  'I'                 TO   XCDRTYPE
050409     ELSE
020411     IF      OLDKFUND            =    '8'
020411       MOVE  'K'                 TO   XCDRTYPE
020411     ELSE
020411     IF      OLDKFUND            =    '9'
020411       MOVE  'M'                 TO   XCDRTYPE
020411     ELSE
             MOVE  'C'                 TO   XCDRTYPE.
083095*    MOVE    'I'                 TO   XCDDTYPE
           MOVE    CTRDI6100           TO   XCDAMT1
           MOVE    CTRDI6200           TO   XCDAMT2
           MOVE    CTRDI6300           TO   XCDAMT3
           MOVE    CTRDI6400           TO   XCDAMT4
           MOVE    CTRDI7100           TO   XCDAMT5
           MOVE    CTRDI7200           TO   XCDAMT6
           MOVE    ZEROS               TO   XCDAMT7
           PERFORM 725-XCD-WRITE       THRU 725-EXIT
           MOVE    '940'               TO   XCDPGM
           MOVE    CTRDI7400           TO   XCDAMT1
           MOVE    CTRDI7500           TO   XCDAMT2
           MOVE    ZEROS               TO   XCDAMT3
           MOVE    CTRDI7700           TO   XCDAMT4
           MOVE    ZEROS               TO   XCDAMT5
           MOVE    CTRDI7900           TO   XCDAMT6
           MOVE    CTRDI8100           TO   XCDAMT7
           PERFORM 725-XCD-WRITE       THRU 725-EXIT.
041706     MOVE    '945'               TO   XCDPGM
041706     MOVE    CTRDI8200           TO   XCDAMT1
041706     MOVE    CTRDI6500           TO   XCDAMT2
041706     MOVE    ZEROS               TO   XCDAMT3
041706     MOVE    ZEROS               TO   XCDAMT4
041706     MOVE    ZEROS               TO   XCDAMT5
041706     MOVE    ZEROS               TO   XCDAMT6
041706     MOVE    ZEROS               TO   XCDAMT7
041706     PERFORM 725-XCD-WRITE       THRU 725-EXIT.
       710-XRD.
083095     IF      OLDRPT              NOT  =  'B'
083095       ADD   +1                  TO   CTRXCD
083095       GO                        TO   710-EXIT.
083095     INITIALIZE  XRD
083095     MOVE    OLDKDIST            TO   XRDDIST
083095     MOVE    OLDKFUND            TO   XRDRTYPE
083095     MOVE    CTRRECR             TO   XRDAMT1
083095     MOVE    CTROTHR             TO   XRDAMT2
083095     MOVE    CTRCAP              TO   XRDAMT3
083095     MOVE    CTRCOMSRV           TO   XRDAMT4
083095     MOVE    CTRDEBT             TO   XRDAMT5
083095     MOVE    CTRFEDIND           TO   XRDAMT7
041499     MOVE    CTRCHRTR            TO   XRDAMT11
083095     MOVE    CTRTOT              TO   XRDAMT8
083095     MOVE    CTRAFR              TO   XRDAMT9
083095     MOVE    CTRCOMP             TO   XRDAMT10
041397     MOVE    'R'                 TO   XRDRECON
083095     MOVE    XRD                 TO   XCDD
083095     WRITE   XCDD
083095     IF      RETXCD              NOT  =  '00'
083095       MOVE  'RECON WRITE ERR'   TO   LNMMSG
083095       MOVE   RETXCD             TO   LNMVALUE1
083095       MOVE  XCDD                TO   LNMVALUE2
083095       PERFORM 520-PRINT         THRU 520-EXIT
083095     ELSE
083095       ADD   +1                  TO   CTRXCD.
       710-EXIT.
           EXIT.

       715-TBL-READ.
           SEARCH  ALL  PGMENTRY
             AT  END
               MOVE     ZEROS          TO   XCDSTF
             WHEN    PGMPGM  (PGM1)    =    XCDPGM
               MOVE  PGMSTF  (PGM1)    TO   XCDSTF.
       715-EXIT.
           EXIT.

       720-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              NOT  =  '00'
             MOVE  ZEROS               TO   XCDSTF
           ELSE
             MOVE  ABFD                TO   ABF
             MOVE  ABFSTAFF            TO   XCDSTF.
       720-EXIT.
           EXIT.

       725-XCD-WRITE.
           MOVE    XCD                 TO   XCDD
           WRITE   XCDD
           IF      RETXCD              NOT  =  '00'
             MOVE  'XCD WRITE ERR'     TO   LNMMSG
             MOVE  RETXCD              TO   LNMVALUE1
             MOVE  XCDD                TO   LNMVALUE2
             PERFORM 520-PRINT         THRU 520-EXIT
           ELSE
             ADD   +1                  TO   CTRXCD.
       725-EXIT.
           EXIT.

050399 730-CHRTR-HDR.
050399     MOVE    '0'                 TO   CTLCHAR
050399     MOVE    HD16                TO   LN1
050399     PERFORM 520-PRINT           THRU 520-EXIT
050399     MOVE    CTR4AMT1            TO   HD17AMT1
050399     MOVE    CTR4AMT2            TO   HD17AMT2
050399     MOVE    CTR4AMT3            TO   HD17AMT3
050399     MOVE    CTR4AMT4            TO   HD17AMT4
050399     MOVE    HD17                TO   LN1
050399     PERFORM 520-PRINT           THRU 520-EXIT
050399     MOVE    CTR4AMT5            TO   HD18AMT1
050399     MOVE    CTR4AMT6            TO   HD18AMT2
050399     MOVE    CTR4AMT7            TO   HD18AMT3
050399     MOVE    CTR4AMT8            TO   HD18AMT4
050399     MOVE    HD18                TO   LN1
050399     PERFORM 520-PRINT           THRU 520-EXIT
050399     MOVE    CTR4AMT9            TO   HD19AMT1
050399     MOVE    CTR4AMT10           TO   HD19AMT2
050399     MOVE    CTR4AMT11           TO   HD19AMT3
050399     MOVE    CTR4AMT12           TO   HD19AMT4
050399     MOVE    HD19                TO   LN1
050399     PERFORM 520-PRINT           THRU 520-EXIT
050399     MOVE    CTR4AMT13           TO   HD20AMT1
050399     MOVE    CTR4AMT14           TO   HD20AMT2
041706     MOVE    CTR4AMT15           TO   HD20AMT3
041706     MOVE    CTR4AMT16           TO   HD20AMT4
050399     MOVE    HD20                TO   LN1
050399     PERFORM 520-PRINT           THRU 520-EXIT
050399     MOVE    'Y'                 TO   WSCFLG4XXX.
050399 730-EXIT.
050399     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  'EW030 NO DATA TO PROCESS'  TO  LNM
             PERFORM 520-PRINT         THRU 520-EXIT
             GO                        TO   999-EOJ.
           PERFORM 650-5CHG            THRU 650-EXIT.
       990-EXIT.
           EXIT.

      ******************************************************************
       999-EOJ.
           CLOSE                       CRD-CARD      CRF-DISK
                                       PR1-PRNT      RWF-DISK
           IF      OLDRPT              =  'B'
             CLOSE                     XCD-DISK      ABF-DISK.
       999-EXIT.
           EXIT.
