       IDENTIFICATION   DIVISION.
       PROGRAM-ID.      EW026.
       AUTHOR.          DOE.
      *****************************************************************
      *                   SUMMARY OF INPUT DATA                       *
      *****************************************************************
      * DATE CREATED:   06/20/95                                      *
      *****************************************************************
      * CALL #  - MMDDYY - PURPOSE                                    *
      * 2001001 - 040301 - MODIFY TO HAVE FUND TOTAL PAGES.           *
      * 2006001 - 041306 - ADD FUNCTIONS 6500 & 8200.                 *
      *****************************************************************


       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       RANDOM
                                       RECORD KEY   CRFDK
                                       FILE STATUS  RETCRF.

           SELECT    CDF-DISK          ASSIGN       DATABASE-EWCDFI
                                       ORGANIZATION INDEXED
                                       ACCESS       SEQUENTIAL
                                       RECORD KEY   CDFDK
                                       FILE STATUS  RETCDF.

       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(03).
012        05        CRDDIST           PIC  X(02).
014        05        FILLER            PIC  X(01).
015        05        CRDFY             PIC  X(02).
017        05        FILLER            PIC  X(01).
018        05        CRDFUND           PIC  X(01).
019        05        FILLER            PIC  X(01).
020        05        CRDTBLE           PIC  X(05).
025        05        FILLER            PIC  X(01).
026        05        CRDSCHL           PIC  X(04).
030        05        FILLER            PIC  X(01).
031        05        CRDERR            PIC  X(01).
032        05        FILLER            PIC  X(01).
033        05        CRDRPT            PIC  X(01).
034        05        CRDPGM            PIC  X(05).
039        05        FILLER            PIC  X(42).

       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.

       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        FILLER            PIC  X(07).
008        05        LN1FUNC           PIC  X(04).
012        05        FILLER            PIC  X(01).
013        05        LN1NAME           PIC  X(30).
043        05        FILLER            PIC  X(02).
045        05        LN1AMT1           PIC  ZZZ,ZZZ,ZZZ-.
057        05        FILLER            PIC  X(02).
059        05        LN1AMT2           PIC  ZZZ,ZZZ,ZZZ-.
071        05        FILLER            PIC  X(02).
073        05        LN1AMT3           PIC  ZZZ,ZZZ,ZZZ-.
085        05        FILLER            PIC  X(02).
087        05        LN1AMT4           PIC  ZZZ,ZZZ,ZZZ-.
099        05        FILLER            PIC  X(02).
101        05        LN1AMT5           PIC  ZZZ,ZZZ,ZZZ-.
113        05        LN1TOT            PIC  Z,ZZZ,ZZZ,ZZZ-.
127        05        FILLER            PIC  X(06).

       01            LN2.
001        05        FILLER            PIC  X(30).
031        05        LN2MSG            PIC  X(06).
037        05        LN2FLD            PIC  X(05).
042        05        FILLER            PIC  X(01).
043        05        LN2AMT1           PIC  Z,ZZZ,ZZZ,ZZZ-.
057        05        LN2AMT2           PIC  Z,ZZZ,ZZZ,ZZZ-.
071        05        LN2AMT3           PIC  Z,ZZZ,ZZZ,ZZZ-.
085        05        LN2AMT4           PIC  Z,ZZZ,ZZZ,ZZZ-.
099        05        LN2AMT5           PIC  Z,ZZZ,ZZZ,ZZZ-.
113        05        LN2AMT6           PIC  Z,ZZZ,ZZZ,ZZZ-.
127        05        FILLER            PIC  X(06).

           COPY                        EWCRFD             OF   CPYSRC.
           COPY                        EWCDFD             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      SRTKTBLE          PIC  X(05).
             10      SRTKSCHL          PIC  X(04).
             10      SRTKFUNC          PIC  X(04).
             10      SRTKCTRL          PIC  X(04).
           05        SRTDATA.
             10      SRTAMT            PIC  S9(09).
             10      SRTPRT            PIC  X(01).

       WORKING-STORAGE SECTION.

       01            WSC.
           05        WSCFUNC           PIC  X(04).
           05        WSCNAME           PIC  X(30).

       01            RET.
           05        RETCRF            PIC  X(02) VALUE '00'.
           05        RETCDF            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      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      ERRERR            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        RQRERR            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(04) 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(04) 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        CTRAMT            PIC S9(09)      COMP-3 VALUE +0.
           05        CTRLNTOT          PIC S9(11)      COMP-3 VALUE +0.
           05        CTRINST1          PIC S9(09)      COMP-3 VALUE +0.
           05        CTRINST2          PIC S9(09)      COMP-3 VALUE +0.
           05        CTRSCHL1          PIC S9(11)      COMP-3 VALUE +0.
           05        CTRSCHL2          PIC S9(11)      COMP-3 VALUE +0.
           05        CTRSCHL3          PIC S9(11)      COMP-3 VALUE +0.
           05        CTRSCHL4          PIC S9(11)      COMP-3 VALUE +0.
           05        CTRSCHL5          PIC S9(11)      COMP-3 VALUE +0.
           05        CTRSCHL6          PIC S9(11)      COMP-3 VALUE +0.
           05        CTRREQ1           PIC S9(11)      COMP-3 VALUE +0.
           05        CTRREQ2           PIC S9(11)      COMP-3 VALUE +0.
           05        CTRREQ3           PIC S9(11)      COMP-3 VALUE +0.
           05        CTRREQ4           PIC S9(11)      COMP-3 VALUE +0.
           05        CTRREQ5           PIC S9(11)      COMP-3 VALUE +0.
           05        CTRREQ6           PIC S9(11)      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).
             10      OLDKCTRL.
               15    OLDKCTRL1         PIC  X(01).
               15    FILLER            PIC  X(03).
           05        OLDPRT            PIC  X(01).


           COPY                        EWSCL        OF          CPYSRC.
           COPY                        EWTBL        OF          CPYSRC.
           COPY                        EWCDF        OF          CPYSRC.

       01            OLDLN             PIC  X(133).

       01      HD1.
001        05  FILLER  PIC X(06) VALUE 'EW026 '.
           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(10) VALUE SPACES.
058        05  FILLER  PIC X(18) VALUE 'SUMMARY INPUT DATA'.
076        05  FILLER  PIC X(22) 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(07) 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(07) VALUE 'TABLE- '.
008        05  HD5TBL  PIC X(05) VALUE SPACES.
013        05  FILLER  PIC X(01) VALUE SPACES.
014        05  HD5DESC PIC X(30) VALUE SPACES.
044        05  FILLER  PIC X(89) VALUE SPACES.

       01      HD6.
001        05  FILLER  PIC X(07) VALUE 'SCHL-  '.
008        05  HD6SCHL PIC X(04) VALUE SPACES.
013        05  FILLER  PIC X(02) VALUE SPACES.
014        05  HD6DESC PIC X(30) VALUE SPACES.
044        05  FILLER  PIC X(89) VALUE SPACES.

       01      HD7.
001        05  FILLER  PIC X(51) VALUE SPACES.
052        05  FILLER  PIC X(12) VALUE 'DIRECT COSTS'.
064        05  FILLER  PIC X(16) VALUE SPACES.
080        05  FILLER  PIC X(13) VALUE 'SCHL INDIRECT'.
093        05  FILLER  PIC X(06) VALUE SPACES.
099        05  FILLER  PIC X(13) VALUE 'DIST INDIRECT'.
112        05  FILLER  PIC X(21) VALUE SPACES.

       01      HD8.
001        05  FILLER  PIC X(46) VALUE SPACES.
047        05  FILLER  PIC X(23) VALUE 'CTRL 1000     CTRL 7000'.
070        05  FILLER  PIC X(05) VALUE SPACES.
075        05  FILLER  PIC X(23) VALUE 'CTRL 200X     CTRL 600X'.
098        05  FILLER  PIC X(05) VALUE SPACES.
103        05  FILLER  PIC X(09) VALUE 'CTRL 300X'.
112        05  FILLER  PIC X(09) VALUE SPACES.
121        05  FILLER  PIC X(05) VALUE 'TOTAL'.
126        05  FILLER  PIC X(07) VALUE SPACES.

       01      HD9.
001        05  FILLER  PIC X(07) VALUE SPACES.
008        05  FILLER  PIC X(17) VALUE '5000 INSTRUCTION:'.
025        05  FILLER  PIC X(108) VALUE SPACES.

       LINKAGE       SECTION.

           COPY                       EWBJR                OF CPYSRC.

       PROCEDURE DIVISION USING BJR.
      ******************************************************************
       DECLARATIVES.
       000-ERROR     SECTION.
           USE AFTER STANDARD ERROR PROCEDURE ON CRD-CARD
                                                 CDF-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      RETCDF              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    CDF-DISK            NEXT
           IF     (CDFDK               >    ENDKEY)                  OR
                  (RETCDF              NOT  =   '00')
             MOVE  '99'                TO   RETCDF
           ELSE
             MOVE  CDFD                TO   CDF.
       010-EXIT.
           EXIT.

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

           MOVE    CDFFUND             TO   SELFUND
           MOVE    CDFTABLE            TO   SELTBLE
           MOVE    CDFSCHL             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  =  CDFDIST)      OR
                  (RQRFY               NOT  =  CDFFY)        OR
                  (RQRSEL              NOT  =  SEL)          OR
                  (CDFCONTROL          >    '7000')
             GO                        TO   015-EXIT.

           MOVE    RQRDIST             TO   SRTKDIST
           MOVE    RQRREQ              TO   SRTKREQ
           MOVE    CDFFY               TO   SRTKFY
           MOVE    CDFFUND             TO   SRTKFUND
           MOVE    CDFTABLE            TO   SRTKTBLE
           MOVE    CDFSCHL             TO   SRTKSCHL
           MOVE    CDFCONTROL          TO   SRTKCTRL
           MOVE    RQRPRT              TO   SRTPRT

           IF      CDFCONTROL          =    '1000'
             MOVE  '5100'              TO   SRTKFUNC
             MOVE  CDFAMT1             TO   SRTAMT
             RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
             MOVE  '5200'              TO   SRTKFUNC
             MOVE  CDFAMT2             TO   SRTAMT
             RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
             MOVE  '5300'              TO   SRTKFUNC
             MOVE  CDFAMT3             TO   SRTAMT
             RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
             MOVE  '5500'              TO   SRTKFUNC
             MOVE  CDFAMT4             TO   SRTAMT
             RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
             MOVE  '5600'              TO   SRTKFUNC
             MOVE  CDFAMT5             TO   SRTAMT
             RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
             MOVE  '5700'              TO   SRTKFUNC
             MOVE  CDFAMT6             TO   SRTAMT
040301*      RELEASE SRT.
040301       RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT.

           IF      CDFCONTROL          =    '2000'
             MOVE  '6100'              TO   SRTKFUNC
             MOVE  CDFAMT1             TO   SRTAMT
             RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
             MOVE  '6200'              TO   SRTKFUNC
             MOVE  CDFAMT2             TO   SRTAMT
             RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
             MOVE  '6300'              TO   SRTKFUNC
             MOVE  CDFAMT3             TO   SRTAMT
             RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
             MOVE  '6400'              TO   SRTKFUNC
             MOVE  CDFAMT4             TO   SRTAMT
040301*      RELEASE SRT.
040301       RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT.

           IF      CDFCONTROL          =    '2001'
             MOVE  '7300'              TO   SRTKFUNC
             MOVE  CDFAMT1             TO   SRTAMT
             RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
             MOVE  '7400'              TO   SRTKFUNC
             MOVE  CDFAMT2             TO   SRTAMT
             RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
             MOVE  '7600'              TO   SRTKFUNC
             MOVE  CDFAMT3             TO   SRTAMT
             RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
             MOVE  '7700'              TO   SRTKFUNC
             MOVE  CDFAMT4             TO   SRTAMT
040301*      RELEASE SRT.
040301       RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT.

           IF      CDFCONTROL          =    '2002'
             MOVE  '7800'              TO   SRTKFUNC
             MOVE  CDFAMT1             TO   SRTAMT
             RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
             MOVE  '7900'              TO   SRTKFUNC
             MOVE  CDFAMT2             TO   SRTAMT
             RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
             MOVE  '8100'              TO   SRTKFUNC
             MOVE  CDFAMT3             TO   SRTAMT
040301*      RELEASE SRT.
040301       RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
041306*      PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT.
041306       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
041306       MOVE  '8200'              TO   SRTKFUNC
041306       MOVE  CDFAMT4             TO   SRTAMT
041306       RELEASE SRT
041306       MOVE  '00000'             TO   SRTKTBLE
041306       MOVE  '9999'              TO   SRTKSCHL
041306       RELEASE SRT
041306       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT.

041306     IF      CDFCONTROL          =    '2003'
041306       MOVE  '6500'              TO   SRTKFUNC
041306       MOVE  CDFAMT1             TO   SRTAMT
041306       RELEASE SRT
041306       MOVE  '00000'             TO   SRTKTBLE
041306       MOVE  '9999'              TO   SRTKSCHL
041306       RELEASE SRT
041306       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT.

           IF      CDFCONTROL          =    '3000'
             MOVE  '6100'              TO   SRTKFUNC
             MOVE  CDFAMT1             TO   SRTAMT
             RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
             MOVE  '6200'              TO   SRTKFUNC
             MOVE  CDFAMT2             TO   SRTAMT
             RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
             MOVE  '6300'              TO   SRTKFUNC
             MOVE  CDFAMT3             TO   SRTAMT
             RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
             MOVE  '6400'              TO   SRTKFUNC
             MOVE  CDFAMT4             TO   SRTAMT
040301*      RELEASE SRT.
040301       RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT.

           IF      CDFCONTROL          =    '3001'
             MOVE  '7100'              TO   SRTKFUNC
             MOVE  CDFAMT1             TO   SRTAMT
             RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
             MOVE  '7200'              TO   SRTKFUNC
             MOVE  CDFAMT2             TO   SRTAMT
             RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
             MOVE  '7400'              TO   SRTKFUNC
             MOVE  CDFAMT3             TO   SRTAMT
             RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
             MOVE  '7500'              TO   SRTKFUNC
             MOVE  CDFAMT4             TO   SRTAMT
040301*      RELEASE SRT.
040301       RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT.

           IF      CDFCONTROL          =    '3002'
             MOVE  '7600'              TO   SRTKFUNC
             MOVE  CDFAMT1             TO   SRTAMT
             RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
             MOVE  '7700'              TO   SRTKFUNC
             MOVE  CDFAMT2             TO   SRTAMT
             RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
             MOVE  '7800'              TO   SRTKFUNC
             MOVE  CDFAMT3             TO   SRTAMT
             RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
             MOVE  '7900'              TO   SRTKFUNC
             MOVE  CDFAMT4             TO   SRTAMT
040301*      RELEASE SRT.
040301       RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT.

           IF      CDFCONTROL          =    '3003'
             MOVE  '8100'              TO   SRTKFUNC
             MOVE  CDFAMT1             TO   SRTAMT
040301*      RELEASE SRT.
040301       RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
041306*      PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT.
041306       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
041306       MOVE  '8200'              TO   SRTKFUNC
041306       MOVE  CDFAMT2             TO   SRTAMT
041306       RELEASE SRT
041306       MOVE  '00000'             TO   SRTKTBLE
041306       MOVE  '9999'              TO   SRTKSCHL
041306       RELEASE SRT
041306       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
041306       MOVE  '6500'              TO   SRTKFUNC
041306       MOVE  CDFAMT3             TO   SRTAMT
041306       RELEASE SRT
041306       MOVE  '00000'             TO   SRTKTBLE
041306       MOVE  '9999'              TO   SRTKSCHL
041306       RELEASE SRT
041306       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT.

           IF      CDFCONTROL          =    '6000'
             MOVE  '6100'              TO   SRTKFUNC
             MOVE  CDFAMT1             TO   SRTAMT
             RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
             MOVE  '6200'              TO   SRTKFUNC
             MOVE  CDFAMT2             TO   SRTAMT
             RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
             MOVE  '6300'              TO   SRTKFUNC
             MOVE  CDFAMT3             TO   SRTAMT
             RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
             MOVE  '6400'              TO   SRTKFUNC
             MOVE  CDFAMT4             TO   SRTAMT
             RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
             MOVE  '0000'              TO   SRTKSCHL
             MOVE  '6100'              TO   SRTKFUNC
             MOVE  CDFAMT1             TO   SRTAMT
             RELEASE SRT
             MOVE  '0000'              TO   SRTKSCHL
             MOVE  '6200'              TO   SRTKFUNC
             MOVE  CDFAMT2             TO   SRTAMT
             RELEASE SRT
             MOVE  '0000'              TO   SRTKSCHL
             MOVE  '6300'              TO   SRTKFUNC
             MOVE  CDFAMT3             TO   SRTAMT
             RELEASE SRT
             MOVE  '0000'              TO   SRTKSCHL
             MOVE  '6400'              TO   SRTKFUNC
             MOVE  CDFAMT4             TO   SRTAMT
             RELEASE SRT.

           IF      CDFCONTROL          =    '6001'
             MOVE  '7300'              TO   SRTKFUNC
             MOVE  CDFAMT1             TO   SRTAMT
             RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
             MOVE  '7400'              TO   SRTKFUNC
             MOVE  CDFAMT2             TO   SRTAMT
             RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
             MOVE  '7600'              TO   SRTKFUNC
             MOVE  CDFAMT3             TO   SRTAMT
             RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
             MOVE  '7700'              TO   SRTKFUNC
             MOVE  CDFAMT4             TO   SRTAMT
             RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
             MOVE  '0000'              TO   SRTKSCHL
             MOVE  '7300'              TO   SRTKFUNC
             MOVE  CDFAMT1             TO   SRTAMT
             RELEASE SRT
             MOVE  '0000'              TO   SRTKSCHL
             MOVE  '7400'              TO   SRTKFUNC
             MOVE  CDFAMT2             TO   SRTAMT
             RELEASE SRT
             MOVE  '0000'              TO   SRTKSCHL
             MOVE  '7600'              TO   SRTKFUNC
             MOVE  CDFAMT3             TO   SRTAMT
             RELEASE SRT
             MOVE  '0000'              TO   SRTKSCHL
             MOVE  '7700'              TO   SRTKFUNC
             MOVE  CDFAMT4             TO   SRTAMT
             RELEASE SRT.

           IF      CDFCONTROL          =    '6002'
             MOVE  '7800'              TO   SRTKFUNC
             MOVE  CDFAMT1             TO   SRTAMT
             RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
             MOVE  '7900'              TO   SRTKFUNC
             MOVE  CDFAMT2             TO   SRTAMT
             RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
             MOVE  '8100'              TO   SRTKFUNC
             MOVE  CDFAMT3             TO   SRTAMT
             RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
041306       MOVE  '8200'              TO   SRTKFUNC
041306       MOVE  CDFAMT4             TO   SRTAMT
041306       RELEASE SRT
041306       MOVE  '00000'             TO   SRTKTBLE
041306       MOVE  '9999'              TO   SRTKSCHL
041306       RELEASE SRT
041306       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
             MOVE  '0000'              TO   SRTKSCHL
             MOVE  '7800'              TO   SRTKFUNC
             MOVE  CDFAMT1             TO   SRTAMT
             RELEASE SRT
             MOVE  '0000'              TO   SRTKSCHL
             MOVE  '7900'              TO   SRTKFUNC
             MOVE  CDFAMT2             TO   SRTAMT
             RELEASE SRT
             MOVE  '0000'              TO   SRTKSCHL
             MOVE  '8100'              TO   SRTKFUNC
             MOVE  CDFAMT3             TO   SRTAMT
041306*      RELEASE SRT.
041306       RELEASE SRT
041306       MOVE  '0000'              TO   SRTKSCHL
041306       MOVE  '8200'              TO   SRTKFUNC
041306       MOVE  CDFAMT4             TO   SRTAMT
041306       RELEASE SRT.

041306     IF      CDFCONTROL          =    '6003'
041306       MOVE  '6500'              TO   SRTKFUNC
041306       MOVE  CDFAMT1             TO   SRTAMT
041306       RELEASE SRT
041306       MOVE  '00000'             TO   SRTKTBLE
041306       MOVE  '9999'              TO   SRTKSCHL
041306       RELEASE SRT
041306       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
041306       MOVE  '0000'              TO   SRTKSCHL
041306       MOVE  '6500'              TO   SRTKFUNC
041306       MOVE  CDFAMT1             TO   SRTAMT
041306       RELEASE SRT.

           IF      CDFCONTROL          =    '7000'
             MOVE  '5100'              TO   SRTKFUNC
             MOVE  CDFAMT1             TO   SRTAMT
             RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
             MOVE  '5200'              TO   SRTKFUNC
             MOVE  CDFAMT2             TO   SRTAMT
             RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
             MOVE  '5300'              TO   SRTKFUNC
             MOVE  CDFAMT3             TO   SRTAMT
             RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
             MOVE  '5500'              TO   SRTKFUNC
             MOVE  CDFAMT4             TO   SRTAMT
             RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
             MOVE  '5600'              TO   SRTKFUNC
             MOVE  CDFAMT5             TO   SRTAMT
             RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
             MOVE  '5700'              TO   SRTKFUNC
             MOVE  CDFAMT6             TO   SRTAMT
             RELEASE SRT
040301       MOVE  '00000'             TO   SRTKTBLE
040301       MOVE  '9999'              TO   SRTKSCHL
040301       RELEASE SRT
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT
             MOVE  '0000'              TO   SRTKSCHL
             MOVE  '5100'              TO   SRTKFUNC
             MOVE  CDFAMT1             TO   SRTAMT
             RELEASE SRT
             MOVE  '0000'              TO   SRTKSCHL
             MOVE  '5200'              TO   SRTKFUNC
             MOVE  CDFAMT2             TO   SRTAMT
             RELEASE SRT
             MOVE  '0000'              TO   SRTKSCHL
             MOVE  '5300'              TO   SRTKFUNC
             MOVE  CDFAMT3             TO   SRTAMT
             RELEASE SRT
             MOVE  '0000'              TO   SRTKSCHL
             MOVE  '5500'              TO   SRTKFUNC
             MOVE  CDFAMT4             TO   SRTAMT
             RELEASE SRT
             MOVE  '0000'              TO   SRTKSCHL
             MOVE  '5600'              TO   SRTKFUNC
             MOVE  CDFAMT5             TO   SRTAMT
             RELEASE SRT
             MOVE  '0000'              TO   SRTKSCHL
             MOVE  '5700'              TO   SRTKFUNC
             MOVE  CDFAMT6             TO   SRTAMT
             RELEASE SRT.

       015-EXIT.
           EXIT.

040301 016-BUILD-SRTKEY.
040301     MOVE    RQRDIST             TO   SRTKDIST
040301     MOVE    RQRREQ              TO   SRTKREQ
040301     MOVE    CDFFY               TO   SRTKFY
040301     MOVE    CDFFUND             TO   SRTKFUND
040301     MOVE    CDFTABLE            TO   SRTKTBLE
040301     MOVE    CDFSCHL             TO   SRTKSCHL
040301     MOVE    CDFCONTROL          TO   SRTKCTRL
040301     MOVE    RQRPRT              TO   SRTPRT.
040301 016-EXIT.
040301     EXIT.

      ******************************************************************
       490-HOUSEKEEPING.
           OPEN    INPUT                    CRD-CARD      CRF-DISK
                                            CDF-DISK
                   OUTPUT                   PR1-PRNT
           MOVE    SPACES              TO   LN1
           MOVE    '1'                 TO   CTLCHAR
           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')
             MOVE  ALL '-'             TO   ERRRPT.
           IF     (CRDFUND             NOT  =   '1')                 AND
                  (CRDFUND             NOT  =   '4')                 AND
                  (CRDFUND             NOT  =   ' ')
             MOVE  ALL '-'             TO   ERRFUND.
           IF     (CRDERR              NOT  =   ' '               AND
                   CRDFUND             NOT  =   'Y')                 OR
                  (CRDRPT              =    'A'                   AND
                   CRDERR              NOT  =   SPACES)
             MOVE  ALL '-'             TO   ERRERR.
           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    CRDERR              TO   RQRERR
           MOVE    CRDRPT              TO   RQRRPT

           MOVE    CRDDIST             TO   CDFKEY
           MOVE    CRDFY               TO   CDFFY
           MOVE    CRDFUND             TO   CDFFUND
           MOVE    CRDTBLE             TO   CDFTABLE
           MOVE    CRDSCHL             TO   CDFSCHL
           IF     (CDFKEY              <    STRKEY)
             MOVE  CDFKEY              TO   STRKEY.
           INSPECT CDFKEY       REPLACING   ALL  ' ' BY HIGH-VALUES
           IF     (CDFKEY              >    ENDKEY)
             MOVE  CDFKEY              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    'EW026 NO REQUESTS *'   TO   LNMMSG
             PERFORM 520-PRINT         THRU 520-EXIT.
           IF      RETCRF              NOT  =   '00'
             MOVE    'CRF OPEN ERROR'  TO   LNMMSG
             MOVE    RETCRF            TO   LNMVALUE1
             PERFORM 520-PRINT         THRU 520-EXIT.
           IF      RETCDF              NOT  =   '00'
             MOVE    'CDF OPEN ERROR'  TO   LNMMSG
             MOVE    RETCDF            TO   LNMVALUE1
             PERFORM 520-PRINT         THRU 520-EXIT.
           IF     (RETCRF              NOT  =   '00')                OR
                  (RETCDF              NOT  =   '00')
             GO                        TO   499-EOJ.
           MOVE    STRKEY              TO   CDFDK
           START   CDF-DISK        KEY >    CDFDK
           IF      RETCDF              =    '00'
             PERFORM 010-READ          THRU 010-EXIT.
       490-EXIT.
           EXIT.

      ******************************************************************
       495-LOAD.
           MOVE    BJRCARD1            TO   CRD
           MOVE    SPACES              TO   ERR
           IF     (CRDPRT              NOT  =   'U')                 AND
                  (CRDPRT              NOT  =   'T')                 AND
                  (CRDPRT              NOT  =   'B')                 AND
                  (CRDPRT              NOT  =   'N')
             MOVE  ALL '-'             TO   ERRPRT.
           IF     (CRDDIST             =    SPACES)
             MOVE  ALL '-'             TO   ERRDIST.
           IF     (CRDFY               NOT  NUMERIC)
             MOVE  ALL '-'             TO   ERRFY.
           IF     (CRDRPT              NOT  =   'A')                 AND
                  (CRDRPT              NOT  =   'B')
             MOVE  ALL '-'             TO   ERRRPT.
           IF     (CRDFUND             NOT  =   '1')                 AND
                  (CRDFUND             NOT  =   '4')                 AND
                  (CRDFUND             NOT  =   ' ')
             MOVE  ALL '-'             TO   ERRFUND.
           IF     (CRDERR              NOT  =   ' '               AND
                   CRDFUND             NOT  =   'Y')                 OR
                  (CRDRPT              =    'A'                   AND
                   CRDERR              NOT  =   SPACES)
             MOVE  ALL '-'             TO   ERRERR.
           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    CRDTBLE             TO   RQRTBLE
           MOVE    CRDSCHL             TO   RQRSCHL
           MOVE    CRDERR              TO   RQRERR
           MOVE    CRDRPT              TO   RQRRPT

           MOVE    CRDDIST             TO   CDFKEY
           MOVE    CRDFY               TO   CDFFY
           MOVE    CRDFUND             TO   CDFFUND
           MOVE    CRDTBLE             TO   CDFTABLE
           MOVE    CRDSCHL             TO   CDFSCHL
           IF     (CDFKEY              <    STRKEY)
             MOVE  CDFKEY              TO   STRKEY.
           INSPECT CDFKEY       REPLACING   ALL  ' ' BY HIGH-VALUES
           IF     (CDFKEY              >    ENDKEY)
             MOVE  CDFKEY              TO   ENDKEY.

           MOVE    BJRREQ1             TO   CRHREQ
           MOVE    BJRID1              TO   CRHID
           MOVE    BJRUSER1            TO   CRHUSER
           MOVE    BJRHEAD1            TO   CRHHEAD.
       495-HEAD.
           MOVE    CRHREQ              TO   RQHREQ       (RQH1)
           MOVE    CRHID               TO   RQHID        (RQH1)
           MOVE    CRHUSER             TO   RQHUSER      (RQH1)
           MOVE    SPACES              TO   RQHHEAD      (RQH1)
           MOVE    +50                 TO   CTRIDX
           SET     CRH1                TO   +50.
       495-HEAD1.
           IF      CRHB         (CRH1) =    SPACES
             IF      CRH1              >    +2
               ADD   -1                TO   CTRIDX
               SET   CRH1              DOWN BY  +1
               GO                      TO   495-HEAD1.
           SUBTRACT +1                 FROM CTRIDX
           COMPUTE CTRIDX      ROUNDED =    (50  - CTRIDX) / 2
           SET     RQH2                TO   CTRIDX
           SET     CRH1                TO   +1.
       495-HEAD2.
           MOVE    CRHB         (CRH1) TO   RQHB         (RQH1 RQH2)
           IF      RQH2                <    +50
             SET   RQH2  CRH1          UP   BY  +1
             GO                        TO   495-HEAD2.
           IF      BJRHEAD2            NOT  =   SPACES              AND
                   RQH1                =    +1
             SET   RQH1                UP   BY  +1
             MOVE  BJRREQ2             TO   CRHREQ
             MOVE  BJRID2              TO   CRHID
             MOVE  BJRUSER2            TO   CRHUSER
             MOVE  BJRHEAD2            TO   CRHHEAD
             GO                        TO   495-HEAD.
       495-EXIT.
           EXIT.
      ******************************************************************
       499-EOJ.
       499-EXIT.
           EXIT.

      ******************************************************************
       500-OUTPUT SECTION.
           PERFORM 990-HOUSEKEEPING    THRU 990-EXIT.
       505-LOOP.
             IF    (SRTKDIST           NOT  =   OLDKDIST)            OR
                   (SRTKREQ            NOT  =   OLDKREQ)             OR
                   (SRTKFY             NOT  =   OLDKFY)              OR
                   (SRTKFUND           NOT  =   OLDKFUND)            OR
                   (SRTKTBLE           NOT  =   OLDKTBLE)            OR
                   (SRTKSCHL           NOT  =   OLDKSCHL)            OR
                   (SRTKFUNC           NOT  =   OLDKFUNC)            OR
                   (SRTKCTRL           NOT  =   OLDKCTRL)
               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)            OR
                   (SRTKSCHL           NOT  =   OLDKSCHL)            OR
                   (SRTKFUNC           NOT  =   OLDKFUNC)
                 PERFORM 625-2TOT      THRU 625-EXIT
                 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 635-3TOT    THRU 635-EXIT
                   IF  (SRTKDIST       NOT  =   OLDKDIST)            OR
                       (SRTKREQ        NOT  =   OLDKREQ)             OR
                       (SRTKFY         NOT  =   OLDKFY)              OR
                       (SRTKFUND       NOT  =   OLDKFUND)            OR
                       (SRTKTBLE       NOT  =   OLDKTBLE)
                     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.
           ADD      SRTAMT             TO   CTRAMT.
       515-EXIT.
           EXIT.

      ******************************************************************
       520-PRINT.
           IF      CTRLN               >    +60
             PERFORM 525-HEADS         THRU 525-EXIT.
           IF      CTLCHAR             =    '1'
             WRITE LN1             AFTER    ADVANCING PAGE
           ELSE
             IF      CTLCHAR           =    '0'
               WRITE LN1           AFTER    ADVANCING  2  LINES
               ADD   +2                TO   CTRLN
             ELSE
               IF      CTLCHAR         =    ' '
                 WRITE LN1         AFTER    ADVANCING  1  LINES
                 ADD   +1              TO   CTRLN
               ELSE
                 WRITE LN1         AFTER    ADVANCING  0  LINES
                 ADD   +0              TO   CTRLN.
           MOVE    SPACES              TO   LN1           CTLCHAR.
       520-EXIT.
           EXIT.

       525-HEADS.
           MOVE    LN1                 TO   OLDLN
           MOVE    +0                  TO   CTRLN
           ADD     +1                  TO   CTRPG
           MOVE    CTRPG               TO   HD1PG
           MOVE    HD1                 TO   LN1
           MOVE    '1'                 TO   CTLCHAR
           PERFORM 520-PRINT           THRU 520-EXIT
           IF      HD2                 NOT  =   SPACES
             MOVE    HD2               TO   LN1
             PERFORM 520-PRINT         THRU 520-EXIT.
           IF      HD3                 NOT  =   SPACES
             MOVE    HD3               TO   LN1
             PERFORM 520-PRINT         THRU 520-EXIT.
           MOVE    '0'                 TO   CTLCHAR
           IF      SRTKREQ             =    OLDKREQ
             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    HD8                 TO   LN1
           PERFORM 520-PRINT           THRU 520-EXIT
           MOVE    '0'                 TO   CTLCHAR
           IF      SRTKREQ             =    OLDKREQ
             MOVE    HD9               TO   LN1
             PERFORM 520-PRINT         THRU 520-EXIT.
           MOVE    OLDLN               TO   LN1.
       525-EXIT.
           EXIT.

      ******************************************************************
       610-1CHG.
           MOVE    SRTKCTRL            TO   OLDKCTRL
           MOVE    ZEROS               TO   CTRAMT.
       610-EXIT.
           EXIT.

       615-1TOT.
           IF      OLDKCTRL1           NOT  =  '7'
             ADD   CTRAMT              TO   CTRLNTOT  CTRSCHL6.
           IF      OLDKCTRL1           =    '1'
             MOVE  CTRAMT              TO   LN1AMT1
             ADD   CTRAMT              TO   CTRSCHL1.
           IF      OLDKCTRL1           =    '7'
             MOVE  CTRAMT              TO   LN1AMT2
             ADD   CTRAMT              TO   CTRSCHL2.
           IF      OLDKCTRL1           =    '2'
             MOVE  CTRAMT              TO   LN1AMT3
             ADD   CTRAMT              TO   CTRSCHL3.
           IF      OLDKCTRL1           =    '6'
             MOVE  CTRAMT              TO   LN1AMT4
             ADD   CTRAMT              TO   CTRSCHL4.
           IF      OLDKCTRL1           =    '3'
             MOVE  CTRAMT              TO   LN1AMT5
             ADD   CTRAMT              TO   CTRSCHL5.
           IF     (OLDKFUNC            >    '5000'       AND
                   OLDKFUNC            <    '6000')            AND
                  (OLDKCTRL1           =    '1')
             ADD   CTRAMT              TO   CTRINST1.
           IF     (OLDKFUNC            >    '5000'       AND
                   OLDKFUNC            <    '6000')            AND
                  (OLDKCTRL1           =    '7')
             ADD   CTRAMT              TO   CTRINST2.
       615-EXIT.
           EXIT.

       620-2CHG.
           MOVE    SRTKFUNC            TO   OLDKFUNC
           MOVE    ZEROS               TO   CTRLNTOT
           PERFORM 610-1CHG            THRU 610-EXIT.
       620-EXIT.
           EXIT.

       625-2TOT.
           IF      OLDKFUNC            >    '6000'
             MOVE  OLDKFUNC            TO   LN1FUNC.
           MOVE    OLDKFUNC            TO   WSCFUNC
           PERFORM 700-FUNC-NAME       THRU 700-EXIT
           MOVE    WSCNAME             TO   LN1NAME
           MOVE    CTRLNTOT            TO   LN1TOT
           PERFORM 520-PRINT           THRU 520-EXIT
           IF     (OLDKFUNC            <    '6000')           AND
                  (SRTKFUNC            >    '6000'       OR
                   SRTKSCHL            NOT  =  OLDKSCHL)
             MOVE  'SUBTOTAL INSTRUCTION'   TO   LN1NAME
             MOVE  CTRINST1            TO   LN1AMT1
             MOVE  CTRINST2            TO   LN1AMT2
             PERFORM 520-PRINT         THRU 520-EXIT
             MOVE  ZEROS               TO   CTRINST1  CTRINST2.
       625-EXIT.
           EXIT.

       630-3CHG.
           MOVE    SRTKSCHL            TO   OLDKSCHL  HD6SCHL
           MOVE    SRTKDIST            TO   SCLDIST
           MOVE    SRTKFY              TO   SCLFY
           MOVE    'SCL'               TO   SCLPREF
           MOVE    SRTKSCHL            TO   SCLSCL
           MOVE    SCLKEY              TO   CRFDK
           READ    CRF-DISK
           IF      RETCRF              NOT  =  '00'
             MOVE  'UNKNOWN'           TO   HD6DESC
           ELSE
             MOVE  CRFD                TO   SCL
             MOVE  SCLDESC             TO   HD6DESC.
040301     IF      SRTKSCHL            =    '9999'
040301       MOVE  'TOTAL PAGE'        TO   HD6DESC.
           MOVE    ZEROS               TO   CTRSCHL1  CTRSCHL2
                                            CTRSCHL3  CTRSCHL4
                                            CTRSCHL5  CTRSCHL6
           PERFORM 620-2CHG            THRU 620-EXIT.
       630-EXIT.
           EXIT.

       635-3TOT.
           MOVE    'SCHL  '            TO   LN2MSG
           MOVE    OLDKSCHL            TO   LN2FLD
           MOVE    CTRSCHL1            TO   LN2AMT1
           MOVE    CTRSCHL2            TO   LN2AMT2
           MOVE    CTRSCHL3            TO   LN2AMT3
           MOVE    CTRSCHL4            TO   LN2AMT4
           MOVE    CTRSCHL5            TO   LN2AMT5
           MOVE    CTRSCHL6            TO   LN2AMT6
           MOVE    '0'                 TO   CTLCHAR
           PERFORM 520-PRINT           THRU 520-EXIT
           MOVE    +61                 TO   CTRLN
           IF      OLDKSCHL            =    '0000'
             ADD   CTRSCHL1            TO   CTRREQ1
             ADD   CTRSCHL2            TO   CTRREQ2
             ADD   CTRSCHL3            TO   CTRREQ3
             ADD   CTRSCHL4            TO   CTRREQ4
             ADD   CTRSCHL5            TO   CTRREQ5
             ADD   CTRSCHL6            TO   CTRREQ6.
       635-EXIT.
           EXIT.

       640-4CHG.
           MOVE    SRTKFUND            TO   OLDKFUND  HD4FND
           MOVE    SRTKTBLE            TO   OLDKTBLE  HD5TBL
           MOVE    SRTKDIST            TO   TBLDIST
           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
040301     IF      SRTKTBLE            =    '00000'
040301       MOVE  'TOTAL PAGE'        TO   HD5DESC.
           PERFORM 630-3CHG            THRU 630-EXIT.
       640-EXIT.
           EXIT.

       645-4TOT.
       645-EXIT.
           EXIT.

       650-5CHG.
           MOVE     ZEROS              TO   CTRLN         CTRPG
                                            CTRREQ1       CTRREQ2
                                            CTRREQ3       CTRREQ4
                                            CTRREQ5       CTRREQ6
           MOVE     SRTKREQ            TO   OLDKREQ
           MOVE     SRTKDIST           TO   OLDKDIST
           MOVE     SRTKFY             TO   OLDKFY
           MOVE     SRTPRT             TO   OLDPRT

           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    'REQ'               TO   LN2MSG
           MOVE    OLDKREQ             TO   LN2FLD
           MOVE    CTRREQ1             TO   LN2AMT1
           MOVE    CTRREQ2             TO   LN2AMT2
           MOVE    CTRREQ3             TO   LN2AMT3
           MOVE    CTRREQ4             TO   LN2AMT4
           MOVE    CTRREQ5             TO   LN2AMT5
           MOVE    CTRREQ6             TO   LN2AMT6
           PERFORM 520-PRINT           THRU 520-EXIT.
       655-EXIT.
           EXIT.

      ******************************************************************
       700-FUNC-NAME.
           IF      WSCFUNC                           =    '5100'
             MOVE  '  SALARIES'                      TO   WSCNAME.
           IF      WSCFUNC                           =    '5200'
             MOVE  '  EMPLOYEE BENEFITS'             TO   WSCNAME.
           IF      WSCFUNC                           =    '5300'
             MOVE  '  PURCHASED SERVICES'            TO   WSCNAME.
           IF      WSCFUNC                           =    '5500'
             MOVE  '  MATERIALS AND SUPPLIES'        TO   WSCNAME.
           IF      WSCFUNC                           =    '5600'
             MOVE  '  OTHER EXPENSES'                TO   WSCNAME.
           IF      WSCFUNC                           =    '5700'
             MOVE  '  CAPITAL OUTLAY'                TO   WSCNAME.
           IF      WSCFUNC                           =    '6100'
             MOVE  'PUPIL PERSONNEL'                 TO   WSCNAME.
           IF      WSCFUNC                           =    '6200'
             MOVE  'INSTRUCTIONAL MEDIA'             TO   WSCNAME.
           IF      WSCFUNC                           =    '6300'
             MOVE  'INSTRUCTION AND CURRICULM DEV.'  TO   WSCNAME.
           IF      WSCFUNC                           =    '6400'
             MOVE  'INTRUCTIONAL STAFF TRAINING'     TO   WSCNAME.
           IF      WSCFUNC                           =    '7100'
             MOVE  'BOARD'                           TO   WSCNAME.
           IF      WSCFUNC                           =    '7200'
             MOVE  'GENERAL ADMINISTRATION'          TO   WSCNAME.
           IF      WSCFUNC                           =    '7300'
             MOVE  'SCHOOL ADMINISTRATION'           TO   WSCNAME.
           IF      WSCFUNC                           =    '7400'
             MOVE  'FACILITIES ACQ. AND CONSTR.'     TO   WSCNAME.
           IF      WSCFUNC                           =    '7500'
             MOVE  'FISCAL SERVICES'                 TO   WSCNAME.
           IF      WSCFUNC                           =    '7600'
             MOVE  'FOOD SERVICES'                   TO   WSCNAME.
           IF      WSCFUNC                           =    '7700'
             MOVE  'CENTRAL SERVICES'                TO   WSCNAME.
           IF      WSCFUNC                           =    '7800'
             MOVE  'PUPIL TRANSPORTATION'            TO   WSCNAME.
           IF      WSCFUNC                           =    '7900'
             MOVE  'OPERATION OF PLANT'              TO   WSCNAME.
           IF      WSCFUNC                           =    '8100'
             MOVE  'MAINTENANCE OF PLANT'            TO   WSCNAME.
041306     IF      WSCFUNC                           =    '8200'
041306       MOVE  'ADMINISTRATIVE TECHNOLOGY SER.'  TO   WSCNAME.
041306     IF      WSCFUNC                           =    '6500'
041306       MOVE  'INSTRUCTION RELATED TECHNOLOGY'  TO   WSCNAME.
       700-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  'EW026 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
                                       CDF-DISK      PR1-PRNT.
       999-EXIT.
           EXIT.
