00001  IDENTIFICATION DIVISION.                                         12/14/09
00002  PROGRAM-ID.             DTSCS17.                                 DTSCS17
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV051
00004  DATE-WRITTEN.           APRIL 1994.                              DTSCS17
00005  DATE-COMPILED.                                                   DTSCS17
00006      SKIP3                                                        DTSCS17
00007 *****                                                             DTSCS17
00008 *                                                                 DTSCS17
00009 *    FUNCTION:  SPAN OF LIABILITY INQUIRY/UPDATE                  DTSCS17
00010 *               SCREEN PROCESSOR.                                 DTSCS17
00011 *                                                                 DTSCS17
00012 *                                                                 DTSCS17
00013 *    MODIFICATION LOG:                                            DTSCS17
00014 *                                                                 DTSCS17
00015 *                                                                 DTSCS17
00016 *    10/27/98  MODIFIED FOR DC.       COPIED FROM MACCS17.        DTSCS17
00017 *              REFERENCE RFP:                   PROGRAMMER: ZL1   DTSCS17
00018 *                                                                 DTSCS17
00019 *    08/27/1999  INITIALIZE T036-ADDR-ESTB-ABSTIME TO ZERO.       DTSCS17
00020 *                REFERENCE: BUG FIX             PROGRAMMER: EHH   DTSCS17
00021 *                                                                 DTSCS17
00022 *    05/08/2000  MODIFIED S1710 TO MAKE INACTIVE LETTER TYPE      DTSCS17
00023 *                A REQUIRED FIELD.                                DTSCS17
00024 *                REFERENCE: ENH014              PROGRAMMER: GD    DTSCS17
00025 *                                                                 DTSCS17
00026 *    12/09/2002  MODIFIED TO TO USE OPERATOR ID OF USER CURRENTLY DTSCS17
00027 *                SIGNED ON AS 'RESPONSIBLE OP ID,' UNLESS THE     DTSCS17
00028 *                USER HAS SPECIFICALLY ENTERED A DIFFERENT ID     DTSCS17
00029 *                IN THE MAP-RESP-OP-ID FIELD.                     DTSCS17
00030 *                REFERENCE: REQUEST FROM STATUS PROGRAMMER: GD    DTSCS17
00031 *                                                                 DTSCS17
00032 *    10/20/2003  MODIFIED S1600: IF SPAN OF LIABILITY IS WITHDRAWNDTSCS17
00033 *                (INACT-CD = 04 OR 05), LIABILITY DATE MUST =     DTSCS17
00034 *                INACTIVE DATE.                                   DTSCS17
00035 *                REFERENCE: REQUEST FROM FIELD  PROGRAMMER: GD    DTSCS17
00036 *                                                                 DTSCS17
00037 *    08/02/2004  MODIFIED S3300: ONLY SUPERVISORS CAN ENTER       DTSCS17
00038 *                TRANSACTIONS THAT WILL WITHDRAW REPORTS.         DTSCS17
00039 *                REFERENCE:                     PROGRAMMER: GD    DTSCS17
00040 *                                                                 DTSCS17
00041 *    09/01/2004  MODIFIED S3300: TRANSACTIONS THAT WITHDRAW       DTSCS17
00042 *                REPORTS WILL PRODUCE AN ERROR MESSAGE ONLY IF    DTSCS17
00043 *                THERE ARE REPORTS WITH TOTAL WAGES > ZERO.       DTSCS17
00044 *                REFERENCE:                     PROGRAMMER: GD    DTSCS17
00045 *                                                                 DTSCS17
00046 *    01/11/2005  MODIFIED TO UPDATE MERA WHEN A SPAN OF           DTSCS17
00047 *                LIABILITY IS WITHDRAWN.                          DTSCS17
00048 *                REFERENCE:                     PROGRAMMER: GD    DTSCS17
00049 *                                                                 DTSCS17
00050 *    04/06/2005  MODIFIED S3314: DO NOT INCREMENT WRK-WITHDRAW-   DTSCS17
00051 *                WAGES-CNT IF THE REPORT IS ESTIMATED. IF THE     DTSCS17
00052 *                COUNT IS > ZERO, THE PROGRAM REQUIRES            DTSCS17
00053 *                SUPERVISOR APPROVAL FOR ACTIONS THAT WILL        DTSCS17
00054 *                WITHDRAW REPORTS. WITHDRAWAL OF ESTIMATED        DTSCS17
00055 *                REPORTS DOES NOT REQUIRE SUPERVISOR APPROVAL.    DTSCS17
00056 *                REFERENCE:                     PROGRAMMER: GD    DTSCS17
00057 *                                                                 DTSCS17
00058 *    05/24/2007  MODIFIED EDIT IN S3210 INVOLVING INACTIVE DATE   DTSCS17
00059 *                AND RELATIONSHIPS. IF THE TRANSFER IS 100%, THE  DTSCS17
00060 *                INACTIVE DATE MUST BE < THE TRANSFER EFF DATE.   DTSCS17
00061 *                THE EDIT IS BYPASSED IF THE TRANSFER IS FOR      DTSCS17
00062 *                LESS THAN 100%.                                  DTSCS17
00063 *                REFERENCE:                     PROGRAMMER: GD    DTSCS17
00064 *                                                                 DTSCS17
00065 *    07/14/2009  RECOMPILED FOR NEW VERSION OF MPRF -             DTSCS17
00066 *                ELIGIBILITY CODES 21 (AB) AND 22 (DEPENDENCY     DTSCS17
00067 *                ALLOWANCE) ADDED.                                DTSCS17
00068 *                REFERENCE:                     PROGRAMMER: GD    DTSCS17
00069 *                                                                 DTSCS17
00070 *    07/30/2009  RECOMPILED FOR NEW VERSION OF MPRF -             DTSCS17
00071 *                ELIGIBILITY CODE 23 (TRAINING EXTENSION) ADDED   DTSCS17
00072 *                REFERENCE:                     PROGRAMMER: GD    DTSCS17
00073 *                                                                 DTSCS17
00074 *    11/30/2009  MODIFIED TO CALL DTSCU084 TO CHECK FOR           DTSCS17
00075 *                APPROVAL BEFORE ALLOWING A SPAN OF LIABILITY     DTSCS17
00076 *                CHANGE.                                          DTSCS17
00077 *                REFERENCE:                     PROGRAMMER: GD    DTSCS17
00078 *                                                                 DTSCS17
00079 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCS17
00080 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCS17
00081 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSCS17
00082 *                                                                 DTSCS17
00083 *                                                                 DTSCS17
00084 *  DESCRIPTION:                                                   DTSCS17
00085 *                                                                 DTSCS17
00086 *                                                                 DTSCS17
00087 *    CLEAR:                                                       DTSCS17
00088 *                                                                 DTSCS17
00089 *      FIELD DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO)             DTSCS17
00090 *                                                                 DTSCS17
00091 *                                                                 DTSCS17
00092 *    JUMP:                                                        DTSCS17
00093 *                                                                 DTSCS17
00094 *      F17  REGISTRATION INQUIRY (11).                            DTSCS17
00095 *                                                                 DTSCS17
00096 *                                                                 DTSCS17
00097 *    INQUIRY:                                                     DTSCS17
00098 *                                                                 DTSCS17
00099 *      CONTROL FIELD(S): MAP-EMP-NO                               DTSCS17
00100 *                                                                 DTSCS17
00101 *      JUMP IN:  IF LCCM-EMP-NO = LCCM-SCR17-HOLD-AREA EMP-NO     DTSCS17
00102 *                  DISPLAY RECORD INDICATED BY                    DTSCS17
00103 *                  LCCM-SCR17-HOLD-AREA                           DTSCS17
00104 *                ELSE                                             DTSCS17
00105 *                  DISPLAY LAST PAGE OF DATA ASSOCIATED WITH      DTSCS17
00106 *                  LCCM-EMP-NO.                                   DTSCS17
00107 *                                                                 DTSCS17
00108 *      ENTER, F5, F6, F7, F8: STANDARD PAGING.                    DTSCS17
00109 *                                                                 DTSCS17
00110 *           DISPLAY SEQUENCE: ASCENDING ON MSOL-LIAB-DATE         DTSCS17
00111 *                                                                 DTSCS17
00112 *         PAGE INITIALLY DISPLAYED: LAST                          DTSCS17
00113 *                                                                 DTSCS17
00114 *                                                                 DTSCS17
00115 *      JUMP OUT: STANDARD LCCM-EMP-NO MAINTENANCE.                DTSCS17
00116 *                                                                 DTSCS17
00117 *                STORE INFORMATION REPRESENTING PAGE              DTSCS17
00118 *                CURRENTLY DISPLAYED IN LCCM-SCR17-HOLD-AREA.     DTSCS17
00119 *                                                                 DTSCS17
00120 *      STORE PAGING CONTROL INFORMATION IN LCCM-SCR-HOLD-AREA.    DTSCS17
00121 *                                                                 DTSCS17
00122 *                                                                 DTSCS17
00123 *    UPDATE:                                                      DTSCS17
00124 *                                                                 DTSCS17
00125 *      MOD:                                                       DTSCS17
00126 *                                                                 DTSCS17
00127 *        MSOL-LIAB-DATE IS PART OF THE MSOL RECORD KEY.           DTSCS17
00128 *        THUS A USER CHANGE TO MAP-LIAB-DATE REQUIRES THE PROGRAM DTSCS17
00129 *        TO DELETE A MSOL RECORD AND WRITE A MSOL RECORD (RATHER  DTSCS17
00130 *        THAN REWRITE THE MSOL RECORD).                           DTSCS17
00131 *                                                                 DTSCS17
00132 *        WHEN INACTIVATING AN EMPLOYER, MOVE +0 TO MSOL-INACT-    DTSCS17
00133 *        REVERSE-DATE AND MOVE PROC-DATE TO MSOL-INACT-ENTER-DATE.DTSCS17
00134 *                                                                 DTSCS17
00135 *        WHEN REVERSING AN INACTIVATION, MOVE PROC-DATE TO MSOL-  DTSCS17
00136 *        INACT-REVERSE-DATE AND DO NOT MODIFY MSOL-INACT-ENTER    DTSCS17
00137 *        -DATE.                                                   DTSCS17
00138 *                                                                 DTSCS17
00139 *        WHEN MODIFYING (AN EXISTING) MSOL-INACT-DATE, DO NOT     DTSCS17
00140 *        MODIFY MSOL-INACT-ENTER-DATE AND DO NOT MODIFY           DTSCS17
00141 *        MSOL-INACT-REVERSE-DATE.                                 DTSCS17
00142 *                                                                 DTSCS17
00143 *                                                                 DTSCS17
00144 *    RECORDS READ:                                                DTSCS17
00145 *                                                                 DTSCS17
00146 *      MASTER:                                                    DTSCS17
00147 *                                                                 DTSCS17
00148 *        MPRF                                                     DTSCS17
00149 *        MSOL                                                     DTSCS17
00150 *        MQTR                                                     DTSCS17
00151 *        MERA                                                     DTSCS17
00152 *                                                                 DTSCS17
00153 *                                                                 DTSCS17
00154 *      ALTERNATE INDEX:                                           DTSCS17
00155 *                                                                 DTSCS17
00156 *        NONE.                                                    DTSCS17
00157 *                                                                 DTSCS17
00158 *                                                                 DTSCS17
00159 *      REFERENCE:                                                 DTSCS17
00160 *                                                                 DTSCS17
00161 *        NONE.                                                    DTSCS17
00162 *                                                                 DTSCS17
00163 *                                                                 DTSCS17
00164 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS17
00165 *                                                                 DTSCS17
00166 *        NONE.                                                    DTSCS17
00167 *                                                                 DTSCS17
00168 *                                                                 DTSCS17
00169 *    RECORDS UPDATED:                                             DTSCS17
00170 *                                                                 DTSCS17
00171 *      MASTER:                                                    DTSCS17
00172 *                                                                 DTSCS17
00173 *        MPRF (REWRITE)                                           DTSCS17
00174 *        MSOL (WRITE, REWRITE, DELETE)                            DTSCS17
00175 *        MERA (REWRITE)                                           DTSCS17
00176 *        MERD (WRITE)                                             DTSCS17
00177 *                                                                 DTSCS17
00178 *                                                                 DTSCS17
00179 *      REFERENCE:                                                 DTSCS17
00180 *                                                                 DTSCS17
00181 *        NONE.                                                    DTSCS17
00182 *                                                                 DTSCS17
00183 *                                                                 DTSCS17
00184 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS17
00185 *                                                                 DTSCS17
00186 *        NONE.                                                    DTSCS17
00187 *                                                                 DTSCS17
00188 *                                                                 DTSCS17
00189 *    TEMPORARY STORAGE USAGE:                                     DTSCS17
00190 *                                                                 DTSCS17
00191 *      NONE.                                                      DTSCS17
00192 *                                                                 DTSCS17
00193 *                                                                 DTSCS17
00194 *    ON-LINE ACTIVITY FILE RECORDS WRITTEN:                       DTSCS17
00195 *                                                                 DTSCS17
00196 *      IF MSOS-INACT-DATE CHANGED FROM 99999999 TO VALID DATE     DTSCS17
00197 *              AND                                                DTSCS17
00198 *         MAP-INACT-LTR-TYPE IS NOT EQUAL TO 'N'                  DTSCS17
00199 *           DTSIT001 WITH T001-TRN-CD = 03 (INACTIVE-LTR).        DTSCS17
00200 *                                                                 DTSCS17
00201 *      IF MSOS-INACT-DATE CHANGED FROM 999999999 TO VALID DATE    DTSCS17
00202 *           DTSIT036 WITH T036-TRN-CD = 03 (INACTIVITY).          DTSCS17
00203 *                                                                 DTSCS17
00204 *      IF MSOS-INACT-DATE CHANGED FROM 999999999 TO VALID DATE    DTSCS17
00205 *                  OR                                             DTSCS17
00206 *         MSOS-INACT-DATE CHANGED FROM VALID DATE TO 999999999    DTSCS17
00207 *           DTSIT001 WITH T001-TRN-CD = 06 (FILE CLERK LIST).     DTSCS17
00208 *                                                                 DTSCS17
00209 *      DTSIT006 WITH T006-TRN-CD = 01 (UIRTE-EXIST-CHK).          DTSCS17
00210 *                                                                 DTSCS17
00211 *      DTSIT031 WITH T031-TRN-CD = 01 (AUTO-PROCESS).             DTSCS17
00212 *                                                                 DTSCS17
00213 *                                                                 DTSCS17
00214 *    MODULES LINKED TO:                                           DTSCS17
00215 *                                                                 DTSCS17
00216 *      DTSCU001  DATE EDIT/CONVERSION.                            DTSCS17
00217 *      DTSCU004  QUARTER EDIT/CONVERSION.                         DTSCS17
00218 *      DTSCU015  DATE FROM SCREEN FORMAT/EDIT.                    DTSCS17
00219 *      DTSCU018  EMPLOYER NUMBER FROM SCREEN FORMAT/EDIT.         DTSCS17
00220 *      DTSCU031  EMPLOYER REGISTRATION CODES EDIT/DESCRIPTION.    DTSCS17
00221 *      DTSCU074  DUPLICATE FEIN EDIT.                             DTSCS17
00222 *      DTSCU082  OPERATOR ID EDIT/LOOKUP.                         DTSCS17
00223 *      DTSCU201  DETERMINE EMPLOYER CLASS.                        DTSCS17
00224 *      DTSCU202  DETERMINE EMPLOYER TYPE.                         DTSCS17
00225 *      DTSCU221  MPRF-UPDATE DATA ELEMENTS MAINTENANCE.           DTSCS17
00226 *      DTSCU331  WRITE MAINTENANCE LIST REPORT RECORDS.           DTSCS17
00227 *      DTSCU810  MASTER FILE INPUT/OUTPUT.                        DTSCS17
00228 *      DTSCU825  ON-LINE ACTIVITY FILE OUTPUT                     DTSCS17
00229 *                                                                 DTSCS17
00230      SKIP3                                                        DTSCS17
00231  ENVIRONMENT DIVISION.                                            DTSCS17
00232      SKIP3                                                        DTSCS17
00233  DATA DIVISION.                                                   DTSCS17
00234      SKIP3                                                        DTSCS17
00235  WORKING-STORAGE SECTION.                                         DTSCS17
002355 77  PAN-VALET PICTURE X(24) VALUE '051DTSCS17   12/14/09'.       DTSCS17
00236      SKIP3                                                        DTSCS17
00237  01  WRK-AREA.                                                    DTSCS17
00238      05  WRK-ABEND-CD                PIC  X(04)  VALUE 'S17 '.    DTSCS17
00239                                                                   DTSCS17
00240      05  WRK-SCR-ID.                                              DTSCS17
00241          10  WRK-SCR-ID-N            PIC  9(02)  VALUE 17.        DTSCS17
00242                                                                   DTSCS17
00243      05  WRK-F03-SCR-ID              PIC  X(02)  VALUE '10'.      DTSCS17
00244      SKIP3                                                        DTSCS17
00245      05  ALL-NINES-DATE              PIC S9(09)  COMP-3           DTSCS17
00246                                             VALUE +999999999.     DTSCS17
00247      05  ALL-NINES-YRQ               PIC S9(05)  COMP-3           DTSCS17
00248                                             VALUE +99999.         DTSCS17
00249      SKIP3                                                        DTSCS17
00250      05  SCR-ACCESS-IND              PIC X(01).                   DTSCS17
00251          88  SCR-ACCESS-INQ                  VALUE '1'.           DTSCS17
00252          88  SCR-ACCESS-UPDATE               VALUE '2'.           DTSCS17
00253                                                                   DTSCS17
00254      05  CURSOR-SET-IND              PIC X(01).                   DTSCS17
00255          88  CURSOR-SET-YES                  VALUE 'Y'.           DTSCS17
00256          88  CURSOR-SET-NO                   VALUE 'N'.           DTSCS17
00257          88  CURSOR-SET-GOTO                 VALUE 'G'.           DTSCS17
00258                                                                   DTSCS17
00259      05  REQ-IND                     PIC X(01).                   DTSCS17
00260          88  REQ-ERROR                       VALUE 'O'.           DTSCS17
00261          88  REQ-JUMP                        VALUE 'J'.           DTSCS17
00262          88  REQ-INQUIRE                     VALUE 'I'.           DTSCS17
00263          88  REQ-CLEAR                       VALUE 'C'.           DTSCS17
00264          88  REQ-EDIT                        VALUE 'E'.           DTSCS17
00265          88  REQ-UPDATE                      VALUE 'U'.           DTSCS17
00266          88  REQ-CURSOR-TO-GOTO              VALUE 'G'.           DTSCS17
00267                                                                   DTSCS17
00268      05  RESP-IND                    PIC X(01).                   DTSCS17
00269          88  RESP-SEND-MSGONLY               VALUE 'O'.           DTSCS17
00270          88  RESP-SEND-MAP                   VALUE 'M'.           DTSCS17
00271          88  RESP-JUMP                       VALUE 'J'.           DTSCS17
00272          88  RESP-CURSOR-TO-GOTO             VALUE 'G'.           DTSCS17
00273                                                                   DTSCS17
00274      05  WRK-MSG-AREA                PIC  X(64).                  DTSCS17
00275                                                                   DTSCS17
00276      05  WRK-ATB-AN                  PIC  X(01).                  DTSCS17
00277      05  WRK-ATB-NUM                 PIC  X(01).                  DTSCS17
00278      SKIP3                                                        DTSCS17
00279      05  WRK-EMP-NO                  PIC S9(07)  COMP-3.          DTSCS17
00280                                                                   DTSCS17
00281      05  WRK-TRANSFER-EMP-NO         PIC S9(07)  COMP-3.          DTSCS17
00282                                                                   DTSCS17
00283      05  WRK-MPRF-IND                PIC  X(01).                  DTSCS17
00284          88  WRK-MPRF-YES-88                VALUE 'Y'.            DTSCS17
00285          88  WRK-MPRF-NO-88                 VALUE 'N'.            DTSCS17
00286      SKIP3                                                        DTSCS17
00287      05  WRK-DISPLAY                 PIC 9(11).                   DTSCS17
00288                                                                   DTSCS17
00289      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS17
00290          10  FILLER                  PIC X(05).                   DTSCS17
00291          10  WRK-DISPLAY-EMP-NO-1    PIC X(03).                   DTSCS17
00292          10  WRK-DISPLAY-EMP-NO-2    PIC X(03).                   DTSCS17
00293                                                                   DTSCS17
00294      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS17
00295          10  FILLER                  PIC X(05).                   DTSCS17
00296          10  WRK-DISPLAY-YR          PIC X(02).                   DTSCS17
00297          10  WRK-DISPLAY-MO          PIC X(02).                   DTSCS17
00298          10  WRK-DISPLAY-DA          PIC X(02).                   DTSCS17
00299                                                                   DTSCS17
00300      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS17
00301          10  FILLER                  PIC X(08).                   DTSCS17
00302          10  WRK-DISPLAY-QTR-YR      PIC X(02).                   DTSCS17
00303          10  WRK-DISPLAY-QTR-Q       PIC X(01).                   DTSCS17
00304                                                                   DTSCS17
00305      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS17
00306          10  FILLER                  PIC X(08).                   DTSCS17
00307          10  WRK-DISPLAY-ID-NO       PIC X(03).                   DTSCS17
00308      SKIP3                                                        DTSCS17
00309      05  WRK-INACT-CD                PIC  X(02).                  DTSCS17
00310      05  WRK-LIAB-DATE               PIC S9(09)  COMP-3.          DTSCS17
00311      05  WRK-INACT-DATE              PIC S9(09)  COMP-3.          DTSCS17
00312                                                                   DTSCS17
00313      05  WRK-FIRST-LIAB-YRQ          PIC S9(05) COMP-3.           DTSCS17
00314      05  WRK-LAST-LIAB-YRQ           PIC S9(05) COMP-3.           DTSCS17
00315      05  WRK-ESTIM-YRQ               PIC S9(05) COMP-3.           DTSCS17
00316                                                                   DTSCS17
00317      05  WRK-ALL-NINES-YRQ           PIC  9(05) VALUE 99999.      DTSCS17
00318      05  WRK-YRQ                     PIC  9(05).                  DTSCS17
00319      05  FILLER REDEFINES WRK-YRQ.                                DTSCS17
00320          10  WRK-YRQ-YR              PIC  9(04).                  DTSCS17
00321          10  WRK-YRQ-Q               PIC  9(01).                  DTSCS17
00322                                                                   DTSCS17
00323      05  WRK-END-YRQ                 PIC  9(05).                  DTSCS17
00324                                                                   DTSCS17
00325      05  WRK-RATE-CHK-IND            PIC  X(01).                  DTSCS17
00326          88  WRK-RATE-CHK-NULL-88           VALUE '0'.            DTSCS17
00327          88  WRK-RATE-CHK-ESTIM-88          VALUE '1'.            DTSCS17
00328          88  WRK-RATE-CHK-NO-RATE-88        VALUE '2'.            DTSCS17
00329          88  WRK-RATE-CHK-OK-88             VALUE '3'.            DTSCS17
00330          88  WRK-RATE-CHK-COMPLETE-88       VALUE '1' '2' '3'.    DTSCS17
00331                                                                   DTSCS17
00332      05  WRK-DISPLAY-ERR-IND         PIC  X(01).                  DTSCS17
00333          88  WRK-DISPLAY-ERR-YES-88         VALUE 'Y'.            DTSCS17
00334          88  WRK-DISPLAY-ERR-NO-88          VALUE 'N'.            DTSCS17
00335                                                                   DTSCS17
00336      05  TEMP-INACT-CD               PIC  X(02).                  DTSCS17
00337      SKIP3                                                        DTSCS17
00338      05  WRK-BNK-END-DATE            PIC S9(09)  COMP-3.          DTSCS17
00339      SKIP3                                                        DTSCS17
00340      05  HOLD-AREA.                                               DTSCS17
00341          10  HOLD-EMP-CLASS          PIC  X(01).                  DTSCS17
00342          10  HOLD-EMP-STATUS         PIC  X(01).                  DTSCS17
00343              88  HOLD-STATUS-ACT-88         VALUE 'A'.            DTSCS17
00344              88  HOLD-STATUS-INACT-88       VALUE 'I'.            DTSCS17
00345                                                                   DTSCS17
00346          10  HOLD-INACT-CD           PIC  X(02).                  DTSCS17
00347              88  HOLD-INACT-ACTIVE-88       VALUE '  '.           DTSCS17
00348          10  HOLD-FIRST-LIAB-YRQ     PIC S9(05)  COMP-3.          DTSCS17
00349          10  HOLD-LAST-LIAB-YRQ      PIC S9(05)  COMP-3.          DTSCS17
00350          10  HOLD-INACT-DATE         PIC S9(09)  COMP-3.          DTSCS17
00351          10  HOLD-LIAB-DATE          PIC S9(09)  COMP-3.          DTSCS17
00352          10  HOLD-LIAB-ESTB-DATE     PIC S9(09)  COMP-3.          DTSCS17
00353                                                                   DTSCS17
00354      SKIP3                                                        DTSCS17
00355      05  WRK-WITHDRAW-CNT            PIC S9(04)  COMP.            DTSCS17
00356                                                                   DTSCS17
00357      05  WRK-WITHDRAW-WAGES-CNT      PIC S9(04)  COMP.            DTSCS17
00358                                                                   DTSCS17
00359      05  WRK-TRANSFER-CNT            PIC S9(04)  COMP.            DTSCS17
00360                                                                   DTSCS17
00361      05  WRK-WITHDRAW-IND            PIC  X(01).                  DTSCS17
00362                                                                   DTSCS17
00363                                                                   DTSCS17
00364      05  WRK-TRANSFER-IND            PIC  X(01).                  DTSCS17
00365      SKIP3                                                        DTSCS17
00366      05  WRK-SUB1                    PIC S9(04)  COMP.            DTSCS17
00367      05  TBL-CNT                     PIC S9(04)  COMP.            DTSCS17
00368                                                                   DTSCS17
00369      05  TBL-ENTRY OCCURS 50 TIMES.                               DTSCS17
00370          10  TBL-FIRST-YRQ           PIC S9(05)  COMP-3.          DTSCS17
00371          10  TBL-LAST-YRQ            PIC S9(05)  COMP-3.          DTSCS17
00372      SKIP3                                                        DTSCS17
00373      05  INQUIRY-CONTROL-AREA.                                    DTSCS17
00374          10  LAST-REC-NUM            PIC S9(08)  COMP.            DTSCS17
00375          10  WS-REC-NUM              PIC S9(08)  COMP.            DTSCS17
00376                                                                   DTSCS17
00377          10  LAST-REC-KEY-AREA       PIC  X(16).                  DTSCS17
00378          10  SCR-REC-KEY-AREA        PIC  X(16).                  DTSCS17
00379                                                                   DTSCS17
00380          10  WS-REC-FOUND-IND        PIC  X(01).                  DTSCS17
00381      SKIP3                                                        DTSCS17
00382      05  HOLD-CANC-DATE              PIC  X(08).                  DTSCS17
00383          88  HOLD-CANC-DATE-NOT-VALID-88     VALUE HIGH-VALUES.   DTSCS17
00384          88  HOLD-CANC-DATE-NO-ENTRY-88      VALUE SPACES.        DTSCS17
00385      05  HOLD-CANC-DATE-9 REDEFINES HOLD-CANC-DATE                DTSCS17
00386                                      PIC  9(08).                  DTSCS17
00387                                                                   DTSCS17
00388      05  HOLD-REOPN-DATE             PIC  X(08).                  DTSCS17
00389          88  HOLD-REOPN-DATE-NOT-VALID-88    VALUE HIGH-VALUES.   DTSCS17
00390          88  HOLD-REOPN-DATE-NO-ENTRY-88     VALUE SPACES.        DTSCS17
00391      05  HOLD-REOPN-DATE-9 REDEFINES HOLD-REOPN-DATE              DTSCS17
00392                                      PIC  9(08).                  DTSCS17
00393                                                                   DTSCS17
00394 *****05  HOLD-WH-FIRST-ACTV-YRM      PIC  X(04).                  DTSCS17
00395 *********88  HOLD-WH-FIRST-NOT-VALID-88      VALUE HIGH-VALUES.   DTSCS17
00396 *********88  HOLD-WH-FIRST-NO-ENTRY-88       VALUE SPACES.        DTSCS17
00397 *****05  HOLD-WH-FIRST-ACTV-YRM-9                                 DTSCS17
00398 ************************REDEFINES HOLD-WH-FIRST-ACTV-YRM          DTSCS17
00399 *************************************PIC  9(04).                  DTSCS17
00400                                                                   DTSCS17
00401 *****05  HOLD-OFLT-FIRST-ACTV-YRM    PIC  X(04).                  DTSCS17
00402 *********88  HOLD-OFLT-FIRST-NOT-VALID-88    VALUE HIGH-VALUES.   DTSCS17
00403 *********88  HOLD-OFLT-FIRST-NO-ENTRY-88     VALUE SPACES.        DTSCS17
00404 *****05  HOLD-OFLT-FIRST-ACTV-YRM-9                               DTSCS17
00405 ************************REDEFINES HOLD-OFLT-FIRST-ACTV-YRM        DTSCS17
00406 *************************************PIC  9(04).                  DTSCS17
00407      EJECT                                                        DTSCS17
00408  01  MSG-LITERALS.                                                DTSCS17
00409      05  MSG-E171-AREA.                                           DTSCS17
00410          10  FILLER                  PIC  X(04)  VALUE 'E171'.    DTSCS17
00411          10  FILLER                  PIC  X(30)                   DTSCS17
00412                VALUE 'OVERLAPPING SPANS OF LIABILITY'.            DTSCS17
00413          10  FILLER                  PIC  X(30)                   DTSCS17
00414                VALUE ' ARE NOT ALLOWED.             '.            DTSCS17
00415                                                                   DTSCS17
00416 *****05  MSG-E172-AREA.                                           DTSCS17
00417 *********10  FILLER                  PIC  X(04)  VALUE 'E172'.    DTSCS17
00418 *********10  FILLER                  PIC  X(30)                   DTSCS17
00419 ***************VALUE 'SPAN OF LIABILITY OVERLAPS SPA'.            DTSCS17
00420 *********10  FILLER                  PIC  X(30)                   DTSCS17
00421 ***************VALUE 'N OF BANKRUPTCY  NOT ALLOWED  '.            DTSCS17
00422                                                                   DTSCS17
00423 *****05  MSG-E173-AREA.                                           DTSCS17
00424 *********10  FILLER                  PIC  X(04)  VALUE 'E173'.    DTSCS17
00425 *********10  FILLER                  PIC  X(30)                   DTSCS17
00426 ***************VALUE 'OPEN BANKRUPTCY  ACTIVATION NO'.            DTSCS17
00427 *********10  FILLER                  PIC  X(30)                   DTSCS17
00428 ***************VALUE 'T ALLOWED                     '.            DTSCS17
00429                                                                   DTSCS17
00430      05  MSG-E174-AREA.                                           DTSCS17
00431          10  FILLER                  PIC  X(04)  VALUE 'E174'.    DTSCS17
00432          10  FILLER                  PIC  X(30)                   DTSCS17
00433                VALUE 'PREDECESSOR EMPLOYER  CONFLICT'.            DTSCS17
00434          10  FILLER                  PIC  X(30)                   DTSCS17
00435                VALUE ' WITH RELATIONSHIP            '.            DTSCS17
00436                                                                   DTSCS17
00437      05  MSG-E175-AREA.                                           DTSCS17
00438          10  FILLER                  PIC  X(04)  VALUE 'E175'.    DTSCS17
00439          10  FILLER                  PIC  X(30)                   DTSCS17
00440                VALUE 'REPORTS WILL BE AUTOMATICALLY '.            DTSCS17
00441          10  FILLER                  PIC  X(30)                   DTSCS17
00442                VALUE 'WITHDRAWN.  TRANSFER?         '.            DTSCS17
00443                                                                   DTSCS17
00444      05  MSG-E176-AREA.                                           DTSCS17
00445          10  FILLER                  PIC  X(04)  VALUE 'E176'.    DTSCS17
00446          10  FILLER                  PIC  X(30)                   DTSCS17
00447                VALUE 'EMPLOYER CLASS WILL BE CHANGED'.            DTSCS17
00448          10  FILLER                  PIC  X(30)                   DTSCS17
00449                VALUE '.  OVERRIDE?                  '.            DTSCS17
00450                                                                   DTSCS17
00451      05  MSG-E177-AREA.                                           DTSCS17
00452          10  FILLER                  PIC  X(04)  VALUE 'E177'.    DTSCS17
00453          10  FILLER                  PIC  X(30)                   DTSCS17
00454                VALUE 'LIAB CD NOT CONSISTENT WITH EM'.            DTSCS17
00455          10  FILLER                  PIC  X(30)                   DTSCS17
00456                VALUE 'P CLASS                       '.            DTSCS17
00457                                                                   DTSCS17
00458      05  MSG-E178-AREA.                                           DTSCS17
00459          10  FILLER                  PIC  X(04)  VALUE 'E178'.    DTSCS17
00460          10  FILLER                  PIC  X(30)                   DTSCS17
00461                VALUE 'EMPLOYER NOT SUBJECT  TRANSFER'.            DTSCS17
00462          10  FILLER                  PIC  X(30)                   DTSCS17
00463                VALUE ' NOT POSSIBLE                 '.            DTSCS17
00464                                                                   DTSCS17
00465      05  MSG-E179-AREA.                                           DTSCS17
00466          10  FILLER                  PIC  X(04)  VALUE 'E179'.    DTSCS17
00467          10  FILLER                  PIC  X(30)                   DTSCS17
00468                VALUE 'NO REPORTS ARE ELIGIBLE FOR AU'.            DTSCS17
00469          10  FILLER                  PIC  X(30)                   DTSCS17
00470                VALUE 'TOMATIC WITHDRAWAL            '.            DTSCS17
00471                                                                   DTSCS17
00472      05  MSG-E17A-AREA.                                           DTSCS17
00473          10  FILLER                  PIC  X(04)  VALUE 'E17A'.    DTSCS17
00474          10  FILLER                  PIC  X(30)                   DTSCS17
00475                VALUE 'NO REPORTS ARE ELIGIBLE FOR AU'.            DTSCS17
00476          10  FILLER                  PIC  X(30)                   DTSCS17
00477                VALUE 'TOMATIC TRANSFER              '.            DTSCS17
00478                                                                   DTSCS17
00479      05  MSG-E17B-AREA.                                           DTSCS17
00480          10  FILLER                  PIC  X(04)  VALUE 'E17B'.    DTSCS17
00481          10  FILLER                  PIC  X(30)                   DTSCS17
00482                VALUE 'ONE OR MORE RATES MISSING DURI'.            DTSCS17
00483          10  FILLER                  PIC  X(30)                   DTSCS17
00484                VALUE 'NG SPAN OF LIABILITY.         '.            DTSCS17
00485                                                                   DTSCS17
00486      05  MSG-E17C-AREA.                                           DTSCS17
00487          10  FILLER                  PIC  X(04)  VALUE 'E17C'.    DTSCS17
00488          10  FILLER                  PIC  X(30)                   DTSCS17
00489                VALUE 'ESTIMATED RATE WILL BECOME FIN'.            DTSCS17
00490          10  FILLER                  PIC  X(30)                   DTSCS17
00491                VALUE 'AL. CONTINUE?                 '.            DTSCS17
00492                                                                   DTSCS17
00493      05  MSG-E17D-AREA.                                           DTSCS17
00494          10  FILLER                  PIC  X(04)  VALUE 'E17D'.    DTSCS17
00495          10  FILLER                  PIC  X(30)                   DTSCS17
00496                VALUE 'LIABILITY DATE MAY NOT BE > CU'.            DTSCS17
00497          10  FILLER                  PIC  X(30)                   DTSCS17
00498                VALUE 'RRENT DATE.                   '.            DTSCS17
00499                                                                   DTSCS17
00500      05  MSG-E17E-AREA.                                           DTSCS17
00501          10  FILLER                  PIC  X(04)  VALUE 'E17E'.    DTSCS17
00502          10  FILLER                  PIC  X(30)                   DTSCS17
00503                VALUE 'LIABILITY ESTABLISH DATE MAY N'.            DTSCS17
00504          10  FILLER                  PIC  X(30)                   DTSCS17
00505                VALUE 'OT BE > CURRENT DATE.         '.            DTSCS17
00506                                                                   DTSCS17
00507      05  MSG-E17F-AREA.                                           DTSCS17
00508          10  FILLER                  PIC  X(04)  VALUE 'E17F'.    DTSCS17
00509          10  FILLER                  PIC  X(30)                   DTSCS17
00510                VALUE 'FOR WITHDRAWAL, LIABILITY DATE'.            DTSCS17
00511          10  FILLER                  PIC  X(30)                   DTSCS17
00512                VALUE ' MUST = INACTIVE DATE.        '.            DTSCS17
00513                                                                   DTSCS17
00514 ** MESSAGE BELOW REPLACED BY E17H.  ALL CHANGES TO SPANS          DTSCS17
00515 ** OF LIABILITY REQUIRE PRIOR APPROVAL BY SUPERVISOR.             DTSCS17
00516 **   05  MSG-E17G-AREA.                                           DTSCS17
00517 *        10  FILLER                  PIC  X(04)  VALUE 'E17G'.    DTSCS17
00518 *        10  FILLER                  PIC  X(30)                   DTSCS17
00519 *              VALUE 'REPORTS WILL BE WITHDRAWN. SUP'.            DTSCS17
00520 *        10  FILLER                  PIC  X(30)                   DTSCS17
00521 **             VALUE 'ERVISOR APPROVAL NEEDED.      '.            DTSCS17
00522                                                                   DTSCS17
00523      05  MSG-E17H-AREA.                                           DTSCS17
00524          10  FILLER                  PIC  X(04)  VALUE 'E17H'.    DTSCS17
00525          10  FILLER                  PIC  X(30)                   DTSCS17
00526                VALUE 'SUPERVISOR APPROVAL NEEDED FOR'.            DTSCS17
00527          10  FILLER                  PIC  X(30)                   DTSCS17
00528                VALUE ' ALL UPDATES.                 '.            DTSCS17
00529                                                                   DTSCS17
00530      EJECT                                                        DTSCS17
00531  01  L001-COMM-AREA.                                              DTSCS17
00532  ++INCLUDE DTSIL001                                               DTSCS17
00533      EJECT                                                        DTSCS17
00534  01  L004-COMM-AREA.                                              DTSCS17
00535  ++INCLUDE DTSIL004                                               DTSCS17
00536      EJECT                                                        DTSCS17
00537  01  L006-COMM-AREA.                                              DTSCS17
00538  ++INCLUDE DTSIL006                                               DTSCS17
00539      EJECT                                                        DTSCS17
00540  01  L015-COMM-AREA.                                              DTSCS17
00541  ++INCLUDE DTSIL015                                               DTSCS17
00542      EJECT                                                        DTSCS17
00543  01  L016-COMM-AREA.                                              DTSCS17
00544  ++INCLUDE DTSIL016                                               DTSCS17
00545      EJECT                                                        DTSCS17
00546  01  L018-COMM-AREA.                                              DTSCS17
00547  ++INCLUDE DTSIL018                                               DTSCS17
00548      EJECT                                                        DTSCS17
00549  01  L031-COMM-AREA.                                              DTSCS17
00550  ++INCLUDE DTSIL031                                               DTSCS17
00551      EJECT                                                        DTSCS17
00552  01  L074-COMM-AREA.                                              DTSCS17
00553  ++INCLUDE DTSIL074                                               DTSCS17
00554      EJECT                                                        DTSCS17
00555  01  L082-COMM-AREA.                                              DTSCS17
00556  ++INCLUDE DTSIL082                                               DTSCS17
00557      EJECT                                                        DTSCS17
00558  01  L084-COMM-AREA.                                              DTSCS17
00559  ++INCLUDE DTSIL084                                               DTSCS17
00560      EJECT                                                        DTSCS17
00561  01  L201-COMM-AREA.                                              DTSCS17
00562  ++INCLUDE DTSIL201                                               DTSCS17
00563      EJECT                                                        DTSCS17
00564  01  L202-COMM-AREA.                                              DTSCS17
00565  ++INCLUDE DTSIL202                                               DTSCS17
00566      EJECT                                                        DTSCS17
00567  01  L221-COMM-AREA.                                              DTSCS17
00568  ++INCLUDE DTSIL221                                               DTSCS17
00569      EJECT                                                        DTSCS17
00570  01  L331-COMM-AREA.                                              DTSCS17
00571  ++INCLUDE DTSIL331                                               DTSCS17
00572      EJECT                                                        DTSCS17
00573  01  L410-COMM-AREA.                                              DTSCS17
00574  ++INCLUDE DTSIL410                                               DTSCS17
00575      EJECT                                                        DTSCS17
00576  01  L415-COMM-AREA.                                              DTSCS17
00577  ++INCLUDE DTSIL415                                               DTSCS17
00578      EJECT                                                        DTSCS17
00579  01  L805-COMM-AREA.                                              DTSCS17
00580  ++INCLUDE DTSIL805                                               DTSCS17
00581      EJECT                                                        DTSCS17
00582  01  L810-COMM-AREA.                                              DTSCS17
00583      05  L810-CONTROL-BLOCK.                                      DTSCS17
00584  ++INCLUDE DTSIL810                                               DTSCS17
00585      EJECT                                                        DTSCS17
00586      05  MSKL-REC.                                                DTSCS17
00587  ++INCLUDE DTSIMSKL                                               DTSCS17
00588      EJECT                                                        DTSCS17
00589  01  MPRF-REC.                                                    DTSCS17
00590  ++INCLUDE DTSIMPRF                                               DTSCS17
00591      EJECT                                                        DTSCS17
00592  01  MSOL-REC.                                                    DTSCS17
00593  ++INCLUDE DTSIMSOL                                               DTSCS17
00594      EJECT                                                        DTSCS17
00595  01  MERA-REC.                                                    DTSCS17
00596  ++INCLUDE DTSIMERA                                               DTSCS17
00597      EJECT                                                        DTSCS17
00598  01  MERD-REC.                                                    DTSCS17
00599  ++INCLUDE DTSIMERD                                               DTSCS17
00600      EJECT                                                        DTSCS17
00601  01  MREL-REC.                                                    DTSCS17
00602  ++INCLUDE DTSIMREL                                               DTSCS17
00603      EJECT                                                        DTSCS17
00604  01  MRTE-REC.                                                    DTSCS17
00605  ++INCLUDE DTSIMRTE                                               DTSCS17
00606      EJECT                                                        DTSCS17
00607  01  MQTR-REC.                                                    DTSCS17
00608  ++INCLUDE DTSIMQTR                                               DTSCS17
00609      EJECT                                                        DTSCS17
00610  01  L821-COMM-AREA.                                              DTSCS17
00611      05  L821-CONTROL-BLOCK.                                      DTSCS17
00612  ++INCLUDE DTSIL821                                               DTSCS17
00613      SKIP3                                                        DTSCS17
00614      05  ISKL-REC.                                                DTSCS17
00615  ++INCLUDE DTSIISKL                                               DTSCS17
00616      EJECT                                                        DTSCS17
00617  01  IPES-REC.                                                    DTSCS17
00618  ++INCLUDE DTSIIPES                                               DTSCS17
00619      EJECT                                                        DTSCS17
00620  01  L825-COMM-AREA.                                              DTSCS17
00621      05  L825-CONTROL-BLOCK.                                      DTSCS17
00622  ++INCLUDE DTSIL825                                               DTSCS17
00623      SKIP3                                                        DTSCS17
00624      05  RSKL-REC.                                                DTSCS17
00625  ++INCLUDE DTSIRSK1                                               DTSCS17
00626      EJECT                                                        DTSCS17
00627  01  T001-REC.                                                    DTSCS17
00628  ++INCLUDE DTSIT001                                               DTSCS17
00629      EJECT                                                        DTSCS17
00630  01  T006-REC.                                                    DTSCS17
00631  ++INCLUDE DTSIT006                                               DTSCS17
00632      EJECT                                                        DTSCS17
00633  01  T031-REC.                                                    DTSCS17
00634  ++INCLUDE DTSIT031                                               DTSCS17
00635      EJECT                                                        DTSCS17
00636  01  T036-REC.                                                    DTSCS17
00637  ++INCLUDE DTSIT036                                               DTSCS17
00638      EJECT                                                        DTSCS17
00639  01  L851-COMM-AREA.                                              DTSCS17
00640  ++INCLUDE DTSIL851                                               DTSCS17
00641      SKIP3                                                        DTSCS17
00642      05  MAP-AREA REDEFINES L851-MAP-AREA.                        DTSCS17
00643  ++INCLUDE DTSIS17                                                DTSCS17
00644      EJECT                                                        DTSCS17
00645  01  CATB-LITERALS.                                               DTSCS17
00646  ++INCLUDE DTSICATB                                               DTSCS17
00647      SKIP3                                                        DTSCS17
00648  01  CFKD-LITERALS.                                               DTSCS17
00649  ++INCLUDE DTSICFKD                                               DTSCS17
00650      SKIP3                                                        DTSCS17
00651  01  CECD-LITERALS.                                               DTSCS17
00652  ++INCLUDE DTSICECD                                               DTSCS17
00653      SKIP3                                                        DTSCS17
00654  01  CPCD-LITERALS.                                               DTSCS17
00655  ++INCLUDE DTSICPCD                                               DTSCS17
00656      EJECT                                                        DTSCS17
00657  LINKAGE SECTION.                                                 DTSCS17
00658      SKIP3                                                        DTSCS17
00659  01  DFHCOMMAREA.                                                 DTSCS17
00660  ++INCLUDE DTSILCCM                                               DTSCS17
00661      SKIP3                                                        DTSCS17
00662      EJECT                                                        DTSCS17
00663 ******************************************************************DTSCS17
00664 *                                                                *DTSCS17
00665 ******************************************************************DTSCS17
00666                                                                   DTSCS17
00667  PROCEDURE DIVISION.                                              DTSCS17
00668      SKIP2                                                        DTSCS17
00669      MOVE +0 TO WRK-EMP-NO.                                       DTSCS17
00670                                                                   DTSCS17
00671      SET WRK-MPRF-NO-88 TO TRUE.                                  DTSCS17
00672                                                                   DTSCS17
00673      MOVE +0 TO WRK-TRANSFER-EMP-NO.                              DTSCS17
00674                                                                   DTSCS17
00675      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS17
00676                                                                   DTSCS17
00677      SET CURSOR-SET-NO TO TRUE.                                   DTSCS17
00678                                                                   DTSCS17
00679      MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N)                  DTSCS17
00680        TO SCR-ACCESS-IND.                                         DTSCS17
00681      SKIP3                                                        DTSCS17
00682      MOVE SPACE TO REQ-IND.                                       DTSCS17
00683                                                                   DTSCS17
00684      PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT.               DTSCS17
00685                                                                   DTSCS17
00686 *-----------------------------------------------------            DTSCS17
00687 *    P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE           DTSCS17
00688 *    "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT             DTSCS17
00689 *    REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE             DTSCS17
00690 *    OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED.         DTSCS17
00691 *                                                                 DTSCS17
00692 *    THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE                DTSCS17
00693 *    PROCESSED.                                                   DTSCS17
00694 *                                                                 DTSCS17
00695 *    THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND,         DTSCS17
00696 *    INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE            DTSCS17
00697 *    WORK STATION OPERATOR.                                       DTSCS17
00698 *-----------------------------------------------------            DTSCS17
00699                                                                   DTSCS17
00700      MOVE SPACE TO RESP-IND.                                      DTSCS17
00701                                                                   DTSCS17
00702      IF REQ-ERROR                                                 DTSCS17
00703         PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT               DTSCS17
00704      ELSE                                                         DTSCS17
00705      IF REQ-JUMP                                                  DTSCS17
00706         PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT                DTSCS17
00707      ELSE                                                         DTSCS17
00708      IF REQ-CLEAR                                                 DTSCS17
00709         PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT               DTSCS17
00710      ELSE                                                         DTSCS17
00711      IF REQ-CURSOR-TO-GOTO                                        DTSCS17
00712         PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT              DTSCS17
00713      ELSE                                                         DTSCS17
00714      IF REQ-INQUIRE                                               DTSCS17
00715         PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT             DTSCS17
00716      ELSE                                                         DTSCS17
00717      IF REQ-EDIT                                                  DTSCS17
00718         PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT                DTSCS17
00719      ELSE                                                         DTSCS17
00720      IF REQ-UPDATE                                                DTSCS17
00721         PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT              DTSCS17
00722      ELSE                                                         DTSCS17
00723         GO TO S899-ABEND.                                         DTSCS17
00724      SKIP3                                                        DTSCS17
00725 *-----------------------------------------------------            DTSCS17
00726 *    THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED             DTSCS17
00727 *    IN RESP-IND THE TYPE OF RESPONSE TO BE MADE.                 DTSCS17
00728 *-----------------------------------------------------            DTSCS17
00729                                                                   DTSCS17
00730      IF RESP-SEND-MAP                                             DTSCS17
00731          PERFORM S9300-SEND-MAP THRU S9300-EXIT                   DTSCS17
00732          SET LCCM-END-TASK-88 TO TRUE                             DTSCS17
00733      ELSE                                                         DTSCS17
00734      IF RESP-SEND-MSGONLY                                         DTSCS17
00735          PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT              DTSCS17
00736          SET LCCM-END-TASK-88 TO TRUE                             DTSCS17
00737      ELSE                                                         DTSCS17
00738      IF RESP-JUMP                                                 DTSCS17
00739          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS17
00740      ELSE                                                         DTSCS17
00741      IF RESP-CURSOR-TO-GOTO                                       DTSCS17
00742          PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT              DTSCS17
00743          SET LCCM-END-TASK-88 TO TRUE                             DTSCS17
00744      ELSE                                                         DTSCS17
00745          GO TO S899-ABEND.                                        DTSCS17
00746      SKIP3                                                        DTSCS17
00747  MAINLINE-EXIT.                                                   DTSCS17
00748                                                                   DTSCS17
00749      EXEC CICS                                                    DTSCS17
00750          RETURN                                                   DTSCS17
00751      END-EXEC.                                                    DTSCS17
00752      SKIP2                                                        DTSCS17
00753      GOBACK.                                                      DTSCS17
00754      EJECT                                                        DTSCS17
00755 /*****************************************************************DTSCS17
00756 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION         *DTSCS17
00757 ******************************************************************DTSCS17
00758  P1000-ANALYZE-REQUEST.                                           DTSCS17
00759                                                                   DTSCS17
00760 *-----------------------------------------------------            DTSCS17
00761 *     IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE)         DTSCS17
00762 *     THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE               DTSCS17
00763 *     REPLACED WITH ENTER)                                        DTSCS17
00764 *-----------------------------------------------------            DTSCS17
00765      IF LCCM-SCR-ID NOT = WRK-SCR-ID                              DTSCS17
00766         SET LCCM-ENTER-88 TO TRUE                                 DTSCS17
00767         SET REQ-INQUIRE TO TRUE                                   DTSCS17
00768         IF LCCM-EMP-NO > ZERO                                     DTSCS17
00769             MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1                    DTSCS17
00770             MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2                    DTSCS17
00771         END-IF                                                    DTSCS17
00772         GO TO P1000-EXIT.                                         DTSCS17
00773      SKIP3                                                        DTSCS17
00774 *-----------------------------------------------------            DTSCS17
00775 *      MAP IS RECEIVED                                            DTSCS17
00776 *-----------------------------------------------------            DTSCS17
00777      PERFORM S9100-RECEIVE THRU S9100-EXIT.                       DTSCS17
00778      SKIP3                                                        DTSCS17
00779 *-----------------------------------------------------            DTSCS17
00780 *    CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE            DTSCS17
00781 *    WORK STATION                                                 DTSCS17
00782 *-----------------------------------------------------            DTSCS17
00783      IF LCCM-CLEAR-88                                             DTSCS17
00784         SET REQ-CLEAR TO TRUE                                     DTSCS17
00785         GO TO P1000-EXIT.                                         DTSCS17
00786      SKIP3                                                        DTSCS17
00787 *-----------------------------------------------------            DTSCS17
00788 *    IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED             DTSCS17
00789 *-----------------------------------------------------            DTSCS17
00790      IF LCCM-SCR-UPDATE-LOCKED                                    DTSCS17
00791         PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT               DTSCS17
00792         GO TO P1000-EXIT.                                         DTSCS17
00793      SKIP3                                                        DTSCS17
00794 *-----------------------------------------------------            DTSCS17
00795 *    PA2 IS A REQUEST TO POSITION CURSOR AT GO TO:                DTSCS17
00796 *-----------------------------------------------------            DTSCS17
00797      IF LCCM-PA2-88                                               DTSCS17
00798          SET REQ-CURSOR-TO-GOTO TO TRUE                           DTSCS17
00799          GO TO P1000-EXIT.                                        DTSCS17
00800      SKIP3                                                        DTSCS17
00801 *-----------------------------------------------------            DTSCS17
00802 *    ALL OTHER PA KEYS ARE NOT ACTIVE                             DTSCS17
00803 *-----------------------------------------------------            DTSCS17
00804      IF LCCM-PA-88                                                DTSCS17
00805        PERFORM S804-INVALID-KEY THRU S804-EXIT                    DTSCS17
00806        SET REQ-ERROR TO TRUE                                      DTSCS17
00807        GO TO P1000-EXIT.                                          DTSCS17
00808      SKIP3                                                        DTSCS17
00809 *-----------------------------------------------------            DTSCS17
00810 *    IF PF12 IS PRESSED AND UPDATE NOT IN PROGRESS THEN           DTSCS17
00811 *    CLEAR SCREEN                                                 DTSCS17
00812 *-----------------------------------------------------            DTSCS17
00813      IF LCCM-F12-88                                               DTSCS17
00814         MOVE LOW-VALUES TO MAP-AREA                               DTSCS17
00815         SET REQ-CLEAR TO TRUE                                     DTSCS17
00816         GO TO P1000-EXIT.                                         DTSCS17
00817      SKIP3                                                        DTSCS17
00818 *-----------------------------------------------------            DTSCS17
00819 *    IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION            DTSCS17
00820 *-----------------------------------------------------            DTSCS17
00821      IF LCCM-F03-88                                               DTSCS17
00822         MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID                    DTSCS17
00823         SET REQ-JUMP TO TRUE                                      DTSCS17
00824         GO TO P1000-EXIT.                                         DTSCS17
00825      SKIP3                                                        DTSCS17
00826 *-----------------------------------------------------            DTSCS17
00827 *    IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN         DTSCS17
00828 *-----------------------------------------------------            DTSCS17
00829      IF LCCM-F04-88                                               DTSCS17
00830         MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID                 DTSCS17
00831         SET REQ-JUMP TO TRUE                                      DTSCS17
00832         GO TO P1000-EXIT.                                         DTSCS17
00833      SKIP3                                                        DTSCS17
00834 *-----------------------------------------------------            DTSCS17
00835 *    IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO                DTSCS17
00836 *    CORRESPONDENCE SCREEN                                        DTSCS17
00837 *-----------------------------------------------------            DTSCS17
00838      IF LCCM-F14-88                                               DTSCS17
00839         MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID                  DTSCS17
00840         SET REQ-JUMP TO TRUE                                      DTSCS17
00841         GO TO P1000-EXIT.                                         DTSCS17
00842      SKIP3                                                        DTSCS17
00843 *-----------------------------------------------------            DTSCS17
00844 *    IF REGISTRATION INQUIRY SCREEN KEY PRESSED,                  DTSCS17
00845 *    THEN JUMP TO REGISTRATION INQUIRY SCREEN.                    DTSCS17
00846 *-----------------------------------------------------            DTSCS17
00847 *****IF LCCM-F17-88                                               DTSCS17
00848 ********MOVE '11' TO LCCM-REQ-SCR-ID                              DTSCS17
00849 ********SET REQ-JUMP TO TRUE                                      DTSCS17
00850 ********GO TO P1000-EXIT.                                         DTSCS17
00851      SKIP3                                                        DTSCS17
00852 *-----------------------------------------------------            DTSCS17
00853 *    IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO               DTSCS17
00854 *    REQUESTED SCREEN TYPE                                        DTSCS17
00855 *-----------------------------------------------------            DTSCS17
00856      IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID             DTSCS17
00857         NEXT SENTENCE                                             DTSCS17
00858      ELSE                                                         DTSCS17
00859        MOVE MAP-GOTO TO LCCM-REQ-SCR-ID                           DTSCS17
00860        SET REQ-JUMP TO TRUE                                       DTSCS17
00861        GO TO P1000-EXIT.                                          DTSCS17
00862      SKIP3                                                        DTSCS17
00863 *-----------------------------------------------------            DTSCS17
00864 *    IF REQUEST TO UPDATE THE DATA (MOD)                          DTSCS17
00865 *          VERIFY USER ACCESS TO PERFORM UPDATE                   DTSCS17
00866 *-----------------------------------------------------            DTSCS17
00867      IF LCCM-F10-88                                               DTSCS17
00868         IF SCR-ACCESS-UPDATE                                      DTSCS17
00869            SET REQ-EDIT TO TRUE                                   DTSCS17
00870            GO TO P1000-EXIT                                       DTSCS17
00871         ELSE                                                      DTSCS17
00872            PERFORM S804-INVALID-KEY THRU S804-EXIT                DTSCS17
00873            SET REQ-ERROR TO TRUE                                  DTSCS17
00874            GO TO P1000-EXIT.                                      DTSCS17
00875      SKIP3                                                        DTSCS17
00876 *-----------------------------------------------------            DTSCS17
00877 *    IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7,              DTSCS17
00878 *          OR F8), INDICATE INQUIRY REQUEST                       DTSCS17
00879 *-----------------------------------------------------            DTSCS17
00880      IF LCCM-INQUIRY-88                                           DTSCS17
00881          SET REQ-INQUIRE TO TRUE                                  DTSCS17
00882          GO TO P1000-EXIT.                                        DTSCS17
00883      SKIP3                                                        DTSCS17
00884 *-----------------------------------------------------            DTSCS17
00885 *     ANY OTHER KEY IS INVALID                                    DTSCS17
00886 *-----------------------------------------------------            DTSCS17
00887      PERFORM S804-INVALID-KEY THRU S804-EXIT.                     DTSCS17
00888      SET REQ-ERROR TO TRUE.                                       DTSCS17
00889  P1000-EXIT.                                                      DTSCS17
00890      EXIT.                                                        DTSCS17
00891      SKIP3                                                        DTSCS17
00892 ******************************************************************DTSCS17
00893 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS17
00894 ******************************************************************DTSCS17
00895                                                                   DTSCS17
00896  P1100-UPDATE-LOCKED.                                             DTSCS17
00897 *-----------------------------------------------------            DTSCS17
00898 *    IF THE SCREEN IS "LOCKED FOR UPDATE", THEN                   DTSCS17
00899 *    THE ONLY VALID OPERATOR REQUESTS ARE ENTER                   DTSCS17
00900 *    (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE).              DTSCS17
00901 *-----------------------------------------------------            DTSCS17
00902      IF LCCM-ENTER-88 OR LCCM-F12-88                              DTSCS17
00903         SET REQ-UPDATE TO TRUE                                    DTSCS17
00904      ELSE                                                         DTSCS17
00905         SET REQ-ERROR TO TRUE                                     DTSCS17
00906         IF LCCM-SCR-MOD-LOCKED                                    DTSCS17
00907            MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID                   DTSCS17
00908         ELSE                                                      DTSCS17
00909            GO TO S899-ABEND.                                      DTSCS17
00910  P1100-EXIT.                                                      DTSCS17
00911      EXIT.                                                        DTSCS17
00912 /*****************************************************************DTSCS17
00913 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS17
00914 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN.                      *DTSCS17
00915 ******************************************************************DTSCS17
00916                                                                   DTSCS17
00917  P2000-REQUEST-ERROR.                                             DTSCS17
00918      IF LCCM-MSG                                                  DTSCS17
00919         SET RESP-SEND-MSGONLY TO TRUE                             DTSCS17
00920      ELSE                                                         DTSCS17
00921         GO TO S899-ABEND.                                         DTSCS17
00922  P2000-EXIT.                                                      DTSCS17
00923      EXIT.                                                        DTSCS17
00924 /*****************************************************************DTSCS17
00925 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED                  *DTSCS17
00926 ******************************************************************DTSCS17
00927                                                                   DTSCS17
00928  P3000-REQUEST-JUMP.                                              DTSCS17
00929 *-----------------------------------------------------            DTSCS17
00930 *    VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE    DTSCS17
00931 *    BY USER                                                      DTSCS17
00932 *-----------------------------------------------------            DTSCS17
00933      PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT.                 DTSCS17
00934      SKIP3                                                        DTSCS17
00935 *-----------------------------------------------------            DTSCS17
00936 *    VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED               DTSCS17
00937 *-----------------------------------------------------            DTSCS17
00938      IF LCCM-MSG                                                  DTSCS17
00939         SET RESP-SEND-MSGONLY TO TRUE                             DTSCS17
00940         SET CURSOR-SET-GOTO TO TRUE                               DTSCS17
00941         GO TO P3000-EXIT.                                         DTSCS17
00942      SKIP3                                                        DTSCS17
00943      MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA.                  DTSCS17
00944      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS17
00945      IF L018-VALID                                                DTSCS17
00946          MOVE L018-EMP-NO TO LCCM-EMP-NO.                         DTSCS17
00947      SKIP3                                                        DTSCS17
00948 *-----------------------------------------------------            DTSCS17
00949 *    CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING      DTSCS17
00950 *-----------------------------------------------------            DTSCS17
00951      MOVE LOW-VALUES TO LCCM-SCR-STATUS                           DTSCS17
00952                         LCCM-SCR-HOLD-AREA.                       DTSCS17
00953      MOVE +0 TO LCCM-SCR-ABSTIME.                                 DTSCS17
00954      SET RESP-JUMP TO TRUE.                                       DTSCS17
00955  P3000-EXIT.                                                      DTSCS17
00956      EXIT.                                                        DTSCS17
00957 /*****************************************************************DTSCS17
00958 * CLEAR KEY WAS PRESSED                                          *DTSCS17
00959 ******************************************************************DTSCS17
00960                                                                   DTSCS17
00961  P4000-REQUEST-CLEAR.                                             DTSCS17
00962      PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT.                 DTSCS17
00963      SKIP3                                                        DTSCS17
00964 *-----------------------------------------------------            DTSCS17
00965 *   CLEAN UP INDICATORS AND PAGING STORAGE.  RESET KEY            DTSCS17
00966 *   FIELDS FROM EARLIER REQUESTS                                  DTSCS17
00967 *-----------------------------------------------------            DTSCS17
00968      IF LCCM-EMP-NO > ZERO                                        DTSCS17
00969          MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1                       DTSCS17
00970          MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2.                      DTSCS17
00971                                                                   DTSCS17
00972      MOVE ZERO TO LCCM-EMP-NO.                                    DTSCS17
00973                                                                   DTSCS17
00974      MOVE LOW-VALUES TO LCCM-SCR17-HOLD-AREA.                     DTSCS17
00975      MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA.                       DTSCS17
00976      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS17
00977      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS17
00978      SET RESP-SEND-MAP TO TRUE.                                   DTSCS17
00979  P4000-EXIT.                                                      DTSCS17
00980      EXIT.                                                        DTSCS17
00981 /*****************************************************************DTSCS17
00982 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED                   *DTSCS17
00983 ******************************************************************DTSCS17
00984                                                                   DTSCS17
00985  P5000-CURSOR-TO-GOTO.                                            DTSCS17
00986      SET CURSOR-SET-GOTO TO TRUE.                                 DTSCS17
00987      SET RESP-CURSOR-TO-GOTO TO TRUE.                             DTSCS17
00988  P5000-EXIT.                                                      DTSCS17
00989      EXIT.                                                        DTSCS17
00990 /*****************************************************************DTSCS17
00991 * INQUIRY WAS REQUESTED                                          *DTSCS17
00992 ******************************************************************DTSCS17
00993                                                                   DTSCS17
00994  P6000-REQUEST-INQUIRE.                                           DTSCS17
00995      MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA.                  DTSCS17
00996      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS17
00997      MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA.                  DTSCS17
00998                                                                   DTSCS17
00999      PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT.                 DTSCS17
01000                                                                   DTSCS17
01001      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS17
01002      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS17
01003                                                                   DTSCS17
01004      SET RESP-SEND-MAP TO TRUE.                                   DTSCS17
01005                                                                   DTSCS17
01006      MOVE LCCM-SCR17-HOLD-AREA TO SCR-REC-KEY-AREA.               DTSCS17
01007      MOVE LOW-VALUES TO LCCM-SCR17-HOLD-AREA.                     DTSCS17
01008                                                                   DTSCS17
01009      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS17
01010      IF LCCM-MSG                                                  DTSCS17
01011          GO TO P6000-EXIT.                                        DTSCS17
01012                                                                   DTSCS17
01013      PERFORM S1110-READ-MPRF THRU S1110-EXIT.                     DTSCS17
01014      IF LCCM-MSG                                                  DTSCS17
01015          GO TO P6000-EXIT.                                        DTSCS17
01016                                                                   DTSCS17
01017      MOVE WRK-EMP-NO TO LCCM-EMP-NO.                              DTSCS17
01018                                                                   DTSCS17
01019      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSCS17
01020      MOVE WRK-EMP-NO TO MSKL-EMP-NO.                              DTSCS17
01021      SET MSKL-SOL-88 TO TRUE.                                     DTSCS17
01022      PERFORM S810-COUNT THRU S810-EXIT.                           DTSCS17
01023                                                                   DTSCS17
01024      IF L810-RECORD-CNT = +0                                      DTSCS17
01025          MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                      DTSCS17
01026          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS17
01027          GO TO P6000-EXIT.                                        DTSCS17
01028                                                                   DTSCS17
01029      MOVE L810-RECORD-CNT TO LAST-REC-NUM.                        DTSCS17
01030      MOVE MSKL-KEY-AREA TO LAST-REC-KEY-AREA.                     DTSCS17
01031                                                                   DTSCS17
01032      PERFORM P6100-LOCATE-REC THRU P6100-EXIT.                    DTSCS17
01033      IF LCCM-MSG                                                  DTSCS17
01034          GO TO P6000-EXIT.                                        DTSCS17
01035                                                                   DTSCS17
01036      IF SCR-ACCESS-UPDATE                                         DTSCS17
01037          PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.          DTSCS17
01038                                                                   DTSCS17
01039      PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT.              DTSCS17
01040                                                                   DTSCS17
01041      MOVE MSOL-KEY-AREA TO LCCM-SCR17-HOLD-AREA.                  DTSCS17
01042                                                                   DTSCS17
01043      SET LCCM-SCR-INQUIRE TO TRUE.                                DTSCS17
01044  P6000-EXIT.                                                      DTSCS17
01045      EXIT.                                                        DTSCS17
01046      EJECT                                                        DTSCS17
01047  P6100-LOCATE-REC.                                                DTSCS17
01048 *------------------------------------------------------------     DTSCS17
01049 *    IF, AT THE LAST USE OF THIS SCREEN, A RECORD FOR             DTSCS17
01050 *    EMPLOYER NUMBER LCCM-EMP-NO WAS DISPLAYED ON THE             DTSCS17
01051 *    SCREEN, THEN BASE THE PAGING LOGIC ON THE LAST RECORD        DTSCS17
01052 *    DISPLAYED ON THIS SCREEN; OTHERWISE, DISPLAY THE             DTSCS17
01053 *    RECORD WITH THE GREATEST MSOL-LIAB-DATE (THE MOST            DTSCS17
01054 *    RECENT SPAN OF LIABILITY ASSOCIATED WITH WRK-EMP-NO).        DTSCS17
01055 *------------------------------------------------------------     DTSCS17
01056                                                                   DTSCS17
01057      IF SCR-REC-KEY-AREA = LOW-VALUES                             DTSCS17
01058          PERFORM P6140-LAST-REC THRU P6140-EXIT                   DTSCS17
01059          GO TO P6100-EXIT.                                        DTSCS17
01060                                                                   DTSCS17
01061      MOVE SCR-REC-KEY-AREA TO MSOL-KEY-AREA.                      DTSCS17
01062                                                                   DTSCS17
01063      IF WRK-EMP-NO = MSOL-EMP-NO                                  DTSCS17
01064          NEXT SENTENCE                                            DTSCS17
01065      ELSE                                                         DTSCS17
01066          PERFORM P6140-LAST-REC THRU P6140-EXIT                   DTSCS17
01067          GO TO P6100-EXIT.                                        DTSCS17
01068      SKIP3                                                        DTSCS17
01069      IF LCCM-F05-88                                               DTSCS17
01070          PERFORM P6110-FIRST-REC THRU P6110-EXIT                  DTSCS17
01071          GO TO P6100-EXIT.                                        DTSCS17
01072                                                                   DTSCS17
01073      IF LCCM-F06-88                                               DTSCS17
01074          PERFORM P6140-LAST-REC THRU P6140-EXIT                   DTSCS17
01075          GO TO P6100-EXIT.                                        DTSCS17
01076      SKIP3                                                        DTSCS17
01077      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSCS17
01078      MOVE WRK-EMP-NO TO MSKL-EMP-NO.                              DTSCS17
01079      SET MSKL-SOL-88 TO TRUE.                                     DTSCS17
01080      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS17
01081      IF L810-NO-REC-88                                            DTSCS17
01082          MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                      DTSCS17
01083          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS17
01084          GO TO P6100-EXIT.                                        DTSCS17
01085                                                                   DTSCS17
01086      MOVE +0 TO WS-REC-NUM.                                       DTSCS17
01087      MOVE 'N' TO WS-REC-FOUND-IND.                                DTSCS17
01088      PERFORM P6190-BROWSE-MSOL THRU P6190-EXIT                    DTSCS17
01089          UNTIL (L810-NO-REC-88)                                   DTSCS17
01090                    OR                                             DTSCS17
01091                (WS-REC-FOUND-IND = 'Y').                          DTSCS17
01092                                                                   DTSCS17
01093      IF L810-NO-REC-88                                            DTSCS17
01094          PERFORM P6140-LAST-REC THRU P6140-EXIT                   DTSCS17
01095          GO TO P6100-EXIT.                                        DTSCS17
01096      SKIP3                                                        DTSCS17
01097      IF LCCM-ENTER-88                                             DTSCS17
01098          PERFORM S810-END-BROWSE THRU S810-EXIT                   DTSCS17
01099          GO TO P6100-EXIT.                                        DTSCS17
01100                                                                   DTSCS17
01101      IF LCCM-F07-88                                               DTSCS17
01102          PERFORM P6120-PREV-REC THRU P6120-EXIT                   DTSCS17
01103          GO TO P6100-EXIT.                                        DTSCS17
01104                                                                   DTSCS17
01105      IF LCCM-F08-88                                               DTSCS17
01106          PERFORM P6130-NEXT-REC THRU P6130-EXIT                   DTSCS17
01107          GO TO P6100-EXIT.                                        DTSCS17
01108      SKIP3                                                        DTSCS17
01109      GO TO S899-ABEND.                                            DTSCS17
01110  P6100-EXIT.                                                      DTSCS17
01111      EXIT.                                                        DTSCS17
01112      SKIP3                                                        DTSCS17
01113  P6110-FIRST-REC.                                                 DTSCS17
01114      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSCS17
01115      MOVE WRK-EMP-NO TO MSKL-EMP-NO.                              DTSCS17
01116      SET MSKL-SOL-88 TO TRUE.                                     DTSCS17
01117      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS17
01118      IF L810-NO-REC-88                                            DTSCS17
01119          MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                      DTSCS17
01120          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS17
01121          GO TO P6110-EXIT.                                        DTSCS17
01122                                                                   DTSCS17
01123      PERFORM S810-END-BROWSE THRU S810-EXIT.                      DTSCS17
01124                                                                   DTSCS17
01125      MOVE MSKL-REC TO MSOL-REC.                                   DTSCS17
01126                                                                   DTSCS17
01127      MOVE +1 TO WS-REC-NUM.                                       DTSCS17
01128  P6110-EXIT.                                                      DTSCS17
01129      EXIT.                                                        DTSCS17
01130      SKIP3                                                        DTSCS17
01131  P6120-PREV-REC.                                                  DTSCS17
01132      PERFORM S810-READ-PREV THRU S810-EXIT.                       DTSCS17
01133      IF L810-NO-REC-88                                            DTSCS17
01134          MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                      DTSCS17
01135          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS17
01136          GO TO P6120-EXIT.                                        DTSCS17
01137                                                                   DTSCS17
01138      PERFORM S810-READ-PREV THRU S810-EXIT.                       DTSCS17
01139      IF L810-NO-REC-88                                            DTSCS17
01140          GO TO P6120-EXIT.                                        DTSCS17
01141                                                                   DTSCS17
01142      PERFORM S810-END-BROWSE THRU S810-EXIT.                      DTSCS17
01143                                                                   DTSCS17
01144      SUBTRACT 1 FROM WS-REC-NUM.                                  DTSCS17
01145                                                                   DTSCS17
01146      MOVE MSKL-REC TO MSOL-REC.                                   DTSCS17
01147  P6120-EXIT.                                                      DTSCS17
01148      EXIT.                                                        DTSCS17
01149      SKIP3                                                        DTSCS17
01150  P6130-NEXT-REC.                                                  DTSCS17
01151      IF MSOL-KEY-AREA > SCR-REC-KEY-AREA                          DTSCS17
01152          PERFORM S810-END-BROWSE THRU S810-EXIT                   DTSCS17
01153          GO TO P6130-EXIT.                                        DTSCS17
01154                                                                   DTSCS17
01155      PERFORM S810-READ-NEXT THRU S810-EXIT.                       DTSCS17
01156                                                                   DTSCS17
01157      IF L810-NO-REC-88                                            DTSCS17
01158          GO TO P6130-EXIT.                                        DTSCS17
01159                                                                   DTSCS17
01160      PERFORM S810-END-BROWSE THRU S810-EXIT.                      DTSCS17
01161                                                                   DTSCS17
01162      ADD +1 TO WS-REC-NUM.                                        DTSCS17
01163                                                                   DTSCS17
01164      MOVE MSKL-REC TO MSOL-REC.                                   DTSCS17
01165  P6130-EXIT.                                                      DTSCS17
01166      EXIT.                                                        DTSCS17
01167      SKIP3                                                        DTSCS17
01168  P6140-LAST-REC.                                                  DTSCS17
01169      MOVE LAST-REC-KEY-AREA TO MSKL-KEY-AREA.                     DTSCS17
01170      PERFORM S810-READ THRU S810-EXIT.                            DTSCS17
01171      IF L810-NO-REC-88                                            DTSCS17
01172          MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                      DTSCS17
01173          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS17
01174          GO TO P6140-EXIT.                                        DTSCS17
01175                                                                   DTSCS17
01176      MOVE MSKL-REC TO MSOL-REC.                                   DTSCS17
01177                                                                   DTSCS17
01178      MOVE LAST-REC-NUM TO WS-REC-NUM.                             DTSCS17
01179  P6140-EXIT.                                                      DTSCS17
01180      EXIT.                                                        DTSCS17
01181      SKIP3                                                        DTSCS17
01182  P6190-BROWSE-MSOL.                                               DTSCS17
01183      MOVE MSKL-REC TO MSOL-REC.                                   DTSCS17
01184      ADD +1 TO WS-REC-NUM.                                        DTSCS17
01185      IF MSOL-KEY-AREA NOT < SCR-REC-KEY-AREA                      DTSCS17
01186          MOVE 'Y' TO WS-REC-FOUND-IND                             DTSCS17
01187      ELSE                                                         DTSCS17
01188          PERFORM S810-READ-NEXT THRU S810-EXIT.                   DTSCS17
01189  P6190-EXIT.                                                      DTSCS17
01190      EXIT.                                                        DTSCS17
01191      EJECT                                                        DTSCS17
01192 /*****************************************************************DTSCS17
01193 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS            *DTSCS17
01194 ******************************************************************DTSCS17
01195                                                                   DTSCS17
01196  P6900-CONSTRUCT-SCREEN.                                          DTSCS17
01197      PERFORM P6910-FROM-MSOL THRU P6910-EXIT.                     DTSCS17
01198                                                                   DTSCS17
01199      PERFORM P6990-PAGE-NUMBER THRU P6990-EXIT.                   DTSCS17
01200  P6900-EXIT.                                                      DTSCS17
01201      EXIT.                                                        DTSCS17
01202      SKIP3                                                        DTSCS17
01203  P6910-FROM-MSOL.                                                 DTSCS17
01204      MOVE MSOL-LIAB-DATE TO WRK-DISPLAY.                          DTSCS17
01205      MOVE WRK-DISPLAY-MO TO MAP-LIAB-MO.                          DTSCS17
01206      MOVE WRK-DISPLAY-DA TO MAP-LIAB-DA.                          DTSCS17
01207      MOVE WRK-DISPLAY-YR TO MAP-LIAB-YR.                          DTSCS17
01208                                                                   DTSCS17
01209      IF MSOL-FIRST-LIAB-YRQ > +0                                  DTSCS17
01210          MOVE MSOL-FIRST-LIAB-YRQ TO L004-QTR-5-9                 DTSCS17
01211          PERFORM S004-FROM-5 THRU S004-EXIT                       DTSCS17
01212          MOVE L004-SLASH-QTR TO MAP-FIRST-LIAB-YRQ.               DTSCS17
01213                                                                   DTSCS17
01214      MOVE MSOL-LIAB-ESTB-DATE TO WRK-DISPLAY.                     DTSCS17
01215      MOVE WRK-DISPLAY-MO TO MAP-LIAB-ESTB-MO.                     DTSCS17
01216      MOVE WRK-DISPLAY-DA TO MAP-LIAB-ESTB-DA.                     DTSCS17
01217      MOVE WRK-DISPLAY-YR TO MAP-LIAB-ESTB-YR.                     DTSCS17
01218                                                                   DTSCS17
01219      MOVE MSOL-LIAB-CD TO MAP-LIAB-CD.                            DTSCS17
01220                                                                   DTSCS17
01221      IF MSOL-INACT-INACTIVE-88                                    DTSCS17
01222          MOVE MSOL-INACT-DATE TO WRK-DISPLAY                      DTSCS17
01223          MOVE WRK-DISPLAY-MO TO MAP-INACT-MO                      DTSCS17
01224          MOVE WRK-DISPLAY-DA TO MAP-INACT-DA                      DTSCS17
01225          MOVE WRK-DISPLAY-YR TO MAP-INACT-YR                      DTSCS17
01226          IF MSOL-LAST-LIAB-YRQ > +0                               DTSCS17
01227              MOVE MSOL-LAST-LIAB-YRQ TO L004-QTR-5-9              DTSCS17
01228              PERFORM S004-FROM-5 THRU S004-EXIT                   DTSCS17
01229              MOVE L004-SLASH-QTR TO MAP-LAST-LIAB-YRQ             DTSCS17
01230          END-IF                                                   DTSCS17
01231          MOVE MSOL-INACT-CD TO MAP-INACT-CD.                      DTSCS17
01232                                                                   DTSCS17
01233      MOVE MSOL-NEW-EMPLOYER-IND TO MAP-NEW-EMPLOYER-IND.          DTSCS17
01234                                                                   DTSCS17
01235      IF MSOL-ESTB-DATE > +0                                       DTSCS17
01236           MOVE MSOL-ESTB-DATE TO L001-FED-8-DATE-9                DTSCS17
01237           PERFORM S001-FROM-FED-8 THRU S001-EXIT                  DTSCS17
01238           MOVE L001-SLASH-DATE TO MAP-ESTB-DATE.                  DTSCS17
01239                                                                   DTSCS17
01240      IF MSOL-LIAB-MAIL-DATE > +0                                  DTSCS17
01241           MOVE MSOL-LIAB-MAIL-DATE TO L001-FED-8-DATE-9           DTSCS17
01242           PERFORM S001-FROM-FED-8 THRU S001-EXIT                  DTSCS17
01243           MOVE L001-SLASH-DATE TO MAP-LIAB-MAIL-DATE.             DTSCS17
01244                                                                   DTSCS17
01245      IF MSOL-INACT-ENTER-DATE > +0                                DTSCS17
01246           MOVE MSOL-INACT-ENTER-DATE TO L001-FED-8-DATE-9         DTSCS17
01247           PERFORM S001-FROM-FED-8 THRU S001-EXIT                  DTSCS17
01248           MOVE L001-SLASH-DATE TO MAP-INACT-ENTER-DATE.           DTSCS17
01249                                                                   DTSCS17
01250      IF MSOL-INACT-REVERSE-DATE > +0                              DTSCS17
01251           MOVE MSOL-INACT-REVERSE-DATE TO L001-FED-8-DATE-9       DTSCS17
01252           PERFORM S001-FROM-FED-8 THRU S001-EXIT                  DTSCS17
01253           MOVE L001-SLASH-DATE TO MAP-INACT-REVERSE-DATE.         DTSCS17
01254  P6910-EXIT.                                                      DTSCS17
01255      EXIT.                                                        DTSCS17
01256      SKIP3                                                        DTSCS17
01257  P6990-PAGE-NUMBER.                                               DTSCS17
01258      MOVE WS-REC-NUM TO MAP-CURR-PAGE.                            DTSCS17
01259      MOVE LAST-REC-NUM TO MAP-LAST-PAGE.                          DTSCS17
01260                                                                   DTSCS17
01261      IF WS-REC-NUM = +1                                           DTSCS17
01262          IF LAST-REC-NUM = +1                                     DTSCS17
01263              MOVE PMSG-ONLY-PAGE TO LCCM-MSG-AREA                 DTSCS17
01264          ELSE                                                     DTSCS17
01265              MOVE PMSG-FIRST-PAGE TO LCCM-MSG-AREA                DTSCS17
01266      ELSE                                                         DTSCS17
01267          IF WS-REC-NUM = LAST-REC-NUM                             DTSCS17
01268              MOVE PMSG-LAST-PAGE TO LCCM-MSG-AREA.                DTSCS17
01269  P6990-EXIT.                                                      DTSCS17
01270      EXIT.                                                        DTSCS17
01271 /*****************************************************************DTSCS17
01272 * FUNCTION KEY TO MOD THE RECORD WAS PRESSED.                    *DTSCS17
01273 ******************************************************************DTSCS17
01274                                                                   DTSCS17
01275  P7000-REQUEST-EDIT.                                              DTSCS17
01276      IF LCCM-SCR-INQUIRE                                          DTSCS17
01277          PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT           DTSCS17
01278      ELSE                                                         DTSCS17
01279          PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT.             DTSCS17
01280                                                                   DTSCS17
01281      IF LCCM-F10-88                                               DTSCS17
01282         PERFORM P7200-EDIT-MOD THRU P7200-EXIT                    DTSCS17
01283      ELSE                                                         DTSCS17
01284         GO TO S899-ABEND.                                         DTSCS17
01285      SKIP3                                                        DTSCS17
01286 *------------------------------------------------------           DTSCS17
01287 *  SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED.          DTSCS17
01288 *  IN ORDER TO CONTINUE TO ATTEMPT A MOD THE SCREEN MUST          DTSCS17
01289 *  REMAIN IN 'INQUIRE' STATUS.                                    DTSCS17
01290 *------------------------------------------------------           DTSCS17
01291                                                                   DTSCS17
01292      IF LCCM-MSG                                                  DTSCS17
01293         NEXT SENTENCE                                             DTSCS17
01294      ELSE                                                         DTSCS17
01295         PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT              DTSCS17
01296         IF LCCM-F10-88                                            DTSCS17
01297            SET LCCM-SCR-MOD-LOCKED TO TRUE                        DTSCS17
01298            MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID.                  DTSCS17
01299                                                                   DTSCS17
01300      SET RESP-SEND-MAP TO TRUE.                                   DTSCS17
01301  P7000-EXIT.                                                      DTSCS17
01302      EXIT.                                                        DTSCS17
01303 /*****************************************************************DTSCS17
01304 * MODIFICATION FUNCTION WAS REQUESTED                            *DTSCS17
01305 ******************************************************************DTSCS17
01306                                                                   DTSCS17
01307  P7200-EDIT-MOD.                                                  DTSCS17
01308 *-----------------------------------------------------            DTSCS17
01309 *    MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY         DTSCS17
01310 *    INQUIRED                                                     DTSCS17
01311 *-----------------------------------------------------            DTSCS17
01312      IF NOT LCCM-SCR-INQUIRE                                      DTSCS17
01313         MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID                     DTSCS17
01314         GO TO P7200-EXIT.                                         DTSCS17
01315      SKIP3                                                        DTSCS17
01316 *-----------------------------------------------------            DTSCS17
01317 *    MAP-EMP-NO MAY NOT BE CHANGED DURING THE MOD                 DTSCS17
01318 *-----------------------------------------------------            DTSCS17
01319      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS17
01320      IF LCCM-MSG                                                  DTSCS17
01321          GO TO P7200-EXIT.                                        DTSCS17
01322                                                                   DTSCS17
01323      IF LCCM-EMP-NO NOT = WRK-EMP-NO                              DTSCS17
01324          MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA         DTSCS17
01325          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS17
01326          GO TO P7200-EXIT.                                        DTSCS17
01327                                                                   DTSCS17
01328      MOVE WRK-EMP-NO               TO L084-EMP-NO.                DTSCS17
01329      MOVE LCCM-CURR-RUN-DATE       TO L084-CURR-RUN-DATE.         DTSCS17
01330                                                                   DTSCS17
01331      SET L084-SOL-CHANGE-88        TO TRUE.                       DTSCS17
01332                                                                   DTSCS17
01333      PERFORM S084-APPROVAL         THRU S084-EXIT.                DTSCS17
01334      IF NOT L084-VALID-APPROVAL-88                                DTSCS17
01335         SET L084-SUCCESSOR-88      TO TRUE                        DTSCS17
01336         PERFORM S084-APPROVAL      THRU S084-EXIT                 DTSCS17
01337         IF NOT L084-VALID-APPROVAL-88                             DTSCS17
01338            MOVE MSG-E17H-AREA      TO WRK-MSG-AREA                DTSCS17
01339            PERFORM S1199-ERROR     THRU S1199-EXIT                DTSCS17
01340            GO TO P7200-EXIT                                       DTSCS17
01341         END-IF                                                    DTSCS17
01342      END-IF.                                                      DTSCS17
01343                                                                   DTSCS17
01344                                                                   DTSCS17
01345      PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT.                  DTSCS17
01346  P7200-EXIT.                                                      DTSCS17
01347      EXIT.                                                        DTSCS17
01348 /*****************************************************************DTSCS17
01349 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED       *DTSCS17
01350 ******************************************************************DTSCS17
01351                                                                   DTSCS17
01352  P8000-REQUEST-UPDATE.                                            DTSCS17
01353      PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCS17
01354                                                                   DTSCS17
01355      IF LCCM-SCR-MOD-LOCKED                                       DTSCS17
01356         PERFORM P8200-MOD THRU P8200-EXIT                         DTSCS17
01357      ELSE                                                         DTSCS17
01358         GO TO S899-ABEND.                                         DTSCS17
01359                                                                   DTSCS17
01360      SET RESP-SEND-MAP TO TRUE.                                   DTSCS17
01361  P8000-EXIT.                                                      DTSCS17
01362      EXIT.                                                        DTSCS17
01363 /*****************************************************************DTSCS17
01364 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS        *DTSCS17
01365 ******************************************************************DTSCS17
01366                                                                   DTSCS17
01367  P8200-MOD.                                                       DTSCS17
01368      SET LCCM-SCR-INQUIRE TO TRUE.                                DTSCS17
01369      SKIP2                                                        DTSCS17
01370      IF LCCM-F12-88                                               DTSCS17
01371         MOVE PMSG-MOD-CANCELED        TO LCCM-MSG-ID              DTSCS17
01372         GO TO P8200-EXIT.                                         DTSCS17
01373      SKIP2                                                        DTSCS17
01374      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS17
01375                                                                   DTSCS17
01376      MOVE 'M' TO L221-UPDATE-FUNCTION.                            DTSCS17
01377      PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT.                 DTSCS17
01378      IF LCCM-MSG                                                  DTSCS17
01379          GO TO P8200-EXIT.                                        DTSCS17
01380                                                                   DTSCS17
01381      PERFORM P8900-UPDATE THRU P8900-EXIT.                        DTSCS17
01382                                                                   DTSCS17
01383      PERFORM S221-EMP-UNLOCK THRU S221-EXIT.                      DTSCS17
01384                                                                   DTSCS17
01385      MOVE MSOL-KEY-AREA TO LCCM-SCR17-HOLD-AREA.                  DTSCS17
01386                                                                   DTSCS17
01387      SET LCCM-ENTER-88 TO TRUE.                                   DTSCS17
01388                                                                   DTSCS17
01389      PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT.               DTSCS17
01390      SKIP2                                                        DTSCS17
01391      MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS17
01392                                                                   DTSCS17
01393      MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID.                     DTSCS17
01394  P8200-EXIT.                                                      DTSCS17
01395      EXIT.                                                        DTSCS17
01396      SKIP3                                                        DTSCS17
01397  P8810-LOCK-EMPLOYER.                                             DTSCS17
01398      MOVE WRK-EMP-NO TO L221-EMP-NO.                              DTSCS17
01399      MOVE LCCM-SCR-ABSTIME TO L221-SCR-ABSTIME.                   DTSCS17
01400      MOVE LCCM-TASK-ID TO L221-UPDATE-TASK-ID.                    DTSCS17
01401      MOVE LCCM-OP-ID TO L221-UPDATE-OP-ID.                        DTSCS17
01402      MOVE LCCM-CICS-TERM-ID TO L221-UPDATE-TERMID.                DTSCS17
01403      MOVE LCCM-TASK-NETNAME TO L221-UPDATE-NETNAME.               DTSCS17
01404      MOVE LCCM-TASK-START-DATE TO L221-UPDATE-START-DATE.         DTSCS17
01405      MOVE LCCM-TASK-START-TIME TO L221-UPDATE-START-TIME.         DTSCS17
01406      MOVE WRK-SCR-ID TO L221-UPDATE-SCR-ID.                       DTSCS17
01407                                                                   DTSCS17
01408      PERFORM S221-EMP-LOCK THRU S221-EXIT.                        DTSCS17
01409  P8810-EXIT.                                                      DTSCS17
01410      EXIT.                                                        DTSCS17
01411      EJECT                                                        DTSCS17
01412  P8900-UPDATE.                                                    DTSCS17
01413      MOVE LOW-VALUES TO MPRF-KEY-AREA.                            DTSCS17
01414      MOVE WRK-EMP-NO TO MPRF-EMP-NO.                              DTSCS17
01415      SET MPRF-PRF-88 TO TRUE.                                     DTSCS17
01416      MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS17
01417      PERFORM S810-READ THRU S810-EXIT.                            DTSCS17
01418      IF L810-NO-REC-88                                            DTSCS17
01419          GO TO S899-ABEND.                                        DTSCS17
01420      MOVE MSKL-REC TO MPRF-REC.                                   DTSCS17
01421                                                                   DTSCS17
01422      MOVE LCCM-SCR17-HOLD-AREA TO MSKL-KEY-AREA.                  DTSCS17
01423      PERFORM S810-READ THRU S810-EXIT.                            DTSCS17
01424      IF L810-NO-REC-88                                            DTSCS17
01425          GO TO S899-ABEND.                                        DTSCS17
01426      MOVE MSKL-REC TO MSOL-REC.                                   DTSCS17
01427      SKIP2                                                        DTSCS17
01428      PERFORM P8905-EMP-INIT-MLOG THRU P8905-EXIT.                 DTSCS17
01429      SKIP2                                                        DTSCS17
01430      PERFORM P8910-MPRF-UPDATE THRU P8910-EXIT.                   DTSCS17
01431                                                                   DTSCS17
01432      PERFORM P8920-MSOL-UPDATE THRU P8920-EXIT.                   DTSCS17
01433      SKIP2                                                        DTSCS17
01434      MOVE MPRF-REC TO MSKL-REC.                                   DTSCS17
01435      PERFORM S810-REWRITE THRU S810-EXIT.                         DTSCS17
01436                                                                   DTSCS17
01437      MOVE LCCM-SCR17-HOLD-AREA TO SCR-REC-KEY-AREA.               DTSCS17
01438      IF MSOL-KEY-AREA = SCR-REC-KEY-AREA                          DTSCS17
01439          MOVE MSOL-REC TO MSKL-REC                                DTSCS17
01440          PERFORM S810-REWRITE THRU S810-EXIT                      DTSCS17
01441      ELSE                                                         DTSCS17
01442          MOVE SCR-REC-KEY-AREA TO MSKL-KEY-AREA                   DTSCS17
01443          PERFORM S810-DELETE THRU S810-EXIT                       DTSCS17
01444          MOVE MSOL-REC TO MSKL-REC                                DTSCS17
01445          PERFORM S810-WRITE THRU S810-EXIT.                       DTSCS17
01446  P8900-EXIT.                                                      DTSCS17
01447      EXIT.                                                        DTSCS17
01448      SKIP3                                                        DTSCS17
01449  P8905-EMP-INIT-MLOG.                                             DTSCS17
01450      MOVE WRK-EMP-NO TO L331-EMP-NO.                              DTSCS17
01451      MOVE LCCM-CURR-RUN-DATE TO L331-CURR-RUN-DATE.               DTSCS17
01452      MOVE LCCM-TASK-START-ABSTIME TO L331-UPDATE-ABSTIME.         DTSCS17
01453      MOVE LCCM-OP-ID TO L331-OP-ID.                               DTSCS17
01454  P8905-EXIT.  EXIT.                                               DTSCS17
01455      EJECT                                                        DTSCS17
01456  P8910-MPRF-UPDATE.                                               DTSCS17
01457                                                                   DTSCS17
01458      PERFORM P8911-EMP-CLASS THRU P8911-EXIT.                     DTSCS17
01459                                                                   DTSCS17
01460      PERFORM P8912-EMP-STATUS THRU P8912-EXIT.                    DTSCS17
01461                                                                   DTSCS17
01462      IF (MPRF-CLASS-RATED-88)                                     DTSCS17
01463             AND                                                   DTSCS17
01464         (MPRF-STATUS-INACT-88)                                    DTSCS17
01465          NEXT SENTENCE                                            DTSCS17
01466      ELSE                                                         DTSCS17
01467          SET MPRF-CHRG-STMT-PRINT-YES-88 TO TRUE.                 DTSCS17
01468  P8910-EXIT.                                                      DTSCS17
01469      EXIT.                                                        DTSCS17
01470      SKIP3                                                        DTSCS17
01471  P8911-EMP-CLASS.                                                 DTSCS17
01472      MOVE MPRF-EMP-CLASS TO HOLD-EMP-CLASS.                       DTSCS17
01473      MOVE SPACES TO L331-REC-OCC-ID.                              DTSCS17
01474      MOVE MAP-LIAB-CD TO L201-LIAB-CD.                            DTSCS17
01475      PERFORM S201-DETER-EMP-CLASS THRU S201-EXIT.                 DTSCS17
01476      IF L201-EMP-CLASS = MPRF-EMP-CLASS                           DTSCS17
01477          GO TO P8911-EXIT.                                        DTSCS17
01478                                                                   DTSCS17
01479      MOVE 'MPRF-EMP-CLASS' TO L331-FIELD-NAME.                    DTSCS17
01480      MOVE MPRF-EMP-CLASS TO L331-FROM-VALUE.                      DTSCS17
01481      MOVE L201-EMP-CLASS TO L331-TO-VALUE.                        DTSCS17
01482      PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT.                  DTSCS17
01483      MOVE L201-EMP-CLASS TO MPRF-EMP-CLASS.                       DTSCS17
01484      MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE.                   DTSCS17
01485                                                                   DTSCS17
01486      MOVE MPRF-EMP-CLASS TO L202-EMP-CLASS.                       DTSCS17
01487      PERFORM S202-DETER-ELIG-CD THRU S202-EXIT.                   DTSCS17
01488      MOVE L202-ELIGIBLE-CD TO MPRF-ELIGIBLE-CD.                   DTSCS17
01489                                                                   DTSCS17
01490                                                                   DTSCS17
01491      IF MPRF-CLASS-RATED-88                                       DTSCS17
01492          PERFORM P8992-INITIALIZE-T006 THRU P8992-EXIT            DTSCS17
01493          SET T006-UIRTE-EXIST-CHK TO TRUE                         DTSCS17
01494          MOVE +0 TO T006-START-YRQ                                DTSCS17
01495          MOVE ALL-NINES-YRQ TO T006-END-YRQ                       DTSCS17
01496          MOVE LENGTH OF T006-REC TO T006-LENGTH                   DTSCS17
01497          MOVE T006-REC TO RSKL-REC                                DTSCS17
01498          PERFORM S825-WRITE THRU S825-EXIT.                       DTSCS17
01499                                                                   DTSCS17
01500      PERFORM P8994-INITIALIZE-T031 THRU P8994-EXIT.               DTSCS17
01501      SET T031-AUTO-PROCESS TO TRUE.                               DTSCS17
01502      MOVE +0 TO T031-START-YRQ.                                   DTSCS17
01503      MOVE ALL-NINES-YRQ TO T031-END-YRQ.                          DTSCS17
01504      PERFORM P8996-SET-TRANSFER-TO THRU P8996-EXIT.               DTSCS17
01505      MOVE LENGTH OF T031-REC TO T031-LENGTH.                      DTSCS17
01506      MOVE T031-REC TO RSKL-REC.                                   DTSCS17
01507      PERFORM S825-WRITE THRU S825-EXIT.                           DTSCS17
01508  P8911-EXIT.                                                      DTSCS17
01509      EXIT.                                                        DTSCS17
01510      SKIP3                                                        DTSCS17
01511  P8912-EMP-STATUS.                                                DTSCS17
01512      MOVE MPRF-EMP-STATUS TO HOLD-EMP-STATUS.                     DTSCS17
01513                                                                   DTSCS17
01514      IF MSOL-INACT-ACTIVE-88                                      DTSCS17
01515          IF MAP-INACT-CD = SPACES                                 DTSCS17
01516              NEXT SENTENCE                                        DTSCS17
01517          ELSE                                                     DTSCS17
01518              SET MPRF-STATUS-INACT-88 TO TRUE                     DTSCS17
01519      ELSE                                                         DTSCS17
01520          IF MAP-INACT-CD = SPACES                                 DTSCS17
01521              SET MPRF-STATUS-ACT-88 TO TRUE                       DTSCS17
01522          ELSE                                                     DTSCS17
01523              NEXT SENTENCE.                                       DTSCS17
01524                                                                   DTSCS17
01525      IF HOLD-EMP-STATUS = MPRF-EMP-STATUS                         DTSCS17
01526          NEXT SENTENCE                                            DTSCS17
01527      ELSE                                                         DTSCS17
01528          MOVE SPACES TO L331-REC-OCC-ID                           DTSCS17
01529          MOVE 'MPRF-EMP-STATUS' TO L331-FIELD-NAME                DTSCS17
01530          MOVE HOLD-EMP-STATUS TO L331-FROM-VALUE                  DTSCS17
01531          MOVE MPRF-EMP-STATUS TO L331-TO-VALUE                    DTSCS17
01532          PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT               DTSCS17
01533          MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE.               DTSCS17
01534  P8912-EXIT.                                                      DTSCS17
01535      EXIT.                                                        DTSCS17
01536      EJECT                                                        DTSCS17
01537  P8920-MSOL-UPDATE.                                               DTSCS17
01538      MOVE MSOL-INACT-CD TO HOLD-INACT-CD.                         DTSCS17
01539      MOVE MSOL-FIRST-LIAB-YRQ TO HOLD-FIRST-LIAB-YRQ.             DTSCS17
01540      MOVE MSOL-LAST-LIAB-YRQ TO HOLD-LAST-LIAB-YRQ.               DTSCS17
01541                                                                   DTSCS17
01542      MOVE MSOL-LIAB-DATE TO HOLD-LIAB-DATE.                       DTSCS17
01543      MOVE MSOL-INACT-DATE TO HOLD-INACT-DATE.                     DTSCS17
01544      MOVE MSOL-LIAB-ESTB-DATE TO HOLD-LIAB-ESTB-DATE.             DTSCS17
01545      SKIP2                                                        DTSCS17
01546      MOVE MAP-LIAB-DATE-AREA TO L015-S-DATE-AREA.                 DTSCS17
01547      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS17
01548      IF L015-VALID                                                DTSCS17
01549          NEXT SENTENCE                                            DTSCS17
01550      ELSE                                                         DTSCS17
01551          GO TO S899-ABEND.                                        DTSCS17
01552                                                                   DTSCS17
01553      MOVE L015-DATE TO WRK-LIAB-DATE.                             DTSCS17
01554                                                                   DTSCS17
01555      IF MAP-INACT-CD = SPACES                                     DTSCS17
01556          MOVE ALL-NINES-DATE TO WRK-INACT-DATE                    DTSCS17
01557      ELSE                                                         DTSCS17
01558          MOVE MAP-INACT-DATE-AREA TO L015-S-DATE-AREA             DTSCS17
01559          PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT             DTSCS17
01560          IF L015-VALID                                            DTSCS17
01561              MOVE L015-DATE TO WRK-INACT-DATE                     DTSCS17
01562          ELSE                                                     DTSCS17
01563              GO TO S899-ABEND.                                    DTSCS17
01564                                                                   DTSCS17
01565      MOVE MAP-INACT-CD TO WRK-INACT-CD.                           DTSCS17
01566                                                                   DTSCS17
01567      PERFORM S6100-SET-LIAB-YRQ THRU S6100-EXIT.                  DTSCS17
01568                                                                   DTSCS17
01569      PERFORM P8923-CHK-RATES    THRU P8923-EXIT.                  DTSCS17
01570                                                                   DTSCS17
01571      PERFORM P8921-MSOL-CHANGE THRU P8921-EXIT.                   DTSCS17
01572                                                                   DTSCS17
01573      PERFORM P8922-OLA-WRITE THRU P8922-EXIT.                     DTSCS17
01574                                                                   DTSCS17
01575      IF MAP-INACT-CD = '04' OR '05'                               DTSCS17
01576         IF MAP-INACT-CD NOT = HOLD-INACT-CD                       DTSCS17
01577            PERFORM P8924-UPDATE-MERA  THRU P8924-EXIT             DTSCS17
01578         END-IF                                                    DTSCS17
01579      END-IF.                                                      DTSCS17
01580                                                                   DTSCS17
01581  P8920-EXIT.                                                      DTSCS17
01582      EXIT.                                                        DTSCS17
01583      EJECT                                                        DTSCS17
01584  P8921-MSOL-CHANGE.                                               DTSCS17
01585      MOVE WRK-LIAB-DATE TO L001-FED-8-DATE-9.                     DTSCS17
01586      PERFORM S001-FROM-FED-8 THRU S001-EXIT.                      DTSCS17
01587      MOVE SPACES TO L331-REC-OCC-ID.                              DTSCS17
01588      MOVE L001-FED-8-DATE-X TO L331-REC-OCC-ID.                   DTSCS17
01589                                                                   DTSCS17
01590      IF WRK-LIAB-DATE = MSOL-LIAB-DATE                            DTSCS17
01591          NEXT SENTENCE                                            DTSCS17
01592      ELSE                                                         DTSCS17
01593          MOVE 'MSOL-LIAB-DATE' TO L331-FIELD-NAME                 DTSCS17
01594          MOVE MSOL-LIAB-DATE TO L001-FED-8-DATE-9                 DTSCS17
01595          PERFORM S001-FROM-FED-8 THRU S001-EXIT                   DTSCS17
01596          MOVE L001-SLASH-DATE TO L331-FROM-VALUE                  DTSCS17
01597          MOVE WRK-LIAB-DATE TO L001-FED-8-DATE-9                  DTSCS17
01598          PERFORM S001-FROM-FED-8 THRU S001-EXIT                   DTSCS17
01599          MOVE L001-SLASH-DATE TO L331-TO-VALUE                    DTSCS17
01600          PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT               DTSCS17
01601          MOVE WRK-LIAB-DATE TO MSOL-LIAB-DATE                     DTSCS17
01602          MOVE LCCM-CURR-RUN-DATE TO MSOL-CHNG-DATE.               DTSCS17
01603                                                                   DTSCS17
01604      IF WRK-FIRST-LIAB-YRQ = MSOL-FIRST-LIAB-YRQ                  DTSCS17
01605          NEXT SENTENCE                                            DTSCS17
01606      ELSE                                                         DTSCS17
01607          MOVE 'MSOL-FIRST-LIAB-YRQ' TO L331-FIELD-NAME            DTSCS17
01608          IF MSOL-FIRST-LIAB-YRQ = +0                              DTSCS17
01609              MOVE SPACES TO L331-FROM-VALUE                       DTSCS17
01610          ELSE                                                     DTSCS17
01611              MOVE MSOL-FIRST-LIAB-YRQ TO L004-QTR-5-9             DTSCS17
01612              PERFORM S004-FROM-5 THRU S004-EXIT                   DTSCS17
01613              MOVE L004-SLASH-QTR TO L331-FROM-VALUE               DTSCS17
01614          END-IF                                                   DTSCS17
01615          IF WRK-FIRST-LIAB-YRQ = +0                               DTSCS17
01616              MOVE SPACES TO L331-TO-VALUE                         DTSCS17
01617          ELSE                                                     DTSCS17
01618              MOVE WRK-FIRST-LIAB-YRQ TO L004-QTR-5-9              DTSCS17
01619              PERFORM S004-FROM-5 THRU S004-EXIT                   DTSCS17
01620              MOVE L004-SLASH-QTR TO L331-TO-VALUE                 DTSCS17
01621          END-IF                                                   DTSCS17
01622          PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT               DTSCS17
01623          MOVE WRK-FIRST-LIAB-YRQ TO MSOL-FIRST-LIAB-YRQ           DTSCS17
01624          MOVE LCCM-CURR-RUN-DATE TO MSOL-CHNG-DATE.               DTSCS17
01625                                                                   DTSCS17
01626      MOVE MAP-LIAB-ESTB-DATE-AREA TO L015-S-DATE-AREA.            DTSCS17
01627      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS17
01628      IF L015-DATE = MSOL-LIAB-ESTB-DATE                           DTSCS17
01629          NEXT SENTENCE                                            DTSCS17
01630      ELSE                                                         DTSCS17
01631          MOVE 'MSOL-LIAB-ESTB-DATE' TO L331-FIELD-NAME            DTSCS17
01632          MOVE MSOL-LIAB-ESTB-DATE TO L001-FED-8-DATE-9            DTSCS17
01633          PERFORM S001-FROM-FED-8 THRU S001-EXIT                   DTSCS17
01634          MOVE L001-SLASH-DATE TO L331-FROM-VALUE                  DTSCS17
01635          MOVE L015-DATE TO L001-FED-8-DATE-9                      DTSCS17
01636          PERFORM S001-FROM-FED-8 THRU S001-EXIT                   DTSCS17
01637          MOVE L001-SLASH-DATE TO L331-TO-VALUE                    DTSCS17
01638          PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT               DTSCS17
01639          MOVE L015-DATE TO MSOL-LIAB-ESTB-DATE                    DTSCS17
01640          MOVE LCCM-CURR-RUN-DATE TO MSOL-CHNG-DATE.               DTSCS17
01641                                                                   DTSCS17
01642      IF MAP-LIAB-CD = MSOL-LIAB-CD                                DTSCS17
01643          NEXT SENTENCE                                            DTSCS17
01644      ELSE                                                         DTSCS17
01645          MOVE 'MSOL-LIAB-CD' TO L331-FIELD-NAME                   DTSCS17
01646          MOVE MSOL-LIAB-CD TO L331-FROM-VALUE                     DTSCS17
01647          MOVE MAP-LIAB-CD TO L331-TO-VALUE                        DTSCS17
01648          PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT               DTSCS17
01649          MOVE MAP-LIAB-CD TO MSOL-LIAB-CD                         DTSCS17
01650          MOVE LCCM-CURR-RUN-DATE TO MSOL-CHNG-DATE.               DTSCS17
01651                                                                   DTSCS17
01652      IF WRK-INACT-DATE = MSOL-INACT-DATE                          DTSCS17
01653          NEXT SENTENCE                                            DTSCS17
01654      ELSE                                                         DTSCS17
01655          MOVE 'MSOL-INACT-DATE' TO L331-FIELD-NAME                DTSCS17
01656          IF MSOL-INACT-DATE = +0                                  DTSCS17
01657              MOVE SPACES TO L331-FROM-VALUE                       DTSCS17
01658          ELSE                                                     DTSCS17
01659              IF MSOL-INACT-DATE = ALL-NINES-DATE                  DTSCS17
01660                  MOVE '99/99/99' TO L331-FROM-VALUE               DTSCS17
01661              ELSE                                                 DTSCS17
01662                  MOVE MSOL-INACT-DATE TO L001-FED-8-DATE-9        DTSCS17
01663                  PERFORM S001-FROM-FED-8 THRU S001-EXIT           DTSCS17
01664                  MOVE L001-SLASH-DATE TO L331-FROM-VALUE          DTSCS17
01665              END-IF                                               DTSCS17
01666          END-IF                                                   DTSCS17
01667          IF WRK-INACT-DATE = +0                                   DTSCS17
01668              MOVE SPACES TO L331-TO-VALUE                         DTSCS17
01669          ELSE                                                     DTSCS17
01670              IF WRK-INACT-DATE = ALL-NINES-DATE                   DTSCS17
01671                  MOVE '99/99/99' TO L331-TO-VALUE                 DTSCS17
01672              ELSE                                                 DTSCS17
01673                  MOVE WRK-INACT-DATE TO L001-FED-8-DATE-9         DTSCS17
01674                  PERFORM S001-FROM-FED-8 THRU S001-EXIT           DTSCS17
01675                  MOVE L001-SLASH-DATE TO L331-TO-VALUE            DTSCS17
01676              END-IF                                               DTSCS17
01677          END-IF                                                   DTSCS17
01678          PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT               DTSCS17
01679          MOVE WRK-INACT-DATE TO MSOL-INACT-DATE                   DTSCS17
01680          MOVE LCCM-CURR-RUN-DATE TO MSOL-CHNG-DATE.               DTSCS17
01681                                                                   DTSCS17
01682      IF WRK-LAST-LIAB-YRQ = MSOL-LAST-LIAB-YRQ                    DTSCS17
01683          NEXT SENTENCE                                            DTSCS17
01684      ELSE                                                         DTSCS17
01685          MOVE 'MSOL-LAST-LIAB-YRQ' TO L331-FIELD-NAME             DTSCS17
01686          IF MSOL-LAST-LIAB-YRQ = +0                               DTSCS17
01687              MOVE SPACES TO L331-FROM-VALUE                       DTSCS17
01688          ELSE                                                     DTSCS17
01689              IF MSOL-LAST-LIAB-YRQ =  ALL-NINES-YRQ               DTSCS17
01690                  MOVE '99/9' TO L331-FROM-VALUE                   DTSCS17
01691              ELSE                                                 DTSCS17
01692                  MOVE MSOL-LAST-LIAB-YRQ TO L004-QTR-5-9          DTSCS17
01693                  PERFORM S004-FROM-5 THRU S004-EXIT               DTSCS17
01694                  MOVE L004-SLASH-QTR TO L331-FROM-VALUE           DTSCS17
01695              END-IF                                               DTSCS17
01696          END-IF                                                   DTSCS17
01697          IF WRK-LAST-LIAB-YRQ = +0                                DTSCS17
01698              MOVE SPACES TO L331-TO-VALUE                         DTSCS17
01699          ELSE                                                     DTSCS17
01700              IF WRK-LAST-LIAB-YRQ = ALL-NINES-YRQ                 DTSCS17
01701                  MOVE '99/9' TO L331-TO-VALUE                     DTSCS17
01702              ELSE                                                 DTSCS17
01703                  MOVE WRK-LAST-LIAB-YRQ TO L004-QTR-5-9           DTSCS17
01704                  PERFORM S004-FROM-5 THRU S004-EXIT               DTSCS17
01705                  MOVE L004-SLASH-QTR TO L331-TO-VALUE             DTSCS17
01706              END-IF                                               DTSCS17
01707          END-IF                                                   DTSCS17
01708          PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT               DTSCS17
01709          MOVE WRK-LAST-LIAB-YRQ TO MSOL-LAST-LIAB-YRQ             DTSCS17
01710          MOVE LCCM-CURR-RUN-DATE TO MSOL-CHNG-DATE.               DTSCS17
01711                                                                   DTSCS17
01712      IF MAP-INACT-CD = MSOL-INACT-CD                              DTSCS17
01713          NEXT SENTENCE                                            DTSCS17
01714      ELSE                                                         DTSCS17
01715          MOVE 'MSOL-INACT-CD' TO L331-FIELD-NAME                  DTSCS17
01716          MOVE MSOL-INACT-CD TO L331-FROM-VALUE                    DTSCS17
01717          MOVE MAP-INACT-CD TO L331-TO-VALUE                       DTSCS17
01718          PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT               DTSCS17
01719          MOVE MAP-INACT-CD TO MSOL-INACT-CD                       DTSCS17
01720          MOVE LCCM-CURR-RUN-DATE TO MSOL-CHNG-DATE.               DTSCS17
01721                                                                   DTSCS17
01722      IF HOLD-INACT-ACTIVE-88                                      DTSCS17
01723          IF MSOL-INACT-INACTIVE-88                                DTSCS17
01724              MOVE LCCM-CURR-RUN-DATE TO MSOL-INACT-ENTER-DATE     DTSCS17
01725              MOVE +0 TO MSOL-INACT-REVERSE-DATE                   DTSCS17
01726              MOVE LCCM-CURR-RUN-DATE TO MSOL-CHNG-DATE.           DTSCS17
01727                                                                   DTSCS17
01728      IF NOT HOLD-INACT-ACTIVE-88                                  DTSCS17
01729          IF MSOL-INACT-ACTIVE-88                                  DTSCS17
01730              MOVE LCCM-CURR-RUN-DATE TO MSOL-INACT-REVERSE-DATE   DTSCS17
01731              MOVE LCCM-CURR-RUN-DATE TO MSOL-CHNG-DATE.           DTSCS17
01732      SKIP3                                                        DTSCS17
01733      MOVE LOW-VALUES TO MERD-REC.                                 DTSCS17
01734                                                                   DTSCS17
01735      MOVE WRK-EMP-NO TO MERD-EMP-NO.                              DTSCS17
01736      SET MERD-ERD-88 TO TRUE.                                     DTSCS17
01737      MOVE LCCM-TASK-START-ABSTIME TO MERD-ESTB-ABSTIME.           DTSCS17
01738      MOVE +0 TO MERD-PURGE-DATE.                                  DTSCS17
01739      MOVE WRK-SCR-ID TO MERD-SCREEN-ID.                           DTSCS17
01740      MOVE LCCM-OP-ID TO MERD-OP-ID.                               DTSCS17
01741      SET MERD-NOT-CONVERTED-88 TO TRUE.                           DTSCS17
01742      MOVE LCCM-CURR-RUN-DATE TO MERD-ESTB-DATE.                   DTSCS17
01743                                                                   DTSCS17
01744      IF HOLD-INACT-ACTIVE-88                                      DTSCS17
01745          IF MSOL-INACT-ACTIVE-88                                  DTSCS17
01746              NEXT SENTENCE                                        DTSCS17
01747          ELSE                                                     DTSCS17
01748              PERFORM P8921A-INACTIVATION THRU P8921A-EXIT         DTSCS17
01749      ELSE                                                         DTSCS17
01750          IF MSOL-INACT-ACTIVE-88                                  DTSCS17
01751              PERFORM P8921B-REACTIVATION THRU P8921B-EXIT         DTSCS17
01752          ELSE                                                     DTSCS17
01753              NEXT SENTENCE.                                       DTSCS17
01754  P8921-EXIT.                                                      DTSCS17
01755      EXIT.                                                        DTSCS17
01756      SKIP3                                                        DTSCS17
01757  P8921A-INACTIVATION.                                             DTSCS17
01758      ADD +1 TO MERD-ESTB-ABSTIME.                                 DTSCS17
01759      SET MERD-DETER-INACT-88 TO TRUE.                             DTSCS17
01760      MOVE MSOL-INACT-DATE TO MERD-EFFECTIVE-DATE.                 DTSCS17
01761                                                                   DTSCS17
01762      MOVE MERD-REC TO MSKL-REC.                                   DTSCS17
01763      PERFORM S810-WRITE THRU S810-EXIT.                           DTSCS17
01764  P8921A-EXIT.                                                     DTSCS17
01765      EXIT.                                                        DTSCS17
01766      SKIP3                                                        DTSCS17
01767  P8921B-REACTIVATION.                                             DTSCS17
01768      ADD +1 TO MERD-ESTB-ABSTIME.                                 DTSCS17
01769      SET MERD-DETER-NEW-88 TO TRUE.                               DTSCS17
01770      MOVE HOLD-INACT-DATE TO L001-FED-8-DATE-9.                   DTSCS17
01771      PERFORM S001-FROM-FED-8 THRU S001-EXIT.                      DTSCS17
01772      ADD +1 TO L001-JUL-ABS-DAY.                                  DTSCS17
01773      PERFORM S001-FROM-ABS-DATE THRU S001-EXIT.                   DTSCS17
01774      MOVE L001-FED-8-DATE-9 TO MERD-EFFECTIVE-DATE.               DTSCS17
01775                                                                   DTSCS17
01776      MOVE MERD-REC TO MSKL-REC.                                   DTSCS17
01777      PERFORM S810-WRITE THRU S810-EXIT.                           DTSCS17
01778  P8921B-EXIT.                                                     DTSCS17
01779      EXIT.                                                        DTSCS17
01780      EJECT                                                        DTSCS17
01781  P8922-OLA-WRITE.                                                 DTSCS17
01782      IF ((HOLD-INACT-ACTIVE-88) AND (MSOL-INACT-INACTIVE-88))     DTSCS17
01783                  OR                                               DTSCS17
01784         ((NOT HOLD-INACT-ACTIVE-88) AND (MSOL-INACT-ACTIVE-88))   DTSCS17
01785          PERFORM P8991-INITIALIZE-T001 THRU P8991-EXIT            DTSCS17
01786          SET T001-FILE-CLERK-LIST TO TRUE                         DTSCS17
01787          MOVE LENGTH OF T001-REC TO T001-LENGTH                   DTSCS17
01788          MOVE T001-REC TO RSKL-REC                                DTSCS17
01789          PERFORM S825-WRITE THRU S825-EXIT.                       DTSCS17
01790      SKIP3                                                        DTSCS17
01791      IF ((HOLD-INACT-ACTIVE-88)                                   DTSCS17
01792             AND                                                   DTSCS17
01793          (MSOL-INACT-INACTIVE-88)                                 DTSCS17
01794             AND                                                   DTSCS17
01795          (MAP-INACT-LTR-TYPE NOT = 'N'))                          DTSCS17
01796          PERFORM P8991-INITIALIZE-T001 THRU P8991-EXIT            DTSCS17
01797          SET T001-INACTIVE-LTR TO TRUE                            DTSCS17
01798          MOVE MAP-INACT-LTR-TYPE TO T001-INACT-LTR-TYPE           DTSCS17
01799          MOVE LENGTH OF T001-REC TO T001-LENGTH                   DTSCS17
01800          MOVE T001-REC TO RSKL-REC                                DTSCS17
01801          PERFORM S825-WRITE THRU S825-EXIT.                       DTSCS17
01802                                                                   DTSCS17
01803 ***  PERFORM P8922A-CHK-RATES    THRU P8922A-EXIT.                DTSCS17
01804                                                                   DTSCS17
01805 **** IF MSOL-FIRST-LIAB-YRQ = +0                                  DTSCS17
01806 *        NEXT SENTENCE                                            DTSCS17
01807 *    ELSE                                                         DTSCS17
01808 *        IF (MSOL-FIRST-LIAB-YRQ < HOLD-FIRST-LIAB-YRQ)           DTSCS17
01809 *               OR                                                DTSCS17
01810 *           (MSOL-LAST-LIAB-YRQ > HOLD-LAST-LIAB-YRQ)             DTSCS17
01811 *            PERFORM P8992-INITIALIZE-T006 THRU P8992-EXIT        DTSCS17
01812 *            SET T006-UIRTE-EXIST-CHK TO TRUE                     DTSCS17
01813 *            MOVE MSOL-FIRST-LIAB-YRQ TO T006-START-YRQ           DTSCS17
01814 *            MOVE MSOL-LAST-LIAB-YRQ TO T006-END-YRQ              DTSCS17
01815 *            MOVE LENGTH OF T006-REC TO T006-LENGTH               DTSCS17
01816 *            MOVE T006-REC TO RSKL-REC                            DTSCS17
01817 ****         PERFORM S825-WRITE THRU S825-EXIT.                   DTSCS17
01818      SKIP3                                                        DTSCS17
01819      IF (HOLD-FIRST-LIAB-YRQ = MSOL-FIRST-LIAB-YRQ)               DTSCS17
01820             AND                                                   DTSCS17
01821         (HOLD-LAST-LIAB-YRQ = MSOL-LAST-LIAB-YRQ)                 DTSCS17
01822          NEXT SENTENCE                                            DTSCS17
01823      ELSE                                                         DTSCS17
01824          PERFORM P8994-INITIALIZE-T031 THRU P8994-EXIT            DTSCS17
01825          SET T031-AUTO-PROCESS TO TRUE                            DTSCS17
01826          IF HOLD-FIRST-LIAB-YRQ < MSOL-FIRST-LIAB-YRQ             DTSCS17
01827              MOVE HOLD-FIRST-LIAB-YRQ TO T031-START-YRQ           DTSCS17
01828          ELSE                                                     DTSCS17
01829              MOVE MSOL-FIRST-LIAB-YRQ TO T031-START-YRQ           DTSCS17
01830          END-IF                                                   DTSCS17
01831          IF HOLD-LAST-LIAB-YRQ > MSOL-LAST-LIAB-YRQ               DTSCS17
01832              MOVE HOLD-LAST-LIAB-YRQ TO T031-END-YRQ              DTSCS17
01833          ELSE                                                     DTSCS17
01834              MOVE MSOL-LAST-LIAB-YRQ TO T031-END-YRQ              DTSCS17
01835          END-IF                                                   DTSCS17
01836          PERFORM P8996-SET-TRANSFER-TO THRU P8996-EXIT            DTSCS17
01837          MOVE LENGTH OF T031-REC TO T031-LENGTH                   DTSCS17
01838          MOVE T031-REC TO RSKL-REC                                DTSCS17
01839          PERFORM S825-WRITE THRU S825-EXIT.                       DTSCS17
01840      SKIP3                                                        DTSCS17
01841      SET L410-MODE-INPUT-YRQ-88   TO TRUE                         DTSCS17
01842      MOVE WRK-EMP-NO              TO L410-EMP-NO                  DTSCS17
01843      MOVE MSOL-LAST-LIAB-YRQ      TO L410-YRQ                     DTSCS17
01844      PERFORM S410-FILING-SCHEDULE THRU S410-EXIT                  DTSCS17
01845      IF L410-ANN-SCHED-88                                         DTSCS17
01846         PERFORM P8922B-ANNUAL     THRU P8922B-EXIT                DTSCS17
01847      ELSE                                                         DTSCS17
01848         PERFORM P8922C-QUARTERLY  THRU P8922C-EXIT.               DTSCS17
01849                                                                   DTSCS17
01850  P8922-EXIT.                                                      DTSCS17
01851      EXIT.                                                        DTSCS17
01852                                                                   DTSCS17
01853  P8922B-ANNUAL.                                                   DTSCS17
01854      SET L415-MODE-MOST-RECENT-88 TO TRUE.                        DTSCS17
01855      PERFORM S415-HOUSEHOLD-DATES   THRU S415-EXIT.               DTSCS17
01856 ************************************************************      DTSCS17
01857 *  THE FOLLOWING 2 LINES NEEDED ONLY FOR THE FIRST YEAR OF        DTSCS17
01858 *  ANNUAL FILING, BEFORE THE FIRST ANNUAL MASS MAILING            DTSCS17
01859 *  HAS OCCURRED.                                                  DTSCS17
01860 ************************************************************      DTSCS17
01861      IF L415-UC30H-MASS-MAIL-STRT-YRQ = ZERO                      DTSCS17
01862         MOVE 20011 TO L415-UC30H-MASS-MAIL-STRT-YRQ.              DTSCS17
01863                                                                   DTSCS17
01864      IF (NOT HOLD-INACT-ACTIVE-88)                                DTSCS17
01865            OR                                                     DTSCS17
01866         (MSOL-INACT-ACTIVE-88)                                    DTSCS17
01867            OR                                                     DTSCS17
01868         (MSOL-LAST-LIAB-YRQ NOT >                                 DTSCS17
01869                               L415-UC30H-MASS-MAIL-STRT-YRQ)      DTSCS17
01870          NEXT SENTENCE                                            DTSCS17
01871      ELSE                                                         DTSCS17
01872          PERFORM P8995-INITIALIZE-T036 THRU P8995-EXIT            DTSCS17
01873          SET T036-INACTIVATION TO TRUE                            DTSCS17
01874          MOVE L415-UC30H-MASS-MAIL-STRT-YRQ TO L004-QTR-5-9       DTSCS17
01875          PERFORM S004-FROM-5 THRU S004-EXIT                       DTSCS17
01876          ADD 1 TO L004-QTR-5-YR                                   DTSCS17
01877          PERFORM S004-FROM-5   THRU S004-EXIT                     DTSCS17
01878          MOVE L004-QTR-5-9 TO T036-START-YRQ                      DTSCS17
01879          MOVE MSOL-LAST-LIAB-YRQ TO T036-END-YRQ                  DTSCS17
01880          MOVE LENGTH OF T036-REC TO T036-LENGTH                   DTSCS17
01881          MOVE T036-REC TO RSKL-REC                                DTSCS17
01882          PERFORM S825-WRITE THRU S825-EXIT.                       DTSCS17
01883                                                                   DTSCS17
01884  P8922B-EXIT.                                                     DTSCS17
01885      EXIT.                                                        DTSCS17
01886                                                                   DTSCS17
01887  P8922C-QUARTERLY.                                                DTSCS17
01888      IF (NOT HOLD-INACT-ACTIVE-88)                                DTSCS17
01889            OR                                                     DTSCS17
01890         (MSOL-INACT-ACTIVE-88)                                    DTSCS17
01891            OR                                                     DTSCS17
01892         (MSOL-LAST-LIAB-YRQ NOT > LCCM-LAST-UC30-MASS-MAIL-YRQ)   DTSCS17
01893          NEXT SENTENCE                                            DTSCS17
01894      ELSE                                                         DTSCS17
01895          PERFORM P8995-INITIALIZE-T036 THRU P8995-EXIT            DTSCS17
01896          SET T036-INACTIVATION TO TRUE                            DTSCS17
01897          MOVE LCCM-LAST-UC30-MASS-MAIL-YRQ TO L004-QTR-5-9        DTSCS17
01898          PERFORM S004-FROM-5 THRU S004-EXIT                       DTSCS17
01899          ADD +1 TO L004-ABS-QTR                                   DTSCS17
01900          PERFORM S004-FROM-ABS THRU S004-EXIT                     DTSCS17
01901          MOVE L004-QTR-5-9 TO T036-START-YRQ                      DTSCS17
01902          MOVE MSOL-LAST-LIAB-YRQ TO T036-END-YRQ                  DTSCS17
01903          MOVE LENGTH OF T036-REC TO T036-LENGTH                   DTSCS17
01904          MOVE T036-REC TO RSKL-REC                                DTSCS17
01905          PERFORM S825-WRITE THRU S825-EXIT.                       DTSCS17
01906                                                                   DTSCS17
01907  P8922C-EXIT.                                                     DTSCS17
01908      EXIT.                                                        DTSCS17
01909                                                                   DTSCS17
01910  P8923-CHK-RATES.                                                 DTSCS17
01911      SET WRK-DISPLAY-ERR-NO-88        TO TRUE.                    DTSCS17
01912      PERFORM S3400-CHECK-MRTE         THRU S3400-EXIT.            DTSCS17
01913                                                                   DTSCS17
01914      IF WRK-RATE-CHK-ESTIM-88                                     DTSCS17
01915         PERFORM P8992-INITIALIZE-T006 THRU P8992-EXIT             DTSCS17
01916         SET T006-FINAL-RATE           TO TRUE                     DTSCS17
01917         MOVE WRK-ESTIM-YRQ            TO T006-START-YRQ           DTSCS17
01918         MOVE ZERO                     TO T006-END-YRQ             DTSCS17
01919         MOVE LENGTH OF T006-REC       TO T006-LENGTH              DTSCS17
01920         MOVE T006-REC                 TO RSKL-REC                 DTSCS17
01921         PERFORM S825-WRITE            THRU S825-EXIT.             DTSCS17
01922                                                                   DTSCS17
01923  P8923-EXIT.                                                      DTSCS17
01924      EXIT.                                                        DTSCS17
01925                                                                   DTSCS17
01926 **********************************************************        DTSCS17
01927 *  SET MERA STATUS TO 'NOT LIABLE' IF MERA STATUS IS              DTSCS17
01928 *  ACTIVE AND SPAN OF LIABILITY HAS BEEN WITHDRAWN.               DTSCS17
01929 **********************************************************        DTSCS17
01930  P8924-UPDATE-MERA.                                               DTSCS17
01931      MOVE LOW-VALUES TO MERA-KEY-AREA.                            DTSCS17
01932      MOVE WRK-EMP-NO TO MERA-EMP-NO.                              DTSCS17
01933      SET MERA-ERA-88 TO TRUE.                                     DTSCS17
01934      MOVE MERA-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS17
01935                                                                   DTSCS17
01936      PERFORM S810-READ THRU S810-EXIT.                            DTSCS17
01937                                                                   DTSCS17
01938      IF L810-NO-REC-88                                            DTSCS17
01939          NEXT SENTENCE                                            DTSCS17
01940      ELSE                                                         DTSCS17
01941          MOVE MSKL-REC TO MERA-REC                                DTSCS17
01942          IF MERA-STATUS-ACTIVE-88                                 DTSCS17
01943             SET MERA-STATUS-NOT-LIAB-88 TO TRUE                   DTSCS17
01944             MOVE LCCM-CURR-RUN-DATE TO MERA-STATUS-CHNG-DATE      DTSCS17
01945                                        MERA-CHNG-DATE             DTSCS17
01946             IF MERA-DETER-NOTSUB-DATE = LCCM-CURR-RUN-DATE        DTSCS17
01947                 NEXT SENTENCE                                     DTSCS17
01948             ELSE                                                  DTSCS17
01949                 MOVE LCCM-CURR-RUN-DATE TO MERA-DETER-NOTSUB-DATE DTSCS17
01950                                            MERA-CHNG-DATE         DTSCS17
01951             END-IF                                                DTSCS17
01952             MOVE MERA-REC TO MSKL-REC                             DTSCS17
01953             PERFORM S810-REWRITE THRU S810-EXIT                   DTSCS17
01954          END-IF                                                   DTSCS17
01955       END-IF.                                                     DTSCS17
01956                                                                   DTSCS17
01957  P8924-EXIT.                                                      DTSCS17
01958      EXIT.                                                        DTSCS17
01959                                                                   DTSCS17
01960  P8991-INITIALIZE-T001.                                           DTSCS17
01961      MOVE WRK-EMP-NO TO T001-EMP-NO.                              DTSCS17
01962      MOVE LCCM-OP-ID TO T001-OP-ID.                               DTSCS17
01963      MOVE WRK-SCR-ID TO T001-SCR-ID.                              DTSCS17
01964      MOVE LCCM-TASK-START-DATE TO T001-SYS-DATE.                  DTSCS17
01965      MOVE LCCM-TASK-START-TIME TO T001-SYS-TIME.                  DTSCS17
01966      MOVE MAP-RESP-OP-ID TO T001-RESP-OP-ID.                      DTSCS17
01967      MOVE SPACES TO T001-INACT-LTR-TYPE                           DTSCS17
01968                     T001-WELCOME-LTR-IND.                         DTSCS17
01969 ********************T001-WELCOME-LTR-ADDR-IND.                    DTSCS17
01970 *****MOVE +0 TO T001-PRED-EMP-NO.                                 DTSCS17
01971  P8991-EXIT.                                                      DTSCS17
01972      EXIT.                                                        DTSCS17
01973      SKIP3                                                        DTSCS17
01974  P8992-INITIALIZE-T006.                                           DTSCS17
01975      MOVE WRK-EMP-NO TO T006-EMP-NO.                              DTSCS17
01976      MOVE LCCM-OP-ID TO T006-OP-ID.                               DTSCS17
01977      MOVE WRK-SCR-ID TO T006-SCR-ID.                              DTSCS17
01978      MOVE LCCM-TASK-START-DATE TO T006-SYS-DATE.                  DTSCS17
01979      MOVE LCCM-TASK-START-TIME TO T006-SYS-TIME.                  DTSCS17
01980      MOVE MAP-RESP-OP-ID TO T006-RESP-OP-ID.                      DTSCS17
01981      MOVE +0 TO T006-START-YRQ                                    DTSCS17
01982                 T006-END-YRQ.                                     DTSCS17
01983  P8992-EXIT.                                                      DTSCS17
01984      EXIT.                                                        DTSCS17
01985      SKIP3                                                        DTSCS17
01986  P8994-INITIALIZE-T031.                                           DTSCS17
01987      MOVE WRK-EMP-NO TO T031-EMP-NO.                              DTSCS17
01988      MOVE LCCM-OP-ID TO T031-OP-ID.                               DTSCS17
01989      MOVE WRK-SCR-ID TO T031-SCR-ID.                              DTSCS17
01990      MOVE LCCM-TASK-START-DATE TO T031-SYS-DATE.                  DTSCS17
01991      MOVE LCCM-TASK-START-TIME TO T031-SYS-TIME.                  DTSCS17
01992      MOVE +0 TO T031-START-YRQ                                    DTSCS17
01993                 T031-END-YRQ                                      DTSCS17
01994                 T031-WAIVER-START-YRQ                             DTSCS17
01995                 T031-WAIVER-END-YRQ                               DTSCS17
01996                 T031-WAIVER-EXT-DATE.                             DTSCS17
01997                                                                   DTSCS17
01998      SET T031-TRANSFER-NO-88 TO TRUE.                             DTSCS17
01999      MOVE +0 TO T031-TRANSFER-TO-EMP-NO.                          DTSCS17
02000  P8994-EXIT.                                                      DTSCS17
02001      EXIT.                                                        DTSCS17
02002      SKIP3                                                        DTSCS17
02003  P8995-INITIALIZE-T036.                                           DTSCS17
02004      MOVE WRK-EMP-NO TO T036-EMP-NO.                              DTSCS17
02005      MOVE LCCM-OP-ID TO T036-OP-ID.                               DTSCS17
02006      MOVE WRK-SCR-ID TO T036-SCR-ID.                              DTSCS17
02007      MOVE LCCM-TASK-START-DATE TO T036-SYS-DATE.                  DTSCS17
02008      MOVE LCCM-TASK-START-TIME TO T036-SYS-TIME.                  DTSCS17
02009      MOVE MAP-RESP-OP-ID TO T036-RESP-OP-ID.                      DTSCS17
02010      MOVE +0 TO T036-START-YRQ                                    DTSCS17
02011                 T036-END-YRQ.                                     DTSCS17
02012      SET T036-NO-FORCE-PRINT TO TRUE.                             DTSCS17
02013      MOVE +0 TO T036-WAIVER-START-YRQ                             DTSCS17
02014                 T036-WAIVER-END-YRQ                               DTSCS17
02015                 T036-WAIVER-EXT-DATE.                             DTSCS17
02016      MOVE SPACE TO T036-ADDR-TYPE.                                DTSCS17
02017      MOVE +0 TO T036-ADDR-ESTB-ABSTIME.                           DTSCS17
02018 *****MOVE +0 TO T036-ADDR-NO.                                     DTSCS17
02019 *****SET T036-5E-REQ-NO-88 TO TRUE.                               DTSCS17
02020  P8995-EXIT.                                                      DTSCS17
02021      EXIT.                                                        DTSCS17
02022      SKIP3                                                        DTSCS17
02023  P8996-SET-TRANSFER-TO.                                           DTSCS17
02024      IF MAP-TRANSFER-YES-88                                       DTSCS17
02025          NEXT SENTENCE                                            DTSCS17
02026      ELSE                                                         DTSCS17
02027          GO TO P8996-EXIT.                                        DTSCS17
02028                                                                   DTSCS17
02029      SET T031-TRANSFER-YES-88 TO TRUE.                            DTSCS17
02030                                                                   DTSCS17
02031      MOVE MAP-TRANSFER-EMP-NO-AREA TO L018-S-EMP-NO-AREA.         DTSCS17
02032      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS17
02033                                                                   DTSCS17
02034      IF L018-VALID                                                DTSCS17
02035          MOVE L018-EMP-NO TO T031-TRANSFER-TO-EMP-NO              DTSCS17
02036      ELSE                                                         DTSCS17
02037          GO TO S899-ABEND.                                        DTSCS17
02038  P8996-EXIT.                                                      DTSCS17
02039      EXIT.                                                        DTSCS17
02040 /*****************************************************************DTSCS17
02041 * LINKS TO UTILITY MODULES                                        DTSCS17
02042 ******************************************************************DTSCS17
02043                                                                   DTSCS17
02044  S001-FROM-FED-8.                                                 DTSCS17
02045      SET L001-FROM-FED-8 TO TRUE.                                 DTSCS17
02046      GO TO S001-DATE.                                             DTSCS17
02047                                                                   DTSCS17
02048  S001-FROM-ABS-DATE.                                              DTSCS17
02049      SET L001-FROM-ABS-DAY TO TRUE.                               DTSCS17
02050      GO TO S001-DATE.                                             DTSCS17
02051                                                                   DTSCS17
02052  S001-DATE.                                                       DTSCS17
02053      EXEC CICS LINK                                               DTSCS17
02054          PROGRAM('DTSCU001')                                      DTSCS17
02055          COMMAREA(L001-COMM-AREA)                                 DTSCS17
02056      END-EXEC.                                                    DTSCS17
02057  S001-EXIT.                                                       DTSCS17
02058      EXIT.                                                        DTSCS17
02059      SKIP3                                                        DTSCS17
02060  S004-FROM-5.                                                     DTSCS17
02061      SET L004-FROM-5 TO TRUE.                                     DTSCS17
02062      GO TO S004-YRQ.                                              DTSCS17
02063                                                                   DTSCS17
02064  S004-FROM-ABS.                                                   DTSCS17
02065      SET L004-FROM-ABS TO TRUE.                                   DTSCS17
02066      GO TO S004-YRQ.                                              DTSCS17
02067                                                                   DTSCS17
02068  S004-FROM-DATE.                                                  DTSCS17
02069      SET L004-FROM-DATE TO TRUE.                                  DTSCS17
02070      GO TO S004-YRQ.                                              DTSCS17
02071                                                                   DTSCS17
02072  S004-YRQ.                                                        DTSCS17
02073      EXEC CICS LINK                                               DTSCS17
02074          PROGRAM('DTSCU004')                                      DTSCS17
02075          COMMAREA(L004-COMM-AREA)                                 DTSCS17
02076      END-EXEC.                                                    DTSCS17
02077  S004-EXIT.                                                       DTSCS17
02078      EXIT.                                                        DTSCS17
02079      SKIP3                                                        DTSCS17
02080  S006-RATE-PERIOD.                                                DTSCS17
02081      SET L006-FROM-QTR               TO TRUE.                     DTSCS17
02082      EXEC CICS LINK                                               DTSCS17
02083          PROGRAM('DTSCU006')                                      DTSCS17
02084          COMMAREA(L006-COMM-AREA)                                 DTSCS17
02085      END-EXEC.                                                    DTSCS17
02086  S006-EXIT.                                                       DTSCS17
02087      EXIT.                                                        DTSCS17
02088                                                                   DTSCS17
02089  S015-DATE-FROM-SCREEN.                                           DTSCS17
02090      EXEC CICS LINK                                               DTSCS17
02091          PROGRAM('DTSCU015')                                      DTSCS17
02092          COMMAREA(L015-COMM-AREA)                                 DTSCS17
02093      END-EXEC.                                                    DTSCS17
02094  S015-EXIT.                                                       DTSCS17
02095      EXIT.                                                        DTSCS17
02096      SKIP3                                                        DTSCS17
02097  S016-YRQ-FROM-SCREEN.                                            DTSCS17
02098      EXEC CICS LINK                                               DTSCS17
02099          PROGRAM('DTSCU016')                                      DTSCS17
02100          COMMAREA(L016-COMM-AREA)                                 DTSCS17
02101      END-EXEC.                                                    DTSCS17
02102  S016-EXIT.                                                       DTSCS17
02103      EXIT.                                                        DTSCS17
02104      SKIP3                                                        DTSCS17
02105  S018-EMP-NO-FROM-SCREEN.                                         DTSCS17
02106      EXEC CICS LINK                                               DTSCS17
02107          PROGRAM('DTSCU018')                                      DTSCS17
02108          COMMAREA(L018-COMM-AREA)                                 DTSCS17
02109      END-EXEC.                                                    DTSCS17
02110  S018-EXIT.                                                       DTSCS17
02111      EXIT.                                                        DTSCS17
02112      SKIP3                                                        DTSCS17
02113  S031-REG-CODES.                                                  DTSCS17
02114      EXEC CICS LINK                                               DTSCS17
02115          PROGRAM('DTSCU031')                                      DTSCS17
02116          COMMAREA(L031-COMM-AREA)                                 DTSCS17
02117      END-EXEC.                                                    DTSCS17
02118  S031-EXIT.                                                       DTSCS17
02119      EXIT.                                                        DTSCS17
02120      SKIP3                                                        DTSCS17
02121  S074-DUP-FEIN-EDIT.                                              DTSCS17
02122      EXEC CICS LINK                                               DTSCS17
02123          PROGRAM('DTSCU074')                                      DTSCS17
02124          COMMAREA(L074-COMM-AREA)                                 DTSCS17
02125      END-EXEC.                                                    DTSCS17
02126                                                                   DTSCS17
02127      IF L074-FILE-CLOSED-88                                       DTSCS17
02128          MOVE L074-MSG-AREA TO LCCM-MSG-AREA                      DTSCS17
02129          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS17
02130          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS17
02131          GO TO MAINLINE-EXIT.                                     DTSCS17
02132  S074-EXIT.                                                       DTSCS17
02133      EXIT.                                                        DTSCS17
02134      SKIP3                                                        DTSCS17
02135  S082-OP-ID-LOOKUP.                                               DTSCS17
02136      EXEC CICS LINK                                               DTSCS17
02137          PROGRAM('DTSCU082')                                      DTSCS17
02138          COMMAREA(L082-COMM-AREA)                                 DTSCS17
02139      END-EXEC.                                                    DTSCS17
02140                                                                   DTSCS17
02141      IF L082-FILE-CLOSED                                          DTSCS17
02142          MOVE L082-MSG-AREA TO LCCM-MSG-AREA                      DTSCS17
02143          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS17
02144          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS17
02145          GO TO MAINLINE-EXIT.                                     DTSCS17
02146  S082-EXIT.                                                       DTSCS17
02147      EXIT.                                                        DTSCS17
02148      SKIP3                                                        DTSCS17
02149  S084-APPROVAL.                                                   DTSCS17
02150      EXEC CICS LINK                                               DTSCS17
02151          PROGRAM('DTSCU084')                                      DTSCS17
02152          COMMAREA(L084-COMM-AREA)                                 DTSCS17
02153      END-EXEC.                                                    DTSCS17
02154                                                                   DTSCS17
02155      IF L084-FILE-CLOSED-88                                       DTSCS17
02156          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS17
02157          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS17
02158          GO TO MAINLINE-EXIT.                                     DTSCS17
02159  S084-EXIT.                                                       DTSCS17
02160      EXIT.                                                        DTSCS17
02161                                                                   DTSCS17
02162  S201-DETER-EMP-CLASS.                                            DTSCS17
02163      EXEC CICS LINK                                               DTSCS17
02164          PROGRAM('DTSCU201')                                      DTSCS17
02165          COMMAREA(L201-COMM-AREA)                                 DTSCS17
02166      END-EXEC.                                                    DTSCS17
02167  S201-EXIT.                                                       DTSCS17
02168      EXIT.                                                        DTSCS17
02169      SKIP3                                                        DTSCS17
02170  S202-DETER-ELIG-CD.                                              DTSCS17
02171      EXEC CICS LINK                                               DTSCS17
02172          PROGRAM('DTSCU202')                                      DTSCS17
02173          COMMAREA(L202-COMM-AREA)                                 DTSCS17
02174      END-EXEC.                                                    DTSCS17
02175  S202-EXIT.                                                       DTSCS17
02176      EXIT.                                                        DTSCS17
02177      SKIP3                                                        DTSCS17
02178      SKIP3                                                        DTSCS17
02179  S221-EMP-LOCK.                                                   DTSCS17
02180      SET L221-START-UPDATE TO TRUE.                               DTSCS17
02181      GO TO S221-EMP-LOCK-UNLOCK.                                  DTSCS17
02182                                                                   DTSCS17
02183  S221-EMP-UNLOCK.                                                 DTSCS17
02184      SET L221-END-UPDATE TO TRUE.                                 DTSCS17
02185      GO TO S221-EMP-LOCK-UNLOCK.                                  DTSCS17
02186                                                                   DTSCS17
02187  S221-EMP-LOCK-UNLOCK.                                            DTSCS17
02188      EXEC CICS LINK                                               DTSCS17
02189          PROGRAM('DTSCU221')                                      DTSCS17
02190          COMMAREA(L221-COMM-AREA)                                 DTSCS17
02191      END-EXEC.                                                    DTSCS17
02192                                                                   DTSCS17
02193      IF L221-FILE-CLOSED                                          DTSCS17
02194          MOVE L221-MSG-AREA TO LCCM-MSG-AREA                      DTSCS17
02195          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS17
02196          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS17
02197          GO TO MAINLINE-EXIT.                                     DTSCS17
02198                                                                   DTSCS17
02199      IF L221-NOT-OK                                               DTSCS17
02200          MOVE L221-MSG-AREA TO LCCM-MSG-AREA.                     DTSCS17
02201  S221-EXIT.                                                       DTSCS17
02202      EXIT.                                                        DTSCS17
02203      SKIP3                                                        DTSCS17
02204  S331-EMP-WRITE-MLOG.                                             DTSCS17
02205      EXEC CICS LINK                                               DTSCS17
02206          PROGRAM('DTSCU331')                                      DTSCS17
02207          COMMAREA(L331-COMM-AREA)                                 DTSCS17
02208      END-EXEC.                                                    DTSCS17
02209                                                                   DTSCS17
02210      IF L331-FILE-CLOSED                                          DTSCS17
02211          MOVE L331-MSG-AREA TO LCCM-MSG-AREA                      DTSCS17
02212          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS17
02213          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS17
02214          GO TO MAINLINE-EXIT.                                     DTSCS17
02215  S331-EXIT.                                                       DTSCS17
02216      EXIT.                                                        DTSCS17
02217      SKIP3                                                        DTSCS17
02218  S410-FILING-SCHEDULE.                                            DTSCS17
02219                                                                   DTSCS17
02220      EXEC CICS LINK                                               DTSCS17
02221          PROGRAM('DTSCU410')                                      DTSCS17
02222          COMMAREA(L410-COMM-AREA)                                 DTSCS17
02223      END-EXEC.                                                    DTSCS17
02224                                                                   DTSCS17
02225  S410-EXIT.                                                       DTSCS17
02226      EXIT.                                                        DTSCS17
02227                                                                   DTSCS17
02228  S415-HOUSEHOLD-DATES.                                            DTSCS17
02229                                                                   DTSCS17
02230      EXEC CICS LINK                                               DTSCS17
02231          PROGRAM('DTSCU415')                                      DTSCS17
02232          COMMAREA(L415-COMM-AREA)                                 DTSCS17
02233      END-EXEC.                                                    DTSCS17
02234                                                                   DTSCS17
02235  S415-EXIT.                                                       DTSCS17
02236      EXIT.                                                        DTSCS17
02237                                                                   DTSCS17
02238  S803-REQ-SCR-ID-EDIT.                                            DTSCS17
02239      EXEC CICS LINK                                               DTSCS17
02240          PROGRAM ('DTSCU803')                                     DTSCS17
02241          COMMAREA (DFHCOMMAREA)                                   DTSCS17
02242      END-EXEC.                                                    DTSCS17
02243  S803-EXIT.                                                       DTSCS17
02244      EXIT.                                                        DTSCS17
02245      SKIP3                                                        DTSCS17
02246  S804-INVALID-KEY.                                                DTSCS17
02247      EXEC CICS LINK                                               DTSCS17
02248          PROGRAM ('DTSCU804')                                     DTSCS17
02249          COMMAREA (DFHCOMMAREA)                                   DTSCS17
02250      END-EXEC.                                                    DTSCS17
02251  S804-EXIT.                                                       DTSCS17
02252      EXIT.                                                        DTSCS17
02253      SKIP3                                                        DTSCS17
02254  S805-MSG-AREA.                                                   DTSCS17
02255      MOVE LCCM-MSG-AREA TO L805-MSG-AREA                          DTSCS17
02256                                                                   DTSCS17
02257      EXEC CICS LINK                                               DTSCS17
02258          PROGRAM ('DTSCU805')                                     DTSCS17
02259          COMMAREA (L805-COMM-AREA)                                DTSCS17
02260      END-EXEC.                                                    DTSCS17
02261                                                                   DTSCS17
02262      MOVE L805-S-MSG-AREA TO MAP-MSG-AREA.                        DTSCS17
02263  S805-EXIT.                                                       DTSCS17
02264      EXIT.                                                        DTSCS17
02265      EJECT                                                        DTSCS17
02266  S810-READ.                                                       DTSCS17
02267      SET L810-READ-88 TO TRUE.                                    DTSCS17
02268      GO TO S810-IO.                                               DTSCS17
02269                                                                   DTSCS17
02270  S810-START-BROWSE.                                               DTSCS17
02271      SET L810-START-BROWSE-88 TO TRUE.                            DTSCS17
02272      GO TO S810-IO.                                               DTSCS17
02273                                                                   DTSCS17
02274  S810-READ-NEXT.                                                  DTSCS17
02275      SET L810-READ-NEXT-88 TO TRUE.                               DTSCS17
02276      GO TO S810-IO.                                               DTSCS17
02277                                                                   DTSCS17
02278  S810-READ-PREV.                                                  DTSCS17
02279      SET L810-READ-PREV-88 TO TRUE.                               DTSCS17
02280      GO TO S810-IO.                                               DTSCS17
02281                                                                   DTSCS17
02282  S810-END-BROWSE.                                                 DTSCS17
02283      SET L810-END-BROWSE-88 TO TRUE.                              DTSCS17
02284      GO TO S810-IO.                                               DTSCS17
02285                                                                   DTSCS17
02286  S810-COUNT.                                                      DTSCS17
02287      SET L810-COUNT-88 TO TRUE.                                   DTSCS17
02288      GO TO S810-IO.                                               DTSCS17
02289                                                                   DTSCS17
02290  S810-REWRITE.                                                    DTSCS17
02291      SET L810-REWRITE-88 TO TRUE.                                 DTSCS17
02292      GO TO S810-IO.                                               DTSCS17
02293                                                                   DTSCS17
02294  S810-WRITE.                                                      DTSCS17
02295      SET L810-WRITE-88 TO TRUE.                                   DTSCS17
02296      GO TO S810-IO.                                               DTSCS17
02297                                                                   DTSCS17
02298  S810-DELETE.                                                     DTSCS17
02299      SET L810-DELETE-88 TO TRUE.                                  DTSCS17
02300      GO TO S810-IO.                                               DTSCS17
02301                                                                   DTSCS17
02302  S810-IO.                                                         DTSCS17
02303                                                                   DTSCS17
02304      EXEC CICS LINK                                               DTSCS17
02305          PROGRAM ('DTSCU810')                                     DTSCS17
02306          COMMAREA (L810-COMM-AREA)                                DTSCS17
02307      END-EXEC.                                                    DTSCS17
02308                                                                   DTSCS17
02309      IF L810-FILE-CLOSED-88                                       DTSCS17
02310          MOVE L810-MSG-AREA TO LCCM-MSG-AREA                      DTSCS17
02311          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS17
02312          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS17
02313          GO TO MAINLINE-EXIT.                                     DTSCS17
02314  S810-EXIT.                                                       DTSCS17
02315      EXIT.                                                        DTSCS17
02316      EJECT                                                        DTSCS17
02317  S821-READ.                                                       DTSCS17
02318      SET L821-READ-88 TO TRUE.                                    DTSCS17
02319      GO TO S821-I.                                                DTSCS17
02320                                                                   DTSCS17
02321  S821-START-BROWSE.                                               DTSCS17
02322      SET L821-START-BROWSE-88 TO TRUE.                            DTSCS17
02323      GO TO S821-I.                                                DTSCS17
02324                                                                   DTSCS17
02325  S821-READ-NEXT.                                                  DTSCS17
02326      SET L821-READ-NEXT-88 TO TRUE.                               DTSCS17
02327      GO TO S821-I.                                                DTSCS17
02328                                                                   DTSCS17
02329  S821-READ-PREV.                                                  DTSCS17
02330      SET L821-READ-PREV-88 TO TRUE.                               DTSCS17
02331      GO TO S821-I.                                                DTSCS17
02332                                                                   DTSCS17
02333  S821-END-BROWSE.                                                 DTSCS17
02334      SET L821-END-BROWSE-88 TO TRUE.                              DTSCS17
02335      GO TO S821-I.                                                DTSCS17
02336                                                                   DTSCS17
02337  S821-I.                                                          DTSCS17
02338                                                                   DTSCS17
02339      EXEC CICS LINK                                               DTSCS17
02340          PROGRAM ('DTSCU821')                                     DTSCS17
02341          COMMAREA (L821-COMM-AREA)                                DTSCS17
02342      END-EXEC.                                                    DTSCS17
02343                                                                   DTSCS17
02344      IF L821-FILE-CLOSED-88                                       DTSCS17
02345          MOVE L810-MSG-AREA TO LCCM-MSG-AREA                      DTSCS17
02346          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS17
02347          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS17
02348          GO TO MAINLINE-EXIT.                                     DTSCS17
02349  S821-EXIT.                                                       DTSCS17
02350      EXIT.                                                        DTSCS17
02351      EJECT                                                        DTSCS17
02352  S825-WRITE.                                                      DTSCS17
02353      SET L825-WRITE-88 TO TRUE.                                   DTSCS17
02354      GO TO S825-O.                                                DTSCS17
02355                                                                   DTSCS17
02356  S825-O.                                                          DTSCS17
02357                                                                   DTSCS17
02358                                                                   DTSCS17
02359      EXEC CICS LINK                                               DTSCS17
02360          PROGRAM ('DTSCU825')                                     DTSCS17
02361          COMMAREA (L825-COMM-AREA)                                DTSCS17
02362      END-EXEC.                                                    DTSCS17
02363                                                                   DTSCS17
02364      IF L825-FILE-CLOSED-88                                       DTSCS17
02365          MOVE L825-MSG-AREA TO LCCM-MSG-AREA                      DTSCS17
02366          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS17
02367          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS17
02368          GO TO MAINLINE-EXIT.                                     DTSCS17
02369  S825-EXIT.                                                       DTSCS17
02370      EXIT.                                                        DTSCS17
02371      EJECT                                                        DTSCS17
02372  S851-SCREEN-PROCESSING.                                          DTSCS17
02373      EXEC CICS LINK                                               DTSCS17
02374          PROGRAM ('DTSCU851')                                     DTSCS17
02375          COMMAREA (L851-COMM-AREA)                                DTSCS17
02376      END-EXEC.                                                    DTSCS17
02377  S851-EXIT.                                                       DTSCS17
02378      EXIT.                                                        DTSCS17
02379      SKIP3                                                        DTSCS17
02380  S899-ABEND.                                                      DTSCS17
02381      EXEC CICS ABEND                                              DTSCS17
02382          ABCODE(WRK-ABEND-CD)                                     DTSCS17
02383      END-EXEC.                                                    DTSCS17
02384  S899-EXIT.                                                       DTSCS17
02385      EXIT.                                                        DTSCS17
02386 /*****************************************************************DTSCS17
02387 *    EDIT THE INFORMATION ON THE SCREEN.                         *DTSCS17
02388 ******************************************************************DTSCS17
02389                                                                   DTSCS17
02390  S1000-SCREEN-EDITS.                                              DTSCS17
02391      PERFORM S1110-READ-MPRF THRU S1110-EXIT.                     DTSCS17
02392      IF LCCM-MSG                                                  DTSCS17
02393          GO TO S1000-EXIT.                                        DTSCS17
02394                                                                   DTSCS17
02395      PERFORM S1120-READ-MSOL THRU S1120-EXIT.                     DTSCS17
02396      IF LCCM-MSG                                                  DTSCS17
02397          GO TO S1000-EXIT.                                        DTSCS17
02398                                                                   DTSCS17
02399      PERFORM S1200-LIAB-DATE THRU S1200-EXIT.                     DTSCS17
02400      IF LCCM-MSG                                                  DTSCS17
02401          GO TO S1000-EXIT.                                        DTSCS17
02402                                                                   DTSCS17
02403      PERFORM S1300-LIAB-ESTB-DATE THRU S1300-EXIT.                DTSCS17
02404      PERFORM S1400-LIAB-CD THRU S1400-EXIT.                       DTSCS17
02405                                                                   DTSCS17
02406      PERFORM S1500-INACT-DATE THRU S1500-EXIT.                    DTSCS17
02407      PERFORM S1600-INACT-CD THRU S1600-EXIT.                      DTSCS17
02408      PERFORM S1710-INACT-LTR-TYPE THRU S1710-EXIT.                DTSCS17
02409      PERFORM S1720-TRANSFER-IND THRU S1720-EXIT.                  DTSCS17
02410      PERFORM S1730-TRANSFER-EMP-NO THRU S1730-EXIT.               DTSCS17
02411      PERFORM S1800-OVERRIDE-IND THRU S1800-EXIT.                  DTSCS17
02412                                                                   DTSCS17
02413      PERFORM S6100-SET-LIAB-YRQ THRU S6100-EXIT.                  DTSCS17
02414                                                                   DTSCS17
02415      IF LCCM-NO-MSG                                               DTSCS17
02416          PERFORM S2100-CHECK-DUP-FEIN THRU S2100-EXIT.            DTSCS17
02417                                                                   DTSCS17
02418      IF LCCM-NO-MSG                                               DTSCS17
02419          PERFORM S2200-CHECK-WRITE-OFF THRU S2200-EXIT.           DTSCS17
02420                                                                   DTSCS17
02421      IF LCCM-NO-MSG                                               DTSCS17
02422          PERFORM S3100-CHECK-OVERLAP THRU S3100-EXIT.             DTSCS17
02423                                                                   DTSCS17
02424      IF LCCM-NO-MSG                                               DTSCS17
02425          PERFORM S3200-CHECK-RELATIONSHIPS THRU S3200-EXIT.       DTSCS17
02426                                                                   DTSCS17
02427      IF LCCM-NO-MSG                                               DTSCS17
02428          PERFORM S3300-CHECK-ORPHANS THRU S3300-EXIT.             DTSCS17
02429                                                                   DTSCS17
02430      IF LCCM-NO-MSG                                               DTSCS17
02431          SET WRK-DISPLAY-ERR-YES-88  TO TRUE                      DTSCS17
02432          PERFORM S3400-CHECK-MRTE    THRU S3400-EXIT.             DTSCS17
02433                                                                   DTSCS17
02434      PERFORM S1900-RESP-OP-ID THRU S1900-EXIT.                    DTSCS17
02435      SKIP3                                                        DTSCS17
02436  S1000-EXIT. EXIT.                                                DTSCS17
02437      EJECT                                                        DTSCS17
02438  S1100-EDIT-KEY.                                                  DTSCS17
02439      PERFORM S1101-EMP-NO              THRU S1101-EXIT.           DTSCS17
02440  S1100-EXIT. EXIT.                                                DTSCS17
02441 /*****************************************************************DTSCS17
02442 *                                                                 DTSCS17
02443 ******************************************************************DTSCS17
02444  S1101-EMP-NO.                                                    DTSCS17
02445      MOVE MAP-EMP-NO-AREA            TO L018-S-EMP-NO-AREA.       DTSCS17
02446      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS17
02447                                                                   DTSCS17
02448      IF L018-NO-ENTRY                                             DTSCS17
02449         MOVE EMSG-FIELD-REQUIRED     TO WRK-MSG-AREA              DTSCS17
02450         PERFORM S1199-ERROR          THRU S1199-EXIT              DTSCS17
02451         GO TO S1101-EXIT.                                         DTSCS17
02452                                                                   DTSCS17
02453      IF L018-NOT-VALID                                            DTSCS17
02454         MOVE EMSG-FIELD-NOT-VALID    TO WRK-MSG-AREA              DTSCS17
02455         PERFORM S1199-ERROR          THRU S1199-EXIT              DTSCS17
02456         GO TO S1101-EXIT.                                         DTSCS17
02457                                                                   DTSCS17
02458      MOVE L018-EMP-NO                TO WRK-EMP-NO.               DTSCS17
02459  S1101-EXIT. EXIT.                                                DTSCS17
02460      SKIP3                                                        DTSCS17
02461  S1110-READ-MPRF.                                                 DTSCS17
02462      MOVE LOW-VALUES TO MPRF-KEY-AREA.                            DTSCS17
02463      MOVE WRK-EMP-NO TO MPRF-EMP-NO.                              DTSCS17
02464      SET MPRF-PRF-88 TO TRUE.                                     DTSCS17
02465      MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS17
02466      PERFORM S810-READ THRU S810-EXIT.                            DTSCS17
02467      IF L810-NO-REC-88                                            DTSCS17
02468          MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA                    DTSCS17
02469          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS17
02470      ELSE                                                         DTSCS17
02471          MOVE MSKL-REC TO MPRF-REC                                DTSCS17
02472          SET WRK-MPRF-YES-88 TO TRUE.                             DTSCS17
02473  S1110-EXIT.                                                      DTSCS17
02474      EXIT.                                                        DTSCS17
02475      SKIP3                                                        DTSCS17
02476  S1120-READ-MSOL.                                                 DTSCS17
02477      MOVE LCCM-SCR17-HOLD-AREA TO MSKL-KEY-AREA.                  DTSCS17
02478      PERFORM S810-READ THRU S810-EXIT.                            DTSCS17
02479      IF L810-NO-REC-88                                            DTSCS17
02480          MOVE EMSG-NO-RECORD TO WRK-MSG-AREA                      DTSCS17
02481          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS17
02482      ELSE                                                         DTSCS17
02483          MOVE MSKL-REC TO MSOL-REC.                               DTSCS17
02484  S1120-EXIT.                                                      DTSCS17
02485      EXIT.                                                        DTSCS17
02486      SKIP3                                                        DTSCS17
02487  S1199-ERROR.                                                     DTSCS17
02488      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A            DTSCS17
02489                                         MAP-EMP-NO-2-A.           DTSCS17
02490      IF LCCM-NO-MSG                                               DTSCS17
02491         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS17
02492         MOVE CATB-CURSOR             TO MAP-EMP-NO-1-L            DTSCS17
02493         SET CURSOR-SET-YES TO TRUE.                               DTSCS17
02494  S1199-EXIT. EXIT.                                                DTSCS17
02495 /*****************************************************************DTSCS17
02496 *                                                                 DTSCS17
02497 ******************************************************************DTSCS17
02498  S1200-LIAB-DATE.                                                 DTSCS17
02499      MOVE ZEROS                      TO WRK-LIAB-DATE.            DTSCS17
02500      MOVE MAP-LIAB-DATE-AREA         TO L015-S-DATE-AREA.         DTSCS17
02501      PERFORM S015-DATE-FROM-SCREEN   THRU S015-EXIT.              DTSCS17
02502      IF L015-NO-ENTRY                                             DTSCS17
02503          MOVE EMSG-FIELD-REQUIRED  TO WRK-MSG-AREA                DTSCS17
02504          PERFORM S1201-ERROR       THRU S1201-EXIT                DTSCS17
02505      ELSE                                                         DTSCS17
02506      IF L015-NOT-VALID                                            DTSCS17
02507          MOVE EMSG-FIELD-NOT-VALID    TO WRK-MSG-AREA             DTSCS17
02508          PERFORM S1201-ERROR          THRU S1201-EXIT             DTSCS17
02509      ELSE                                                         DTSCS17
02510          IF L015-DATE > LCCM-CURR-RUN-DATE                        DTSCS17
02511             MOVE MSG-E17D-AREA TO WRK-MSG-AREA                    DTSCS17
02512             PERFORM S1201-ERROR   THRU S1201-EXIT                 DTSCS17
02513          ELSE                                                     DTSCS17
02514             MOVE L015-DATE TO WRK-LIAB-DATE                       DTSCS17
02515             IF L015-DATE = MSOL-LIAB-DATE                         DTSCS17
02516                 NEXT SENTENCE                                     DTSCS17
02517             ELSE                                                  DTSCS17
02518                 MOVE L015-DATE           TO MSOL-LIAB-DATE        DTSCS17
02519                 MOVE MSOL-KEY-AREA       TO MSKL-KEY-AREA         DTSCS17
02520                 PERFORM S810-READ        THRU S810-EXIT           DTSCS17
02521                 IF L810-OK-88                                     DTSCS17
02522                     MOVE MSG-E171-AREA TO WRK-MSG-AREA            DTSCS17
02523                     PERFORM S1201-ERROR   THRU S1201-EXIT.        DTSCS17
02524  S1200-EXIT. EXIT.                                                DTSCS17
02525                                                                   DTSCS17
02526  S1201-ERROR.                                                     DTSCS17
02527      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-LIAB-MO-A             DTSCS17
02528                                         MAP-LIAB-DA-A             DTSCS17
02529                                         MAP-LIAB-YR-A.            DTSCS17
02530      IF LCCM-NO-MSG                                               DTSCS17
02531         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS17
02532         MOVE CATB-CURSOR             TO MAP-LIAB-MO-L             DTSCS17
02533         SET CURSOR-SET-YES TO TRUE.                               DTSCS17
02534  S1201-EXIT. EXIT.                                                DTSCS17
02535 /*****************************************************************DTSCS17
02536 *                                                                *DTSCS17
02537 ******************************************************************DTSCS17
02538  S1300-LIAB-ESTB-DATE.                                            DTSCS17
02539      MOVE MAP-LIAB-ESTB-DATE-AREA    TO L015-S-DATE-AREA.         DTSCS17
02540      PERFORM S015-DATE-FROM-SCREEN   THRU S015-EXIT.              DTSCS17
02541      IF L015-NO-ENTRY                                             DTSCS17
02542          MOVE EMSG-FIELD-REQUIRED  TO WRK-MSG-AREA                DTSCS17
02543          PERFORM S1301-ERROR       THRU S1301-EXIT                DTSCS17
02544      ELSE                                                         DTSCS17
02545      IF L015-NOT-VALID                                            DTSCS17
02546         MOVE EMSG-FIELD-NOT-VALID    TO WRK-MSG-AREA              DTSCS17
02547         PERFORM S1301-ERROR          THRU S1301-EXIT              DTSCS17
02548      ELSE                                                         DTSCS17
02549         IF L015-DATE > LCCM-CURR-RUN-DATE                         DTSCS17
02550            MOVE MSG-E17E-AREA TO WRK-MSG-AREA                     DTSCS17
02551            PERFORM S1301-ERROR   THRU S1301-EXIT                  DTSCS17
02552         ELSE                                                      DTSCS17
02553         IF L015-DATE = WRK-LIAB-DATE                              DTSCS17
02554            NEXT SENTENCE                                          DTSCS17
02555         ELSE                                                      DTSCS17
02556            MOVE EMSG-CROSS-EDIT         TO WRK-MSG-AREA           DTSCS17
02557            PERFORM S1301-ERROR          THRU S1301-EXIT           DTSCS17
02558            PERFORM S1201-ERROR          THRU S1201-EXIT.          DTSCS17
02559  S1300-EXIT. EXIT.                                                DTSCS17
02560      SKIP3                                                        DTSCS17
02561  S1301-ERROR.                                                     DTSCS17
02562      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-LIAB-ESTB-MO-A        DTSCS17
02563                                         MAP-LIAB-ESTB-DA-A        DTSCS17
02564                                         MAP-LIAB-ESTB-YR-A        DTSCS17
02565      IF LCCM-NO-MSG                                               DTSCS17
02566         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS17
02567         MOVE CATB-CURSOR             TO MAP-LIAB-ESTB-MO-L        DTSCS17
02568         SET CURSOR-SET-YES TO TRUE.                               DTSCS17
02569  S1301-EXIT. EXIT.                                                DTSCS17
02570 /*****************************************************************DTSCS17
02571 *                                                                *DTSCS17
02572 ******************************************************************DTSCS17
02573  S1400-LIAB-CD.                                                   DTSCS17
02574      IF MAP-LIAB-CD = LOW-VALUES                                  DTSCS17
02575          MOVE SPACES TO MAP-LIAB-CD.                              DTSCS17
02576                                                                   DTSCS17
02577      IF MAP-LIAB-CD = SPACES                                      DTSCS17
02578          MOVE EMSG-FIELD-REQUIRED     TO WRK-MSG-AREA             DTSCS17
02579          PERFORM S1401-ERROR          THRU S1401-EXIT             DTSCS17
02580      ELSE                                                         DTSCS17
02581         MOVE MAP-LIAB-CD             TO L031-CD                   DTSCS17
02582         SET L031-MSOL-LIAB-CD        TO TRUE                      DTSCS17
02583         PERFORM S031-REG-CODES       THRU S031-EXIT               DTSCS17
02584         IF L031-NOT-VALID                                         DTSCS17
02585            MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA              DTSCS17
02586            PERFORM S1401-ERROR       THRU S1401-EXIT              DTSCS17
02587         ELSE                                                      DTSCS17
02588 ***********MOVE LCCM-EMP-NO          TO L201-EMP-NO               DTSCS17
02589            MOVE MAP-LIAB-CD          TO L201-LIAB-CD              DTSCS17
02590            PERFORM S201-DETER-EMP-CLASS THRU S201-EXIT            DTSCS17
02591            IF MPRF-EMP-CLASS NOT EQUAL L201-EMP-CLASS             DTSCS17
02592                PERFORM S1410-CHECK-CLASS-CHNG THRU S1410-EXIT.    DTSCS17
02593  S1400-EXIT. EXIT.                                                DTSCS17
02594      SKIP3                                                        DTSCS17
02595  S1401-ERROR.                                                     DTSCS17
02596      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-LIAB-CD-A.            DTSCS17
02597      IF LCCM-NO-MSG                                               DTSCS17
02598         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS17
02599         MOVE CATB-CURSOR             TO MAP-LIAB-CD-L             DTSCS17
02600         SET CURSOR-SET-YES TO TRUE.                               DTSCS17
02601  S1401-EXIT. EXIT.                                                DTSCS17
02602      SKIP3                                                        DTSCS17
02603  S1410-CHECK-CLASS-CHNG.                                          DTSCS17
02604      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSCS17
02605      MOVE WRK-EMP-NO TO MSKL-EMP-NO.                              DTSCS17
02606      SET MSKL-SOL-88 TO TRUE.                                     DTSCS17
02607      PERFORM S810-COUNT THRU S810-EXIT.                           DTSCS17
02608      IF L810-RECORD-CNT > +1                                      DTSCS17
02609          MOVE MSG-E177-AREA TO WRK-MSG-AREA                       DTSCS17
02610          PERFORM S1401-ERROR THRU S1401-EXIT                      DTSCS17
02611          GO TO S1410-EXIT.                                        DTSCS17
02612                                                                   DTSCS17
02613      SET MSKL-RTE-88 TO TRUE.                                     DTSCS17
02614      PERFORM S810-COUNT THRU S810-EXIT.                           DTSCS17
02615      IF L810-RECORD-CNT > +0                                      DTSCS17
02616          MOVE MSG-E177-AREA TO WRK-MSG-AREA                       DTSCS17
02617          PERFORM S1401-ERROR THRU S1401-EXIT                      DTSCS17
02618          GO TO S1410-EXIT.                                        DTSCS17
02619                                                                   DTSCS17
02620      SET MSKL-RPT-88 TO TRUE.                                     DTSCS17
02621      PERFORM S810-COUNT THRU S810-EXIT.                           DTSCS17
02622      IF L810-RECORD-CNT > +0                                      DTSCS17
02623          MOVE MSG-E177-AREA TO WRK-MSG-AREA                       DTSCS17
02624          PERFORM S1401-ERROR THRU S1401-EXIT                      DTSCS17
02625          GO TO S1410-EXIT.                                        DTSCS17
02626                                                                   DTSCS17
02627      SET MSKL-PAY-88 TO TRUE.                                     DTSCS17
02628      PERFORM S810-COUNT THRU S810-EXIT.                           DTSCS17
02629      IF L810-RECORD-CNT > +0                                      DTSCS17
02630          MOVE MSG-E177-AREA TO WRK-MSG-AREA                       DTSCS17
02631          PERFORM S1401-ERROR THRU S1401-EXIT                      DTSCS17
02632          GO TO S1410-EXIT.                                        DTSCS17
02633                                                                   DTSCS17
02634      SET MSKL-ADJ-88 TO TRUE.                                     DTSCS17
02635      PERFORM S810-COUNT THRU S810-EXIT.                           DTSCS17
02636      IF L810-RECORD-CNT > +0                                      DTSCS17
02637          MOVE MSG-E177-AREA TO WRK-MSG-AREA                       DTSCS17
02638          PERFORM S1401-ERROR THRU S1401-EXIT                      DTSCS17
02639          GO TO S1410-EXIT.                                        DTSCS17
02640                                                                   DTSCS17
02641      MOVE LOW-VALUES TO IPES-REC.                                 DTSCS17
02642      SET IPES-PES-88 TO TRUE.                                     DTSCS17
02643      MOVE WRK-EMP-NO TO IPES-PRED-EMP-NO.                         DTSCS17
02644      MOVE IPES-KEY-AREA TO ISKL-KEY-AREA.                         DTSCS17
02645      PERFORM S821-START-BROWSE THRU S821-EXIT.                    DTSCS17
02646      PERFORM S1411-BROWSE-IPES THRU S1411-EXIT                    DTSCS17
02647          UNTIL L821-NO-REC-88.                                    DTSCS17
02648      PERFORM S821-END-BROWSE THRU S821-EXIT.                      DTSCS17
02649                                                                   DTSCS17
02650      IF LCCM-MSG                                                  DTSCS17
02651          GO TO S1410-EXIT.                                        DTSCS17
02652                                                                   DTSCS17
02653      MOVE LOW-VALUES TO MREL-KEY-AREA.                            DTSCS17
02654      MOVE WRK-EMP-NO TO MREL-EMP-NO.                              DTSCS17
02655      SET MREL-REL-88 TO TRUE.                                     DTSCS17
02656      MOVE +0 TO MREL-EFF-DATE                                     DTSCS17
02657                 MREL-PRED-EMP-NO.                                 DTSCS17
02658      MOVE MREL-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS17
02659      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS17
02660      PERFORM S1412-BROWSE-MREL THRU S1412-EXIT                    DTSCS17
02661          UNTIL L810-NO-REC-88.                                    DTSCS17
02662                                                                   DTSCS17
02663      IF LCCM-MSG                                                  DTSCS17
02664          GO TO S1410-EXIT.                                        DTSCS17
02665                                                                   DTSCS17
02666      IF MAP-OVERRIDE-YES-88                                       DTSCS17
02667          GO TO S1410-EXIT.                                        DTSCS17
02668                                                                   DTSCS17
02669      MOVE MSG-E176-AREA TO WRK-MSG-AREA.                          DTSCS17
02670      PERFORM S1801-ERROR THRU S1801-EXIT.                         DTSCS17
02671  S1410-EXIT.                                                      DTSCS17
02672      EXIT.                                                        DTSCS17
02673      SKIP3                                                        DTSCS17
02674  S1411-BROWSE-IPES.                                               DTSCS17
02675      MOVE ISKL-REC TO IPES-REC.                                   DTSCS17
02676      IF IPES-PRED-EMP-NO = WRK-EMP-NO                             DTSCS17
02677          NEXT SENTENCE                                            DTSCS17
02678      ELSE                                                         DTSCS17
02679          SET L821-NO-REC-88 TO TRUE                               DTSCS17
02680          GO TO S1411-EXIT.                                        DTSCS17
02681                                                                   DTSCS17
02682      IF IPES-EXP-TRNSF-NO-88                                      DTSCS17
02683          NEXT SENTENCE                                            DTSCS17
02684      ELSE                                                         DTSCS17
02685          MOVE MSG-E177-AREA TO WRK-MSG-AREA                       DTSCS17
02686          PERFORM S1401-ERROR THRU S1401-EXIT.                     DTSCS17
02687                                                                   DTSCS17
02688      PERFORM S821-READ-NEXT THRU S821-EXIT.                       DTSCS17
02689  S1411-EXIT.                                                      DTSCS17
02690      EXIT.                                                        DTSCS17
02691      SKIP3                                                        DTSCS17
02692  S1412-BROWSE-MREL.                                               DTSCS17
02693      MOVE MSKL-REC TO MREL-REC.                                   DTSCS17
02694 *****IF MREL-EXP-NOT-88                                           DTSCS17
02695      IF MREL-EXP-TRNSF-NO-88                                      DTSCS17
02696          NEXT SENTENCE                                            DTSCS17
02697      ELSE                                                         DTSCS17
02698          MOVE MSG-E177-AREA TO WRK-MSG-AREA                       DTSCS17
02699          PERFORM S1401-ERROR THRU S1401-EXIT.                     DTSCS17
02700                                                                   DTSCS17
02701      PERFORM S810-READ-NEXT THRU S810-EXIT.                       DTSCS17
02702  S1412-EXIT.                                                      DTSCS17
02703      EXIT.                                                        DTSCS17
02704 /*****************************************************************DTSCS17
02705 *                                                                 DTSCS17
02706 ******************************************************************DTSCS17
02707  S1500-INACT-DATE.                                                DTSCS17
02708      MOVE ALL-NINES-DATE TO WRK-INACT-DATE.                       DTSCS17
02709                                                                   DTSCS17
02710      MOVE MAP-INACT-DATE-AREA        TO L015-S-DATE-AREA.         DTSCS17
02711      PERFORM S015-DATE-FROM-SCREEN   THRU S015-EXIT.              DTSCS17
02712      IF L015-NO-ENTRY                                             DTSCS17
02713          IF (MSOL-INACT-INACTIVE-88)                              DTSCS17
02714                 AND                                               DTSCS17
02715             (MPRF-STATUS-ACT-88)                                  DTSCS17
02716              MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA             DTSCS17
02717              PERFORM S1501-ERROR THRU S1501-EXIT                  DTSCS17
02718          ELSE                                                     DTSCS17
02719              NEXT SENTENCE                                        DTSCS17
02720      ELSE                                                         DTSCS17
02721      IF L015-NOT-VALID                                            DTSCS17
02722         MOVE EMSG-FIELD-NOT-VALID    TO WRK-MSG-AREA              DTSCS17
02723         PERFORM S1501-ERROR          THRU S1501-EXIT              DTSCS17
02724      ELSE                                                         DTSCS17
02725      IF L015-DATE < WRK-LIAB-DATE                                 DTSCS17
02726         MOVE EMSG-FIELD-NOT-VALID    TO WRK-MSG-AREA              DTSCS17
02727         PERFORM S1501-ERROR          THRU S1501-EXIT              DTSCS17
02728      ELSE                                                         DTSCS17
02729         MOVE L015-DATE TO WRK-INACT-DATE.                         DTSCS17
02730  S1500-EXIT. EXIT.                                                DTSCS17
02731      SKIP3                                                        DTSCS17
02732  S1501-ERROR.                                                     DTSCS17
02733      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-INACT-MO-A            DTSCS17
02734                                         MAP-INACT-DA-A            DTSCS17
02735                                         MAP-INACT-YR-A            DTSCS17
02736      IF LCCM-NO-MSG                                               DTSCS17
02737         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS17
02738         MOVE CATB-CURSOR             TO MAP-INACT-MO-L            DTSCS17
02739         SET CURSOR-SET-YES TO TRUE.                               DTSCS17
02740  S1501-EXIT. EXIT.                                                DTSCS17
02741 /*****************************************************************DTSCS17
02742 *                                                                *DTSCS17
02743 ******************************************************************DTSCS17
02744  S1600-INACT-CD.                                                  DTSCS17
02745      IF MAP-INACT-CD = LOW-VALUES                                 DTSCS17
02746          MOVE SPACES TO MAP-INACT-CD.                             DTSCS17
02747                                                                   DTSCS17
02748      MOVE MAP-INACT-CD TO WRK-INACT-CD.                           DTSCS17
02749                                                                   DTSCS17
02750      IF MAP-INACT-CD = SPACES                                     DTSCS17
02751          IF WRK-INACT-DATE = ALL-NINES-DATE                       DTSCS17
02752              NEXT SENTENCE                                        DTSCS17
02753          ELSE                                                     DTSCS17
02754              MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA             DTSCS17
02755              PERFORM S1601-ERROR THRU S1601-EXIT                  DTSCS17
02756      ELSE                                                         DTSCS17
02757      IF WRK-INACT-DATE = ALL-NINES-DATE                           DTSCS17
02758         MOVE EMSG-FIELD-NOT-ALLOWED  TO WRK-MSG-AREA              DTSCS17
02759         PERFORM S1601-ERROR          THRU S1601-EXIT              DTSCS17
02760      ELSE                                                         DTSCS17
02761         MOVE MAP-INACT-CD            TO L031-CD                   DTSCS17
02762         SET L031-MSOL-INACT-CD       TO TRUE                      DTSCS17
02763         PERFORM S031-REG-CODES       THRU S031-EXIT               DTSCS17
02764         IF L031-NOT-VALID                                         DTSCS17
02765            MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA              DTSCS17
02766            PERFORM S1601-ERROR       THRU S1601-EXIT              DTSCS17
02767         ELSE                                                      DTSCS17
02768            IF MAP-INACT-CD = '04' OR '05'                         DTSCS17
02769               IF WRK-LIAB-DATE = WRK-INACT-DATE                   DTSCS17
02770                  NEXT SENTENCE                                    DTSCS17
02771               ELSE                                                DTSCS17
02772                  MOVE MSG-E17F-AREA TO WRK-MSG-AREA               DTSCS17
02773                  PERFORM S1601-ERROR       THRU S1601-EXIT.       DTSCS17
02774  S1600-EXIT. EXIT.                                                DTSCS17
02775      SKIP3                                                        DTSCS17
02776  S1601-ERROR.                                                     DTSCS17
02777      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-INACT-CD-A.           DTSCS17
02778      IF LCCM-NO-MSG                                               DTSCS17
02779         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS17
02780         MOVE CATB-CURSOR             TO MAP-INACT-CD-L            DTSCS17
02781         SET CURSOR-SET-YES TO TRUE.                               DTSCS17
02782  S1601-EXIT. EXIT.                                                DTSCS17
02783 /*****************************************************************DTSCS17
02784 *                                                                 DTSCS17
02785 ******************************************************************DTSCS17
02786  S1710-INACT-LTR-TYPE.                                            DTSCS17
02787      IF MAP-INACT-LTR-TYPE = LOW-VALUES                           DTSCS17
02788          MOVE SPACES TO MAP-INACT-LTR-TYPE.                       DTSCS17
02789                                                                   DTSCS17
02790      IF (MSOL-INACT-ACTIVE-88)                                    DTSCS17
02791             AND                                                   DTSCS17
02792         (MAP-INACT-CD NOT = SPACES)                               DTSCS17
02793          NEXT SENTENCE                                            DTSCS17
02794      ELSE                                                         DTSCS17
02795          IF MAP-INACT-LTR-TYPE = SPACES                           DTSCS17
02796              GO TO S1710-EXIT                                     DTSCS17
02797          ELSE                                                     DTSCS17
02798              MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA          DTSCS17
02799              PERFORM S1711-ERROR THRU S1711-EXIT                  DTSCS17
02800              GO TO S1710-EXIT.                                    DTSCS17
02801                                                                   DTSCS17
02802      IF MAP-INACT-LTR-TYPE = SPACES                               DTSCS17
02803 *********SET MAP-INACT-LTR-DEFAULT-88 TO TRUE                     DTSCS17
02804          MOVE EMSG-FIELD-REQUIRED    TO WRK-MSG-AREA              DTSCS17
02805          PERFORM S1711-ERROR THRU S1711-EXIT                      DTSCS17
02806          GO TO S1710-EXIT                                         DTSCS17
02807      ELSE                                                         DTSCS17
02808          IF MAP-INACT-LTR-VALID-88                                DTSCS17
02809              NEXT SENTENCE                                        DTSCS17
02810          ELSE                                                     DTSCS17
02811              MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA            DTSCS17
02812              PERFORM S1711-ERROR THRU S1711-EXIT.                 DTSCS17
02813  S1710-EXIT.                                                      DTSCS17
02814      EXIT.                                                        DTSCS17
02815      SKIP3                                                        DTSCS17
02816  S1711-ERROR.                                                     DTSCS17
02817      MOVE CATB-UNPROT-NORM-AN-MDTON  TO MAP-INACT-LTR-TYPE-A.     DTSCS17
02818      IF LCCM-NO-MSG                                               DTSCS17
02819         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS17
02820         MOVE CATB-CURSOR             TO MAP-INACT-LTR-TYPE-L      DTSCS17
02821         SET CURSOR-SET-YES TO TRUE.                               DTSCS17
02822  S1711-EXIT. EXIT.                                                DTSCS17
02823 /*****************************************************************DTSCS17
02824 *                                                                 DTSCS17
02825 ******************************************************************DTSCS17
02826  S1720-TRANSFER-IND.                                              DTSCS17
02827      IF MAP-TRANSFER-IND = LOW-VALUES                             DTSCS17
02828          SET MAP-TRANSFER-NA-88 TO TRUE.                          DTSCS17
02829                                                                   DTSCS17
02830      IF MAP-TRANSFER-VALID-88                                     DTSCS17
02831          NEXT SENTENCE                                            DTSCS17
02832      ELSE                                                         DTSCS17
02833          MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS17
02834          PERFORM S1721-ERROR THRU S1721-EXIT.                     DTSCS17
02835  S1720-EXIT.                                                      DTSCS17
02836      EXIT.                                                        DTSCS17
02837      SKIP3                                                        DTSCS17
02838  S1721-ERROR.                                                     DTSCS17
02839      MOVE CATB-UNPROT-NORM-AN-MDTON  TO MAP-TRANSFER-IND-A.       DTSCS17
02840      IF LCCM-NO-MSG                                               DTSCS17
02841         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS17
02842         MOVE CATB-CURSOR             TO MAP-TRANSFER-IND-L        DTSCS17
02843         SET CURSOR-SET-YES TO TRUE.                               DTSCS17
02844  S1721-EXIT. EXIT.                                                DTSCS17
02845 /*****************************************************************DTSCS17
02846 *                                                                 DTSCS17
02847 ******************************************************************DTSCS17
02848  S1730-TRANSFER-EMP-NO.                                           DTSCS17
02849      MOVE MAP-TRANSFER-EMP-NO-AREA TO L018-S-EMP-NO-AREA.         DTSCS17
02850      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS17
02851                                                                   DTSCS17
02852      IF L018-NO-ENTRY                                             DTSCS17
02853          IF MAP-TRANSFER-YES-88                                   DTSCS17
02854              MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA             DTSCS17
02855              PERFORM S1731-ERROR THRU S1731-EXIT                  DTSCS17
02856              GO TO S1730-EXIT                                     DTSCS17
02857          ELSE                                                     DTSCS17
02858              GO TO S1730-EXIT                                     DTSCS17
02859      ELSE                                                         DTSCS17
02860      IF L018-NOT-VALID                                            DTSCS17
02861          IF MAP-TRANSFER-YES-88                                   DTSCS17
02862              MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA            DTSCS17
02863              PERFORM S1731-ERROR THRU S1731-EXIT                  DTSCS17
02864              GO TO S1730-EXIT                                     DTSCS17
02865          ELSE                                                     DTSCS17
02866              MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA          DTSCS17
02867              PERFORM S1731-ERROR THRU S1731-EXIT                  DTSCS17
02868              GO TO S1730-EXIT                                     DTSCS17
02869      ELSE                                                         DTSCS17
02870          IF MAP-TRANSFER-YES-88                                   DTSCS17
02871              NEXT SENTENCE                                        DTSCS17
02872          ELSE                                                     DTSCS17
02873              MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA          DTSCS17
02874              PERFORM S1731-ERROR THRU S1731-EXIT                  DTSCS17
02875              GO TO S1730-EXIT.                                    DTSCS17
02876                                                                   DTSCS17
02877      IF L018-EMP-NO = WRK-EMP-NO                                  DTSCS17
02878          MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA                     DTSCS17
02879          PERFORM S1731-ERROR THRU S1731-EXIT                      DTSCS17
02880          PERFORM S1199-ERROR THRU S1199-EXIT                      DTSCS17
02881          GO TO S1730-EXIT.                                        DTSCS17
02882                                                                   DTSCS17
02883      MOVE L018-EMP-NO TO WRK-TRANSFER-EMP-NO.                     DTSCS17
02884                                                                   DTSCS17
02885      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSCS17
02886      MOVE WRK-TRANSFER-EMP-NO TO MSKL-EMP-NO.                     DTSCS17
02887      SET MSKL-PRF-88 TO TRUE.                                     DTSCS17
02888      PERFORM S810-READ THRU S810-EXIT.                            DTSCS17
02889      IF L810-NO-REC-88                                            DTSCS17
02890          MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA                    DTSCS17
02891          PERFORM S1731-ERROR THRU S1731-EXIT                      DTSCS17
02892          GO TO S1730-EXIT.                                        DTSCS17
02893                                                                   DTSCS17
02894      MOVE MSKL-REC TO MPRF-REC.                                   DTSCS17
02895                                                                   DTSCS17
02896      IF MPRF-CLASS-SUB-88                                         DTSCS17
02897          NEXT SENTENCE                                            DTSCS17
02898      ELSE                                                         DTSCS17
02899          MOVE MSG-E178-AREA TO WRK-MSG-AREA                       DTSCS17
02900          PERFORM S1731-ERROR THRU S1731-EXIT.                     DTSCS17
02901                                                                   DTSCS17
02902      PERFORM S1110-READ-MPRF THRU S1110-EXIT.                     DTSCS17
02903  S1730-EXIT.                                                      DTSCS17
02904      EXIT.                                                        DTSCS17
02905      SKIP3                                                        DTSCS17
02906  S1731-ERROR.                                                     DTSCS17
02907      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-TRANSFER-EMP-NO-1-A   DTSCS17
02908                                         MAP-TRANSFER-EMP-NO-2-A.  DTSCS17
02909      IF LCCM-NO-MSG                                               DTSCS17
02910         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS17
02911         MOVE CATB-CURSOR             TO MAP-TRANSFER-EMP-NO-1-L   DTSCS17
02912         SET CURSOR-SET-YES TO TRUE.                               DTSCS17
02913  S1731-EXIT. EXIT.                                                DTSCS17
02914 /*****************************************************************DTSCS17
02915 *                                                                 DTSCS17
02916 ******************************************************************DTSCS17
02917  S1800-OVERRIDE-IND.                                              DTSCS17
02918      IF MAP-OVERRIDE-IND = LOW-VALUES                             DTSCS17
02919          MOVE SPACES TO MAP-OVERRIDE-IND.                         DTSCS17
02920                                                                   DTSCS17
02921      IF MAP-OVERRIDE-IND = SPACES OR MAP-OVERRIDE-VALID-88        DTSCS17
02922          NEXT SENTENCE                                            DTSCS17
02923      ELSE                                                         DTSCS17
02924          MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS17
02925          PERFORM S1801-ERROR       THRU S1801-EXIT.               DTSCS17
02926  S1800-EXIT. EXIT.                                                DTSCS17
02927      SKIP3                                                        DTSCS17
02928  S1801-ERROR.                                                     DTSCS17
02929      MOVE CATB-UNPROT-NORM-AN-MDTON  TO MAP-OVERRIDE-IND-A.       DTSCS17
02930      IF LCCM-NO-MSG                                               DTSCS17
02931         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS17
02932         MOVE CATB-CURSOR             TO MAP-OVERRIDE-IND-L        DTSCS17
02933         SET CURSOR-SET-YES TO TRUE.                               DTSCS17
02934  S1801-EXIT. EXIT.                                                DTSCS17
02935 /*****************************************************************DTSCS17
02936 *                                                                 DTSCS17
02937 ******************************************************************DTSCS17
02938  S1900-RESP-OP-ID.                                                DTSCS17
02939 ** MODIFIED TO SET RESP-OP-ID TO USER CURRENTLY SIGNED ON,        DTSCS17
02940 ** UNLESS USER HAS SET MAP-RESP-OP-ID.                            DTSCS17
02941 ** REQUEST FROM STATUS UNIT. 12/09/2002  GD                       DTSCS17
02942                                                                   DTSCS17
02943      IF MAP-RESP-OP-ID = LOW-VALUES OR SPACES                     DTSCS17
02944 ******** MOVE LCCM-RESP-OP-ID TO MAP-RESP-OP-ID.                  DTSCS17
02945          MOVE LCCM-OP-ID      TO MAP-RESP-OP-ID.                  DTSCS17
02946                                                                   DTSCS17
02947      IF MAP-RESP-OP-ID = LCCM-OP-ID                               DTSCS17
02948          MOVE MAP-RESP-OP-ID TO LCCM-RESP-OP-ID                   DTSCS17
02949          GO TO S1900-EXIT.                                        DTSCS17
02950                                                                   DTSCS17
02951      MOVE MAP-RESP-OP-ID TO L082-OP-ID.                           DTSCS17
02952      PERFORM S082-OP-ID-LOOKUP THRU S082-EXIT.                    DTSCS17
02953      IF (L082-VALID-OP) AND (L082-EXTERNAL-88)                    DTSCS17
02954          MOVE MAP-RESP-OP-ID TO LCCM-RESP-OP-ID                   DTSCS17
02955      ELSE                                                         DTSCS17
02956          MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS17
02957          PERFORM S1901-ERROR THRU S1901-EXIT.                     DTSCS17
02958  S1900-EXIT. EXIT.                                                DTSCS17
02959      SKIP3                                                        DTSCS17
02960  S1901-ERROR.                                                     DTSCS17
02961      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-RESP-OP-ID-A.          DTSCS17
02962      IF LCCM-NO-MSG                                               DTSCS17
02963         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS17
02964         MOVE CATB-CURSOR             TO MAP-RESP-OP-ID-L          DTSCS17
02965         SET CURSOR-SET-YES TO TRUE.                               DTSCS17
02966  S1901-EXIT. EXIT.                                                DTSCS17
02967 /*****************************************************************DTSCS17
02968 *                                                                *DTSCS17
02969 ******************************************************************DTSCS17
02970  S2100-CHECK-DUP-FEIN.                                            DTSCS17
02971      IF MPRF-FEIN = +0                                            DTSCS17
02972          GO TO S2100-EXIT.                                        DTSCS17
02973                                                                   DTSCS17
02974      IF (MPRF-STATUS-INACT-88)                                    DTSCS17
02975            AND                                                    DTSCS17
02976         (WRK-INACT-DATE = ALL-NINES-DATE)                         DTSCS17
02977          NEXT SENTENCE                                            DTSCS17
02978      ELSE                                                         DTSCS17
02979          GO TO S2100-EXIT.                                        DTSCS17
02980                                                                   DTSCS17
02981      SET L074-ACTIVE-DUP-88 TO TRUE.                              DTSCS17
02982      MOVE WRK-EMP-NO TO L074-EMP-NO.                              DTSCS17
02983      MOVE MPRF-FEIN TO L074-FEIN.                                 DTSCS17
02984      MOVE +0 TO L074-INACTIVE-EMP-NO.                             DTSCS17
02985      PERFORM S074-DUP-FEIN-EDIT THRU S074-EXIT.                   DTSCS17
02986      IF L074-DUP-NOT-OK-88                                        DTSCS17
02987           MOVE EMSG-DUPLICATE-FEIN TO WRK-MSG-AREA                DTSCS17
02988           PERFORM S1501-ERROR THRU S1501-EXIT.                    DTSCS17
02989  S2100-EXIT.                                                      DTSCS17
02990      EXIT.                                                        DTSCS17
02991 /*****************************************************************DTSCS17
02992 *                                                                *DTSCS17
02993 ******************************************************************DTSCS17
02994  S2200-CHECK-WRITE-OFF.                                           DTSCS17
02995      IF MPRF-NOT-WRITTEN-OFF-88                                   DTSCS17
02996          NEXT SENTENCE                                            DTSCS17
02997      ELSE                                                         DTSCS17
02998          MOVE EMSG-EMP-WRITTEN-OFF TO WRK-MSG-AREA                DTSCS17
02999          PERFORM S1199-ERROR THRU S1199-EXIT.                     DTSCS17
03000  S2200-EXIT.                                                      DTSCS17
03001      EXIT.                                                        DTSCS17
03002 /*****************************************************************DTSCS17
03003 *                                                                *DTSCS17
03004 ******************************************************************DTSCS17
03005  S3100-CHECK-OVERLAP.                                             DTSCS17
03006      MOVE MAP-INACT-CD TO MSOL-INACT-CD.                          DTSCS17
03007      IF MSOL-INACT-WITHDRAWN-88                                   DTSCS17
03008          GO TO S3100-EXIT.                                        DTSCS17
03009                                                                   DTSCS17
03010      MOVE LCCM-SCR17-HOLD-AREA TO SCR-REC-KEY-AREA.               DTSCS17
03011                                                                   DTSCS17
03012      MOVE LOW-VALUES TO MSOL-KEY-AREA.                            DTSCS17
03013      MOVE WRK-EMP-NO TO MSOL-EMP-NO.                              DTSCS17
03014      SET MSOL-SOL-88 TO TRUE.                                     DTSCS17
03015      MOVE ZEROS TO MSOL-LIAB-DATE.                                DTSCS17
03016      MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS17
03017      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS17
03018      PERFORM S3110-COMPARE THRU S3110-EXIT                        DTSCS17
03019        UNTIL L810-NO-REC-88.                                      DTSCS17
03020                                                                   DTSCS17
03021 *****IF LCCM-MSG                                                  DTSCS17
03022 *****    GO TO S3100-EXIT.                                        DTSCS17
03023 *****                                                             DTSCS17
03024 *****MOVE LOW-VALUES TO MCOL-KEY-AREA.                            DTSCS17
03025 *****MOVE WRK-EMP-NO TO MCOL-EMP-NO.                              DTSCS17
03026 *****SET MCOL-COL-88 TO TRUE.                                     DTSCS17
03027 *****MOVE MCOL-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS17
03028 *****PERFORM S810-READ THRU S810-EXIT.                            DTSCS17
03029 *****IF L810-NO-REC-88                                            DTSCS17
03030 *****    GO TO S3100-EXIT.                                        DTSCS17
03031 *****MOVE MSKL-REC TO MCOL-REC.                                   DTSCS17
03032 *****                                                             DTSCS17
03033 *****IF MCOL-BNK-NOT-BANKRUPT-88                                  DTSCS17
03034 *****    GO TO S3100-EXIT.                                        DTSCS17
03035 *****                                                             DTSCS17
03036 *****MOVE ALL-NINES-DATE TO WRK-BNK-END-DATE.                     DTSCS17
03037 *****IF MCOL-BNK-DISCHRG-CLOSE-DATE NOT = +0                      DTSCS17
03038 *****    MOVE MCOL-BNK-DISCHRG-CLOSE-DATE TO WRK-BNK-END-DATE     DTSCS17
03039 *****ELSE                                                         DTSCS17
03040 *****IF MCOL-BNK-DISMISS-DATE NOT = +0                            DTSCS17
03041 *****    MOVE MCOL-BNK-DISMISS-DATE TO WRK-BNK-END-DATE.          DTSCS17
03042 *****                                                             DTSCS17
03043 *****IF (WRK-INACT-DATE < MCOL-BNK-PETITION-DATE)                 DTSCS17
03044 *****        OR                                                   DTSCS17
03045 *****   (WRK-LIAB-DATE > WRK-BNK-END-DATE)                        DTSCS17
03046 *****    NEXT SENTENCE                                            DTSCS17
03047 *****ELSE                                                         DTSCS17
03048 *****    MOVE MSG-E172-AREA TO WRK-MSG-AREA                       DTSCS17
03049 *****    PERFORM S1201-ERROR THRU S1201-EXIT                      DTSCS17
03050 *****    PERFORM S1501-ERROR THRU S1501-EXIT.                     DTSCS17
03051                                                                   DTSCS17
03052 *****IF LCCM-MSG                                                  DTSCS17
03053 *****    GO TO S3100-EXIT.                                        DTSCS17
03054                                                                   DTSCS17
03055 *****IF (WRK-INACT-DATE = ALL-NINES-DATE)                         DTSCS17
03056 *****      AND                                                    DTSCS17
03057 *****   (WRK-BNK-END-DATE = ALL-NINES-DATE)                       DTSCS17
03058 *****    MOVE MSG-E173-AREA TO WRK-MSG-AREA                       DTSCS17
03059 *****    PERFORM S1501-ERROR THRU S1501-EXIT.                     DTSCS17
03060  S3100-EXIT. EXIT.                                                DTSCS17
03061      SKIP3                                                        DTSCS17
03062  S3110-COMPARE.                                                   DTSCS17
03063      MOVE MSKL-REC TO MSOL-REC.                                   DTSCS17
03064      IF MSOL-KEY-AREA = SCR-REC-KEY-AREA                          DTSCS17
03065          NEXT SENTENCE                                            DTSCS17
03066      ELSE                                                         DTSCS17
03067      IF MSOL-INACT-WITHDRAWN-88                                   DTSCS17
03068         NEXT SENTENCE                                             DTSCS17
03069      ELSE                                                         DTSCS17
03070         IF WRK-INACT-DATE < MSOL-LIAB-DATE                        DTSCS17
03071             OR WRK-LIAB-DATE > MSOL-INACT-DATE                    DTSCS17
03072            NEXT SENTENCE                                          DTSCS17
03073         ELSE                                                      DTSCS17
03074            MOVE MSG-E171-AREA TO WRK-MSG-AREA                     DTSCS17
03075            PERFORM S1201-ERROR THRU S1201-EXIT                    DTSCS17
03076            PERFORM S1501-ERROR THRU S1501-EXIT.                   DTSCS17
03077                                                                   DTSCS17
03078      PERFORM S810-READ-NEXT THRU S810-EXIT.                       DTSCS17
03079  S3110-EXIT. EXIT.                                                DTSCS17
03080      EJECT                                                        DTSCS17
03081  S3200-CHECK-RELATIONSHIPS.                                       DTSCS17
03082      MOVE WRK-INACT-CD TO MSOL-INACT-CD.                          DTSCS17
03083                                                                   DTSCS17
03084      IF MSOL-INACT-WITHDRAWN-88                                   DTSCS17
03085          GO TO S3200-EXIT.                                        DTSCS17
03086                                                                   DTSCS17
03087      MOVE LOW-VALUES TO IPES-KEY-AREA.                            DTSCS17
03088      SET IPES-PES-88 TO TRUE.                                     DTSCS17
03089      MOVE WRK-EMP-NO TO IPES-PRED-EMP-NO.                         DTSCS17
03090      MOVE IPES-KEY-AREA TO ISKL-KEY-AREA.                         DTSCS17
03091      PERFORM S821-START-BROWSE THRU S821-EXIT.                    DTSCS17
03092      PERFORM S3210-SCAN-IPES THRU S3210-EXIT                      DTSCS17
03093          UNTIL L821-NO-REC-88.                                    DTSCS17
03094      PERFORM S821-END-BROWSE THRU S821-EXIT.                      DTSCS17
03095  S3200-EXIT.                                                      DTSCS17
03096      EXIT.                                                        DTSCS17
03097      SKIP3                                                        DTSCS17
03098  S3210-SCAN-IPES.                                                 DTSCS17
03099      MOVE ISKL-REC TO IPES-REC.                                   DTSCS17
03100      IF IPES-PRED-EMP-NO = WRK-EMP-NO                             DTSCS17
03101          NEXT SENTENCE                                            DTSCS17
03102      ELSE                                                         DTSCS17
03103          SET L821-NO-REC-88 TO TRUE                               DTSCS17
03104          GO TO S3210-EXIT.                                        DTSCS17
03105                                                                   DTSCS17
03106 *    IF IPES-EXP-CHANGE-OWN-88 OR IPES-EXP-ACQ-CON-MERG-88        DTSCS17
03107      IF IPES-EXP-TRNSF-YES-88                                     DTSCS17
03108      AND IPES-PERCENT-TRNSFRD = 1                                 DTSCS17
03109          IF WRK-INACT-DATE < IPES-EFF-DATE                        DTSCS17
03110              NEXT SENTENCE                                        DTSCS17
03111          ELSE                                                     DTSCS17
03112              MOVE MSG-E174-AREA TO WRK-MSG-AREA                   DTSCS17
03113              PERFORM S1501-ERROR THRU S1501-EXIT                  DTSCS17
03114      ELSE                                                         DTSCS17
03115          NEXT SENTENCE.                                           DTSCS17
03116                                                                   DTSCS17
03117      PERFORM S821-READ-NEXT THRU S821-EXIT.                       DTSCS17
03118  S3210-EXIT.                                                      DTSCS17
03119      EXIT.                                                        DTSCS17
03120      EJECT                                                        DTSCS17
03121  S3300-CHECK-ORPHANS.                                             DTSCS17
03122      MOVE +0 TO TBL-CNT.                                          DTSCS17
03123      IF WRK-FIRST-LIAB-YRQ = +0                                   DTSCS17
03124          NEXT SENTENCE                                            DTSCS17
03125      ELSE                                                         DTSCS17
03126          ADD +1 TO TBL-CNT                                        DTSCS17
03127          MOVE WRK-FIRST-LIAB-YRQ TO TBL-FIRST-YRQ (TBL-CNT)       DTSCS17
03128          MOVE WRK-LAST-LIAB-YRQ TO TBL-LAST-YRQ (TBL-CNT).        DTSCS17
03129                                                                   DTSCS17
03130      MOVE LCCM-SCR17-HOLD-AREA TO SCR-REC-KEY-AREA.               DTSCS17
03131                                                                   DTSCS17
03132      MOVE LOW-VALUES TO MSOL-KEY-AREA.                            DTSCS17
03133      MOVE WRK-EMP-NO TO MSOL-EMP-NO.                              DTSCS17
03134      SET MSOL-SOL-88 TO TRUE.                                     DTSCS17
03135      MOVE +0 TO MSOL-LIAB-DATE.                                   DTSCS17
03136      MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS17
03137      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS17
03138      PERFORM S3311-BROWSE-MSOL THRU S3311-EXIT                    DTSCS17
03139          UNTIL L810-NO-REC-88                                     DTSCS17
03140                                                                   DTSCS17
03141      MOVE +0 TO WRK-WITHDRAW-CNT                                  DTSCS17
03142                 WRK-WITHDRAW-WAGES-CNT                            DTSCS17
03143                 WRK-TRANSFER-CNT.                                 DTSCS17
03144                                                                   DTSCS17
03145      MOVE LOW-VALUES    TO MQTR-KEY-AREA.                         DTSCS17
03146      MOVE WRK-EMP-NO    TO MQTR-EMP-NO.                           DTSCS17
03147      SET MQTR-QTR-88    TO TRUE.                                  DTSCS17
03148      MOVE +0            TO MQTR-YRQ.                              DTSCS17
03149      MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS17
03150      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS17
03151      PERFORM                                                      DTSCS17
03152        UNTIL L810-NO-REC-88                                       DTSCS17
03153          MOVE MSKL-REC TO MQTR-REC                                DTSCS17
03154          PERFORM S3314-PROCESS-QTR THRU S3314-EXIT                DTSCS17
03155          PERFORM S810-READ-NEXT THRU S810-EXIT                    DTSCS17
03156      END-PERFORM.                                                 DTSCS17
03157                                                                   DTSCS17
03158 **   IF MAP-OVERRIDE-YES-88                                       DTSCS17
03159 *    AND (LCCM-OP-IS-FLD-DESK-88                                  DTSCS17
03160 *    OR LCCM-OP-IS-ACCOUNTING-DESK-88)                            DTSCS17
03161 *       NEXT SENTENCE                                             DTSCS17
03162 *    ELSE                                                         DTSCS17
03163 *       IF (WRK-WITHDRAW-WAGES-CNT > +0                           DTSCS17
03164 *       AND MAP-TRANSFER-NO-88)                                   DTSCS17
03165 *          MOVE MSG-E17G-AREA TO WRK-MSG-AREA                     DTSCS17
03166 *          PERFORM S1501-ERROR THRU S1501-EXIT                    DTSCS17
03167 *          GO TO S3300-EXIT                                       DTSCS17
03168 *       END-IF                                                    DTSCS17
03169 **   END-IF.                                                      DTSCS17
03170                                                                   DTSCS17
03171      IF MAP-TRANSFER-YES-88                                       DTSCS17
03172          IF WRK-WITHDRAW-CNT = +0                                 DTSCS17
03173              MOVE MSG-E179-AREA TO WRK-MSG-AREA                   DTSCS17
03174              PERFORM S1721-ERROR THRU S1721-EXIT                  DTSCS17
03175          ELSE                                                     DTSCS17
03176          IF WRK-TRANSFER-CNT = +0                                 DTSCS17
03177              MOVE MSG-E17A-AREA TO WRK-MSG-AREA                   DTSCS17
03178              PERFORM S1721-ERROR THRU S1721-EXIT                  DTSCS17
03179          ELSE                                                     DTSCS17
03180              NEXT SENTENCE                                        DTSCS17
03181      ELSE                                                         DTSCS17
03182      IF MAP-TRANSFER-NO-88                                        DTSCS17
03183          IF WRK-WITHDRAW-CNT = +0                                 DTSCS17
03184              MOVE MSG-E179-AREA TO WRK-MSG-AREA                   DTSCS17
03185              PERFORM S1721-ERROR THRU S1721-EXIT                  DTSCS17
03186          ELSE                                                     DTSCS17
03187              NEXT SENTENCE                                        DTSCS17
03188      ELSE                                                         DTSCS17
03189          IF WRK-WITHDRAW-CNT = +0                                 DTSCS17
03190              NEXT SENTENCE                                        DTSCS17
03191          ELSE                                                     DTSCS17
03192              MOVE MSG-E175-AREA TO WRK-MSG-AREA                   DTSCS17
03193              PERFORM S1721-ERROR THRU S1721-EXIT.                 DTSCS17
03194                                                                   DTSCS17
03195  S3300-EXIT. EXIT.                                                DTSCS17
03196      SKIP3                                                        DTSCS17
03197  S3311-BROWSE-MSOL.                                               DTSCS17
03198      MOVE MSKL-REC TO MSOL-REC.                                   DTSCS17
03199      IF MSOL-KEY-AREA = SCR-REC-KEY-AREA                          DTSCS17
03200          NEXT SENTENCE                                            DTSCS17
03201      ELSE                                                         DTSCS17
03202          PERFORM S3313-TABLE THRU S3313-EXIT.                     DTSCS17
03203                                                                   DTSCS17
03204      PERFORM S810-READ-NEXT THRU S810-EXIT.                       DTSCS17
03205  S3311-EXIT.                                                      DTSCS17
03206      EXIT.                                                        DTSCS17
03207      SKIP3                                                        DTSCS17
03208  S3313-TABLE.                                                     DTSCS17
03209      IF TBL-CNT < +50                                             DTSCS17
03210          NEXT SENTENCE                                            DTSCS17
03211      ELSE                                                         DTSCS17
03212          GO TO S3313-EXIT.                                        DTSCS17
03213                                                                   DTSCS17
03214      IF (MSOL-INACT-WITHDRAWN-88)                                 DTSCS17
03215             OR                                                    DTSCS17
03216         (MSOL-FIRST-LIAB-YRQ = +0)                                DTSCS17
03217          GO TO S3313-EXIT.                                        DTSCS17
03218                                                                   DTSCS17
03219      ADD +1 TO TBL-CNT.                                           DTSCS17
03220      MOVE MSOL-FIRST-LIAB-YRQ TO TBL-FIRST-YRQ (TBL-CNT).         DTSCS17
03221      MOVE MSOL-LAST-LIAB-YRQ TO TBL-LAST-YRQ (TBL-CNT).           DTSCS17
03222  S3313-EXIT.                                                      DTSCS17
03223      EXIT.                                                        DTSCS17
03224      SKIP3                                                        DTSCS17
03225  S3314-PROCESS-QTR.                                               DTSCS17
03226      MOVE 'Y' TO WRK-WITHDRAW-IND.                                DTSCS17
03227                                                                   DTSCS17
03228      IF MQTR-CURR-ESTIM-88 OR MQTR-CURR-RCVD-88                   DTSCS17
03229          PERFORM                                                  DTSCS17
03230            VARYING WRK-SUB1 FROM 1 BY 1                           DTSCS17
03231            UNTIL (WRK-SUB1 > TBL-CNT)                             DTSCS17
03232                     OR                                            DTSCS17
03233                  (WRK-WITHDRAW-IND = 'N')                         DTSCS17
03234              IF (MQTR-YRQ < TBL-FIRST-YRQ (WRK-SUB1))             DTSCS17
03235                      OR                                           DTSCS17
03236                 (MQTR-YRQ > TBL-LAST-YRQ (WRK-SUB1))              DTSCS17
03237                  CONTINUE                                         DTSCS17
03238              ELSE                                                 DTSCS17
03239                  MOVE 'N' TO WRK-WITHDRAW-IND                     DTSCS17
03240              END-IF                                               DTSCS17
03241          END-PERFORM                                              DTSCS17
03242      ELSE                                                         DTSCS17
03243          MOVE 'N' TO WRK-WITHDRAW-IND.                            DTSCS17
03244                                                                   DTSCS17
03245      IF WRK-WITHDRAW-IND = 'N'                                    DTSCS17
03246          GO TO S3314-EXIT.                                        DTSCS17
03247                                                                   DTSCS17
03248      ADD +1 TO WRK-WITHDRAW-CNT.                                  DTSCS17
03249                                                                   DTSCS17
03250      IF MQTR-CURR-ESTIM-88                                        DTSCS17
03251          GO TO S3314-EXIT.                                        DTSCS17
03252                                                                   DTSCS17
03253      IF MQTR-TOT-WAGE > ZERO                                      DTSCS17
03254         ADD +1 TO WRK-WITHDRAW-WAGES-CNT                          DTSCS17
03255      END-IF.                                                      DTSCS17
03256                                                                   DTSCS17
03257      IF MAP-TRANSFER-YES-88                                       DTSCS17
03258          NEXT SENTENCE                                            DTSCS17
03259      ELSE                                                         DTSCS17
03260          GO TO S3314-EXIT.                                        DTSCS17
03261                                                                   DTSCS17
03262      PERFORM S810-END-BROWSE THRU S810-EXIT.                      DTSCS17
03263                                                                   DTSCS17
03264      MOVE 'N' TO WRK-TRANSFER-IND.                                DTSCS17
03265                                                                   DTSCS17
03266      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSCS17
03267      MOVE WRK-TRANSFER-EMP-NO TO MSKL-EMP-NO.                     DTSCS17
03268      SET MSKL-SOL-88 TO TRUE.                                     DTSCS17
03269      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS17
03270                                                                   DTSCS17
03271      PERFORM                                                      DTSCS17
03272        UNTIL L810-NO-REC-88                                       DTSCS17
03273          MOVE MSKL-REC TO MSOL-REC                                DTSCS17
03274          PERFORM S3314A-CHECK-MSOL THRU S3314A-EXIT               DTSCS17
03275          PERFORM S810-READ-NEXT THRU S810-EXIT                    DTSCS17
03276      END-PERFORM.                                                 DTSCS17
03277                                                                   DTSCS17
03278      IF WRK-TRANSFER-IND = 'Y'                                    DTSCS17
03279          PERFORM S3314B-CHECK-MQTR THRU S3314B-EXIT.              DTSCS17
03280                                                                   DTSCS17
03281      MOVE WRK-EMP-NO TO MQTR-EMP-NO.                              DTSCS17
03282                                                                   DTSCS17
03283      MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS17
03284                                                                   DTSCS17
03285      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS17
03286  S3314-EXIT.  EXIT.                                               DTSCS17
03287      SKIP3                                                        DTSCS17
03288  S3314A-CHECK-MSOL.                                               DTSCS17
03289      IF (MQTR-YRQ < MSOL-FIRST-LIAB-YRQ)                          DTSCS17
03290             OR                                                    DTSCS17
03291         (MQTR-YRQ > MSOL-LAST-LIAB-YRQ)                           DTSCS17
03292          NEXT SENTENCE                                            DTSCS17
03293      ELSE                                                         DTSCS17
03294          MOVE 'Y' TO WRK-TRANSFER-IND.                            DTSCS17
03295  S3314A-EXIT.  EXIT.                                              DTSCS17
03296      SKIP3                                                        DTSCS17
03297  S3314B-CHECK-MQTR.                                               DTSCS17
03298      MOVE WRK-TRANSFER-EMP-NO TO MQTR-EMP-NO.                     DTSCS17
03299                                                                   DTSCS17
03300      MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS17
03301                                                                   DTSCS17
03302      PERFORM S810-READ THRU S810-EXIT.                            DTSCS17
03303                                                                   DTSCS17
03304      IF L810-NO-REC-88                                            DTSCS17
03305          ADD +1 TO WRK-TRANSFER-CNT                               DTSCS17
03306          GO TO S3314B-EXIT.                                       DTSCS17
03307                                                                   DTSCS17
03308      MOVE MSKL-REC TO MQTR-REC.                                   DTSCS17
03309                                                                   DTSCS17
03310      IF MQTR-CURR-RCVD-88                                         DTSCS17
03311          GO TO S3314B-EXIT.                                       DTSCS17
03312                                                                   DTSCS17
03313      ADD +1 TO WRK-TRANSFER-CNT.                                  DTSCS17
03314  S3314B-EXIT.                                                     DTSCS17
03315      EXIT.                                                        DTSCS17
03316                                                                   DTSCS17
03317  S3400-CHECK-MRTE.                                                DTSCS17
03318      MOVE ZERO                TO WRK-ESTIM-YRQ.                   DTSCS17
03319                                                                   DTSCS17
03320      IF MPRF-CLASS-SELF-INS-88                                    DTSCS17
03321          GO TO S3400-EXIT.                                        DTSCS17
03322                                                                   DTSCS17
03323      IF WRK-FIRST-LIAB-YRQ = +0                                   DTSCS17
03324          GO TO S3400-EXIT                                         DTSCS17
03325      ELSE                                                         DTSCS17
03326          IF MSOL-FIRST-LIAB-YRQ = ZERO                            DTSCS17
03327             MOVE WRK-FIRST-LIAB-YRQ      TO WRK-YRQ               DTSCS17
03328             MOVE WRK-LAST-LIAB-YRQ       TO WRK-END-YRQ           DTSCS17
03329          ELSE                                                     DTSCS17
03330             IF WRK-FIRST-LIAB-YRQ < MSOL-FIRST-LIAB-YRQ           DTSCS17
03331             OR WRK-LAST-LIAB-YRQ  > MSOL-LAST-LIAB-YRQ            DTSCS17
03332             OR WRK-LAST-LIAB-YRQ  < MSOL-LAST-LIAB-YRQ            DTSCS17
03333                PERFORM S3410-SET-DATES  THRU S3410-EXIT           DTSCS17
03334             ELSE                                                  DTSCS17
03335                GO TO S3400-EXIT.                                  DTSCS17
03336                                                                   DTSCS17
03337      IF WRK-YRQ < MPRF-LAST-ARCHIVED-YRQ                          DTSCS17
03338         MOVE MPRF-LAST-ARCHIVED-YRQ TO WRK-YRQ.                   DTSCS17
03339      MOVE 1                         TO WRK-YRQ-Q.                 DTSCS17
03340                                                                   DTSCS17
03341      SET WRK-RATE-CHK-NULL-88   TO TRUE.                          DTSCS17
03342      PERFORM S3420-FIND-RATES   THRU S3420-EXIT                   DTSCS17
03343         UNTIL WRK-RATE-CHK-COMPLETE-88.                           DTSCS17
03344                                                                   DTSCS17
03345      IF WRK-DISPLAY-ERR-YES-88                                    DTSCS17
03346         IF WRK-RATE-CHK-NO-RATE-88                                DTSCS17
03347            MOVE MSG-E17B-AREA TO WRK-MSG-AREA                     DTSCS17
03348            PERFORM S1201-ERROR THRU S1201-EXIT                    DTSCS17
03349         ELSE                                                      DTSCS17
03350         IF WRK-RATE-CHK-ESTIM-88                                  DTSCS17
03351            IF MAP-OVERRIDE-YES-88                                 DTSCS17
03352               NEXT SENTENCE                                       DTSCS17
03353            ELSE                                                   DTSCS17
03354               MOVE MSG-E17C-AREA TO WRK-MSG-AREA                  DTSCS17
03355               PERFORM S1801-ERROR THRU S1801-EXIT.                DTSCS17
03356                                                                   DTSCS17
03357  S3400-EXIT.                                                      DTSCS17
03358      EXIT.                                                        DTSCS17
03359                                                                   DTSCS17
03360  S3410-SET-DATES.                                                 DTSCS17
03361      MOVE WRK-ALL-NINES-YRQ          TO WRK-YRQ.                  DTSCS17
03362      MOVE ZERO                       TO WRK-END-YRQ.              DTSCS17
03363                                                                   DTSCS17
03364      IF WRK-FIRST-LIAB-YRQ            < MSOL-FIRST-LIAB-YRQ       DTSCS17
03365         MOVE MSOL-FIRST-LIAB-YRQ     TO WRK-END-YRQ               DTSCS17
03366         MOVE WRK-FIRST-LIAB-YRQ      TO WRK-YRQ.                  DTSCS17
03367                                                                   DTSCS17
03368      IF WRK-LAST-LIAB-YRQ             > MSOL-LAST-LIAB-YRQ        DTSCS17
03369         MOVE WRK-LAST-LIAB-YRQ       TO WRK-END-YRQ               DTSCS17
03370         IF MSOL-LAST-LIAB-YRQ         < WRK-YRQ                   DTSCS17
03371            MOVE MSOL-LAST-LIAB-YRQ   TO WRK-YRQ                   DTSCS17
03372         END-IF                                                    DTSCS17
03373      ELSE                                                         DTSCS17
03374         IF WRK-LAST-LIAB-YRQ             < MSOL-LAST-LIAB-YRQ     DTSCS17
03375            MOVE WRK-LAST-LIAB-YRQ       TO WRK-END-YRQ            DTSCS17
03376            IF WRK-LAST-LIAB-YRQ          < WRK-YRQ                DTSCS17
03377               MOVE WRK-LAST-LIAB-YRQ    TO WRK-YRQ                DTSCS17
03378            END-IF                                                 DTSCS17
03379         END-IF                                                    DTSCS17
03380      END-IF.                                                      DTSCS17
03381                                                                   DTSCS17
03382  S3410-EXIT.                                                      DTSCS17
03383      EXIT.                                                        DTSCS17
03384                                                                   DTSCS17
03385  S3420-FIND-RATES.                                                DTSCS17
03386      MOVE LOW-VALUES     TO MRTE-KEY-AREA.                        DTSCS17
03387      MOVE MPRF-EMP-NO    TO MRTE-EMP-NO.                          DTSCS17
03388      SET MRTE-RTE-88     TO TRUE.                                 DTSCS17
03389      MOVE WRK-YRQ        TO MRTE-EFF-YRQ.                         DTSCS17
03390                                                                   DTSCS17
03391      MOVE MRTE-KEY-AREA  TO MSKL-KEY-AREA.                        DTSCS17
03392                                                                   DTSCS17
03393      PERFORM S810-READ   THRU S810-EXIT.                          DTSCS17
03394      IF L810-NO-REC-88                                            DTSCS17
03395         SET WRK-RATE-CHK-NO-RATE-88 TO TRUE                       DTSCS17
03396         GO TO S3420-EXIT                                          DTSCS17
03397      ELSE                                                         DTSCS17
03398         MOVE MSKL-REC    TO MRTE-REC.                             DTSCS17
03399                                                                   DTSCS17
03400      MOVE MRTE-EFF-YRQ TO L006-YRQ.                               DTSCS17
03401      PERFORM S006-RATE-PERIOD THRU S006-EXIT.                     DTSCS17
03402                                                                   DTSCS17
03403      IF MRTE-RATE-TYPE-ESTIM-88                                   DTSCS17
03404         SET WRK-RATE-CHK-ESTIM-88  TO TRUE                        DTSCS17
03405         MOVE L006-RTE-YR-START-YRQ TO WRK-ESTIM-YRQ               DTSCS17
03406         GO TO S3420-EXIT.                                         DTSCS17
03407                                                                   DTSCS17
03408      IF L006-RTE-YR-END-YRQ >= WRK-END-YRQ                        DTSCS17
03409         SET WRK-RATE-CHK-OK-88  TO TRUE                           DTSCS17
03410         GO TO S3420-EXIT.                                         DTSCS17
03411                                                                   DTSCS17
03412      IF L006-RTE-YR-END-YRQ >= LCCM-LAST-RATE-END-YRQ             DTSCS17
03413         SET WRK-RATE-CHK-OK-88  TO TRUE                           DTSCS17
03414         GO TO S3420-EXIT.                                         DTSCS17
03415                                                                   DTSCS17
03416      IF L006-RTE-YR-END-YRQ >= WRK-LAST-LIAB-YRQ                  DTSCS17
03417         SET WRK-RATE-CHK-OK-88  TO TRUE                           DTSCS17
03418         GO TO S3420-EXIT.                                         DTSCS17
03419                                                                   DTSCS17
03420      ADD 1                      TO WRK-YRQ-YR.                    DTSCS17
03421                                                                   DTSCS17
03422      IF WRK-YRQ                  > WRK-END-YRQ                    DTSCS17
03423         SET WRK-RATE-CHK-OK-88  TO TRUE                           DTSCS17
03424         GO TO S3420-EXIT.                                         DTSCS17
03425                                                                   DTSCS17
03426      IF WRK-YRQ                  > LCCM-LAST-RATE-END-YRQ         DTSCS17
03427         SET WRK-RATE-CHK-OK-88  TO TRUE                           DTSCS17
03428         GO TO S3420-EXIT.                                         DTSCS17
03429                                                                   DTSCS17
03430      IF WRK-YRQ                  > WRK-LAST-LIAB-YRQ              DTSCS17
03431         SET WRK-RATE-CHK-OK-88  TO TRUE                           DTSCS17
03432         GO TO S3420-EXIT.                                         DTSCS17
03433                                                                   DTSCS17
03434                                                                   DTSCS17
03435  S3420-EXIT.                                                      DTSCS17
03436      EXIT.                                                        DTSCS17
03437      EJECT                                                        DTSCS17
03438 /*****************************************************************DTSCS17
03439 * LOCK SCREEN FOR UPDATE CONFIRMATION                            *DTSCS17
03440 ******************************************************************DTSCS17
03441  S5100-SET-LOCK-ATTRB.                                            DTSCS17
03442      MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN                      DTSCS17
03443                                 WRK-ATB-NUM.                      DTSCS17
03444                                                                   DTSCS17
03445      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS17
03446                                                                   DTSCS17
03447      MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A                  DTSCS17
03448                                 MAP-EMP-NO-2-A                    DTSCS17
03449                                 MAP-GOTO-A.                       DTSCS17
03450  S5100-EXIT.                                                      DTSCS17
03451      EXIT.                                                        DTSCS17
03452      SKIP3                                                        DTSCS17
03453 ******************************************************************DTSCS17
03454 * SET ATTIBUTE BYTES FOR UPDATE ACCESS                           *DTSCS17
03455 ******************************************************************DTSCS17
03456  S5200-SET-UPDATE-ATTRB.                                          DTSCS17
03457      MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN.                 DTSCS17
03458      MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM.               DTSCS17
03459                                                                   DTSCS17
03460      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS17
03461  S5200-EXIT.                                                      DTSCS17
03462      EXIT.                                                        DTSCS17
03463      SKIP3                                                        DTSCS17
03464 ******************************************************************DTSCS17
03465 *  SET ATTRIBUTE BYTES FOR INQUIRY STATUS                        *DTSCS17
03466 ******************************************************************DTSCS17
03467  S5300-SET-INQ-ATTRB.                                             DTSCS17
03468      MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN                     DTSCS17
03469                                   WRK-ATB-NUM.                    DTSCS17
03470                                                                   DTSCS17
03471      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS17
03472  S5300-EXIT.                                                      DTSCS17
03473      EXIT.                                                        DTSCS17
03474      SKIP3                                                        DTSCS17
03475  S5900-SET-ATTRB.                                                 DTSCS17
03476      MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A             DTSCS17
03477                                      MAP-EMP-NO-2-A.              DTSCS17
03478                                                                   DTSCS17
03479      MOVE WRK-ATB-AN TO MAP-TRANSFER-IND-A                        DTSCS17
03480                         MAP-OVERRIDE-IND-A                        DTSCS17
03481                         MAP-RESP-OP-ID-A                          DTSCS17
03482                         MAP-INACT-LTR-TYPE-A.                     DTSCS17
03483                                                                   DTSCS17
03484      MOVE WRK-ATB-NUM TO MAP-LIAB-MO-A                            DTSCS17
03485                          MAP-LIAB-DA-A                            DTSCS17
03486                          MAP-LIAB-YR-A                            DTSCS17
03487                          MAP-LIAB-ESTB-MO-A                       DTSCS17
03488                          MAP-LIAB-ESTB-DA-A                       DTSCS17
03489                          MAP-LIAB-ESTB-YR-A                       DTSCS17
03490                          MAP-LIAB-CD-A                            DTSCS17
03491                          MAP-INACT-MO-A                           DTSCS17
03492                          MAP-INACT-DA-A                           DTSCS17
03493                          MAP-INACT-YR-A                           DTSCS17
03494                          MAP-INACT-CD-A                           DTSCS17
03495                          MAP-TRANSFER-EMP-NO-1-A                  DTSCS17
03496                          MAP-TRANSFER-EMP-NO-2-A.                 DTSCS17
03497                                                                   DTSCS17
03498      MOVE CATB-ASKIP-BRT-MDTON TO MAP-CURR-PAGE-A                 DTSCS17
03499                                   MAP-LAST-PAGE-A.                DTSCS17
03500                                                                   DTSCS17
03501      MOVE CATB-ASKIP-BRT-MDTON TO MAP-PRIMARY-NAME-A.             DTSCS17
03502                                                                   DTSCS17
03503      MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-CLASS-DESC-A            DTSCS17
03504                                   MAP-FIRST-LIAB-YRQ-A            DTSCS17
03505                                   MAP-LAST-LIAB-YRQ-A             DTSCS17
03506                                   MAP-NEW-EMPLOYER-IND-A          DTSCS17
03507                                   MAP-ESTB-DATE-A                 DTSCS17
03508                                   MAP-LIAB-MAIL-DATE-A            DTSCS17
03509                                   MAP-INACT-ENTER-DATE-A          DTSCS17
03510                                   MAP-INACT-REVERSE-DATE-A.       DTSCS17
03511                                                                   DTSCS17
03512      MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A.                 DTSCS17
03513  S5900-EXIT.                                                      DTSCS17
03514      EXIT.                                                        DTSCS17
03515      SKIP3                                                        DTSCS17
03516  S6100-SET-LIAB-YRQ.                                              DTSCS17
03517      MOVE +0 TO WRK-FIRST-LIAB-YRQ.                               DTSCS17
03518      MOVE ALL-NINES-YRQ TO WRK-LAST-LIAB-YRQ.                     DTSCS17
03519      IF WRK-LIAB-DATE = +0                                        DTSCS17
03520          GO TO S6100-EXIT.                                        DTSCS17
03521                                                                   DTSCS17
03522      MOVE WRK-LIAB-DATE TO L004-DATE.                             DTSCS17
03523      PERFORM S004-FROM-DATE THRU S004-EXIT.                       DTSCS17
03524      MOVE L004-QTR-5-9 TO WRK-FIRST-LIAB-YRQ.                     DTSCS17
03525                                                                   DTSCS17
03526      IF WRK-INACT-DATE = +0 OR ALL-NINES-DATE                     DTSCS17
03527          NEXT SENTENCE                                            DTSCS17
03528      ELSE                                                         DTSCS17
03529          MOVE WRK-INACT-DATE TO L004-DATE                         DTSCS17
03530          PERFORM S004-FROM-DATE THRU S004-EXIT                    DTSCS17
03531          MOVE L004-QTR-5-9 TO WRK-LAST-LIAB-YRQ.                  DTSCS17
03532                                                                   DTSCS17
03533      MOVE MSOL-INACT-CD TO TEMP-INACT-CD.                         DTSCS17
03534      MOVE WRK-INACT-CD TO MSOL-INACT-CD.                          DTSCS17
03535      IF MSOL-INACT-WITHDRAWN-88                                   DTSCS17
03536          MOVE +0 TO WRK-FIRST-LIAB-YRQ                            DTSCS17
03537                     WRK-LAST-LIAB-YRQ.                            DTSCS17
03538      MOVE TEMP-INACT-CD TO MSOL-INACT-CD.                         DTSCS17
03539  S6100-EXIT.                                                      DTSCS17
03540      EXIT.                                                        DTSCS17
03541 /*****************************************************************DTSCS17
03542 * MAP ROUTINES                                                   *DTSCS17
03543 ******************************************************************DTSCS17
03544  S9100-RECEIVE.                                                   DTSCS17
03545      SET L851-RECEIVE-88 TO TRUE.                                 DTSCS17
03546                                                                   DTSCS17
03547      MOVE WRK-SCR-ID TO L851-SCR-ID.                              DTSCS17
03548                                                                   DTSCS17
03549      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS17
03550                                                                   DTSCS17
03551      MOVE L851-AID TO LCCM-AID.                                   DTSCS17
03552      MOVE L851-CURSOR TO LCCM-CURSOR.                             DTSCS17
03553  S9100-EXIT.                                                      DTSCS17
03554      EXIT.                                                        DTSCS17
03555      SKIP3                                                        DTSCS17
03556  S9200-SEND-DATAONLY.                                             DTSCS17
03557      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS17
03558                                                                   DTSCS17
03559      IF LCCM-NO-MSG                                               DTSCS17
03560          NEXT SENTENCE                                            DTSCS17
03561      ELSE                                                         DTSCS17
03562          PERFORM S805-MSG-AREA THRU S805-EXIT.                    DTSCS17
03563                                                                   DTSCS17
03564      IF CURSOR-SET-GOTO                                           DTSCS17
03565          MOVE CATB-CURSOR TO MAP-GOTO-L                           DTSCS17
03566      ELSE                                                         DTSCS17
03567          MOVE CATB-CURSOR TO MAP-EMP-NO-1-L.                      DTSCS17
03568                                                                   DTSCS17
03569      SET L851-SEND-DATAONLY-88 TO TRUE.                           DTSCS17
03570                                                                   DTSCS17
03571      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS17
03572                                                                   DTSCS17
03573      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS17
03574  S9200-EXIT.                                                      DTSCS17
03575      EXIT.                                                        DTSCS17
03576      SKIP3                                                        DTSCS17
03577  S9300-SEND-MAP.                                                  DTSCS17
03578      MOVE  LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE.             DTSCS17
03579      MOVE  SPACES TO MAP-SYS-TIME.                                DTSCS17
03580      MOVE  LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME.             DTSCS17
03581      MOVE  LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME.         DTSCS17
03582                                                                   DTSCS17
03583      IF SCR-ACCESS-UPDATE                                         DTSCS17
03584          PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT               DTSCS17
03585      ELSE                                                         DTSCS17
03586          PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT.             DTSCS17
03587                                                                   DTSCS17
03588      PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT.                   DTSCS17
03589                                                                   DTSCS17
03590      PERFORM S805-MSG-AREA THRU S805-EXIT.                        DTSCS17
03591                                                                   DTSCS17
03592      IF CURSOR-SET-NO                                             DTSCS17
03593          MOVE CATB-CURSOR TO MAP-EMP-NO-1-L.                      DTSCS17
03594                                                                   DTSCS17
03595      SET L851-SEND-88 TO TRUE.                                    DTSCS17
03596                                                                   DTSCS17
03597      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS17
03598                                                                   DTSCS17
03599      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS17
03600  S9300-EXIT.                                                      DTSCS17
03601      EXIT.                                                        DTSCS17
03602      SKIP3                                                        DTSCS17
03603  S9310-UPDATE-FKEYS.                                              DTSCS17
03604      PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT.                 DTSCS17
03605                                                                   DTSCS17
03606      MOVE CFKD-MOD TO MAP-KEY-MOD.                                DTSCS17
03607                                                                   DTSCS17
03608      IF LCCM-SCR-CLEAR                                            DTSCS17
03609          MOVE LOW-VALUES TO MAP-KEY-MOD                           DTSCS17
03610      ELSE                                                         DTSCS17
03611      IF LCCM-SCR-INQUIRE                                          DTSCS17
03612          NEXT SENTENCE                                            DTSCS17
03613      ELSE                                                         DTSCS17
03614      IF LCCM-SCR-UPDATE-LOCKED                                    DTSCS17
03615          MOVE LOW-VALUES TO MAP-KEY-FIRST                         DTSCS17
03616                             MAP-KEY-LAST                          DTSCS17
03617                             MAP-KEY-BACK                          DTSCS17
03618                             MAP-KEY-FWRD                          DTSCS17
03619                             MAP-KEY-MOD                           DTSCS17
03620      ELSE                                                         DTSCS17
03621          NEXT SENTENCE.                                           DTSCS17
03622  S9310-EXIT.                                                      DTSCS17
03623      EXIT.                                                        DTSCS17
03624      SKIP3                                                        DTSCS17
03625  S9320-INQUIRY-FKEYS.                                             DTSCS17
03626      MOVE CFKD-FIRST TO MAP-KEY-FIRST.                            DTSCS17
03627      MOVE CFKD-LAST TO MAP-KEY-LAST.                              DTSCS17
03628      MOVE CFKD-BACKWARD TO MAP-KEY-BACK.                          DTSCS17
03629      MOVE CFKD-FORWARD TO MAP-KEY-FWRD.                           DTSCS17
03630                                                                   DTSCS17
03631      MOVE LOW-VALUES TO MAP-KEY-MOD.                              DTSCS17
03632                                                                   DTSCS17
03633 *    PERFORM S9321-JUMP-KEYS THRU S9321-EXIT.                     DTSCS17
03634  S9320-EXIT.                                                      DTSCS17
03635      EXIT.                                                        DTSCS17
03636      SKIP3                                                        DTSCS17
03637 *S9321-JUMP-KEYS.                                                 DTSCS17
03638 *    MOVE CFKD-REG-INQ TO MAP-KEY-REG-INQ.                        DTSCS17
03639 *S9321-EXIT.                                                      DTSCS17
03640 *    EXIT.                                                        DTSCS17
03641      SKIP3                                                        DTSCS17
03642  S9330-DSCR-FIELDS.                                               DTSCS17
03643      IF WRK-MPRF-YES-88                                           DTSCS17
03644          MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME               DTSCS17
03645          MOVE MPRF-EMP-CLASS TO L031-CD                           DTSCS17
03646          SET L031-MPRF-EMP-CLASS TO TRUE                          DTSCS17
03647          PERFORM S031-REG-CODES THRU S031-EXIT                    DTSCS17
03648          MOVE L031-SHORT-DSCR TO MAP-EMP-CLASS-DESC.              DTSCS17
03649                                                                   DTSCS17
03650      IF MAP-LIAB-CD = SPACES OR LOW-VALUES                        DTSCS17
03651          MOVE LOW-VALUES TO MAP-LIAB-CD-DESC                      DTSCS17
03652      ELSE                                                         DTSCS17
03653          MOVE MAP-LIAB-CD TO L031-CD                              DTSCS17
03654          SET L031-MSOL-LIAB-CD TO TRUE                            DTSCS17
03655          PERFORM S031-REG-CODES THRU S031-EXIT                    DTSCS17
03656          MOVE L031-SHORT-DSCR TO MAP-LIAB-CD-DESC.                DTSCS17
03657                                                                   DTSCS17
03658      IF MAP-INACT-CD = SPACES OR LOW-VALUES                       DTSCS17
03659          MOVE LOW-VALUES TO MAP-INACT-CD-DESC                     DTSCS17
03660      ELSE                                                         DTSCS17
03661          MOVE MAP-INACT-CD TO L031-CD                             DTSCS17
03662          SET L031-MSOL-INACT-CD TO TRUE                           DTSCS17
03663          PERFORM S031-REG-CODES THRU S031-EXIT                    DTSCS17
03664          MOVE L031-SHORT-DSCR TO MAP-INACT-CD-DESC.               DTSCS17
03665                                                                   DTSCS17
03666      IF MAP-RESP-OP-ID = LOW-VALUES OR SPACES                     DTSCS17
03667          MOVE LOW-VALUES TO MAP-RESP-OP-ID-DESC                   DTSCS17
03668      ELSE                                                         DTSCS17
03669      IF MAP-RESP-OP-ID = LCCM-OP-ID                               DTSCS17
03670          MOVE LCCM-OP-NAME TO MAP-RESP-OP-ID-DESC                 DTSCS17
03671      ELSE                                                         DTSCS17
03672          MOVE MAP-RESP-OP-ID TO L082-OP-ID                        DTSCS17
03673          PERFORM S082-OP-ID-LOOKUP THRU S082-EXIT                 DTSCS17
03674          MOVE L082-NAME TO MAP-RESP-OP-ID-DESC.                   DTSCS17
03675                                                                   DTSCS17
03676      MOVE MAP-INACT-CD TO WRK-INACT-CD.                           DTSCS17
03677                                                                   DTSCS17
03678      MOVE MAP-LIAB-DATE-AREA     TO L015-S-DATE-AREA.             DTSCS17
03679      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS17
03680      MOVE L015-DATE TO WRK-LIAB-DATE.                             DTSCS17
03681                                                                   DTSCS17
03682      MOVE MAP-INACT-DATE-AREA TO L015-S-DATE-AREA.                DTSCS17
03683      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS17
03684      MOVE L015-DATE TO WRK-INACT-DATE.                            DTSCS17
03685                                                                   DTSCS17
03686      PERFORM S6100-SET-LIAB-YRQ THRU S6100-EXIT.                  DTSCS17
03687                                                                   DTSCS17
03688      IF WRK-FIRST-LIAB-YRQ = +0                                   DTSCS17
03689          MOVE LOW-VALUES TO MAP-FIRST-LIAB-YRQ                    DTSCS17
03690      ELSE                                                         DTSCS17
03691          MOVE WRK-FIRST-LIAB-YRQ TO L004-QTR-5-9                  DTSCS17
03692          PERFORM S004-FROM-5 THRU S004-EXIT                       DTSCS17
03693          MOVE L004-SLASH-QTR TO MAP-FIRST-LIAB-YRQ.               DTSCS17
03694                                                                   DTSCS17
03695      IF WRK-LAST-LIAB-YRQ = +0 OR ALL-NINES-YRQ                   DTSCS17
03696          MOVE LOW-VALUES TO MAP-LAST-LIAB-YRQ                     DTSCS17
03697      ELSE                                                         DTSCS17
03698          MOVE WRK-LAST-LIAB-YRQ TO L004-QTR-5-9                   DTSCS17
03699          PERFORM S004-FROM-5 THRU S004-EXIT                       DTSCS17
03700          MOVE L004-SLASH-QTR TO MAP-LAST-LIAB-YRQ.                DTSCS17
03701  S9330-EXIT. EXIT.                                                DTSCS17
03702      SKIP3                                                        DTSCS17
03703  S9900-PREPARE-SEND.                                              DTSCS17
03704      MOVE WRK-SCR-ID TO L851-SCR-ID                               DTSCS17
03705                         LCCM-SCR-ID.                              DTSCS17
03706      MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND.                    DTSCS17
03707      MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE.                         DTSCS17
03708  S9900-EXIT.                                                      DTSCS17
03709      EXIT.                                                        DTSCS17
