       IDENTIFICATION   DIVISION.

       PROGRAM-ID.      EW001.
       AUTHOR.          DOE.
      *****************************************************************
      *                      CREATE SATSY WORK FILE                   *
      *****************************************************************
      * DATE CREATED:   04/06/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          *
      * 9509049 - 092095 - PRINT ERROR MESSAGE FOR ADULT STUDENTS     *
      * 9512050 - 121595 - POINT SURVEY-1 TO PREVIOUS FISCAL YEAR     *
      * FIX9706 - 041397 - SKIP RECORDS WITH FROM/TO PERIDO = '00'    *
      * FIX9709 - 041497 - MAP ESE PGMS 251-255 TO PGM 250            *
      * FIX9716 - 042697 - CORRECT FOR ESE TEACHERS WITH NO SC RCRDS  *
      * FIX9901 - 032499 - WDIS                                       *
      * FIX9903 - 040599 - CHG FEFP PGMS                              *
      * FIX9907 - 040799 - DON'T PROCESS CHARTER SCHOOLS              *
      * LOCAL01 - 020498 - REMOVE REFERENCE TO V2R1 STUDENT FILES     *
      * 2001001 - 033001 - DON'T ROLL PROGRAMS 251 -> 255 INTO PGM    *
      *                    250.                                       *
      * 2001002 - 040301 - DO NOT ALLOW CORRECT FOR ESE TCHRS WITH NO *
      *                    SC RCRDS.                                  *
      * 2002001 - 052302 - SKIP SCHOLARSHIP SCHOOLS (SCHOOL OF        *
      *                    ENROLLMENT = '3518')                       *
      * 2010003 - 040610 - PROCESS 0 FTE RECORDS                      *
      *****************************************************************


       ENVIRONMENT DIVISION.

       INPUT-OUTPUT SECTION.
       FILE-CONTROL.

           SELECT    CRD-CARD          ASSIGN       DATABASE-EWCRDI.           1
                                                                               0
           SELECT    SRT-SORT          ASSIGN       WORKSTATION-SORT.

           SELECT    PR1-PRNT          ASSIGN       PRINTER-EWPRT01.

           SELECT    CRF-DISK          ASSIGN       DATABASE-EWCRFI
                                       ORGANIZATION INDEXED
                                       ACCESS       RANDOM
                                       RECORD KEY   CRFDK
                                       FILE STATUS  RETCRF.

           SELECT    DTC-DISK          ASSIGN       DATABASE-EWDTCI
                                       ORGANIZATION SEQUENTIAL
                                       ACCESS       SEQUENTIAL
                                       FILE STATUS  RETDTC.

           SELECT    DTC-TAPE          ASSIGN       TAPEFILE-EWTAP01
                                       ORGANIZATION SEQUENTIAL
                                       ACCESS       SEQUENTIAL
                                       FILE STATUS  RETDTCT.

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

           SELECT    DSC-TAPE          ASSIGN       TAPEFILE-EWTAP01
                                       ORGANIZATION SEQUENTIAL
                                       ACCESS       SEQUENTIAL
                                       FILE STATUS  RETDSCT.

020498*    SELECT    SST-MASTER        ASSIGN       DATABASE-TSSTI
020498*                                ORGANIZATION INDEXED
020498*                                ACCESS       RANDOM
020498*                                RECORD KEY   SSTKEYD
020498*                                FILE STATUS  RETSST.
020498*
020498*    SELECT    SMS-MASTER        ASSIGN       DATABASE-TSMSI
020498*                                ORGANIZATION INDEXED
020498*                                ACCESS       RANDOM
020498*                                RECORD KEY   SMSKEYD
020498*                                FILE STATUS  RETSMS.
020498*
020498*    SELECT    SCO-MASTER        ASSIGN       DATABASE-TSCOI
020498*                                ORGANIZATION INDEXED
020498*                                ACCESS       RANDOM
020498*                                RECORD KEY   SCOKEYD
020498*                                FILE STATUS  RETSCO.

           SELECT    SWF-DISK          ASSIGN       DATABASE-EWSWFB
                                       ORGANIZATION INDEXED
                                       ACCESS       DYNAMIC
                                       RECORD KEY   SWFDK
                                       FILE STATUS  RETSWF.


       DATA DIVISION.
       FILE SECTION.

       FD  CRD-CARD
           RECORD    CONTAINS   80  CHARACTERS
           LABEL     RECORDS   ARE  OMITTED
           DATA      RECORDS   ARE  CRD  CRH.

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

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

       FD  PR1-PRNT
           RECORD    CONTAINS  132  CHARACTERS
           LABEL     RECORDS   ARE  OMITTED
           DATA      RECORDS   ARE  LNM  LN1  LN2.

       01  LNM.
001        05        LNMMSG            PIC  X(20).
021        05        FILLER            PIC  X(02).
023        05        LNMVALUE1         PIC  X(02).
025        05        FILLER            PIC  X(01).
026        05        LNMVALUE2         PIC  X(80).
106        05        FILLER            PIC  X(27).

       01            LN1.
001        05        LN1SRVY           PIC  X(01).
002        05        FILLER            PIC  X(01).
003        05        LN1SCHL           PIC  X(04).
007        05        FILLER            PIC  X(01).
008        05        LN1CRSE           PIC  X(07).
015        05        FILLER            PIC  X(01).
016        05        LN1DESC           PIC  X(30).
046        05        FILLER            PIC  X(01).
047        05        LN1SECT           PIC  X(05).
052        05        FILLER            PIC  X(01).
053        05        LN1FPRD           PIC  99.
055        05        LN1DASH           PIC  X(01).
056        05        LN1TPRD           PIC  99.
058        05        FILLER            PIC  X(01).
059        05        LN1TCHR           PIC  X(10).
069        05        FILLER            PIC  X(01).
070        05        LN1NAME           PIC  X(30).
100        05        FILLER            PIC  X(01).
101        05        LN1PGM            PIC  X(03).
104        05        FILLER            PIC  X(01).
105        05        LN1CNT            PIC  ZZ,ZZ9.
111        05        FILLER            PIC  X(01).
112        05        LN1MNS            PIC  Z,ZZZ,ZZ9.
121        05        FILLER            PIC  X(01).
122        05        LN1FTE            PIC  ZZ9.9999.
130        05        FILLER            PIC  X(01).
131        05        LN1MSG            PIC  X(02).

       01            LN2.
001        05        FILLER            PIC  X(77).
078        05        LN2MSG1           PIC  X(08).
086        05        LN2REQ            PIC  X(03).
089        05        LN2MSG2           PIC  X(07).
096        05        LN2CNT            PIC  ZZZ,ZZ9.
103        05        LN2MSG3           PIC  X(20).
123        05        FILLER            PIC  X(10).

           COPY                        EWCRFD      OF   COSTS-CPYSRC.
           COPY                        EWDTCD      OF   COSTS-CPYSRC.
           COPY                        EWDTCT      OF   COSTS-CPYSRC.
           COPY                        EWDSCD      OF   COSTS-CPYSRC.
           COPY                        EWDSCT      OF   COSTS-CPYSRC.
020498*    COPY                        TSSTFD      OF   TERMSC-CBLSRC.
020498*    COPY                        TSMSFD      OF   TERMSC-CBLSRC.
020498*    COPY                        TSCOFD      OF   TERMSC-CBLSRC.
           COPY                        EWSWFD      OF   COSTS-CPYSRC.

       SD  SRT-SORT.

       01            SRT.
           05        SRTKEY.
             10      SRTKDIST          PIC  X(02).
             10      SRTKREQ.
               15    SRTKREQ1          PIC  X(01).
               15    SRTKREQ2          PIC  X(01).
               15    SRTKREQ3          PIC  X(01).
             10      SRTKFY.
               15    SRTKFY1           PIC  X(01).
               15    SRTKFY2           PIC  X(01).
             10      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'.
020498*    05        RETSST            PIC  X(02) VALUE '00'.
020498*    05        RETSMS            PIC  X(02) VALUE '00'.
020498*    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(01).
             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).
040799     05        OLDCHRTR          PIC  X(01).


           COPY                        EWSCL        OF   COSTS-CPYSRC.
           COPY                        EWDTC        OF   COSTS-CPYSRC.
           COPY                        EWDSC        OF   COSTS-CPYSRC.
020498*    COPY                        TSSTR        OF   TERMSC-CBLSRC.
020498*    COPY                        TSMSR        OF   TERMSC-CBLSRC.
020498*    COPY                        TSCOR        OF   TERMSC-CBLSRC.
           COPY                        EWSWF        OF   COSTS-CPYSRC.

       01            OLDLN             PIC  X(133).

       01      HD1.
001        05  FILLER  PIC X(06) VALUE 'EW001 '.
           05  HD1ABBR.
007         10 HD1B    OCCURS 22 TIMES INDEXED BY HD11 PIC X(01).
029        05  FILLER  PIC X(11) VALUE SPACES.
040        05  HD1MODE PIC X(08) VALUE SPACES.
048        05  FILLER  PIC X(07) VALUE SPACES.
055        05  FILLER  PIC X(22) VALUE 'CREATE SATSY WORK FILE'.
077        05  FILLER  PIC X(21) VALUE SPACES.
098        05  HD1USER PIC X(09) VALUE SPACES.
107        05  HD1MM   PIC X(02) VALUE SPACES.
109        05  FILLER  PIC X(01) VALUE '/'.
110        05  HD1DD   PIC X(02) VALUE SPACES.
112        05  FILLER  PIC X(01) VALUE '/'.
113        05  HD1YY   PIC X(02) VALUE SPACES.
115        05  FILLER  PIC X(02) VALUE SPACES.
117        05  HD1HR   PIC X(02) VALUE SPACES.
119        05  FILLER  PIC X(01) VALUE ':'.
120        05  HD1MN   PIC X(02) VALUE SPACES.
122        05  FILLER  PIC X(07) VALUE '  PAGE-'.
129        05  HD1PG   PIC ZZZ9.

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

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

       01      HD4.
001        05  FILLER  PIC X(53) VALUE SPACES.
054        05  FILLER  PIC X(03) VALUE 'PRD'.
057        05  FILLER  PIC X(49) VALUE SPACES.
106        05  FILLER  PIC X(04) VALUE 'STDT'.
110        05  FILLER  PIC X(23) VALUE SPACES.

       01      HD5.
001        05  FILLER  PIC X(17) VALUE 'S SCHL COURSE    '.
018        05  FILLER  PIC X(29) VALUE SPACES.
047        05  FILLER  PIC X(22) VALUE 'SECT  FR-TO TEACHER ID'.
069        05  FILLER  PIC X(32) VALUE SPACES.
101        05  FILLER  PIC X(20) VALUE 'PGM  COUNT   MINUTES'.
121        05  FILLER  PIC X(12) VALUE ' STDT FTE ER'.

       LINKAGE       SECTION.

           COPY                       EWBJR       OF    COSTS-CPYSRC.

       PROCEDURE DIVISION USING BJR.
      ******************************************************************
       DECLARATIVES.
       000-ERROR     SECTION.
           USE AFTER STANDARD ERROR PROCEDURE ON CRD-CARD
020498*                                          SST-MASTER
020498*                                          SMS-MASTER
020498*                                          SCO-MASTER
                                                 SWF-DISK
                                                 DTC-DISK
                                                 DTC-TAPE
                                                 DSC-DISK
                                                 DSC-TAPE
                                                 CRF-DISK.
       000-ENCOUNTERED.
           CONTINUE.
       END DECLARATIVES.

      ******************************************************************
           SORT    SRT-SORT            ASCENDING KEY       SRTKEY
                                       INPUT     PROCEDURE 000-INPUT
                                       OUTPUT    PROCEDURE 500-OUTPUT.
           GOBACK.

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

           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
             IF    RETDTCT             NOT  =  '00'
               CLOSE                   DTC-TAPE
               MOVE '99'               TO   RETDTCT
               OPEN   INPUT            DSC-TAPE
             ELSE
               MOVE  DTCT              TO   DTC
               MOVE  'T'               TO   WSCFILE
               GO                      TO   010-EXIT.

           READ    DSC-TAPE
           IF      RETDSCT             NOT  =  '00'
             MOVE  '99'                TO   RETDSCT
             GO                        TO   010-EXIT
           ELSE
             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
040799       MOVE  DTCISCHL            TO   OLDSCHL
040799       MOVE  SPACES              TO   OLDCHRTR
040799       PERFORM 020-READ-SCHL     THRU 020-EXIT.

           IF      OLDCHRTR            =    'Y'
040799       GO                        TO   015-EXIT.

032499     IF      DTCCRSE             NOT  NUMERIC
032499       GO                        TO   015-EXIT.

           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    DTCTFY              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

040301*    IF      DTCCRSE             =    '2222222'
040301*      MOVE  DTCIDIST            TO   SRTKDIST
040301*      MOVE  RQRREQ              TO   SRTKREQ
040301*      MOVE  DTCTFY              TO   SRTKFY
040301*      MOVE  DTCSURV             TO   SRTKSRVY
040301*      MOVE  DTCISCHL            TO   SRTKSCHL
040301*      MOVE  DTCCRSE             TO   SRTKCRSE
040301*      MOVE  DTCSECT             TO   SRTKSECT
040301*      MOVE  SPACES              TO   SRTKSSN
040301*      MOVE  '205'               TO   SRTKPGM
040301*      MOVE  1                   TO   SRTMNS
040301*      MOVE  1                   TO   SRTFTE
040301*      MOVE  DTCFPRD             TO   SRTFPRD
040301*      MOVE  DTCTPRD             TO   SRTTPRD
040301*      MOVE  RQRPRT              TO   SRTPRT
040301*      MOVE  RQRRPT              TO   SRTRPT
040301*      MOVE  RQRERR              TO   SRTERR
040301*      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
040799       MOVE  DSCISCHL            TO   OLDSCHL
040799       MOVE  SPACES              TO   OLDCHRTR
040799       PERFORM 020-READ-SCHL     THRU 020-EXIT.

052302*    IF      OLDCHRTR            =    'Y'
052302     IF     (OLDCHRTR            =    'Y')             OR
052302            (DSCESCHL            =    '3518')
040799       GO                        TO   015-EXIT.

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
032499       GO                        TO   015-EXIT.

           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    DSCTFY              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'
040599           MOVE  '120'           TO   SRTKPGM
040599         ELSE
033001*        IF  DSCPGM              =    '251'
033001*          MOVE  '250'           TO   SRTKPGM
033001*        ELSE
033001*        IF  DSCPGM              =    '252'
033001*          MOVE  '250'           TO   SRTKPGM
033001*        ELSE
033001*        IF  DSCPGM              =    '253'
033001*          MOVE  '250'           TO   SRTKPGM
033001*        ELSE
033001*        IF  DSCPGM              =    '254'
033001*          MOVE  '250'           TO   SRTKPGM
033001*        ELSE
033001*        IF  DSCPGM              =    '255'
033001*          MOVE  '250'           TO   SRTKPGM
033001*        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******************************************************************
040799 020-READ-SCHL.
040799     MOVE     '    SCL    '      TO   SCLKEY
040799     MOVE     RQRDIST            TO   SCLDIST
040799     MOVE     RQRFY              TO   SCLFY
040799     MOVE     OLDSCHL            TO   SCLSCL
040799     MOVE     SCLKEY             TO   CRFDK
040799     READ     CRF-DISK
040799     IF       RETCRF             NOT  =   '00'
040799       INITIALIZE  SCL
040799       MOVE   SCLCHRTR           TO   OLDCHRTR
040799     ELSE
040799       MOVE   CRFD               TO   SCL
040799       MOVE   SCLCHRTR           TO   OLDCHRTR.
040799 020-EXIT.
040799     EXIT.
040799
      ******************************************************************
       490-HOUSEKEEPING.
           OPEN    INPUT                    CRD-CARD      CRF-DISK
020498*                                     SST-MASTER    SCO-MASTER
020498*                                     SMS-MASTER
                   OUTPUT                   PR1-PRNT
           MOVE    SPACES              TO   LN1
040799     MOVE    SPACES              TO   OLDCHRTR
           MOVE    '1'                 TO   CTLCHAR
           MOVE    HIGH-VALUES         TO   RQR           RQH.
           SET     RQH1                TO   +1.
           IF      BJR                 >    SPACES
             PERFORM 495-LOAD          THRU 495-EXIT
             GO                        TO   490-TEST.
       490-LOAD.
           READ    CRD-CARD            AT   END
             GO                        TO   490-TEST.
           IF      CRDREQ              NOT  NUMERIC
             MOVE    CRD               TO   LNMVALUE2
             PERFORM 520-PRINT         THRU 520-EXIT
             GO                        TO   490-LOAD.
           MOVE    SPACES              TO   ERR
           IF      CRDID               =    'SL'
             GO                        TO   490-REQ
           ELSE
             IF     (CRDID             =    'H1')                    OR
                    (CRDID             =    'H2')
               GO                      TO   490-HEAD
             ELSE
               GO                      TO   490-LOAD.

       490-REQ.
           IF     (CRDPRT              NOT  =   'U')                 AND
                  (CRDPRT              NOT  =   'T')                 AND
                  (CRDPRT              NOT  =   'B')                 AND
                  (CRDPRT              NOT  =   'N')
             MOVE  ALL '-'             TO   ERRPRT.
           IF     (CRDDIST             =    SPACES)
             MOVE  ALL '-'             TO   ERRDIST.
           IF     (CRDFY               NOT  NUMERIC)
             MOVE  ALL '-'             TO   ERRFY.
           IF     (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
           ELSE
             MOVE    'REQUEST LOADED'  TO   LNMMSG
             MOVE    CRD               TO   LNMVALUE2
             PERFORM 520-PRINT         THRU 520-EXIT.
           MOVE    CRDREQ              TO   RQRREQ
           MOVE    CRDPRT              TO   RQRPRT
           MOVE    CRDDIST             TO   RQRDIST
           MOVE    CRDFY               TO   RQRFY
           MOVE    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'
SKIP         IF   (WSCTC               =    SPACES         AND
                   WSCSC               =    SPACES)
               OPEN  INPUT             DTC-DISK   DSC-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    CRD                 TO   LNMVALUE2
           PERFORM 520-PRINT           THRU 520-EXIT
           MOVE    CRHREQ              TO   RQHREQ       (RQH1)
           MOVE    CRHID               TO   RQHID        (RQH1)
           MOVE    CRHUSER             TO   RQHUSER      (RQH1)
           MOVE    SPACES              TO   RQHHEAD      (RQH1)
           MOVE    +50                 TO   CTRIDX
           SET     CRH1                TO   +50.
       490-HEAD1.
           IF      CRHB         (CRH1) =    SPACES
             IF      CRH1              >    +2
               ADD   -1                TO   CTRIDX
               SET   CRH1              DOWN BY  +1
               GO                      TO   490-HEAD1.
           SUBTRACT +1                 FROM CTRIDX
           COMPUTE CTRIDX      ROUNDED =    (50  - CTRIDX) / 2
           SET     RQH2                TO   CTRIDX
           SET     CRH1                TO   +1.
       490-HEAD2.
           MOVE    CRHB         (CRH1) TO   RQHB         (RQH1 RQH2)
           IF      RQH2                <    +50
             SET   RQH2  CRH1          UP   BY  +1
             GO                        TO   490-HEAD2.
           SET     RQH1             UP BY   +1
           GO                          TO   490-LOAD.

       490-TEST.
           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.
020498*    IF      RETSST              NOT  =   '00'
020498*      MOVE    'SST OPEN ERROR'  TO   LNMMSG
020498*      MOVE    RETSST            TO   LNMVALUE1
020498*      PERFORM 520-PRINT         THRU 520-EXIT.
020498*    IF      RETSMS              NOT  =   '00'
020498*      MOVE    'SMS OPEN ERROR'  TO   LNMMSG
020498*      MOVE    RETSMS            TO   LNMVALUE1
020498*      PERFORM 520-PRINT         THRU 520-EXIT.
020498*    IF      RETSCO              NOT  =   '00'
020498*      MOVE    'SCO OPEN ERROR'  TO   LNMMSG
020498*      MOVE    RETSCO            TO   LNMVALUE1
020498*      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
020498*           (RETSST              NOT  =   '00')                OR
020498*           (RETSMS              NOT  =   '00')                OR
020498*           (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'
             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           ((SWFSURVEY           =    '1'     AND
080395             CRDSRVY1            =    ' ')         OR
080395            (SWFSURVEY           =    '2'     AND
080395             CRDSRVY2            =    ' ')         OR
080395            (SWFSURVEY           =    '3'     AND
080395             CRDSRVY3            =    ' ')         OR
080395            (SWFSURVEY           =    '4'     AND
080395             CRDSRVY4            =    ' '))
032499         IF  SWFK12              =    'Y'
                 DELETE SWF-DISK
032499           GO                    TO   493-LOOP
032499         ELSE
                 GO                    TO   493-LOOP.
       493-EXIT.
           EXIT.

      ******************************************************************
       495-LOAD.
           MOVE    BJRCARD1            TO   CRD
           MOVE    SPACES              TO   ERR
           IF     (CRDPRT              NOT  =   'U')                 AND
                  (CRDPRT              NOT  =   'T')                 AND
                  (CRDPRT              NOT  =   'B')                 AND
                  (CRDPRT              NOT  =   'N')
             MOVE  ALL '-'             TO   ERRPRT.
           IF     (CRDDIST             =    SPACES)
             MOVE  ALL '-'             TO   ERRDIST.
           IF     (CRDFY               NOT  NUMERIC)
             MOVE  ALL '-'             TO   ERRFY.
           IF     (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   495-EXIT.
           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

CHECK      IF      RQRSRCE             =    'D'
             IF   (WSCTC               =    SPACES         AND
                   WSCSC               =    SPACES)
               OPEN  INPUT             DTC-DISK   DSC-DISK
 WHY           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.

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

      ******************************************************************
       500-OUTPUT SECTION.
           PERFORM 990-HOUSEKEEPING    THRU 990-EXIT.
       505-LOOP.
             IF    (SRTKDIST           NOT  =   OLDKDIST)            OR
                   (SRTKREQ            NOT  =   OLDKREQ)             OR
                   (SRTKFY             NOT  =   OLDKFY)              OR
                   (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
           MOVE    OLDKFY              TO   SWFFY
           MOVE    OLDKSRVY            TO   SWFSURVEY
           MOVE    OLDKSCHL            TO   SWFSCHL
           MOVE    OLDKCRSE            TO   SWFCRSE
           MOVE    OLDKSECT            TO   SWFSECT
           MOVE    OLDKSSN             TO   SWFSSN
           MOVE    OLDFPRD             TO   SWFFPRD LN1FPRD
           MOVE    OLDTPRD             TO   SWFTPRD LN1TPRD
092095     IF      OLDFPRD             =    '99'
092095       MOVE  'AD'                TO   LN1MSG.
           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
             MOVE  ZEROS               TO   SWFCNT  LN1CNT
                                            SWFMNSWK LN1MNS
                                            SWFFTE  LN1FTE
                                            SWFSQFT
             MOVE  '**'                TO   LN1MSG
           ELSE
             MOVE  PGMPGM  (PGM1)      TO   SWFPGM  LN1PGM
             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
092095*             LN1MSG             =    '**')               OR
092095              LN1MSG             NOT  =  SPACES)          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.

           IF      OLDRPT              =    'B'
032499       MOVE  'Y'                 TO   SWFK12
             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
           MOVE    OLDKFY              TO   SWFFY
           MOVE    OLDKSRVY            TO   SWFSURVEY
           MOVE    OLDKSCHL            TO   SWFSCHL
           MOVE    OLDKCRSE            TO   SWFCRSE
           MOVE    OLDKSECT            TO   SWFSECT
           MOVE    '000000001'         TO   SWFSSN   LN1TCHR
           MOVE    '**'                TO   LN1MSG
           MOVE    '-'                 TO   LN1DASH
           MOVE    PGMPGM  (PGM1)      TO   SWFPGM  LN1PGM
           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
092095     IF      PGMFPRD (PGM1)      =    '99'           AND
092095             LN1MSG              =    SPACES
092095       MOVE  'AD'                TO   LN1MSG.
           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
092095*             LN1MSG             =    '**')               OR
092095              LN1MSG             NOT  =  SPACES)          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.

           IF      OLDRPT              =    'B'
032499       MOVE  'Y'                 TO   SWFK12
             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.
020498*    MOVE    SPACES              TO   TCHNAME    WSCLAST
020498*                                     WSCFIRST   WSCNAME
020498*                                     TCHCOMP
020498*    MOVE    SRTKDIST            TO   SMSDISTN
020498*    MOVE    SRTKFY              TO   SMSSY
121595*    IF      SRTKSRVY            =    '1'
121595*      MOVE  SRTKFY              TO   WSCFY
121595*      COMPUTE WSCFY             =    (WSCFY - 1)
121595*      MOVE  WSCFY               TO   SMSSY.
020498*    MOVE    SRTKSCHL            TO   SMSSCHL
020498*    MOVE    SRTKCLASS           TO   WSCCLASS
020498*    MOVE    WSCCRSE             TO   SMSCRSE
020498*    MOVE    WSCSECT             TO   SMSSECM
020498*    MOVE    SMSKEY              TO   SMSKEYD
020498*    READ    SMS-MASTER
020498*    IF      RETSMS              NOT  =  '00'
020498*      MOVE  SPACES              TO   TCHNAME  TCHCOMP
020498*      GO                        TO   710-EXIT
020498*    ELSE
020498*      MOVE  SMSRCDD             TO   SMS.
020498*    MOVE    SRTKDIST            TO   SSTDISTN
020498*    MOVE    SRTKFY              TO   SSTSY
121595*    IF      SRTKSRVY            =    '1'
121595*      MOVE  WSCFY               TO   SSTSY.
020498*    MOVE    SRTKSCHL            TO   SSTSCHL
020498*    MOVE    SMSTCHR             TO   SSTTCHR
020498*    MOVE    SSTKEY              TO   SSTKEYD
020498*    READ    SST-MASTER
020498*    IF      RETSST              NOT  =  '00'
020498*      MOVE  SPACES              TO   TCHNAME  TCHCOMP
020498*      GO                        TO   710-EXIT
020498*    ELSE
020498*      MOVE  SSTRCDD             TO   SST
020498*      IF    SSTNAME1            =    SPACES
020498*        MOVE SSTNAME1           TO   TCHNAME  TCHCOMP
020498*        GO                      TO   710-EXIT
020498*      ELSE
020498*        MOVE  SSTNAME1          TO   WSCNAME  TCHCOMP.
020498*    SET     NAM1  LST1 FST1     TO   +1.
020498*710-LOOP1.
020498*    IF      WSCNAMEB (NAM1)     NOT  =  ','
020498*      MOVE  WSCNAMEB (NAM1)     TO   WSCLASTB (LST1)
020498*      IF    LST1                <    +17
020498*        SET  NAM1  LST1         UP   BY  +1
020498*        GO                      TO   710-LOOP1.
020498*
020498*    IF      WSCNAMEB (NAM1)     =    ','
020498*      SET   NAM1                UP   BY  +2
020498*    ELSE
020498*      SET   NAM1                UP   BY  +1.
020498*710-LOOP2.
020498*    IF      NAM1                <    +21
020498*      IF    WSCNAMEB (NAM1)     =    ','
020498*        SET NAM1                UP   BY  +2
020498*      ELSE
020498*        IF  WSCNAMEB (NAM1)     =    SPACES
020498*          SET  NAM1             UP   BY  +1
020498*          MOVE WSCNAMEB (NAM1)  TO   TCHMI
020498*          SET  NAM1             TO   +20
020498*        ELSE
020498*          MOVE WSCNAMEB (NAM1)  TO   WSCFIRSTB (FST1).
020498*
020498*    IF      NAM1                <    +20               AND
020498*            FST1                <    +12
020498*      SET   NAM1  FST1          UP   BY  +1
020498*      GO                        TO   710-LOOP2.
020498*
020498*    MOVE    WSCLAST             TO   TCHLAST
020498*    MOVE    WSCFIRST            TO   TCHFIRST.
020498*
       710-EXIT.
           EXIT.
      ******************************************************************
       720-CRSE-NAME.
020498*    MOVE    SPACES              TO   CRSENAME
020498*    MOVE    SRTKDIST            TO   SCODISTN
020498*    MOVE    SRTKFY              TO   SCOSY
121595*    IF      SRTKSRVY            =    '1'
121595*      MOVE  WSCFY               TO   SCOSY.
020498*    MOVE    SRTKSCHL            TO   SCOSCHL
020498*    MOVE    SRTKCLASS           TO   SCOCRSE
020498*    MOVE    SCOKEY              TO   SCOKEYD
020498*    READ    SCO-MASTER
020498*    IF      RETSCO              NOT  =  '00'
020498*      MOVE  'UNKNOWN'           TO   CRSENAME
020498*    ELSE
020498*      MOVE  SCORCDD             TO   SCO
020498*      MOVE  SCOTITLE            TO   CRSENAME.
020498*
       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      CRF-DISK
                                       DTC-DISK      DSC-DISK
                                       DTC-TAPE      DSC-TAPE
020498*                                SST-MASTER    SCO-MASTER
020498*                                SMS-MASTER    SWF-DISK
020498                                               SWF-DISK
                                       PR1-PRNT.
       999-EXIT.
           EXIT.
