       IDENTIFICATION   DIVISION.

       PROGRAM-ID.      EW001.
       AUTHOR.          DOE.
      *****************************************************************
      *                      CREATE SATSY WORK FILE                   *
      *****************************************************************
      * DATE CREATED:   04/28/95                                      *
      *****************************************************************
      * CALL #  - MMDDYY - PURPOSE                                    *
      * 9507110 - 072895 - EXCLUDE PROGRAM '999' FROM REPORT.         *
      * 9507125 - 080395 - ONLY PURGE RECORDS W/ SRVYS TO BE PROCESSED*
      * 9508028 - 090895 - SKIP STUDENT COURSE RECORDS WITH FTE = ZERO*
      * 9509030 - 091495 - SKIP SWF RECORDS WITH FTE = ZEROS          *
      * 9512050 - 121595 - POINT SURVEY-1 TO PREVIOUS FISCAL YEAR     *
      * FIX9706 - 041397 - SKIP RECORDS WITH FROM/TO PERIOD = '00'    *
      * FIX9709 - 041497 - MAP ESE PGMS 251-255 TO PGM 250            *
      * FIX9716 - 042697 - CORRECT FOR ESE TEACHERS WITH NO SC RCRDS  *
      * JON A.  - 021198 - MOD TO COMBINE 120 & 121 INTO PGM 120      *
      * JON A.  - 042899 - MOD FOR Y2K CHANGE IN COPYBOOK SIRCD01     *
      * FIX9901 032499 WDIS                                           * EW000320
      * FIX9903 040599 CHG FEFP PGMS                                  * EW000330
      * FIX9907 040799 DON'T PROCESS CHARTER SCHOOLS                  * EW000340
      * ROB C.  - 032300 - CORRECT CALCULATION OF CDRECKEY FOR Y2K.   * EW000340
      * ROB C.  - 112700 - CEASE CONVERTING 254 AND 255 TO PGM 250.   * EW000340
      * 2001001 033001 DON'T ROLL PROGRAMS 251 -> 255 INTO PGM 250    * EW000350
      * 2001002 040301 DO NOT ALLOW CORRECT FOR ESE TCHRS WITH NO     * EW000360
      *                SC RECORDS                                     * EW000370
      * 2002001 052302 SKIP SCHOLARSHIP SCHOOLS (SCHOOL OF            * EW000400
      *                ENROLLMENT = '3518')                           * EW000410
      * 2010003 040610 PROCESS 0 FTE RECORDS                          * EW000400
      *****************************************************************


       ENVIRONMENT DIVISION.

       INPUT-OUTPUT SECTION.
       FILE-CONTROL.

MVS        SELECT    CRD-CARD          ASSIGN    UT-S-CARDIN.               0021
                                                                            0020
MVS        SELECT    PR1-PRNT          ASSIGN    UT-S-PRTOT1.
                                                                            0026
MVS        SELECT    SRT-SORT          ASSIGN    DA-SORTWK.

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

MVS        SELECT    DTC-DISK          ASSIGN       DA-EWDTC
                                       ORGANIZATION SEQUENTIAL
                                       ACCESS       SEQUENTIAL
                                       FILE STATUS  RETDTC.

MVS        SELECT    DTC-TAPE          ASSIGN       UT-S-TAPE01.

MVS        SELECT    DSC-DISK          ASSIGN       DA-EWDSCI
                                       ORGANIZATION SEQUENTIAL
                                       ACCESS       SEQUENTIAL
                                       FILE STATUS  RETDSC.

MVS        SELECT    DSC-TAPE          ASSIGN       UT-S-TAPE01.

MVS        SELECT    GI-MASTER         ASSIGN       DA-HRFGI
                                       ORGANIZATION INDEXED
                                       ACCESS       RANDOM
                                       RECORD KEY   GI-KEY
                                       FILE STATUS  RETGI.

MVS        SELECT    SCO-MASTER        ASSIGN       DA-TSCOI
                                       ORGANIZATION INDEXED
                                       ACCESS       RANDOM
                                       RECORD KEY   CDRECKEY
                                       FILE STATUS  RETSCO.

MVS        SELECT    SWF-DISK          ASSIGN       DA-EWSWF
                                       ORGANIZATION INDEXED
                                       ACCESS       DYNAMIC
                                       RECORD KEY   SWFDK
                                       FILE STATUS  RETSWF.                 0024


       DATA DIVISION.
       FILE SECTION.

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

       01            CRD.
001        05        CRDREQ            PIC  X(03).
004        05        FILLER            PIC  X(01).
005        05        CRDID             PIC  X(02).
007        05        FILLER            PIC  X(01).
008        05        CRDPRT            PIC  X(01).
009        05        FILLER            PIC  X(03).
012        05        CRDDIST           PIC  X(02).
014        05        FILLER            PIC  X(02).
016        05        CRDFY             PIC  X(02).
018        05        FILLER            PIC  X(01).
019        05        CRDSRVY1          PIC  X(01).
020        05        FILLER            PIC  X(01).
021        05        CRDSRVY2          PIC  X(01).
022        05        FILLER            PIC  X(01).
023        05        CRDSRVY3          PIC  X(01).
024        05        FILLER            PIC  X(01).
025        05        CRDSRVY4          PIC  X(01).
026        05        FILLER            PIC  X(01).
027        05        CRDERR            PIC  X(01).
028        05        FILLER            PIC  X(01).
029        05        CRDSRCE           PIC  X(01).
030        05        FILLER            PIC  X(01).
031        05        CRDRPT            PIC  X(01).
032        05        CRDPGM            PIC  X(05).
037        05        FILLER            PIC  X(44).

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

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

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

       01            LN1.
           05        FILLER            PIC  X(01).
002        05        LN1SRVY           PIC  X(01).
003        05        FILLER            PIC  X(01).
004        05        LN1SCHL           PIC  X(04).
008        05        FILLER            PIC  X(01).
009        05        LN1CRSE           PIC  X(07).
016        05        FILLER            PIC  X(01).
017        05        LN1DESC           PIC  X(30).
047        05        FILLER            PIC  X(01).
048        05        LN1SECT           PIC  X(05).
053        05        FILLER            PIC  X(01).
054        05        LN1FPRD           PIC  99.
056        05        LN1DASH           PIC  X(01).
057        05        LN1TPRD           PIC  99.
059        05        FILLER            PIC  X(01).
060        05        LN1TCHR           PIC  X(10).
070        05        FILLER            PIC  X(01).
071        05        LN1NAME           PIC  X(30).
101        05        FILLER            PIC  X(01).
102        05        LN1PGM            PIC  X(03).
105        05        FILLER            PIC  X(01).
106        05        LN1CNT            PIC  ZZ,ZZ9.
112        05        FILLER            PIC  X(01).
113        05        LN1MNS            PIC  Z,ZZZ,ZZ9.
122        05        FILLER            PIC  X(01).
123        05        LN1FTE            PIC  ZZ9.9999.
131        05        FILLER            PIC  X(01).
132        05        LN1MSG            PIC  X(02).

       01            LN2.
           05        FILLER            PIC  X(01).
002        05        FILLER            PIC  X(77).
079        05        LN2MSG1           PIC  X(08).
087        05        LN2REQ            PIC  X(03).
090        05        LN2MSG2           PIC  X(07).
097        05        LN2CNT            PIC  ZZZ,ZZ9.
104        05        LN2MSG3           PIC  X(20).
124        05        FILLER            PIC  X(10).

           COPY                        EWCRFD.
           COPY                        EWDTCD.
           COPY                        EWDTCT.
           COPY                        EWDSCD.
           COPY                        EWDSCT.
       FD  GI-MASTER.
           COPY                        HRFGI.

       FD  SCO-MASTER.
           COPY                        SIRCD01.

           COPY                        EWSWFD.

       SD  SRT-SORT.

       01            SRT.
           05        SRTKEY.
             10      SRTKDIST          PIC  X(02).
             10      SRTKREQ.
               15    SRTKREQ1          PIC  X(01).
               15    SRTKREQ2          PIC  X(01).
               15    SRTKREQ3          PIC  X(01).
             10      SRTKFY.
               15    SRTKFY1           PIC  X(01).
               15    SRTKFY2           PIC  X(01).
             10      SRTKSRVY          PIC  X(01).
             10      SRTKSCHL          PIC  X(04).
             10      SRTKCLASS.
               15    SRTKCRSE          PIC  X(07).
               15    SRTKSECT          PIC  X(05).
             10      SRTKSSN           PIC  X(10).
             10      SRTKPGM           PIC  X(03).
           05        SRTDATA.
             10      SRTFPRD           PIC  9(02).
             10      SRTTPRD           PIC  9(02).
             10      SRTMNS            PIC  S9(07)       COMP-3.
             10      SRTFTE            PIC  S9(03)V9(04) COMP-3.
             10      SRTPRT            PIC  X(01).
             10      SRTRPT            PIC  X(01).
             10      SRTERR            PIC  X(01).

       WORKING-STORAGE SECTION.

       01            WSC.
           05        WSCTC             PIC  X(01) VALUE SPACES.
           05        WSCTCT            PIC  X(01) VALUE SPACES.
           05        WSCSC             PIC  X(01) VALUE SPACES.
           05        WSCSCT            PIC  X(01) VALUE SPACES.
           05        WSCFILE           PIC  X(01) VALUE SPACES.
121595     05        WSCFY             PIC  9(02).
           05        WSCNAME.
             10      WSCNAMEB   OCCURS 20 TIMES INDEXED BY NAM1
                                       PIC  X(01).
           05        WSCLAST.
             10      WSCLASTB   OCCURS 17 TIMES INDEXED BY LST1
                                       PIC  X(01).
           05        WSCFIRST.
             10      WSCFIRSTB  OCCURS 12 TIMES INDEXED BY FST1
                                       PIC  X(01).
           05        WSCCLASS.
             10      WSCCRSE           PIC  X(08).
             10      WSCSECT           PIC  X(04).

       01            PGMTBLUPD         PIC  X(01) VALUE SPACES.
       01            TCHNAME.
           05        TCHLAST           PIC  X(17) VALUE SPACES.
           05        TCHFIRST          PIC  X(12) VALUE SPACES.
           05        TCHMI             PIC  X(01) VALUE SPACES.
       01            TCHCOMP           PIC  X(30) VALUE SPACES.
       01            CRSENAME          PIC  X(30).

       01            RET.
           05        RETCRF            PIC  X(02) VALUE '00'.
           05        RETDTC            PIC  X(02) VALUE '00'.
           05        RETDSC            PIC  X(02) VALUE '00'.
           05        RETDTCT           PIC  X(02) VALUE '00'.
           05        RETDSCT           PIC  X(02) VALUE '00'.
           05        RETGI             PIC  X(02) VALUE '00'.
           05        RETSMS            PIC  X(02) VALUE '00'.
           05        RETSCO            PIC  X(02) VALUE '00'.
           05        RETSWF            PIC  X(02) VALUE '00'.
           05        RETSWFOLD         PIC  X(02) VALUE '00'.

       01            SYS.
           05        SYSTIME.
             10      SYSHR             PIC  X(02).
             10      SYSMIN            PIC  X(02).
             10      SYSSEC            PIC  X(02).
           05        SYSDATE.
             10      SYSYY             PIC  9(02).
             10      SYSMM             PIC  X(02).
             10      SYSDD             PIC  X(02).

       01            CTLAREA.
           05        CTLCHAR           PIC  X(01) VALUE ' '.
           05        ERR.
             10      ERRREQ            PIC  X(03).
             10      FILLER            PIC  X(01).
             10      ERRID             PIC  X(02).
             10      FILLER            PIC  X(01).
             10      ERRPRT            PIC  X(01).
             10      FILLER            PIC  X(03).
             10      ERRDIST           PIC  X(02).
             10      FILLER            PIC  X(02).
             10      ERRFY             PIC  X(02).
             10      FILLER            PIC  X(01).
             10      ERRSRVY1          PIC  X(01).
             10      FILLER            PIC  X(01).
             10      ERRSRVY2          PIC  X(01).
             10      FILLER            PIC  X(01).
             10      ERRSRVY3          PIC  X(01).
             10      FILLER            PIC  X(01).
             10      ERRSRVY4          PIC  X(01).
             10      FILLER            PIC  X(01).
             10      ERRERR            PIC  X(01).
             10      FILLER            PIC  X(01).
             10      ERRSRCE           PIC  X(01).
             10      FILLER            PIC  X(01).
             10      ERRRPT            PIC  X(01).

       01            RQR.
           05        RQRREQ            PIC  X(03).
           05        RQRPRT            PIC  X(01).
           05        RQRDIST           PIC  X(02).
           05        RQRFY             PIC  X(02).
           05        RQRSRVY1          PIC  X(01).
           05        RQRSRVY2          PIC  X(01).
           05        RQRSRVY3          PIC  X(01).
           05        RQRSRVY4          PIC  X(01).
           05        RQRERR            PIC  X(01).
           05        RQRSRCE           PIC  X(01).
           05        RQRRPT            PIC  X(01).

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

       01            PGMTBL.
           05        PGMTBLENTRY OCCURS 1000 TIMES INDEXED BY PGM1.
             10      PGMPGM            PIC  X(03).
             10      PGMCNT            PIC  9(03).
             10      PGMMNS            PIC  9(07).
             10      PGMFTE            PIC  9(03)V9(04).
             10      PGMFPRD           PIC  9(02).
             10      PGMTPRD           PIC  9(02).

       01            CTR.
           05        CTRLN             PIC S9(03)       COMP-3 VALUE +0.
           05        CTRPG             PIC S9(03)       COMP-3 VALUE +0.
           05        CTRWRITE          PIC S9(05)       COMP-3 VALUE +0.
           05        CTRIDX            PIC S9(05)       COMP-3 VALUE +0.
           05        WRKPGMCNT         PIC S9(03)       COMP-3 VALUE +0.
           05        WRKPGMMNS         PIC S9(07)       COMP-3 VALUE +0.
           05        WRKPGMFTE         PIC S9(03)V9(04) COMP-3 VALUE +0.
           05        WRKPGMFPRD        PIC S9(02)       COMP-3 VALUE +0.
           05        WRKPGMTPRD        PIC S9(02)       COMP-3 VALUE +0.

       01            OLD.
           05        OLDKEY.
             10      OLDKDIST          PIC  X(02).
             10      OLDKREQ           PIC  X(03).
             10      OLDKFY            PIC  X(02).
             10      OLDKSRVY          PIC  X(01).
             10      OLDKSCHL          PIC  X(04).
             10      OLDKCRSE          PIC  X(07).
             10      OLDKSECT          PIC  X(05).
             10      OLDKSSN           PIC  X(10).
             10      OLDKPGM           PIC  X(03).
           05        OLDPRT            PIC  X(01).
           05        OLDRPT            PIC  X(01).
           05        OLDERR            PIC  X(01).
           05        OLDDESC           PIC  X(30).
           05        OLDFPRD           PIC  9(02).
           05        OLDTPRD           PIC  9(02).
040799     05        OLDSCHL           PIC  X(04).                      EW003920
040799     05        OLDCHRTR          PIC  X(01).                      EW003930


           COPY                        EWSCL.
           COPY                        EWDTC.
           COPY                        EWDSC.
           COPY                        EWSWF.

       01            OLDLN             PIC  X(133).

       01      HD1.
           05  FILLER  PIC X(01) VALUE ' '.
002        05  FILLER  PIC X(06) VALUE 'EW001 '.
           05  HD1ABBR.
008         10 HD1B    OCCURS 22 TIMES INDEXED BY HD11 PIC X(01).
030        05  FILLER  PIC X(11) VALUE SPACES.
041        05  HD1MODE PIC X(08) VALUE SPACES.
049        05  FILLER  PIC X(07) VALUE SPACES.
056        05  FILLER  PIC X(22) VALUE 'CREATE SATSY WORK FILE'.
078        05  FILLER  PIC X(21) VALUE SPACES.
099        05  HD1USER PIC X(09) VALUE SPACES.
108        05  HD1MM   PIC X(02) VALUE SPACES.
110        05  FILLER  PIC X(01) VALUE '/'.
111        05  HD1DD   PIC X(02) VALUE SPACES.
113        05  FILLER  PIC X(01) VALUE '/'.
114        05  HD1YY   PIC X(02) VALUE SPACES.
116        05  FILLER  PIC X(02) VALUE SPACES.
118        05  HD1HR   PIC X(02) VALUE SPACES.
120        05  FILLER  PIC X(01) VALUE ':'.
121        05  HD1MN   PIC X(02) VALUE SPACES.
123        05  FILLER  PIC X(07) VALUE '  PAGE-'.
130        05  HD1PG   PIC ZZZ9.

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

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

       01      HD4.
           05  FILLER  PIC X(01) VALUE ' '.
002        05  FILLER  PIC X(53) VALUE SPACES.
055        05  FILLER  PIC X(03) VALUE 'PRD'.
058        05  FILLER  PIC X(49) VALUE SPACES.
107        05  FILLER  PIC X(04) VALUE 'STDT'.
111        05  FILLER  PIC X(23) VALUE SPACES.

       01      HD5.
           05  FILLER  PIC X(01) VALUE ' '.
002        05  FILLER  PIC X(17) VALUE 'S SCHL COURSE    '.
019        05  FILLER  PIC X(29) VALUE SPACES.
048        05  FILLER  PIC X(22) VALUE 'SECT  FR-TO TEACHER ID'.
070        05  FILLER  PIC X(32) VALUE SPACES.
102        05  FILLER  PIC X(20) VALUE 'PGM  COUNT   MINUTES'.
122        05  FILLER  PIC X(12) VALUE ' STDT FTE ER'.


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

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

           IF      WSCTC               NOT  =  'Y'
             MOVE  '99'                TO   RETDTC.

           IF      WSCTCT              NOT  =  'Y'
             MOVE  '99'                TO   RETDTCT.

           IF      WSCSC               NOT  =  'Y'
             MOVE  '99'                TO   RETDSC.

           IF      WSCSCT              NOT  =  'Y'
             MOVE  '99'                TO   RETDSCT.
       005-LOOP.
           IF      RETDTC              NOT  =  '00'                AND
                   RETDSC              NOT  =  '00'                AND
                   RETDTCT             NOT  =  '00'                AND
                   RETDSCT             NOT  =  '00'
             GO                        TO   499-EOJ.
           PERFORM 015-SELECT          THRU 015-EXIT
           PERFORM 010-READ            THRU 010-EXIT
           GO                          TO   005-LOOP.

      ******************************************************************
       010-READ.

           IF      RQRSRCE             =    'T'
             GO                        TO   010-CONT.


           IF      RETDTC              =    '00'
             READ  DTC-DISK            NEXT
             IF    RETDTC              NOT  =  '00'
               MOVE '99'               TO   RETDTC
             ELSE
               MOVE  DTCD              TO   DTC
               MOVE  'T'               TO   WSCFILE
               GO                      TO   010-EXIT.


           READ    DSC-DISK            NEXT
           IF      RETDSC              NOT  =  '00'
             MOVE  '99'                TO   RETDSC
             GO                        TO   010-EXIT
           ELSE
             MOVE  DSCD                TO   DSC
             MOVE  'S'                 TO   WSCFILE
             GO                        TO   010-EXIT.

       010-CONT.
           IF      RETDTCT             =    '00'
             READ  DTC-TAPE            AT   END
               CLOSE                   DTC-TAPE
               MOVE '99'               TO   RETDTCT
               OPEN   INPUT            DSC-TAPE.

           IF    RETDTCT               =  '00'
             MOVE  DTCT                TO   DTC
             MOVE  'T'                 TO   WSCFILE
             GO                        TO   010-EXIT.

           READ    DSC-TAPE            AT   END
             MOVE  '99'                TO   RETDSCT
             GO                        TO   010-EXIT.

           IF      RETDSCT             =  '00'
             MOVE  DSCT                TO   DSC
             MOVE  'S'                 TO   WSCFILE.

       010-EXIT.
           EXIT.

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


           IF      WSCFILE             =    'S'
             GO                        TO   015-CONT.



           IF      RQRDIST             NOT  =  DTCIDIST     OR
                   RQRFY               NOT  =  DTCTFY
             GO                        TO   015-EXIT.


           IF      DTCISCHL            NOT  NUMERIC         OR
                   DTCISCHL            <    0001            OR
                   DTCISCHL            >    9899
             GO                        TO   015-EXIT.

040799     IF      DTCISCHL            NOT  =  OLDSCHL                  EW005600
040799       MOVE  DTCISCHL            TO   OLDSCHL                     EW005610
040799       MOVE  SPACES              TO   OLDCHRTR                    EW005620
040799       PERFORM  020-READ-SCHL    THRU 020-EXIT.                   EW005630
                                                                        EW005640
052302*    IF      OLDCHRTR            =    'Y'                         EW005740
052302     IF     (OLDCHRTR            =    'Y')                   OR   EW005750
052302            (DSCESCHL            =    '3518')                     EW005760
040799       GO                        TO   015-EXIT.                   EW005660
                                                                        EW005660
032499     IF      DTCCRSE             NOT  NUMERIC                     EW005680
032499       GO                        TO   015-EXIT.                   EW005690

           IF     (RQRSRVY1       NOT  =    ' '        AND
                   DTCSURV             =    '1')             OR
                  (RQRSRVY2       NOT  =    ' '        AND
                   DTCSURV             =    '2')             OR
                  (RQRSRVY3       NOT  =    ' '        AND
                   DTCSURV             =    '3')             OR
                  (RQRSRVY4       NOT  =    ' '        AND
                   DTCSURV             =    '4')             OR
                  (DTCSURV        NOT  =    '1'        AND
                   DTCSURV        NOT  =    '2'        AND
                   DTCSURV        NOT  =    '3'        AND
                   DTCSURV        NOT  =    '4')
             GO                        TO   015-EXIT.

041397     IF      DTCFPRD             =    '00'       OR
041397             DTCTPRD             =    '00'
041397       GO                        TO   015-EXIT.

           MOVE    DTCIDIST            TO   SRTKDIST
           MOVE    RQRREQ              TO   SRTKREQ
           MOVE    RQRFY               TO   SRTKFY
           MOVE    DTCSURV             TO   SRTKSRVY
           MOVE    DTCISCHL            TO   SRTKSCHL
           MOVE    DTCCRSE             TO   SRTKCRSE
           MOVE    DTCSECT             TO   SRTKSECT
           MOVE    DTCSSN              TO   SRTKSSN
           MOVE    HIGH-VALUES         TO   SRTKPGM
           MOVE    ZEROS               TO   SRTMNS  SRTFTE
           MOVE    DTCFPRD             TO   SRTFPRD
           MOVE    DTCTPRD             TO   SRTTPRD
           MOVE    RQRPRT              TO   SRTPRT
           MOVE    RQRRPT              TO   SRTRPT
           MOVE    RQRERR              TO   SRTERR

           RELEASE SRT

042697*    IF      DTCCRSE             =    '2222222'
042697*      MOVE  DTCIDIST            TO   SRTKDIST
042697*      MOVE  RQRREQ              TO   SRTKREQ
042697*      MOVE  DTCTFY              TO   SRTKFY
042697*      MOVE  DTCSURV             TO   SRTKSRVY
042697*      MOVE  DTCISCHL            TO   SRTKSCHL
042697*      MOVE  DTCCRSE             TO   SRTKCRSE
042697*      MOVE  DTCSECT             TO   SRTKSECT
042697*      MOVE  SPACES              TO   SRTKSSN
042697*      MOVE  '205'               TO   SRTKPGM
042697*      MOVE  1                   TO   SRTMNS
042697*      MOVE  1                   TO   SRTFTE
042697*      MOVE  DTCFPRD             TO   SRTFPRD
042697*      MOVE  DTCTPRD             TO   SRTTPRD
042697*      MOVE  RQRPRT              TO   SRTPRT
042697*      MOVE  RQRRPT              TO   SRTRPT
042697*      MOVE  RQRERR              TO   SRTERR
      *      RELEASE SRT.

           GO                          TO   015-EXIT.

       015-CONT.

           IF      DSCISCHL            NOT  NUMERIC         OR
                   DSCISCHL            <    0001            OR
                   DSCISCHL            >    9899
             GO                        TO   015-EXIT.

040799     IF      DSCISCHL            NOT  =  OLDSCHL                  EW006430
040799       MOVE  DSCISCHL            TO   OLDSCHL                     EW006440
040799       MOVE  SPACES              TO   OLDCHRTR                    EW006450
040799       PERFORM  020-READ-SCHL    THRU 020-EXIT.                   EW006460
                                                                        EW006470
040799     IF      OLDCHRTR            =    'Y'                         EW006480
040799       GO                        TO   015-EXIT.                   EW006490
                                                                        EW006500
072895     IF      DSCPGM              =    '999'
072895       GO                        TO   015-EXIT.

           IF      RQRDIST             NOT  =  DSCIDIST     OR
                   RQRFY               NOT  =  DSCTFY
             GO                        TO   015-EXIT.

032499     IF      DSCCRSE             NOT  NUMERIC                     EW006710
032499       GO                        TO   015-EXIT.                   EW006720

           IF     (RQRSRVY1       NOT  =    ' '        AND
                   DSCSURV             =    '1')             OR
                  (RQRSRVY2       NOT  =    ' '        AND
                   DSCSURV             =    '2')             OR
                  (RQRSRVY3       NOT  =    ' '        AND
                   DSCSURV             =    '3')             OR
                  (RQRSRVY4       NOT  =    ' '        AND
                   DSCSURV             =    '4')             OR
                  (DSCSURV        NOT  =    '1'        AND
                   DSCSURV        NOT  =    '2'        AND
                   DSCSURV        NOT  =    '3'        AND
                   DSCSURV        NOT  =    '4')
             GO                        TO   015-EXIT.

041397     IF      DSCFPRD             =    '00'       OR
041397             DSCTPRD             =    '00'
041397       GO                        TO   015-EXIT.

           MOVE    DSCIDIST            TO   SRTKDIST
           MOVE    RQRREQ              TO   SRTKREQ
           MOVE    RQRFY               TO   SRTKFY
           MOVE    DSCSURV             TO   SRTKSRVY
           MOVE    DSCISCHL            TO   SRTKSCHL
           MOVE    DSCCRSE             TO   SRTKCRSE
           MOVE    DSCSECT             TO   SRTKSECT
           MOVE    SPACES              TO   SRTKSSN
           IF      DSCPGM              =    '116'
             MOVE  '101'               TO   SRTKPGM
           ELSE
             IF    DSCPGM              =    '117'
               MOVE  '102'             TO   SRTKPGM
             ELSE
               IF  DSCPGM              =    '118'
                 MOVE  '103'           TO   SRTKPGM
               ELSE
040599         IF  DSCPGM              =    '121'                       EW007090
040599           MOVE  '120'           TO   SRTKPGM                     EW007100
040599         ELSE                                                     EW007110
041397*        IF  DSCPGM              =    '251'
041397*            MOVE '250'          TO   SRTKPGM
041397*        ELSE
041397*        IF  DSCPGM              =    '252'
041397*            MOVE '250'          TO   SRTKPGM
041397*        ELSE
041397*        IF  DSCPGM              =    '253'
041397*            MOVE '250'          TO   SRTKPGM
041397*        ELSE
041397*        IF  DSCPGM              =    '254'
041397*            MOVE '250'          TO   SRTKPGM
041397*        ELSE
041397*        IF  DSCPGM              =    '255'
041397*            MOVE '250'          TO   SRTKPGM
JA0298*        ELSE
JA0298         IF  DSCPGM              =    '121'
JA0298             MOVE '120'          TO   SRTKPGM
041397         ELSE
                 MOVE DSCPGM           TO   SRTKPGM.

           MOVE    DSCMINWK            TO   SRTMNS
           MOVE    DSCFTE              TO   SRTFTE
           MOVE    DSCFPRD             TO   SRTFPRD
           MOVE    DSCTPRD             TO   SRTTPRD
           MOVE    RQRPRT              TO   SRTPRT
           MOVE    RQRRPT              TO   SRTRPT
           MOVE    RQRERR              TO   SRTERR

           RELEASE SRT.
       015-EXIT.
           EXIT.

040799******************************************************************EW007410
040799 020-READ-SCHL.                                                   EW007420
040799     MOVE     '    SCL    '      TO   SCLKEY                      EW007430
040799     MOVE     RQRDIST            TO   SCLDIST                     EW007440
040799     MOVE     RQRFY              TO   SCLFY                       EW007450
040799     MOVE     OLDSCHL            TO   SCLSCL                      EW007460
040799     MOVE     SCLKEY             TO   CRFDK                       EW007470
040799     READ     CRF-DISK                                            EW007480
040799     IF       RETCRF             NOT  =   '00'                    EW007490
040799       MOVE   SPACES             TO   OLDCHRTR                    EW007500
040799     ELSE                                                         EW007510
040799       MOVE   CRFD               TO   SCL                         EW007520
040799       MOVE   SCLCHRTR           TO   OLDCHRTR.                   EW007530
040799 020-EXIT.                                                        EW007540
040799     EXIT.                                                        EW007550
040799                                                                  EW007560
      ******************************************************************
       490-HOUSEKEEPING.
           OPEN    INPUT                    CRD-CARD      CRF-DISK
                                            GI-MASTER     SCO-MASTER
           OPEN    OUTPUT                   PR1-PRNT
           MOVE    SPACES              TO   LN1
040799     MOVE    SPACES              TO   OLDCHRTR                    EW007640
           MOVE    '1'                 TO   CTLCHAR
           MOVE    HIGH-VALUES         TO   RQR           RQH.
           SET     RQH1          TO   +1.

       490-LOAD.
           READ    CRD-CARD            AT   END
             GO                        TO   490-TEST.
           MOVE    SPACES              TO   ERR
           IF      CRDID               =    'SL'
             GO                        TO   490-REQ
           ELSE
             IF     (CRDID             =    'H1')                    OR
                    (CRDID             =    'H2')
               GO                      TO   490-HEAD
             ELSE
               GO                      TO   490-LOAD.

       490-REQ.
           IF     (CRDPRT              NOT  =   'U')                 AND
                  (CRDPRT              NOT  =   'T')                 AND
                  (CRDPRT              NOT  =   'B')                 AND
                  (CRDPRT              NOT  =   'N')
             MOVE  ALL '-'             TO   ERRPRT.
           IF     (CRDDIST             =    SPACES)
             MOVE  ALL '-'             TO   ERRDIST.
           IF     (CRDFY               NOT  NUMERIC)
             MOVE  ALL '-'             TO   ERRFY.
           IF     (CRDSRVY1            NOT  =   ' ')                 AND
                  (CRDSRVY1            NOT  =   'N')
             MOVE  ALL '-'             TO   ERRSRVY1.
           IF     (CRDSRVY2            NOT  =   ' ')                 AND
                  (CRDSRVY2            NOT  =   'N')
             MOVE  ALL '-'             TO   ERRSRVY2.
           IF     (CRDSRVY3            NOT  =   ' ')                 AND
                  (CRDSRVY3            NOT  =   'N')
             MOVE  ALL '-'             TO   ERRSRVY3.
           IF     (CRDSRVY4            NOT  =   ' ')                 AND
                  (CRDSRVY4            NOT  =   'N')
             MOVE  ALL '-'             TO   ERRSRVY4.
           IF     (CRDERR              NOT  =   ' ')                 AND
                  (CRDERR              NOT  =   'Y')
             MOVE  ALL '-'             TO   ERRERR.
           IF     (CRDSRCE             NOT  =   'D')                 AND
                  (CRDSRCE             NOT  =   'T')
             MOVE  ALL '-'             TO   ERRSRCE.
           IF      CRDRPT              NOT  =  'A'            AND
                   CRDRPT              NOT  =  'B'
             MOVE  ALL '-'             TO   ERRRPT.
           IF      ERR                 NOT  =   SPACES
             MOVE    'ERROR. BYPASSED' TO   LNMMSG
             MOVE    CRD               TO   LNMVALUE2
             PERFORM 520-PRINT         THRU 520-EXIT
             MOVE    ERR               TO   LNMVALUE2
             PERFORM 520-PRINT         THRU 520-EXIT
             GO                        TO   490-LOAD.
           MOVE    CRDREQ              TO   RQRREQ
           MOVE    CRDPRT              TO   RQRPRT
           MOVE    CRDDIST             TO   RQRDIST
           MOVE    CRDFY               TO   RQRFY
           MOVE    CRDSRVY1            TO   RQRSRVY1
           MOVE    CRDSRVY2            TO   RQRSRVY2
           MOVE    CRDSRVY3            TO   RQRSRVY3
           MOVE    CRDSRVY4            TO   RQRSRVY4
           MOVE    CRDERR              TO   RQRERR
           MOVE    CRDSRCE             TO   RQRSRCE
           MOVE    CRDRPT              TO   RQRRPT

           IF      RQRSRCE             =    'D'
             IF   (WSCTC               =    SPACES         AND
                   WSCSC               =    SPACES)
               OPEN  INPUT             DSC-DISK  DTC-DISK
               MOVE  '00'              TO   RETDTCT  RETDSCT
               MOVE  'Y'               TO   WSCTC  WSCSC.

           IF      RQRSRCE             =    'T'
             IF   (WSCTCT              =    SPACES         AND
                   WSCSCT              =    SPACES)
               OPEN  INPUT             DTC-TAPE
               MOVE  '00'              TO   RETDTC  RETDSC  RETDSCT
               MOVE  'Y'               TO   WSCTCT WSCSCT.

           IF      RQRRPT              =    'B'
             OPEN  I-O                 SWF-DISK
           ELSE
             OPEN  INPUT               SWF-DISK.
           MOVE    RETSWF              TO  RETSWFOLD.

           IF      CRDRPT              =    'B'
             PERFORM 493-SWF-PURGE     THRU 493-EXIT.

           GO                          TO   490-LOAD.
       490-HEAD.
           MOVE    CRHREQ              TO   RQHREQ       (RQH1)
           MOVE    CRHID               TO   RQHID        (RQH1)
           MOVE    CRHUSER             TO   RQHUSER      (RQH1)
           MOVE    SPACES              TO   RQHHEAD      (RQH1)
           MOVE    +50                 TO   CTRIDX
           SET     CRH1                TO   +50.
       490-HEAD1.
           IF      CRHB         (CRH1) =    SPACES
             IF      CRH1              >    +2
               ADD   -1                TO   CTRIDX
               SET   CRH1              DOWN BY  +1
               GO                      TO   490-HEAD1.
           SUBTRACT +1                 FROM CTRIDX
           COMPUTE CTRIDX      ROUNDED =    (50  - CTRIDX) / 2
           SET     RQH2                TO   CTRIDX
           SET     CRH1                TO   +1.
       490-HEAD2.
           MOVE    CRHB         (CRH1) TO   RQHB         (RQH1 RQH2)
           IF      RQH2                <    +50
             SET   RQH2  CRH1          UP   BY  +1
             GO                        TO   490-HEAD2.
           SET     RQH1             UP BY   +1
           GO                          TO   490-LOAD.

       490-TEST.
           MOVE    RETSWFOLD           TO   RETSWF
           IF      RQR                 =    HIGH-VALUES
             MOVE    ' EW001 NO REQUESTS *'   TO   LNMMSG
             PERFORM 520-PRINT         THRU 520-EXIT.
           IF      RETCRF              NOT  =   '00'
             MOVE    'CRF OPEN ERROR'  TO   LNMMSG
             MOVE    RETCRF            TO   LNMVALUE1
             PERFORM 520-PRINT         THRU 520-EXIT.
           IF      RETDSC              NOT  =   '00'
             MOVE    'DSC OPEN ERROR'  TO   LNMMSG
             MOVE    RETDSC            TO   LNMVALUE1
             PERFORM 520-PRINT         THRU 520-EXIT.
           IF      RETDTC              NOT  =   '00'
             MOVE    'DTC OPEN ERROR'  TO   LNMMSG
             MOVE    RETDTC            TO   LNMVALUE1
             PERFORM 520-PRINT         THRU 520-EXIT.
           IF      RETDSCT             NOT  =   '00'
             MOVE    'DSC TAPE ERROR'  TO   LNMMSG
             MOVE    RETDSCT           TO   LNMVALUE1
             PERFORM 520-PRINT         THRU 520-EXIT.
           IF      RETDTCT             NOT  =   '00'
             MOVE    'DTC TAPE ERROR'  TO   LNMMSG
             MOVE    RETDTCT           TO   LNMVALUE1
             PERFORM 520-PRINT         THRU 520-EXIT.
           IF      RETGI               NOT  =   '00'
             MOVE    ' GI OPEN ERROR'  TO   LNMMSG
             MOVE    RETGI             TO   LNMVALUE1
             PERFORM 520-PRINT         THRU 520-EXIT.
           IF      RETSMS              NOT  =   '00'
             MOVE    'SMS OPEN ERROR'  TO   LNMMSG
             MOVE    RETSMS            TO   LNMVALUE1
             PERFORM 520-PRINT         THRU 520-EXIT.
           IF      RETSCO              NOT  =   '00'
             MOVE    'SCO OPEN ERROR'  TO   LNMMSG
             MOVE    RETSCO            TO   LNMVALUE1
             PERFORM 520-PRINT         THRU 520-EXIT.
           IF      RETSWF              NOT  =   '00'
             MOVE    'SWF OPEN ERROR'  TO   LNMMSG
             MOVE    RETSWF            TO   LNMVALUE1
             PERFORM 520-PRINT         THRU 520-EXIT.
           IF     (RETCRF              NOT  =   '00')                OR
                  (RETGI               NOT  =   '00')                OR
                  (RETSMS              NOT  =   '00')                OR
                  (RETSCO              NOT  =   '00')                OR
                  (RETSWF              NOT  =   '00')                OR
                  (RETDSC              NOT  =   '00')                OR
                  (RETDTC              NOT  =   '00')                OR
                  (RETDSCT             NOT  =   '00')                OR
                  (RETDTCT             NOT  =   '00')
             GO                        TO   499-EOJ.

           PERFORM     010-READ        THRU 010-EXIT.
       490-EXIT.
           EXIT.

      ******************************************************************
       493-SWF-PURGE.
           MOVE    CRDDIST             TO   SWFKEY
           MOVE    CRDFY               TO   SWFFY
           MOVE    SWFKEY              TO   SWFDK
           START   SWF-DISK        KEY >    SWFDK
           IF      RETSWF              NOT  =  '00'
JA0298       DISPLAY 'BAD START ON SWF, KEY= ' SWFDK
JA0298       DISPLAY '               STATUS= ' RETSWF
             GO                        TO   493-EXIT.
       493-LOOP.
           READ    SWF-DISK            NEXT
           IF      RETSWF              =    '00'
             MOVE  SWFD                TO   SWF
             IF    SWFDIST             =    CRDDIST          AND
080395*            SWFFY               =    CRDFY
080395             SWFFY               =    CRDFY            AND
080395           ((CRDSRVY1            =    ' '        AND
080395             SWFSURVEY           =    '1')           OR
080395            (CRDSRVY2            =    ' '        AND
080395             SWFSURVEY           =    '2')           OR
080395            (CRDSRVY3            =    ' '        AND
080395             SWFSURVEY           =    '3')           OR
080395            (CRDSRVY4            =    ' '        AND
080395             SWFSURVEY           =    '4'))
032499             IF  SWFK12          =    'Y'                         EW009600
                       DELETE SWF-DISK                                  EW009610
032499                 GO              TO   493-LOOP                    EW009620
032499             ELSE                                                 EW009630
JA0298                 GO              TO   493-LOOP.
       493-EXIT.
           EXIT.

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

      ******************************************************************
       500-OUTPUT SECTION.
           PERFORM 990-HOUSEKEEPING    THRU 990-EXIT.
       505-LOOP.
             IF    (SRTKDIST           NOT  =   OLDKDIST)            OR
                   (SRTKREQ            NOT  =   OLDKREQ)             OR
                   (SRTKFY             NOT  =   OLDKFY)              OR
                   (SRTKSRVY           NOT  =   OLDKSRVY)            OR
                   (SRTKSCHL           NOT  =   OLDKSCHL)            OR
                   (SRTKCRSE           NOT  =   OLDKCRSE)            OR
                   (SRTKSECT           NOT  =   OLDKSECT)            OR
                   (SRTKSSN            NOT  =   OLDKSSN)             OR
                   (SRTKPGM            NOT  =   OLDKPGM)
               PERFORM 615-1TOT        THRU 615-EXIT
               IF  (SRTKDIST           NOT  =   OLDKDIST)            OR
                   (SRTKREQ            NOT  =   OLDKREQ)             OR
                   (SRTKFY             NOT  =   OLDKFY)              OR
                   (SRTKSRVY           NOT  =   OLDKSRVY)            OR
                   (SRTKSCHL           NOT  =   OLDKSCHL)            OR
                   (SRTKCRSE           NOT  =   OLDKCRSE)            OR
                   (SRTKSECT           NOT  =   OLDKSECT)            OR
                   (SRTKSSN            NOT  =   OLDKSSN)
                 PERFORM 625-2TOT      THRU 625-EXIT
                 IF   (SRTKDIST        NOT  =   OLDKDIST)            OR
                      (SRTKREQ         NOT  =   OLDKREQ)             OR
                      (SRTKFY          NOT  =   OLDKFY)              OR
                      (SRTKSRVY        NOT  =   OLDKSRVY)            OR
                      (SRTKSCHL        NOT  =   OLDKSCHL)            OR
                      (SRTKCRSE        NOT  =   OLDKCRSE)            OR
                      (SRTKSECT        NOT  =   OLDKSECT)
                   PERFORM 635-3TOT    THRU 635-EXIT
                   IF (SRTKDIST        NOT  =   OLDKDIST)            OR
                      (SRTKREQ         NOT  =   OLDKREQ)             OR
                      (SRTKFY          NOT  =   OLDKFY)              OR
                      (SRTKSRVY        NOT  =   OLDKSRVY)            OR
                      (SRTKSCHL        NOT  =   OLDKSCHL)            OR
                      (SRTKCRSE        NOT  =   OLDKCRSE)
                     PERFORM 645-4TOT    THRU 645-EXIT
                     IF (SRTKDIST      NOT  =   OLDKDIST)            OR
                        (SRTKREQ       NOT  =   OLDKREQ)             OR
                        (SRTKFY        NOT  =   OLDKFY)              OR
                        (SRTKSRVY      NOT  =   OLDKSRVY)            OR
                        (SRTKSCHL      NOT  =   OLDKSCHL)
                       PERFORM 655-5TOT    THRU 655-EXIT
                       IF (SRTKDIST    NOT  =   OLDKDIST)            OR
                          (SRTKREQ     NOT  =   OLDKREQ)             OR
                          (SRTKFY      NOT  =   OLDKFY)              OR
                          (SRTKSRVY    NOT  =   OLDKSRVY)
                         PERFORM 665-6TOT    THRU 665-EXIT
                         IF (SRTKDIST  NOT  =   OLDKDIST)            OR
                            (SRTKREQ   NOT  =   OLDKREQ)             OR
                            (SRTKFY    NOT  =   OLDKFY)
                           PERFORM 675-7TOT    THRU 675-EXIT
                           IF  (SRTKEY =    HIGH-VALUES)
                             GO        TO   999-EOJ
                           ELSE
                             PERFORM 670-7CHG    THRU 670-EXIT
                         ELSE
                           PERFORM 660-6CHG      THRU 660-EXIT
                       ELSE
                         PERFORM 650-5CHG        THRU 650-EXIT
                     ELSE
                       PERFORM 640-4CHG          THRU 640-EXIT
                   ELSE
                     PERFORM 630-3CHG            THRU 630-EXIT
                 ELSE
                   PERFORM 620-2CHG              THRU 620-EXIT
               ELSE
                 PERFORM 610-1CHG                THRU 610-EXIT.

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

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

      ******************************************************************
       515-PROCESS.
           ADD     +1                  TO   WRKPGMCNT
           ADD     SRTMNS              TO   WRKPGMMNS
           ADD     SRTFTE              TO   WRKPGMFTE
           MOVE    SRTFPRD             TO   WRKPGMFPRD
           MOVE    SRTTPRD             TO   WRKPGMTPRD.
       515-EXIT.
           EXIT.

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

       525-HEADS.
           MOVE    LN1                 TO   OLDLN
           MOVE    +0                  TO   CTRLN
           ADD     +1                  TO   CTRPG
           IF      OLDRPT              =    'A'
             MOVE  '* EDIT *'          TO   HD1MODE
           ELSE
             MOVE  '* POST *'          TO   HD1MODE.
           MOVE    CTRPG               TO   HD1PG
           MOVE    HD1                 TO   LN1
           MOVE    '1'                 TO   CTLCHAR
           PERFORM 520-PRINT           THRU 520-EXIT
           IF      HD2                 NOT  =   SPACES
             MOVE    HD2               TO   LN1
             PERFORM 520-PRINT         THRU 520-EXIT.
           IF      HD3                 NOT  =   SPACES
             MOVE    HD3               TO   LN1
             PERFORM 520-PRINT         THRU 520-EXIT.
           MOVE    '0'                 TO   CTLCHAR
           MOVE    HD4                 TO   LN1
           PERFORM 520-PRINT           THRU 520-EXIT
           MOVE    HD5                 TO   LN1
           PERFORM 520-PRINT           THRU 520-EXIT
           MOVE    OLDLN               TO   LN1
           MOVE    '0'                 TO   CTLCHAR.
       525-EXIT.
           EXIT.

      ******************************************************************
       610-1CHG.
           MOVE    ZEROS               TO   WRKPGMCNT
                                            WRKPGMMNS
                                            WRKPGMFTE
           MOVE    SRTKPGM             TO   OLDKPGM.
       610-EXIT.
           EXIT.

       615-1TOT.
           IF      OLDKPGM             NOT  =  HIGH-VALUES
             MOVE  OLDKPGM             TO   PGMPGM (PGM1)
             MOVE  WRKPGMCNT           TO   PGMCNT (PGM1)
             MOVE  WRKPGMMNS           TO   PGMMNS (PGM1)
             MOVE  WRKPGMFTE           TO   PGMFTE (PGM1)
             MOVE  WRKPGMFPRD          TO   PGMFPRD (PGM1)
             MOVE  WRKPGMTPRD          TO   PGMTPRD (PGM1)
             SET   PGM1                UP   BY  +1.
       615-EXIT.
           EXIT.

       620-2CHG.
           MOVE    SRTKSSN             TO   OLDKSSN   LN1TCHR
           PERFORM 710-TCHR-NAME       THRU 710-EXIT
           MOVE    TCHCOMP             TO   LN1NAME
           MOVE    SRTFPRD             TO   OLDFPRD
           MOVE    SRTTPRD             TO   OLDTPRD
           PERFORM 610-1CHG            THRU 610-EXIT.
       620-EXIT.
           EXIT.

       625-2TOT.
           IF      OLDKSSN             =    SPACES
             GO                        TO   625-EXIT.
           MOVE    'Y'                 TO   PGMTBLUPD
           MOVE    OLDKDIST            TO   SWFDIST    SWFDIST2
           MOVE    OLDKFY              TO   SWFFY      SWFFY2
           MOVE    OLDKSRVY            TO   SWFSURVEY  SWFSURVEY2
           MOVE    OLDKSCHL            TO   SWFSCHL    SWFSCHL2
           MOVE    OLDKCRSE            TO   SWFCRSE    SWFCRSE2
           MOVE    OLDKSECT            TO   SWFSECT    SWFSECT2
           MOVE    OLDKSSN             TO   SWFSSN     SWFSSN2
           MOVE    OLDFPRD             TO   SWFFPRD LN1FPRD
           MOVE    OLDTPRD             TO   SWFTPRD LN1TPRD
           MOVE    '-'                 TO   LN1DASH
           MOVE    TCHNAME             TO   SWFNAME
           SET     PGM1                TO   +1.
       625-LOOP.
           IF      PGMTBLENTRY  (PGM1) =    HIGH-VALUES          AND
                   PGM1                >    +1
             GO                        TO   625-EXIT.
           IF      PGMTBLENTRY  (PGM1) =    HIGH-VALUES
             MOVE  SPACES              TO   SWFPGM  LN1PGM  SWFPGM2
             MOVE  ZEROS               TO   SWFCNT  LN1CNT
                                            SWFMNSWK LN1MNS
                                            SWFFTE  LN1FTE
                                            SWFSQFT
             MOVE  '**'                TO   LN1MSG
           ELSE
             MOVE  PGMPGM  (PGM1)      TO   SWFPGM  LN1PGM  SWFPGM2
             MOVE  PGMCNT  (PGM1)      TO   SWFCNT  LN1CNT
             MOVE  PGMMNS  (PGM1)      TO   SWFMNSWK  LN1MNS
             MOVE  PGMFTE  (PGM1)      TO   SWFFTE  LN1FTE
             MOVE   ZEROS              TO   SWFSQFT.

           IF      CTRLN               >    +60
             MOVE  OLDKSRVY            TO   LN1SRVY
             MOVE  OLDKSCHL            TO   LN1SCHL
             MOVE  OLDKCRSE            TO   LN1CRSE
             MOVE  OLDKSECT            TO   LN1SECT
             MOVE  OLDDESC             TO   LN1DESC
             MOVE  OLDKSSN             TO   LN1TCHR
             MOVE  OLDFPRD             TO   LN1FPRD
             MOVE  OLDTPRD             TO   LN1TPRD
             MOVE  '-'                 TO   LN1DASH
             MOVE  TCHCOMP             TO   LN1NAME.

090895*    IF      (OLDERR             =    'Y'            AND
090895*             LN1MSG             =    '**')               OR
090895*            (OLDERR             =    ' ')
090895*      PERFORM 520-PRINT         THRU 520-EXIT.

091495*    IF      PGMFTE  (PGM1)      =    ZEROS
040610*    IF      SWFFTE              =    ZEROS
040610*      SET   PGM1                UP   BY  +1
040610*      GO                        TO   625-LOOP.

052996     IF      (OLDERR             =    'Y'            AND
052996              LN1MSG             =    '**')               OR
052996             (OLDERR             =    ' ')
052996       PERFORM 520-PRINT         THRU 520-EXIT.

           IF      OLDRPT              =    'B'
032499       MOVE  'Y'                 TO   SWFK12                      EW012140
             MOVE  SWF                 TO   SWFD
             WRITE SWFD
             IF    RETSWF              NOT  =  '00'
               MOVE 'SWF WRITE ERROR'  TO   LNMMSG
               MOVE RETSWF             TO   LNMVALUE1
               MOVE SWFDK              TO   LNMVALUE2
               PERFORM 520-PRINT       THRU 520-EXIT
             ELSE
               ADD +1                  TO   CTRWRITE
           ELSE
             ADD +1                    TO   CTRWRITE.

090895*    IF      (OLDERR             =    'Y'            AND
090895*             LN1MSG             =    '**')               OR
090895*            (OLDERR             =    ' ')
090895*      PERFORM 520-PRINT         THRU 520-EXIT.

           SET     PGM1                UP  BY +1
           GO                          TO  625-LOOP.
       625-EXIT.
           EXIT.

       630-3CHG.
           MOVE    SRTKSECT            TO   OLDKSECT  LN1SECT
           MOVE    HIGH-VALUES         TO   PGMTBL
           MOVE    SPACES              TO   PGMTBLUPD
           SET     PGM1                TO   +1
           PERFORM 620-2CHG            THRU  620-EXIT.
       630-EXIT.
           EXIT.

       635-3TOT.
           IF      PGMTBLUPD           =    'Y'
             GO                        TO   635-EXIT.
           SET     PGM1                TO   +1.
       635-LOOP.
           IF      PGMTBLENTRY  (PGM1) =    HIGH-VALUES          AND
                   PGM1                >    +1
             GO                        TO   635-EXIT.
           MOVE    OLDKDIST            TO   SWFDIST    SWFDIST2
           MOVE    OLDKFY              TO   SWFFY      SWFFY2
           MOVE    OLDKSRVY            TO   SWFSURVEY  SWFSURVEY2
           MOVE    OLDKSCHL            TO   SWFSCHL    SWFSCHL2
           MOVE    OLDKCRSE            TO   SWFCRSE    SWFCRSE2
           MOVE    OLDKSECT            TO   SWFSECT    SWFSECT2
           MOVE    '000000001'         TO   SWFSSN   LN1TCHR   SWFSSN2
           MOVE    '**'                TO   LN1MSG
           MOVE    '-'                 TO   LN1DASH
           MOVE    PGMPGM  (PGM1)      TO   SWFPGM  LN1PGM  SWFPGM2
           MOVE    PGMCNT  (PGM1)      TO   SWFCNT  LN1CNT
           MOVE    PGMMNS  (PGM1)      TO   SWFMNSWK  LN1MNS
           MOVE    PGMFTE  (PGM1)      TO   SWFFTE  LN1FTE
           MOVE    PGMFPRD (PGM1)      TO   SWFFPRD LN1FPRD
           MOVE    PGMTPRD (PGM1)      TO   SWFTPRD LN1TPRD
           MOVE    SPACES              TO   SWFNAME LN1NAME
           MOVE    ZEROS               TO   SWFSQFT
           IF      CTRLN               >   +60
             MOVE  OLDKSRVY            TO  LN1SRVY
             MOVE  OLDKSCHL            TO  LN1SCHL
             MOVE  OLDKCRSE            TO  LN1CRSE
             MOVE  OLDKSECT            TO  LN1SECT
             MOVE  OLDDESC             TO  LN1DESC.

090895*    IF      (OLDERR             =    'Y'            AND
090895*             LN1MSG             =    '**')               OR
090895*            (OLDERR             =    ' ')
090895*      PERFORM 520-PRINT         THRU 520-EXIT.

091495*    IF      PGMFTE  (PGM1)      =    ZEROS
040610*    IF      SWFFTE              =    ZEROS
040610*      SET   PGM1                UP   BY  +1
040610*      GO                        TO   635-LOOP.

052996     IF      (OLDERR             =    'Y'            AND
052996              LN1MSG             =    '**')               OR
052996             (OLDERR             =    ' ')
052996       PERFORM 520-PRINT         THRU 520-EXIT.

           IF      OLDRPT              =    'B'
032499       MOVE  'Y'                 TO   SWFK12                      EW012940
             MOVE  SWF                 TO   SWFD
             WRITE SWFD
             IF    RETSWF              NOT  =  '00'
               MOVE 'SWF WRITE ERROR'  TO   LNMMSG
               MOVE RETSWF             TO   LNMVALUE1
               MOVE SWFDK              TO   LNMVALUE2
               PERFORM 520-PRINT       THRU 520-EXIT
             ELSE
               ADD +1                  TO   CTRWRITE
           ELSE
             ADD +1                    TO   CTRWRITE.

090895*    IF      (OLDERR             =    'Y'            AND
090895*             LN1MSG             =    '**')               OR
090895*            (OLDERR             =    ' ')
090895*      PERFORM 520-PRINT         THRU 520-EXIT.

           SET     PGM1                UP  BY +1
           GO                          TO  635-LOOP.

       635-EXIT.
           EXIT.

       640-4CHG.
           MOVE    SRTKCRSE            TO   OLDKCRSE  LN1CRSE
           PERFORM 720-CRSE-NAME       THRU 720-EXIT
           MOVE    CRSENAME            TO   OLDDESC   LN1DESC
           PERFORM 630-3CHG            THRU  630-EXIT.
       640-EXIT.
           EXIT.

       645-4TOT.
       645-EXIT.
           EXIT.

       650-5CHG.
           MOVE    SRTKSCHL            TO   OLDKSCHL  LN1SCHL
           PERFORM 640-4CHG            THRU  640-EXIT.
       650-EXIT.
           EXIT.

       655-5TOT.
       655-EXIT.
           EXIT.

       660-6CHG.
           MOVE    SRTKSRVY            TO    OLDKSRVY  LN1SRVY
           PERFORM  650-5CHG           THRU  650-EXIT.
       660-EXIT.
           EXIT.

       665-6TOT.
       665-EXIT.
           EXIT.

       670-7CHG.
           MOVE     ZEROS              TO   CTRLN         CTRPG
           MOVE     SRTKREQ            TO   OLDKREQ
           MOVE     SRTKDIST           TO   OLDKDIST
           MOVE     SRTKFY             TO   OLDKFY
           MOVE     SRTPRT             TO   OLDPRT
           MOVE     SRTRPT             TO   OLDRPT
           MOVE     SRTERR             TO   OLDERR

           MOVE     '    SCL0000'      TO   SCLKEY
           MOVE     SRTKDIST           TO   SCLDIST
           MOVE     SRTKFY             TO   SCLFY
           MOVE     SCLKEY             TO   CRFDK
           READ     CRF-DISK
           IF       RETCRF             NOT  =   '00'
             MOVE   'UNKNOWN'          TO   HD1ABBR
           ELSE
             MOVE   CRFD               TO   SCL
             MOVE   SCLABBR            TO   HD1ABBR.
           SET     HD11                TO   +15.
       670-REQ.
           IF      HD1B         (HD11) =    SPACES
             SET   HD11                DOWN BY  +1
             GO                        TO   670-REQ.
           SET     HD11                UP   BY  +1
           MOVE    '-'                 TO   HD1B         (HD11)
           SET     HD11                UP   BY  +1
           MOVE    SRTKREQ1            TO   HD1B         (HD11)
           SET     HD11                UP   BY  +1
           MOVE    SRTKREQ2            TO   HD1B         (HD11)
           SET     HD11                UP   BY  +1
           MOVE    SRTKREQ3            TO   HD1B         (HD11)
           SET     HD11                UP   BY  +1
           MOVE    '-'                 TO   HD1B         (HD11)
           SET     HD11                UP   BY  +1
           MOVE    SRTKFY1             TO   HD1B         (HD11)
           SET     HD11                UP   BY  +1
           MOVE    SRTKFY2             TO   HD1B         (HD11).

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

           PERFORM 660-6CHG            THRU 660-EXIT
           PERFORM 525-HEADS           THRU 525-EXIT.
       670-EXIT.
           EXIT.

       675-7TOT.
           MOVE    SPACES              TO   LN1
           MOVE    'REQUEST'           TO   LN2MSG1
           MOVE    OLDKREQ             TO   LN2REQ
           MOVE    ' TOTAL '           TO   LN2MSG2
           MOVE    CTRWRITE            TO   LN2CNT
           MOVE    ' SWF RECORDS WRITTEN' TO   LN2MSG3
           MOVE    '0'                 TO   CTLCHAR
           PERFORM 520-PRINT           THRU 520-EXIT.
       675-EXIT.
           EXIT.

      ******************************************************************
       710-TCHR-NAME.
           MOVE    SPACES              TO   TCHNAME    WSCLAST
                                            WSCFIRST   WSCNAME
                                            TCHCOMP
           MOVE    SPACES              TO   GI-KEY
           MOVE    SRTKSSN             TO   GI-SSN
           READ    GI-MASTER
           IF      RETGI               NOT  =  '00'
             MOVE  SPACES              TO   TCHNAME  TCHCOMP
           ELSE
             MOVE  GI-LAST           TO     TCHLAST
             MOVE  GI-FIRST          TO     TCHFIRST
             MOVE  GI-MINIT          TO     TCHMI
             MOVE  TCHNAME           TO     TCHCOMP.

       710-EXIT.
           EXIT.
      ******************************************************************
       720-CRSE-NAME.
           MOVE    SPACES              TO   CRSENAME
JA-Y2K     IF      SRTKFY              <    '80'
JA-Y2K             MOVE 20             TO   CDSCHYR-CC
JA-Y2K     ELSE
JA-Y2K             MOVE 19             TO   CDSCHYR-CC.
           MOVE    SRTKFY              TO   CDSCHYR2
      *    COMPUTE CDSCHYR1            =    CDSCHYR2 - 1
RC0300     IF CDSCHYR2 = 00
RC0300         MOVE 19                 TO   CDSCHYR-CC
RC0300         MOVE 99                 TO   CDSCHYR1
RC0300     ELSE
RC0300         COMPUTE CDSCHYR1        =    CDSCHYR2 - 1.
121595*    IF      SRTKSRVY            =    '1'
121595*      MOVE  CDSCHYR1            TO   CDSCHYR2.
           MOVE    SRTKCLASS           TO   CDCSEGEN
           READ    SCO-MASTER
           IF      RETSCO              NOT  =  '00'
             MOVE  'UNKNOWN'           TO   CRSENAME
           ELSE
             MOVE  CDATIT              TO   CRSENAME.

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

      ******************************************************************
       999-EOJ.
           CLOSE                       CRD-CARD
           CLOSE                       CRF-DISK
           CLOSE                       DTC-DISK
           CLOSE                       DSC-DISK
           CLOSE                       GI-MASTER
           CLOSE                       SCO-MASTER
           CLOSE                       SWF-DISK
           IF        RQRSRCE           =   'T'
             CLOSE                     DSC-TAPE.
           CLOSE                       PR1-PRNT.
       999-EXIT.
           EXIT.
