       IDENTIFICATION DIVISION.                                         EW000010
                                                                        EW000020
       PROGRAM-ID.      EW004.                                          EW000030
       AUTHOR.          DOE.                                            EW000040
      ***************************************************************** EW000050
      *                  WORK FILE CONVERSION TO SATSY                * EW000060
      ***************************************************************** EW000070
      * DATE CREATED:  04/06/95                                       * EW000080
      ***************************************************************** EW000090
      * CALL #  - MMDDYY - PURPOSE                                    * EW000100
      * 9507137 - 080495 - CHANGE THE WAY MULTIPLE PERIOD CLASSES ARE * EW000110
      *                    PROCESSED                                  * EW000120
      * 9510025 - 101695 - IF A NAME IS ASSIGNED TO ANY MOD RECORD    * EW000130
      *                    WITHIN A JOB, THEN USE IT                  * EW000140
      * 9511012 - 112995 - ADDED FAILSAFE EDITS TO PREVENT ABEND.     * EW000150
      * 05995  041096 ABEND ON DIVIDE BY ZERO (OLDSRVPRDS)        JJD * EW000160
      * FIX9902 -040599- REMOVE % PGM FROM/TO FIELDS                  * EW000190
      *          040699- "PRE-LOAD" % PGM WITH 340 AND 450            * EW000200
      * 2009003 - 100808 - FIX PROBLEM OF % TIME IN MOD NOT CALC      * EW000200
      *                    CORRECTLY WHEN TEACHER HAS A REGULAR JOB   * EW000200
      *                    AND AN ADULT ED JOB.                       * EW000200
      * 2010004 - 072810 - CORRECT FOR PGM '999' WHICH IS TRANSLATED  * EW000200
      *                    TO SPACES                                  * EW000200
      ***************************************************************** EW000210
   
       ENVIRONMENT DIVISION.

       INPUT-OUTPUT SECTION.
       FILE-CONTROL.

VSE   *&&  SELECT    CRD-CARD          ASSIGN    SYS007-UR-3505-S.      EW000280
MVS        SELECT    CRD-CARD          ASSIGN    UT-S-CARDIN.           EW000290
                                                                        EW000300
VSE   *&&  SELECT    PR1-PRNT          ASSIGN    SYS013-UR-3203-S.      EW000310
MVS        SELECT    PR1-PRNT          ASSIGN    UT-S-PRTOT1.           EW000320
                                                                        EW000330
VSE   *    SELECT    CRF-DISK          ASSIGN       SYS026              EW000340
MVS        SELECT    CRF-DISK          ASSIGN       DA-EWCRF            EW000350
                                       ORGANIZATION INDEXED             EW000360
                                       ACCESS       RANDOM              EW000370
                                       RECORD KEY   CRFDK               EW000380
                                       FILE STATUS  RETCRF.             EW000390
                                                                        EW000400
VSE   *    SELECT    SWF-DISK          ASSIGN       SYS030              EW000410
MVS        SELECT    SWF-DISK          ASSIGN       DA-EWSWF            EW000420
                                       ORGANIZATION INDEXED             EW000430
                                       ACCESS       SEQUENTIAL          EW000440
                                       RECORD KEY   SWFDD1              EW000450
                                       FILE STATUS  RETSWF.             EW000460
                                                                        EW000470
VSE   *    SELECT    STH-DISK          ASSIGN       SYS027              EW000480
MVS        SELECT    STH-DISK          ASSIGN       DA-EWSTH            EW000490
                                       ORGANIZATION INDEXED             EW000500
                                       ACCESS       DYNAMIC             EW000510
                                       RECORD KEY   STHDK               EW000520
                                       FILE STATUS  RETSTH.             EW000530
                                                                        EW000540
VSE   *    SELECT    STS-DISK          ASSIGN       SYS028              EW000550
MVS        SELECT    STS-DISK          ASSIGN       DA-EWSTS            EW000560
                                       ORGANIZATION INDEXED             EW000570
                                       ACCESS       DYNAMIC             EW000580
                                       RECORD KEY   STSDK               EW000590
                                       FILE STATUS  RETSTS.             EW000600
                                                                        EW000610
VSE   *    SELECT    SMP-DISK          ASSIGN       SYS029              EW000620
MVS        SELECT    SMP-DISK          ASSIGN       DA-EWSMP            EW000630
                                       ORGANIZATION INDEXED             EW000640
                                       ACCESS       DYNAMIC             EW000650
                                       RECORD KEY   SMPDK               EW000660
                                       FILE STATUS  RETSMP.             EW000670

VSE   *    SELECT    SRT-SORT          ASSIGN    SYS001-UT-3350-SORTWK1.EW000690
MVS        SELECT    SRT-SORT          ASSIGN    DA-SORTWK.             EW000700
                                                                        EW000710
       DATA DIVISION.                                                   EW000720
       FILE SECTION.                                                    EW000730
                                                                        EW000740
       FD  CRD-CARD                                                     EW000750
           RECORDING MODE       IS  F                                   EW000760
           RECORD    CONTAINS   80  CHARACTERS                          EW000770
MVS        BLOCK     CONTAINS    0  RECORDS                             EW000780
           LABEL     RECORDS   ARE  OMITTED                             EW000790
           DATA      RECORDS   ARE  CRD  CRH.                           EW000800
                                                                        EW000810
       01            CRD.                                               EW000820
001        05        CRDREQ            PIC  X(03).                      EW000830
004        05        FILLER            PIC  X(01).                      EW000840
005        05        CRDID             PIC  X(02).                      EW000850
007        05        FILLER            PIC  X(01).                      EW000860
008        05        CRDPRT            PIC  X(01).                      EW000870
009        05        FILLER            PIC  X(03).                      EW000880
012        05        CRDDIST           PIC  X(02).                      EW000890
014        05        FILLER            PIC  X(02).                      EW000900
016        05        CRDFY             PIC  X(02).                      EW000910
018        05        FILLER            PIC  X(01).                      EW000920
019        05        CRDREG1           PIC  9(02).                      EW000930
021        05        FILLER            PIC  X(01).                      EW000940
022        05        CRDREG2           PIC  9(02).                      EW000950
024        05        FILLER            PIC  X(01).                      EW000960
025        05        CRDREG3           PIC  9(02).                      EW000970
027        05        FILLER            PIC  X(01).                      EW000980
028        05        CRDREG4           PIC  9(02).                      EW000990
030        05        FILLER            PIC  X(01).                      EW001000
031        05        CRDFROM           PIC  X(03).                      EW001010
034        05        FILLER            PIC  X(01).                      EW001020
035        05        CRDTO             PIC  X(03).                      EW001030
038        05        FILLER            PIC  X(01).                      EW001040
039        05        CRDADLT1          PIC  9(02).                      EW001050
041        05        FILLER            PIC  X(01).                      EW001060
042        05        CRDADLT2          PIC  9(02).                      EW001070
044        05        FILLER            PIC  X(01).                      EW001080
045        05        CRDADLT3          PIC  9(02).                      EW001090
047        05        FILLER            PIC  X(01).                      EW001100
048        05        CRDADLT4          PIC  9(02).                      EW001110
050        05        FILLER            PIC  X(01).                      EW001120
051        05        CRDRPT            PIC  X(01).                      EW001130
052        05        FILLER            PIC  X(29).                      EW001140
                                                                        EW001150
       01            CRH.                                               EW001160
001        05        CRHREQ            PIC  X(03).                      EW001170
004        05        FILLER            PIC  X(01).                      EW001180
005        05        CRHID             PIC  X(02).                      EW001190
007        05        FILLER            PIC  X(01).                      EW001200
008        05        CRHUSER           PIC  X(08).                      EW001210
016        05        FILLER            PIC  X(01).                      EW001220
           05        CRHHEAD.                                           EW001230
017          10      CRHB       OCCURS 050  TIMES  INDEXED BY CRH1      EW001240
                                       PIC  X(01).                      EW001250
067        05        FILLER            PIC  X(14).                      EW001260
                                                                        EW001270
       FD  PR1-PRNT                                                     EW001280
           RECORDING MODE       IS  F                                   EW001290
VSE   *&&  RECORD    CONTAINS  133  CHARACTERS                          EW001300
MVS        RECORD    CONTAINS  132  CHARACTERS                          EW001310
MVS        BLOCK     CONTAINS    0  RECORDS                             EW001320
           LABEL     RECORDS   ARE  OMITTED                             EW001330
           DATA      RECORDS   ARE  LNM  LN1.                           EW001340
                                                                        EW001350
       01  LNM.                                                         EW001360
VSE   *&&  05        FILLER            PIC  X(01).                      EW001370
002        05        LNMMSG            PIC  X(20).                      EW001380
022        05        FILLER            PIC  X(02).                      EW001390
024        05        LNMVALUE1         PIC  X(02).                      EW001400
026        05        FILLER            PIC  X(01).                      EW001410
027        05        LNMVALUE2         PIC  X(80).                      EW001420
107        05        FILLER            PIC  X(27).                      EW001430
                                                                        EW001440
       01            LN1.                                               EW001450
VSE   *&&  05        FILLER            PIC  X(01).                      EW001460
002        05        LN1MSG1           PIC  X(08).                      EW001470
010        05        LN1REQ            PIC  X(04).                      EW001480
014        05        LN1MSG2           PIC  X(06).                      EW001490
020        05        LN1CNT            PIC  ZZZ,ZZ9-.                   EW001500
028        05        LN1MSG3           PIC  X(19).                      EW001510
047        05        FILLER            PIC  X(87).                      EW001520
                                                                        EW001530
           COPY                        EWCRFD.                          EW001540
           COPY                        EWSWFD.                          EW001550
           COPY                        EWSTHD.                          EW001560
           COPY                        EWSTSD.                          EW001570
           COPY                        EWSMPD.                          EW001580
                                                                        EW001590
       SD  SRT-SORT.                                                    EW001600
                                                                        EW001610
       01            SRT.                                               EW001620
           05        SRTKEY.                                            EW001630
001          10      SRTKDIST          PIC  X(02).                      EW001640
             10      SRTKREQ.                                           EW001650
003            15    SRTKREQ1          PIC  X(01).                      EW001660
004            15    SRTKREQ2          PIC  X(01).                      EW001670
005            15    SRTKREQ3          PIC  X(01).                      EW001680
             10      SRTKFY.                                            EW001690
006            15    SRTKFY1           PIC  X(01).                      EW001700
007            15    SRTKFY2           PIC  X(01).                      EW001710
008          10      SRTKSSN           PIC  X(10).                      EW001720
018          10      SRTKJOB           PIC  9(02).                      EW001730
020          10      SRTKSCHL          PIC  X(04).                      EW001740
024          10      SRTKSURVEY        PIC  X(01).                      EW001750
025          10      SRTKMOD           PIC  X(02).                      EW001760
027          10      SRTKPGM           PIC  X(03).                      EW001770
           05        SRTDATA.                                           EW001780
030          10      SRTNBRPRD         PIC S9(03).                      EW001790
034          10      SRTCNT            PIC S9(03).                      EW001800
038          10      SRTSQFT           PIC S9(05).                      EW001810
044          10      SRTMNSWK          PIC S9(08).                      EW001820
053          10      SRTFTE            PIC S9(04)V9(04).                EW001830
             10      SRTNAME.                                           EW001840
062            15    SRTLAST           PIC  X(17).                      EW001850
079            15    SRTFIRST          PIC  X(12).                      EW001860
091            15    SRTMINIT          PIC  X(01).                      EW001870
092          10      SRTRPT            PIC  X(01).                      EW001880
093          10      SRTPRT            PIC  X(01).                      EW001890
                                                                        EW001900
       WORKING-STORAGE SECTION.                                         EW001910
                                                                        EW001920

       01            RET.                                               EW001930
           05        RETCRF            PIC  X(02) VALUE '00'.           EW001940
           05        RETSWF            PIC  X(02) VALUE '00'.           EW001950
           05        RETSTH            PIC  X(02) VALUE '00'.           EW001960
           05        RETSTS            PIC  X(02) VALUE '00'.           EW001970
           05        RETSMP            PIC  X(02) VALUE '00'.           EW001980
           05        RETCRFOLD         PIC  X(02) VALUE '00'.           EW001990
           05        RETSTHOLD         PIC  X(02) VALUE '00'.           EW002000
           05        RETSTSOLD         PIC  X(02) VALUE '00'.           EW002010
           05        RETSMPOLD         PIC  X(02) VALUE '00'.           EW002020
                                                                        EW002030
       01            SYS.                                               EW002040
           05        SYSTIME.                                           EW002050
             10      SYSHR             PIC  X(02).                      EW002060
             10      SYSMIN            PIC  X(02).                      EW002070
             10      SYSSEC            PIC  X(02).                      EW002080
           05        SYSDATE.                                           EW002090
             10      SYSYY             PIC  9(02).                      EW002100
             10      SYSMM             PIC  X(02).                      EW002110
             10      SYSDD             PIC  X(02).                      EW002120
                                                                        EW002130
       01            CTLAREA.                                           EW002140
           05        CTLCHAR           PIC  X(01) VALUE ' '.            EW002150
           05        ERR.                                               EW002160
             10      ERRREQ            PIC  X(03).                      EW002170
             10      FILLER            PIC  X(01).                      EW002180
             10      ERRID             PIC  X(02).                      EW002190
             10      FILLER            PIC  X(01).                      EW002200
             10      ERRPRT            PIC  X(01).                      EW002210
             10      FILLER            PIC  X(03).                      EW002220
             10      ERRDIST           PIC  X(02).                      EW002230
             10      FILLER            PIC  X(02).                      EW002240
             10      ERRFY             PIC  X(02).                      EW002250
             10      FILLER            PIC  X(01).                      EW002260
             10      ERRREG1           PIC  X(02).                      EW002270
             10      FILLER            PIC  X(01).                      EW002280
             10      ERRREG2           PIC  X(02).                      EW002290
             10      FILLER            PIC  X(01).                      EW002300
             10      ERRREG3           PIC  X(02).                      EW002310
             10      FILLER            PIC  X(01).                      EW002320
             10      ERRREG4           PIC  X(02).                      EW002330
             10      FILLER            PIC  X(01).                      EW002340
             10      ERRFROM           PIC  X(03).                      EW002350
             10      FILLER            PIC  X(01).                      EW002360
             10      ERRTO             PIC  X(03).                      EW002370
             10      FILLER            PIC  X(01).                      EW002380
             10      ERRADLT1          PIC  X(02).                      EW002390
             10      FILLER            PIC  X(01).                      EW002400
             10      ERRADLT2          PIC  X(02).                      EW002410
             10      FILLER            PIC  X(01).                      EW002420
             10      ERRADLT3          PIC  X(02).                      EW002430
             10      FILLER            PIC  X(01).                      EW002440
             10      ERRADLT4          PIC  X(02).                      EW002450
             10      FILLER            PIC  X(01).                      EW002460
             10      ERRRPT            PIC  X(01).                      EW002470
                                                                        EW002480
       01            RQR.                                               EW002490
           05        RQRENTRY.                                          EW002500
             10      RQRREQ            PIC  X(03).                      EW002510
             10      RQRID             PIC  X(02).                      EW002520
             10      RQRPRT            PIC  X(01).                      EW002530
             10      RQRDIST           PIC  X(02).                      EW002540
             10      RQRFY             PIC  X(02).                      EW002550
             10      RQRREG1           PIC  9(02).                      EW002560
             10      RQRREG2           PIC  9(02).                      EW002570
             10      RQRREG3           PIC  9(02).                      EW002580
             10      RQRREG4           PIC  9(02).                      EW002590
             10      RQRFROM           PIC  X(03).                      EW002600
             10      RQRTO             PIC  X(03).                      EW002610
             10      RQRADLT1          PIC  9(02).                      EW002620
             10      RQRADLT2          PIC  9(02).                      EW002630
             10      RQRADLT3          PIC  9(02).                      EW002640
             10      RQRADLT4          PIC  9(02).                      EW002650
             10      RQRRPT            PIC  X(01).                      EW002660
                                                                        EW002670
       01            RQH.                                               EW002680
           05        RQHENTRY   OCCURS 100  TIMES INDEXED BY RQH1.      EW002690
             10      RQHREQ            PIC  X(03).                      EW002700
             10      RQHID             PIC  X(02).                      EW002710
             10      RQHUSER           PIC  X(08).                      EW002720
             10      RQHHEAD.                                           EW002730
               15    RQHB       OCCURS 050  TIMES INDEXED BY RQH2       EW002740
                                       PIC  X(01).                      EW002750
                                                                        EW002760
       01            TBL.                                               EW002770
           05        TBLENTRY   OCCURS 201  TIMES INDEXED BY TBL1.      EW002780
             10      TBLSCHL           PIC  X(04).                      EW002790
             10      TBLSTS            PIC S9(03)       COMP-3.         EW002800
             10      TBLFTE            PIC S9(05)V9(04) COMP-3.         EW002810
                                                                        EW002820
       01            STRKEY.                                            EW002830
           05        STRDIST           PIC  X(02) VALUE HIGH-VALUES.    EW002840
           05        STRFY             PIC  X(02) VALUE HIGH-VALUES.    EW002850
           05        FILLER            PIC  X(32) VALUE HIGH-VALUES.    EW002860
                                                                        EW002870
       01            ENDKEY            PIC  X(36) VALUE LOW-VALUES.     EW002880
                                                                        EW002890
       01            CTR.                                               EW002900
           05        CTRLN             PIC S9(03)       COMP-3 VALUE +0.EW002910
           05        CTRPG             PIC S9(05)       COMP-3 VALUE +0.EW002920
           05        CTRIDX            PIC S9(05)       COMP-3 VALUE +0.EW002930
           05        CTRCRD            PIC S9(03)       COMP-3 VALUE +0.EW002940
           05        CTRPRDS           PIC S9(03)       COMP-3 VALUE +0.EW002950
           05        CTRMNSWK          PIC S9(09)       COMP-3 VALUE +0.EW002960
           05        CTRPRDMNSWK       PIC S9(09)       COMP-3 VALUE +0.EW002970
           05        CTRFTE            PIC S9(04)V9(04) COMP-3 VALUE +0.EW002980
           05        CTRCNT            PIC S9(03)       COMP-3 VALUE +0.EW002990
           05        CTRPSTDT          PIC S9(02)V9(03) COMP-3 VALUE +0.EW003000
           05        CTRSMP            PIC S9(03)       COMP-3 VALUE +0.EW003010
           05        CTRSTS            PIC S9(03)       COMP-3 VALUE +0.EW003020
           05        CTRSCHLFTE        PIC S9(05)V9(04) COMP-3 VALUE +0.EW003030
           05        CTRJOBFTE         PIC S9(05)V9(04) COMP-3 VALUE +0.EW003040
           05        CTRPGM            PIC S9(03)       COMP-3 VALUE +0.EW003050
           05        CTRPMOD           PIC S9(01)V9(02) COMP-3 VALUE +0.EW003060
           05        CTRREQSMP         PIC S9(09)       COMP-3 VALUE +0.EW003070
           05        CTRREQSTS         PIC S9(09)       COMP-3 VALUE +0.EW003080
           05        CTRREQSTH         PIC S9(09)       COMP-3 VALUE +0.EW003090
           05        CTRPSCHL          PIC S9(01)V9(02) COMP-3 VALUE +0.EW003100
080495     05        CTRPGMMNSWK       PIC S9(09)       COMP-3 VALUE +0.EW003110
080495     05        CTRPGMCNT         PIC S9(03)       COMP-3 VALUE +0.EW003120
080495     05        CTRPGMFTE         PIC S9(05)V9(04) COMP-3 VALUE +0.EW003130
                                                                        EW003140
       01            OLDKEY.                                            EW003150
           05        OLDDIST           PIC  X(02).                      EW003160
           05        OLDFY             PIC  X(02).                      EW003170
           05        OLDSCHL           PIC  X(04).                      EW003180
           05        OLDSSN            PIC  X(10).                      EW003190
           05        OLDSURVEY         PIC  X(01).                      EW003200
           05        OLDFPRD           PIC  9(02).                      EW003210
           05        OLDTPRD           PIC  9(02).                      EW003220
           05        OLDPGM            PIC  X(03).                      EW003230
           05        OLDNAME           PIC  X(30).                      EW003240
           05        OLDKDIST          PIC  X(02).                      EW003250
           05        OLDKREQ           PIC  X(03).                      EW003260
           05        OLDKFY            PIC  X(02).                      EW003270
           05        OLDKSSN           PIC  X(10).                      EW003280
           05        OLDKJOB           PIC  X(02).                      EW003290
           05        OLDKSCHL          PIC  X(04).                      EW003300
           05        OLDKSURVEY        PIC  X(01).                      EW003310
           05        OLDKMOD           PIC  X(02).                      EW003320
080495     05        OLDKPGM           PIC  X(03).                      EW003330
           05        OLDMNSWK          PIC S9(08).                      EW003340
           05        OLDMODPRDS        PIC S9(03).                      EW003350
           05        OLDSRVPRDS        PIC S9(03).                      EW003360
           05        OLDSQFT           PIC S9(05).                      EW003370
           05        OLDRPT            PIC  X(01).                      EW003380
           05        OLDPRT            PIC  X(01).                      EW003390
                                                                        EW003400
       01            WSC.                                               EW003410
           05        WSCSPEFLG         PIC  X(01).                      EW003420
080495     05        WSCFPRD           PIC  9(02).                      EW003430
080495     05        WSCTPRD           PIC  9(02).                      EW003440
080495     05        WSCNBRPRD         PIC  9(02).                      EW003450
                                                                        EW003460
080495 01            PRDTBL.                                            EW003470
080495     05        PRDENTRY  OCCURS  99 TIMES INDEXED BY PRD1.        EW003480
080495       10      PRD               PIC  X(01).                      EW003490
                                                                        EW003500
           COPY                        EWSCL.                           EW003510
           COPY                        EWFPG.                           EW003520
           COPY                        EWSWF.                           EW003530
           COPY                        EWSTH.                           EW003540
           COPY                        EWSTS.                           EW003550
           COPY                        EWSMP.                           EW003560
                                                                        EW003570
       01            OLDLN             PIC  X(133).                     EW003580
                                                                        EW003590
       01      HD1.                                                     EW003600
VSE   *&&  05  FILLER  PIC X(01) VALUE ' '.                             EW003610
002        05  FILLER  PIC X(06) VALUE 'EW004 '.                        EW003620
           05  HD1ABBR.                                                 EW003630
008         10 HD1B    OCCURS 22 TIMES INDEXED BY HD11 PIC X(01).       EW003640
020        05  FILLER  PIC X(11) VALUE SPACES.                          EW003650
041        05  HD1MODE PIC X(08) VALUE SPACES.                          EW003660
049        05  FILLER  PIC X(04) VALUE SPACES.                          EW003670
053        05  FILLER  PIC X(29) VALUE 'WORK FILE CONVERSION TO SATSY'. EW003680
082        05  FILLER  PIC X(18) VALUE SPACES.                          EW003690
100        05  HD1USER PIC X(09) VALUE SPACES.                          EW003700
109        05  HD1MM   PIC X(02) VALUE SPACES.                          EW003710
111        05  FILLER  PIC X(01) VALUE '/'.                             EW003720
112        05  HD1DD   PIC X(02) VALUE SPACES.                          EW003730
114        05  FILLER  PIC X(01) VALUE '/'.                             EW003740
115        05  HD1YY   PIC X(02) VALUE SPACES.                          EW003750
117        05  FILLER  PIC X(01) VALUE SPACES.                          EW003760
119        05  HD1HR   PIC X(02) VALUE SPACES.                          EW003770
120        05  FILLER  PIC X(01) VALUE ':'.                             EW003780
121        05  HD1MN   PIC X(02) VALUE SPACES.                          EW003790
123        05  FILLER  PIC X(07) VALUE '  PAGE-'.                       EW003800
130        05  HD1PG   PIC ZZZ9.                                        EW003810
                                                                        EW003820
       01      HD2.                                                     EW003830
VSE   *&&  05  FILLER  PIC X(01) VALUE ' '.                             EW003840
002        05  FILLER  PIC X(41) VALUE SPACES.                          EW003850
           05  HD2HEAD.                                                 EW003860
043         10 HD2B    OCCURS 50 TIMES INDEXED BY HD21 PIC X(01).       EW003870
093        05  FILLER  PIC X(41) VALUE SPACES.                          EW003880
                                                                        EW003890
       01      HD3.                                                     EW003900
VSE   *&&  05  FILLER  PIC X(01) VALUE ' '.                             EW003910
002        05  FILLER  PIC X(41) VALUE SPACES.                          EW003920
           05  HD3HEAD.                                                 EW003930
043         10 HD3B    OCCURS 50 TIMES INDEXED BY HD31 PIC X(01).       EW003940
093        05  FILLER  PIC X(41) VALUE SPACES.                          EW003950
                                                                        EW003960
       PROCEDURE DIVISION.                                              EW003970
      ******************************************************************EW003980
           SORT    SRT-SORT            ASCENDING KEY       SRTKEY       EW003990
                                       INPUT     PROCEDURE 000-INPUT
      *EW004000
                                       OUTPUT    PROCEDURE 500-OUTPUT.  EW004010
           STOP                        RUN.                             EW004020
                                                                        EW004030
      ******************************************************************EW004040
       000-INPUT SECTION.                                               EW004050
           PERFORM 490-HOUSEKEEPING    THRU 490-EXIT.                   EW004060
       005-LOOP.                                                        EW004070
           IF     (RETSWF              NOT  =   '00')                OR EW004080
                  (SWFDIST             NOT  =   OLDDIST)             OR EW004090
                  (SWFFY               NOT  =   OLDFY)               OR EW004100
                  (SWFSCHL             NOT  =   OLDSCHL)             OR EW004110
                  (SWFSSN              NOT  =   OLDSSN)              OR EW004120
                  (SWFSURVEY           NOT  =   OLDSURVEY)           OR EW004130
                  (SWFFPRD             NOT  =   OLDFPRD)             OR EW004140
080495            (SWFTPRD             NOT  =   OLDTPRD)             OR EW004150
                  (SWFPGM              NOT  =   OLDPGM)                 EW004160
             PERFORM  025-1TOT         THRU 025-EXIT                    EW004170
             IF   (RETSWF              NOT  =   '00')                OR EW004180
                  (SWFDIST             NOT  =   OLDDIST)             OR EW004190
                  (SWFFY               NOT  =   OLDFY)               OR EW004200
                  (SWFSCHL             NOT  =   OLDSCHL)             OR EW004210
                  (SWFSSN              NOT  =   OLDSSN)              OR EW004220
                  (SWFSURVEY           NOT  =   OLDSURVEY)           OR EW004230
080495            (SWFFPRD             NOT  =   OLDFPRD)             OR EW004240
080495            (SWFTPRD             NOT  =   OLDTPRD)                EW004250
080495*           (SWFFPRD             NOT  =   OLDFPRD)                EW004260
               PERFORM  035-2TOT       THRU 035-EXIT                    EW004270
               IF (RETSWF              NOT  =   '00')                OR EW004280
                  (SWFDIST             NOT  =   OLDDIST)             OR EW004290
                  (SWFFY               NOT  =   OLDFY)               OR EW004300
                  (SWFSCHL             NOT  =   OLDSCHL)             OR EW004310
                  (SWFSSN              NOT  =   OLDSSN)              OR EW004320
100808*           (SWFSURVEY           NOT  =   OLDSURVEY)              EW004330
100808            (SWFSURVEY           NOT  =   OLDSURVEY)           OR
100808           ((SWFSURVEY                =   OLDSURVEY)        AND
100808            (SWFFPRD                  =   '99'))
                 PERFORM  045-3TOT     THRU 045-EXIT                    EW004340
                 IF (RETSWF            NOT  =   '00')                   EW004350
                   GO                  TO   499-EOJ                     EW004360
                 ELSE                                                   EW004370
                   PERFORM 040-3CHG    THRU 040-EXIT                    EW004380
               ELSE                                                     EW004390
                 PERFORM 030-2CHG      THRU 030-EXIT                    EW004400
             ELSE                                                       EW004410
               PERFORM 020-1CHG        THRU 020-EXIT.                   EW004420
           PERFORM 015-SELECT          THRU 015-EXIT                    EW004430
           PERFORM 010-READ            THRU 010-EXIT                    EW004440
           GO                          TO   005-LOOP.                   EW004450
                                                                        EW004460
      ******************************************************************EW004470
       010-READ.                                                        EW004480
           READ    SWF-DISK                 NEXT                        EW004490
           IF     (SWFDD1              >    ENDKEY)                  OR EW004500
                  (RETSWF              NOT  =   '00')                   EW004510
             MOVE  '99'                TO   RETSWF                      EW004520
           ELSE                                                         EW004530
072810*      MOVE  SWFD                TO   SWF.
072810       MOVE  SWFD                TO   SWF
072810       IF    SWFPGM              =    SPACES
072810         GO                      TO   010-READ.
                                                                        EW004550
       010-EXIT.                                                        EW004610
           EXIT.                                                        EW004620
                                                                        EW004630
      ******************************************************************EW004640
       015-SELECT.                                                      EW004650
           ADD     SWFCNT              TO   CTRCNT                      EW004660
           ADD     SWFMNSWK            TO   CTRMNSWK                    EW004670
           ADD     SWFFTE              TO   CTRFTE.                     EW004680
       015-EXIT.                                                        EW004690
           EXIT.                                                        EW004700
                                                                        EW004710
      ******************************************************************EW004720
       020-1CHG.                                                        EW004730
           MOVE    SWFPGM              TO   OLDPGM                      EW004740
           MOVE    ZEROS               TO   CTRCNT      CTRMNSWK        EW004750
                                            CTRFTE.                     EW004760
       020-EXIT.                                                        EW004770
           EXIT.                                                        EW004780
                                                                        EW004790
       025-1TOT.                                                        EW004800
           MOVE    SPACES              TO   SRT                         EW004810
                                                                        EW004820
           MOVE    OLDDIST             TO   SRTKDIST                    EW004830
           MOVE    RQRREQ              TO   SRTKREQ                     EW004840
           MOVE    OLDFY               TO   SRTKFY                      EW004850
           MOVE    OLDSCHL             TO   SRTKSCHL                    EW004860
           MOVE    OLDSSN              TO   SRTKSSN                     EW004870
           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                     EW005080
           MOVE    OLDSURVEY           TO   SRTKSURVEY                  EW005090
           MOVE    OLDPGM              TO   SRTKPGM                     EW005100
                                                                        EW005110
           IF     (OLDPGM              <    RQRFROM)               OR   EW005120
                  (OLDPGM              >    RQRTO)                      EW005130
             MOVE  'N'                 TO   WSCSPEFLG.                  EW005140
                                                                        EW005150
           MOVE    ZEROS               TO   SRTNBRPRD                   EW005160
           MOVE    CTRCNT              TO   SRTCNT                      EW005170
           MOVE    ZEROS               TO   SRTSQFT                     EW005180
080495*    MOVE    CTRMNSWK            TO   SRTMNSWK                    EW005190
080495*    ADD     CTRMNSWK            TO   CTRPRDMNSWK                 EW005200
           MOVE    CTRFTE              TO   SRTFTE                      EW005210
           MOVE    SPACES              TO   SRTNAME                     EW005220
           MOVE    RQRRPT              TO   SRTRPT                      EW005230
           MOVE    RQRPRT              TO   SRTPRT                      EW005240
                                                                        EW005250
080495*    RELEASE SRT.                                                 EW005260
112995*    IF     (OLDTPRD             NOT  =  88)               AND    EW005270
112995*           (OLDFPRD             NOT  =  99)                      EW005280
112995     IF     (OLDTPRD             >    OLDFPRD)                    EW005290
080495       COMPUTE  WSCNBRPRD        =    OLDTPRD - OLDFPRD + 1       EW005300
080495     ELSE                                                         EW005310
112995*      ADD   +1                  TO   WSCNBRPRD.                  EW005320
112995       MOVE  +1                  TO   WSCNBRPRD.                  EW005330
080495     COMPUTE  SRTMNSWK           =    CTRMNSWK / WSCNBRPRD        EW005340
080495     COMPUTE  CTRPRDMNSWK        =    CTRPRDMNSWK + SRTMNSWK      EW005350
080495     MOVE     OLDFPRD            TO   WSCFPRD                     EW005360
080495     MOVE     OLDTPRD            TO   WSCTPRD.                    EW005370
080495 025-LOOP.                                                        EW005380
080495     RELEASE SRT                                                  EW005390
080495     MOVE     'Y'                TO   PRD   (WSCFPRD)             EW005400
080495     IF       (WSCFPRD           <    WSCTPRD)              AND   EW005410
080495              (OLDTPRD           NOT  =  88)                AND   EW005420
080495              (OLDFPRD           NOT  =  99)                      EW005430
080495       ADD    +1                 TO   WSCFPRD                     EW005440
080495       MOVE   WSCFPRD            TO   SRTKMOD                     EW005450
080495       GO                        TO   025-LOOP.                   EW005460
       025-EXIT.                                                        EW005470
           EXIT.                                                        EW005480
                                                                        EW005490
       030-2CHG.                                                        EW005500
           MOVE    SWFFPRD             TO   OLDFPRD                     EW005510
           MOVE    ZERO                TO   CTRPRDMNSWK                 EW005520
           MOVE    SWFTPRD             TO   OLDTPRD                     EW005530
           MOVE    SWFSQFT             TO   OLDSQFT                     EW005540
           MOVE    SPACES              TO   WSCSPEFLG                   EW005550
           PERFORM 020-1CHG            THRU 020-EXIT.                   EW005560
       030-EXIT.                                                        EW005570
           EXIT.                                                        EW005580
                                                                        EW005590
       035-2TOT.                                                        EW005600
           MOVE    LOW-VALUES          TO   SRTKPGM                     EW005610
           IF      WSCSPEFLG           =    'N'                         EW005620
             MOVE  ZEROS               TO   SRTMNSWK                    EW005630
           ELSE                                                         EW005640
             MOVE  CTRPRDMNSWK         TO   SRTMNSWK.                   EW005650
080495*    IF     (OLDTPRD             NOT  =  88)                 AND  EW005660
080495*           (OLDFPRD             NOT  =  99)                      EW005670
080495*      COMPUTE  SRTNBRPRD  =  OLDTPRD - OLDFPRD + 1               EW005680
080495*    ELSE                                                         EW005690
080495*      MOVE  +1                  TO   SRTNBRPRD.                  EW005700
080495     MOVE    +1                  TO   SRTNBRPRD                   EW005710
           ADD     SRTNBRPRD           TO   CTRPRDS                     EW005720
           MOVE    OLDSQFT             TO   SRTSQFT                     EW005730
           MOVE    ZEROS               TO   SRTFTE        SRTCNT        EW005740
           MOVE    SPACES              TO   SRTNAME                     EW005750
080495*    RELEASE SRT.                                                 EW005760
080495     MOVE    OLDFPRD             TO   WSCFPRD                     EW005770
080495     MOVE    OLDTPRD             TO   WSCTPRD.                    EW005780
080495 035-LOOP.                                                        EW005790
080495     MOVE    WSCFPRD             TO   SRTKMOD                     EW005800
080495     RELEASE  SRT                                                 EW005810
080495     MOVE    'Y'                 TO   PRD (WSCFPRD)               EW005820
080495     IF      (WSCFPRD            <    WSCTPRD)                 ANDEW005830
080495             (OLDTPRD            NOT  =  88)                   ANDEW005840
080495             (OLDFPRD            NOT  =  99)                      EW005850
080495       ADD   +1                  TO   WSCFPRD                     EW005860
080495       GO                        TO   035-LOOP.                   EW005870
       035-EXIT.                                                        EW005880
           EXIT.                                                        EW005890
                                                                        EW005900
       040-3CHG.                                                        EW005910
           MOVE    SWFDIST             TO   OLDDIST                     EW005920
           MOVE    SWFFY               TO   OLDFY                       EW005930
           MOVE    SWFSCHL             TO   OLDSCHL                     EW005940
           MOVE    SWFSSN              TO   OLDSSN                      EW005950
           MOVE    SWFSURVEY           TO   OLDSURVEY                   EW005960
           MOVE    ZERO                TO   CTRPRDS                     EW005970
080495     MOVE    SPACES              TO   PRDTBL                      EW005980
           MOVE    SWFNAME             TO   OLDNAME                     EW005990
           PERFORM 030-2CHG            THRU 030-EXIT.                   EW006000
       040-EXIT.                                                        EW006010
           EXIT.                                                        EW006020
                                                                        EW006030
       045-3TOT.                                                        EW006040
           MOVE    LOW-VALUES          TO   SRTKMOD       SRTKPGM       EW006050
080495*    MOVE    CTRPRDS             TO   SRTNBRPRD                   EW006060
080495     MOVE    ZEROS               TO   SRTNBRPRD                   EW006070
080495     MOVE    +1                  TO   WSCFPRD.                    EW006080
080495 045-LOOP.                                                        EW006090
080495     IF      PRD  (WSCFPRD)      =    'Y'                         EW006100
080495       ADD   +1                  TO   SRTNBRPRD.                  EW006110
080495     IF      WSCFPRD             <    99                          EW006120
080495       ADD   +1                  TO   WSCFPRD                     EW006130
080495       GO                        TO   045-LOOP.                   EW006140
           MOVE    ZEROS               TO   SRTCNT        SRTSQFT       EW006150
                                            SRTMNSWK      SRTFTE        EW006160
           MOVE    OLDNAME             TO   SRTNAME                     EW006170
           RELEASE SRT.                                                 EW006180
       045-EXIT.                                                        EW006190
           EXIT.                                                        EW006200
                                                                        EW006210
      ******************************************************************
       490-HOUSEKEEPING.
           OPEN    INPUT                    CRD-CARD      CRF-DISK
                                            SWF-DISK
                   OUTPUT                   PR1-PRNT.                   EW006260
           MOVE    SPACES              TO   LN1                         EW006270
           MOVE    '1'                 TO   CTLCHAR                     EW006280
           SET     RQH1                TO   +1                          EW006290
           MOVE    HIGH-VALUES         TO   RQR           RQH.          EW006300
           MOVE    1                   TO   CTRCRD.                     EW006310
       490-LOAD.                                                        EW006320
           READ    CRD-CARD            AT   END                         EW006330
             GO                        TO   490-TEST.                   EW006340
           MOVE    SPACES              TO   ERR                         EW006350
           IF      CRDID               =    'SL'                        EW006360
             GO                        TO   490-REQ                     EW006370
           ELSE                                                         EW006380
             IF     (CRDID             =    'H1')                    OR EW006390
                    (CRDID             =    'H2')                       EW006400
               GO                      TO   490-HEAD                    EW006410
             ELSE                                                       EW006420
               GO                      TO   490-LOAD.                   EW006430
                                                                        EW006440
       490-REQ.                                                         EW006450
           IF      CTRCRD              >    1                           EW006460
             MOVE  'ERROR. ONLY 1 REQ.' TO  LNMMSG                      EW006470
             MOVE  CRD                 TO   LNMVALUE2                   EW006480
             PERFORM  520-PRINT        THRU 520-EXIT                    EW006490
             GO                        TO   490-LOAD.                   EW006500
           IF     (CRDPRT              NOT  =   'U')               AND  EW006510
                  (CRDPRT              NOT  =   'T')               AND  EW006520
                  (CRDPRT              NOT  =   'B')               AND  EW006530
                  (CRDPRT              NOT  =   'N')                    EW006540
             MOVE  ALL '-'             TO   ERRPRT.                     EW006550
           IF     (CRDRPT              NOT  =   'A')               AND  EW006560
                  (CRDRPT              NOT  =   'B')                    EW006570
             MOVE  ALL '-'             TO   ERRRPT.                     EW006580
           IF     (CRDDIST             =    SPACES)                     EW006590
             MOVE  ALL '-'             TO   ERRDIST.                    EW006600
           IF     (CRDFY               NOT  NUMERIC)                    EW006610
             MOVE  ALL '-'             TO   ERRFY.                      EW006620
           IF     (CRDREG1             NOT  NUMERIC)               OR   EW006630
                  (CRDREG1             <    1)                          EW006640
             MOVE  ALL '-'             TO   ERRREG1.                    EW006650
           IF     (CRDREG2             NOT  NUMERIC)               OR   EW006660
                  (CRDREG2             <    1)                          EW006670
             MOVE  ALL '-'             TO   ERRREG2.                    EW006680
           IF     (CRDREG3             NOT  NUMERIC)               OR   EW006690
                  (CRDREG3             <    1)                          EW006700
             MOVE  ALL '-'             TO   ERRREG3.                    EW006710
           IF     (CRDREG4             NOT  NUMERIC)               OR   EW006720
                  (CRDREG4             <    1)                          EW006730
             MOVE  ALL '-'             TO   ERRREG4.                    EW006740
040599*    MOVE    CRDDIST             TO   FPGKEY                      EW006750
040599*    MOVE    CRDFY               TO   FPGFY                       EW006760
040599*    MOVE    'FPG'               TO   FPGPREF                     EW006770
040599*    MOVE    CRDFROM             TO   FPGFPG                      EW006780
040599*    MOVE    FPGKEY              TO   CRFDK                       EW006790
040599*    READ    CRF-DISK                                             EW006800
040599*    IF      RETCRF              NOT  =   '00'                    EW006810
040599*      MOVE  ALL '-'             TO   ERRFROM.                    EW006820
040599*    MOVE    CRDTO               TO   FPGFPG                      EW006830
040599*    MOVE    FPGKEY              TO   CRFDK                       EW006840
040599*    READ    CRF-DISK                                             EW006850
040599*    IF      RETCRF              NOT  =   '00'                    EW006860
040599*      MOVE  ALL '-'             TO   ERRTO.                      EW006870
040599*    IF      CRDTO               <    CRDFROM                     EW006880
040599*      MOVE  ALL '-'             TO   ERRFROM     ERRTO.          EW006890
           IF     (CRDADLT1            NOT  NUMERIC)               OR   EW006900
                  (CRDADLT1            <    1)                          EW006910
             MOVE  ALL '-'             TO   ERRADLT1.                   EW006920
           IF     (CRDADLT2            NOT  NUMERIC)               OR   EW006930
                  (CRDADLT2            <    1)                          EW006940
             MOVE  ALL '-'             TO   ERRADLT2.                   EW006950
           IF     (CRDADLT3            NOT  NUMERIC)               OR   EW006960
                  (CRDADLT3            <    1)                          EW006970
             MOVE  ALL '-'             TO   ERRADLT3.                   EW006980
           IF     (CRDADLT4            NOT  NUMERIC)               OR   EW006990
                  (CRDADLT4            <    1)                          EW007000
             MOVE  ALL '-'             TO   ERRADLT4.                   EW007010
           IF      ERR                 NOT  =   SPACES                  EW007020
             MOVE    'ERROR. BYPASSED' TO   LNMMSG                      EW007030
             MOVE    CRD               TO   LNMVALUE2                   EW007040
             PERFORM 520-PRINT         THRU 520-EXIT                    EW007050
             MOVE    ERR               TO   LNMVALUE2                   EW007060
             PERFORM 520-PRINT         THRU 520-EXIT                    EW007070
             GO                        TO   490-LOAD.                   EW007080
           MOVE    CRDREQ              TO   RQRREQ                      EW007090
           MOVE    CRDPRT              TO   RQRPRT                      EW007100
           MOVE    CRDDIST             TO   RQRDIST                     EW007110
           MOVE    CRDFY               TO   RQRFY                       EW007120
           MOVE    CRDREG1             TO   RQRREG1                     EW007130
           MOVE    CRDREG2             TO   RQRREG2                     EW007140
           MOVE    CRDREG3             TO   RQRREG3                     EW007150
           MOVE    CRDREG4             TO   RQRREG4                     EW007160
040699*    MOVE    CRDFROM             TO   RQRFROM                     EW007170
040699*    MOVE    CRDTO               TO   RQRTO                       EW007180
040699     MOVE    '340'               TO   RQRFROM                     EW007190
040699     MOVE    '450'               TO   RQRTO                       EW007200
           MOVE    CRDADLT1            TO   RQRADLT1                    EW007210
           MOVE    CRDADLT2            TO   RQRADLT2                    EW007220
           MOVE    CRDADLT3            TO   RQRADLT3                    EW007230
           MOVE    CRDADLT4            TO   RQRADLT4                    EW007240
           MOVE    CRDRPT              TO   RQRRPT                      EW007250
           MOVE    SPACES              TO   SWF                         EW007260
           MOVE    CRDDIST             TO   SWFDIST2                    EW007270
           MOVE    CRDFY               TO   SWFFY2                      EW007280
           IF     (SWFALT              <    STRKEY)                     EW007290
             MOVE  SWFALT              TO   STRKEY.                     EW007300
           SET     SWF1                TO   +1.                         EW007310
       490-SET.                                                         EW007320
           IF      SWFB     (SWF1)     =    SPACES                      EW007330
             MOVE  HIGH-VALUES         TO   SWFB (SWF1).                EW007340
           IF      SWF1                <    +36                         EW007350
             SET   SWF1                UP   BY  +1                      EW007360
             GO                        TO   490-SET.                    EW007370
           IF     (SWFALT              >    ENDKEY)                     EW007380
             MOVE  SWFALT              TO   ENDKEY.                     EW007390
           ADD     +1                  TO   CTRCRD                      EW007400
           GO                          TO   490-LOAD.                   EW007410
                                                                        EW007420
       490-HEAD.                                                        EW007430
           MOVE    CRHREQ              TO   RQHREQ       (RQH1)         EW007440
           MOVE    CRHID               TO   RQHID        (RQH1)         EW007450
           MOVE    CRHUSER             TO   RQHUSER      (RQH1)         EW007460
           MOVE    SPACES              TO   RQHHEAD      (RQH1)         EW007470
           MOVE    +50                 TO   CTRIDX                      EW007480
           SET     CRH1                TO   +50.                        EW007490
       490-HEAD1.                                                       EW007500
           IF      CRHB         (CRH1) =    SPACES                      EW007510
             IF      CRH1              >    +2                          EW007520
               ADD   -1                TO   CTRIDX                      EW007530
               SET   CRH1              DOWN BY  +1                      EW007540
               GO                      TO   490-HEAD1.                  EW007550
           COMPUTE CTRIDX              =    CTRIDX - 1                  EW007560
           COMPUTE CTRIDX      ROUNDED =    (50  - CTRIDX) / 2          EW007570
           SET     RQH2                TO   CTRIDX                      EW007580
           SET     CRH1                TO   +1.                         EW007590
       490-HEAD2.                                                       EW007600
           MOVE    CRHB         (CRH1) TO   RQHB         (RQH1 RQH2)    EW007610
           IF      RQH2                <    +50                         EW007620
             SET   RQH2  CRH1          UP   BY  +1                      EW007630
             GO                        TO   490-HEAD2.                  EW007640
           SET     RQH1             UP BY   +1                          EW007650
           GO                          TO   490-LOAD.                   EW007660
                                                                        EW007670
       490-TEST.                                                        EW007680
           MOVE    RETCRFOLD           TO   RETCRF                      EW007690
           IF      RQRRPT              =    'B'                         EW007700
             OPEN  I-O                      STH-DISK      STS-DISK      EW007710
                                            SMP-DISK                    EW007720
             MOVE  RETSTH              TO   RETSTHOLD                   EW007730
             MOVE  RETSTS              TO   RETSTSOLD                   EW007740
             MOVE  RETSMP              TO   RETSMPOLD                   EW007750
             PERFORM 493-SATSY-PURGE   THRU 493-EXIT                    EW007760
             MOVE  RETSTHOLD           TO   RETSTH                      EW007770
             MOVE  RETSTSOLD           TO   RETSTS                      EW007780
             MOVE  RETSMPOLD           TO   RETSMP                      EW007790
           ELSE                                                         EW007800
             OPEN  INPUT                    STH-DISK      STS-DISK      EW007810
                                            SMP-DISK.                   EW007820
           IF      RQRENTRY            =    HIGH-VALUES                 EW007830
             MOVE    ' EW004 NO REQUESTS *'   TO   LNM                  EW007840
             PERFORM 520-PRINT         THRU 520-EXIT.                   EW007850
           IF      RETCRF              NOT  =   '00'                    EW007860
             MOVE    'CRF OPEN ERROR'  TO   LNMMSG                      EW007870
             MOVE    RETCRF            TO   LNMVALUE1                   EW007880
             PERFORM 520-PRINT         THRU 520-EXIT.                   EW007890
           IF      RETSWF              NOT  =   '00'                    EW007900
             MOVE    'SWF OPEN ERROR'  TO   LNMMSG                      EW007910
             MOVE    RETSWF            TO   LNMVALUE1                   EW007920
             PERFORM 520-PRINT         THRU 520-EXIT.                   EW007930
           IF      RETSTH              NOT  =   '00'                    EW007940
             MOVE    'STH OPEN ERROR'  TO   LNMMSG                      EW007950
             MOVE    RETSTH            TO   LNMVALUE1                   EW007960
             PERFORM 520-PRINT         THRU 520-EXIT.                   EW007970
           IF      RETSTS              NOT  =   '00'                    EW007980
             MOVE    'STS OPEN ERROR'  TO   LNMMSG                      EW007990
             MOVE    RETSTS            TO   LNMVALUE1                   EW008000
             PERFORM 520-PRINT         THRU 520-EXIT.                   EW008010
           IF      RETSMP              NOT  =   '00'                    EW008020
             MOVE    'SMP OPEN ERROR'  TO   LNMMSG                      EW008030
             MOVE    RETSMP            TO   LNMVALUE1                   EW008040
             PERFORM 520-PRINT         THRU 520-EXIT.                   EW008050
           IF     (RETCRF              NOT  =   '00')                OR EW008060
                  (RETSWF              NOT  =   '00')                OR EW008070
                  (RETSTH              NOT  =   '00')                OR EW008080
                  (RETSTS              NOT  =   '00')                OR EW008090
                  (RETSMP              NOT  =   '00')                OR EW008100
                  (RQRENTRY            =    HIGH-VALUES)                EW008110
             GO                        TO   499-EOJ.                    EW008120
           MOVE    STRKEY              TO   SWFDD1                      EW008130
           START   SWF-DISK        KEY >    SWFDD1                      EW008140
           IF      RETSWF              =    '00'                        EW008150
             PERFORM 010-READ          THRU 010-EXIT.                   EW008160
           PERFORM 040-3CHG            THRU 040-EXIT.                   EW008170
       490-EXIT.                                                        EW008180
           EXIT.                                                        EW008190
                                                                        EW008200
                                                                        EW008200
                                                                        EW008210
       493-SATSY-PURGE.                                                 EW008220
           MOVE    RQRDIST             TO   STHKEY                      EW008230
           MOVE    RQRFY               TO   STHFY                       EW008240
           MOVE    STHKEY              TO   STHDK                       EW008250
           START   STH-DISK        KEY >    STHDK                       EW008260
           IF      RETSTH              NOT  =  '00'                     EW008270
             GO                        TO   493-CONT1.                  EW008280
       493-LOOP.                                                        EW008290
           READ    STH-DISK            NEXT                             EW008300
           IF      RETSTH              =    '00'                        EW008310
             MOVE  STHD                TO   STH                         EW008320
             IF    STHDIST             =    RQRDIST          AND        EW008330
                   STHFY               =    RQRFY                       EW008340
               DELETE STH-DISK                                          EW008350
               GO                      TO   493-LOOP.                   EW008360
       493-CONT1.                                                       EW008370
           MOVE    RQRDIST             TO   STSKEY                      EW008380
           MOVE    RQRFY               TO   STSFY                       EW008390
           MOVE    STSKEY              TO   STSDK                       EW008400
           START   STS-DISK        KEY >    STSDK                       EW008410
           IF      RETSTS              NOT  =  '00'                     EW008420
             GO                        TO   493-CONT2.                  EW008430
       493-LOOP2.                                                       EW008440
           READ    STS-DISK            NEXT                             EW008450
           IF      RETSTS              =    '00'                        EW008460
             MOVE  STSD                TO   STS                         EW008470
             IF    STSDIST             =    RQRDIST          AND        EW008480
                   STSFY               =    RQRFY                       EW008490
               DELETE STS-DISK                                          EW008500
               GO                      TO   493-LOOP2.                  EW008510
       493-CONT2.                                                       EW008520
           MOVE    RQRDIST             TO   SMPKEY                      EW008530
           MOVE    RQRFY               TO   SMPFY                       EW008540
           MOVE    SMPKEY              TO   SMPDK                       EW008550
           START   SMP-DISK        KEY >    SMPDK                       EW008560
           IF      RETSMP              NOT  =  '00'                     EW008570
             GO                        TO   493-EXIT.                   EW008580
       493-LOOP3.                                                       EW008590
           READ    SMP-DISK            NEXT                             EW008600
           IF      RETSMP              =    '00'                        EW008610
             MOVE  SMPD                TO   SMP                         EW008620
             IF    SMPDIST             =    RQRDIST          AND        EW008630
                   SMPFY               =    RQRFY                       EW008640
               DELETE SMP-DISK                                          EW008650
               GO                      TO   493-LOOP3.                  EW008660
       493-EXIT.                                                        EW008670
           EXIT.                                                        EW008680
                                                                        EW008690
      ******************************************************************EW008700
       499-EOJ.                                                         EW008710
           EXIT.                                                        EW008720
                                                                        EW008730
      ******************************************************************EW008740
       500-OUTPUT SECTION.                                              EW008750
           PERFORM 990-HOUSEKEEPING    THRU 990-EXIT.                   EW008760
       505-LOOP.                                                        EW008770
080495     IF     (SRTKDIST            NOT  =   OLDKDIST)            OR EW008780
080495            (SRTKREQ             NOT  =   OLDKREQ)             OR EW008790
080495            (SRTKFY              NOT  =   OLDKFY)              OR EW008800
080495            (SRTKSSN             NOT  =   OLDKSSN)             OR EW008810
080495            (SRTKJOB             NOT  =   OLDKJOB)             OR EW008820
080495            (SRTKSCHL            NOT  =   OLDKSCHL)            OR EW008830
080495            (SRTKSURVEY          NOT  =   OLDKSURVEY)          OR EW008840
080495            (SRTKMOD             NOT  =   OLDKMOD)             OR EW008850
080495            (SRTKPGM             NOT  =   OLDKPGM)                EW008860
080495       PERFORM 605-0TOT          THRU 605-EXIT                    EW008870
           IF     (SRTKDIST            NOT  =   OLDKDIST)            OR EW008880
                  (SRTKREQ             NOT  =   OLDKREQ)             OR EW008890
                  (SRTKFY              NOT  =   OLDKFY)              OR EW008900
                  (SRTKSSN             NOT  =   OLDKSSN)             OR EW008910
                  (SRTKJOB             NOT  =   OLDKJOB)             OR EW008920
                  (SRTKSCHL            NOT  =   OLDKSCHL)            OR EW008930
                  (SRTKSURVEY          NOT  =   OLDKSURVEY)          OR EW008940
                  (SRTKMOD             NOT  =   OLDKMOD)                EW008950
             PERFORM 615-1TOT          THRU 615-EXIT                    EW008960
             IF   (SRTKDIST            NOT  =   OLDKDIST)            OR EW008970
                  (SRTKREQ             NOT  =   OLDKREQ)             OR EW008980
                  (SRTKFY              NOT  =   OLDKFY)              OR EW008990
                  (SRTKSSN             NOT  =   OLDKSSN)             OR EW009000
                  (SRTKJOB             NOT  =   OLDKJOB)             OR EW009010
                  (SRTKSCHL            NOT  =   OLDKSCHL)            OR EW009020
                  (SRTKSURVEY          NOT  =   OLDKSURVEY)             EW009030
               PERFORM 625-2TOT        THRU 625-EXIT                    EW009040
               IF (SRTKDIST            NOT  =   OLDKDIST)            OR EW009050
                  (SRTKREQ             NOT  =   OLDKREQ)             OR EW009060
                  (SRTKFY              NOT  =   OLDKFY)              OR EW009070
                  (SRTKSSN             NOT  =   OLDKSSN)             OR EW009080
                  (SRTKJOB             NOT  =   OLDKJOB)             OR EW009090
                  (SRTKSCHL            NOT  =   OLDKSCHL)               EW009100
                 PERFORM 635-3TOT      THRU 635-EXIT                    EW009110
                 IF (SRTKDIST          NOT  =   OLDKDIST)            OR EW009120
                    (SRTKREQ           NOT  =   OLDKREQ)             OR EW009130
                    (SRTKFY            NOT  =   OLDKFY)              OR EW009140
                    (SRTKSSN           NOT  =   OLDKSSN)             OR EW009150
                    (SRTKJOB           NOT  =   OLDKJOB)                EW009160
                   PERFORM 645-4TOT    THRU 645-EXIT                    EW009170
                   IF (SRTKDIST        NOT  =   OLDKDIST)            OR EW009180
                      (SRTKREQ         NOT  =   OLDKREQ)             OR EW009190
                      (SRTKFY          NOT  =   OLDKFY)              OR EW009200
                      (SRTKSSN         NOT  =   OLDKSSN)                EW009210
                     PERFORM 655-5TOT  THRU 655-EXIT                    EW009220
                     IF (SRTKDIST      NOT  =   OLDKDIST)            OR EW009230
                        (SRTKREQ       NOT  =   OLDKREQ)             OR EW009240
                        (SRTKFY        NOT  =   OLDKFY)                 EW009250
                       PERFORM 665-6TOT THRU 665-EXIT                   EW009260
                       IF     (SRTKEY  =    HIGH-VALUES)                EW009270
                         GO            TO   999-EOJ                     EW009280
                       ELSE                                             EW009290
                         PERFORM 660-6CHG THRU 660-EXIT                 EW009300
                     ELSE                                               EW009310
                       PERFORM 650-5CHG   THRU 650-EXIT                 EW009320
                   ELSE                                                 EW009330
                     PERFORM 640-4CHG  THRU 640-EXIT                    EW009340
                 ELSE                                                   EW009350
                   PERFORM 630-3CHG    THRU 630-EXIT                    EW009360
               ELSE                                                     EW009370
                 PERFORM 620-2CHG      THRU 620-EXIT                    EW009380
             ELSE                                                       EW009390
080495*        PERFORM 610-1CHG        THRU 610-EXIT.                   EW009400
080495         PERFORM 610-1CHG        THRU 610-EXIT                    EW009410
080495       ELSE                                                       EW009420
080495         PERFORM 600-0CHG        THRU 600-EXIT.                   EW009430
           PERFORM 515-PROCESS         THRU 515-EXIT                    EW009440
           PERFORM 510-READ            THRU 510-EXIT                    EW009450
           GO                          TO   505-LOOP.                   EW009460
                                                                        EW009470
      ******************************************************************EW009480
       510-READ.                                                        EW009490
           RETURN  SRT-SORT            AT   END                         EW009500
             MOVE  HIGH-VALUES         TO   SRTKEY.                     EW009510
       510-EXIT.                                                        EW009520
           EXIT.                                                        EW009530
                                                                        EW009540
      ******************************************************************EW009550
       515-PROCESS.                                                     EW009560
           IF      SRTKPGM             NOT  >  SPACES                   EW009570
080495       IF    SRTKMOD             >    SPACES                      EW009580
080495         ADD SRTMNSWK            TO   OLDMNSWK                    EW009590
080495         GO                      TO   515-EXIT                    EW009600
080495       ELSE                                                       EW009610
             GO                        TO   515-EXIT.                   EW009620
080495     ADD     SRTMNSWK            TO   CTRPGMMNSWK                 EW009630
080495     ADD     SRTCNT              TO   CTRPGMCNT                   EW009640
080495     ADD     SRTFTE              TO   CTRPGMFTE.                  EW009650
080495*    MOVE    SRTKDIST            TO   SMPKEY                      EW009660
080495*    MOVE    SRTKFY              TO   SMPFY                       EW009670
080495*    MOVE    SRTKSSN             TO   SMPSSN                      EW009680
080495*    MOVE    SRTKJOB             TO   SMPJOB                      EW009690
080495*    MOVE    SRTKSCHL            TO   SMPSCHL                     EW009700
080495*    MOVE    SRTKSURVEY          TO   SMPSURVEY                   EW009710
080495*    MOVE    SRTKMOD             TO   SMPMOD                      EW009720
080495*    MOVE    SRTKPGM             TO   SMPPGM                      EW009730
080495*    IF      OLDMNSWK            NOT  =  0                        EW009740
080495*      MOVE  ZEROS               TO   SMPSTDT                     EW009750
080495*      COMPUTE  SMPPCT  ROUNDED  =   (SRTMNSWK / OLDMNSWK)        EW009760
080495*      ADD   SMPPCT              TO   CTRPSTDT                    EW009770
080495*      IF    SMPPCT              =    1                           EW009780
080495*        MOVE  ZEROS             TO   SMPPCT                      EW009790
080495*        MOVE  SRTCNT            TO   SMPSTDT                     EW009800
080495*      ELSE                                                       EW009810
080495*        NEXT SENTENCE                                            EW009820
080495*    ELSE                                                         EW009830
080495*      MOVE  SRTCNT              TO   SMPSTDT                     EW009840
080495*      MOVE  ZEROS               TO   SMPPCT                      EW009850
080495*      MOVE  1                   TO   CTRPSTDT.                   EW009860
080495*    IF      SRTRPT              =    'B'                         EW009870
080495*      MOVE  SMP                 TO   SMPD                        EW009880
080495*      WRITE SMPD                                                 EW009890
080495*      IF    RETSMP              NOT  =  '00'                     EW009900
080495*        MOVE  'SMP WRITE ERROR' TO   LNMMSG                      EW009910
080495*        MOVE  RETSMP            TO   LNMVALUE1                   EW009920
080495*        MOVE  SMPDK             TO   LNMVALUE2                   EW009930
080495*        PERFORM 520-PRINT       THRU 520-EXIT                    EW009940
080495*      ELSE                                                       EW009950
080495*        ADD +1                  TO   CTRSMP                      EW009960
080495*    ELSE                                                         EW009970
080495*      ADD   +1                  TO   CTRSMP.                     EW009980
080495     ADD     SRTFTE              TO   CTRSCHLFTE.                 EW009990
       515-EXIT.                                                        EW010000
           EXIT.                                                        EW010010
                                                                        EW010020
      ******************************************************************EW010030
       520-PRINT.                                                       EW010040
           IF      CTRLN               >    +60                         EW010050
             PERFORM 525-HEADS         THRU 525-EXIT.                   EW010060
           IF      CTLCHAR             =    '1'                         EW010070
             WRITE LN1             AFTER    ADVANCING PAGE              EW010080
           ELSE                                                         EW010090
             IF      CTLCHAR           =    '0'                         EW010100
               WRITE LN1           AFTER    ADVANCING  2  LINES         EW010110
               ADD   +2                TO   CTRLN                       EW010120
             ELSE                                                       EW010130
               IF      CTLCHAR         =    ' '                         EW010140
                 WRITE LN1         AFTER    ADVANCING  1  LINES         EW010150
                 ADD   +1              TO   CTRLN                       EW010160
               ELSE                                                     EW010170
                 WRITE LN1         AFTER    ADVANCING  0  LINES         EW010180
                 ADD   +0              TO   CTRLN.                      EW010190
           MOVE    SPACES              TO   LN1           CTLCHAR.      EW010200
       520-EXIT.                                                        EW010210
           EXIT.                                                        EW010220
                                                                        EW010230
       525-HEADS.                                                       EW010240
           MOVE    LN1                 TO   OLDLN                       EW010250
           MOVE    +0                  TO   CTRLN                       EW010260
           ADD     +1                  TO   CTRPG                       EW010270
           IF      OLDRPT              =    'A'                         EW010280
             MOVE  '* EDIT *'          TO   HD1MODE                     EW010290
           ELSE                                                         EW010300
             MOVE  '* POST *'          TO   HD1MODE.                    EW010310
           MOVE    CTRPG               TO   HD1PG                       EW010320
           MOVE    HD1                 TO   LN1                         EW010330
           MOVE    '1'                 TO   CTLCHAR                     EW010340
           PERFORM 520-PRINT           THRU 520-EXIT                    EW010350
           IF      HD2                 NOT  =   SPACES                  EW010360
             MOVE    HD2               TO   LN1                         EW010370
             PERFORM 520-PRINT         THRU 520-EXIT.                   EW010380
           IF      HD3                 NOT  =   SPACES                  EW010390
             MOVE    HD3               TO   LN1                         EW010400
             PERFORM 520-PRINT         THRU 520-EXIT.                   EW010410
           MOVE    OLDLN               TO   LN1                         EW010420
           MOVE    '0'                 TO   CTLCHAR.                    EW010430
       525-EXIT.                                                        EW010440
           EXIT.                                                        EW010450
                                                                        EW010460
      ******************************************************************EW010470
080495 600-0CHG.                                                        EW010480
080495     MOVE    SRTKPGM             TO   OLDKPGM                     EW010490
080495     MOVE    ZEROS               TO   CTRPGMMNSWK    CTRPGMCNT    EW010500
080495                                      CTRPGMFTE.                  EW010510
080495 600-EXIT.                                                        EW010520
080495     EXIT.                                                        EW010530
                                                                        EW010540
080495 605-0TOT.                                                        EW010550
080495     IF      (OLDKPGM            NOT  >   SPACES)            OR   EW010560
080495             (OLDKMOD            NOT  >   SPACES)                 EW010570
080495       GO                        TO   605-EXIT.                   EW010580
080495     MOVE    OLDKDIST            TO   SMPKEY                      EW010590
080495     MOVE    OLDKFY              TO   SMPFY                       EW010600
080495     MOVE    OLDKSSN             TO   SMPSSN                      EW010610
080495     MOVE    OLDKJOB             TO   SMPJOB                      EW010620
080495     MOVE    OLDKSCHL            TO   SMPSCHL                     EW010630
080495     MOVE    OLDKSURVEY          TO   SMPSURVEY                   EW010640
080495     MOVE    OLDKMOD             TO   SMPMOD                      EW010650
080495     MOVE    OLDKPGM             TO   SMPPGM
080495     IF      OLDMNSWK            NOT  =  0                        EW010670
080495       MOVE  ZEROS               TO   SMPSTDT                     EW010680
080495       COMPUTE SMPPCT ROUNDED    =   (CTRPGMMNSWK / OLDMNSWK)     EW010690
080495       ADD   SMPPCT              TO   CTRPSTDT                    EW010700
080495       IF    SMPPCT              NOT  =  1                        EW010710
080495         NEXT SENTENCE                                            EW010720
080495       ELSE                                                       EW010730
080495         MOVE  ZEROS             TO   SMPPCT                      EW010740
080495         MOVE  CTRPGMCNT         TO   SMPSTDT                     EW010750
080495     ELSE                                                         EW010760
080495       MOVE   CTRPGMCNT          TO   SMPSTDT                     EW010770
080495       MOVE   ZEROS              TO   SMPPCT                      EW010780
080495       MOVE   1                  TO   CTRPSTDT.                   EW010790
080495     IF       OLDRPT             =    'B'                         EW010800
080495       MOVE   SMP                TO   SMPD                        EW010810
080495       WRITE  SMPD                                                EW010820
080495       IF     RETSMP             NOT  =  '00'                     EW010830
080495         MOVE 'SMP WRITE ERROR'  TO   LNMMSG                      EW010840
080495         MOVE  RETSMP            TO   LNMVALUE1                   EW010850
080495         MOVE  SMPDK             TO   LNMVALUE2                   EW010860
080495         PERFORM 520-PRINT       THRU  520-EXIT                   EW010870
080495       ELSE                                                       EW010880
080495         ADD  +1                 TO   CTRSMP                      EW010890
080495     ELSE                                                         EW010900
080495       ADD    +1                 TO   CTRSMP.                     EW010910
080495 605-EXIT.                                                        EW010920
080495     EXIT.                                                        EW010930
                                                                        EW010940
       610-1CHG.                                                        EW010950
           MOVE    SRTKMOD             TO   OLDKMOD                     EW010960
           MOVE    ZEROS               TO   CTRSMP    CTRPSTDT          EW010970
           MOVE    SRTNBRPRD           TO   OLDMODPRDS                  EW010980
           MOVE    SRTSQFT             TO   OLDSQFT                     EW010990
080495*    MOVE    SRTMNSWK            TO   OLDMNSWK.                   EW011000
080495     MOVE    ZEROS               TO   OLDMNSWK                    EW011010
101695     IF      SRTNAME             >    SPACES                      EW011020
101695       MOVE  SRTNAME             TO   OLDNAME.                    EW011030
080495     PERFORM 600-0CHG            THRU 600-EXIT.                   EW011040
       610-EXIT.                                                        EW011050
           EXIT.                                                        EW011060
                                                                        EW011070
       615-1TOT.                                                        EW011080
           IF      OLDKMOD             NOT  > SPACES                    EW011090
             GO                        TO   615-EXIT.                   EW011100
           MOVE    OLDKDIST            TO   STSKEY                      EW011110
           MOVE    OLDKFY              TO   STSFY                       EW011120
           MOVE    OLDKSSN             TO   STSSSN                      EW011130
           MOVE    OLDKJOB             TO   STSJOB                      EW011140
           MOVE    OLDKSCHL            TO   STSSCHL                     EW011150
           MOVE    OLDKSURVEY          TO   STSSURVEY                   EW011160
           MOVE    OLDKMOD             TO   STSMOD                      EW011170
041096*    DISPLAY ' OLD-KEY= ' OLDKEY                                  EW011180
041096     IF      OLDSRVPRDS      NOT >    ZEROS                       EW011190
041096       MOVE  +1                  TO   OLDSRVPRDS.                 EW011200
           COMPUTE STSPMOD  ROUNDED    =   (OLDMODPRDS / OLDSRVPRDS)    EW011210
           ADD     STSPMOD             TO   CTRPMOD                     EW011220
           MOVE    OLDSQFT             TO   STSSPACE                    EW011230
           ADD     CTRSMP              TO   CTRREQSMP                   EW011240
           IF     (STSSPACE            >    ZEROS              OR       EW011250
                   STSPMOD             >    ZEROS)                 AND  EW011260
                  (CTRSMP              >    ZEROS)                      EW011270
             IF      OLDRPT            =    'B'                         EW011280
               MOVE  STS               TO   STSD                        EW011290
               WRITE STSD                                               EW011300
               IF    RETSTS            NOT  =  '00'                     EW011310
                 MOVE  'STS WRITE ERROR' TO   LNMMSG                    EW011320
                 MOVE  RETSTS          TO   LNMVALUE1                   EW011330
                 MOVE  STSDK           TO   LNMVALUE2                   EW011340
                 PERFORM 520-PRINT     THRU 520-EXIT                    EW011350
               ELSE                                                     EW011360
                 ADD +1                TO   CTRSTS                      EW011370
             ELSE                                                       EW011380
               ADD   +1                TO   CTRSTS.                     EW011390
           COMPUTE CTRPSTDT            =    1 - CTRPSTDT                EW011400
           IF     (OLDRPT              =    'B')                   AND  EW011410
                  (CTRPSTDT            NOT  =  0)                  AND  EW011420
                  (CTRSMP              >    ZERO)                       EW011430
             READ  SMP-DISK                                             EW011440
             MOVE  SMPD                TO   SMP                         EW011450
             ADD   CTRPSTDT            TO   SMPPCT                      EW011460
             MOVE  SMP                 TO   SMPD                        EW011470
             REWRITE SMPD                                               EW011480
             IF    RETSMP              NOT  =  '00'                     EW011490
               MOVE  'SMP REWRITE ERROR' TO   LNMMSG                    EW011500
               MOVE  RETSMP            TO   LNMVALUE1                   EW011510
               MOVE  SMPDK             TO   LNMVALUE2                   EW011520
               PERFORM 520-PRINT       THRU 520-EXIT.                   EW011530
       615-EXIT.                                                        EW011540
           EXIT.                                                        EW011550
                                                                        EW011560
       620-2CHG.                                                        EW011570
           MOVE    SRTKSURVEY          TO   OLDKSURVEY                  EW011580
           MOVE    ZEROS               TO   CTRPMOD                     EW011590
           MOVE    SRTNBRPRD           TO   OLDSRVPRDS                  EW011600
           PERFORM 610-1CHG            THRU 610-EXIT.                   EW011610
       620-EXIT.                                                        EW011620
           EXIT.                                                        EW011630
                                                                        EW011640
       625-2TOT.                                                        EW011650
           COMPUTE CTRPMOD             =    1 - CTRPMOD                 EW011660
           IF     (OLDRPT              =    'B')                   AND  EW011670
                  (CTRPMOD             NOT  =  0)                       EW011680
             READ  STS-DISK                                             EW011690
             MOVE  STSD                TO   STS                         EW011700
             ADD   CTRPMOD             TO   STSPMOD                     EW011710
             MOVE  STS                 TO   STSD                        EW011720
             REWRITE STSD                                               EW011730
             IF    RETSTS              NOT  =  '00'                     EW011740
               MOVE  'STS REWRITE ERROR' TO   LNMMSG                    EW011750
               MOVE  RETSTS            TO   LNMVALUE1                   EW011760
               MOVE  STSDK             TO   LNMVALUE2                   EW011770
               PERFORM 520-PRINT       THRU 520-EXIT.                   EW011780
       625-EXIT.                                                        EW011790
           EXIT.                                                        EW011800
                                                                        EW011810
       630-3CHG.                                                        EW011820
           MOVE    SRTKSCHL            TO   OLDKSCHL                    EW011830
           MOVE    ZEROS               TO   CTRSTS      CTRSCHLFTE      EW011840
           PERFORM 620-2CHG            THRU 620-EXIT.                   EW011850
       630-EXIT.                                                        EW011860
           EXIT.                                                        EW011870
                                                                        EW011880
       635-3TOT.                                                        EW011890
           IF      TBL1                >    200                         EW011900
             MOVE  'SCHL TABLE OVERLOAD' TO  LNMMSG                     EW011910
             PERFORM 520-PRINT         THRU 520-EXIT                    EW011920
             GO                        TO   635-EXIT.                   EW011930
           MOVE    OLDKSCHL            TO   TBLSCHL  (TBL1)             EW011940
           MOVE    CTRSTS              TO   TBLSTS   (TBL1)             EW011950
           ADD     CTRSTS              TO   CTRREQSTS                   EW011960
           MOVE    CTRSCHLFTE          TO   TBLFTE   (TBL1)             EW011970
           ADD     CTRSCHLFTE          TO   CTRJOBFTE                   EW011980
           SET     TBL1                UP   BY  +1.                     EW011990
       635-EXIT.                                                        EW012000
           EXIT.                                                        EW012010
                                                                        EW012020
       640-4CHG.                                                        EW012030
           MOVE    SRTKJOB             TO   OLDKJOB                     EW012040
           MOVE    ZEROS               TO   CTRJOBFTE                   EW012050
           SET     TBL1                TO   +1                          EW012060
           MOVE    HIGH-VALUES         TO   TBL                         EW012070
           PERFORM 630-3CHG            THRU 630-EXIT.                   EW012080
       640-EXIT.                                                        EW012090
           EXIT.                                                        EW012100
                                                                        EW012110
       645-4TOT.                                                        EW012120
           MOVE    ZEROS               TO   CTRPSCHL                    EW012130
           SET     TBL1                TO   +1.                         EW012140
       645-LOOP.                                                        EW012150
           IF      TBLSCHL  (TBL1)     =    HIGH-VALUES                 EW012160
             GO                        TO   645-EXIT.                   EW012170
           MOVE    SPACES              TO   STH                         EW012180
           MOVE    ZEROS               TO   STHJOB      STHJOB1         EW012190
                                            STHSSN9     STHSSN91        EW012200
                                            STHSALARY   STHHRLY         EW012210
                                            STHPSCHL    STHDAYS1        EW012220
                                            STHDAYS2    STHDAYS3        EW012230
                                            STHDAYS4                    EW012240
           MOVE    OLDKDIST            TO   STHDIST STHDIST1 STHDIST2   EW012250
           MOVE    OLDKFY              TO   STHFY   STHFY1   STHFY2     EW012260
           MOVE    OLDKSSN             TO   STHSSN  STHSSN1             EW012270
           MOVE    OLDKJOB             TO   STHJOB  STHJOB1             EW012280
           MOVE    TBLSCHL  (TBL1)     TO   STHSCHL STHSCHL1            EW012290
           IF      CTRJOBFTE           NOT  =  ZEROS                    EW012300
             COMPUTE STHPSCHL  ROUNDED =    TBLFTE (TBL1) / CTRJOBFTE   EW012310
           ELSE                                                         EW012320
             MOVE  ZEROS               TO   STHPSCHL.                   EW012330
           ADD     STHPSCHL            TO   CTRPSCHL                    EW012340
           IF     (TBLSCHL  (TBL1 + 1) =    HIGH-VALUES)           AND  EW012350
                  (CTRPSCHL            NOT  =  1)                       EW012360
             COMPUTE  STHPSCHL         =    STHPSCHL + (1 - CTRPSCHL).  EW012370
           MOVE    OLDNAME             TO   STHNAME                     EW012380
           IF      OLDRPT              =    'B'                         EW012390
             MOVE  STH                 TO   STHD                        EW012400
             WRITE STHD                                                 EW012410
             IF    RETSTH              NOT  =  '00'                     EW012420
               MOVE  'STH WRITE ERROR' TO   LNMMSG                      EW012430
               MOVE  RETSTH            TO   LNMVALUE1                   EW012440
               MOVE  STHDK             TO   LNMVALUE2                   EW012450
               PERFORM 520-PRINT       THRU 520-EXIT                    EW012460
             ELSE                                                       EW012470
               ADD +1                  TO   CTRREQSTH                   EW012480
           ELSE                                                         EW012490
             ADD   +1                  TO   CTRREQSTH.                  EW012500
           SET     TBL1                UP   BY  +1                      EW012510
           GO                          TO   645-LOOP.                   EW012520
       645-EXIT.                                                        EW012530
           EXIT.                                                        EW012540
                                                                        EW012550
       650-5CHG.                                                        EW012560
           MOVE    SRTKSSN             TO   OLDKSSN                     EW012570
101695*    MOVE    SRTNAME             TO   OLDNAME                     EW012580
101695     MOVE    SPACES              TO   OLDNAME                     EW012590
           PERFORM 640-4CHG            THRU 640-EXIT.                   EW012600
       650-EXIT.                                                        EW012610
           EXIT.                                                        EW012620
                                                                        EW012630
       655-5TOT.                                                        EW012640
       655-EXIT.                                                        EW012650
           EXIT.                                                        EW012660
                                                                        EW012670
       660-6CHG.                                                        EW012680
           MOVE    SRTKREQ             TO   OLDKREQ                     EW012690
           MOVE    SRTKDIST            TO   OLDKDIST                    EW012700
           MOVE    SRTKFY              TO   OLDKFY                      EW012710
           MOVE    ZEROS               TO   CTRLN       CTRPG           EW012720
           MOVE    ZEROS               TO   CTRREQSMP   CTRREQSTS       EW012730
                                            CTRREQSTH                   EW012740
           MOVE    SRTPRT              TO   OLDPRT                      EW012750
           MOVE    SRTRPT              TO   OLDRPT                      EW012760
           MOVE    '    SCL0000'       TO   SCLKEY                      EW012770
           MOVE    SRTKDIST            TO   SCLDIST                     EW012780
           MOVE    SRTKFY              TO   SCLFY                       EW012790
           MOVE    SCLKEY              TO   CRFDK                       EW012800
           READ    CRF-DISK                                             EW012810
           IF      RETCRF              NOT  =   '00'                    EW012820
             MOVE  'UNKNOWN'           TO   HD1ABBR                     EW012830
           ELSE                                                         EW012840
             MOVE  CRFD                TO   SCL                         EW012850
             MOVE  SCLABBR             TO   HD1ABBR.                    EW012860
                                                                        EW012870
           SET     HD11                TO   +15.                        EW012880
       660-REQ.                                                         EW012890
           IF      HD1B         (HD11) =    SPACES                      EW012900
             SET   HD11                DOWN BY  +1                      EW012910
             GO                        TO   660-REQ.                    EW012920
           SET     HD11                UP   BY  +1                      EW012930
           MOVE    '-'                 TO   HD1B         (HD11)         EW012940
           SET     HD11                UP   BY  +1                      EW012950
           MOVE    SRTKREQ1            TO   HD1B         (HD11)         EW012960
           SET     HD11                UP   BY  +1                      EW012970
           MOVE    SRTKREQ2            TO   HD1B         (HD11)         EW012980
           SET     HD11                UP   BY  +1                      EW012990
           MOVE    SRTKREQ3            TO   HD1B         (HD11)         EW013000
           SET     HD11                UP   BY  +1                      EW013010
           MOVE    '-'                 TO   HD1B         (HD11)         EW013020
           SET     HD11                UP   BY  +1                      EW013030
           MOVE    SRTKFY1             TO   HD1B         (HD11)         EW013040
           SET     HD11                UP   BY  +1                      EW013050
           MOVE    SRTKFY2             TO   HD1B         (HD11)         EW013060
                                                                        EW013070
           SET     RQH1                TO   +1.                         EW013080
       660-HEAD.                                                        EW013090
           IF      RQHREQ       (RQH1) NOT  =   HIGH-VALUES             EW013100
             IF      RQHREQ     (RQH1) NOT  =   SRTKREQ                 EW013110
               SET   RQH1              UP   BY  +1                      EW013120
               GO                      TO   660-HEAD                    EW013130
             ELSE                                                       EW013140
               IF      RQHID    (RQH1) =    'H1'                        EW013150
                 MOVE  RQHHEAD  (RQH1) TO   HD2HEAD                     EW013160
                 MOVE  RQHUSER  (RQH1) TO   HD1USER                     EW013170
                 SET   RQH1            UP   BY  +1                      EW013180
                 GO                    TO   660-HEAD                    EW013190
               ELSE                                                     EW013200
                 IF      RQHID  (RQH1) =    'H2'                        EW013210
                   MOVE  RQHHEAD (RQH1) TO  HD3HEAD                     EW013220
                   SET   RQH1          UP   BY  +1                      EW013230
                   GO                  TO   660-HEAD.                   EW013240
           IF      OLDPRT              =    'N'                         EW013250
             MOVE  SPACES              TO   HD2HEAD       HD1USER       EW013260
             MOVE  SPACES              TO   HD3HEAD                     EW013270
           ELSE                                                         EW013280
             IF      OLDPRT            =    'U'                         EW013290
               MOVE  SPACES            TO   HD2HEAD       HD3HEAD       EW013300
             ELSE                                                       EW013310
               IF      OLDPRT          =    'T'                         EW013320
                 MOVE  SPACES          TO   HD1USER.                    EW013330
                                                                        EW013340
           PERFORM 525-HEADS           THRU 525-EXIT                    EW013350
           PERFORM 650-5CHG            THRU 650-EXIT.                   EW013360
       660-EXIT.                                                        EW013370
           EXIT.                                                        EW013380
                                                                        EW013390
       665-6TOT.                                                        EW013400
           MOVE    '0'                 TO   CTLCHAR                     EW013410
           MOVE    'REQUEST'           TO   LN1MSG1                     EW013420
           MOVE    OLDKREQ             TO   LN1REQ                      EW013430
           MOVE    'TOTAL'             TO   LN1MSG2                     EW013440
           MOVE    CTRREQSMP           TO   LN1CNT                      EW013450
           MOVE    'SMP RECORDS WRITTEN' TO LN1MSG3                     EW013460
           PERFORM 520-PRINT           THRU 520-EXIT                    EW013470
           MOVE    'TOTAL'             TO   LN1MSG2                     EW013480
           MOVE    CTRREQSTS           TO   LN1CNT                      EW013490
           MOVE    'STS RECORDS WRITTEN' TO LN1MSG3                     EW013500
           PERFORM 520-PRINT           THRU 520-EXIT                    EW013510
           MOVE    'TOTAL'             TO   LN1MSG2                     EW013520
           MOVE    CTRREQSTH           TO   LN1CNT                      EW013530
           MOVE    'STH RECORDS WRITTEN' TO LN1MSG3                     EW013540
           PERFORM 520-PRINT           THRU 520-EXIT.                   EW013550
       665-EXIT.                                                        EW013560
           EXIT.                                                        EW013570
                                                                        EW013580
      ******************************************************************EW013590
       990-HOUSEKEEPING.                                                EW013600
           PERFORM 510-READ            THRU 510-EXIT                    EW013610
           ACCEPT  SYSDATE             FROM DATE                        EW013620
           MOVE    SYSYY               TO   HD1YY                       EW013630
           MOVE    SYSMM               TO   HD1MM                       EW013640
           MOVE    SYSDD               TO   HD1DD                       EW013650
           ACCEPT  SYSTIME             FROM TIME                        EW013660
           MOVE    SYSHR               TO   HD1HR                       EW013670
           MOVE    SYSMIN              TO   HD1MN                       EW013680
           IF      SRTKEY              =    HIGH-VALUES                 EW013690
             MOVE    ' EW004 NO DATA TO PROCESS'  TO  LNM               EW013700
             PERFORM 520-PRINT         THRU 520-EXIT                    EW013710
             GO                        TO   999-EOJ.                    EW013720
           PERFORM 660-6CHG            THRU 660-EXIT.                   EW013730
       990-EXIT.                                                        EW013740
           EXIT.                                                        EW013750
                                                                        EW013760
      ******************************************************************EW013770
       999-EOJ.                                                         EW013780
           CLOSE                            CRD-CARD      CRF-DISK      EW013790
                                            SWF-DISK      PR1-PRNT      EW013800
                                            STH-DISK      STS-DISK      EW013810
                                            SMP-DISK                    EW013820
       999-EXIT.                                                        EW013830
           EXIT.                                                        EW013840
