       IDENTIFICATION DIVISION.                                         EW000010
       PROGRAM-ID.      EW025.                                          EW000020
       AUTHOR.          DOE.                                            EW000030
      ***************************************************************** EW000040
      *                        COST CALCULATOR                        * EW000050
      ***************************************************************** EW000060
      * DATE CREATED:  06/19/95                                       * EW000070
      ***************************************************************** EW000080
      * CALL #  - MMDDYY - PURPOSE                                    * EW000090
      * 9511011 - 112295 - REPLACE GOBACK WITH STOP RUN.              * EW000100
      * 9512021 - 120795 - CORRECT CALCULATION OF BENEFITS AND CORRECT* EW000110
      *                    MATCHING OF 7XXX RECORDS TO TABLE FILE(SPT)* EW000120
      * 9512053 - 121495 - CORRECT CALCULATION OF BENEFITS WHEN NO    * EW000130
      *                    FORM 5 RECORDS HAVE BEEN ENTERED FOR TABLE * EW000140
      * FIX9908 - 041499 - ADDED CHARTER SCHOOL                       * EW000150
      * FIX9904 - 050399 - ADD PROCESSING FOR FORM 7                  * EW000160
      * 2002001 - 030402 - REMOVE FUNCTIONS 6100, 6200, AND 7100 FROM * EW000180
      *                    FTE ATTRIBUTION OF INDIRECT COSTS TO THE   * EW000190
      *                    STAFF ATTRIBUTION                          * EW000200
      * 2002002 - 030502 - CHANGE ATTRIBUTION OF RESIDUAL DIRECT COSTS* EW000210
      *                    TO STAFF FOR ALL OBJECTS OF DIRECT COST    * EW000220
      * 2006001 - 041706 - ADD FUNCTIONS 6500 & 8200.                 * EW000210
      ***************************************************************** EW000170
                                                                        EW000180
       ENVIRONMENT DIVISION.                                            EW000190
                                                                        EW000200
       INPUT-OUTPUT SECTION.                                            EW000210
       FILE-CONTROL.                                                    EW000220
                                                                        EW000230
MVS        SELECT    CRD-CARD          ASSIGN    UT-S-CARDIN.           EW000250
                                                                        EW000260
MVS        SELECT    PR1-PRNT          ASSIGN    UT-S-PRTOT1.           EW000280
                                                                        EW000290
MVS        SELECT    CRF-DISK          ASSIGN       DA-EWCRF            EW000310
                                       ORGANIZATION INDEXED             EW000320
                                       ACCESS       RANDOM              EW000330
                                       RECORD KEY   CRFDK               EW000340
                                       FILE STATUS  RETCRF.             EW000350
                                                                        EW000360
MVS        SELECT    CDF-DISK          ASSIGN       DA-EWCDF            EW000380
                                       ORGANIZATION INDEXED             EW000390
                                       ACCESS       SEQUENTIAL          EW000400
                                       RECORD KEY   CDFDK               EW000410
                                       FILE STATUS  RETCDF.             EW000420
                                                                        EW000430
MVS        SELECT    SPT-DISK          ASSIGN       DA-EWSPT            EW000450
                                       ORGANIZATION INDEXED             EW000460
                                       ACCESS       SEQUENTIAL          EW000470
                                       RECORD KEY   SPTDK               EW000480
                                       FILE STATUS  RETSPT.             EW000490
                                                                        EW000500
MVS        SELECT    SCF-DISK          ASSIGN       DA-EWSCF            EW000520
                                       ORGANIZATION INDEXED             EW000530
                                       ACCESS       DYNAMIC             EW000540
                                       RECORD KEY   SCFDK               EW000550
                                       FILE STATUS  RETSCF.             EW000560
                                                                        EW000570
MVS        SELECT    RWF-DISK          ASSIGN       DA-EWRWF            EW000590
                                       ORGANIZATION INDEXED             EW000600
                                       ACCESS       DYNAMIC             EW000610
                                       RECORD KEY   RWFDK               EW000620
                                       FILE STATUS  RETRWF.             EW000630
                                                                        EW000640
       DATA DIVISION.                                                   EW000650
       FILE SECTION.                                                    EW000660
                                                                        EW000670
       FD  CRD-CARD                                                     EW000680
           RECORDING MODE       IS  F                                   EW000690
           RECORD    CONTAINS   80  CHARACTERS                          EW000700
MVS        BLOCK     CONTAINS    0  RECORDS                             EW000710
           LABEL     RECORDS   ARE  OMITTED                             EW000720
           DATA      RECORDS   ARE  CRD  CRH.                           EW000730
                                                                        EW000740
       01            CRD.                                               EW000750
001        05        CRDREQ            PIC  X(03).                      EW000760
004        05        FILLER            PIC  X(01).                      EW000770
005        05        CRDID             PIC  X(02).                      EW000780
007        05        FILLER            PIC  X(01).                      EW000790
008        05        CRDPRT            PIC  X(01).                      EW000800
009        05        FILLER            PIC  X(03).                      EW000810
012        05        CRDDIST           PIC  X(02).                      EW000820
014        05        FILLER            PIC  X(02).                      EW000830
016        05        CRDFY             PIC  X(02).                      EW000840
018        05        FILLER            PIC  X(01).                      EW000850
019        05        CRDRPT            PIC  X(01).                      EW000860
020        05        CRDPGM            PIC  X(05).                      EW000870
025        05        FILLER            PIC  X(56).                      EW000880
                                                                        EW000890
       01            CRH.                                               EW000900
001        05        CRHREQ            PIC  X(03).                      EW000910
004        05        FILLER            PIC  X(01).                      EW000920
005        05        CRHID             PIC  X(02).                      EW000930
007        05        FILLER            PIC  X(01).                      EW000940
008        05        CRHUSER           PIC  X(08).                      EW000950
016        05        FILLER            PIC  X(01).                      EW000960
           05        CRHHEAD.                                           EW000970
017          10      CRHB       OCCURS 050  TIMES  INDEXED BY CRH1      EW000980
                                       PIC  X(01).                      EW000990
067        05        FILLER            PIC  X(14).                      EW001000
                                                                        EW001010
       FD  PR1-PRNT                                                     EW001020
           RECORDING MODE       IS  F                                   EW001030
VSE        RECORD    CONTAINS  133  CHARACTERS                          EW001040
MVS        BLOCK     CONTAINS    0  RECORDS                             EW001060
           LABEL     RECORDS   ARE  OMITTED                             EW001070
           DATA      RECORDS   ARE  LNM  LN1.                           EW001080
                                                                        EW001090
       01  LNM.                                                         EW001100
VSE        05        FILLER            PIC  X(01).                      EW001110
002        05        LNMMSG            PIC  X(20).                      EW001120
022        05        FILLER            PIC  X(02).                      EW001130
024        05        LNMVALUE1         PIC  X(02).                      EW001140
026        05        FILLER            PIC  X(01).                      EW001150
027        05        LNMVALUE2         PIC  X(80).                      EW001160
107        05        FILLER            PIC  X(27).                      EW001170
                                                                        EW001180
       01            LN1.                                               EW001190
VSE        05        FILLER            PIC  X(01).                      EW001200
002        05        FILLER            PIC  X(03).                      EW001210
005        05        LN1MSG1           PIC  X(08).                      EW001220
013        05        LN1REQ            PIC  X(04).                      EW001230
017        05        LN1MSG2           PIC  X(06).                      EW001240
023        05        LN1CNT            PIC  ZZZ,ZZ9-.                   EW001250
031        05        LN1MSG3           PIC  X(19).                      EW001260
050        05        FILLER            PIC  X(84).                      EW001270
                                                                        EW001280
           COPY                        EWCRFD.                          EW001290
           COPY                        EWCDFD.                          EW001300
           COPY                        EWSPTD.                          EW001310
           COPY                        EWSCFD.                          EW001320
           COPY                        EWRWFD.                          EW001330
                                                                        EW001340
       WORKING-STORAGE SECTION.                                         EW001350
                                                                        EW001360
       01            RET.                                               EW001370
           05        RETCRF            PIC  X(02) VALUE '00'.           EW001380
           05        RETCDF            PIC  X(02) VALUE '00'.           EW001390
           05        RETSPT            PIC  X(02) VALUE '00'.           EW001400
           05        RETSCF            PIC  X(02) VALUE '00'.           EW001410
           05        RETSCFOLD         PIC  X(02) VALUE '00'.           EW001420
           05        RETRWF            PIC  X(02) VALUE '00'.           EW001430
           05        RETRWFOLD         PIC  X(02) VALUE '00'.           EW001440
                                                                        EW001450
       01            SYS.                                               EW001460
           05        SYSTIME.                                           EW001470
             10      SYSHR             PIC  X(02).                      EW001480
             10      SYSMIN            PIC  X(02).                      EW001490
             10      SYSSEC            PIC  X(02).                      EW001500
           05        SYSDATE.                                           EW001510
             10      SYSYY             PIC  9(02).                      EW001520
             10      SYSMM             PIC  X(02).                      EW001530
             10      SYSDD             PIC  X(02).                      EW001540
                                                                        EW001550
       01            CTLAREA.                                           EW001560
           05        CTLCHAR           PIC  X(01) VALUE ' '.            EW001570
           05        ERR.                                               EW001580
             10      ERRREQ            PIC  X(03).                      EW001590
             10      FILLER            PIC  X(01).                      EW001600
             10      ERRID             PIC  X(02).                      EW001610
             10      FILLER            PIC  X(01).                      EW001620
             10      ERRPRT            PIC  X(01).                      EW001630
             10      FILLER            PIC  X(03).                      EW001640
             10      ERRDIST           PIC  X(02).                      EW001650
             10      FILLER            PIC  X(02).                      EW001660
             10      ERRFY             PIC  X(02).                      EW001670
             10      FILLER            PIC  X(01).                      EW001680
             10      ERRRPT            PIC  X(01).                      EW001690
             10      ERRPGM            PIC  X(05).                      EW001700
                                                                        EW001710
       01            RQR.                                               EW001720
           05        RQRENTRY.                                          EW001730
             10      RQRREQ.                                            EW001740
               15    RQRREQ1           PIC  X(01).                      EW001750
               15    RQRREQ2           PIC  X(01).                      EW001760
               15    RQRREQ3           PIC  X(01).                      EW001770
             10      RQRID             PIC  X(02).                      EW001780
             10      RQRPRT            PIC  X(01).                      EW001790
             10      RQRDIST           PIC  X(02).                      EW001800
             10      RQRFY.                                             EW001810
               15    RQRFY1            PIC  X(01).                      EW001820
               15    RQRFY2            PIC  X(01).                      EW001830
             10      RQRRPT            PIC  X(01).                      EW001840
             10      RQRPGM            PIC  X(05).                      EW001850
                                                                        EW001860
       01            RQH.                                               EW001870
           05        RQHENTRY   OCCURS 100  TIMES INDEXED BY RQH1.      EW001880
             10      RQHREQ            PIC  X(03).                      EW001890
             10      RQHID             PIC  X(02).                      EW001900
             10      RQHUSER           PIC  X(08).                      EW001910
             10      RQHHEAD.                                           EW001920
               15    RQHB       OCCURS 050  TIMES INDEXED BY RQH2       EW001930
                                       PIC  X(01).                      EW001940
                                                                        EW001950
       01            STRSPT.                                            EW001960
           05        STRDIST           PIC  X(02) VALUE HIGH-VALUES.    EW001970
           05        STRFY             PIC  X(02) VALUE HIGH-VALUES.    EW001980
           05        FILLER            PIC  X(13) VALUE HIGH-VALUES.    EW001990
                                                                        EW002000
       01            ENDSPT.                                            EW002010
           05        ENDDIST           PIC  X(02) VALUE LOW-VALUES.     EW002020
           05        ENDFY             PIC  X(02) VALUE LOW-VALUES.     EW002030
           05        FILLER            PIC  X(13) VALUE LOW-VALUES.     EW002040
                                                                        EW002050
       01            STRCDF.                                            EW002060
           05        STR2DIST          PIC  X(02) VALUE HIGH-VALUES.    EW002070
           05        STR2FY            PIC  X(02) VALUE HIGH-VALUES.    EW002080
           05        FILLER            PIC  X(14) VALUE HIGH-VALUES.    EW002090
                                                                        EW002100
       01            ENDCDF.                                            EW002110
           05        END2DIST          PIC  X(02) VALUE LOW-VALUES.     EW002120
           05        END2FY            PIC  X(02) VALUE LOW-VALUES.     EW002130
           05        FILLER            PIC  X(14) VALUE LOW-VALUES.     EW002140
                                                                        EW002150
       01            CTR.                                               EW002160
           05        CTRLN             PIC S9(03)       COMP-3 VALUE +0.EW002170
           05        CTRPG             PIC S9(05)       COMP-3 VALUE +0.EW002180
           05        CTRIDX            PIC S9(05)       COMP-3 VALUE +0.EW002190
           05        CTRCRD            PIC S9(03)       COMP-3 VALUE +0.EW002200
           05        CTRWRITE          PIC S9(07)       COMP-3 VALUE +0.EW002210
                                                                        EW002220
       01            OLDKEY.                                            EW002230
           05        OLDDIST           PIC  X(02).                      EW002240
           05        OLDFY             PIC  X(02).                      EW002250
           05        OLDFUND           PIC  X(01).                      EW002260
           05        OLDTABLE          PIC  X(05).                      EW002270
           05        OLDSCHL           PIC  X(04).                      EW002280
           05        OLD1000.                                           EW002290
             10      OLD1SAL           PIC  S9(09)         COMP-3.      EW002300
             10      OLD1PCT           PIC  X(01).                      EW002310
             10      OLD1BEN           PIC  S9(09)         COMP-3.      EW002320
             10      OLD1PRCH          PIC  S9(09)         COMP-3.      EW002330
             10      OLD1MATSUP        PIC  S9(09)         COMP-3.      EW002340
             10      OLD1OTHER         PIC  S9(09)         COMP-3.      EW002350
             10      OLD1CAP           PIC  S9(09)         COMP-3.      EW002360
           05        OLD2000.                                           EW002370
             10      OLD26100          PIC  S9(09)         COMP-3.      EW002380
             10      OLD26200          PIC  S9(09)         COMP-3.      EW002390
             10      OLD26300          PIC  S9(09)         COMP-3.      EW002400
             10      OLD26400          PIC  S9(09)         COMP-3.      EW002410
             10      OLD27300          PIC  S9(09)         COMP-3.      EW002420
             10      OLD27400          PIC  S9(09)         COMP-3.      EW002430
             10      OLD27600          PIC  S9(09)         COMP-3.      EW002440
             10      OLD27700          PIC  S9(09)         COMP-3.      EW002450
             10      OLD27800          PIC  S9(09)         COMP-3.      EW002460
             10      OLD27900          PIC  S9(09)         COMP-3.      EW002470
             10      OLD28100          PIC  S9(09)         COMP-3.      EW002480
041706       10      OLD28200          PIC  S9(09)         COMP-3.      EW002480
041706       10      OLD26500          PIC  S9(09)         COMP-3.      EW002480
           05        OLD3000.                                           EW002490
             10      OLD36100          PIC  S9(09)         COMP-3.      EW002500
             10      OLD36200          PIC  S9(09)         COMP-3.      EW002510
             10      OLD36300          PIC  S9(09)         COMP-3.      EW002520
             10      OLD36400          PIC  S9(09)         COMP-3.      EW002530
             10      OLD37100          PIC  S9(09)         COMP-3.      EW002540
             10      OLD37200          PIC  S9(09)         COMP-3.      EW002550
             10      OLD37400          PIC  S9(09)         COMP-3.      EW002560
             10      OLD37500          PIC  S9(09)         COMP-3.      EW002570
             10      OLD37600          PIC  S9(09)         COMP-3.      EW002580
             10      OLD37700          PIC  S9(09)         COMP-3.      EW002590
             10      OLD37800          PIC  S9(09)         COMP-3.      EW002600
             10      OLD37900          PIC  S9(09)         COMP-3.      EW002610
             10      OLD38100          PIC  S9(09)         COMP-3.      EW002620
041706       10      OLD38200          PIC  S9(09)         COMP-3.      EW002480
041706       10      OLD36500          PIC  S9(09)         COMP-3.      EW002480
           05        OLD6000.                                           EW002630
             10      OLD66100          PIC  S9(09)         COMP-3.      EW002640
             10      OLD66200          PIC  S9(09)         COMP-3.      EW002650
             10      OLD66300          PIC  S9(09)         COMP-3.      EW002660
             10      OLD66400          PIC  S9(09)         COMP-3.      EW002670
             10      OLD67300          PIC  S9(09)         COMP-3.      EW002680
             10      OLD67400          PIC  S9(09)         COMP-3.      EW002690
             10      OLD67600          PIC  S9(09)         COMP-3.      EW002700
             10      OLD67700          PIC  S9(09)         COMP-3.      EW002710
             10      OLD67800          PIC  S9(09)         COMP-3.      EW002720
             10      OLD67900          PIC  S9(09)         COMP-3.      EW002730
             10      OLD68100          PIC  S9(09)         COMP-3.      EW002740
041706       10      OLD68200          PIC  S9(09)         COMP-3.      EW002480
041706       10      OLD66500          PIC  S9(09)         COMP-3.      EW002480
           05        OLD7000.                                           EW002750
             10      OLD7SAL           PIC  S9(09)         COMP-3.      EW002760
             10      OLD7PCT           PIC  X(01).                      EW002770
             10      OLD7BEN           PIC  S9(09)         COMP-3.      EW002780
             10      OLD7PRCH          PIC  S9(09)         COMP-3.      EW002790
             10      OLD7MATSUP        PIC  S9(09)         COMP-3.      EW002800
             10      OLD7OTHER         PIC  S9(09)         COMP-3.      EW002810
             10      OLD7CAP           PIC  S9(09)         COMP-3.      EW002820
           05        OLDTBLESUM.                                        EW002830
             10      OLDTSSAL          PIC  S9(09)         COMP-3.      EW002840
             10      OLDTSPCT          PIC   X(01).                     EW002850
             10      OLDTSBEN          PIC  S9(09)         COMP-3.      EW002860
             10      OLDTSPRCH         PIC  S9(09)         COMP-3.      EW002870
             10      OLDTSMATSUP       PIC  S9(09)         COMP-3.      EW002880
             10      OLDTSOTHER        PIC  S9(09)         COMP-3.      EW002890
             10      OLDTSCAP          PIC  S9(09)         COMP-3.      EW002900
           05        OLDSCHLSUM.                                        EW002910
             10      OLDSSSAL          PIC  S9(09)         COMP-3.      EW002920
             10      OLDSSBEN          PIC  S9(09)         COMP-3.      EW002930
             10      OLDSSPRCH         PIC  S9(09)         COMP-3.      EW002940
             10      OLDSSMATSUP       PIC  S9(09)         COMP-3.      EW002950
             10      OLDSSOTHER        PIC  S9(09)         COMP-3.      EW002960
             10      OLDSSCAP          PIC  S9(09)         COMP-3.      EW002970
                                                                        EW002980
       01            TST.                                               EW002990
           05        TSTSPT            PIC  X(14).                      EW003000
           05        TSTCDF            PIC  X(14).                      EW003010
                                                                        EW003020
       01            FLG.                                               EW003030
           05        FLGSPT            PIC  X(01).                      EW003040
           05        FLGCDF            PIC  X(01).                      EW003050
                                                                        EW003060
       01            WRK.                                               EW003070
           05        WRKAMTS.                                           EW003080
             10      WRKAMT1           PIC S9(09)        COMP-3.        EW003090
             10      WRKAMT2           PIC S9(09)        COMP-3.        EW003100
             10      WRKAMT3           PIC S9(09)        COMP-3.        EW003110
             10      WRKAMT4           PIC S9(09)        COMP-3.        EW003120
             10      WRKAMT5           PIC S9(09)        COMP-3.        EW003130
             10      WRKAMT6           PIC S9(09)        COMP-3.        EW003140
           05        WRKBENPCT         PIC S9(01)V9(08)  COMP-3.        EW003150
                                                                        EW003160
           COPY                        EWSCL.                           EW003170
           COPY                        EWCDF.                           EW003180
           COPY                        EWSPT.                           EW003190
           COPY                        EWSCF.                           EW003200
           COPY                        EWRWF.                           EW003210
                                                                        EW003220
       01            OLDLN             PIC  X(133).                     EW003230
                                                                        EW003240
       01      HD1.                                                     EW003250
VSE        05  FILLER  PIC X(01) VALUE ' '.                             EW003260
002        05  FILLER  PIC X(06) VALUE 'EW025 '.                        EW003270
           05  HD1ABBR.                                                 EW003280
008         10 HD1B    OCCURS 22 TIMES INDEXED BY HD11 PIC X(01).       EW003290
030        05  FILLER  PIC X(11) VALUE SPACES.                          EW003300
041        05  HD1MODE PIC X(08) VALUE SPACES.                          EW003310
049        05  FILLER  PIC X(12) VALUE SPACES.                          EW003320
061        05  FILLER  PIC X(15) VALUE 'COST CALCULATOR'.               EW003330
076        05  FILLER  PIC X(24) VALUE SPACES.                          EW003340
100        05  HD1USER PIC X(09) VALUE SPACES.                          EW003350
109        05  HD1MM   PIC X(02) VALUE SPACES.                          EW003360
111        05  FILLER  PIC X(01) VALUE '/'.                             EW003370
112        05  HD1DD   PIC X(02) VALUE SPACES.                          EW003380
114        05  FILLER  PIC X(01) VALUE '/'.                             EW003390
115        05  HD1YY   PIC X(02) VALUE SPACES.                          EW003400
117        05  FILLER  PIC X(01) VALUE SPACES.                          EW003410
118        05  HD1HR   PIC X(02) VALUE SPACES.                          EW003420
120        05  FILLER  PIC X(01) VALUE ':'.                             EW003430
121        05  HD1MN   PIC X(02) VALUE SPACES.                          EW003440
123        05  FILLER  PIC X(07) VALUE '  PAGE-'.                       EW003450
130        05  HD1PG   PIC ZZZ9.                                        EW003460
                                                                        EW003470
       01      HD2.                                                     EW003480
VSE        05  FILLER  PIC X(01) VALUE ' '.                             EW003490
002        05  FILLER  PIC X(41) VALUE SPACES.                          EW003500
           05  HD2HEAD.                                                 EW003510
043         10 HD2B    OCCURS 50 TIMES INDEXED BY HD21 PIC X(01).       EW003520
093        05  FILLER  PIC X(41) VALUE SPACES.                          EW003530
                                                                        EW003540
       01      HD3.                                                     EW003550
VSE        05  FILLER  PIC X(01) VALUE ' '.                             EW003560
002        05  FILLER  PIC X(41) VALUE SPACES.                          EW003570
           05  HD3HEAD.                                                 EW003580
043         10 HD3B    OCCURS 50 TIMES INDEXED BY HD31 PIC X(01).       EW003590
093        05  FILLER  PIC X(41) VALUE SPACES.                          EW003600
                                                                        EW003610
       PROCEDURE DIVISION.                                              EW003620
      ******************************************************************EW003630
       000-INPUT SECTION.                                               EW003640
           PERFORM 490-HOUSEKEEPING    THRU 490-EXIT.                   EW003650
       005-LOOP.                                                        EW003660
           MOVE    SPTKEY              TO   TSTSPT                      EW003670
           MOVE    CDFKEY              TO   TSTCDF                      EW003680
           IF    ((RETSPT              NOT  =   '00')            AND            
                  (RETCDF              NOT  =   '00'))              OR  EW003700
                 ((TSTSPT              <    TSTCDF)              AND    EW003710
                  (SPTDIST             NOT  =   OLDDIST       OR        EW003720
                   SPTFY               NOT  =   OLDFY         OR        EW003730
                   SPTFUND             NOT  =   OLDFUND       OR        EW003740
                   SPTTABLE            NOT  =   OLDTABLE      OR        EW003750
                   SPTSCHL             NOT  =   OLDSCHL))           OR  EW003760
                 ((TSTSPT              NOT  <   TSTCDF)          AND    EW003770
                  (CDFDIST             NOT  =   OLDDIST       OR        EW003780
                   CDFFY               NOT  =   OLDFY         OR        EW003790
                   CDFFUND             NOT  =   OLDFUND       OR        EW003800
                   CDFTABLE            NOT  =   OLDTABLE      OR        EW003810
                   CDFSCHL             NOT  =   OLDSCHL))               EW003820
             PERFORM  025-1TOT         THRU 025-EXIT                    EW003830
             IF  ((RETSPT              NOT  =   '00')            AND    EW003840
                  (RETCDF              NOT  =   '00'))              OR  EW003850
                 ((TSTSPT              <    TSTCDF)              AND    EW003860
                  (SPTDIST             NOT  =   OLDDIST       OR        EW003870
                   SPTFY               NOT  =   OLDFY         OR        EW003880
                   SPTFUND             NOT  =   OLDFUND       OR        EW003890
                   SPTTABLE            NOT  =   OLDTABLE))          OR  EW003900
                 ((TSTSPT              NOT  <   TSTCDF)          AND    EW003910
                  (CDFDIST             NOT  =   OLDDIST       OR        EW003920
                   CDFFY               NOT  =   OLDFY         OR        EW003930
                   CDFFUND             NOT  =   OLDFUND       OR        EW003940
                   CDFTABLE            NOT  =   OLDTABLE))              EW003950
               PERFORM  035-2TOT       THRU 035-EXIT                    EW003960
               IF (RETSPT              NOT  =   '00')               AND EW003970
                  (RETCDF              NOT  =   '00')                   EW003980
                 GO                    TO   499-EOJ                     EW003990
               ELSE                                                     EW004000
                 PERFORM 030-2CHG      THRU 030-EXIT                    EW004010
             ELSE                                                       EW004020
               PERFORM 020-1CHG        THRU 020-EXIT.                   EW004030
           PERFORM 015-SELECT          THRU 015-EXIT                    EW004040
           PERFORM 010-READ            THRU 010-EXIT                    EW004050
           GO                          TO   005-LOOP.                   EW004060
                                                                        EW004070
      ******************************************************************EW004080
       010-READ.                                                        EW004090
           IF     (FLGSPT              =    'Y')                    AND EW004100
                  (RETSPT              =    '00')                       EW004110
             MOVE  SPACES              TO   FLGSPT                      EW004120
             READ  SPT-DISK                 NEXT                        EW004130
             IF   (SPTDK               >    ENDSPT)                 OR  EW004140
                  (RETSPT              NOT  =   '00')                   EW004150
               MOVE  '99'              TO   RETSPT                      EW004160
               MOVE  HIGH-VALUES       TO   SPTKEY                      EW004170
             ELSE                                                       EW004180
               MOVE  SPTD              TO   SPT.                        EW004190
           IF     (FLGCDF              =    'Y')                    AND EW004200
                  (RETCDF              =    '00')                       EW004210
             MOVE  SPACES              TO   FLGCDF                      EW004220
             READ  CDF-DISK                 NEXT                        EW004230
             IF   (CDFDK               >    ENDCDF)                 OR  EW004240
                  (RETCDF              NOT  =   '00')                   EW004250
               MOVE  '99'              TO   RETCDF                      EW004260
               MOVE  HIGH-VALUES       TO   CDFKEY                      EW004270
             ELSE                                                       EW004280
               MOVE  CDFD              TO   CDF.                        EW004290
       010-EXIT.                                                        EW004300
           EXIT.                                                        EW004310
                                                                        EW004320
      ******************************************************************EW004330
       015-SELECT.                                                      EW004340
           IF      TSTSPT              <    TSTCDF                      EW004350
             MOVE  'Y'                 TO   FLGSPT                      EW004360
           ELSE                                                         EW004370
             IF    TSTSPT              >    TSTCDF                      EW004380
               MOVE  'Y'               TO   FLGCDF                      EW004390
           ELSE                                                         EW004400
             IF    CDFCONTROL          <    '7001'                      EW004410
               MOVE  'Y'               TO   FLGCDF                      EW004420
           ELSE                                                         EW004430
             IF    SPTPGM              <    CDFPGM                      EW004440
               MOVE  'Y'               TO   FLGSPT                      EW004450
           ELSE                                                         EW004460
             IF    SPTPGM              >    CDFPGM                      EW004470
               MOVE  'Y'               TO   FLGCDF                      EW004480
           ELSE                                                         EW004490
               MOVE  'Y'               TO   FLGCDF   FLGSPT.            EW004500
                                                                        EW004510
           IF     (CDFCONTROL          =    '1000')                AND  EW004520
                  (FLGCDF              =    'Y')                        EW004530
             MOVE  CDFAMT1             TO   OLD1SAL                     EW004540
             MOVE  CDFPCT              TO   OLD1PCT                     EW004550
             MOVE  CDFAMT2             TO   OLD1BEN                     EW004560
             MOVE  CDFAMT3             TO   OLD1PRCH                    EW004570
             MOVE  CDFAMT4             TO   OLD1MATSUP                  EW004580
             MOVE  CDFAMT5             TO   OLD1OTHER                   EW004590
             MOVE  CDFAMT6             TO   OLD1CAP.                    EW004600
           IF     (CDFCONTROL          =    '2000')                AND  EW004610
                  (FLGCDF              =    'Y')                        EW004620
             MOVE  CDFAMT1             TO   OLD26100                    EW004630
             MOVE  CDFAMT2             TO   OLD26200                    EW004640
             MOVE  CDFAMT3             TO   OLD26300                    EW004650
             MOVE  CDFAMT4             TO   OLD26400.                   EW004660
           IF     (CDFCONTROL          =    '2001')                AND  EW004670
                  (FLGCDF              =    'Y')                        EW004680
             MOVE  CDFAMT1             TO   OLD27300                    EW004690
             MOVE  CDFAMT2             TO   OLD27400                    EW004700
             MOVE  CDFAMT3             TO   OLD27600                    EW004710
             MOVE  CDFAMT4             TO   OLD27700.                   EW004720
           IF     (CDFCONTROL          =    '2002')                AND  EW004730
                  (FLGCDF              =    'Y')                        EW004740
             MOVE  CDFAMT1             TO   OLD27800                    EW004750
             MOVE  CDFAMT2             TO   OLD27900                    EW004760
041706       MOVE  CDFAMT4             TO   OLD28200                    EW004760
             MOVE  CDFAMT3             TO   OLD28100.                   EW004770
041706     IF     (CDFCONTROL          =    '2003')                AND          
041706            (FLGCDF              =    'Y')                                
041706       MOVE  CDFAMT1             TO   OLD26500.                           
           IF     (CDFCONTROL          =    '3000')                AND  EW004780
                  (FLGCDF              =    'Y')                        EW004790
             MOVE  CDFAMT1             TO   OLD36100                    EW004800
             MOVE  CDFAMT2             TO   OLD36200                    EW004810
             MOVE  CDFAMT3             TO   OLD36300                    EW004820
             MOVE  CDFAMT4             TO   OLD36400.                   EW004830
           IF     (CDFCONTROL          =    '3001')                AND  EW004840
                  (FLGCDF              =    'Y')                        EW004850
             MOVE  CDFAMT1             TO   OLD37100                    EW004860
             MOVE  CDFAMT2             TO   OLD37200                    EW004870
             MOVE  CDFAMT3             TO   OLD37400                    EW004880
             MOVE  CDFAMT4             TO   OLD37500.                   EW004890
           IF     (CDFCONTROL          =    '3002')                AND  EW004900
                  (FLGCDF              =    'Y')                        EW004910
             MOVE  CDFAMT1             TO   OLD37600                    EW004920
             MOVE  CDFAMT2             TO   OLD37700                    EW004930
             MOVE  CDFAMT3             TO   OLD37800                    EW004940
             MOVE  CDFAMT4             TO   OLD37900.                   EW004950
           IF     (CDFCONTROL          =    '3003')                AND  EW004960
                  (FLGCDF              =    'Y')                        EW004970
041706       MOVE  CDFAMT2             TO   OLD38200                            
041706       MOVE  CDFAMT3             TO   OLD36500                            
             MOVE  CDFAMT1             TO   OLD38100.                   EW004980
050399     IF     (CDFCONTROL          =    '4000')                AND  EW004990
050399            (FLGCDF              =    'Y')                        EW005000
050399       MOVE  SPACES              TO   RWF                         EW005010
050399       MOVE  ZEROS               TO   RWFDSAL      RWFDBEN        EW005020
050399              RWFDPRCH   RWFDMATSUP   RWFDOTHER    RWFDCAP        EW005030
050399              RWFSI6100  RWFSI6200    RWFSI6300    RWFSI6400      EW005040
050399              RWFSI7300  RWFSI7400    RWFSI7600    RWFSI7700      EW005050
050399              RWFSI7800  RWFSI7900    RWFSI8100                   EW005060
050399              RWFDI6100  RWFDI6200    RWFDI6300    RWFDI6400      EW005070
050399              RWFDI7100  RWFDI7200    RWFDI7400    RWFDI7500      EW005080
050399              RWFDI7600  RWFDI7700    RWFDI7800    RWFDI7900      EW005090
050399              RWFDI8100  RWFTOTAL                                 EW005100
041706              RWFSI8200  RWFSI6500    RWFDI8200    RWFDI6500              
050399       MOVE  CDFDIST             TO   RWFDIST                     EW005110
050399       MOVE  CDFFY               TO   RWFFY                       EW005120
050399       MOVE  CDFFUND             TO   RWFFUND                     EW005130
050399       MOVE  CDFTABLE            TO   RWFTABLE                    EW005140
050399       MOVE  CDFSCHL             TO   RWFSCHL                     EW005150
050399       MOVE  'A'                 TO   RWFPGM                      EW005160
050399       MOVE  CDFAMT1             TO   RWFDI6100                   EW005170
050399       MOVE  CDFAMT2             TO   RWFDI6200                   EW005180
050399       MOVE  CDFAMT3             TO   RWFDI6300                   EW005190
050399       MOVE  CDFAMT4             TO   RWFDI6400                   EW005200
050399       IF    RQRRPT              =    'B'                         EW005210
050399         MOVE  RWF               TO   RWFD                        EW005220
050399         WRITE RWFD                                               EW005230
050399         IF    RETRWF            NOT  =  '00'                     EW005240
050399           MOVE 'RWF WRITE ERROR'  TO   LNMMSG                    EW005250
050399           MOVE RETRWF           TO   LNMVALUE1                   EW005260
050399           MOVE RWFDK            TO   LNMVALUE2                   EW005270
050399           PERFORM 520-PRINT     THRU 520-EXIT                    EW005280
050399         ELSE                                                     EW005290
050399           ADD +1                TO   CTRWRITE                    EW005300
050399       ELSE                                                       EW005310
050399         ADD +1                  TO   CTRWRITE.                   EW005320
050399     IF     (CDFCONTROL          =    '4001')                AND  EW005330
050399            (FLGCDF              =    'Y')                        EW005340
050399       MOVE  SPACES              TO   RWF                         EW005350
050399       MOVE  ZEROS               TO   RWFDSAL      RWFDBEN        EW005360
050399              RWFDPRCH   RWFDMATSUP   RWFDOTHER    RWFDCAP        EW005370
050399              RWFSI6100  RWFSI6200    RWFSI6300    RWFSI6400      EW005380
050399              RWFSI7300  RWFSI7400    RWFSI7600    RWFSI7700      EW005390
050399              RWFSI7800  RWFSI7900    RWFSI8100                   EW005400
050399              RWFDI6100  RWFDI6200    RWFDI6300    RWFDI6400      EW005410
050399              RWFDI7100  RWFDI7200    RWFDI7400    RWFDI7500      EW005420
050399              RWFDI7600  RWFDI7700    RWFDI7800    RWFDI7900      EW005430
050399              RWFDI8100  RWFTOTAL                                 EW005440
041706              RWFSI8200  RWFSI6500    RWFDI8200    RWFDI6500              
050399       MOVE  CDFDIST             TO   RWFDIST                     EW005450
050399       MOVE  CDFFY               TO   RWFFY                       EW005460
050399       MOVE  CDFFUND             TO   RWFFUND                     EW005470
050399       MOVE  CDFTABLE            TO   RWFTABLE                    EW005480
050399       MOVE  CDFSCHL             TO   RWFSCHL                     EW005490
050399       MOVE  'B'                 TO   RWFPGM                      EW005500
050399       MOVE  CDFAMT1             TO   RWFDI7100                   EW005510
050399       MOVE  CDFAMT2             TO   RWFDI7200                   EW005520
050399       MOVE  CDFAMT3             TO   RWFSI7300                   EW005530
050399       MOVE  CDFAMT4             TO   RWFDI7400                   EW005540
050399       IF    RQRRPT              =    'B'                         EW005550
050399         MOVE  RWF               TO   RWFD                        EW005560
050399         WRITE RWFD                                               EW005570
050399         IF    RETRWF            NOT  =  '00'                     EW005580
050399           MOVE 'RWF WRITE ERROR'  TO   LNMMSG                    EW005590
050399           MOVE RETRWF           TO   LNMVALUE1                   EW005600
050399           MOVE RWFDK            TO   LNMVALUE2                   EW005610
050399           PERFORM 520-PRINT     THRU 520-EXIT                    EW005620
050399         ELSE                                                     EW005630
050399           ADD +1                TO   CTRWRITE                    EW005640
050399       ELSE                                                       EW005650
050399         ADD +1                  TO   CTRWRITE.                   EW005660
050399     IF     (CDFCONTROL          =    '4002')                AND  EW005670
050399            (FLGCDF              =    'Y')                        EW005680
050399       MOVE  SPACES              TO   RWF                         EW005690
050399       MOVE  ZEROS               TO   RWFDSAL      RWFDBEN        EW005700
050399              RWFDPRCH   RWFDMATSUP   RWFDOTHER    RWFDCAP        EW005710
050399              RWFSI6100  RWFSI6200    RWFSI6300    RWFSI6400      EW005720
050399              RWFSI7300  RWFSI7400    RWFSI7600    RWFSI7700      EW005730
050399              RWFSI7800  RWFSI7900    RWFSI8100                   EW005740
050399              RWFDI6100  RWFDI6200    RWFDI6300    RWFDI6400      EW005750
050399              RWFDI7100  RWFDI7200    RWFDI7400    RWFDI7500      EW005760
050399              RWFDI7600  RWFDI7700    RWFDI7800    RWFDI7900      EW005770
050399              RWFDI8100  RWFTOTAL                                 EW005780
041706              RWFSI8200  RWFSI6500    RWFDI8200    RWFDI6500              
050399       MOVE  CDFDIST             TO   RWFDIST                     EW005790
050399       MOVE  CDFFY               TO   RWFFY                       EW005800
050399       MOVE  CDFFUND             TO   RWFFUND                     EW005810
050399       MOVE  CDFTABLE            TO   RWFTABLE                    EW005820
050399       MOVE  CDFSCHL             TO   RWFSCHL                     EW005830
050399       MOVE  'C'                 TO   RWFPGM                      EW005840
050399       MOVE  CDFAMT1             TO   RWFDI7500                   EW005850
050399       MOVE  CDFAMT2             TO   RWFDI7600                   EW005860
050399       MOVE  CDFAMT3             TO   RWFDI7700                   EW005870
050399       MOVE  CDFAMT4             TO   RWFDI7800                   EW005880
050399       IF    RQRRPT              =    'B'                         EW005890
050399         MOVE  RWF               TO   RWFD                        EW005900
050399         WRITE RWFD                                               EW005910
050399         IF    RETRWF            NOT  =  '00'                     EW005920
050399           MOVE 'RWF WRITE ERROR'  TO   LNMMSG                    EW005930
050399           MOVE RETRWF           TO   LNMVALUE1                   EW005940
050399           MOVE RWFDK            TO   LNMVALUE2                   EW005950
050399           PERFORM 520-PRINT     THRU 520-EXIT                    EW005960
050399         ELSE                                                     EW005970
050399           ADD +1                TO   CTRWRITE                    EW005980
050399       ELSE                                                       EW005990
050399         ADD +1                  TO   CTRWRITE.                   EW006000
050399     IF     (CDFCONTROL          =    '4003')                AND  EW006010
050399            (FLGCDF              =    'Y')                        EW006020
050399       MOVE  SPACES              TO   RWF                         EW006030
050399       MOVE  ZEROS               TO   RWFDSAL      RWFDBEN        EW006040
050399              RWFDPRCH   RWFDMATSUP   RWFDOTHER    RWFDCAP        EW006050
050399              RWFSI6100  RWFSI6200    RWFSI6300    RWFSI6400      EW006060
050399              RWFSI7300  RWFSI7400    RWFSI7600    RWFSI7700      EW006070
050399              RWFSI7800  RWFSI7900    RWFSI8100                   EW006080
050399              RWFDI6100  RWFDI6200    RWFDI6300    RWFDI6400      EW006090
050399              RWFDI7100  RWFDI7200    RWFDI7400    RWFDI7500      EW006100
050399              RWFDI7600  RWFDI7700    RWFDI7800    RWFDI7900      EW006110
050399              RWFDI8100  RWFTOTAL                                 EW006120
041706              RWFSI8200  RWFSI6500    RWFDI8200    RWFDI6500              
050399       MOVE  CDFDIST             TO   RWFDIST                     EW006130
050399       MOVE  CDFFY               TO   RWFFY                       EW006140
050399       MOVE  CDFFUND             TO   RWFFUND                     EW006150
050399       MOVE  CDFTABLE            TO   RWFTABLE                    EW006160
050399       MOVE  CDFSCHL             TO   RWFSCHL                     EW006170
050399       MOVE  'D'                 TO   RWFPGM                      EW006180
050399       MOVE  CDFAMT1             TO   RWFDI7900                   EW006190
050399       MOVE  CDFAMT2             TO   RWFDI8100                   EW006200
041706       MOVE  CDFAMT3             TO   RWFDI8200                           
041706       MOVE  CDFAMT4             TO   RWFDI6500                           
050399       IF    RQRRPT              =    'B'                         EW006210
050399         MOVE  RWF               TO   RWFD                        EW006220
050399         WRITE RWFD                                               EW006230
050399         IF    RETRWF            NOT  =  '00'                     EW006240
050399           MOVE 'RWF WRITE ERROR'  TO   LNMMSG                    EW006250
050399           MOVE RETRWF           TO   LNMVALUE1                   EW006260
050399           MOVE RWFDK            TO   LNMVALUE2                   EW006270
050399           PERFORM 520-PRINT     THRU 520-EXIT                    EW006280
050399         ELSE                                                     EW006290
050399           ADD +1                TO   CTRWRITE                    EW006300
050399       ELSE                                                       EW006310
050399         ADD +1                  TO   CTRWRITE.                   EW006320
050399     IF     (CDFCNBR             =    '5')                   AND  EW006330
050399            (FLGCDF              =    'Y')                        EW006340
050399       MOVE  SPACES              TO   RWF                         EW006350
050399       MOVE  ZEROS               TO   RWFDSAL      RWFDBEN        EW006360
050399              RWFDPRCH   RWFDMATSUP   RWFDOTHER    RWFDCAP        EW006370
050399              RWFSI6100  RWFSI6200    RWFSI6300    RWFSI6400      EW006380
050399              RWFSI7300  RWFSI7400    RWFSI7600    RWFSI7700      EW006390
050399              RWFSI7800  RWFSI7900    RWFSI8100                   EW006400
050399              RWFDI6100  RWFDI6200    RWFDI6300    RWFDI6400      EW006410
050399              RWFDI7100  RWFDI7200    RWFDI7400    RWFDI7500      EW006420
050399              RWFDI7600  RWFDI7700    RWFDI7800    RWFDI7900      EW006430
050399              RWFDI8100  RWFTOTAL                                 EW006440
041706              RWFSI8200  RWFSI6500    RWFDI8200    RWFDI6500              
050399       MOVE  CDFDIST             TO   RWFDIST                     EW006450
050399       MOVE  CDFFY               TO   RWFFY                       EW006460
050399       MOVE  CDFFUND             TO   RWFFUND                     EW006470
050399       MOVE  CDFTABLE            TO   RWFTABLE                    EW006480
050399       MOVE  CDFSCHL             TO   RWFSCHL                     EW006490
050399       MOVE  CDFPGM              TO   RWFPGM                      EW006500
050399       MOVE  CDFAMT1             TO   RWFDSAL                     EW006510
050399       MOVE  CDFAMT2             TO   RWFDBEN                     EW006520
050399       MOVE  CDFAMT3             TO   RWFDPRCH                    EW006530
050399       MOVE  CDFAMT4             TO   RWFDMATSUP                  EW006540
050399       MOVE  CDFAMT5             TO   RWFDOTHER                   EW006550
050399       MOVE  CDFAMT6             TO   RWFDCAP                     EW006560
050399       MOVE  CDFAMT7             TO   RWFSI6100                   EW006570
050399       IF    RQRRPT              =    'B'                         EW006580
050399         MOVE  RWF               TO   RWFD                        EW006590
050399         WRITE RWFD                                               EW006600
050399         IF    RETRWF            NOT  =  '00'                     EW006610
050399           MOVE 'RWF WRITE ERROR'  TO   LNMMSG                    EW006620
050399           MOVE RETRWF           TO   LNMVALUE1                   EW006630
050399           MOVE RWFDK            TO   LNMVALUE2                   EW006640
050399           PERFORM 520-PRINT     THRU 520-EXIT                    EW006650
050399         ELSE                                                     EW006660
050399           ADD +1                TO   CTRWRITE                    EW006670
050399       ELSE                                                       EW006680
050399         ADD +1                  TO   CTRWRITE.                   EW006690
                                                                        EW006700
           IF     (CDFCONTROL          =    '6000')                AND  EW006710
                  (FLGCDF              =    'Y')                        EW006720
             MOVE  CDFAMT1             TO   OLD66100                    EW006730
             MOVE  CDFAMT2             TO   OLD66200                    EW006740
             MOVE  CDFAMT3             TO   OLD66300                    EW006750
             MOVE  CDFAMT4             TO   OLD66400.                   EW006760
           IF     (CDFCONTROL          =    '6001')                AND  EW006770
                  (FLGCDF              =    'Y')                        EW006780
             MOVE  CDFAMT1             TO   OLD67300                    EW006790
             MOVE  CDFAMT2             TO   OLD67400                    EW006800
             MOVE  CDFAMT3             TO   OLD67600                    EW006810
             MOVE  CDFAMT4             TO   OLD67700.                   EW006820
           IF     (CDFCONTROL          =    '6002')                AND  EW006830
                  (FLGCDF              =    'Y')                        EW006840
             MOVE  CDFAMT1             TO   OLD67800                    EW006850
             MOVE  CDFAMT2             TO   OLD67900                    EW006860
041706       MOVE  CDFAMT4             TO   OLD68200                            
             MOVE  CDFAMT3             TO   OLD68100.                   EW006870
041706     IF     (CDFCONTROL          =    '6003')                AND          
041706            (FLGCDF              =    'Y')                                
041706       MOVE  CDFAMT1             TO   OLD66500.                           
           IF     (CDFCONTROL          =    '7000')                AND  EW006880
                  (FLGCDF              =    'Y')                        EW006890
             MOVE  CDFAMT1             TO   OLD7SAL                     EW006900
             MOVE  CDFPCT              TO   OLD7PCT                     EW006910
             MOVE  CDFAMT2             TO   OLD7BEN                     EW006920
             MOVE  CDFAMT3             TO   OLD7PRCH                    EW006930
             MOVE  CDFAMT4             TO   OLD7MATSUP                  EW006940
             MOVE  CDFAMT5             TO   OLD7OTHER                   EW006950
             MOVE  CDFAMT6             TO   OLD7CAP.                    EW006960
           IF     (CDFCONTROL          =    '8000')                AND  EW006970
                  (FLGCDF              =    'Y')                        EW006980
             MOVE  SPACES              TO   RWF                         EW006990
             MOVE  ZEROS               TO   RWFDSAL      RWFDBEN        EW007000
                    RWFDPRCH   RWFDMATSUP   RWFDOTHER    RWFDCAP        EW007010
                    RWFSI6100  RWFSI6200    RWFSI6300    RWFSI6400      EW007020
                    RWFSI7300  RWFSI7400    RWFSI7600    RWFSI7700      EW007030
                    RWFSI7800  RWFSI7900    RWFSI8100                   EW007040
                    RWFDI6100  RWFDI6200    RWFDI6300    RWFDI6400      EW007050
                    RWFDI7100  RWFDI7200    RWFDI7400    RWFDI7500      EW007060
                    RWFDI7600  RWFDI7700    RWFDI7800    RWFDI7900      EW007070
                    RWFDI8100  RWFTOTAL                                 EW007080
041706              RWFSI8200  RWFSI6500    RWFDI8200    RWFDI6500              
             MOVE  CDFDIST             TO   RWFDIST                     EW007090
             MOVE  CDFFY               TO   RWFFY                       EW007100
             MOVE  CDFFUND             TO   RWFFUND                     EW007110
             MOVE  '99999'             TO   RWFTABLE                    EW007120
             MOVE  '0000'              TO   RWFSCHL                     EW007130
             MOVE  CDFAMT1             TO   RWFRRECEN                   EW007140
             MOVE  CDFAMT2             TO   RWFROTHER                   EW007150
             MOVE  CDFAMT3             TO   RWFRCAP                     EW007160
             MOVE  CDFAMT4             TO   RWFRCMTYSRVC                EW007170
             MOVE  CDFAMT5             TO   RWFRDEBT                    EW007180
             MOVE  CDFAMT6             TO   RWFRFEDIND                  EW007190
041499       MOVE  CDFAMT7             TO   RWFRCHRTR                   EW007200
             MOVE  CDFTOTAL            TO   RWFTOTAL                    EW007210
             IF    RQRRPT              =    'B'                         EW007220
               MOVE  RWF               TO   RWFD                        EW007230
               WRITE RWFD                                               EW007240
               IF    RETRWF            NOT  =  '00'                     EW007250
                 MOVE 'RWF WRITE ERROR'  TO   LNMMSG                    EW007260
                 MOVE RETRWF           TO   LNMVALUE1                   EW007270
                 MOVE RWFDK            TO   LNMVALUE2                   EW007280
                 PERFORM 520-PRINT     THRU 520-EXIT                    EW007290
               ELSE                                                     EW007300
                 ADD +1                TO   CTRWRITE                    EW007310
             ELSE                                                       EW007320
               ADD +1                  TO   CTRWRITE.                   EW007330
                                                                        EW007340
           IF      FLGSPT              NOT  =  'Y'                      EW007350
             GO                        TO   015-EXIT.                   EW007360
           MOVE    ZEROS               TO   WRKAMT1   WRKAMT2   WRKAMT3 EW007370
                                            WRKAMT4   WRKAMT5   WRKAMT6 EW007380
120795*    IF      TSTSPT              =    TSTCDF                      EW007390
120795     IF     (TSTSPT              =    TSTCDF)                 AND EW007400
120795            (SPTPGM              =    CDFPGM)                     EW007410
             MOVE  CDFAMT1             TO   WRKAMT1                     EW007420
             MOVE  CDFAMT2             TO   WRKAMT2                     EW007430
             MOVE  CDFAMT3             TO   WRKAMT3                     EW007440
             MOVE  CDFAMT4             TO   WRKAMT4                     EW007450
             MOVE  CDFAMT5             TO   WRKAMT5                     EW007460
             MOVE  CDFAMT6             TO   WRKAMT6.                    EW007470
                                                                        EW007480
           MOVE    SPACES              TO   RWF                         EW007490
           MOVE    ZEROS               TO   RWFDSAL      RWFDBEN        EW007500
                    RWFDPRCH   RWFDMATSUP   RWFDOTHER    RWFDCAP        EW007510
                    RWFSI6100  RWFSI6200    RWFSI6300    RWFSI6400      EW007520
                    RWFSI7300  RWFSI7400    RWFSI7600    RWFSI7700      EW007530
                    RWFSI7800  RWFSI7900    RWFSI8100                   EW007540
                    RWFDI6100  RWFDI6200    RWFDI6300    RWFDI6400      EW007550
                    RWFDI7100  RWFDI7200    RWFDI7400    RWFDI7500      EW007560
                    RWFDI7600  RWFDI7700    RWFDI7800    RWFDI7900      EW007570
                    RWFDI8100  RWFTOTAL                                 EW007580
041706              RWFSI8200  RWFSI6500    RWFDI8200    RWFDI6500              
           MOVE    SPTDIST             TO   RWFDIST                     EW007590
           MOVE    SPTFY               TO   RWFFY                       EW007600
           MOVE    SPTFUND             TO   RWFFUND                     EW007610
           MOVE    SPTTABLE            TO   RWFTABLE                    EW007620
           MOVE    SPTSCHL             TO   RWFSCHL                     EW007630
           MOVE    SPTPGM              TO   RWFPGM                      EW007640
                                                                        EW007650
           COMPUTE RWFDSAL     ROUNDED   =  WRKAMT1                   + EW007660
                            ((OLD7SAL    - OLDSSSAL)    * SPTPGMSTF)  + EW007670
                            ((OLD1SAL    - OLDTSSAL)    * SPTALLSTF)    EW007680
           IF     (OLD1PCT               =  ' ')                        EW007690
             COMPUTE RWFDBEN   ROUNDED   =  WRKAMT2                   + EW007700
                            ((OLD7BEN    - OLDSSBEN)    * SPTPGMSTF)  + EW007710
                            ((OLD1BEN    - OLDTSBEN)    * SPTALLSTF)    EW007720
           ELSE                                                         EW007730
             IF   (OLD1PCT               =  'P')                   AND  EW007740
                  (OLDTSPCT              =  'E'                 OR      EW007750
121495             OLDTSPCT              =  ' '                 OR      EW007760
                   OLDTSPCT              =  'N')                        EW007770
               IF  OLD1SAL               =  ZEROS                       EW007780
                 MOVE  ZERO              TO RWFDBEN                     EW007790
               ELSE                                                     EW007800
                 COMPUTE WRKBENPCT ROUNDED =  OLD1BEN / OLD1SAL         EW007810
120795*          COMPUTE RWFDBEN   ROUNDED =  WRKAMT1 * WRKBENPCT       EW007820
120795           COMPUTE RWFDBEN   ROUNDED =  RWFDSAL * WRKBENPCT       EW007830
             ELSE                                                       EW007840
120795*        IF  OLD7SAL               =  ZEROS                       EW007850
120795*          COMPUTE RWFDBEN   ROUNDED =  (OLD1BEN - OLDTSBEN) *    EW007860
120795*                                                   SPTALLSTF     EW007870
120795*        ELSE                                                     EW007880
121495         IF  OLD7SAL               =  ZEROS                       EW007890
121495           COMPUTE RWFDBEN   ROUNDED =  (OLD1BEN - OLDTSBEN) *    EW007900
121495                                                    SPTALLSTF     EW007910
121495         ELSE                                                     EW007920
                 COMPUTE WRKBENPCT ROUNDED =  OLD7BEN / OLD7SAL         EW007930
120795*          COMPUTE RWFDBEN   ROUNDED =  WRKAMT1 * WRKBENPCT     + EW007940
120795           COMPUTE RWFDBEN   ROUNDED =  RWFDSAL * WRKBENPCT     + EW007950
                            ((OLD1BEN    - OLDTSBEN)    * SPTALLSTF).   EW007960
           COMPUTE RWFDPRCH    ROUNDED   =  WRKAMT3                   + EW007970
030502                      ((OLD7PRCH   - OLDSSPRCH)   * SPTPGMSTF)  + EW008060
030502                      ((OLD1PRCH   - OLDTSPRCH)   * SPTALLSTF)    EW008070
030502*                     ((OLD7PRCH   - OLDSSPRCH)   * SPTPGMFTE)  + EW008080
030502*                     ((OLD1PRCH   - OLDTSPRCH)   * SPTALLFTE)    EW008090
           COMPUTE RWFDMATSUP  ROUNDED   =  WRKAMT4                   + EW008000
030502                      ((OLD7MATSUP - OLDSSMATSUP) * SPTPGMSTF)  + EW008110
030502                      ((OLD1MATSUP - OLDTSMATSUP) * SPTALLSTF)    EW008120
030502*                     ((OLD7MATSUP - OLDSSMATSUP) * SPTPGMFTE)  + EW008130
030502*                     ((OLD1MATSUP - OLDTSMATSUP) * SPTALLFTE)    EW008140
           COMPUTE RWFDOTHER   ROUNDED   =  WRKAMT5                   + EW008030
                            ((OLD7OTHER  - OLDSSOTHER)  * SPTPGMSTF)  + EW008040
                            ((OLD1OTHER  - OLDTSOTHER)  * SPTALLSTF)    EW008050
           COMPUTE RWFDCAP     ROUNDED   =  WRKAMT6                   + EW008060
030502                      ((OLD7CAP    - OLDSSCAP)    * SPTPGMSTF)  + EW008190
030502                      ((OLD1CAP    - OLDTSCAP)    * SPTALLSTF)    EW008200
030502*                     ((OLD7CAP    - OLDSSCAP)    * SPTPGMFTE)  + EW008210
030502*                     ((OLD1CAP    - OLDTSCAP)    * SPTALLFTE)    EW008220
                                                                        EW008090
           COMPUTE RWFSI6100   ROUNDED =   (OLD26100  * SPTALLFTE)    + EW008100
                                           (OLD66100  * SPTPGMFTE)      EW008110
           COMPUTE RWFSI6200   ROUNDED =   (OLD26200  * SPTALLFTE)    + EW008120
                                           (OLD66200  * SPTPGMFTE)      EW008130
           COMPUTE RWFSI6300   ROUNDED =   (OLD26300  * SPTALLSTF)    + EW008140
                                           (OLD66300  * SPTPGMSTF)      EW008150
           COMPUTE RWFSI6400   ROUNDED =   (OLD26400  * SPTALLSTF)    + EW008160
                                           (OLD66400  * SPTPGMSTF)      EW008170
           COMPUTE RWFSI7300   ROUNDED =   (OLD27300  * SPTALLSTF)    + EW008180
                                           (OLD67300  * SPTPGMSTF)      EW008190
           COMPUTE RWFSI7400   ROUNDED =   (OLD27400  * SPTALLSPC)    + EW008200
                                           (OLD67400  * SPTPGMSPC)      EW008210
           COMPUTE RWFSI7600   ROUNDED =   (OLD27600  * SPTALLFTE)    + EW008220
                                           (OLD67600  * SPTPGMFTE)      EW008230
           COMPUTE RWFSI7700   ROUNDED =   (OLD27700  * SPTALLSTF)    + EW008240
                                           (OLD67700  * SPTPGMSTF)      EW008250
           COMPUTE RWFSI7800   ROUNDED =   (OLD27800  * SPTALLFTE)    + EW008260
                                           (OLD67800  * SPTPGMFTE)      EW008270
           COMPUTE RWFSI7900   ROUNDED =   (OLD27900  * SPTALLSPC)    + EW008280
                                           (OLD67900  * SPTPGMSPC)      EW008290
           COMPUTE RWFSI8100   ROUNDED =   (OLD28100  * SPTALLSPC)    + EW008300
                                           (OLD68100  * SPTPGMSPC)      EW008310
041706     COMPUTE RWFSI8200   ROUNDED =   (OLD28200  * SPTALLSTF)    +         
041706                                     (OLD68200  * SPTPGMSTF)              
041706     COMPUTE RWFSI6500   ROUNDED =   (OLD26500  * SPTALLSTF)    +         
041706                                     (OLD66500  * SPTPGMSTF)              
                                                                        EW008320
030402*    COMPUTE RWFDI6100   ROUNDED =    OLD36100  * SPTALLFTE       EW008510
030402     COMPUTE RWFDI6100   ROUNDED =    OLD36100  * SPTALLSTF       EW008520
030402*    COMPUTE RWFDI6200   ROUNDED =    OLD36200  * SPTALLFTE       EW008530
030402     COMPUTE RWFDI6200   ROUNDED =    OLD36200  * SPTALLSTF       EW008540
           COMPUTE RWFDI6300   ROUNDED =    OLD36300  * SPTALLSTF       EW008350
           COMPUTE RWFDI6400   ROUNDED =    OLD36400  * SPTALLSTF       EW008360
030402*    COMPUTE RWFDI7100   ROUNDED =    OLD37100  * SPTALLFTE       EW008570
030402     COMPUTE RWFDI7100   ROUNDED =    OLD37100  * SPTALLSTF       EW008580
           COMPUTE RWFDI7200   ROUNDED =    OLD37200  * SPTALLSTF       EW008380
           COMPUTE RWFDI7400   ROUNDED =    OLD37400  * SPTALLSPC       EW008390
           COMPUTE RWFDI7500   ROUNDED =    OLD37500  * SPTALLSTF       EW008400
           COMPUTE RWFDI7600   ROUNDED =    OLD37600  * SPTALLFTE       EW008410
           COMPUTE RWFDI7700   ROUNDED =    OLD37700  * SPTALLSTF       EW008420
           COMPUTE RWFDI7800   ROUNDED =    OLD37800  * SPTALLFTE       EW008430
           COMPUTE RWFDI7900   ROUNDED =    OLD37900  * SPTALLSPC       EW008440
           COMPUTE RWFDI8100   ROUNDED =    OLD38100  * SPTALLSPC       EW008450
041706     COMPUTE RWFDI8200   ROUNDED =    OLD38200  * SPTALLSTF               
041706     COMPUTE RWFDI6500   ROUNDED =    OLD36500  * SPTALLSTF               
                                                                        EW008460
           IF      RQRRPT              =    'B'                         EW008470
             MOVE  RWF                 TO   RWFD                        EW008480
             WRITE RWFD                                                 EW008490
             IF    RETRWF              NOT  =  '00'                     EW008500
               MOVE 'RWF WRITE ERROR'  TO   LNMMSG                      EW008510
               MOVE RETRWF             TO   LNMVALUE1                   EW008520
               MOVE RWFDK              TO   LNMVALUE2                   EW008530
               PERFORM 520-PRINT       THRU 520-EXIT                    EW008540
             ELSE                                                       EW008550
               ADD +1                  TO   CTRWRITE                    EW008560
           ELSE                                                         EW008570
             ADD +1                    TO   CTRWRITE.                   EW008580
       015-EXIT.                                                        EW008590
           EXIT.                                                        EW008600
                                                                        EW008610
      ******************************************************************EW008620
       020-1CHG.                                                        EW008630
           IF      TSTSPT              <    TSTCDF                      EW008640
             MOVE  SPTSCHL             TO   OLDSCHL                     EW008650
           ELSE                                                         EW008660
             MOVE  CDFSCHL             TO   OLDSCHL.                    EW008670
           MOVE    ZEROS               TO   OLD66100  OLD66200  OLD66300EW008680
                        OLD66400  OLD67300  OLD67400  OLD67600  OLD67700EW008690
                        OLD67800  OLD67900  OLD68100                    EW008700
041706                  OLD68200  OLD66500                                      
           MOVE    ZEROS               TO   OLD7SAL   OLD7BEN   OLD7PRCHEW008710
                                            OLD7MATSUP OLD7OTHER OLD7CAPEW008720
           MOVE    SPACES              TO   OLD7PCT                     EW008730
           MOVE    ZEROS               TO   OLDSSSAL    OLDSSBEN        EW008740
                                            OLDSSPRCH   OLDSSMATSUP     EW008750
                                            OLDSSOTHER  OLDSSCAP        EW008760
           MOVE    RQRDIST             TO   SCFKEY                      EW008770
           MOVE    RQRFY               TO   SCFFY                       EW008780
           IF      TSTSPT              <    TSTCDF                      EW008790
             MOVE  SPTFUND             TO   SCFFUND                     EW008800
             MOVE  SPTTABLE            TO   SCFTABLE                    EW008810
           ELSE                                                         EW008820
             MOVE  CDFFUND             TO   SCFFUND                     EW008830
             MOVE  CDFTABLE            TO   SCFTABLE.                   EW008840
           MOVE    OLDSCHL             TO   SCFSCHL                     EW008850
           MOVE    SCFKEY              TO   SCFDK                       EW008860
           READ    SCF-DISK                                             EW008870
           IF      RETSCF              =    '00'                        EW008880
             MOVE  SCFD                TO   SCF                         EW008890
             MOVE  SCFSAL              TO   OLDSSSAL                    EW008900
             MOVE  SCFBEN              TO   OLDSSBEN                    EW008910
             MOVE  SCFPRCH             TO   OLDSSPRCH                   EW008920
             MOVE  SCFMATSUP           TO   OLDSSMATSUP                 EW008930
             MOVE  SCFOTHER            TO   OLDSSOTHER                  EW008940
             MOVE  SCFCAP              TO   OLDSSCAP.                   EW008950
       020-EXIT.                                                        EW008960
           EXIT.                                                        EW008970
                                                                        EW008980
       025-1TOT.                                                        EW008990
       025-EXIT.                                                        EW009000
           EXIT.                                                        EW009010
                                                                        EW009020
       030-2CHG.                                                        EW009030
           IF      TSTSPT              <    TSTCDF                      EW009040
             MOVE  SPTDIST             TO   OLDDIST                     EW009050
             MOVE  SPTFY               TO   OLDFY                       EW009060
             MOVE  SPTFUND             TO   OLDFUND                     EW009070
             MOVE  SPTTABLE            TO   OLDTABLE                    EW009080
           ELSE                                                         EW009090
             MOVE  CDFDIST             TO   OLDDIST                     EW009100
             MOVE  CDFFY               TO   OLDFY                       EW009110
             MOVE  CDFFUND             TO   OLDFUND                     EW009120
             MOVE  CDFTABLE            TO   OLDTABLE.                   EW009130
           MOVE    ZEROS               TO   OLD1SAL   OLD1BEN   OLD1PRCHEW009140
                                            OLD1MATSUP OLD1OTHER OLD1CAPEW009150
           MOVE    SPACES              TO   OLD1PCT                     EW009160
           MOVE    ZEROS               TO   OLD26100  OLD26200  OLD26300EW009170
                        OLD26400  OLD27300  OLD27400  OLD27600  OLD27700EW009180
                        OLD27800  OLD27900  OLD28100                    EW009190
041706                  OLD28200  OLD26500                                      
           MOVE    ZEROS               TO   OLD36100  OLD36200  OLD36300EW009200
                        OLD36400  OLD37100  OLD37200  OLD37400  OLD37500EW009210
                        OLD37600  OLD37700  OLD37800  OLD37900  OLD38100EW009220
041706                  OLD38200  OLD36500                                      
           MOVE    ZEROS               TO   OLDTSSAL       OLDTSBEN     EW009230
                                            OLDTSPRCH      OLDTSMATSUP  EW009240
                                            OLDTSOTHER     OLDTSCAP     EW009250
           MOVE    SPACES              TO   OLDTSPCT                    EW009260
           MOVE    RQRDIST             TO   SCFKEY                      EW009270
           MOVE    RQRFY               TO   SCFFY                       EW009280
           MOVE    OLDFUND             TO   SCFFUND                     EW009290
           MOVE    OLDTABLE            TO   SCFTABLE                    EW009300
           MOVE    '0000'              TO   SCFSCHL                     EW009310
           MOVE    SCFKEY              TO   SCFDK                       EW009320
           READ    SCF-DISK                                             EW009330
           IF      RETSCF              =    '00'                        EW009340
             MOVE  SCFD                TO   SCF                         EW009350
             MOVE  SCFSAL              TO   OLDTSSAL                    EW009360
             MOVE  SCFPCTFLG           TO   OLDTSPCT                    EW009370
             MOVE  SCFBEN              TO   OLDTSBEN                    EW009380
             MOVE  SCFPRCH             TO   OLDTSPRCH                   EW009390
             MOVE  SCFMATSUP           TO   OLDTSMATSUP                 EW009400
             MOVE  SCFOTHER            TO   OLDTSOTHER                  EW009410
             MOVE  SCFCAP              TO   OLDTSCAP.                   EW009420
                                                                        EW009430
           PERFORM 020-1CHG            THRU 020-EXIT.                   EW009440
       030-EXIT.                                                        EW009450
           EXIT.                                                        EW009460
                                                                        EW009470
       035-2TOT.                                                        EW009480
       035-EXIT.                                                        EW009490
           EXIT.                                                        EW009500
                                                                        EW009510
      ******************************************************************EW009520
       490-HOUSEKEEPING.                                                EW009530
           OPEN    INPUT                    CRD-CARD      CRF-DISK      EW009540
                                            CDF-DISK      SPT-DISK      EW009550
                   OUTPUT                   PR1-PRNT                    EW009560
           MOVE    ZEROS               TO   CTRWRITE                    EW009570
           MOVE    SPACES              TO   LN1                         EW009580
           MOVE    '1'                 TO   CTLCHAR                     EW009590
           MOVE    HIGH-VALUES         TO   RQR           RQH.          EW009600
           SET     RQH1                TO   +1.                         EW009610
       490-LOAD.                                                        EW009620
           READ    CRD-CARD            AT   END                         EW009630
             GO                        TO   490-TEST.                   EW009640
           IF      CRDREQ              NOT  NUMERIC                     EW009650
             MOVE    CRD               TO   LNMVALUE2                   EW009660
             PERFORM 520-PRINT         THRU 520-EXIT                    EW009670
             GO                        TO   490-LOAD.                   EW009680
           MOVE    SPACES              TO   ERR                         EW009690
           IF      CRDID               =    'SL'                        EW009700
             GO                        TO   490-REQ                     EW009710
           ELSE                                                         EW009720
             IF     (CRDID             =    'H1')                    OR EW009730
                    (CRDID             =    'H2')                       EW009740
               GO                      TO   490-HEAD                    EW009750
             ELSE                                                       EW009760
               GO                      TO   490-LOAD.                   EW009770
                                                                        EW009780
       490-REQ.                                                         EW009790
           IF      CTRCRD              >    1                           EW009800
             MOVE  'ERROR. ONLY 1 REQ.' TO  LNMMSG                      EW009810
             MOVE  CRD                 TO   LNMVALUE2                   EW009820
             PERFORM  520-PRINT        THRU 520-EXIT                    EW009830
             GO                        TO   490-LOAD.                   EW009840
           IF     (CRDPRT              NOT  =   'U')               AND  EW009850
                  (CRDPRT              NOT  =   'T')               AND  EW009860
                  (CRDPRT              NOT  =   'B')               AND  EW009870
                  (CRDPRT              NOT  =   'N')                    EW009880
             MOVE  ALL '-'             TO   ERRPRT.                     EW009890
           IF     (CRDRPT              NOT  =   'A')               AND  EW009900
                  (CRDRPT              NOT  =   'B')                    EW009910
             MOVE  ALL '-'             TO   ERRRPT.                     EW009920
           IF     (CRDDIST             =    SPACES)                     EW009930
             MOVE  ALL '-'             TO   ERRDIST.                    EW009940
           IF     (CRDFY               NOT  NUMERIC)                    EW009950
             MOVE  ALL '-'             TO   ERRFY.                      EW009960
           IF      ERR                 NOT  =   SPACES                  EW009970
             MOVE    'ERROR. BYPASSED' TO   LNMMSG                      EW009980
             MOVE    CRD               TO   LNMVALUE2                   EW009990
             PERFORM 520-PRINT         THRU 520-EXIT                    EW010000
             MOVE    ERR               TO   LNMVALUE2                   EW010010
             PERFORM 520-PRINT         THRU 520-EXIT                    EW010020
             GO                        TO   490-LOAD                    EW010030
           ELSE                                                         EW010040
             MOVE    'REQUEST LOADED'  TO   LNMMSG                      EW010050
             MOVE    CRD               TO   LNMVALUE2                   EW010060
             PERFORM 520-PRINT         THRU 520-EXIT.                   EW010070
           MOVE    CRDREQ              TO   RQRREQ                      EW010080
           MOVE    CRDPRT              TO   RQRPRT                      EW010090
           MOVE    CRDDIST             TO   RQRDIST                     EW010100
           MOVE    CRDFY               TO   RQRFY                       EW010110
           MOVE    CRDRPT              TO   RQRRPT                      EW010120
           MOVE    SPACES              TO   SPTKEY      CDFKEY          EW010130
           MOVE    CRDDIST             TO   SPTDIST     CDFDIST         EW010140
           MOVE    CRDFY               TO   SPTFY       CDFFY           EW010150
           IF     (SPTKEY              <    STRSPT)                     EW010160
             MOVE  SPTKEY              TO   STRSPT.                     EW010170
           IF     (CDFKEY              <    STRCDF)                     EW010180
             MOVE  CDFKEY              TO   STRCDF.                     EW010190
           SET     SPT1                TO   +1                          EW010200
           SET     CDF1                TO   +15.                        EW010210
       490-SET.                                                         EW010220
           IF      SPTB     (SPT1)     =    SPACES                      EW010230
             MOVE  HIGH-VALUES         TO   SPTB (SPT1).                EW010240
           IF      CDFB     (CDF1)     =    SPACES                      EW010250
             MOVE  HIGH-VALUES         TO   CDFB (CDF1).                EW010260
           IF      SPT1                <    +17                         EW010270
             SET   SPT1                UP   BY  +1                      EW010280
             GO                        TO   490-SET.                    EW010290
           IF      CDF1                <    +32                         EW010300
             SET   CDF1                UP   BY  +1                      EW010310
             GO                        TO   490-SET.                    EW010320
           IF     (SPTKEY              >    ENDSPT)                     EW010330
             MOVE  SPTKEY              TO   ENDSPT.                     EW010340
           IF     (CDFKEY              >    ENDCDF)                     EW010350
             MOVE  CDFKEY              TO   ENDCDF.                     EW010360
           ADD     +1                  TO   CTRCRD                      EW010370
           GO                          TO   490-LOAD.                   EW010380
                                                                        EW010390
       490-HEAD.                                                        EW010400
           MOVE    CRD                 TO   LNMVALUE2                   EW010410
           PERFORM 520-PRINT           THRU 520-EXIT                    EW010420
           MOVE    CRHREQ              TO   RQHREQ       (RQH1)         EW010430
           MOVE    CRHID               TO   RQHID        (RQH1)         EW010440
           MOVE    CRHUSER             TO   RQHUSER      (RQH1)         EW010450
           MOVE    SPACES              TO   RQHHEAD      (RQH1)         EW010460
           MOVE    +50                 TO   CTRIDX                      EW010470
           SET     CRH1                TO   +50.                        EW010480
       490-HEAD1.                                                       EW010490
           IF      CRHB         (CRH1) =    SPACES                      EW010500
             IF      CRH1              >    +2                          EW010510
               ADD   -1                TO   CTRIDX                      EW010520
               SET   CRH1              DOWN BY  +1                      EW010530
               GO                      TO   490-HEAD1.                  EW010540
           COMPUTE CTRIDX              =    CTRIDX - 1                  EW010550
           COMPUTE CTRIDX      ROUNDED =    (50  - CTRIDX) / 2          EW010560
           SET     RQH2                TO   CTRIDX                      EW010570
           SET     CRH1                TO   +1.                         EW010580
       490-HEAD2.                                                       EW010590
           MOVE    CRHB         (CRH1) TO   RQHB         (RQH1 RQH2)    EW010600
           IF      RQH2                <    +50                         EW010610
             SET   RQH2  CRH1          UP   BY  +1                      EW010620
             GO                        TO   490-HEAD2.                  EW010630
           SET     RQH1             UP BY   +1                          EW010640
           GO                          TO   490-LOAD.                   EW010650
                                                                        EW010660
       490-TEST.                                                        EW010670
           IF      RQRRPT              =    'B'                         EW010680
             OPEN  I-O                      SCF-DISK      RWF-DISK      EW010690
           ELSE                                                         EW010700
             OPEN  I-O                      SCF-DISK                    EW010710
                   INPUT                    RWF-DISK.                   EW010720
           MOVE    RETSCF              TO   RETSCFOLD                   EW010730
           MOVE    RETRWF              TO   RETRWFOLD                   EW010740
           PERFORM 493-PURGE           THRU 493-EXIT                    EW010750
           MOVE    RETSCFOLD           TO   RETSCF                      EW010760
           MOVE    RETRWFOLD           TO   RETRWF                      EW010770
           IF      RQRENTRY            =    HIGH-VALUES                 EW010780
             MOVE    ' EW025 NO REQUESTS *'   TO   LNM                  EW010790
             PERFORM 520-PRINT         THRU 520-EXIT.                   EW010800
           IF      RETCRF              NOT  =   '00'                    EW010810
             MOVE    'CRF OPEN ERROR'  TO   LNMMSG                      EW010820
             MOVE    RETCRF            TO   LNMVALUE1                   EW010830
             PERFORM 520-PRINT         THRU 520-EXIT.                   EW010840
           IF      RETCDF              NOT  =   '00'                    EW010850
             MOVE    'CDF OPEN ERROR'  TO   LNMMSG                      EW010860
             MOVE    RETCDF            TO   LNMVALUE1                   EW010870
             PERFORM 520-PRINT         THRU 520-EXIT.                   EW010880
           IF      RETSPT              NOT  =   '00'                    EW010890
             MOVE    'SPT OPEN ERROR'  TO   LNMMSG                      EW010900
             MOVE    RETSPT            TO   LNMVALUE1                   EW010910
             PERFORM 520-PRINT         THRU 520-EXIT.                   EW010920
           IF      RETSCF              NOT  =   '00'                    EW010930
             MOVE    'SCF OPEN ERROR'  TO   LNMMSG                      EW010940
             MOVE    RETSCF            TO   LNMVALUE1                   EW010950
             PERFORM 520-PRINT         THRU 520-EXIT.                   EW010960
           IF      RETRWF              NOT  =   '00'                    EW010970
             MOVE    'RWF OPEN ERROR'  TO   LNMMSG                      EW010980
             MOVE    RETRWF            TO   LNMVALUE1                   EW010990
             PERFORM 520-PRINT         THRU 520-EXIT.                   EW011000
           IF     (RETCRF              NOT  =   '00')                OR EW011010
                  (RETCDF              NOT  =   '00')                OR EW011020
                  (RETSPT              NOT  =   '00')                OR EW011030
                  (RETSCF              NOT  =   '00')                OR EW011040
                  (RETRWF              NOT  =   '00')                OR EW011050
                  (RQRENTRY            =    HIGH-VALUES)                EW011060
             GO                        TO   499-EOJ.                    EW011070
                                                                        EW011080
           PERFORM 494-BUILD-SCF       THRU 494-EXIT                    EW011090
                                                                        EW011100
           PERFORM 496-HEADS           THRU 496-EXIT                    EW011110
                                                                        EW011120
           MOVE    'Y'                 TO   FLGSPT     FLGCDF           EW011130
           MOVE    STRSPT              TO   SPTDK                       EW011140
           START   SPT-DISK        KEY >    SPTDK                       EW011150
           MOVE    STRCDF              TO   CDFDK                       EW011160
           START   CDF-DISK        KEY >    CDFDK                       EW011170
           IF     (RETSPT              =    '00')                   OR  EW011180
                  (RETCDF              =    '00')                       EW011190
             PERFORM 010-READ          THRU 010-EXIT.                   EW011200
           PERFORM 030-2CHG            THRU 030-EXIT.                   EW011210
       490-EXIT.                                                        EW011220
           EXIT.                                                        EW011230
                                                                        EW011240
      ******************************************************************EW011250
       493-PURGE.                                                       EW011260
           MOVE    RQRDIST             TO   SCFKEY                      EW011270
           MOVE    RQRFY               TO   SCFFY                       EW011280
           MOVE    SCFKEY              TO   SCFDK                       EW011290
           START   SCF-DISK        KEY >    SCFDK                       EW011300
           IF      RETSCF              NOT  =  '00'                     EW011310
             GO                        TO   493-CONT1.                  EW011320
       493-LOOP.                                                        EW011330
           READ    SCF-DISK            NEXT                             EW011340
           IF      RETSCF              =    '00'                        EW011350
             MOVE  SCFD                TO   SCF                         EW011360
             IF    SCFDIST             =    RQRDIST          AND        EW011370
                   SCFFY               =    RQRFY                       EW011380
               DELETE SCF-DISK                                          EW011390
               GO                      TO   493-LOOP.                   EW011400
       493-CONT1.                                                       EW011410
           IF      RQRRPT              NOT  =  'B'                      EW011420
             GO                        TO   493-EXIT.                   EW011430
           MOVE    RQRDIST             TO   RWFKEY                      EW011440
           MOVE    RQRFY               TO   RWFFY                       EW011450
           MOVE    RWFKEY              TO   RWFDK                       EW011460
           START   RWF-DISK        KEY >    RWFDK                       EW011470
           IF      RETRWF              NOT  =  '00'                     EW011480
             GO                        TO   493-EXIT.                   EW011490
       493-LOOP2.                                                       EW011500
           READ    RWF-DISK            NEXT                             EW011510
           IF      RETRWF              =    '00'                        EW011520
             MOVE  RWFD                TO   CDF                         EW011530
             IF    RWFDIST             =    RQRDIST          AND        EW011540
                   RWFFY               =    RQRFY                       EW011550
               DELETE RWF-DISK                                          EW011560
               GO                      TO   493-LOOP2.                  EW011570
       493-EXIT.                                                        EW011580
           EXIT.                                                        EW011590
                                                                        EW011600
      ******************************************************************EW011610
       494-BUILD-SCF.                                                   EW011620
           MOVE    RQRDIST             TO   CDFKEY                      EW011630
           MOVE    RQRFY               TO   CDFFY                       EW011640
           MOVE    CDFKEY              TO   CDFDK                       EW011650
           START   CDF-DISK        KEY >    CDFDK                       EW011660
           READ    CDF-DISK                 NEXT                        EW011670
           MOVE    CDFD                TO   CDF                         EW011680
           IF      RETCDF              NOT  =  '00'                OR   EW011690
                   CDFDIST             NOT  =  RQRDIST             OR   EW011700
                   CDFFY               NOT  =  RQRFY                    EW011710
             GO                        TO   494-EXIT.                   EW011720
           MOVE    ZEROS               TO   OLD1SAL   OLD1BEN   OLD1PRCHEW011730
                                            OLD1MATSUP OLD1OTHER OLD1CAPEW011740
           MOVE    SPACES              TO   OLD1PCT                     EW011750
           MOVE    ZEROS               TO   OLD7SAL   OLD7BEN   OLD7PRCHEW011760
                                            OLD7MATSUP OLD7OTHER OLD7CAPEW011770
           MOVE    SPACES              TO   OLD7PCT                     EW011780
           MOVE    CDFFUND             TO   OLDFUND                     EW011790
           MOVE    CDFTABLE            TO   OLDTABLE                    EW011800
           MOVE    CDFSCHL             TO   OLDSCHL.                    EW011810
       494-LOOP.                                                        EW011820
           IF     (OLDSCHL             NOT  =  '0000')             AND  EW011830
                 ((CDFFUND             NOT  =  OLDFUND)         OR      EW011840
                  (CDFTABLE            NOT  =  OLDTABLE)        OR      EW011850
                  (CDFSCHL             NOT  =  OLDSCHL))                EW011860
             MOVE  RQRDIST             TO   SCFDIST                     EW011870
             MOVE  RQRFY               TO   SCFFY                       EW011880
             MOVE  OLDFUND             TO   SCFFUND                     EW011890
             MOVE  OLDTABLE            TO   SCFTABLE                    EW011900
             MOVE  OLDSCHL             TO   SCFSCHL                     EW011910
             MOVE  OLD7SAL             TO   SCFSAL                      EW011920
             MOVE  SPACES              TO   SCFPCTFLG                   EW011930
             MOVE  OLD7BEN             TO   SCFBEN                      EW011940
             MOVE  OLD7PRCH            TO   SCFPRCH                     EW011950
             MOVE  OLD7MATSUP          TO   SCFMATSUP                   EW011960
             MOVE  OLD7OTHER           TO   SCFOTHER                    EW011970
             MOVE  OLD7CAP             TO   SCFCAP                      EW011980
             IF   (OLD7SAL             >    ZERO)                  OR   EW011990
                  (OLD7BEN             >    ZERO)                  OR   EW012000
                  (OLD7PRCH            >    ZERO)                  OR   EW012010
                  (OLD7MATSUP          >    ZERO)                  OR   EW012020
                  (OLD7OTHER           >    ZERO)                  OR   EW012030
                  (OLD7CAP             >    ZERO)                       EW012040
               MOVE  SCF               TO   SCFD                        EW012050
               WRITE  SCFD                                              EW012060
               IF      RETSCF          NOT  =    '00'                   EW012070
                 MOVE  'SCF WRITE ERR' TO   LNMMSG                      EW012080
                 MOVE  RETSCF          TO   LNMVALUE1                   EW012090
                 MOVE  SCFDK           TO   LNMVALUE2                   EW012100
                 PERFORM 520-PRINT     THRU 520-EXIT.                   EW012110
           IF     (CDFFUND             NOT  =  OLDFUND)            OR   EW012120
                  (CDFTABLE            NOT  =  OLDTABLE)           OR   EW012130
                  (CDFSCHL             NOT  =  OLDSCHL)                 EW012140
             MOVE  ZEROS               TO   OLD7SAL   OLD7BEN   OLD7PRCHEW012150
                                            OLD7MATSUP OLD7OTHER OLD7CAPEW012160
             MOVE  SPACES              TO   OLD7PCT                     EW012170
             MOVE  CDFSCHL             TO   OLDSCHL.                    EW012180
                                                                        EW012190
           IF     (CDFFUND             NOT  =  OLDFUND)            OR   EW012200
                  (CDFTABLE            NOT  =  OLDTABLE)                EW012210
             MOVE  RQRDIST             TO   SCFDIST                     EW012220
             MOVE  RQRFY               TO   SCFFY                       EW012230
             MOVE  OLDFUND             TO   SCFFUND                     EW012240
             MOVE  OLDTABLE            TO   SCFTABLE                    EW012250
             MOVE  '0000'              TO   SCFSCHL                     EW012260
             MOVE  OLD1SAL             TO   SCFSAL                      EW012270
             MOVE  OLD1PCT             TO   SCFPCTFLG                   EW012280
             MOVE  OLD1BEN             TO   SCFBEN                      EW012290
             MOVE  OLD1PRCH            TO   SCFPRCH                     EW012300
             MOVE  OLD1MATSUP          TO   SCFMATSUP                   EW012310
             MOVE  OLD1OTHER           TO   SCFOTHER                    EW012320
             MOVE  OLD1CAP             TO   SCFCAP                      EW012330
             IF   (OLD1SAL             >    ZERO)                  OR   EW012340
                  (OLD1BEN             >    ZERO)                  OR   EW012350
                  (OLD1PRCH            >    ZERO)                  OR   EW012360
                  (OLD1MATSUP          >    ZERO)                  OR   EW012370
                  (OLD1OTHER           >    ZERO)                  OR   EW012380
                  (OLD1CAP             >    ZERO)                       EW012390
               MOVE  SCF               TO   SCFD                        EW012400
               WRITE  SCFD                                              EW012410
               IF      RETSCF          NOT  =    '00'                   EW012420
                 MOVE  'SCF WRITE ERR' TO   LNMMSG                      EW012430
                 MOVE  RETSCF          TO   LNMVALUE1                   EW012440
                 MOVE  SCFDK           TO   LNMVALUE2                   EW012450
                 PERFORM 520-PRINT     THRU 520-EXIT.                   EW012460
           IF     (CDFFUND             NOT  =  OLDFUND)            OR   EW012470
                  (CDFTABLE            NOT  =  OLDTABLE)                EW012480
             MOVE  ZEROS               TO   OLD1SAL   OLD1BEN   OLD1PRCHEW012490
                                            OLD1MATSUP OLD1OTHER OLD1CAPEW012500
             MOVE  SPACES              TO   OLD1PCT                     EW012510
             MOVE  CDFFUND             TO   OLDFUND                     EW012520
             MOVE  CDFTABLE            TO   OLDTABLE.                   EW012530
                                                                        EW012540
           IF      CDFCONTROL          =    '7000'                      EW012550
             ADD   CDFAMT1             TO   OLD1SAL                     EW012560
             ADD   CDFAMT2             TO   OLD1BEN                     EW012570
             ADD   CDFAMT3             TO   OLD1PRCH                    EW012580
             ADD   CDFAMT4             TO   OLD1MATSUP                  EW012590
             ADD   CDFAMT5             TO   OLD1OTHER                   EW012600
             ADD   CDFAMT6             TO   OLD1CAP.                    EW012610
           IF     (CDFCONTROL          =    '7000')                AND  EW012620
                  (OLD1PCT             =    SPACES)                     EW012630
             IF    CDFPCT              =    'P'                         EW012640
               MOVE  'Y'               TO   OLD1PCT                     EW012650
             ELSE                                                       EW012660
               MOVE  'N'               TO   OLD1PCT.                    EW012670
           IF     (CDFCONTROL          =    '7000')                     EW012680
             IF   (CDFPCT              =    'P'                 AND     EW012690
                   OLD1PCT             =    'N')                   OR   EW012700
                  (CDFPCT              =    SPACES              AND     EW012710
                   OLD1PCT             =    'Y')                        EW012720
               MOVE  'E'               TO   OLD1PCT.                    EW012730
           IF     (CDFCONTROL          >    '7000')                AND  EW012740
                  (CDFCONTROL          <    '8000')                     EW012750
             ADD   CDFAMT1             TO   OLD7SAL                     EW012760
             ADD   CDFAMT2             TO   OLD7BEN                     EW012770
             ADD   CDFAMT3             TO   OLD7PRCH                    EW012780
             ADD   CDFAMT4             TO   OLD7MATSUP                  EW012790
             ADD   CDFAMT5             TO   OLD7OTHER                   EW012800
             ADD   CDFAMT6             TO   OLD7CAP.                    EW012810
                                                                        EW012820
           IF      RETCDF              =    '00'                        EW012830
             READ  CDF-DISK                 NEXT                        EW012840
             MOVE  CDFD                TO   CDF                         EW012850
             IF    RETCDF              NOT  =  '00'                OR   EW012860
                   CDFDIST             NOT  =  RQRDIST             OR   EW012870
                   CDFFY               NOT  =  RQRFY                    EW012880
               MOVE  '99'              TO   RETCDF                      EW012890
               MOVE  HIGH-VALUES       TO   CDF                         EW012900
               GO                      TO   494-LOOP                    EW012910
             ELSE                                                       EW012920
               GO                      TO   494-LOOP.                   EW012930
       494-EXIT.                                                        EW012940
           EXIT.                                                        EW012950
                                                                        EW012960
      ******************************************************************EW012970
       496-HEADS.                                                       EW012980
           ACCEPT  SYSDATE             FROM DATE                        EW012990
           MOVE    SYSYY               TO   HD1YY                       EW013000
           MOVE    SYSMM               TO   HD1MM                       EW013010
           MOVE    SYSDD               TO   HD1DD                       EW013020
           ACCEPT  SYSTIME             FROM TIME                        EW013030
           MOVE    SYSHR               TO   HD1HR                       EW013040
           MOVE    SYSMIN              TO   HD1MN                       EW013050
           MOVE    ZEROS               TO   CTRLN         CTRPG         EW013060
           MOVE    '    SCL0000'       TO   SCLKEY                      EW013070
           MOVE    RQRDIST             TO   SCLDIST                     EW013080
           MOVE    RQRFY               TO   SCLFY                       EW013090
           MOVE    SCLKEY              TO   CRFDK                       EW013100
           READ    CRF-DISK                                             EW013110
           IF      RETCRF              NOT  =   '00'                    EW013120
             MOVE  'UNKNOWN'           TO   HD1ABBR                     EW013130
           ELSE                                                         EW013140
             MOVE  CRFD                TO   SCL                         EW013150
             MOVE  SCLABBR             TO   HD1ABBR.                    EW013160
           SET     HD11                TO   +15.                        EW013170
       496-REQ.                                                         EW013180
           IF      HD1B         (HD11) =    SPACES                      EW013190
             SET   HD11                DOWN BY  +1                      EW013200
             GO                        TO   496-REQ.                    EW013210
           SET     HD11                UP   BY  +1                      EW013220
           MOVE    '-'                 TO   HD1B         (HD11)         EW013230
           SET     HD11                UP   BY  +1                      EW013240
           MOVE    RQRREQ1             TO   HD1B         (HD11)         EW013250
           SET     HD11                UP   BY  +1                      EW013260
           MOVE    RQRREQ2             TO   HD1B         (HD11)         EW013270
           SET     HD11                UP   BY  +1                      EW013280
           MOVE    RQRREQ3             TO   HD1B         (HD11)         EW013290
           SET     HD11                UP   BY  +1                      EW013300
           MOVE    '-'                 TO   HD1B         (HD11)         EW013310
           SET     HD11                UP   BY  +1                      EW013320
           MOVE    RQRFY1              TO   HD1B         (HD11)         EW013330
           SET     HD11                UP   BY  +1                      EW013340
           MOVE    RQRFY2              TO   HD1B         (HD11).        EW013350
                                                                        EW013360
           SET     RQH1                TO   +1.                         EW013370
       496-HEAD.                                                        EW013380
           IF      RQHREQ       (RQH1) NOT  =   HIGH-VALUES             EW013390
             IF      RQHREQ     (RQH1) NOT  =   RQRREQ                  EW013400
               SET   RQH1              UP   BY  +1                      EW013410
               GO                      TO   496-HEAD                    EW013420
             ELSE                                                       EW013430
               IF      RQHID    (RQH1) =    'H1'                        EW013440
                 MOVE  RQHHEAD  (RQH1) TO   HD2HEAD                     EW013450
                 MOVE  RQHUSER  (RQH1) TO   HD1USER                     EW013460
                 SET   RQH1            UP   BY  +1                      EW013470
                 GO                    TO   496-HEAD                    EW013480
               ELSE                                                     EW013490
                 IF      RQHID  (RQH1) =    'H2'                        EW013500
                   MOVE  RQHHEAD (RQH1) TO  HD3HEAD                     EW013510
                   SET   RQH1          UP   BY  +1                      EW013520
                   GO                  TO   496-HEAD.                   EW013530
           IF      RQRPRT              =    'N'                         EW013540
             MOVE  SPACES              TO   HD2HEAD       HD1USER       EW013550
             MOVE  SPACES              TO   HD3HEAD                     EW013560
           ELSE                                                         EW013570
             IF      RQRPRT            =    'U'                         EW013580
               MOVE  SPACES            TO   HD2HEAD       HD3HEAD       EW013590
             ELSE                                                       EW013600
               IF      RQRPRT          =    'T'                         EW013610
                 MOVE  SPACES          TO   HD1USER.                    EW013620
       496-HEAD2.                                                       EW013630
           MOVE    LN1                 TO   OLDLN                       EW013640
           MOVE    +0                  TO   CTRLN                       EW013650
           ADD     +1                  TO   CTRPG                       EW013660
           IF      RQRRPT              =    'A'                         EW013670
             MOVE  '* EDIT *'          TO   HD1MODE                     EW013680
           ELSE                                                         EW013690
             MOVE  '* POST *'          TO   HD1MODE.                    EW013700
           MOVE    CTRPG               TO   HD1PG                       EW013710
           MOVE    HD1                 TO   LN1                         EW013720
           MOVE    '1'                 TO   CTLCHAR                     EW013730
           PERFORM 520-PRINT           THRU 520-EXIT                    EW013740
           IF      HD2                 NOT  =   SPACES                  EW013750
             MOVE    HD2               TO   LN1                         EW013760
             PERFORM 520-PRINT         THRU 520-EXIT.                   EW013770
           IF      HD3                 NOT  =   SPACES                  EW013780
             MOVE    HD3               TO   LN1                         EW013790
             PERFORM 520-PRINT         THRU 520-EXIT.                   EW013800
           MOVE    OLDLN               TO   LN1                         EW013810
           MOVE    '0'                 TO   CTLCHAR.                    EW013820
       496-EXIT.                                                        EW013830
           EXIT.                                                        EW013840
                                                                        EW013850
      ******************************************************************EW013860
       499-EOJ.                                                         EW013870
           MOVE    '0'                 TO   CTLCHAR                     EW013880
           MOVE    'REQUEST'           TO   LN1MSG1                     EW013890
           MOVE    RQRREQ              TO   LN1REQ                      EW013900
           MOVE    'TOTAL'             TO   LN1MSG2                     EW013910
           MOVE    CTRWRITE            TO   LN1CNT                      EW013920
           MOVE    'RWF RECORDS WRITTEN' TO LN1MSG3                     EW013930
           PERFORM 520-PRINT           THRU 520-EXIT                    EW013940
           CLOSE                            CRD-CARD      PR1-PRNT      EW013950
                                            CRF-DISK      CDF-DISK      EW013960
                                            SPT-DISK      SCF-DISK      EW013970
                                            RWF-DISK                    EW013980
112295*    GOBACK.                                                      EW013990
112295     STOP                             RUN.                        EW014000
       499-EXIT.                                                        EW014010
           EXIT.                                                        EW014020
                                                                        EW014030
      ******************************************************************EW014040
       520-PRINT.                                                       EW014050
           IF      CTRLN               >    +60                         EW014060
             PERFORM 496-HEAD2         THRU 496-EXIT.                   EW014070
           IF      CTLCHAR             =    '1'                         EW014080
             WRITE LN1             AFTER    ADVANCING PAGE              EW014090
           ELSE                                                         EW014100
             IF      CTLCHAR           =    '0'                         EW014110
               WRITE LN1           AFTER    ADVANCING  2  LINES         EW014120
               ADD   +2                TO   CTRLN                       EW014130
             ELSE                                                       EW014140
               IF      CTLCHAR         =    ' '                         EW014150
                 WRITE LN1         AFTER    ADVANCING  1  LINES         EW014160
                 ADD   +1              TO   CTRLN                       EW014170
               ELSE                                                     EW014180
                 WRITE LN1         AFTER    ADVANCING  0  LINES         EW014190
                 ADD   +0              TO   CTRLN.                      EW014200
           MOVE    SPACES              TO   LN1           CTLCHAR.      EW014210
       520-EXIT.                                                        EW014220
           EXIT.                                                        EW014230
                                                                        EW014240
