00001  IDENTIFICATION DIVISION.                                         07/19/99
00002  PROGRAM-ID.             DTSCSL1.                                 DTSCSL1
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV021
00004  DATE-WRITTEN.           MAY 1994.                                DTSCSL1
00005  DATE-COMPILED.                                                   DTSCSL1
00006      SKIP3                                                        DTSCSL1
00007 *****                                                             DTSCSL1
00008 *                                                                 DTSCSL1
00009 *    FUNCTION:    LMI INQUIRY/UPDATE                                 CL**2
00010 *               SCREEN PROCESSOR.                                 DTSCSL1
00011 *                                                                 DTSCSL1
00012 *                                                                 DTSCSL1
00013 *    MODIFICATION LOG:                                            DTSCSL1
00014 *                                                                 DTSCSL1
00015 *    03/28/99  INITIAL DEVELOPMENT  COPIED FROM MACCSR1              CL**2
00016 *              WORK ORDER:                      PROGRAMMER: ZL1      CL**2
00017 *                                                                 DTSCSL1
00018 *                                                                 DTSCSL1
00019 *    05/27/1999  PICKUP MODIFICATIONS.  ENTRY OF 'PU' IN YRQ.        CL*14
00020 *                REFERENCE: PICKUP DIR          PROGRAMMER: EHH      CL*14
00021 *                                                                    CL*14
00022 *                                                                    CL*14
00023 *    07/19/1999  DISPLAY AND UPDATE SIC AUX CD RATHER THAN           CL*16
00024 *                NAICS AUX CD.                                       CL*16
00025 *                REFERENCE: 07/16/1999 EMAIL    PROGRAMMER: EHH      CL*16
00026 *                           FROM GIL                                 CL*16
00027 *                                                                    CL*16
00028 *    07/19/1999  MODIFICATIONS FOR SEVEN DIGIT DC EMPLOYEE           CL*17
00029 *                COUNT DATA ELEMENTS.                                CL*17
00030 *                REFERENCE: BUG FIX             PROGRAMMER: EHH      CL*17
00031 *                                                                    CL*17
00032 *    07/19/1999  MODIFICATIONS TO BUGGY SIC CODE EDITS AND           CL*17
00033 *                TO BUGGY NAICS CODE EDITS.                          CL*17
00034 *                REFERENCE: BUG FIX             PROGRAMMER: EHH      CL*17
00035 *                                                                    CL*17
00036 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX      CL*17
00037 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX      CL*17
00038 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX      CL*17
00039 *                                                                 DTSCSL1
00040 *                                                                 DTSCSL1
00041 *  DESCRIPTION:                                                   DTSCSL1
00042 *                                                                 DTSCSL1
00043 *    CLEAR:                                                       DTSCSL1
00044 *                                                                 DTSCSL1
00045 *      FIELD DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO).            DTSCSL1
00046 *                                                                 DTSCSL1
00047 *                                                                 DTSCSL1
00048 *    JUMP:                                                        DTSCSL1
00049 *                                                                 DTSCSL1
00050 *      NONE.                                                      DTSCSL1
00051 *                                                                 DTSCSL1
00052 *                                                                 DTSCSL1
00053 *    INQUIRY:                                                     DTSCSL1
00054 *                                                                 DTSCSL1
00055 *      CONTROL FIELD(S): MAP-EMP-NO                               DTSCSL1
00056 *                        MAP-YRQ.                                 DTSCSL1
00057 *                                                                 DTSCSL1
00058 *      JUMP IN:  DISPLAY PAGE OF DATA ASSOCIATED WITH             DTSCSL1
00059 *                  LCCM-EMP-NO AND LCCM-YRQ.                      DTSCSL1
00060 *                                                                 DTSCSL1
00061 *      ENTER, F05, F06, F07, F08: STANDARD PAGING.                DTSCSL1
00062 *                                                                 DTSCSL1
00063 *               DISPLAY SEQUENCE: ASCENDING ON MQTR-YRQ.          DTSCSL1
00064 *                                                                 DTSCSL1
00065 *       PAGE INITIALLY DISPLAYED: LAST.                           DTSCSL1
00066 *                                                                 DTSCSL1
00067 *      IF NO MQTR RECORD EXISTS, THEN SOME SPECIAL PROCESSING     DTSCSL1
00068 *      IS NECESSARY.  SEE THE SCREEN DESCRIPTION.                 DTSCSL1
00069 *                                                                 DTSCSL1
00070 *                                                                 DTSCSL1
00071 *      JUMP OUT:  STANDARD LCCM-EMP-NO MAINTENANCE.               DTSCSL1
00072 *                                                                 DTSCSL1
00073 *                 STANDARD LCCM-YRQ MAINTENANCE.                  DTSCSL1
00074 *                                                                 DTSCSL1
00075 *                                                                 DTSCSL1
00076 *      STORE PAGING CONTROL INFORMATION IN LCCM-SCRL1-HOLD-AREA.     CL**7
00077 *                                                                 DTSCSL1
00078 *                                                                 DTSCSL1
00079 *    UPDATE:                                                      DTSCSL1
00080 *                                                                 DTSCSL1
00081 *      MOD                                                        DTSCSL1
00082 *                                                                 DTSCSL1
00083 *                                                                 DTSCSL1
00084 *    RECORDS READ:                                                DTSCSL1
00085 *                                                                 DTSCSL1
00086 *      MASTER:                                                    DTSCSL1
00087 *                                                                 DTSCSL1
00088 *        MPRF                                                     DTSCSL1
00089 *        MQTR                                                     DTSCSL1
00090 *                                                                 DTSCSL1
00091 *                                                                 DTSCSL1
00092 *      ALTERNATE INDEX:                                           DTSCSL1
00093 *                                                                 DTSCSL1
00094 *        NONE.                                                    DTSCSL1
00095 *                                                                 DTSCSL1
00096 *                                                                 DTSCSL1
00097 *      REFERENCE:                                                 DTSCSL1
00098 *                                                                 DTSCSL1
00099 *        NONE.                                                    DTSCSL1
00100 *                                                                 DTSCSL1
00101 *                                                                 DTSCSL1
00102 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCSL1
00103 *                                                                 DTSCSL1
00104 *        NONE.                                                    DTSCSL1
00105 *                                                                 DTSCSL1
00106 *                                                                 DTSCSL1
00107 *    RECORDS UPDATED:                                             DTSCSL1
00108 *                                                                 DTSCSL1
00109 *      MASTER:                                                    DTSCSL1
00110 *                                                                 DTSCSL1
00111 *        MPRF (REWRITE)                                           DTSCSL1
00112 *        MQTR (REWRITE)                                           DTSCSL1
00113 *                                                                 DTSCSL1
00114 *                                                                 DTSCSL1
00115 *      REFERENCE:                                                 DTSCSL1
00116 *                                                                 DTSCSL1
00117 *        NONE.                                                    DTSCSL1
00118 *                                                                 DTSCSL1
00119 *                                                                 DTSCSL1
00120 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCSL1
00121 *                                                                 DTSCSL1
00122 *        NONE.                                                    DTSCSL1
00123 *                                                                 DTSCSL1
00124 *                                                                 DTSCSL1
00125 *    ON-LINE ACTIVITY FILE RECORDS WRITTEN:                       DTSCSL1
00126 *                                                                 DTSCSL1
00127 *      IF MPRF-SIC-DIVISION IS MODIFIED                           DTSCSL1
00128 *          WRITE DTSIT006 (T006-TRN-CD = 02).                        CL**2
00129 *                                                                 DTSCSL1
00130 *                                                                 DTSCSL1
00131 *    TEMPORARY STORAGE USAGE:                                     DTSCSL1
00132 *                                                                 DTSCSL1
00133 *      NONE                                                       DTSCSL1
00134 *                                                                 DTSCSL1
00135 *                                                                 DTSCSL1
00136 *    MODULES LINKED TO:                                           DTSCSL1
00137 *                                                                 DTSCSL1
00138 *      DTSCU001  DATE EDIT/CONVERSION.                               CL**2
00139 *      DTSCU013  COUNT FROM SCREEN FORMAT/EDIT.                      CL**2
00140 *      DTSCU029  YEAR/QUARTER FROM SCREEN FORMAT/EDIT.               CL*14
00141 *      DTSCU018  EMPLOYER NUMBER FROM SCREEN FORMAT/EDIT.            CL**2
00142 *      DTSCU032  ACCOUNTING CODES EDIT/DESCRIPTION.                  CL**2
00143 *      DTSCU038  R&A CODES EDIT/DESCRIPTION.                         CL**2
00144 *      DTSCU039  R&A SIC EDIT/DESCRIPTION.                           CL**2
00145 *      DTSSU221  MPRF-UPDATE DATA ELEMENT MAINTENANCE.               CL**2
00146 *      DTSCU331  WRITE MAINTENANCE LIST REPORT RECORD.               CL**2
00147 *      DTSCU810  MASTER FILE INPUT/OUTPUT.                           CL**2
00148 *      DTSCU825  ON-LINE ACTIVITY FILE OUTPUT.                       CL**2
00149 *                                                                 DTSCSL1
00150 *                                                                 DTSCSL1
00151 *****                                                             DTSCSL1
00152                                                                   DTSCSL1
00153  ENVIRONMENT DIVISION.                                            DTSCSL1
00154                                                                   DTSCSL1
00155  DATA DIVISION.                                                   DTSCSL1
00156                                                                   DTSCSL1
00157  WORKING-STORAGE SECTION.                                         DTSCSL1
001575 77  PAN-VALET PICTURE X(24) VALUE '021DTSCSL1   07/19/99'.       DTSCSL1
00158                                                                   DTSCSL1
00159  01  WRK-AREA.                                                    DTSCSL1
00160      05  WRK-ABEND-CD                PIC  X(04)  VALUE 'LM1 '.       CL**2
00161                                                                   DTSCSL1
00162      05  WRK-SCR-ID                  PIC  X(02) VALUE 'L1'.          CL**2
00163      05  FILLER REDEFINES WRK-SCR-ID.                             DTSCSL1
00164          10  FILLER                  PIC  X(01).                  DTSCSL1
00165          10  WRK-SCR-ID-N            PIC  9(01).                  DTSCSL1
00166                                                                   DTSCSL1
00167      05  WRK-F03-SCR-ID              PIC  X(02)  VALUE 'L0'.         CL**2
00168                                                                   DTSCSL1
00169      05  ALL-NINES-YRQ               PIC S9(05)  COMP-3           DTSCSL1
00170                                                  VALUE +99999.    DTSCSL1
00171                                                                   DTSCSL1
00172      05  SCR-ACCESS-IND              PIC X(01).                   DTSCSL1
00173          88  SCR-ACCESS-INQ                  VALUE '1'.           DTSCSL1
00174          88  SCR-ACCESS-UPDATE               VALUE '2'.           DTSCSL1
00175                                                                   DTSCSL1
00176      05  CURSOR-SET-IND              PIC X(01).                   DTSCSL1
00177          88  CURSOR-SET-YES                  VALUE 'Y'.           DTSCSL1
00178          88  CURSOR-SET-NO                   VALUE 'N'.           DTSCSL1
00179          88  CURSOR-SET-GOTO                 VALUE 'G'.           DTSCSL1
00180                                                                   DTSCSL1
00181      05  REQ-IND                     PIC X(01).                   DTSCSL1
00182          88  REQ-CURSOR-TO-GOTO              VALUE 'G'.           DTSCSL1
00183          88  REQ-ERROR                       VALUE 'O'.           DTSCSL1
00184          88  REQ-JUMP                        VALUE 'J'.           DTSCSL1
00185          88  REQ-UPDATE                      VALUE 'U'.           DTSCSL1
00186          88  REQ-INQUIRE                     VALUE 'I'.           DTSCSL1
00187          88  REQ-CLEAR                       VALUE 'C'.           DTSCSL1
00188          88  REQ-EDIT                        VALUE 'E'.           DTSCSL1
00189                                                                   DTSCSL1
00190      05  RESP-IND                    PIC X(01).                   DTSCSL1
00191          88  RESP-SEND-MSGONLY               VALUE 'O'.           DTSCSL1
00192          88  RESP-SEND-MAP                   VALUE 'M'.           DTSCSL1
00193          88  RESP-JUMP                       VALUE 'J'.           DTSCSL1
00194          88  RESP-CURSOR-TO-GOTO             VALUE 'G'.           DTSCSL1
00195                                                                   DTSCSL1
00196      05  WRK-MSG-AREA                PIC  X(64).                  DTSCSL1
00197                                                                   DTSCSL1
00198      05  WRK-ATB-AN                  PIC  X(01).                  DTSCSL1
00199      05  WRK-ATB-NUM                 PIC  X(01).                  DTSCSL1
00200                                                                   DTSCSL1
00201      05  COMM-AREA-LENGTH            PIC S9(04)  COMP.            DTSCSL1
00202                                                                   DTSCSL1
00203      05  JUID-MOD-IND                PIC  X(01).                  DTSCSL1
00204          88  JUID-MOD-YES-88                VALUE 'Y'.            DTSCSL1
00205          88  JUID-MOD-NO-88                 VALUE 'N'.            DTSCSL1
00206                                                                   DTSCSL1
00207      05  WRK-KEY-INFO.                                            DTSCSL1
00208          10  WRK-EMP-NO              PIC S9(07)  COMP-3.          DTSCSL1
00209          10  WRK-YRQ                 PIC S9(05)  COMP-3.          DTSCSL1
00210                                                                   DTSCSL1
00211      05  WRK-MPRF-IND                PIC  X(01).                  DTSCSL1
00212          88  WRK-MPRF-YES-88                VALUE 'Y'.            DTSCSL1
00213          88  WRK-MPRF-NO-88                 VALUE 'N'.            DTSCSL1
00214      05  WRK-MQTR-IND                PIC  X(01).                  DTSCSL1
00215          88  WRK-MQTR-YES-88                VALUE 'Y'.            DTSCSL1
00216          88  WRK-MQTR-NO-88                 VALUE 'N'.            DTSCSL1
00217                                                                   DTSCSL1
00218      05  WRK-DISPLAY                 PIC 9(11).                   DTSCSL1
00219                                                                   DTSCSL1
00220      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCSL1
00221          10  FILLER                  PIC X(05).                   DTSCSL1
00222          10  WRK-DISPLAY-EMP-NO-1    PIC X(03).                   DTSCSL1
00223          10  WRK-DISPLAY-EMP-NO-2    PIC X(03).                   DTSCSL1
00224                                                                   DTSCSL1
00225      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCSL1
00226          10  FILLER                  PIC X(06).                   DTSCSL1
00227          10  WRK-DISPLAY-YRQ         PIC X(05).                   DTSCSL1
00228                                                                   DTSCSL1
00229      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCSL1
00230          10  FILLER                  PIC X(05).                   DTSCSL1
00231          10  WRK-DISPLAY-YR          PIC X(02).                   DTSCSL1
00232          10  WRK-DISPLAY-MO          PIC X(02).                   DTSCSL1
00233          10  WRK-DISPLAY-DA          PIC X(02).                   DTSCSL1
00234                                                                   DTSCSL1
00235      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCSL1
00236          10  FILLER                  PIC X(08).                   DTSCSL1
00237          10  WRK-DISPLAY-YRQ-YR      PIC X(02).                   DTSCSL1
00238          10  WRK-DISPLAY-YRQ-Q       PIC X(01).                   DTSCSL1
00239                                                                   DTSCSL1
00240      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCSL1
00241          10  FILLER                  PIC X(02).                      CL*17
00242          10  WRK-CNT-DISPLAY         PIC Z,ZZZ,ZZ9.                  CL*21
00243          10  WRK-CNT-DISPLAY-X REDEFINES                          DTSCSL1
00244              WRK-CNT-DISPLAY         PIC X(09).                      CL*17
00245                                                                   DTSCSL1
00246      05  WRK-EMPL-DATA.                                           DTSCSL1
00247          10  WRK-1ST-MTH-EMPL-CNT                                 DTSCSL1
00248                                          PIC S9(07)       COMP-3.    CL*17
00249              88  WRK-1ST-MTH-NO-ENTRY-88    VALUE +9999999.          CL*17
00250          10  WRK-2ND-MTH-EMPL-CNT                                 DTSCSL1
00251                                          PIC S9(07)       COMP-3.    CL*17
00252              88  WRK-2ND-MTH-NO-ENTRY-88    VALUE +9999999.          CL*17
00253          10  WRK-3RD-MTH-EMPL-CNT                                 DTSCSL1
00254                                          PIC S9(07)       COMP-3.    CL*17
00255              88  WRK-3RD-MTH-NO-ENTRY-88    VALUE +9999999.          CL*17
00256                                                                   DTSCSL1
00257      05  INQUIRY-CONTROL-AREA.                                    DTSCSL1
00258          10  WS-REC-FOUND-IND        PIC  X(01).                  DTSCSL1
00259                                                                   DTSCSL1
00260      05  SCR-HOLD-AREA.                                           DTSCSL1
00261          10  SCR-HOLD-KEY-INFO.                                   DTSCSL1
00262              15  SCR-HOLD-EMP-NO     PIC S9(07)  COMP-3.          DTSCSL1
00263              15  SCR-HOLD-YRQ        PIC S9(05)  COMP-3.          DTSCSL1
00264          10  SCR-HOLD-CURR-PAGE-NUM  PIC S9(04)  COMP.            DTSCSL1
00265          10  FILLER                  PIC  X(11).                  DTSCSL1
00266        SKIP3                                                      DTSCSL1
00267      05  CURR-PAGE-NUM               PIC S9(04)  COMP.            DTSCSL1
00268      EJECT                                                        DTSCSL1
00269  01  MSG-LITERALS.                                                DTSCSL1
00270      05  MSG-PL11-AREA.                                              CL**6
00271          10  FILLER                  PIC  X(04)  VALUE 'PL11'.       CL**6
00272          10  FILLER                  PIC  X(30)                   DTSCSL1
00273                VALUE 'NO QUARTER DATA EXISTS        '.            DTSCSL1
00274          10  FILLER                  PIC  X(30)                   DTSCSL1
00275                VALUE '                              '.            DTSCSL1
00276                                                                   DTSCSL1
00277      EJECT                                                        DTSCSL1
00278  01  L001-COMM-AREA.                                              DTSCSL1
00279  ++INCLUDE DTSIL001                                                  CL**2
00280      EJECT                                                        DTSCSL1
00281  01  L013-COMM-AREA.                                              DTSCSL1
00282  ++INCLUDE DTSIL013                                                  CL**2
00283      EJECT                                                        DTSCSL1
00284  01  L018-COMM-AREA.                                              DTSCSL1
00285  ++INCLUDE DTSIL018                                                  CL**2
00286      EJECT                                                           CL*14
00287  01  L029-COMM-AREA.                                                 CL*14
00288  ++INCLUDE DTSIL029                                                  CL*14
00289      EJECT                                                        DTSCSL1
00290  01  L032-COMM-AREA.                                              DTSCSL1
00291  ++INCLUDE DTSIL032                                                  CL**2
00292      EJECT                                                        DTSCSL1
00293  01  L038-COMM-AREA.                                              DTSCSL1
00294  ++INCLUDE DTSIL038                                                  CL**2
00295      EJECT                                                        DTSCSL1
00296  01  L039-COMM-AREA.                                              DTSCSL1
00297  ++INCLUDE DTSIL039                                                  CL**2
00298      EJECT                                                        DTSCSL1
00299  01  L040-COMM-AREA.                                                 CL**7
00300  ++INCLUDE DTSIL040                                                  CL**7
00301      EJECT                                                           CL**7
00302  01  L221-COMM-AREA.                                              DTSCSL1
00303  ++INCLUDE DTSIL221                                                  CL**2
00304      EJECT                                                        DTSCSL1
00305  01  L331-COMM-AREA.                                              DTSCSL1
00306  ++INCLUDE DTSIL331                                                  CL**2
00307      EJECT                                                        DTSCSL1
00308  01  L805-COMM-AREA.                                              DTSCSL1
00309  ++INCLUDE DTSIL805                                                  CL**2
00310      EJECT                                                        DTSCSL1
00311  01  L810-COMM-AREA.                                              DTSCSL1
00312      05  L810-CONTROL-BLOCK.                                      DTSCSL1
00313  ++INCLUDE DTSIL810                                                  CL**2
00314      EJECT                                                        DTSCSL1
00315      05  MSKL-REC.                                                DTSCSL1
00316  ++INCLUDE DTSIMSKL                                                  CL**2
00317      EJECT                                                        DTSCSL1
00318  01  MPRF-REC.                                                    DTSCSL1
00319  ++INCLUDE DTSIMPRF                                                  CL**2
00320      EJECT                                                        DTSCSL1
00321  01  MQTR-REC.                                                    DTSCSL1
00322  ++INCLUDE DTSIMQTR                                                  CL**2
00323      EJECT                                                        DTSCSL1
00324  01  L825-COMM-AREA.                                              DTSCSL1
00325      05  L825-CONTROL-BLOCK.                                      DTSCSL1
00326  ++INCLUDE DTSIL825                                                  CL**2
00327                                                                   DTSCSL1
00328      05  RSKL-REC.                                                DTSCSL1
00329  ++INCLUDE DTSIRSK1                                                  CL**2
00330      EJECT                                                        DTSCSL1
00331  01  T006-REC.                                                    DTSCSL1
00332  ++INCLUDE DTSIT006                                                  CL**2
00333      EJECT                                                        DTSCSL1
00334  01  L851-COMM-AREA.                                              DTSCSL1
00335  ++INCLUDE DTSIL851                                                  CL**2
00336                                                                   DTSCSL1
00337      05  MAP-AREA REDEFINES L851-MAP-AREA.                        DTSCSL1
00338  ++INCLUDE DTSISL1                                                   CL**2
00339      EJECT                                                        DTSCSL1
00340  01  CATB-LITERALS.                                               DTSCSL1
00341  ++INCLUDE DTSICATB                                                  CL**2
00342                                                                   DTSCSL1
00343  01  CFKD-LITERALS.                                               DTSCSL1
00344  ++INCLUDE DTSICFKD                                                  CL**2
00345                                                                   DTSCSL1
00346  01  CECD-LITERALS.                                               DTSCSL1
00347  ++INCLUDE DTSICECD                                                  CL**2
00348                                                                   DTSCSL1
00349  01  CPCD-LITERALS.                                               DTSCSL1
00350  ++INCLUDE DTSICPCD                                                  CL**2
00351      EJECT                                                        DTSCSL1
00352  LINKAGE SECTION.                                                 DTSCSL1
00353                                                                   DTSCSL1
00354  01  DFHCOMMAREA.                                                 DTSCSL1
00355  ++INCLUDE DTSILCCM                                                  CL**2
00356              15  FILLER REDEFINES LCCM-SCR-HOLD-AREA.             DTSCSL1
00357                  20  LCCM-SCR-HOLD-CONTROL-AREA.                  DTSCSL1
00358                      25  LCCM-SCR-HOLD-EMP-NO                     DTSCSL1
00359                                           PIC S9(07)  COMP-3.     DTSCSL1
00360                      25  LCCM-SCR-HOLD-ABSTIME                    DTSCSL1
00361                                           PIC S9(15)  COMP-3.     DTSCSL1
00362                      25  LCCM-SCR-HOLD-LAST-PAGE-NUM              DTSCSL1
00363                                           PIC S9(04)  COMP.       DTSCSL1
00364                      25  LCCM-SCR-HOLD-LAST-KEY-AREA              DTSCSL1
00365                                           PIC  X(16).             DTSCSL1
00366      EJECT                                                        DTSCSL1
00367 ******************************************************************DTSCSL1
00368 *                                                                *DTSCSL1
00369 ******************************************************************DTSCSL1
00370                                                                   DTSCSL1
00371  PROCEDURE DIVISION.                                              DTSCSL1
00372                                                                   DTSCSL1
00373      MOVE +0 TO WRK-EMP-NO                                        DTSCSL1
00374                 WRK-YRQ.                                          DTSCSL1
00375      SET WRK-MPRF-NO-88 TO TRUE.                                  DTSCSL1
00376                                                                   DTSCSL1
00377      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCSL1
00378                                                                   DTSCSL1
00379      SET CURSOR-SET-NO TO TRUE.                                   DTSCSL1
00380                                                                   DTSCSL1
00381      SET SCR-ACCESS-INQ TO TRUE.                                  DTSCSL1
00382                                                                   DTSCSL1
00383      PERFORM P0100-ACCESS-SEARCH THRU P0100-EXIT                  DTSCSL1
00384          VARYING LCCM-NONUM-IDX FROM 1 BY 1                       DTSCSL1
00385          UNTIL LCCM-NONUM-IDX > LCCM-SCR-NONUM-CNT.               DTSCSL1
00386                                                                   DTSCSL1
00387      MOVE SPACE TO REQ-IND.                                       DTSCSL1
00388                                                                   DTSCSL1
00389      PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT.               DTSCSL1
00390                                                                   DTSCSL1
00391 *-----------------------------------------------------            DTSCSL1
00392 *    P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE           DTSCSL1
00393 *    "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT             DTSCSL1
00394 *    REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE             DTSCSL1
00395 *    OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED.         DTSCSL1
00396 *                                                                 DTSCSL1
00397 *    THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE                DTSCSL1
00398 *    PROCESSED.                                                   DTSCSL1
00399 *                                                                 DTSCSL1
00400 *    THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND,         DTSCSL1
00401 *    INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE            DTSCSL1
00402 *    WORK STATION OPERATOR.                                       DTSCSL1
00403 *-----------------------------------------------------            DTSCSL1
00404                                                                   DTSCSL1
00405      MOVE SPACE TO RESP-IND.                                      DTSCSL1
00406                                                                   DTSCSL1
00407      IF REQ-ERROR                                                 DTSCSL1
00408         PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT               DTSCSL1
00409      ELSE                                                         DTSCSL1
00410      IF REQ-JUMP                                                  DTSCSL1
00411         PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT                DTSCSL1
00412      ELSE                                                         DTSCSL1
00413      IF REQ-CLEAR                                                 DTSCSL1
00414         PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT               DTSCSL1
00415      ELSE                                                         DTSCSL1
00416      IF REQ-CURSOR-TO-GOTO                                        DTSCSL1
00417         PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT              DTSCSL1
00418      ELSE                                                         DTSCSL1
00419      IF REQ-INQUIRE                                               DTSCSL1
00420         PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT             DTSCSL1
00421      ELSE                                                         DTSCSL1
00422      IF REQ-EDIT                                                  DTSCSL1
00423         PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT                DTSCSL1
00424      ELSE                                                         DTSCSL1
00425      IF REQ-UPDATE                                                DTSCSL1
00426         PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT              DTSCSL1
00427      ELSE                                                         DTSCSL1
00428         GO TO S899-ABEND.                                         DTSCSL1
00429                                                                   DTSCSL1
00430 *-----------------------------------------------------            DTSCSL1
00431 *    THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED             DTSCSL1
00432 *    IN RESP-IND THE TYPE OF RESPONSE TO BE MADE.                 DTSCSL1
00433 *-----------------------------------------------------            DTSCSL1
00434                                                                   DTSCSL1
00435      IF RESP-SEND-MAP                                             DTSCSL1
00436          PERFORM S9300-SEND-MAP THRU S9300-EXIT                   DTSCSL1
00437          SET LCCM-END-TASK-88 TO TRUE                             DTSCSL1
00438      ELSE                                                         DTSCSL1
00439      IF RESP-SEND-MSGONLY                                         DTSCSL1
00440          PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT              DTSCSL1
00441          SET LCCM-END-TASK-88 TO TRUE                             DTSCSL1
00442      ELSE                                                         DTSCSL1
00443      IF RESP-JUMP                                                 DTSCSL1
00444          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCSL1
00445      ELSE                                                         DTSCSL1
00446      IF RESP-CURSOR-TO-GOTO                                       DTSCSL1
00447          PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT              DTSCSL1
00448          SET LCCM-END-TASK-88 TO TRUE                             DTSCSL1
00449      ELSE                                                         DTSCSL1
00450          GO TO S899-ABEND.                                        DTSCSL1
00451                                                                   DTSCSL1
00452  MAINLINE-EXIT.                                                   DTSCSL1
00453                                                                   DTSCSL1
00454      EXEC CICS                                                    DTSCSL1
00455          RETURN                                                   DTSCSL1
00456      END-EXEC.                                                    DTSCSL1
00457                                                                   DTSCSL1
00458 *    GOBACK.                                                      DTSCSL1
00459      SKIP3                                                        DTSCSL1
00460  P0100-ACCESS-SEARCH.                                             DTSCSL1
00461      IF LCCM-SCR-NONUM-ID (LCCM-NONUM-IDX) = WRK-SCR-ID           DTSCSL1
00462          MOVE LCCM-SCR-NONUM-ACCESS-IND (LCCM-NONUM-IDX)          DTSCSL1
00463            TO SCR-ACCESS-IND.                                     DTSCSL1
00464  P0100-EXIT.                                                      DTSCSL1
00465      EXIT.                                                        DTSCSL1
00466      EJECT                                                        DTSCSL1
00467 /*****************************************************************DTSCSL1
00468 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION         *DTSCSL1
00469 ******************************************************************DTSCSL1
00470  P1000-ANALYZE-REQUEST.                                           DTSCSL1
00471                                                                   DTSCSL1
00472 *-----------------------------------------------------            DTSCSL1
00473 *     IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE)         DTSCSL1
00474 *     THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE               DTSCSL1
00475 *     REPLACED WITH ENTER)                                        DTSCSL1
00476 *-----------------------------------------------------            DTSCSL1
00477      IF LCCM-SCR-ID NOT = WRK-SCR-ID                              DTSCSL1
00478          MOVE LOW-VALUE TO LCCM-SCR-HOLD-AREA                     DTSCSL1
00479                                                                   DTSCSL1
00480          SET LCCM-ENTER-88 TO TRUE                                DTSCSL1
00481          IF LCCM-EMP-NO = +0                                      DTSCSL1
00482              MOVE +0 TO LCCM-YRQ                                  DTSCSL1
00483              MOVE PMSG-KEY-EMP-NO TO LCCM-MSG-AREA                DTSCSL1
00484              SET REQ-CLEAR TO TRUE                                DTSCSL1
00485          ELSE                                                     DTSCSL1
00486              SET REQ-INQUIRE TO TRUE                              DTSCSL1
00487              MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1                   DTSCSL1
00488              MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2                   DTSCSL1
00489              PERFORM P1200-CHECK-LCCM-YRQ THRU P1200-EXIT         DTSCSL1
00490          END-IF                                                   DTSCSL1
00491          GO TO P1000-EXIT.                                        DTSCSL1
00492                                                                   DTSCSL1
00493 *-----------------------------------------------------            DTSCSL1
00494 *      MAP IS RECEIVED                                            DTSCSL1
00495 *-----------------------------------------------------            DTSCSL1
00496      PERFORM S9100-RECEIVE THRU S9100-EXIT.                       DTSCSL1
00497                                                                   DTSCSL1
00498 *-----------------------------------------------------            DTSCSL1
00499 *    CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE            DTSCSL1
00500 *    WORK STATION                                                 DTSCSL1
00501 *-----------------------------------------------------            DTSCSL1
00502      IF LCCM-CLEAR-88                                             DTSCSL1
00503         SET REQ-CLEAR TO TRUE                                     DTSCSL1
00504         GO TO P1000-EXIT.                                         DTSCSL1
00505                                                                   DTSCSL1
00506 *-----------------------------------------------------            DTSCSL1
00507 *    IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED             DTSCSL1
00508 *-----------------------------------------------------            DTSCSL1
00509      IF LCCM-SCR-UPDATE-LOCKED                                    DTSCSL1
00510         PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT               DTSCSL1
00511         GO TO P1000-EXIT.                                         DTSCSL1
00512                                                                   DTSCSL1
00513 *-----------------------------------------------------            DTSCSL1
00514 *    PA2 IS A REQUEST TO POSITION CURSOR AT GO TO:                DTSCSL1
00515 *-----------------------------------------------------            DTSCSL1
00516      IF LCCM-PA2-88                                               DTSCSL1
00517          SET REQ-CURSOR-TO-GOTO TO TRUE                           DTSCSL1
00518          GO TO P1000-EXIT.                                        DTSCSL1
00519                                                                   DTSCSL1
00520 *-----------------------------------------------------            DTSCSL1
00521 *    ALL OTHER PA KEYS ARE NOT ACTIVE                             DTSCSL1
00522 *-----------------------------------------------------            DTSCSL1
00523      IF LCCM-PA-88                                                DTSCSL1
00524        PERFORM S804-INVALID-KEY THRU S804-EXIT                    DTSCSL1
00525        SET REQ-ERROR TO TRUE                                      DTSCSL1
00526        GO TO P1000-EXIT.                                          DTSCSL1
00527                                                                   DTSCSL1
00528 *-----------------------------------------------------               CL**2
00529 *    IF F12 KEY IS PRESSED AND UPDATE NOT IN PROGRESS                CL**2
00530 *    CLEAR SCREEN                                                    CL**2
00531 *-----------------------------------------------------               CL**2
00532      IF LCCM-F12-88                                                  CL**2
00533         MOVE LOW-VALUES TO MAP-AREA                                  CL**2
00534         SET REQ-CLEAR TO TRUE                                        CL**2
00535         GO TO P1000-EXIT.                                            CL**2
00536                                                                      CL**2
00537 *-----------------------------------------------------            DTSCSL1
00538 *    IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION            DTSCSL1
00539 *-----------------------------------------------------            DTSCSL1
00540      IF LCCM-F03-88                                               DTSCSL1
00541         MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID                    DTSCSL1
00542         SET REQ-JUMP TO TRUE                                      DTSCSL1
00543         GO TO P1000-EXIT.                                         DTSCSL1
00544                                                                   DTSCSL1
00545 *-----------------------------------------------------            DTSCSL1
00546 *    IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN         DTSCSL1
00547 *-----------------------------------------------------            DTSCSL1
00548      IF LCCM-F04-88                                               DTSCSL1
00549         MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID                 DTSCSL1
00550         SET REQ-JUMP TO TRUE                                      DTSCSL1
00551         GO TO P1000-EXIT.                                         DTSCSL1
00552                                                                   DTSCSL1
00553 *---------------------------------------------------------        DTSCSL1
00554 *    IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO                DTSCSL1
00555 *    CORRESPONDENCE SCREEN.                                       DTSCSL1
00556 *---------------------------------------------------------        DTSCSL1
00557                                                                      CL*13
00558      IF LCCM-F14-88                                                  CL*13
00559         MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID                     CL*13
00560         SET REQ-JUMP TO TRUE                                         CL*13
00561         GO TO P1000-EXIT.                                            CL*13
00562                                                                      CL*13
00563 *-----------------------------------------------------            DTSCSL1
00564 *    IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO               DTSCSL1
00565 *    REQUESTED SCREEN TYPE                                        DTSCSL1
00566 *-----------------------------------------------------            DTSCSL1
00567      IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID             DTSCSL1
00568         NEXT SENTENCE                                             DTSCSL1
00569      ELSE                                                         DTSCSL1
00570        MOVE MAP-GOTO TO LCCM-REQ-SCR-ID                           DTSCSL1
00571        SET REQ-JUMP TO TRUE                                       DTSCSL1
00572        GO TO P1000-EXIT.                                          DTSCSL1
00573                                                                   DTSCSL1
00574 *-----------------------------------------------------            DTSCSL1
00575 *    IF REQUEST TO UPDATE THE DATA (MOD)                          DTSCSL1
00576 *          VERIFY USER ACCESS TO PERFORM UPDATE                   DTSCSL1
00577 *-----------------------------------------------------            DTSCSL1
00578      IF LCCM-F10-88                                               DTSCSL1
00579         IF SCR-ACCESS-UPDATE                                      DTSCSL1
00580            SET REQ-EDIT TO TRUE                                   DTSCSL1
00581            GO TO P1000-EXIT                                       DTSCSL1
00582         ELSE                                                      DTSCSL1
00583            PERFORM S804-INVALID-KEY THRU S804-EXIT                DTSCSL1
00584            SET REQ-ERROR TO TRUE                                  DTSCSL1
00585            GO TO P1000-EXIT.                                      DTSCSL1
00586                                                                   DTSCSL1
00587 *-----------------------------------------------------            DTSCSL1
00588 *    IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7,              DTSCSL1
00589 *          OR F8), INDICATE INQUIRY REQUEST                       DTSCSL1
00590 *-----------------------------------------------------            DTSCSL1
00591      IF LCCM-INQUIRY-88                                           DTSCSL1
00592          SET REQ-INQUIRE TO TRUE                                  DTSCSL1
00593          GO TO P1000-EXIT.                                        DTSCSL1
00594                                                                   DTSCSL1
00595 *-----------------------------------------------------            DTSCSL1
00596 *     ANY OTHER KEY IS INVALID                                    DTSCSL1
00597 *-----------------------------------------------------            DTSCSL1
00598      PERFORM S804-INVALID-KEY THRU S804-EXIT.                     DTSCSL1
00599      SET REQ-ERROR TO TRUE.                                       DTSCSL1
00600  P1000-EXIT.                                                      DTSCSL1
00601      EXIT.                                                        DTSCSL1
00602      SKIP3                                                        DTSCSL1
00603  P1100-UPDATE-LOCKED.                                             DTSCSL1
00604 *-----------------------------------------------------            DTSCSL1
00605 *    IF THE SCREEN IS "LOCKED FOR UPDATE", THEN                   DTSCSL1
00606 *    THE ONLY VALID OPERATOR REQUESTS ARE ENTER                   DTSCSL1
00607 *    (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE).              DTSCSL1
00608 *-----------------------------------------------------            DTSCSL1
00609      IF LCCM-ENTER-88 OR LCCM-F12-88                              DTSCSL1
00610         SET REQ-UPDATE TO TRUE                                    DTSCSL1
00611      ELSE                                                         DTSCSL1
00612         SET REQ-ERROR TO TRUE                                     DTSCSL1
00613         IF LCCM-SCR-MOD-LOCKED                                    DTSCSL1
00614            MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-AREA                 DTSCSL1
00615         ELSE                                                      DTSCSL1
00616            GO TO S899-ABEND.                                      DTSCSL1
00617  P1100-EXIT.                                                      DTSCSL1
00618      EXIT.                                                        DTSCSL1
00619      EJECT                                                        DTSCSL1
00620  P1200-CHECK-LCCM-YRQ.                                            DTSCSL1
00621      IF LCCM-YRQ = ALL-NINES-YRQ                                  DTSCSL1
00622          MOVE +0 TO LCCM-YRQ                                      DTSCSL1
00623          GO TO P1200-EXIT.                                        DTSCSL1
00624                                                                   DTSCSL1
00625      IF LCCM-YRQ > +0                                             DTSCSL1
00626          IF LCCM-YRQ >= LCCM-PICKUP-YRQ                              CL*15
00627              PERFORM P1210-DISPLAY-YRQ THRU P1210-EXIT               CL*15
00628              GO TO P1200-EXIT                                        CL*15
00629          ELSE                                                        CL*15
00630              MOVE +0 TO LCCM-YRQ                                     CL*15
00631              GO TO P1200-EXIT.                                       CL*15
00632                                                                   DTSCSL1
00633      MOVE LCCM-SCRL1-HOLD-AREA TO SCR-HOLD-AREA.                     CL**7
00634                                                                   DTSCSL1
00635      IF SCR-HOLD-AREA NOT = LOW-VALUES                            DTSCSL1
00636          IF SCR-HOLD-EMP-NO = LCCM-EMP-NO                         DTSCSL1
00637              IF SCR-HOLD-YRQ > +0                                 DTSCSL1
00638                  MOVE SCR-HOLD-YRQ TO LCCM-YRQ                    DTSCSL1
00639                  PERFORM P1210-DISPLAY-YRQ THRU P1210-EXIT.       DTSCSL1
00640  P1200-EXIT.                                                      DTSCSL1
00641      EXIT.                                                        DTSCSL1
00642                                                                   DTSCSL1
00643  P1210-DISPLAY-YRQ.                                               DTSCSL1
00644      IF LCCM-YRQ = LCCM-PICKUP-YRQ                                   CL*15
00645          MOVE 'PU' TO MAP-YRQ-YR                                     CL*15
00646          MOVE ' ' TO MAP-YRQ-Q                                       CL*15
00647      ELSE                                                            CL*15
00648          MOVE LCCM-YRQ TO WRK-DISPLAY                                CL*15
00649          MOVE WRK-DISPLAY-YRQ-YR TO MAP-YRQ-YR                       CL*15
00650          MOVE WRK-DISPLAY-YRQ-Q  TO MAP-YRQ-Q.                       CL*15
00651  P1210-EXIT.                                                      DTSCSL1
00652      EXIT.                                                        DTSCSL1
00653 /*****************************************************************DTSCSL1
00654 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCSL1
00655 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN.                      *DTSCSL1
00656 ******************************************************************DTSCSL1
00657                                                                   DTSCSL1
00658  P2000-REQUEST-ERROR.                                             DTSCSL1
00659      IF LCCM-MSG                                                  DTSCSL1
00660         SET RESP-SEND-MSGONLY TO TRUE                             DTSCSL1
00661      ELSE                                                         DTSCSL1
00662         GO TO S899-ABEND.                                         DTSCSL1
00663  P2000-EXIT.                                                      DTSCSL1
00664      EXIT.                                                        DTSCSL1
00665 /*****************************************************************DTSCSL1
00666 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED                  *DTSCSL1
00667 ******************************************************************DTSCSL1
00668                                                                   DTSCSL1
00669  P3000-REQUEST-JUMP.                                              DTSCSL1
00670 *-----------------------------------------------------            DTSCSL1
00671 *    VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE    DTSCSL1
00672 *    BY USER                                                      DTSCSL1
00673 *-----------------------------------------------------            DTSCSL1
00674      PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT.                 DTSCSL1
00675                                                                   DTSCSL1
00676 *-----------------------------------------------------            DTSCSL1
00677 *    VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED               DTSCSL1
00678 *-----------------------------------------------------            DTSCSL1
00679      IF LCCM-MSG                                                  DTSCSL1
00680         SET RESP-SEND-MSGONLY TO TRUE                             DTSCSL1
00681         SET CURSOR-SET-GOTO TO TRUE                               DTSCSL1
00682         GO TO P3000-EXIT.                                         DTSCSL1
00683      SKIP3                                                        DTSCSL1
00684      MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA.                  DTSCSL1
00685      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCSL1
00686      IF L018-VALID                                                DTSCSL1
00687          MOVE L018-EMP-NO TO LCCM-EMP-NO                          DTSCSL1
00688                                                                   DTSCSL1
00689          MOVE MAP-YRQ-AREA TO L029-S-YRQ-AREA                        CL*14
00690          PERFORM S029-YRQ-FROM-SCREEN THRU S029-EXIT                 CL*14
00691          IF L029-VALID                                               CL*14
00692              MOVE L029-YRQ TO LCCM-YRQ.                              CL*14
00693                                                                   DTSCSL1
00694 *-----------------------------------------------------            DTSCSL1
00695 *    CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING      DTSCSL1
00696 *-----------------------------------------------------            DTSCSL1
00697      MOVE LOW-VALUES TO LCCM-SCR-STATUS                           DTSCSL1
00698                         LCCM-SCR-HOLD-AREA.                       DTSCSL1
00699      MOVE +0 TO LCCM-SCR-ABSTIME.                                 DTSCSL1
00700      SET RESP-JUMP TO TRUE.                                       DTSCSL1
00701  P3000-EXIT.                                                      DTSCSL1
00702      EXIT.                                                        DTSCSL1
00703 /*****************************************************************DTSCSL1
00704 * CLEAR KEY WAS PRESSED                                          *DTSCSL1
00705 ******************************************************************DTSCSL1
00706                                                                   DTSCSL1
00707  P4000-REQUEST-CLEAR.                                             DTSCSL1
00708 *-----------------------------------------------------            DTSCSL1
00709 *   CLEAN UP INDICATORS AND PAGING STORAGE.  RESET KEY            DTSCSL1
00710 *   FIELDS FROM EARLIER REQUESTS                                  DTSCSL1
00711 *-----------------------------------------------------            DTSCSL1
00712      IF LCCM-EMP-NO > ZERO                                        DTSCSL1
00713          MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1                       DTSCSL1
00714          MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2.                      DTSCSL1
00715                                                                   DTSCSL1
00716      MOVE ZERO TO LCCM-EMP-NO                                     DTSCSL1
00717                   LCCM-YRQ.                                       DTSCSL1
00718                                                                   DTSCSL1
00719      MOVE LOW-VALUES TO LCCM-SCRL1-HOLD-AREA.                        CL**7
00720                                                                   DTSCSL1
00721      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCSL1
00722                                                                   DTSCSL1
00723      PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT.                 DTSCSL1
00724                                                                   DTSCSL1
00725      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCSL1
00726                                                                   DTSCSL1
00727      SET RESP-SEND-MAP TO TRUE.                                   DTSCSL1
00728  P4000-EXIT.                                                      DTSCSL1
00729      EXIT.                                                        DTSCSL1
00730 /*****************************************************************DTSCSL1
00731 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED                   *DTSCSL1
00732 ******************************************************************DTSCSL1
00733                                                                   DTSCSL1
00734  P5000-CURSOR-TO-GOTO.                                            DTSCSL1
00735      SET CURSOR-SET-GOTO TO TRUE.                                 DTSCSL1
00736      SET RESP-CURSOR-TO-GOTO TO TRUE.                             DTSCSL1
00737  P5000-EXIT.                                                      DTSCSL1
00738      EXIT.                                                        DTSCSL1
00739 /*****************************************************************DTSCSL1
00740 * INQUIRY WAS REQUESTED                                          *DTSCSL1
00741 ******************************************************************DTSCSL1
00742                                                                   DTSCSL1
00743  P6000-REQUEST-INQUIRE.                                           DTSCSL1
00744      MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA.                  DTSCSL1
00745      MOVE MAP-YRQ-AREA    TO L029-S-YRQ-AREA.                        CL*14
00746      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCSL1
00747      MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA.                  DTSCSL1
00748      MOVE L029-S-YRQ-AREA    TO MAP-YRQ-AREA.                        CL*14
00749                                                                   DTSCSL1
00750      PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT.                 DTSCSL1
00751                                                                   DTSCSL1
00752      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCSL1
00753                                                                   DTSCSL1
00754      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCSL1
00755                                                                   DTSCSL1
00756      SET RESP-SEND-MAP TO TRUE.                                   DTSCSL1
00757                                                                   DTSCSL1
00758      PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT.                 DTSCSL1
00759                                                                   DTSCSL1
00760      MOVE LCCM-SCRL1-HOLD-AREA TO SCR-HOLD-AREA.                     CL**7
00761                                                                   DTSCSL1
00762      MOVE LOW-VALUES TO LCCM-SCRL1-HOLD-AREA.                        CL**7
00763                                                                   DTSCSL1
00764      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCSL1
00765      IF LCCM-NO-MSG                                               DTSCSL1
00766          PERFORM S1110-READ-MPRF THRU S1110-EXIT.                 DTSCSL1
00767          IF LCCM-NO-MSG                                           DTSCSL1
00768              MOVE WRK-EMP-NO TO LCCM-EMP-NO.                      DTSCSL1
00769                                                                   DTSCSL1
00770      PERFORM S2101-YRQ THRU S2101-EXIT.                           DTSCSL1
00771      IF LCCM-MSG                                                  DTSCSL1
00772          GO TO P6000-EXIT.                                        DTSCSL1
00773                                                                   DTSCSL1
00774      MOVE WRK-YRQ TO LCCM-YRQ.                                    DTSCSL1
00775      SKIP3                                                        DTSCSL1
00776      IF (LCCM-SCR-HOLD-CONTROL-AREA = LOW-VALUES)                 DTSCSL1
00777               OR                                                  DTSCSL1
00778         (WRK-EMP-NO NOT = LCCM-SCR-HOLD-EMP-NO)                   DTSCSL1
00779               OR                                                  DTSCSL1
00780         (LCCM-SCR-HOLD-ABSTIME < MPRF-UPDATE-END-ABSTIME)         DTSCSL1
00781          PERFORM P6200-REFRESH-LCCM-SCR-HOLD THRU P6200-EXIT.     DTSCSL1
00782      SKIP3                                                        DTSCSL1
00783      PERFORM P6100-LOCATE-REC THRU P6100-EXIT.                    DTSCSL1
00784                                                                   DTSCSL1
00785      IF LCCM-MSG                                                  DTSCSL1
00786          GO TO P6000-EXIT.                                        DTSCSL1
00787      SKIP3                                                        DTSCSL1
00788      PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT.              DTSCSL1
00789      SKIP3                                                        DTSCSL1
00790      MOVE LOW-VALUES TO SCR-HOLD-AREA.                            DTSCSL1
00791                                                                   DTSCSL1
00792      MOVE WRK-EMP-NO TO SCR-HOLD-EMP-NO.                          DTSCSL1
00793                                                                   DTSCSL1
00794      MOVE WRK-YRQ TO SCR-HOLD-YRQ                                 DTSCSL1
00795                      LCCM-YRQ.                                    DTSCSL1
00796                                                                   DTSCSL1
00797      MOVE CURR-PAGE-NUM TO SCR-HOLD-CURR-PAGE-NUM.                DTSCSL1
00798                                                                   DTSCSL1
00799      MOVE SCR-HOLD-AREA TO LCCM-SCRL1-HOLD-AREA.                     CL**7
00800      SKIP3                                                        DTSCSL1
00801      SET LCCM-SCR-INQUIRE TO TRUE.                                DTSCSL1
00802                                                                   DTSCSL1
00803      IF SCR-ACCESS-UPDATE                                         DTSCSL1
00804          PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.          DTSCSL1
00805  P6000-EXIT.                                                      DTSCSL1
00806      EXIT.                                                        DTSCSL1
00807      EJECT                                                        DTSCSL1
00808  P6100-LOCATE-REC.                                                DTSCSL1
00809      IF LCCM-SCR-HOLD-LAST-PAGE-NUM = +0                          DTSCSL1
00810          MOVE +0 TO WRK-YRQ                                       DTSCSL1
00811                     CURR-PAGE-NUM                                 DTSCSL1
00812          GO TO P6100-EXIT.                                        DTSCSL1
00813      SKIP3                                                        DTSCSL1
00814      IF LCCM-F05-88                                               DTSCSL1
00815          PERFORM P6110-FIRST-REC THRU P6110-EXIT                  DTSCSL1
00816          GO TO P6100-EXIT.                                        DTSCSL1
00817      SKIP3                                                        DTSCSL1
00818      IF LCCM-F06-88                                               DTSCSL1
00819          PERFORM P6140-LAST-REC THRU P6140-EXIT                   DTSCSL1
00820          GO TO P6100-EXIT.                                        DTSCSL1
00821      SKIP3                                                        DTSCSL1
00822      IF WRK-YRQ = +0                                              DTSCSL1
00823          PERFORM P6150-DEFAULT-REC THRU P6150-EXIT                DTSCSL1
00824          GO TO P6100-EXIT.                                        DTSCSL1
00825      SKIP3                                                        DTSCSL1
00826      MOVE LOW-VALUES TO MQTR-KEY-AREA.                            DTSCSL1
00827      MOVE WRK-EMP-NO TO MQTR-EMP-NO.                              DTSCSL1
00828      SET MQTR-QTR-88 TO TRUE.                                     DTSCSL1
00829      MOVE WRK-YRQ TO MQTR-YRQ.                                    DTSCSL1
00830                                                                   DTSCSL1
00831      IF (SCR-HOLD-KEY-INFO = WRK-KEY-INFO)                        DTSCSL1
00832              AND                                                  DTSCSL1
00833         (SCR-HOLD-CURR-PAGE-NUM NOT = +0)                         DTSCSL1
00834          MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA                      DTSCSL1
00835          PERFORM S810-START-BROWSE THRU S810-EXIT                 DTSCSL1
00836          IF L810-OK-88                                            DTSCSL1
00837              IF MSKL-KEY-AREA = MQTR-KEY-AREA                     DTSCSL1
00838                  MOVE SCR-HOLD-CURR-PAGE-NUM TO CURR-PAGE-NUM     DTSCSL1
00839                  MOVE MSKL-REC TO MQTR-REC                        DTSCSL1
00840                  IF LCCM-ENTER-88                                 DTSCSL1
00841                      PERFORM S810-END-BROWSE THRU S810-EXIT       DTSCSL1
00842                      GO TO P6100-EXIT                             DTSCSL1
00843                  ELSE                                             DTSCSL1
00844                  IF LCCM-F07-88                                   DTSCSL1
00845                      PERFORM P6120-PREV-REC THRU P6120-EXIT       DTSCSL1
00846                      GO TO P6100-EXIT                             DTSCSL1
00847                  ELSE                                             DTSCSL1
00848                  IF LCCM-F08-88                                   DTSCSL1
00849                      PERFORM P6130-NEXT-REC THRU P6130-EXIT       DTSCSL1
00850                      GO TO P6100-EXIT                             DTSCSL1
00851                  ELSE                                             DTSCSL1
00852                      GO TO S899-ABEND                             DTSCSL1
00853              ELSE                                                 DTSCSL1
00854                  PERFORM S810-END-BROWSE THRU S810-EXIT.          DTSCSL1
00855      SKIP3                                                        DTSCSL1
00856      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSCSL1
00857                                                                   DTSCSL1
00858      MOVE WRK-EMP-NO TO MSKL-EMP-NO.                              DTSCSL1
00859                                                                   DTSCSL1
00860      SET MSKL-QTR-88 TO TRUE.                                     DTSCSL1
00861                                                                   DTSCSL1
00862      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCSL1
00863                                                                   DTSCSL1
00864      IF L810-NO-REC-88                                            DTSCSL1
00865          MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                      DTSCSL1
00866          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCSL1
00867          GO TO P6100-EXIT.                                        DTSCSL1
00868      SKIP3                                                        DTSCSL1
00869      MOVE +0 TO CURR-PAGE-NUM.                                    DTSCSL1
00870                                                                   DTSCSL1
00871      MOVE 'N' TO WS-REC-FOUND-IND.                                DTSCSL1
00872                                                                   DTSCSL1
00873      PERFORM P6190-BROWSE-MQTR THRU P6190-EXIT                    DTSCSL1
00874          UNTIL (L810-NO-REC-88)                                   DTSCSL1
00875                    OR                                             DTSCSL1
00876                (WS-REC-FOUND-IND = 'Y').                          DTSCSL1
00877      SKIP3                                                        DTSCSL1
00878      IF L810-NO-REC-88                                            DTSCSL1
00879          IF LCCM-ENTER-88                                         DTSCSL1
00880              MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                  DTSCSL1
00881              PERFORM S2199-ERROR THRU S2199-EXIT                  DTSCSL1
00882          ELSE                                                     DTSCSL1
00883              PERFORM P6140-LAST-REC THRU P6140-EXIT               DTSCSL1
00884      ELSE                                                         DTSCSL1
00885          IF LCCM-ENTER-88                                         DTSCSL1
00886              PERFORM S810-END-BROWSE THRU S810-EXIT               DTSCSL1
00887              IF MQTR-YRQ = WRK-YRQ                                DTSCSL1
00888                  NEXT SENTENCE                                    DTSCSL1
00889              ELSE                                                 DTSCSL1
00890                  MOVE EMSG-NO-RECORD TO WRK-MSG-AREA              DTSCSL1
00891                  PERFORM S2199-ERROR THRU S2199-EXIT              DTSCSL1
00892          ELSE                                                     DTSCSL1
00893          IF LCCM-F07-88                                           DTSCSL1
00894              PERFORM P6120-PREV-REC THRU P6120-EXIT               DTSCSL1
00895          ELSE                                                     DTSCSL1
00896          IF LCCM-F08-88                                           DTSCSL1
00897              PERFORM P6130-NEXT-REC THRU P6130-EXIT               DTSCSL1
00898          ELSE                                                     DTSCSL1
00899              GO TO S899-ABEND.                                    DTSCSL1
00900  P6100-EXIT.                                                      DTSCSL1
00901      EXIT.                                                        DTSCSL1
00902      SKIP3                                                        DTSCSL1
00903  P6110-FIRST-REC.                                                 DTSCSL1
00904      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSCSL1
00905      MOVE WRK-EMP-NO TO MSKL-EMP-NO.                              DTSCSL1
00906      SET MSKL-QTR-88 TO TRUE.                                     DTSCSL1
00907      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCSL1
00908      IF L810-NO-REC-88                                            DTSCSL1
00909          MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                      DTSCSL1
00910          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCSL1
00911          GO TO P6110-EXIT.                                        DTSCSL1
00912      SKIP3                                                        DTSCSL1
00913      PERFORM S810-END-BROWSE THRU S810-EXIT.                      DTSCSL1
00914                                                                   DTSCSL1
00915      MOVE MSKL-REC TO MQTR-REC.                                   DTSCSL1
00916                                                                   DTSCSL1
00917      MOVE MQTR-YRQ TO WRK-YRQ.                                    DTSCSL1
00918                                                                   DTSCSL1
00919      MOVE +1 TO CURR-PAGE-NUM.                                    DTSCSL1
00920  P6110-EXIT.                                                      DTSCSL1
00921      EXIT.                                                        DTSCSL1
00922      SKIP3                                                        DTSCSL1
00923  P6120-PREV-REC.                                                  DTSCSL1
00924      PERFORM S810-READ-PREV THRU S810-EXIT.                       DTSCSL1
00925      IF L810-NO-REC-88                                            DTSCSL1
00926          MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                      DTSCSL1
00927          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCSL1
00928          GO TO P6120-EXIT.                                        DTSCSL1
00929      SKIP3                                                        DTSCSL1
00930      PERFORM S810-READ-PREV THRU S810-EXIT.                       DTSCSL1
00931      IF L810-NO-REC-88                                            DTSCSL1
00932          MOVE MQTR-YRQ TO WRK-YRQ                                 DTSCSL1
00933          GO TO P6120-EXIT.                                        DTSCSL1
00934      SKIP3                                                        DTSCSL1
00935      PERFORM S810-END-BROWSE THRU S810-EXIT.                      DTSCSL1
00936                                                                   DTSCSL1
00937      MOVE MSKL-REC TO MQTR-REC.                                   DTSCSL1
00938                                                                   DTSCSL1
00939      IF CURR-PAGE-NUM > +0                                        DTSCSL1
00940          SUBTRACT 1 FROM CURR-PAGE-NUM.                           DTSCSL1
00941                                                                   DTSCSL1
00942      MOVE MQTR-YRQ TO WRK-YRQ.                                    DTSCSL1
00943  P6120-EXIT.                                                      DTSCSL1
00944      EXIT.                                                        DTSCSL1
00945      SKIP3                                                        DTSCSL1
00946  P6130-NEXT-REC.                                                  DTSCSL1
00947      IF MQTR-YRQ > WRK-YRQ                                        DTSCSL1
00948          PERFORM S810-END-BROWSE THRU S810-EXIT                   DTSCSL1
00949          MOVE MQTR-YRQ TO WRK-YRQ                                 DTSCSL1
00950          GO TO P6130-EXIT.                                        DTSCSL1
00951      SKIP3                                                        DTSCSL1
00952      PERFORM S810-READ-NEXT THRU S810-EXIT.                       DTSCSL1
00953                                                                   DTSCSL1
00954      IF L810-NO-REC-88                                            DTSCSL1
00955          MOVE MQTR-YRQ TO WRK-YRQ                                 DTSCSL1
00956          GO TO P6130-EXIT.                                        DTSCSL1
00957      SKIP3                                                        DTSCSL1
00958      PERFORM S810-END-BROWSE THRU S810-EXIT.                      DTSCSL1
00959                                                                   DTSCSL1
00960      IF CURR-PAGE-NUM  < LCCM-SCR-HOLD-LAST-PAGE-NUM              DTSCSL1
00961          ADD +1 TO CURR-PAGE-NUM.                                 DTSCSL1
00962                                                                   DTSCSL1
00963      MOVE MSKL-REC TO MQTR-REC.                                   DTSCSL1
00964                                                                   DTSCSL1
00965      MOVE MQTR-YRQ TO WRK-YRQ.                                    DTSCSL1
00966  P6130-EXIT.                                                      DTSCSL1
00967      EXIT.                                                        DTSCSL1
00968      SKIP3                                                        DTSCSL1
00969  P6140-LAST-REC.                                                  DTSCSL1
00970      IF LCCM-SCR-HOLD-LAST-KEY-AREA = LOW-VALUES                  DTSCSL1
00971          MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                      DTSCSL1
00972          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCSL1
00973          GO TO P6140-EXIT.                                        DTSCSL1
00974                                                                   DTSCSL1
00975      MOVE LCCM-SCR-HOLD-LAST-KEY-AREA TO MSKL-KEY-AREA.           DTSCSL1
00976                                                                   DTSCSL1
00977      PERFORM S810-READ THRU S810-EXIT.                            DTSCSL1
00978      IF L810-NO-REC-88                                            DTSCSL1
00979          MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                      DTSCSL1
00980          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCSL1
00981          GO TO P6140-EXIT.                                        DTSCSL1
00982      SKIP3                                                        DTSCSL1
00983      MOVE MSKL-REC TO MQTR-REC.                                   DTSCSL1
00984                                                                   DTSCSL1
00985      MOVE MQTR-YRQ TO WRK-YRQ.                                    DTSCSL1
00986                                                                   DTSCSL1
00987      MOVE LCCM-SCR-HOLD-LAST-PAGE-NUM TO CURR-PAGE-NUM.           DTSCSL1
00988  P6140-EXIT.                                                      DTSCSL1
00989      EXIT.                                                        DTSCSL1
00990      SKIP3                                                        DTSCSL1
00991  P6150-DEFAULT-REC.                                               DTSCSL1
00992      PERFORM P6140-LAST-REC THRU P6140-EXIT.                      DTSCSL1
00993  P6150-EXIT.                                                      DTSCSL1
00994      EXIT.                                                        DTSCSL1
00995      SKIP3                                                        DTSCSL1
00996  P6190-BROWSE-MQTR.                                               DTSCSL1
00997      MOVE MSKL-REC TO MQTR-REC.                                   DTSCSL1
00998      ADD +1 TO CURR-PAGE-NUM.                                     DTSCSL1
00999      IF MQTR-YRQ < WRK-YRQ                                        DTSCSL1
01000          PERFORM S810-READ-NEXT THRU S810-EXIT                    DTSCSL1
01001      ELSE                                                         DTSCSL1
01002          MOVE 'Y' TO WS-REC-FOUND-IND.                            DTSCSL1
01003  P6190-EXIT.                                                      DTSCSL1
01004      EXIT.                                                        DTSCSL1
01005      EJECT                                                        DTSCSL1
01006  P6200-REFRESH-LCCM-SCR-HOLD.                                     DTSCSL1
01007      MOVE LOW-VALUES TO LCCM-SCR-HOLD-CONTROL-AREA.               DTSCSL1
01008                                                                   DTSCSL1
01009      MOVE +0 TO SCR-HOLD-CURR-PAGE-NUM.                           DTSCSL1
01010                                                                   DTSCSL1
01011      MOVE WRK-EMP-NO TO LCCM-SCR-HOLD-EMP-NO.                     DTSCSL1
01012                                                                   DTSCSL1
01013      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-HOLD-ABSTIME.       DTSCSL1
01014      SKIP3                                                        DTSCSL1
01015      MOVE LOW-VALUE TO MSKL-KEY-AREA.                             DTSCSL1
01016      MOVE WRK-EMP-NO TO MSKL-EMP-NO.                              DTSCSL1
01017      SET  MSKL-QTR-88 TO TRUE.                                    DTSCSL1
01018      PERFORM S810-COUNT THRU S810-EXIT.                           DTSCSL1
01019      IF L810-RECORD-CNT > +0                                      DTSCSL1
01020          MOVE L810-RECORD-CNT TO LCCM-SCR-HOLD-LAST-PAGE-NUM      DTSCSL1
01021          MOVE MSKL-KEY-AREA TO LCCM-SCR-HOLD-LAST-KEY-AREA        DTSCSL1
01022      ELSE                                                         DTSCSL1
01023          MOVE +0 TO LCCM-SCR-HOLD-LAST-PAGE-NUM                   DTSCSL1
01024          MOVE LOW-VALUES TO LCCM-SCR-HOLD-LAST-KEY-AREA.          DTSCSL1
01025  P6200-EXIT.                                                      DTSCSL1
01026      EXIT.                                                        DTSCSL1
01027 /*****************************************************************DTSCSL1
01028 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS            *DTSCSL1
01029 ******************************************************************DTSCSL1
01030                                                                   DTSCSL1
01031  P6900-CONSTRUCT-SCREEN.                                          DTSCSL1
01032      IF WRK-YRQ > +0                                              DTSCSL1
01033         PERFORM P6910-FROM-MQTR THRU P6910-EXIT                   DTSCSL1
01034      ELSE                                                         DTSCSL1
01035         MOVE LOW-VALUES TO MAP-YRQ-YR                             DTSCSL1
01036                            MAP-YRQ-Q.                             DTSCSL1
01037                                                                   DTSCSL1
01038      PERFORM P6920-FROM-MPRF THRU P6920-EXIT.                     DTSCSL1
01039                                                                   DTSCSL1
01040      PERFORM P6990-PAGE-NUMBER THRU P6990-EXIT.                   DTSCSL1
01041  P6900-EXIT.                                                      DTSCSL1
01042      EXIT.                                                        DTSCSL1
01043      SKIP3                                                        DTSCSL1
01044  P6910-FROM-MQTR.                                                 DTSCSL1
01045      IF WRK-YRQ = LCCM-PICKUP-YRQ                                    CL*15
01046          MOVE 'PU' TO MAP-YRQ-YR                                     CL*15
01047          MOVE ' ' TO MAP-YRQ-Q                                       CL*15
01048      ELSE                                                            CL*15
01049          MOVE WRK-YRQ TO WRK-DISPLAY                                 CL*15
01050          MOVE WRK-DISPLAY-YRQ-YR TO MAP-YRQ-YR                       CL*15
01051          MOVE WRK-DISPLAY-YRQ-Q  TO MAP-YRQ-Q.                       CL*15
01052                                                                   DTSCSL1
01053      IF MQTR-1ST-MTH-NO-ENTRY-88                                  DTSCSL1
01054         MOVE SPACES TO MAP-1ST-MTH-EMPL-CNT                       DTSCSL1
01055      ELSE                                                         DTSCSL1
01056         MOVE MQTR-1ST-MTH-EMPL-CNT                                DTSCSL1
01057           TO MAP-1ST-MTH-EMPL-CNT-N                               DTSCSL1
01058      END-IF.                                                      DTSCSL1
01059                                                                   DTSCSL1
01060      IF MQTR-2ND-MTH-NO-ENTRY-88                                  DTSCSL1
01061         MOVE SPACES TO MAP-2ND-MTH-EMPL-CNT                       DTSCSL1
01062      ELSE                                                         DTSCSL1
01063         MOVE MQTR-2ND-MTH-EMPL-CNT                                DTSCSL1
01064           TO MAP-2ND-MTH-EMPL-CNT-N                               DTSCSL1
01065      END-IF.                                                      DTSCSL1
01066                                                                   DTSCSL1
01067      IF MQTR-3RD-MTH-NO-ENTRY-88                                  DTSCSL1
01068         MOVE SPACES TO MAP-3RD-MTH-EMPL-CNT                       DTSCSL1
01069      ELSE                                                         DTSCSL1
01070         MOVE MQTR-3RD-MTH-EMPL-CNT                                DTSCSL1
01071           TO MAP-3RD-MTH-EMPL-CNT-N                               DTSCSL1
01072      END-IF.                                                      DTSCSL1
01073                                                                   DTSCSL1
01074      IF WRK-YRQ = LCCM-PICKUP-YRQ                                    CL*15
01075          MOVE SPACES TO MAP-TOT-WAGE                                 CL*15
01076                         MAP-TAX-WAGE                                 CL*15
01077      ELSE                                                            CL*15
01078          MOVE MQTR-TOT-WAGE TO MAP-TOT-WAGE-N                        CL*15
01079          MOVE MQTR-TAX-WAGE TO MAP-TAX-WAGE-N.                       CL*15
01080                                                                   DTSCSL1
01081      IF MQTR-WAGE-CHNG-DATE  > +0                                 DTSCSL1
01082         MOVE MQTR-WAGE-CHNG-DATE TO L001-FED-8-DATE-9             DTSCSL1
01083         PERFORM S001-FROM-FED-8 THRU S001-EXIT                    DTSCSL1
01084         MOVE L001-SLASH-DATE TO MAP-WAGE-CHNG-DATE                DTSCSL1
01085      END-IF.                                                      DTSCSL1
01086                                                                   DTSCSL1
01087      MOVE MQTR-CURR-RPT-TYPE TO L032-CD.                          DTSCSL1
01088      PERFORM S032-MQTR-CURR-RPT-TYPE THRU S032-EXIT.              DTSCSL1
01089      MOVE L032-SHORT-DSCR TO MAP-CURR-RPT-TYPE-DSCR.              DTSCSL1
01090                                                                   DTSCSL1
01091      IF MQTR-EMPL-CNT-CHNG-DATE  > +0                             DTSCSL1
01092         MOVE MQTR-EMPL-CNT-CHNG-DATE TO L001-FED-8-DATE-9         DTSCSL1
01093         PERFORM S001-FROM-FED-8 THRU S001-EXIT                    DTSCSL1
01094         MOVE L001-SLASH-DATE TO MAP-EMPL-CNT-CHNG-DATE            DTSCSL1
01095      END-IF.                                                      DTSCSL1
01096                                                                   DTSCSL1
01097  P6910-EXIT.                                                      DTSCSL1
01098      EXIT.                                                        DTSCSL1
01099                                                                   DTSCSL1
01100  P6920-FROM-MPRF.                                                 DTSCSL1
01101                                                                   DTSCSL1
01102      MOVE MPRF-SIC-CD TO MAP-SIC-CD.                              DTSCSL1
01103                                                                      CL**3
01104      MOVE MPRF-OLD-SIC-CD  TO MAP-OLD-SIC-CD                         CL**3
01105                                                                   DTSCSL1
01106                                                                   DTSCSL1
01107      IF MPRF-SIC-CHNG-DATE > +0                                   DTSCSL1
01108         MOVE MPRF-OLD-SIC-CD TO MAP-OLD-SIC-CD                    DTSCSL1
01109         MOVE MPRF-SIC-CHNG-DATE TO L001-FED-8-DATE-9              DTSCSL1
01110         PERFORM S001-FROM-FED-8 THRU S001-EXIT                    DTSCSL1
01111         MOVE L001-SLASH-DATE TO MAP-SIC-CD-CHNG-DATE                 CL**8
01112      END-IF.                                                      DTSCSL1
01113                                                                   DTSCSL1
01114      MOVE MPRF-SIC-AUXILIARY-CD  TO MAP-SIC-AUX-CD.                  CL*16
01115                                                                      CL*16
01116      MOVE MPRF-NAICS-CD  TO MAP-NAICS-CD.                            CL**3
01117                                                                      CL**3
01118      IF MPRF-NAICS-CHNG-DATE > +0                                    CL**3
01119         MOVE MPRF-OLD-NAICS-CD TO MAP-OLD-NAICS-CD                   CL**3
01120         MOVE MPRF-NAICS-CHNG-DATE TO L001-FED-8-DATE-9               CL**3
01121         PERFORM S001-FROM-FED-8 THRU S001-EXIT                       CL**3
01122         MOVE L001-SLASH-DATE TO MAP-NAICS-CHNG-DATE                  CL**3
01123      END-IF.                                                         CL**3
01124                                                                      CL**3
01125      MOVE MPRF-OWN-CD TO MAP-OWN-CD.                                 CL**3
01126                                                                      CL**3
01127      IF MPRF-OWN-CHNG-DATE > +0                                   DTSCSL1
01128         MOVE MPRF-OLD-OWN-CD TO MAP-OLD-OWN-CD                    DTSCSL1
01129         MOVE MPRF-OWN-CHNG-DATE TO L001-FED-8-DATE-9              DTSCSL1
01130         PERFORM S001-FROM-FED-8 THRU S001-EXIT                    DTSCSL1
01131         MOVE L001-SLASH-DATE TO MAP-OWN-CHNG-DATE                 DTSCSL1
01132      END-IF.                                                      DTSCSL1
01133                                                                   DTSCSL1
01134      MOVE MPRF-MULTI-IND TO MAP-MULTI-IND.                        DTSCSL1
01135                                                                   DTSCSL1
01136      MOVE MPRF-WARD-CD   TO MAP-WARD-CD.                             CL**3
01137                                                                      CL**3
01138  P6920-EXIT.                                                      DTSCSL1
01139      EXIT.                                                        DTSCSL1
01140      EJECT                                                        DTSCSL1
01141  P6990-PAGE-NUMBER.                                               DTSCSL1
01142      IF WRK-YRQ = +0                                              DTSCSL1
01143          MOVE MSG-PL11-AREA TO LCCM-MSG-AREA                         CL**7
01144          GO TO P6990-EXIT.                                        DTSCSL1
01145      SKIP3                                                        DTSCSL1
01146      MOVE CURR-PAGE-NUM TO MAP-CURR-PAGE.                         DTSCSL1
01147      MOVE LCCM-SCR-HOLD-LAST-PAGE-NUM TO MAP-LAST-PAGE.           DTSCSL1
01148                                                                   DTSCSL1
01149      IF CURR-PAGE-NUM = +1                                        DTSCSL1
01150          IF LCCM-SCR-HOLD-LAST-PAGE-NUM = +1                      DTSCSL1
01151              MOVE PMSG-ONLY-PAGE TO LCCM-MSG-AREA                 DTSCSL1
01152          ELSE                                                     DTSCSL1
01153              MOVE PMSG-FIRST-PAGE TO LCCM-MSG-AREA                DTSCSL1
01154      ELSE                                                         DTSCSL1
01155          IF CURR-PAGE-NUM = LCCM-SCR-HOLD-LAST-PAGE-NUM           DTSCSL1
01156              MOVE PMSG-LAST-PAGE TO LCCM-MSG-AREA.                DTSCSL1
01157  P6990-EXIT.                                                      DTSCSL1
01158      EXIT.                                                        DTSCSL1
01159 /*****************************************************************DTSCSL1
01160 * FUNCTION KEY TO MOD THE RECORD WAS PRESSED.                    *DTSCSL1
01161 ******************************************************************DTSCSL1
01162                                                                   DTSCSL1
01163  P7000-REQUEST-EDIT.                                              DTSCSL1
01164      MOVE LCCM-SCRL1-HOLD-AREA TO SCR-HOLD-AREA.                     CL**7
01165                                                                   DTSCSL1
01166      PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCSL1
01167                                                                   DTSCSL1
01168      IF LCCM-F10-88                                               DTSCSL1
01169         PERFORM P7200-EDIT-MOD THRU P7200-EXIT                    DTSCSL1
01170      ELSE                                                         DTSCSL1
01171         GO TO S899-ABEND.                                         DTSCSL1
01172                                                                   DTSCSL1
01173 *------------------------------------------------------           DTSCSL1
01174 *  SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED.          DTSCSL1
01175 *  IN ORDER TO CONTINUE TO ATTEMPT A MOD THE SCREEN MUST          DTSCSL1
01176 *  REMAIN IN 'INQUIRE' STATUS.                                    DTSCSL1
01177 *------------------------------------------------------           DTSCSL1
01178                                                                   DTSCSL1
01179      IF LCCM-MSG                                                  DTSCSL1
01180         NEXT SENTENCE                                             DTSCSL1
01181      ELSE                                                         DTSCSL1
01182         PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT              DTSCSL1
01183         IF LCCM-F10-88                                            DTSCSL1
01184            SET LCCM-SCR-MOD-LOCKED TO TRUE                        DTSCSL1
01185            MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-AREA.                DTSCSL1
01186                                                                   DTSCSL1
01187      SET RESP-SEND-MAP TO TRUE.                                   DTSCSL1
01188  P7000-EXIT.                                                      DTSCSL1
01189      EXIT.                                                        DTSCSL1
01190 /*****************************************************************DTSCSL1
01191 * MODIFICATION FUNCTION WAS REQUESTED                            *DTSCSL1
01192 ******************************************************************DTSCSL1
01193                                                                   DTSCSL1
01194  P7200-EDIT-MOD.                                                  DTSCSL1
01195 *-----------------------------------------------------            DTSCSL1
01196 *    MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY         DTSCSL1
01197 *    INQUIRED                                                     DTSCSL1
01198 *-----------------------------------------------------            DTSCSL1
01199      IF NOT LCCM-SCR-INQUIRE                                      DTSCSL1
01200         MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-AREA                   DTSCSL1
01201         GO TO P7200-EXIT.                                         DTSCSL1
01202                                                                   DTSCSL1
01203 *-----------------------------------------------------            DTSCSL1
01204 *    MAP-EMP-NO MAY NOT BE CHANGED DURING THE MOD                 DTSCSL1
01205 *-----------------------------------------------------            DTSCSL1
01206      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCSL1
01207      IF LCCM-MSG                                                  DTSCSL1
01208          GO TO P7200-EXIT.                                        DTSCSL1
01209                                                                   DTSCSL1
01210      PERFORM S2101-YRQ THRU S2101-EXIT.                           DTSCSL1
01211      IF LCCM-MSG                                                  DTSCSL1
01212          GO TO P7200-EXIT.                                        DTSCSL1
01213                                                                   DTSCSL1
01214      IF LCCM-EMP-NO NOT = WRK-EMP-NO                              DTSCSL1
01215          MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA         DTSCSL1
01216          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCSL1
01217          GO TO P7200-EXIT.                                        DTSCSL1
01218                                                                   DTSCSL1
01219      IF LCCM-YRQ NOT = WRK-YRQ                                    DTSCSL1
01220          MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA         DTSCSL1
01221          PERFORM S2199-ERROR THRU S2199-EXIT                      DTSCSL1
01222          GO TO P7200-EXIT.                                        DTSCSL1
01223                                                                   DTSCSL1
01224      PERFORM S1110-READ-MPRF THRU S1110-EXIT.                     DTSCSL1
01225      IF LCCM-MSG                                                  DTSCSL1
01226          GO TO P7200-EXIT.                                        DTSCSL1
01227                                                                   DTSCSL1
01228      PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT.                  DTSCSL1
01229  P7200-EXIT.                                                      DTSCSL1
01230      EXIT.                                                        DTSCSL1
01231 /*****************************************************************DTSCSL1
01232 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED       *DTSCSL1
01233 ******************************************************************DTSCSL1
01234                                                                   DTSCSL1
01235  P8000-REQUEST-UPDATE.                                            DTSCSL1
01236      MOVE LCCM-SCRL1-HOLD-AREA TO SCR-HOLD-AREA.                     CL**7
01237                                                                   DTSCSL1
01238      PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCSL1
01239                                                                   DTSCSL1
01240      IF LCCM-SCR-MOD-LOCKED                                       DTSCSL1
01241         PERFORM P8200-MOD THRU P8200-EXIT                         DTSCSL1
01242      ELSE                                                         DTSCSL1
01243         GO TO S899-ABEND.                                         DTSCSL1
01244                                                                   DTSCSL1
01245      SET RESP-SEND-MAP TO TRUE.                                   DTSCSL1
01246  P8000-EXIT.                                                      DTSCSL1
01247      EXIT.                                                        DTSCSL1
01248 /*****************************************************************DTSCSL1
01249 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS        *DTSCSL1
01250 ******************************************************************DTSCSL1
01251                                                                   DTSCSL1
01252  P8200-MOD.                                                       DTSCSL1
01253      SET LCCM-SCR-INQUIRE TO TRUE.                                DTSCSL1
01254                                                                   DTSCSL1
01255      IF LCCM-F12-88                                               DTSCSL1
01256         MOVE PMSG-MOD-CANCELED        TO LCCM-MSG-AREA            DTSCSL1
01257         GO TO P8200-EXIT.                                         DTSCSL1
01258                                                                   DTSCSL1
01259      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCSL1
01260                                                                   DTSCSL1
01261      MOVE 'M' TO L221-UPDATE-FUNCTION.                            DTSCSL1
01262      PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT.                 DTSCSL1
01263      IF LCCM-MSG                                                  DTSCSL1
01264          GO TO P8200-EXIT.                                        DTSCSL1
01265                                                                   DTSCSL1
01266      MOVE WRK-EMP-NO      TO L331-EMP-NO.                            CL**6
01267      MOVE LCCM-CURR-RUN-DATE TO L331-CURR-RUN-DATE.                  CL**6
01268      MOVE LCCM-TASK-START-ABSTIME TO L331-UPDATE-ABSTIME.            CL**6
01269      MOVE LCCM-OP-ID  TO L331-OP-ID.                                 CL**6
01270                                                                      CL**6
01271      PERFORM P8210-MPRF-UPDATE THRU P8210-EXIT.                   DTSCSL1
01272                                                                   DTSCSL1
01273      PERFORM P8220-MQTR-UPDATE THRU P8220-EXIT.                   DTSCSL1
01274                                                                   DTSCSL1
01275      PERFORM S221-EMP-UNLOCK THRU S221-EXIT.                      DTSCSL1
01276                                                                   DTSCSL1
01277      SET LCCM-ENTER-88 TO TRUE.                                   DTSCSL1
01278                                                                   DTSCSL1
01279      PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT.               DTSCSL1
01280                                                                   DTSCSL1
01281      MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCSL1
01282                                                                   DTSCSL1
01283      MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-AREA.                   DTSCSL1
01284  P8200-EXIT.                                                      DTSCSL1
01285      EXIT.                                                        DTSCSL1
01286  P8210-MPRF-UPDATE.                                               DTSCSL1
01287      MOVE LOW-VALUES TO MPRF-KEY-AREA.                            DTSCSL1
01288      MOVE WRK-EMP-NO TO MPRF-EMP-NO.                              DTSCSL1
01289      SET MPRF-PRF-88 TO TRUE.                                     DTSCSL1
01290      MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA.                         DTSCSL1
01291      PERFORM S810-READ THRU S810-EXIT.                            DTSCSL1
01292      IF L810-NO-REC-88                                            DTSCSL1
01293          GO TO S899-ABEND.                                        DTSCSL1
01294                                                                   DTSCSL1
01295      MOVE MSKL-REC TO MPRF-REC.                                   DTSCSL1
01296      IF MPRF-SIC-CD = MAP-SIC-CD                                  DTSCSL1
01297      AND MPRF-OWN-CD = MAP-OWN-CD                                 DTSCSL1
01298      AND MPRF-NAICS-CD = MAP-NAICS-CD                                CL**4
01299      AND MPRF-WARD-CD = MAP-WARD-CD                                  CL**6
01300      AND MPRF-MULTI-IND = MAP-MULTI-IND                           DTSCSL1
01301      AND MPRF-SIC-AUXILIARY-CD = MAP-SIC-AUX-CD                      CL*16
01302          GO TO P8210-EXIT.                                        DTSCSL1
01303                                                                   DTSCSL1
01304      MOVE SPACES TO L331-REC-OCC-ID.                                 CL**6
01305                                                                   DTSCSL1
01306      IF MPRF-NAICS-CD NOT = MAP-NAICS-CD                             CL**6
01307         MOVE MPRF-NAICS-CD TO MPRF-OLD-NAICS-CD                      CL**6
01308         MOVE LCCM-CURR-RUN-DATE TO MPRF-NAICS-CHNG-DATE              CL**6
01309         MOVE 'MPRF-NAICS-CD         ' TO L331-FIELD-NAME             CL**6
01310         MOVE MPRF-NAICS-CD            TO L331-FROM-VALUE             CL**6
01311         MOVE MAP-NAICS-CD             TO L331-TO-VALUE               CL**6
01312         PERFORM S331-WRITE-MLOG       THRU S331-EXIT                 CL**6
01313         MOVE MAP-NAICS-CD TO MPRF-NAICS-CD                           CL**6
01314      END-IF.                                                         CL**6
01315                                                                      CL**6
01316                                                                   DTSCSL1
01317      IF MPRF-SIC-CD NOT = MAP-SIC-CD                              DTSCSL1
01318         MOVE MPRF-SIC-CD TO MPRF-OLD-SIC-CD                       DTSCSL1
01319         MOVE LCCM-CURR-RUN-DATE TO MPRF-SIC-CHNG-DATE             DTSCSL1
01320         MOVE 'MPRF-SIC-CD         '   TO L331-FIELD-NAME          DTSCSL1
01321         MOVE MPRF-SIC-CD              TO L331-FROM-VALUE          DTSCSL1
01322         MOVE MAP-SIC-CD               TO L331-TO-VALUE            DTSCSL1
01323         PERFORM S331-WRITE-MLOG       THRU S331-EXIT                 CL**6
01324         MOVE MAP-SIC-CD TO MPRF-SIC-CD                            DTSCSL1
01325      END-IF.                                                      DTSCSL1
01326                                                                   DTSCSL1
01327      IF MPRF-OWN-CD NOT = MAP-OWN-CD                              DTSCSL1
01328         MOVE MPRF-OWN-CD TO MPRF-OLD-OWN-CD                       DTSCSL1
01329         MOVE LCCM-CURR-RUN-DATE TO MPRF-OWN-CHNG-DATE             DTSCSL1
01330         MOVE 'MPRF-OWN-CD         '   TO L331-FIELD-NAME          DTSCSL1
01331         MOVE MPRF-OWN-CD              TO L331-FROM-VALUE          DTSCSL1
01332         MOVE MAP-OWN-CD               TO L331-TO-VALUE            DTSCSL1
01333         PERFORM S331-WRITE-MLOG       THRU S331-EXIT                 CL**6
01334         MOVE MAP-OWN-CD TO MPRF-OWN-CD                            DTSCSL1
01335      END-IF.                                                      DTSCSL1
01336                                                                   DTSCSL1
01337      IF MAP-MULTI-IND NOT = MPRF-MULTI-IND                        DTSCSL1
01338         MOVE 'MPRF-MULTI-IND      '   TO L331-FIELD-NAME          DTSCSL1
01339         MOVE MPRF-MULTI-IND           TO L331-FROM-VALUE          DTSCSL1
01340         MOVE MAP-MULTI-IND            TO L331-TO-VALUE            DTSCSL1
01341         PERFORM S331-WRITE-MLOG       THRU S331-EXIT                 CL**6
01342         MOVE MAP-MULTI-IND      TO  MPRF-MULTI-IND                DTSCSL1
01343      END-IF.                                                      DTSCSL1
01344                                                                      CL**6
01345      IF MAP-WARD-CD NOT = MPRF-WARD-CD                               CL**6
01346         MOVE 'MPRF-WARD-CD        '   TO L331-FIELD-NAME             CL**6
01347         MOVE MPRF-WARD-CD             TO L331-FROM-VALUE             CL**6
01348         MOVE MAP-WARD-CD              TO L331-TO-VALUE               CL**6
01349         PERFORM S331-WRITE-MLOG       THRU S331-EXIT                 CL**6
01350         MOVE MAP-WARD-CD        TO  MPRF-WARD-CD                     CL**6
01351      END-IF.                                                         CL**6
01352                                                                   DTSCSL1
01353      IF MAP-SIC-AUX-CD NOT = MPRF-SIC-AUXILIARY-CD                   CL*16
01354         MOVE 'MPRF-SIC-AUXILIARY-CD   ' TO L331-FIELD-NAME           CL*16
01355         MOVE MPRF-SIC-AUXILIARY-CD  TO L331-FROM-VALUE               CL*16
01356         MOVE MAP-SIC-AUX-CD         TO L331-TO-VALUE                 CL*16
01357         PERFORM S331-WRITE-MLOG       THRU S331-EXIT                 CL*16
01358         MOVE MAP-SIC-AUX-CD   TO  MPRF-SIC-AUXILIARY-CD              CL*16
01359      END-IF.                                                      DTSCSL1
01360                                                                   DTSCSL1
01361      MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE.                   DTSCSL1
01362                                                                   DTSCSL1
01363      MOVE MPRF-REC TO MSKL-REC.                                   DTSCSL1
01364                                                                   DTSCSL1
01365      PERFORM S810-REWRITE THRU S810-EXIT.                         DTSCSL1
01366                                                                   DTSCSL1
01367  P8210-EXIT.                                                      DTSCSL1
01368      EXIT.                                                        DTSCSL1
01369      EJECT                                                        DTSCSL1
01370  P8220-MQTR-UPDATE.                                               DTSCSL1
01371      IF SCR-HOLD-YRQ = +0 OR LCCM-PICKUP-YRQ                         CL*15
01372          GO TO P8220-EXIT.                                        DTSCSL1
01373      SKIP3                                                        DTSCSL1
01374      MOVE LOW-VALUE TO MQTR-KEY-AREA.                             DTSCSL1
01375      MOVE WRK-EMP-NO TO MQTR-EMP-NO.                              DTSCSL1
01376      SET MQTR-QTR-88 TO TRUE.                                     DTSCSL1
01377      MOVE SCR-HOLD-YRQ TO MQTR-YRQ.                               DTSCSL1
01378      MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSCSL1
01379      PERFORM S810-READ THRU S810-EXIT.                            DTSCSL1
01380      IF L810-NO-REC-88                                            DTSCSL1
01381          GO TO S899-ABEND.                                        DTSCSL1
01382      MOVE MSKL-REC TO MQTR-REC.                                   DTSCSL1
01383                                                                   DTSCSL1
01384      MOVE MAP-1ST-MTH-EMPL-CNT-AREA  TO L013-S-CNT-AREA.          DTSCSL1
01385      PERFORM S013-COUNT-FROM-SCREEN  THRU S013-EXIT.              DTSCSL1
01386      IF L013-NO-ENTRY                                             DTSCSL1
01387         SET WRK-1ST-MTH-NO-ENTRY-88 TO TRUE                       DTSCSL1
01388      ELSE                                                         DTSCSL1
01389         MOVE L013-CNT TO WRK-1ST-MTH-EMPL-CNT                     DTSCSL1
01390      END-IF.                                                      DTSCSL1
01391                                                                   DTSCSL1
01392      MOVE MAP-2ND-MTH-EMPL-CNT-AREA  TO L013-S-CNT-AREA.          DTSCSL1
01393      PERFORM S013-COUNT-FROM-SCREEN  THRU S013-EXIT.              DTSCSL1
01394      IF L013-NO-ENTRY                                             DTSCSL1
01395         SET WRK-2ND-MTH-NO-ENTRY-88 TO TRUE                       DTSCSL1
01396      ELSE                                                         DTSCSL1
01397         MOVE L013-CNT TO WRK-2ND-MTH-EMPL-CNT                     DTSCSL1
01398      END-IF.                                                      DTSCSL1
01399                                                                   DTSCSL1
01400      MOVE MAP-3RD-MTH-EMPL-CNT-AREA  TO L013-S-CNT-AREA.          DTSCSL1
01401      PERFORM S013-COUNT-FROM-SCREEN  THRU S013-EXIT.              DTSCSL1
01402      IF L013-NO-ENTRY                                             DTSCSL1
01403         SET WRK-3RD-MTH-NO-ENTRY-88 TO TRUE                       DTSCSL1
01404      ELSE                                                         DTSCSL1
01405         MOVE L013-CNT TO WRK-3RD-MTH-EMPL-CNT                     DTSCSL1
01406      END-IF.                                                      DTSCSL1
01407                                                                   DTSCSL1
01408      IF (MQTR-1ST-MTH-EMPL-CNT                                    DTSCSL1
01409          = WRK-1ST-MTH-EMPL-CNT)                                  DTSCSL1
01410      AND (MQTR-2ND-MTH-EMPL-CNT                                   DTSCSL1
01411          = WRK-2ND-MTH-EMPL-CNT)                                  DTSCSL1
01412      AND (MQTR-3RD-MTH-EMPL-CNT                                   DTSCSL1
01413          = WRK-3RD-MTH-EMPL-CNT)                                  DTSCSL1
01414          GO TO P8220-EXIT                                         DTSCSL1
01415      END-IF.                                                      DTSCSL1
01416                                                                   DTSCSL1
01417      MOVE MQTR-YRQ TO WRK-DISPLAY-YRQ.                            DTSCSL1
01418      MOVE WRK-DISPLAY-YRQ TO L331-REC-OCC-ID.                        CL**6
01419                                                                   DTSCSL1
01420      IF WRK-1ST-MTH-EMPL-CNT                                      DTSCSL1
01421        NOT = MQTR-1ST-MTH-EMPL-CNT                                DTSCSL1
01422          MOVE 'MQTR-1ST-MTH-EMPL-CNT'  TO L331-FIELD-NAME         DTSCSL1
01423          IF MQTR-1ST-MTH-NO-ENTRY-88                              DTSCSL1
01424              MOVE SPACES TO L331-FROM-VALUE                       DTSCSL1
01425          ELSE                                                     DTSCSL1
01426              MOVE MQTR-1ST-MTH-EMPL-CNT    TO WRK-CNT-DISPLAY     DTSCSL1
01427              MOVE WRK-CNT-DISPLAY-X        TO L331-FROM-VALUE     DTSCSL1
01428          END-IF                                                   DTSCSL1
01429          MOVE MAP-1ST-MTH-EMPL-CNT     TO L331-TO-VALUE           DTSCSL1
01430          PERFORM S331-WRITE-MLOG       THRU S331-EXIT                CL**6
01431          MOVE WRK-1ST-MTH-EMPL-CNT                                DTSCSL1
01432            TO MQTR-1ST-MTH-EMPL-CNT                               DTSCSL1
01433      END-IF.                                                      DTSCSL1
01434                                                                   DTSCSL1
01435      IF WRK-2ND-MTH-EMPL-CNT                                      DTSCSL1
01436        NOT = MQTR-2ND-MTH-EMPL-CNT                                DTSCSL1
01437          MOVE 'MQTR-2ND-MTH-EMPL-CNT'  TO L331-FIELD-NAME         DTSCSL1
01438          IF MQTR-2ND-MTH-NO-ENTRY-88                              DTSCSL1
01439              MOVE SPACES TO L331-FROM-VALUE                       DTSCSL1
01440          ELSE                                                     DTSCSL1
01441              MOVE MQTR-2ND-MTH-EMPL-CNT    TO WRK-CNT-DISPLAY     DTSCSL1
01442              MOVE WRK-CNT-DISPLAY-X        TO L331-FROM-VALUE     DTSCSL1
01443          END-IF                                                   DTSCSL1
01444          MOVE MAP-2ND-MTH-EMPL-CNT     TO L331-TO-VALUE           DTSCSL1
01445          PERFORM S331-WRITE-MLOG       THRU S331-EXIT                CL**6
01446          MOVE WRK-2ND-MTH-EMPL-CNT                                DTSCSL1
01447            TO MQTR-2ND-MTH-EMPL-CNT                               DTSCSL1
01448      END-IF.                                                      DTSCSL1
01449                                                                   DTSCSL1
01450      IF WRK-3RD-MTH-EMPL-CNT                                      DTSCSL1
01451        NOT = MQTR-3RD-MTH-EMPL-CNT                                DTSCSL1
01452          MOVE 'MQTR-3RD-MTH-EMPL-CNT'  TO L331-FIELD-NAME         DTSCSL1
01453          IF MQTR-3RD-MTH-NO-ENTRY-88                              DTSCSL1
01454              MOVE SPACES TO L331-FROM-VALUE                       DTSCSL1
01455          ELSE                                                     DTSCSL1
01456              MOVE MQTR-3RD-MTH-EMPL-CNT    TO WRK-CNT-DISPLAY     DTSCSL1
01457              MOVE WRK-CNT-DISPLAY-X        TO L331-FROM-VALUE     DTSCSL1
01458          END-IF                                                   DTSCSL1
01459          MOVE MAP-3RD-MTH-EMPL-CNT     TO L331-TO-VALUE           DTSCSL1
01460          PERFORM S331-WRITE-MLOG       THRU S331-EXIT                CL**6
01461          MOVE WRK-3RD-MTH-EMPL-CNT                                   CL*21
01462            TO MQTR-3RD-MTH-EMPL-CNT                                  CL*21
01463      END-IF.                                                      DTSCSL1
01464                                                                   DTSCSL1
01465      MOVE LCCM-CURR-RUN-DATE TO MQTR-CHNG-DATE                    DTSCSL1
01466                                 MQTR-EMPL-CNT-CHNG-DATE.          DTSCSL1
01467                                                                   DTSCSL1
01468      MOVE MQTR-REC TO MSKL-REC.                                   DTSCSL1
01469      PERFORM S810-REWRITE THRU S810-EXIT.                         DTSCSL1
01470  P8220-EXIT.                                                      DTSCSL1
01471      EXIT.                                                        DTSCSL1
01472                                                                   DTSCSL1
01473  P8810-LOCK-EMPLOYER.                                             DTSCSL1
01474      MOVE WRK-EMP-NO TO L221-EMP-NO.                              DTSCSL1
01475      MOVE LCCM-SCR-ABSTIME TO L221-SCR-ABSTIME.                   DTSCSL1
01476      MOVE LCCM-TASK-ID TO L221-UPDATE-TASK-ID.                    DTSCSL1
01477      MOVE LCCM-OP-ID TO L221-UPDATE-OP-ID.                        DTSCSL1
01478      MOVE LCCM-CICS-TERM-ID TO L221-UPDATE-TERMID.                DTSCSL1
01479      MOVE LCCM-TASK-NETNAME TO L221-UPDATE-NETNAME.                  CL**4
01480      MOVE LCCM-TASK-START-DATE TO L221-UPDATE-START-DATE.         DTSCSL1
01481      MOVE LCCM-TASK-START-TIME TO L221-UPDATE-START-TIME.         DTSCSL1
01482      MOVE WRK-SCR-ID TO L221-UPDATE-SCR-ID.                       DTSCSL1
01483                                                                   DTSCSL1
01484      PERFORM S221-EMP-LOCK THRU S221-EXIT.                        DTSCSL1
01485  P8810-EXIT.                                                      DTSCSL1
01486      EXIT.                                                        DTSCSL1
01487                                                                   DTSCSL1
01488 /*****************************************************************DTSCSL1
01489 * LINKS TO UTILITY MODULES                                        DTSCSL1
01490 ******************************************************************DTSCSL1
01491                                                                   DTSCSL1
01492  S001-FROM-FED-8.                                                 DTSCSL1
01493      SET L001-FROM-FED-8 TO TRUE.                                 DTSCSL1
01494      GO TO S001-DATE.                                             DTSCSL1
01495                                                                   DTSCSL1
01496 *S001-FROM-ABS-DATE.                                              DTSCSL1
01497 *    SET L001-FROM-ABS-DAY TO TRUE.                               DTSCSL1
01498 *    GO TO S001-DATE.                                             DTSCSL1
01499                                                                   DTSCSL1
01500  S001-DATE.                                                       DTSCSL1
01501      EXEC CICS LINK                                               DTSCSL1
01502          PROGRAM('DTSCU001')                                         CL**4
01503          COMMAREA(L001-COMM-AREA)                                 DTSCSL1
01504      END-EXEC.                                                    DTSCSL1
01505  S001-EXIT.                                                       DTSCSL1
01506      EXIT.                                                        DTSCSL1
01507                                                                   DTSCSL1
01508  S013-COUNT-FROM-SCREEN.                                          DTSCSL1
01509      MOVE +0 TO L013-MIN-CNT                                      DTSCSL1
01510      MOVE +9999998 TO L013-MAX-CNT                                   CL*17
01511      EXEC CICS LINK                                               DTSCSL1
01512          PROGRAM('DTSCU013')                                         CL**4
01513          COMMAREA(L013-COMM-AREA)                                 DTSCSL1
01514      END-EXEC.                                                    DTSCSL1
01515  S013-EXIT.                                                       DTSCSL1
01516      EXIT.                                                        DTSCSL1
01517                                                                   DTSCSL1
01518  S018-EMP-NO-FROM-SCREEN.                                         DTSCSL1
01519      EXEC CICS LINK                                               DTSCSL1
01520          PROGRAM('DTSCU018')                                         CL**4
01521          COMMAREA(L018-COMM-AREA)                                 DTSCSL1
01522      END-EXEC.                                                    DTSCSL1
01523  S018-EXIT.                                                       DTSCSL1
01524      EXIT.                                                        DTSCSL1
01525                                                                      CL*14
01526  S029-YRQ-FROM-SCREEN.                                               CL*14
01527      EXEC CICS LINK                                                  CL*14
01528          PROGRAM('DTSCU029')                                         CL*14
01529          COMMAREA(L029-COMM-AREA)                                    CL*14
01530      END-EXEC.                                                       CL*14
01531  S029-EXIT.                                                          CL*14
01532      EXIT.                                                           CL*14
01533                                                                   DTSCSL1
01534  S032-MQTR-CURR-RPT-TYPE.                                            CL*17
01535      SET L032-MQTR-CURR-RPT-TYPE   TO TRUE.                       DTSCSL1
01536      GO TO S032-LINK.                                             DTSCSL1
01537                                                                   DTSCSL1
01538  S032-LINK.                                                       DTSCSL1
01539      EXEC CICS LINK                                               DTSCSL1
01540          PROGRAM  ('DTSCU032')                                       CL**4
01541          COMMAREA (L032-COMM-AREA)                                DTSCSL1
01542      END-EXEC.                                                    DTSCSL1
01543  S032-EXIT.                                                       DTSCSL1
01544      EXIT.                                                        DTSCSL1
01545                                                                      CL**6
01546  S038-MPRF-OWN-CD.                                                   CL**6
01547      SET L038-MPRF-OWN-CD          TO TRUE.                          CL**6
01548      GO TO S038-LINK.                                                CL**6
01549                                                                   DTSCSL1
01550  S038-MPRF-MULTI-IND.                                                CL**6
01551      SET L038-MPRF-MULTI-IND       TO TRUE.                       DTSCSL1
01552      GO TO S038-LINK.                                             DTSCSL1
01553                                                                      CL**6
01554  S038-MPRF-WARD-CD.                                                  CL**6
01555      SET L038-MPRF-WARD-CD         TO TRUE.                          CL**6
01556      GO TO S038-LINK.                                                CL**6
01557                                                                   DTSCSL1
01558  S038-MPRF-SIC-AUXILIARY-CD.                                         CL*16
01559      SET L038-MPRF-SIC-AUXILIARY-CD TO TRUE.                         CL*16
01560      GO TO S038-LINK.                                             DTSCSL1
01561                                                                   DTSCSL1
01562  S038-LINK.                                                       DTSCSL1
01563      EXEC CICS LINK                                               DTSCSL1
01564          PROGRAM  ('DTSCU038')                                       CL**4
01565          COMMAREA (L038-COMM-AREA)                                DTSCSL1
01566      END-EXEC.                                                    DTSCSL1
01567  S038-EXIT.                                                       DTSCSL1
01568      EXIT.                                                        DTSCSL1
01569                                                                   DTSCSL1
01570  S039-SIC-CD-DSCR.                                                   CL**6
01571      EXEC CICS LINK                                               DTSCSL1
01572          PROGRAM  ('DTSCU039')                                       CL**4
01573          COMMAREA (L039-COMM-AREA)                                DTSCSL1
01574      END-EXEC.                                                    DTSCSL1
01575                                                                   DTSCSL1
01576      IF L039-SIC-FILE-CLOSED                                      DTSCSL1
01577          MOVE L039-MSG-AREA TO LCCM-MSG-AREA                      DTSCSL1
01578          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCSL1
01579          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCSL1
01580          GO TO MAINLINE-EXIT.                                     DTSCSL1
01581                                                                   DTSCSL1
01582  S039-EXIT.                                                       DTSCSL1
01583      EXIT.                                                        DTSCSL1
01584      SKIP3                                                        DTSCSL1
01585                                                                      CL**5
01586  S040-NAICS-CD-DSCR.                                                 CL**5
01587      EXEC CICS LINK                                                  CL**5
01588          PROGRAM  ('DTSCU040')                                       CL**5
01589          COMMAREA (L040-COMM-AREA)                                   CL**5
01590      END-EXEC.                                                       CL**5
01591                                                                      CL**5
01592      IF L040-NAICS-FILE-CLOSED                                       CL**5
01593          MOVE L040-MSG-AREA TO LCCM-MSG-AREA                         CL**5
01594          SET LCCM-REQ-SCR-SF-88 TO TRUE                              CL**5
01595          SET LCCM-LINK-SCREEN-88 TO TRUE                             CL**5
01596          GO TO MAINLINE-EXIT.                                        CL**5
01597                                                                      CL**5
01598  S040-EXIT.                                                          CL**5
01599      EXIT.                                                           CL**5
01600      SKIP3                                                           CL**5
01601  S221-EMP-LOCK.                                                   DTSCSL1
01602      SET L221-START-UPDATE TO TRUE.                               DTSCSL1
01603      GO TO S221-EMP-LOCK-UNLOCK.                                  DTSCSL1
01604                                                                   DTSCSL1
01605  S221-EMP-UNLOCK.                                                 DTSCSL1
01606      SET L221-END-UPDATE TO TRUE.                                 DTSCSL1
01607      GO TO S221-EMP-LOCK-UNLOCK.                                  DTSCSL1
01608                                                                   DTSCSL1
01609  S221-EMP-LOCK-UNLOCK.                                            DTSCSL1
01610      EXEC CICS LINK                                               DTSCSL1
01611          PROGRAM('DTSCU221')                                         CL**4
01612          COMMAREA(L221-COMM-AREA)                                 DTSCSL1
01613      END-EXEC.                                                    DTSCSL1
01614                                                                   DTSCSL1
01615      IF L221-FILE-CLOSED                                          DTSCSL1
01616          MOVE L221-MSG-AREA TO LCCM-MSG-AREA                      DTSCSL1
01617          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCSL1
01618          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCSL1
01619          GO TO MAINLINE-EXIT.                                     DTSCSL1
01620                                                                   DTSCSL1
01621      IF L221-NOT-OK                                               DTSCSL1
01622          MOVE L221-MSG-AREA TO LCCM-MSG-AREA.                     DTSCSL1
01623  S221-EXIT.                                                       DTSCSL1
01624      EXIT.                                                        DTSCSL1
01625                                                                   DTSCSL1
01626  S331-WRITE-MLOG.                                                    CL**6
01627                                                                   DTSCSL1
01628      EXEC CICS LINK                                               DTSCSL1
01629          PROGRAM('DTSCU331')                                         CL**4
01630          COMMAREA(L331-COMM-AREA)                                 DTSCSL1
01631      END-EXEC.                                                    DTSCSL1
01632                                                                   DTSCSL1
01633      IF L331-FILE-CLOSED                                          DTSCSL1
01634          MOVE L331-MSG-AREA TO LCCM-MSG-AREA                      DTSCSL1
01635          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCSL1
01636          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCSL1
01637          GO TO MAINLINE-EXIT.                                     DTSCSL1
01638  S331-EXIT.                                                       DTSCSL1
01639      EXIT.                                                        DTSCSL1
01640                                                                   DTSCSL1
01641  S803-REQ-SCR-ID-EDIT.                                            DTSCSL1
01642      EXEC CICS LINK                                               DTSCSL1
01643          PROGRAM ('DTSCU803')                                        CL**4
01644          COMMAREA (DFHCOMMAREA)                                   DTSCSL1
01645      END-EXEC.                                                    DTSCSL1
01646  S803-EXIT.                                                       DTSCSL1
01647      EXIT.                                                        DTSCSL1
01648                                                                   DTSCSL1
01649  S804-INVALID-KEY.                                                DTSCSL1
01650      EXEC CICS LINK                                               DTSCSL1
01651          PROGRAM ('DTSCU804')                                        CL**4
01652          COMMAREA (DFHCOMMAREA)                                   DTSCSL1
01653      END-EXEC.                                                    DTSCSL1
01654  S804-EXIT.                                                       DTSCSL1
01655      EXIT.                                                        DTSCSL1
01656                                                                   DTSCSL1
01657  S805-MSG-AREA.                                                   DTSCSL1
01658      MOVE LCCM-MSG-AREA TO L805-MSG-AREA                          DTSCSL1
01659                                                                   DTSCSL1
01660      EXEC CICS LINK                                               DTSCSL1
01661          PROGRAM ('DTSCU805')                                        CL**4
01662          COMMAREA (L805-COMM-AREA)                                DTSCSL1
01663      END-EXEC.                                                    DTSCSL1
01664                                                                   DTSCSL1
01665      MOVE L805-S-MSG-AREA TO MAP-MSG-AREA.                        DTSCSL1
01666  S805-EXIT.                                                       DTSCSL1
01667      EXIT.                                                        DTSCSL1
01668      EJECT                                                        DTSCSL1
01669  S810-READ.                                                       DTSCSL1
01670      SET L810-READ-88 TO TRUE.                                    DTSCSL1
01671      GO TO S810-IO.                                               DTSCSL1
01672                                                                   DTSCSL1
01673  S810-START-BROWSE.                                               DTSCSL1
01674      SET L810-START-BROWSE-88 TO TRUE.                            DTSCSL1
01675      GO TO S810-IO.                                               DTSCSL1
01676                                                                   DTSCSL1
01677  S810-READ-NEXT.                                                  DTSCSL1
01678      SET L810-READ-NEXT-88 TO TRUE.                               DTSCSL1
01679      GO TO S810-IO.                                               DTSCSL1
01680                                                                   DTSCSL1
01681  S810-READ-PREV.                                                  DTSCSL1
01682      SET L810-READ-PREV-88 TO TRUE.                               DTSCSL1
01683      GO TO S810-IO.                                               DTSCSL1
01684                                                                   DTSCSL1
01685  S810-END-BROWSE.                                                 DTSCSL1
01686      SET L810-END-BROWSE-88 TO TRUE.                              DTSCSL1
01687      GO TO S810-IO.                                               DTSCSL1
01688                                                                   DTSCSL1
01689  S810-COUNT.                                                      DTSCSL1
01690      SET L810-COUNT-88 TO TRUE.                                   DTSCSL1
01691      GO TO S810-IO.                                               DTSCSL1
01692                                                                   DTSCSL1
01693  S810-REWRITE.                                                    DTSCSL1
01694      SET L810-REWRITE-88 TO TRUE.                                 DTSCSL1
01695      GO TO S810-IO.                                               DTSCSL1
01696                                                                   DTSCSL1
01697 *S810-WRITE.                                                      DTSCSL1
01698 *    SET L810-WRITE-88 TO TRUE.                                   DTSCSL1
01699 *    GO TO S810-IO.                                               DTSCSL1
01700                                                                   DTSCSL1
01701 *S810-DELETE.                                                     DTSCSL1
01702 *    SET L810-DELETE-88 TO TRUE.                                  DTSCSL1
01703 *    GO TO S810-IO.                                               DTSCSL1
01704                                                                   DTSCSL1
01705  S810-IO.                                                         DTSCSL1
01706                                                                   DTSCSL1
01707      EXEC CICS LINK                                               DTSCSL1
01708          PROGRAM ('DTSCU810')                                        CL**4
01709          COMMAREA (L810-COMM-AREA)                                DTSCSL1
01710      END-EXEC.                                                    DTSCSL1
01711                                                                   DTSCSL1
01712      IF L810-FILE-CLOSED-88                                       DTSCSL1
01713          MOVE L810-MSG-AREA TO LCCM-MSG-AREA                      DTSCSL1
01714          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCSL1
01715          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCSL1
01716          GO TO MAINLINE-EXIT.                                     DTSCSL1
01717  S810-EXIT.                                                       DTSCSL1
01718      EXIT.                                                        DTSCSL1
01719      EJECT                                                        DTSCSL1
01720  S825-WRITE.                                                      DTSCSL1
01721      SET L825-WRITE-88 TO TRUE.                                   DTSCSL1
01722      GO TO S825-O.                                                DTSCSL1
01723                                                                   DTSCSL1
01724  S825-O.                                                          DTSCSL1
01725                                                                   DTSCSL1
01726      EXEC CICS LINK                                               DTSCSL1
01727          PROGRAM ('DTSCU825')                                        CL**4
01728          COMMAREA (L825-COMM-AREA)                                DTSCSL1
01729      END-EXEC.                                                    DTSCSL1
01730                                                                   DTSCSL1
01731      IF L825-FILE-CLOSED-88                                       DTSCSL1
01732          MOVE L825-MSG-AREA TO LCCM-MSG-AREA                      DTSCSL1
01733          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCSL1
01734          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCSL1
01735          GO TO MAINLINE-EXIT.                                     DTSCSL1
01736  S825-EXIT.                                                       DTSCSL1
01737      EXIT.                                                        DTSCSL1
01738      EJECT                                                        DTSCSL1
01739                                                                   DTSCSL1
01740  S851-SCREEN-PROCESSING.                                          DTSCSL1
01741      EXEC CICS LINK                                               DTSCSL1
01742          PROGRAM ('DTSCU851')                                        CL**4
01743          COMMAREA (L851-COMM-AREA)                                DTSCSL1
01744      END-EXEC.                                                    DTSCSL1
01745  S851-EXIT.                                                       DTSCSL1
01746      EXIT.                                                        DTSCSL1
01747                                                                   DTSCSL1
01748  S899-ABEND.                                                      DTSCSL1
01749      EXEC CICS ABEND                                              DTSCSL1
01750          ABCODE(WRK-ABEND-CD)                                     DTSCSL1
01751      END-EXEC.                                                    DTSCSL1
01752 *S899-EXIT.                                                       DTSCSL1
01753 *    EXIT.                                                        DTSCSL1
01754 /*****************************************************************DTSCSL1
01755 *    EDIT THE INFORMATION ON THE SCREEN.                         *DTSCSL1
01756 ******************************************************************DTSCSL1
01757                                                                   DTSCSL1
01758  S1000-SCREEN-EDITS.                                              DTSCSL1
01759      PERFORM S1200-1ST-MTH-EMPL-CNT  THRU S1200-EXIT.             DTSCSL1
01760      PERFORM S1300-2ND-MTH-EMPL-CNT  THRU S1300-EXIT.             DTSCSL1
01761      PERFORM S1400-3RD-MTH-EMPL-CNT  THRU S1400-EXIT.             DTSCSL1
01762      PERFORM S1500-SIC-CD            THRU S1500-EXIT.                CL**5
01763      PERFORM S1700-SIC-AUX-CD        THRU S1700-EXIT.                CL*16
01764      PERFORM S1600-NAICS-CD          THRU S1600-EXIT.                CL**5
01765      PERFORM S1800-OWN-CD            THRU S1800-EXIT.                CL**5
01766      PERFORM S1900-MULTI-IND         THRU S1900-EXIT.                CL**5
01767      PERFORM S2000-WARD-CD           THRU S2000-EXIT.                CL**5
01768  S1000-EXIT. EXIT.                                                DTSCSL1
01769      EJECT                                                        DTSCSL1
01770  S1100-EDIT-KEY.                                                  DTSCSL1
01771      PERFORM S1101-EMP-NO              THRU S1101-EXIT.           DTSCSL1
01772  S1100-EXIT. EXIT.                                                DTSCSL1
01773 /*****************************************************************DTSCSL1
01774 *                                                                 DTSCSL1
01775 ******************************************************************DTSCSL1
01776  S1101-EMP-NO.                                                    DTSCSL1
01777      MOVE MAP-EMP-NO-AREA            TO L018-S-EMP-NO-AREA.       DTSCSL1
01778      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCSL1
01779                                                                   DTSCSL1
01780      IF L018-NO-ENTRY                                             DTSCSL1
01781         MOVE EMSG-FIELD-REQUIRED     TO WRK-MSG-AREA              DTSCSL1
01782         PERFORM S1199-ERROR          THRU S1199-EXIT              DTSCSL1
01783         GO TO S1101-EXIT.                                         DTSCSL1
01784                                                                   DTSCSL1
01785      IF L018-NOT-VALID                                            DTSCSL1
01786         MOVE EMSG-FIELD-NOT-VALID    TO WRK-MSG-AREA              DTSCSL1
01787         PERFORM S1199-ERROR          THRU S1199-EXIT              DTSCSL1
01788         GO TO S1101-EXIT.                                         DTSCSL1
01789                                                                   DTSCSL1
01790      MOVE L018-EMP-NO                TO WRK-EMP-NO.               DTSCSL1
01791  S1101-EXIT. EXIT.                                                DTSCSL1
01792                                                                   DTSCSL1
01793  S1110-READ-MPRF.                                                 DTSCSL1
01794      MOVE LOW-VALUES TO MPRF-KEY-AREA.                            DTSCSL1
01795      MOVE WRK-EMP-NO TO MPRF-EMP-NO.                              DTSCSL1
01796      SET MPRF-PRF-88 TO TRUE.                                     DTSCSL1
01797      MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA.                         DTSCSL1
01798      PERFORM S810-READ THRU S810-EXIT.                            DTSCSL1
01799      IF L810-NO-REC-88                                            DTSCSL1
01800          MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA                    DTSCSL1
01801          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCSL1
01802      ELSE                                                         DTSCSL1
01803          MOVE MSKL-REC TO MPRF-REC                                DTSCSL1
01804          SET WRK-MPRF-YES-88 TO TRUE.                             DTSCSL1
01805  S1110-EXIT.                                                      DTSCSL1
01806      EXIT.                                                        DTSCSL1
01807                                                                   DTSCSL1
01808  S1199-ERROR.                                                     DTSCSL1
01809      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A            DTSCSL1
01810                                         MAP-EMP-NO-2-A.           DTSCSL1
01811      IF LCCM-NO-MSG                                               DTSCSL1
01812         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCSL1
01813         MOVE CATB-CURSOR             TO MAP-EMP-NO-1-L            DTSCSL1
01814         SET CURSOR-SET-YES TO TRUE.                               DTSCSL1
01815  S1199-EXIT. EXIT.                                                DTSCSL1
01816 /*****************************************************************DTSCSL1
01817 *                                                                 DTSCSL1
01818 ******************************************************************DTSCSL1
01819  S1200-1ST-MTH-EMPL-CNT.                                          DTSCSL1
01820      MOVE MAP-1ST-MTH-EMPL-CNT-AREA  TO L013-S-CNT-AREA.          DTSCSL1
01821      PERFORM S013-COUNT-FROM-SCREEN  THRU S013-EXIT.              DTSCSL1
01822                                                                   DTSCSL1
01823      IF L013-NO-ENTRY                                             DTSCSL1
01824         GO TO S1200-EXIT.                                         DTSCSL1
01825                                                                   DTSCSL1
01826      IF L013-INVALID-NEGATIVE                                     DTSCSL1
01827         MOVE EMSG-INVALID-NEGATIVE   TO WRK-MSG-AREA              DTSCSL1
01828         PERFORM S1201-ERROR          THRU S1201-EXIT              DTSCSL1
01829         GO TO S1200-EXIT.                                         DTSCSL1
01830                                                                   DTSCSL1
01831      IF L013-EXCEEDS-MIN-MAX                                      DTSCSL1
01832         MOVE EMSG-EXCEEDS-MIN-MAX    TO WRK-MSG-AREA              DTSCSL1
01833         PERFORM S1201-ERROR          THRU S1201-EXIT              DTSCSL1
01834         GO TO S1200-EXIT.                                         DTSCSL1
01835                                                                   DTSCSL1
01836      IF L013-NOT-VALID                                            DTSCSL1
01837         MOVE EMSG-FIELD-NOT-VALID    TO WRK-MSG-AREA              DTSCSL1
01838         PERFORM S1201-ERROR          THRU S1201-EXIT              DTSCSL1
01839         GO TO S1200-EXIT.                                         DTSCSL1
01840                                                                   DTSCSL1
01841      MOVE L013-CNT                  TO MAP-1ST-MTH-EMPL-CNT-N.    DTSCSL1
01842  S1200-EXIT. EXIT.                                                DTSCSL1
01843                                                                   DTSCSL1
01844  S1201-ERROR.                                                     DTSCSL1
01845      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-1ST-MTH-EMPL-CNT-A    DTSCSL1
01846      IF LCCM-NO-MSG                                               DTSCSL1
01847         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCSL1
01848         MOVE CATB-CURSOR             TO MAP-1ST-MTH-EMPL-CNT-L    DTSCSL1
01849         SET CURSOR-SET-YES TO TRUE.                               DTSCSL1
01850  S1201-EXIT. EXIT.                                                DTSCSL1
01851 /*****************************************************************DTSCSL1
01852 *                                                                 DTSCSL1
01853 ******************************************************************DTSCSL1
01854  S1300-2ND-MTH-EMPL-CNT.                                          DTSCSL1
01855      MOVE MAP-2ND-MTH-EMPL-CNT-AREA  TO L013-S-CNT-AREA.          DTSCSL1
01856      PERFORM S013-COUNT-FROM-SCREEN  THRU S013-EXIT.              DTSCSL1
01857                                                                   DTSCSL1
01858      IF L013-NO-ENTRY                                             DTSCSL1
01859         GO TO S1300-EXIT.                                         DTSCSL1
01860                                                                   DTSCSL1
01861      IF L013-INVALID-NEGATIVE                                     DTSCSL1
01862         MOVE EMSG-INVALID-NEGATIVE   TO WRK-MSG-AREA              DTSCSL1
01863         PERFORM S1301-ERROR          THRU S1301-EXIT              DTSCSL1
01864         GO TO S1300-EXIT.                                         DTSCSL1
01865                                                                   DTSCSL1
01866      IF L013-EXCEEDS-MIN-MAX                                      DTSCSL1
01867         MOVE EMSG-EXCEEDS-MIN-MAX    TO WRK-MSG-AREA              DTSCSL1
01868         PERFORM S1301-ERROR          THRU S1301-EXIT              DTSCSL1
01869         GO TO S1300-EXIT.                                         DTSCSL1
01870                                                                   DTSCSL1
01871      IF L013-NOT-VALID                                            DTSCSL1
01872         MOVE EMSG-FIELD-NOT-VALID    TO WRK-MSG-AREA              DTSCSL1
01873         PERFORM S1301-ERROR          THRU S1301-EXIT              DTSCSL1
01874         GO TO S1300-EXIT.                                         DTSCSL1
01875                                                                   DTSCSL1
01876      MOVE L013-CNT                  TO MAP-2ND-MTH-EMPL-CNT-N.    DTSCSL1
01877  S1300-EXIT. EXIT.                                                DTSCSL1
01878                                                                   DTSCSL1
01879  S1301-ERROR.                                                     DTSCSL1
01880      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-2ND-MTH-EMPL-CNT-A    DTSCSL1
01881      IF LCCM-NO-MSG                                               DTSCSL1
01882         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCSL1
01883         MOVE CATB-CURSOR             TO MAP-2ND-MTH-EMPL-CNT-L    DTSCSL1
01884         SET CURSOR-SET-YES TO TRUE.                               DTSCSL1
01885  S1301-EXIT. EXIT.                                                DTSCSL1
01886 /*****************************************************************DTSCSL1
01887 *                                                                 DTSCSL1
01888 ******************************************************************DTSCSL1
01889  S1400-3RD-MTH-EMPL-CNT.                                          DTSCSL1
01890      MOVE MAP-3RD-MTH-EMPL-CNT-AREA  TO L013-S-CNT-AREA.          DTSCSL1
01891      PERFORM S013-COUNT-FROM-SCREEN  THRU S013-EXIT.              DTSCSL1
01892                                                                   DTSCSL1
01893      IF L013-NO-ENTRY                                             DTSCSL1
01894         GO TO S1400-EXIT.                                         DTSCSL1
01895                                                                   DTSCSL1
01896      IF L013-INVALID-NEGATIVE                                     DTSCSL1
01897         MOVE EMSG-INVALID-NEGATIVE   TO WRK-MSG-AREA              DTSCSL1
01898         PERFORM S1401-ERROR          THRU S1401-EXIT              DTSCSL1
01899         GO TO S1400-EXIT.                                         DTSCSL1
01900                                                                   DTSCSL1
01901      IF L013-EXCEEDS-MIN-MAX                                      DTSCSL1
01902         MOVE EMSG-EXCEEDS-MIN-MAX    TO WRK-MSG-AREA              DTSCSL1
01903         PERFORM S1401-ERROR          THRU S1401-EXIT              DTSCSL1
01904         GO TO S1400-EXIT.                                         DTSCSL1
01905                                                                   DTSCSL1
01906      IF L013-NOT-VALID                                            DTSCSL1
01907         MOVE EMSG-FIELD-NOT-VALID    TO WRK-MSG-AREA              DTSCSL1
01908         PERFORM S1401-ERROR          THRU S1401-EXIT              DTSCSL1
01909         GO TO S1400-EXIT.                                         DTSCSL1
01910                                                                   DTSCSL1
01911      MOVE L013-CNT                  TO MAP-3RD-MTH-EMPL-CNT-N.    DTSCSL1
01912  S1400-EXIT. EXIT.                                                DTSCSL1
01913                                                                   DTSCSL1
01914  S1401-ERROR.                                                     DTSCSL1
01915      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-3RD-MTH-EMPL-CNT-A    DTSCSL1
01916      IF LCCM-NO-MSG                                               DTSCSL1
01917         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCSL1
01918         MOVE CATB-CURSOR             TO MAP-3RD-MTH-EMPL-CNT-L    DTSCSL1
01919         SET CURSOR-SET-YES TO TRUE.                               DTSCSL1
01920  S1401-EXIT. EXIT.                                                DTSCSL1
01921 /*****************************************************************DTSCSL1
01922 *                                                                 DTSCSL1
01923 ******************************************************************DTSCSL1
01924  S1500-SIC-CD.                                                       CL**5
01925      IF MAP-SIC-CD = LOW-VALUES OR SPACES                            CL*18
01926          SET MAP-SIC-CD-NONCLASSIF-88 TO TRUE.                       CL*18
01927                                                                      CL*18
01928      MOVE MAP-SIC-CD  TO L039-SIC-CD.                                CL*18
01929                                                                      CL*18
01930      PERFORM S039-SIC-CD-DSCR THRU S039-EXIT.                        CL*18
01931                                                                      CL*18
01932      IF L039-SIC-NOT-VALID                                        DTSCSL1
01933         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCSL1
01934         PERFORM S1501-ERROR THRU S1501-EXIT.                         CL**5
01935  S1500-EXIT.                                                         CL*18
01936      EXIT.                                                           CL*18
01937                                                                      CL*18
01938                                                                      CL*18
01939                                                                      CL*18
01940  S1501-ERROR.                                                        CL**5
01941      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-SIC-CD-A.              DTSCSL1
01942      IF LCCM-NO-MSG                                               DTSCSL1
01943         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                           CL*18
01944         MOVE CATB-CURSOR TO MAP-SIC-CD-L                             CL*18
01945         SET CURSOR-SET-YES TO TRUE.                               DTSCSL1
01946  S1501-EXIT.                                                         CL*18
01947      EXIT.                                                           CL*18
01948 /*****************************************************************   CL*18
01949 *                                                                    CL*18
01950 ******************************************************************   CL*18
01951  S1600-NAICS-CD.                                                     CL**5
01952      IF MAP-NAICS-CD = LOW-VALUES OR SPACES                          CL**5
01953         SET MAP-NAICS-CD-NONCLASSIF-88 TO TRUE.                      CL*18
01954                                                                      CL*18
01955      MOVE MAP-NAICS-CD TO L040-NAICS-CD.                             CL*18
01956                                                                      CL*18
01957      PERFORM S040-NAICS-CD-DSCR THRU S040-EXIT.                      CL*18
01958                                                                      CL*18
01959      IF L040-NAICS-NOT-VALID                                         CL**8
01960         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                    CL**5
01961         PERFORM S1601-ERROR THRU S1601-EXIT                          CL*18
01962         GO TO S1600-EXIT.                                            CL**5
01963  S1600-EXIT.                                                         CL*18
01964      EXIT.                                                           CL*18
01965                                                                      CL*18
01966                                                                      CL*18
01967                                                                      CL*18
01968  S1601-ERROR.                                                        CL**5
01969      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-NAICS-CD-A.               CL*18
01970                                                                      CL*18
01971      IF LCCM-NO-MSG                                                  CL**5
01972         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                           CL*18
01973         MOVE CATB-CURSOR TO MAP-NAICS-CD-L                           CL*18
01974         SET CURSOR-SET-YES TO TRUE.                                  CL**5
01975  S1601-EXIT.                                                         CL*18
01976      EXIT.                                                           CL*18
01977 /*****************************************************************DTSCSL1
01978 *                                                                 DTSCSL1
01979 ******************************************************************DTSCSL1
01980  S1700-SIC-AUX-CD.                                                   CL*16
01981      IF MAP-SIC-AUX-CD = LOW-VALUES OR SPACES                        CL*16
01982         SET MAP-SIC-AUX-UNK-88 TO TRUE.                              CL*18
01983                                                                   DTSCSL1
01984      MOVE MAP-SIC-AUX-CD TO L038-CD-1.                               CL*16
01985                                                                   DTSCSL1
01986      PERFORM S038-MPRF-SIC-AUXILIARY-CD THRU S038-EXIT.              CL*16
01987                                                                      CL*18
01988      IF L038-NOT-VALID                                            DTSCSL1
01989         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCSL1
01990         PERFORM S1701-ERROR THRU S1701-EXIT.                         CL*18
01991  S1700-EXIT.                                                         CL*18
01992      EXIT.                                                           CL*18
01993                                                                      CL*18
01994                                                                      CL*18
01995                                                                      CL*18
01996  S1701-ERROR.                                                     DTSCSL1
01997      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-SIC-AUX-CD-A.             CL*18
01998                                                                      CL*18
01999      IF LCCM-NO-MSG                                               DTSCSL1
02000         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                           CL*18
02001         MOVE CATB-CURSOR TO MAP-SIC-AUX-CD-L                         CL*18
02002         SET CURSOR-SET-YES TO TRUE.                               DTSCSL1
02003  S1701-EXIT.                                                         CL*18
02004      EXIT.                                                           CL*18
02005 /*****************************************************************   CL**5
02006 *                                                                    CL**5
02007 ******************************************************************   CL**5
02008  S1800-OWN-CD.                                                       CL**5
02009      IF MAP-OWN-CD = LOW-VALUES OR SPACES                            CL*19
02010          SET MAP-OWN-CD-NONCLASSIF-88 TO TRUE.                       CL*19
02011                                                                      CL*19
02012      MOVE MAP-OWN-CD TO L038-CD-2.                                   CL*19
02013                                                                      CL*19
02014      PERFORM S038-MPRF-OWN-CD THRU S038-EXIT.                        CL*19
02015                                                                      CL*19
02016      IF L038-NOT-VALID                                               CL**7
02017         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                    CL**5
02018         PERFORM S1801-ERROR THRU S1801-EXIT.                         CL**5
02019  S1800-EXIT.                                                         CL*19
02020      EXIT.                                                           CL*19
02021                                                                      CL*19
02022                                                                      CL*19
02023                                                                      CL*19
02024  S1801-ERROR.                                                        CL**5
02025      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-OWN-CD-A.                 CL**5
02026                                                                      CL*19
02027      IF LCCM-NO-MSG                                                  CL**5
02028         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                           CL*19
02029         MOVE CATB-CURSOR TO MAP-OWN-CD-L                             CL*19
02030         SET CURSOR-SET-YES TO TRUE.                                  CL**5
02031  S1801-EXIT.                                                         CL*19
02032      EXIT.                                                           CL*19
02033 /*****************************************************************DTSCSL1
02034 *                                                                 DTSCSL1
02035 ******************************************************************DTSCSL1
02036  S1900-MULTI-IND.                                                    CL**5
02037      IF MAP-MULTI-IND = LOW-VALUES OR SPACES                      DTSCSL1
02038         MOVE 'N' TO MAP-MULTI-IND.                                   CL*20
02039                                                                   DTSCSL1
02040      MOVE MAP-MULTI-IND TO L038-CD-1                                 CL*11
02041                                                                   DTSCSL1
02042      PERFORM S038-MPRF-MULTI-IND THRU S038-EXIT.                  DTSCSL1
02043                                                                      CL*20
02044      IF L038-NOT-VALID                                            DTSCSL1
02045         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCSL1
02046         PERFORM S1901-ERROR THRU S1901-EXIT.                         CL*20
02047  S1900-EXIT.                                                         CL*20
02048      EXIT.                                                           CL*20
02049                                                                      CL*20
02050                                                                      CL*20
02051                                                                      CL*20
02052  S1901-ERROR.                                                        CL**5
02053      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-MULTI-IND-A.              CL*20
02054                                                                      CL*20
02055      IF LCCM-NO-MSG                                               DTSCSL1
02056         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                           CL*20
02057         MOVE CATB-CURSOR TO MAP-MULTI-IND-L                          CL*20
02058         SET CURSOR-SET-YES TO TRUE.                               DTSCSL1
02059  S1901-EXIT.                                                         CL*20
02060      EXIT.                                                           CL*20
02061 /*****************************************************************   CL**5
02062 *                                                                    CL**5
02063 ******************************************************************   CL**5
02064  S2000-WARD-CD.                                                      CL**5
02065      IF MAP-WARD-CD = LOW-VALUES OR SPACES                           CL**5
02066          SET MAP-WARD-UNKOWN-88 TO TRUE.                             CL*20
02067                                                                      CL*20
02068      MOVE MAP-WARD-CD TO L038-CD-2.                                  CL*20
02069                                                                      CL*20
02070      PERFORM S038-MPRF-WARD-CD THRU S038-EXIT.                       CL*20
02071                                                                      CL*20
02072      IF L038-NOT-VALID                                               CL**5
02073         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                    CL**5
02074         PERFORM S2001-ERROR THRU S2001-EXIT.                         CL*20
02075  S2000-EXIT.                                                         CL*19
02076      EXIT.                                                           CL*19
02077                                                                      CL*19
02078                                                                      CL*19
02079                                                                      CL*19
02080  S2001-ERROR.                                                        CL**5
02081      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-WARD-CD-A.                CL*20
02082                                                                      CL*20
02083      IF LCCM-NO-MSG                                                  CL**5
02084         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                           CL*20
02085         MOVE CATB-CURSOR TO MAP-WARD-CD-L                            CL*20
02086         SET CURSOR-SET-YES TO TRUE.                                  CL**5
02087  S2001-EXIT.                                                         CL*20
02088      EXIT.                                                           CL*20
02089 /*****************************************************************DTSCSL1
02090 *  'EMPTY' IS LEGITIMATE.                                         DTSCSL1
02091 ******************************************************************DTSCSL1
02092  S2101-YRQ.                                                       DTSCSL1
02093      MOVE MAP-YRQ-AREA          TO L029-S-YRQ-AREA.                  CL*14
02094      PERFORM S029-YRQ-FROM-SCREEN    THRU S029-EXIT.                 CL*14
02095      IF L029-NO-ENTRY                                                CL*14
02096          MOVE +0                      TO WRK-YRQ                  DTSCSL1
02097      ELSE                                                         DTSCSL1
02098      IF L029-VALID                                                   CL*14
02099          MOVE L029-YRQ                TO WRK-YRQ                     CL*14
02100      ELSE                                                         DTSCSL1
02101         MOVE EMSG-FIELD-NOT-VALID    TO WRK-MSG-AREA              DTSCSL1
02102         PERFORM S2199-ERROR          THRU S2199-EXIT.             DTSCSL1
02103  S2101-EXIT. EXIT.                                                DTSCSL1
02104                                                                   DTSCSL1
02105  S2199-ERROR.                                                     DTSCSL1
02106      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-YRQ-YR-A                  CL*14
02107                                        MAP-YRQ-Q-A.                  CL*14
02108      IF LCCM-NO-MSG                                               DTSCSL1
02109         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCSL1
02110         MOVE CATB-CURSOR             TO MAP-YRQ-YR-L              DTSCSL1
02111         SET CURSOR-SET-YES TO TRUE.                               DTSCSL1
02112  S2199-EXIT. EXIT.                                                DTSCSL1
02113      EJECT                                                        DTSCSL1
02114 /*****************************************************************DTSCSL1
02115 * LOCK SCREEN FOR UPDATE CONFIRMATION                            *DTSCSL1
02116 ******************************************************************DTSCSL1
02117  S5100-SET-LOCK-ATTRB.                                            DTSCSL1
02118      MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN                      DTSCSL1
02119                                 WRK-ATB-NUM.                      DTSCSL1
02120                                                                   DTSCSL1
02121      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCSL1
02122                                                                   DTSCSL1
02123      MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A                  DTSCSL1
02124                                   MAP-EMP-NO-2-A                  DTSCSL1
02125                                   MAP-YRQ-YR-A                    DTSCSL1
02126                                   MAP-YRQ-Q-A                     DTSCSL1
02127                                   MAP-GOTO-A.                     DTSCSL1
02128  S5100-EXIT.                                                      DTSCSL1
02129      EXIT.                                                        DTSCSL1
02130                                                                   DTSCSL1
02131 ******************************************************************DTSCSL1
02132 * SET ATTIBUTE BYTES FOR UPDATE ACCESS                           *DTSCSL1
02133 ******************************************************************DTSCSL1
02134  S5200-SET-UPDATE-ATTRB.                                          DTSCSL1
02135      MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN.                 DTSCSL1
02136      MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM.               DTSCSL1
02137                                                                   DTSCSL1
02138      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCSL1
02139                                                                   DTSCSL1
02140      IF (SCR-HOLD-YRQ NOT NUMERIC)                                DTSCSL1
02141            OR                                                     DTSCSL1
02142         (SCR-HOLD-YRQ = +0)                                       DTSCSL1
02143            OR                                                        CL*14
02144         (SCR-HOLD-YRQ = LCCM-PICKUP-YRQ)                             CL*14
02145         MOVE CATB-ASKIP-BRT-MDTON TO                                 CL*14
02146                          MAP-1ST-MTH-EMPL-CNT-A                   DTSCSL1
02147                          MAP-2ND-MTH-EMPL-CNT-A                   DTSCSL1
02148                          MAP-3RD-MTH-EMPL-CNT-A                   DTSCSL1
02149      END-IF.                                                      DTSCSL1
02150  S5200-EXIT.                                                      DTSCSL1
02151      EXIT.                                                        DTSCSL1
02152                                                                   DTSCSL1
02153 ******************************************************************DTSCSL1
02154 *  SET ATTRIBUTE BYTES FOR INQUIRY STATUS                        *DTSCSL1
02155 ******************************************************************DTSCSL1
02156  S5300-SET-INQ-ATTRB.                                             DTSCSL1
02157      MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN                     DTSCSL1
02158                                   WRK-ATB-NUM.                    DTSCSL1
02159                                                                   DTSCSL1
02160      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCSL1
02161  S5300-EXIT.                                                      DTSCSL1
02162      EXIT.                                                        DTSCSL1
02163                                                                   DTSCSL1
02164  S5900-SET-ATTRB.                                                 DTSCSL1
02165      MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A             DTSCSL1
02166                                        MAP-EMP-NO-2-A.               CL*14
02167                                                                      CL*14
02168      MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-YRQ-YR-A                   CL*14
02169                                       MAP-YRQ-Q-A.                   CL*14
02170                                                                   DTSCSL1
02171      MOVE WRK-ATB-AN TO MAP-MULTI-IND-A                           DTSCSL1
02172                         MAP-SIC-AUX-CD-A                             CL*16
02173                         MAP-SIC-CD-A                              DTSCSL1
02174                         MAP-NAICS-CD-A                               CL**4
02175                         MAP-WARD-CD-A                                CL**4
02176                         MAP-OWN-CD-A.                             DTSCSL1
02177                                                                   DTSCSL1
02178      MOVE WRK-ATB-NUM TO MAP-1ST-MTH-EMPL-CNT-A                   DTSCSL1
02179                          MAP-2ND-MTH-EMPL-CNT-A                   DTSCSL1
02180                          MAP-3RD-MTH-EMPL-CNT-A.                     CL**4
02181                                                                   DTSCSL1
02182      MOVE CATB-ASKIP-BRT-MDTON TO MAP-PRIMARY-NAME-A                 CL**4
02183                                   MAP-CURR-PAGE-A                 DTSCSL1
02184                                   MAP-LAST-PAGE-A                 DTSCSL1
02185                                   MAP-TOT-WAGE-A                  DTSCSL1
02186                                   MAP-TAX-WAGE-A                  DTSCSL1
02187                                   MAP-WAGE-CHNG-DATE-A            DTSCSL1
02188                                   MAP-CURR-RPT-TYPE-DSCR-A        DTSCSL1
02189                                   MAP-EMPL-CNT-CHNG-DATE-A        DTSCSL1
02190                                   MAP-OLD-NAICS-CD-A                 CL**4
02191                                   MAP-OLD-SIC-CD-A                DTSCSL1
02192                                   MAP-SIC-CD-CHNG-DATE-A             CL**8
02193                                   MAP-OLD-OWN-CD-A                DTSCSL1
02194                                   MAP-OWN-CHNG-DATE-A             DTSCSL1
02195                                   MAP-NAICS-CHNG-DATE-A.             CL**9
02196                                                                   DTSCSL1
02197      MOVE CATB-ASKIP-NORM-MDTON TO MAP-NAICS-CD-DSCR-A               CL**4
02198                                    MAP-SIC-CD-DSCR-A              DTSCSL1
02199                                    MAP-OWN-CD-DSCR-A              DTSCSL1
02200                                    MAP-SIC-AUX-CD-DSCR-A             CL*16
02201                                    MAP-MULTI-IND-DSCR-A.          DTSCSL1
02202                                                                   DTSCSL1
02203      MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A.                 DTSCSL1
02204  S5900-EXIT.                                                      DTSCSL1
02205      EXIT.                                                        DTSCSL1
02206 /*****************************************************************DTSCSL1
02207 * MAP ROUTINES                                                   *DTSCSL1
02208 ******************************************************************DTSCSL1
02209  S9100-RECEIVE.                                                   DTSCSL1
02210      SET L851-RECEIVE-88 TO TRUE.                                 DTSCSL1
02211                                                                   DTSCSL1
02212      MOVE WRK-SCR-ID TO L851-SCR-ID.                              DTSCSL1
02213                                                                   DTSCSL1
02214      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCSL1
02215                                                                   DTSCSL1
02216      MOVE L851-AID TO LCCM-AID.                                   DTSCSL1
02217      MOVE L851-CURSOR TO LCCM-CURSOR.                             DTSCSL1
02218  S9100-EXIT.                                                      DTSCSL1
02219      EXIT.                                                        DTSCSL1
02220                                                                   DTSCSL1
02221  S9200-SEND-DATAONLY.                                             DTSCSL1
02222      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCSL1
02223                                                                   DTSCSL1
02224      IF LCCM-NO-MSG                                               DTSCSL1
02225          NEXT SENTENCE                                            DTSCSL1
02226      ELSE                                                         DTSCSL1
02227          PERFORM S805-MSG-AREA THRU S805-EXIT.                    DTSCSL1
02228                                                                   DTSCSL1
02229      IF CURSOR-SET-GOTO                                           DTSCSL1
02230          MOVE CATB-CURSOR TO MAP-GOTO-L                           DTSCSL1
02231      ELSE                                                         DTSCSL1
02232          MOVE CATB-CURSOR TO MAP-EMP-NO-1-L.                      DTSCSL1
02233                                                                   DTSCSL1
02234      SET L851-SEND-DATAONLY-88 TO TRUE.                           DTSCSL1
02235                                                                   DTSCSL1
02236      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCSL1
02237                                                                   DTSCSL1
02238      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCSL1
02239  S9200-EXIT.                                                      DTSCSL1
02240      EXIT.                                                        DTSCSL1
02241                                                                   DTSCSL1
02242  S9300-SEND-MAP.                                                  DTSCSL1
02243      MOVE  LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE.             DTSCSL1
02244      MOVE  SPACES TO MAP-SYS-TIME.                                DTSCSL1
02245      MOVE  LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME.             DTSCSL1
02246      MOVE  LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME.         DTSCSL1
02247                                                                   DTSCSL1
02248      IF SCR-ACCESS-UPDATE                                         DTSCSL1
02249          PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT               DTSCSL1
02250      ELSE                                                         DTSCSL1
02251          PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT.             DTSCSL1
02252                                                                   DTSCSL1
02253      PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT.                   DTSCSL1
02254                                                                   DTSCSL1
02255      PERFORM S805-MSG-AREA THRU S805-EXIT.                        DTSCSL1
02256                                                                   DTSCSL1
02257      IF CURSOR-SET-NO                                             DTSCSL1
02258          MOVE CATB-CURSOR TO MAP-EMP-NO-1-L.                      DTSCSL1
02259                                                                   DTSCSL1
02260      SET L851-SEND-88 TO TRUE.                                    DTSCSL1
02261                                                                   DTSCSL1
02262      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCSL1
02263                                                                   DTSCSL1
02264      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCSL1
02265  S9300-EXIT.                                                      DTSCSL1
02266      EXIT.                                                        DTSCSL1
02267                                                                   DTSCSL1
02268  S9310-UPDATE-FKEYS.                                              DTSCSL1
02269      PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT.                 DTSCSL1
02270                                                                   DTSCSL1
02271      MOVE CFKD-MOD TO MAP-KEY-MOD.                                DTSCSL1
02272                                                                   DTSCSL1
02273      IF LCCM-SCR-CLEAR                                            DTSCSL1
02274          MOVE LOW-VALUES TO MAP-KEY-MOD                           DTSCSL1
02275      ELSE                                                         DTSCSL1
02276      IF LCCM-SCR-INQUIRE                                          DTSCSL1
02277          NEXT SENTENCE                                            DTSCSL1
02278      ELSE                                                         DTSCSL1
02279      IF LCCM-SCR-UPDATE-LOCKED                                    DTSCSL1
02280          MOVE LOW-VALUES TO MAP-KEY-FIRST                         DTSCSL1
02281                             MAP-KEY-LAST                          DTSCSL1
02282                             MAP-KEY-BACK                          DTSCSL1
02283                             MAP-KEY-FWRD                          DTSCSL1
02284                             MAP-KEY-MOD                           DTSCSL1
02285      ELSE                                                         DTSCSL1
02286          NEXT SENTENCE.                                           DTSCSL1
02287  S9310-EXIT.                                                      DTSCSL1
02288      EXIT.                                                        DTSCSL1
02289                                                                   DTSCSL1
02290  S9320-INQUIRY-FKEYS.                                             DTSCSL1
02291      MOVE CFKD-FIRST TO MAP-KEY-FIRST.                            DTSCSL1
02292      MOVE CFKD-LAST TO MAP-KEY-LAST.                              DTSCSL1
02293      MOVE CFKD-BACKWARD TO MAP-KEY-BACK.                          DTSCSL1
02294      MOVE CFKD-FORWARD TO MAP-KEY-FWRD.                           DTSCSL1
02295                                                                   DTSCSL1
02296      MOVE LOW-VALUES TO MAP-KEY-MOD.                              DTSCSL1
02297                                                                   DTSCSL1
02298      PERFORM S9321-JUMP-KEYS THRU S9321-EXIT.                     DTSCSL1
02299  S9320-EXIT.                                                      DTSCSL1
02300      EXIT.                                                        DTSCSL1
02301                                                                   DTSCSL1
02302  S9321-JUMP-KEYS.                                                 DTSCSL1
02303  S9321-EXIT.                                                      DTSCSL1
02304      EXIT.                                                        DTSCSL1
02305                                                                   DTSCSL1
02306  S9330-DSCR-FIELDS.                                               DTSCSL1
02307      IF WRK-MPRF-YES-88                                           DTSCSL1
02308          MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME.                 CL**4
02309                                                                   DTSCSL1
02310      IF MAP-OWN-CD = SPACES OR LOW-VALUES                            CL**4
02311          MOVE LOW-VALUES TO MAP-OWN-CD-DSCR                          CL**4
02312      ELSE                                                         DTSCSL1
02313          MOVE MAP-OWN-CD TO L038-CD-2                                CL*11
02314          PERFORM S038-MPRF-OWN-CD THRU S038-EXIT                     CL**4
02315          MOVE L038-SHORT-DSCR TO MAP-OWN-CD-DSCR.                    CL**8
02316                                                                   DTSCSL1
02317      IF  MAP-SIC-CD = SPACES OR LOW-VALUES                           CL**4
02318          MOVE LOW-VALUES TO MAP-SIC-CD-DSCR                       DTSCSL1
02319      ELSE                                                         DTSCSL1
02320          MOVE MAP-SIC-CD TO L039-SIC-CD                           DTSCSL1
02321          PERFORM S039-SIC-CD-DSCR THRU S039-EXIT                     CL**6
02322          MOVE L039-SIC-LONG-DSCR TO MAP-SIC-CD-DSCR.                 CL**4
02323                                                                   DTSCSL1
02324      IF MAP-SIC-AUX-CD = SPACES OR LOW-VALUES                        CL*16
02325          MOVE LOW-VALUES TO MAP-SIC-AUX-CD-DSCR                      CL*16
02326      ELSE                                                         DTSCSL1
02327          MOVE MAP-SIC-AUX-CD TO L038-CD-1                            CL*16
02328          PERFORM S038-MPRF-SIC-AUXILIARY-CD THRU S038-EXIT           CL*16
02329          MOVE L038-SHORT-DSCR TO MAP-SIC-AUX-CD-DSCR.                CL*16
02330                                                                   DTSCSL1
02331      IF MAP-MULTI-IND = SPACES OR LOW-VALUES                      DTSCSL1
02332          MOVE LOW-VALUES TO MAP-MULTI-IND-DSCR                    DTSCSL1
02333      ELSE                                                         DTSCSL1
02334          MOVE MAP-MULTI-IND TO L038-CD-1                             CL*11
02335          PERFORM S038-MPRF-MULTI-IND THRU S038-EXIT               DTSCSL1
02336          MOVE L038-SHORT-DSCR TO MAP-MULTI-IND-DSCR.              DTSCSL1
02337                                                                   DTSCSL1
02338      IF  MAP-NAICS-CD = SPACES OR LOW-VALUES                         CL**4
02339          MOVE LOW-VALUES TO MAP-NAICS-CD-DSCR                        CL**4
02340      ELSE                                                            CL**4
02341          MOVE MAP-NAICS-CD TO L040-NAICS-CD                          CL**4
02342          PERFORM S040-NAICS-CD-DSCR THRU S040-EXIT                   CL**6
02343          MOVE L040-NAICS-LONG-DSCR TO MAP-NAICS-CD-DSCR.             CL**4
02344                                                                      CL**4
02345  S9330-EXIT. EXIT.                                                DTSCSL1
02346                                                                   DTSCSL1
02347  S9900-PREPARE-SEND.                                              DTSCSL1
02348      MOVE WRK-SCR-ID TO L851-SCR-ID                               DTSCSL1
02349                         LCCM-SCR-ID.                              DTSCSL1
02350      MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND.                    DTSCSL1
02351      MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE.                         DTSCSL1
02352  S9900-EXIT.                                                      DTSCSL1
02353      EXIT.                                                        DTSCSL1
