       IDENTIFICATION DIVISION.
       PROGRAM-ID.      EW025.
       AUTHOR.          DOE.
      *****************************************************************
      *                        COST CALCULATOR                        *
      *****************************************************************
      * DATE CREATED:  06/19/95                                       *
      *****************************************************************
      * CALL #  - MMDDYY - PURPOSE                                    *
      * 9512021 - 120795 - CORRECT CALCULATION OF BENEFITS AND CORRECT*
      *                    MATCHING OF 7XXX RECORDS TO TABLE FILE(SPT)*
      * 9512053 - 121495 - CORRECT CALCULATION OF BENEFITS WHEN NO    *
      *                    FORM 5 RECORDS HAVE BEEN ENTERED FOR TABLE *
      * FIX9908 - 041499 - ADDED CHARTER SCHOOL                       *
      * FIX9904 - 050399 - ADD PROCESSING FOR FORM 7                  *
      * 2002001 - 030402 - REMOVE FUNCTIONS 6100, 6200, AND 7100 FROM *
      *                    FTE ATTRIBUTION OF INDIRECT COSTS TO THE   *
      *                    STAFF ATTRIBUTION.                         *
      * 2002002 - 030502 - CHANGE ATTRIBUTION OF RESIDUAL DIRECT COSTS*
      *                    TO STAFF FOR ALL OBJECTS OF DIRECT COST.   *
      * 2006001 - 041706 - ADD FUNCTIONS 6500 & 8200.                 *
      * 2009001 - 050709 - CHANGES FOR AARA POSTING                   *
      * 2011001 - 020411 - ADD ARRA FUNDS 8 & 9                       *
      *****************************************************************

       ENVIRONMENT DIVISION.

       INPUT-OUTPUT SECTION.
       FILE-CONTROL.

           SELECT    CRD-CARD          ASSIGN       DATABASE-EWCRDI.

           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.

           SELECT    SPT-DISK          ASSIGN       DATABASE-EWSPTI
                                       ORGANIZATION INDEXED
                                       ACCESS       SEQUENTIAL
                                       RECORD KEY   SPTDK
                                       FILE STATUS  RETSPT.

           SELECT    SCF-DISK          ASSIGN       DATABASE-EWSCFB
                                       ORGANIZATION INDEXED
                                       ACCESS       DYNAMIC
                                       RECORD KEY   SCFDK
                                       FILE STATUS  RETSCF.

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

       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        CRDRPT            PIC  X(01).
019        05        CRDPGM            PIC  X(05).
024        05        FILLER            PIC  X(57).

       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.

       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(03).
004        05        LN1MSG1           PIC  X(08).
012        05        LN1REQ            PIC  X(04).
016        05        LN1MSG2           PIC  X(06).
022        05        LN1CNT            PIC  ZZZ,ZZ9-.
030        05        LN1MSG3           PIC  X(19).
049        05        FILLER            PIC  X(84).

           COPY                        EWCRFD              OF   CPYSRC.
           COPY                        EWCDFD              OF   CPYSRC.
           COPY                        EWSPTD              OF   CPYSRC.
           COPY                        EWSCFD              OF   CPYSRC.
           COPY                        EWRWFD              OF   CPYSRC.

       WORKING-STORAGE SECTION.

       01            RET.
           05        RETCRF            PIC  X(02) VALUE '00'.
           05        RETCDF            PIC  X(02) VALUE '00'.
           05        RETSPT            PIC  X(02) VALUE '00'.
           05        RETSCF            PIC  X(02) VALUE '00'.
           05        RETSCFOLD         PIC  X(02) VALUE '00'.
           05        RETRWF            PIC  X(02) VALUE '00'.
           05        RETRWFOLD         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      ERRRPT            PIC  X(01).
             10      ERRPGM            PIC  X(05).

       01            RQR.
           05        RQRENTRY.
             10      RQRREQ.
               15    RQRREQ1           PIC  X(01).
               15    RQRREQ2           PIC  X(01).
               15    RQRREQ3           PIC  X(01).
             10      RQRID             PIC  X(02).
             10      RQRPRT            PIC  X(01).
             10      RQRDIST           PIC  X(02).
             10      RQRFY.
               15    RQRFY1            PIC  X(01).
               15    RQRFY2            PIC  X(01).
             10      RQRRPT            PIC  X(01).
             10      RQRPGM            PIC  X(05).

       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            STRSPT.
           05        STRDIST           PIC  X(02) VALUE HIGH-VALUES.
           05        STRFY             PIC  X(02) VALUE HIGH-VALUES.
           05        FILLER            PIC  X(13) VALUE HIGH-VALUES.

       01            ENDSPT.
           05        ENDDIST           PIC  X(02) VALUE LOW-VALUES.
           05        ENDFY             PIC  X(02) VALUE LOW-VALUES.
           05        FILLER            PIC  X(13) VALUE LOW-VALUES.

       01            STRCDF.
           05        STR2DIST          PIC  X(02) VALUE HIGH-VALUES.
           05        STR2FY            PIC  X(02) VALUE HIGH-VALUES.
           05        FILLER            PIC  X(14) VALUE HIGH-VALUES.

       01            ENDCDF.
           05        END2DIST          PIC  X(02) VALUE LOW-VALUES.
           05        END2FY            PIC  X(02) VALUE LOW-VALUES.
           05        FILLER            PIC  X(14) VALUE LOW-VALUES.

       01            CTR.
           05        CTRLN             PIC S9(03)       COMP-3 VALUE +0.
           05        CTRPG             PIC S9(05)       COMP-3 VALUE +0.
           05        CTRIDX            PIC S9(05)       COMP-3 VALUE +0.
           05        CTRCRD            PIC S9(03)       COMP-3 VALUE +0.
           05        CTRWRITE          PIC S9(07)       COMP-3 VALUE +0.

       01            OLDKEY.
           05        OLDDIST           PIC  X(02).
           05        OLDFY             PIC  X(02).
           05        OLDFUND           PIC  X(01).
           05        OLDTABLE          PIC  X(05).
           05        OLDSCHL           PIC  X(04).
           05        OLD1000.
             10      OLD1SAL           PIC  S9(09)         COMP-3.
             10      OLD1PCT           PIC  X(01).
             10      OLD1BEN           PIC  S9(09)         COMP-3.
             10      OLD1PRCH          PIC  S9(09)         COMP-3.
             10      OLD1MATSUP        PIC  S9(09)         COMP-3.
             10      OLD1OTHER         PIC  S9(09)         COMP-3.
             10      OLD1CAP           PIC  S9(09)         COMP-3.
           05        OLD2000.
             10      OLD26100          PIC  S9(09)         COMP-3.
             10      OLD26200          PIC  S9(09)         COMP-3.
             10      OLD26300          PIC  S9(09)         COMP-3.
             10      OLD26400          PIC  S9(09)         COMP-3.
             10      OLD27300          PIC  S9(09)         COMP-3.
             10      OLD27400          PIC  S9(09)         COMP-3.
             10      OLD27600          PIC  S9(09)         COMP-3.
             10      OLD27700          PIC  S9(09)         COMP-3.
             10      OLD27800          PIC  S9(09)         COMP-3.
             10      OLD27900          PIC  S9(09)         COMP-3.
             10      OLD28100          PIC  S9(09)         COMP-3.
041706       10      OLD28200          PIC  S9(09)         COMP-3.
041706       10      OLD26500          PIC  S9(09)         COMP-3.
           05        OLD3000.
             10      OLD36100          PIC  S9(09)         COMP-3.
             10      OLD36200          PIC  S9(09)         COMP-3.
             10      OLD36300          PIC  S9(09)         COMP-3.
             10      OLD36400          PIC  S9(09)         COMP-3.
             10      OLD37100          PIC  S9(09)         COMP-3.
             10      OLD37200          PIC  S9(09)         COMP-3.
             10      OLD37400          PIC  S9(09)         COMP-3.
             10      OLD37500          PIC  S9(09)         COMP-3.
             10      OLD37600          PIC  S9(09)         COMP-3.
             10      OLD37700          PIC  S9(09)         COMP-3.
             10      OLD37800          PIC  S9(09)         COMP-3.
             10      OLD37900          PIC  S9(09)         COMP-3.
             10      OLD38100          PIC  S9(09)         COMP-3.
041706       10      OLD38200          PIC  S9(09)         COMP-3.
041706       10      OLD36500          PIC  S9(09)         COMP-3.
           05        OLD6000.
             10      OLD66100          PIC  S9(09)         COMP-3.
             10      OLD66200          PIC  S9(09)         COMP-3.
             10      OLD66300          PIC  S9(09)         COMP-3.
             10      OLD66400          PIC  S9(09)         COMP-3.
             10      OLD67300          PIC  S9(09)         COMP-3.
             10      OLD67400          PIC  S9(09)         COMP-3.
             10      OLD67600          PIC  S9(09)         COMP-3.
             10      OLD67700          PIC  S9(09)         COMP-3.
             10      OLD67800          PIC  S9(09)         COMP-3.
             10      OLD67900          PIC  S9(09)         COMP-3.
             10      OLD68100          PIC  S9(09)         COMP-3.
041706       10      OLD68200          PIC  S9(09)         COMP-3.
041706       10      OLD66500          PIC  S9(09)         COMP-3.
           05        OLD7000.
             10      OLD7SAL           PIC  S9(09)         COMP-3.
             10      OLD7PCT           PIC  X(01).
             10      OLD7BEN           PIC  S9(09)         COMP-3.
             10      OLD7PRCH          PIC  S9(09)         COMP-3.
             10      OLD7MATSUP        PIC  S9(09)         COMP-3.
             10      OLD7OTHER         PIC  S9(09)         COMP-3.
             10      OLD7CAP           PIC  S9(09)         COMP-3.
           05        OLDTBLESUM.
             10      OLDTSSAL          PIC  S9(09)         COMP-3.
             10      OLDTSPCT          PIC   X(01).
             10      OLDTSBEN          PIC  S9(09)         COMP-3.
             10      OLDTSPRCH         PIC  S9(09)         COMP-3.
             10      OLDTSMATSUP       PIC  S9(09)         COMP-3.
             10      OLDTSOTHER        PIC  S9(09)         COMP-3.
             10      OLDTSCAP          PIC  S9(09)         COMP-3.
           05        OLDSCHLSUM.
             10      OLDSSSAL          PIC  S9(09)         COMP-3.
             10      OLDSSBEN          PIC  S9(09)         COMP-3.
             10      OLDSSPRCH         PIC  S9(09)         COMP-3.
             10      OLDSSMATSUP       PIC  S9(09)         COMP-3.
             10      OLDSSOTHER        PIC  S9(09)         COMP-3.
             10      OLDSSCAP          PIC  S9(09)         COMP-3.

       01            TST.
           05        TSTSPT            PIC  X(14).
           05        TSTCDF            PIC  X(14).

       01            FLG.
           05        FLGSPT            PIC  X(01).
           05        FLGCDF            PIC  X(01).

       01            WRK.
           05        WRKAMTS.
             10      WRKAMT1           PIC S9(09)        COMP-3.
             10      WRKAMT2           PIC S9(09)        COMP-3.
             10      WRKAMT3           PIC S9(09)        COMP-3.
             10      WRKAMT4           PIC S9(09)        COMP-3.
             10      WRKAMT5           PIC S9(09)        COMP-3.
             10      WRKAMT6           PIC S9(09)        COMP-3.
           05        WRKBENPCT         PIC S9(01)V9(08)  COMP-3.

           COPY                        EWSCL               OF   CPYSRC.
           COPY                        EWCDF               OF   CPYSRC.
           COPY                        EWSPT               OF   CPYSRC.
           COPY                        EWSCF               OF   CPYSRC.
           COPY                        EWRWF               OF   CPYSRC.

       01            OLDLN             PIC  X(133).

       01      HD1.
001        05  FILLER  PIC X(06) VALUE 'EW025 '.
           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(12) VALUE SPACES.
060        05  FILLER  PIC X(15) VALUE 'COST CALCULATOR'.
075        05  FILLER  PIC X(24) VALUE SPACES.
099        05  HD1USER PIC X(09) VALUE SPACES.
108        05  HD1MM   PIC X(02) VALUE SPACES.
110        05  FILLER  PIC X(01) VALUE '/'.
111        05  HD1DD   PIC X(02) VALUE SPACES.
113        05  FILLER  PIC X(01) VALUE '/'.
114        05  HD1YY   PIC X(02) VALUE SPACES.
116        05  FILLER  PIC X(01) VALUE SPACES.
117        05  HD1HR   PIC X(02) VALUE SPACES.
119        05  FILLER  PIC X(01) VALUE ':'.
120        05  HD1MN   PIC X(02) VALUE SPACES.
122        05  FILLER  PIC X(07) VALUE '  PAGE-'.
129        05  HD1PG   PIC ZZZ9.

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

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

       LINKAGE       SECTION.

           COPY                        EWBJR               OF CPYSRC.

       PROCEDURE DIVISION USING BJR.
      ******************************************************************
       DECLARATIVES.
       000-ERROR     SECTION.
           USE AFTER STANDARD ERROR PROCEDURE ON CRD-CARD  CRF-DISK
                                                 CDF-DISK  SPT-DISK
                                                 SCF-DISK  RWF-DISK.
       000-ENCOUNTERED.
           CONTINUE.
       END DECLARATIVES.
      *****************************************************************
       000-INPUT SECTION.
           PERFORM 490-HOUSEKEEPING    THRU 490-EXIT.
       005-LOOP.
           MOVE    SPTKEY              TO   TSTSPT
           MOVE    CDFKEY              TO   TSTCDF
           IF    ((RETSPT              NOT  =   '00')            AND
                  (RETCDF              NOT  =   '00'))              OR
                 ((TSTSPT              <    TSTCDF)              AND
                  (SPTDIST             NOT  =   OLDDIST       OR
                   SPTFY               NOT  =   OLDFY         OR
                   SPTFUND             NOT  =   OLDFUND       OR
                   SPTTABLE            NOT  =   OLDTABLE      OR
                   SPTSCHL             NOT  =   OLDSCHL))           OR
                 ((TSTSPT              NOT  <   TSTCDF)          AND
                  (CDFDIST             NOT  =   OLDDIST       OR
                   CDFFY               NOT  =   OLDFY         OR
                   CDFFUND             NOT  =   OLDFUND       OR
                   CDFTABLE            NOT  =   OLDTABLE      OR
                   CDFSCHL             NOT  =   OLDSCHL))
             PERFORM  025-1TOT         THRU 025-EXIT
             IF  ((RETSPT              NOT  =   '00')            AND
                  (RETCDF              NOT  =   '00'))              OR
                 ((TSTSPT              <    TSTCDF)              AND
                  (SPTDIST             NOT  =   OLDDIST       OR
                   SPTFY               NOT  =   OLDFY         OR
                   SPTFUND             NOT  =   OLDFUND       OR
                   SPTTABLE            NOT  =   OLDTABLE))          OR
                 ((TSTSPT              NOT  <   TSTCDF)          AND
                  (CDFDIST             NOT  =   OLDDIST       OR
                   CDFFY               NOT  =   OLDFY         OR
                   CDFFUND             NOT  =   OLDFUND       OR
                   CDFTABLE            NOT  =   OLDTABLE))
               PERFORM  035-2TOT       THRU 035-EXIT
               IF (RETSPT              NOT  =   '00')               AND
                  (RETCDF              NOT  =   '00')
                 GO                    TO   499-EOJ
               ELSE
                 PERFORM 030-2CHG      THRU 030-EXIT
             ELSE
               PERFORM 020-1CHG        THRU 020-EXIT.
           PERFORM 015-SELECT          THRU 015-EXIT
           PERFORM 010-READ            THRU 010-EXIT
           GO                          TO   005-LOOP.

      ******************************************************************
       010-READ.
           IF     (FLGSPT              =    'Y')                    AND
                  (RETSPT              =    '00')
             MOVE  SPACES              TO   FLGSPT
             READ  SPT-DISK                 NEXT
             IF   (SPTDK               >    ENDSPT)                 OR
                  (RETSPT              NOT  =   '00')
               MOVE  '99'              TO   RETSPT
               MOVE  HIGH-VALUES       TO   SPTKEY
             ELSE
               MOVE  SPTD              TO   SPT.
           IF     (FLGCDF              =    'Y')                    AND
                  (RETCDF              =    '00')
             MOVE  SPACES              TO   FLGCDF
             READ  CDF-DISK                 NEXT
             IF   (CDFDK               >    ENDCDF)                 OR
                  (RETCDF              NOT  =   '00')
               MOVE  '99'              TO   RETCDF
               MOVE  HIGH-VALUES       TO   CDFKEY
             ELSE
               MOVE  CDFD              TO   CDF.
       010-EXIT.
           EXIT.

      ******************************************************************
       015-SELECT.
           IF      TSTSPT              <    TSTCDF
             MOVE  'Y'                 TO   FLGSPT
           ELSE
             IF    TSTSPT              >    TSTCDF
               MOVE  'Y'               TO   FLGCDF
           ELSE
             IF    CDFCONTROL          <    '7001'
               MOVE  'Y'               TO   FLGCDF
           ELSE
             IF    SPTPGM              <    CDFPGM
               MOVE  'Y'               TO   FLGSPT
           ELSE
             IF    SPTPGM              >    CDFPGM
               MOVE  'Y'               TO   FLGCDF
           ELSE
               MOVE  'Y'               TO   FLGCDF   FLGSPT.

           IF     (CDFCONTROL          =    '1000')                AND
                  (FLGCDF              =    'Y')
             MOVE  CDFAMT1             TO   OLD1SAL
             MOVE  CDFPCT              TO   OLD1PCT
             MOVE  CDFAMT2             TO   OLD1BEN
             MOVE  CDFAMT3             TO   OLD1PRCH
             MOVE  CDFAMT4             TO   OLD1MATSUP
             MOVE  CDFAMT5             TO   OLD1OTHER
             MOVE  CDFAMT6             TO   OLD1CAP.
           IF     (CDFCONTROL          =    '2000')                AND
                  (FLGCDF              =    'Y')
             MOVE  CDFAMT1             TO   OLD26100
             MOVE  CDFAMT2             TO   OLD26200
             MOVE  CDFAMT3             TO   OLD26300
             MOVE  CDFAMT4             TO   OLD26400.
           IF     (CDFCONTROL          =    '2001')                AND
                  (FLGCDF              =    'Y')
             MOVE  CDFAMT1             TO   OLD27300
             MOVE  CDFAMT2             TO   OLD27400
             MOVE  CDFAMT3             TO   OLD27600
             MOVE  CDFAMT4             TO   OLD27700.
           IF     (CDFCONTROL          =    '2002')                AND
                  (FLGCDF              =    'Y')
             MOVE  CDFAMT1             TO   OLD27800
             MOVE  CDFAMT2             TO   OLD27900
041706       MOVE  CDFAMT4             TO   OLD28200
             MOVE  CDFAMT3             TO   OLD28100.
041706     IF     (CDFCONTROL          =    '2003')                AND
041706            (FLGCDF              =    'Y')
041706       MOVE  CDFAMT1             TO   OLD26500.
           IF     (CDFCONTROL          =    '3000')                AND
                  (FLGCDF              =    'Y')
             MOVE  CDFAMT1             TO   OLD36100
             MOVE  CDFAMT2             TO   OLD36200
             MOVE  CDFAMT3             TO   OLD36300
             MOVE  CDFAMT4             TO   OLD36400.
           IF     (CDFCONTROL          =    '3001')                AND
                  (FLGCDF              =    'Y')
             MOVE  CDFAMT1             TO   OLD37100
             MOVE  CDFAMT2             TO   OLD37200
             MOVE  CDFAMT3             TO   OLD37400
             MOVE  CDFAMT4             TO   OLD37500.
           IF     (CDFCONTROL          =    '3002')                AND
                  (FLGCDF              =    'Y')
             MOVE  CDFAMT1             TO   OLD37600
             MOVE  CDFAMT2             TO   OLD37700
             MOVE  CDFAMT3             TO   OLD37800
             MOVE  CDFAMT4             TO   OLD37900.
           IF     (CDFCONTROL          =    '3003')                AND
                  (FLGCDF              =    'Y')
041706       MOVE  CDFAMT2             TO   OLD38200
041706       MOVE  CDFAMT3             TO   OLD36500
             MOVE  CDFAMT1             TO   OLD38100.

050399     IF     (CDFCONTROL          =    '4000')                AND
050399            (FLGCDF              =    'Y')
050399       INITIALIZE                     RWF
050399       MOVE  CDFDIST             TO   RWFDIST
050399       MOVE  CDFFY               TO   RWFFY
050399       MOVE  CDFFUND             TO   RWFFUND
050399       MOVE  CDFTABLE            TO   RWFTABLE
050399       MOVE  CDFSCHL             TO   RWFSCHL
050399       MOVE  'A'                 TO   RWFPGM
050399       MOVE  CDFAMT1             TO   RWFDI6100
050399       MOVE  CDFAMT2             TO   RWFDI6200
050399       MOVE  CDFAMT3             TO   RWFDI6300
050399       MOVE  CDFAMT4             TO   RWFDI6400
050399       IF    RQRRPT              =    'B'
050399         MOVE  RWF               TO   RWFD
050399         WRITE RWFD
050399         IF    RETRWF            NOT  =  '00'
050399           MOVE 'RWF WRITE ERROR'  TO   LNMMSG
050399           MOVE RETRWF           TO   LNMVALUE1
050399           MOVE RWFDK            TO   LNMVALUE2
050399           PERFORM 520-PRINT     THRU 520-EXIT
050399         ELSE
050399           ADD +1                TO   CTRWRITE
050399       ELSE
050399         ADD +1                  TO   CTRWRITE.
050399     IF     (CDFCONTROL          =    '4001')                AND
050399            (FLGCDF              =    'Y')
050399       INITIALIZE                     RWF
050399       MOVE  CDFDIST             TO   RWFDIST
050399       MOVE  CDFFY               TO   RWFFY
050399       MOVE  CDFFUND             TO   RWFFUND
050399       MOVE  CDFTABLE            TO   RWFTABLE
050399       MOVE  CDFSCHL             TO   RWFSCHL
050399       MOVE  'B'                 TO   RWFPGM
050399       MOVE  CDFAMT1             TO   RWFDI7100
050399       MOVE  CDFAMT2             TO   RWFDI7200
050399       MOVE  CDFAMT3             TO   RWFSI7300
050399       MOVE  CDFAMT4             TO   RWFDI7400
050399       IF    RQRRPT              =    'B'
050399         MOVE  RWF               TO   RWFD
050399         WRITE RWFD
050399         IF    RETRWF            NOT  =  '00'
050399           MOVE 'RWF WRITE ERROR'  TO   LNMMSG
050399           MOVE RETRWF           TO   LNMVALUE1
050399           MOVE RWFDK            TO   LNMVALUE2
050399           PERFORM 520-PRINT     THRU 520-EXIT
050399         ELSE
050399           ADD +1                TO   CTRWRITE
050399       ELSE
050399         ADD +1                  TO   CTRWRITE.
050399     IF     (CDFCONTROL          =    '4002')                AND
050399            (FLGCDF              =    'Y')
050399       INITIALIZE                     RWF
050399       MOVE  CDFDIST             TO   RWFDIST
050399       MOVE  CDFFY               TO   RWFFY
050399       MOVE  CDFFUND             TO   RWFFUND
050399       MOVE  CDFTABLE            TO   RWFTABLE
050399       MOVE  CDFSCHL             TO   RWFSCHL
050399       MOVE  'C'                 TO   RWFPGM
050399       MOVE  CDFAMT1             TO   RWFDI7500
050399       MOVE  CDFAMT2             TO   RWFDI7600
050399       MOVE  CDFAMT3             TO   RWFDI7700
050399       MOVE  CDFAMT4             TO   RWFDI7800
050399       IF    RQRRPT              =    'B'
050399         MOVE  RWF               TO   RWFD
050399         WRITE RWFD
050399         IF    RETRWF            NOT  =  '00'
050399           MOVE 'RWF WRITE ERROR'  TO   LNMMSG
050399           MOVE RETRWF           TO   LNMVALUE1
050399           MOVE RWFDK            TO   LNMVALUE2
050399           PERFORM 520-PRINT     THRU 520-EXIT
050399         ELSE
050399           ADD +1                TO   CTRWRITE
050399       ELSE
050399         ADD +1                  TO   CTRWRITE.
050399     IF     (CDFCONTROL          =    '4003')                AND
050399            (FLGCDF              =    'Y')
050399       INITIALIZE                     RWF
050399       MOVE  CDFDIST             TO   RWFDIST
050399       MOVE  CDFFY               TO   RWFFY
050399       MOVE  CDFFUND             TO   RWFFUND
050399       MOVE  CDFTABLE            TO   RWFTABLE
050399       MOVE  CDFSCHL             TO   RWFSCHL
050399       MOVE  'D'                 TO   RWFPGM
050399       MOVE  CDFAMT1             TO   RWFDI7900
050399       MOVE  CDFAMT2             TO   RWFDI8100
041706       MOVE  CDFAMT3             TO   RWFDI8200
041706       MOVE  CDFAMT4             TO   RWFDI6500
050399       IF    RQRRPT              =    'B'
050399         MOVE  RWF               TO   RWFD
050399         WRITE RWFD
050399         IF    RETRWF            NOT  =  '00'
050399           MOVE 'RWF WRITE ERROR'  TO   LNMMSG
050399           MOVE RETRWF           TO   LNMVALUE1
050399           MOVE RWFDK            TO   LNMVALUE2
050399           PERFORM 520-PRINT     THRU 520-EXIT
050399         ELSE
050399           ADD +1                TO   CTRWRITE
050399       ELSE
050399         ADD +1                  TO   CTRWRITE.
050399     IF     (CDFCNBR             =    '5')                   AND
050399            (FLGCDF              =    'Y')
050399       INITIALIZE                     RWF
050399       MOVE  CDFDIST             TO   RWFDIST
050399       MOVE  CDFFY               TO   RWFFY
050399       MOVE  CDFFUND             TO   RWFFUND
050399       MOVE  CDFTABLE            TO   RWFTABLE
050399       MOVE  CDFSCHL             TO   RWFSCHL
050399       MOVE  CDFPGM              TO   RWFPGM
050399       MOVE  CDFAMT1             TO   RWFDSAL
050399       MOVE  CDFAMT2             TO   RWFDBEN
050399       MOVE  CDFAMT3             TO   RWFDPRCH
050399       MOVE  CDFAMT4             TO   RWFDMATSUP
050399       MOVE  CDFAMT5             TO   RWFDOTHER
050399       MOVE  CDFAMT6             TO   RWFDCAP
050399       MOVE  CDFAMT7             TO   RWFSI6100
050399       IF    RQRRPT              =    'B'
050399         MOVE  RWF               TO   RWFD
050399         WRITE RWFD
050399         IF    RETRWF            NOT  =  '00'
050399           MOVE 'RWF WRITE ERROR'  TO   LNMMSG
050399           MOVE RETRWF           TO   LNMVALUE1
050399           MOVE RWFDK            TO   LNMVALUE2
050399           PERFORM 520-PRINT     THRU 520-EXIT
050399         ELSE
050399           ADD +1                TO   CTRWRITE
050399       ELSE
050399         ADD +1                  TO   CTRWRITE.

           IF     (CDFCONTROL          =    '6000')                AND
                  (FLGCDF              =    'Y')
             MOVE  CDFAMT1             TO   OLD66100
             MOVE  CDFAMT2             TO   OLD66200
             MOVE  CDFAMT3             TO   OLD66300
             MOVE  CDFAMT4             TO   OLD66400.
           IF     (CDFCONTROL          =    '6001')                AND
                  (FLGCDF              =    'Y')
             MOVE  CDFAMT1             TO   OLD67300
             MOVE  CDFAMT2             TO   OLD67400
             MOVE  CDFAMT3             TO   OLD67600
             MOVE  CDFAMT4             TO   OLD67700.
           IF     (CDFCONTROL          =    '6002')                AND
                  (FLGCDF              =    'Y')
             MOVE  CDFAMT1             TO   OLD67800
             MOVE  CDFAMT2             TO   OLD67900
041706       MOVE  CDFAMT4             TO   OLD68200
             MOVE  CDFAMT3             TO   OLD68100.
041706     IF     (CDFCONTROL          =    '6003')                AND
041706            (FLGCDF              =    'Y')
041706       MOVE  CDFAMT1             TO   OLD66500.
           IF     (CDFCONTROL          =    '7000')                AND
                  (FLGCDF              =    'Y')
             MOVE  CDFAMT1             TO   OLD7SAL
             MOVE  CDFPCT              TO   OLD7PCT
             MOVE  CDFAMT2             TO   OLD7BEN
             MOVE  CDFAMT3             TO   OLD7PRCH
             MOVE  CDFAMT4             TO   OLD7MATSUP
             MOVE  CDFAMT5             TO   OLD7OTHER
             MOVE  CDFAMT6             TO   OLD7CAP.
           IF     (CDFCONTROL          =    '8000')                AND
                  (FLGCDF              =    'Y')
             INITIALIZE                     RWF
             MOVE  CDFDIST             TO   RWFDIST
             MOVE  CDFFY               TO   RWFFY
             MOVE  CDFFUND             TO   RWFFUND
             MOVE  '99999'             TO   RWFTABLE
             MOVE  '0000'              TO   RWFSCHL
             MOVE  CDFAMT1             TO   RWFRRECEN
             MOVE  CDFAMT2             TO   RWFROTHER
             MOVE  CDFAMT3             TO   RWFRCAP
             MOVE  CDFAMT4             TO   RWFRCMTYSRVC
             MOVE  CDFAMT5             TO   RWFRDEBT
             MOVE  CDFAMT6             TO   RWFRFEDIND
041499       MOVE  CDFAMT7             TO   RWFRCHRTR
             MOVE  CDFTOTAL            TO   RWFTOTAL
             IF    RQRRPT              =    'B'
               MOVE  RWF               TO   RWFD
               WRITE RWFD
               IF    RETRWF            NOT  =  '00'
                 MOVE 'RWF WRITE ERROR'  TO   LNMMSG
                 MOVE RETRWF           TO   LNMVALUE1
                 MOVE RWFDK            TO   LNMVALUE2
                 PERFORM 520-PRINT     THRU 520-EXIT
               ELSE
                 ADD +1                TO   CTRWRITE
             ELSE
               ADD +1                  TO   CTRWRITE.

           IF      FLGSPT              NOT  =  'Y'
             GO                        TO   015-EXIT.
           INITIALIZE                       WRKAMTS
120795*    IF      TSTSPT              =    TSTCDF
120795     IF     (TSTSPT              =    TSTCDF)                AND
120795            (SPTPGM              =    CDFPGM)
             MOVE  CDFAMT1             TO   WRKAMT1
             MOVE  CDFAMT2             TO   WRKAMT2
             MOVE  CDFAMT3             TO   WRKAMT3
             MOVE  CDFAMT4             TO   WRKAMT4
             MOVE  CDFAMT5             TO   WRKAMT5
             MOVE  CDFAMT6             TO   WRKAMT6.

           INITIALIZE                       RWF
           MOVE    SPTDIST             TO   RWFDIST
           MOVE    SPTFY               TO   RWFFY
           MOVE    SPTFUND             TO   RWFFUND
050709     IF      SPTTABLE (1:3)      =    '431'
050709       MOVE  '5'                 TO   RWFFUND.
050709     IF      SPTTABLE (1:3)      =    '432'
050709       MOVE  '6'                 TO   RWFFUND.
050709     IF      SPTTABLE (1:3)      =    '433'
050709       MOVE  '7'                 TO   RWFFUND.
020411     IF      SPTTABLE (1:3)      =    '434'
020411       MOVE  '8'                 TO   RWFFUND.
020411     IF      SPTTABLE (1:3)      =    '435'
020411       MOVE  '9'                 TO   RWFFUND.
           MOVE    SPTTABLE            TO   RWFTABLE
           MOVE    SPTSCHL             TO   RWFSCHL
           MOVE    SPTPGM              TO   RWFPGM

           COMPUTE RWFDSAL     ROUNDED   =  WRKAMT1                   +
                            ((OLD7SAL    - OLDSSSAL)    * SPTPGMSTF)  +
                            ((OLD1SAL    - OLDTSSAL)    * SPTALLSTF)
           IF     (OLD1PCT               =  ' ')
             COMPUTE RWFDBEN   ROUNDED   =  WRKAMT2                   +
                            ((OLD7BEN    - OLDSSBEN)    * SPTPGMSTF)  +
                            ((OLD1BEN    - OLDTSBEN)    * SPTALLSTF)
           ELSE
             IF   (OLD1PCT               =  'P')                   AND
                  (OLDTSPCT              =  'E'                 OR
121495             OLDTSPCT              =  ' '                 OR
                   OLDTSPCT              =  'N')
               IF  OLD1SAL               =  ZEROS
                 MOVE  ZERO              TO RWFDBEN
               ELSE
                 COMPUTE WRKBENPCT ROUNDED =  OLD1BEN / OLD1SAL
120795*          COMPUTE RWFDBEN   ROUNDED =  WRKAMT1 * WRKBENPCT
120795           COMPUTE RWFDBEN   ROUNDED =  RWFDSAL * WRKBENPCT
             ELSE
120795*        IF  OLD7SAL               =  ZEROS
120795*          COMPUTE RWFDBEN   ROUNDED =  (OLD1BEN - OLDTSBEN) *
120795*                                                   SPTALLSTF
120795*        ELSE
121495         IF  OLD7SAL               =  ZEROS
121495           COMPUTE RWFDBEN   ROUNDED =  (OLD1BEN - OLDTSBEN) *
121495                                                    SPTALLSTF
121495         ELSE
                 COMPUTE WRKBENPCT ROUNDED =  OLD7BEN / OLD7SAL
120795*          COMPUTE RWFDBEN   ROUNDED =  WRKAMT1 * WRKBENPCT     +
120795           COMPUTE RWFDBEN   ROUNDED =  RWFDSAL * WRKBENPCT     +
                            ((OLD1BEN    - OLDTSBEN)    * SPTALLSTF).
           COMPUTE RWFDPRCH    ROUNDED   =  WRKAMT3                   +
030502*                     ((OLD7PRCH   - OLDSSPRCH)   * SPTPGMFTE)  +
030502*                     ((OLD1PRCH   - OLDTSPRCH)   * SPTALLFTE)
030502                      ((OLD7PRCH   - OLDSSPRCH)   * SPTPGMSTF)  +
030502                      ((OLD1PRCH   - OLDTSPRCH)   * SPTALLSTF)
           COMPUTE RWFDMATSUP  ROUNDED   =  WRKAMT4                   +
030502*                     ((OLD7MATSUP - OLDSSMATSUP) * SPTPGMFTE)  +
030502*                     ((OLD1MATSUP - OLDTSMATSUP) * SPTALLFTE)
030502                      ((OLD7MATSUP - OLDSSMATSUP) * SPTPGMSTF)  +
030502                      ((OLD1MATSUP - OLDTSMATSUP) * SPTALLSTF)
           COMPUTE RWFDOTHER   ROUNDED   =  WRKAMT5                   +
                            ((OLD7OTHER  - OLDSSOTHER)  * SPTPGMSTF)  +
                            ((OLD1OTHER  - OLDTSOTHER)  * SPTALLSTF)
           COMPUTE RWFDCAP     ROUNDED   =  WRKAMT6                   +
030502*                     ((OLD7CAP    - OLDSSCAP)    * SPTPGMFTE)  +
030502*                     ((OLD1CAP    - OLDTSCAP)    * SPTALLFTE)
030502                      ((OLD7CAP    - OLDSSCAP)    * SPTPGMSTF)  +
030502                      ((OLD1CAP    - OLDTSCAP)    * SPTALLSTF)

030402*    COMPUTE RWFSI6100   ROUNDED =   (OLD26100  * SPTALLFTE)    +
030402*                                    (OLD66100  * SPTPGMFTE)
030402     COMPUTE RWFSI6100   ROUNDED =   (OLD26100  * SPTALLSTF)    +
030402                                     (OLD66100  * SPTPGMSTF)
030402*    COMPUTE RWFSI6200   ROUNDED =   (OLD26200  * SPTALLFTE)    +
030402*                                    (OLD66200  * SPTPGMFTE)
030402     COMPUTE RWFSI6200   ROUNDED =   (OLD26200  * SPTALLSTF)    +
030402                                     (OLD66200  * SPTPGMSTF)
           COMPUTE RWFSI6300   ROUNDED =   (OLD26300  * SPTALLSTF)    +
                                           (OLD66300  * SPTPGMSTF)
           COMPUTE RWFSI6400   ROUNDED =   (OLD26400  * SPTALLSTF)    +
                                           (OLD66400  * SPTPGMSTF)
           COMPUTE RWFSI7300   ROUNDED =   (OLD27300  * SPTALLSTF)    +
                                           (OLD67300  * SPTPGMSTF)
           COMPUTE RWFSI7400   ROUNDED =   (OLD27400  * SPTALLSPC)    +
                                           (OLD67400  * SPTPGMSPC)
           COMPUTE RWFSI7600   ROUNDED =   (OLD27600  * SPTALLFTE)    +
                                           (OLD67600  * SPTPGMFTE)
           COMPUTE RWFSI7700   ROUNDED =   (OLD27700  * SPTALLSTF)    +
                                           (OLD67700  * SPTPGMSTF)
           COMPUTE RWFSI7800   ROUNDED =   (OLD27800  * SPTALLFTE)    +
                                           (OLD67800  * SPTPGMFTE)
           COMPUTE RWFSI7900   ROUNDED =   (OLD27900  * SPTALLSPC)    +
                                           (OLD67900  * SPTPGMSPC)
           COMPUTE RWFSI8100   ROUNDED =   (OLD28100  * SPTALLSPC)    +
                                           (OLD68100  * SPTPGMSPC)
041706     COMPUTE RWFSI8200   ROUNDED =   (OLD28200  * SPTALLSTF)    +
041706                                     (OLD68200  * SPTPGMSTF)
041706     COMPUTE RWFSI6500   ROUNDED =   (OLD26500  * SPTALLSTF)    +
041706                                     (OLD66500  * SPTPGMSTF)

030402*    COMPUTE RWFDI6100   ROUNDED =    OLD36100  * SPTALLFTE
030402     COMPUTE RWFDI6100   ROUNDED =    OLD36100  * SPTALLSTF
030402*    COMPUTE RWFDI6200   ROUNDED =    OLD36200  * SPTALLFTE
030402     COMPUTE RWFDI6200   ROUNDED =    OLD36200  * SPTALLSTF
           COMPUTE RWFDI6300   ROUNDED =    OLD36300  * SPTALLSTF
           COMPUTE RWFDI6400   ROUNDED =    OLD36400  * SPTALLSTF
030402*    COMPUTE RWFDI7100   ROUNDED =    OLD37100  * SPTALLFTE
030402     COMPUTE RWFDI7100   ROUNDED =    OLD37100  * SPTALLSTF
           COMPUTE RWFDI7200   ROUNDED =    OLD37200  * SPTALLSTF
           COMPUTE RWFDI7400   ROUNDED =    OLD37400  * SPTALLSPC
           COMPUTE RWFDI7500   ROUNDED =    OLD37500  * SPTALLSTF
           COMPUTE RWFDI7600   ROUNDED =    OLD37600  * SPTALLFTE
           COMPUTE RWFDI7700   ROUNDED =    OLD37700  * SPTALLSTF
           COMPUTE RWFDI7800   ROUNDED =    OLD37800  * SPTALLFTE
           COMPUTE RWFDI7900   ROUNDED =    OLD37900  * SPTALLSPC
           COMPUTE RWFDI8100   ROUNDED =    OLD38100  * SPTALLSPC
041706     COMPUTE RWFDI8200   ROUNDED =    OLD38200  * SPTALLSTF
041706     COMPUTE RWFDI6500   ROUNDED =    OLD36500  * SPTALLSTF

           IF      RQRRPT              =    'B'
             MOVE  RWF                 TO   RWFD
             WRITE RWFD
             IF    RETRWF              NOT  =  '00'
               MOVE 'RWF WRITE ERROR'  TO   LNMMSG
               MOVE RETRWF             TO   LNMVALUE1
               MOVE RWFDK              TO   LNMVALUE2
               PERFORM 520-PRINT       THRU 520-EXIT
             ELSE
               ADD +1                  TO   CTRWRITE
           ELSE
             ADD +1                    TO   CTRWRITE.
       015-EXIT.
           EXIT.

      ******************************************************************
       020-1CHG.
           IF      TSTSPT              <    TSTCDF
             MOVE  SPTSCHL             TO   OLDSCHL
           ELSE
             MOVE  CDFSCHL             TO   OLDSCHL.
           INITIALIZE                       OLD6000     OLD7000
                                            OLDSCHLSUM
           MOVE    RQRDIST             TO   SCFKEY
           MOVE    RQRFY               TO   SCFFY
           IF      TSTSPT              <    TSTCDF
             MOVE  SPTFUND             TO   SCFFUND
             MOVE  SPTTABLE            TO   SCFTABLE
           ELSE
             MOVE  CDFFUND             TO   SCFFUND
             MOVE  CDFTABLE            TO   SCFTABLE.
           MOVE    OLDSCHL             TO   SCFSCHL
           MOVE    SCFKEY              TO   SCFDK
           READ    SCF-DISK
           IF      RETSCF              =    '00'
             MOVE  SCFD                TO   SCF
             MOVE  SCFSAL              TO   OLDSSSAL
             MOVE  SCFBEN              TO   OLDSSBEN
             MOVE  SCFPRCH             TO   OLDSSPRCH
             MOVE  SCFMATSUP           TO   OLDSSMATSUP
             MOVE  SCFOTHER            TO   OLDSSOTHER
             MOVE  SCFCAP              TO   OLDSSCAP.
       020-EXIT.
           EXIT.

       025-1TOT.
       025-EXIT.
           EXIT.

       030-2CHG.
           IF      TSTSPT              <    TSTCDF
             MOVE  SPTDIST             TO   OLDDIST
             MOVE  SPTFY               TO   OLDFY
             MOVE  SPTFUND             TO   OLDFUND
             MOVE  SPTTABLE            TO   OLDTABLE
           ELSE
             MOVE  CDFDIST             TO   OLDDIST
             MOVE  CDFFY               TO   OLDFY
             MOVE  CDFFUND             TO   OLDFUND
             MOVE  CDFTABLE            TO   OLDTABLE.
           INITIALIZE                       OLD1000     OLD2000
                                            OLD3000     OLDTBLESUM
           MOVE    RQRDIST             TO   SCFKEY
           MOVE    RQRFY               TO   SCFFY
           MOVE    OLDFUND             TO   SCFFUND
           MOVE    OLDTABLE            TO   SCFTABLE
           MOVE    '0000'              TO   SCFSCHL
           MOVE    SCFKEY              TO   SCFDK
           READ    SCF-DISK
           IF      RETSCF              =    '00'
             MOVE  SCFD                TO   SCF
             MOVE  SCFSAL              TO   OLDTSSAL
             MOVE  SCFPCTFLG           TO   OLDTSPCT
             MOVE  SCFBEN              TO   OLDTSBEN
             MOVE  SCFPRCH             TO   OLDTSPRCH
             MOVE  SCFMATSUP           TO   OLDTSMATSUP
             MOVE  SCFOTHER            TO   OLDTSOTHER
             MOVE  SCFCAP              TO   OLDTSCAP.

           PERFORM 020-1CHG            THRU 020-EXIT.
       030-EXIT.
           EXIT.

       035-2TOT.
       035-EXIT.
           EXIT.

      ******************************************************************
       490-HOUSEKEEPING.
           OPEN    INPUT                    CRD-CARD      CRF-DISK
                                            CDF-DISK      SPT-DISK
                   OUTPUT                   PR1-PRNT
           MOVE    ZEROS               TO   CTRWRITE
           MOVE    SPACES              TO   LN1
           MOVE    '1'                 TO   CTLCHAR
           SET     RQH1                TO   +1
           MOVE    HIGH-VALUES         TO   RQR           RQH.
           IF      BJR                 >    SPACES
             PERFORM 495-LOAD          THRU 495-EXIT
             GO                        TO   490-TEST.
           MOVE    1                   TO   CTRCRD.
       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      CTRCRD              >    1
             MOVE  'ERROR. ONLY 1 REQ.' TO  LNMMSG
             MOVE  CRD                 TO   LNMVALUE2
             PERFORM  520-PRINT        THRU 520-EXIT
             GO                        TO   490-LOAD.
           IF     (CRDPRT              NOT  =   'U')               AND
                  (CRDPRT              NOT  =   'T')               AND
                  (CRDPRT              NOT  =   'B')               AND
                  (CRDPRT              NOT  =   'N')
             MOVE  ALL '-'             TO   ERRPRT.
           IF     (CRDRPT              NOT  =   'A')               AND
                  (CRDRPT              NOT  =   'B')
             MOVE  ALL '-'             TO   ERRRPT.
           IF     (CRDDIST             =    SPACES)
             MOVE  ALL '-'             TO   ERRDIST.
           IF     (CRDFY               NOT  NUMERIC)
             MOVE  ALL '-'             TO   ERRFY.
           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    CRDRPT              TO   RQRRPT
           MOVE    SPACES              TO   SPTKEY      CDFKEY
           MOVE    CRDDIST             TO   SPTDIST     CDFDIST
           MOVE    CRDFY               TO   SPTFY       CDFFY
           IF     (SPTKEY              <    STRSPT)
             MOVE  SPTKEY              TO   STRSPT.
           INSPECT SPTKEY    REPLACING ALL  ' '         BY HIGH-VALUES
           IF     (SPTKEY              >    ENDSPT)
             MOVE  SPTKEY              TO   ENDSPT.
           IF     (CDFKEY              <    STRCDF)
             MOVE  CDFKEY              TO   STRCDF.
           INSPECT CDFKEY    REPLACING ALL  ' '         BY HIGH-VALUES
           IF     (CDFKEY              >    ENDCDF)
             MOVE  CDFKEY              TO   ENDCDF.
           ADD     +1                  TO   CTRCRD
           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.
           COMPUTE CTRIDX              =    CTRIDX - 1
           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      RQRRPT              =    'B'
             OPEN  I-O                      SCF-DISK      RWF-DISK
           ELSE
             OPEN  I-O                      SCF-DISK
                   INPUT                    RWF-DISK.
           MOVE    RETSCF              TO   RETSCFOLD
           MOVE    RETRWF              TO   RETRWFOLD
           PERFORM 493-PURGE           THRU 493-EXIT
           MOVE    RETSCFOLD           TO   RETSCF
           MOVE    RETRWFOLD           TO   RETRWF
           IF      RQRENTRY            =    HIGH-VALUES
             MOVE    'EW025 NO REQUESTS *'   TO   LNM
             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      RETSPT              NOT  =   '00'
             MOVE    'SPT OPEN ERROR'  TO   LNMMSG
             MOVE    RETSPT            TO   LNMVALUE1
             PERFORM 520-PRINT         THRU 520-EXIT.
           IF      RETSCF              NOT  =   '00'
             MOVE    'SCF OPEN ERROR'  TO   LNMMSG
             MOVE    RETSCF            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     (RETCRF              NOT  =   '00')                OR
                  (RETCDF              NOT  =   '00')                OR
                  (RETSPT              NOT  =   '00')                OR
                  (RETSCF              NOT  =   '00')                OR
                  (RETRWF              NOT  =   '00')                OR
                  (RQRENTRY            =    HIGH-VALUES)
             GO                        TO   499-EOJ.

           PERFORM 494-BUILD-SCF       THRU 494-EXIT

           PERFORM 496-HEADS           THRU 496-EXIT

           MOVE    'Y'                 TO   FLGSPT     FLGCDF
           MOVE    STRSPT              TO   SPTDK
           START   SPT-DISK        KEY >    SPTDK
           MOVE    STRCDF              TO   CDFDK
           START   CDF-DISK        KEY >    CDFDK
           IF     (RETSPT              =    '00')                   OR
                  (RETCDF              =    '00')
             PERFORM 010-READ          THRU 010-EXIT.
           PERFORM 030-2CHG            THRU 030-EXIT.
       490-EXIT.
           EXIT.

      ******************************************************************
       493-PURGE.
           MOVE    RQRDIST             TO   SCFKEY
           MOVE    RQRFY               TO   SCFFY
           MOVE    SCFKEY              TO   SCFDK
           START   SCF-DISK        KEY >=   SCFDK
           IF      RETSCF              NOT  =  '00'
             GO                        TO   493-CONT1.
       493-LOOP.
           READ    SCF-DISK            NEXT
           IF      RETSCF              =    '00'
             MOVE  SCFD                TO   SCF
             IF    SCFDIST             =    RQRDIST          AND
                   SCFFY               =    RQRFY
               DELETE SCF-DISK
               GO                      TO   493-LOOP.
       493-CONT1.
           IF      RQRRPT              NOT  =  'B'
             GO                        TO   493-EXIT.
           MOVE    RQRDIST             TO   RWFKEY
           MOVE    RQRFY               TO   RWFFY
           MOVE    RWFKEY              TO   RWFDK
           START   RWF-DISK        KEY >=   RWFDK
           IF      RETRWF              NOT  =  '00'
             GO                        TO   493-EXIT.
       493-LOOP2.
           READ    RWF-DISK            NEXT
           IF      RETRWF              =    '00'
             MOVE  RWFD                TO   CDF
             IF    RWFDIST             =    RQRDIST          AND
                   RWFFY               =    RQRFY
               DELETE RWF-DISK
               GO                      TO   493-LOOP2.
       493-EXIT.
           EXIT.

      ******************************************************************
       494-BUILD-SCF.
           MOVE    RQRDIST             TO   CDFKEY
           MOVE    RQRFY               TO   CDFFY
           MOVE    CDFKEY              TO   CDFDK
           START   CDF-DISK        KEY >    CDFDK
           READ    CDF-DISK                 NEXT
           MOVE    CDFD                TO   CDF
           IF      RETCDF              NOT  =  '00'                OR
                   CDFDIST             NOT  =  RQRDIST             OR
                   CDFFY               NOT  =  RQRFY
             GO                        TO   494-EXIT.
           INITIALIZE                       OLD1000     OLD7000
           MOVE    CDFFUND             TO   OLDFUND
           MOVE    CDFTABLE            TO   OLDTABLE
           MOVE    CDFSCHL             TO   OLDSCHL.
       494-LOOP.
           IF     (OLDSCHL             NOT  =  '0000')             AND
                 ((CDFFUND             NOT  =  OLDFUND)         OR
                  (CDFTABLE            NOT  =  OLDTABLE)        OR
                  (CDFSCHL             NOT  =  OLDSCHL))
             MOVE  RQRDIST             TO   SCFDIST
             MOVE  RQRFY               TO   SCFFY
             MOVE  OLDFUND             TO   SCFFUND
             MOVE  OLDTABLE            TO   SCFTABLE
             MOVE  OLDSCHL             TO   SCFSCHL
             MOVE  OLD7SAL             TO   SCFSAL
             MOVE  SPACES              TO   SCFPCTFLG
             MOVE  OLD7BEN             TO   SCFBEN
             MOVE  OLD7PRCH            TO   SCFPRCH
             MOVE  OLD7MATSUP          TO   SCFMATSUP
             MOVE  OLD7OTHER           TO   SCFOTHER
             MOVE  OLD7CAP             TO   SCFCAP
             IF   (OLD7SAL             >    ZERO)                  OR
                  (OLD7BEN             >    ZERO)                  OR
                  (OLD7PRCH            >    ZERO)                  OR
                  (OLD7MATSUP          >    ZERO)                  OR
                  (OLD7OTHER           >    ZERO)                  OR
                  (OLD7CAP             >    ZERO)
               MOVE  SCF               TO   SCFD
               WRITE  SCFD
               IF      RETSCF          NOT  =    '00'
                 MOVE  'SCF WRITE ERR' TO   LNMMSG
                 MOVE  RETSCF          TO   LNMVALUE1
                 MOVE  SCFDK           TO   LNMVALUE2
                 PERFORM 520-PRINT     THRU 520-EXIT.
           IF     (CDFFUND             NOT  =  OLDFUND)            OR
                  (CDFTABLE            NOT  =  OLDTABLE)           OR
                  (CDFSCHL             NOT  =  OLDSCHL)
             INITIALIZE                     OLD7000
             MOVE  CDFSCHL             TO   OLDSCHL.

           IF     (CDFFUND             NOT  =  OLDFUND)            OR
                  (CDFTABLE            NOT  =  OLDTABLE)
             MOVE  RQRDIST             TO   SCFDIST
             MOVE  RQRFY               TO   SCFFY
             MOVE  OLDFUND             TO   SCFFUND
             MOVE  OLDTABLE            TO   SCFTABLE
             MOVE  '0000'              TO   SCFSCHL
             MOVE  OLD1SAL             TO   SCFSAL
             MOVE  OLD1PCT             TO   SCFPCTFLG
             MOVE  OLD1BEN             TO   SCFBEN
             MOVE  OLD1PRCH            TO   SCFPRCH
             MOVE  OLD1MATSUP          TO   SCFMATSUP
             MOVE  OLD1OTHER           TO   SCFOTHER
             MOVE  OLD1CAP             TO   SCFCAP
             IF   (OLD1SAL             >    ZERO)                  OR
                  (OLD1BEN             >    ZERO)                  OR
                  (OLD1PRCH            >    ZERO)                  OR
                  (OLD1MATSUP          >    ZERO)                  OR
                  (OLD1OTHER           >    ZERO)                  OR
                  (OLD1CAP             >    ZERO)
               MOVE  SCF               TO   SCFD
               WRITE  SCFD
               IF      RETSCF          NOT  =    '00'
                 MOVE  'SCF WRITE ERR' TO   LNMMSG
                 MOVE  RETSCF          TO   LNMVALUE1
                 MOVE  SCFDK           TO   LNMVALUE2
                 PERFORM 520-PRINT     THRU 520-EXIT.
           IF     (CDFFUND             NOT  =  OLDFUND)            OR
                  (CDFTABLE            NOT  =  OLDTABLE)
             INITIALIZE                     OLD1000
             MOVE  CDFFUND             TO   OLDFUND
             MOVE  CDFTABLE            TO   OLDTABLE.

           IF      CDFCONTROL          =    '7000'
             ADD   CDFAMT1             TO   OLD1SAL
             ADD   CDFAMT2             TO   OLD1BEN
             ADD   CDFAMT3             TO   OLD1PRCH
             ADD   CDFAMT4             TO   OLD1MATSUP
             ADD   CDFAMT5             TO   OLD1OTHER
             ADD   CDFAMT6             TO   OLD1CAP.
           IF     (CDFCONTROL          =    '7000')                AND
                  (OLD1PCT             =    SPACES)
             IF    CDFPCT              =    'P'
               MOVE  'Y'               TO   OLD1PCT
             ELSE
               MOVE  'N'               TO   OLD1PCT.
           IF     (CDFCONTROL          =    '7000')
             IF   (CDFPCT              =    'P'                 AND
                   OLD1PCT             =    'N')                   OR
                  (CDFPCT              =    SPACES              AND
                   OLD1PCT             =    'Y')
               MOVE  'E'               TO   OLD1PCT.
           IF     (CDFCONTROL          >    '7000')                AND
                  (CDFCONTROL          <    '8000')
             ADD   CDFAMT1             TO   OLD7SAL
             ADD   CDFAMT2             TO   OLD7BEN
             ADD   CDFAMT3             TO   OLD7PRCH
             ADD   CDFAMT4             TO   OLD7MATSUP
             ADD   CDFAMT5             TO   OLD7OTHER
             ADD   CDFAMT6             TO   OLD7CAP.

           IF      RETCDF              =    '00'
             READ  CDF-DISK                 NEXT
             MOVE  CDFD                TO   CDF
             IF    RETCDF              NOT  =  '00'                OR
                   CDFDIST             NOT  =  RQRDIST             OR
                   CDFFY               NOT  =  RQRFY
               MOVE  '99'              TO   RETCDF
               MOVE  HIGH-VALUES       TO   CDF
               GO                      TO   494-LOOP
             ELSE
               GO                      TO   494-LOOP.
       494-EXIT.
           EXIT.

      ******************************************************************
       495-LOAD.
           MOVE    BJRCARD1            TO   CRD
           MOVE    SPACES              TO   ERR
           IF     (CRDPRT              NOT  =   'U')              AND
                  (CRDPRT              NOT  =   'T')              AND
                  (CRDPRT              NOT  =   'B')              AND
                  (CRDPRT              NOT  =   'N')
             MOVE  ALL '-'             TO   ERRPRT.
           IF     (CRDRPT              NOT  =   'A')              AND
                  (CRDRPT              NOT  =   'B')
             MOVE  ALL '-'             TO   ERRRPT.
           IF     (CRDDIST             =    SPACES)
             MOVE  ALL '-'             TO   ERRDIST.
           IF     (CRDFY               NOT  NUMERIC)
             MOVE  ALL '-'             TO   ERRFY.
           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    CRDRPT              TO   RQRRPT
           MOVE    SPACES              TO   SPTKEY      CDFKEY
           MOVE    CRDDIST             TO   SPTDIST     CDFDIST
           MOVE    CRDFY               TO   SPTFY       CDFFY
           IF     (SPTKEY              <    STRSPT)
             MOVE  SPTKEY              TO   STRSPT.
           INSPECT SPTKEY    REPLACING ALL  ' '         BY HIGH-VALUES
           IF     (SPTKEY              >    ENDSPT)
             MOVE  SPTKEY              TO   ENDSPT.
           IF     (CDFKEY              <    STRCDF)
             MOVE  CDFKEY              TO   STRCDF.
           INSPECT CDFKEY    REPLACING ALL  ' '         BY HIGH-VALUES
           IF     (CDFKEY              >    ENDCDF)
             MOVE  CDFKEY              TO   ENDCDF.

           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.

      ******************************************************************
       496-HEADS.
           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
           MOVE    ZEROS               TO   CTRLN         CTRPG
           MOVE    '    SCL0000'       TO   SCLKEY
           MOVE    RQRDIST             TO   SCLDIST
           MOVE    RQRFY               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.
       496-REQ.
           IF      HD1B         (HD11) =    SPACES
             SET   HD11                DOWN BY  +1
             GO                        TO   496-REQ.
           SET     HD11                UP   BY  +1
           MOVE    '-'                 TO   HD1B         (HD11)
           SET     HD11                UP   BY  +1
           MOVE    RQRREQ1             TO   HD1B         (HD11)
           SET     HD11                UP   BY  +1
           MOVE    RQRREQ2             TO   HD1B         (HD11)
           SET     HD11                UP   BY  +1
           MOVE    RQRREQ3             TO   HD1B         (HD11)
           SET     HD11                UP   BY  +1
           MOVE    '-'                 TO   HD1B         (HD11)
           SET     HD11                UP   BY  +1
           MOVE    RQRFY1              TO   HD1B         (HD11)
           SET     HD11                UP   BY  +1
           MOVE    RQRFY2              TO   HD1B         (HD11).

           SET     RQH1                TO   +1.
       496-HEAD.
           IF      RQHREQ       (RQH1) NOT  =   HIGH-VALUES
             IF      RQHREQ     (RQH1) NOT  =   RQRREQ
               SET   RQH1              UP   BY  +1
               GO                      TO   496-HEAD
             ELSE
               IF      RQHID    (RQH1) =    'H1'
                 MOVE  RQHHEAD  (RQH1) TO   HD2HEAD
                 MOVE  RQHUSER  (RQH1) TO   HD1USER
                 SET   RQH1            UP   BY  +1
                 GO                    TO   496-HEAD
               ELSE
                 IF      RQHID  (RQH1) =    'H2'
                   MOVE  RQHHEAD (RQH1) TO  HD3HEAD
                   SET   RQH1          UP   BY  +1
                   GO                  TO   496-HEAD.
           IF      RQRPRT              =    'N'
             MOVE  SPACES              TO   HD2HEAD       HD1USER
             MOVE  SPACES              TO   HD3HEAD
           ELSE
             IF      RQRPRT            =    'U'
               MOVE  SPACES            TO   HD2HEAD       HD3HEAD
             ELSE
               IF      RQRPRT          =    'T'
                 MOVE  SPACES          TO   HD1USER.
       496-HEAD2.
           MOVE    LN1                 TO   OLDLN
           MOVE    +0                  TO   CTRLN
           ADD     +1                  TO   CTRPG
           IF      RQRRPT              =    'A'
             MOVE  '* EDIT *'          TO   HD1MODE
           ELSE
             MOVE  '* POST *'          TO   HD1MODE.
           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    OLDLN               TO   LN1
           MOVE    '0'                 TO   CTLCHAR.
       496-EXIT.
           EXIT.

      ******************************************************************
       499-EOJ.
           MOVE    '0'                 TO   CTLCHAR
           MOVE    'REQUEST'           TO   LN1MSG1
           MOVE    RQRREQ              TO   LN1REQ
           MOVE    'TOTAL'             TO   LN1MSG2
           MOVE    CTRWRITE            TO   LN1CNT
           MOVE    'RWF RECORDS WRITTEN' TO LN1MSG3
           PERFORM 520-PRINT           THRU 520-EXIT
           CLOSE                            CRD-CARD      PR1-PRNT
                                            CRF-DISK      CDF-DISK
                                            SPT-DISK      SCF-DISK
                                            RWF-DISK
           GOBACK.
       499-EXIT.
           EXIT.

      ******************************************************************
       520-PRINT.
           IF      CTRLN               >    +60
             PERFORM 496-HEAD2         THRU 496-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.

