       IDENTIFICATION   DIVISION.
       PROGRAM-ID.      EW028.
       AUTHOR.          DOE.
      *****************************************************************
      *                       COST TABLE REPORT                       *
      *****************************************************************
      * DATE CREATED:   06/21/95                                      *
      *****************************************************************
      * CALL #  - MMDDYY - PURPOSE                                    *
      * 9511011 - 112295 - REPLACE GOBACK WITH STOP RUN.              *
      * 9512059 - 121595 - MOVE DISTRICT TO TBLKEY, NOT TBLDIST.      *
      * 2006001 - 080106 - ADD NEW FUNCTIONS 8200 & 6500              *
      * 2009001 - 050409 - ALLOW FUNDS 5,6,7 FOR AARA MONEY           *
      * 2010001 - 110109 - FIX ROUNDING TRUNCATION PROBLEM            *
      * 2010002 - 042810 - CORRECT CHARTER SCHOOL PROGRAM INDIRECT    *
      *                    PROBLEM WITH PRINTING "SCHL IND" BY PROGRAM*
      *****************************************************************


       ENVIRONMENT DIVISION.

       INPUT-OUTPUT SECTION.
       FILE-CONTROL.

MVS        SELECT    CRD-CARD          ASSIGN    UT-S-CARDIN.               0021
                                                                               0
MVS        SELECT    SRT-SORT          ASSIGN    DA-SORTWK.

MVS        SELECT    PR1-PRNT          ASSIGN    UT-S-PRTOT1.

MVS        SELECT    CRF-DISK          ASSIGN       DA-EWCRF
                                       ORGANIZATION INDEXED
                                       ACCESS       RANDOM
                                       RECORD KEY   CRFDK
                                       FILE STATUS  RETCRF.

MVS        SELECT    RWF-DISK          ASSIGN       DA-EWRWF
                                       ORGANIZATION INDEXED
                                       ACCESS       SEQUENTIAL
                                       RECORD KEY   RWFDK
                                       FILE STATUS  RETRWF.

MVS        SELECT    XST-DISK          ASSIGN       DA-EWXST
                                       ORGANIZATION SEQUENTIAL
                                       ACCESS       SEQUENTIAL
                                       FILE STATUS  RETXST.

       DATA DIVISION.
       FILE SECTION.

       FD  CRD-CARD
           RECORDING MODE       IS  F                                       0033
           RECORD    CONTAINS   80  CHARACTERS
MVS        BLOCK     CONTAINS    0  RECORDS                                 0034
           LABEL     RECORDS   ARE  OMITTED
           DATA      RECORDS   ARE  CRD  CRH.

       01            CRD.
001        05        CRDREQ            PIC  X(03).
004        05        FILLER            PIC  X(01).
005        05        CRDID             PIC  X(02).
007        05        FILLER            PIC  X(01).
008        05        CRDPRT            PIC  X(01).
009        05        FILLER            PIC  X(03).
012        05        CRDDIST           PIC  X(02).
014        05        FILLER            PIC  X(02).
016        05        CRDFY             PIC  X(02).
018        05        FILLER            PIC  X(01).
019        05        CRDFUND           PIC  X(01).
020        05        FILLER            PIC  X(01).
021        05        CRDTBLE           PIC  X(05).
026        05        FILLER            PIC  X(01).
027        05        CRDSCHL           PIC  X(04).
031        05        FILLER            PIC  X(01).
032        05        CRDSUM            PIC  X(01).
033        05        FILLER            PIC  X(01).
034        05        CRDRPT            PIC  X(01).
035        05        CRDPGM            PIC  X(05).
040        05        FILLER            PIC  X(41).

       01            CRH.
001        05        CRHREQ            PIC  X(03).
004        05        FILLER            PIC  X(01).
005        05        CRHID             PIC  X(02).
007        05        FILLER            PIC  X(01).
008        05        CRHUSER           PIC  X(08).
016        05        FILLER            PIC  X(01).
           05        CRHHEAD.
017          10      CRHB       OCCURS 050  TIMES  INDEXED BY CRH1
                                       PIC  X(01).
067        05        FILLER            PIC  X(14).

       FD  PR1-PRNT
           RECORDING MODE       IS  F                                       0044
           RECORD    CONTAINS  133  CHARACTERS
MVS        BLOCK     CONTAINS    0  RECORDS
           LABEL     RECORDS   ARE  OMITTED
           DATA      RECORDS   ARE  LNM  LN1  LN2  LN3.

       01  LNM.
001        05        FILLER            PIC  X(01).
002        05        LNMMSG            PIC  X(20).
022        05        FILLER            PIC  X(02).
024        05        LNMVALUE1         PIC  X(02).
026        05        FILLER            PIC  X(01).
027        05        LNMVALUE2         PIC  X(80).
107        05        FILLER            PIC  X(27).

       01            LN1.
VSE        05        FILLER            PIC  X(01).
002        05        FILLER            PIC  X(41).
043        05        LN1FUNC           PIC  X(04).
047        05        FILLER            PIC  X(01).
048        05        LN1NAME           PIC  X(30).
110109*    05        FILLER            PIC  X(01).
110109*    05        LN1AMT1           PIC  ZZZ,ZZZ,ZZZ-.
110109*    05        FILLER            PIC  X(02).
110109*    05        LN1AMT2           PIC  ZZZ,ZZZ,ZZZ-.
110109     05        LN1AMT1           PIC ZZZZ,ZZZ,ZZZ-.
110109     05        FILLER            PIC  X(01).
110109     05        LN1AMT2           PIC ZZZZ,ZZZ,ZZZ-.
104        05        FILLER            PIC  X(29).

       01            LN2.
VSE        05        FILLER            PIC  X(01).
002        05        FILLER            PIC  X(59).
061        05        LN2MSG1           PIC  X(05).
066        05        LN2FLD            PIC  X(04).
070        05        LN2MSG2           PIC  X(20).
090        05        LN2AMT            PIC  ZZ,ZZZ,ZZZ,ZZZ-.
105        05        FILLER            PIC  X(29).

       01            LN3.
VSE        05        FILLER            PIC  X(01).
002        05        LN3MSG1           PIC  X(08).
010        05        LN3REQ            PIC  X(03).
013        05        LN3MSG2           PIC  X(07).
020        05        LN3AMT            PIC  ZZZ,ZZ9.
027        05        LN3MSG3           PIC  X(20).
047        05        FILLER            PIC  X(87).

           COPY                        EWCRFD.
           COPY                        EWRWFD.
           COPY                        EWXSTD.

       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      SRTKTBLE          PIC  X(05).
             10      SRTKSCHL          PIC  X(04).
           05        SRTDATA.
             10      SRTAMT.
110109*        15    SRTAMT1           PIC  S9(09).
110109*        15    SRTAMT2           PIC  S9(09).
110109*        15    SRTAMT3           PIC  S9(09).
110109*        15    SRTAMT4           PIC  S9(09).
110109*        15    SRTAMT5           PIC  S9(09).
110109*        15    SRTAMT6           PIC  S9(09).
110109*        15    SRTAMT7           PIC  S9(09).
110109*        15    SRTAMT8           PIC  S9(09).
110109*        15    SRTAMT9           PIC  S9(09).
110109*        15    SRTAMT10          PIC  S9(09).
110109*        15    SRTAMT11          PIC  S9(09).
110109*        15    SRTAMT12          PIC  S9(09).
110109*        15    SRTAMT13          PIC  S9(09).
110109*        15    SRTAMT14          PIC  S9(09).
110109*        15    SRTAMT15          PIC  S9(09).
110109*        15    SRTAMT16          PIC  S9(09).
110109*        15    SRTAMT17          PIC  S9(09).
110109*        15    SRTAMT18          PIC  S9(09).
110109*        15    SRTAMT19          PIC  S9(09).
110109*        15    SRTAMT20          PIC  S9(09).
110109         15    SRTAMT1           PIC  S9(10)V9(7).
110109         15    SRTAMT2           PIC  S9(10)V9(7).
110109         15    SRTAMT3           PIC  S9(10)V9(7).
110109         15    SRTAMT4           PIC  S9(10)V9(7).
110109         15    SRTAMT5           PIC  S9(10)V9(7).
110109         15    SRTAMT6           PIC  S9(10)V9(7).
110109         15    SRTAMT7           PIC  S9(10)V9(7).
110109         15    SRTAMT8           PIC  S9(10)V9(7).
110109         15    SRTAMT9           PIC  S9(10)V9(7).
110109         15    SRTAMT10          PIC  S9(10)V9(7).
110109         15    SRTAMT11          PIC  S9(10)V9(7).
110109         15    SRTAMT12          PIC  S9(10)V9(7).
110109         15    SRTAMT13          PIC  S9(10)V9(7).
110109         15    SRTAMT14          PIC  S9(10)V9(7).
110109         15    SRTAMT15          PIC  S9(10)V9(7).
110109         15    SRTAMT16          PIC  S9(10)V9(7).
110109         15    SRTAMT17          PIC  S9(10)V9(7).
110109         15    SRTAMT18          PIC  S9(10)V9(7).
110109         15    SRTAMT19          PIC  S9(10)V9(7).
110109         15    SRTAMT20          PIC  S9(10)V9(7).
110109         15    SRTAMT21          PIC  S9(10)V9(7).
110109         15    SRTAMT22          PIC  S9(10)V9(7).
             10      SRTPRT            PIC  X(01).
             10      SRTRPT            PIC  X(01).

       WORKING-STORAGE SECTION.

       01            WSC.
           05        WSCLAST           PIC  X(01) VALUE 'N'.
           05        WSCAMT.
110109*      10      WSC5100           PIC S9(09) VALUE ZEROS.
110109*      10      WSC5200           PIC S9(09) VALUE ZEROS.
110109*      10      WSC5300           PIC S9(09) VALUE ZEROS.
110109*      10      WSC5500           PIC S9(09) VALUE ZEROS.
110109*      10      WSC5600           PIC S9(09) VALUE ZEROS.
110109*      10      WSC5700           PIC S9(09) VALUE ZEROS.
110109*      10      WSC6100           PIC S9(09) VALUE ZEROS.
110109*      10      WSC6200           PIC S9(09) VALUE ZEROS.
110109*      10      WSC6300           PIC S9(09) VALUE ZEROS.
110109*      10      WSC6400           PIC S9(09) VALUE ZEROS.
110109*      10      WSC7100           PIC S9(09) VALUE ZEROS.
110109*      10      WSC7200           PIC S9(09) VALUE ZEROS.
110109*      10      WSC7300           PIC S9(09) VALUE ZEROS.
110109*      10      WSC7400           PIC S9(09) VALUE ZEROS.
110109*      10      WSC7500           PIC S9(09) VALUE ZEROS.
110109*      10      WSC7600           PIC S9(09) VALUE ZEROS.
110109*      10      WSC7700           PIC S9(09) VALUE ZEROS.
110109*      10      WSC7800           PIC S9(09) VALUE ZEROS.
110109*      10      WSC7900           PIC S9(09) VALUE ZEROS.
110109*      10      WSC8100           PIC S9(09) VALUE ZEROS.
110109       10      WSC5100           PIC S9(10)V9(7) VALUE ZEROS.
110109       10      WSC5200           PIC S9(10)V9(7) VALUE ZEROS.
110109       10      WSC5300           PIC S9(10)V9(7) VALUE ZEROS.
110109       10      WSC5500           PIC S9(10)V9(7) VALUE ZEROS.
110109       10      WSC5600           PIC S9(10)V9(7) VALUE ZEROS.
110109       10      WSC5700           PIC S9(10)V9(7) VALUE ZEROS.
110109       10      WSC6100           PIC S9(10)V9(7) VALUE ZEROS.
110109       10      WSC6200           PIC S9(10)V9(7) VALUE ZEROS.
110109       10      WSC6300           PIC S9(10)V9(7) VALUE ZEROS.
110109       10      WSC6400           PIC S9(10)V9(7) VALUE ZEROS.
110109       10      WSC7100           PIC S9(10)V9(7) VALUE ZEROS.
110109       10      WSC7200           PIC S9(10)V9(7) VALUE ZEROS.
110109       10      WSC7300           PIC S9(10)V9(7) VALUE ZEROS.
110109       10      WSC7400           PIC S9(10)V9(7) VALUE ZEROS.
110109       10      WSC7500           PIC S9(10)V9(7) VALUE ZEROS.
110109       10      WSC7600           PIC S9(10)V9(7) VALUE ZEROS.
110109       10      WSC7700           PIC S9(10)V9(7) VALUE ZEROS.
110109       10      WSC7800           PIC S9(10)V9(7) VALUE ZEROS.
110109       10      WSC7900           PIC S9(10)V9(7) VALUE ZEROS.
110109       10      WSC8100           PIC S9(10)V9(7) VALUE ZEROS.
110109       10      WSC8200           PIC S9(10)V9(7) VALUE ZEROS.
110109       10      WSC6500           PIC S9(10)V9(7) VALUE ZEROS.

       01            RET.
           05        RETCRF            PIC  X(02) VALUE '00'.
           05        RETRWF            PIC  X(02) VALUE '00'.
           05        RETXST            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(02).
             10      ERRFY             PIC  X(02).
             10      FILLER            PIC  X(01).
             10      ERRFUND           PIC  X(01).
             10      FILLER            PIC  X(01).
             10      ERRTBLE           PIC  X(05).
             10      FILLER            PIC  X(01).
             10      ERRSCHL           PIC  X(04).
             10      FILLER            PIC  X(01).
             10      ERRSUM            PIC  X(01).
             10      FILLER            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      RQRTBLE           PIC  X(05).
             10      RQRSCHL           PIC  X(04).
           05        RQRSELR    REDEFINES   RQRSEL.
             10      RQRB       OCCURS 010  TIMES INDEXED BY RQR1
                                       PIC  X(01).
           05        RQRSUM            PIC  X(01).
           05        RQRRPT            PIC  X(01).

       01            SEL.
           05        SELFUND           PIC  X(01).
           05        SELTBLE           PIC  X(05).
           05        SELSCHL           PIC  X(04).
       01            SELR       REDEFINES   SEL.
           05        SELB       OCCURS 010  TIMES INDEXED BY SEL1
                                       PIC  X(01).

       01            RQH.
           05        RQHENTRY   OCCURS 100  TIMES INDEXED BY RQH1.
             10      RQHREQ            PIC  X(03).
             10      RQHID             PIC  X(02).
             10      RQHUSER           PIC  X(08).
             10      RQHHEAD.
               15    RQHB       OCCURS 050  TIMES INDEXED BY RQH2
                                       PIC  X(01).

       01            STRKEY.
           05        STRDIST           PIC  X(02) VALUE HIGH-VALUES.
           05        STRFY             PIC  X(02) VALUE HIGH-VALUES.
           05        STRFUND           PIC  X(01) VALUE HIGH-VALUES.
           05        STRTBLE           PIC  X(05) VALUE HIGH-VALUES.
           05        STRSCHL           PIC  X(04) VALUE HIGH-VALUES.
           05        FILLER            PIC  X(03) 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        ENDTBLE           PIC  X(05) VALUE LOW-VALUES.
           05        ENDSCHL           PIC  X(04) VALUE LOW-VALUES.
           05        FILLER            PIC  X(03) 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.
110109*    05        CTRAMT            PIC S9(09)      COMP-3 VALUE +0.
110109*    05        CTRSCHL           PIC S9(09)      COMP-3 VALUE +0.
110109*    05        CTRFUND           PIC S9(13)      COMP-3 VALUE +0.
110109     05        CTRAMT            PIC S9(10)V9(07) COMP-3 VALUE +0.
110109     05        CTRSCHL           PIC S9(10)V9(07) COMP-3 VALUE +0.
110109     05        CTRFUND           PIC S9(10)V9(07) COMP-3 VALUE +0.
           05        CTRREQ            PIC S9(07)      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      OLDKTBLE          PIC  X(05).
             10      OLDKSCHL          PIC  X(04).
             10      OLDKFUNC          PIC  X(04).
           05        OLDPRT            PIC  X(01).
           05        OLDRPT            PIC  X(01).
           05        OLDNAME           PIC  X(30).


           COPY                        EWSCL.
           COPY                        EWTBL.
           COPY                        EWRWF.
           COPY                        EWXST.

       01            OLDLN             PIC  X(133).

       01      HD1.
VSE        05  FILLER  PIC X(01) VALUE ' '.
002        05  FILLER  PIC X(06) VALUE 'EW028 '.
           05  HD1ABBR.
008         10 HD1B    OCCURS 22 TIMES INDEXED BY HD11 PIC X(01).
030        05  FILLER  PIC X(11) VALUE SPACES.
041        05  HD1MODE PIC X(08) VALUE SPACES.
049        05  FILLER  PIC X(10) VALUE SPACES.
059        05  FILLER  PIC X(18) VALUE 'COST TABLE REPORT '.
077        05  FILLER  PIC X(22) VALUE SPACES.
099        05  HD1USER PIC X(09) VALUE SPACES.
108        05  HD1MM   PIC X(02) VALUE SPACES.
110        05  FILLER  PIC X(01) VALUE '/'.
111        05  HD1DD   PIC X(02) VALUE SPACES.
113        05  FILLER  PIC X(01) VALUE '/'.
114        05  HD1YY   PIC X(02) VALUE SPACES.
116        05  FILLER  PIC X(02) VALUE SPACES.
118        05  HD1HR   PIC X(02) VALUE SPACES.
120        05  FILLER  PIC X(01) VALUE ':'.
121        05  HD1MN   PIC X(02) VALUE SPACES.
123        05  FILLER  PIC X(07) VALUE '  PAGE-'.
130        05  HD1PG   PIC ZZZ9.

       01      HD2.
VSE        05  FILLER  PIC X(01) VALUE ' '.
002        05  FILLER  PIC X(41) VALUE SPACES.
           05  HD2HEAD.
043         10 HD2B    OCCURS 50 TIMES INDEXED BY HD21 PIC X(01).
093        05  FILLER  PIC X(41) VALUE SPACES.

       01      HD3.
VSE        05  FILLER  PIC X(01) VALUE ' '.
002        05  FILLER  PIC X(41) VALUE SPACES.
           05  HD3HEAD.
043         10 HD3B    OCCURS 50 TIMES INDEXED BY HD31 PIC X(01).
093        05  FILLER  PIC X(41) VALUE SPACES.

       01      HD4.
VSE        05  FILLER  PIC X(01) VALUE ' '.
002        05  FILLER  PIC X(07) VALUE 'FUND - '.
009        05  HD4FND  PIC X(01) VALUE SPACES.
010        05  FILLER  PIC X(124) VALUE SPACES.

       01      HD5.
VSE        05  FILLER  PIC X(01) VALUE ' '.
002        05  FILLER  PIC X(07) VALUE 'TABLE- '.
009        05  HD5TBL  PIC X(05) VALUE SPACES.
014        05  FILLER  PIC X(01) VALUE SPACES.
015        05  HD5DESC PIC X(30) VALUE SPACES.
045        05  FILLER  PIC X(89) VALUE SPACES.

       01      HD6.
VSE        05  FILLER  PIC X(01) VALUE ' '.
002        05  FILLER  PIC X(07) VALUE 'SCHL-  '.
009        05  HD6SCHL PIC X(04) VALUE SPACES.
014        05  FILLER  PIC X(02) VALUE SPACES.
015        05  HD6DESC PIC X(30) VALUE SPACES.
045        05  FILLER  PIC X(89) VALUE SPACES.

       01      HD7.
VSE        05  FILLER  PIC X(01) VALUE ' '.
002        05  FILLER  PIC X(41) VALUE SPACES.
043        05  FILLER  PIC X(08) VALUE 'FUNCTION'.
051        05  FILLER  PIC X(47) VALUE SPACES.
098        05  FILLER  PIC X(06) VALUE 'AMOUNT'.
104        05  FILLER  PIC X(30) VALUE SPACES.

       01      HD8.
VSE        05  FILLER  PIC X(01) VALUE ' '.
002        05  FILLER  PIC X(41) VALUE SPACES.
043        05  FILLER  PIC X(17) VALUE '5000 INSTRUCTION:'.
060        05  FILLER  PIC X(74) VALUE SPACES.

       PROCEDURE DIVISION.
      ******************************************************************
           SORT    SRT-SORT            ASCENDING KEY       SRTKEY
                                       INPUT     PROCEDURE 000-INPUT
                                       OUTPUT    PROCEDURE 500-OUTPUT.
112295*    GOBACK.
112295     STOP                        RUN.

      ******************************************************************
       000-INPUT SECTION.
           PERFORM 490-HOUSEKEEPING    THRU 490-EXIT.

       005-LOOP.
           IF      RETRWF              NOT  =  '00'
             GO                        TO   499-EOJ.
           PERFORM 015-SELECT          THRU 015-EXIT
           PERFORM 010-READ            THRU 010-EXIT
           GO                          TO   005-LOOP.

      ******************************************************************
       010-READ.
           READ    RWF-DISK            NEXT
           IF     (RWFDK               >    ENDKEY)                  OR
                  (RETRWF              NOT  =   '00')
             MOVE  '99'                TO   RETRWF
           ELSE
             MOVE  RWFD                TO   RWF.
       010-EXIT.
           EXIT.

      ******************************************************************
       015-SELECT.
           IF     (RQRREQ              =    HIGH-VALUES)
             GO                        TO   015-EXIT.

           MOVE    RWFFUND             TO   SELFUND
           MOVE    RWFTABLE            TO   SELTBLE
           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)          OR
                  (RWFTABLE            =    '99999'       AND
                   RWFSCHL             =    '0000')
             GO                        TO   015-EXIT.

           MOVE    SPACES              TO   SRTKEY
           MOVE    ZEROS               TO   SRTAMT
           MOVE    SPACES              TO   SRTRPT
           MOVE    RQRDIST             TO   SRTKDIST
           MOVE    RQRREQ              TO   SRTKREQ
           MOVE    RWFFY               TO   SRTKFY
           MOVE    RWFFUND             TO   SRTKFUND
           MOVE    RWFTABLE            TO   SRTKTBLE
           MOVE    RWFSCHL             TO   SRTKSCHL
           MOVE    RQRPRT              TO   SRTPRT
           MOVE    RQRRPT              TO   SRTRPT
           MOVE    RWFDSAL             TO   SRTAMT1
           MOVE    RWFDBEN             TO   SRTAMT2
           MOVE    RWFDPRCH            TO   SRTAMT3
           MOVE    RWFDMATSUP          TO   SRTAMT4
           MOVE    RWFDOTHER           TO   SRTAMT5
           MOVE    RWFDCAP             TO   SRTAMT6
042810     IF      RWFTABLE            NOT  =  '99998'
             ADD   RWFSI6100           TO   SRTAMT7
042810     END-IF
           ADD     RWFSI6200           TO   SRTAMT8
           ADD     RWFSI6300           TO   SRTAMT9
           ADD     RWFSI6400           TO   SRTAMT10
           ADD     RWFSI7300           TO   SRTAMT13
           ADD     RWFSI7400           TO   SRTAMT14
           ADD     RWFSI7600           TO   SRTAMT16
           ADD     RWFSI7700           TO   SRTAMT17
           ADD     RWFSI7800           TO   SRTAMT18
           ADD     RWFSI7900           TO   SRTAMT19
           ADD     RWFSI8100           TO   SRTAMT20
080106     ADD     RWFSI8200           TO   SRTAMT21
080106     ADD     RWFSI6500           TO   SRTAMT22
           ADD     RWFDI6100           TO   SRTAMT7
           ADD     RWFDI6200           TO   SRTAMT8
           ADD     RWFDI6300           TO   SRTAMT9
           ADD     RWFDI6400           TO   SRTAMT10
           ADD     RWFDI7100           TO   SRTAMT11
           ADD     RWFDI7200           TO   SRTAMT12
           ADD     RWFDI7400           TO   SRTAMT14
           ADD     RWFDI7500           TO   SRTAMT15
           ADD     RWFDI7600           TO   SRTAMT16
           ADD     RWFDI7700           TO   SRTAMT17
           ADD     RWFDI7800           TO   SRTAMT18
           ADD     RWFDI7900           TO   SRTAMT19
           ADD     RWFDI8100           TO   SRTAMT20
080106     ADD     RWFDI8200           TO   SRTAMT21
080106     ADD     RWFDI6500           TO   SRTAMT22

           RELEASE  SRT
           MOVE    '0000'              TO   SRTKSCHL
           RELEASE  SRT.
       015-EXIT.
           EXIT.

      ******************************************************************
       490-HOUSEKEEPING.
           OPEN    INPUT                    CRD-CARD      CRF-DISK
                                            RWF-DISK
                   OUTPUT                   PR1-PRNT
           MOVE    SPACES              TO   LN1
           MOVE    '1'                 TO   CTLCHAR
           MOVE    HIGH-VALUES         TO   RQR           RQH.
           SET     RQH1                TO   +1.
       490-LOAD.
           READ    CRD-CARD            AT   END
             GO                        TO   490-TEST.
           IF      CRDREQ              NOT  NUMERIC
             MOVE    CRD               TO   LNMVALUE2
             PERFORM 520-PRINT         THRU 520-EXIT
             GO                        TO   490-LOAD.
           MOVE    SPACES              TO   ERR
           IF      CRDID               =    'SL'
             GO                        TO   490-REQ
           ELSE
             IF     (CRDID             =    'H1')                    OR
                    (CRDID             =    'H2')
               GO                      TO   490-HEAD
             ELSE
               GO                      TO   490-LOAD.

       490-REQ.
           IF     (CRDPRT              NOT  =   'U')                 AND
                  (CRDPRT              NOT  =   'T')                 AND
                  (CRDPRT              NOT  =   'B')                 AND
                  (CRDPRT              NOT  =   'N')
             MOVE  ALL '-'             TO   ERRPRT.
           IF     (CRDDIST             =    SPACES)
             MOVE  ALL '-'             TO   ERRDIST.
           IF     (CRDFY               NOT  NUMERIC)
             MOVE  ALL '-'             TO   ERRFY.
           IF     (CRDRPT              NOT  =   'A')                 AND
                  (CRDRPT              NOT  =   'B')                 AND
                  (CRDRPT              NOT  =   'C')
             MOVE  ALL '-'             TO   ERRRPT.
           IF     (CRDFUND             NOT  =   '1')                 AND
                  (CRDFUND             NOT  =   '4')                 AND
050409            (CRDFUND             NOT  =   '5')                 AND
050409            (CRDFUND             NOT  =   '6')                 AND
050409            (CRDFUND             NOT  =   '7')                 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    CRDTBLE             TO   RQRTBLE
           MOVE    CRDSCHL             TO   RQRSCHL
           MOVE    CRDSUM              TO   RQRSUM
           MOVE    CRDRPT              TO   RQRRPT

           MOVE    CRDDIST             TO   RWFKEY
           MOVE    CRDFY               TO   RWFFY
           MOVE    CRDFUND             TO   RWFFUND
           MOVE    CRDTBLE             TO   RWFTABLE
           MOVE    CRDSCHL             TO   RWFSCHL
           IF     (RWFKEY              <    STRKEY)
             MOVE  RWFKEY              TO   STRKEY.
           SET     RWF1                TO   +1.
       490-SET.
           IF      RWFB     (RWF1)     =    SPACES
             MOVE  HIGH-VALUES         TO   RWFB (RWF1).
           IF      RWF1                <    +17
             SET   RWF1                UP   BY  +1
             GO                        TO   490-SET.
           IF     (RWFKEY              >    ENDKEY)
             MOVE  RWFKEY              TO   ENDKEY.
           GO                          TO   490-LOAD.
       490-HEAD.
           MOVE    CRD                 TO   LNMVALUE2
           PERFORM 520-PRINT           THRU 520-EXIT
           MOVE    CRHREQ              TO   RQHREQ       (RQH1)
           MOVE    CRHID               TO   RQHID        (RQH1)
           MOVE    CRHUSER             TO   RQHUSER      (RQH1)
           MOVE    SPACES              TO   RQHHEAD      (RQH1)
           MOVE    +50                 TO   CTRIDX
           SET     CRH1                TO   +50.
       490-HEAD1.
           IF      CRHB         (CRH1) =    SPACES
             IF      CRH1              >    +2
               ADD   -1                TO   CTRIDX
               SET   CRH1              DOWN BY  +1
               GO                      TO   490-HEAD1.
           SUBTRACT +1                 FROM CTRIDX
           COMPUTE CTRIDX      ROUNDED =    (50  - CTRIDX) / 2
           SET     RQH2                TO   CTRIDX
           SET     CRH1                TO   +1.
       490-HEAD2.
           MOVE    CRHB         (CRH1) TO   RQHB         (RQH1 RQH2)
           IF      RQH2                <    +50
             SET   RQH2  CRH1          UP   BY  +1
             GO                        TO   490-HEAD2.
           SET     RQH1             UP BY   +1
           GO                          TO   490-LOAD.

       490-TEST.
           IF      RQR                 =    HIGH-VALUES
             MOVE    'EW028 NO REQUESTS *'   TO   LNMMSG
             PERFORM 520-PRINT         THRU 520-EXIT.
           IF      RQRRPT              =    'B'
             OPEN  OUTPUT              XST-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      RETXST              NOT  =   '00'
             MOVE    'XST OPEN ERROR'  TO   LNMMSG
             MOVE    RETXST            TO   LNMVALUE1
             PERFORM 520-PRINT         THRU 520-EXIT.
           IF     (RETCRF              NOT  =   '00')                OR
                  (RETRWF              NOT  =   '00')                OR
                  (RETXST              NOT  =   '00')
             GO                        TO   499-EOJ.
           MOVE    STRKEY              TO   RWFDK
           START   RWF-DISK        KEY >    RWFDK
           IF      RETRWF              =    '00'
             PERFORM 010-READ          THRU 010-EXIT.
       490-EXIT.
           EXIT.

      ******************************************************************
       499-EOJ.
       499-EXIT.
           EXIT.

      ******************************************************************
       500-OUTPUT SECTION.
           PERFORM 990-HOUSEKEEPING    THRU 990-EXIT.
       505-LOOP.
             IF    (SRTKDIST           NOT  =   OLDKDIST)            OR
                   (SRTKREQ            NOT  =   OLDKREQ)             OR
                   (SRTKFY             NOT  =   OLDKFY)              OR
                   (SRTKFUND           NOT  =   OLDKFUND)            OR
                   (SRTKTBLE           NOT  =   OLDKTBLE)            OR
                   (SRTKSCHL           NOT  =   OLDKSCHL)
               PERFORM 615-1TOT        THRU 615-EXIT
               IF  (SRTKDIST           NOT  =   OLDKDIST)            OR
                   (SRTKREQ            NOT  =   OLDKREQ)             OR
                   (SRTKFY             NOT  =   OLDKFY)              OR
                   (SRTKFUND           NOT  =   OLDKFUND)            OR
                   (SRTKTBLE           NOT  =   OLDKTBLE)
                 PERFORM 625-2TOT      THRU 625-EXIT
                 IF  (SRTKDIST         NOT  =   OLDKDIST)            OR
                     (SRTKREQ          NOT  =   OLDKREQ)             OR
                     (SRTKFY           NOT  =   OLDKFY)              OR
                     (SRTKFUND         NOT  =   OLDKFUND)
                   PERFORM 635-3TOT    THRU 635-EXIT
                   IF  (SRTKDIST       NOT  =   OLDKDIST)          OR
                       (SRTKREQ        NOT  =   OLDKREQ)           OR
                       (SRTKFY         NOT  =   OLDKFY)
                     PERFORM 645-4TOT  THRU 645-EXIT
                     IF  (SRTKEY       =    HIGH-VALUES)
                       GO              TO   999-EOJ
                   ELSE
                     PERFORM 640-4CHG  THRU 640-EXIT
                 ELSE
                   PERFORM 630-3CHG    THRU 630-EXIT
               ELSE
                 PERFORM 620-2CHG      THRU 620-EXIT
             ELSE
               PERFORM 610-1CHG        THRU 610-EXIT.

           PERFORM 515-PROCESS         THRU 515-EXIT
           PERFORM 510-READ            THRU 510-EXIT
           GO                          TO   505-LOOP.

      ******************************************************************
       510-READ.
           RETURN  SRT-SORT            AT   END
             MOVE  HIGH-VALUES         TO   SRTKEY.
       510-EXIT.
           EXIT.

      ******************************************************************
       515-PROCESS.
           ADD      SRTAMT1            TO   WSC5100
           ADD      SRTAMT2            TO   WSC5200
           ADD      SRTAMT3            TO   WSC5300
           ADD      SRTAMT4            TO   WSC5500
           ADD      SRTAMT5            TO   WSC5600
           ADD      SRTAMT6            TO   WSC5700
           ADD      SRTAMT7            TO   WSC6100
           ADD      SRTAMT8            TO   WSC6200
           ADD      SRTAMT9            TO   WSC6300
           ADD      SRTAMT10           TO   WSC6400
           ADD      SRTAMT11           TO   WSC7100
           ADD      SRTAMT12           TO   WSC7200
           ADD      SRTAMT13           TO   WSC7300
           ADD      SRTAMT14           TO   WSC7400
           ADD      SRTAMT15           TO   WSC7500
           ADD      SRTAMT16           TO   WSC7600
           ADD      SRTAMT17           TO   WSC7700
           ADD      SRTAMT18           TO   WSC7800
           ADD      SRTAMT19           TO   WSC7900
           ADD      SRTAMT20           TO   WSC8100.
080106     ADD      SRTAMT21           TO   WSC8200.
080106     ADD      SRTAMT22           TO   WSC6500.
       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    HD6               TO   LN1
             PERFORM 520-PRINT         THRU 520-EXIT
             MOVE    '0'               TO   CTLCHAR
             MOVE    HD7               TO   LN1
             PERFORM 520-PRINT         THRU 520-EXIT
             MOVE    '0'               TO   CTLCHAR
             MOVE    HD8               TO   LN1
             PERFORM 520-PRINT         THRU 520-EXIT
           ELSE
             MOVE  'N'                 TO   WSCLAST.
           MOVE    OLDLN               TO   LN1.
       525-EXIT.
           EXIT.

      ******************************************************************
       610-1CHG.
           MOVE    SRTKSCHL            TO   OLDKSCHL  HD6SCHL
           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   HD6DESC
           ELSE
             MOVE  CRFD                TO   SCL
             MOVE  SCLDESC             TO   HD6DESC.
           MOVE    +61                 TO   CTRLN
           MOVE    ZEROS               TO   WSCAMT
           MOVE    ZEROS               TO   CTRSCHL.
       610-EXIT.
           EXIT.

       615-1TOT.
           MOVE   SPACES               TO   XST
           MOVE   ZEROS                TO   XSTAMT1       XSTAMT2
                                            XSTAMT3       XSTAMT4
                                            XSTAMT5       XSTAMT6
                                            XSTAMT7
           MOVE    'C'                 TO   XSTIND
           MOVE    OLDKDIST            TO   XSTDIST
           MOVE    OLDKFUND            TO   XSTFUND
           MOVE    OLDKTBLE            TO   XSTTABLE
           MOVE    OLDKSCHL            TO   XSTSCHL
           MOVE    '1'                 TO   XSTRTYPE
           MOVE    '  SALARIES'        TO   LN1NAME
           MOVE    WSC5100             TO   LN1AMT1   XSTAMT1
           ADD     WSC5100             TO   CTRSCHL
           PERFORM 520-PRINT           THRU 520-EXIT
           MOVE    '  EMPLOYEE BENEFITS' TO   LN1NAME
           MOVE    WSC5200             TO   LN1AMT1   XSTAMT2
           ADD     WSC5200             TO   CTRSCHL
           PERFORM 520-PRINT           THRU 520-EXIT
           MOVE    '  PURCHASED SERVICES'   TO   LN1NAME
           MOVE    WSC5300             TO   LN1AMT1   XSTAMT3
           ADD     WSC5300             TO   CTRSCHL
           PERFORM 520-PRINT           THRU 520-EXIT
           MOVE    '  MATERIALS AND SUPPLIES'   TO   LN1NAME
           MOVE    WSC5500             TO   LN1AMT1   XSTAMT4
           ADD     WSC5500             TO   CTRSCHL
           PERFORM 520-PRINT           THRU 520-EXIT
           MOVE    '  OTHER EXPENSES'  TO   LN1NAME
           MOVE    WSC5600             TO   LN1AMT1   XSTAMT5
           ADD     WSC5600             TO   CTRSCHL
           PERFORM 520-PRINT           THRU 520-EXIT
           MOVE    '  CAPITAL OUTLAY'  TO   LN1NAME
           MOVE    WSC5700             TO   LN1AMT1   XSTAMT6
           ADD     WSC5700             TO   CTRSCHL
           PERFORM 520-PRINT           THRU 520-EXIT
           IF      OLDKSCHL            NOT  =  '0000'
             IF    OLDRPT              =    'B'
               MOVE  XST               TO   XSTD
               WRITE XSTD
               IF    RETXST            NOT  = '00'
                 MOVE 'XST WRITE ERROR'  TO   LNMMSG
                 MOVE RETXST           TO   LNMVALUE1
                 MOVE XSTD             TO   LNMVALUE2
                 PERFORM 520-PRINT     THRU 520-EXIT
               ELSE
                 ADD   +1              TO   CTRREQ
             ELSE
               ADD     +1              TO   CTRREQ.
           MOVE    'SUBTOTAL INSTRUCTION'   TO   LN1NAME
           MOVE    CTRSCHL             TO   LN1AMT2
           PERFORM 520-PRINT           THRU 520-EXIT
           MOVE    '2'                 TO   XSTRTYPE
           MOVE    '6100'              TO   LN1FUNC
           MOVE    'PUPIL PERSONNEL'   TO   LN1NAME
           MOVE    WSC6100             TO   LN1AMT2       XSTAMT1
           ADD     WSC6100             TO   CTRSCHL
           PERFORM 520-PRINT           THRU 520-EXIT
           MOVE    '6200'              TO   LN1FUNC
           MOVE    'INSTRUCTIONAL MEDIA'   TO   LN1NAME
           MOVE    WSC6200             TO   LN1AMT2       XSTAMT2
           ADD     WSC6200             TO   CTRSCHL
           PERFORM 520-PRINT           THRU 520-EXIT
           MOVE    '6300'              TO   LN1FUNC
           MOVE    'INSTRUCTION AND CURRICULM DEV'   TO   LN1NAME
           MOVE    WSC6300             TO   LN1AMT2       XSTAMT3
           ADD     WSC6300             TO   CTRSCHL
           PERFORM 520-PRINT           THRU 520-EXIT
           MOVE    '6400'              TO   LN1FUNC
           MOVE    'INSTRUCTIONAL STAFF TRAINING'    TO   LN1NAME
           MOVE    WSC6400             TO   LN1AMT2       XSTAMT4
           ADD     WSC6400             TO   CTRSCHL
           PERFORM 520-PRINT           THRU 520-EXIT
080106     MOVE    '6500'              TO   LN1FUNC
080106     MOVE    'INSTRUCT TECHNOLOGY '   TO   LN1NAME
080106     MOVE    WSC6500             TO   LN1AMT2    XSTAMT7
080106     ADD     WSC6500             TO   CTRSCHL
080106     PERFORM 520-PRINT           THRU 520-EXIT
           MOVE    '7100'              TO   LN1FUNC
           MOVE    'BOARD'             TO   LN1NAME
           MOVE    WSC7100             TO   LN1AMT2       XSTAMT5
           ADD     WSC7100             TO   CTRSCHL
           PERFORM 520-PRINT           THRU 520-EXIT
           MOVE    '7200'              TO   LN1FUNC
           MOVE    'GENERAL ADMINISTRATION'   TO   LN1NAME
           MOVE    WSC7200             TO   LN1AMT2       XSTAMT6
           ADD     WSC7200             TO   CTRSCHL
           PERFORM 520-PRINT           THRU 520-EXIT
           MOVE    '7300'              TO   LN1FUNC
           MOVE    'SCHOOL ADMINISTRATION'  TO   LN1NAME
           MOVE    WSC7300             TO   LN1AMT2       XSTAMT7
           ADD     WSC7300             TO   CTRSCHL
           PERFORM 520-PRINT           THRU 520-EXIT
           IF      OLDKSCHL            NOT  =  '0000'
             IF    OLDRPT              =    'B'
               MOVE  XST               TO   XSTD
               WRITE XSTD
               IF    RETXST            NOT  = '00'
                 MOVE 'XST WRITE ERROR'  TO   LNMMSG
                 MOVE RETXST           TO   LNMVALUE1
                 MOVE XSTD             TO   LNMVALUE2
                 PERFORM 520-PRINT     THRU 520-EXIT
               ELSE
                 ADD   +1              TO   CTRREQ
             ELSE
               ADD     +1              TO   CTRREQ.
           MOVE    '3'                 TO   XSTRTYPE
           MOVE    '7400'              TO   LN1FUNC
           MOVE    'FACILITIES ACQ. AND CONSTR.'    TO   LN1NAME
           MOVE    WSC7400             TO   LN1AMT2    XSTAMT1
           ADD     WSC7400             TO   CTRSCHL
           PERFORM 520-PRINT           THRU 520-EXIT
           MOVE    '7500'              TO   LN1FUNC
           MOVE    'FISCAL SERVICES'   TO   LN1NAME
           MOVE    WSC7500             TO   LN1AMT2    XSTAMT2
           ADD     WSC7500             TO   CTRSCHL
           PERFORM 520-PRINT           THRU 520-EXIT
           MOVE    '7600'              TO   LN1FUNC
           MOVE    'FOOD SERVICES'     TO   LN1NAME
           MOVE    WSC7600             TO   LN1AMT2    XSTAMT3
           ADD     WSC7600             TO   CTRSCHL
           PERFORM 520-PRINT           THRU 520-EXIT
           MOVE    '7700'              TO   LN1FUNC
           MOVE    'CENTRAL SERVICES'  TO   LN1NAME
           MOVE    WSC7700             TO   LN1AMT2    XSTAMT4
           ADD     WSC7700             TO   CTRSCHL
           PERFORM 520-PRINT           THRU 520-EXIT
           MOVE    '7800'              TO   LN1FUNC
           MOVE    'PUPIL TRANSPORTATION'   TO   LN1NAME
           MOVE    WSC7800             TO   LN1AMT2    XSTAMT5
           ADD     WSC7800             TO   CTRSCHL
           PERFORM 520-PRINT           THRU 520-EXIT
           MOVE    '7900'              TO   LN1FUNC
           MOVE    'OPERATION OF PLANT' TO   LN1NAME
           MOVE    WSC7900             TO   LN1AMT2    XSTAMT6
           ADD     WSC7900             TO   CTRSCHL
           PERFORM 520-PRINT           THRU 520-EXIT
           MOVE    '8100'              TO   LN1FUNC
           MOVE    'MAINTENANCE OF PLANT'   TO   LN1NAME
           MOVE    WSC8100             TO   LN1AMT2    XSTAMT7
           ADD     WSC8100             TO   CTRSCHL
           PERFORM 520-PRINT           THRU 520-EXIT
080106     MOVE    '8200'              TO   LN1FUNC
080106     MOVE    'ADMIN TECHNOLOGY SRV'   TO   LN1NAME
080106     MOVE    WSC8200             TO   LN1AMT2    XSTAMT7
080106     ADD     WSC8200             TO   CTRSCHL
080106     PERFORM 520-PRINT           THRU 520-EXIT
           IF      OLDKSCHL            NOT  =  '0000'
             IF    OLDRPT              =    'B'
               MOVE  XST               TO   XSTD
               WRITE XSTD
               IF    RETXST            NOT  = '00'
                 MOVE 'XST WRITE ERROR'  TO   LNMMSG
                 MOVE RETXST           TO   LNMVALUE1
                 MOVE XSTD             TO   LNMVALUE2
                 PERFORM 520-PRINT     THRU 520-EXIT
               ELSE
                 ADD   +1              TO   CTRREQ
             ELSE
               ADD     +1              TO   CTRREQ.
           MOVE    'SCHL  '            TO   LN2MSG1
           MOVE    OLDKSCHL            TO   LN2FLD
           MOVE    ' TOTAL EXPENDITURES '   TO  LN2MSG2
           MOVE    CTRSCHL             TO   LN2AMT
           MOVE    '0'                 TO   CTLCHAR
           PERFORM 520-PRINT           THRU 520-EXIT
           MOVE    '0'                 TO   CTLCHAR
           IF      OLDKSCHL            =    '0000'
             ADD   CTRSCHL             TO   CTRFUND.
       615-EXIT.
           EXIT.

       620-2CHG.
           MOVE    SRTKTBLE            TO   OLDKTBLE  HD5TBL
121595*    MOVE    SRTKDIST            TO   TBLDIST
121595     MOVE    SRTKDIST            TO   TBLKEY
           MOVE    SRTKFY              TO   TBLFY
           MOVE    'TBL'               TO   TBLPREF
           MOVE    SRTKTBLE            TO   TBLTBL
           MOVE    TBLKEY              TO   CRFDK
           READ    CRF-DISK
           IF      RETCRF              NOT  =  '00'
             MOVE  'UNKNOWN'           TO   TBLDESC
           ELSE
             MOVE  CRFD                TO   TBL.
           MOVE    TBLDESC             TO   HD5DESC   OLDNAME
           PERFORM 610-1CHG            THRU 610-EXIT.
       620-EXIT.
           EXIT.

       625-2TOT.
           IF      OLDKSCHL            =  '0000'
             GO                        TO  625-EXIT.
           IF      OLDRPT              =  'B'
             MOVE   SPACES             TO   XST
             MOVE   'CT17'             TO   XSTCNBR
             MOVE   OLDKDIST           TO   XSTDST
             MOVE   OLDKTBLE           TO   XSTTBL1
             MOVE   OLDNAME            TO   XSTNAM1
             MOVE   XST                TO   XSTD
             WRITE  XSTD
             IF     RETXST             NOT  =  '00'
               MOVE 'XST WRITE ERR'    TO   LNMMSG
               MOVE RETXST             TO   LNMVALUE1
               MOVE XSTD               TO   LNMVALUE2
               PERFORM 520-PRINT       THRU 520-EXIT
             ELSE
               ADD  +1                 TO   CTRREQ
           ELSE
             ADD    +1                 TO   CTRREQ.
       625-EXIT.
           EXIT.

       630-3CHG.
           MOVE    SRTKFUND            TO   OLDKFUND  HD4FND
           MOVE    ZEROS               TO   CTRFUND
           MOVE    +61                 TO   CTRLN
           PERFORM 620-2CHG            THRU 620-EXIT.
       630-EXIT.
           EXIT.

       635-3TOT.
           MOVE    'FUND '             TO   LN2MSG1
           MOVE    OLDKFUND            TO   LN2FLD
           MOVE    ' TOTAL EXPENDITURES '   TO  LN2MSG2
           MOVE    CTRFUND             TO   LN2AMT
           MOVE    '0'                 TO   CTLCHAR
           PERFORM 520-PRINT           THRU 520-EXIT.
       635-EXIT.
           EXIT.

       640-4CHG.
           MOVE     ZEROS              TO   CTRLN         CTRPG
                                            CTRREQ
           MOVE     'N'                TO   WSCLAST
           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.
       640-REQ.
           IF      HD1B         (HD11) =    SPACES
             SET   HD11                DOWN BY  +1
             GO                        TO   640-REQ.
           SET     HD11                UP   BY  +1
           MOVE    '-'                 TO   HD1B         (HD11)
           SET     HD11                UP   BY  +1
           MOVE    SRTKREQ1            TO   HD1B         (HD11)
           SET     HD11                UP   BY  +1
           MOVE    SRTKREQ2            TO   HD1B         (HD11)
           SET     HD11                UP   BY  +1
           MOVE    SRTKREQ3            TO   HD1B         (HD11)
           SET     HD11                UP   BY  +1
           MOVE    '-'                 TO   HD1B         (HD11)
           SET     HD11                UP   BY  +1
           MOVE    SRTKFY1             TO   HD1B         (HD11)
           SET     HD11                UP   BY  +1
           MOVE    SRTKFY2             TO   HD1B         (HD11).

           SET     RQH1                TO   +1.
       640-HEAD.
           IF      RQHREQ       (RQH1) NOT  =   HIGH-VALUES
             IF      RQHREQ     (RQH1) NOT  =   SRTKREQ
               SET   RQH1              UP   BY  +1
               GO                      TO   640-HEAD
             ELSE
               IF      RQHID    (RQH1) =    'H1'
                 MOVE  RQHHEAD  (RQH1) TO   HD2HEAD
                 MOVE  RQHUSER  (RQH1) TO   HD1USER
                 SET   RQH1            UP   BY  +1
                 GO                    TO   640-HEAD
               ELSE
                 IF      RQHID  (RQH1) =    'H2'
                   MOVE  RQHHEAD (RQH1) TO  HD3HEAD
                   SET   RQH1          UP   BY  +1
                   GO                  TO   640-HEAD.
           IF        OLDPRT            =    'N'
             MOVE    SPACES            TO   HD2HEAD       HD1USER
             MOVE    SPACES            TO   HD3HEAD
           ELSE
             IF      OLDPRT            =    'U'
               MOVE  SPACES            TO   HD2HEAD       HD3HEAD
             ELSE
               IF    OLDPRT            =    'T'
                 MOVE  SPACES          TO   HD1USER.

           PERFORM 630-3CHG            THRU 630-EXIT
           PERFORM 525-HEADS           THRU 525-EXIT.
       640-EXIT.
           EXIT.

       645-4TOT.
           MOVE    'Y'                 TO   WSCLAST
           MOVE    'REQUEST '          TO   LN3MSG1
           MOVE    OLDKREQ             TO   LN3REQ
           MOVE    ' TOTAL '           TO   LN3MSG2
           MOVE    CTRREQ              TO   LN3AMT
           MOVE    ' XST RECORDS WRITTEN'   TO  LN3MSG3
           MOVE    +61                 TO   CTRLN
           PERFORM 520-PRINT           THRU 520-EXIT.
       645-EXIT.
           EXIT.

      ******************************************************************
       990-HOUSEKEEPING.
           PERFORM 510-READ            THRU 510-EXIT
           ACCEPT  SYSDATE             FROM DATE
           MOVE    SYSYY               TO   HD1YY
           MOVE    SYSMM               TO   HD1MM
           MOVE    SYSDD               TO   HD1DD
           ACCEPT  SYSTIME             FROM TIME
           MOVE    SYSHR               TO   HD1HR
           MOVE    SYSMIN              TO   HD1MN
           IF      SRTKEY              =    HIGH-VALUES
             MOVE  ' EW028 NO DATA TO PROCESS'  TO  LNM
             PERFORM 520-PRINT         THRU 520-EXIT
             GO                        TO   999-EOJ.
           PERFORM 640-4CHG            THRU 640-EXIT.
       990-EXIT.
           EXIT.

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