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