       IDENTIFICATION DIVISION.

       PROGRAM-ID.      EW004.
       AUTHOR.          DOE.
      *****************************************************************
      *                  WORK FILE CONVERSION TO SATSY                *
      *****************************************************************
      * DATE CREATED:  04/28/95                                       *
      *****************************************************************
      * CALL #  - MMDDYY - PURPOSE                                    *
      * 9507137 - 073195 - CHANGE THE WAY MULTIPLE PERIOD CLASSES     *
      *                    ARE PROCESSED                              *
      * 9510025 - 101495 - IF A NAME IS ASSIGNED TO ANY MOD RECORD    *
      *                    WITHIN A JOB, THEN USE IT                  *
      * 9511012 - 112995 - ADD FAILSAFE EDITS TO PREVENT ABEND        *
      * FIX9902 - 040599 - REMOVE % PGM FROM/TO FIELDS                *
      *           040699 - "PRE-LOAD" % PGM WITH 340 AND 450          *
      * 2002001 - 071102 - FIX LOAD OF PGM RANGE FOR STDT %           *
      * 2009003 - 100808 - FIX PROBLEM OF % TIME IN MOD NOT CALC      *
      *                    CORRECTLY WHEN TEACHER HAS A REGULAR JOB   *
      *                    AND AN ADULT ED JOB.                       *
      *****************************************************************

       ENVIRONMENT DIVISION.

       INPUT-OUTPUT SECTION.
       FILE-CONTROL.

           SELECT    CRD-CARD          ASSIGN       DATABASE-EWCRDI.

           SELECT    PR1-PRNT          ASSIGN       PRINTER-EWPRT01.

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

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

           SELECT    STH-DISK          ASSIGN       DATABASE-EWSTHB
                                       ORGANIZATION INDEXED
                                       ACCESS       DYNAMIC
                                       RECORD KEY   STHDK
                                       FILE STATUS  RETSTH.

           SELECT    STS-DISK          ASSIGN       DATABASE-EWSTSB
                                       ORGANIZATION INDEXED
                                       ACCESS       DYNAMIC
                                       RECORD KEY   STSDK
                                       FILE STATUS  RETSTS.

           SELECT    SMP-DISK          ASSIGN       DATABASE-EWSMPB
                                       ORGANIZATION INDEXED
                                       ACCESS       DYNAMIC
                                       RECORD KEY   SMPDK
                                       FILE STATUS  RETSMP.

           SELECT    SRT-SORT          ASSIGN       WORKSTATION-SORT.

       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        CRDREG1           PIC  9(02).
020        05        FILLER            PIC  X(01).
021        05        CRDREG2           PIC  9(02).
023        05        FILLER            PIC  X(01).
024        05        CRDREG3           PIC  9(02).
026        05        FILLER            PIC  X(01).
027        05        CRDREG4           PIC  9(02).
029        05        FILLER            PIC  X(01).
030        05        CRDFROM           PIC  X(03).
033        05        FILLER            PIC  X(01).
034        05        CRDTO             PIC  X(03).
037        05        FILLER            PIC  X(01).
038        05        CRDADLT1          PIC  9(02).
040        05        FILLER            PIC  X(01).
041        05        CRDADLT2          PIC  9(02).
043        05        FILLER            PIC  X(01).
044        05        CRDADLT3          PIC  9(02).
046        05        FILLER            PIC  X(01).
047        05        CRDADLT4          PIC  9(02).
049        05        FILLER            PIC  X(01).
050        05        CRDRPT            PIC  X(01).
051        05        FILLER            PIC  X(30).

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

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

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

       01            LN1.
001        05        LN1MSG1           PIC  X(08).
009        05        LN1REQ            PIC  X(04).
013        05        LN1MSG2           PIC  X(06).
019        05        LN1CNT            PIC  ZZZ,ZZ9-.
027        05        LN1MSG3           PIC  X(19).
046        05        FILLER            PIC  X(87).

           COPY                        EWCRFD              OF   CPYSRC.
           COPY                        EWSWFDL1            OF   CPYSRC.
           COPY                        EWSTHD              OF   CPYSRC.
           COPY                        EWSTSD              OF   CPYSRC.
           COPY                        EWSMPD              OF   CPYSRC.

       SD  SRT-SORT.

       01            SRT.
           05        SRTKEY.
001          10      SRTKDIST          PIC  X(02).
             10      SRTKREQ.
003            15    SRTKREQ1          PIC  X(01).
004            15    SRTKREQ2          PIC  X(01).
005            15    SRTKREQ3          PIC  X(01).
             10      SRTKFY.
006            15    SRTKFY1           PIC  X(01).
007            15    SRTKFY2           PIC  X(01).
008          10      SRTKSSN           PIC  X(10).
018          10      SRTKJOB           PIC  9(02).
020          10      SRTKSCHL          PIC  X(04).
024          10      SRTKSURVEY        PIC  X(01).
025          10      SRTKMOD           PIC  X(02).
027          10      SRTKPGM           PIC  X(03).
           05        SRTDATA.
030          10      SRTNBRPRD         PIC S9(03).
034          10      SRTCNT            PIC S9(03).
038          10      SRTSQFT           PIC S9(05).
044          10      SRTMNSWK          PIC S9(08).
053          10      SRTFTE            PIC S9(04)V9(04).
             10      SRTNAME.
062            15    SRTLAST           PIC  X(17).
079            15    SRTFIRST          PIC  X(12).
091            15    SRTMINIT          PIC  X(01).
092          10      SRTRPT            PIC  X(01).
093          10      SRTPRT            PIC  X(01).

       WORKING-STORAGE SECTION.

       01            RET.
           05        RETCRF            PIC  X(02) VALUE '00'.
           05        RETSWF            PIC  X(02) VALUE '00'.
           05        RETSTH            PIC  X(02) VALUE '00'.
           05        RETSTS            PIC  X(02) VALUE '00'.
           05        RETSMP            PIC  X(02) VALUE '00'.
           05        RETCRFOLD         PIC  X(02) VALUE '00'.
           05        RETSTHOLD         PIC  X(02) VALUE '00'.
           05        RETSTSOLD         PIC  X(02) VALUE '00'.
           05        RETSMPOLD         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      ERRREG1           PIC  X(02).
             10      FILLER            PIC  X(01).
             10      ERRREG2           PIC  X(02).
             10      FILLER            PIC  X(01).
             10      ERRREG3           PIC  X(02).
             10      FILLER            PIC  X(01).
             10      ERRREG4           PIC  X(02).
             10      FILLER            PIC  X(01).
             10      ERRFROM           PIC  X(03).
             10      FILLER            PIC  X(01).
             10      ERRTO             PIC  X(03).
             10      FILLER            PIC  X(01).
             10      ERRADLT1          PIC  X(02).
             10      FILLER            PIC  X(01).
             10      ERRADLT2          PIC  X(02).
             10      FILLER            PIC  X(01).
             10      ERRADLT3          PIC  X(02).
             10      FILLER            PIC  X(01).
             10      ERRADLT4          PIC  X(02).
             10      FILLER            PIC  X(01).
             10      ERRRPT            PIC  X(01).

       01            RQR.
           05        RQRENTRY.
             10      RQRREQ            PIC  X(03).
             10      RQRID             PIC  X(02).
             10      RQRPRT            PIC  X(01).
             10      RQRDIST           PIC  X(02).
             10      RQRFY             PIC  X(02).
             10      RQRREG1           PIC  9(02).
             10      RQRREG2           PIC  9(02).
             10      RQRREG3           PIC  9(02).
             10      RQRREG4           PIC  9(02).
             10      RQRFROM           PIC  X(03).
             10      RQRTO             PIC  X(03).
             10      RQRADLT1          PIC  9(02).
             10      RQRADLT2          PIC  9(02).
             10      RQRADLT3          PIC  9(02).
             10      RQRADLT4          PIC  9(02).
             10      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            TBL.
           05        TBLENTRY   OCCURS 201  TIMES INDEXED BY TBL1.
             10      TBLSCHL           PIC  X(04).
             10      TBLSTS            PIC S9(03)       COMP-3.
             10      TBLFTE            PIC S9(05)V9(04) COMP-3.

       01            STRKEY.
           05        STRDIST           PIC  X(02) VALUE HIGH-VALUES.
           05        STRFY             PIC  X(02) VALUE HIGH-VALUES.
           05        FILLER            PIC  X(32) VALUE HIGH-VALUES.

       01            ENDKEY.
           05        ENDDIST           PIC  X(02) VALUE LOW-VALUES.
           05        ENDFY             PIC  X(02) VALUE LOW-VALUES.
           05        FILLER            PIC  X(32) VALUE LOW-VALUES.

       01            CTR.
           05        CTRLN             PIC S9(03)       COMP-3 VALUE +0.
           05        CTRPG             PIC S9(05)       COMP-3 VALUE +0.
           05        CTRIDX            PIC S9(05)       COMP-3 VALUE +0.
           05        CTRCRD            PIC S9(03)       COMP-3 VALUE +0.
           05        CTRPRDS           PIC S9(03)       COMP-3 VALUE +0.
           05        CTRMNSWK          PIC S9(09)       COMP-3 VALUE +0.
           05        CTRPRDMNSWK       PIC S9(09)       COMP-3 VALUE +0.
           05        CTRFTE            PIC S9(04)V9(04) COMP-3 VALUE +0.
           05        CTRCNT            PIC S9(03)       COMP-3 VALUE +0.
           05        CTRPSTDT          PIC S9(02)V9(03) COMP-3 VALUE +0.
           05        CTRSMP            PIC S9(03)       COMP-3 VALUE +0.
           05        CTRSTS            PIC S9(03)       COMP-3 VALUE +0.
           05        CTRSCHLFTE        PIC S9(05)V9(04) COMP-3 VALUE +0.
           05        CTRJOBFTE         PIC S9(05)V9(04) COMP-3 VALUE +0.
           05        CTRPGM            PIC S9(03)       COMP-3 VALUE +0.
           05        CTRPMOD           PIC S9(01)V9(02) COMP-3 VALUE +0.
           05        CTRREQSMP         PIC S9(09)       COMP-3 VALUE +0.
           05        CTRREQSTS         PIC S9(09)       COMP-3 VALUE +0.
           05        CTRREQSTH         PIC S9(09)       COMP-3 VALUE +0.
           05        CTRPSCHL          PIC S9(01)V9(02) COMP-3 VALUE +0.
073195     05        CTRPGMMNSWK       PIC S9(09)       COMP-3 VALUE +0.
073195     05        CTRPGMCNT         PIC S9(03)       COMP-3 VALUE +0.
073195     05        CTRPGMFTE         PIC S9(05)V9(04) COMP-3 VALUE +0.

       01            OLDKEY.
           05        OLDDIST           PIC  X(02).
           05        OLDFY             PIC  X(02).
           05        OLDSCHL           PIC  X(04).
           05        OLDSSN            PIC  X(10).
           05        OLDSURVEY         PIC  X(01).
           05        OLDFPRD           PIC  9(02).
           05        OLDTPRD           PIC  9(02).
           05        OLDPGM            PIC  X(03).
           05        OLDNAME           PIC  X(30).
           05        OLDKDIST          PIC  X(02).
           05        OLDKREQ           PIC  X(03).
           05        OLDKFY            PIC  X(02).
           05        OLDKSSN           PIC  X(10).
           05        OLDKJOB           PIC  X(02).
           05        OLDKSCHL          PIC  X(04).
           05        OLDKSURVEY        PIC  X(01).
           05        OLDKMOD           PIC  X(02).
073195     05        OLDKPGM           PIC  X(03).
           05        OLDMNSWK          PIC S9(08).
           05        OLDMODPRDS        PIC S9(03).
           05        OLDSRVPRDS        PIC S9(03).
           05        OLDSQFT           PIC S9(05).
           05        OLDRPT            PIC  X(01).
           05        OLDPRT            PIC  X(01).

       01            WSC.
           05        WSCSPEFLG         PIC  X(01).
073195     05        WSCFPRD           PIC  9(02).
073195     05        WSCTPRD           PIC  9(02).
073195     05        WSCNBRPRD         PIC  9(02).

073195 01            PRDTBL.
073195     05        PRDENTRY   OCCURS  99  TIMES INDEXED BY PRD1.
073195       10      PRD               PIC  X(01).

           COPY                        EWSCL               OF   CPYSRC.
           COPY                        EWFPG               OF   CPYSRC.
           COPY                        EWSWFL1             OF   CPYSRC.
           COPY                        EWSTH               OF   CPYSRC.
           COPY                        EWSTS               OF   CPYSRC.
           COPY                        EWSMP               OF   CPYSRC.

       01            OLDLN             PIC  X(133).

       01      HD1.
001        05  FILLER  PIC X(06) VALUE 'EW004 '.
           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(04) VALUE SPACES.
052        05  FILLER  PIC X(29) VALUE 'WORK FILE CONVERSION TO SATSY'.
081        05  FILLER  PIC X(18) VALUE SPACES.
099        05  HD1USER PIC X(09) VALUE SPACES.
108        05  HD1MM   PIC X(02) VALUE SPACES.
110        05  FILLER  PIC X(01) VALUE '/'.
111        05  HD1DD   PIC X(02) VALUE SPACES.
113        05  FILLER  PIC X(01) VALUE '/'.
114        05  HD1YY   PIC X(02) VALUE SPACES.
116        05  FILLER  PIC X(01) VALUE SPACES.
117        05  HD1HR   PIC X(02) VALUE SPACES.
119        05  FILLER  PIC X(01) VALUE ':'.
120        05  HD1MN   PIC X(02) VALUE SPACES.
122        05  FILLER  PIC X(07) VALUE '  PAGE-'.
129        05  HD1PG   PIC ZZZ9.

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

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

       LINKAGE       SECTION.

           COPY                        EWBJR               OF CPYSRC.

       PROCEDURE DIVISION USING BJR.
      ******************************************************************
       DECLARATIVES.
       000-ERROR     SECTION.
           USE AFTER STANDARD ERROR PROCEDURE ON CRD-CARD  CRF-DISK
                                                 SWF-DISK  STH-DISK
                                                 STS-DISK  SMP-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.
       005-LOOP.
           IF     (RETSWF              NOT  =   '00')                OR
                  (SWFDIST             NOT  =   OLDDIST)             OR
                  (SWFFY               NOT  =   OLDFY)               OR
                  (SWFSCHL             NOT  =   OLDSCHL)             OR
                  (SWFSSN              NOT  =   OLDSSN)              OR
                  (SWFSURVEY           NOT  =   OLDSURVEY)           OR
                  (SWFFPRD             NOT  =   OLDFPRD)             OR
073195            (SWFTPRD             NOT  =   OLDTPRD)             OR
                  (SWFPGM              NOT  =   OLDPGM)
             PERFORM  025-1TOT         THRU 025-EXIT
             IF   (RETSWF              NOT  =   '00')                OR
                  (SWFDIST             NOT  =   OLDDIST)             OR
                  (SWFFY               NOT  =   OLDFY)               OR
                  (SWFSCHL             NOT  =   OLDSCHL)             OR
                  (SWFSSN              NOT  =   OLDSSN)              OR
                  (SWFSURVEY           NOT  =   OLDSURVEY)           OR
073195            (SWFFPRD             NOT  =   OLDFPRD)             OR
073195            (SWFTPRD             NOT  =   OLDTPRD)
073195*           (SWFFPRD             NOT  =   OLDFPRD)
               PERFORM  035-2TOT       THRU 035-EXIT
               IF (RETSWF              NOT  =   '00')                OR
                  (SWFDIST             NOT  =   OLDDIST)             OR
                  (SWFFY               NOT  =   OLDFY)               OR
                  (SWFSCHL             NOT  =   OLDSCHL)             OR
                  (SWFSSN              NOT  =   OLDSSN)              OR
100808*           (SWFSURVEY           NOT  =   OLDSURVEY)
100808            (SWFSURVEY           NOT  =   OLDSURVEY)           OR
100808           ((SWFSURVEY                =   OLDSURVEY)        AND
100808            (SWFFPRD                  =   '99'))
                 PERFORM  045-3TOT     THRU 045-EXIT
                 IF (RETSWF            NOT  =   '00')
                   GO                  TO   499-EOJ
                 ELSE
                   PERFORM 040-3CHG    THRU 040-EXIT
               ELSE
                 PERFORM 030-2CHG      THRU 030-EXIT
             ELSE
               PERFORM 020-1CHG        THRU 020-EXIT.
           PERFORM 015-SELECT          THRU 015-EXIT
           PERFORM 010-READ            THRU 010-EXIT
           GO                          TO   005-LOOP.

      ******************************************************************
       010-READ.
           READ    SWF-DISK                 NEXT
           IF     (SWFDK               >    ENDKEY)                  OR
                  (RETSWF              NOT  =   '00')
             MOVE  '99'                TO   RETSWF
           ELSE
             MOVE  SWFD                TO   SWF.
       010-EXIT.
           EXIT.

      ******************************************************************
       015-SELECT.
           ADD     SWFCNT              TO   CTRCNT
           ADD     SWFMNSWK            TO   CTRMNSWK
           ADD     SWFFTE              TO   CTRFTE.
       015-EXIT.
           EXIT.

      ******************************************************************
       020-1CHG.
           MOVE    SWFPGM              TO   OLDPGM
           MOVE    ZEROS               TO   CTRCNT      CTRMNSWK
                                            CTRFTE.
       020-EXIT.
           EXIT.

       025-1TOT.
           MOVE    SPACES              TO   SRT

           MOVE    OLDDIST             TO   SRTKDIST
           MOVE    RQRREQ              TO   SRTKREQ
           MOVE    OLDFY               TO   SRTKFY
           MOVE    OLDSCHL             TO   SRTKSCHL
           MOVE    OLDSSN              TO   SRTKSSN
           IF      OLDSURVEY           =    '1'
             IF    OLDFPRD             NOT  =  99
               MOVE  RQRREG1           TO   SRTKJOB
             ELSE
               MOVE  RQRADLT1          TO   SRTKJOB.
           IF      OLDSURVEY           =    '2'
             IF    OLDFPRD             NOT  =  99
               MOVE  RQRREG2           TO   SRTKJOB
             ELSE
               MOVE  RQRADLT2          TO   SRTKJOB.
           IF      OLDSURVEY           =    '3'
             IF    OLDFPRD             NOT  =  99
               MOVE  RQRREG3           TO   SRTKJOB
             ELSE
               MOVE  RQRADLT3          TO   SRTKJOB.
           IF      OLDSURVEY           =    '4'
             IF    OLDFPRD             NOT  =  99
               MOVE  RQRREG4           TO   SRTKJOB
             ELSE
               MOVE  RQRADLT4          TO   SRTKJOB.
           MOVE    OLDFPRD             TO   SRTKMOD
           MOVE    OLDSURVEY           TO   SRTKSURVEY
           MOVE    OLDPGM              TO   SRTKPGM

           IF     (OLDPGM              <    RQRFROM)               OR
                  (OLDPGM              >    RQRTO)
             MOVE  'N'                 TO   WSCSPEFLG.

           MOVE    ZEROS               TO   SRTNBRPRD
           MOVE    CTRCNT              TO   SRTCNT
           MOVE    ZEROS               TO   SRTSQFT
073195*    MOVE    CTRMNSWK            TO   SRTMNSWK
073195*    ADD     CTRMNSWK            TO   CTRPRDMNSWK
           MOVE    CTRFTE              TO   SRTFTE
           MOVE    SPACES              TO   SRTNAME
           MOVE    RQRRPT              TO   SRTRPT
           MOVE    RQRPRT              TO   SRTPRT

073195*    RELEASE SRT.
112995*    IF     (OLDTPRD             NOT  =  88)                 AND
112995*           (OLDFPRD             NOT  =  99)
112995     IF     (OLDTPRD             >    OLDFPRD)
073195       COMPUTE  WSCNBRPRD        =    OLDTPRD - OLDFPRD + 1
073195     ELSE
112995*      ADD   +1                  TO   WSCNBRPRD.
112995       MOVE  +1                  TO   WSCNBRPRD.
073195     COMPUTE SRTMNSWK     =  CTRMNSWK / WSCNBRPRD
073195     COMPUTE CTRPRDMNSWK  =  CTRPRDMNSWK + SRTMNSWK
073195     MOVE    OLDFPRD             TO   WSCFPRD
073195     MOVE    OLDTPRD             TO   WSCTPRD.
073195 025-LOOP.
073195     RELEASE SRT
073195     MOVE    'Y'                 TO   PRD  (WSCFPRD)
073195     IF     (WSCFPRD             <    WSCTPRD)               AND
073195            (OLDTPRD             NOT  =  88)                 AND
073195            (OLDFPRD             NOT  =  99)
073195       ADD   +1                  TO   WSCFPRD
073195       MOVE  WSCFPRD             TO   SRTKMOD
073195       GO                        TO   025-LOOP.
       025-EXIT.
           EXIT.

       030-2CHG.
           MOVE    SWFFPRD             TO   OLDFPRD
           MOVE    ZERO                TO   CTRPRDMNSWK
           MOVE    SWFTPRD             TO   OLDTPRD
           MOVE    SWFSQFT             TO   OLDSQFT
           MOVE    SPACES              TO   WSCSPEFLG
           PERFORM 020-1CHG            THRU 020-EXIT.
       030-EXIT.
           EXIT.

       035-2TOT.
           MOVE    LOW-VALUES          TO   SRTKPGM
           IF      WSCSPEFLG           =    'N'
             MOVE  ZEROS               TO   SRTMNSWK
           ELSE
             MOVE  CTRPRDMNSWK         TO   SRTMNSWK.
073195*    IF     (OLDTPRD             NOT  =  88)                 AND
073195*           (OLDFPRD             NOT  =  99)
073195*      COMPUTE  SRTNBRPRD  =  OLDTPRD - OLDFPRD + 1
073195*    ELSE
073195*      MOVE  +1                  TO   SRTNBRPRD.
073195     MOVE    +1                  TO   SRTNBRPRD
           ADD     SRTNBRPRD           TO   CTRPRDS
           MOVE    OLDSQFT             TO   SRTSQFT
           MOVE    ZEROS               TO   SRTFTE        SRTCNT
           MOVE    SPACES              TO   SRTNAME
073195*    RELEASE SRT.
073195     MOVE    OLDFPRD             TO   WSCFPRD
073195     MOVE    OLDTPRD             TO   WSCTPRD.
073195 035-LOOP.
073195     MOVE    WSCFPRD             TO   SRTKMOD
073195     RELEASE SRT
073195     MOVE    'Y'                 TO   PRD  (WSCFPRD)
073195     IF     (WSCFPRD             <    WSCTPRD)               AND
073195            (OLDTPRD             NOT  =  88)                 AND
073195            (OLDFPRD             NOT  =  99)
073195       ADD   +1                  TO   WSCFPRD
073195       GO                        TO   035-LOOP.
       035-EXIT.
           EXIT.

       040-3CHG.
           MOVE    SWFDIST             TO   OLDDIST
           MOVE    SWFFY               TO   OLDFY
           MOVE    SWFSCHL             TO   OLDSCHL
           MOVE    SWFSSN              TO   OLDSSN
           MOVE    SWFSURVEY           TO   OLDSURVEY
           MOVE    ZERO                TO   CTRPRDS
073195     MOVE    SPACES              TO   PRDTBL
           MOVE    SWFNAME             TO   OLDNAME
           PERFORM 030-2CHG            THRU 030-EXIT.
       040-EXIT.
           EXIT.

       045-3TOT.
           MOVE    LOW-VALUES          TO   SRTKMOD       SRTKPGM
073195*    MOVE    CTRPRDS             TO   SRTNBRPRD
073195     MOVE    ZEROS               TO   SRTNBRPRD
073195     MOVE    +1                  TO   WSCFPRD.
073195 045-LOOP.
073195     IF      PRD  (WSCFPRD)      =    'Y'
073195       ADD   +1                  TO   SRTNBRPRD.
073195     IF      WSCFPRD             <    99
073195       ADD   +1                  TO   WSCFPRD
073195       GO                        TO   045-LOOP.
           MOVE    ZEROS               TO   SRTCNT        SRTSQFT
                                            SRTMNSWK      SRTFTE
           MOVE    OLDNAME             TO   SRTNAME
           RELEASE SRT.
       045-EXIT.
           EXIT.

      ******************************************************************
       490-HOUSEKEEPING.
           OPEN    INPUT                    CRD-CARD      CRF-DISK
                                            SWF-DISK
                   OUTPUT                   PR1-PRNT
           MOVE    RETCRF              TO   RETCRFOLD
           MOVE    SPACES              TO   LN1
           MOVE    '1'                 TO   CTLCHAR
           SET     RQH1                TO   +1
           MOVE    HIGH-VALUES         TO   RQR           RQH.
           IF      BJR                 >    SPACES
             PERFORM 495-LOAD          THRU 495-EXIT
             GO                        TO   490-TEST.
           MOVE    1                   TO   CTRCRD.
       490-LOAD.
           READ    CRD-CARD            AT   END
             GO                        TO   490-TEST.
           IF      CRDREQ              NOT  NUMERIC
             MOVE    CRD               TO   LNMVALUE2
             PERFORM 520-PRINT         THRU 520-EXIT
             GO                        TO   490-LOAD.
           MOVE    SPACES              TO   ERR
           IF      CRDID               =    'SL'
             GO                        TO   490-REQ
           ELSE
             IF     (CRDID             =    'H1')                    OR
                    (CRDID             =    'H2')
               GO                      TO   490-HEAD
             ELSE
               GO                      TO   490-LOAD.

       490-REQ.
           IF      CTRCRD              >    1
             MOVE  'ERROR. ONLY 1 REQ.' TO  LNMMSG
             MOVE  CRD                 TO   LNMVALUE2
             PERFORM  520-PRINT        THRU 520-EXIT
             GO                        TO   490-LOAD.
           IF     (CRDPRT              NOT  =   'U')               AND
                  (CRDPRT              NOT  =   'T')               AND
                  (CRDPRT              NOT  =   'B')               AND
                  (CRDPRT              NOT  =   'N')
             MOVE  ALL '-'             TO   ERRPRT.
           IF     (CRDRPT              NOT  =   'A')               AND
                  (CRDRPT              NOT  =   'B')
             MOVE  ALL '-'             TO   ERRRPT.
           IF     (CRDDIST             =    SPACES)
             MOVE  ALL '-'             TO   ERRDIST.
           IF     (CRDFY               NOT  NUMERIC)
             MOVE  ALL '-'             TO   ERRFY.
           IF     (CRDREG1             NOT  NUMERIC)               OR
                  (CRDREG1             <    1)
             MOVE  ALL '-'             TO   ERRREG1.
           IF     (CRDREG2             NOT  NUMERIC)               OR
                  (CRDREG2             <    1)
             MOVE  ALL '-'             TO   ERRREG2.
           IF     (CRDREG3             NOT  NUMERIC)               OR
                  (CRDREG3             <    1)
             MOVE  ALL '-'             TO   ERRREG3.
           IF     (CRDREG4             NOT  NUMERIC)               OR
                  (CRDREG4             <    1)
             MOVE  ALL '-'             TO   ERRREG4.
040599*    MOVE    CRDDIST             TO   FPGKEY
040599*    MOVE    CRDFY               TO   FPGFY
040599*    MOVE    'FPG'               TO   FPGPREF
040599*    MOVE    CRDFROM             TO   FPGFPG
040599*    MOVE    FPGKEY              TO   CRFDK
040599*    READ    CRF-DISK
040599*    IF      RETCRF              NOT  =   '00'
040599*      MOVE  ALL '-'             TO   ERRFROM.
040599*    MOVE    CRDTO               TO   FPGFPG
040599*    MOVE    FPGKEY              TO   CRFDK
040599*    READ    CRF-DISK
040599*    IF      RETCRF              NOT  =   '00'
040599*      MOVE  ALL '-'             TO   ERRTO.
040599*    IF      CRDTO               <    CRDFROM
040599*      MOVE  ALL '-'             TO   ERRFROM     ERRTO.
           IF     (CRDADLT1            NOT  NUMERIC)               OR
                  (CRDADLT1            <    1)
             MOVE  ALL '-'             TO   ERRADLT1.
           IF     (CRDADLT2            NOT  NUMERIC)               OR
                  (CRDADLT2            <    1)
             MOVE  ALL '-'             TO   ERRADLT2.
           IF     (CRDADLT3            NOT  NUMERIC)               OR
                  (CRDADLT3            <    1)
             MOVE  ALL '-'             TO   ERRADLT3.
           IF     (CRDADLT4            NOT  NUMERIC)               OR
                  (CRDADLT4            <    1)
             MOVE  ALL '-'             TO   ERRADLT4.
           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    CRDREG1             TO   RQRREG1
           MOVE    CRDREG2             TO   RQRREG2
           MOVE    CRDREG3             TO   RQRREG3
           MOVE    CRDREG4             TO   RQRREG4
040699*    MOVE    CRDFROM             TO   RQRFROM
040699*    MOVE    CRDTO               TO   RQRTO
040699     MOVE    '340'               TO   RQRFROM
040699     MOVE    '450'               TO   RQRTO
           MOVE    CRDADLT1            TO   RQRADLT1
           MOVE    CRDADLT2            TO   RQRADLT2
           MOVE    CRDADLT3            TO   RQRADLT3
           MOVE    CRDADLT4            TO   RQRADLT4
           MOVE    CRDRPT              TO   RQRRPT
           MOVE    SPACES              TO   SWFKEY
           MOVE    CRDDIST             TO   SWFDIST
           MOVE    CRDFY               TO   SWFFY
           IF     (SWFKEY              <    STRKEY)
             MOVE  SWFKEY              TO   STRKEY.
           INSPECT SWFKEY    REPLACING ALL  ' '         BY HIGH-VALUES
           IF     (SWFKEY              >    ENDKEY)
             MOVE  SWFKEY              TO   ENDKEY.
           ADD     +1                  TO   CTRCRD
           GO                          TO   490-LOAD.

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

       490-TEST.
           MOVE    RETCRFOLD           TO   RETCRF
           IF      RQRRPT              =    'B'
             OPEN  I-O                      STH-DISK      STS-DISK
                                            SMP-DISK
             MOVE  RETSTH              TO   RETSTHOLD
             MOVE  RETSTS              TO   RETSTSOLD
             MOVE  RETSMP              TO   RETSMPOLD
             PERFORM 493-SATSY-PURGE   THRU 493-EXIT
             MOVE  RETSTHOLD           TO   RETSTH
             MOVE  RETSTSOLD           TO   RETSTS
             MOVE  RETSMPOLD           TO   RETSMP
           ELSE
             OPEN  INPUT                    STH-DISK      STS-DISK
                                            SMP-DISK.
           IF      RQRENTRY            =    HIGH-VALUES
             MOVE    'EW004 NO REQUESTS *'   TO   LNM
             PERFORM 520-PRINT         THRU 520-EXIT.
           IF      RETCRF              NOT  =   '00'
             MOVE    'CRF OPEN ERROR'  TO   LNMMSG
             MOVE    RETCRF            TO   LNMVALUE1
             PERFORM 520-PRINT         THRU 520-EXIT.
           IF      RETSWF              NOT  =   '00'
             MOVE    'SWF OPEN ERROR'  TO   LNMMSG
             MOVE    RETSWF            TO   LNMVALUE1
             PERFORM 520-PRINT         THRU 520-EXIT.
           IF      RETSTH              NOT  =   '00'
             MOVE    'STH OPEN ERROR'  TO   LNMMSG
             MOVE    RETSTH            TO   LNMVALUE1
             PERFORM 520-PRINT         THRU 520-EXIT.
           IF      RETSTS              NOT  =   '00'
             MOVE    'STS OPEN ERROR'  TO   LNMMSG
             MOVE    RETSTS            TO   LNMVALUE1
             PERFORM 520-PRINT         THRU 520-EXIT.
           IF      RETSMP              NOT  =   '00'
             MOVE    'SMP OPEN ERROR'  TO   LNMMSG
             MOVE    RETSMP            TO   LNMVALUE1
             PERFORM 520-PRINT         THRU 520-EXIT.
           IF     (RETCRF              NOT  =   '00')                OR
                  (RETSWF              NOT  =   '00')                OR
                  (RETSTH              NOT  =   '00')                OR
                  (RETSTS              NOT  =   '00')                OR
                  (RETSMP              NOT  =   '00')                OR
                  (RQRENTRY            =    HIGH-VALUES)
             GO                        TO   499-EOJ.
           MOVE    STRKEY              TO   SWFDK
           START   SWF-DISK        KEY >    SWFDK
           IF      RETSWF              =    '00'
             PERFORM 010-READ          THRU 010-EXIT.
           PERFORM 040-3CHG            THRU 040-EXIT.
       490-EXIT.
           EXIT.

      ******************************************************************
       493-SATSY-PURGE.
           MOVE    RQRDIST             TO   STHKEY
           MOVE    RQRFY               TO   STHFY
           MOVE    STHKEY              TO   STHDK
           START   STH-DISK        KEY >=   STHDK
           IF      RETSTH              NOT  =  '00'
             GO                        TO   493-CONT1.
       493-LOOP.
           READ    STH-DISK            NEXT
           IF      RETSTH              =    '00'
             MOVE  STHD                TO   STH
             IF    STHDIST             =    RQRDIST          AND
                   STHFY               =    RQRFY
               DELETE STH-DISK
               GO                      TO   493-LOOP.
       493-CONT1.
           MOVE    RQRDIST             TO   STSKEY
           MOVE    RQRFY               TO   STSFY
           MOVE    STSKEY              TO   STSDK
           START   STS-DISK        KEY >=   STSDK
           IF      RETSTS              NOT  =  '00'
             GO                        TO   493-CONT2.
       493-LOOP2.
           READ    STS-DISK            NEXT
           IF      RETSTS              =    '00'
             MOVE  STSD                TO   STS
             IF    STSDIST             =    RQRDIST          AND
                   STSFY               =    RQRFY
               DELETE STS-DISK
               GO                      TO   493-LOOP2.
       493-CONT2.
           MOVE    RQRDIST             TO   SMPKEY
           MOVE    RQRFY               TO   SMPFY
           MOVE    SMPKEY              TO   SMPDK
           START   SMP-DISK        KEY >=   SMPDK
           IF      RETSMP              NOT  =  '00'
             GO                        TO   493-EXIT.
       493-LOOP3.
           READ    SMP-DISK            NEXT
           IF      RETSMP              =    '00'
             MOVE  SMPD                TO   SMP
             IF    SMPDIST             =    RQRDIST          AND
                   SMPFY               =    RQRFY
               DELETE SMP-DISK
               GO                      TO   493-LOOP3.
       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     (CRDRPT              NOT  =   'A')              AND
                  (CRDRPT              NOT  =   'B')
             MOVE  ALL '-'             TO   ERRRPT.
           IF     (CRDDIST             =    SPACES)
             MOVE  ALL '-'             TO   ERRDIST.
           IF     (CRDFY               NOT  NUMERIC)
             MOVE  ALL '-'             TO   ERRFY.
           IF     (CRDREG1             NOT  NUMERIC)               OR
                  (CRDREG1             <    1)
             MOVE  ALL '-'             TO   ERRREG1.
           IF     (CRDREG2             NOT  NUMERIC)               OR
                  (CRDREG2             <    1)
             MOVE  ALL '-'             TO   ERRREG2.
           IF     (CRDREG3             NOT  NUMERIC)               OR
                  (CRDREG3             <    1)
             MOVE  ALL '-'             TO   ERRREG3.
           IF     (CRDREG4             NOT  NUMERIC)               OR
                  (CRDREG4             <    1)
             MOVE  ALL '-'             TO   ERRREG4.
040599*    MOVE    CRDDIST             TO   FPGKEY
040599*    MOVE    CRDFY               TO   FPGFY
040599*    MOVE    'FPG'               TO   FPGPREF
040599*    MOVE    CRDFROM             TO   FPGFPG
040599*    MOVE    FPGKEY              TO   CRFDK
040599*    READ    CRF-DISK
040599*    IF      RETCRF              NOT  =   '00'
040599*      MOVE  ALL '-'             TO   ERRFROM.
040599*    MOVE    CRDTO               TO   FPGFPG
040599*    MOVE    FPGKEY              TO   CRFDK
040599*    READ    CRF-DISK
040599*    IF      RETCRF              NOT  =   '00'
040599*      MOVE  ALL '-'             TO   ERRTO.
040599*    IF      CRDTO               <    CRDFROM
040599*      MOVE  ALL '-'             TO   ERRFROM     ERRTO.
           IF     (CRDADLT1            NOT  NUMERIC)               OR
                  (CRDADLT1            <    1)
             MOVE  ALL '-'             TO   ERRADLT1.
           IF     (CRDADLT2            NOT  NUMERIC)               OR
                  (CRDADLT2            <    1)
             MOVE  ALL '-'             TO   ERRADLT2.
           IF     (CRDADLT3            NOT  NUMERIC)               OR
                  (CRDADLT3            <    1)
             MOVE  ALL '-'             TO   ERRADLT3.
           IF     (CRDADLT4            NOT  NUMERIC)               OR
                  (CRDADLT4            <    1)
             MOVE  ALL '-'             TO   ERRADLT4.
           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    CRDREG1             TO   RQRREG1
           MOVE    CRDREG2             TO   RQRREG2
           MOVE    CRDREG3             TO   RQRREG3
           MOVE    CRDREG4             TO   RQRREG4
040699*    MOVE    CRDFROM             TO   RQRFROM
040699*    MOVE    CRDTO               TO   RQRTO
040699     MOVE    '340'               TO   RQRFROM
040699     MOVE    '450'               TO   RQRTO
071102*    MOVE    CRDTO               TO   RQRTO
           MOVE    CRDADLT1            TO   RQRADLT1
           MOVE    CRDADLT2            TO   RQRADLT2
           MOVE    CRDADLT3            TO   RQRADLT3
           MOVE    CRDADLT4            TO   RQRADLT4
           MOVE    CRDRPT              TO   RQRRPT
           MOVE    SPACES              TO   SWFKEY
           MOVE    CRDDIST             TO   SWFDIST
           MOVE    CRDFY               TO   SWFFY
           IF     (SWFKEY              <    STRKEY)
             MOVE  SWFKEY              TO   STRKEY.
           INSPECT SWFKEY    REPLACING ALL  ' '         BY HIGH-VALUES
           IF     (SWFKEY              >    ENDKEY)
             MOVE  SWFKEY              TO   ENDKEY.

           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.
           EXIT.

      ******************************************************************
       500-OUTPUT SECTION.
           PERFORM 990-HOUSEKEEPING    THRU 990-EXIT.
       505-LOOP.
073195     IF     (SRTKDIST            NOT  =   OLDKDIST)            OR
073195            (SRTKREQ             NOT  =   OLDKREQ)             OR
073195            (SRTKFY              NOT  =   OLDKFY)              OR
073195            (SRTKSSN             NOT  =   OLDKSSN)             OR
073195            (SRTKJOB             NOT  =   OLDKJOB)             OR
073195            (SRTKSCHL            NOT  =   OLDKSCHL)            OR
073195            (SRTKSURVEY          NOT  =   OLDKSURVEY)          OR
073195            (SRTKMOD             NOT  =   OLDKMOD)             OR
073195            (SRTKPGM             NOT  =   OLDKPGM)
073195       PERFORM 605-0TOT          THRU 605-EXIT
           IF     (SRTKDIST            NOT  =   OLDKDIST)            OR
                  (SRTKREQ             NOT  =   OLDKREQ)             OR
                  (SRTKFY              NOT  =   OLDKFY)              OR
                  (SRTKSSN             NOT  =   OLDKSSN)             OR
                  (SRTKJOB             NOT  =   OLDKJOB)             OR
                  (SRTKSCHL            NOT  =   OLDKSCHL)            OR
                  (SRTKSURVEY          NOT  =   OLDKSURVEY)          OR
                  (SRTKMOD             NOT  =   OLDKMOD)
             PERFORM 615-1TOT          THRU 615-EXIT
             IF   (SRTKDIST            NOT  =   OLDKDIST)            OR
                  (SRTKREQ             NOT  =   OLDKREQ)             OR
                  (SRTKFY              NOT  =   OLDKFY)              OR
                  (SRTKSSN             NOT  =   OLDKSSN)             OR
                  (SRTKJOB             NOT  =   OLDKJOB)             OR
                  (SRTKSCHL            NOT  =   OLDKSCHL)            OR
                  (SRTKSURVEY          NOT  =   OLDKSURVEY)
               PERFORM 625-2TOT        THRU 625-EXIT
               IF (SRTKDIST            NOT  =   OLDKDIST)            OR
                  (SRTKREQ             NOT  =   OLDKREQ)             OR
                  (SRTKFY              NOT  =   OLDKFY)              OR
                  (SRTKSSN             NOT  =   OLDKSSN)             OR
                  (SRTKJOB             NOT  =   OLDKJOB)             OR
                  (SRTKSCHL            NOT  =   OLDKSCHL)
                 PERFORM 635-3TOT      THRU 635-EXIT
                 IF (SRTKDIST          NOT  =   OLDKDIST)            OR
                    (SRTKREQ           NOT  =   OLDKREQ)             OR
                    (SRTKFY            NOT  =   OLDKFY)              OR
                    (SRTKSSN           NOT  =   OLDKSSN)             OR
                    (SRTKJOB           NOT  =   OLDKJOB)
                   PERFORM 645-4TOT    THRU 645-EXIT
                   IF (SRTKDIST        NOT  =   OLDKDIST)            OR
                      (SRTKREQ         NOT  =   OLDKREQ)             OR
                      (SRTKFY          NOT  =   OLDKFY)              OR
                      (SRTKSSN         NOT  =   OLDKSSN)
                     PERFORM 655-5TOT  THRU 655-EXIT
                     IF (SRTKDIST      NOT  =   OLDKDIST)            OR
                        (SRTKREQ       NOT  =   OLDKREQ)             OR
                        (SRTKFY        NOT  =   OLDKFY)
                       PERFORM 665-6TOT THRU 665-EXIT
                       IF     (SRTKEY  =    HIGH-VALUES)
                         GO            TO   999-EOJ
                       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
073195*        PERFORM 610-1CHG        THRU 610-EXIT.
073195         PERFORM 610-1CHG        THRU 610-EXIT
073195       ELSE
073195         PERFORM 600-0CHG        THRU 600-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.
           IF      SRTKPGM             NOT  >  SPACES
073195       IF    SRTKMOD             >    SPACES
073195         ADD SRTMNSWK            TO   OLDMNSWK
073195         GO                      TO   515-EXIT
073195       ELSE
             GO                        TO   515-EXIT.
073195     ADD     SRTMNSWK            TO   CTRPGMMNSWK
073195     ADD     SRTCNT              TO   CTRPGMCNT
073195     ADD     SRTFTE              TO   CTRPGMFTE.
073195*    MOVE    SRTKDIST            TO   SMPKEY
073195*    MOVE    SRTKFY              TO   SMPFY
073195*    MOVE    SRTKSSN             TO   SMPSSN
073195*    MOVE    SRTKJOB             TO   SMPJOB
073195*    MOVE    SRTKSCHL            TO   SMPSCHL
073195*    MOVE    SRTKSURVEY          TO   SMPSURVEY
073195*    MOVE    SRTKMOD             TO   SMPMOD
073195*    MOVE    SRTKPGM             TO   SMPPGM
073195*    IF      OLDMNSWK            NOT  =  0
073195*      MOVE  ZEROS               TO   SMPSTDT
073195*      COMPUTE  SMPPCT  ROUNDED  =   (SRTMNSWK / OLDMNSWK)
073195*      ADD   SMPPCT              TO   CTRPSTDT
073195*      IF    SMPPCT              =    1
073195*        MOVE  ZEROS             TO   SMPPCT
073195*        MOVE  SRTCNT            TO   SMPSTDT
073195*      END-IF
073195*    ELSE
073195*      MOVE  SRTCNT              TO   SMPSTDT
073195*      MOVE  ZEROS               TO   SMPPCT
073195*      MOVE  1                   TO   CTRPSTDT.
073195*    IF      SRTRPT              =    'B'
073195*      MOVE  SMP                 TO   SMPD
073195*      WRITE SMPD
073195*      IF    RETSMP              NOT  =  '00'
073195*        MOVE  'SMP REWRITE ERROR' TO   LNMMSG
073195*        MOVE  RETSMP            TO   LNMVALUE1
073195*        MOVE  SMPDK             TO   LNMVALUE2
073195*        PERFORM 520-PRINT       THRU 520-EXIT
073195*      ELSE
073195*        ADD +1                  TO   CTRSMP
073195*    ELSE
073195*      ADD   +1                  TO   CTRSMP.
073195*    ADD     SRTFTE              TO   CTRSCHLFTE.
       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    OLDLN               TO   LN1
           MOVE    '0'                 TO   CTLCHAR.
       525-EXIT.
           EXIT.

      ******************************************************************
073195 600-0CHG.
073195     MOVE    SRTKPGM             TO   OLDKPGM
073195     MOVE    ZEROS               TO   CTRPGMMNSWK    CTRPGMCNT
073195                                      CTRPGMFTE.
073195 600-EXIT.
073195     EXIT.
073195
073195 605-0TOT.
073195     IF     (OLDKPGM             NOT  >  SPACES)              OR
073195            (OLDKMOD             NOT  >  SPACES)
073195       GO                        TO   605-EXIT.
073195     MOVE    OLDKDIST            TO   SMPKEY
073195     MOVE    OLDKFY              TO   SMPFY
073195     MOVE    OLDKSSN             TO   SMPSSN
073195     MOVE    OLDKJOB             TO   SMPJOB
073195     MOVE    OLDKSCHL            TO   SMPSCHL
073195     MOVE    OLDKSURVEY          TO   SMPSURVEY
073195     MOVE    OLDKMOD             TO   SMPMOD
073195     MOVE    OLDKPGM             TO   SMPPGM
073195     IF      OLDMNSWK            NOT  =  0
073195       MOVE  ZEROS               TO   SMPSTDT
073195       COMPUTE  SMPPCT  ROUNDED  =   (CTRPGMMNSWK / OLDMNSWK)
073195       ADD   SMPPCT              TO   CTRPSTDT
073195       IF    SMPPCT              =    1
073195         MOVE  ZEROS             TO   SMPPCT
073195         MOVE  CTRPGMCNT         TO   SMPSTDT
073195       END-IF
073195     ELSE
073195       MOVE  CTRPGMCNT           TO   SMPSTDT
073195       MOVE  ZEROS               TO   SMPPCT
073195       MOVE  1                   TO   CTRPSTDT.
073195     IF      OLDRPT              =    'B'
073195       MOVE  SMP                 TO   SMPD
073195       WRITE SMPD
073195       IF    RETSMP              NOT  =  '00'
073195         MOVE  'SMP WRITE ERROR' TO   LNMMSG
073195         MOVE  RETSMP            TO   LNMVALUE1
073195         MOVE  SMPDK             TO   LNMVALUE2
073195         PERFORM 520-PRINT       THRU 520-EXIT
073195       ELSE
073195         ADD +1                  TO   CTRSMP
073195     ELSE
073195       ADD   +1                  TO   CTRSMP.
073195     ADD     CTRPGMFTE           TO   CTRSCHLFTE.
073195 605-EXIT.
073195     EXIT.

       610-1CHG.
           MOVE    SRTKMOD             TO   OLDKMOD
           MOVE    ZEROS               TO   CTRSMP    CTRPSTDT
           MOVE    SRTNBRPRD           TO   OLDMODPRDS
           MOVE    SRTSQFT             TO   OLDSQFT
073195*    MOVE    SRTMNSWK            TO   OLDMNSWK.
073195     MOVE    ZEROS               TO   OLDMNSWK
101495     IF      SRTNAME             >    SPACES
101495        MOVE SRTNAME             TO   OLDNAME.
073195     PERFORM 600-0CHG            THRU 600-EXIT.
       610-EXIT.
           EXIT.

       615-1TOT.
           IF      OLDKMOD             NOT  > SPACES
             GO                        TO   615-EXIT.
           MOVE    OLDKDIST            TO   STSKEY
           MOVE    OLDKFY              TO   STSFY
           MOVE    OLDKSSN             TO   STSSSN
           MOVE    OLDKJOB             TO   STSJOB
           MOVE    OLDKSCHL            TO   STSSCHL
           MOVE    OLDKSURVEY          TO   STSSURVEY
           MOVE    OLDKMOD             TO   STSMOD
           COMPUTE STSPMOD  ROUNDED    =   (OLDMODPRDS / OLDSRVPRDS)
           ADD     STSPMOD             TO   CTRPMOD
           MOVE    OLDSQFT             TO   STSSPACE
           ADD     CTRSMP              TO   CTRREQSMP
           IF      OLDRPT              =    'B'
             MOVE  STS                 TO   STSD
             WRITE STSD
             IF    RETSTS              NOT  =  '00'
               MOVE  'STS WRITE ERROR' TO   LNMMSG
               MOVE  RETSTS            TO   LNMVALUE1
               MOVE  STSDK             TO   LNMVALUE2
               PERFORM 520-PRINT       THRU 520-EXIT
             ELSE
               ADD +1                  TO   CTRSTS
           ELSE
             ADD   +1                  TO   CTRSTS.
           COMPUTE CTRPSTDT            =    1 - CTRPSTDT
           IF     (OLDRPT              =    'B')                   AND
                  (CTRPSTDT            NOT  =  0)                  AND
                  (CTRSMP              >    ZERO)
             READ  SMP-DISK
             MOVE  SMPD                TO   SMP
             ADD   CTRPSTDT            TO   SMPPCT
             MOVE  SMP                 TO   SMPD
             REWRITE SMPD
             IF    RETSMP              NOT  =  '00'
               MOVE  'SMP REWRITE ERROR' TO   LNMMSG
               MOVE  RETSMP            TO   LNMVALUE1
               MOVE  SMPDK             TO   LNMVALUE2
               PERFORM 520-PRINT       THRU 520-EXIT.
       615-EXIT.
           EXIT.

       620-2CHG.
           MOVE    SRTKSURVEY          TO   OLDKSURVEY
           MOVE    ZEROS               TO   CTRPMOD
           MOVE    SRTNBRPRD           TO   OLDSRVPRDS
           PERFORM 610-1CHG            THRU 610-EXIT.
       620-EXIT.
           EXIT.

       625-2TOT.
           COMPUTE CTRPMOD             =    1 - CTRPMOD
           IF     (OLDRPT              =    'B')                   AND
                  (CTRPMOD             NOT  =  0)
             READ  STS-DISK
             MOVE  STSD                TO   STS
             ADD   CTRPMOD             TO   STSPMOD
             MOVE  STS                 TO   STSD
             REWRITE STSD
             IF    RETSTS              NOT  =  '00'
               MOVE  'STS REWRITE ERROR' TO   LNMMSG
               MOVE  RETSTS            TO   LNMVALUE1
               MOVE  STSDK             TO   LNMVALUE2
               PERFORM 520-PRINT       THRU 520-EXIT.
       625-EXIT.
           EXIT.

       630-3CHG.
           MOVE    SRTKSCHL            TO   OLDKSCHL
           MOVE    ZEROS               TO   CTRSTS      CTRSCHLFTE
           PERFORM 620-2CHG            THRU 620-EXIT.
       630-EXIT.
           EXIT.

       635-3TOT.
           IF      TBL1                >    200
             MOVE  'SCHL TABLE OVERLOAD' TO  LNMMSG
             PERFORM 520-PRINT         THRU 520-EXIT
             GO                        TO   635-EXIT.
           MOVE    OLDKSCHL            TO   TBLSCHL  (TBL1)
           MOVE    CTRSTS              TO   TBLSTS   (TBL1)
           ADD     CTRSTS              TO   CTRREQSTS
           MOVE    CTRSCHLFTE          TO   TBLFTE   (TBL1)
           ADD     CTRSCHLFTE          TO   CTRJOBFTE
           SET     TBL1                UP   BY  +1.
       635-EXIT.
           EXIT.

       640-4CHG.
           MOVE    SRTKJOB             TO   OLDKJOB
           MOVE    ZEROS               TO   CTRJOBFTE
           SET     TBL1                TO   +1
           MOVE    HIGH-VALUES         TO   TBL
           PERFORM 630-3CHG            THRU 630-EXIT.
       640-EXIT.
           EXIT.

       645-4TOT.
           MOVE    ZEROS               TO   CTRPSCHL
           SET     TBL1                TO   +1.
       645-LOOP.
           IF      TBLSCHL  (TBL1)     =    HIGH-VALUES
             GO                        TO   645-EXIT.
           INITIALIZE STH
           MOVE    OLDKDIST            TO   STHDIST
           MOVE    OLDKFY              TO   STHFY
           MOVE    OLDKSSN             TO   STHSSN
           MOVE    OLDKJOB             TO   STHJOB
           MOVE    TBLSCHL  (TBL1)     TO   STHSCHL
           IF      CTRJOBFTE           NOT  =  ZEROS
             COMPUTE STHPSCHL  ROUNDED =    TBLFTE (TBL1) / CTRJOBFTE
           ELSE
             MOVE  ZEROS               TO   STHPSCHL.
           ADD     STHPSCHL            TO   CTRPSCHL
           IF     (TBLSCHL  (TBL1 + 1) =    HIGH-VALUES)           AND
                  (CTRPSCHL            NOT  =  1)
             COMPUTE  STHPSCHL         =    STHPSCHL + (1 - CTRPSCHL).
           MOVE    OLDNAME             TO   STHNAME
           IF      OLDRPT              =    'B'
             MOVE  STH                 TO   STHD
             WRITE STHD
             IF    RETSTH              NOT  =  '00'
               MOVE  'STH WRITE ERROR' TO   LNMMSG
               MOVE  RETSTH            TO   LNMVALUE1
               MOVE  STHDK             TO   LNMVALUE2
               PERFORM 520-PRINT       THRU 520-EXIT
             ELSE
               ADD +1                  TO   CTRREQSTH
           ELSE
             ADD   +1                  TO   CTRREQSTH.
           SET     TBL1                UP   BY  +1
           GO                          TO   645-LOOP.
       645-EXIT.
           EXIT.

       650-5CHG.
           MOVE    SRTKSSN             TO   OLDKSSN
101495*    MOVE    SRTNAME             TO   OLDNAME
101495     MOVE    SPACES              TO   OLDNAME
           PERFORM 640-4CHG            THRU 640-EXIT.
       650-EXIT.
           EXIT.

       655-5TOT.
       655-EXIT.
           EXIT.

       660-6CHG.
           MOVE    SRTKREQ             TO   OLDKREQ
           MOVE    SRTKDIST            TO   OLDKDIST
           MOVE    SRTKFY              TO   OLDKFY
           MOVE    ZEROS               TO   CTRLN       CTRPG
           MOVE    ZEROS               TO   CTRREQSMP   CTRREQSTS
                                            CTRREQSTH
           MOVE    SRTPRT              TO   OLDPRT
           MOVE    SRTRPT              TO   OLDRPT
           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.
       660-REQ.
           IF      HD1B         (HD11) =    SPACES
             SET   HD11                DOWN BY  +1
             GO                        TO   660-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.
       660-HEAD.
           IF      RQHREQ       (RQH1) NOT  =   HIGH-VALUES
             IF      RQHREQ     (RQH1) NOT  =   SRTKREQ
               SET   RQH1              UP   BY  +1
               GO                      TO   660-HEAD
             ELSE
               IF      RQHID    (RQH1) =    'H1'
                 MOVE  RQHHEAD  (RQH1) TO   HD2HEAD
                 MOVE  RQHUSER  (RQH1) TO   HD1USER
                 SET   RQH1            UP   BY  +1
                 GO                    TO   660-HEAD
               ELSE
                 IF      RQHID  (RQH1) =    'H2'
                   MOVE  RQHHEAD (RQH1) TO  HD3HEAD
                   SET   RQH1          UP   BY  +1
                   GO                  TO   660-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 525-HEADS           THRU 525-EXIT
           PERFORM 650-5CHG            THRU 650-EXIT.
       660-EXIT.
           EXIT.

       665-6TOT.
           MOVE    '0'                 TO   CTLCHAR
           MOVE    'REQUEST'           TO   LN1MSG1
           MOVE    OLDKREQ             TO   LN1REQ
           MOVE    'TOTAL'             TO   LN1MSG2
           MOVE    CTRREQSMP           TO   LN1CNT
           MOVE    'SMP RECORDS WRITTEN' TO LN1MSG3
           PERFORM 520-PRINT           THRU 520-EXIT
           MOVE    'TOTAL'             TO   LN1MSG2
           MOVE    CTRREQSTS           TO   LN1CNT
           MOVE    'STS RECORDS WRITTEN' TO LN1MSG3
           PERFORM 520-PRINT           THRU 520-EXIT
           MOVE    'TOTAL'             TO   LN1MSG2
           MOVE    CTRREQSTH           TO   LN1CNT
           MOVE    'STH RECORDS WRITTEN' TO LN1MSG3
           PERFORM 520-PRINT           THRU 520-EXIT.
       665-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    'EW004 NO DATA TO PROCESS'  TO  LNM
             PERFORM 520-PRINT         THRU 520-EXIT
             GO                        TO   999-EOJ.
           PERFORM 660-6CHG            THRU 660-EXIT.
       990-EXIT.
           EXIT.

      ******************************************************************
       999-EOJ.
           CLOSE                            CRD-CARD      CRF-DISK
                                            SWF-DISK      PR1-PRNT
                                            STH-DISK      STS-DISK
                                            SMP-DISK.
       999-EXIT.
           EXIT.
