       IDENTIFICATION   DIVISION.                                       EW000010
       PROGRAM-ID.      EW026.                                          EW000020
       AUTHOR.          DOE.                                            EW000030
      ***************************************************************** EW000040
      *                   SUMMARY OF INPUT DATA                       * EW000050
      ***************************************************************** EW000060
      * DATE CREATED:   06/20/95                                      * EW000070
      ***************************************************************** EW000080
      * CALL #  - MMDDYY - PURPOSE                                    * EW000090
      * 9511011 - 112295 - REPLACE GOBACK WITH STOP RUN.              * EW000100
      * 2001001 - 040301 - MODIFY TO HAVE FUND TOTAL PAGES            * EW000110
      * 2006001 - 041306 - ADD FUNCTIONS 6500 & 8200.                 * EW000110
      ***************************************************************** EW000120
                                                                        EW000130
                                                                        EW000140
       ENVIRONMENT DIVISION.                                            EW000150
                                                                        EW000160
       INPUT-OUTPUT SECTION.                                            EW000170
       FILE-CONTROL.                                                    EW000180
                                                                        EW000190
MVS        SELECT    CRD-CARD          ASSIGN    UT-S-CARDIN.           EW000210
                                                                        EW000220
MVS        SELECT    SRT-SORT          ASSIGN    DA-SORTWK.             EW000240
                                                                        EW000250
MVS        SELECT    PR1-PRNT          ASSIGN    UT-S-PRTOT1.           EW000270
                                                                        EW000280
MVS        SELECT    CRF-DISK          ASSIGN       DA-EWCRF            EW000300
                                       ORGANIZATION INDEXED             EW000310
                                       ACCESS       RANDOM              EW000320
                                       RECORD KEY   CRFDK               EW000330
                                       FILE STATUS  RETCRF.             EW000340
                                                                        EW000350
MVS        SELECT    CDF-DISK          ASSIGN       DA-EWCDF            EW000370
                                       ORGANIZATION INDEXED             EW000380
                                       ACCESS       SEQUENTIAL          EW000390
                                       RECORD KEY   CDFDK               EW000400
                                       FILE STATUS  RETCDF.             EW000410
                                                                        EW000420
       DATA DIVISION.                                                   EW000430
       FILE SECTION.                                                    EW000440
                                                                        EW000450
       FD  CRD-CARD                                                     EW000460
           RECORDING MODE       IS  F                                   EW000470
           RECORD    CONTAINS   80  CHARACTERS                          EW000480
MVS   *    BLOCK     CONTAINS    0  RECORDS                             EW000490
           LABEL     RECORDS   ARE  OMITTED                             EW000500
           DATA      RECORDS   ARE  CRD  CRH.                           EW000510
                                                                        EW000520
       01            CRD.                                               EW000530
001        05        CRDREQ            PIC  X(03).                      EW000540
004        05        FILLER            PIC  X(01).                      EW000550
005        05        CRDID             PIC  X(02).                      EW000560
007        05        FILLER            PIC  X(01).                      EW000570
008        05        CRDPRT            PIC  X(01).                      EW000580
009        05        FILLER            PIC  X(03).                      EW000590
012        05        CRDDIST           PIC  X(02).                      EW000600
014        05        FILLER            PIC  X(02).                      EW000610
016        05        CRDFY             PIC  X(02).                      EW000620
018        05        FILLER            PIC  X(01).                      EW000630
019        05        CRDFUND           PIC  X(01).                      EW000640
020        05        FILLER            PIC  X(01).                      EW000650
021        05        CRDTBLE           PIC  X(05).                      EW000660
026        05        FILLER            PIC  X(01).                      EW000670
027        05        CRDSCHL           PIC  X(04).                      EW000680
031        05        FILLER            PIC  X(01).                      EW000690
032        05        CRDERR            PIC  X(01).                      EW000700
033        05        FILLER            PIC  X(01).                      EW000710
034        05        CRDRPT            PIC  X(01).                      EW000720
035        05        CRDPGM            PIC  X(05).                      EW000730
040        05        FILLER            PIC  X(41).                      EW000740
                                                                        EW000750
       01            CRH.                                               EW000760
001        05        CRHREQ            PIC  X(03).                      EW000770
004        05        FILLER            PIC  X(01).                      EW000780
005        05        CRHID             PIC  X(02).                      EW000790
007        05        FILLER            PIC  X(01).                      EW000800
008        05        CRHUSER           PIC  X(08).                      EW000810
016        05        FILLER            PIC  X(01).                      EW000820
           05        CRHHEAD.                                           EW000830
017          10      CRHB       OCCURS 050  TIMES  INDEXED BY CRH1      EW000840
                                       PIC  X(01).                      EW000850
067        05        FILLER            PIC  X(14).                      EW000860
                                                                        EW000870
       FD  PR1-PRNT                                                     EW000880
           RECORDING MODE       IS  F                                   EW000890
VSE        RECORD    CONTAINS  133  CHARACTERS                          EW000900
MVS   *    RECORD    CONTAINS  132  CHARACTERS                          EW000910
MVS   *    BLOCK     CONTAINS    0  RECORDS                             EW000920
           LABEL     RECORDS   ARE  OMITTED                             EW000930
           DATA      RECORDS   ARE  LNM  LN1  LN2.                      EW000940
                                                                        EW000950
       01  LNM.                                                         EW000960
VSE        05        FILLER            PIC  X(01).                      EW000970
002        05        LNMMSG            PIC  X(20).                      EW000980
022        05        FILLER            PIC  X(02).                      EW000990
024        05        LNMVALUE1         PIC  X(02).                      EW001000
026        05        FILLER            PIC  X(01).                      EW001010
027        05        LNMVALUE2         PIC  X(80).                      EW001020
107        05        FILLER            PIC  X(27).                      EW001030
                                                                        EW001040
       01            LN1.                                               EW001050
VSE        05        FILLER            PIC  X(01).                      EW001060
002        05        FILLER            PIC  X(07).                      EW001070
009        05        LN1FUNC           PIC  X(04).                      EW001080
013        05        FILLER            PIC  X(01).                      EW001090
014        05        LN1NAME           PIC  X(30).                      EW001100
044        05        FILLER            PIC  X(02).                      EW001110
046        05        LN1AMT1           PIC  ZZZ,ZZZ,ZZZ-.               EW001120
058        05        FILLER            PIC  X(02).                      EW001130
060        05        LN1AMT2           PIC  ZZZ,ZZZ,ZZZ-.               EW001140
072        05        FILLER            PIC  X(02).                      EW001150
074        05        LN1AMT3           PIC  ZZZ,ZZZ,ZZZ-.               EW001160
086        05        FILLER            PIC  X(02).                      EW001170
088        05        LN1AMT4           PIC  ZZZ,ZZZ,ZZZ-.               EW001180
100        05        FILLER            PIC  X(02).                      EW001190
102        05        LN1AMT5           PIC  ZZZ,ZZZ,ZZZ-.               EW001200
114        05        LN1TOT            PIC  Z,ZZZ,ZZZ,ZZZ-.             EW001210
128        05        FILLER            PIC  X(06).                      EW001220
                                                                        EW001230
       01            LN2.                                               EW001240
VSE        05        FILLER            PIC  X(01).                      EW001250
002        05        FILLER            PIC  X(30).                      EW001260
032        05        LN2MSG            PIC  X(06).                      EW001270
038        05        LN2FLD            PIC  X(05).                      EW001280
043        05        FILLER            PIC  X(01).                      EW001290
044        05        LN2AMT1           PIC  Z,ZZZ,ZZZ,ZZZ-.             EW001300
058        05        LN2AMT2           PIC  Z,ZZZ,ZZZ,ZZZ-.             EW001310
072        05        LN2AMT3           PIC  Z,ZZZ,ZZZ,ZZZ-.             EW001320
086        05        LN2AMT4           PIC  Z,ZZZ,ZZZ,ZZZ-.             EW001330
100        05        LN2AMT5           PIC  Z,ZZZ,ZZZ,ZZZ-.             EW001340
114        05        LN2AMT6           PIC  Z,ZZZ,ZZZ,ZZZ-.             EW001350
128        05        FILLER            PIC  X(06).                      EW001360
                                                                        EW001370
           COPY                        EWCRFD.                          EW001380
           COPY                        EWCDFD.                          EW001390
                                                                        EW001400
       SD  SRT-SORT.                                                    EW001410
                                                                        EW001420
       01            SRT.                                               EW001430
           05        SRTKEY.                                            EW001440
             10      SRTKDIST          PIC  X(02).                      EW001450
             10      SRTKREQ.                                           EW001460
               15    SRTKREQ1          PIC  X(01).                      EW001470
               15    SRTKREQ2          PIC  X(01).                      EW001480
               15    SRTKREQ3          PIC  X(01).                      EW001490
             10      SRTKFY.                                            EW001500
               15    SRTKFY1           PIC  X(01).                      EW001510
               15    SRTKFY2           PIC  X(01).                      EW001520
             10      SRTKFUND          PIC  X(01).                      EW001530
             10      SRTKTBLE          PIC  X(05).                      EW001540
             10      SRTKSCHL          PIC  X(04).                      EW001550
             10      SRTKFUNC          PIC  X(04).                      EW001560
             10      SRTKCTRL          PIC  X(04).                      EW001570
           05        SRTDATA.                                           EW001580
             10      SRTAMT            PIC  S9(09).                     EW001590
             10      SRTPRT            PIC  X(01).                      EW001600
                                                                        EW001610
       WORKING-STORAGE SECTION.                                         EW001620
                                                                        EW001630
       01            WSC.                                               EW001640
           05        WSCFUNC           PIC  X(04).                      EW001650
           05        WSCNAME           PIC  X(30).                      EW001660
                                                                        EW001670
       01            RET.                                               EW001680
           05        RETCRF            PIC  X(02) VALUE '00'.           EW001690
           05        RETCDF            PIC  X(02) VALUE '00'.           EW001700
                                                                        EW001710
       01            SYS.                                               EW001720
           05        SYSTIME.                                           EW001730
             10      SYSHR             PIC  X(02).                      EW001740
             10      SYSMIN            PIC  X(02).                      EW001750
             10      SYSSEC            PIC  X(02).                      EW001760
           05        SYSDATE.                                           EW001770
             10      SYSYY             PIC  9(02).                      EW001780
             10      SYSMM             PIC  X(02).                      EW001790
             10      SYSDD             PIC  X(02).                      EW001800
                                                                        EW001810
       01            CTLAREA.                                           EW001820
           05        CTLCHAR           PIC  X(01) VALUE ' '.            EW001830
           05        ERR.                                               EW001840
             10      ERRREQ            PIC  X(03).                      EW001850
             10      FILLER            PIC  X(01).                      EW001860
             10      ERRID             PIC  X(02).                      EW001870
             10      FILLER            PIC  X(01).                      EW001880
             10      ERRPRT            PIC  X(01).                      EW001890
             10      FILLER            PIC  X(03).                      EW001900
             10      ERRDIST           PIC  X(02).                      EW001910
             10      FILLER            PIC  X(02).                      EW001920
             10      ERRFY             PIC  X(02).                      EW001930
             10      FILLER            PIC  X(01).                      EW001940
             10      ERRFUND           PIC  X(01).                      EW001950
             10      FILLER            PIC  X(01).                      EW001960
             10      ERRTBLE           PIC  X(05).                      EW001970
             10      FILLER            PIC  X(01).                      EW001980
             10      ERRSCHL           PIC  X(04).                      EW001990
             10      FILLER            PIC  X(01).                      EW002000
             10      ERRERR            PIC  X(01).                      EW002010
             10      FILLER            PIC  X(01).                      EW002020
             10      ERRRPT            PIC  X(01).                      EW002030
                                                                        EW002040
       01            RQR.                                               EW002050
           05        RQRREQ            PIC  X(03).                      EW002060
           05        RQRPRT            PIC  X(01).                      EW002070
           05        RQRDIST           PIC  X(02).                      EW002080
           05        RQRFY             PIC  X(02).                      EW002090
           05        RQRSEL.                                            EW002100
             10      RQRFUND           PIC  X(01).                      EW002110
             10      RQRTBLE           PIC  X(05).                      EW002120
             10      RQRSCHL           PIC  X(04).                      EW002130
           05        RQRSELR    REDEFINES   RQRSEL.                     EW002140
             10      RQRB       OCCURS 010  TIMES INDEXED BY RQR1       EW002150
                                       PIC  X(01).                      EW002160
           05        RQRERR            PIC  X(01).                      EW002170
           05        RQRRPT            PIC  X(01).                      EW002180
                                                                        EW002190
       01            SEL.                                               EW002200
           05        SELFUND           PIC  X(01).                      EW002210
           05        SELTBLE           PIC  X(05).                      EW002220
           05        SELSCHL           PIC  X(04).                      EW002230
       01            SELR       REDEFINES   SEL.                        EW002240
           05        SELB       OCCURS 010  TIMES INDEXED BY SEL1       EW002250
                                       PIC  X(01).                      EW002260
                                                                        EW002270
       01            RQH.                                               EW002280
           05        RQHENTRY   OCCURS 100  TIMES INDEXED BY RQH1.      EW002290
             10      RQHREQ            PIC  X(03).                      EW002300
             10      RQHID             PIC  X(02).                      EW002310
             10      RQHUSER           PIC  X(08).                      EW002320
             10      RQHHEAD.                                           EW002330
               15    RQHB       OCCURS 050  TIMES INDEXED BY RQH2       EW002340
                                       PIC  X(01).                      EW002350
                                                                        EW002360
       01            STRKEY.                                            EW002370
           05        STRDIST           PIC  X(02) VALUE HIGH-VALUES.    EW002380
           05        STRFY             PIC  X(02) VALUE HIGH-VALUES.    EW002390
           05        STRFUND           PIC  X(01) VALUE HIGH-VALUES.    EW002400
           05        STRTBLE           PIC  X(05) VALUE HIGH-VALUES.    EW002410
           05        STRSCHL           PIC  X(04) VALUE HIGH-VALUES.    EW002420
           05        FILLER            PIC  X(04) VALUE HIGH-VALUES.    EW002430
                                                                        EW002440
       01            ENDKEY.                                            EW002450
           05        ENDDIST           PIC  X(02) VALUE LOW-VALUES.     EW002460
           05        ENDFY             PIC  X(02) VALUE LOW-VALUES.     EW002470
           05        ENDFUND           PIC  X(01) VALUE LOW-VALUES.     EW002480
           05        ENDTBLE           PIC  X(05) VALUE LOW-VALUES.     EW002490
           05        ENDSCHL           PIC  X(04) VALUE LOW-VALUES.     EW002500
           05        FILLER            PIC  X(04) VALUE LOW-VALUES.     EW002510
                                                                        EW002520
       01            CTR.                                               EW002530
           05        CTRLN             PIC S9(03)      COMP-3 VALUE +0. EW002540
           05        CTRPG             PIC S9(03)      COMP-3 VALUE +0. EW002550
           05        CTRIDX            PIC S9(05)      COMP-3 VALUE +0. EW002560
           05        CTRAMT            PIC S9(09)      COMP-3 VALUE +0. EW002570
           05        CTRLNTOT          PIC S9(11)      COMP-3 VALUE +0. EW002580
           05        CTRINST1          PIC S9(09)      COMP-3 VALUE +0. EW002590
           05        CTRINST2          PIC S9(09)      COMP-3 VALUE +0. EW002600
           05        CTRSCHL1          PIC S9(11)      COMP-3 VALUE +0. EW002610
           05        CTRSCHL2          PIC S9(11)      COMP-3 VALUE +0. EW002620
           05        CTRSCHL3          PIC S9(11)      COMP-3 VALUE +0. EW002630
           05        CTRSCHL4          PIC S9(11)      COMP-3 VALUE +0. EW002640
           05        CTRSCHL5          PIC S9(11)      COMP-3 VALUE +0. EW002650
           05        CTRSCHL6          PIC S9(11)      COMP-3 VALUE +0. EW002660
           05        CTRREQ1           PIC S9(11)      COMP-3 VALUE +0. EW002670
           05        CTRREQ2           PIC S9(11)      COMP-3 VALUE +0. EW002680
           05        CTRREQ3           PIC S9(11)      COMP-3 VALUE +0. EW002690
           05        CTRREQ4           PIC S9(11)      COMP-3 VALUE +0. EW002700
           05        CTRREQ5           PIC S9(11)      COMP-3 VALUE +0. EW002710
           05        CTRREQ6           PIC S9(11)      COMP-3 VALUE +0. EW002720
                                                                        EW002730
       01            OLD.                                               EW002740
           05        OLDKEY.                                            EW002750
             10      OLDKDIST          PIC  X(02).                      EW002760
             10      OLDKREQ           PIC  X(03).                      EW002770
             10      OLDKFY            PIC  X(02).                      EW002780
             10      OLDKFUND          PIC  X(01).                      EW002790
             10      OLDKTBLE          PIC  X(05).                      EW002800
             10      OLDKSCHL          PIC  X(04).                      EW002810
             10      OLDKFUNC          PIC  X(04).                      EW002820
             10      OLDKCTRL.                                          EW002830
               15    OLDKCTRL1         PIC  X(01).                      EW002840
               15    FILLER            PIC  X(03).                      EW002850
           05        OLDPRT            PIC  X(01).                      EW002860
                                                                        EW002870
                                                                        EW002880
           COPY                        EWSCL.                           EW002890
           COPY                        EWTBL.                           EW002900
           COPY                        EWCDF.                           EW002910
                                                                        EW002920
       01            OLDLN             PIC  X(133).                     EW002930
                                                                        EW002940
       01      HD1.                                                     EW002950
VSE        05  FILLER  PIC X(01) VALUE ' '.                             EW002960
002        05  FILLER  PIC X(06) VALUE 'EW026 '.                        EW002970
           05  HD1ABBR.                                                 EW002980
008         10 HD1B    OCCURS 22 TIMES INDEXED BY HD11 PIC X(01).       EW002990
030        05  FILLER  PIC X(11) VALUE SPACES.                          EW003000
041        05  HD1MODE PIC X(08) VALUE SPACES.                          EW003010
049        05  FILLER  PIC X(10) VALUE SPACES.                          EW003020
059        05  FILLER  PIC X(18) VALUE 'SUMMARY INPUT DATA'.            EW003030
077        05  FILLER  PIC X(22) VALUE SPACES.                          EW003040
099        05  HD1USER PIC X(09) VALUE SPACES.                          EW003050
108        05  HD1MM   PIC X(02) VALUE SPACES.                          EW003060
110        05  FILLER  PIC X(01) VALUE '/'.                             EW003070
111        05  HD1DD   PIC X(02) VALUE SPACES.                          EW003080
113        05  FILLER  PIC X(01) VALUE '/'.                             EW003090
114        05  HD1YY   PIC X(02) VALUE SPACES.                          EW003100
116        05  FILLER  PIC X(02) VALUE SPACES.                          EW003110
118        05  HD1HR   PIC X(02) VALUE SPACES.                          EW003120
120        05  FILLER  PIC X(01) VALUE ':'.                             EW003130
121        05  HD1MN   PIC X(02) VALUE SPACES.                          EW003140
123        05  FILLER  PIC X(07) VALUE '  PAGE-'.                       EW003150
130        05  HD1PG   PIC ZZZ9.                                        EW003160
                                                                        EW003170
       01      HD2.                                                     EW003180
VSE        05  FILLER  PIC X(01) VALUE ' '.                             EW003190
002        05  FILLER  PIC X(41) VALUE SPACES.                          EW003200
           05  HD2HEAD.                                                 EW003210
043         10 HD2B    OCCURS 50 TIMES INDEXED BY HD21 PIC X(01).       EW003220
093        05  FILLER  PIC X(41) VALUE SPACES.                          EW003230
                                                                        EW003240
       01      HD3.                                                     EW003250
VSE        05  FILLER  PIC X(01) VALUE ' '.                             EW003260
002        05  FILLER  PIC X(41) VALUE SPACES.                          EW003270
           05  HD3HEAD.                                                 EW003280
043         10 HD3B    OCCURS 50 TIMES INDEXED BY HD31 PIC X(01).       EW003290
093        05  FILLER  PIC X(41) VALUE SPACES.                          EW003300
                                                                        EW003310
       01      HD4.                                                     EW003320
VSE        05  FILLER  PIC X(01) VALUE ' '.                             EW003330
002        05  FILLER  PIC X(07) VALUE 'FUND - '.                       EW003340
009        05  HD4FND  PIC X(01) VALUE SPACES.                          EW003350
010        05  FILLER  PIC X(124) VALUE SPACES.                         EW003360
                                                                        EW003370
       01      HD5.                                                     EW003380
VSE        05  FILLER  PIC X(01) VALUE ' '.                             EW003390
002        05  FILLER  PIC X(07) VALUE 'TABLE- '.                       EW003400
009        05  HD5TBL  PIC X(05) VALUE SPACES.                          EW003410
014        05  FILLER  PIC X(01) VALUE SPACES.                          EW003420
015        05  HD5DESC PIC X(30) VALUE SPACES.                          EW003430
045        05  FILLER  PIC X(89) VALUE SPACES.                          EW003440
                                                                        EW003450
       01      HD6.                                                     EW003460
VSE        05  FILLER  PIC X(01) VALUE ' '.                             EW003470
002        05  FILLER  PIC X(07) VALUE 'SCHL-  '.                       EW003480
009        05  HD6SCHL PIC X(04) VALUE SPACES.                          EW003490
014        05  FILLER  PIC X(02) VALUE SPACES.                          EW003500
015        05  HD6DESC PIC X(30) VALUE SPACES.                          EW003510
045        05  FILLER  PIC X(89) VALUE SPACES.                          EW003520
                                                                        EW003530
       01      HD7.                                                     EW003540
VSE        05  FILLER  PIC X(01) VALUE ' '.                             EW003550
002        05  FILLER  PIC X(51) VALUE SPACES.                          EW003560
053        05  FILLER  PIC X(12) VALUE 'DIRECT COSTS'.                  EW003570
065        05  FILLER  PIC X(16) VALUE SPACES.                          EW003580
081        05  FILLER  PIC X(13) VALUE 'SCHL INDIRECT'.                 EW003590
094        05  FILLER  PIC X(06) VALUE SPACES.                          EW003600
100        05  FILLER  PIC X(13) VALUE 'DIST INDIRECT'.                 EW003610
113        05  FILLER  PIC X(21) VALUE SPACES.                          EW003620
                                                                        EW003630
       01      HD8.                                                     EW003640
VSE        05  FILLER  PIC X(01) VALUE ' '.                             EW003650
002        05  FILLER  PIC X(46) VALUE SPACES.                          EW003660
048        05  FILLER  PIC X(23) VALUE 'CTRL 1000     CTRL 7000'.       EW003670
071        05  FILLER  PIC X(05) VALUE SPACES.                          EW003680
076        05  FILLER  PIC X(23) VALUE 'CTRL 200X     CTRL 600X'.       EW003690
099        05  FILLER  PIC X(05) VALUE SPACES.                          EW003700
104        05  FILLER  PIC X(09) VALUE 'CTRL 300X'.                     EW003710
113        05  FILLER  PIC X(09) VALUE SPACES.                          EW003720
122        05  FILLER  PIC X(05) VALUE 'TOTAL'.                         EW003730
127        05  FILLER  PIC X(07) VALUE SPACES.                          EW003740
                                                                        EW003750
       01      HD9.                                                     EW003760
VSE        05  FILLER  PIC X(01) VALUE ' '.                             EW003770
002        05  FILLER  PIC X(07) VALUE SPACES.                          EW003780
009        05  FILLER  PIC X(17) VALUE '5000 INSTRUCTION:'.             EW003790
026        05  FILLER  PIC X(108) VALUE SPACES.                         EW003800
                                                                        EW003810
       PROCEDURE DIVISION.                                              EW003820
      ******************************************************************EW003830
           SORT    SRT-SORT            ASCENDING KEY       SRTKEY       EW003840
                                       INPUT     PROCEDURE 000-INPUT    EW003850
                                       OUTPUT    PROCEDURE 500-OUTPUT.  EW003860
112295*    GOBACK.                                                      EW003870
112295     STOP                        RUN.                             EW003880
                                                                        EW003890
      ******************************************************************EW003900
       000-INPUT SECTION.                                               EW003910
           PERFORM 490-HOUSEKEEPING    THRU 490-EXIT.                   EW003920
                                                                        EW003930
       005-LOOP.                                                        EW003940
           IF      RETCDF              NOT  =  '00'                     EW003950
             GO                        TO   499-EOJ.                    EW003960
           PERFORM 015-SELECT          THRU 015-EXIT                    EW003970
           PERFORM 010-READ            THRU 010-EXIT                    EW003980
           GO                          TO   005-LOOP.                   EW003990
                                                                        EW004000
      ******************************************************************EW004010
       010-READ.                                                        EW004020
           READ    CDF-DISK            NEXT                             EW004030
           IF     (CDFDK               >    ENDKEY)                  OR EW004040
                  (RETCDF              NOT  =   '00')                   EW004050
             MOVE  '99'                TO   RETCDF                      EW004060
           ELSE                                                         EW004070
             MOVE  CDFD                TO   CDF.                        EW004080
       010-EXIT.                                                        EW004090
           EXIT.                                                        EW004100
                                                                        EW004110
      ******************************************************************EW004120
       015-SELECT.                                                      EW004130
           IF     (RQRREQ              =    HIGH-VALUES)                EW004140
             GO                        TO   015-EXIT.                   EW004150
                                                                        EW004160
           MOVE    CDFFUND             TO   SELFUND                     EW004170
           MOVE    CDFTABLE            TO   SELTBLE                     EW004180
           MOVE    CDFSCHL             TO   SELSCHL                     EW004190
           SET     RQR1  SEL1          TO   +1.                         EW004200
       015-MASK.                                                        EW004210
           IF      RQRB    (RQR1)      =    SPACES                      EW004220
             MOVE  ' '                 TO   SELB         (SEL1).        EW004230
           IF      RQR1                <    +10                         EW004240
             SET   RQR1  SEL1          UP   BY  +1                      EW004250
             GO                        TO   015-MASK.                   EW004260
                                                                        EW004270
           IF     (RQRDIST             NOT  =  CDFDIST)      OR         EW004280
                  (RQRFY               NOT  =  CDFFY)        OR         EW004290
                  (RQRSEL              NOT  =  SEL)          OR         EW004300
                  (CDFCONTROL          >    '7000')                     EW004310
             GO                        TO   015-EXIT.                   EW004320
                                                                        EW004330
           MOVE    RQRDIST             TO   SRTKDIST                    EW004340
           MOVE    RQRREQ              TO   SRTKREQ                     EW004350
           MOVE    CDFFY               TO   SRTKFY                      EW004360
           MOVE    CDFFUND             TO   SRTKFUND                    EW004370
           MOVE    CDFTABLE            TO   SRTKTBLE                    EW004380
           MOVE    CDFSCHL             TO   SRTKSCHL                    EW004390
           MOVE    CDFCONTROL          TO   SRTKCTRL                    EW004400
           MOVE    RQRPRT              TO   SRTPRT                      EW004410
                                                                        EW004420
           IF      CDFCONTROL          =    '1000'                      EW004430
             MOVE  '5100'              TO   SRTKFUNC                    EW004440
             MOVE  CDFAMT1             TO   SRTAMT                      EW004450
             RELEASE SRT                                                EW004460
040301       MOVE  '00000'             TO   SRTKTBLE                    EW004470
040301       MOVE  '9999'              TO   SRTKSCHL                    EW004480
040301       RELEASE SRT                                                EW004490
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                    EW004500
             MOVE  '5200'              TO   SRTKFUNC                    EW004510
             MOVE  CDFAMT2             TO   SRTAMT                      EW004520
             RELEASE SRT                                                EW004530
040301       MOVE  '00000'             TO   SRTKTBLE                    EW004540
040301       MOVE  '9999'              TO   SRTKSCHL                    EW004550
040301       RELEASE SRT                                                EW004560
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                    EW004570
             MOVE  '5300'              TO   SRTKFUNC                    EW004580
             MOVE  CDFAMT3             TO   SRTAMT                      EW004590
             RELEASE SRT                                                EW004600
040301       MOVE  '00000'             TO   SRTKTBLE                    EW004610
040301       MOVE  '9999'              TO   SRTKSCHL                    EW004620
040301       RELEASE SRT                                                EW004630
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                    EW004640
             MOVE  '5500'              TO   SRTKFUNC                    EW004650
             MOVE  CDFAMT4             TO   SRTAMT                      EW004660
             RELEASE SRT                                                EW004670
040301       MOVE  '00000'             TO   SRTKTBLE                    EW004680
040301       MOVE  '9999'              TO   SRTKSCHL                    EW004690
040301       RELEASE SRT                                                EW004700
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                    EW004710
             MOVE  '5600'              TO   SRTKFUNC                    EW004720
             MOVE  CDFAMT5             TO   SRTAMT                      EW004730
             RELEASE SRT                                                EW004740
040301       MOVE  '00000'             TO   SRTKTBLE                    EW004750
040301       MOVE  '9999'              TO   SRTKSCHL                    EW004760
040301       RELEASE SRT                                                EW004770
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                    EW004780
             MOVE  '5700'              TO   SRTKFUNC                    EW004790
             MOVE  CDFAMT6             TO   SRTAMT                      EW004800
040301*      RELEASE SRT.                                               EW004810
040301       RELEASE SRT                                                EW004820
040301       MOVE  '00000'             TO   SRTKTBLE                    EW004830
040301       MOVE  '9999'              TO   SRTKSCHL                    EW004840
040301       RELEASE SRT                                                EW004850
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT.                   EW004860
                                                                        EW004870
                                                                        EW004880
           IF      CDFCONTROL          =    '2000'                      EW004890
             MOVE  '6100'              TO   SRTKFUNC                    EW004900
             MOVE  CDFAMT1             TO   SRTAMT                      EW004910
             RELEASE SRT                                                EW004920
040301       MOVE  '00000'             TO   SRTKTBLE                    EW004930
040301       MOVE  '9999'              TO   SRTKSCHL                    EW004940
040301       RELEASE SRT                                                EW004950
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                    EW004960
             MOVE  '6200'              TO   SRTKFUNC                    EW004970
             MOVE  CDFAMT2             TO   SRTAMT                      EW004980
             RELEASE SRT                                                EW004990
040301       MOVE  '00000'             TO   SRTKTBLE                    EW005000
040301       MOVE  '9999'              TO   SRTKSCHL                    EW005010
040301       RELEASE SRT                                                EW005020
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                    EW005030
             MOVE  '6300'              TO   SRTKFUNC                    EW005040
             MOVE  CDFAMT3             TO   SRTAMT                      EW005050
             RELEASE SRT                                                EW005060
040301       MOVE  '00000'             TO   SRTKTBLE                    EW005070
040301       MOVE  '9999'              TO   SRTKSCHL                    EW005080
040301       RELEASE SRT                                                EW005090
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                    EW005100
             MOVE  '6400'              TO   SRTKFUNC                    EW005110
             MOVE  CDFAMT4             TO   SRTAMT                      EW005120
040301*      RELEASE SRT.                                               EW005130
040301       RELEASE SRT                                                EW005140
040301       MOVE  '00000'             TO   SRTKTBLE                    EW005150
040301       MOVE  '9999'              TO   SRTKSCHL                    EW005160
040301       RELEASE SRT                                                EW005170
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT.                   EW005180
                                                                        EW005190
           IF      CDFCONTROL          =    '2001'                      EW005200
             MOVE  '7300'              TO   SRTKFUNC                    EW005210
             MOVE  CDFAMT1             TO   SRTAMT                      EW005220
             RELEASE SRT                                                EW005230
040301       MOVE  '00000'             TO   SRTKTBLE                    EW005240
040301       MOVE  '9999'              TO   SRTKSCHL                    EW005250
040301       RELEASE SRT                                                EW005260
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                    EW005270
             MOVE  '7400'              TO   SRTKFUNC                    EW005280
             MOVE  CDFAMT2             TO   SRTAMT                      EW005290
             RELEASE SRT                                                EW005300
040301       MOVE  '00000'             TO   SRTKTBLE                    EW005310
040301       MOVE  '9999'              TO   SRTKSCHL                    EW005320
040301       RELEASE SRT                                                EW005330
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                    EW005340
             MOVE  '7600'              TO   SRTKFUNC                    EW005350
             MOVE  CDFAMT3             TO   SRTAMT                      EW005360
             RELEASE SRT                                                EW005370
040301       MOVE  '00000'             TO   SRTKTBLE                    EW005380
040301       MOVE  '9999'              TO   SRTKSCHL                    EW005390
040301       RELEASE SRT                                                EW005400
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                    EW005410
             MOVE  '7700'              TO   SRTKFUNC                    EW005420
             MOVE  CDFAMT4             TO   SRTAMT                      EW005430
040301*      RELEASE SRT.                                               EW005440
040301       RELEASE SRT                                                EW005450
040301       MOVE  '00000'             TO   SRTKTBLE                    EW005460
040301       MOVE  '9999'              TO   SRTKSCHL                    EW005470
040301       RELEASE SRT                                                EW005480
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT.                   EW005490
                                                                        EW005500
           IF      CDFCONTROL          =    '2002'                      EW005510
             MOVE  '7800'              TO   SRTKFUNC                    EW005520
             MOVE  CDFAMT1             TO   SRTAMT                      EW005530
             RELEASE SRT                                                EW005540
040301       MOVE  '00000'             TO   SRTKTBLE                    EW005550
040301       MOVE  '9999'              TO   SRTKSCHL                    EW005560
040301       RELEASE SRT                                                EW005570
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                    EW005580
             MOVE  '7900'              TO   SRTKFUNC                    EW005590
             MOVE  CDFAMT2             TO   SRTAMT                      EW005600
             RELEASE SRT                                                EW005610
040301       MOVE  '00000'             TO   SRTKTBLE                    EW005620
040301       MOVE  '9999'              TO   SRTKSCHL                    EW005630
040301       RELEASE SRT                                                EW005640
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                    EW005650
             MOVE  '8100'              TO   SRTKFUNC                    EW005660
             MOVE  CDFAMT3             TO   SRTAMT                      EW005670
040301*      RELEASE SRT.                                               EW005680
040301       RELEASE SRT                                                EW005690
040301       MOVE  '00000'             TO   SRTKTBLE                    EW005700
040301       MOVE  '9999'              TO   SRTKSCHL                    EW005710
040301       RELEASE SRT                                                EW005720
041306*      PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT.                   EW005730
041306       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                    EW005730
041306       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                            
041306       MOVE  '8200'              TO   SRTKFUNC                            
041306       MOVE  CDFAMT4             TO   SRTAMT                              
041306       RELEASE SRT                                                        
041306       MOVE  '00000'             TO   SRTKTBLE                            
041306       MOVE  '9999'              TO   SRTKSCHL                            
041306       RELEASE SRT                                                        
041306       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT.                           
                                                                        EW005740
041306     IF      CDFCONTROL          =    '2003'                              
041306       MOVE  '6500'              TO   SRTKFUNC                            
041306       MOVE  CDFAMT1             TO   SRTAMT                              
041306       RELEASE SRT                                                        
041306       MOVE  '00000'             TO   SRTKTBLE                            
041306       MOVE  '9999'              TO   SRTKSCHL                            
041306       RELEASE SRT                                                        
041306       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT.                           
                                                                                
           IF      CDFCONTROL          =    '3000'                      EW005750
             MOVE  '6100'              TO   SRTKFUNC                    EW005760
             MOVE  CDFAMT1             TO   SRTAMT                      EW005770
             RELEASE SRT                                                EW005780
040301       MOVE  '00000'             TO   SRTKTBLE                    EW005790
040301       MOVE  '9999'              TO   SRTKSCHL                    EW005800
040301       RELEASE SRT                                                EW005810
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                    EW005820
             MOVE  '6200'              TO   SRTKFUNC                    EW005830
             MOVE  CDFAMT2             TO   SRTAMT                      EW005840
             RELEASE SRT                                                EW005850
040301       MOVE  '00000'             TO   SRTKTBLE                    EW005860
040301       MOVE  '9999'              TO   SRTKSCHL                    EW005870
040301       RELEASE SRT                                                EW005880
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                    EW005890
             MOVE  '6300'              TO   SRTKFUNC                    EW005900
             MOVE  CDFAMT3             TO   SRTAMT                      EW005910
             RELEASE SRT                                                EW005920
040301       MOVE  '00000'             TO   SRTKTBLE                    EW005930
040301       MOVE  '9999'              TO   SRTKSCHL                    EW005940
040301       RELEASE SRT                                                EW005950
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                    EW005960
             MOVE  '6400'              TO   SRTKFUNC                    EW005970
             MOVE  CDFAMT4             TO   SRTAMT                      EW005980
040301*      RELEASE SRT.                                               EW005990
040301       RELEASE SRT                                                EW006000
040301       MOVE  '00000'             TO   SRTKTBLE                    EW006010
040301       MOVE  '9999'              TO   SRTKSCHL                    EW006020
040301       RELEASE SRT                                                EW006030
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT.                   EW006040
                                                                        EW006050
           IF      CDFCONTROL          =    '3001'                      EW006060
             MOVE  '7100'              TO   SRTKFUNC                    EW006070
             MOVE  CDFAMT1             TO   SRTAMT                      EW006080
             RELEASE SRT                                                EW006090
040301       MOVE  '00000'             TO   SRTKTBLE                    EW006100
040301       MOVE  '9999'              TO   SRTKSCHL                    EW006110
040301       RELEASE SRT                                                EW006120
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                    EW006130
             MOVE  '7200'              TO   SRTKFUNC                    EW006140
             MOVE  CDFAMT2             TO   SRTAMT                      EW006150
             RELEASE SRT                                                EW006160
040301       MOVE  '00000'             TO   SRTKTBLE                    EW006170
040301       MOVE  '9999'              TO   SRTKSCHL                    EW006180
040301       RELEASE SRT                                                EW006190
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                    EW006200
             MOVE  '7400'              TO   SRTKFUNC                    EW006210
             MOVE  CDFAMT3             TO   SRTAMT                      EW006220
             RELEASE SRT                                                EW006230
040301       MOVE  '00000'             TO   SRTKTBLE                    EW006240
040301       MOVE  '9999'              TO   SRTKSCHL                    EW006250
040301       RELEASE SRT                                                EW006260
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                    EW006270
             MOVE  '7500'              TO   SRTKFUNC                    EW006280
             MOVE  CDFAMT4             TO   SRTAMT                      EW006290
040301*      RELEASE SRT.                                               EW006300
040301       RELEASE SRT                                                EW006310
040301       MOVE  '00000'             TO   SRTKTBLE                    EW006320
040301       MOVE  '9999'              TO   SRTKSCHL                    EW006330
040301       RELEASE SRT                                                EW006340
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT.                   EW006350
                                                                        EW006360
           IF      CDFCONTROL          =    '3002'                      EW006370
             MOVE  '7600'              TO   SRTKFUNC                    EW006380
             MOVE  CDFAMT1             TO   SRTAMT                      EW006390
             RELEASE SRT                                                EW006400
040301       MOVE  '00000'             TO   SRTKTBLE                    EW006410
040301       MOVE  '9999'              TO   SRTKSCHL                    EW006420
040301       RELEASE SRT                                                EW006430
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                    EW006440
             MOVE  '7700'              TO   SRTKFUNC                    EW006450
             MOVE  CDFAMT2             TO   SRTAMT                      EW006460
             RELEASE SRT                                                EW006470
040301       MOVE  '00000'             TO   SRTKTBLE                    EW006480
040301       MOVE  '9999'              TO   SRTKSCHL                    EW006490
040301       RELEASE SRT                                                EW006500
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                    EW006510
             MOVE  '7800'              TO   SRTKFUNC                    EW006520
             MOVE  CDFAMT3             TO   SRTAMT                      EW006530
             RELEASE SRT                                                EW006540
040301       MOVE  '00000'             TO   SRTKTBLE                    EW006550
040301       MOVE  '9999'              TO   SRTKSCHL                    EW006560
040301       RELEASE SRT                                                EW006570
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                    EW006580
             MOVE  '7900'              TO   SRTKFUNC                    EW006590
             MOVE  CDFAMT4             TO   SRTAMT                      EW006600
040301*      RELEASE SRT.                                               EW006610
040301       RELEASE SRT                                                EW006620
040301       MOVE  '00000'             TO   SRTKTBLE                    EW006630
040301       MOVE  '9999'              TO   SRTKSCHL                    EW006640
040301       RELEASE SRT                                                EW006650
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT.                   EW006660
                                                                        EW006670
           IF      CDFCONTROL          =    '3003'                      EW006680
             MOVE  '8100'              TO   SRTKFUNC                    EW006690
             MOVE  CDFAMT1             TO   SRTAMT                      EW006700
040301*      RELEASE SRT.                                               EW006710
040301       RELEASE SRT                                                EW006720
040301       MOVE  '00000'             TO   SRTKTBLE                    EW006730
040301       MOVE  '9999'              TO   SRTKSCHL                    EW006740
040301       RELEASE SRT                                                EW006750
041306*      PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT.                   EW006760
041306       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                            
041306       MOVE  '8200'              TO   SRTKFUNC                            
041306       MOVE  CDFAMT2             TO   SRTAMT                              
041306       RELEASE SRT                                                        
041306       MOVE  '00000'             TO   SRTKTBLE                            
041306       MOVE  '9999'              TO   SRTKSCHL                            
041306       RELEASE SRT                                                        
041306       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                            
041306       MOVE  '6500'              TO   SRTKFUNC                            
041306       MOVE  CDFAMT3             TO   SRTAMT                              
041306       RELEASE SRT                                                        
041306       MOVE  '00000'             TO   SRTKTBLE                            
041306       MOVE  '9999'              TO   SRTKSCHL                            
041306       RELEASE SRT                                                        
041306       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT.                           
                                                                        EW006770
           IF      CDFCONTROL          =    '6000'                      EW006780
             MOVE  '6100'              TO   SRTKFUNC                    EW006790
             MOVE  CDFAMT1             TO   SRTAMT                      EW006800
             RELEASE SRT                                                EW006810
040301       MOVE  '00000'             TO   SRTKTBLE                    EW006820
040301       MOVE  '9999'              TO   SRTKSCHL                    EW006830
040301       RELEASE SRT                                                EW006840
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                    EW006850
             MOVE  '6200'              TO   SRTKFUNC                    EW006860
             MOVE  CDFAMT2             TO   SRTAMT                      EW006870
             RELEASE SRT                                                EW006880
040301       MOVE  '00000'             TO   SRTKTBLE                    EW006890
040301       MOVE  '9999'              TO   SRTKSCHL                    EW006900
040301       RELEASE SRT                                                EW006910
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                    EW006920
             MOVE  '6300'              TO   SRTKFUNC                    EW006930
             MOVE  CDFAMT3             TO   SRTAMT                      EW006940
             RELEASE SRT                                                EW006950
040301       MOVE  '00000'             TO   SRTKTBLE                    EW006960
040301       MOVE  '9999'              TO   SRTKSCHL                    EW006970
040301       RELEASE SRT                                                EW006980
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                    EW006990
             MOVE  '6400'              TO   SRTKFUNC                    EW007000
             MOVE  CDFAMT4             TO   SRTAMT                      EW007010
             RELEASE SRT                                                EW007020
040301       MOVE  '00000'             TO   SRTKTBLE                    EW007030
040301       MOVE  '9999'              TO   SRTKSCHL                    EW007040
040301       RELEASE SRT                                                EW007050
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                    EW007060
             MOVE  '0000'              TO   SRTKSCHL                    EW007070
             MOVE  '6100'              TO   SRTKFUNC                    EW007080
             MOVE  CDFAMT1             TO   SRTAMT                      EW007090
             RELEASE SRT                                                EW007100
             MOVE  '0000'              TO   SRTKSCHL                    EW007110
             MOVE  '6200'              TO   SRTKFUNC                    EW007120
             MOVE  CDFAMT2             TO   SRTAMT                      EW007130
             RELEASE SRT                                                EW007140
             MOVE  '0000'              TO   SRTKSCHL                    EW007150
             MOVE  '6300'              TO   SRTKFUNC                    EW007160
             MOVE  CDFAMT3             TO   SRTAMT                      EW007170
             RELEASE SRT                                                EW007180
             MOVE  '0000'              TO   SRTKSCHL                    EW007190
             MOVE  '6400'              TO   SRTKFUNC                    EW007200
             MOVE  CDFAMT4             TO   SRTAMT                      EW007210
             RELEASE SRT.                                               EW007220
                                                                        EW007230
           IF      CDFCONTROL          =    '6001'                      EW007240
             MOVE  '7300'              TO   SRTKFUNC                    EW007250
             MOVE  CDFAMT1             TO   SRTAMT                      EW007260
             RELEASE SRT                                                EW007270
040301       MOVE  '00000'             TO   SRTKTBLE                    EW007280
040301       MOVE  '9999'              TO   SRTKSCHL                    EW007290
040301       RELEASE SRT                                                EW007300
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                    EW007310
             MOVE  '7400'              TO   SRTKFUNC                    EW007320
             MOVE  CDFAMT2             TO   SRTAMT                      EW007330
             RELEASE SRT                                                EW007340
040301       MOVE  '00000'             TO   SRTKTBLE                    EW007350
040301       MOVE  '9999'              TO   SRTKSCHL                    EW007360
040301       RELEASE SRT                                                EW007370
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                    EW007380
             MOVE  '7600'              TO   SRTKFUNC                    EW007390
             MOVE  CDFAMT3             TO   SRTAMT                      EW007400
             RELEASE SRT                                                EW007410
040301       MOVE  '00000'             TO   SRTKTBLE                    EW007420
040301       MOVE  '9999'              TO   SRTKSCHL                    EW007430
040301       RELEASE SRT                                                EW007440
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                    EW007450
             MOVE  '7700'              TO   SRTKFUNC                    EW007460
             MOVE  CDFAMT4             TO   SRTAMT                      EW007470
             RELEASE SRT                                                EW007480
040301       MOVE  '00000'             TO   SRTKTBLE                    EW007490
040301       MOVE  '9999'              TO   SRTKSCHL                    EW007500
040301       RELEASE SRT                                                EW007510
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                    EW007520
             MOVE  '0000'              TO   SRTKSCHL                    EW007530
             MOVE  '7300'              TO   SRTKFUNC                    EW007540
             MOVE  CDFAMT1             TO   SRTAMT                      EW007550
             RELEASE SRT                                                EW007560
             MOVE  '0000'              TO   SRTKSCHL                    EW007570
             MOVE  '7400'              TO   SRTKFUNC                    EW007580
             MOVE  CDFAMT2             TO   SRTAMT                      EW007590
             RELEASE SRT                                                EW007600
             MOVE  '0000'              TO   SRTKSCHL                    EW007610
             MOVE  '7600'              TO   SRTKFUNC                    EW007620
             MOVE  CDFAMT3             TO   SRTAMT                      EW007630
             RELEASE SRT                                                EW007640
             MOVE  '0000'              TO   SRTKSCHL                    EW007650
             MOVE  '7700'              TO   SRTKFUNC                    EW007660
             MOVE  CDFAMT4             TO   SRTAMT                      EW007670
             RELEASE SRT.                                               EW007680
                                                                        EW007690
           IF      CDFCONTROL          =    '6002'                      EW007700
             MOVE  '7800'              TO   SRTKFUNC                    EW007710
             MOVE  CDFAMT1             TO   SRTAMT                      EW007720
             RELEASE SRT                                                EW007730
040301       MOVE  '00000'             TO   SRTKTBLE                    EW007740
040301       MOVE  '9999'              TO   SRTKSCHL                    EW007750
040301       RELEASE SRT                                                EW007760
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                    EW007770
             MOVE  '7900'              TO   SRTKFUNC                    EW007780
             MOVE  CDFAMT2             TO   SRTAMT                      EW007790
             RELEASE SRT                                                EW007800
040301       MOVE  '00000'             TO   SRTKTBLE                    EW007810
040301       MOVE  '9999'              TO   SRTKSCHL                    EW007820
040301       RELEASE SRT                                                EW007830
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                    EW007840
             MOVE  '8100'              TO   SRTKFUNC                    EW007850
             MOVE  CDFAMT3             TO   SRTAMT                      EW007860
             RELEASE SRT                                                EW007870
040301       MOVE  '00000'             TO   SRTKTBLE                    EW007880
040301       MOVE  '9999'              TO   SRTKSCHL                    EW007890
040301       RELEASE SRT                                                EW007900
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                    EW007910
041306       MOVE  '8200'              TO   SRTKFUNC                            
041306       MOVE  CDFAMT4             TO   SRTAMT                              
041306       RELEASE SRT                                                        
041306       MOVE  '00000'             TO   SRTKTBLE                            
041306       MOVE  '9999'              TO   SRTKSCHL                            
041306       RELEASE SRT                                                        
041306       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                            
             MOVE  '0000'              TO   SRTKSCHL                    EW007920
             MOVE  '7800'              TO   SRTKFUNC                    EW007930
             MOVE  CDFAMT1             TO   SRTAMT                      EW007940
             RELEASE SRT                                                EW007950
             MOVE  '0000'              TO   SRTKSCHL                    EW007960
             MOVE  '7900'              TO   SRTKFUNC                    EW007970
             MOVE  CDFAMT2             TO   SRTAMT                      EW007980
             RELEASE SRT                                                EW007990
             MOVE  '0000'              TO   SRTKSCHL                    EW008000
             MOVE  '8100'              TO   SRTKFUNC                    EW008010
             MOVE  CDFAMT3             TO   SRTAMT                      EW008020
041306*      RELEASE SRT.                                               EW008030
041306       RELEASE SRT                                                        
041306       MOVE  '0000'              TO   SRTKSCHL                            
041306       MOVE  '8200'              TO   SRTKFUNC                            
041306       MOVE  CDFAMT4             TO   SRTAMT                              
041306       RELEASE SRT.                                                       
                                                                        EW008040
041306     IF      CDFCONTROL          =    '6003'                              
041306       MOVE  '6500'              TO   SRTKFUNC                            
041306       MOVE  CDFAMT1             TO   SRTAMT                              
041306       RELEASE SRT                                                        
041306       MOVE  '00000'             TO   SRTKTBLE                            
041306       MOVE  '9999'              TO   SRTKSCHL                            
041306       RELEASE SRT                                                        
041306       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                            
041306       MOVE  '0000'              TO   SRTKSCHL                            
041306       MOVE  '6500'              TO   SRTKFUNC                            
041306       MOVE  CDFAMT1             TO   SRTAMT                              
041306       RELEASE SRT.                                                       
                                                                                
           IF      CDFCONTROL          =    '7000'                      EW008050
             MOVE  '5100'              TO   SRTKFUNC                    EW008060
             MOVE  CDFAMT1             TO   SRTAMT                      EW008070
             RELEASE SRT                                                EW008080
040301       MOVE  '00000'             TO   SRTKTBLE                    EW008090
040301       MOVE  '9999'              TO   SRTKSCHL                    EW008100
040301       RELEASE SRT                                                EW008110
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                    EW008120
             MOVE  '5200'              TO   SRTKFUNC                    EW008130
             MOVE  CDFAMT2             TO   SRTAMT                      EW008140
             RELEASE SRT                                                EW008150
040301       MOVE  '00000'             TO   SRTKTBLE                    EW008160
040301       MOVE  '9999'              TO   SRTKSCHL                    EW008170
040301       RELEASE SRT                                                EW008180
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                    EW008190
             MOVE  '5300'              TO   SRTKFUNC                    EW008200
             MOVE  CDFAMT3             TO   SRTAMT                      EW008210
             RELEASE SRT                                                EW008220
040301       MOVE  '00000'             TO   SRTKTBLE                    EW008230
040301       MOVE  '9999'              TO   SRTKSCHL                    EW008240
040301       RELEASE SRT                                                EW008250
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                    EW008260
             MOVE  '5500'              TO   SRTKFUNC                    EW008270
             MOVE  CDFAMT4             TO   SRTAMT                      EW008280
             RELEASE SRT                                                EW008290
040301       MOVE  '00000'             TO   SRTKTBLE                    EW008300
040301       MOVE  '9999'              TO   SRTKSCHL                    EW008310
040301       RELEASE SRT                                                EW008320
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                    EW008330
             MOVE  '5600'              TO   SRTKFUNC                    EW008340
             MOVE  CDFAMT5             TO   SRTAMT                      EW008350
             RELEASE SRT                                                EW008360
040301       MOVE  '00000'             TO   SRTKTBLE                    EW008370
040301       MOVE  '9999'              TO   SRTKSCHL                    EW008380
040301       RELEASE SRT                                                EW008390
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                    EW008400
             MOVE  '5700'              TO   SRTKFUNC                    EW008410
             MOVE  CDFAMT6             TO   SRTAMT                      EW008420
             RELEASE SRT                                                EW008430
040301       MOVE  '00000'             TO   SRTKTBLE                    EW008440
040301       MOVE  '9999'              TO   SRTKSCHL                    EW008450
040301       RELEASE SRT                                                EW008460
040301       PERFORM 016-BUILD-SRTKEY  THRU 016-EXIT                    EW008470
             MOVE  '0000'              TO   SRTKSCHL                    EW008480
             MOVE  '5100'              TO   SRTKFUNC                    EW008490
             MOVE  CDFAMT1             TO   SRTAMT                      EW008500
             RELEASE SRT                                                EW008510
             MOVE  '0000'              TO   SRTKSCHL                    EW008520
             MOVE  '5200'              TO   SRTKFUNC                    EW008530
             MOVE  CDFAMT2             TO   SRTAMT                      EW008540
             RELEASE SRT                                                EW008550
             MOVE  '0000'              TO   SRTKSCHL                    EW008560
             MOVE  '5300'              TO   SRTKFUNC                    EW008570
             MOVE  CDFAMT3             TO   SRTAMT                      EW008580
             RELEASE SRT                                                EW008590
             MOVE  '0000'              TO   SRTKSCHL                    EW008600
             MOVE  '5500'              TO   SRTKFUNC                    EW008610
             MOVE  CDFAMT4             TO   SRTAMT                      EW008620
             RELEASE SRT                                                EW008630
             MOVE  '0000'              TO   SRTKSCHL                    EW008640
             MOVE  '5600'              TO   SRTKFUNC                    EW008650
             MOVE  CDFAMT5             TO   SRTAMT                      EW008660
             RELEASE SRT                                                EW008670
             MOVE  '0000'              TO   SRTKSCHL                    EW008680
             MOVE  '5700'              TO   SRTKFUNC                    EW008690
             MOVE  CDFAMT6             TO   SRTAMT                      EW008700
             RELEASE SRT.                                               EW008710
                                                                        EW008720
       015-EXIT.                                                        EW008730
           EXIT.                                                        EW008740
                                                                        EW008750
040301 016-BUILD-SRTKEY.                                                EW008760
040301     MOVE    RQRDIST             TO   SRTKDIST                    EW008770
040301     MOVE    RQRREQ              TO   SRTKREQ                     EW008780
040301     MOVE    CDFFY               TO   SRTKFY                      EW008790
040301     MOVE    CDFFUND             TO   SRTKFUND                    EW008800
040301     MOVE    CDFTABLE            TO   SRTKTBLE                    EW008810
040301     MOVE    CDFSCHL             TO   SRTKSCHL                    EW008820
040301     MOVE    CDFCONTROL          TO   SRTKCTRL                    EW008830
040301     MOVE    RQRPRT              TO   SRTPRT.                     EW008840
040301 016-EXIT.                                                        EW008850
040301     EXIT.                                                        EW008860
                                                                        EW008870
      ******************************************************************EW008880
       490-HOUSEKEEPING.                                                EW008890
           OPEN    INPUT                    CRD-CARD      CRF-DISK      EW008900
                                            CDF-DISK                    EW008910
                   OUTPUT                   PR1-PRNT                    EW008920
           MOVE    SPACES              TO   LN1                         EW008930
           MOVE    '1'                 TO   CTLCHAR                     EW008940
           MOVE    HIGH-VALUES         TO   RQR           RQH.          EW008950
           SET     RQH1                TO   +1.                         EW008960
       490-LOAD.                                                        EW008970
           READ    CRD-CARD            AT   END                         EW008980
             GO                        TO   490-TEST.                   EW008990
           IF      CRDREQ              NOT  NUMERIC                     EW009000
             MOVE    CRD               TO   LNMVALUE2                   EW009010
             PERFORM 520-PRINT         THRU 520-EXIT                    EW009020
             GO                        TO   490-LOAD.                   EW009030
           MOVE    SPACES              TO   ERR                         EW009040
           IF      CRDID               =    'SL'                        EW009050
             GO                        TO   490-REQ                     EW009060
           ELSE                                                         EW009070
             IF     (CRDID             =    'H1')                    OR EW009080
                    (CRDID             =    'H2')                       EW009090
               GO                      TO   490-HEAD                    EW009100
             ELSE                                                       EW009110
               GO                      TO   490-LOAD.                   EW009120
                                                                        EW009130
       490-REQ.                                                         EW009140
           IF     (CRDPRT              NOT  =   'U')                 ANDEW009150
                  (CRDPRT              NOT  =   'T')                 ANDEW009160
                  (CRDPRT              NOT  =   'B')                 ANDEW009170
                  (CRDPRT              NOT  =   'N')                    EW009180
             MOVE  ALL '-'             TO   ERRPRT.                     EW009190
           IF     (CRDDIST             =    SPACES)                     EW009200
             MOVE  ALL '-'             TO   ERRDIST.                    EW009210
           IF     (CRDFY               NOT  NUMERIC)                    EW009220
             MOVE  ALL '-'             TO   ERRFY.                      EW009230
           IF     (CRDRPT              NOT  =   'A')                 ANDEW009240
                  (CRDRPT              NOT  =   'B')                    EW009250
             MOVE  ALL '-'             TO   ERRRPT.                     EW009260
           IF     (CRDFUND             NOT  =   '1')                 ANDEW009270
                  (CRDFUND             NOT  =   '4')                 ANDEW009280
                  (CRDFUND             NOT  =   ' ')                    EW009290
             MOVE  ALL '-'             TO   ERRFUND.                    EW009300
           IF     (CRDERR              NOT  =   ' '               AND   EW009310
                   CRDFUND             NOT  =   'Y')                 OR EW009320
                  (CRDRPT              =    'A'                   AND   EW009330
                   CRDERR              NOT  =   SPACES)                 EW009340
             MOVE  ALL '-'             TO   ERRERR.                     EW009350
           IF      ERR                 NOT  =   SPACES                  EW009360
             MOVE    'ERROR. BYPASSED' TO   LNMMSG                      EW009370
             MOVE    CRD               TO   LNMVALUE2                   EW009380
             PERFORM 520-PRINT         THRU 520-EXIT                    EW009390
             MOVE    ERR               TO   LNMVALUE2                   EW009400
             PERFORM 520-PRINT         THRU 520-EXIT                    EW009410
             GO                        TO   490-LOAD                    EW009420
           ELSE                                                         EW009430
             MOVE    'REQUEST LOADED'  TO   LNMMSG                      EW009440
             MOVE    CRD               TO   LNMVALUE2                   EW009450
             PERFORM 520-PRINT         THRU 520-EXIT.                   EW009460
           MOVE    CRDREQ              TO   RQRREQ                      EW009470
           MOVE    CRDPRT              TO   RQRPRT                      EW009480
           MOVE    CRDDIST             TO   RQRDIST                     EW009490
           MOVE    CRDFY               TO   RQRFY                       EW009500
           MOVE    CRDFUND             TO   RQRFUND                     EW009510
           MOVE    CRDTBLE             TO   RQRTBLE                     EW009520
           MOVE    CRDSCHL             TO   RQRSCHL                     EW009530
           MOVE    CRDERR              TO   RQRERR                      EW009540
           MOVE    CRDRPT              TO   RQRRPT                      EW009550
                                                                        EW009560
           MOVE    CRDDIST             TO   CDFKEY                      EW009570
           MOVE    CRDFY               TO   CDFFY                       EW009580
           MOVE    CRDFUND             TO   CDFFUND                     EW009590
           MOVE    CRDTBLE             TO   CDFTABLE                    EW009600
           MOVE    CRDSCHL             TO   CDFSCHL                     EW009610
           IF     (CDFKEY              <    STRKEY)                     EW009620
             MOVE  CDFKEY              TO   STRKEY.                     EW009630
           SET     CDF1                TO   +15.                        EW009640
       490-SET.                                                         EW009650
           IF      CDFB     (CDF1)     =    SPACES                      EW009660
             MOVE  HIGH-VALUES         TO   CDFB (CDF1).                EW009670
           IF      CDF1                <    +32                         EW009680
             SET   CDF1                UP   BY  +1                      EW009690
             GO                        TO   490-SET.                    EW009700
           IF     (CDFKEY              >    ENDKEY)                     EW009710
             MOVE  CDFKEY              TO   ENDKEY.                     EW009720
           GO                          TO   490-LOAD.                   EW009730
       490-HEAD.                                                        EW009740
           MOVE    CRD                 TO   LNMVALUE2                   EW009750
           PERFORM 520-PRINT           THRU 520-EXIT                    EW009760
           MOVE    CRHREQ              TO   RQHREQ       (RQH1)         EW009770
           MOVE    CRHID               TO   RQHID        (RQH1)         EW009780
           MOVE    CRHUSER             TO   RQHUSER      (RQH1)         EW009790
           MOVE    SPACES              TO   RQHHEAD      (RQH1)         EW009800
           MOVE    +50                 TO   CTRIDX                      EW009810
           SET     CRH1                TO   +50.                        EW009820
       490-HEAD1.                                                       EW009830
           IF      CRHB         (CRH1) =    SPACES                      EW009840
             IF      CRH1              >    +2                          EW009850
               ADD   -1                TO   CTRIDX                      EW009860
               SET   CRH1              DOWN BY  +1                      EW009870
               GO                      TO   490-HEAD1.                  EW009880
           SUBTRACT +1                 FROM CTRIDX                      EW009890
           COMPUTE CTRIDX      ROUNDED =    (50  - CTRIDX) / 2          EW009900
           SET     RQH2                TO   CTRIDX                      EW009910
           SET     CRH1                TO   +1.                         EW009920
       490-HEAD2.                                                       EW009930
           MOVE    CRHB         (CRH1) TO   RQHB         (RQH1 RQH2)    EW009940
           IF      RQH2                <    +50                         EW009950
             SET   RQH2  CRH1          UP   BY  +1                      EW009960
             GO                        TO   490-HEAD2.                  EW009970
           SET     RQH1             UP BY   +1                          EW009980
           GO                          TO   490-LOAD.                   EW009990
                                                                        EW010000
       490-TEST.                                                        EW010010
           IF      RQR                 =    HIGH-VALUES                 EW010020
             MOVE    'EW026 NO REQUESTS *'   TO   LNMMSG                EW010030
             PERFORM 520-PRINT         THRU 520-EXIT.                   EW010040
           IF      RETCRF              NOT  =   '00'                    EW010050
             MOVE    'CRF OPEN ERROR'  TO   LNMMSG                      EW010060
             MOVE    RETCRF            TO   LNMVALUE1                   EW010070
             PERFORM 520-PRINT         THRU 520-EXIT.                   EW010080
           IF      RETCDF              NOT  =   '00'                    EW010090
             MOVE    'CDF OPEN ERROR'  TO   LNMMSG                      EW010100
             MOVE    RETCDF            TO   LNMVALUE1                   EW010110
             PERFORM 520-PRINT         THRU 520-EXIT.                   EW010120
           IF     (RETCRF              NOT  =   '00')                OR EW010130
                  (RETCDF              NOT  =   '00')                   EW010140
             GO                        TO   499-EOJ.                    EW010150
           MOVE    STRKEY              TO   CDFDK                       EW010160
           START   CDF-DISK        KEY >    CDFDK                       EW010170
           IF      RETCDF              =    '00'                        EW010180
             PERFORM 010-READ          THRU 010-EXIT.                   EW010190
       490-EXIT.                                                        EW010200
           EXIT.                                                        EW010210
                                                                        EW010220
      ******************************************************************EW010230
       499-EOJ.                                                         EW010240
       499-EXIT.                                                        EW010250
           EXIT.                                                        EW010260
                                                                        EW010270
      ******************************************************************EW010280
       500-OUTPUT SECTION.                                              EW010290
           PERFORM 990-HOUSEKEEPING    THRU 990-EXIT.                   EW010300
       505-LOOP.                                                        EW010310
             IF    (SRTKDIST           NOT  =   OLDKDIST)            OR EW010320
                   (SRTKREQ            NOT  =   OLDKREQ)             OR EW010330
                   (SRTKFY             NOT  =   OLDKFY)              OR EW010340
                   (SRTKFUND           NOT  =   OLDKFUND)            OR EW010350
                   (SRTKTBLE           NOT  =   OLDKTBLE)            OR EW010360
                   (SRTKSCHL           NOT  =   OLDKSCHL)            OR EW010370
                   (SRTKFUNC           NOT  =   OLDKFUNC)            OR EW010380
                   (SRTKCTRL           NOT  =   OLDKCTRL)               EW010390
               PERFORM 615-1TOT        THRU 615-EXIT                    EW010400
               IF  (SRTKDIST           NOT  =   OLDKDIST)            OR EW010410
                   (SRTKREQ            NOT  =   OLDKREQ)             OR EW010420
                   (SRTKFY             NOT  =   OLDKFY)              OR EW010430
                   (SRTKFUND           NOT  =   OLDKFUND)            OR EW010440
                   (SRTKTBLE           NOT  =   OLDKTBLE)            OR EW010450
                   (SRTKSCHL           NOT  =   OLDKSCHL)            OR EW010460
                   (SRTKFUNC           NOT  =   OLDKFUNC)               EW010470
                 PERFORM 625-2TOT      THRU 625-EXIT                    EW010480
                 IF  (SRTKDIST         NOT  =   OLDKDIST)            OR EW010490
                     (SRTKREQ          NOT  =   OLDKREQ)             OR EW010500
                     (SRTKFY           NOT  =   OLDKFY)              OR EW010510
                     (SRTKFUND         NOT  =   OLDKFUND)            OR EW010520
                     (SRTKTBLE         NOT  =   OLDKTBLE)            OR EW010530
                     (SRTKSCHL         NOT  =   OLDKSCHL)               EW010540
                   PERFORM 635-3TOT    THRU 635-EXIT                    EW010550
                   IF  (SRTKDIST       NOT  =   OLDKDIST)            OR EW010560
                       (SRTKREQ        NOT  =   OLDKREQ)             OR EW010570
                       (SRTKFY         NOT  =   OLDKFY)              OR EW010580
                       (SRTKFUND       NOT  =   OLDKFUND)            OR EW010590
                       (SRTKTBLE       NOT  =   OLDKTBLE)               EW010600
                     PERFORM 645-4TOT  THRU 645-EXIT                    EW010610
                     IF  (SRTKDIST     NOT  =   OLDKDIST)            OR EW010620
                         (SRTKREQ      NOT  =   OLDKREQ)             OR EW010630
                         (SRTKFY       NOT  =   OLDKFY)                 EW010640
                       PERFORM 655-5TOT  THRU 655-EXIT                  EW010650
                       IF  (SRTKEY          =    HIGH-VALUES)           EW010660
                         GO                 TO   999-EOJ                EW010670
                       ELSE                                             EW010680
                         PERFORM 650-5CHG   THRU 650-EXIT               EW010690
                     ELSE                                               EW010700
                       PERFORM 640-4CHG     THRU 640-EXIT               EW010710
                   ELSE                                                 EW010720
                     PERFORM 630-3CHG       THRU 630-EXIT               EW010730
                 ELSE                                                   EW010740
                   PERFORM 620-2CHG         THRU 620-EXIT               EW010750
               ELSE                                                     EW010760
                 PERFORM 610-1CHG           THRU 610-EXIT.              EW010770
                                                                        EW010780
           PERFORM 515-PROCESS         THRU 515-EXIT                    EW010790
           PERFORM 510-READ            THRU 510-EXIT                    EW010800
           GO                          TO   505-LOOP.                   EW010810
                                                                        EW010820
      ******************************************************************EW010830
       510-READ.                                                        EW010840
           RETURN  SRT-SORT            AT   END                         EW010850
             MOVE  HIGH-VALUES         TO   SRTKEY.                     EW010860
       510-EXIT.                                                        EW010870
           EXIT.                                                        EW010880
                                                                        EW010890
      ******************************************************************EW010900
       515-PROCESS.                                                     EW010910
           ADD      SRTAMT             TO   CTRAMT.                     EW010920
       515-EXIT.                                                        EW010930
           EXIT.                                                        EW010940
                                                                        EW010950
      ******************************************************************EW010960
       520-PRINT.                                                       EW010970
           IF      CTRLN               >    +60                         EW010980
             PERFORM 525-HEADS         THRU 525-EXIT.                   EW010990
           IF      CTLCHAR             =    '1'                         EW011000
             WRITE LN1             AFTER    ADVANCING PAGE              EW011010
           ELSE                                                         EW011020
             IF      CTLCHAR           =    '0'                         EW011030
               WRITE LN1           AFTER    ADVANCING  2  LINES         EW011040
               ADD   +2                TO   CTRLN                       EW011050
             ELSE                                                       EW011060
               IF      CTLCHAR         =    ' '                         EW011070
                 WRITE LN1         AFTER    ADVANCING  1  LINES         EW011080
                 ADD   +1              TO   CTRLN                       EW011090
               ELSE                                                     EW011100
                 WRITE LN1         AFTER    ADVANCING  0  LINES         EW011110
                 ADD   +0              TO   CTRLN.                      EW011120
           MOVE    SPACES              TO   LN1           CTLCHAR.      EW011130
       520-EXIT.                                                        EW011140
           EXIT.                                                        EW011150
                                                                        EW011160
       525-HEADS.                                                       EW011170
           MOVE    LN1                 TO   OLDLN                       EW011180
           MOVE    +0                  TO   CTRLN                       EW011190
           ADD     +1                  TO   CTRPG                       EW011200
           MOVE    CTRPG               TO   HD1PG                       EW011210
           MOVE    HD1                 TO   LN1                         EW011220
           MOVE    '1'                 TO   CTLCHAR                     EW011230
           PERFORM 520-PRINT           THRU 520-EXIT                    EW011240
           IF      HD2                 NOT  =   SPACES                  EW011250
             MOVE    HD2               TO   LN1                         EW011260
             PERFORM 520-PRINT         THRU 520-EXIT.                   EW011270
           IF      HD3                 NOT  =   SPACES                  EW011280
             MOVE    HD3               TO   LN1                         EW011290
             PERFORM 520-PRINT         THRU 520-EXIT.                   EW011300
           MOVE    '0'                 TO   CTLCHAR                     EW011310
           IF      SRTKREQ             =    OLDKREQ                     EW011320
             MOVE    HD4               TO   LN1                         EW011330
             PERFORM 520-PRINT         THRU 520-EXIT                    EW011340
             MOVE    HD5               TO   LN1                         EW011350
             PERFORM 520-PRINT         THRU 520-EXIT                    EW011360
             MOVE    HD6               TO   LN1                         EW011370
             PERFORM 520-PRINT         THRU 520-EXIT.                   EW011380
           MOVE    '0'                 TO   CTLCHAR                     EW011390
           MOVE    HD7                 TO   LN1                         EW011400
           PERFORM 520-PRINT           THRU 520-EXIT                    EW011410
           MOVE    HD8                 TO   LN1                         EW011420
           PERFORM 520-PRINT           THRU 520-EXIT                    EW011430
           MOVE    '0'                 TO   CTLCHAR                     EW011440
           IF      SRTKREQ             =    OLDKREQ                     EW011450
             MOVE    HD9               TO   LN1                         EW011460
             PERFORM 520-PRINT         THRU 520-EXIT.                   EW011470
           MOVE    OLDLN               TO   LN1.                        EW011480
       525-EXIT.                                                        EW011490
           EXIT.                                                        EW011500
                                                                        EW011510
      ******************************************************************EW011520
       610-1CHG.                                                        EW011530
           MOVE    SRTKCTRL            TO   OLDKCTRL                    EW011540
           MOVE    ZEROS               TO   CTRAMT.                     EW011550
       610-EXIT.                                                        EW011560
           EXIT.                                                        EW011570
                                                                        EW011580
       615-1TOT.                                                        EW011590
           IF      OLDKCTRL1           NOT  =  '7'                      EW011600
             ADD   CTRAMT              TO   CTRLNTOT  CTRSCHL6.         EW011610
           IF      OLDKCTRL1           =    '1'                         EW011620
             MOVE  CTRAMT              TO   LN1AMT1                     EW011630
             ADD   CTRAMT              TO   CTRSCHL1.                   EW011640
           IF      OLDKCTRL1           =    '7'                         EW011650
             MOVE  CTRAMT              TO   LN1AMT2                     EW011660
             ADD   CTRAMT              TO   CTRSCHL2.                   EW011670
           IF      OLDKCTRL1           =    '2'                         EW011680
             MOVE  CTRAMT              TO   LN1AMT3                     EW011690
             ADD   CTRAMT              TO   CTRSCHL3.                   EW011700
           IF      OLDKCTRL1           =    '6'                         EW011710
             MOVE  CTRAMT              TO   LN1AMT4                     EW011720
             ADD   CTRAMT              TO   CTRSCHL4.                   EW011730
           IF      OLDKCTRL1           =    '3'                         EW011740
             MOVE  CTRAMT              TO   LN1AMT5                     EW011750
             ADD   CTRAMT              TO   CTRSCHL5.                   EW011760
           IF     (OLDKFUNC            >    '5000'       AND            EW011770
                   OLDKFUNC            <    '6000')            AND      EW011780
                  (OLDKCTRL1           =    '1')                        EW011790
             ADD   CTRAMT              TO   CTRINST1.                   EW011800
           IF     (OLDKFUNC            >    '5000'       AND            EW011810
                   OLDKFUNC            <    '6000')            AND      EW011820
                  (OLDKCTRL1           =    '7')                        EW011830
             ADD   CTRAMT              TO   CTRINST2.                   EW011840
       615-EXIT.                                                        EW011850
           EXIT.                                                        EW011860
                                                                        EW011870
       620-2CHG.                                                        EW011880
           MOVE    SRTKFUNC            TO   OLDKFUNC                    EW011890
           MOVE    ZEROS               TO   CTRLNTOT                    EW011900
           PERFORM 610-1CHG            THRU 610-EXIT.                   EW011910
       620-EXIT.                                                        EW011920
           EXIT.                                                        EW011930
                                                                        EW011940
       625-2TOT.                                                        EW011950
           IF      OLDKFUNC            >    '6000'                      EW011960
             MOVE  OLDKFUNC            TO   LN1FUNC.                    EW011970
           MOVE    OLDKFUNC            TO   WSCFUNC                     EW011980
           PERFORM 700-FUNC-NAME       THRU 700-EXIT                    EW011990
           MOVE    WSCNAME             TO   LN1NAME                     EW012000
           MOVE    CTRLNTOT            TO   LN1TOT                      EW012010
           PERFORM 520-PRINT           THRU 520-EXIT                    EW012020
           IF     (OLDKFUNC            <    '6000')           AND       EW012030
                  (SRTKFUNC            >    '6000'        OR            EW012040
                   OLDKSCHL            NOT  =  SRTKSCHL)                EW012050
             MOVE  'SUBTOTAL INSTRUCTION'   TO   LN1NAME                EW012060
             MOVE  CTRINST1            TO   LN1AMT1                     EW012070
             MOVE  CTRINST2            TO   LN1AMT2                     EW012080
             PERFORM 520-PRINT         THRU 520-EXIT                    EW012090
             MOVE  ZEROS               TO   CTRINST1  CTRINST2.         EW012100
       625-EXIT.                                                        EW012110
           EXIT.                                                        EW012120
                                                                        EW012130
       630-3CHG.                                                        EW012140
           MOVE    SRTKSCHL            TO   OLDKSCHL  HD6SCHL           EW012150
           MOVE    SRTKDIST            TO   SCLDIST                     EW012160
           MOVE    SRTKFY              TO   SCLFY                       EW012170
           MOVE    'SCL'               TO   SCLPREF                     EW012180
           MOVE    SRTKSCHL            TO   SCLSCL                      EW012190
           MOVE    SCLKEY              TO   CRFDK                       EW012200
           READ    CRF-DISK                                             EW012210
           IF      RETCRF              NOT  =  '00'                     EW012220
             MOVE  'UNKNOWN'           TO   HD6DESC                     EW012230
           ELSE                                                         EW012240
             MOVE  CRFD                TO   SCL                         EW012250
             MOVE  SCLDESC             TO   HD6DESC.                    EW012260
040301     IF      SRTKSCHL            =    '9999'                      EW012270
040301       MOVE  'TOTAL PAGE'        TO   HD6DESC.                    EW012280
           MOVE    ZEROS               TO   CTRSCHL1  CTRSCHL2          EW012290
                                            CTRSCHL3  CTRSCHL4          EW012300
                                            CTRSCHL5  CTRSCHL6          EW012310
           PERFORM 620-2CHG            THRU 620-EXIT.                   EW012320
       630-EXIT.                                                        EW012330
           EXIT.                                                        EW012340
                                                                        EW012350
       635-3TOT.                                                        EW012360
           MOVE    'SCHL  '            TO   LN2MSG                      EW012370
           MOVE    OLDKSCHL            TO   LN2FLD                      EW012380
           MOVE    CTRSCHL1            TO   LN2AMT1                     EW012390
           MOVE    CTRSCHL2            TO   LN2AMT2                     EW012400
           MOVE    CTRSCHL3            TO   LN2AMT3                     EW012410
           MOVE    CTRSCHL4            TO   LN2AMT4                     EW012420
           MOVE    CTRSCHL5            TO   LN2AMT5                     EW012430
           MOVE    CTRSCHL6            TO   LN2AMT6                     EW012440
           MOVE    '0'                 TO   CTLCHAR                     EW012450
           PERFORM 520-PRINT           THRU 520-EXIT                    EW012460
           MOVE    +61                 TO   CTRLN                       EW012470
           IF      OLDKSCHL            =    '0000'                      EW012480
             ADD   CTRSCHL1            TO   CTRREQ1                     EW012490
             ADD   CTRSCHL2            TO   CTRREQ2                     EW012500
             ADD   CTRSCHL3            TO   CTRREQ3                     EW012510
             ADD   CTRSCHL4            TO   CTRREQ4                     EW012520
             ADD   CTRSCHL5            TO   CTRREQ5                     EW012530
             ADD   CTRSCHL6            TO   CTRREQ6.                    EW012540
       635-EXIT.                                                        EW012550
           EXIT.                                                        EW012560
                                                                        EW012570
       640-4CHG.                                                        EW012580
           MOVE    SRTKFUND            TO   OLDKFUND  HD4FND            EW012590
           MOVE    SRTKTBLE            TO   OLDKTBLE  HD5TBL            EW012600
           MOVE    SRTKDIST            TO   TBLKEY                      EW012610
           MOVE    SRTKFY              TO   TBLFY                       EW012620
           MOVE    'TBL'               TO   TBLPREF                     EW012630
           MOVE    SRTKTBLE            TO   TBLTBL                      EW012640
           MOVE    TBLKEY              TO   CRFDK                       EW012650
           READ    CRF-DISK                                             EW012660
           IF      RETCRF              NOT  =  '00'                     EW012670
             MOVE  'UNKNOWN'           TO   TBLDESC                     EW012680
           ELSE                                                         EW012690
             MOVE  CRFD                TO   TBL.                        EW012700
           MOVE    TBLDESC             TO   HD5DESC                     EW012710
040301     IF      SRTKTBLE            =    '00000'                     EW012720
040301       MOVE  'TOTAL PAGE'        TO   HD5DESC.                    EW012730
           PERFORM 630-3CHG            THRU 630-EXIT.                   EW012740
       640-EXIT.                                                        EW012750
           EXIT.                                                        EW012760
                                                                        EW012770
       645-4TOT.                                                        EW012780
       645-EXIT.                                                        EW012790
           EXIT.                                                        EW012800
                                                                        EW012810
       650-5CHG.                                                        EW012820
           MOVE     ZEROS              TO   CTRLN         CTRPG         EW012830
                                            CTRREQ1       CTRREQ2       EW012840
                                            CTRREQ3       CTRREQ4       EW012850
                                            CTRREQ5       CTRREQ6       EW012860
           MOVE     SRTKREQ            TO   OLDKREQ                     EW012870
           MOVE     SRTKDIST           TO   OLDKDIST                    EW012880
           MOVE     SRTKFY             TO   OLDKFY                      EW012890
           MOVE     SRTPRT             TO   OLDPRT                      EW012900
                                                                        EW012910
           MOVE     '    SCL0000'      TO   SCLKEY                      EW012920
           MOVE     SRTKDIST           TO   SCLDIST                     EW012930
           MOVE     SRTKFY             TO   SCLFY                       EW012940
           MOVE     SCLKEY             TO   CRFDK                       EW012950
           READ     CRF-DISK                                            EW012960
           IF       RETCRF             NOT  =   '00'                    EW012970
             MOVE   'UNKNOWN'          TO   HD1ABBR                     EW012980
           ELSE                                                         EW012990
             MOVE   CRFD               TO   SCL                         EW013000
             MOVE   SCLABBR            TO   HD1ABBR.                    EW013010
           SET     HD11                TO   +15.                        EW013020
       650-REQ.                                                         EW013030
           IF      HD1B         (HD11) =    SPACES                      EW013040
             SET   HD11                DOWN BY  +1                      EW013050
             GO                        TO   650-REQ.                    EW013060
           SET     HD11                UP   BY  +1                      EW013070
           MOVE    '-'                 TO   HD1B         (HD11)         EW013080
           SET     HD11                UP   BY  +1                      EW013090
           MOVE    SRTKREQ1            TO   HD1B         (HD11)         EW013100
           SET     HD11                UP   BY  +1                      EW013110
           MOVE    SRTKREQ2            TO   HD1B         (HD11)         EW013120
           SET     HD11                UP   BY  +1                      EW013130
           MOVE    SRTKREQ3            TO   HD1B         (HD11)         EW013140
           SET     HD11                UP   BY  +1                      EW013150
           MOVE    '-'                 TO   HD1B         (HD11)         EW013160
           SET     HD11                UP   BY  +1                      EW013170
           MOVE    SRTKFY1             TO   HD1B         (HD11)         EW013180
           SET     HD11                UP   BY  +1                      EW013190
           MOVE    SRTKFY2             TO   HD1B         (HD11).        EW013200
                                                                        EW013210
           SET     RQH1                TO   +1.                         EW013220
       650-HEAD.                                                        EW013230
           IF      RQHREQ       (RQH1) NOT  =   HIGH-VALUES             EW013240
             IF      RQHREQ     (RQH1) NOT  =   SRTKREQ                 EW013250
               SET   RQH1              UP   BY  +1                      EW013260
               GO                      TO   650-HEAD                    EW013270
             ELSE                                                       EW013280
               IF      RQHID    (RQH1) =    'H1'                        EW013290
                 MOVE  RQHHEAD  (RQH1) TO   HD2HEAD                     EW013300
                 MOVE  RQHUSER  (RQH1) TO   HD1USER                     EW013310
                 SET   RQH1            UP   BY  +1                      EW013320
                 GO                    TO   650-HEAD                    EW013330
               ELSE                                                     EW013340
                 IF      RQHID  (RQH1) =    'H2'                        EW013350
                   MOVE  RQHHEAD (RQH1) TO  HD3HEAD                     EW013360
                   SET   RQH1          UP   BY  +1                      EW013370
                   GO                  TO   650-HEAD.                   EW013380
           IF        OLDPRT            =    'N'                         EW013390
             MOVE    SPACES            TO   HD2HEAD       HD1USER       EW013400
             MOVE    SPACES            TO   HD3HEAD                     EW013410
           ELSE                                                         EW013420
             IF      OLDPRT            =    'U'                         EW013430
               MOVE  SPACES            TO   HD2HEAD       HD3HEAD       EW013440
             ELSE                                                       EW013450
               IF    OLDPRT            =    'T'                         EW013460
                 MOVE  SPACES          TO   HD1USER.                    EW013470
                                                                        EW013480
           PERFORM 640-4CHG            THRU 640-EXIT                    EW013490
           PERFORM 525-HEADS           THRU 525-EXIT.                   EW013500
       650-EXIT.                                                        EW013510
           EXIT.                                                        EW013520
                                                                        EW013530
       655-5TOT.                                                        EW013540
           MOVE    'REQ'               TO   LN2MSG                      EW013550
           MOVE    OLDKREQ             TO   LN2FLD                      EW013560
           MOVE    CTRREQ1             TO   LN2AMT1                     EW013570
           MOVE    CTRREQ2             TO   LN2AMT2                     EW013580
           MOVE    CTRREQ3             TO   LN2AMT3                     EW013590
           MOVE    CTRREQ4             TO   LN2AMT4                     EW013600
           MOVE    CTRREQ5             TO   LN2AMT5                     EW013610
           MOVE    CTRREQ6             TO   LN2AMT6                     EW013620
           PERFORM 520-PRINT           THRU 520-EXIT.                   EW013630
       655-EXIT.                                                        EW013640
           EXIT.                                                        EW013650
                                                                        EW013660
      ******************************************************************EW013670
       700-FUNC-NAME.                                                   EW013680
           IF      WSCFUNC                           =    '5100'        EW013690
             MOVE  '  SALARIES'                      TO   WSCNAME.      EW013700
           IF      WSCFUNC                           =    '5200'        EW013710
             MOVE  '  EMPLOYEE BENEFITS'             TO   WSCNAME.      EW013720
           IF      WSCFUNC                           =    '5300'        EW013730
             MOVE  '  PURCHASED SERVICES'            TO   WSCNAME.      EW013740
           IF      WSCFUNC                           =    '5500'        EW013750
             MOVE  '  MATERIALS AND SUPPLIES'        TO   WSCNAME.      EW013760
           IF      WSCFUNC                           =    '5600'        EW013770
             MOVE  '  OTHER EXPENSES'                TO   WSCNAME.      EW013780
           IF      WSCFUNC                           =    '5700'        EW013790
             MOVE  '  CAPITAL OUTLAY'                TO   WSCNAME.      EW013800
           IF      WSCFUNC                           =    '6100'        EW013810
             MOVE  'PUPIL PERSONNEL'                 TO   WSCNAME.      EW013820
           IF      WSCFUNC                           =    '6200'        EW013830
             MOVE  'INSTRUCTIONAL MEDIA'             TO   WSCNAME.      EW013840
           IF      WSCFUNC                           =    '6300'        EW013850
             MOVE  'INSTRUCTION AND CURRICULM DEV.'  TO   WSCNAME.      EW013860
           IF      WSCFUNC                           =    '6400'        EW013870
             MOVE  'INTRUCTIONAL STAFF TRAINING'     TO   WSCNAME.      EW013880
           IF      WSCFUNC                           =    '7100'        EW013890
             MOVE  'BOARD'                           TO   WSCNAME.      EW013900
           IF      WSCFUNC                           =    '7200'        EW013910
             MOVE  'GENERAL ADMINISTRATION'          TO   WSCNAME.      EW013920
           IF      WSCFUNC                           =    '7300'        EW013930
             MOVE  'SCHOOL ADMINISTRATION'           TO   WSCNAME.      EW013940
           IF      WSCFUNC                           =    '7400'        EW013950
             MOVE  'FACILITIES ACQ. AND CONSTR.'     TO   WSCNAME.      EW013960
           IF      WSCFUNC                           =    '7500'        EW013970
             MOVE  'FISCAL SERVICES'                 TO   WSCNAME.      EW013980
           IF      WSCFUNC                           =    '7600'        EW013990
             MOVE  'FOOD SERVICES'                   TO   WSCNAME.      EW014000
           IF      WSCFUNC                           =    '7700'        EW014010
             MOVE  'CENTRAL SERVICES'                TO   WSCNAME.      EW014020
           IF      WSCFUNC                           =    '7800'        EW014030
             MOVE  'PUPIL TRANSPORTATION'            TO   WSCNAME.      EW014040
           IF      WSCFUNC                           =    '7900'        EW014050
             MOVE  'OPERATION OF PLANT'              TO   WSCNAME.      EW014060
           IF      WSCFUNC                           =    '8100'        EW014070
             MOVE  'MAINTENANCE OF PLANT'            TO   WSCNAME.      EW014080
041306     IF      WSCFUNC                           =    '8200'                
041306       MOVE  'ADMINISTRATIVE TECHNOLOGY SER.'  TO   WSCNAME.              
041306     IF      WSCFUNC                           =    '6500'                
041306       MOVE  'INSTRUCTION RELATED TECHNOLOGY'  TO   WSCNAME.              
       700-EXIT.                                                        EW014090
           EXIT.                                                        EW014100
                                                                        EW014110
      ******************************************************************EW014120
       990-HOUSEKEEPING.                                                EW014130
           PERFORM 510-READ            THRU 510-EXIT                    EW014140
           ACCEPT  SYSDATE             FROM DATE                        EW014150
           MOVE    SYSYY               TO   HD1YY                       EW014160
           MOVE    SYSMM               TO   HD1MM                       EW014170
           MOVE    SYSDD               TO   HD1DD                       EW014180
           ACCEPT  SYSTIME             FROM TIME                        EW014190
           MOVE    SYSHR               TO   HD1HR                       EW014200
           MOVE    SYSMIN              TO   HD1MN                       EW014210
           IF      SRTKEY              =    HIGH-VALUES                 EW014220
             MOVE  ' EW026 NO DATA TO PROCESS'  TO  LNM                 EW014230
             PERFORM 520-PRINT         THRU 520-EXIT                    EW014240
             GO                        TO   999-EOJ.                    EW014250
           PERFORM 650-5CHG            THRU 650-EXIT.                   EW014260
       990-EXIT.                                                        EW014270
           EXIT.                                                        EW014280
                                                                        EW014290
      ******************************************************************EW014300
       999-EOJ.                                                         EW014310
           CLOSE                       CRD-CARD      CRF-DISK           EW014320
                                       CDF-DISK      PR1-PRNT.          EW014330
       999-EXIT.                                                        EW014340
           EXIT.                                                        EW014350
                                                                                
