00001  IDENTIFICATION DIVISION.                                         12/08/21
00002  PROGRAM-ID.             DTSCS1C.                                 DTSCS1C
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV100
00004  DATE-WRITTEN.           APRIL 1994.                              DTSCS1C
00005  DATE-COMPILED.                                                   DTSCS1C
00006                                                                   DTSCS1C
00007 *TESTINP PPUP                                                     DTSCS1C
00008 *                                                                 DTSCS1C
00009 *    FUNCTION:  LIABILITY DETERMINATION ENTRY                     DTSCS1C
00010 *               SCREEN PROCESSOR.                                 DTSCS1C
00011 *                                                                 DTSCS1C
00012 *                                                                 DTSCS1C
00013 *    MODIFICATION LOG:                                            DTSCS1C
00014 *                                                                 DTSCS1C
00015 *    12/14/94  AUTOMATICALLY CONVERT ORG TYPES 'INK' 'CNK' AND    DTSCS1C
00016 *              'PNK' TO 'I' 'C' AND 'P'.                          DTSCS1C
00017 *              WORK ORDER: CR028                PROGRAMMER: RHC   DTSCS1C
00018 *                                                                 DTSCS1C
00019 *    01/13/95  CHANGE RATE ENTRY FIELDS FROM FIVE TO THREE        DTSCS1C
00020 *              CHARACTERS LONG.  (ONLY CHANGES: DTSCM1C, DTSIS1C.)DTSCS1C
00021 *              WORK ORDER: CR038                PROGRAMMER: RHC   DTSCS1C
00022 *                                                                 DTSCS1C
00023 *    03/23/95  ADD RPT PRINT INDICATOR.                           DTSCS1C
00024 *              WORK ORDER: CR062                PROGRAMMER: EHH   DTSCS1C
00025 *                                                                 DTSCS1C
00026 *    03/31/95  CHANGE DATA PHONE NUMBER TO VOICE2 PHONE NUMBER.   DTSCS1C
00027 *              WORK ORDER: CR068                PROGRAMMER: RHC   DTSCS1C
00028 *                                                                 DTSCS1C
00029 *    05/16/95  HAVING AN OPEN BANKRUPTCY IN A SPAN OF LIABILITY   DTSCS1C
00030 *              OR DURING A DETERMINATION IS NOW ALLOWED.          DTSCS1C
00031 *              WORK ORDER: CR086                PROGRAMMER: RHC   DTSCS1C
00032 *                                                                 DTSCS1C
00033 *    06/15/95  CHANGE "OVERRIDE?" TO "TRANSFER?".                 DTSCS1C
00034 *              WORK ORDER: CR066                PROGRAMMER: EHH   DTSCS1C
00035 *                                                                 DTSCS1C
00036 *    10/24/95  JOINT REGISTRATION MODIFICATIONS.                  DTSCS1C
00037 *              WORK ORDER: JR                   PROGRAMMER: EHH   DTSCS1C
00038 *                                                                 DTSCS1C
00039 *    06/13/96  RECOMPILED TO INCORPORATE CHANGES TO DTSIT036      DTSCS1C
00040 *              REFERENCE RFP: #WARP II          PROGRAMMER: MJA   DTSCS1C
00041 *                                                                 DTSCS1C
00042 *    07/15/96  SET T036-5E-REQ-NO-88 TO TRUE - FIX FOR ABOVE.     DTSCS1C
00043 *              REFERENCE RFP: #WARP II          PROGRAMMER: SFW   DTSCS1C
00044 *                                                                 DTSCS1C
00045 *    09/22/1998  REVIEWED AND MODIFIED FOR DC.                    DTSCS1C
00046 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH   DTSCS1C
00047 *                                                                 DTSCS1C
00048 *    05/13/1999  REQUIRE MAP-RTE-EFF-YRQ AND MAP-WAIVER-START-YRQ DTSCS1C
00049 *                TO BE GREATER THAN LCCM-PICKUP-YRQ.              DTSCS1C
00050 *                REFERENCE: PICKUP DIR          PROGRAMMER: EHH   DTSCS1C
00051 *                                                                 DTSCS1C
00052 *    06/02/1999  RECOMPILED TO PICKUP MODIFICATIONS TO MAP-INACT- DTSCS1C
00053 *                LTR-VALID-88 AND MAP-PRED-INACT-LTR-VALID-88.    DTSCS1C
00054 *                REFERENCE: 119R2 TO R117R3     PROGRAMMER: EHH   DTSCS1C
00055 *                                                                 DTSCS1C
00056 *    05/08/2000  MODIFIED S3200 AND S4600 TO MAKE INACTIVE        DTSCS1C
00057 *                LETTER TYPE A REQUIRED FIELD.                    DTSCS1C
00058 *                REFERENCE: ENH014              PROGRAMMER: GD    DTSCS1C
00059 *                                                                 DTSCS1C
00060 *    10/17/2001  MODIFIED FOR HOUSEHOLD EMPLOYERS.                DTSCS1C
00061 *                REFERENCE: HOUSEHOLD           PROGRAMMER: GD    DTSCS1C
00062 *                                                                 DTSCS1C
00063 *    08/21/2002  MODIFIED TO PRINT RATE NOTICE WHEN CHANGING      DTSCS1C
00064 *                AN ESTIMATED RATE TO FINAL.                      DTSCS1C
00065 *                REFERENCE: HOUSEHOLD           PROGRAMMER: GD    DTSCS1C
00066 *                                                                 DTSCS1C
00067 *    12/09/2002  MODIFIED TO USE OPERATOR ID OF USER CURRENTLY    DTSCS1C
00068 *                SIGNED ON AS 'RESPONSIBLE OP ID,' UNLESS THE     DTSCS1C
00069 *                USER HAS SPECIFICALLY ENTERED A DIFFERENT ID     DTSCS1C
00070 *                IN THE MAP-RESP-OP-ID FIELD.                     DTSCS1C
00071 *                REFERENCE: REQUEST FROM STATUS PROGRAMMER: GD    DTSCS1C
00072 *                                                                 DTSCS1C
00073 *    06/23/2004  MODIFIED TO PREVENT ACTIVE DETERMINATION IS AN   DTSCS1C
00074 *                ACCOUNT WITH THE SAME FEIN IS ON FILE WITH       DTSCS1C
00075 *                STATUS = UNKNOWN (I.E., DETERMINATION NOT DONE). DTSCS1C
00076 *                (SEE S1800).                                     DTSCS1C
00077 *                                                                 DTSCS1C
00078 *                MODIFIED S1200 TO DISPLAY ERROR IF IDENTICAL     DTSCS1C
00079 *                NAME FOUND FOR ANOTHER EMPLOYER. THIS ERROR      DTSCS1C
00080 *                MAY BE OVERRIDDEN.                               DTSCS1C
00081 *                REFERENCE: REQUEST FROM STATUS PROGRAMMER: GD    DTSCS1C
00082 *                                                                 DTSCS1C
00083 *    06/29/2004  RECOMPILED FOR NEW MPRF WITH ELIG CODE 17 -      DTSCS1C
00084 *                DOMESTIC VIOLENCE.                               DTSCS1C
00085 *                REFERENCE:                     PROGRAMMER: GD    DTSCS1C
00086 *                                                                 DTSCS1C
00087 *    07/15/2004  ADDED S2150 TO CHECK FOR DC ADDRESS. IF          DTSCS1C
00088 *                EMPLOYER IS LIABLE WITH NO DC ADDRESS, DISPLAY   DTSCS1C
00089 *                ERROR MESSAGE UNLESS OPERATOR IS FIELD DESK OR   DTSCS1C
00090 *                ACCOUNTING DESK.                                 DTSCS1C
00091 *                REFERENCE:                     PROGRAMMER: GD    DTSCS1C
00092 *                                                                 DTSCS1C
00093 *    07/22/2004  MODIFIED P8931 (UPDATE MERA) TO SET MERA STATUS  DTSCS1C
00094 *                TO 'SET UP' IF LIABILITY DETERMINED BASED ON     DTSCS1C
00095 *                UC30 AND FR500 RECEIVED DATE = ZERO. THIS WILL   DTSCS1C
00096 *                FORCE THE SYSTEM TO SEND A FIRST LETTER WITH     DTSCS1C
00097 *                AN FR500 FORM.                                   DTSCS1C
00098 *                REFERENCE:                     PROGRAMMER: GD    DTSCS1C
00099 *                                                                 DTSCS1C
00100 *    08/02/2004  MODIFIED S3400 TO PREVENT REACTIVATION IF MORE   DTSCS1C
00101 *                THAN 12 QUARTERS HAVE PASSED BETWEEN THE LAST    DTSCS1C
00102 *                INACTIVATION DATE AND THE NEW LIABILITY DATE.    DTSCS1C
00103 *                IF MORE THAN 12 QUARTERS HAVE PASSED, THE EMPLOYEDTSCS1C
00104 *                MUST BE ASSIGNED A NEW ACCOUNT NUMBER.           DTSCS1C
00105 *                EDITS IN THE SAME PARAGRAPH WILL PREVENT         DTSCS1C
00106 *                REACTIVATION IF THERE IS LESS THAN ONE QUARTER   DTSCS1C
00107 *                BETWEEN THE LAST SPAN OF LIABILITY AND           DTSCS1C
00108 *                THE NEW ONE.                                     DTSCS1C
00109 *                REFERENCE:                     PROGRAMMER: GD    DTSCS1C
00110 *                                                                 DTSCS1C
00111 *    08/27/2004  MODIFIED S1200 TO BYPASS DUP NAME CHECK IF       DTSCS1C
00112 *                MAP PRIMARY NAME = MPRF-PRIMARY-NAME.            DTSCS1C
00113 *                REFERENCE:                     PROGRAMMER: GD    DTSCS1C
00114 *                                                                 DTSCS1C
00115 *    12/03/2004  CORRECTED ERROR MESSAGE E1CS (INACTIVE MORE      DTSCS1C
00116 *                THAN 3 YEARS). THE MESSAGE HAD 8 QUARTERS        DTSCS1C
00117 *                INSTEAD OF 3 YEARS.                              DTSCS1C
00118 *                REFERENCE:                     PROGRAMMER: GD    DTSCS1C
00119 *                                                                 DTSCS1C
00120 *    08/11/2005  MODIFIED P8962 TO PREVENT PRINTING OF A UC-30    DTSCS1C
00121 *                WHEN EMPLOYER WAS MADE LIABLE BASED ON           DTSCS1C
00122 *                RECIPT OF A UC-30.                               DTSCS1C
00123 *                REFERENCE:                     PROGRAMMER: GD    DTSCS1C
00124 *                                                                 DTSCS1C
00125 *    09/18/2006  CHANGED S2150 TO ALLOW STAFF TO BYPASS EDIT      DTSCS1C
00126 *                REQUIRING ENTRY OF A DC ADDRESS. EMPLOYER MAY    DTSCS1C
00127 *                NOW BE MADE LIABLE WITHOUT SUPERVISOR APPROVAL.  DTSCS1C
00128 *                REFERENCE: BOBBY TUCKER        PROGRAMMER: GD    DTSCS1C
00129 *                                                                 DTSCS1C
00130 *    02/26/2009  RECOMPILED FOR NEW VERSION OF MPRF -             DTSCS1C
00131 *                ELIGIBILITY CODE 20 (FAC) ADDED.                 DTSCS1C
00132 *                REFERENCE:                     PROGRAMMER: GD    DTSCS1C
00133 *                                                                 DTSCS1C
00134 *    04/15/2009  REMOVED ERROR MESSAGE E1CI - THIS PREVENTED      DTSCS1C
00135 *                MAKING A HOUSEHOLD EMPLOYER LIABLE BASED ON      DTSCS1C
00136 *                A UC-30 WITH AN ANNUAL SCHEDULE.  THE TERM       DTSCS1C
00137 *                'UC30' INCLUDES THE UC30H.                       DTSCS1C
00138 *                REFERENCE:                     PROGRAMMER: GD    DTSCS1C
00139 *                                                                 DTSCS1C
00140 *    07/14/2009  RECOMPILED FOR NEW VERSION OF MPRF -             DTSCS1C
00141 *                ELIGIBILITY CODES 21 (AB) AND 22 (DEPENDENCY     DTSCS1C
00142 *                ALLOWANCE) ADDED.                                DTSCS1C
00143 *                REFERENCE:                     PROGRAMMER: GD    DTSCS1C
00144 *                                                                 DTSCS1C
00145 *    11/17/2009  RECOMPILED FOR NEW VERSION OF MPRF -             DTSCS1C
00146 *                ELIGIBILITY CODES 24 AND 25 (EUC 2008            DTSCS1C
00147 *                TIERS 3 AND 4) ADDED.                            DTSCS1C
00148 *                REFERENCE:                     PROGRAMMER: GD    DTSCS1C
00149 *                                                                 DTSCS1C
00150 *    12/01/2009  MODIFIED FOR SUPERVISOR APPROVAL OF              DTSCS1C
00151 *                PREDECESSOR/SUCCESSOR RELATIONSHIPS.             DTSCS1C
00152 *                S3300, S4400, S4500, S4600, S4800.               DTSCS1C
00153 *                REFERENCE:                     PROGRAMMER: GD    DTSCS1C
00154 *                                                                 DTSCS1C
00155 *    01/04/2010  MODIFIED P7200 - IF VALID APPROVAL OF            DTSCS1C
00156 *                PREDECESSOR/SUCCESSOR RELATIONSHIP NOT FOUND     DTSCS1C
00157 *                FOR WRK-EMP-NO, TRY PREDECESSOR.                 DTSCS1C
00158 *                REFERENCE:                     PROGRAMMER: GD    DTSCS1C
00159 *                                                                 DTSCS1C
00160 *    09/26/2014  RECOMPILED FOR NEW VERSION OF MPRF -             DTSCS1C
00161 *                ELIGIBILITY CODE  28 (UCPIA)                     DTSCS1C
00162 *                REFERENCE:                     PROGRAMMER: ZL1   DTSCS1C
00163 *                                                                 DTSCS1C
00164 *    03/26/2015  RECOMPILED FOR NEW VERSION OF MPRF -             DTSCS1C
00165 *                ELIGIBILITY CODE  29 (DUA) AND 30 -GPA           DTSCS1C
00166 *                REFERENCE:                     PROGRAMMER: ZL1   DTSCS1C
00167 *                                                                 DTSCS1C
00168 *    09/15/2015  RECOMPILED FOR NEW VERSION OF MPRF -             DTSCS1C
00169 *                ORGANIZATION CODES UNA FIT AND OTH               DTSCS1C
00170 *                REFERENCE:                     PROGRAMMER: ZL1   DTSCS1C
00171 *                                                                 DTSCS1C
00172 *                                                                 DTSCS1C
00173 *    03/09/2018  CORRECTED WORK QTRS DIFFERENCE. INACTIVE MORE    DTSCS1C
00174 *                THAN 3 YEARS (13 QUARTERS) PROGRAM WAS STOPPING  DTSCS1C
00175 *                REACTIVATION WHEN INACTIVE FOR 12 QUARTERS       DTSCS1C
00176 *                REFERENCE:                     PROGRAMMER: ZL1   DTSCS1C
00177 *                                                                 DTSCS1C
00178 *    04/24/2020  RECOMPILED FOR NEW VERSION OF MPRF -             DTSCS1C
00179 *                ELIGIBILITY CODE  34 (PEUC)                      DTSCS1C
00180 *                REFERENCE:                     PROGRAMMER: ZL1   DTSCS1C
00181 *                                                                 DTSCS1C
00182 *    05/08/2020  RECOMPILED FOR NEW VERSION OF MPRF -             DTSCS1C
00183 *                ELIGIBILITY CODE  35 (REUR)                      DTSCS1C
00184 *                REFERENCE:                     PROGRAMMER: ZL1   DTSCS1C
00185 *                                                                 DTSCS1C
00186 *    09/02/2020  RECOMPILED FOR NEW VERSION OF MPRF -             DTSCS1C
00187 *                ELIGIBILITY CODE  36 (LWA)                       DTSCS1C
00188 *                REFERENCE:                     PROGRAMMER: ZL1   DTSCS1C
00189 *                                                                 DTSCS1C
00190 *    12/05/2020  RECOMPILED FOR NEW VERSION OF MPRF -             DTSCS1C
00191 *                ELIGIBILITY CODE  37 PUA SITMULUS                DTSCS1C
00192 *                REFERENCE:                     PROGRAMMER: ZL1   DTSCS1C
00193 *                                                                 DTSCS1C
00194 *    02/16/2021  RECOMPILED FOR NEW VERSION OF MPRF -             DTSCS1C
00195 *                ELIGIBILITY CODE  38 MEUC                        DTSCS1C
00196 *                REFERENCE:                     PROGRAMMER: ZL1   DTSCS1C
00197 *                                                                 DTSCS1C
00198 *    12/06/2021  RECOMPILED FOR NEW VERSION OF MPRF -             DTSCS1C
00199 *                ELIGIBILITY CODE  39 DUC                         DTSCS1C
00200 *                REFERENCE:                     PROGRAMMER: ZL1   DTSCS1C
00201 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCS1C
00202 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCS1C
00203 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSCS1C
00204 *                                                                 DTSCS1C
00205 *  DESCRIPTION:                                                   DTSCS1C
00206 *                                                                 DTSCS1C
00207 *                                                                 DTSCS1C
00208 *    CLEAR:                                                       DTSCS1C
00209 *                                                                 DTSCS1C
00210 *      FIELD DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO)             DTSCS1C
00211 *                                                                 DTSCS1C
00212 *                                                                 DTSCS1C
00213 *    JUMP:                                                        DTSCS1C
00214 *                                                                 DTSCS1C
00215 *      F17  REGISTRATION INQUIRY (11).                            DTSCS1C
00216 *      F21  TAX ADDRESS INQUIRY/UPDATE (13).                      DTSCS1C
00217 *                                                                 DTSCS1C
00218 *                                                                 DTSCS1C
00219 *    INQUIRY:                                                     DTSCS1C
00220 *                                                                 DTSCS1C
00221 *      CONTROL FIELD(S): MAP-EMP-NO.                              DTSCS1C
00222 *                                                                 DTSCS1C
00223 *      JUMP IN: DISPLAY DATA ASSOCIATED WITH LCCM-EMP-NO.         DTSCS1C
00224 *                                                                 DTSCS1C
00225 *      ENTER: DISPLAY DATA ASSOCIATED WITH MAP-EMP-NO.            DTSCS1C
00226 *                                                                 DTSCS1C
00227 *      STANDARD LCCM-EMP-NO MAINTENANCE.                          DTSCS1C
00228 *                                                                 DTSCS1C
00229 *                                                                 DTSCS1C
00230 *    UPDATE:                                                      DTSCS1C
00231 *                                                                 DTSCS1C
00232 *      MOD:                                                       DTSCS1C
00233 *                                                                 DTSCS1C
00234 *        ADDS A 'LIABILITY DETERMINATION" TO THE EMPLOYER.  OF    DTSCS1C
00235 *        COURSE, THE RECORD TYPES ADDED, DELETED, OR MODIFIED     DTSCS1C
00236 *        DEPENDS ON THE DETERMINATION (LIABLE OR NOT LIABLE)      DTSCS1C
00237 *        AND THE INFORMATION INPUT WITH THE DETERMINATION         DTSCS1C
00238 *        (RELATIONSHIP, RATES).                                   DTSCS1C
00239 *                                                                 DTSCS1C
00240 *        A 'MOD' REQUIRES THE FOLLOWING CONDITIONS EXIST:         DTSCS1C
00241 *                                                                 DTSCS1C
00242 *         1.  NOT MPRF-CLASS-CHG-ONLY-88; AND,                    DTSCS1C
00243 *                                                                 DTSCS1C
00244 *         2.  NOT MPRF-STATUS-ACT-88; AND,                        DTSCS1C
00245 *                                                                 DTSCS1C
00246 *         3.  NOT MPRF-BANKRP-OPEN-88; AND,                       DTSCS1C
00247 *                                                                 DTSCS1C
00248 *         4.  MAP-EMP-NO IS NOT THE PREDECESSOR IN                DTSCS1C
00249 *             A "CHANGE OF OWNERSHIP" OR "ACQUISITION             DTSCS1C
00250 *             /CONSOLIDATION/MERGER" RELATIONSHIP.                DTSCS1C
00251 *                                                                 DTSCS1C
00252 *         'ADD' MAY CAUSE UPDATE OF BOTH MAP-EMP-NO AND           DTSCS1C
00253 *         MAP-PRED-EMP-NO.  IF MAP-PRED-INACT-CD IS INPUT, THEN   DTSCS1C
00254 *         MAP-PRED-EMP-NO MUST BE INCATIVATED.                    DTSCS1C
00255 *                                                                 DTSCS1C
00256 *         IF MAP-LIAB-IND = 'N', THEN MAP-LIAB-CD,                DTSCS1C
00257 *         MAP-PRED-EMP-NO, MAP-RATE-EFF-YRQ(S) MAY NOT BE         DTSCS1C
00258 *         INPUT; HOWEVER MAP-ATTN THRU MAP-FEIN MAY BE            DTSCS1C
00259 *         MODIFIED.                                               DTSCS1C
00260 *                                                                 DTSCS1C
00261 *         IF NO MERA OR MERB RECORD EXISTS, THEN ADD AN           DTSCS1C
00262 *         MERA RECORD WITH MERA-STATUS-CD EQUAL TO EITHER         DTSCS1C
00263 *         '21' OR '31'.                                           DTSCS1C
00264 *                                                                 DTSCS1C
00265 *         IF AN "ACTIVE" (MERA/B-STATUS-CD 00 THROUGH 11) MERA/B  DTSCS1C
00266 *         RECORD EXISTS, THEN RECORD THE RESULT OF THE LIABILITY  DTSCS1C
00267 *         DETERMINATION IN THE ACTIVE MERA/B RECORD.              DTSCS1C
00268 *                                                                 DTSCS1C
00269 *         IF AN AN MERA OR MERB RECORD EXISTS, BUT NEITHER RECORD DTSCS1C
00270 *         IS "ACTIVE", THEN RECORD THE RESULT OF THE LIABILITY    DTSCS1C
00271 *         DETERMINATION IN THE RECORD WHICH EXISTS (IF THEY BOTH  DTSCS1C
00272 *         EXIST, THEN RECORD THE RESULTS OF THE DETERMINATION IN  DTSCS1C
00273 *         MERA).                                                  DTSCS1C
00274 *                                                                 DTSCS1C
00275 *         IF MAP-FOLLOW-UP-DATE IS ENTERED, THEN WRITE A MTCK     DTSCS1C
00276 *         RECORD WITH TICKLER DESTINATION EQUAL TO 'STATUS' AND   DTSCS1C
00277 *         A TICKLER TRIGGER DATE EQUAL TO MAP-FOLLOW-UP-DATE.     DTSCS1C
00278 *                                                                 DTSCS1C
00279 *                                                                 DTSCS1C
00280 *    RECORDS READ:                                                DTSCS1C
00281 *                                                                 DTSCS1C
00282 *      MASTER:                                                    DTSCS1C
00283 *                                                                 DTSCS1C
00284 *        MPRF                                                     DTSCS1C
00285 *        MTAD                                                     DTSCS1C
00286 *        MSOL                                                     DTSCS1C
00287 *        MRTE                                                     DTSCS1C
00288 *        MREL                                                     DTSCS1C
00289 *        MERA                                                     DTSCS1C
00290 *        MQTR                                                     DTSCS1C
00291 *                                                                 DTSCS1C
00292 *                                                                 DTSCS1C
00293 *      ALTERNATE INDEX:                                           DTSCS1C
00294 *                                                                 DTSCS1C
00295 *        IPES.                                                    DTSCS1C
00296 *                                                                 DTSCS1C
00297 *                                                                 DTSCS1C
00298 *      REFERENCE:                                                 DTSCS1C
00299 *                                                                 DTSCS1C
00300 *        NONE.                                                    DTSCS1C
00301 *                                                                 DTSCS1C
00302 *                                                                 DTSCS1C
00303 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS1C
00304 *                                                                 DTSCS1C
00305 *        NONE.                                                    DTSCS1C
00306 *                                                                 DTSCS1C
00307 *                                                                 DTSCS1C
00308 *    RECORDS UPDATED:                                             DTSCS1C
00309 *                                                                 DTSCS1C
00310 *      MASTER:                                                    DTSCS1C
00311 *                                                                 DTSCS1C
00312 *        MPRF (REWRITE)                                           DTSCS1C
00313 *        MTAD (WRITE, REWRITE)                                    DTSCS1C
00314 *        MSOL (WRITE, REWRITE)                                    DTSCS1C
00315 *        MRTE (WRITE)                                             DTSCS1C
00316 *        MREL (WRITE)                                             DTSCS1C
00317 *        MERA (WRITE, REWRITE)                                    DTSCS1C
00318 *        MERD (WRITE)                                             DTSCS1C
00319 *        MTCK (WRITE)                                             DTSCS1C
00320 *                                                                 DTSCS1C
00321 *                                                                 DTSCS1C
00322 *      REFERENCE:                                                 DTSCS1C
00323 *                                                                 DTSCS1C
00324 *        NONE.                                                    DTSCS1C
00325 *                                                                 DTSCS1C
00326 *                                                                 DTSCS1C
00327 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS1C
00328 *                                                                 DTSCS1C
00329 *        NONE.                                                    DTSCS1C
00330 *                                                                 DTSCS1C
00331 *                                                                 DTSCS1C
00332 *    ON-LINE ACTIVITY FILE RECORDS WRITTEN:                       DTSCS1C
00333 *                                                                 DTSCS1C
00334 *      IF MAP-UI-LIABLE-IND = 'N'                                 DTSCS1C
00335 *             AND                                                 DTSCS1C
00336 *         MAP-NOT-LIABLE-LTR-TYPE NOT = 'N'                       DTSCS1C
00337 *                                                                 DTSCS1C
00338 *        DTSIT001 WITH T001-TRN-CD = 02 (NOT-LIABLE-LTR).         DTSCS1C
00339 *                                                                 DTSCS1C
00340 *                                                                 DTSCS1C
00341 *      IF MAP-UI-LIABLE-IND = 'Y'                                 DTSCS1C
00342 *                                                                 DTSCS1C
00343 *        DTSIT001 WITH T001-TRN-CD = 02 (LIABLE-PKG)              DTSCS1C
00344 *                                                                 DTSCS1C
00345 *        DTSIT001 WITH T001-TRN-CD = 06 (FILE CLERK LIST)         DTSCS1C
00346 *                                                                 DTSCS1C
00347 *        DTSIT006 WITH T006-TRN-CD = 01 (RTE EXIST CHECK)         DTSCS1C
00348 *                                                                 DTSCS1C
00349 *        DTSIT031 WITH T031-TRN-CD = 01 (AUTO PROCESS)            DTSCS1C
00350 *                                                                 DTSCS1C
00351 *        DTSIT036 WITH T036-TRN-CD = 01 (LIAB DETERM)             DTSCS1C
00352 *                                                                 DTSCS1C
00353 *                                                                 DTSCS1C
00354 *        IF MAP-AUTO-WAIVER INFORMATION ENTERED                   DTSCS1C
00355 *                                                                 DTSCS1C
00356 *          DTSIT036(S) WITH T036-TRN-CD = 01 (AUTO WAIVER)        DTSCS1C
00357 *                                                                 DTSCS1C
00358 *        END-IF                                                   DTSCS1C
00359 *                                                                 DTSCS1C
00360 *                                                                 DTSCS1C
00361 *        IF MAP-INAC-CD IS ENTERED (INACTIVATED)                  DTSCS1C
00362 *                                                                 DTSCS1C
00363 *          DTSIT036 WITH T036-TRN-CD = 03 (PRED UI5 CHECK)        DTSCS1C
00364 *                                                                 DTSCS1C
00365 *          IF MAP-INAC-LTR-TYPE NOT EQUAL TO 'N'                  DTSCS1C
00366 *                                                                 DTSCS1C
00367 *            DTSIT001 WITH T001-TRN-CD = 03 (INACTIVE-LTR)        DTSCS1C
00368 *                                                                 DTSCS1C
00369 *          END-IF                                                 DTSCS1C
00370 *                                                                 DTSCS1C
00371 *        END-IF                                                   DTSCS1C
00372 *                                                                 DTSCS1C
00373 *                                                                 DTSCS1C
00374 *        IF MAP-PRED-INAC-CD IS ENTERED (PREDECESSOR INACTIVATED) DTSCS1C
00375 *                                                                 DTSCS1C
00376 *          DTSIT036 WITH T036-TRN-CD = 03 (PRED UI5 CHECK)   PRED DTSCS1C
00377 *                                                                 DTSCS1C
00378 *          DTSIT001 WITH T001-TRN-CD = 06 (FILE CLERK LIST)  PRED DTSCS1C
00379 *                                                                 DTSCS1C
00380 *          DTSIT031 WITH T031-TRN-CD = 01 (AUTO PROCESS)     PRED DTSCS1C
00381 *                                                                 DTSCS1C
00382 *          IF MAP-PRED-INAC-LTR-TYPE NOT EQUAL TO 'N'        PRED DTSCS1C
00383 *                                                                 DTSCS1C
00384 *            DTSIT001 WITH T001-TRN-CD = 03 (INACTIVE-LTR)   PRED DTSCS1C
00385 *                                                                 DTSCS1C
00386 *          END-IF                                                 DTSCS1C
00387 *                                                                 DTSCS1C
00388 *        END-IF                                                   DTSCS1C
00389 *                                                                 DTSCS1C
00390 *      END-IF                                                     DTSCS1C
00391 *                                                                 DTSCS1C
00392 *                                                                 DTSCS1C
00393 *    MODULES LINKED TO:                                           DTSCS1C
00394 *                                                                 DTSCS1C
00395 *      DTSCU001  DATE EDIT/CONVERSION.                            DTSCS1C
00396 *      DTSCU004  YEAR/QUARTER EDIT/CONVERSION.                    DTSCS1C
00397 *      DTSCU006  RATING YEAR PERIOD START/END.                    DTSCS1C
00398 *      DTSCU012  RATE FROM SCREEN FORMAT/EDIT.                    DTSCS1C
00399 *      DTSCU013  COUNT FROM SCREEN FORMAT/EDIT.                   DTSCS1C
00400 *      DTSCU015  DATE FROM SCREEN FORMAT/EDIT.                    DTSCS1C
00401 *      DTSCU016  YEAR/QUARTER FROM SCREEN FORMAT/EDIT.            DTSCS1C
00402 *      DTSCU017  FEIN FROM SCREEN FORMAT/EDIT.                    DTSCS1C
00403 *      DTSCU018  EMP NO FROM SCREEN FORMAT/EDIT.                  DTSCS1C
00404 *      DTSCU021  TELEPHONE NUMBER FROM SCREEN FORMAT/EDIT.        DTSCS1C
00405 *      DTSCU031  EMPLOYER REGISTRATION CODES EDIT/DESCRIPTION.    DTSCS1C
00406 *      DTSCU052  UI RATE EDIT.                                    DTSCS1C
00407 *      DTSCU056  RATE DISPLAY.                                    DTSCS1C
00408 *      DTSCU072  ADDRESS EDIT.                                    DTSCS1C
00409 *      DTSCU073  TELEPHONE NUMBER EDIT.                           DTSCS1C
00410 *      DTSCU074  DUPLICATE FEIN EDIT.                             DTSCS1C
00411 *      DTSCU201  DETERMINE EMPLOYER CLASS.                        DTSCS1C
00412 *      DTSCU202  DETERMINE ELIGIBLE CODE.                         DTSCS1C
00413 *      DTSCU203  DETERMINE FIELD ZIP CODE                         DTSCS1C
00414 *      DTSCU221  MPRF-UPDATE DATA ELEMENT MAINTENANCE.            DTSCS1C
00415 *      DTSCU331  WRITE MAINTENANCE LIST REPORT RECORDS.           DTSCS1C
00416 *      DTSCU810  MASTER FILE INPUT/OUTPUT.                        DTSCS1C
00417 *      DTSCU825  ON-LINE ACTIVITY FILE OUTPUT.                    DTSCS1C
00418 *                                                                 DTSCS1C
00419 *                                                                 DTSCS1C
00420 *    VERMONT REFERENCE:                                           DTSCS1C
00421 *                                                                 DTSCS1C
00422 *      TXC320C                                                    DTSCS1C
00423 *                                                                 DTSCS1C
00424 *****                                                             DTSCS1C
00425      SKIP3                                                        DTSCS1C
00426  ENVIRONMENT DIVISION.                                            DTSCS1C
00427      SKIP3                                                        DTSCS1C
00428  DATA DIVISION.                                                   DTSCS1C
00429      SKIP3                                                        DTSCS1C
00430  WORKING-STORAGE SECTION.                                         DTSCS1C
004305 77  PAN-VALET PICTURE X(24) VALUE '100DTSCS1C   12/08/21'.       DTSCS1C
00431  77  PAN-VALET PICTURE X(24) VALUE '002DTSCS1C   12/07/21'.       DTSCS1C
00432  77  PAN-VALET PICTURE X(24) VALUE '098DTSCS1C   02/16/21'.       DTSCS1C
00433  77  PAN-VALET PICTURE X(24) VALUE '002DTSCS1C   02/16/21'.       DTSCS1C
00434  77  PAN-VALET PICTURE X(24) VALUE '096DTSCS1C   12/07/20'.       DTSCS1C
00435  77  PAN-VALET PICTURE X(24) VALUE '003DTSCS1C   12/07/20'.       DTSCS1C
00436  77  PAN-VALET PICTURE X(24) VALUE '094DTSCS1C   05/08/20'.       DTSCS1C
00437  77  PAN-VALET PICTURE X(24) VALUE '002DTSCS1C   05/08/20'.       DTSCS1C
00438  77  PAN-VALET PICTURE X(24) VALUE '092DTSCS1C   04/27/20'.       DTSCS1C
00439  77  PAN-VALET PICTURE X(24) VALUE '007DTSCS1C   04/25/20'.       DTSCS1C
00440  77  PAN-VALET PICTURE X(24) VALUE '090DTSCS1C   03/25/15'.       DTSCS1C
00441  77  PAN-VALET PICTURE X(24) VALUE '002DTSCS1C   03/25/15'.       DTSCS1C
00442  77  PAN-VALET PICTURE X(24) VALUE '088DTSCS1C   10/01/14'.       DTSCS1C
00443  77  PAN-VALET PICTURE X(24) VALUE '002DTSCS1C   09/26/14'.       DTSCS1C
00444  77  PAN-VALET PICTURE X(24) VALUE '086DTSCS1C   01/14/10'.       DTSCS1C
00445      SKIP3                                                        DTSCS1C
00446  01  WRK-AREA.                                                    DTSCS1C
00447      05  WRK-ABEND-CD                PIC  X(04)  VALUE 'S1C '.    DTSCS1C
00448                                                                   DTSCS1C
00449      05  WRK-SCR-ID                  PIC  X(02)  VALUE '1C'.      DTSCS1C
00450                                                                   DTSCS1C
00451      05  WRK-F03-SCR-ID              PIC  X(02)  VALUE '10'.      DTSCS1C
00452                                                                   DTSCS1C
00453                                                                   DTSCS1C
00454      05  ALL-NINES-DATE              PIC S9(09)  COMP-3           DTSCS1C
00455                                             VALUE +999999999.     DTSCS1C
00456                                                                   DTSCS1C
00457      05  ALL-NINES-YRQ               PIC S9(05)  COMP-3           DTSCS1C
00458                                             VALUE +99999.         DTSCS1C
00459                                                                   DTSCS1C
00460 ***  ANNUAL REPORTING NOT ALLOWED PRIOR TO THIS DATE ***          DTSCS1C
00461      05  WRK-FIRST-ANNUAL-YRQ        PIC S9(05)  COMP-3           DTSCS1C
00462                                             VALUE +20021.         DTSCS1C
00463                                                                   DTSCS1C
00464      05  RTE-OCC-MAX                 PIC S9(04)  COMP  VALUE +6.  DTSCS1C
00465      SKIP3                                                        DTSCS1C
00466      05  SCR-ACCESS-IND              PIC X(01).                   DTSCS1C
00467          88  SCR-ACCESS-INQ                  VALUE '1'.           DTSCS1C
00468          88  SCR-ACCESS-UPDATE               VALUE '2'.           DTSCS1C
00469                                                                   DTSCS1C
00470      05  CURSOR-SET-IND              PIC X(01).                   DTSCS1C
00471          88  CURSOR-SET-YES                  VALUE 'Y'.           DTSCS1C
00472          88  CURSOR-SET-NO                   VALUE 'N'.           DTSCS1C
00473          88  CURSOR-SET-GOTO                 VALUE 'G'.           DTSCS1C
00474                                                                   DTSCS1C
00475      05  REQ-IND                     PIC X(01).                   DTSCS1C
00476          88  REQ-ERROR                       VALUE 'O'.           DTSCS1C
00477          88  REQ-JUMP                        VALUE 'J'.           DTSCS1C
00478          88  REQ-INQUIRE                     VALUE 'I'.           DTSCS1C
00479          88  REQ-CLEAR                       VALUE 'C'.           DTSCS1C
00480          88  REQ-EDIT                        VALUE 'E'.           DTSCS1C
00481          88  REQ-UPDATE                      VALUE 'U'.           DTSCS1C
00482          88  REQ-CURSOR-TO-GOTO              VALUE 'G'.           DTSCS1C
00483                                                                   DTSCS1C
00484      05  RESP-IND                    PIC X(01).                   DTSCS1C
00485          88  RESP-SEND-MSGONLY               VALUE 'O'.           DTSCS1C
00486          88  RESP-SEND-MAP                   VALUE 'M'.           DTSCS1C
00487          88  RESP-JUMP                       VALUE 'J'.           DTSCS1C
00488          88  RESP-CURSOR-TO-GOTO             VALUE 'G'.           DTSCS1C
00489                                                                   DTSCS1C
00490      05  WRK-MSG-AREA                PIC  X(64).                  DTSCS1C
00491                                                                   DTSCS1C
00492      05  WRK-ATB-AN                  PIC  X(01).                  DTSCS1C
00493                                                                   DTSCS1C
00494      05  WRK-ATB-NUM                 PIC  X(01).                  DTSCS1C
00495                                                                   DTSCS1C
00496                                                                   DTSCS1C
00497      05  WRK-EMP-NO                  PIC S9(07)  COMP-3.          DTSCS1C
00498                                                                   DTSCS1C
00499                                                                   DTSCS1C
00500      05  WRK-DISPLAY                 PIC 9(11).                   DTSCS1C
00501                                                                   DTSCS1C
00502      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS1C
00503          10  FILLER                  PIC X(05).                   DTSCS1C
00504          10  WRK-DISPLAY-EMP-NO-1    PIC X(03).                   DTSCS1C
00505          10  WRK-DISPLAY-EMP-NO-2    PIC X(03).                   DTSCS1C
00506                                                                   DTSCS1C
00507      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS1C
00508          10  FILLER                  PIC X(05).                   DTSCS1C
00509          10  WRK-DISPLAY-YR          PIC X(02).                   DTSCS1C
00510          10  WRK-DISPLAY-MO          PIC X(02).                   DTSCS1C
00511          10  WRK-DISPLAY-DA          PIC X(02).                   DTSCS1C
00512                                                                   DTSCS1C
00513      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS1C
00514          10  FILLER                  PIC X(08).                   DTSCS1C
00515          10  WRK-DISPLAY-QTR-YR      PIC X(02).                   DTSCS1C
00516          10  WRK-DISPLAY-QTR-Q       PIC X(01).                   DTSCS1C
00517                                                                   DTSCS1C
00518      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS1C
00519          10  FILLER                  PIC X(02).                   DTSCS1C
00520          10  WRK-DISPLAY-FEIN-1      PIC X(02).                   DTSCS1C
00521          10  WRK-DISPLAY-FEIN-2      PIC X(07).                   DTSCS1C
00522                                                                   DTSCS1C
00523                                                                   DTSCS1C
00524      05  HOLD-ATTRB-AREA.                                         DTSCS1C
00525          10  HOLD-ATTN-LINE-A        PIC  X(01).                  DTSCS1C
00526          10  HOLD-DELIV-LINE-1-A     PIC  X(01).                  DTSCS1C
00527          10  HOLD-DELIV-LINE-2-A     PIC  X(01).                  DTSCS1C
00528          10  HOLD-CITY-A             PIC  X(01).                  DTSCS1C
00529          10  HOLD-ST-A               PIC  X(01).                  DTSCS1C
00530          10  HOLD-ZIP-A              PIC  X(01).                  DTSCS1C
00531                                                                   DTSCS1C
00532                                                                   DTSCS1C
00533      05  WRK-DISPLAY-PERCENT.                                     DTSCS1C
00534          10  WRK-DISPLAY-PERCENT-9   PIC  ZZ9.99.                 DTSCS1C
00535          10  FILLER                  PIC  X(01)  VALUE '%'.       DTSCS1C
00536                                                                   DTSCS1C
00537                                                                   DTSCS1C
00538      05  WRK-EMP-CLASS               PIC  X(01).                  DTSCS1C
00539          88 WRK-EMP-RATED-88                VALUE 'R'.            DTSCS1C
00540          88 WRK-EMP-SELF-INSURED-88         VALUE 'S'.            DTSCS1C
00541                                                                   DTSCS1C
00542                                                                   DTSCS1C
00543      05  WRK-LIAB-DATE               PIC S9(09)  COMP-3.          DTSCS1C
00544                                                                   DTSCS1C
00545      05  WRK-INACT-DATE              PIC S9(09)  COMP-3.          DTSCS1C
00546                                                                   DTSCS1C
00547      05  WRK-FIRST-LIAB-YRQ          PIC S9(05) COMP-3.           DTSCS1C
00548                                                                   DTSCS1C
00549      05  WRK-LAST-LIAB-YRQ           PIC S9(05) COMP-3.           DTSCS1C
00550                                                                   DTSCS1C
00551      05  WRK-LAST-INACT-YRQ          PIC S9(05) COMP-3.           DTSCS1C
00552      05  WRK-LAST-INACT-ABS-QTR      PIC S9(04) COMP.             DTSCS1C
00553      05  WRK-DIFF                    PIC S9(04) COMP.             DTSCS1C
00554                                                                   DTSCS1C
00555                                                                   DTSCS1C
00556 *****05  WRK-BNK-END-DATE            PIC S9(09)  COMP-3.          DTSCS1C
00557                                                                   DTSCS1C
00558                                                                   DTSCS1C
00559      05  WRK-SUB1                    PIC S9(04)  COMP.            DTSCS1C
00560                                                                   DTSCS1C
00561      05  WRK-SUB2                    PIC S9(04)  COMP.            DTSCS1C
00562                                                                   DTSCS1C
00563      05  WRK-SUB3                    PIC S9(04)  COMP.            DTSCS1C
00564                                                                   DTSCS1C
00565      05  WRK-ERR-IND                 PIC  X(01).                  DTSCS1C
00566          88  WRK-ERR-NO                     VALUE 'N'.            DTSCS1C
00567          88  WRK-ERR-YES                    VALUE 'Y'.            DTSCS1C
00568                                                                   DTSCS1C
00569      05  WRK-RATE-AREA OCCURS 6 TIMES.                            DTSCS1C
00570          10  WRK-RATE-YRQ            PIC S9(05)  COMP-3.          DTSCS1C
00571          10  WRK-RATE-UI-RATE        PIC S9(01)V9(04)  COMP-3.    DTSCS1C
00572                                                                   DTSCS1C
00573      05  WRK-RTE-START-YRQ           PIC S9(05)  COMP-3.          DTSCS1C
00574                                                                   DTSCS1C
00575      05  WRK-RTE-END-YRQ             PIC S9(05)  COMP-3.          DTSCS1C
00576                                                                   DTSCS1C
00577      05  WRK-RTE-LAST-YRQ            PIC S9(05)  COMP-3.          DTSCS1C
00578                                                                   DTSCS1C
00579      05  WRK-BLANK-IND               PIC  X(01).                  DTSCS1C
00580          88  WRK-BLANK-YES                  VALUE 'Y'.            DTSCS1C
00581          88  WRK-BLANK-NO                   VALUE 'N'.            DTSCS1C
00582                                                                   DTSCS1C
00583                                                                   DTSCS1C
00584      05  WRK-WAIVER-START-YRQ        PIC S9(05)  COMP-3.          DTSCS1C
00585                                                                   DTSCS1C
00586      05  WRK-WAIVER-END-YRQ          PIC S9(05)  COMP-3.          DTSCS1C
00587                                                                   DTSCS1C
00588      05  WRK-WAIVER-EXT-DATE         PIC S9(09)  COMP-3.          DTSCS1C
00589                                                                   DTSCS1C
00590                                                                   DTSCS1C
00591      05  WRK-PRED-EMP-NO             PIC S9(07)  COMP-3.          DTSCS1C
00592                                                                   DTSCS1C
00593      05  WRK-PRED-LOCKED-IND         PIC  X(01).                  DTSCS1C
00594          88  WRK-PRED-LOCKED-NO-88          VALUE 'N'.            DTSCS1C
00595          88  WRK-PRED-LOCKED-YES-88         VALUE 'Y'.            DTSCS1C
00596                                                                   DTSCS1C
00597      05  WRK-PRED-ACTIVE-IND         PIC  X(01).                  DTSCS1C
00598          88  WRK-PRED-ACTIVE-YES-88         VALUE 'Y'.            DTSCS1C
00599          88  WRK-PRED-ACTIVE-NO-88          VALUE 'N'.            DTSCS1C
00600                                                                   DTSCS1C
00601      05  WRK-PRED-MAX-INACT-DATE     PIC S9(09)  COMP-3.          DTSCS1C
00602                                                                   DTSCS1C
00603      05  WRK-PRED-EXP-TRNSF-IND      PIC  X(01).                  DTSCS1C
00604          88  WRK-PRED-EXP-TRNSF-NO-88        VALUE 'N'.           DTSCS1C
00605          88  WRK-PRED-EXP-TRNSF-YES-88       VALUE 'Y'.           DTSCS1C
00606                                                                   DTSCS1C
00607      05  WRK-PRED-WITHDRAW-CNT       PIC S9(04)  COMP.            DTSCS1C
00608                                                                   DTSCS1C
00609      05  WRK-PRED-TRANSFER-CNT       PIC S9(04)  COMP.            DTSCS1C
00610                                                                   DTSCS1C
00611      05  WRK-PRED-WITHDRAW-IND       PIC  X(01).                  DTSCS1C
00612                                                                   DTSCS1C
00613      05  WRK-PRED-TRANSFER-IND       PIC  X(01).                  DTSCS1C
00614                                                                   DTSCS1C
00615                                                                   DTSCS1C
00616      05  TBL-CNT                     PIC S9(04)  COMP.            DTSCS1C
00617                                                                   DTSCS1C
00618      05  TBL-ENTRY OCCURS 50 TIMES.                               DTSCS1C
00619          10  TBL-FIRST-YRQ           PIC S9(05)  COMP-3.          DTSCS1C
00620          10  TBL-LAST-YRQ            PIC S9(05)  COMP-3.          DTSCS1C
00621                                                                   DTSCS1C
00622                                                                   DTSCS1C
00623      05  WRK-MTAD-IND                PIC  X(01).                  DTSCS1C
00624          88  WRK-MTAD-YES-88                VALUE 'Y'.            DTSCS1C
00625          88  WRK-MTAD-NO-88                 VALUE 'N'.            DTSCS1C
00626                                                                   DTSCS1C
00627      05  WRK-DC-ADDR-IND             PIC  X(01).                  DTSCS1C
00628          88  WRK-DC-ADDR-YES-88             VALUE 'Y'.            DTSCS1C
00629          88  WRK-DC-ADDR-NO-88              VALUE 'N'.            DTSCS1C
00630      05  WRK-PO-BOX-IND              PIC  X(01).                  DTSCS1C
00631          88  WRK-PO-BOX-YES-88              VALUE 'Y'.            DTSCS1C
00632          88  WRK-PO-BOX-NO-88               VALUE 'N'.            DTSCS1C
00633                                                                   DTSCS1C
00634      05  HOLD-EMP-STATUS             PIC  X(01).                  DTSCS1C
00635                                                                   DTSCS1C
00636      05  HOLD-FIRST-LIAB-YRQ         PIC S9(05)  COMP-3.          DTSCS1C
00637                                                                   DTSCS1C
00638                                                                   DTSCS1C
00639      05  WRK-MERA-IND                PIC  X(01).                  DTSCS1C
00640          88  WRK-MERA-NONE-88                VALUE 'N'.           DTSCS1C
00641          88  WRK-MERA-ACTIVE-88              VALUE 'A'.           DTSCS1C
00642          88  WRK-MERA-INACTIVE-88            VALUE 'I'.           DTSCS1C
00643                                                                   DTSCS1C
00644      05  WRK-MSOL-CNT                PIC S9(03)  COMP-3           DTSCS1C
00645                                              VALUE +0.            DTSCS1C
00646                                                                   DTSCS1C
00647      05  WRK-PRIOR-YRQ               PIC S9(05) COMP-3.           DTSCS1C
00648      05  WRK-OLD-YRQ                 PIC  9(05).                  DTSCS1C
00649      05  FILLER REDEFINES WRK-OLD-YRQ.                            DTSCS1C
00650          10  WRK-OLD-YEAR            PIC  9(04).                  DTSCS1C
00651          10  WRK-OLD-Q               PIC  9(01).                  DTSCS1C
00652                                                                   DTSCS1C
00653      05  WRK-NEW-YRQ                 PIC  9(05).                  DTSCS1C
00654      05  FILLER REDEFINES WRK-NEW-YRQ.                            DTSCS1C
00655          10  WRK-NEW-YEAR            PIC  9(04).                  DTSCS1C
00656          10  WRK-NEW-Q               PIC  9(01).                  DTSCS1C
00657                                                                   DTSCS1C
00658      EJECT                                                        DTSCS1C
00659  01  MSG-LITERALS.                                                DTSCS1C
00660      05  MSG-E1C1-AREA.                                           DTSCS1C
00661          10  FILLER                  PIC  X(04)  VALUE 'E1C1'.    DTSCS1C
00662          10  FILLER                  PIC  X(30)                   DTSCS1C
00663                VALUE 'OVERLAPPING SPANS OF LIABILITY'.            DTSCS1C
00664          10  FILLER                  PIC  X(30)                   DTSCS1C
00665                VALUE ' ARE NOT ALLOWED.             '.            DTSCS1C
00666                                                                   DTSCS1C
00667      05  MSG-E1C2-AREA.                                           DTSCS1C
00668          10  FILLER                  PIC  X(04)  VALUE 'E1C2'.    DTSCS1C
00669          10  FILLER                  PIC  X(30)                   DTSCS1C
00670                VALUE 'PRED AND SUC EMP CLASS DIFFER '.            DTSCS1C
00671          10  FILLER                  PIC  X(30)                   DTSCS1C
00672                VALUE ' NO EXP TRNSF ALLOWED         '.            DTSCS1C
00673                                                                   DTSCS1C
00674      05  MSG-E1C3-AREA.                                           DTSCS1C
00675          10  FILLER                  PIC  X(04)  VALUE 'E1C3'.    DTSCS1C
00676          10  FILLER                  PIC  X(30)                   DTSCS1C
00677                VALUE 'CHARGING ONLY EMPLOYER  DETERM'.            DTSCS1C
00678          10  FILLER                  PIC  X(30)                   DTSCS1C
00679                VALUE 'INATION ENTRY NOT ALLOWED     '.            DTSCS1C
00680                                                                   DTSCS1C
00681      05  MSG-E1C4-AREA.                                           DTSCS1C
00682          10  FILLER                  PIC  X(04)  VALUE 'E1C4'.    DTSCS1C
00683          10  FILLER                  PIC  X(30)                   DTSCS1C
00684                VALUE 'ACTIVE EMPLOYER  DETERMINATION'.            DTSCS1C
00685          10  FILLER                  PIC  X(30)                   DTSCS1C
00686                VALUE ' ENTRY NOT ALLOWED            '.            DTSCS1C
00687                                                                   DTSCS1C
00688      05  MSG-E1C5-AREA.                                           DTSCS1C
00689          10  FILLER                  PIC  X(04)  VALUE 'E1C5'.    DTSCS1C
00690          10  FILLER                  PIC  X(30)                   DTSCS1C
00691                VALUE '1 YEAR REQUIRED BETWEEN SPANS:'.            DTSCS1C
00692          10  FILLER                  PIC  X(30)                   DTSCS1C
00693                VALUE ' REVERSE PRIOR INACTIVATION   '.            DTSCS1C
00694                                                                   DTSCS1C
00695      05  MSG-E1C6-AREA.                                           DTSCS1C
00696          10  FILLER                  PIC  X(04)  VALUE 'E1C6'.    DTSCS1C
00697          10  FILLER                  PIC  X(30)                   DTSCS1C
00698                VALUE 'PREDECESSOR EMPLOYER  DETERMIN'.            DTSCS1C
00699          10  FILLER                  PIC  X(30)                   DTSCS1C
00700                VALUE 'ATION ENTRY NOT ALLOWED       '.            DTSCS1C
00701                                                                   DTSCS1C
00702      05  MSG-E1C7-AREA.                                           DTSCS1C
00703          10  FILLER                  PIC  X(04)  VALUE 'E1C7'.    DTSCS1C
00704          10  FILLER                  PIC  X(30)                   DTSCS1C
00705                VALUE 'PAYMENT PROCESSED  ONLY RATED '.            DTSCS1C
00706          10  FILLER                  PIC  X(30)                   DTSCS1C
00707                VALUE 'LIAB CD IS VALID              '.            DTSCS1C
00708                                                                   DTSCS1C
00709 *****05  MSG-E1C8-AREA.                                           DTSCS1C
00710 *****    10  FILLER                  PIC  X(04)  VALUE 'E1C8'.    DTSCS1C
00711 *****    10  FILLER                  PIC  X(30)                   DTSCS1C
00712 *****          VALUE 'SPAN OF LIABILITY MAY NOT OVER'.            DTSCS1C
00713 *****    10  FILLER                  PIC  X(30)                   DTSCS1C
00714 *****          VALUE 'LAP A PERIOD OF BANKRUPTCY    '.            DTSCS1C
00715                                                                   DTSCS1C
00716      05  MSG-E1C9-AREA.                                           DTSCS1C
00717          10  FILLER                  PIC  X(04)  VALUE 'E1C9'.    DTSCS1C
00718          10  FILLER                  PIC  X(30)                   DTSCS1C
00719                VALUE 'REPORTS WILL BE AUTOMATICALLY '.            DTSCS1C
00720          10  FILLER                  PIC  X(30)                   DTSCS1C
00721                VALUE 'WITHDRAWN.  TRANSFER?         '.            DTSCS1C
00722                                                                   DTSCS1C
00723      05  MSG-E1CA-AREA.                                           DTSCS1C
00724          10  FILLER                  PIC  X(04)  VALUE 'E1CA'.    DTSCS1C
00725          10  FILLER                  PIC  X(17)  VALUE            DTSCS1C
00726              'DEFAULT RATE FOR '.                                 DTSCS1C
00727          10  WRK-RTE-MSG-YR          PIC  9(02).                  DTSCS1C
00728          10  FILLER                  PIC  X(01)  VALUE SPACES.    DTSCS1C
00729          10  WRK-RTE-MSG-Q           PIC  9(01).                  DTSCS1C
00730          10  FILLER                  PIC  X(39)                   DTSCS1C
00731               VALUE ' CAN NOT BE DISPLAYED'.                      DTSCS1C
00732                                                                   DTSCS1C
00733      05  MSG-E1CB-AREA.                                           DTSCS1C
00734          10  FILLER                  PIC  X(04)  VALUE 'E1CB'.    DTSCS1C
00735          10  FILLER                  PIC  X(30)                   DTSCS1C
00736                VALUE 'LIAB CD NOT CONSISTENT WITH EM'.            DTSCS1C
00737          10  FILLER                  PIC  X(30)                   DTSCS1C
00738                VALUE 'P CLASS                       '.            DTSCS1C
00739                                                                   DTSCS1C
00740      05  MSG-E1CC-AREA.                                           DTSCS1C
00741          10  FILLER                  PIC  X(04)  VALUE 'E1CC'.    DTSCS1C
00742          10  FILLER                  PIC  X(30)                   DTSCS1C
00743                VALUE 'TOTAL EXP TRNSF FROM PRED ON L'.            DTSCS1C
00744          10  FILLER                  PIC  X(30)                   DTSCS1C
00745                VALUE 'IAB DT EXCEEDS 100%           '.            DTSCS1C
00746                                                                   DTSCS1C
00747      05  MSG-E1CD-AREA.                                           DTSCS1C
00748          10  FILLER                  PIC  X(04)  VALUE 'E1CD'.    DTSCS1C
00749          10  FILLER                  PIC  X(30)                   DTSCS1C
00750                VALUE 'NO REPORTS ARE ELIGIBLE FOR AU'.            DTSCS1C
00751          10  FILLER                  PIC  X(30)                   DTSCS1C
00752                VALUE 'TOMATIC WITHDRAWAL            '.            DTSCS1C
00753                                                                   DTSCS1C
00754      05  MSG-E1CE-AREA.                                           DTSCS1C
00755          10  FILLER                  PIC  X(04)  VALUE 'E1CE'.    DTSCS1C
00756          10  FILLER                  PIC  X(30)                   DTSCS1C
00757                VALUE 'NO REPORTS ARE ELIGIBLE FOR AU'.            DTSCS1C
00758          10  FILLER                  PIC  X(30)                   DTSCS1C
00759                VALUE 'TOMATIC TRANSFER              '.            DTSCS1C
00760                                                                   DTSCS1C
00761      05  MSG-E1CF-AREA.                                           DTSCS1C
00762          10  FILLER                  PIC  X(04)  VALUE 'E1CF'.    DTSCS1C
00763          10  FILLER                  PIC  X(17)  VALUE            DTSCS1C
00764              'DEFAULT RATE FOR '.                                 DTSCS1C
00765          10  WRK-E1CF-MSG-YR         PIC  9(02).                  DTSCS1C
00766          10  FILLER                  PIC  X(01)  VALUE SPACES.    DTSCS1C
00767          10  WRK-E1CF-MSG-Q          PIC  9(01).                  DTSCS1C
00768          10  FILLER                  PIC  X(39)                   DTSCS1C
00769               VALUE ' CAN NOT BE DETERMINED'.                     DTSCS1C
00770                                                                   DTSCS1C
00771      05  MSG-E1CG-AREA.                                           DTSCS1C
00772          10  FILLER                  PIC  X(04)  VALUE 'E1CG'.    DTSCS1C
00773          10  FILLER                  PIC  X(30)                   DTSCS1C
00774                VALUE 'ORG TYPE AND LIABILITY CODE AR'.            DTSCS1C
00775          10  FILLER                  PIC  X(30)                   DTSCS1C
00776                VALUE 'E INCONSISTENT                '.            DTSCS1C
00777                                                                   DTSCS1C
00778      05  MSG-E1CH-AREA.                                           DTSCS1C
00779          10  FILLER                  PIC  X(04)  VALUE 'E1CH'.    DTSCS1C
00780          10  FILLER                  PIC  X(30)                   DTSCS1C
00781                VALUE 'ENTRY OF FILING SCHED NOT ALLO'.            DTSCS1C
00782          10  FILLER                  PIC  X(30)                   DTSCS1C
00783                VALUE 'WED DURING REDETERMINATION    '.            DTSCS1C
00784                                                                   DTSCS1C
00785 **   05  MSG-E1CI-AREA.                                           DTSCS1C
00786 *        10  FILLER                  PIC  X(04)  VALUE 'E1CI'.    DTSCS1C
00787 *        10  FILLER                  PIC  X(30)                   DTSCS1C
00788 *              VALUE 'DETERM BASED ON UC-30 - QUARTE'.            DTSCS1C
00789 *        10  FILLER                  PIC  X(30)                   DTSCS1C
00790 **             VALUE 'RLY IS ONLY VALUE ALLOWED     '.            DTSCS1C
00791                                                                   DTSCS1C
00792      05  MSG-E1CJ-AREA.                                           DTSCS1C
00793          10  FILLER                  PIC  X(04)  VALUE 'E1CJ'.    DTSCS1C
00794          10  FILLER                  PIC  X(30)                   DTSCS1C
00795                VALUE 'NO FILING SCHEDULE ON FILE - U'.            DTSCS1C
00796          10  FILLER                  PIC  X(30)                   DTSCS1C
00797                VALUE 'SE SCREEN 1A TO ADD PENDING   '.            DTSCS1C
00798                                                                   DTSCS1C
00799      05  MSG-E1CK-AREA.                                           DTSCS1C
00800          10  FILLER                  PIC  X(04)  VALUE 'E1CK'.    DTSCS1C
00801          10  FILLER                  PIC  X(30)                   DTSCS1C
00802                VALUE 'ANNUAL FILING SCHEDULE NOT ALL'.            DTSCS1C
00803          10  FILLER                  PIC  X(30)                   DTSCS1C
00804                VALUE 'OWED PRIOR TO 2002            '.            DTSCS1C
00805                                                                   DTSCS1C
00806      05  MSG-E1CL-AREA.                                           DTSCS1C
00807          10  FILLER                  PIC  X(04)  VALUE 'E1CL'.    DTSCS1C
00808          10  FILLER                  PIC  X(50)  VALUE            DTSCS1C
00809              'ESTIMATED RATE WILL BECOME FINAL. CONTINUE?'.       DTSCS1C
00810                                                                   DTSCS1C
00811      05  MSG-E1CM-AREA.                                           DTSCS1C
00812          10  FILLER                  PIC  X(04)  VALUE 'E1CM'.    DTSCS1C
00813          10  FILLER                  PIC  X(50)  VALUE            DTSCS1C
00814              'LIABILITY DATE MAY NOT BE > CURRENT DATE.'.         DTSCS1C
00815                                                                   DTSCS1C
00816      05  MSG-E1CN-AREA.                                           DTSCS1C
00817          10  FILLER                  PIC  X(04)  VALUE 'E1CN'.    DTSCS1C
00818          10  FILLER                  PIC  X(50)  VALUE            DTSCS1C
00819              'LIAB ESTABLISH DATE MAY NOT BE > CURRENT DATE.'.    DTSCS1C
00820                                                                   DTSCS1C
00821      05  MSG-E1CO-AREA.                                           DTSCS1C
00822          10  FILLER                  PIC  X(04)  VALUE 'E1CO'.    DTSCS1C
00823          10  FILLER                  PIC  X(50)  VALUE            DTSCS1C
00824              'ACCOUNT WITH STATUS UNKNOWN HAS SAME FEIN.    '.    DTSCS1C
00825                                                                   DTSCS1C
00826      05  MSG-E1CP-AREA.                                           DTSCS1C
00827          10  FILLER                  PIC  X(04)  VALUE 'E1CP'.    DTSCS1C
00828          10  FILLER                  PIC  X(50)  VALUE            DTSCS1C
00829              'DUPLICATE NAME - SUPERVISOR APPROVAL NEEDED   '.    DTSCS1C
00830                                                                   DTSCS1C
00831      05  MSG-E1CQ-AREA.                                           DTSCS1C
00832          10  FILLER                  PIC  X(04)  VALUE 'E1CQ'.    DTSCS1C
00833          10  FILLER                  PIC  X(50)  VALUE            DTSCS1C
00834              'NO DC ADDRESS - VERIFY TO CONTINUE            '.    DTSCS1C
00835                                                                   DTSCS1C
00836      05  MSG-E1CR-AREA.                                           DTSCS1C
00837          10  FILLER                  PIC  X(04)  VALUE 'E1CR'.    DTSCS1C
00838          10  FILLER                  PIC  X(50)  VALUE            DTSCS1C
00839              'PO BOX - VERIFY TO CONTINUE            '.           DTSCS1C
00840                                                                   DTSCS1C
00841      05  MSG-E1CS-AREA.                                           DTSCS1C
00842          10  FILLER                  PIC  X(04)  VALUE 'E1CS'.    DTSCS1C
00843          10  FILLER                  PIC  X(50)  VALUE            DTSCS1C
00844              'INACT MORE THAN 3 YEARS - ASSIGN NEW NUMBER'.       DTSCS1C
00845                                                                   DTSCS1C
00846      05  MSG-E1CT-AREA.                                           DTSCS1C
00847          10  FILLER                  PIC  X(04)  VALUE 'E1CT'.    DTSCS1C
00848          10  FILLER                  PIC  X(30)                   DTSCS1C
00849                VALUE '1 QTR REQUIRED BETWEEN SPANS:'.             DTSCS1C
00850          10  FILLER                  PIC  X(30)                   DTSCS1C
00851                VALUE ' REVERSE PRIOR INACTIVATION   '.            DTSCS1C
00852                                                                   DTSCS1C
00853      05  MSG-E1CU-AREA.                                           DTSCS1C
00854          10  FILLER                  PIC  X(04)  VALUE 'E1CU'.    DTSCS1C
00855          10  FILLER                  PIC  X(30)                   DTSCS1C
00856                VALUE 'SUPERVISOR APPROVAL NEEDED FOR'.            DTSCS1C
00857          10  FILLER                  PIC  X(30)                   DTSCS1C
00858                VALUE ' PRED/SUCC DETERMINATION      '.            DTSCS1C
00859                                                                   DTSCS1C
00860      05  MSG-E1CV-AREA.                                           DTSCS1C
00861          10  FILLER                  PIC  X(04)  VALUE 'E1CV'.    DTSCS1C
00862          10  FILLER                  PIC  X(30)                   DTSCS1C
00863                VALUE 'SUPERVISOR APPROVAL NEEDED WHE'.            DTSCS1C
00864          10  FILLER                  PIC  X(30)                   DTSCS1C
00865                VALUE 'N NOT NEW EMPLOYER RATE       '.            DTSCS1C
00866                                                                   DTSCS1C
00867      05  MSG-MOD-SUCCESSFUL.                                      DTSCS1C
00868          10  FILLER                      PIC X(18) VALUE          DTSCS1C
00869              'DETERMINATION FOR '.                                DTSCS1C
00870          10  MSG-EMP-NO-1                PIC 9(3).                DTSCS1C
00871          10  FILLER                      PIC X VALUE ' '.         DTSCS1C
00872          10  MSG-EMP-NO-2                PIC 9(3).                DTSCS1C
00873          10  FILLER                      PIC X(23) VALUE          DTSCS1C
00874              ' SUCCESSFULLY PROCESSED'.                           DTSCS1C
00875      EJECT                                                        DTSCS1C
00876  01  L001-COMM-AREA.                                              DTSCS1C
00877  ++INCLUDE DTSIL001                                               DTSCS1C
00878      EJECT                                                        DTSCS1C
00879  01  L004-COMM-AREA.                                              DTSCS1C
00880  ++INCLUDE DTSIL004                                               DTSCS1C
00881      EJECT                                                        DTSCS1C
00882  01  L006-COMM-AREA.                                              DTSCS1C
00883  ++INCLUDE DTSIL006                                               DTSCS1C
00884      EJECT                                                        DTSCS1C
00885  01  L012-COMM-AREA.                                              DTSCS1C
00886  ++INCLUDE DTSIL012                                               DTSCS1C
00887      EJECT                                                        DTSCS1C
00888  01  L015-COMM-AREA.                                              DTSCS1C
00889  ++INCLUDE DTSIL015                                               DTSCS1C
00890      EJECT                                                        DTSCS1C
00891  01  L016-COMM-AREA.                                              DTSCS1C
00892  ++INCLUDE DTSIL016                                               DTSCS1C
00893      EJECT                                                        DTSCS1C
00894  01  L017-COMM-AREA.                                              DTSCS1C
00895  ++INCLUDE DTSIL017                                               DTSCS1C
00896      EJECT                                                        DTSCS1C
00897  01  L018-COMM-AREA.                                              DTSCS1C
00898  ++INCLUDE DTSIL018                                               DTSCS1C
00899      EJECT                                                        DTSCS1C
00900  01  L021-COMM-AREA.                                              DTSCS1C
00901  ++INCLUDE DTSIL021                                               DTSCS1C
00902      EJECT                                                        DTSCS1C
00903  01  L031-COMM-AREA.                                              DTSCS1C
00904  ++INCLUDE DTSIL031                                               DTSCS1C
00905      EJECT                                                        DTSCS1C
00906  01  L042-COMM-AREA.                                              DTSCS1C
00907  ++INCLUDE DTSIL042                                               DTSCS1C
00908      EJECT                                                        DTSCS1C
00909  01  L052-COMM-AREA.                                              DTSCS1C
00910  ++INCLUDE DTSIL052                                               DTSCS1C
00911      EJECT                                                        DTSCS1C
00912  01  L056-COMM-AREA.                                              DTSCS1C
00913  ++INCLUDE DTSIL056                                               DTSCS1C
00914      EJECT                                                        DTSCS1C
00915  01  L072-COMM-AREA.                                              DTSCS1C
00916  ++INCLUDE DTSIL072                                               DTSCS1C
00917      EJECT                                                        DTSCS1C
00918  01  L073-COMM-AREA.                                              DTSCS1C
00919  ++INCLUDE DTSIL073                                               DTSCS1C
00920      EJECT                                                        DTSCS1C
00921  01  L074-COMM-AREA.                                              DTSCS1C
00922  ++INCLUDE DTSIL074                                               DTSCS1C
00923      EJECT                                                        DTSCS1C
00924  01  L082-COMM-AREA.                                              DTSCS1C
00925  ++INCLUDE DTSIL082                                               DTSCS1C
00926      EJECT                                                        DTSCS1C
00927  01  L084-COMM-AREA.                                              DTSCS1C
00928  ++INCLUDE DTSIL084                                               DTSCS1C
00929      EJECT                                                        DTSCS1C
00930  01  L201-COMM-AREA.                                              DTSCS1C
00931  ++INCLUDE DTSIL201                                               DTSCS1C
00932      EJECT                                                        DTSCS1C
00933  01  L202-COMM-AREA.                                              DTSCS1C
00934  ++INCLUDE DTSIL202                                               DTSCS1C
00935      EJECT                                                        DTSCS1C
00936  01  L203-COMM-AREA.                                              DTSCS1C
00937  ++INCLUDE DTSIL203                                               DTSCS1C
00938      EJECT                                                        DTSCS1C
00939  01  L221-COMM-AREA.                                              DTSCS1C
00940  ++INCLUDE DTSIL221                                               DTSCS1C
00941      EJECT                                                        DTSCS1C
00942  01  L331-COMM-AREA.                                              DTSCS1C
00943  ++INCLUDE DTSIL331                                               DTSCS1C
00944      EJECT                                                        DTSCS1C
00945  01  L400-COMM-AREA.                                              DTSCS1C
00946  ++INCLUDE DTSIL400                                               DTSCS1C
00947      EJECT                                                        DTSCS1C
00948  01  L410-COMM-AREA.                                              DTSCS1C
00949  ++INCLUDE DTSIL410                                               DTSCS1C
00950      EJECT                                                        DTSCS1C
00951  01  L415-COMM-AREA.                                              DTSCS1C
00952  ++INCLUDE DTSIL415                                               DTSCS1C
00953      EJECT                                                        DTSCS1C
00954  01  L805-COMM-AREA.                                              DTSCS1C
00955  ++INCLUDE DTSIL805                                               DTSCS1C
00956      EJECT                                                        DTSCS1C
00957  01  L810-COMM-AREA.                                              DTSCS1C
00958      05  L810-CONTROL-BLOCK.                                      DTSCS1C
00959  ++INCLUDE DTSIL810                                               DTSCS1C
00960      EJECT                                                        DTSCS1C
00961      05  MSKL-REC.                                                DTSCS1C
00962  ++INCLUDE DTSIMSKL                                               DTSCS1C
00963      EJECT                                                        DTSCS1C
00964  01  MPRF-REC.                                                    DTSCS1C
00965  ++INCLUDE DTSIMPRF                                               DTSCS1C
00966      EJECT                                                        DTSCS1C
00967  01  MSOL-REC.                                                    DTSCS1C
00968  ++INCLUDE DTSIMSOL                                               DTSCS1C
00969      EJECT                                                        DTSCS1C
00970  01  MRTE-REC.                                                    DTSCS1C
00971  ++INCLUDE DTSIMRTE                                               DTSCS1C
00972      EJECT                                                        DTSCS1C
00973  01  MTAD-REC.                                                    DTSCS1C
00974  ++INCLUDE DTSIMTAD                                               DTSCS1C
00975      EJECT                                                        DTSCS1C
00976  01  MREL-REC.                                                    DTSCS1C
00977  ++INCLUDE DTSIMREL                                               DTSCS1C
00978      EJECT                                                        DTSCS1C
00979  01  MERA-REC.                                                    DTSCS1C
00980  ++INCLUDE DTSIMERA                                               DTSCS1C
00981      EJECT                                                        DTSCS1C
00982  01  MERD-REC.                                                    DTSCS1C
00983  ++INCLUDE DTSIMERD                                               DTSCS1C
00984      EJECT                                                        DTSCS1C
00985 *01  MCOL-REC.                                                    DTSCS1C
00986 *++INCLUDE DTSIMCOL                                               DTSCS1C
00987      EJECT                                                        DTSCS1C
00988  01  MQTR-REC.                                                    DTSCS1C
00989  ++INCLUDE DTSIMQTR                                               DTSCS1C
00990      EJECT                                                        DTSCS1C
00991  01  MTCK-REC.                                                    DTSCS1C
00992  ++INCLUDE DTSIMTCK                                               DTSCS1C
00993      EJECT                                                        DTSCS1C
00994  01  L821-COMM-AREA.                                              DTSCS1C
00995      05  L821-CONTROL-BLOCK.                                      DTSCS1C
00996  ++INCLUDE DTSIL821                                               DTSCS1C
00997      SKIP3                                                        DTSCS1C
00998      05  ISKL-REC.                                                DTSCS1C
00999  ++INCLUDE DTSIISKL                                               DTSCS1C
01000      EJECT                                                        DTSCS1C
01001  01  IPES-REC.                                                    DTSCS1C
01002  ++INCLUDE DTSIIPES                                               DTSCS1C
01003      EJECT                                                        DTSCS1C
01004  01  IBTB-REC.                                                    DTSCS1C
01005  ++INCLUDE DTSIIBTB                                               DTSCS1C
01006      EJECT                                                        DTSCS1C
01007  01  L825-COMM-AREA.                                              DTSCS1C
01008      05  L825-CONTROL-BLOCK.                                      DTSCS1C
01009  ++INCLUDE DTSIL825                                               DTSCS1C
01010      SKIP3                                                        DTSCS1C
01011      05  RSKL-REC.                                                DTSCS1C
01012  ++INCLUDE DTSIRSK1                                               DTSCS1C
01013      EJECT                                                        DTSCS1C
01014  01  T001-REC.                                                    DTSCS1C
01015  ++INCLUDE DTSIT001                                               DTSCS1C
01016      EJECT                                                        DTSCS1C
01017  01  T006-REC.                                                    DTSCS1C
01018  ++INCLUDE DTSIT006                                               DTSCS1C
01019      EJECT                                                        DTSCS1C
01020  01  T031-REC.                                                    DTSCS1C
01021  ++INCLUDE DTSIT031                                               DTSCS1C
01022      EJECT                                                        DTSCS1C
01023  01  T036-REC.                                                    DTSCS1C
01024  ++INCLUDE DTSIT036                                               DTSCS1C
01025      EJECT                                                        DTSCS1C
01026  01  L831-COMM-AREA.                                              DTSCS1C
01027      05  L831-CONTROL-BLOCK.                                      DTSCS1C
01028  ++INCLUDE DTSIL831                                               DTSCS1C
01029      SKIP3                                                        DTSCS1C
01030      05  FSKL-REC.                                                DTSCS1C
01031  ++INCLUDE DTSIFSKL                                               DTSCS1C
01032      EJECT                                                        DTSCS1C
01033  01  FUIR-REC.                                                    DTSCS1C
01034  ++INCLUDE DTSIFUIR                                               DTSCS1C
01035      EJECT                                                        DTSCS1C
01036  01  L851-COMM-AREA.                                              DTSCS1C
01037  ++INCLUDE DTSIL851                                               DTSCS1C
01038      SKIP3                                                        DTSCS1C
01039      05  MAP-AREA REDEFINES L851-MAP-AREA.                        DTSCS1C
01040  ++INCLUDE DTSIS1C                                                DTSCS1C
01041      EJECT                                                        DTSCS1C
01042  01  CATB-LITERALS.                                               DTSCS1C
01043  ++INCLUDE DTSICATB                                               DTSCS1C
01044      SKIP3                                                        DTSCS1C
01045  01  CFKD-LITERALS.                                               DTSCS1C
01046  ++INCLUDE DTSICFKD                                               DTSCS1C
01047      SKIP3                                                        DTSCS1C
01048  01  CECD-LITERALS.                                               DTSCS1C
01049  ++INCLUDE DTSICECD                                               DTSCS1C
01050      SKIP3                                                        DTSCS1C
01051  01  CPCD-LITERALS.                                               DTSCS1C
01052  ++INCLUDE DTSICPCD                                               DTSCS1C
01053      EJECT                                                        DTSCS1C
01054  LINKAGE SECTION.                                                 DTSCS1C
01055      SKIP3                                                        DTSCS1C
01056  01  DFHCOMMAREA.                                                 DTSCS1C
01057  ++INCLUDE DTSILCCM                                               DTSCS1C
01058      SKIP3                                                        DTSCS1C
01059              15  FILLER REDEFINES LCCM-SCR-HOLD-AREA.             DTSCS1C
01060                  20  LCCM-HOLD-ADDRESS-1       PIC  X(171).       DTSCS1C
01061      EJECT                                                        DTSCS1C
01062  PROCEDURE DIVISION.                                              DTSCS1C
01063                                                                   DTSCS1C
01064      MOVE +0 TO WRK-EMP-NO                                        DTSCS1C
01065                 WRK-PRED-EMP-NO.                                  DTSCS1C
01066                                                                   DTSCS1C
01067      SET WRK-MTAD-NO-88 TO TRUE.                                  DTSCS1C
01068                                                                   DTSCS1C
01069      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS1C
01070                                                                   DTSCS1C
01071      SET CURSOR-SET-NO TO TRUE.                                   DTSCS1C
01072                                                                   DTSCS1C
01073                                                                   DTSCS1C
01074      SET SCR-ACCESS-INQ TO TRUE.                                  DTSCS1C
01075                                                                   DTSCS1C
01076      PERFORM P0100-ACCESS-SEARCH THRU P0100-EXIT                  DTSCS1C
01077          VARYING LCCM-NONUM-IDX FROM 1 BY 1                       DTSCS1C
01078          UNTIL LCCM-NONUM-IDX > LCCM-SCR-NONUM-CNT.               DTSCS1C
01079                                                                   DTSCS1C
01080                                                                   DTSCS1C
01081      MOVE SPACE TO REQ-IND.                                       DTSCS1C
01082                                                                   DTSCS1C
01083      PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT.               DTSCS1C
01084                                                                   DTSCS1C
01085                                                                   DTSCS1C
01086 *-----------------------------------------------------            DTSCS1C
01087 *    P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE           DTSCS1C
01088 *    "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT             DTSCS1C
01089 *    REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE             DTSCS1C
01090 *    OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED.         DTSCS1C
01091 *                                                                 DTSCS1C
01092 *    THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE                DTSCS1C
01093 *    PROCESSED.                                                   DTSCS1C
01094 *                                                                 DTSCS1C
01095 *    THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND,         DTSCS1C
01096 *    INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE            DTSCS1C
01097 *    WORK STATION OPERATOR.                                       DTSCS1C
01098 *-----------------------------------------------------            DTSCS1C
01099                                                                   DTSCS1C
01100      MOVE SPACE TO RESP-IND.                                      DTSCS1C
01101                                                                   DTSCS1C
01102      IF REQ-ERROR                                                 DTSCS1C
01103         PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT               DTSCS1C
01104      ELSE                                                         DTSCS1C
01105      IF REQ-JUMP                                                  DTSCS1C
01106         PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT                DTSCS1C
01107      ELSE                                                         DTSCS1C
01108      IF REQ-CLEAR                                                 DTSCS1C
01109         PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT               DTSCS1C
01110      ELSE                                                         DTSCS1C
01111      IF REQ-CURSOR-TO-GOTO                                        DTSCS1C
01112         PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT              DTSCS1C
01113      ELSE                                                         DTSCS1C
01114      IF REQ-INQUIRE                                               DTSCS1C
01115         PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT             DTSCS1C
01116      ELSE                                                         DTSCS1C
01117      IF REQ-EDIT                                                  DTSCS1C
01118         PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT                DTSCS1C
01119      ELSE                                                         DTSCS1C
01120      IF REQ-UPDATE                                                DTSCS1C
01121         PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT              DTSCS1C
01122      ELSE                                                         DTSCS1C
01123         GO TO S899-ABEND.                                         DTSCS1C
01124                                                                   DTSCS1C
01125                                                                   DTSCS1C
01126 *-----------------------------------------------------            DTSCS1C
01127 *    THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED             DTSCS1C
01128 *    IN RESP-IND THE TYPE OF RESPONSE TO BE MADE.                 DTSCS1C
01129 *-----------------------------------------------------            DTSCS1C
01130                                                                   DTSCS1C
01131      IF RESP-SEND-MAP                                             DTSCS1C
01132          PERFORM S9300-SEND-MAP THRU S9300-EXIT                   DTSCS1C
01133          SET LCCM-END-TASK-88 TO TRUE                             DTSCS1C
01134      ELSE                                                         DTSCS1C
01135      IF RESP-SEND-MSGONLY                                         DTSCS1C
01136          PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT              DTSCS1C
01137          SET LCCM-END-TASK-88 TO TRUE                             DTSCS1C
01138      ELSE                                                         DTSCS1C
01139      IF RESP-JUMP                                                 DTSCS1C
01140          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS1C
01141      ELSE                                                         DTSCS1C
01142      IF RESP-CURSOR-TO-GOTO                                       DTSCS1C
01143          PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT              DTSCS1C
01144          SET LCCM-END-TASK-88 TO TRUE                             DTSCS1C
01145      ELSE                                                         DTSCS1C
01146          GO TO S899-ABEND.                                        DTSCS1C
01147                                                                   DTSCS1C
01148                                                                   DTSCS1C
01149  MAINLINE-EXIT.                                                   DTSCS1C
01150                                                                   DTSCS1C
01151      EXEC CICS                                                    DTSCS1C
01152          RETURN                                                   DTSCS1C
01153      END-EXEC.                                                    DTSCS1C
01154                                                                   DTSCS1C
01155                                                                   DTSCS1C
01156      GOBACK.                                                      DTSCS1C
01157      EJECT                                                        DTSCS1C
01158  P0100-ACCESS-SEARCH.                                             DTSCS1C
01159      IF LCCM-SCR-NONUM-ID (LCCM-NONUM-IDX) = WRK-SCR-ID           DTSCS1C
01160          MOVE LCCM-SCR-NONUM-ACCESS-IND (LCCM-NONUM-IDX)          DTSCS1C
01161            TO SCR-ACCESS-IND.                                     DTSCS1C
01162  P0100-EXIT.                                                      DTSCS1C
01163      EXIT.                                                        DTSCS1C
01164 /*****************************************************************DTSCS1C
01165 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION         *DTSCS1C
01166 ******************************************************************DTSCS1C
01167  P1000-ANALYZE-REQUEST.                                           DTSCS1C
01168                                                                   DTSCS1C
01169 *-----------------------------------------------------            DTSCS1C
01170 *     IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE)         DTSCS1C
01171 *     THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE               DTSCS1C
01172 *     REPLACED WITH ENTER)                                        DTSCS1C
01173 *-----------------------------------------------------            DTSCS1C
01174      IF LCCM-SCR-ID NOT = WRK-SCR-ID                              DTSCS1C
01175         SET LCCM-ENTER-88 TO TRUE                                 DTSCS1C
01176         SET REQ-INQUIRE TO TRUE                                   DTSCS1C
01177         IF LCCM-EMP-NO > ZERO                                     DTSCS1C
01178             MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1                    DTSCS1C
01179             MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2                    DTSCS1C
01180         END-IF                                                    DTSCS1C
01181         GO TO P1000-EXIT.                                         DTSCS1C
01182                                                                   DTSCS1C
01183                                                                   DTSCS1C
01184 *-----------------------------------------------------            DTSCS1C
01185 *      RECEIVE THE MAP                                            DTSCS1C
01186 *-----------------------------------------------------            DTSCS1C
01187      PERFORM S9100-RECEIVE THRU S9100-EXIT.                       DTSCS1C
01188                                                                   DTSCS1C
01189                                                                   DTSCS1C
01190 *-----------------------------------------------------            DTSCS1C
01191 *    CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE            DTSCS1C
01192 *    WORK STATION                                                 DTSCS1C
01193 *-----------------------------------------------------            DTSCS1C
01194      IF LCCM-CLEAR-88                                             DTSCS1C
01195         SET REQ-CLEAR TO TRUE                                     DTSCS1C
01196         GO TO P1000-EXIT.                                         DTSCS1C
01197                                                                   DTSCS1C
01198                                                                   DTSCS1C
01199 *-----------------------------------------------------            DTSCS1C
01200 *    IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED             DTSCS1C
01201 *-----------------------------------------------------            DTSCS1C
01202      IF LCCM-SCR-UPDATE-LOCKED                                    DTSCS1C
01203         PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT               DTSCS1C
01204         GO TO P1000-EXIT.                                         DTSCS1C
01205                                                                   DTSCS1C
01206                                                                   DTSCS1C
01207 *-----------------------------------------------------            DTSCS1C
01208 *    PA2 IS A REQUEST TO POSITION CURSOR AT GO TO:                DTSCS1C
01209 *-----------------------------------------------------            DTSCS1C
01210      IF LCCM-PA2-88                                               DTSCS1C
01211          SET REQ-CURSOR-TO-GOTO TO TRUE                           DTSCS1C
01212          GO TO P1000-EXIT.                                        DTSCS1C
01213                                                                   DTSCS1C
01214                                                                   DTSCS1C
01215 *-----------------------------------------------------            DTSCS1C
01216 *    ALL OTHER PA KEYS ARE NOT ACTIVE                             DTSCS1C
01217 *-----------------------------------------------------            DTSCS1C
01218      IF LCCM-PA-88                                                DTSCS1C
01219        PERFORM S804-INVALID-KEY THRU S804-EXIT                    DTSCS1C
01220        SET REQ-ERROR TO TRUE                                      DTSCS1C
01221        GO TO P1000-EXIT.                                          DTSCS1C
01222                                                                   DTSCS1C
01223                                                                   DTSCS1C
01224 *----------------------------------------------------             DTSCS1C
01225 *    F12 PRESSED WHEN UPDATE NOT IN PROGRESS IS A                 DTSCS1C
01226 *    REQUEST TO CLEAR THE SCREEN.                                 DTSCS1C
01227 *----------------------------------------------------             DTSCS1C
01228      IF LCCM-F12-88                                               DTSCS1C
01229          MOVE LOW-VALUES TO MAP-AREA                              DTSCS1C
01230          SET REQ-CLEAR TO TRUE                                    DTSCS1C
01231          GO TO P1000-EXIT.                                        DTSCS1C
01232                                                                   DTSCS1C
01233                                                                   DTSCS1C
01234 *-----------------------------------------------------            DTSCS1C
01235 *    IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION            DTSCS1C
01236 *-----------------------------------------------------            DTSCS1C
01237      IF LCCM-F03-88                                               DTSCS1C
01238         MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID                    DTSCS1C
01239         SET REQ-JUMP TO TRUE                                      DTSCS1C
01240         GO TO P1000-EXIT.                                         DTSCS1C
01241                                                                   DTSCS1C
01242                                                                   DTSCS1C
01243 *-----------------------------------------------------            DTSCS1C
01244 *    IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN         DTSCS1C
01245 *-----------------------------------------------------            DTSCS1C
01246      IF LCCM-F04-88                                               DTSCS1C
01247         MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID                 DTSCS1C
01248         SET REQ-JUMP TO TRUE                                      DTSCS1C
01249         GO TO P1000-EXIT.                                         DTSCS1C
01250                                                                   DTSCS1C
01251                                                                   DTSCS1C
01252 *-----------------------------------------------------            DTSCS1C
01253 *    IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO                DTSCS1C
01254 *    CORRESPONDENCE SCREEN                                        DTSCS1C
01255 *-----------------------------------------------------            DTSCS1C
01256      IF LCCM-F14-88                                               DTSCS1C
01257         MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID                  DTSCS1C
01258         SET REQ-JUMP TO TRUE                                      DTSCS1C
01259         GO TO P1000-EXIT.                                         DTSCS1C
01260                                                                   DTSCS1C
01261                                                                   DTSCS1C
01262 *-----------------------------------------------------            DTSCS1C
01263 *    IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO               DTSCS1C
01264 *    REQUESTED SCREEN TYPE                                        DTSCS1C
01265 *-----------------------------------------------------            DTSCS1C
01266      IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID             DTSCS1C
01267         NEXT SENTENCE                                             DTSCS1C
01268      ELSE                                                         DTSCS1C
01269        MOVE MAP-GOTO TO LCCM-REQ-SCR-ID                           DTSCS1C
01270        SET REQ-JUMP TO TRUE                                       DTSCS1C
01271        GO TO P1000-EXIT.                                          DTSCS1C
01272                                                                   DTSCS1C
01273                                                                   DTSCS1C
01274 *-----------------------------------------------------            DTSCS1C
01275 *    IF REQUEST TO UPDATE THE DATA (MOD)                          DTSCS1C
01276 *          VERIFY USER ACCESS TO PERFORM UPDATE                   DTSCS1C
01277 *-----------------------------------------------------            DTSCS1C
01278      IF LCCM-F10-88                                               DTSCS1C
01279         IF SCR-ACCESS-UPDATE                                      DTSCS1C
01280            SET REQ-EDIT TO TRUE                                   DTSCS1C
01281            GO TO P1000-EXIT                                       DTSCS1C
01282         ELSE                                                      DTSCS1C
01283            PERFORM S804-INVALID-KEY THRU S804-EXIT                DTSCS1C
01284            SET REQ-ERROR TO TRUE                                  DTSCS1C
01285            GO TO P1000-EXIT.                                      DTSCS1C
01286                                                                   DTSCS1C
01287                                                                   DTSCS1C
01288 *-----------------------------------------------------            DTSCS1C
01289 *    IF INQUIRY TYPE KEY PRESSED (ENTER, PAGE DOWN,               DTSCS1C
01290 *          PAGE UP), INDICATE INQUIRY REQUEST.                    DTSCS1C
01291 *          ON SCREEN 1C, ONLY ENTER IS VALID.                     DTSCS1C
01292 *-----------------------------------------------------            DTSCS1C
01293      IF LCCM-ENTER-88                                             DTSCS1C
01294          SET REQ-INQUIRE TO TRUE                                  DTSCS1C
01295          GO TO P1000-EXIT.                                        DTSCS1C
01296                                                                   DTSCS1C
01297                                                                   DTSCS1C
01298 *-----------------------------------------------------            DTSCS1C
01299 *     ANY OTHER KEY IS INVALID                                    DTSCS1C
01300 *-----------------------------------------------------            DTSCS1C
01301      PERFORM S804-INVALID-KEY THRU S804-EXIT.                     DTSCS1C
01302      SET REQ-ERROR TO TRUE.                                       DTSCS1C
01303  P1000-EXIT.                                                      DTSCS1C
01304      EXIT.                                                        DTSCS1C
01305                                                                   DTSCS1C
01306                                                                   DTSCS1C
01307                                                                   DTSCS1C
01308 ******************************************************************DTSCS1C
01309 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS1C
01310 * TO UPDATE THE EMPLOYER MASTER FILE.                            *DTSCS1C
01311 ******************************************************************DTSCS1C
01312                                                                   DTSCS1C
01313  P1100-UPDATE-LOCKED.                                             DTSCS1C
01314 *-----------------------------------------------------            DTSCS1C
01315 *    IF THE SCREEN IS "LOCKED FOR UPDATE", THEN                   DTSCS1C
01316 *    THE ONLY VALID OPERATOR REQUESTS ARE ENTER                   DTSCS1C
01317 *    (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE).              DTSCS1C
01318 *-----------------------------------------------------            DTSCS1C
01319      IF LCCM-ENTER-88 OR LCCM-F12-88                              DTSCS1C
01320         SET REQ-UPDATE TO TRUE                                    DTSCS1C
01321      ELSE                                                         DTSCS1C
01322         SET REQ-ERROR TO TRUE                                     DTSCS1C
01323         IF LCCM-SCR-MOD-LOCKED                                    DTSCS1C
01324            MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID                   DTSCS1C
01325         ELSE                                                      DTSCS1C
01326            GO TO S899-ABEND.                                      DTSCS1C
01327  P1100-EXIT.                                                      DTSCS1C
01328      EXIT.                                                        DTSCS1C
01329 /*****************************************************************DTSCS1C
01330 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS1C
01331 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN.                      *DTSCS1C
01332 ******************************************************************DTSCS1C
01333                                                                   DTSCS1C
01334  P2000-REQUEST-ERROR.                                             DTSCS1C
01335      IF LCCM-MSG                                                  DTSCS1C
01336         SET RESP-SEND-MSGONLY TO TRUE                             DTSCS1C
01337      ELSE                                                         DTSCS1C
01338         GO TO S899-ABEND.                                         DTSCS1C
01339  P2000-EXIT.                                                      DTSCS1C
01340      EXIT.                                                        DTSCS1C
01341 /*****************************************************************DTSCS1C
01342 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED                  *DTSCS1C
01343 ******************************************************************DTSCS1C
01344                                                                   DTSCS1C
01345  P3000-REQUEST-JUMP.                                              DTSCS1C
01346 *-----------------------------------------------------            DTSCS1C
01347 *    VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE    DTSCS1C
01348 *    BY USER                                                      DTSCS1C
01349 *-----------------------------------------------------            DTSCS1C
01350      PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT.                 DTSCS1C
01351                                                                   DTSCS1C
01352                                                                   DTSCS1C
01353 *-----------------------------------------------------            DTSCS1C
01354 *    VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED               DTSCS1C
01355 *-----------------------------------------------------            DTSCS1C
01356      IF LCCM-MSG                                                  DTSCS1C
01357         SET RESP-SEND-MSGONLY TO TRUE                             DTSCS1C
01358         SET CURSOR-SET-GOTO TO TRUE                               DTSCS1C
01359         GO TO P3000-EXIT.                                         DTSCS1C
01360                                                                   DTSCS1C
01361                                                                   DTSCS1C
01362      MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA.                  DTSCS1C
01363                                                                   DTSCS1C
01364      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS1C
01365                                                                   DTSCS1C
01366      IF L018-VALID                                                DTSCS1C
01367          MOVE L018-EMP-NO TO LCCM-EMP-NO.                         DTSCS1C
01368                                                                   DTSCS1C
01369                                                                   DTSCS1C
01370 *-----------------------------------------------------            DTSCS1C
01371 *    CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING      DTSCS1C
01372 *-----------------------------------------------------            DTSCS1C
01373      MOVE LOW-VALUES TO LCCM-SCR-STATUS                           DTSCS1C
01374                         LCCM-SCR-HOLD-AREA.                       DTSCS1C
01375                                                                   DTSCS1C
01376      MOVE +0 TO LCCM-SCR-ABSTIME.                                 DTSCS1C
01377                                                                   DTSCS1C
01378      SET RESP-JUMP TO TRUE.                                       DTSCS1C
01379  P3000-EXIT.                                                      DTSCS1C
01380      EXIT.                                                        DTSCS1C
01381 /*****************************************************************DTSCS1C
01382 * CLEAR KEY WAS PRESSED                                          *DTSCS1C
01383 ******************************************************************DTSCS1C
01384                                                                   DTSCS1C
01385  P4000-REQUEST-CLEAR.                                             DTSCS1C
01386      IF SCR-ACCESS-UPDATE                                         DTSCS1C
01387          PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT           DTSCS1C
01388      ELSE                                                         DTSCS1C
01389          PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT.             DTSCS1C
01390                                                                   DTSCS1C
01391                                                                   DTSCS1C
01392 *-----------------------------------------------------            DTSCS1C
01393 *   CLEAN UP INDICATORS AND PAGING STORAGE.  RESET KEY            DTSCS1C
01394 *   FIELDS FROM EARLIER REQUESTS                                  DTSCS1C
01395 *-----------------------------------------------------            DTSCS1C
01396      IF LCCM-EMP-NO > ZERO                                        DTSCS1C
01397          MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1                       DTSCS1C
01398          MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2.                      DTSCS1C
01399                                                                   DTSCS1C
01400      MOVE ZERO TO LCCM-EMP-NO.                                    DTSCS1C
01401                                                                   DTSCS1C
01402      MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA.                       DTSCS1C
01403                                                                   DTSCS1C
01404      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS1C
01405                                                                   DTSCS1C
01406      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS1C
01407                                                                   DTSCS1C
01408      SET RESP-SEND-MAP TO TRUE.                                   DTSCS1C
01409  P4000-EXIT.                                                      DTSCS1C
01410      EXIT.                                                        DTSCS1C
01411 /*****************************************************************DTSCS1C
01412 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED                   *DTSCS1C
01413 ******************************************************************DTSCS1C
01414                                                                   DTSCS1C
01415  P5000-CURSOR-TO-GOTO.                                            DTSCS1C
01416      SET CURSOR-SET-GOTO TO TRUE.                                 DTSCS1C
01417                                                                   DTSCS1C
01418      SET RESP-CURSOR-TO-GOTO TO TRUE.                             DTSCS1C
01419  P5000-EXIT.                                                      DTSCS1C
01420      EXIT.                                                        DTSCS1C
01421 /*****************************************************************DTSCS1C
01422 * INQUIRY WAS REQUESTED                                          *DTSCS1C
01423 ******************************************************************DTSCS1C
01424                                                                   DTSCS1C
01425  P6000-REQUEST-INQUIRE.                                           DTSCS1C
01426      MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA.                  DTSCS1C
01427                                                                   DTSCS1C
01428      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS1C
01429                                                                   DTSCS1C
01430      MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA.                  DTSCS1C
01431                                                                   DTSCS1C
01432                                                                   DTSCS1C
01433      PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT.                 DTSCS1C
01434                                                                   DTSCS1C
01435                                                                   DTSCS1C
01436      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS1C
01437                                                                   DTSCS1C
01438      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS1C
01439                                                                   DTSCS1C
01440                                                                   DTSCS1C
01441      PERFORM S1001-EDIT-KEY THRU S1001-EXIT.                      DTSCS1C
01442                                                                   DTSCS1C
01443      IF LCCM-MSG                                                  DTSCS1C
01444          NEXT SENTENCE                                            DTSCS1C
01445      ELSE                                                         DTSCS1C
01446      IF LCCM-ENTER-88                                             DTSCS1C
01447          PERFORM P6100-NO-PAGE THRU P6100-EXIT                    DTSCS1C
01448      ELSE                                                         DTSCS1C
01449          GO TO S899-ABEND.                                        DTSCS1C
01450                                                                   DTSCS1C
01451                                                                   DTSCS1C
01452      SET RESP-SEND-MAP TO TRUE.                                   DTSCS1C
01453  P6000-EXIT.                                                      DTSCS1C
01454      EXIT.                                                        DTSCS1C
01455      EJECT                                                        DTSCS1C
01456  P6100-NO-PAGE.                                                   DTSCS1C
01457      PERFORM S1190-READ-MPRF THRU S1190-EXIT.                     DTSCS1C
01458                                                                   DTSCS1C
01459      IF LCCM-MSG                                                  DTSCS1C
01460          GO TO P6100-EXIT.                                        DTSCS1C
01461                                                                   DTSCS1C
01462                                                                   DTSCS1C
01463      IF MPRF-CLASS-CHG-ONLY-88                                    DTSCS1C
01464          MOVE MSG-E1C3-AREA TO WRK-MSG-AREA                       DTSCS1C
01465          PERFORM S1101-ERROR THRU S1101-EXIT                      DTSCS1C
01466          GO TO P6100-EXIT.                                        DTSCS1C
01467                                                                   DTSCS1C
01468                                                                   DTSCS1C
01469 *****IF MPRF-BANKRP-OPEN-88                                       DTSCS1C
01470 *****    MOVE MSG-E1C5-AREA TO WRK-MSG-AREA                       DTSCS1C
01471 *****    PERFORM S1101-ERROR THRU S1101-EXIT                      DTSCS1C
01472 *****    GO TO P6100-EXIT.                                        DTSCS1C
01473                                                                   DTSCS1C
01474                                                                   DTSCS1C
01475      IF MPRF-STATUS-ACT-88                                        DTSCS1C
01476          MOVE MSG-E1C4-AREA TO WRK-MSG-AREA                       DTSCS1C
01477          PERFORM S1101-ERROR THRU S1101-EXIT                      DTSCS1C
01478          GO TO P6100-EXIT.                                        DTSCS1C
01479                                                                   DTSCS1C
01480      PERFORM P6110-CHECK-PRED    THRU P6110-EXIT.                 DTSCS1C
01481                                                                   DTSCS1C
01482      IF LCCM-MSG                                                  DTSCS1C
01483          GO TO P6100-EXIT.                                        DTSCS1C
01484                                                                   DTSCS1C
01485      PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT.              DTSCS1C
01486  P6100-EXIT.                                                      DTSCS1C
01487      EXIT.                                                        DTSCS1C
01488      SKIP3                                                        DTSCS1C
01489  P6110-CHECK-PRED.                                                DTSCS1C
01490      MOVE LOW-VALUES TO IPES-REC.                                 DTSCS1C
01491                                                                   DTSCS1C
01492      SET IPES-PES-88 TO TRUE.                                     DTSCS1C
01493                                                                   DTSCS1C
01494      MOVE WRK-EMP-NO TO IPES-PRED-EMP-NO.                         DTSCS1C
01495                                                                   DTSCS1C
01496      MOVE +0 TO IPES-EFF-DATE                                     DTSCS1C
01497                 IPES-SUC-EMP-NO.                                  DTSCS1C
01498                                                                   DTSCS1C
01499      MOVE IPES-REC TO ISKL-REC.                                   DTSCS1C
01500                                                                   DTSCS1C
01501      PERFORM S821-START-BROWSE THRU S821-EXIT.                    DTSCS1C
01502                                                                   DTSCS1C
01503      PERFORM P6111-IPES-LOOP THRU P6111-EXIT                      DTSCS1C
01504          UNTIL L821-NO-REC-88.                                    DTSCS1C
01505                                                                   DTSCS1C
01506      PERFORM S821-END-BROWSE THRU S821-EXIT.                      DTSCS1C
01507                                                                   DTSCS1C
01508  P6110-EXIT.                                                      DTSCS1C
01509      EXIT.                                                        DTSCS1C
01510      SKIP3                                                        DTSCS1C
01511  P6111-IPES-LOOP.                                                 DTSCS1C
01512      MOVE ISKL-REC TO IPES-REC.                                   DTSCS1C
01513                                                                   DTSCS1C
01514      IF WRK-EMP-NO = IPES-PRED-EMP-NO                             DTSCS1C
01515          NEXT SENTENCE                                            DTSCS1C
01516      ELSE                                                         DTSCS1C
01517          SET L821-NO-REC-88 TO TRUE                               DTSCS1C
01518          GO TO P6111-EXIT.                                        DTSCS1C
01519                                                                   DTSCS1C
01520      IF IPES-EXP-TRNSF-YES-88                                     DTSCS1C
01521          MOVE MSG-E1C6-AREA TO WRK-MSG-AREA                       DTSCS1C
01522          PERFORM S1101-ERROR THRU S1101-EXIT.                     DTSCS1C
01523                                                                   DTSCS1C
01524      PERFORM S821-READ-NEXT THRU S821-EXIT.                       DTSCS1C
01525  P6111-EXIT.                                                      DTSCS1C
01526      EXIT.                                                        DTSCS1C
01527 /*****************************************************************DTSCS1C
01528 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS            *DTSCS1C
01529 ******************************************************************DTSCS1C
01530                                                                   DTSCS1C
01531  P6900-CONSTRUCT-SCREEN.                                          DTSCS1C
01532      IF SCR-ACCESS-UPDATE                                         DTSCS1C
01533          PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.          DTSCS1C
01534                                                                   DTSCS1C
01535      PERFORM P6910-FROM-MPRF THRU P6910-EXIT.                     DTSCS1C
01536                                                                   DTSCS1C
01537      PERFORM P6920-FROM-MTAD THRU P6920-EXIT.                     DTSCS1C
01538                                                                   DTSCS1C
01539      PERFORM P6930-FROM-MERA THRU P6930-EXIT.                     DTSCS1C
01540                                                                   DTSCS1C
01541      SET LCCM-SCR-INQUIRE TO TRUE.                                DTSCS1C
01542                                                                   DTSCS1C
01543      MOVE WRK-EMP-NO TO LCCM-EMP-NO.                              DTSCS1C
01544  P6900-EXIT.                                                      DTSCS1C
01545      EXIT.                                                        DTSCS1C
01546      SKIP3                                                        DTSCS1C
01547  P6910-FROM-MPRF.                                                 DTSCS1C
01548      MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME.                  DTSCS1C
01549                                                                   DTSCS1C
01550      MOVE MPRF-ORG-TYPE TO MAP-ORG-TYPE.                          DTSCS1C
01551                                                                   DTSCS1C
01552      IF MPRF-FEIN > 0                                             DTSCS1C
01553          MOVE MPRF-FEIN TO WRK-DISPLAY                            DTSCS1C
01554          MOVE WRK-DISPLAY-FEIN-1 TO MAP-FEIN-1                    DTSCS1C
01555          MOVE WRK-DISPLAY-FEIN-2 TO MAP-FEIN-2.                   DTSCS1C
01556                                                                   DTSCS1C
01557      IF MPRF-CLASS-SUB-88                                         DTSCS1C
01558          MOVE MPRF-EMP-CLASS TO MAP-EMP-CLASS                     DTSCS1C
01559          MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-CLASS-A.            DTSCS1C
01560  P6910-EXIT.                                                      DTSCS1C
01561      EXIT.                                                        DTSCS1C
01562                                                                   DTSCS1C
01563                                                                   DTSCS1C
01564                                                                   DTSCS1C
01565  P6920-FROM-MTAD.                                                 DTSCS1C
01566      MOVE LOW-VALUES TO MTAD-KEY-AREA.                            DTSCS1C
01567                                                                   DTSCS1C
01568      MOVE WRK-EMP-NO TO MTAD-EMP-NO.                              DTSCS1C
01569                                                                   DTSCS1C
01570      SET MTAD-TAD-88 TO TRUE.                                     DTSCS1C
01571                                                                   DTSCS1C
01572      SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE.                     DTSCS1C
01573                                                                   DTSCS1C
01574      MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS1C
01575                                                                   DTSCS1C
01576      PERFORM S810-READ THRU S810-EXIT.                            DTSCS1C
01577                                                                   DTSCS1C
01578      IF L810-NO-REC-88                                            DTSCS1C
01579          GO TO P6920-EXIT.                                        DTSCS1C
01580                                                                   DTSCS1C
01581                                                                   DTSCS1C
01582      MOVE MSKL-REC TO MTAD-REC.                                   DTSCS1C
01583                                                                   DTSCS1C
01584                                                                   DTSCS1C
01585      MOVE MTAD-ATTN-LINE TO MAP-ATTN-LINE.                        DTSCS1C
01586                                                                   DTSCS1C
01587      MOVE MTAD-DELIV-LINE-1 TO MAP-DELIV-LINE-1.                  DTSCS1C
01588                                                                   DTSCS1C
01589      MOVE MTAD-DELIV-LINE-2 TO MAP-DELIV-LINE-2.                  DTSCS1C
01590                                                                   DTSCS1C
01591      MOVE MTAD-CITY TO MAP-CITY.                                  DTSCS1C
01592                                                                   DTSCS1C
01593      MOVE MTAD-ST TO MAP-ST.                                      DTSCS1C
01594                                                                   DTSCS1C
01595      MOVE MTAD-ZIP TO MAP-ZIP.                                    DTSCS1C
01596                                                                   DTSCS1C
01597      IF MTAD-VOICE-1 NOT = SPACES                                 DTSCS1C
01598          MOVE MTAD-VOICE-1-AREA-CD TO MAP-VOICE-1-AREA-CD         DTSCS1C
01599          MOVE MTAD-VOICE-1-PREFIX TO MAP-VOICE-1-PREFIX           DTSCS1C
01600          MOVE MTAD-VOICE-1-SUFFIX TO MAP-VOICE-1-SUFFIX           DTSCS1C
01601          MOVE MTAD-VOICE-1-EXT TO MAP-VOICE-1-EXT.                DTSCS1C
01602                                                                   DTSCS1C
01603      IF MTAD-VOICE-2 NOT = SPACES                                 DTSCS1C
01604          MOVE MTAD-VOICE-2-AREA-CD TO MAP-VOICE-2-AREA-CD         DTSCS1C
01605          MOVE MTAD-VOICE-2-PREFIX TO MAP-VOICE-2-PREFIX           DTSCS1C
01606          MOVE MTAD-VOICE-2-SUFFIX TO MAP-VOICE-2-SUFFIX           DTSCS1C
01607          MOVE MTAD-VOICE-2-EXT TO MAP-VOICE-2-EXT.                DTSCS1C
01608                                                                   DTSCS1C
01609      IF MTAD-FAX NOT = SPACES                                     DTSCS1C
01610          MOVE MTAD-FAX-AREA-CD TO MAP-FAX-AREA-CD                 DTSCS1C
01611          MOVE MTAD-FAX-PREFIX TO MAP-FAX-PREFIX                   DTSCS1C
01612          MOVE MTAD-FAX-SUFFIX TO MAP-FAX-SUFFIX                   DTSCS1C
01613          MOVE MTAD-FAX-EXT TO MAP-FAX-EXT.                        DTSCS1C
01614  P6920-EXIT.                                                      DTSCS1C
01615      EXIT.                                                        DTSCS1C
01616                                                                   DTSCS1C
01617                                                                   DTSCS1C
01618                                                                   DTSCS1C
01619  P6930-FROM-MERA.                                                 DTSCS1C
01620      MOVE LOW-VALUES TO MERA-KEY-AREA.                            DTSCS1C
01621                                                                   DTSCS1C
01622      MOVE WRK-EMP-NO TO MERA-EMP-NO.                              DTSCS1C
01623                                                                   DTSCS1C
01624      SET MERA-ERA-88 TO TRUE.                                     DTSCS1C
01625                                                                   DTSCS1C
01626      MOVE MERA-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS1C
01627                                                                   DTSCS1C
01628      PERFORM S810-READ THRU S810-EXIT.                            DTSCS1C
01629                                                                   DTSCS1C
01630      IF L810-NO-REC-88                                            DTSCS1C
01631          GO TO P6930-EXIT.                                        DTSCS1C
01632                                                                   DTSCS1C
01633                                                                   DTSCS1C
01634      MOVE MSKL-REC TO MERA-REC.                                   DTSCS1C
01635                                                                   DTSCS1C
01636                                                                   DTSCS1C
01637      IF MERA-STATUS-ACTIVE-88                                     DTSCS1C
01638          NEXT SENTENCE                                            DTSCS1C
01639      ELSE                                                         DTSCS1C
01640          GO TO P6930-EXIT.                                        DTSCS1C
01641                                                                   DTSCS1C
01642                                                                   DTSCS1C
01643      IF MERA-POT-PRED-EMP-NO NOT = +0                             DTSCS1C
01644          MOVE MERA-POT-PRED-EMP-NO TO WRK-DISPLAY                 DTSCS1C
01645          MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-PRED-EMP-NO-1           DTSCS1C
01646          MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-PRED-EMP-NO-2.          DTSCS1C
01647  P6930-EXIT.                                                      DTSCS1C
01648      EXIT.                                                        DTSCS1C
01649 /*****************************************************************DTSCS1C
01650 * FUNCTION KEY TO MOD THE RECORD WAS PRESSED.                    *DTSCS1C
01651 ******************************************************************DTSCS1C
01652                                                                   DTSCS1C
01653  P7000-REQUEST-EDIT.                                              DTSCS1C
01654      PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCS1C
01655                                                                   DTSCS1C
01656      IF LCCM-F10-88                                               DTSCS1C
01657         PERFORM P7200-EDIT-MOD THRU P7200-EXIT                    DTSCS1C
01658      ELSE                                                         DTSCS1C
01659         GO TO S899-ABEND.                                         DTSCS1C
01660                                                                   DTSCS1C
01661                                                                   DTSCS1C
01662 *------------------------------------------------------           DTSCS1C
01663 *  SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED.          DTSCS1C
01664 *  IN ORDER TO CONTINUE TO ATTEMPT A MOD THE SCREEN MUST          DTSCS1C
01665 *  REMAIN IN 'INQUIRE' STATUS.                                    DTSCS1C
01666 *------------------------------------------------------           DTSCS1C
01667                                                                   DTSCS1C
01668      IF LCCM-MSG                                                  DTSCS1C
01669         NEXT SENTENCE                                             DTSCS1C
01670      ELSE                                                         DTSCS1C
01671         PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT              DTSCS1C
01672         IF LCCM-F10-88                                            DTSCS1C
01673            SET LCCM-SCR-MOD-LOCKED TO TRUE                        DTSCS1C
01674            MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID.                  DTSCS1C
01675                                                                   DTSCS1C
01676      SET RESP-SEND-MAP TO TRUE.                                   DTSCS1C
01677  P7000-EXIT.                                                      DTSCS1C
01678      EXIT.                                                        DTSCS1C
01679 /*****************************************************************DTSCS1C
01680 * MODIFICATION FUNCTION WAS REQUESTED                            *DTSCS1C
01681 ******************************************************************DTSCS1C
01682                                                                   DTSCS1C
01683  P7200-EDIT-MOD.                                                  DTSCS1C
01684 *-----------------------------------------------------            DTSCS1C
01685 *    MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY         DTSCS1C
01686 *    INQUIRED                                                     DTSCS1C
01687 *-----------------------------------------------------            DTSCS1C
01688      IF NOT LCCM-SCR-INQUIRE                                      DTSCS1C
01689         MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID                     DTSCS1C
01690         GO TO P7200-EXIT.                                         DTSCS1C
01691                                                                   DTSCS1C
01692                                                                   DTSCS1C
01693 *-----------------------------------------------------            DTSCS1C
01694 *    MAP-EMP-NO MAY NOT BE CHANGED DURING THE MOD                 DTSCS1C
01695 *-----------------------------------------------------            DTSCS1C
01696      PERFORM S1001-EDIT-KEY THRU S1001-EXIT.                      DTSCS1C
01697                                                                   DTSCS1C
01698      IF LCCM-MSG                                                  DTSCS1C
01699          GO TO P7200-EXIT.                                        DTSCS1C
01700                                                                   DTSCS1C
01701                                                                   DTSCS1C
01702      PERFORM S1190-READ-MPRF THRU S1190-EXIT.                     DTSCS1C
01703                                                                   DTSCS1C
01704      IF LCCM-MSG                                                  DTSCS1C
01705          GO TO P7200-EXIT.                                        DTSCS1C
01706                                                                   DTSCS1C
01707      IF LCCM-EMP-NO NOT = WRK-EMP-NO                              DTSCS1C
01708          MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA         DTSCS1C
01709          PERFORM S1101-ERROR THRU S1101-EXIT                      DTSCS1C
01710          GO TO P7200-EXIT.                                        DTSCS1C
01711                                                                   DTSCS1C
01712      MOVE WRK-EMP-NO               TO L084-EMP-NO.                DTSCS1C
01713      MOVE LCCM-CURR-RUN-DATE       TO L084-CURR-RUN-DATE.         DTSCS1C
01714      SET L084-SUCCESSOR-88         TO TRUE.                       DTSCS1C
01715      PERFORM S084-APPROVAL         THRU S084-EXIT.                DTSCS1C
01716                                                                   DTSCS1C
01717      IF NOT L084-VALID-APPROVAL-88                                DTSCS1C
01718         PERFORM P7205-CHECK-PRED   THRU P7205-EXIT                DTSCS1C
01719      END-IF.                                                      DTSCS1C
01720                                                                   DTSCS1C
01721      PERFORM P7210-READ-MERA    THRU P7210-EXIT.                  DTSCS1C
01722                                                                   DTSCS1C
01723      PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT.                  DTSCS1C
01724  P7200-EXIT.                                                      DTSCS1C
01725      EXIT.                                                        DTSCS1C
01726                                                                   DTSCS1C
01727  P7205-CHECK-PRED.                                                DTSCS1C
01728      MOVE MAP-PRED-EMP-NO-AREA TO L018-S-EMP-NO-AREA.             DTSCS1C
01729                                                                   DTSCS1C
01730      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS1C
01731      IF L018-VALID                                                DTSCS1C
01732         MOVE L018-EMP-NO              TO L084-EMP-NO              DTSCS1C
01733         MOVE LCCM-CURR-RUN-DATE       TO L084-CURR-RUN-DATE       DTSCS1C
01734         SET L084-SUCCESSOR-88         TO TRUE                     DTSCS1C
01735         PERFORM S084-APPROVAL         THRU S084-EXIT              DTSCS1C
01736      END-IF.                                                      DTSCS1C
01737                                                                   DTSCS1C
01738  P7205-EXIT.                                                      DTSCS1C
01739      EXIT.                                                        DTSCS1C
01740                                                                   DTSCS1C
01741  P7210-READ-MERA.                                                 DTSCS1C
01742      MOVE LOW-VALUES TO MERA-KEY-AREA.                            DTSCS1C
01743                                                                   DTSCS1C
01744      MOVE WRK-EMP-NO TO MERA-EMP-NO.                              DTSCS1C
01745                                                                   DTSCS1C
01746      SET MERA-ERA-88 TO TRUE.                                     DTSCS1C
01747                                                                   DTSCS1C
01748      MOVE MERA-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS1C
01749                                                                   DTSCS1C
01750      PERFORM S810-READ THRU S810-EXIT.                            DTSCS1C
01751                                                                   DTSCS1C
01752      IF L810-NO-REC-88                                            DTSCS1C
01753          SET WRK-MERA-NONE-88 TO TRUE                             DTSCS1C
01754      ELSE                                                         DTSCS1C
01755          MOVE MSKL-REC TO MERA-REC                                DTSCS1C
01756          IF MERA-STATUS-ACTIVE-88                                 DTSCS1C
01757              SET WRK-MERA-ACTIVE-88 TO TRUE                       DTSCS1C
01758          ELSE                                                     DTSCS1C
01759              SET WRK-MERA-INACTIVE-88 TO TRUE.                    DTSCS1C
01760                                                                   DTSCS1C
01761  P7210-EXIT.                                                      DTSCS1C
01762      EXIT.                                                        DTSCS1C
01763                                                                   DTSCS1C
01764 /*****************************************************************DTSCS1C
01765 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED       *DTSCS1C
01766 ******************************************************************DTSCS1C
01767                                                                   DTSCS1C
01768  P8000-REQUEST-UPDATE.                                            DTSCS1C
01769      PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT.              DTSCS1C
01770                                                                   DTSCS1C
01771      SET RESP-SEND-MAP TO TRUE.                                   DTSCS1C
01772                                                                   DTSCS1C
01773      IF LCCM-SCR-MOD-LOCKED                                       DTSCS1C
01774         PERFORM P8200-MOD THRU P8200-EXIT                         DTSCS1C
01775      ELSE                                                         DTSCS1C
01776         GO TO S899-ABEND.                                         DTSCS1C
01777                                                                   DTSCS1C
01778  P8000-EXIT.                                                      DTSCS1C
01779      EXIT.                                                        DTSCS1C
01780 /*****************************************************************DTSCS1C
01781 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS        *DTSCS1C
01782 ******************************************************************DTSCS1C
01783                                                                   DTSCS1C
01784  P8200-MOD.                                                       DTSCS1C
01785      SET LCCM-SCR-INQUIRE TO TRUE.                                DTSCS1C
01786                                                                   DTSCS1C
01787      PERFORM S1001-EDIT-KEY THRU S1001-EXIT.                      DTSCS1C
01788                                                                   DTSCS1C
01789      IF LCCM-MSG                                                  DTSCS1C
01790          GO TO P8200-EXIT.                                        DTSCS1C
01791                                                                   DTSCS1C
01792                                                                   DTSCS1C
01793      PERFORM S1190-READ-MPRF THRU S1190-EXIT.                     DTSCS1C
01794                                                                   DTSCS1C
01795      IF LCCM-MSG                                                  DTSCS1C
01796          GO TO P8200-EXIT.                                        DTSCS1C
01797                                                                   DTSCS1C
01798                                                                   DTSCS1C
01799      IF MPRF-CLASS-SUB-88                                         DTSCS1C
01800          MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-CLASS-A.            DTSCS1C
01801                                                                   DTSCS1C
01802                                                                   DTSCS1C
01803      IF LCCM-F12-88                                               DTSCS1C
01804         MOVE PMSG-MOD-CANCELED        TO LCCM-MSG-ID              DTSCS1C
01805         GO TO P8200-EXIT.                                         DTSCS1C
01806                                                                   DTSCS1C
01807                                                                   DTSCS1C
01808      MOVE 'M' TO L221-UPDATE-FUNCTION.                            DTSCS1C
01809                                                                   DTSCS1C
01810      PERFORM P8810-LOCK-EMPLOYER THRU P8810-EXIT.                 DTSCS1C
01811                                                                   DTSCS1C
01812      IF LCCM-MSG                                                  DTSCS1C
01813          GO TO P8200-EXIT.                                        DTSCS1C
01814                                                                   DTSCS1C
01815                                                                   DTSCS1C
01816      SET WRK-PRED-LOCKED-NO-88 TO TRUE.                           DTSCS1C
01817                                                                   DTSCS1C
01818      PERFORM P8820-LOCK-PRED THRU P8820-EXIT.                     DTSCS1C
01819                                                                   DTSCS1C
01820      IF LCCM-MSG                                                  DTSCS1C
01821          MOVE WRK-EMP-NO TO L221-EMP-NO                           DTSCS1C
01822          PERFORM S221-EMP-UNLOCK THRU S221-EXIT                   DTSCS1C
01823          GO TO P8200-EXIT.                                        DTSCS1C
01824                                                                   DTSCS1C
01825                                                                   DTSCS1C
01826      MOVE WRK-EMP-NO TO L331-EMP-NO.                              DTSCS1C
01827                                                                   DTSCS1C
01828      MOVE LCCM-CURR-RUN-DATE TO L331-CURR-RUN-DATE.               DTSCS1C
01829                                                                   DTSCS1C
01830      MOVE LCCM-TASK-START-ABSTIME TO L331-UPDATE-ABSTIME.         DTSCS1C
01831                                                                   DTSCS1C
01832      MOVE LCCM-OP-ID TO L331-OP-ID.                               DTSCS1C
01833                                                                   DTSCS1C
01834                                                                   DTSCS1C
01835      PERFORM P8910-MTAD-UPDATE THRU P8910-EXIT.                   DTSCS1C
01836                                                                   DTSCS1C
01837      PERFORM P8920-MPRF-UPDATE THRU P8920-EXIT.                   DTSCS1C
01838                                                                   DTSCS1C
01839      PERFORM P8930-MERA THRU P8930-EXIT.                          DTSCS1C
01840                                                                   DTSCS1C
01841      IF MAP-UI-LIABLE-NO-88                                       DTSCS1C
01842          PERFORM P8940-LIABLE-NO THRU P8940-EXIT                  DTSCS1C
01843      ELSE                                                         DTSCS1C
01844          PERFORM P8950-LIABLE-YES THRU P8950-EXIT.                DTSCS1C
01845                                                                   DTSCS1C
01846                                                                   DTSCS1C
01847      MOVE WRK-EMP-NO TO L221-EMP-NO.                              DTSCS1C
01848                                                                   DTSCS1C
01849      PERFORM S221-EMP-UNLOCK THRU S221-EXIT.                      DTSCS1C
01850                                                                   DTSCS1C
01851      IF WRK-PRED-LOCKED-YES-88                                    DTSCS1C
01852          MOVE WRK-PRED-EMP-NO TO L221-EMP-NO                      DTSCS1C
01853          PERFORM S221-EMP-UNLOCK THRU S221-EXIT.                  DTSCS1C
01854                                                                   DTSCS1C
01855                                                                   DTSCS1C
01856      MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS1C
01857                                                                   DTSCS1C
01858      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS1C
01859                                                                   DTSCS1C
01860      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS1C
01861                                                                   DTSCS1C
01862      PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT.                 DTSCS1C
01863                                                                   DTSCS1C
01864                                                                   DTSCS1C
01865      MOVE WRK-EMP-NO TO WRK-DISPLAY.                              DTSCS1C
01866                                                                   DTSCS1C
01867      MOVE WRK-DISPLAY-EMP-NO-1 TO MSG-EMP-NO-1.                   DTSCS1C
01868                                                                   DTSCS1C
01869      MOVE WRK-DISPLAY-EMP-NO-2 TO MSG-EMP-NO-2.                   DTSCS1C
01870                                                                   DTSCS1C
01871      MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID.                     DTSCS1C
01872      MOVE MSG-MOD-SUCCESSFUL TO LCCM-MSG-TEXT.                    DTSCS1C
01873  P8200-EXIT.                                                      DTSCS1C
01874      EXIT.                                                        DTSCS1C
01875      EJECT                                                        DTSCS1C
01876  P8810-LOCK-EMPLOYER.                                             DTSCS1C
01877      MOVE WRK-EMP-NO TO L221-EMP-NO.                              DTSCS1C
01878                                                                   DTSCS1C
01879      MOVE LCCM-SCR-ABSTIME TO L221-SCR-ABSTIME.                   DTSCS1C
01880                                                                   DTSCS1C
01881      MOVE LCCM-TASK-ID TO L221-UPDATE-TASK-ID.                    DTSCS1C
01882                                                                   DTSCS1C
01883      MOVE LCCM-OP-ID TO L221-UPDATE-OP-ID.                        DTSCS1C
01884                                                                   DTSCS1C
01885      MOVE LCCM-CICS-TERM-ID TO L221-UPDATE-TERMID.                DTSCS1C
01886                                                                   DTSCS1C
01887      MOVE LCCM-TASK-NETNAME TO L221-UPDATE-NETNAME.               DTSCS1C
01888                                                                   DTSCS1C
01889      MOVE LCCM-TASK-START-DATE TO L221-UPDATE-START-DATE.         DTSCS1C
01890                                                                   DTSCS1C
01891      MOVE LCCM-TASK-START-TIME TO L221-UPDATE-START-TIME.         DTSCS1C
01892                                                                   DTSCS1C
01893      MOVE WRK-SCR-ID TO L221-UPDATE-SCR-ID.                       DTSCS1C
01894                                                                   DTSCS1C
01895      PERFORM S221-EMP-LOCK THRU S221-EXIT.                        DTSCS1C
01896  P8810-EXIT.                                                      DTSCS1C
01897      EXIT.                                                        DTSCS1C
01898      SKIP3                                                        DTSCS1C
01899  P8820-LOCK-PRED.                                                 DTSCS1C
01900      IF (MAP-PRED-INACT-CD = SPACES)                              DTSCS1C
01901            AND                                                    DTSCS1C
01902         (MAP-RELATIONSHIP-CD = SPACES)                            DTSCS1C
01903          GO TO P8820-EXIT.                                        DTSCS1C
01904                                                                   DTSCS1C
01905                                                                   DTSCS1C
01906      MOVE MAP-PRED-EMP-NO-AREA TO L018-S-EMP-NO-AREA.             DTSCS1C
01907                                                                   DTSCS1C
01908      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS1C
01909                                                                   DTSCS1C
01910      IF L018-VALID                                                DTSCS1C
01911          NEXT SENTENCE                                            DTSCS1C
01912      ELSE                                                         DTSCS1C
01913          GO TO S899-ABEND.                                        DTSCS1C
01914                                                                   DTSCS1C
01915                                                                   DTSCS1C
01916      MOVE L018-EMP-NO TO WRK-PRED-EMP-NO.                         DTSCS1C
01917                                                                   DTSCS1C
01918      MOVE WRK-PRED-EMP-NO TO L221-EMP-NO.                         DTSCS1C
01919                                                                   DTSCS1C
01920      PERFORM S221-EMP-LOCK THRU S221-EXIT.                        DTSCS1C
01921                                                                   DTSCS1C
01922      SET WRK-PRED-LOCKED-YES-88 TO TRUE.                          DTSCS1C
01923  P8820-EXIT.                                                      DTSCS1C
01924      EXIT.                                                        DTSCS1C
01925      EJECT                                                        DTSCS1C
01926  P8910-MTAD-UPDATE.                                               DTSCS1C
01927      MOVE LOW-VALUES TO MTAD-KEY-AREA.                            DTSCS1C
01928                                                                   DTSCS1C
01929      MOVE WRK-EMP-NO TO MTAD-EMP-NO.                              DTSCS1C
01930                                                                   DTSCS1C
01931      SET MTAD-TAD-88 TO TRUE.                                     DTSCS1C
01932                                                                   DTSCS1C
01933      SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE.                     DTSCS1C
01934                                                                   DTSCS1C
01935      MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS1C
01936                                                                   DTSCS1C
01937      PERFORM S810-READ THRU S810-EXIT.                            DTSCS1C
01938                                                                   DTSCS1C
01939                                                                   DTSCS1C
01940      IF L810-NO-REC-88                                            DTSCS1C
01941          PERFORM P8911-MTAD-INITIALIZE THRU P8911-EXIT            DTSCS1C
01942          PERFORM P8912-UPDATE THRU P8912-EXIT                     DTSCS1C
01943          MOVE MTAD-REC TO MSKL-REC                                DTSCS1C
01944          PERFORM S810-WRITE THRU S810-EXIT                        DTSCS1C
01945      ELSE                                                         DTSCS1C
01946          MOVE MSKL-REC TO MTAD-REC                                DTSCS1C
01947          PERFORM P8912-UPDATE THRU P8912-EXIT                     DTSCS1C
01948          MOVE MTAD-REC TO MSKL-REC                                DTSCS1C
01949          PERFORM S810-REWRITE THRU S810-EXIT.                     DTSCS1C
01950  P8910-EXIT.                                                      DTSCS1C
01951      EXIT.                                                        DTSCS1C
01952      SKIP3                                                        DTSCS1C
01953  P8911-MTAD-INITIALIZE.                                           DTSCS1C
01954      MOVE +0 TO MTAD-PURGE-DATE.                                  DTSCS1C
01955                                                                   DTSCS1C
01956      MOVE LOW-VALUES TO MTAD-DATA-AREA.                           DTSCS1C
01957                                                                   DTSCS1C
01958      MOVE SPACES TO MTAD-ADDRESS.                                 DTSCS1C
01959                                                                   DTSCS1C
01960      MOVE SPACES TO MTAD-PHONE-NUMBERS.                           DTSCS1C
01961                                                                   DTSCS1C
01962      MOVE SPACES TO MTAD-EMAIL-ADDRESS.                           DTSCS1C
01963                                                                   DTSCS1C
01964      SET MTAD-UC223-YES-88 TO TRUE.                               DTSCS1C
01965                                                                   DTSCS1C
01966      SET MTAD-MISSING-RPT-LTRS-YES-88 TO TRUE.                    DTSCS1C
01967                                                                   DTSCS1C
01968      SET MTAD-PHYSICAL-ADDRESS-NO-88 TO TRUE.                     DTSCS1C
01969                                                                   DTSCS1C
01970      SET MTAD-NOT-CONVERTED-88 TO TRUE.                           DTSCS1C
01971                                                                   DTSCS1C
01972      MOVE LCCM-CURR-RUN-DATE TO MTAD-ESTB-DATE                    DTSCS1C
01973                                 MTAD-CHNG-DATE.                   DTSCS1C
01974  P8911-EXIT.                                                      DTSCS1C
01975      EXIT.                                                        DTSCS1C
01976      SKIP3                                                        DTSCS1C
01977  P8912-UPDATE.                                                    DTSCS1C
01978      MOVE 'MAILING ADDRESS' TO L331-REC-OCC-ID.                   DTSCS1C
01979                                                                   DTSCS1C
01980      MOVE LCCM-HOLD-ADDRESS-1 TO L072-ADDRESS.                    DTSCS1C
01981                                                                   DTSCS1C
01982                                                                   DTSCS1C
01983      IF L072-ATTN-LINE = MTAD-ATTN-LINE                           DTSCS1C
01984          NEXT SENTENCE                                            DTSCS1C
01985      ELSE                                                         DTSCS1C
01986          MOVE 'MTAD-ATTN-LINE' TO L331-FIELD-NAME                 DTSCS1C
01987          MOVE MTAD-ATTN-LINE TO L331-FROM-VALUE                   DTSCS1C
01988          MOVE L072-ATTN-LINE TO L331-TO-VALUE                     DTSCS1C
01989          PERFORM S331-WRITE-MLOG THRU S331-EXIT                   DTSCS1C
01990          MOVE L072-ATTN-LINE TO MTAD-ATTN-LINE                    DTSCS1C
01991          MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE.               DTSCS1C
01992                                                                   DTSCS1C
01993      IF L072-DELIV-LINE-1 = MTAD-DELIV-LINE-1                     DTSCS1C
01994          NEXT SENTENCE                                            DTSCS1C
01995      ELSE                                                         DTSCS1C
01996          MOVE 'MTAD-DELIV-LINE-1' TO L331-FIELD-NAME              DTSCS1C
01997          MOVE MTAD-DELIV-LINE-1 TO L331-FROM-VALUE                DTSCS1C
01998          MOVE L072-DELIV-LINE-1 TO L331-TO-VALUE                  DTSCS1C
01999          PERFORM S331-WRITE-MLOG THRU S331-EXIT                   DTSCS1C
02000          MOVE L072-DELIV-LINE-1 TO MTAD-DELIV-LINE-1              DTSCS1C
02001          MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE.               DTSCS1C
02002                                                                   DTSCS1C
02003      IF L072-DELIV-LINE-2 = MTAD-DELIV-LINE-2                     DTSCS1C
02004          NEXT SENTENCE                                            DTSCS1C
02005      ELSE                                                         DTSCS1C
02006          MOVE 'MTAD-DELIV-LINE-2' TO L331-FIELD-NAME              DTSCS1C
02007          MOVE MTAD-DELIV-LINE-2 TO L331-FROM-VALUE                DTSCS1C
02008          MOVE L072-DELIV-LINE-2 TO L331-TO-VALUE                  DTSCS1C
02009          PERFORM S331-WRITE-MLOG THRU S331-EXIT                   DTSCS1C
02010          MOVE L072-DELIV-LINE-2 TO MTAD-DELIV-LINE-2              DTSCS1C
02011          MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE.               DTSCS1C
02012                                                                   DTSCS1C
02013      IF L072-CITY = MTAD-CITY                                     DTSCS1C
02014          NEXT SENTENCE                                            DTSCS1C
02015      ELSE                                                         DTSCS1C
02016          MOVE 'MTAD-CITY' TO L331-FIELD-NAME                      DTSCS1C
02017          MOVE MTAD-CITY TO L331-FROM-VALUE                        DTSCS1C
02018          MOVE L072-CITY TO L331-TO-VALUE                          DTSCS1C
02019          PERFORM S331-WRITE-MLOG THRU S331-EXIT                   DTSCS1C
02020          MOVE L072-CITY TO MTAD-CITY                              DTSCS1C
02021          MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE.               DTSCS1C
02022                                                                   DTSCS1C
02023      IF L072-ST = MTAD-ST                                         DTSCS1C
02024          NEXT SENTENCE                                            DTSCS1C
02025      ELSE                                                         DTSCS1C
02026          MOVE 'MTAD-ST' TO L331-FIELD-NAME                        DTSCS1C
02027          MOVE MTAD-ST TO L331-FROM-VALUE                          DTSCS1C
02028          MOVE L072-ST TO L331-TO-VALUE                            DTSCS1C
02029          PERFORM S331-WRITE-MLOG THRU S331-EXIT                   DTSCS1C
02030          MOVE L072-ST TO MTAD-ST                                  DTSCS1C
02031          MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE.               DTSCS1C
02032                                                                   DTSCS1C
02033      IF L072-ZIP = MTAD-ZIP                                       DTSCS1C
02034          NEXT SENTENCE                                            DTSCS1C
02035      ELSE                                                         DTSCS1C
02036          MOVE 'MTAD-ZIP' TO L331-FIELD-NAME                       DTSCS1C
02037          MOVE MTAD-ZIP TO L331-FROM-VALUE                         DTSCS1C
02038          MOVE L072-ZIP TO L331-TO-VALUE                           DTSCS1C
02039          PERFORM S331-WRITE-MLOG THRU S331-EXIT                   DTSCS1C
02040          MOVE L072-ZIP TO MTAD-ZIP                                DTSCS1C
02041          MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE.               DTSCS1C
02042                                                                   DTSCS1C
02043      IF L072-ADVANCED-BARCODE = MTAD-ADVANCED-BARCODE             DTSCS1C
02044          NEXT SENTENCE                                            DTSCS1C
02045      ELSE                                                         DTSCS1C
02046          MOVE L072-ADVANCED-BARCODE TO MTAD-ADVANCED-BARCODE      DTSCS1C
02047          MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE.               DTSCS1C
02048                                                                   DTSCS1C
02049                                                                   DTSCS1C
02050      MOVE MAP-VOICE-1-AREA TO L021-S-TNO-AREA.                    DTSCS1C
02051                                                                   DTSCS1C
02052      PERFORM S021-TELNO-FROM-SCREEN THRU S021-EXIT.               DTSCS1C
02053                                                                   DTSCS1C
02054      IF L021-TNO = MTAD-VOICE-1                                   DTSCS1C
02055          NEXT SENTENCE                                            DTSCS1C
02056      ELSE                                                         DTSCS1C
02057          MOVE 'MTAD-VOICE-1' TO L331-FIELD-NAME                   DTSCS1C
02058          MOVE SPACE TO L331-FROM-VALUE                            DTSCS1C
02059                        L331-TO-VALUE                              DTSCS1C
02060          STRING MTAD-VOICE-1-AREA-CD DELIMITED BY SIZE            DTSCS1C
02061                 ' '                  DELIMITED BY SIZE            DTSCS1C
02062                 MTAD-VOICE-1-PREFIX  DELIMITED BY SIZE            DTSCS1C
02063                 ' '                  DELIMITED BY SIZE            DTSCS1C
02064                 MTAD-VOICE-1-SUFFIX  DELIMITED BY SIZE            DTSCS1C
02065                 ' '                  DELIMITED BY SIZE            DTSCS1C
02066                 MTAD-VOICE-1-EXT     DELIMITED BY SIZE            DTSCS1C
02067              INTO L331-FROM-VALUE                                 DTSCS1C
02068          STRING L021-TNO-AREA-CD DELIMITED BY SIZE                DTSCS1C
02069                 ' '              DELIMITED BY SIZE                DTSCS1C
02070                 L021-TNO-PREFIX  DELIMITED BY SIZE                DTSCS1C
02071                 ' '              DELIMITED BY SIZE                DTSCS1C
02072                 L021-TNO-SUFFIX  DELIMITED BY SIZE                DTSCS1C
02073                 ' '              DELIMITED BY SIZE                DTSCS1C
02074                 L021-TNO-EXT     DELIMITED BY SIZE                DTSCS1C
02075              INTO L331-TO-VALUE                                   DTSCS1C
02076          PERFORM S331-WRITE-MLOG THRU S331-EXIT                   DTSCS1C
02077          MOVE L021-TNO TO MTAD-VOICE-1                            DTSCS1C
02078          MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE.               DTSCS1C
02079                                                                   DTSCS1C
02080                                                                   DTSCS1C
02081      MOVE MAP-VOICE-2-AREA TO L021-S-TNO-AREA.                    DTSCS1C
02082                                                                   DTSCS1C
02083      PERFORM S021-TELNO-FROM-SCREEN THRU S021-EXIT.               DTSCS1C
02084                                                                   DTSCS1C
02085      IF L021-TNO = MTAD-VOICE-2                                   DTSCS1C
02086          NEXT SENTENCE                                            DTSCS1C
02087      ELSE                                                         DTSCS1C
02088          MOVE 'MTAD-VOICE-2' TO L331-FIELD-NAME                   DTSCS1C
02089          MOVE SPACE TO L331-FROM-VALUE                            DTSCS1C
02090                        L331-TO-VALUE                              DTSCS1C
02091          STRING MTAD-VOICE-2-AREA-CD DELIMITED BY SIZE            DTSCS1C
02092                 ' '                  DELIMITED BY SIZE            DTSCS1C
02093                 MTAD-VOICE-2-PREFIX  DELIMITED BY SIZE            DTSCS1C
02094                 ' '                  DELIMITED BY SIZE            DTSCS1C
02095                 MTAD-VOICE-2-SUFFIX  DELIMITED BY SIZE            DTSCS1C
02096                 ' '                  DELIMITED BY SIZE            DTSCS1C
02097                 MTAD-VOICE-2-EXT     DELIMITED BY SIZE            DTSCS1C
02098              INTO L331-FROM-VALUE                                 DTSCS1C
02099          STRING L021-TNO-AREA-CD DELIMITED BY SIZE                DTSCS1C
02100                 ' '              DELIMITED BY SIZE                DTSCS1C
02101                 L021-TNO-PREFIX  DELIMITED BY SIZE                DTSCS1C
02102                 ' '              DELIMITED BY SIZE                DTSCS1C
02103                 L021-TNO-SUFFIX  DELIMITED BY SIZE                DTSCS1C
02104                 ' '              DELIMITED BY SIZE                DTSCS1C
02105                 L021-TNO-EXT     DELIMITED BY SIZE                DTSCS1C
02106              INTO L331-TO-VALUE                                   DTSCS1C
02107          PERFORM S331-WRITE-MLOG THRU S331-EXIT                   DTSCS1C
02108          MOVE L021-TNO TO MTAD-VOICE-2                            DTSCS1C
02109          MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE.               DTSCS1C
02110                                                                   DTSCS1C
02111                                                                   DTSCS1C
02112      MOVE MAP-FAX-AREA TO L021-S-TNO-AREA.                        DTSCS1C
02113                                                                   DTSCS1C
02114      PERFORM S021-TELNO-FROM-SCREEN THRU S021-EXIT.               DTSCS1C
02115                                                                   DTSCS1C
02116      IF L021-TNO = MTAD-FAX                                       DTSCS1C
02117          NEXT SENTENCE                                            DTSCS1C
02118      ELSE                                                         DTSCS1C
02119          MOVE 'MTAD-FAX' TO L331-FIELD-NAME                       DTSCS1C
02120          MOVE SPACE TO L331-FROM-VALUE                            DTSCS1C
02121                        L331-TO-VALUE                              DTSCS1C
02122          STRING MTAD-FAX-AREA-CD DELIMITED BY SIZE                DTSCS1C
02123                 ' '              DELIMITED BY SIZE                DTSCS1C
02124                 MTAD-FAX-PREFIX  DELIMITED BY SIZE                DTSCS1C
02125                 ' '              DELIMITED BY SIZE                DTSCS1C
02126                 MTAD-FAX-SUFFIX  DELIMITED BY SIZE                DTSCS1C
02127                 ' '              DELIMITED BY SIZE                DTSCS1C
02128                 MTAD-FAX-EXT     DELIMITED BY SIZE                DTSCS1C
02129              INTO L331-FROM-VALUE                                 DTSCS1C
02130          STRING L021-TNO-AREA-CD DELIMITED BY SIZE                DTSCS1C
02131                 ' '              DELIMITED BY SIZE                DTSCS1C
02132                 L021-TNO-PREFIX  DELIMITED BY SIZE                DTSCS1C
02133                 ' '              DELIMITED BY SIZE                DTSCS1C
02134                 L021-TNO-SUFFIX  DELIMITED BY SIZE                DTSCS1C
02135                 ' '              DELIMITED BY SIZE                DTSCS1C
02136                 L021-TNO-EXT     DELIMITED BY SIZE                DTSCS1C
02137              INTO L331-TO-VALUE                                   DTSCS1C
02138          PERFORM S331-WRITE-MLOG THRU S331-EXIT                   DTSCS1C
02139          MOVE L021-TNO TO MTAD-FAX                                DTSCS1C
02140          MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE.               DTSCS1C
02141  P8912-EXIT.                                                      DTSCS1C
02142      EXIT.                                                        DTSCS1C
02143      EJECT                                                        DTSCS1C
02144  P8920-MPRF-UPDATE.                                               DTSCS1C
02145      MOVE LOW-VALUES TO MPRF-KEY-AREA.                            DTSCS1C
02146                                                                   DTSCS1C
02147      MOVE WRK-EMP-NO TO MPRF-EMP-NO.                              DTSCS1C
02148                                                                   DTSCS1C
02149      SET MPRF-PRF-88 TO TRUE.                                     DTSCS1C
02150                                                                   DTSCS1C
02151      MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS1C
02152                                                                   DTSCS1C
02153      PERFORM S810-READ THRU S810-EXIT.                            DTSCS1C
02154                                                                   DTSCS1C
02155      IF L810-NO-REC-88                                            DTSCS1C
02156          GO TO S899-ABEND.                                        DTSCS1C
02157                                                                   DTSCS1C
02158                                                                   DTSCS1C
02159      MOVE MSKL-REC TO MPRF-REC.                                   DTSCS1C
02160                                                                   DTSCS1C
02161                                                                   DTSCS1C
02162      MOVE SPACES TO L331-REC-OCC-ID.                              DTSCS1C
02163                                                                   DTSCS1C
02164                                                                   DTSCS1C
02165      PERFORM P8921-EMP-CLASS THRU P8921-EXIT.                     DTSCS1C
02166                                                                   DTSCS1C
02167      PERFORM P8922-EMP-STATUS THRU P8922-EXIT.                    DTSCS1C
02168                                                                   DTSCS1C
02169                                                                   DTSCS1C
02170      IF (MPRF-CLASS-RATED-88)                                     DTSCS1C
02171             AND                                                   DTSCS1C
02172         (MPRF-STATUS-INACT-88)                                    DTSCS1C
02173          NEXT SENTENCE                                            DTSCS1C
02174      ELSE                                                         DTSCS1C
02175          IF MPRF-CHRG-STMT-PRINT-YES-88                           DTSCS1C
02176              NEXT SENTENCE                                        DTSCS1C
02177          ELSE                                                     DTSCS1C
02178              MOVE 'MPRF-CHRG-STMT-PRINT-IND' TO L331-FIELD-NAME   DTSCS1C
02179              MOVE MPRF-CHRG-STMT-PRINT-IND TO L331-FROM-VALUE     DTSCS1C
02180              SET MPRF-CHRG-STMT-PRINT-YES-88 TO TRUE              DTSCS1C
02181              MOVE MPRF-CHRG-STMT-PRINT-IND TO L331-TO-VALUE       DTSCS1C
02182              PERFORM S331-WRITE-MLOG THRU S331-EXIT               DTSCS1C
02183              MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE.           DTSCS1C
02184                                                                   DTSCS1C
02185                                                                   DTSCS1C
02186      IF MAP-PRIMARY-NAME = MPRF-PRIMARY-NAME                      DTSCS1C
02187          NEXT SENTENCE                                            DTSCS1C
02188      ELSE                                                         DTSCS1C
02189          MOVE 'MPRF-PRIMARY-NAME' TO L331-FIELD-NAME              DTSCS1C
02190          MOVE MPRF-PRIMARY-NAME TO L331-FROM-VALUE                DTSCS1C
02191          MOVE MAP-PRIMARY-NAME TO L331-TO-VALUE                   DTSCS1C
02192          PERFORM S331-WRITE-MLOG THRU S331-EXIT                   DTSCS1C
02193          MOVE MAP-PRIMARY-NAME TO MPRF-PRIMARY-NAME               DTSCS1C
02194          MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE.               DTSCS1C
02195                                                                   DTSCS1C
02196      MOVE WRK-EMP-NO TO L203-EMP-NO.                              DTSCS1C
02197                                                                   DTSCS1C
02198      MOVE MPRF-TAX-REC-ADDR-EXISTS-IND                            DTSCS1C
02199        TO L203-TAX-REC-ADDR-EXISTS-IND.                           DTSCS1C
02200                                                                   DTSCS1C
02201      PERFORM S203-DETER-ZIPS THRU S203-EXIT.                      DTSCS1C
02202                                                                   DTSCS1C
02203      IF L203-FLD-ZIP NOT = MPRF-FLD-ZIP                           DTSCS1C
02204          MOVE L203-FLD-ZIP TO MPRF-FLD-ZIP                        DTSCS1C
02205          MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE.               DTSCS1C
02206                                                                   DTSCS1C
02207      IF L203-FLD-STATE NOT = MPRF-FLD-ST                          DTSCS1C
02208          MOVE L203-FLD-STATE TO MPRF-FLD-ST                       DTSCS1C
02209          MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE.               DTSCS1C
02210                                                                   DTSCS1C
02211                                                                   DTSCS1C
02212      IF MAP-ORG-TYPE = MPRF-ORG-TYPE                              DTSCS1C
02213          NEXT SENTENCE                                            DTSCS1C
02214      ELSE                                                         DTSCS1C
02215          MOVE 'MPRF-ORG-TYPE' TO L331-FIELD-NAME                  DTSCS1C
02216          MOVE MPRF-ORG-TYPE TO L331-FROM-VALUE                    DTSCS1C
02217          MOVE MAP-ORG-TYPE TO L331-TO-VALUE                       DTSCS1C
02218          PERFORM S331-WRITE-MLOG THRU S331-EXIT                   DTSCS1C
02219          MOVE MAP-ORG-TYPE TO MPRF-ORG-TYPE                       DTSCS1C
02220          MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE.               DTSCS1C
02221                                                                   DTSCS1C
02222                                                                   DTSCS1C
02223      MOVE MAP-FEIN-AREA TO L017-S-FEIN-AREA.                      DTSCS1C
02224                                                                   DTSCS1C
02225      PERFORM S017-FEIN-FROM-SCREEN THRU S017-EXIT.                DTSCS1C
02226                                                                   DTSCS1C
02227      IF L017-FEIN = MPRF-FEIN                                     DTSCS1C
02228          NEXT SENTENCE                                            DTSCS1C
02229      ELSE                                                         DTSCS1C
02230          MOVE 'MPRF-FEIN' TO L331-FIELD-NAME                      DTSCS1C
02231          MOVE SPACES TO L331-TO-VALUE                             DTSCS1C
02232                         L331-FROM-VALUE                           DTSCS1C
02233          IF MPRF-FEIN NOT = +0                                    DTSCS1C
02234              MOVE MPRF-FEIN TO WRK-DISPLAY                        DTSCS1C
02235              STRING WRK-DISPLAY-FEIN-1 DELIMITED BY SIZE          DTSCS1C
02236                     ' '                DELIMITED BY SIZE          DTSCS1C
02237                     WRK-DISPLAY-FEIN-2 DELIMITED BY SIZE          DTSCS1C
02238                  INTO L331-FROM-VALUE                             DTSCS1C
02239          END-IF                                                   DTSCS1C
02240          IF L017-FEIN NOT = +0                                    DTSCS1C
02241              MOVE L017-FEIN TO WRK-DISPLAY                        DTSCS1C
02242              STRING WRK-DISPLAY-FEIN-1 DELIMITED BY SIZE          DTSCS1C
02243                     ' '                DELIMITED BY SIZE          DTSCS1C
02244                     WRK-DISPLAY-FEIN-2 DELIMITED BY SIZE          DTSCS1C
02245                  INTO L331-TO-VALUE                               DTSCS1C
02246          END-IF                                                   DTSCS1C
02247          PERFORM S331-WRITE-MLOG THRU S331-EXIT                   DTSCS1C
02248          MOVE L017-FEIN TO MPRF-FEIN                              DTSCS1C
02249          MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE.               DTSCS1C
02250                                                                   DTSCS1C
02251                                                                   DTSCS1C
02252      MOVE MPRF-REC TO MSKL-REC.                                   DTSCS1C
02253                                                                   DTSCS1C
02254      PERFORM S810-REWRITE THRU S810-EXIT.                         DTSCS1C
02255  P8920-EXIT.                                                      DTSCS1C
02256      EXIT.                                                        DTSCS1C
02257      SKIP3                                                        DTSCS1C
02258  P8921-EMP-CLASS.                                                 DTSCS1C
02259      IF (MPRF-CLASS-UNK-88)                                       DTSCS1C
02260           AND                                                     DTSCS1C
02261         (MAP-UI-LIABLE-YES-88)                                    DTSCS1C
02262          MOVE 'MPRF-EMP-CLASS' TO L331-FIELD-NAME                 DTSCS1C
02263          MOVE MPRF-EMP-CLASS TO L331-FROM-VALUE                   DTSCS1C
02264          MOVE MAP-EMP-CLASS TO L331-TO-VALUE                      DTSCS1C
02265          PERFORM S331-WRITE-MLOG THRU S331-EXIT                   DTSCS1C
02266          MOVE MAP-EMP-CLASS TO MPRF-EMP-CLASS                     DTSCS1C
02267          MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE                DTSCS1C
02268          MOVE MPRF-EMP-CLASS TO L202-EMP-CLASS                    DTSCS1C
02269          PERFORM S202-DETER-ELIG-CD THRU S202-EXIT                DTSCS1C
02270          MOVE L202-ELIGIBLE-CD TO MPRF-ELIGIBLE-CD.               DTSCS1C
02271  P8921-EXIT.                                                      DTSCS1C
02272      EXIT.                                                        DTSCS1C
02273      SKIP3                                                        DTSCS1C
02274  P8922-EMP-STATUS.                                                DTSCS1C
02275      MOVE MPRF-EMP-STATUS TO HOLD-EMP-STATUS.                     DTSCS1C
02276                                                                   DTSCS1C
02277      IF MAP-UI-LIABLE-NO-88                                       DTSCS1C
02278          IF MPRF-STATUS-UNK-88                                    DTSCS1C
02279              SET MPRF-STATUS-NEVERSUB-88 TO TRUE                  DTSCS1C
02280          ELSE                                                     DTSCS1C
02281              NEXT SENTENCE                                        DTSCS1C
02282      ELSE                                                         DTSCS1C
02283          IF MAP-INACT-CD = SPACES                                 DTSCS1C
02284              SET MPRF-STATUS-ACT-88 TO TRUE                       DTSCS1C
02285          ELSE                                                     DTSCS1C
02286              SET MPRF-STATUS-INACT-88 TO TRUE.                    DTSCS1C
02287                                                                   DTSCS1C
02288      IF HOLD-EMP-STATUS = MPRF-EMP-STATUS                         DTSCS1C
02289          NEXT SENTENCE                                            DTSCS1C
02290      ELSE                                                         DTSCS1C
02291          MOVE 'MPRF-EMP-STATUS' TO L331-FIELD-NAME                DTSCS1C
02292          MOVE HOLD-EMP-STATUS TO L331-FROM-VALUE                  DTSCS1C
02293          MOVE MPRF-EMP-STATUS TO L331-TO-VALUE                    DTSCS1C
02294          PERFORM S331-WRITE-MLOG THRU S331-EXIT                   DTSCS1C
02295          MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE.               DTSCS1C
02296  P8922-EXIT.                                                      DTSCS1C
02297      EXIT.                                                        DTSCS1C
02298      EJECT                                                        DTSCS1C
02299  P8930-MERA.                                                      DTSCS1C
02300      MOVE LOW-VALUES TO MERA-KEY-AREA.                            DTSCS1C
02301                                                                   DTSCS1C
02302      MOVE WRK-EMP-NO TO MERA-EMP-NO.                              DTSCS1C
02303                                                                   DTSCS1C
02304      SET MERA-ERA-88 TO TRUE.                                     DTSCS1C
02305                                                                   DTSCS1C
02306      MOVE MERA-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS1C
02307                                                                   DTSCS1C
02308      PERFORM S810-READ THRU S810-EXIT.                            DTSCS1C
02309                                                                   DTSCS1C
02310      IF L810-NO-REC-88                                            DTSCS1C
02311          SET WRK-MERA-NONE-88 TO TRUE                             DTSCS1C
02312      ELSE                                                         DTSCS1C
02313          MOVE MSKL-REC TO MERA-REC                                DTSCS1C
02314          IF MERA-STATUS-ACTIVE-88                                 DTSCS1C
02315              SET WRK-MERA-ACTIVE-88 TO TRUE                       DTSCS1C
02316          ELSE                                                     DTSCS1C
02317              SET WRK-MERA-INACTIVE-88 TO TRUE.                    DTSCS1C
02318                                                                   DTSCS1C
02319                                                                   DTSCS1C
02320      IF WRK-MERA-ACTIVE-88 OR WRK-MERA-INACTIVE-88                DTSCS1C
02321          PERFORM P8931-UPDATE-MERA THRU P8931-EXIT                DTSCS1C
02322          MOVE MERA-REC TO MSKL-REC                                DTSCS1C
02323          PERFORM S810-REWRITE THRU S810-EXIT                      DTSCS1C
02324          GO TO P8930-EXIT.                                        DTSCS1C
02325                                                                   DTSCS1C
02326                                                                   DTSCS1C
02327      PERFORM P8933-INITIALIZE-MERA THRU P8933-EXIT.               DTSCS1C
02328                                                                   DTSCS1C
02329      PERFORM P8931-UPDATE-MERA THRU P8931-EXIT.                   DTSCS1C
02330                                                                   DTSCS1C
02331      MOVE MERA-REC TO MSKL-REC.                                   DTSCS1C
02332                                                                   DTSCS1C
02333      PERFORM S810-WRITE THRU S810-EXIT.                           DTSCS1C
02334  P8930-EXIT.                                                      DTSCS1C
02335      EXIT.                                                        DTSCS1C
02336      SKIP3                                                        DTSCS1C
02337  P8931-UPDATE-MERA.                                               DTSCS1C
02338      IF MAP-UI-LIABLE-NO-88                                       DTSCS1C
02339          IF MERA-STATUS-NOT-LIAB-88                               DTSCS1C
02340              NEXT SENTENCE                                        DTSCS1C
02341          ELSE                                                     DTSCS1C
02342              SET MERA-STATUS-NOT-LIAB-88 TO TRUE                  DTSCS1C
02343              MOVE LCCM-CURR-RUN-DATE TO MERA-STATUS-CHNG-DATE     DTSCS1C
02344                                         MERA-CHNG-DATE            DTSCS1C
02345          END-IF                                                   DTSCS1C
02346          IF MERA-DETER-NOTSUB-DATE = LCCM-CURR-RUN-DATE           DTSCS1C
02347              NEXT SENTENCE                                        DTSCS1C
02348          ELSE                                                     DTSCS1C
02349              MOVE LCCM-CURR-RUN-DATE TO MERA-DETER-NOTSUB-DATE    DTSCS1C
02350                                         MERA-CHNG-DATE            DTSCS1C
02351          END-IF                                                   DTSCS1C
02352      END-IF.                                                      DTSCS1C
02353                                                                   DTSCS1C
02354      IF MAP-UI-LIABLE-YES-88                                      DTSCS1C
02355          IF MERA-STATUS-LIAB-88                                   DTSCS1C
02356              NEXT SENTENCE                                        DTSCS1C
02357          ELSE                                                     DTSCS1C
02358              SET MERA-STATUS-LIAB-88 TO TRUE                      DTSCS1C
02359              MOVE LCCM-CURR-RUN-DATE TO MERA-STATUS-CHNG-DATE     DTSCS1C
02360                                         MERA-CHNG-DATE            DTSCS1C
02361              IF (MERA-SOURCE-UC30-88                              DTSCS1C
02362              AND MERA-RECEIVED-DATE = ZERO)                       DTSCS1C
02363                 PERFORM P8931A-START-CYCLE-A  THRU P8931A-EXIT    DTSCS1C
02364              END-IF                                               DTSCS1C
02365          END-IF                                                   DTSCS1C
02366          IF MERA-DETER-NOTSUB-DATE = +0                           DTSCS1C
02367              NEXT SENTENCE                                        DTSCS1C
02368          ELSE                                                     DTSCS1C
02369              MOVE +0 TO MERA-DETER-NOTSUB-DATE                    DTSCS1C
02370              MOVE LCCM-CURR-RUN-DATE TO MERA-CHNG-DATE            DTSCS1C
02371          END-IF                                                   DTSCS1C
02372      END-IF.                                                      DTSCS1C
02373  P8931-EXIT.                                                      DTSCS1C
02374      EXIT.                                                        DTSCS1C
02375      SKIP3                                                        DTSCS1C
02376  P8931A-START-CYCLE-A.                                            DTSCS1C
02377      IF MERA-STATUS-ACTIVE-88                                     DTSCS1C
02378         GO TO P8931A-EXIT                                         DTSCS1C
02379      END-IF.                                                      DTSCS1C
02380                                                                   DTSCS1C
02381      SET MERA-STATUS-SETUP-88  TO TRUE.                           DTSCS1C
02382      SET MERA-LETTER-UC30-RCVD-88  TO TRUE.                       DTSCS1C
02383                                                                   DTSCS1C
02384      MOVE LOW-VALUES TO MTCK-REC.                                 DTSCS1C
02385      MOVE WRK-EMP-NO TO MTCK-EMP-NO.                              DTSCS1C
02386      SET MTCK-TCK-88 TO TRUE.                                     DTSCS1C
02387      MOVE LCCM-TASK-START-ABSTIME TO MTCK-ESTB-ABSTIME.           DTSCS1C
02388      MOVE ZEROS TO MTCK-PURGE-DATE                                DTSCS1C
02389      SET MTCK-TYPE-CYCLE-A-88 TO TRUE.                            DTSCS1C
02390      MOVE LCCM-CURR-RUN-DATE TO MTCK-TRIGGER-DATE                 DTSCS1C
02391      MOVE ZEROS TO MTCK-ACKNOWLEDGED-DATE.                        DTSCS1C
02392      MOVE 'SYSTEM' TO MTCK-SOURCE-OP-ID.                          DTSCS1C
02393      MOVE 'SYSTEM' TO MTCK-DEST-OP-ID.                            DTSCS1C
02394      SET MTCK-NOT-CONVERTED-88 TO TRUE.                           DTSCS1C
02395      MOVE LCCM-CURR-RUN-DATE TO MTCK-ESTB-DATE.                   DTSCS1C
02396      MOVE LCCM-CURR-RUN-DATE TO MTCK-CHNG-DATE.                   DTSCS1C
02397      MOVE ZEROS TO MTCK-TEXT-CNT.                                 DTSCS1C
02398                                                                   DTSCS1C
02399      MOVE MTCK-REC TO MSKL-REC.                                   DTSCS1C
02400                                                                   DTSCS1C
02401      PERFORM S810-WRITE THRU S810-EXIT.                           DTSCS1C
02402                                                                   DTSCS1C
02403  P8931A-EXIT.                                                     DTSCS1C
02404      EXIT.                                                        DTSCS1C
02405      SKIP3                                                        DTSCS1C
02406  P8933-INITIALIZE-MERA.                                           DTSCS1C
02407      MOVE +0 TO MERA-PURGE-DATE.                                  DTSCS1C
02408                                                                   DTSCS1C
02409      MOVE LOW-VALUES TO MERA-DATA-AREA.                           DTSCS1C
02410                                                                   DTSCS1C
02411      SET MERA-SOURCE-UNK-88 TO TRUE.                              DTSCS1C
02412                                                                   DTSCS1C
02413      MOVE +0 TO MERA-CLAIMANT-SSN.                                DTSCS1C
02414                                                                   DTSCS1C
02415      MOVE SPACES TO MERA-CLAIMANT-NAME.                           DTSCS1C
02416                                                                   DTSCS1C
02417      MOVE LCCM-RESP-OP-ID TO MERA-RESPONSIBLE-OP-ID.              DTSCS1C
02418                                                                   DTSCS1C
02419      MOVE +0 TO MERA-POT-PRED-EMP-NO.                             DTSCS1C
02420                                                                   DTSCS1C
02421      MOVE SPACES TO MERA-NOTE.                                    DTSCS1C
02422                                                                   DTSCS1C
02423      SET MERA-LETTER-GENERIC-88 TO TRUE.                          DTSCS1C
02424                                                                   DTSCS1C
02425      MOVE +1 TO MERA-LABEL-CNT.                                   DTSCS1C
02426                                                                   DTSCS1C
02427      SET MERA-STATUS-SETUP-88 TO TRUE.                            DTSCS1C
02428                                                                   DTSCS1C
02429      MOVE LCCM-CURR-RUN-DATE TO MERA-STATUS-CHNG-DATE.            DTSCS1C
02430                                                                   DTSCS1C
02431      MOVE +0 TO MERA-MAIL-DATE-1                                  DTSCS1C
02432                 MERA-MAIL-DATE-2                                  DTSCS1C
02433                 MERA-COOP-AGENCY-REQ-DATE                         DTSCS1C
02434                 MERA-FIELD-ASSIGN-DATE                            DTSCS1C
02435                 MERA-RECEIVED-DATE                                DTSCS1C
02436                 MERA-DETER-NOTSUB-DATE.                           DTSCS1C
02437                                                                   DTSCS1C
02438      SET MERA-NOT-CONVERTED-88 TO TRUE.                           DTSCS1C
02439                                                                   DTSCS1C
02440      MOVE LCCM-CURR-RUN-DATE TO MERA-ESTB-DATE                    DTSCS1C
02441                                 MERA-CHNG-DATE.                   DTSCS1C
02442  P8933-EXIT.                                                      DTSCS1C
02443      EXIT.                                                        DTSCS1C
02444      EJECT                                                        DTSCS1C
02445  P8940-LIABLE-NO.                                                 DTSCS1C
02446      IF MAP-NOT-LIABLE-LTR-NO-88                                  DTSCS1C
02447          NEXT SENTENCE                                            DTSCS1C
02448      ELSE                                                         DTSCS1C
02449          PERFORM P8991-INITIALIZE-T001 THRU P8991-EXIT            DTSCS1C
02450          MOVE WRK-EMP-NO TO T001-EMP-NO                           DTSCS1C
02451          SET T001-NOT-LIABLE-LTR TO TRUE                          DTSCS1C
02452          MOVE MAP-NOT-LIABLE-LTR-TYPE TO T001-NOT-LIABLE-LTR-TYPE DTSCS1C
02453          PERFORM S825-WRITE-T001 THRU S825-EXIT.                  DTSCS1C
02454                                                                   DTSCS1C
02455                                                                   DTSCS1C
02456      MOVE MAP-FOLLOWUP-DATE-AREA TO L015-S-DATE-AREA.             DTSCS1C
02457                                                                   DTSCS1C
02458      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS1C
02459                                                                   DTSCS1C
02460      IF L015-VALID                                                DTSCS1C
02461          MOVE LOW-VALUES TO MTCK-REC                              DTSCS1C
02462          MOVE WRK-EMP-NO TO MTCK-EMP-NO                           DTSCS1C
02463          SET MTCK-TCK-88 TO TRUE                                  DTSCS1C
02464          MOVE LCCM-TASK-START-ABSTIME TO MTCK-ESTB-ABSTIME        DTSCS1C
02465          MOVE +0 TO MTCK-PURGE-DATE                               DTSCS1C
02466          SET MTCK-TYPE-MANUAL-88 TO TRUE                          DTSCS1C
02467          MOVE L015-DATE TO MTCK-TRIGGER-DATE                      DTSCS1C
02468          MOVE +0 TO MTCK-ACKNOWLEDGED-DATE                        DTSCS1C
02469          MOVE LCCM-OP-ID TO MTCK-SOURCE-OP-ID                     DTSCS1C
02470          MOVE 'STATUS' TO MTCK-DEST-OP-ID                         DTSCS1C
02471          SET MTCK-NOT-CONVERTED-88 TO TRUE                        DTSCS1C
02472          MOVE LCCM-CURR-RUN-DATE TO MTCK-ESTB-DATE                DTSCS1C
02473                                     MTCK-CHNG-DATE                DTSCS1C
02474          MOVE +1 TO MTCK-TEXT-CNT                                 DTSCS1C
02475          MOVE SPACES TO MTCK-TEXT (1)                             DTSCS1C
02476          STRING 'DETERMINATION OF NOT LIABLE ENTERED ON '         DTSCS1C
02477                   DELIMITED BY SIZE                               DTSCS1C
02478                 LCCM-TASK-START-DISP-DATE                         DTSCS1C
02479                   DELIMITED BY SIZE                               DTSCS1C
02480                 '.  FOLLOW UP?'                                   DTSCS1C
02481                   DELIMITED BY SIZE                               DTSCS1C
02482              INTO                                                 DTSCS1C
02483                  MTCK-TEXT (1)                                    DTSCS1C
02484          MOVE MTCK-REC TO MSKL-REC                                DTSCS1C
02485          PERFORM S810-WRITE THRU S810-EXIT.                       DTSCS1C
02486                                                                   DTSCS1C
02487      PERFORM P8965-NOT-LIAB-HOUSEHOLD  THRU P8965-EXIT.           DTSCS1C
02488                                                                   DTSCS1C
02489  P8940-EXIT.                                                      DTSCS1C
02490      EXIT.                                                        DTSCS1C
02491      EJECT                                                        DTSCS1C
02492  P8950-LIABLE-YES.                                                DTSCS1C
02493      MOVE MAP-LIAB-DATE-AREA TO L015-S-DATE-AREA.                 DTSCS1C
02494                                                                   DTSCS1C
02495      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS1C
02496                                                                   DTSCS1C
02497      IF L015-VALID                                                DTSCS1C
02498          NEXT SENTENCE                                            DTSCS1C
02499      ELSE                                                         DTSCS1C
02500          GO TO S899-ABEND.                                        DTSCS1C
02501                                                                   DTSCS1C
02502                                                                   DTSCS1C
02503      MOVE L015-DATE TO WRK-LIAB-DATE.                             DTSCS1C
02504                                                                   DTSCS1C
02505      IF MAP-INACT-CD = SPACES                                     DTSCS1C
02506          MOVE ALL-NINES-DATE TO WRK-INACT-DATE                    DTSCS1C
02507      ELSE                                                         DTSCS1C
02508          MOVE MAP-INACT-DATE-AREA TO L015-S-DATE-AREA             DTSCS1C
02509          PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT             DTSCS1C
02510          IF L015-VALID                                            DTSCS1C
02511              MOVE L015-DATE TO WRK-INACT-DATE                     DTSCS1C
02512          ELSE                                                     DTSCS1C
02513              GO TO S899-ABEND.                                    DTSCS1C
02514                                                                   DTSCS1C
02515                                                                   DTSCS1C
02516      PERFORM S6100-SET-LIAB-YRQ THRU S6100-EXIT.                  DTSCS1C
02517                                                                   DTSCS1C
02518      PERFORM P8961-ADD-MSOL THRU P8961-EXIT.                      DTSCS1C
02519                                                                   DTSCS1C
02520      PERFORM P8962-LIABILITY-OLA-WRITE THRU P8962-EXIT.           DTSCS1C
02521                                                                   DTSCS1C
02522      PERFORM P8963-ADD-MRTE THRU P8963-EXIT                       DTSCS1C
02523          VARYING WRK-SUB1 FROM 1 BY 1                             DTSCS1C
02524          UNTIL WRK-SUB1 > RTE-OCC-MAX.                            DTSCS1C
02525                                                                   DTSCS1C
02526      PERFORM P8964-ADD-MFSC            THRU P8964-EXIT.           DTSCS1C
02527                                                                   DTSCS1C
02528      MOVE WRK-FIRST-LIAB-YRQ TO L006-YRQ.                         DTSCS1C
02529      SET L006-FROM-QTR TO TRUE.                                   DTSCS1C
02530      PERFORM S006-RATING-YRQ THRU S006-EXIT.                      DTSCS1C
02531      MOVE L006-RTE-YR-START-YRQ TO WRK-RTE-START-YRQ.             DTSCS1C
02532      MOVE L006-RTE-YR-END-YRQ TO WRK-RTE-END-YRQ.                 DTSCS1C
02533      IF WRK-LAST-LIAB-YRQ < LCCM-LAST-RATE-END-YRQ                DTSCS1C
02534          MOVE WRK-LAST-LIAB-YRQ TO WRK-RTE-LAST-YRQ               DTSCS1C
02535      ELSE                                                         DTSCS1C
02536          MOVE LCCM-LAST-RATE-END-YRQ                              DTSCS1C
02537            TO WRK-RTE-LAST-YRQ.                                   DTSCS1C
02538                                                                   DTSCS1C
02539      PERFORM P8966-CHK-ESTIM-RATES     THRU P8966-EXIT            DTSCS1C
02540       UNTIL (WRK-RTE-START-YRQ > WRK-RTE-LAST-YRQ).               DTSCS1C
02541                                                                   DTSCS1C
02542      IF MAP-PRED-INACT-CD = SPACES                                DTSCS1C
02543          NEXT SENTENCE                                            DTSCS1C
02544      ELSE                                                         DTSCS1C
02545          PERFORM P8971-PRED-INACTIVATE THRU P8971-EXIT.           DTSCS1C
02546                                                                   DTSCS1C
02547      IF MAP-RELATIONSHIP-CD = SPACES                              DTSCS1C
02548          NEXT SENTENCE                                            DTSCS1C
02549      ELSE                                                         DTSCS1C
02550          PERFORM P8972-ADD-MREL THRU P8972-EXIT.                  DTSCS1C
02551  P8950-EXIT.                                                      DTSCS1C
02552      EXIT.                                                        DTSCS1C
02553      EJECT                                                        DTSCS1C
02554  P8961-ADD-MSOL.                                                  DTSCS1C
02555      MOVE WRK-LIAB-DATE TO L001-FED-8-DATE-9.                     DTSCS1C
02556                                                                   DTSCS1C
02557      MOVE L001-FED-8-DATE-X TO L331-REC-OCC-ID.                   DTSCS1C
02558                                                                   DTSCS1C
02559      MOVE SPACE TO L331-FROM-VALUE.                               DTSCS1C
02560                                                                   DTSCS1C
02561                                                                   DTSCS1C
02562      MOVE LOW-VALUES TO MSOL-REC.                                 DTSCS1C
02563                                                                   DTSCS1C
02564                                                                   DTSCS1C
02565      MOVE WRK-EMP-NO TO MSOL-EMP-NO.                              DTSCS1C
02566                                                                   DTSCS1C
02567      SET MSOL-SOL-88 TO TRUE.                                     DTSCS1C
02568                                                                   DTSCS1C
02569      MOVE WRK-LIAB-DATE TO MSOL-LIAB-DATE.                        DTSCS1C
02570                                                                   DTSCS1C
02571      MOVE +0 TO MSOL-PURGE-DATE.                                  DTSCS1C
02572                                                                   DTSCS1C
02573                                                                   DTSCS1C
02574      MOVE WRK-FIRST-LIAB-YRQ TO MSOL-FIRST-LIAB-YRQ.              DTSCS1C
02575                                                                   DTSCS1C
02576      IF WRK-FIRST-LIAB-YRQ NOT = +0                               DTSCS1C
02577          MOVE 'MSOL-FIRST-LIAB-YRQ' TO L331-FIELD-NAME            DTSCS1C
02578          MOVE WRK-FIRST-LIAB-YRQ TO L004-QTR-5-9                  DTSCS1C
02579          SET L004-FROM-5 TO TRUE                                  DTSCS1C
02580          PERFORM S004-YRQ THRU S004-EXIT                          DTSCS1C
02581          MOVE L004-SLASH-QTR TO L331-TO-VALUE                     DTSCS1C
02582          PERFORM S331-WRITE-MLOG THRU S331-EXIT.                  DTSCS1C
02583                                                                   DTSCS1C
02584                                                                   DTSCS1C
02585      MOVE MAP-LIAB-ESTB-DATE-AREA TO L015-S-DATE-AREA.            DTSCS1C
02586                                                                   DTSCS1C
02587      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS1C
02588                                                                   DTSCS1C
02589      MOVE L015-DATE TO MSOL-LIAB-ESTB-DATE.                       DTSCS1C
02590                                                                   DTSCS1C
02591      MOVE 'MSOL-LIAB-ESTB-DATE' TO L331-FIELD-NAME.               DTSCS1C
02592                                                                   DTSCS1C
02593      MOVE MSOL-LIAB-ESTB-DATE TO L001-FED-8-DATE-9.               DTSCS1C
02594                                                                   DTSCS1C
02595      SET L001-FROM-FED-8 TO TRUE.                                 DTSCS1C
02596                                                                   DTSCS1C
02597      PERFORM S001-DATE THRU S001-EXIT.                            DTSCS1C
02598                                                                   DTSCS1C
02599      MOVE L001-SLASH-DATE TO L331-TO-VALUE.                       DTSCS1C
02600                                                                   DTSCS1C
02601      PERFORM S331-WRITE-MLOG THRU S331-EXIT.                      DTSCS1C
02602                                                                   DTSCS1C
02603                                                                   DTSCS1C
02604      MOVE +0 TO MSOL-LIAB-MAIL-DATE.                              DTSCS1C
02605                                                                   DTSCS1C
02606                                                                   DTSCS1C
02607                                                                   DTSCS1C
02608      MOVE MAP-LIAB-CD TO MSOL-LIAB-CD.                            DTSCS1C
02609                                                                   DTSCS1C
02610      MOVE 'MSOL-LIAB-CD' TO L331-FIELD-NAME.                      DTSCS1C
02611                                                                   DTSCS1C
02612      MOVE MSOL-LIAB-CD TO L331-TO-VALUE.                          DTSCS1C
02613                                                                   DTSCS1C
02614      PERFORM S331-WRITE-MLOG THRU S331-EXIT.                      DTSCS1C
02615                                                                   DTSCS1C
02616                                                                   DTSCS1C
02617      MOVE MAP-581-NEW-IND TO MSOL-NEW-EMPLOYER-IND.               DTSCS1C
02618                                                                   DTSCS1C
02619      MOVE 'MSOL-NEW-EMPLOYER-IND' TO L331-FIELD-NAME.             DTSCS1C
02620                                                                   DTSCS1C
02621      MOVE MSOL-NEW-EMPLOYER-IND TO L331-TO-VALUE.                 DTSCS1C
02622                                                                   DTSCS1C
02623      PERFORM S331-WRITE-MLOG THRU S331-EXIT.                      DTSCS1C
02624                                                                   DTSCS1C
02625                                                                   DTSCS1C
02626      MOVE WRK-INACT-DATE TO MSOL-INACT-DATE.                      DTSCS1C
02627                                                                   DTSCS1C
02628      IF WRK-INACT-DATE = ALL-NINES-DATE                           DTSCS1C
02629          NEXT SENTENCE                                            DTSCS1C
02630      ELSE                                                         DTSCS1C
02631          MOVE 'MSOL-INACT-DATE' TO L331-FIELD-NAME                DTSCS1C
02632          MOVE MSOL-INACT-DATE TO L001-FED-8-DATE-9                DTSCS1C
02633          SET L001-FROM-FED-8 TO TRUE                              DTSCS1C
02634          PERFORM S001-DATE THRU S001-EXIT                         DTSCS1C
02635          MOVE L001-SLASH-DATE TO L331-TO-VALUE                    DTSCS1C
02636          PERFORM S331-WRITE-MLOG THRU S331-EXIT.                  DTSCS1C
02637                                                                   DTSCS1C
02638                                                                   DTSCS1C
02639      IF WRK-INACT-DATE = ALL-NINES-DATE                           DTSCS1C
02640          MOVE +0 TO MSOL-INACT-ENTER-DATE                         DTSCS1C
02641      ELSE                                                         DTSCS1C
02642          MOVE LCCM-CURR-RUN-DATE TO MSOL-INACT-ENTER-DATE.        DTSCS1C
02643                                                                   DTSCS1C
02644                                                                   DTSCS1C
02645      MOVE +0 TO MSOL-INACT-REVERSE-DATE.                          DTSCS1C
02646                                                                   DTSCS1C
02647                                                                   DTSCS1C
02648      MOVE WRK-LAST-LIAB-YRQ TO MSOL-LAST-LIAB-YRQ.                DTSCS1C
02649                                                                   DTSCS1C
02650      IF WRK-LAST-LIAB-YRQ = +0 OR ALL-NINES-YRQ                   DTSCS1C
02651          NEXT SENTENCE                                            DTSCS1C
02652      ELSE                                                         DTSCS1C
02653          MOVE 'MSOL-LAST-LIAB-YRQ' TO L331-FIELD-NAME             DTSCS1C
02654          MOVE WRK-LAST-LIAB-YRQ TO L004-QTR-5-9                   DTSCS1C
02655          SET L004-FROM-5 TO TRUE                                  DTSCS1C
02656          PERFORM S004-YRQ THRU S004-EXIT                          DTSCS1C
02657          MOVE L004-SLASH-QTR TO L331-TO-VALUE                     DTSCS1C
02658          PERFORM S331-WRITE-MLOG THRU S331-EXIT.                  DTSCS1C
02659                                                                   DTSCS1C
02660                                                                   DTSCS1C
02661      MOVE MAP-INACT-CD TO MSOL-INACT-CD.                          DTSCS1C
02662                                                                   DTSCS1C
02663      IF MAP-INACT-CD = SPACES                                     DTSCS1C
02664          NEXT SENTENCE                                            DTSCS1C
02665      ELSE                                                         DTSCS1C
02666          MOVE 'MSOL-INACT-CD' TO L331-FIELD-NAME                  DTSCS1C
02667          MOVE MSOL-INACT-CD TO L331-TO-VALUE                      DTSCS1C
02668          PERFORM S331-WRITE-MLOG THRU S331-EXIT.                  DTSCS1C
02669                                                                   DTSCS1C
02670                                                                   DTSCS1C
02671      SET MSOL-NOT-CONVERTED-88 TO TRUE.                           DTSCS1C
02672                                                                   DTSCS1C
02673      MOVE LCCM-CURR-RUN-DATE TO MSOL-ESTB-DATE                    DTSCS1C
02674                                 MSOL-CHNG-DATE.                   DTSCS1C
02675                                                                   DTSCS1C
02676      MOVE MSOL-REC TO MSKL-REC.                                   DTSCS1C
02677                                                                   DTSCS1C
02678      PERFORM S810-WRITE THRU S810-EXIT.                           DTSCS1C
02679                                                                   DTSCS1C
02680                                                                   DTSCS1C
02681                                                                   DTSCS1C
02682      MOVE LOW-VALUES TO MERD-REC.                                 DTSCS1C
02683                                                                   DTSCS1C
02684      MOVE WRK-EMP-NO TO MERD-EMP-NO.                              DTSCS1C
02685                                                                   DTSCS1C
02686      SET MERD-ERD-88 TO TRUE.                                     DTSCS1C
02687                                                                   DTSCS1C
02688      MOVE LCCM-TASK-START-ABSTIME TO MERD-ESTB-ABSTIME.           DTSCS1C
02689                                                                   DTSCS1C
02690      MOVE +0 TO MERD-PURGE-DATE.                                  DTSCS1C
02691                                                                   DTSCS1C
02692      IF MAP-581-NEW-YES-88                                        DTSCS1C
02693          SET MERD-DETER-NEW-88 TO TRUE                            DTSCS1C
02694      ELSE                                                         DTSCS1C
02695          SET MERD-DETER-SUC-88 TO TRUE.                           DTSCS1C
02696                                                                   DTSCS1C
02697      MOVE MSOL-LIAB-ESTB-DATE TO MERD-EFFECTIVE-DATE.             DTSCS1C
02698                                                                   DTSCS1C
02699      MOVE WRK-SCR-ID TO MERD-SCREEN-ID.                           DTSCS1C
02700                                                                   DTSCS1C
02701      MOVE LCCM-OP-ID TO MERD-OP-ID.                               DTSCS1C
02702                                                                   DTSCS1C
02703      SET MERD-NOT-CONVERTED-88 TO TRUE.                           DTSCS1C
02704                                                                   DTSCS1C
02705      MOVE LCCM-CURR-RUN-DATE TO MERD-ESTB-DATE.                   DTSCS1C
02706                                                                   DTSCS1C
02707      MOVE MERD-REC TO MSKL-REC.                                   DTSCS1C
02708                                                                   DTSCS1C
02709      PERFORM S810-WRITE THRU S810-EXIT.                           DTSCS1C
02710                                                                   DTSCS1C
02711                                                                   DTSCS1C
02712                                                                   DTSCS1C
02713      IF MSOL-INACT-ACTIVE-88                                      DTSCS1C
02714          NEXT SENTENCE                                            DTSCS1C
02715      ELSE                                                         DTSCS1C
02716          ADD +1 TO MERD-ESTB-ABSTIME                              DTSCS1C
02717          SET MERD-DETER-INACT-88 TO TRUE                          DTSCS1C
02718          MOVE MSOL-INACT-DATE TO MERD-EFFECTIVE-DATE              DTSCS1C
02719          MOVE MERD-REC TO MSKL-REC                                DTSCS1C
02720          PERFORM S810-WRITE THRU S810-EXIT.                       DTSCS1C
02721  P8961-EXIT.                                                      DTSCS1C
02722      EXIT.                                                        DTSCS1C
02723      EJECT                                                        DTSCS1C
02724  P8962-LIABILITY-OLA-WRITE.                                       DTSCS1C
02725      PERFORM P8991-INITIALIZE-T001 THRU P8991-EXIT.               DTSCS1C
02726                                                                   DTSCS1C
02727      MOVE WRK-EMP-NO TO T001-EMP-NO.                              DTSCS1C
02728                                                                   DTSCS1C
02729      SET T001-LIABLE-PKG TO TRUE.                                 DTSCS1C
02730                                                                   DTSCS1C
02731      MOVE MAP-WELCOME-LTR-IND TO T001-WELCOME-LTR-IND.            DTSCS1C
02732                                                                   DTSCS1C
02733      PERFORM S825-WRITE-T001 THRU S825-EXIT.                      DTSCS1C
02734                                                                   DTSCS1C
02735                                                                   DTSCS1C
02736                                                                   DTSCS1C
02737      SET T001-FILE-CLERK-LIST TO TRUE.                            DTSCS1C
02738                                                                   DTSCS1C
02739      MOVE SPACES TO T001-WELCOME-LTR-IND.                         DTSCS1C
02740                                                                   DTSCS1C
02741      PERFORM S825-WRITE-T001 THRU S825-EXIT.                      DTSCS1C
02742                                                                   DTSCS1C
02743                                                                   DTSCS1C
02744      MOVE MAP-WAIVER-START-YRQ-AREA TO L016-S-YRQ-AREA.           DTSCS1C
02745                                                                   DTSCS1C
02746      PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT.                 DTSCS1C
02747                                                                   DTSCS1C
02748      MOVE L016-YRQ TO WRK-WAIVER-START-YRQ.                       DTSCS1C
02749                                                                   DTSCS1C
02750      MOVE MAP-WAIVER-END-YRQ-AREA TO L016-S-YRQ-AREA.             DTSCS1C
02751                                                                   DTSCS1C
02752      PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT.                 DTSCS1C
02753                                                                   DTSCS1C
02754      MOVE L016-YRQ TO WRK-WAIVER-END-YRQ.                         DTSCS1C
02755                                                                   DTSCS1C
02756      MOVE MAP-WAIVER-EXT-DATE-AREA TO L015-S-DATE-AREA.           DTSCS1C
02757                                                                   DTSCS1C
02758      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS1C
02759                                                                   DTSCS1C
02760      MOVE L015-DATE TO WRK-WAIVER-EXT-DATE.                       DTSCS1C
02761                                                                   DTSCS1C
02762                                                                   DTSCS1C
02763      IF (MSOL-FIRST-LIAB-YRQ = +0)                                DTSCS1C
02764          NEXT SENTENCE                                            DTSCS1C
02765      ELSE                                                         DTSCS1C
02766          PERFORM P8994-INITIALIZE-T031 THRU P8994-EXIT            DTSCS1C
02767          MOVE WRK-EMP-NO TO T031-EMP-NO                           DTSCS1C
02768          SET T031-AUTO-PROCESS TO TRUE                            DTSCS1C
02769          MOVE MSOL-FIRST-LIAB-YRQ TO T031-START-YRQ               DTSCS1C
02770          MOVE MSOL-LAST-LIAB-YRQ TO T031-END-YRQ                  DTSCS1C
02771          MOVE WRK-WAIVER-START-YRQ TO T031-WAIVER-START-YRQ       DTSCS1C
02772          MOVE WRK-WAIVER-END-YRQ TO T031-WAIVER-END-YRQ           DTSCS1C
02773          MOVE WRK-WAIVER-EXT-DATE TO T031-WAIVER-EXT-DATE         DTSCS1C
02774          PERFORM S825-WRITE-T031 THRU S825-EXIT.                  DTSCS1C
02775                                                                   DTSCS1C
02776                                                                   DTSCS1C
02777      IF (MSOL-FIRST-LIAB-YRQ = +0)                                DTSCS1C
02778             OR                                                    DTSCS1C
02779         (MAP-RPT-PRINT-NO-88)                                     DTSCS1C
02780             OR                                                    DTSCS1C
02781         ((WRK-MERA-ACTIVE-88 OR WRK-MERA-INACTIVE-88)             DTSCS1C
02782           AND                                                     DTSCS1C
02783          (MERA-SOURCE-UC30-88 AND MERA-RECEIVED-DATE = ZERO))     DTSCS1C
02784          NEXT SENTENCE                                            DTSCS1C
02785      ELSE                                                         DTSCS1C
02786          PERFORM P8995-INITIALIZE-T036 THRU P8995-EXIT            DTSCS1C
02787          MOVE WRK-EMP-NO TO T036-EMP-NO                           DTSCS1C
02788          SET T036-LIAB-DETER TO TRUE                              DTSCS1C
02789          MOVE MSOL-FIRST-LIAB-YRQ TO T036-START-YRQ               DTSCS1C
02790          MOVE MSOL-LAST-LIAB-YRQ TO T036-END-YRQ                  DTSCS1C
02791          SET T036-NO-FORCE-PRINT TO TRUE                          DTSCS1C
02792          MOVE WRK-WAIVER-START-YRQ TO T036-WAIVER-START-YRQ       DTSCS1C
02793          MOVE WRK-WAIVER-END-YRQ TO T036-WAIVER-END-YRQ           DTSCS1C
02794          MOVE WRK-WAIVER-EXT-DATE TO T036-WAIVER-EXT-DATE         DTSCS1C
02795          PERFORM S825-WRITE-T036 THRU S825-EXIT.                  DTSCS1C
02796                                                                   DTSCS1C
02797                                                                   DTSCS1C
02798      IF (MAP-INACT-CD = SPACES)                                   DTSCS1C
02799             OR                                                    DTSCS1C
02800         (MAP-INACT-LTR-TYPE = 'N')                                DTSCS1C
02801          NEXT SENTENCE                                            DTSCS1C
02802      ELSE                                                         DTSCS1C
02803          PERFORM P8991-INITIALIZE-T001 THRU P8991-EXIT            DTSCS1C
02804          MOVE WRK-EMP-NO TO T001-EMP-NO                           DTSCS1C
02805          SET T001-INACTIVE-LTR TO TRUE                            DTSCS1C
02806          MOVE MAP-INACT-LTR-TYPE TO T001-INACT-LTR-TYPE           DTSCS1C
02807          PERFORM S825-WRITE-T001 THRU S825-EXIT.                  DTSCS1C
02808                                                                   DTSCS1C
02809      SET L410-MODE-INPUT-YRQ-88   TO TRUE.                        DTSCS1C
02810      MOVE WRK-EMP-NO              TO L410-EMP-NO.                 DTSCS1C
02811      MOVE MSOL-LAST-LIAB-YRQ      TO L410-YRQ.                    DTSCS1C
02812      PERFORM S410-FILING-SCHEDULE THRU S410-EXIT.                 DTSCS1C
02813      IF L410-ANN-SCHED-88                                         DTSCS1C
02814         PERFORM P8962A-ANNUAL     THRU P8962A-EXIT                DTSCS1C
02815      ELSE                                                         DTSCS1C
02816         PERFORM P8962B-QUARTERLY  THRU P8962B-EXIT.               DTSCS1C
02817                                                                   DTSCS1C
02818                                                                   DTSCS1C
02819  P8962-EXIT.                                                      DTSCS1C
02820      EXIT.                                                        DTSCS1C
02821                                                                   DTSCS1C
02822  P8962A-ANNUAL.                                                   DTSCS1C
02823      SET L415-MODE-MOST-RECENT-88 TO TRUE.                        DTSCS1C
02824      PERFORM S415-HOUSEHOLD-DATES   THRU S415-EXIT.               DTSCS1C
02825 ************************************************************      DTSCS1C
02826 *  THE FOLLOWING 2 LINES NEEDED ONLY FOR THE FIRST YEAR OF        DTSCS1C
02827 *  ANNUAL FILING, BEFORE THE FIRST ANNUAL MASS MAILING            DTSCS1C
02828 *  HAS OCCURRED.                                                  DTSCS1C
02829 ************************************************************      DTSCS1C
02830      IF L415-UC30H-MASS-MAIL-STRT-YRQ = ZERO                      DTSCS1C
02831         MOVE 20011 TO L415-UC30H-MASS-MAIL-STRT-YRQ.              DTSCS1C
02832                                                                   DTSCS1C
02833      IF (MAP-INACT-CD = SPACES)                                   DTSCS1C
02834            OR                                                     DTSCS1C
02835         (MSOL-LAST-LIAB-YRQ = +0)                                 DTSCS1C
02836            OR                                                     DTSCS1C
02837         (MSOL-LAST-LIAB-YRQ NOT >                                 DTSCS1C
02838                               L415-UC30H-MASS-MAIL-STRT-YRQ)      DTSCS1C
02839            OR                                                     DTSCS1C
02840         (MAP-RPT-PRINT-NO-88)                                     DTSCS1C
02841          NEXT SENTENCE                                            DTSCS1C
02842      ELSE                                                         DTSCS1C
02843          PERFORM P8995-INITIALIZE-T036 THRU P8995-EXIT            DTSCS1C
02844          MOVE WRK-EMP-NO TO T036-EMP-NO                           DTSCS1C
02845          SET T036-INACTIVATION TO TRUE                            DTSCS1C
02846          MOVE L415-UC30H-MASS-MAIL-STRT-YRQ TO L004-QTR-5-9       DTSCS1C
02847          SET L004-FROM-5 TO TRUE                                  DTSCS1C
02848          PERFORM S004-YRQ THRU S004-EXIT                          DTSCS1C
02849          ADD 1 TO L004-QTR-5-YR                                   DTSCS1C
02850          SET L004-FROM-5   TO TRUE                                DTSCS1C
02851          PERFORM S004-YRQ THRU S004-EXIT                          DTSCS1C
02852          MOVE L004-QTR-5-9 TO T036-START-YRQ                      DTSCS1C
02853          MOVE MSOL-LAST-LIAB-YRQ TO T036-END-YRQ                  DTSCS1C
02854          PERFORM S825-WRITE-T036 THRU S825-EXIT.                  DTSCS1C
02855                                                                   DTSCS1C
02856  P8962A-EXIT.                                                     DTSCS1C
02857      EXIT.                                                        DTSCS1C
02858                                                                   DTSCS1C
02859  P8962B-QUARTERLY.                                                DTSCS1C
02860      IF (MAP-INACT-CD = SPACES)                                   DTSCS1C
02861            OR                                                     DTSCS1C
02862         (MSOL-LAST-LIAB-YRQ = +0)                                 DTSCS1C
02863            OR                                                     DTSCS1C
02864         (MSOL-LAST-LIAB-YRQ NOT > LCCM-LAST-UC30-MASS-MAIL-YRQ)   DTSCS1C
02865            OR                                                     DTSCS1C
02866         (MAP-RPT-PRINT-NO-88)                                     DTSCS1C
02867          NEXT SENTENCE                                            DTSCS1C
02868      ELSE                                                         DTSCS1C
02869          PERFORM P8995-INITIALIZE-T036 THRU P8995-EXIT            DTSCS1C
02870          MOVE WRK-EMP-NO TO T036-EMP-NO                           DTSCS1C
02871          SET T036-INACTIVATION TO TRUE                            DTSCS1C
02872          MOVE LCCM-LAST-UC30-MASS-MAIL-YRQ TO L004-QTR-5-9        DTSCS1C
02873          SET L004-FROM-5 TO TRUE                                  DTSCS1C
02874          PERFORM S004-YRQ THRU S004-EXIT                          DTSCS1C
02875          ADD +1 TO L004-ABS-QTR                                   DTSCS1C
02876          SET L004-FROM-ABS TO TRUE                                DTSCS1C
02877          PERFORM S004-YRQ THRU S004-EXIT                          DTSCS1C
02878          MOVE L004-QTR-5-9 TO T036-START-YRQ                      DTSCS1C
02879          MOVE MSOL-LAST-LIAB-YRQ TO T036-END-YRQ                  DTSCS1C
02880          PERFORM S825-WRITE-T036 THRU S825-EXIT.                  DTSCS1C
02881                                                                   DTSCS1C
02882  P8962B-EXIT.                                                     DTSCS1C
02883      EXIT.                                                        DTSCS1C
02884      EJECT                                                        DTSCS1C
02885  P8963-ADD-MRTE.                                                  DTSCS1C
02886      MOVE MAP-RTE-EFF-YRQ-AREA (WRK-SUB1) TO L016-S-YRQ-AREA.     DTSCS1C
02887                                                                   DTSCS1C
02888      PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT.                 DTSCS1C
02889                                                                   DTSCS1C
02890      IF L016-NO-ENTRY                                             DTSCS1C
02891          GO TO P8963-EXIT.                                        DTSCS1C
02892                                                                   DTSCS1C
02893                                                                   DTSCS1C
02894      MOVE LOW-VALUES TO MRTE-REC.                                 DTSCS1C
02895                                                                   DTSCS1C
02896      MOVE WRK-EMP-NO TO MRTE-EMP-NO.                              DTSCS1C
02897                                                                   DTSCS1C
02898      SET MRTE-RTE-88 TO TRUE.                                     DTSCS1C
02899                                                                   DTSCS1C
02900      MOVE L016-YRQ TO MRTE-EFF-YRQ.                               DTSCS1C
02901                                                                   DTSCS1C
02902      MOVE +0 TO MRTE-PURGE-DATE.                                  DTSCS1C
02903                                                                   DTSCS1C
02904      SET L006-FROM-QTR TO TRUE.                                   DTSCS1C
02905                                                                   DTSCS1C
02906      MOVE MRTE-EFF-YRQ TO L006-YRQ.                               DTSCS1C
02907                                                                   DTSCS1C
02908      PERFORM S006-RATING-YRQ THRU S006-EXIT.                      DTSCS1C
02909                                                                   DTSCS1C
02910      MOVE L006-RTE-YR-END-YRQ TO MRTE-END-YRQ.                    DTSCS1C
02911                                                                   DTSCS1C
02912      MOVE MAP-RTE-RATE-AREA (WRK-SUB1) TO L012-S-RATE-AREA.       DTSCS1C
02913                                                                   DTSCS1C
02914      PERFORM S012-RATE-FROM-SCREEN THRU S012-EXIT.                DTSCS1C
02915                                                                   DTSCS1C
02916      MOVE L012-RATE TO MRTE-UI-RATE.                              DTSCS1C
02917                                                                   DTSCS1C
02918      SET MRTE-RATE-TYPE-REG-88  TO TRUE.                          DTSCS1C
02919                                                                   DTSCS1C
02920      MOVE +0 TO MRTE-NOTICE-DATE.                                 DTSCS1C
02921                                                                   DTSCS1C
02922      SET MRTE-NOT-CONVERTED-88 TO TRUE.                           DTSCS1C
02923                                                                   DTSCS1C
02924      MOVE LCCM-CURR-RUN-DATE TO MRTE-ESTB-DATE                    DTSCS1C
02925                                 MRTE-CHNG-DATE.                   DTSCS1C
02926                                                                   DTSCS1C
02927      MOVE MRTE-REC TO MSKL-REC.                                   DTSCS1C
02928                                                                   DTSCS1C
02929      PERFORM S810-WRITE THRU S810-EXIT.                           DTSCS1C
02930                                                                   DTSCS1C
02931                                                                   DTSCS1C
02932      IF (MRTE-EFF-YRQ < MSOL-FIRST-LIAB-YRQ)                      DTSCS1C
02933             OR                                                    DTSCS1C
02934         (MRTE-END-YRQ > MSOL-LAST-LIAB-YRQ)                       DTSCS1C
02935          PERFORM P8994-INITIALIZE-T031 THRU P8994-EXIT            DTSCS1C
02936          MOVE WRK-EMP-NO TO T031-EMP-NO                           DTSCS1C
02937          SET T031-AUTO-PROCESS TO TRUE                            DTSCS1C
02938          MOVE MRTE-EFF-YRQ TO T031-START-YRQ                      DTSCS1C
02939          MOVE MRTE-END-YRQ TO T031-END-YRQ                        DTSCS1C
02940          MOVE +0 TO T031-WAIVER-START-YRQ                         DTSCS1C
02941                     T031-WAIVER-END-YRQ                           DTSCS1C
02942                     T031-WAIVER-EXT-DATE                          DTSCS1C
02943          PERFORM S825-WRITE-T031 THRU S825-EXIT.                  DTSCS1C
02944                                                                   DTSCS1C
02945                                                                   DTSCS1C
02946      MOVE SPACES TO L331-REC-OCC-ID.                              DTSCS1C
02947                                                                   DTSCS1C
02948      MOVE MRTE-EFF-YRQ TO L004-QTR-5-9.                           DTSCS1C
02949                                                                   DTSCS1C
02950      STRING L004-QTR-5-YR DELIMITED BY SIZE                       DTSCS1C
02951             '/'           DELIMITED BY SIZE                       DTSCS1C
02952             L004-QTR-5-Q  DELIMITED BY SIZE                       DTSCS1C
02953        INTO                                                       DTSCS1C
02954          L331-REC-OCC-ID.                                         DTSCS1C
02955                                                                   DTSCS1C
02956      MOVE SPACES TO L331-FROM-VALUE.                              DTSCS1C
02957                                                                   DTSCS1C
02958                                                                   DTSCS1C
02959      MOVE MRTE-UI-RATE TO L056-RATE.                              DTSCS1C
02960                                                                   DTSCS1C
02961      SET L056-DISP1-LEFT-88 TO TRUE.                              DTSCS1C
02962                                                                   DTSCS1C
02963      PERFORM S056-RATE-DISPLAY THRU S056-EXIT.                    DTSCS1C
02964                                                                   DTSCS1C
02965      MOVE 'MRTE-UI-RATE' TO L331-FIELD-NAME.                      DTSCS1C
02966                                                                   DTSCS1C
02967      MOVE L056-DISP-RATE TO L331-TO-VALUE.                        DTSCS1C
02968                                                                   DTSCS1C
02969      PERFORM S331-WRITE-MLOG THRU S331-EXIT.                      DTSCS1C
02970  P8963-EXIT.                                                      DTSCS1C
02971      EXIT.                                                        DTSCS1C
02972      EJECT                                                        DTSCS1C
02973  P8964-ADD-MFSC.                                                  DTSCS1C
02974      SET L400-LIAB-DETERM-88 TO TRUE.                             DTSCS1C
02975      MOVE WRK-EMP-NO         TO L400-EMP-NO.                      DTSCS1C
02976                                                                   DTSCS1C
02977      MOVE MPRF-ORG-TYPE        TO L400-ORG-TYPE.                  DTSCS1C
02978      MOVE MSOL-FIRST-LIAB-YRQ  TO L400-FIRST-LIAB-YRQ.            DTSCS1C
02979      MOVE MAP-FILING-SCHED     TO L400-FILING-SCHED.              DTSCS1C
02980      MOVE LCCM-CURR-RUN-DATE   TO L400-CURR-RUN-DATE.             DTSCS1C
02981      MOVE LCCM-OP-ID           TO L400-OP-ID.                     DTSCS1C
02982                                                                   DTSCS1C
02983      PERFORM S400-HOUSEHOLD  THRU S400-EXIT.                      DTSCS1C
02984                                                                   DTSCS1C
02985  P8964-EXIT.                                                      DTSCS1C
02986      EXIT.                                                        DTSCS1C
02987  P8965-NOT-LIAB-HOUSEHOLD.                                        DTSCS1C
02988      SET L400-NOT-LIAB-DETERM-88 TO TRUE.                         DTSCS1C
02989      MOVE WRK-EMP-NO             TO L400-EMP-NO.                  DTSCS1C
02990                                                                   DTSCS1C
02991      MOVE LCCM-CURR-RUN-DATE     TO L400-CURR-RUN-DATE.           DTSCS1C
02992      MOVE LCCM-OP-ID             TO L400-OP-ID.                   DTSCS1C
02993                                                                   DTSCS1C
02994      PERFORM S400-HOUSEHOLD      THRU S400-EXIT.                  DTSCS1C
02995                                                                   DTSCS1C
02996  P8965-EXIT.                                                      DTSCS1C
02997      EXIT.                                                        DTSCS1C
02998                                                                   DTSCS1C
02999  P8966-CHK-ESTIM-RATES.                                           DTSCS1C
03000      MOVE LOW-VALUES TO MRTE-REC.                                 DTSCS1C
03001      MOVE WRK-EMP-NO TO MRTE-EMP-NO.                              DTSCS1C
03002      SET MRTE-RTE-88 TO TRUE.                                     DTSCS1C
03003      MOVE WRK-RTE-START-YRQ TO MRTE-EFF-YRQ.                      DTSCS1C
03004      MOVE MRTE-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS1C
03005                                                                   DTSCS1C
03006      PERFORM S810-READ THRU S810-EXIT.                            DTSCS1C
03007                                                                   DTSCS1C
03008      IF L810-NO-REC-88                                            DTSCS1C
03009         NEXT SENTENCE                                             DTSCS1C
03010      ELSE                                                         DTSCS1C
03011         MOVE MSKL-REC    TO MRTE-REC                              DTSCS1C
03012         IF MRTE-RATE-TYPE-ESTIM-88                                DTSCS1C
03013            PERFORM P8992-INITIALIZE-T006 THRU P8992-EXIT          DTSCS1C
03014            SET T006-FINAL-RATE           TO TRUE                  DTSCS1C
03015            MOVE MRTE-EFF-YRQ             TO T006-START-YRQ        DTSCS1C
03016            MOVE ZERO                     TO T006-END-YRQ          DTSCS1C
03017            PERFORM S825-WRITE-T006       THRU S825-EXIT.          DTSCS1C
03018                                                                   DTSCS1C
03019                                                                   DTSCS1C
03020      SET L004-FROM-5 TO TRUE.                                     DTSCS1C
03021                                                                   DTSCS1C
03022      MOVE WRK-RTE-END-YRQ TO L004-QTR-5-9.                        DTSCS1C
03023                                                                   DTSCS1C
03024      PERFORM S004-YRQ THRU S004-EXIT.                             DTSCS1C
03025                                                                   DTSCS1C
03026      ADD +1 TO L004-ABS-QTR.                                      DTSCS1C
03027                                                                   DTSCS1C
03028      SET L004-FROM-ABS TO TRUE.                                   DTSCS1C
03029                                                                   DTSCS1C
03030      PERFORM S004-YRQ THRU S004-EXIT.                             DTSCS1C
03031                                                                   DTSCS1C
03032                                                                   DTSCS1C
03033      MOVE L004-QTR-5-9 TO L006-YRQ.                               DTSCS1C
03034                                                                   DTSCS1C
03035      SET L006-FROM-QTR TO TRUE.                                   DTSCS1C
03036                                                                   DTSCS1C
03037      PERFORM S006-RATING-YRQ THRU S006-EXIT.                      DTSCS1C
03038                                                                   DTSCS1C
03039      MOVE L006-RTE-YR-START-YRQ TO WRK-RTE-START-YRQ.             DTSCS1C
03040                                                                   DTSCS1C
03041      MOVE L006-RTE-YR-END-YRQ TO WRK-RTE-END-YRQ.                 DTSCS1C
03042  P8966-EXIT.                                                      DTSCS1C
03043      EXIT.                                                        DTSCS1C
03044                                                                   DTSCS1C
03045      EJECT                                                        DTSCS1C
03046  P8971-PRED-INACTIVATE.                                           DTSCS1C
03047      MOVE WRK-PRED-EMP-NO TO L331-EMP-NO.                         DTSCS1C
03048                                                                   DTSCS1C
03049                                                                   DTSCS1C
03050      MOVE LOW-VALUES TO MPRF-KEY-AREA.                            DTSCS1C
03051                                                                   DTSCS1C
03052      MOVE WRK-PRED-EMP-NO TO MPRF-EMP-NO.                         DTSCS1C
03053                                                                   DTSCS1C
03054      SET MPRF-PRF-88 TO TRUE.                                     DTSCS1C
03055                                                                   DTSCS1C
03056      MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS1C
03057                                                                   DTSCS1C
03058      PERFORM S810-READ THRU S810-EXIT.                            DTSCS1C
03059                                                                   DTSCS1C
03060      IF L810-NO-REC-88                                            DTSCS1C
03061          GO TO S899-ABEND.                                        DTSCS1C
03062                                                                   DTSCS1C
03063                                                                   DTSCS1C
03064      MOVE MSKL-REC TO MPRF-REC.                                   DTSCS1C
03065                                                                   DTSCS1C
03066      MOVE SPACES TO L331-REC-OCC-ID.                              DTSCS1C
03067                                                                   DTSCS1C
03068      MOVE 'MPRF-EMP-STATUS' TO L331-FIELD-NAME.                   DTSCS1C
03069                                                                   DTSCS1C
03070      MOVE MPRF-EMP-STATUS TO L331-FROM-VALUE.                     DTSCS1C
03071                                                                   DTSCS1C
03072      SET MPRF-STATUS-INACT-88 TO TRUE.                            DTSCS1C
03073                                                                   DTSCS1C
03074      MOVE MPRF-EMP-STATUS TO L331-TO-VALUE.                       DTSCS1C
03075                                                                   DTSCS1C
03076      PERFORM S331-WRITE-MLOG THRU S331-EXIT.                      DTSCS1C
03077                                                                   DTSCS1C
03078      MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE.                   DTSCS1C
03079                                                                   DTSCS1C
03080      MOVE MPRF-REC TO MSKL-REC.                                   DTSCS1C
03081                                                                   DTSCS1C
03082      PERFORM S810-REWRITE THRU S810-EXIT.                         DTSCS1C
03083                                                                   DTSCS1C
03084                                                                   DTSCS1C
03085                                                                   DTSCS1C
03086      MOVE LOW-VALUES TO MSOL-KEY-AREA.                            DTSCS1C
03087                                                                   DTSCS1C
03088      MOVE WRK-PRED-EMP-NO TO MSOL-EMP-NO.                         DTSCS1C
03089                                                                   DTSCS1C
03090      SET MSOL-SOL-88 TO TRUE.                                     DTSCS1C
03091                                                                   DTSCS1C
03092      MOVE +0 TO MSOL-LIAB-DATE.                                   DTSCS1C
03093                                                                   DTSCS1C
03094      MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS1C
03095                                                                   DTSCS1C
03096      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS1C
03097                                                                   DTSCS1C
03098      PERFORM P8971A-MSOL-SCAN THRU P8971A-EXIT                    DTSCS1C
03099          UNTIL L810-NO-REC-88.                                    DTSCS1C
03100                                                                   DTSCS1C
03101                                                                   DTSCS1C
03102      PERFORM P8991-INITIALIZE-T001 THRU P8991-EXIT.               DTSCS1C
03103                                                                   DTSCS1C
03104      MOVE WRK-PRED-EMP-NO TO T001-EMP-NO.                         DTSCS1C
03105                                                                   DTSCS1C
03106      SET T001-FILE-CLERK-LIST TO TRUE.                            DTSCS1C
03107                                                                   DTSCS1C
03108      PERFORM S825-WRITE-T001 THRU S825-EXIT.                      DTSCS1C
03109                                                                   DTSCS1C
03110      IF MAP-PRED-INACT-LTR-TYPE = 'N'                             DTSCS1C
03111          NEXT SENTENCE                                            DTSCS1C
03112      ELSE                                                         DTSCS1C
03113          PERFORM P8991-INITIALIZE-T001 THRU P8991-EXIT            DTSCS1C
03114          MOVE WRK-PRED-EMP-NO TO T001-EMP-NO                      DTSCS1C
03115          SET T001-INACTIVE-LTR TO TRUE                            DTSCS1C
03116          MOVE MAP-PRED-INACT-LTR-TYPE TO T001-INACT-LTR-TYPE      DTSCS1C
03117          PERFORM S825-WRITE-T001 THRU S825-EXIT.                  DTSCS1C
03118                                                                   DTSCS1C
03119                                                                   DTSCS1C
03120      MOVE WRK-EMP-NO TO L331-EMP-NO.                              DTSCS1C
03121  P8971-EXIT.                                                      DTSCS1C
03122      EXIT.                                                        DTSCS1C
03123                                                                   DTSCS1C
03124                                                                   DTSCS1C
03125                                                                   DTSCS1C
03126  P8971A-MSOL-SCAN.                                                DTSCS1C
03127      MOVE MSKL-REC TO MSOL-REC.                                   DTSCS1C
03128                                                                   DTSCS1C
03129      IF MSOL-INACT-ACTIVE-88                                      DTSCS1C
03130          PERFORM S810-END-BROWSE THRU S810-EXIT                   DTSCS1C
03131          PERFORM P8971B-UPDATE-MSOL THRU P8971B-EXIT              DTSCS1C
03132          MOVE MSOL-REC TO MSKL-REC                                DTSCS1C
03133          PERFORM S810-REWRITE THRU S810-EXIT                      DTSCS1C
03134          PERFORM S810-START-BROWSE THRU S810-EXIT.                DTSCS1C
03135                                                                   DTSCS1C
03136      PERFORM S810-READ-NEXT THRU S810-EXIT.                       DTSCS1C
03137  P8971A-EXIT.                                                     DTSCS1C
03138      EXIT.                                                        DTSCS1C
03139                                                                   DTSCS1C
03140                                                                   DTSCS1C
03141                                                                   DTSCS1C
03142  P8971B-UPDATE-MSOL.                                              DTSCS1C
03143      MOVE WRK-LIAB-DATE TO L001-FED-8-DATE-9.                     DTSCS1C
03144                                                                   DTSCS1C
03145      SET L001-FROM-FED-8 TO TRUE.                                 DTSCS1C
03146                                                                   DTSCS1C
03147      PERFORM S001-DATE THRU S001-EXIT.                            DTSCS1C
03148                                                                   DTSCS1C
03149      SUBTRACT 1 FROM L001-JUL-ABS-DAY.                            DTSCS1C
03150                                                                   DTSCS1C
03151      SET L001-FROM-ABS-DAY TO TRUE.                               DTSCS1C
03152                                                                   DTSCS1C
03153      PERFORM S001-DATE THRU S001-EXIT.                            DTSCS1C
03154                                                                   DTSCS1C
03155      MOVE L001-FED-8-DATE-9 TO MSOL-INACT-DATE.                   DTSCS1C
03156                                                                   DTSCS1C
03157      MOVE LCCM-CURR-RUN-DATE TO MSOL-INACT-ENTER-DATE.            DTSCS1C
03158                                                                   DTSCS1C
03159      MOVE +0 TO MSOL-INACT-REVERSE-DATE.                          DTSCS1C
03160                                                                   DTSCS1C
03161      MOVE MAP-PRED-INACT-CD TO MSOL-INACT-CD.                     DTSCS1C
03162                                                                   DTSCS1C
03163      MOVE MSOL-FIRST-LIAB-YRQ TO HOLD-FIRST-LIAB-YRQ.             DTSCS1C
03164                                                                   DTSCS1C
03165      IF (MSOL-LIAB-DATE > MSOL-INACT-DATE)                        DTSCS1C
03166            OR                                                     DTSCS1C
03167         (MSOL-INACT-WITHDRAWN-88)                                 DTSCS1C
03168          MOVE +0 TO MSOL-FIRST-LIAB-YRQ                           DTSCS1C
03169                     MSOL-LAST-LIAB-YRQ                            DTSCS1C
03170      ELSE                                                         DTSCS1C
03171          MOVE MSOL-INACT-DATE TO L004-DATE                        DTSCS1C
03172          SET L004-FROM-DATE TO TRUE                               DTSCS1C
03173          PERFORM S004-YRQ THRU S004-EXIT                          DTSCS1C
03174          MOVE L004-QTR-5-9 TO MSOL-LAST-LIAB-YRQ.                 DTSCS1C
03175                                                                   DTSCS1C
03176      MOVE LCCM-CURR-RUN-DATE TO MSOL-CHNG-DATE.                   DTSCS1C
03177                                                                   DTSCS1C
03178                                                                   DTSCS1C
03179      MOVE MSOL-LIAB-DATE TO L001-FED-8-DATE-9.                    DTSCS1C
03180                                                                   DTSCS1C
03181      MOVE L001-FED-8-DATE-X TO L331-REC-OCC-ID.                   DTSCS1C
03182                                                                   DTSCS1C
03183                                                                   DTSCS1C
03184      IF MSOL-FIRST-LIAB-YRQ = HOLD-FIRST-LIAB-YRQ                 DTSCS1C
03185          NEXT SENTENCE                                            DTSCS1C
03186      ELSE                                                         DTSCS1C
03187          MOVE 'MSOL-FIRST-LIAB-YRQ' TO L331-FIELD-NAME            DTSCS1C
03188          MOVE HOLD-FIRST-LIAB-YRQ TO L004-QTR-5-9                 DTSCS1C
03189          SET L004-FROM-5 TO TRUE                                  DTSCS1C
03190          PERFORM S004-YRQ THRU S004-EXIT                          DTSCS1C
03191          MOVE L004-SLASH-QTR TO L331-FROM-VALUE                   DTSCS1C
03192          MOVE SPACES TO L331-TO-VALUE                             DTSCS1C
03193          IF MSOL-FIRST-LIAB-YRQ NOT = +0                          DTSCS1C
03194              MOVE MSOL-FIRST-LIAB-YRQ TO L004-QTR-5-9             DTSCS1C
03195              SET L004-FROM-5 TO TRUE                              DTSCS1C
03196              PERFORM S004-YRQ THRU S004-EXIT                      DTSCS1C
03197              MOVE L004-SLASH-QTR TO L331-TO-VALUE                 DTSCS1C
03198          END-IF                                                   DTSCS1C
03199          PERFORM S331-WRITE-MLOG THRU S331-EXIT.                  DTSCS1C
03200                                                                   DTSCS1C
03201                                                                   DTSCS1C
03202      MOVE MSOL-INACT-DATE TO L001-FED-8-DATE-9.                   DTSCS1C
03203                                                                   DTSCS1C
03204      SET L001-FROM-FED-8 TO TRUE.                                 DTSCS1C
03205                                                                   DTSCS1C
03206      PERFORM S001-DATE THRU S001-EXIT.                            DTSCS1C
03207                                                                   DTSCS1C
03208      MOVE 'MSOL-INACT-DATE' TO L331-FIELD-NAME.                   DTSCS1C
03209                                                                   DTSCS1C
03210      MOVE SPACES TO L331-FROM-VALUE.                              DTSCS1C
03211                                                                   DTSCS1C
03212      MOVE L001-SLASH-DATE TO L331-TO-VALUE.                       DTSCS1C
03213                                                                   DTSCS1C
03214      PERFORM S331-WRITE-MLOG THRU S331-EXIT.                      DTSCS1C
03215                                                                   DTSCS1C
03216                                                                   DTSCS1C
03217      MOVE 'MSOL-INACT-CD' TO L331-FIELD-NAME.                     DTSCS1C
03218                                                                   DTSCS1C
03219      MOVE SPACES TO L331-FROM-VALUE.                              DTSCS1C
03220                                                                   DTSCS1C
03221      MOVE 'MSOL-INACT-CD' TO L331-FIELD-NAME.                     DTSCS1C
03222                                                                   DTSCS1C
03223      MOVE MSOL-INACT-CD TO L331-TO-VALUE.                         DTSCS1C
03224                                                                   DTSCS1C
03225      PERFORM S331-WRITE-MLOG THRU S331-EXIT.                      DTSCS1C
03226                                                                   DTSCS1C
03227                                                                   DTSCS1C
03228      MOVE 'MSOL-LAST-LIAB-YRQ' TO L331-FIELD-NAME.                DTSCS1C
03229                                                                   DTSCS1C
03230      MOVE SPACES TO L331-FROM-VALUE.                              DTSCS1C
03231                                                                   DTSCS1C
03232      IF MSOL-LAST-LIAB-YRQ = +0                                   DTSCS1C
03233          NEXT SENTENCE                                            DTSCS1C
03234      ELSE                                                         DTSCS1C
03235          MOVE MSOL-LAST-LIAB-YRQ TO L004-QTR-5-9                  DTSCS1C
03236          SET L004-FROM-5 TO TRUE                                  DTSCS1C
03237          PERFORM S004-YRQ THRU S004-EXIT                          DTSCS1C
03238          MOVE L004-SLASH-QTR TO L331-TO-VALUE                     DTSCS1C
03239          PERFORM S331-WRITE-MLOG THRU S331-EXIT.                  DTSCS1C
03240                                                                   DTSCS1C
03241                                                                   DTSCS1C
03242      PERFORM P8994-INITIALIZE-T031 THRU P8994-EXIT.               DTSCS1C
03243                                                                   DTSCS1C
03244      MOVE WRK-PRED-EMP-NO TO T031-EMP-NO.                         DTSCS1C
03245                                                                   DTSCS1C
03246      SET T031-AUTO-PROCESS TO TRUE.                               DTSCS1C
03247                                                                   DTSCS1C
03248      IF MSOL-LAST-LIAB-YRQ = +0                                   DTSCS1C
03249          MOVE +0 TO T031-START-YRQ                                DTSCS1C
03250      ELSE                                                         DTSCS1C
03251          MOVE MSOL-LAST-LIAB-YRQ TO L004-QTR-5-9                  DTSCS1C
03252          SET L004-FROM-5 TO TRUE                                  DTSCS1C
03253          PERFORM S004-YRQ THRU S004-EXIT                          DTSCS1C
03254          ADD +1 TO L004-ABS-QTR                                   DTSCS1C
03255          SET L004-FROM-ABS TO TRUE                                DTSCS1C
03256          PERFORM S004-YRQ THRU S004-EXIT                          DTSCS1C
03257          MOVE L004-QTR-5-9 TO T031-START-YRQ.                     DTSCS1C
03258                                                                   DTSCS1C
03259      MOVE ALL-NINES-YRQ TO T031-END-YRQ.                          DTSCS1C
03260                                                                   DTSCS1C
03261      IF MAP-TRANSFER-YES-88                                       DTSCS1C
03262          SET T031-TRANSFER-YES-88 TO TRUE                         DTSCS1C
03263          MOVE WRK-EMP-NO TO T031-TRANSFER-TO-EMP-NO.              DTSCS1C
03264                                                                   DTSCS1C
03265      PERFORM S825-WRITE-T031 THRU S825-EXIT.                      DTSCS1C
03266                                                                   DTSCS1C
03267                                                                   DTSCS1C
03268      IF (MSOL-LAST-LIAB-YRQ = +0)                                 DTSCS1C
03269             OR                                                    DTSCS1C
03270         (MSOL-LAST-LIAB-YRQ NOT > LCCM-LAST-UC30-MASS-MAIL-YRQ)   DTSCS1C
03271          NEXT SENTENCE                                            DTSCS1C
03272      ELSE                                                         DTSCS1C
03273          PERFORM P8995-INITIALIZE-T036 THRU P8995-EXIT            DTSCS1C
03274          MOVE WRK-PRED-EMP-NO TO T036-EMP-NO                      DTSCS1C
03275          SET T036-INACTIVATION TO TRUE                            DTSCS1C
03276          MOVE LCCM-LAST-UC30-MASS-MAIL-YRQ TO L004-QTR-5-9        DTSCS1C
03277          SET L004-FROM-5 TO TRUE                                  DTSCS1C
03278          PERFORM S004-YRQ THRU S004-EXIT                          DTSCS1C
03279          ADD +1 TO L004-ABS-QTR                                   DTSCS1C
03280          SET L004-FROM-ABS TO TRUE                                DTSCS1C
03281          PERFORM S004-YRQ THRU S004-EXIT                          DTSCS1C
03282          MOVE L004-QTR-5-9 TO T036-START-YRQ                      DTSCS1C
03283          MOVE MSOL-LAST-LIAB-YRQ TO T036-END-YRQ                  DTSCS1C
03284          PERFORM S825-WRITE-T036 THRU S825-EXIT.                  DTSCS1C
03285                                                                   DTSCS1C
03286                                                                   DTSCS1C
03287      MOVE LOW-VALUES TO MERD-REC.                                 DTSCS1C
03288                                                                   DTSCS1C
03289      MOVE WRK-PRED-EMP-NO TO MERD-EMP-NO.                         DTSCS1C
03290                                                                   DTSCS1C
03291      SET MERD-ERD-88 TO TRUE.                                     DTSCS1C
03292                                                                   DTSCS1C
03293      MOVE LCCM-TASK-START-ABSTIME TO MERD-ESTB-ABSTIME.           DTSCS1C
03294                                                                   DTSCS1C
03295      MOVE +0 TO MERD-PURGE-DATE.                                  DTSCS1C
03296                                                                   DTSCS1C
03297      SET MERD-DETER-INACT-88 TO TRUE.                             DTSCS1C
03298                                                                   DTSCS1C
03299      MOVE MSOL-INACT-DATE TO MERD-EFFECTIVE-DATE.                 DTSCS1C
03300                                                                   DTSCS1C
03301      MOVE WRK-SCR-ID TO MERD-SCREEN-ID.                           DTSCS1C
03302                                                                   DTSCS1C
03303      MOVE LCCM-OP-ID TO MERD-OP-ID.                               DTSCS1C
03304                                                                   DTSCS1C
03305      SET MERD-NOT-CONVERTED-88 TO TRUE.                           DTSCS1C
03306                                                                   DTSCS1C
03307      MOVE LCCM-CURR-RUN-DATE TO MERD-ESTB-DATE.                   DTSCS1C
03308                                                                   DTSCS1C
03309      MOVE MERD-REC TO MSKL-REC.                                   DTSCS1C
03310                                                                   DTSCS1C
03311      PERFORM S810-WRITE THRU S810-EXIT.                           DTSCS1C
03312  P8971B-EXIT.                                                     DTSCS1C
03313      EXIT.                                                        DTSCS1C
03314      EJECT                                                        DTSCS1C
03315  P8972-ADD-MREL.                                                  DTSCS1C
03316      MOVE LOW-VALUES TO MREL-REC.                                 DTSCS1C
03317                                                                   DTSCS1C
03318      MOVE WRK-EMP-NO TO MREL-EMP-NO.                              DTSCS1C
03319                                                                   DTSCS1C
03320      SET MREL-REL-88 TO TRUE.                                     DTSCS1C
03321                                                                   DTSCS1C
03322 *****MOVE WRK-LIAB-DATE TO L001-FED-8-DATE-9.                     DTSCS1C
03323 *****SET L001-FROM-FED-8 TO TRUE.                                 DTSCS1C
03324 *****PERFORM S001-DATE THRU S001-EXIT.                            DTSCS1C
03325 *****SUBTRACT 1 FROM L001-JUL-ABS-DAY.                            DTSCS1C
03326 *****SET L001-FROM-ABS-DAY TO TRUE.                               DTSCS1C
03327 *****PERFORM S001-DATE THRU S001-EXIT.                            DTSCS1C
03328 *****MOVE L001-FED-8-DATE-9 TO MREL-EFF-DATE.                     DTSCS1C
03329                                                                   DTSCS1C
03330      MOVE WRK-LIAB-DATE TO MREL-EFF-DATE.                         DTSCS1C
03331                                                                   DTSCS1C
03332      MOVE WRK-PRED-EMP-NO TO MREL-PRED-EMP-NO.                    DTSCS1C
03333                                                                   DTSCS1C
03334      MOVE +0 TO MREL-PURGE-DATE.                                  DTSCS1C
03335                                                                   DTSCS1C
03336      MOVE MAP-RELATIONSHIP-CD TO MREL-RELATIONSHIP-CD.            DTSCS1C
03337                                                                   DTSCS1C
03338      SET MREL-SUCCESSOR-DET-NO-88 TO TRUE.                        DTSCS1C
03339                                                                   DTSCS1C
03340      MOVE MAP-EXP-TRNSF-CD TO MREL-EXP-TRNSF-CD.                  DTSCS1C
03341                                                                   DTSCS1C
03342      IF MREL-EXP-TRNSF-YES-88                                     DTSCS1C
03343          MOVE 1.0000 TO MREL-PORTION-EXP-TRNSF                    DTSCS1C
03344      ELSE                                                         DTSCS1C
03345          MOVE 0.0000 TO MREL-PORTION-EXP-TRNSF.                   DTSCS1C
03346                                                                   DTSCS1C
03347      SET MREL-NOT-CONVERTED-88 TO TRUE.                           DTSCS1C
03348                                                                   DTSCS1C
03349      MOVE LCCM-CURR-RUN-DATE TO MREL-ESTB-DATE                    DTSCS1C
03350                                 MREL-CHNG-DATE.                   DTSCS1C
03351                                                                   DTSCS1C
03352      MOVE +0 TO MREL-TEXT-CNT.                                    DTSCS1C
03353                                                                   DTSCS1C
03354      MOVE MREL-REC TO MSKL-REC.                                   DTSCS1C
03355                                                                   DTSCS1C
03356      PERFORM S810-WRITE THRU S810-EXIT.                           DTSCS1C
03357                                                                   DTSCS1C
03358                                                                   DTSCS1C
03359      MOVE SPACES TO L331-REC-OCC-ID.                              DTSCS1C
03360                                                                   DTSCS1C
03361      MOVE SPACES TO L331-FROM-VALUE.                              DTSCS1C
03362                                                                   DTSCS1C
03363      MOVE MREL-EFF-DATE TO L001-FED-8-DATE-9.                     DTSCS1C
03364                                                                   DTSCS1C
03365      MOVE WRK-PRED-EMP-NO TO WRK-DISPLAY.                         DTSCS1C
03366                                                                   DTSCS1C
03367      STRING L001-FED-8-DATE-X  DELIMITED BY SIZE                  DTSCS1C
03368             '/'                DELIMITED BY SIZE                  DTSCS1C
03369             WRK-DISPLAY-EMP-NO-1  DELIMITED BY SIZE               DTSCS1C
03370             WRK-DISPLAY-EMP-NO-2  DELIMITED BY SIZE               DTSCS1C
03371        INTO                                                       DTSCS1C
03372          L331-REC-OCC-ID.                                         DTSCS1C
03373                                                                   DTSCS1C
03374                                                                   DTSCS1C
03375      MOVE MREL-EFF-DATE TO L001-FED-8-DATE-9.                     DTSCS1C
03376                                                                   DTSCS1C
03377      SET L001-FROM-FED-8 TO TRUE.                                 DTSCS1C
03378                                                                   DTSCS1C
03379      PERFORM S001-DATE THRU S001-EXIT.                            DTSCS1C
03380                                                                   DTSCS1C
03381      MOVE 'MREL-EFF-DATE' TO L331-FIELD-NAME.                     DTSCS1C
03382                                                                   DTSCS1C
03383      MOVE L001-SLASH-DATE TO L331-TO-VALUE.                       DTSCS1C
03384                                                                   DTSCS1C
03385      PERFORM S331-WRITE-MLOG THRU S331-EXIT.                      DTSCS1C
03386                                                                   DTSCS1C
03387                                                                   DTSCS1C
03388      MOVE 'MREL-PRED-EMP-NO' TO L331-FIELD-NAME.                  DTSCS1C
03389                                                                   DTSCS1C
03390      MOVE MREL-PRED-EMP-NO TO WRK-DISPLAY.                        DTSCS1C
03391                                                                   DTSCS1C
03392      MOVE SPACES TO L331-TO-VALUE.                                DTSCS1C
03393                                                                   DTSCS1C
03394      STRING WRK-DISPLAY-EMP-NO-1 DELIMITED BY SIZE                DTSCS1C
03395             ' '                  DELIMITED BY SIZE                DTSCS1C
03396             WRK-DISPLAY-EMP-NO-2 DELIMITED BY SIZE                DTSCS1C
03397        INTO                                                       DTSCS1C
03398          L331-TO-VALUE.                                           DTSCS1C
03399                                                                   DTSCS1C
03400      PERFORM S331-WRITE-MLOG THRU S331-EXIT.                      DTSCS1C
03401                                                                   DTSCS1C
03402                                                                   DTSCS1C
03403      MOVE 'MREL-RELATIONSHIP-CD' TO L331-FIELD-NAME.              DTSCS1C
03404                                                                   DTSCS1C
03405      MOVE MREL-RELATIONSHIP-CD TO L331-TO-VALUE.                  DTSCS1C
03406                                                                   DTSCS1C
03407      PERFORM S331-WRITE-MLOG THRU S331-EXIT.                      DTSCS1C
03408                                                                   DTSCS1C
03409                                                                   DTSCS1C
03410      MOVE 'MREL-EXP-TRNSF-CD' TO L331-FIELD-NAME.                 DTSCS1C
03411                                                                   DTSCS1C
03412      MOVE MREL-EXP-TRNSF-CD TO L331-TO-VALUE.                     DTSCS1C
03413                                                                   DTSCS1C
03414      PERFORM S331-WRITE-MLOG THRU S331-EXIT.                      DTSCS1C
03415                                                                   DTSCS1C
03416                                                                   DTSCS1C
03417      IF MREL-PORTION-EXP-TRNSF = +0                               DTSCS1C
03418          NEXT SENTENCE                                            DTSCS1C
03419      ELSE                                                         DTSCS1C
03420          MOVE 'MREL-PORTION-EXP-TRNSF' TO L331-FIELD-NAME         DTSCS1C
03421          COMPUTE WRK-DISPLAY-PERCENT-9                            DTSCS1C
03422            = MREL-PORTION-EXP-TRNSF * 100                         DTSCS1C
03423          MOVE WRK-DISPLAY-PERCENT TO L331-TO-VALUE                DTSCS1C
03424          PERFORM S331-WRITE-MLOG THRU S331-EXIT.                  DTSCS1C
03425  P8972-EXIT.                                                      DTSCS1C
03426      EXIT.                                                        DTSCS1C
03427      EJECT                                                        DTSCS1C
03428  P8991-INITIALIZE-T001.                                           DTSCS1C
03429      MOVE LCCM-OP-ID TO T001-OP-ID.                               DTSCS1C
03430      MOVE WRK-SCR-ID TO T001-SCR-ID.                              DTSCS1C
03431      MOVE LCCM-TASK-START-DATE TO T001-SYS-DATE.                  DTSCS1C
03432      MOVE LCCM-TASK-START-TIME TO T001-SYS-TIME.                  DTSCS1C
03433      MOVE MAP-RESP-OP-ID TO T001-RESP-OP-ID.                      DTSCS1C
03434      MOVE SPACES TO T001-INACT-LTR-TYPE                           DTSCS1C
03435                     T001-NOT-LIABLE-LTR-TYPE                      DTSCS1C
03436                     T001-WELCOME-LTR-IND.                         DTSCS1C
03437  P8991-EXIT.                                                      DTSCS1C
03438      EXIT.                                                        DTSCS1C
03439                                                                   DTSCS1C
03440  P8992-INITIALIZE-T006.                                           DTSCS1C
03441      MOVE WRK-EMP-NO TO T006-EMP-NO.                              DTSCS1C
03442      MOVE LCCM-OP-ID TO T006-OP-ID.                               DTSCS1C
03443      MOVE WRK-SCR-ID TO T006-SCR-ID.                              DTSCS1C
03444      MOVE LCCM-TASK-START-DATE TO T006-SYS-DATE.                  DTSCS1C
03445      MOVE LCCM-TASK-START-TIME TO T006-SYS-TIME.                  DTSCS1C
03446      MOVE MAP-RESP-OP-ID TO T006-RESP-OP-ID.                      DTSCS1C
03447      MOVE +0 TO T006-START-YRQ                                    DTSCS1C
03448                 T006-END-YRQ.                                     DTSCS1C
03449  P8992-EXIT.                                                      DTSCS1C
03450      EXIT.                                                        DTSCS1C
03451                                                                   DTSCS1C
03452      SKIP3                                                        DTSCS1C
03453  P8994-INITIALIZE-T031.                                           DTSCS1C
03454      MOVE LCCM-OP-ID TO T031-OP-ID.                               DTSCS1C
03455      MOVE WRK-SCR-ID TO T031-SCR-ID.                              DTSCS1C
03456      MOVE LCCM-TASK-START-DATE TO T031-SYS-DATE.                  DTSCS1C
03457      MOVE LCCM-TASK-START-TIME TO T031-SYS-TIME.                  DTSCS1C
03458      MOVE +0 TO T031-START-YRQ                                    DTSCS1C
03459                 T031-END-YRQ                                      DTSCS1C
03460                 T031-WAIVER-START-YRQ                             DTSCS1C
03461                 T031-WAIVER-END-YRQ                               DTSCS1C
03462                 T031-WAIVER-EXT-DATE.                             DTSCS1C
03463      SET T031-TRANSFER-NO-88 TO TRUE.                             DTSCS1C
03464      MOVE +0 TO T031-TRANSFER-TO-EMP-NO.                          DTSCS1C
03465  P8994-EXIT.                                                      DTSCS1C
03466      EXIT.                                                        DTSCS1C
03467      SKIP3                                                        DTSCS1C
03468  P8995-INITIALIZE-T036.                                           DTSCS1C
03469      MOVE LCCM-OP-ID TO T036-OP-ID.                               DTSCS1C
03470      MOVE WRK-SCR-ID TO T036-SCR-ID.                              DTSCS1C
03471      MOVE LCCM-TASK-START-DATE TO T036-SYS-DATE.                  DTSCS1C
03472      MOVE LCCM-TASK-START-TIME TO T036-SYS-TIME.                  DTSCS1C
03473      MOVE MAP-RESP-OP-ID TO T036-RESP-OP-ID.                      DTSCS1C
03474      MOVE +0 TO T036-START-YRQ                                    DTSCS1C
03475                 T036-END-YRQ.                                     DTSCS1C
03476      SET T036-NO-FORCE-PRINT TO TRUE.                             DTSCS1C
03477      MOVE +0 TO T036-WAIVER-START-YRQ                             DTSCS1C
03478                 T036-WAIVER-END-YRQ                               DTSCS1C
03479                 T036-WAIVER-EXT-DATE.                             DTSCS1C
03480      MOVE SPACE TO T036-ADDR-TYPE.                                DTSCS1C
03481      MOVE +0 TO T036-ADDR-ESTB-ABSTIME.                           DTSCS1C
03482  P8995-EXIT.                                                      DTSCS1C
03483      EXIT.                                                        DTSCS1C
03484 /*****************************************************************DTSCS1C
03485 * LINKS TO UTILITY MODULES                                        DTSCS1C
03486 ******************************************************************DTSCS1C
03487                                                                   DTSCS1C
03488  S001-DATE.                                                       DTSCS1C
03489      EXEC CICS LINK                                               DTSCS1C
03490          PROGRAM('DTSCU001')                                      DTSCS1C
03491          COMMAREA(L001-COMM-AREA)                                 DTSCS1C
03492      END-EXEC.                                                    DTSCS1C
03493  S001-EXIT.                                                       DTSCS1C
03494      EXIT.                                                        DTSCS1C
03495      SKIP3                                                        DTSCS1C
03496  S004-YRQ.                                                        DTSCS1C
03497      EXEC CICS LINK                                               DTSCS1C
03498          PROGRAM('DTSCU004')                                      DTSCS1C
03499          COMMAREA(L004-COMM-AREA)                                 DTSCS1C
03500      END-EXEC.                                                    DTSCS1C
03501  S004-EXIT.                                                       DTSCS1C
03502      EXIT.                                                        DTSCS1C
03503      SKIP3                                                        DTSCS1C
03504  S006-RATING-YRQ.                                                 DTSCS1C
03505      EXEC CICS LINK                                               DTSCS1C
03506          PROGRAM('DTSCU006')                                      DTSCS1C
03507          COMMAREA(L006-COMM-AREA)                                 DTSCS1C
03508      END-EXEC.                                                    DTSCS1C
03509  S006-EXIT.                                                       DTSCS1C
03510      EXIT.                                                        DTSCS1C
03511      SKIP3                                                        DTSCS1C
03512  S012-RATE-FROM-SCREEN.                                           DTSCS1C
03513      EXEC CICS LINK                                               DTSCS1C
03514          PROGRAM('DTSCU012')                                      DTSCS1C
03515          COMMAREA(L012-COMM-AREA)                                 DTSCS1C
03516      END-EXEC.                                                    DTSCS1C
03517  S012-EXIT.                                                       DTSCS1C
03518      EXIT.                                                        DTSCS1C
03519      SKIP3                                                        DTSCS1C
03520  S015-DATE-FROM-SCREEN.                                           DTSCS1C
03521      EXEC CICS LINK                                               DTSCS1C
03522          PROGRAM('DTSCU015')                                      DTSCS1C
03523          COMMAREA(L015-COMM-AREA)                                 DTSCS1C
03524      END-EXEC.                                                    DTSCS1C
03525  S015-EXIT.                                                       DTSCS1C
03526      EXIT.                                                        DTSCS1C
03527      SKIP3                                                        DTSCS1C
03528  S016-YRQ-FROM-SCREEN.                                            DTSCS1C
03529      EXEC CICS LINK                                               DTSCS1C
03530          PROGRAM('DTSCU016')                                      DTSCS1C
03531          COMMAREA(L016-COMM-AREA)                                 DTSCS1C
03532      END-EXEC.                                                    DTSCS1C
03533  S016-EXIT.                                                       DTSCS1C
03534      EXIT.                                                        DTSCS1C
03535      SKIP3                                                        DTSCS1C
03536  S017-FEIN-FROM-SCREEN.                                           DTSCS1C
03537      EXEC CICS LINK                                               DTSCS1C
03538          PROGRAM('DTSCU017')                                      DTSCS1C
03539          COMMAREA(L017-COMM-AREA)                                 DTSCS1C
03540      END-EXEC.                                                    DTSCS1C
03541  S017-EXIT.                                                       DTSCS1C
03542      EXIT.                                                        DTSCS1C
03543      SKIP3                                                        DTSCS1C
03544  S018-EMP-NO-FROM-SCREEN.                                         DTSCS1C
03545      EXEC CICS LINK                                               DTSCS1C
03546          PROGRAM('DTSCU018')                                      DTSCS1C
03547          COMMAREA(L018-COMM-AREA)                                 DTSCS1C
03548      END-EXEC.                                                    DTSCS1C
03549  S018-EXIT.                                                       DTSCS1C
03550      EXIT.                                                        DTSCS1C
03551      SKIP3                                                        DTSCS1C
03552  S021-TELNO-FROM-SCREEN.                                          DTSCS1C
03553      EXEC CICS LINK                                               DTSCS1C
03554          PROGRAM('DTSCU021')                                      DTSCS1C
03555          COMMAREA(L021-COMM-AREA)                                 DTSCS1C
03556      END-EXEC.                                                    DTSCS1C
03557  S021-EXIT.                                                       DTSCS1C
03558      EXIT.                                                        DTSCS1C
03559      SKIP3                                                        DTSCS1C
03560  S031-REG-CODES.                                                  DTSCS1C
03561      EXEC CICS LINK                                               DTSCS1C
03562          PROGRAM('DTSCU031')                                      DTSCS1C
03563          COMMAREA(L031-COMM-AREA)                                 DTSCS1C
03564      END-EXEC.                                                    DTSCS1C
03565  S031-EXIT.                                                       DTSCS1C
03566      EXIT.                                                        DTSCS1C
03567      SKIP3                                                        DTSCS1C
03568  S042-MFSC-CODES.                                                 DTSCS1C
03569      EXEC CICS LINK                                               DTSCS1C
03570          PROGRAM('DTSCU042')                                      DTSCS1C
03571          COMMAREA(L042-COMM-AREA)                                 DTSCS1C
03572      END-EXEC.                                                    DTSCS1C
03573  S042-EXIT.                                                       DTSCS1C
03574      EXIT.                                                        DTSCS1C
03575      SKIP3                                                        DTSCS1C
03576  S052-UI-RATE-EDIT.                                               DTSCS1C
03577      EXEC CICS LINK                                               DTSCS1C
03578          PROGRAM('DTSCU052')                                      DTSCS1C
03579          COMMAREA(L052-COMM-AREA)                                 DTSCS1C
03580      END-EXEC.                                                    DTSCS1C
03581                                                                   DTSCS1C
03582      IF L052-FILE-CLOSED                                          DTSCS1C
03583          MOVE L052-MSG-AREA TO LCCM-MSG-AREA                      DTSCS1C
03584          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS1C
03585          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS1C
03586          GO TO MAINLINE-EXIT.                                     DTSCS1C
03587  S052-EXIT.                                                       DTSCS1C
03588      EXIT.                                                        DTSCS1C
03589      SKIP3                                                        DTSCS1C
03590  S056-RATE-DISPLAY.                                               DTSCS1C
03591      EXEC CICS LINK                                               DTSCS1C
03592          PROGRAM('DTSCU056')                                      DTSCS1C
03593          COMMAREA(L056-COMM-AREA)                                 DTSCS1C
03594      END-EXEC.                                                    DTSCS1C
03595  S056-EXIT.                                                       DTSCS1C
03596      EXIT.                                                        DTSCS1C
03597      SKIP3                                                        DTSCS1C
03598  S072-ADDRESS-EDIT.                                               DTSCS1C
03599      EXEC CICS LINK                                               DTSCS1C
03600          PROGRAM('DTSCU072')                                      DTSCS1C
03601          COMMAREA(L072-COMM-AREA)                                 DTSCS1C
03602      END-EXEC.                                                    DTSCS1C
03603  S072-EXIT.                                                       DTSCS1C
03604      EXIT.                                                        DTSCS1C
03605      SKIP3                                                        DTSCS1C
03606  S073-TELNO-EDIT.                                                 DTSCS1C
03607      EXEC CICS LINK                                               DTSCS1C
03608          PROGRAM('DTSCU073')                                      DTSCS1C
03609          COMMAREA(L073-COMM-AREA)                                 DTSCS1C
03610      END-EXEC.                                                    DTSCS1C
03611  S073-EXIT.                                                       DTSCS1C
03612      EXIT.                                                        DTSCS1C
03613      SKIP3                                                        DTSCS1C
03614  S074-DUP-FEIN-EDIT.                                              DTSCS1C
03615      EXEC CICS LINK                                               DTSCS1C
03616          PROGRAM('DTSCU074')                                      DTSCS1C
03617          COMMAREA(L074-COMM-AREA)                                 DTSCS1C
03618      END-EXEC.                                                    DTSCS1C
03619                                                                   DTSCS1C
03620      IF L074-FILE-CLOSED-88                                       DTSCS1C
03621          MOVE L074-MSG-AREA TO LCCM-MSG-AREA                      DTSCS1C
03622          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS1C
03623          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS1C
03624          GO TO MAINLINE-EXIT.                                     DTSCS1C
03625  S074-EXIT.                                                       DTSCS1C
03626      EXIT.                                                        DTSCS1C
03627      SKIP3                                                        DTSCS1C
03628  S082-OP-ID-LOOKUP.                                               DTSCS1C
03629      EXEC CICS LINK                                               DTSCS1C
03630          PROGRAM('DTSCU082')                                      DTSCS1C
03631          COMMAREA(L082-COMM-AREA)                                 DTSCS1C
03632      END-EXEC.                                                    DTSCS1C
03633                                                                   DTSCS1C
03634      IF L082-FILE-CLOSED                                          DTSCS1C
03635          MOVE L082-MSG-AREA TO LCCM-MSG-AREA                      DTSCS1C
03636          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS1C
03637          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS1C
03638          GO TO MAINLINE-EXIT.                                     DTSCS1C
03639  S082-EXIT.                                                       DTSCS1C
03640      EXIT.                                                        DTSCS1C
03641      SKIP3                                                        DTSCS1C
03642  S084-APPROVAL.                                                   DTSCS1C
03643      EXEC CICS LINK                                               DTSCS1C
03644          PROGRAM('DTSCU084')                                      DTSCS1C
03645          COMMAREA(L084-COMM-AREA)                                 DTSCS1C
03646      END-EXEC.                                                    DTSCS1C
03647                                                                   DTSCS1C
03648      IF L084-FILE-CLOSED-88                                       DTSCS1C
03649          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS1C
03650          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS1C
03651          GO TO MAINLINE-EXIT.                                     DTSCS1C
03652  S084-EXIT.                                                       DTSCS1C
03653      EXIT.                                                        DTSCS1C
03654                                                                   DTSCS1C
03655  S201-DETER-EMP-CLASS.                                            DTSCS1C
03656      EXEC CICS LINK                                               DTSCS1C
03657          PROGRAM('DTSCU201')                                      DTSCS1C
03658          COMMAREA(L201-COMM-AREA)                                 DTSCS1C
03659      END-EXEC.                                                    DTSCS1C
03660  S201-EXIT.                                                       DTSCS1C
03661      EXIT.                                                        DTSCS1C
03662      SKIP3                                                        DTSCS1C
03663  S202-DETER-ELIG-CD.                                              DTSCS1C
03664      EXEC CICS LINK                                               DTSCS1C
03665          PROGRAM('DTSCU202')                                      DTSCS1C
03666          COMMAREA(L202-COMM-AREA)                                 DTSCS1C
03667      END-EXEC.                                                    DTSCS1C
03668  S202-EXIT.                                                       DTSCS1C
03669      EXIT.                                                        DTSCS1C
03670      SKIP3                                                        DTSCS1C
03671  S203-DETER-ZIPS.                                                 DTSCS1C
03672      EXEC CICS LINK                                               DTSCS1C
03673          PROGRAM('DTSCU203')                                      DTSCS1C
03674          COMMAREA(L203-COMM-AREA)                                 DTSCS1C
03675      END-EXEC.                                                    DTSCS1C
03676                                                                   DTSCS1C
03677      IF L203-FILE-CLOSED-88                                       DTSCS1C
03678          MOVE L203-MSG-AREA TO LCCM-MSG-AREA                      DTSCS1C
03679          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS1C
03680          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS1C
03681          GO TO MAINLINE-EXIT.                                     DTSCS1C
03682  S203-EXIT.                                                       DTSCS1C
03683      EXIT.                                                        DTSCS1C
03684      SKIP3                                                        DTSCS1C
03685  S221-EMP-LOCK.                                                   DTSCS1C
03686      SET L221-START-UPDATE TO TRUE.                               DTSCS1C
03687      GO TO S221-EMP-LOCK-UNLOCK.                                  DTSCS1C
03688                                                                   DTSCS1C
03689  S221-EMP-UNLOCK.                                                 DTSCS1C
03690      SET L221-END-UPDATE TO TRUE.                                 DTSCS1C
03691      GO TO S221-EMP-LOCK-UNLOCK.                                  DTSCS1C
03692                                                                   DTSCS1C
03693  S221-EMP-LOCK-UNLOCK.                                            DTSCS1C
03694      EXEC CICS LINK                                               DTSCS1C
03695          PROGRAM('DTSCU221')                                      DTSCS1C
03696          COMMAREA(L221-COMM-AREA)                                 DTSCS1C
03697      END-EXEC.                                                    DTSCS1C
03698                                                                   DTSCS1C
03699      IF L221-FILE-CLOSED                                          DTSCS1C
03700          MOVE L221-MSG-AREA TO LCCM-MSG-AREA                      DTSCS1C
03701          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS1C
03702          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS1C
03703          GO TO MAINLINE-EXIT.                                     DTSCS1C
03704                                                                   DTSCS1C
03705      IF L221-NOT-OK                                               DTSCS1C
03706          MOVE L221-MSG-AREA TO LCCM-MSG-AREA.                     DTSCS1C
03707  S221-EXIT.                                                       DTSCS1C
03708      EXIT.                                                        DTSCS1C
03709      SKIP3                                                        DTSCS1C
03710  S331-WRITE-MLOG.                                                 DTSCS1C
03711                                                                   DTSCS1C
03712      EXEC CICS LINK                                               DTSCS1C
03713          PROGRAM('DTSCU331')                                      DTSCS1C
03714          COMMAREA(L331-COMM-AREA)                                 DTSCS1C
03715      END-EXEC.                                                    DTSCS1C
03716                                                                   DTSCS1C
03717      IF L331-FILE-CLOSED                                          DTSCS1C
03718          MOVE L331-MSG-AREA TO LCCM-MSG-AREA                      DTSCS1C
03719          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS1C
03720          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS1C
03721          GO TO MAINLINE-EXIT.                                     DTSCS1C
03722  S331-EXIT.                                                       DTSCS1C
03723      EXIT.                                                        DTSCS1C
03724      SKIP3                                                        DTSCS1C
03725  S400-HOUSEHOLD.                                                  DTSCS1C
03726                                                                   DTSCS1C
03727      EXEC CICS LINK                                               DTSCS1C
03728          PROGRAM('DTSCU400')                                      DTSCS1C
03729          COMMAREA(L400-COMM-AREA)                                 DTSCS1C
03730      END-EXEC.                                                    DTSCS1C
03731                                                                   DTSCS1C
03732  S400-EXIT.                                                       DTSCS1C
03733      EXIT.                                                        DTSCS1C
03734      SKIP3                                                        DTSCS1C
03735  S410-FILING-SCHEDULE.                                            DTSCS1C
03736                                                                   DTSCS1C
03737      EXEC CICS LINK                                               DTSCS1C
03738          PROGRAM('DTSCU410')                                      DTSCS1C
03739          COMMAREA(L410-COMM-AREA)                                 DTSCS1C
03740      END-EXEC.                                                    DTSCS1C
03741                                                                   DTSCS1C
03742  S410-EXIT.                                                       DTSCS1C
03743      EXIT.                                                        DTSCS1C
03744      SKIP3                                                        DTSCS1C
03745  S415-HOUSEHOLD-DATES.                                            DTSCS1C
03746                                                                   DTSCS1C
03747      EXEC CICS LINK                                               DTSCS1C
03748          PROGRAM('DTSCU415')                                      DTSCS1C
03749          COMMAREA(L415-COMM-AREA)                                 DTSCS1C
03750      END-EXEC.                                                    DTSCS1C
03751                                                                   DTSCS1C
03752  S415-EXIT.                                                       DTSCS1C
03753      EXIT.                                                        DTSCS1C
03754      SKIP3                                                        DTSCS1C
03755  S803-REQ-SCR-ID-EDIT.                                            DTSCS1C
03756      EXEC CICS LINK                                               DTSCS1C
03757          PROGRAM ('DTSCU803')                                     DTSCS1C
03758          COMMAREA (DFHCOMMAREA)                                   DTSCS1C
03759      END-EXEC.                                                    DTSCS1C
03760  S803-EXIT.                                                       DTSCS1C
03761      EXIT.                                                        DTSCS1C
03762      SKIP3                                                        DTSCS1C
03763  S804-INVALID-KEY.                                                DTSCS1C
03764      EXEC CICS LINK                                               DTSCS1C
03765          PROGRAM ('DTSCU804')                                     DTSCS1C
03766          COMMAREA (DFHCOMMAREA)                                   DTSCS1C
03767      END-EXEC.                                                    DTSCS1C
03768  S804-EXIT.                                                       DTSCS1C
03769      EXIT.                                                        DTSCS1C
03770      SKIP3                                                        DTSCS1C
03771  S805-MSG-AREA.                                                   DTSCS1C
03772      MOVE LCCM-MSG-AREA TO L805-MSG-AREA                          DTSCS1C
03773                                                                   DTSCS1C
03774      EXEC CICS LINK                                               DTSCS1C
03775          PROGRAM ('DTSCU805')                                     DTSCS1C
03776          COMMAREA (L805-COMM-AREA)                                DTSCS1C
03777      END-EXEC.                                                    DTSCS1C
03778                                                                   DTSCS1C
03779      MOVE L805-S-MSG-AREA TO MAP-MSG-AREA.                        DTSCS1C
03780  S805-EXIT.                                                       DTSCS1C
03781      EXIT.                                                        DTSCS1C
03782      EJECT                                                        DTSCS1C
03783  S810-READ.                                                       DTSCS1C
03784      SET L810-READ-88 TO TRUE.                                    DTSCS1C
03785      GO TO S810-IO.                                               DTSCS1C
03786                                                                   DTSCS1C
03787  S810-START-BROWSE.                                               DTSCS1C
03788      SET L810-START-BROWSE-88 TO TRUE.                            DTSCS1C
03789      GO TO S810-IO.                                               DTSCS1C
03790                                                                   DTSCS1C
03791  S810-READ-NEXT.                                                  DTSCS1C
03792      SET L810-READ-NEXT-88 TO TRUE.                               DTSCS1C
03793      GO TO S810-IO.                                               DTSCS1C
03794                                                                   DTSCS1C
03795  S810-READ-PREV.                                                  DTSCS1C
03796      SET L810-READ-PREV-88 TO TRUE.                               DTSCS1C
03797      GO TO S810-IO.                                               DTSCS1C
03798                                                                   DTSCS1C
03799  S810-END-BROWSE.                                                 DTSCS1C
03800      SET L810-END-BROWSE-88 TO TRUE.                              DTSCS1C
03801      GO TO S810-IO.                                               DTSCS1C
03802                                                                   DTSCS1C
03803  S810-REWRITE.                                                    DTSCS1C
03804      SET L810-REWRITE-88 TO TRUE.                                 DTSCS1C
03805      GO TO S810-IO.                                               DTSCS1C
03806                                                                   DTSCS1C
03807  S810-WRITE.                                                      DTSCS1C
03808      SET L810-WRITE-88 TO TRUE.                                   DTSCS1C
03809      GO TO S810-IO.                                               DTSCS1C
03810                                                                   DTSCS1C
03811  S810-DELETE.                                                     DTSCS1C
03812      SET L810-DELETE-88 TO TRUE.                                  DTSCS1C
03813      GO TO S810-IO.                                               DTSCS1C
03814                                                                   DTSCS1C
03815  S810-IO.                                                         DTSCS1C
03816                                                                   DTSCS1C
03817      EXEC CICS LINK                                               DTSCS1C
03818          PROGRAM ('DTSCU810')                                     DTSCS1C
03819          COMMAREA (L810-COMM-AREA)                                DTSCS1C
03820      END-EXEC.                                                    DTSCS1C
03821                                                                   DTSCS1C
03822      IF L810-FILE-CLOSED-88                                       DTSCS1C
03823          MOVE L810-MSG-AREA TO LCCM-MSG-AREA                      DTSCS1C
03824          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS1C
03825          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS1C
03826          GO TO MAINLINE-EXIT.                                     DTSCS1C
03827  S810-EXIT.                                                       DTSCS1C
03828      EXIT.                                                        DTSCS1C
03829      EJECT                                                        DTSCS1C
03830  S821-READ.                                                       DTSCS1C
03831      SET L821-READ-88 TO TRUE.                                    DTSCS1C
03832      GO TO S821-I.                                                DTSCS1C
03833                                                                   DTSCS1C
03834  S821-START-BROWSE.                                               DTSCS1C
03835      SET L821-START-BROWSE-88 TO TRUE.                            DTSCS1C
03836      GO TO S821-I.                                                DTSCS1C
03837                                                                   DTSCS1C
03838  S821-READ-NEXT.                                                  DTSCS1C
03839      SET L821-READ-NEXT-88 TO TRUE.                               DTSCS1C
03840      GO TO S821-I.                                                DTSCS1C
03841                                                                   DTSCS1C
03842  S821-READ-PREV.                                                  DTSCS1C
03843      SET L821-READ-PREV-88 TO TRUE.                               DTSCS1C
03844      GO TO S821-I.                                                DTSCS1C
03845                                                                   DTSCS1C
03846  S821-END-BROWSE.                                                 DTSCS1C
03847      SET L821-END-BROWSE-88 TO TRUE.                              DTSCS1C
03848      GO TO S821-I.                                                DTSCS1C
03849                                                                   DTSCS1C
03850  S821-I.                                                          DTSCS1C
03851                                                                   DTSCS1C
03852      EXEC CICS LINK                                               DTSCS1C
03853          PROGRAM ('DTSCU821')                                     DTSCS1C
03854          COMMAREA (L821-COMM-AREA)                                DTSCS1C
03855      END-EXEC.                                                    DTSCS1C
03856                                                                   DTSCS1C
03857      IF L821-FILE-CLOSED-88                                       DTSCS1C
03858          MOVE L821-MSG-AREA TO LCCM-MSG-AREA                      DTSCS1C
03859          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS1C
03860          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS1C
03861          GO TO MAINLINE-EXIT.                                     DTSCS1C
03862  S821-EXIT.                                                       DTSCS1C
03863      EXIT.                                                        DTSCS1C
03864      EJECT                                                        DTSCS1C
03865  S825-WRITE-T001.                                                 DTSCS1C
03866      MOVE LENGTH OF T001-REC TO T001-LENGTH.                      DTSCS1C
03867      MOVE T001-REC TO RSKL-REC.                                   DTSCS1C
03868      SET L825-WRITE-88 TO TRUE.                                   DTSCS1C
03869      GO TO S825-O.                                                DTSCS1C
03870                                                                   DTSCS1C
03871  S825-WRITE-T006.                                                 DTSCS1C
03872      MOVE LENGTH OF T006-REC TO T006-LENGTH.                      DTSCS1C
03873      MOVE T006-REC TO RSKL-REC.                                   DTSCS1C
03874      SET L825-WRITE-88 TO TRUE.                                   DTSCS1C
03875      GO TO S825-O.                                                DTSCS1C
03876                                                                   DTSCS1C
03877  S825-WRITE-T031.                                                 DTSCS1C
03878      MOVE LENGTH OF T031-REC TO T031-LENGTH.                      DTSCS1C
03879      MOVE T031-REC TO RSKL-REC.                                   DTSCS1C
03880      SET L825-WRITE-88 TO TRUE.                                   DTSCS1C
03881      GO TO S825-O.                                                DTSCS1C
03882                                                                   DTSCS1C
03883  S825-WRITE-T036.                                                 DTSCS1C
03884      MOVE LENGTH OF T036-REC TO T036-LENGTH.                      DTSCS1C
03885      MOVE T036-REC TO RSKL-REC.                                   DTSCS1C
03886      SET L825-WRITE-88 TO TRUE.                                   DTSCS1C
03887      GO TO S825-O.                                                DTSCS1C
03888                                                                   DTSCS1C
03889  S825-O.                                                          DTSCS1C
03890                                                                   DTSCS1C
03891      EXEC CICS LINK                                               DTSCS1C
03892          PROGRAM ('DTSCU825')                                     DTSCS1C
03893          COMMAREA (L825-COMM-AREA)                                DTSCS1C
03894      END-EXEC.                                                    DTSCS1C
03895                                                                   DTSCS1C
03896      IF L825-FILE-CLOSED-88                                       DTSCS1C
03897          MOVE L825-MSG-AREA TO LCCM-MSG-AREA                      DTSCS1C
03898          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS1C
03899          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS1C
03900          GO TO MAINLINE-EXIT.                                     DTSCS1C
03901  S825-EXIT.                                                       DTSCS1C
03902      EXIT.                                                        DTSCS1C
03903      EJECT                                                        DTSCS1C
03904  S831-READ.                                                       DTSCS1C
03905      SET L831-READ-88 TO TRUE.                                    DTSCS1C
03906      GO TO S831-I.                                                DTSCS1C
03907                                                                   DTSCS1C
03908  S831-I.                                                          DTSCS1C
03909                                                                   DTSCS1C
03910      EXEC CICS LINK                                               DTSCS1C
03911          PROGRAM ('DTSCU831')                                     DTSCS1C
03912          COMMAREA (L831-COMM-AREA)                                DTSCS1C
03913      END-EXEC.                                                    DTSCS1C
03914                                                                   DTSCS1C
03915      IF L831-FILE-CLOSED-88                                       DTSCS1C
03916          MOVE L831-MSG-AREA TO LCCM-MSG-AREA                      DTSCS1C
03917          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS1C
03918          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS1C
03919          GO TO MAINLINE-EXIT.                                     DTSCS1C
03920  S831-EXIT.                                                       DTSCS1C
03921      EXIT.                                                        DTSCS1C
03922      EJECT                                                        DTSCS1C
03923  S851-SCREEN-PROCESSING.                                          DTSCS1C
03924      EXEC CICS LINK                                               DTSCS1C
03925          PROGRAM ('DTSCU851')                                     DTSCS1C
03926          COMMAREA (L851-COMM-AREA)                                DTSCS1C
03927      END-EXEC.                                                    DTSCS1C
03928  S851-EXIT.                                                       DTSCS1C
03929      EXIT.                                                        DTSCS1C
03930      SKIP3                                                        DTSCS1C
03931  S899-ABEND.                                                      DTSCS1C
03932      EXEC CICS ABEND                                              DTSCS1C
03933          ABCODE(WRK-ABEND-CD)                                     DTSCS1C
03934      END-EXEC.                                                    DTSCS1C
03935  S899-EXIT.                                                       DTSCS1C
03936      EXIT.                                                        DTSCS1C
03937 /*****************************************************************DTSCS1C
03938 *    EDIT THE INFORMATION ON THE SCREEN.                         *DTSCS1C
03939 ******************************************************************DTSCS1C
03940                                                                   DTSCS1C
03941  S1000-SCREEN-EDITS.                                              DTSCS1C
03942      PERFORM S1200-PRIMARY-NAME THRU S1200-EXIT.                  DTSCS1C
03943                                                                   DTSCS1C
03944      PERFORM S1300-EDIT-ADDRESS THRU S1300-EXIT.                  DTSCS1C
03945                                                                   DTSCS1C
03946      PERFORM S1410-VOICE-1 THRU S1410-EXIT.                       DTSCS1C
03947                                                                   DTSCS1C
03948      PERFORM S1420-VOICE-2 THRU S1420-EXIT.                       DTSCS1C
03949                                                                   DTSCS1C
03950      PERFORM S1430-FAX THRU S1430-EXIT.                           DTSCS1C
03951                                                                   DTSCS1C
03952      PERFORM S1700-ORG-TYPE THRU S1700-EXIT.                      DTSCS1C
03953                                                                   DTSCS1C
03954      PERFORM S1800-FEIN THRU S1800-EXIT.                          DTSCS1C
03955                                                                   DTSCS1C
03956      PERFORM S2100-UI-LIABLE-IND THRU S2100-EXIT.                 DTSCS1C
03957                                                                   DTSCS1C
03958      PERFORM S2150-CHK-FOR-DC-ADDR THRU S2150-EXIT.               DTSCS1C
03959                                                                   DTSCS1C
03960      PERFORM S2400-EMP-CLASS THRU S2400-EXIT.                     DTSCS1C
03961                                                                   DTSCS1C
03962      PERFORM S2500-LIAB-CD THRU S2500-EXIT.                       DTSCS1C
03963                                                                   DTSCS1C
03964      PERFORM S2600-LIAB-DATE THRU S2600-EXIT.                     DTSCS1C
03965      IF LCCM-MSG                                                  DTSCS1C
03966         GO TO S1000-EXIT.                                         DTSCS1C
03967                                                                   DTSCS1C
03968      PERFORM S2700-LIAB-ESTB-DATE THRU S2700-EXIT.                DTSCS1C
03969                                                                   DTSCS1C
03970      PERFORM S2800-581-NEW-IND THRU S2800-EXIT.                   DTSCS1C
03971                                                                   DTSCS1C
03972      PERFORM S2900-INACT-CD THRU S2900-EXIT.                      DTSCS1C
03973                                                                   DTSCS1C
03974      PERFORM S3100-INACT-DATE THRU S3100-EXIT.                    DTSCS1C
03975                                                                   DTSCS1C
03976      PERFORM S3200-INACT-LTR-TYPE THRU S3200-EXIT.                DTSCS1C
03977                                                                   DTSCS1C
03978      PERFORM S3300-TRANSFER-IND THRU S3300-EXIT.                  DTSCS1C
03979                                                                   DTSCS1C
03980                                                                   DTSCS1C
03981      PERFORM S6100-SET-LIAB-YRQ THRU S6100-EXIT.                  DTSCS1C
03982                                                                   DTSCS1C
03983                                                                   DTSCS1C
03984      IF (MAP-UI-LIABLE-YES-88)                                    DTSCS1C
03985             AND                                                   DTSCS1C
03986         (LCCM-NO-MSG)                                             DTSCS1C
03987          PERFORM S3400-CHECK-OVERLAP THRU S3400-EXIT.             DTSCS1C
03988                                                                   DTSCS1C
03989      MOVE +0 TO WRK-SUB2.                                         DTSCS1C
03990                                                                   DTSCS1C
03991      PERFORM S3500-RATES THRU S3500-EXIT                          DTSCS1C
03992          VARYING WRK-SUB1 FROM 1 BY 1                             DTSCS1C
03993          UNTIL WRK-SUB1 > RTE-OCC-MAX.                            DTSCS1C
03994                                                                   DTSCS1C
03995      IF (MAP-UI-LIABLE-YES-88)                                    DTSCS1C
03996            AND                                                    DTSCS1C
03997         (LCCM-NO-MSG)                                             DTSCS1C
03998          PERFORM S3590-REARRANGE-RATES THRU S3590-EXIT            DTSCS1C
03999          PERFORM S3600-REQUIRE-RATES THRU S3600-EXIT.             DTSCS1C
04000                                                                   DTSCS1C
04001                                                                   DTSCS1C
04002      PERFORM S3660-FILING-SCHEDULE THRU S3660-EXIT.               DTSCS1C
04003                                                                   DTSCS1C
04004      PERFORM S3670-CHK-HSEHLD-REACT THRU S3670-EXIT.              DTSCS1C
04005                                                                   DTSCS1C
04006      PERFORM S3700-WAIVER-START-YRQ THRU S3700-EXIT.              DTSCS1C
04007                                                                   DTSCS1C
04008      PERFORM S3800-WAIVER-END-YRQ THRU S3800-EXIT.                DTSCS1C
04009                                                                   DTSCS1C
04010      PERFORM S3900-WAIVER-EXT-DATE THRU S3900-EXIT.               DTSCS1C
04011                                                                   DTSCS1C
04012      PERFORM S4000-RPT-PRINT-IND THRU S4000-EXIT.                 DTSCS1C
04013                                                                   DTSCS1C
04014                                                                   DTSCS1C
04015      PERFORM S4100-WELCOME-LTR-IND THRU S4100-EXIT.               DTSCS1C
04016                                                                   DTSCS1C
04017      PERFORM S2200-NOT-LIABLE-LTR-TYPE THRU S2200-EXIT.           DTSCS1C
04018                                                                   DTSCS1C
04019      PERFORM S2300-FOLLOWUP-DATE THRU S2300-EXIT.                 DTSCS1C
04020                                                                   DTSCS1C
04021      PERFORM S4300-RESP-OP-ID THRU S4300-EXIT.                    DTSCS1C
04022                                                                   DTSCS1C
04023 ***************************************************************   DTSCS1C
04024 *  S4400 CHECKS FOR SUPERVISOR APPROVAL WHEN A PREDECESSOR        DTSCS1C
04025 *  IS ENTERED, AND DISPLAYS AN ERROR MESSAGE IF THERE IS NO       DTSCS1C
04026 *  APPROVAL ON FILE.  THE REMAINING PARAGRAPHS WILL ONLY BE       DTSCS1C
04027 *  EXECUTED IF THE APPROVAL IS ON FILE.                           DTSCS1C
04028 ***************************************************************   DTSCS1C
04029      IF L084-VALID-APPROVAL-88                                    DTSCS1C
04030         PERFORM S4400-PRED-EMP-NO          THRU S4400-EXIT        DTSCS1C
04031         PERFORM S4500-PRED-INACT-CD        THRU S4500-EXIT        DTSCS1C
04032         PERFORM S4600-PRED-INACT-LTR-TYPE  THRU S4600-EXIT        DTSCS1C
04033         PERFORM S4800-RELATIONSHIP         THRU S4800-EXIT        DTSCS1C
04034      ELSE                                                         DTSCS1C
04035          MOVE SPACES                  TO MAP-PRED-INACT-CD        DTSCS1C
04036          MOVE SPACES                  TO MAP-PRED-INACT-LTR-TYPE  DTSCS1C
04037          MOVE SPACES                  TO MAP-RELATIONSHIP-CD      DTSCS1C
04038      END-IF.                                                      DTSCS1C
04039                                                                   DTSCS1C
04040  S1000-EXIT. EXIT.                                                DTSCS1C
04041      SKIP3                                                        DTSCS1C
04042  S1001-EDIT-KEY.                                                  DTSCS1C
04043      PERFORM S1100-EMP-NO              THRU S1100-EXIT.           DTSCS1C
04044  S1001-EXIT. EXIT.                                                DTSCS1C
04045 /*****************************************************************DTSCS1C
04046 *                                                                 DTSCS1C
04047 ******************************************************************DTSCS1C
04048  S1100-EMP-NO.                                                    DTSCS1C
04049      MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA.                  DTSCS1C
04050                                                                   DTSCS1C
04051      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS1C
04052                                                                   DTSCS1C
04053      IF L018-NO-ENTRY                                             DTSCS1C
04054         MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA                  DTSCS1C
04055         PERFORM S1101-ERROR THRU S1101-EXIT                       DTSCS1C
04056         GO TO S1100-EXIT.                                         DTSCS1C
04057                                                                   DTSCS1C
04058      IF L018-NOT-VALID                                            DTSCS1C
04059         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS1C
04060         PERFORM S1101-ERROR THRU S1101-EXIT                       DTSCS1C
04061         GO TO S1100-EXIT.                                         DTSCS1C
04062                                                                   DTSCS1C
04063      MOVE L018-EMP-NO                TO WRK-EMP-NO.               DTSCS1C
04064  S1100-EXIT. EXIT.                                                DTSCS1C
04065      SKIP3                                                        DTSCS1C
04066  S1101-ERROR.                                                     DTSCS1C
04067      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A            DTSCS1C
04068                                         MAP-EMP-NO-2-A.           DTSCS1C
04069      IF LCCM-NO-MSG                                               DTSCS1C
04070         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS1C
04071         MOVE CATB-CURSOR TO MAP-EMP-NO-1-L                        DTSCS1C
04072         SET CURSOR-SET-YES TO TRUE.                               DTSCS1C
04073  S1101-EXIT. EXIT.                                                DTSCS1C
04074      SKIP3                                                        DTSCS1C
04075  S1190-READ-MPRF.                                                 DTSCS1C
04076      MOVE LOW-VALUES TO MPRF-KEY-AREA.                            DTSCS1C
04077                                                                   DTSCS1C
04078      MOVE WRK-EMP-NO TO MPRF-EMP-NO.                              DTSCS1C
04079                                                                   DTSCS1C
04080      SET MPRF-PRF-88 TO TRUE.                                     DTSCS1C
04081                                                                   DTSCS1C
04082      MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS1C
04083                                                                   DTSCS1C
04084      PERFORM S810-READ THRU S810-EXIT.                            DTSCS1C
04085                                                                   DTSCS1C
04086      IF L810-NO-REC-88                                            DTSCS1C
04087          MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA                    DTSCS1C
04088          PERFORM S1101-ERROR THRU S1101-EXIT                      DTSCS1C
04089      ELSE                                                         DTSCS1C
04090          MOVE MSKL-REC TO MPRF-REC.                               DTSCS1C
04091  S1190-EXIT.                                                      DTSCS1C
04092      EXIT.                                                        DTSCS1C
04093 /*****************************************************************DTSCS1C
04094 *                                                                 DTSCS1C
04095 ******************************************************************DTSCS1C
04096  S1200-PRIMARY-NAME.                                              DTSCS1C
04097      IF MAP-PRIMARY-NAME = SPACES OR LOW-VALUES                   DTSCS1C
04098          MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA                 DTSCS1C
04099          PERFORM S1201-ERROR THRU S1201-EXIT                      DTSCS1C
04100      ELSE                                                         DTSCS1C
04101      IF MAP-PRIMARY-NAME (1:1) = LOW-VALUES OR SPACES             DTSCS1C
04102          MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS1C
04103          PERFORM S1201-ERROR THRU S1201-EXIT                      DTSCS1C
04104      ELSE                                                         DTSCS1C
04105      IF MAP-PRIMARY-NAME = MPRF-ENTITY-NAME                       DTSCS1C
04106          MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA                     DTSCS1C
04107          PERFORM S1201-ERROR THRU S1201-EXIT                      DTSCS1C
04108      ELSE                                                         DTSCS1C
04109          IF MAP-PRIMARY-NAME = MPRF-PRIMARY-NAME                  DTSCS1C
04110             NEXT SENTENCE                                         DTSCS1C
04111          ELSE                                                     DTSCS1C
04112             IF NOT MAP-VERIFY-YES-88                              DTSCS1C
04113                 PERFORM S1210-CHECK-DUP-NAME THRU S1210-EXIT.     DTSCS1C
04114  S1200-EXIT.                                                      DTSCS1C
04115      EXIT.                                                        DTSCS1C
04116      SKIP3                                                        DTSCS1C
04117  S1201-ERROR.                                                     DTSCS1C
04118      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-VERIFY-A.              DTSCS1C
04119      MOVE CATB-ASKIP-BRT-MDTOFF     TO MAP-VERIFY-LIT-A.          DTSCS1C
04120      MOVE 'VERIFY?'                 TO MAP-VERIFY-LIT.            DTSCS1C
04121                                                                   DTSCS1C
04122      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-PRIMARY-NAME-A.        DTSCS1C
04123                                                                   DTSCS1C
04124      IF LCCM-NO-MSG                                               DTSCS1C
04125          MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                       DTSCS1C
04126          MOVE CATB-CURSOR TO MAP-PRIMARY-NAME-L                   DTSCS1C
04127          SET CURSOR-SET-YES TO TRUE.                              DTSCS1C
04128  S1201-EXIT.                                                      DTSCS1C
04129      EXIT.                                                        DTSCS1C
04130  S1210-CHECK-DUP-NAME.                                            DTSCS1C
04131      MOVE LOW-VALUES TO IBTB-REC.                                 DTSCS1C
04132      SET IBTB-BTB-88 TO TRUE.                                     DTSCS1C
04133      MOVE MAP-PRIMARY-NAME   TO IBTB-NAME.                        DTSCS1C
04134      MOVE IBTB-KEY-AREA TO ISKL-KEY-AREA.                         DTSCS1C
04135                                                                   DTSCS1C
04136      PERFORM S821-START-BROWSE THRU S821-EXIT.                    DTSCS1C
04137      IF L821-NO-REC-88                                            DTSCS1C
04138          NEXT SENTENCE                                            DTSCS1C
04139      ELSE                                                         DTSCS1C
04140          IF ISKL-BTB-88                                           DTSCS1C
04141              MOVE ISKL-REC   TO IBTB-REC                          DTSCS1C
04142              IF (IBTB-NAME = MAP-PRIMARY-NAME                     DTSCS1C
04143              AND IBTB-EMP-NO NOT = WRK-EMP-NO)                    DTSCS1C
04144                  MOVE MSG-E1CP-AREA       TO WRK-MSG-AREA         DTSCS1C
04145                  PERFORM S1211-ERROR THRU S1211-EXIT              DTSCS1C
04146              END-IF                                               DTSCS1C
04147          END-IF                                                   DTSCS1C
04148      END-IF.                                                      DTSCS1C
04149                                                                   DTSCS1C
04150      PERFORM S821-END-BROWSE THRU S821-EXIT.                      DTSCS1C
04151                                                                   DTSCS1C
04152  S1210-EXIT.                                                      DTSCS1C
04153      EXIT.                                                        DTSCS1C
04154                                                                   DTSCS1C
04155  S1211-ERROR.                                                     DTSCS1C
04156      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-PRIMARY-NAME-A.        DTSCS1C
04157                                                                   DTSCS1C
04158      IF LCCM-NO-MSG                                               DTSCS1C
04159         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS1C
04160         MOVE CATB-CURSOR TO MAP-PRIMARY-NAME-L                    DTSCS1C
04161         SET CURSOR-SET-YES TO TRUE                                DTSCS1C
04162         IF LCCM-OP-IS-FLD-DESK-88                                 DTSCS1C
04163         OR LCCM-OP-IS-ACCOUNTING-DESK-88                          DTSCS1C
04164            MOVE CATB-CURSOR TO MAP-VERIFY-L                       DTSCS1C
04165            MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-VERIFY-A         DTSCS1C
04166            MOVE CATB-ASKIP-BRT-MDTOFF     TO MAP-VERIFY-LIT-A     DTSCS1C
04167            MOVE 'VERIFY?'                 TO MAP-VERIFY-LIT       DTSCS1C
04168         END-IF                                                    DTSCS1C
04169      END-IF.                                                      DTSCS1C
04170                                                                   DTSCS1C
04171  S1211-EXIT.                                                      DTSCS1C
04172      EXIT.                                                        DTSCS1C
04173 /*****************************************************************DTSCS1C
04174 *                                                                 DTSCS1C
04175 ******************************************************************DTSCS1C
04176  S1300-EDIT-ADDRESS.                                              DTSCS1C
04177      MOVE LOW-VALUES TO MAP-CASS-CD.                              DTSCS1C
04178                                                                   DTSCS1C
04179      IF MAP-ATTN-LINE = SPACES OR LOW-VALUES                      DTSCS1C
04180          MOVE SPACES TO MAP-ATTN-LINE.                            DTSCS1C
04181                                                                   DTSCS1C
04182      IF MAP-DELIV-LINE-1 = SPACES OR LOW-VALUES                   DTSCS1C
04183          MOVE SPACES TO MAP-DELIV-LINE-1.                         DTSCS1C
04184                                                                   DTSCS1C
04185      IF MAP-DELIV-LINE-2 = SPACES OR LOW-VALUES                   DTSCS1C
04186          MOVE SPACES TO MAP-DELIV-LINE-2.                         DTSCS1C
04187                                                                   DTSCS1C
04188      IF MAP-CASS-IND = SPACES OR LOW-VALUES                       DTSCS1C
04189          MOVE SPACES TO MAP-CASS-IND.                             DTSCS1C
04190                                                                   DTSCS1C
04191      IF MAP-CITY = SPACES OR LOW-VALUES                           DTSCS1C
04192          MOVE SPACES TO MAP-CITY.                                 DTSCS1C
04193                                                                   DTSCS1C
04194      IF MAP-ST = SPACES OR LOW-VALUES                             DTSCS1C
04195          MOVE SPACES TO MAP-ST.                                   DTSCS1C
04196                                                                   DTSCS1C
04197      IF MAP-ZIP = SPACES OR LOW-VALUES                            DTSCS1C
04198          MOVE SPACES TO MAP-ZIP.                                  DTSCS1C
04199                                                                   DTSCS1C
04200                                                                   DTSCS1C
04201      MOVE MAP-CASS-IND TO L072-CASS-IND.                          DTSCS1C
04202                                                                   DTSCS1C
04203      SET L072-MTAD-88 TO TRUE.                                    DTSCS1C
04204                                                                   DTSCS1C
04205      MOVE MAP-PRIMARY-NAME TO L072-NAME.                          DTSCS1C
04206                                                                   DTSCS1C
04207      MOVE SPACES TO L072-ADDRESS.                                 DTSCS1C
04208                                                                   DTSCS1C
04209      MOVE MAP-ATTN-LINE TO L072-ATTN-LINE.                        DTSCS1C
04210                                                                   DTSCS1C
04211      MOVE MAP-DELIV-LINE-1 TO L072-DELIV-LINE-1.                  DTSCS1C
04212                                                                   DTSCS1C
04213      MOVE MAP-DELIV-LINE-2 TO L072-DELIV-LINE-2.                  DTSCS1C
04214                                                                   DTSCS1C
04215      MOVE MAP-CITY TO L072-CITY.                                  DTSCS1C
04216                                                                   DTSCS1C
04217      MOVE MAP-ST TO L072-ST.                                      DTSCS1C
04218                                                                   DTSCS1C
04219      MOVE MAP-ZIP TO L072-ZIP.                                    DTSCS1C
04220                                                                   DTSCS1C
04221                                                                   DTSCS1C
04222      MOVE LOW-VALUES TO MTAD-KEY-AREA.                            DTSCS1C
04223                                                                   DTSCS1C
04224      MOVE WRK-EMP-NO TO MTAD-EMP-NO.                              DTSCS1C
04225                                                                   DTSCS1C
04226      SET MTAD-TAD-88 TO TRUE.                                     DTSCS1C
04227                                                                   DTSCS1C
04228      SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE.                     DTSCS1C
04229                                                                   DTSCS1C
04230      MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS1C
04231                                                                   DTSCS1C
04232      PERFORM S810-READ THRU S810-EXIT.                            DTSCS1C
04233                                                                   DTSCS1C
04234      IF L810-OK-88                                                DTSCS1C
04235          MOVE MSKL-REC TO MTAD-REC                                DTSCS1C
04236          SET WRK-MTAD-YES-88 TO TRUE                              DTSCS1C
04237          IF (L072-ATTN-LINE = MTAD-ATTN-LINE)                     DTSCS1C
04238                AND                                                DTSCS1C
04239             (L072-DELIV-LINE-1 = MTAD-DELIV-LINE-1)               DTSCS1C
04240                AND                                                DTSCS1C
04241             (L072-DELIV-LINE-2 = MTAD-DELIV-LINE-2)               DTSCS1C
04242                AND                                                DTSCS1C
04243             (L072-CITY = MTAD-CITY)                               DTSCS1C
04244                AND                                                DTSCS1C
04245             (L072-ST = MTAD-ST)                                   DTSCS1C
04246                AND                                                DTSCS1C
04247             (L072-ZIP = MTAD-ZIP)                                 DTSCS1C
04248              MOVE MTAD-ADVANCED-BARCODE TO L072-ADVANCED-BARCODE  DTSCS1C
04249              MOVE L072-ADDRESS TO LCCM-HOLD-ADDRESS-1             DTSCS1C
04250              GO TO S1300-EXIT.                                    DTSCS1C
04251                                                                   DTSCS1C
04252                                                                   DTSCS1C
04253      PERFORM S072-ADDRESS-EDIT THRU S072-EXIT.                    DTSCS1C
04254                                                                   DTSCS1C
04255                                                                   DTSCS1C
04256      MOVE L072-CASS-IND TO MAP-CASS-IND.                          DTSCS1C
04257                                                                   DTSCS1C
04258      MOVE L072-CASS-RETURN-CODES TO MAP-CASS-CD.                  DTSCS1C
04259                                                                   DTSCS1C
04260      MOVE L072-ADDRESS TO LCCM-HOLD-ADDRESS-1.                    DTSCS1C
04261                                                                   DTSCS1C
04262                                                                   DTSCS1C
04263      IF L072-ATTN-LINE-NOT-VALID-88                               DTSCS1C
04264          PERFORM S1391-ERROR THRU S1391-EXIT                      DTSCS1C
04265      ELSE                                                         DTSCS1C
04266          MOVE L072-ATTN-LINE TO MAP-ATTN-LINE                     DTSCS1C
04267          IF L072-ATTN-LINE-CHANGED-88                             DTSCS1C
04268              MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ATTN-LINE-A.   DTSCS1C
04269                                                                   DTSCS1C
04270      IF L072-DELIV-LINE-1-NOT-VALID-88                            DTSCS1C
04271          PERFORM S1392-ERROR THRU S1392-EXIT                      DTSCS1C
04272      ELSE                                                         DTSCS1C
04273          MOVE L072-DELIV-LINE-1 TO MAP-DELIV-LINE-1               DTSCS1C
04274          IF L072-DELIV-LINE-1-CHANGED-88                          DTSCS1C
04275              MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DELIV-LINE-1-A.DTSCS1C
04276                                                                   DTSCS1C
04277      IF L072-DELIV-LINE-2-NOT-VALID-88                            DTSCS1C
04278          PERFORM S1393-ERROR THRU S1393-EXIT                      DTSCS1C
04279      ELSE                                                         DTSCS1C
04280          MOVE L072-DELIV-LINE-2 TO MAP-DELIV-LINE-2               DTSCS1C
04281          IF L072-DELIV-LINE-2-CHANGED-88                          DTSCS1C
04282              MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DELIV-LINE-2-A.DTSCS1C
04283                                                                   DTSCS1C
04284      IF L072-CITY-NOT-VALID-88                                    DTSCS1C
04285          PERFORM S1394-ERROR THRU S1394-EXIT                      DTSCS1C
04286      ELSE                                                         DTSCS1C
04287          MOVE L072-CITY TO MAP-CITY                               DTSCS1C
04288          IF L072-CITY-CHANGED-88                                  DTSCS1C
04289              MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-CITY-A.        DTSCS1C
04290                                                                   DTSCS1C
04291      IF L072-ST-NOT-VALID-88                                      DTSCS1C
04292          PERFORM S1395-ERROR THRU S1395-EXIT                      DTSCS1C
04293      ELSE                                                         DTSCS1C
04294          MOVE L072-ST TO MAP-ST                                   DTSCS1C
04295          IF L072-ST-CHANGED-88                                    DTSCS1C
04296              MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ST-A.          DTSCS1C
04297                                                                   DTSCS1C
04298      IF L072-ZIP-NOT-VALID-88                                     DTSCS1C
04299          PERFORM S1396-ERROR THRU S1396-EXIT                      DTSCS1C
04300      ELSE                                                         DTSCS1C
04301          MOVE L072-ZIP TO MAP-ZIP                                 DTSCS1C
04302          IF L072-ZIP-CHANGED-88                                   DTSCS1C
04303              MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ZIP-A.         DTSCS1C
04304                                                                   DTSCS1C
04305      IF L072-ADDRESS-NOT-VALID-88                                 DTSCS1C
04306          IF LCCM-NO-MSG                                           DTSCS1C
04307              PERFORM S1391-ERROR THRU S1391-EXIT.                 DTSCS1C
04308  S1300-EXIT. EXIT.                                                DTSCS1C
04309      SKIP3                                                        DTSCS1C
04310  S1391-ERROR.                                                     DTSCS1C
04311      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ATTN-LINE-A.           DTSCS1C
04312                                                                   DTSCS1C
04313      IF LCCM-NO-MSG                                               DTSCS1C
04314          MOVE L072-MSG-AREA TO LCCM-MSG-AREA                      DTSCS1C
04315          MOVE CATB-CURSOR TO MAP-ATTN-LINE-L                      DTSCS1C
04316          SET CURSOR-SET-YES TO TRUE.                              DTSCS1C
04317  S1391-EXIT.                                                      DTSCS1C
04318      EXIT.                                                        DTSCS1C
04319      SKIP3                                                        DTSCS1C
04320  S1392-ERROR.                                                     DTSCS1C
04321      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DELIV-LINE-1-A.        DTSCS1C
04322                                                                   DTSCS1C
04323      IF LCCM-NO-MSG                                               DTSCS1C
04324          MOVE L072-MSG-AREA TO LCCM-MSG-AREA                      DTSCS1C
04325          MOVE CATB-CURSOR TO MAP-DELIV-LINE-1-L                   DTSCS1C
04326          SET CURSOR-SET-YES TO TRUE.                              DTSCS1C
04327  S1392-EXIT.                                                      DTSCS1C
04328      EXIT.                                                        DTSCS1C
04329      SKIP3                                                        DTSCS1C
04330  S1393-ERROR.                                                     DTSCS1C
04331      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DELIV-LINE-2-A.        DTSCS1C
04332                                                                   DTSCS1C
04333      IF LCCM-NO-MSG                                               DTSCS1C
04334          MOVE L072-MSG-AREA TO LCCM-MSG-AREA                      DTSCS1C
04335          MOVE CATB-CURSOR TO MAP-DELIV-LINE-2-L                   DTSCS1C
04336          SET CURSOR-SET-YES TO TRUE.                              DTSCS1C
04337  S1393-EXIT.                                                      DTSCS1C
04338      EXIT.                                                        DTSCS1C
04339      SKIP3                                                        DTSCS1C
04340  S1394-ERROR.                                                     DTSCS1C
04341      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-CITY-A.                DTSCS1C
04342                                                                   DTSCS1C
04343      IF LCCM-NO-MSG                                               DTSCS1C
04344          MOVE L072-MSG-AREA TO LCCM-MSG-AREA                      DTSCS1C
04345          MOVE CATB-CURSOR TO MAP-CITY-L                           DTSCS1C
04346          SET CURSOR-SET-YES TO TRUE.                              DTSCS1C
04347  S1394-EXIT.                                                      DTSCS1C
04348      EXIT.                                                        DTSCS1C
04349      SKIP3                                                        DTSCS1C
04350  S1395-ERROR.                                                     DTSCS1C
04351      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ST-A.                  DTSCS1C
04352                                                                   DTSCS1C
04353      IF LCCM-NO-MSG                                               DTSCS1C
04354          MOVE L072-MSG-AREA TO LCCM-MSG-AREA                      DTSCS1C
04355          MOVE CATB-CURSOR TO MAP-ST-L                             DTSCS1C
04356          SET CURSOR-SET-YES TO TRUE.                              DTSCS1C
04357  S1395-EXIT.                                                      DTSCS1C
04358      EXIT.                                                        DTSCS1C
04359      SKIP3                                                        DTSCS1C
04360  S1396-ERROR.                                                     DTSCS1C
04361      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ZIP-A.                 DTSCS1C
04362                                                                   DTSCS1C
04363      IF LCCM-NO-MSG                                               DTSCS1C
04364          MOVE L072-MSG-AREA TO LCCM-MSG-AREA                      DTSCS1C
04365          MOVE CATB-CURSOR TO MAP-ZIP-L                            DTSCS1C
04366          SET CURSOR-SET-YES TO TRUE.                              DTSCS1C
04367  S1396-EXIT.                                                      DTSCS1C
04368      EXIT.                                                        DTSCS1C
04369 /*****************************************************************DTSCS1C
04370 *                                                                *DTSCS1C
04371 ******************************************************************DTSCS1C
04372  S1410-VOICE-1.                                                   DTSCS1C
04373      MOVE MAP-VOICE-1-AREA TO L021-S-TNO-AREA.                    DTSCS1C
04374                                                                   DTSCS1C
04375      PERFORM S021-TELNO-FROM-SCREEN THRU S021-EXIT.               DTSCS1C
04376                                                                   DTSCS1C
04377      IF L021-NOT-VALID                                            DTSCS1C
04378         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS1C
04379         PERFORM S1411-ERROR THRU S1411-EXIT                       DTSCS1C
04380      ELSE                                                         DTSCS1C
04381      IF L021-VALID                                                DTSCS1C
04382         MOVE L021-TNO TO L073-TELEPHONE                           DTSCS1C
04383         MOVE MAP-ST TO L073-ST                                    DTSCS1C
04384         MOVE MAP-ZIP TO L073-ZIP                                  DTSCS1C
04385         PERFORM S073-TELNO-EDIT THRU S073-EXIT                    DTSCS1C
04386         IF L073-NOT-VALID                                         DTSCS1C
04387            MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA              DTSCS1C
04388            PERFORM S1411-ERROR THRU S1411-EXIT                    DTSCS1C
04389         ELSE                                                      DTSCS1C
04390            MOVE L073-AREA-CD TO MAP-VOICE-1-AREA-CD               DTSCS1C
04391            MOVE L073-PREFIX TO MAP-VOICE-1-PREFIX                 DTSCS1C
04392            MOVE L073-SUFFIX TO MAP-VOICE-1-SUFFIX                 DTSCS1C
04393            MOVE L073-EXT TO MAP-VOICE-1-EXT.                      DTSCS1C
04394  S1410-EXIT. EXIT.                                                DTSCS1C
04395      SKIP3                                                        DTSCS1C
04396  S1411-ERROR.                                                     DTSCS1C
04397      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-VOICE-1-AREA-CD-A     DTSCS1C
04398                                       MAP-VOICE-1-PREFIX-A        DTSCS1C
04399                                       MAP-VOICE-1-SUFFIX-A        DTSCS1C
04400                                       MAP-VOICE-1-EXT-A.          DTSCS1C
04401                                                                   DTSCS1C
04402      IF LCCM-NO-MSG                                               DTSCS1C
04403         MOVE WRK-MSG-AREA  TO LCCM-MSG-AREA                       DTSCS1C
04404         MOVE CATB-CURSOR   TO MAP-VOICE-1-AREA-CD-L               DTSCS1C
04405         SET CURSOR-SET-YES TO TRUE.                               DTSCS1C
04406  S1411-EXIT. EXIT.                                                DTSCS1C
04407 /*****************************************************************DTSCS1C
04408 *                                                                *DTSCS1C
04409 ******************************************************************DTSCS1C
04410  S1420-VOICE-2.                                                   DTSCS1C
04411      MOVE MAP-VOICE-2-AREA TO L021-S-TNO-AREA.                    DTSCS1C
04412                                                                   DTSCS1C
04413      PERFORM S021-TELNO-FROM-SCREEN THRU S021-EXIT.               DTSCS1C
04414                                                                   DTSCS1C
04415      IF L021-NOT-VALID                                            DTSCS1C
04416         MOVE EMSG-FIELD-NOT-VALID    TO WRK-MSG-AREA              DTSCS1C
04417         PERFORM S1421-ERROR          THRU S1421-EXIT              DTSCS1C
04418      ELSE                                                         DTSCS1C
04419      IF L021-VALID                                                DTSCS1C
04420         MOVE L021-TNO TO L073-TELEPHONE                           DTSCS1C
04421         MOVE MAP-ST TO L073-ST                                    DTSCS1C
04422         MOVE MAP-ZIP TO L073-ZIP                                  DTSCS1C
04423         PERFORM S073-TELNO-EDIT THRU S073-EXIT                    DTSCS1C
04424         IF L073-NOT-VALID                                         DTSCS1C
04425            MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA              DTSCS1C
04426            PERFORM S1421-ERROR THRU S1421-EXIT                    DTSCS1C
04427         ELSE                                                      DTSCS1C
04428            MOVE L073-AREA-CD TO MAP-VOICE-2-AREA-CD               DTSCS1C
04429            MOVE L073-PREFIX TO MAP-VOICE-2-PREFIX                 DTSCS1C
04430            MOVE L073-SUFFIX TO MAP-VOICE-2-SUFFIX                 DTSCS1C
04431            MOVE L073-EXT TO MAP-VOICE-2-EXT.                      DTSCS1C
04432  S1420-EXIT. EXIT.                                                DTSCS1C
04433      SKIP3                                                        DTSCS1C
04434  S1421-ERROR.                                                     DTSCS1C
04435      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-VOICE-2-AREA-CD-A     DTSCS1C
04436                                         MAP-VOICE-2-PREFIX-A      DTSCS1C
04437                                         MAP-VOICE-2-SUFFIX-A      DTSCS1C
04438                                         MAP-VOICE-2-EXT-A.        DTSCS1C
04439                                                                   DTSCS1C
04440      IF LCCM-NO-MSG                                               DTSCS1C
04441         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS1C
04442         MOVE CATB-CURSOR TO MAP-VOICE-2-AREA-CD-L                 DTSCS1C
04443         SET CURSOR-SET-YES TO TRUE.                               DTSCS1C
04444  S1421-EXIT. EXIT.                                                DTSCS1C
04445 /*****************************************************************DTSCS1C
04446 *                                                                *DTSCS1C
04447 ******************************************************************DTSCS1C
04448  S1430-FAX.                                                       DTSCS1C
04449      MOVE MAP-FAX-AREA TO L021-S-TNO-AREA.                        DTSCS1C
04450                                                                   DTSCS1C
04451      PERFORM S021-TELNO-FROM-SCREEN THRU S021-EXIT.               DTSCS1C
04452                                                                   DTSCS1C
04453      IF L021-NOT-VALID                                            DTSCS1C
04454         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS1C
04455         PERFORM S1431-ERROR THRU S1431-EXIT                       DTSCS1C
04456      ELSE                                                         DTSCS1C
04457      IF L021-VALID                                                DTSCS1C
04458         MOVE L021-TNO TO L073-TELEPHONE                           DTSCS1C
04459         MOVE MAP-ST TO L073-ST                                    DTSCS1C
04460         MOVE MAP-ZIP TO L073-ZIP                                  DTSCS1C
04461         PERFORM S073-TELNO-EDIT THRU S073-EXIT                    DTSCS1C
04462         IF L073-NOT-VALID                                         DTSCS1C
04463            MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA              DTSCS1C
04464            PERFORM S1431-ERROR THRU S1431-EXIT                    DTSCS1C
04465         ELSE                                                      DTSCS1C
04466            MOVE L073-AREA-CD TO MAP-FAX-AREA-CD                   DTSCS1C
04467            MOVE L073-PREFIX TO MAP-FAX-PREFIX                     DTSCS1C
04468            MOVE L073-SUFFIX TO MAP-FAX-SUFFIX                     DTSCS1C
04469            MOVE L073-EXT TO MAP-FAX-EXT.                          DTSCS1C
04470  S1430-EXIT. EXIT.                                                DTSCS1C
04471      SKIP3                                                        DTSCS1C
04472  S1431-ERROR.                                                     DTSCS1C
04473      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-FAX-AREA-CD-A         DTSCS1C
04474                                       MAP-FAX-PREFIX-A            DTSCS1C
04475                                       MAP-FAX-SUFFIX-A            DTSCS1C
04476                                       MAP-FAX-EXT-A.              DTSCS1C
04477                                                                   DTSCS1C
04478      IF LCCM-NO-MSG                                               DTSCS1C
04479         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS1C
04480         MOVE CATB-CURSOR TO MAP-FAX-AREA-CD-L                     DTSCS1C
04481         SET CURSOR-SET-YES TO TRUE.                               DTSCS1C
04482  S1431-EXIT. EXIT.                                                DTSCS1C
04483 /*****************************************************************DTSCS1C
04484 * REQUIRED IN ALL CASES BUT MAY BE DEFAULT OF UNK                *DTSCS1C
04485 ******************************************************************DTSCS1C
04486  S1700-ORG-TYPE.                                                  DTSCS1C
04487      IF MAP-ORG-TYPE = LOW-VALUES OR SPACES                       DTSCS1C
04488         SET MAP-ORG-TYPE-UNK TO TRUE.                             DTSCS1C
04489                                                                   DTSCS1C
04490      IF MAP-ORG-TYPE-UNK                                          DTSCS1C
04491         GO TO S1700-EXIT.                                         DTSCS1C
04492                                                                   DTSCS1C
04493      IF MAP-ORG-TYPE-WAS-UNK                                      DTSCS1C
04494         MOVE SPACES TO MAP-ORG-TYPE-EXT.                          DTSCS1C
04495                                                                   DTSCS1C
04496      MOVE MAP-ORG-TYPE TO L031-CD.                                DTSCS1C
04497                                                                   DTSCS1C
04498      SET L031-MPRF-ORG-TYPE TO TRUE.                              DTSCS1C
04499                                                                   DTSCS1C
04500      PERFORM S031-REG-CODES THRU S031-EXIT.                       DTSCS1C
04501                                                                   DTSCS1C
04502      IF L031-NOT-VALID                                            DTSCS1C
04503         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS1C
04504         PERFORM S1701-ERROR THRU S1701-EXIT.                      DTSCS1C
04505  S1700-EXIT. EXIT.                                                DTSCS1C
04506      SKIP3                                                        DTSCS1C
04507  S1701-ERROR.                                                     DTSCS1C
04508      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ORG-TYPE-A.            DTSCS1C
04509      IF LCCM-NO-MSG                                               DTSCS1C
04510         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS1C
04511         MOVE CATB-CURSOR TO MAP-ORG-TYPE-L                        DTSCS1C
04512         SET CURSOR-SET-YES TO TRUE.                               DTSCS1C
04513  S1701-EXIT. EXIT.                                                DTSCS1C
04514 /*****************************************************************DTSCS1C
04515 *                                                                *DTSCS1C
04516 ******************************************************************DTSCS1C
04517  S1800-FEIN.                                                      DTSCS1C
04518      MOVE MAP-FEIN-AREA TO L017-S-FEIN-AREA.                      DTSCS1C
04519                                                                   DTSCS1C
04520      PERFORM S017-FEIN-FROM-SCREEN THRU S017-EXIT.                DTSCS1C
04521                                                                   DTSCS1C
04522      IF L017-NOT-VALID                                            DTSCS1C
04523         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS1C
04524         PERFORM S1801-ERROR THRU S1801-EXIT                       DTSCS1C
04525         GO TO S1800-EXIT.                                         DTSCS1C
04526                                                                   DTSCS1C
04527      IF L017-NO-ENTRY                                             DTSCS1C
04528          GO TO S1800-EXIT.                                        DTSCS1C
04529                                                                   DTSCS1C
04530      IF (MAP-UI-LIABLE-YES-88)                                    DTSCS1C
04531             AND                                                   DTSCS1C
04532         (MAP-INACT-CD = SPACES OR LOW-VALUES)                     DTSCS1C
04533          SET L074-ACTIVE-DUP-88 TO TRUE                           DTSCS1C
04534          MOVE WRK-EMP-NO TO L074-EMP-NO                           DTSCS1C
04535          PERFORM S1810-INACTIVE-EMP-NO THRU S1810-EXIT            DTSCS1C
04536          MOVE L017-FEIN TO L074-FEIN                              DTSCS1C
04537          PERFORM S074-DUP-FEIN-EDIT THRU S074-EXIT                DTSCS1C
04538          IF L074-DUP-NOT-OK-88                                    DTSCS1C
04539              MOVE EMSG-DUPLICATE-FEIN TO WRK-MSG-AREA             DTSCS1C
04540              PERFORM S1801-ERROR THRU S1801-EXIT                  DTSCS1C
04541          ELSE                                                     DTSCS1C
04542              IF L074-DUP-STAT-UNK-88                              DTSCS1C
04543                  MOVE MSG-E1CO-AREA       TO WRK-MSG-AREA         DTSCS1C
04544                  PERFORM S1801-ERROR THRU S1801-EXIT              DTSCS1C
04545              END-IF                                               DTSCS1C
04546          END-IF                                                   DTSCS1C
04547      END-IF.                                                      DTSCS1C
04548                                                                   DTSCS1C
04549  S1800-EXIT. EXIT.                                                DTSCS1C
04550      SKIP3                                                        DTSCS1C
04551  S1801-ERROR.                                                     DTSCS1C
04552      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-FEIN-1-A              DTSCS1C
04553                                       MAP-FEIN-2-A.               DTSCS1C
04554                                                                   DTSCS1C
04555      IF LCCM-NO-MSG                                               DTSCS1C
04556         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS1C
04557         MOVE CATB-CURSOR TO MAP-FEIN-1-L                          DTSCS1C
04558         SET CURSOR-SET-YES TO TRUE.                               DTSCS1C
04559  S1801-EXIT. EXIT.                                                DTSCS1C
04560      SKIP3                                                        DTSCS1C
04561  S1810-INACTIVE-EMP-NO.                                           DTSCS1C
04562      MOVE +0 TO L074-INACTIVE-EMP-NO.                             DTSCS1C
04563                                                                   DTSCS1C
04564      IF MAP-PRED-INACT-CD = SPACES OR LOW-VALUES                  DTSCS1C
04565          GO TO S1810-EXIT.                                        DTSCS1C
04566                                                                   DTSCS1C
04567      MOVE MAP-PRED-EMP-NO-AREA TO L018-S-EMP-NO-AREA.             DTSCS1C
04568                                                                   DTSCS1C
04569      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS1C
04570                                                                   DTSCS1C
04571      IF L018-VALID                                                DTSCS1C
04572          MOVE L018-EMP-NO TO L074-INACTIVE-EMP-NO.                DTSCS1C
04573  S1810-EXIT.                                                      DTSCS1C
04574      EXIT.                                                        DTSCS1C
04575 /*****************************************************************DTSCS1C
04576 *                                                                *DTSCS1C
04577 ******************************************************************DTSCS1C
04578  S2100-UI-LIABLE-IND.                                             DTSCS1C
04579      IF MAP-UI-LIABLE-IND = LOW-VALUES                            DTSCS1C
04580          MOVE SPACES TO MAP-UI-LIABLE-IND.                        DTSCS1C
04581                                                                   DTSCS1C
04582      IF MAP-UI-LIABLE-IND = SPACES                                DTSCS1C
04583         MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA                  DTSCS1C
04584         PERFORM S2101-ERROR THRU S2101-EXIT                       DTSCS1C
04585      ELSE                                                         DTSCS1C
04586      IF MAP-UI-LIABLE-VALID-88                                    DTSCS1C
04587         NEXT SENTENCE                                             DTSCS1C
04588      ELSE                                                         DTSCS1C
04589         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS1C
04590         PERFORM S2101-ERROR THRU S2101-EXIT.                      DTSCS1C
04591                                                                   DTSCS1C
04592      IF MAP-UI-LIABLE-YES-88                                      DTSCS1C
04593          PERFORM S2110-CHECK-WRITTEN-OFF THRU S2110-EXIT.         DTSCS1C
04594                                                                   DTSCS1C
04595  S2100-EXIT. EXIT.                                                DTSCS1C
04596      SKIP3                                                        DTSCS1C
04597  S2101-ERROR.                                                     DTSCS1C
04598      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-UI-LIABLE-IND-A.       DTSCS1C
04599                                                                   DTSCS1C
04600      IF LCCM-NO-MSG                                               DTSCS1C
04601         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS1C
04602         MOVE CATB-CURSOR TO MAP-UI-LIABLE-IND-L                   DTSCS1C
04603         SET CURSOR-SET-YES TO TRUE.                               DTSCS1C
04604  S2101-EXIT. EXIT.                                                DTSCS1C
04605      SKIP3                                                        DTSCS1C
04606  S2110-CHECK-WRITTEN-OFF.                                         DTSCS1C
04607      IF MPRF-NOT-WRITTEN-OFF-88                                   DTSCS1C
04608          NEXT SENTENCE                                            DTSCS1C
04609      ELSE                                                         DTSCS1C
04610          MOVE EMSG-EMP-WRITTEN-OFF TO WRK-MSG-AREA                DTSCS1C
04611          PERFORM S2101-ERROR THRU S2101-EXIT.                     DTSCS1C
04612  S2110-EXIT.                                                      DTSCS1C
04613      EXIT.                                                        DTSCS1C
04614                                                                   DTSCS1C
04615 /*****************************************************************DTSCS1C
04616 *  ENSURE THAT A LOCAL DC ADDRESS IS ON FILE BEFORE ALLOWING     *DTSCS1C
04617 *  A LIABLE DETERMINATION, IF THAT DETERMINATION IS BASED ON     *DTSCS1C
04618 *  AN FR-500.                                                    *DTSCS1C
04619 ******************************************************************DTSCS1C
04620  S2150-CHK-FOR-DC-ADDR.                                           DTSCS1C
04621      SET WRK-DC-ADDR-NO-88  TO TRUE.                              DTSCS1C
04622      SET WRK-PO-BOX-NO-88   TO TRUE.                              DTSCS1C
04623                                                                   DTSCS1C
04624      IF MAP-VERIFY-YES-88                                         DTSCS1C
04625 **   AND (LCCM-OP-IS-FLD-DESK-88                                  DTSCS1C
04626 **   OR LCCM-OP-IS-ACCOUNTING-DESK-88)                            DTSCS1C
04627         GO TO S2150-EXIT                                          DTSCS1C
04628      END-IF.                                                      DTSCS1C
04629                                                                   DTSCS1C
04630      IF NOT MAP-UI-LIABLE-YES-88                                  DTSCS1C
04631         GO TO S2150-EXIT                                          DTSCS1C
04632      END-IF.                                                      DTSCS1C
04633                                                                   DTSCS1C
04634      IF WRK-MERA-NONE-88                                          DTSCS1C
04635         NEXT SENTENCE                                             DTSCS1C
04636      ELSE                                                         DTSCS1C
04637         IF MERA-SOURCE-VOL-88                                     DTSCS1C
04638         OR MERA-RECEIVED-DATE > ZERO                              DTSCS1C
04639            NEXT SENTENCE                                          DTSCS1C
04640         ELSE                                                      DTSCS1C
04641            GO TO S2150-EXIT                                       DTSCS1C
04642         END-IF                                                    DTSCS1C
04643      END-IF.                                                      DTSCS1C
04644                                                                   DTSCS1C
04645      IF MAP-ST                         = 'DC'                     DTSCS1C
04646         SET WRK-DC-ADDR-YES-88        TO TRUE                     DTSCS1C
04647         IF MAP-DELIV-LINE-1(1:6)       = 'PO BOX'                 DTSCS1C
04648         OR MAP-DELIV-LINE-2(1:6)       = 'PO BOX'                 DTSCS1C
04649         OR MAP-DELIV-LINE-1(1:7)       = 'P O BOX'                DTSCS1C
04650         OR MAP-DELIV-LINE-2(1:7)       = 'P O BOX'                DTSCS1C
04651            SET WRK-PO-BOX-YES-88      TO TRUE                     DTSCS1C
04652         ELSE                                                      DTSCS1C
04653            GO TO S2150-EXIT                                       DTSCS1C
04654         END-IF                                                    DTSCS1C
04655      END-IF.                                                      DTSCS1C
04656                                                                   DTSCS1C
04657      MOVE LOW-VALUES                  TO MTAD-KEY-AREA.           DTSCS1C
04658      MOVE WRK-EMP-NO                  TO MTAD-EMP-NO.             DTSCS1C
04659      SET MTAD-TAD-88                  TO TRUE.                    DTSCS1C
04660      SET MTAD-ID-TAX-RECORDS-ADDR-88  TO TRUE.                    DTSCS1C
04661      MOVE MTAD-KEY-AREA               TO MSKL-KEY-AREA.           DTSCS1C
04662      PERFORM S810-READ                THRU S810-EXIT.             DTSCS1C
04663      IF L810-NO-REC-88                                            DTSCS1C
04664         IF WRK-DC-ADDR-NO-88                                      DTSCS1C
04665            MOVE MSG-E1CQ-AREA            TO WRK-MSG-AREA          DTSCS1C
04666            PERFORM S2151-ERROR           THRU S2151-EXIT          DTSCS1C
04667            GO TO S2150-EXIT                                       DTSCS1C
04668         ELSE                                                      DTSCS1C
04669            IF WRK-PO-BOX-YES-88                                   DTSCS1C
04670               MOVE MSG-E1CR-AREA         TO WRK-MSG-AREA          DTSCS1C
04671               PERFORM S2151-ERROR        THRU S2151-EXIT          DTSCS1C
04672               GO TO S2150-EXIT                                    DTSCS1C
04673            END-IF                                                 DTSCS1C
04674         END-IF                                                    DTSCS1C
04675      END-IF.                                                      DTSCS1C
04676                                                                   DTSCS1C
04677      MOVE MSKL-REC                       TO MTAD-REC.             DTSCS1C
04678      IF MTAD-ST                           = 'DC'                  DTSCS1C
04679         IF MTAD-DELIV-LINE-1(1:6)         = 'PO BOX'              DTSCS1C
04680         OR MTAD-DELIV-LINE-2(1:6)         = 'PO BOX'              DTSCS1C
04681         OR MTAD-DELIV-LINE-1(1:7)         = 'P O BOX'             DTSCS1C
04682         OR MTAD-DELIV-LINE-2(1:7)         = 'P O BOX'             DTSCS1C
04683            MOVE MSG-E1CR-AREA            TO WRK-MSG-AREA          DTSCS1C
04684            PERFORM S2151-ERROR           THRU S2151-EXIT          DTSCS1C
04685         ELSE                                                      DTSCS1C
04686            GO TO S2150-EXIT                                       DTSCS1C
04687         END-IF                                                    DTSCS1C
04688      ELSE                                                         DTSCS1C
04689         MOVE MSG-E1CQ-AREA         TO WRK-MSG-AREA                DTSCS1C
04690         PERFORM S2151-ERROR        THRU S2151-EXIT                DTSCS1C
04691      END-IF.                                                      DTSCS1C
04692                                                                   DTSCS1C
04693  S2150-EXIT.                                                      DTSCS1C
04694      EXIT.                                                        DTSCS1C
04695                                                                   DTSCS1C
04696  S2151-ERROR.                                                     DTSCS1C
04697 ***  >> MODIFIED TO ALLOW STAFF TO BYPASS EDIT WITHOUT            DTSCS1C
04698 ***  >> SUPERVISOR APPROVAL.                                      DTSCS1C
04699      MOVE CATB-CURSOR TO MAP-VERIFY-L.                            DTSCS1C
04700      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-VERIFY-A.              DTSCS1C
04701      MOVE CATB-ASKIP-BRT-MDTOFF     TO MAP-VERIFY-LIT-A.          DTSCS1C
04702      MOVE 'VERIFY?'                 TO MAP-VERIFY-LIT.            DTSCS1C
04703                                                                   DTSCS1C
04704 ***  MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-UI-LIABLE-IND-A.       DTSCS1C
04705                                                                   DTSCS1C
04706      IF LCCM-NO-MSG                                               DTSCS1C
04707         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS1C
04708         MOVE CATB-CURSOR TO MAP-UI-LIABLE-IND-L                   DTSCS1C
04709         SET CURSOR-SET-YES TO TRUE                                DTSCS1C
04710 ***     IF LCCM-OP-IS-FLD-DESK-88                                 DTSCS1C
04711 *       OR LCCM-OP-IS-ACCOUNTING-DESK-88                          DTSCS1C
04712 *          MOVE CATB-CURSOR TO MAP-VERIFY-L                       DTSCS1C
04713 *          MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-VERIFY-A         DTSCS1C
04714 *          MOVE CATB-ASKIP-BRT-MDTOFF     TO MAP-VERIFY-LIT-A     DTSCS1C
04715 *          MOVE 'VERIFY?'                 TO MAP-VERIFY-LIT       DTSCS1C
04716 ***     END-IF                                                    DTSCS1C
04717      END-IF.                                                      DTSCS1C
04718  S2151-EXIT. EXIT.                                                DTSCS1C
04719      SKIP3                                                        DTSCS1C
04720 /*****************************************************************DTSCS1C
04721 *                                                                *DTSCS1C
04722 ******************************************************************DTSCS1C
04723  S2200-NOT-LIABLE-LTR-TYPE.                                       DTSCS1C
04724      IF MAP-NOT-LIABLE-LTR-TYPE = LOW-VALUES                      DTSCS1C
04725          MOVE SPACES TO MAP-NOT-LIABLE-LTR-TYPE.                  DTSCS1C
04726                                                                   DTSCS1C
04727      IF MAP-UI-LIABLE-YES-88                                      DTSCS1C
04728          IF MAP-NOT-LIABLE-LTR-TYPE = SPACES                      DTSCS1C
04729              NEXT SENTENCE                                        DTSCS1C
04730          ELSE                                                     DTSCS1C
04731              MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA          DTSCS1C
04732              PERFORM S2201-ERROR THRU S2201-EXIT                  DTSCS1C
04733      ELSE                                                         DTSCS1C
04734      IF MAP-UI-LIABLE-NO-88                                       DTSCS1C
04735          IF MAP-NOT-LIABLE-LTR-TYPE = SPACES                      DTSCS1C
04736              SET MAP-NOT-LIABLE-LTR-REGULAR-88 TO TRUE            DTSCS1C
04737          ELSE                                                     DTSCS1C
04738          IF MAP-NOT-LIABLE-LTR-VALID-88                           DTSCS1C
04739              NEXT SENTENCE                                        DTSCS1C
04740          ELSE                                                     DTSCS1C
04741              MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA            DTSCS1C
04742              PERFORM S2201-ERROR THRU S2201-EXIT.                 DTSCS1C
04743  S2200-EXIT. EXIT.                                                DTSCS1C
04744      SKIP3                                                        DTSCS1C
04745  S2201-ERROR.                                                     DTSCS1C
04746      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-NOT-LIABLE-LTR-TYPE-A. DTSCS1C
04747                                                                   DTSCS1C
04748      IF LCCM-NO-MSG                                               DTSCS1C
04749         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS1C
04750         MOVE CATB-CURSOR TO MAP-NOT-LIABLE-LTR-TYPE-L             DTSCS1C
04751         SET CURSOR-SET-YES TO TRUE.                               DTSCS1C
04752  S2201-EXIT. EXIT.                                                DTSCS1C
04753 /*****************************************************************DTSCS1C
04754 * DATE ONLY IF LIABLE = N - OPTIONAL                             *DTSCS1C
04755 ******************************************************************DTSCS1C
04756  S2300-FOLLOWUP-DATE.                                             DTSCS1C
04757      MOVE MAP-FOLLOWUP-DATE-AREA TO L015-S-DATE-AREA.             DTSCS1C
04758                                                                   DTSCS1C
04759      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS1C
04760                                                                   DTSCS1C
04761      IF L015-NO-ENTRY                                             DTSCS1C
04762         NEXT SENTENCE                                             DTSCS1C
04763      ELSE                                                         DTSCS1C
04764      IF MAP-UI-LIABLE-YES-88                                      DTSCS1C
04765         MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA               DTSCS1C
04766         PERFORM S2301-ERROR THRU S2301-EXIT                       DTSCS1C
04767      ELSE                                                         DTSCS1C
04768      IF L015-NOT-VALID                                            DTSCS1C
04769         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS1C
04770         PERFORM S2301-ERROR THRU S2301-EXIT                       DTSCS1C
04771      ELSE                                                         DTSCS1C
04772      IF L015-DATE NOT > LCCM-CURR-RUN-DATE                        DTSCS1C
04773         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS1C
04774         PERFORM S2301-ERROR THRU S2301-EXIT.                      DTSCS1C
04775  S2300-EXIT. EXIT.                                                DTSCS1C
04776      SKIP3                                                        DTSCS1C
04777  S2301-ERROR.                                                     DTSCS1C
04778      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-FOLLOWUP-MO-A         DTSCS1C
04779                                         MAP-FOLLOWUP-DA-A         DTSCS1C
04780                                         MAP-FOLLOWUP-YR-A         DTSCS1C
04781                                                                   DTSCS1C
04782      IF LCCM-NO-MSG                                               DTSCS1C
04783         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS1C
04784         MOVE CATB-CURSOR TO MAP-FOLLOWUP-MO-L                     DTSCS1C
04785         SET CURSOR-SET-YES TO TRUE.                               DTSCS1C
04786  S2301-EXIT. EXIT.                                                DTSCS1C
04787 /*****************************************************************DTSCS1C
04788 *                                                                 DTSCS1C
04789 ******************************************************************DTSCS1C
04790  S2400-EMP-CLASS.                                                 DTSCS1C
04791      MOVE MPRF-EMP-CLASS TO WRK-EMP-CLASS.                        DTSCS1C
04792                                                                   DTSCS1C
04793      IF MPRF-CLASS-SUB-88                                         DTSCS1C
04794          MOVE MPRF-EMP-CLASS TO MAP-EMP-CLASS                     DTSCS1C
04795          MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-CLASS-A             DTSCS1C
04796          GO TO S2400-EXIT.                                        DTSCS1C
04797                                                                   DTSCS1C
04798      IF MAP-EMP-CLASS = LOW-VALUES                                DTSCS1C
04799          MOVE SPACES TO MAP-EMP-CLASS.                            DTSCS1C
04800                                                                   DTSCS1C
04801      IF MAP-UI-LIABLE-YES-88                                      DTSCS1C
04802          IF MAP-EMP-CLASS = SPACES                                DTSCS1C
04803              MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA             DTSCS1C
04804              PERFORM S2401-ERROR THRU S2401-EXIT                  DTSCS1C
04805          ELSE                                                     DTSCS1C
04806          IF MAP-EMP-CLASS-VALID-88                                DTSCS1C
04807              MOVE MAP-EMP-CLASS TO WRK-EMP-CLASS                  DTSCS1C
04808          ELSE                                                     DTSCS1C
04809              MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA            DTSCS1C
04810              PERFORM S2401-ERROR THRU S2401-EXIT                  DTSCS1C
04811      ELSE                                                         DTSCS1C
04812      IF MAP-UI-LIABLE-NO-88                                       DTSCS1C
04813          IF MAP-EMP-CLASS = SPACES OR LOW-VALUES                  DTSCS1C
04814              NEXT SENTENCE                                        DTSCS1C
04815          ELSE                                                     DTSCS1C
04816              MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA          DTSCS1C
04817              PERFORM S2401-ERROR THRU S2401-EXIT.                 DTSCS1C
04818  S2400-EXIT.                                                      DTSCS1C
04819      EXIT.                                                        DTSCS1C
04820      SKIP3                                                        DTSCS1C
04821  S2401-ERROR.                                                     DTSCS1C
04822      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-EMP-CLASS-A.           DTSCS1C
04823      IF LCCM-NO-MSG                                               DTSCS1C
04824          MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                       DTSCS1C
04825          MOVE CATB-CURSOR TO MAP-EMP-CLASS-L                      DTSCS1C
04826          SET CURSOR-SET-YES TO TRUE.                              DTSCS1C
04827  S2401-EXIT.                                                      DTSCS1C
04828      EXIT.                                                        DTSCS1C
04829 /*****************************************************************DTSCS1C
04830 *                                                                *DTSCS1C
04831 ******************************************************************DTSCS1C
04832  S2500-LIAB-CD.                                                   DTSCS1C
04833      IF MAP-LIAB-CD = LOW-VALUES                                  DTSCS1C
04834          MOVE SPACES TO MAP-LIAB-CD.                              DTSCS1C
04835                                                                   DTSCS1C
04836      MOVE MAP-LIAB-CD TO MSOL-LIAB-CD.                            DTSCS1C
04837                                                                   DTSCS1C
04838      IF MAP-LIAB-CD = SPACES                                      DTSCS1C
04839         IF MAP-UI-LIABLE-YES-88                                   DTSCS1C
04840            MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA               DTSCS1C
04841            PERFORM S2501-ERROR THRU S2501-EXIT                    DTSCS1C
04842         ELSE                                                      DTSCS1C
04843            NEXT SENTENCE                                          DTSCS1C
04844      ELSE                                                         DTSCS1C
04845      IF MAP-UI-LIABLE-NO-88                                       DTSCS1C
04846         MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA               DTSCS1C
04847         PERFORM S2501-ERROR THRU S2501-EXIT                       DTSCS1C
04848      ELSE                                                         DTSCS1C
04849         MOVE MAP-LIAB-CD TO L031-CD                               DTSCS1C
04850         SET L031-MSOL-LIAB-CD TO TRUE                             DTSCS1C
04851         PERFORM S031-REG-CODES THRU S031-EXIT                     DTSCS1C
04852         IF L031-NOT-VALID                                         DTSCS1C
04853         OR MSOL-LIAB-UNK-88                                       DTSCS1C
04854            MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA              DTSCS1C
04855            PERFORM S2501-ERROR THRU S2501-EXIT                    DTSCS1C
04856         ELSE                                                      DTSCS1C
04857            MOVE MAP-LIAB-CD TO L201-LIAB-CD                       DTSCS1C
04858            PERFORM S201-DETER-EMP-CLASS THRU S201-EXIT            DTSCS1C
04859            IF WRK-EMP-CLASS NOT EQUAL L201-EMP-CLASS              DTSCS1C
04860               MOVE MSG-E1CB-AREA  TO WRK-MSG-AREA                 DTSCS1C
04861               PERFORM S2501-ERROR THRU S2501-EXIT                 DTSCS1C
04862            ELSE                                                   DTSCS1C
04863               PERFORM S2510-CHECK-FOR-PAY THRU S2510-EXIT         DTSCS1C
04864               IF LCCM-MSG                                         DTSCS1C
04865                  NEXT SENTENCE                                    DTSCS1C
04866               ELSE                                                DTSCS1C
04867                  PERFORM S2520-ORG-TYPE-CROSS-EDIT                DTSCS1C
04868                                            THRU S2520-EXIT.       DTSCS1C
04869  S2500-EXIT. EXIT.                                                DTSCS1C
04870      SKIP3                                                        DTSCS1C
04871  S2501-ERROR.                                                     DTSCS1C
04872      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-LIAB-CD-A.            DTSCS1C
04873      IF LCCM-NO-MSG                                               DTSCS1C
04874         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS1C
04875         MOVE CATB-CURSOR TO MAP-LIAB-CD-L                         DTSCS1C
04876         SET CURSOR-SET-YES TO TRUE.                               DTSCS1C
04877  S2501-EXIT. EXIT.                                                DTSCS1C
04878      SKIP3                                                        DTSCS1C
04879  S2510-CHECK-FOR-PAY.                                             DTSCS1C
04880                                                                   DTSCS1C
04881 *****                                                             DTSCS1C
04882 *                                                                 DTSCS1C
04883 *    IT IS POSSIBLE TO ENTER PAYMENT TRANSACTIONS AGAINST         DTSCS1C
04884 *    MPRF-CLASS-UNK-88 EMPLOYERS.                                 DTSCS1C
04885 *                                                                 DTSCS1C
04886 *    TO AVOID CONFUSING SYSTEM USERS, THE "TRIAL BALANCE" AND     DTSCS1C
04887 *    "ACCOUNTING SUMMARY" REPRESENTING SUCH TRANSACTIONS IS       DTSCS1C
04888 *    LUMPED WITH THE ACCOUNTING BALANCES FOR "REGULAR" EMPLOYERS. DTSCS1C
04889 *                                                                 DTSCS1C
04890 *    THE THREE LOCATIONS WHERE CODE RELATED TO THIS FUNCTION      DTSCS1C
04891 *    RESIDES ARE:                                                 DTSCS1C
04892 *                                                                 DTSCS1C
04893 *      DTSCS1C    S2510                                           DTSCS1C
04894 *                                                                 DTSCS1C
04895 *      DTSBD510   P3100                                           DTSCS1C
04896 *                                                                 DTSCS1C
04897 *      DTSBE305   P0000                                           DTSCS1C
04898 *                                                                 DTSCS1C
04899 *    THE CODE IN DTSCS1C IS RATHER SUBTLE.  THE DTSCS1C CODE      DTSCS1C
04900 *    SAYS THAT IF A PAYMENT HAS BEEN INPUT AGAINST A              DTSCS1C
04901 *    MPRF-CLASS-UNK-88 EMPLOYER, THEN THE EMPLOYER MAY BE FOUND   DTSCS1C
04902 *    LIABLE ONLY AS A MPRF-CLASS-REG-88 EMPLOYER.  THIS EDIT KEEPSDTSCS1C
04903 *    THE "TRAIL BALANCE" AND "ACCOUNTING SUMMARY" IN BALANCE      DTSCS1C
04904 *    WITHOUT REQUIRING THE SYSTEM TO GENERATE "REVERSING" JOURNAL DTSCS1C
04905 *    RECORDS.                                                     DTSCS1C
04906 *                                                                 DTSCS1C
04907 *    BEFORE MODIFYING ANY OF THE ABOVE REFERENCED CODE, THINK     DTSCS1C
04908 *    CAREFULLY ABOUT THE CONSEQUENCES OF THE MODIFICATIONS FOR    DTSCS1C
04909 *    THE ACCOUNTING BALANCES.                                     DTSCS1C
04910 *                                                                 DTSCS1C
04911 *****                                                             DTSCS1C
04912                                                                   DTSCS1C
04913      IF MPRF-CLASS-SUB-88                                         DTSCS1C
04914          GO TO S2510-EXIT.                                        DTSCS1C
04915                                                                   DTSCS1C
04916      IF WRK-EMP-RATED-88                                          DTSCS1C
04917          GO TO S2510-EXIT.                                        DTSCS1C
04918                                                                   DTSCS1C
04919      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSCS1C
04920                                                                   DTSCS1C
04921      MOVE WRK-EMP-NO TO MSKL-EMP-NO.                              DTSCS1C
04922                                                                   DTSCS1C
04923      SET MSKL-PAY-88 TO TRUE.                                     DTSCS1C
04924                                                                   DTSCS1C
04925      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS1C
04926                                                                   DTSCS1C
04927      IF L810-OK-88                                                DTSCS1C
04928          PERFORM S810-END-BROWSE THRU S810-EXIT                   DTSCS1C
04929          MOVE MSG-E1C7-AREA TO WRK-MSG-AREA                       DTSCS1C
04930          PERFORM S2501-ERROR THRU S2501-EXIT.                     DTSCS1C
04931  S2510-EXIT.                                                      DTSCS1C
04932      EXIT.                                                        DTSCS1C
04933                                                                   DTSCS1C
04934 *****                                                             DTSCS1C
04935 *                                                                 DTSCS1C
04936 *  FOR HOUSEHOLD EMPLOYERS, ORGANIZATION TYPE AND LIABILITY       DTSCS1C
04937 *  CODE MUST BE CONSISTENT.                                       DTSCS1C
04938 *                                                                 DTSCS1C
04939 *****                                                             DTSCS1C
04940  S2520-ORG-TYPE-CROSS-EDIT.                                       DTSCS1C
04941      MOVE MAP-ORG-TYPE     TO MPRF-ORG-TYPE.                      DTSCS1C
04942      IF MSOL-LIAB-RATED-DOMESTIC-88                               DTSCS1C
04943         IF MPRF-ORG-HSEHLD-DMSTIC-88                              DTSCS1C
04944            NEXT SENTENCE                                          DTSCS1C
04945         ELSE                                                      DTSCS1C
04946            MOVE MSG-E1CG-AREA TO WRK-MSG-AREA                     DTSCS1C
04947            PERFORM S2501-ERROR THRU S2501-EXIT                    DTSCS1C
04948         END-IF                                                    DTSCS1C
04949      ELSE                                                         DTSCS1C
04950         IF MPRF-ORG-HSEHLD-DMSTIC-88                              DTSCS1C
04951            MOVE MSG-E1CG-AREA TO WRK-MSG-AREA                     DTSCS1C
04952            PERFORM S2501-ERROR THRU S2501-EXIT                    DTSCS1C
04953         END-IF                                                    DTSCS1C
04954      END-IF.                                                      DTSCS1C
04955  S2520-EXIT.                                                      DTSCS1C
04956      EXIT.                                                        DTSCS1C
04957 /*****************************************************************DTSCS1C
04958 *                                                                 DTSCS1C
04959 ******************************************************************DTSCS1C
04960  S2600-LIAB-DATE.                                                 DTSCS1C
04961      MOVE ZEROS TO WRK-LIAB-DATE.                                 DTSCS1C
04962                                                                   DTSCS1C
04963      MOVE MAP-LIAB-DATE-AREA TO L015-S-DATE-AREA.                 DTSCS1C
04964                                                                   DTSCS1C
04965      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS1C
04966                                                                   DTSCS1C
04967      IF L015-NO-ENTRY                                             DTSCS1C
04968         IF MAP-UI-LIABLE-YES-88                                   DTSCS1C
04969            MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA               DTSCS1C
04970            PERFORM S2601-ERROR THRU S2601-EXIT                    DTSCS1C
04971         ELSE                                                      DTSCS1C
04972            NEXT SENTENCE                                          DTSCS1C
04973      ELSE                                                         DTSCS1C
04974      IF MAP-UI-LIABLE-NO-88                                       DTSCS1C
04975         MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA               DTSCS1C
04976         PERFORM S2601-ERROR THRU S2601-EXIT                       DTSCS1C
04977      ELSE                                                         DTSCS1C
04978      IF L015-NOT-VALID                                            DTSCS1C
04979         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS1C
04980         PERFORM S2601-ERROR THRU S2601-EXIT                       DTSCS1C
04981      ELSE                                                         DTSCS1C
04982         IF L015-DATE > LCCM-CURR-RUN-DATE                         DTSCS1C
04983            MOVE MSG-E1CM-AREA TO WRK-MSG-AREA                     DTSCS1C
04984            PERFORM S2601-ERROR THRU S2601-EXIT                    DTSCS1C
04985         ELSE                                                      DTSCS1C
04986            MOVE L015-DATE TO WRK-LIAB-DATE                        DTSCS1C
04987            IF MAP-UI-LIABLE-YES-88                                DTSCS1C
04988                MOVE LOW-VALUES TO MSOL-REC                        DTSCS1C
04989                MOVE WRK-EMP-NO TO MSOL-EMP-NO                     DTSCS1C
04990                SET MSOL-SOL-88  TO TRUE                           DTSCS1C
04991                MOVE L015-DATE TO MSOL-LIAB-DATE                   DTSCS1C
04992                MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA                DTSCS1C
04993                PERFORM S810-READ THRU S810-EXIT                   DTSCS1C
04994                IF L810-OK-88                                      DTSCS1C
04995                   MOVE MSG-E1C1-AREA TO WRK-MSG-AREA              DTSCS1C
04996                   PERFORM S2601-ERROR THRU S2601-EXIT.            DTSCS1C
04997  S2600-EXIT. EXIT.                                                DTSCS1C
04998      SKIP3                                                        DTSCS1C
04999  S2601-ERROR.                                                     DTSCS1C
05000      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-LIAB-MO-A             DTSCS1C
05001                                         MAP-LIAB-DA-A             DTSCS1C
05002                                         MAP-LIAB-YR-A.            DTSCS1C
05003      IF LCCM-NO-MSG                                               DTSCS1C
05004         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS1C
05005         MOVE CATB-CURSOR TO MAP-LIAB-MO-L                         DTSCS1C
05006         SET CURSOR-SET-YES TO TRUE.                               DTSCS1C
05007  S2601-EXIT. EXIT.                                                DTSCS1C
05008 /*****************************************************************DTSCS1C
05009 *                                                                *DTSCS1C
05010 *    IN DC LIAB-ESTB-DATE IS EQUAL TO LIAB-DATE.  LIAB-ESTB-DATE *DTSCS1C
05011 *    IS CARRIED IN THE SYSTEM BECAUSE THE RULE REQUIRING         *DTSCS1C
05012 *    LIAB-ESTB-DATE TO BE EQUAL TO LIAB-DATE DOES NOT SEEM       *DTSCS1C
05013 *    REASONABLE.  IF THIS RULE CHANGED, THE CODE IN S2700        *DTSCS1C
05014 *    (AND CORRESPONDING CODE IN MODULE DTSCS17) MUST BE          *DTSCS1C
05015 *    MODIFIED.                                                   *DTSCS1C
05016 *                                                                *DTSCS1C
05017 ******************************************************************DTSCS1C
05018  S2700-LIAB-ESTB-DATE.                                            DTSCS1C
05019      MOVE MAP-LIAB-ESTB-DATE-AREA TO L015-S-DATE-AREA.            DTSCS1C
05020                                                                   DTSCS1C
05021      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS1C
05022                                                                   DTSCS1C
05023      IF L015-NO-ENTRY                                             DTSCS1C
05024         IF MAP-UI-LIABLE-YES-88                                   DTSCS1C
05025            IF WRK-LIAB-DATE = +0                                  DTSCS1C
05026               NEXT SENTENCE                                       DTSCS1C
05027            ELSE                                                   DTSCS1C
05028               MOVE MAP-LIAB-MO TO MAP-LIAB-ESTB-MO                DTSCS1C
05029               MOVE MAP-LIAB-DA TO MAP-LIAB-ESTB-DA                DTSCS1C
05030               MOVE MAP-LIAB-YR TO MAP-LIAB-ESTB-YR                DTSCS1C
05031         ELSE                                                      DTSCS1C
05032            NEXT SENTENCE                                          DTSCS1C
05033      ELSE                                                         DTSCS1C
05034      IF MAP-UI-LIABLE-NO-88                                       DTSCS1C
05035         MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA               DTSCS1C
05036         PERFORM S2701-ERROR THRU S2701-EXIT                       DTSCS1C
05037      ELSE                                                         DTSCS1C
05038      IF L015-NOT-VALID                                            DTSCS1C
05039         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS1C
05040         PERFORM S2701-ERROR  THRU S2701-EXIT                      DTSCS1C
05041      ELSE                                                         DTSCS1C
05042      IF WRK-LIAB-DATE NOT = +0                                    DTSCS1C
05043         IF L015-DATE > LCCM-CURR-RUN-DATE                         DTSCS1C
05044            MOVE MSG-E1CN-AREA TO WRK-MSG-AREA                     DTSCS1C
05045            PERFORM S2701-ERROR THRU S2701-EXIT                    DTSCS1C
05046         ELSE                                                      DTSCS1C
05047            IF L015-DATE NOT = WRK-LIAB-DATE                       DTSCS1C
05048               MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA                DTSCS1C
05049               PERFORM S2701-ERROR THRU S2701-EXIT                 DTSCS1C
05050               PERFORM S2601-ERROR THRU S2601-EXIT.                DTSCS1C
05051  S2700-EXIT. EXIT.                                                DTSCS1C
05052      SKIP3                                                        DTSCS1C
05053  S2701-ERROR.                                                     DTSCS1C
05054      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-LIAB-ESTB-MO-A        DTSCS1C
05055                                         MAP-LIAB-ESTB-DA-A        DTSCS1C
05056                                         MAP-LIAB-ESTB-YR-A        DTSCS1C
05057                                                                   DTSCS1C
05058      IF LCCM-NO-MSG                                               DTSCS1C
05059         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS1C
05060         MOVE CATB-CURSOR TO MAP-LIAB-ESTB-MO-L                    DTSCS1C
05061         SET CURSOR-SET-YES TO TRUE.                               DTSCS1C
05062  S2701-EXIT. EXIT.                                                DTSCS1C
05063 /*****************************************************************DTSCS1C
05064 *                                                                 DTSCS1C
05065 ******************************************************************DTSCS1C
05066  S2800-581-NEW-IND.                                               DTSCS1C
05067      IF MAP-581-NEW-IND = LOW-VALUES                              DTSCS1C
05068          MOVE SPACE TO MAP-581-NEW-IND.                           DTSCS1C
05069                                                                   DTSCS1C
05070      IF MAP-581-NEW-IND = SPACES                                  DTSCS1C
05071          IF MAP-UI-LIABLE-YES-88                                  DTSCS1C
05072              MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA             DTSCS1C
05073              PERFORM S2801-ERROR THRU S2801-EXIT                  DTSCS1C
05074          ELSE                                                     DTSCS1C
05075              NEXT SENTENCE                                        DTSCS1C
05076      ELSE                                                         DTSCS1C
05077      IF MAP-UI-LIABLE-NO-88                                       DTSCS1C
05078          MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA              DTSCS1C
05079          PERFORM S2801-ERROR THRU S2801-EXIT                      DTSCS1C
05080      ELSE                                                         DTSCS1C
05081          IF MAP-581-NEW-VALID-88                                  DTSCS1C
05082              NEXT SENTENCE                                        DTSCS1C
05083          ELSE                                                     DTSCS1C
05084              MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA            DTSCS1C
05085              PERFORM S2801-ERROR THRU S2801-EXIT.                 DTSCS1C
05086  S2800-EXIT.                                                      DTSCS1C
05087      EXIT.                                                        DTSCS1C
05088      SKIP3                                                        DTSCS1C
05089  S2801-ERROR.                                                     DTSCS1C
05090      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-581-NEW-IND-A.         DTSCS1C
05091      IF LCCM-NO-MSG                                               DTSCS1C
05092         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS1C
05093         MOVE CATB-CURSOR TO MAP-581-NEW-IND-L                     DTSCS1C
05094         SET CURSOR-SET-YES TO TRUE.                               DTSCS1C
05095  S2801-EXIT. EXIT.                                                DTSCS1C
05096 /*****************************************************************DTSCS1C
05097 * OPTIONAL CODE IF LIABLE-IND = 'Y'                              *DTSCS1C
05098 ******************************************************************DTSCS1C
05099  S2900-INACT-CD.                                                  DTSCS1C
05100      IF MAP-INACT-CD = LOW-VALUES                                 DTSCS1C
05101          MOVE SPACES TO MAP-INACT-CD.                             DTSCS1C
05102                                                                   DTSCS1C
05103      IF MAP-INACT-CD = SPACES                                     DTSCS1C
05104         NEXT SENTENCE                                             DTSCS1C
05105      ELSE                                                         DTSCS1C
05106      IF MAP-UI-LIABLE-NO-88                                       DTSCS1C
05107         MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA               DTSCS1C
05108         PERFORM S2901-ERROR THRU S2901-EXIT                       DTSCS1C
05109      ELSE                                                         DTSCS1C
05110         MOVE MAP-INACT-CD TO L031-CD                              DTSCS1C
05111         SET L031-MSOL-INACT-CD TO TRUE                            DTSCS1C
05112         PERFORM S031-REG-CODES THRU S031-EXIT                     DTSCS1C
05113         IF L031-NOT-VALID                                         DTSCS1C
05114            MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA              DTSCS1C
05115            PERFORM S2901-ERROR THRU S2901-EXIT.                   DTSCS1C
05116  S2900-EXIT. EXIT.                                                DTSCS1C
05117      SKIP3                                                        DTSCS1C
05118  S2901-ERROR.                                                     DTSCS1C
05119      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-INACT-CD-A.           DTSCS1C
05120      IF LCCM-NO-MSG                                               DTSCS1C
05121         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS1C
05122         MOVE CATB-CURSOR TO MAP-INACT-CD-L                        DTSCS1C
05123         SET CURSOR-SET-YES TO TRUE.                               DTSCS1C
05124  S2901-EXIT. EXIT.                                                DTSCS1C
05125 /*****************************************************************DTSCS1C
05126 * DATE ONLY IF LIABLE = Y - REQUIRED IF INACT-CD ENTERED         *DTSCS1C
05127 * NOT ALLOWED IF INACT-CD NOT ENTERED                            *DTSCS1C
05128 ******************************************************************DTSCS1C
05129  S3100-INACT-DATE.                                                DTSCS1C
05130      MOVE ALL-NINES-DATE TO WRK-INACT-DATE.                       DTSCS1C
05131                                                                   DTSCS1C
05132      MOVE MAP-INACT-DATE-AREA TO L015-S-DATE-AREA.                DTSCS1C
05133                                                                   DTSCS1C
05134      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS1C
05135                                                                   DTSCS1C
05136      IF L015-NO-ENTRY                                             DTSCS1C
05137         IF MAP-UI-LIABLE-NO-88                                    DTSCS1C
05138            GO TO S3100-EXIT                                       DTSCS1C
05139         ELSE                                                      DTSCS1C
05140         IF MAP-INACT-CD = SPACES                                  DTSCS1C
05141            GO TO S3100-EXIT                                       DTSCS1C
05142         ELSE                                                      DTSCS1C
05143            MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA               DTSCS1C
05144            PERFORM S3101-ERROR THRU S3101-EXIT                    DTSCS1C
05145      ELSE                                                         DTSCS1C
05146          IF MAP-UI-LIABLE-NO-88                                   DTSCS1C
05147             MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA           DTSCS1C
05148             PERFORM S3101-ERROR THRU S3101-EXIT                   DTSCS1C
05149          ELSE                                                     DTSCS1C
05150              IF MAP-INACT-CD = SPACES                             DTSCS1C
05151                 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA       DTSCS1C
05152                 PERFORM S3101-ERROR THRU S3101-EXIT               DTSCS1C
05153              ELSE                                                 DTSCS1C
05154                  IF L015-NOT-VALID                                DTSCS1C
05155                     MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA     DTSCS1C
05156                     PERFORM S3101-ERROR THRU S3101-EXIT           DTSCS1C
05157                  ELSE                                             DTSCS1C
05158                      IF L015-DATE < WRK-LIAB-DATE                 DTSCS1C
05159                         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1C
05160                         PERFORM S3101-ERROR THRU S3101-EXIT       DTSCS1C
05161                      ELSE                                         DTSCS1C
05162                          MOVE L015-DATE TO WRK-INACT-DATE.        DTSCS1C
05163  S3100-EXIT. EXIT.                                                DTSCS1C
05164      SKIP3                                                        DTSCS1C
05165  S3101-ERROR.                                                     DTSCS1C
05166      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-INACT-MO-A            DTSCS1C
05167                                         MAP-INACT-DA-A            DTSCS1C
05168                                         MAP-INACT-YR-A            DTSCS1C
05169      IF LCCM-NO-MSG                                               DTSCS1C
05170         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS1C
05171         MOVE CATB-CURSOR TO MAP-INACT-MO-L                        DTSCS1C
05172         SET CURSOR-SET-YES TO TRUE.                               DTSCS1C
05173  S3101-EXIT. EXIT.                                                DTSCS1C
05174 /*****************************************************************DTSCS1C
05175 *                                                                 DTSCS1C
05176 ******************************************************************DTSCS1C
05177  S3200-INACT-LTR-TYPE.                                            DTSCS1C
05178      IF MAP-INACT-LTR-TYPE = LOW-VALUES                           DTSCS1C
05179          MOVE SPACES TO MAP-INACT-LTR-TYPE.                       DTSCS1C
05180                                                                   DTSCS1C
05181      IF MAP-INACT-LTR-TYPE = SPACES                               DTSCS1C
05182          IF MAP-INACT-CD = SPACES                                 DTSCS1C
05183              NEXT SENTENCE                                        DTSCS1C
05184          ELSE                                                     DTSCS1C
05185 *************SET MAP-INACT-LTR-DEFAULT-88 TO TRUE                 DTSCS1C
05186              MOVE EMSG-FIELD-REQUIRED    TO WRK-MSG-AREA          DTSCS1C
05187              PERFORM S3201-ERROR THRU S3201-EXIT                  DTSCS1C
05188      ELSE                                                         DTSCS1C
05189          IF MAP-INACT-CD = SPACES OR LOW-VALUES                   DTSCS1C
05190              MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA          DTSCS1C
05191              PERFORM S3201-ERROR THRU S3201-EXIT                  DTSCS1C
05192          ELSE                                                     DTSCS1C
05193          IF MAP-INACT-LTR-VALID-88                                DTSCS1C
05194              NEXT SENTENCE                                        DTSCS1C
05195          ELSE                                                     DTSCS1C
05196              MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA            DTSCS1C
05197              PERFORM S3201-ERROR THRU S3201-EXIT.                 DTSCS1C
05198  S3200-EXIT.                                                      DTSCS1C
05199      EXIT.                                                        DTSCS1C
05200      SKIP3                                                        DTSCS1C
05201  S3201-ERROR.                                                     DTSCS1C
05202      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-INACT-LTR-TYPE-A.      DTSCS1C
05203                                                                   DTSCS1C
05204      IF LCCM-NO-MSG                                               DTSCS1C
05205         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS1C
05206         MOVE CATB-CURSOR TO MAP-INACT-LTR-TYPE-L                  DTSCS1C
05207         SET CURSOR-SET-YES TO TRUE.                               DTSCS1C
05208  S3201-EXIT. EXIT.                                                DTSCS1C
05209      SKIP3                                                        DTSCS1C
05210 /*****************************************************************DTSCS1C
05211 *                                                                 DTSCS1C
05212 ******************************************************************DTSCS1C
05213  S3300-TRANSFER-IND.                                              DTSCS1C
05214      IF MAP-TRANSFER-IND = LOW-VALUES                             DTSCS1C
05215         SET MAP-TRANSFER-NA-88 TO TRUE.                           DTSCS1C
05216                                                                   DTSCS1C
05217      IF MAP-TRANSFER-VALID-88                                     DTSCS1C
05218         IF MAP-TRANSFER-YES-88                                    DTSCS1C
05219         OR MAP-TRANSFER-NO-88                                     DTSCS1C
05220            IF NOT L084-VALID-APPROVAL-88                          DTSCS1C
05221               MOVE MSG-E1CU-AREA        TO WRK-MSG-AREA           DTSCS1C
05222               PERFORM S3301-ERROR       THRU S3301-EXIT           DTSCS1C
05223            END-IF                                                 DTSCS1C
05224         END-IF                                                    DTSCS1C
05225      ELSE                                                         DTSCS1C
05226         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS1C
05227         PERFORM S3301-ERROR       THRU S3301-EXIT                 DTSCS1C
05228      END-IF.                                                      DTSCS1C
05229                                                                   DTSCS1C
05230  S3300-EXIT. EXIT.                                                DTSCS1C
05231      SKIP3                                                        DTSCS1C
05232  S3301-ERROR.                                                     DTSCS1C
05233      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-TRANSFER-IND-A.        DTSCS1C
05234                                                                   DTSCS1C
05235      IF LCCM-NO-MSG                                               DTSCS1C
05236         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS1C
05237         MOVE CATB-CURSOR TO MAP-TRANSFER-IND-L                    DTSCS1C
05238         SET CURSOR-SET-YES TO TRUE.                               DTSCS1C
05239  S3301-EXIT. EXIT.                                                DTSCS1C
05240 /*****************************************************************DTSCS1C
05241 *                                                                *DTSCS1C
05242 ******************************************************************DTSCS1C
05243  S3400-CHECK-OVERLAP.                                             DTSCS1C
05244      MOVE ZERO         TO WRK-MSOL-CNT                            DTSCS1C
05245                           WRK-LAST-INACT-YRQ.                     DTSCS1C
05246      MOVE MAP-INACT-CD TO MSOL-INACT-CD.                          DTSCS1C
05247                                                                   DTSCS1C
05248      IF MSOL-INACT-WITHDRAWN-88                                   DTSCS1C
05249          GO TO S3400-EXIT.                                        DTSCS1C
05250                                                                   DTSCS1C
05251                                                                   DTSCS1C
05252      MOVE LOW-VALUES TO MSOL-KEY-AREA.                            DTSCS1C
05253                                                                   DTSCS1C
05254      MOVE WRK-EMP-NO TO MSOL-EMP-NO.                              DTSCS1C
05255                                                                   DTSCS1C
05256      SET MSOL-SOL-88 TO TRUE.                                     DTSCS1C
05257                                                                   DTSCS1C
05258      MOVE ZEROS TO MSOL-LIAB-DATE.                                DTSCS1C
05259                                                                   DTSCS1C
05260      MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS1C
05261                                                                   DTSCS1C
05262      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS1C
05263                                                                   DTSCS1C
05264      PERFORM S3410-COMPARE THRU S3410-EXIT                        DTSCS1C
05265        UNTIL L810-NO-REC-88.                                      DTSCS1C
05266                                                                   DTSCS1C
05267                                                                   DTSCS1C
05268      IF LCCM-MSG                                                  DTSCS1C
05269          GO TO S3400-EXIT.                                        DTSCS1C
05270                                                                   DTSCS1C
05271      IF WRK-LAST-INACT-YRQ > ZERO                                 DTSCS1C
05272         MOVE WRK-LAST-INACT-YRQ TO L004-QTR-5-9                   DTSCS1C
05273         SET L004-FROM-5 TO TRUE                                   DTSCS1C
05274         PERFORM S004-YRQ THRU S004-EXIT                           DTSCS1C
05275         MOVE L004-ABS-QTR      TO WRK-LAST-INACT-ABS-QTR          DTSCS1C
05276         MOVE WRK-FIRST-LIAB-YRQ TO L004-QTR-5-9                   DTSCS1C
05277         SET L004-FROM-5 TO TRUE                                   DTSCS1C
05278         PERFORM S004-YRQ THRU S004-EXIT                           DTSCS1C
05279         COMPUTE WRK-DIFF =                                        DTSCS1C
05280            (L004-ABS-QTR - WRK-LAST-INACT-ABS-QTR)                DTSCS1C
05281         IF WRK-DIFF > +12                                         DTSCS1C
05282            MOVE MSG-E1CS-AREA TO WRK-MSG-AREA                     DTSCS1C
05283            PERFORM S2601-ERROR THRU S2601-EXIT                    DTSCS1C
05284         ELSE                                                      DTSCS1C
05285            IF WRK-DIFF < +2                                       DTSCS1C
05286               MOVE MSG-E1CT-AREA TO WRK-MSG-AREA                  DTSCS1C
05287               PERFORM S2601-ERROR THRU S2601-EXIT                 DTSCS1C
05288            END-IF                                                 DTSCS1C
05289         END-IF                                                    DTSCS1C
05290      END-IF.                                                      DTSCS1C
05291                                                                   DTSCS1C
05292 *****MOVE LOW-VALUES TO MCOL-KEY-AREA.                            DTSCS1C
05293 *****MOVE WRK-EMP-NO TO MCOL-EMP-NO.                              DTSCS1C
05294 *****SET MCOL-COL-88 TO TRUE.                                     DTSCS1C
05295 *****MOVE MCOL-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS1C
05296 *****PERFORM S810-READ THRU S810-EXIT.                            DTSCS1C
05297 *****IF L810-NO-REC-88                                            DTSCS1C
05298 *****    GO TO S3400-EXIT.                                        DTSCS1C
05299 *****MOVE MSKL-REC TO MCOL-REC.                                   DTSCS1C
05300 *****                                                             DTSCS1C
05301 *****IF MCOL-BNK-NOT-BANKRUPT-88                                  DTSCS1C
05302 *****    GO TO S3400-EXIT.                                        DTSCS1C
05303 *****                                                             DTSCS1C
05304 *****MOVE ALL-NINES-DATE TO WRK-BNK-END-DATE.                     DTSCS1C
05305 *****IF MCOL-BNK-DISCHRG-CLOSE-DATE NOT = +0                      DTSCS1C
05306 *****    MOVE MCOL-BNK-DISCHRG-CLOSE-DATE TO WRK-BNK-END-DATE     DTSCS1C
05307 *****ELSE                                                         DTSCS1C
05308 *****IF MCOL-BNK-DISMISS-DATE NOT = +0                            DTSCS1C
05309 *****    MOVE MCOL-BNK-DISMISS-DATE TO WRK-BNK-END-DATE.          DTSCS1C
05310 *****                                                             DTSCS1C
05311 *****IF (WRK-INACT-DATE < MCOL-BNK-PETITION-DATE)                 DTSCS1C
05312 *****        OR                                                   DTSCS1C
05313 *****   (WRK-LIAB-DATE > WRK-BNK-END-DATE)                        DTSCS1C
05314 *****    NEXT SENTENCE                                            DTSCS1C
05315 *****ELSE                                                         DTSCS1C
05316 *****    MOVE MSG-E1C8-AREA TO WRK-MSG-AREA                       DTSCS1C
05317 *****    PERFORM S2601-ERROR THRU S2601-EXIT                      DTSCS1C
05318 *****    PERFORM S3101-ERROR THRU S3101-EXIT.                     DTSCS1C
05319  S3400-EXIT. EXIT.                                                DTSCS1C
05320      SKIP3                                                        DTSCS1C
05321  S3410-COMPARE.                                                   DTSCS1C
05322      MOVE MSKL-REC TO MSOL-REC.                                   DTSCS1C
05323                                                                   DTSCS1C
05324      IF MSOL-INACT-WITHDRAWN-88                                   DTSCS1C
05325         NEXT SENTENCE                                             DTSCS1C
05326      ELSE                                                         DTSCS1C
05327         ADD +1 TO WRK-MSOL-CNT                                    DTSCS1C
05328         IF MSOL-INACT-INACTIVE-88                                 DTSCS1C
05329            IF MSOL-LAST-LIAB-YRQ > WRK-LAST-INACT-YRQ             DTSCS1C
05330               MOVE MSOL-LAST-LIAB-YRQ  TO WRK-LAST-INACT-YRQ      DTSCS1C
05331            END-IF                                                 DTSCS1C
05332         END-IF                                                    DTSCS1C
05333         IF WRK-INACT-DATE < MSOL-LIAB-DATE                        DTSCS1C
05334             OR WRK-LIAB-DATE > MSOL-INACT-DATE                    DTSCS1C
05335            NEXT SENTENCE                                          DTSCS1C
05336         ELSE                                                      DTSCS1C
05337            MOVE MSG-E1C1-AREA TO WRK-MSG-AREA                     DTSCS1C
05338            PERFORM S2601-ERROR THRU S2601-EXIT                    DTSCS1C
05339            PERFORM S3101-ERROR THRU S3101-EXIT                    DTSCS1C
05340         END-IF                                                    DTSCS1C
05341      END-IF.                                                      DTSCS1C
05342                                                                   DTSCS1C
05343      PERFORM S810-READ-NEXT THRU S810-EXIT.                       DTSCS1C
05344  S3410-EXIT. EXIT.                                                DTSCS1C
05345                                                                   DTSCS1C
05346 /*****************************************************************DTSCS1C
05347 * RATES OCCUR 6 TIMES.  ALL OCCURRENCES ARE OPTIONAL             *DTSCS1C
05348 * BUT BOTH FIELDS WITHIN A GROUP ARE REQUIRED IF ENTERED         *DTSCS1C
05349 ******************************************************************DTSCS1C
05350  S3500-RATES.                                                     DTSCS1C
05351      IF MAP-RTE-EFF-YR (WRK-SUB1) = LOW-VALUES                    DTSCS1C
05352          MOVE SPACES TO MAP-RTE-EFF-YR (WRK-SUB1).                DTSCS1C
05353                                                                   DTSCS1C
05354      IF MAP-RTE-EFF-Q (WRK-SUB1) = LOW-VALUES                     DTSCS1C
05355          MOVE SPACES TO MAP-RTE-EFF-Q (WRK-SUB1).                 DTSCS1C
05356                                                                   DTSCS1C
05357      IF MAP-RTE-RATE (WRK-SUB1) = LOW-VALUES                      DTSCS1C
05358          MOVE SPACES TO MAP-RTE-RATE (WRK-SUB1).                  DTSCS1C
05359                                                                   DTSCS1C
05360                                                                   DTSCS1C
05361      IF (MAP-RTE-EFF-YR (WRK-SUB1) = SPACES)                      DTSCS1C
05362           AND (MAP-RTE-EFF-Q (WRK-SUB1) = SPACES)                 DTSCS1C
05363           AND (MAP-RTE-RATE (WRK-SUB1) = SPACES)                  DTSCS1C
05364         GO TO S3500-EXIT.                                         DTSCS1C
05365                                                                   DTSCS1C
05366                                                                   DTSCS1C
05367      SET WRK-ERR-NO TO TRUE.                                      DTSCS1C
05368                                                                   DTSCS1C
05369      PERFORM S3520-EFF-YRQ THRU S3520-EXIT.                       DTSCS1C
05370                                                                   DTSCS1C
05371      PERFORM S3540-RATE THRU S3540-EXIT.                          DTSCS1C
05372                                                                   DTSCS1C
05373      IF WRK-ERR-YES                                               DTSCS1C
05374         GO TO S3500-EXIT.                                         DTSCS1C
05375                                                                   DTSCS1C
05376                                                                   DTSCS1C
05377      PERFORM S3501-CHECK-DUPLICATES THRU S3501-EXIT               DTSCS1C
05378          VARYING WRK-SUB3 FROM 1 BY 1                             DTSCS1C
05379          UNTIL WRK-SUB3 > WRK-SUB2.                               DTSCS1C
05380                                                                   DTSCS1C
05381      IF WRK-ERR-YES                                               DTSCS1C
05382         GO TO S3500-EXIT.                                         DTSCS1C
05383                                                                   DTSCS1C
05384                                                                   DTSCS1C
05385      PERFORM S3502-CHECK-FILE THRU S3502-EXIT.                    DTSCS1C
05386                                                                   DTSCS1C
05387      IF WRK-ERR-YES                                               DTSCS1C
05388         GO TO S3500-EXIT.                                         DTSCS1C
05389                                                                   DTSCS1C
05390                                                                   DTSCS1C
05391      ADD 1 TO WRK-SUB2.                                           DTSCS1C
05392                                                                   DTSCS1C
05393      MOVE L016-YRQ TO WRK-RATE-YRQ (WRK-SUB2).                    DTSCS1C
05394                                                                   DTSCS1C
05395      MOVE L012-RATE TO WRK-RATE-UI-RATE (WRK-SUB2).               DTSCS1C
05396                                                                   DTSCS1C
05397      MOVE L016-YRQ TO L052-EFF-YRQ.                               DTSCS1C
05398                                                                   DTSCS1C
05399      MOVE L012-RATE TO L052-UI-RATE.                              DTSCS1C
05400                                                                   DTSCS1C
05401      PERFORM S052-UI-RATE-EDIT THRU S052-EXIT.                    DTSCS1C
05402                                                                   DTSCS1C
05403      IF L052-NOT-VALID                                            DTSCS1C
05404         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS1C
05405         PERFORM S3541-ERROR THRU S3541-EXIT.                      DTSCS1C
05406  S3500-EXIT. EXIT.                                                DTSCS1C
05407      SKIP3                                                        DTSCS1C
05408  S3501-CHECK-DUPLICATES.                                          DTSCS1C
05409      IF L016-YRQ = WRK-RATE-YRQ (WRK-SUB3)                        DTSCS1C
05410         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS1C
05411         PERFORM S3521-ERROR THRU S3521-EXIT.                      DTSCS1C
05412  S3501-EXIT. EXIT.                                                DTSCS1C
05413      SKIP3                                                        DTSCS1C
05414  S3502-CHECK-FILE.                                                DTSCS1C
05415      MOVE LOW-VALUES TO MRTE-REC.                                 DTSCS1C
05416                                                                   DTSCS1C
05417      MOVE WRK-EMP-NO TO MRTE-EMP-NO.                              DTSCS1C
05418                                                                   DTSCS1C
05419      SET MRTE-RTE-88 TO TRUE.                                     DTSCS1C
05420                                                                   DTSCS1C
05421      MOVE L016-YRQ TO MRTE-EFF-YRQ.                               DTSCS1C
05422                                                                   DTSCS1C
05423      MOVE MRTE-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS1C
05424                                                                   DTSCS1C
05425      PERFORM S810-READ THRU S810-EXIT.                            DTSCS1C
05426                                                                   DTSCS1C
05427      IF L810-OK-88                                                DTSCS1C
05428         MOVE EMSG-RECORD-EXISTS TO WRK-MSG-AREA                   DTSCS1C
05429         PERFORM S3521-ERROR THRU S3521-EXIT.                      DTSCS1C
05430  S3502-EXIT. EXIT.                                                DTSCS1C
05431      SKIP3                                                        DTSCS1C
05432  S3520-EFF-YRQ.                                                   DTSCS1C
05433      MOVE MAP-RTE-EFF-YRQ-AREA (WRK-SUB1) TO L016-S-YRQ-AREA.     DTSCS1C
05434                                                                   DTSCS1C
05435      PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT.                 DTSCS1C
05436                                                                   DTSCS1C
05437      IF L016-NO-ENTRY                                             DTSCS1C
05438         IF MAP-UI-LIABLE-NO-88                                    DTSCS1C
05439            NEXT SENTENCE                                          DTSCS1C
05440         ELSE                                                      DTSCS1C
05441         IF WRK-EMP-SELF-INSURED-88                                DTSCS1C
05442            NEXT SENTENCE                                          DTSCS1C
05443         ELSE                                                      DTSCS1C
05444            MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA               DTSCS1C
05445            PERFORM S3521-ERROR THRU S3521-EXIT                    DTSCS1C
05446      ELSE                                                         DTSCS1C
05447      IF WRK-EMP-RATED-88                                          DTSCS1C
05448         IF MAP-UI-LIABLE-NO-88                                    DTSCS1C
05449            MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA            DTSCS1C
05450            PERFORM S3521-ERROR THRU S3521-EXIT                    DTSCS1C
05451         ELSE                                                      DTSCS1C
05452         IF L016-NOT-VALID                                         DTSCS1C
05453            MOVE EMSG-FIELD-NOT-VALID    TO WRK-MSG-AREA           DTSCS1C
05454            PERFORM S3521-ERROR          THRU S3521-EXIT           DTSCS1C
05455         ELSE                                                      DTSCS1C
05456             MOVE L016-YRQ TO L006-YRQ                             DTSCS1C
05457             SET L006-FROM-QTR TO TRUE                             DTSCS1C
05458             PERFORM S006-RATING-YRQ THRU S006-EXIT                DTSCS1C
05459             IF (L006-RTE-YR-START-YRQ NOT = L016-YRQ)             DTSCS1C
05460                     OR                                            DTSCS1C
05461                (L016-YRQ <= LCCM-PICKUP-YRQ)                      DTSCS1C
05462                 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA         DTSCS1C
05463                 PERFORM S3521-ERROR THRU S3521-EXIT               DTSCS1C
05464             ELSE                                                  DTSCS1C
05465                 NEXT SENTENCE                                     DTSCS1C
05466      ELSE                                                         DTSCS1C
05467         MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA               DTSCS1C
05468         PERFORM S3521-ERROR THRU S3521-EXIT.                      DTSCS1C
05469  S3520-EXIT. EXIT.                                                DTSCS1C
05470      SKIP3                                                        DTSCS1C
05471  S3521-ERROR.                                                     DTSCS1C
05472      SET WRK-ERR-YES TO TRUE.                                     DTSCS1C
05473                                                                   DTSCS1C
05474      MOVE CATB-UNPROT-NORM-NUM-MDTON                              DTSCS1C
05475        TO MAP-RTE-EFF-YR-A (WRK-SUB1)                             DTSCS1C
05476           MAP-RTE-EFF-Q-A (WRK-SUB1)                              DTSCS1C
05477                                                                   DTSCS1C
05478      IF LCCM-NO-MSG                                               DTSCS1C
05479         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS1C
05480         MOVE CATB-CURSOR  TO MAP-RTE-EFF-YR-L (WRK-SUB1)          DTSCS1C
05481         SET CURSOR-SET-YES TO TRUE.                               DTSCS1C
05482  S3521-EXIT. EXIT.                                                DTSCS1C
05483      SKIP3                                                        DTSCS1C
05484  S3540-RATE.                                                      DTSCS1C
05485      MOVE MAP-RTE-RATE-AREA (WRK-SUB1) TO L012-S-RATE-AREA.       DTSCS1C
05486                                                                   DTSCS1C
05487      PERFORM S012-RATE-FROM-SCREEN THRU S012-EXIT.                DTSCS1C
05488                                                                   DTSCS1C
05489      IF L012-NO-ENTRY                                             DTSCS1C
05490         IF MAP-UI-LIABLE-NO-88                                    DTSCS1C
05491            NEXT SENTENCE                                          DTSCS1C
05492         ELSE                                                      DTSCS1C
05493         IF WRK-EMP-SELF-INSURED-88                                DTSCS1C
05494            NEXT SENTENCE                                          DTSCS1C
05495         ELSE                                                      DTSCS1C
05496            MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA               DTSCS1C
05497            PERFORM S3541-ERROR THRU S3541-EXIT                    DTSCS1C
05498      ELSE                                                         DTSCS1C
05499      IF WRK-EMP-RATED-88                                          DTSCS1C
05500         IF MAP-UI-LIABLE-NO-88                                    DTSCS1C
05501            MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA            DTSCS1C
05502            PERFORM S3541-ERROR THRU S3541-EXIT                    DTSCS1C
05503         ELSE                                                      DTSCS1C
05504         IF L012-NOT-VALID                                         DTSCS1C
05505            MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA              DTSCS1C
05506            PERFORM S3541-ERROR THRU S3541-EXIT                    DTSCS1C
05507         ELSE                                                      DTSCS1C
05508            NEXT SENTENCE                                          DTSCS1C
05509      ELSE                                                         DTSCS1C
05510         MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA               DTSCS1C
05511         PERFORM S3541-ERROR THRU S3541-EXIT.                      DTSCS1C
05512  S3540-EXIT. EXIT.                                                DTSCS1C
05513      SKIP3                                                        DTSCS1C
05514  S3541-ERROR.                                                     DTSCS1C
05515      SET WRK-ERR-YES TO TRUE.                                     DTSCS1C
05516                                                                   DTSCS1C
05517      MOVE CATB-UNPROT-NORM-NUM-MDTON                              DTSCS1C
05518        TO MAP-RTE-RATE-A (WRK-SUB1).                              DTSCS1C
05519                                                                   DTSCS1C
05520      IF LCCM-NO-MSG                                               DTSCS1C
05521         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS1C
05522         MOVE CATB-CURSOR TO MAP-RTE-RATE-L (WRK-SUB1)             DTSCS1C
05523         SET CURSOR-SET-YES TO TRUE.                               DTSCS1C
05524  S3541-EXIT. EXIT.                                                DTSCS1C
05525      SKIP3                                                        DTSCS1C
05526  S3590-REARRANGE-RATES.                                           DTSCS1C
05527      PERFORM                                                      DTSCS1C
05528        VARYING WRK-SUB1 FROM 1 BY 1                               DTSCS1C
05529        UNTIL WRK-SUB1 > RTE-OCC-MAX                               DTSCS1C
05530          MOVE SPACES TO MAP-RTE-EFF-YR (WRK-SUB1)                 DTSCS1C
05531                         MAP-RTE-EFF-Q (WRK-SUB1)                  DTSCS1C
05532                         MAP-RTE-RATE (WRK-SUB1)                   DTSCS1C
05533          IF WRK-SUB1 <= WRK-SUB2                                  DTSCS1C
05534              MOVE WRK-RATE-YRQ (WRK-SUB1) TO WRK-DISPLAY          DTSCS1C
05535              MOVE WRK-DISPLAY-QTR-YR                              DTSCS1C
05536                TO MAP-RTE-EFF-YR (WRK-SUB1)                       DTSCS1C
05537              MOVE WRK-DISPLAY-QTR-Q                               DTSCS1C
05538                TO MAP-RTE-EFF-Q (WRK-SUB1)                        DTSCS1C
05539              MOVE WRK-RATE-UI-RATE (WRK-SUB1)                     DTSCS1C
05540                TO L056-RATE                                       DTSCS1C
05541              SET L056-DISP1-LEFT-88 TO TRUE                       DTSCS1C
05542              PERFORM S056-RATE-DISPLAY THRU S056-EXIT             DTSCS1C
05543              MOVE L056-DISP-RATE TO MAP-RTE-RATE (WRK-SUB1)       DTSCS1C
05544          END-IF                                                   DTSCS1C
05545      END-PERFORM.                                                 DTSCS1C
05546  S3590-EXIT.                                                      DTSCS1C
05547      EXIT.                                                        DTSCS1C
05548 /***************************************************************  DTSCS1C
05549 *                                                                 DTSCS1C
05550 ****************************************************************  DTSCS1C
05551  S3600-REQUIRE-RATES.                                             DTSCS1C
05552      IF WRK-EMP-SELF-INSURED-88                                   DTSCS1C
05553          GO TO S3600-EXIT.                                        DTSCS1C
05554                                                                   DTSCS1C
05555                                                                   DTSCS1C
05556      IF WRK-LIAB-DATE = +0                                        DTSCS1C
05557         GO TO S3600-EXIT.                                         DTSCS1C
05558                                                                   DTSCS1C
05559                                                                   DTSCS1C
05560      PERFORM S3604-THRU-RATE-TABLE THRU S3604-EXIT                DTSCS1C
05561          VARYING WRK-SUB1 FROM 1 BY 1                             DTSCS1C
05562          UNTIL WRK-SUB1 > RTE-OCC-MAX.                            DTSCS1C
05563                                                                   DTSCS1C
05564      IF LCCM-MSG                                                  DTSCS1C
05565          GO TO S3600-EXIT.                                        DTSCS1C
05566                                                                   DTSCS1C
05567                                                                   DTSCS1C
05568      IF WRK-FIRST-LIAB-YRQ = +0                                   DTSCS1C
05569         GO TO S3600-EXIT.                                         DTSCS1C
05570                                                                   DTSCS1C
05571                                                                   DTSCS1C
05572      MOVE WRK-FIRST-LIAB-YRQ TO L006-YRQ.                         DTSCS1C
05573                                                                   DTSCS1C
05574      SET L006-FROM-QTR TO TRUE.                                   DTSCS1C
05575                                                                   DTSCS1C
05576      PERFORM S006-RATING-YRQ THRU S006-EXIT.                      DTSCS1C
05577                                                                   DTSCS1C
05578      MOVE L006-RTE-YR-START-YRQ TO WRK-RTE-START-YRQ.             DTSCS1C
05579                                                                   DTSCS1C
05580      MOVE L006-RTE-YR-END-YRQ TO WRK-RTE-END-YRQ.                 DTSCS1C
05581                                                                   DTSCS1C
05582      IF WRK-LAST-LIAB-YRQ < LCCM-LAST-RATE-END-YRQ                DTSCS1C
05583          MOVE WRK-LAST-LIAB-YRQ TO WRK-RTE-LAST-YRQ               DTSCS1C
05584      ELSE                                                         DTSCS1C
05585          MOVE LCCM-LAST-RATE-END-YRQ                              DTSCS1C
05586            TO WRK-RTE-LAST-YRQ.                                   DTSCS1C
05587                                                                   DTSCS1C
05588                                                                   DTSCS1C
05589      PERFORM S3601-CHECK-EACH-RATE THRU S3601-EXIT                DTSCS1C
05590       UNTIL (WRK-RTE-START-YRQ > WRK-RTE-LAST-YRQ)                DTSCS1C
05591                  OR                                               DTSCS1C
05592             (LCCM-MSG).                                           DTSCS1C
05593  S3600-EXIT. EXIT.                                                DTSCS1C
05594      SKIP3                                                        DTSCS1C
05595  S3601-CHECK-EACH-RATE.                                           DTSCS1C
05596      MOVE LOW-VALUES TO MRTE-REC.                                 DTSCS1C
05597                                                                   DTSCS1C
05598      MOVE WRK-EMP-NO TO MRTE-EMP-NO.                              DTSCS1C
05599                                                                   DTSCS1C
05600      SET MRTE-RTE-88 TO TRUE.                                     DTSCS1C
05601                                                                   DTSCS1C
05602      MOVE WRK-RTE-START-YRQ TO MRTE-EFF-YRQ.                      DTSCS1C
05603                                                                   DTSCS1C
05604      MOVE MRTE-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS1C
05605                                                                   DTSCS1C
05606      PERFORM S810-READ THRU S810-EXIT.                            DTSCS1C
05607                                                                   DTSCS1C
05608      IF L810-NO-REC-88                                            DTSCS1C
05609         MOVE 0 TO L016-YRQ                                        DTSCS1C
05610         PERFORM S3602-ENTERED THRU S3602-EXIT                     DTSCS1C
05611             VARYING WRK-SUB1 FROM 1 BY 1                          DTSCS1C
05612             UNTIL (WRK-SUB1 > WRK-SUB2)                           DTSCS1C
05613                      OR                                           DTSCS1C
05614                   (L016-YRQ = WRK-RTE-START-YRQ)                  DTSCS1C
05615          IF L016-YRQ NOT = WRK-RTE-START-YRQ                      DTSCS1C
05616             PERFORM S3610-DEFAULT-RATE THRU S3610-EXIT            DTSCS1C
05617          END-IF                                                   DTSCS1C
05618      ELSE                                                         DTSCS1C
05619         IF NOT MAP-VERIFY-YES-88                                  DTSCS1C
05620            MOVE MSKL-REC    TO MRTE-REC                           DTSCS1C
05621            IF MRTE-RATE-TYPE-ESTIM-88                             DTSCS1C
05622               MOVE MSG-E1CL-AREA TO WRK-MSG-AREA                  DTSCS1C
05623               PERFORM S3601A-ERROR THRU S3601A-EXIT.              DTSCS1C
05624                                                                   DTSCS1C
05625                                                                   DTSCS1C
05626      SET L004-FROM-5 TO TRUE.                                     DTSCS1C
05627                                                                   DTSCS1C
05628      MOVE WRK-RTE-END-YRQ TO L004-QTR-5-9.                        DTSCS1C
05629                                                                   DTSCS1C
05630      PERFORM S004-YRQ THRU S004-EXIT.                             DTSCS1C
05631                                                                   DTSCS1C
05632      ADD +1 TO L004-ABS-QTR.                                      DTSCS1C
05633                                                                   DTSCS1C
05634      SET L004-FROM-ABS TO TRUE.                                   DTSCS1C
05635                                                                   DTSCS1C
05636      PERFORM S004-YRQ THRU S004-EXIT.                             DTSCS1C
05637                                                                   DTSCS1C
05638                                                                   DTSCS1C
05639      MOVE L004-QTR-5-9 TO L006-YRQ.                               DTSCS1C
05640                                                                   DTSCS1C
05641      SET L006-FROM-QTR TO TRUE.                                   DTSCS1C
05642                                                                   DTSCS1C
05643      PERFORM S006-RATING-YRQ THRU S006-EXIT.                      DTSCS1C
05644                                                                   DTSCS1C
05645      MOVE L006-RTE-YR-START-YRQ TO WRK-RTE-START-YRQ.             DTSCS1C
05646                                                                   DTSCS1C
05647      MOVE L006-RTE-YR-END-YRQ TO WRK-RTE-END-YRQ.                 DTSCS1C
05648  S3601-EXIT. EXIT.                                                DTSCS1C
05649      SKIP3                                                        DTSCS1C
05650  S3601A-ERROR.                                                    DTSCS1C
05651      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-VERIFY-A.              DTSCS1C
05652      MOVE CATB-ASKIP-BRT-MDTOFF     TO MAP-VERIFY-LIT-A.          DTSCS1C
05653      MOVE 'VERIFY?'                 TO MAP-VERIFY-LIT.            DTSCS1C
05654                                                                   DTSCS1C
05655      IF LCCM-NO-MSG                                               DTSCS1C
05656         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS1C
05657         MOVE CATB-CURSOR             TO MAP-VERIFY-L              DTSCS1C
05658         SET CURSOR-SET-YES TO TRUE.                               DTSCS1C
05659                                                                   DTSCS1C
05660  S3601A-EXIT. EXIT.                                               DTSCS1C
05661      SKIP3                                                        DTSCS1C
05662  S3602-ENTERED.                                                   DTSCS1C
05663      MOVE WRK-RATE-YRQ (WRK-SUB1) TO L016-YRQ.                    DTSCS1C
05664  S3602-EXIT. EXIT.                                                DTSCS1C
05665      SKIP3                                                        DTSCS1C
05666  S3604-THRU-RATE-TABLE.                                           DTSCS1C
05667      MOVE MAP-RTE-EFF-YRQ-AREA (WRK-SUB1) TO L016-S-YRQ-AREA.     DTSCS1C
05668                                                                   DTSCS1C
05669      PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT.                 DTSCS1C
05670                                                                   DTSCS1C
05671      IF L016-NO-ENTRY                                             DTSCS1C
05672         GO TO S3604-EXIT.                                         DTSCS1C
05673                                                                   DTSCS1C
05674      MOVE L016-YRQ TO L006-YRQ.                                   DTSCS1C
05675                                                                   DTSCS1C
05676      SET L006-FROM-QTR TO TRUE.                                   DTSCS1C
05677                                                                   DTSCS1C
05678      PERFORM S006-RATING-YRQ THRU S006-EXIT.                      DTSCS1C
05679                                                                   DTSCS1C
05680      IF (L006-RTE-YR-START-YRQ < WRK-FIRST-LIAB-YRQ               DTSCS1C
05681         AND L006-RTE-YR-END-YRQ  < WRK-FIRST-LIAB-YRQ)            DTSCS1C
05682      OR (L006-RTE-YR-START-YRQ > WRK-LAST-LIAB-YRQ                DTSCS1C
05683         AND L006-RTE-YR-END-YRQ  > WRK-LAST-LIAB-YRQ)             DTSCS1C
05684         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS1C
05685         PERFORM S3521-ERROR THRU S3521-EXIT.                      DTSCS1C
05686                                                                   DTSCS1C
05687      IF NOT L084-VALID-APPROVAL-88                                DTSCS1C
05688         PERFORM S3605-NEW-EMP-RATE  THRU S3605-EXIT               DTSCS1C
05689      END-IF.                                                      DTSCS1C
05690                                                                   DTSCS1C
05691  S3604-EXIT. EXIT.                                                DTSCS1C
05692      SKIP3                                                        DTSCS1C
05693  S3605-NEW-EMP-RATE.                                              DTSCS1C
05694      MOVE MAP-RTE-RATE-AREA (WRK-SUB1) TO L012-S-RATE-AREA.       DTSCS1C
05695                                                                   DTSCS1C
05696      PERFORM S012-RATE-FROM-SCREEN THRU S012-EXIT.                DTSCS1C
05697                                                                   DTSCS1C
05698      MOVE LOW-VALUES TO FUIR-KEY-AREA.                            DTSCS1C
05699                                                                   DTSCS1C
05700      SET FUIR-UIR-88 TO TRUE.                                     DTSCS1C
05701      MOVE L016-YRQ          TO FUIR-EFF-YRQ.                      DTSCS1C
05702      MOVE FUIR-KEY-AREA TO FSKL-KEY-AREA.                         DTSCS1C
05703                                                                   DTSCS1C
05704      PERFORM S831-READ THRU S831-EXIT.                            DTSCS1C
05705                                                                   DTSCS1C
05706      IF L831-NO-REC-88                                            DTSCS1C
05707          GO TO S3605-EXIT                                         DTSCS1C
05708      ELSE                                                         DTSCS1C
05709         MOVE FSKL-REC TO FUIR-REC                                 DTSCS1C
05710         IF L012-RATE NOT = FUIR-DEFAULT-NEW-EMP-RATE              DTSCS1C
05711            MOVE MSG-E1CV-AREA TO WRK-MSG-AREA                     DTSCS1C
05712            PERFORM S3541-ERROR THRU S3541-EXIT                    DTSCS1C
05713         END-IF                                                    DTSCS1C
05714      END-IF.                                                      DTSCS1C
05715                                                                   DTSCS1C
05716  S3605-EXIT. EXIT.                                                DTSCS1C
05717      SKIP3                                                        DTSCS1C
05718  S3610-DEFAULT-RATE.                                              DTSCS1C
05719      IF WRK-RTE-START-YRQ <= LCCM-PICKUP-YRQ                      DTSCS1C
05720          GO TO S3610-EXIT.                                        DTSCS1C
05721                                                                   DTSCS1C
05722                                                                   DTSCS1C
05723      IF WRK-SUB2 < RTE-OCC-MAX                                    DTSCS1C
05724          CONTINUE                                                 DTSCS1C
05725      ELSE                                                         DTSCS1C
05726          MOVE WRK-RTE-START-YRQ TO WRK-DISPLAY                    DTSCS1C
05727          MOVE WRK-DISPLAY-QTR-YR TO WRK-RTE-MSG-YR                DTSCS1C
05728          MOVE WRK-DISPLAY-QTR-Q TO WRK-RTE-MSG-Q                  DTSCS1C
05729          MOVE MSG-E1CA-AREA TO WRK-MSG-AREA                       DTSCS1C
05730          PERFORM S2601-ERROR THRU S2601-EXIT                      DTSCS1C
05731          GO TO S3610-EXIT.                                        DTSCS1C
05732                                                                   DTSCS1C
05733      MOVE LOW-VALUES TO FUIR-KEY-AREA.                            DTSCS1C
05734                                                                   DTSCS1C
05735      SET FUIR-UIR-88 TO TRUE.                                     DTSCS1C
05736                                                                   DTSCS1C
05737      MOVE WRK-RTE-START-YRQ TO FUIR-EFF-YRQ.                      DTSCS1C
05738                                                                   DTSCS1C
05739      MOVE FUIR-KEY-AREA TO FSKL-KEY-AREA.                         DTSCS1C
05740                                                                   DTSCS1C
05741      PERFORM S831-READ THRU S831-EXIT.                            DTSCS1C
05742                                                                   DTSCS1C
05743      IF L831-NO-REC-88                                            DTSCS1C
05744          PERFORM S3611-CANNOT-BE-DETERMINED THRU S3611-EXIT       DTSCS1C
05745          GO TO S3610-EXIT.                                        DTSCS1C
05746                                                                   DTSCS1C
05747      MOVE FSKL-REC TO FUIR-REC.                                   DTSCS1C
05748                                                                   DTSCS1C
05749      MOVE FUIR-DEFAULT-NEW-EMP-RATE TO L056-RATE.                 DTSCS1C
05750                                                                   DTSCS1C
05751      IF (L056-RATE = ZERO)                                        DTSCS1C
05752             OR                                                    DTSCS1C
05753         (L056-NO-RATE-88)                                         DTSCS1C
05754          PERFORM S3611-CANNOT-BE-DETERMINED THRU S3611-EXIT.      DTSCS1C
05755                                                                   DTSCS1C
05756      ADD +1 TO WRK-SUB2.                                          DTSCS1C
05757                                                                   DTSCS1C
05758      MOVE WRK-RTE-START-YRQ TO WRK-RATE-YRQ (WRK-SUB2).           DTSCS1C
05759                                                                   DTSCS1C
05760      MOVE FUIR-DEFAULT-NEW-EMP-RATE                               DTSCS1C
05761        TO WRK-RATE-UI-RATE (WRK-SUB2).                            DTSCS1C
05762                                                                   DTSCS1C
05763      MOVE WRK-RTE-START-YRQ TO WRK-DISPLAY.                       DTSCS1C
05764                                                                   DTSCS1C
05765      MOVE WRK-DISPLAY-QTR-YR TO MAP-RTE-EFF-YR (WRK-SUB2).        DTSCS1C
05766                                                                   DTSCS1C
05767      MOVE WRK-DISPLAY-QTR-Q TO MAP-RTE-EFF-Q (WRK-SUB2).          DTSCS1C
05768                                                                   DTSCS1C
05769      MOVE FUIR-DEFAULT-NEW-EMP-RATE TO L056-RATE.                 DTSCS1C
05770                                                                   DTSCS1C
05771      SET L056-DISP1-LEFT-88 TO TRUE.                              DTSCS1C
05772                                                                   DTSCS1C
05773      PERFORM S056-RATE-DISPLAY THRU S056-EXIT.                    DTSCS1C
05774                                                                   DTSCS1C
05775      MOVE L056-DISP-RATE TO MAP-RTE-RATE (WRK-SUB2).              DTSCS1C
05776  S3610-EXIT.                                                      DTSCS1C
05777      EXIT.                                                        DTSCS1C
05778      SKIP3                                                        DTSCS1C
05779  S3611-CANNOT-BE-DETERMINED.                                      DTSCS1C
05780      MOVE WRK-RTE-START-YRQ TO WRK-DISPLAY.                       DTSCS1C
05781                                                                   DTSCS1C
05782      MOVE WRK-DISPLAY-QTR-YR TO WRK-E1CF-MSG-YR.                  DTSCS1C
05783                                                                   DTSCS1C
05784      MOVE WRK-DISPLAY-QTR-Q TO WRK-E1CF-MSG-Q.                    DTSCS1C
05785                                                                   DTSCS1C
05786      MOVE MSG-E1CF-AREA TO WRK-MSG-AREA.                          DTSCS1C
05787                                                                   DTSCS1C
05788      PERFORM S2601-ERROR THRU S2601-EXIT.                         DTSCS1C
05789  S3611-EXIT.                                                      DTSCS1C
05790      EXIT.                                                        DTSCS1C
05791 /*****************************************************************DTSCS1C
05792 * THIS FIELD PROVIDES FOR ENTRY OF A HOUSEHOLD EMPLOYER'S        *DTSCS1C
05793 * FILING SCHEDULE.                                               *DTSCS1C
05794 * THIS IS A REQUIRED FIELD FOR HOUSEHOLD EMPLOYERS - THE         *DTSCS1C
05795 * DETERMINATION MAY NOT BE ENTERED WITHOUT THE SCHEDULE.         *DTSCS1C
05796 ******************************************************************DTSCS1C
05797  S3660-FILING-SCHEDULE.                                           DTSCS1C
05798      IF NOT MAP-ORG-TYPE-HSEHLD                                   DTSCS1C
05799         IF MAP-FILING-SCHED = SPACES OR LOW-VALUES                DTSCS1C
05800            GO TO S3660-EXIT                                       DTSCS1C
05801         ELSE                                                      DTSCS1C
05802            MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA            DTSCS1C
05803            PERFORM S3661-ERROR THRU S3661-EXIT                    DTSCS1C
05804            GO TO S3660-EXIT.                                      DTSCS1C
05805                                                                   DTSCS1C
05806 **   REACTIVATED EMPLOYERS INHERIT THEIR PREVIOUS FILING SCHEDULE.DTSCS1C
05807 **   IF THERE IS NO MFSC ON FILE, SEND ERROR MESSAGE. REGISTRATIONDTSCS1C
05808 **   MUST USE 1A SCREEN TO ADD PENDING MFSC AND SEND NOTICES.     DTSCS1C
05809 **   IF A PENDING MFSC IS ON FILE, REQUIRE ENTRY OF FILING SCHEDULDTSCS1C
05810                                                                   DTSCS1C
05811      IF MAP-FILING-SCHED = SPACES OR LOW-VALUES                   DTSCS1C
05812         IF WRK-MSOL-CNT > ZERO                                    DTSCS1C
05813            PERFORM S3665-PRIOR-MFSC    THRU S3665-EXIT            DTSCS1C
05814            IF L400-REDETERM-88                                    DTSCS1C
05815               GO TO S3660-EXIT                                    DTSCS1C
05816            ELSE                                                   DTSCS1C
05817            IF L400-ORIG-DETERM-88                                 DTSCS1C
05818               MOVE MSG-E1CJ-AREA TO WRK-MSG-AREA                  DTSCS1C
05819               PERFORM S3661-ERROR THRU S3661-EXIT                 DTSCS1C
05820               GO TO S3660-EXIT                                    DTSCS1C
05821            ELSE                                                   DTSCS1C
05822               IF L400-PENDING-MFSC-88                             DTSCS1C
05823                  MOVE EMSG-FIELD-REQUIRED    TO WRK-MSG-AREA      DTSCS1C
05824                  PERFORM S3661-ERROR THRU S3661-EXIT              DTSCS1C
05825                  GO TO S3660-EXIT                                 DTSCS1C
05826               END-IF                                              DTSCS1C
05827            END-IF                                                 DTSCS1C
05828         ELSE                                                      DTSCS1C
05829            MOVE EMSG-FIELD-REQUIRED    TO WRK-MSG-AREA            DTSCS1C
05830            PERFORM S3661-ERROR THRU S3661-EXIT                    DTSCS1C
05831            GO TO S3660-EXIT.                                      DTSCS1C
05832                                                                   DTSCS1C
05833      SET L042-MFSC-FILING-SCHEDULE-CD TO TRUE                     DTSCS1C
05834      MOVE MAP-FILING-SCHED TO L042-CD                             DTSCS1C
05835      PERFORM S042-MFSC-CODES     THRU S042-EXIT                   DTSCS1C
05836      IF L042-VALID                                                DTSCS1C
05837         NEXT SENTENCE                                             DTSCS1C
05838      ELSE                                                         DTSCS1C
05839         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS1C
05840         PERFORM S3661-ERROR THRU S3661-EXIT                       DTSCS1C
05841         GO TO S3660-EXIT.                                         DTSCS1C
05842                                                                   DTSCS1C
05843      IF WRK-MSOL-CNT > ZERO                                       DTSCS1C
05844         PERFORM S3665-PRIOR-MFSC    THRU S3665-EXIT               DTSCS1C
05845         IF L400-PENDING-MFSC-88                                   DTSCS1C
05846            NEXT SENTENCE                                          DTSCS1C
05847         ELSE                                                      DTSCS1C
05848            MOVE MSG-E1CH-AREA TO WRK-MSG-AREA                     DTSCS1C
05849            PERFORM S3661-ERROR THRU S3661-EXIT                    DTSCS1C
05850            GO TO S3660-EXIT.                                      DTSCS1C
05851                                                                   DTSCS1C
05852 **   IF WRK-MERA-ACTIVE-88                                        DTSCS1C
05853 *       IF MERA-SOURCE-CD = '14'                                  DTSCS1C
05854 *          IF MAP-FILING-SCHED = 'A'                              DTSCS1C
05855 *             MOVE MSG-E1CI-AREA TO WRK-MSG-AREA                  DTSCS1C
05856 *             PERFORM S3661-ERROR THRU S3661-EXIT                 DTSCS1C
05857 **            GO TO S3660-EXIT.                                   DTSCS1C
05858                                                                   DTSCS1C
05859      IF MAP-FILING-SCHED = 'A'                                    DTSCS1C
05860         IF WRK-FIRST-LIAB-YRQ < WRK-FIRST-ANNUAL-YRQ              DTSCS1C
05861             MOVE MSG-E1CK-AREA TO WRK-MSG-AREA                    DTSCS1C
05862             PERFORM S3661-ERROR THRU S3661-EXIT                   DTSCS1C
05863             GO TO S3660-EXIT.                                     DTSCS1C
05864                                                                   DTSCS1C
05865  S3660-EXIT. EXIT.                                                DTSCS1C
05866      SKIP3                                                        DTSCS1C
05867  S3661-ERROR.                                                     DTSCS1C
05868      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-FILING-SCHED-A.        DTSCS1C
05869                                                                   DTSCS1C
05870      IF LCCM-NO-MSG                                               DTSCS1C
05871         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS1C
05872         MOVE CATB-CURSOR TO MAP-FILING-SCHED-L                    DTSCS1C
05873         SET CURSOR-SET-YES TO TRUE.                               DTSCS1C
05874  S3661-EXIT. EXIT.                                                DTSCS1C
05875      SKIP3                                                        DTSCS1C
05876  S3665-PRIOR-MFSC.                                                DTSCS1C
05877      SET L400-FIND-PRIOR-88  TO TRUE.                             DTSCS1C
05878      MOVE WRK-EMP-NO         TO L400-EMP-NO.                      DTSCS1C
05879                                                                   DTSCS1C
05880      MOVE SPACES               TO L400-ORG-TYPE                   DTSCS1C
05881                                   L400-FILING-SCHED.              DTSCS1C
05882      MOVE ZERO                 TO L400-FIRST-LIAB-YRQ.            DTSCS1C
05883      MOVE LCCM-CURR-RUN-DATE   TO L400-CURR-RUN-DATE.             DTSCS1C
05884      MOVE LCCM-OP-ID           TO L400-OP-ID.                     DTSCS1C
05885                                                                   DTSCS1C
05886      PERFORM S400-HOUSEHOLD  THRU S400-EXIT.                      DTSCS1C
05887                                                                   DTSCS1C
05888                                                                   DTSCS1C
05889  S3665-EXIT. EXIT.                                                DTSCS1C
05890      SKIP3                                                        DTSCS1C
05891 /*****************************************************************DTSCS1C
05892 *    PREVENT REACTIVIATION OF A HOUSEHOLD EMPLOYER IF THE PRIOR   DTSCS1C
05893 *    INACTIVATION DATE IS IN THE SAME YEAR AS THE NEW LIABLE DATE DTSCS1C
05894 *    AND THE EMPLOYER IS AN ANNUAL FILER. IN THIS CASE, THE PRIOR DTSCS1C
05895 *    INACTIVATION SHOULD BE REVERSED. FOR ANNUAL FILERS, THERE    DTSCS1C
05896 *    MUST BE A FULL YEAR BETWEEN SPANS OF LIABILITY.              DTSCS1C
05897 ******************************************************************DTSCS1C
05898  S3670-CHK-HSEHLD-REACT.                                          DTSCS1C
05899      IF NOT MAP-ORG-TYPE-HSEHLD                                   DTSCS1C
05900         GO TO S3670-EXIT.                                         DTSCS1C
05901                                                                   DTSCS1C
05902      MOVE ZERO       TO WRK-PRIOR-YRQ.                            DTSCS1C
05903                                                                   DTSCS1C
05904      MOVE LOW-VALUES TO MSOL-KEY-AREA.                            DTSCS1C
05905      MOVE WRK-EMP-NO TO MSOL-EMP-NO.                              DTSCS1C
05906      SET MSOL-SOL-88 TO TRUE.                                     DTSCS1C
05907      MOVE ZEROS TO MSOL-LIAB-DATE.                                DTSCS1C
05908      MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS1C
05909                                                                   DTSCS1C
05910      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS1C
05911                                                                   DTSCS1C
05912      PERFORM S3671-FIND-LAST-LIAB-YRQ  THRU S3671-EXIT            DTSCS1C
05913         UNTIL L810-NO-REC-88.                                     DTSCS1C
05914                                                                   DTSCS1C
05915      IF WRK-PRIOR-YRQ = ZERO                                      DTSCS1C
05916         GO TO S3670-EXIT                                          DTSCS1C
05917      ELSE                                                         DTSCS1C
05918         MOVE WRK-PRIOR-YRQ              TO WRK-OLD-YRQ            DTSCS1C
05919         MOVE WRK-FIRST-LIAB-YRQ         TO WRK-NEW-YRQ            DTSCS1C
05920         IF WRK-OLD-YEAR = WRK-NEW-YEAR                            DTSCS1C
05921            SET L410-MODE-INPUT-YRQ-88   TO TRUE                   DTSCS1C
05922            MOVE WRK-EMP-NO              TO L410-EMP-NO            DTSCS1C
05923            MOVE WRK-PRIOR-YRQ           TO L410-YRQ               DTSCS1C
05924            PERFORM S410-FILING-SCHEDULE THRU S410-EXIT            DTSCS1C
05925            IF L410-ANN-SCHED-88                                   DTSCS1C
05926               MOVE MSG-E1C5-AREA        TO WRK-MSG-AREA           DTSCS1C
05927               PERFORM S2101-ERROR       THRU S2101-EXIT           DTSCS1C
05928            END-IF                                                 DTSCS1C
05929         END-IF                                                    DTSCS1C
05930      END-IF.                                                      DTSCS1C
05931                                                                   DTSCS1C
05932  S3670-EXIT. EXIT.                                                DTSCS1C
05933      SKIP3                                                        DTSCS1C
05934  S3671-FIND-LAST-LIAB-YRQ.                                        DTSCS1C
05935      MOVE MSKL-REC TO MSOL-REC.                                   DTSCS1C
05936                                                                   DTSCS1C
05937      IF MSOL-INACT-WITHDRAWN-88                                   DTSCS1C
05938         NEXT SENTENCE                                             DTSCS1C
05939      ELSE                                                         DTSCS1C
05940         IF MSOL-INACT-INACTIVE-88                                 DTSCS1C
05941            IF MSOL-LAST-LIAB-YRQ          < WRK-FIRST-LIAB-YRQ    DTSCS1C
05942               IF MSOL-LAST-LIAB-YRQ       > WRK-PRIOR-YRQ         DTSCS1C
05943                  MOVE MSOL-LAST-LIAB-YRQ  TO WRK-PRIOR-YRQ        DTSCS1C
05944               END-IF                                              DTSCS1C
05945            END-IF                                                 DTSCS1C
05946         END-IF                                                    DTSCS1C
05947      END-IF.                                                      DTSCS1C
05948                                                                   DTSCS1C
05949      PERFORM S810-READ-NEXT THRU S810-EXIT.                       DTSCS1C
05950                                                                   DTSCS1C
05951  S3671-EXIT. EXIT.                                                DTSCS1C
05952      SKIP3                                                        DTSCS1C
05953 /*****************************************************************DTSCS1C
05954 *                                                                 DTSCS1C
05955 ******************************************************************DTSCS1C
05956  S3700-WAIVER-START-YRQ.                                          DTSCS1C
05957      MOVE ZEROS TO WRK-WAIVER-START-YRQ.                          DTSCS1C
05958                                                                   DTSCS1C
05959      MOVE MAP-WAIVER-START-YRQ-AREA TO L016-S-YRQ-AREA.           DTSCS1C
05960                                                                   DTSCS1C
05961      PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT.                 DTSCS1C
05962                                                                   DTSCS1C
05963      IF L016-NO-ENTRY                                             DTSCS1C
05964          NEXT SENTENCE                                            DTSCS1C
05965      ELSE                                                         DTSCS1C
05966      IF MAP-UI-LIABLE-NO-88                                       DTSCS1C
05967         MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA               DTSCS1C
05968         PERFORM S3701-ERROR THRU S3701-EXIT                       DTSCS1C
05969      ELSE                                                         DTSCS1C
05970      IF (L016-NOT-VALID)                                          DTSCS1C
05971              OR                                                   DTSCS1C
05972         (L016-YRQ <= LCCM-PICKUP-YRQ)                             DTSCS1C
05973         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS1C
05974         PERFORM S3701-ERROR THRU S3701-EXIT                       DTSCS1C
05975      ELSE                                                         DTSCS1C
05976         IF (L016-YRQ < WRK-FIRST-LIAB-YRQ)                        DTSCS1C
05977                  OR                                               DTSCS1C
05978            (L016-YRQ > WRK-LAST-LIAB-YRQ)                         DTSCS1C
05979             MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA             DTSCS1C
05980             PERFORM S3701-ERROR THRU S3701-EXIT                   DTSCS1C
05981         ELSE                                                      DTSCS1C
05982             MOVE L016-YRQ TO WRK-WAIVER-START-YRQ.                DTSCS1C
05983  S3700-EXIT. EXIT.                                                DTSCS1C
05984      SKIP3                                                        DTSCS1C
05985  S3701-ERROR.                                                     DTSCS1C
05986      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-WAIVER-START-YR-A     DTSCS1C
05987                                         MAP-WAIVER-START-Q-A.     DTSCS1C
05988                                                                   DTSCS1C
05989      IF LCCM-NO-MSG                                               DTSCS1C
05990         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS1C
05991         MOVE CATB-CURSOR TO MAP-WAIVER-START-YR-L                 DTSCS1C
05992         SET CURSOR-SET-YES TO TRUE.                               DTSCS1C
05993  S3701-EXIT. EXIT.                                                DTSCS1C
05994 /*****************************************************************DTSCS1C
05995 *                                                                 DTSCS1C
05996 ******************************************************************DTSCS1C
05997  S3800-WAIVER-END-YRQ.                                            DTSCS1C
05998      MOVE ZEROS TO WRK-WAIVER-END-YRQ.                            DTSCS1C
05999                                                                   DTSCS1C
06000      MOVE MAP-WAIVER-END-YRQ-AREA TO L016-S-YRQ-AREA.             DTSCS1C
06001                                                                   DTSCS1C
06002      PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT.                 DTSCS1C
06003                                                                   DTSCS1C
06004      IF L016-NO-ENTRY                                             DTSCS1C
06005          IF WRK-WAIVER-START-YRQ > +0                             DTSCS1C
06006              MOVE WRK-WAIVER-START-YRQ TO WRK-WAIVER-END-YRQ      DTSCS1C
06007                                           WRK-DISPLAY             DTSCS1C
06008              MOVE WRK-DISPLAY-QTR-YR TO MAP-WAIVER-END-YR         DTSCS1C
06009              MOVE WRK-DISPLAY-QTR-Q TO MAP-WAIVER-END-Q           DTSCS1C
06010          ELSE                                                     DTSCS1C
06011              NEXT SENTENCE                                        DTSCS1C
06012      ELSE                                                         DTSCS1C
06013      IF MAP-UI-LIABLE-NO-88                                       DTSCS1C
06014         MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA               DTSCS1C
06015         PERFORM S3801-ERROR THRU S3801-EXIT                       DTSCS1C
06016      ELSE                                                         DTSCS1C
06017      IF L016-NOT-VALID                                            DTSCS1C
06018         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS1C
06019         PERFORM S3801-ERROR THRU S3801-EXIT                       DTSCS1C
06020      ELSE                                                         DTSCS1C
06021         IF (L016-YRQ < WRK-FIRST-LIAB-YRQ)                        DTSCS1C
06022                  OR                                               DTSCS1C
06023            (L016-YRQ > WRK-LAST-LIAB-YRQ)                         DTSCS1C
06024                  OR                                               DTSCS1C
06025            (WRK-WAIVER-START-YRQ = +0)                            DTSCS1C
06026                  OR                                               DTSCS1C
06027            (L016-YRQ < WRK-WAIVER-START-YRQ)                      DTSCS1C
06028                  OR                                               DTSCS1C
06029            (L016-YRQ > LCCM-LAST-UC30-MASS-MAIL-YRQ)              DTSCS1C
06030             MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA             DTSCS1C
06031             PERFORM S3801-ERROR THRU S3801-EXIT                   DTSCS1C
06032         ELSE                                                      DTSCS1C
06033             MOVE L016-YRQ TO WRK-WAIVER-END-YRQ.                  DTSCS1C
06034  S3800-EXIT. EXIT.                                                DTSCS1C
06035      SKIP3                                                        DTSCS1C
06036  S3801-ERROR.                                                     DTSCS1C
06037      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-WAIVER-END-YR-A       DTSCS1C
06038                                         MAP-WAIVER-END-Q-A.       DTSCS1C
06039      IF LCCM-NO-MSG                                               DTSCS1C
06040         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS1C
06041         MOVE CATB-CURSOR TO MAP-WAIVER-END-YR-L                   DTSCS1C
06042         SET CURSOR-SET-YES TO TRUE.                               DTSCS1C
06043  S3801-EXIT. EXIT.                                                DTSCS1C
06044 /*****************************************************************DTSCS1C
06045 *                                                                 DTSCS1C
06046 ******************************************************************DTSCS1C
06047  S3900-WAIVER-EXT-DATE.                                           DTSCS1C
06048      MOVE +0 TO WRK-WAIVER-EXT-DATE.                              DTSCS1C
06049                                                                   DTSCS1C
06050      MOVE MAP-WAIVER-EXT-DATE-AREA TO L015-S-DATE-AREA.           DTSCS1C
06051                                                                   DTSCS1C
06052      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS1C
06053                                                                   DTSCS1C
06054      IF L015-NO-ENTRY                                             DTSCS1C
06055          IF WRK-WAIVER-START-YRQ > +0                             DTSCS1C
06056              MOVE LCCM-CURR-RUN-DATE TO L001-FED-8-DATE-9         DTSCS1C
06057              SET L001-FROM-FED-8 TO TRUE                          DTSCS1C
06058              PERFORM S001-DATE THRU S001-EXIT                     DTSCS1C
06059              ADD +30 TO L001-JUL-ABS-DAY                          DTSCS1C
06060              SET L001-FROM-ABS-DAY TO TRUE                        DTSCS1C
06061              PERFORM S001-DATE THRU S001-EXIT                     DTSCS1C
06062              MOVE L001-FED-8-DATE-9 TO WRK-DISPLAY                DTSCS1C
06063                                        WRK-WAIVER-EXT-DATE        DTSCS1C
06064              MOVE WRK-DISPLAY-MO TO MAP-WAIVER-EXT-MO             DTSCS1C
06065              MOVE WRK-DISPLAY-DA TO MAP-WAIVER-EXT-DA             DTSCS1C
06066              MOVE WRK-DISPLAY-YR TO MAP-WAIVER-EXT-YR             DTSCS1C
06067              PERFORM S3910-END-YRQ-EXT-DATE-EDIT THRU S3910-EXIT  DTSCS1C
06068          ELSE                                                     DTSCS1C
06069              NEXT SENTENCE                                        DTSCS1C
06070      ELSE                                                         DTSCS1C
06071      IF MAP-UI-LIABLE-NO-88                                       DTSCS1C
06072         MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA               DTSCS1C
06073         PERFORM S3901-ERROR THRU S3901-EXIT                       DTSCS1C
06074      ELSE                                                         DTSCS1C
06075      IF L015-NOT-VALID                                            DTSCS1C
06076         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS1C
06077         PERFORM S3901-ERROR THRU S3901-EXIT                       DTSCS1C
06078      ELSE                                                         DTSCS1C
06079         MOVE LCCM-CURR-RUN-DATE TO L001-FED-8-DATE-9              DTSCS1C
06080         SET L001-FROM-FED-8 TO TRUE                               DTSCS1C
06081         PERFORM S001-DATE THRU S001-EXIT                          DTSCS1C
06082         ADD +45 TO L001-JUL-ABS-DAY                               DTSCS1C
06083         SET L001-FROM-ABS-DAY TO TRUE                             DTSCS1C
06084         PERFORM S001-DATE THRU S001-EXIT                          DTSCS1C
06085         IF (L015-DATE < LCCM-CURR-MAIL-DATE)                      DTSCS1C
06086                  OR                                               DTSCS1C
06087            (WRK-WAIVER-START-YRQ = +0)                            DTSCS1C
06088                  OR                                               DTSCS1C
06089            (L015-DATE > L001-FED-8-DATE-9)                        DTSCS1C
06090             MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA             DTSCS1C
06091             PERFORM S3901-ERROR THRU S3901-EXIT                   DTSCS1C
06092         ELSE                                                      DTSCS1C
06093             MOVE L015-DATE TO WRK-WAIVER-EXT-DATE                 DTSCS1C
06094             PERFORM S3910-END-YRQ-EXT-DATE-EDIT THRU S3910-EXIT.  DTSCS1C
06095  S3900-EXIT. EXIT.                                                DTSCS1C
06096      SKIP3                                                        DTSCS1C
06097  S3901-ERROR.                                                     DTSCS1C
06098      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-WAIVER-EXT-MO-A       DTSCS1C
06099                                         MAP-WAIVER-EXT-DA-A       DTSCS1C
06100                                         MAP-WAIVER-EXT-YR-A.      DTSCS1C
06101                                                                   DTSCS1C
06102      IF LCCM-NO-MSG                                               DTSCS1C
06103         MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS1C
06104         MOVE CATB-CURSOR             TO MAP-WAIVER-EXT-MO-L       DTSCS1C
06105         SET CURSOR-SET-YES TO TRUE.                               DTSCS1C
06106  S3901-EXIT. EXIT.                                                DTSCS1C
06107      SKIP3                                                        DTSCS1C
06108  S3910-END-YRQ-EXT-DATE-EDIT.                                     DTSCS1C
06109      IF WRK-WAIVER-END-YRQ = +0                                   DTSCS1C
06110          GO TO S3910-EXIT.                                        DTSCS1C
06111                                                                   DTSCS1C
06112                                                                   DTSCS1C
06113      MOVE WRK-WAIVER-END-YRQ TO L004-QTR-5-9.                     DTSCS1C
06114                                                                   DTSCS1C
06115      SET L004-FROM-5 TO TRUE.                                     DTSCS1C
06116                                                                   DTSCS1C
06117      PERFORM S004-YRQ THRU S004-EXIT.                             DTSCS1C
06118                                                                   DTSCS1C
06119      IF L004-QTR-DEFAULT-DUE-DATE < WRK-WAIVER-EXT-DATE           DTSCS1C
06120          NEXT SENTENCE                                            DTSCS1C
06121      ELSE                                                         DTSCS1C
06122          MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA                     DTSCS1C
06123          PERFORM S3801-ERROR THRU S3801-EXIT                      DTSCS1C
06124          PERFORM S3901-ERROR THRU S3901-EXIT.                     DTSCS1C
06125  S3910-EXIT.                                                      DTSCS1C
06126      EXIT.                                                        DTSCS1C
06127 /*****************************************************************DTSCS1C
06128 *                                                                 DTSCS1C
06129 ******************************************************************DTSCS1C
06130  S4000-RPT-PRINT-IND.                                             DTSCS1C
06131      IF MAP-RPT-PRINT-IND = LOW-VALUES                            DTSCS1C
06132          MOVE SPACES TO MAP-RPT-PRINT-IND.                        DTSCS1C
06133                                                                   DTSCS1C
06134      IF MAP-UI-LIABLE-NO-88                                       DTSCS1C
06135          IF MAP-RPT-PRINT-IND = SPACES                            DTSCS1C
06136              GO TO S4000-EXIT                                     DTSCS1C
06137          ELSE                                                     DTSCS1C
06138              MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA          DTSCS1C
06139              PERFORM S4001-ERROR THRU S4001-EXIT                  DTSCS1C
06140              GO TO S4000-EXIT.                                    DTSCS1C
06141                                                                   DTSCS1C
06142      IF MAP-RPT-PRINT-IND = SPACES                                DTSCS1C
06143          SET MAP-RPT-PRINT-YES-88 TO TRUE.                        DTSCS1C
06144                                                                   DTSCS1C
06145      IF MAP-RPT-PRINT-VALID-88                                    DTSCS1C
06146          NEXT SENTENCE                                            DTSCS1C
06147      ELSE                                                         DTSCS1C
06148          MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS1C
06149          PERFORM S4001-ERROR THRU S4001-EXIT                      DTSCS1C
06150          GO TO S4000-EXIT.                                        DTSCS1C
06151                                                                   DTSCS1C
06152      IF MAP-RPT-PRINT-NO-88                                       DTSCS1C
06153          IF WRK-WAIVER-START-YRQ = +0                             DTSCS1C
06154              NEXT SENTENCE                                        DTSCS1C
06155          ELSE                                                     DTSCS1C
06156              MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA                 DTSCS1C
06157              PERFORM S4001-ERROR THRU S4001-EXIT                  DTSCS1C
06158              PERFORM S3701-ERROR THRU S3701-EXIT.                 DTSCS1C
06159  S4000-EXIT.                                                      DTSCS1C
06160      EXIT.                                                        DTSCS1C
06161      SKIP3                                                        DTSCS1C
06162  S4001-ERROR.                                                     DTSCS1C
06163      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-RPT-PRINT-IND-A.       DTSCS1C
06164                                                                   DTSCS1C
06165      IF LCCM-NO-MSG                                               DTSCS1C
06166          MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                       DTSCS1C
06167          MOVE CATB-CURSOR TO MAP-RPT-PRINT-IND-L                  DTSCS1C
06168          SET CURSOR-SET-YES TO TRUE.                              DTSCS1C
06169  S4001-EXIT.                                                      DTSCS1C
06170      EXIT.                                                        DTSCS1C
06171 /*****************************************************************DTSCS1C
06172 *                                                                 DTSCS1C
06173 ******************************************************************DTSCS1C
06174  S4100-WELCOME-LTR-IND.                                           DTSCS1C
06175      IF MAP-WELCOME-LTR-IND = LOW-VALUES                          DTSCS1C
06176          MOVE SPACES TO MAP-WELCOME-LTR-IND.                      DTSCS1C
06177                                                                   DTSCS1C
06178      IF MAP-UI-LIABLE-YES-88                                      DTSCS1C
06179          IF MAP-WELCOME-LTR-IND = SPACES                          DTSCS1C
06180              PERFORM S4110-SET-DEFAULT THRU S4110-EXIT            DTSCS1C
06181          ELSE                                                     DTSCS1C
06182          IF MAP-WELCOME-LTR-VALID-88                              DTSCS1C
06183              NEXT SENTENCE                                        DTSCS1C
06184          ELSE                                                     DTSCS1C
06185              MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA            DTSCS1C
06186              PERFORM S4101-ERROR THRU S4101-EXIT                  DTSCS1C
06187      ELSE                                                         DTSCS1C
06188      IF MAP-UI-LIABLE-NO-88                                       DTSCS1C
06189          IF MAP-WELCOME-LTR-IND = SPACES                          DTSCS1C
06190              NEXT SENTENCE                                        DTSCS1C
06191          ELSE                                                     DTSCS1C
06192              MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA          DTSCS1C
06193              PERFORM S4101-ERROR THRU S4101-EXIT                  DTSCS1C
06194      ELSE                                                         DTSCS1C
06195          NEXT SENTENCE.                                           DTSCS1C
06196  S4100-EXIT.                                                      DTSCS1C
06197      EXIT.                                                        DTSCS1C
06198      SKIP3                                                        DTSCS1C
06199  S4101-ERROR.                                                     DTSCS1C
06200      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-WELCOME-LTR-IND-A.     DTSCS1C
06201                                                                   DTSCS1C
06202      IF LCCM-NO-MSG                                               DTSCS1C
06203          MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                       DTSCS1C
06204          MOVE CATB-CURSOR TO MAP-WELCOME-LTR-IND-L                DTSCS1C
06205          SET CURSOR-SET-YES TO TRUE.                              DTSCS1C
06206  S4101-EXIT.                                                      DTSCS1C
06207      EXIT.                                                        DTSCS1C
06208      SKIP3                                                        DTSCS1C
06209  S4110-SET-DEFAULT.                                               DTSCS1C
06210      MOVE LOW-VALUES TO MSOL-KEY-AREA.                            DTSCS1C
06211                                                                   DTSCS1C
06212      MOVE WRK-EMP-NO TO MSOL-EMP-NO.                              DTSCS1C
06213                                                                   DTSCS1C
06214      SET MSOL-SOL-88 TO TRUE.                                     DTSCS1C
06215                                                                   DTSCS1C
06216      MOVE +0 TO MSOL-LIAB-DATE.                                   DTSCS1C
06217                                                                   DTSCS1C
06218      MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS1C
06219                                                                   DTSCS1C
06220      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS1C
06221                                                                   DTSCS1C
06222      IF L810-NO-REC-88                                            DTSCS1C
06223          SET MAP-WELCOME-LTR-YES-88 TO TRUE                       DTSCS1C
06224      ELSE                                                         DTSCS1C
06225          PERFORM S810-END-BROWSE THRU S810-EXIT                   DTSCS1C
06226          SET MAP-WELCOME-LTR-NO-88 TO TRUE.                       DTSCS1C
06227  S4110-EXIT.                                                      DTSCS1C
06228      EXIT.                                                        DTSCS1C
06229 /*****************************************************************DTSCS1C
06230 *                                                                 DTSCS1C
06231 ******************************************************************DTSCS1C
06232  S4300-RESP-OP-ID.                                                DTSCS1C
06233 ** MODIFIED TO SET RESP-OP-ID TO USER CURRENTLY SIGNED ON,        DTSCS1C
06234 ** UNLESS USER HAS SET MAP-RESP-OP-ID.                            DTSCS1C
06235 ** REQUEST FROM STATUS UNIT. 12/09/2002  GD                       DTSCS1C
06236      IF MAP-RESP-OP-ID = LOW-VALUES OR SPACES                     DTSCS1C
06237 **       MOVE LCCM-RESP-OP-ID TO MAP-RESP-OP-ID.                  DTSCS1C
06238          MOVE LCCM-OP-ID      TO MAP-RESP-OP-ID.                  DTSCS1C
06239                                                                   DTSCS1C
06240                                                                   DTSCS1C
06241      IF MAP-RESP-OP-ID = LCCM-OP-ID                               DTSCS1C
06242          MOVE MAP-RESP-OP-ID TO LCCM-RESP-OP-ID                   DTSCS1C
06243          GO TO S4300-EXIT.                                        DTSCS1C
06244                                                                   DTSCS1C
06245                                                                   DTSCS1C
06246      MOVE MAP-RESP-OP-ID TO L082-OP-ID.                           DTSCS1C
06247                                                                   DTSCS1C
06248      PERFORM S082-OP-ID-LOOKUP THRU S082-EXIT.                    DTSCS1C
06249                                                                   DTSCS1C
06250      IF (L082-VALID-OP) AND (L082-EXTERNAL-88)                    DTSCS1C
06251          MOVE MAP-RESP-OP-ID TO LCCM-RESP-OP-ID                   DTSCS1C
06252      ELSE                                                         DTSCS1C
06253          MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS1C
06254          PERFORM S4301-ERROR THRU S4301-EXIT.                     DTSCS1C
06255  S4300-EXIT. EXIT.                                                DTSCS1C
06256      SKIP3                                                        DTSCS1C
06257  S4301-ERROR.                                                     DTSCS1C
06258      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-RESP-OP-ID-A.          DTSCS1C
06259                                                                   DTSCS1C
06260      IF LCCM-NO-MSG                                               DTSCS1C
06261         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS1C
06262         MOVE CATB-CURSOR TO MAP-RESP-OP-ID-L                      DTSCS1C
06263         SET CURSOR-SET-YES TO TRUE.                               DTSCS1C
06264  S4301-EXIT. EXIT.                                                DTSCS1C
06265 /*****************************************************************DTSCS1C
06266 *                                                                 DTSCS1C
06267 ******************************************************************DTSCS1C
06268  S4400-PRED-EMP-NO.                                               DTSCS1C
06269      MOVE MAP-PRED-EMP-NO-AREA TO L018-S-EMP-NO-AREA.             DTSCS1C
06270                                                                   DTSCS1C
06271      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS1C
06272                                                                   DTSCS1C
06273      IF L018-NO-ENTRY                                             DTSCS1C
06274         GO TO S4400-EXIT                                          DTSCS1C
06275      ELSE                                                         DTSCS1C
06276         IF NOT L084-VALID-APPROVAL-88                             DTSCS1C
06277            MOVE MSG-E1CU-AREA           TO WRK-MSG-AREA           DTSCS1C
06278            PERFORM S4401-ERROR          THRU S4401-EXIT           DTSCS1C
06279         END-IF                                                    DTSCS1C
06280      END-IF.                                                      DTSCS1C
06281                                                                   DTSCS1C
06282      IF L018-NOT-VALID                                            DTSCS1C
06283         MOVE EMSG-FIELD-NOT-VALID       TO WRK-MSG-AREA           DTSCS1C
06284         PERFORM S4401-ERROR             THRU S4401-EXIT           DTSCS1C
06285      ELSE                                                         DTSCS1C
06286         IF L018-EMP-NO = WRK-EMP-NO                               DTSCS1C
06287            MOVE EMSG-FIELD-NOT-VALID    TO WRK-MSG-AREA           DTSCS1C
06288            PERFORM S4401-ERROR          THRU S4401-EXIT           DTSCS1C
06289         ELSE                                                      DTSCS1C
06290            PERFORM S4410-CHECK-FILE     THRU S4410-EXIT           DTSCS1C
06291         END-IF                                                    DTSCS1C
06292      END-IF.                                                      DTSCS1C
06293                                                                   DTSCS1C
06294  S4400-EXIT. EXIT.                                                DTSCS1C
06295      SKIP3                                                        DTSCS1C
06296  S4401-ERROR.                                                     DTSCS1C
06297      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-PRED-EMP-NO-1-A       DTSCS1C
06298                                         MAP-PRED-EMP-NO-2-A.      DTSCS1C
06299                                                                   DTSCS1C
06300      IF LCCM-NO-MSG                                               DTSCS1C
06301         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS1C
06302         MOVE CATB-CURSOR TO MAP-PRED-EMP-NO-1-L                   DTSCS1C
06303         SET CURSOR-SET-YES TO TRUE.                               DTSCS1C
06304  S4401-EXIT. EXIT.                                                DTSCS1C
06305      SKIP3                                                        DTSCS1C
06306  S4410-CHECK-FILE.                                                DTSCS1C
06307      MOVE LOW-VALUES TO MPRF-REC.                                 DTSCS1C
06308                                                                   DTSCS1C
06309      MOVE L018-EMP-NO TO MPRF-EMP-NO.                             DTSCS1C
06310                                                                   DTSCS1C
06311      SET MPRF-PRF-88 TO TRUE.                                     DTSCS1C
06312                                                                   DTSCS1C
06313      MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS1C
06314                                                                   DTSCS1C
06315      PERFORM S810-READ THRU S810-EXIT.                            DTSCS1C
06316                                                                   DTSCS1C
06317      IF L810-NO-REC-88                                            DTSCS1C
06318          MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA                    DTSCS1C
06319          PERFORM S4401-ERROR THRU S4401-EXIT                      DTSCS1C
06320      ELSE                                                         DTSCS1C
06321          MOVE L018-EMP-NO TO WRK-PRED-EMP-NO                      DTSCS1C
06322          MOVE MSKL-REC TO MPRF-REC.                               DTSCS1C
06323  S4410-EXIT. EXIT.                                                DTSCS1C
06324 /*****************************************************************DTSCS1C
06325 * OPTIONAL CODE IF LIABLE-IND = 'Y' AND PRED-EMP-NO ENTERED      *DTSCS1C
06326 ******************************************************************DTSCS1C
06327  S4500-PRED-INACT-CD.                                             DTSCS1C
06328      IF MAP-PRED-INACT-CD = LOW-VALUES                            DTSCS1C
06329          MOVE SPACES TO MAP-PRED-INACT-CD.                        DTSCS1C
06330                                                                   DTSCS1C
06331      IF MAP-PRED-INACT-CD = SPACES                                DTSCS1C
06332         PERFORM S4502-PRED-NOT-INACT THRU S4502-EXIT              DTSCS1C
06333      ELSE                                                         DTSCS1C
06334      IF MAP-UI-LIABLE-NO-88                                       DTSCS1C
06335         MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA               DTSCS1C
06336         PERFORM S4501-ERROR THRU S4501-EXIT                       DTSCS1C
06337      ELSE                                                         DTSCS1C
06338      IF WRK-PRED-EMP-NO = ZERO                                    DTSCS1C
06339         MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA               DTSCS1C
06340         PERFORM S4501-ERROR THRU S4501-EXIT                       DTSCS1C
06341      ELSE                                                         DTSCS1C
06342         MOVE MAP-PRED-INACT-CD TO L031-CD                         DTSCS1C
06343         SET L031-MSOL-INACT-CD TO TRUE                            DTSCS1C
06344         PERFORM S031-REG-CODES THRU S031-EXIT                     DTSCS1C
06345         IF L031-NOT-VALID                                         DTSCS1C
06346            MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA              DTSCS1C
06347            PERFORM S4501-ERROR THRU S4501-EXIT                    DTSCS1C
06348         ELSE                                                      DTSCS1C
06349            PERFORM S4510-CROSS-EDITS THRU S4510-EXIT.             DTSCS1C
06350  S4500-EXIT. EXIT.                                                DTSCS1C
06351      SKIP3                                                        DTSCS1C
06352  S4501-ERROR.                                                     DTSCS1C
06353      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-PRED-INACT-CD-A.      DTSCS1C
06354      IF LCCM-NO-MSG                                               DTSCS1C
06355         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS1C
06356         MOVE CATB-CURSOR TO MAP-PRED-INACT-CD-L                   DTSCS1C
06357         SET CURSOR-SET-YES TO TRUE.                               DTSCS1C
06358  S4501-EXIT. EXIT.                                                DTSCS1C
06359      SKIP3                                                        DTSCS1C
06360  S4502-PRED-NOT-INACT.                                            DTSCS1C
06361      IF MAP-TRANSFER-VALID-88                                     DTSCS1C
06362          IF MAP-TRANSFER-NA-88                                    DTSCS1C
06363              NEXT SENTENCE                                        DTSCS1C
06364          ELSE                                                     DTSCS1C
06365              MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA                 DTSCS1C
06366              PERFORM S3301-ERROR THRU S3301-EXIT                  DTSCS1C
06367              PERFORM S4501-ERROR THRU S4501-EXIT.                 DTSCS1C
06368  S4502-EXIT.                                                      DTSCS1C
06369      EXIT.                                                        DTSCS1C
06370      SKIP3                                                        DTSCS1C
06371  S4510-CROSS-EDITS.                                               DTSCS1C
06372      IF MPRF-STATUS-ACT-88                                        DTSCS1C
06373          NEXT SENTENCE                                            DTSCS1C
06374      ELSE                                                         DTSCS1C
06375          MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA              DTSCS1C
06376          PERFORM S4501-ERROR THRU S4501-EXIT                      DTSCS1C
06377          GO TO S4510-EXIT.                                        DTSCS1C
06378                                                                   DTSCS1C
06379      IF MPRF-NOT-WRITTEN-OFF-88                                   DTSCS1C
06380          NEXT SENTENCE                                            DTSCS1C
06381      ELSE                                                         DTSCS1C
06382          MOVE EMSG-EMP-WRITTEN-OFF TO WRK-MSG-AREA                DTSCS1C
06383          PERFORM S4501-ERROR THRU S4501-EXIT                      DTSCS1C
06384          GO TO S4510-EXIT.                                        DTSCS1C
06385                                                                   DTSCS1C
06386      MOVE LOW-VALUES TO MSOL-KEY-AREA.                            DTSCS1C
06387                                                                   DTSCS1C
06388      MOVE WRK-PRED-EMP-NO TO MSOL-EMP-NO.                         DTSCS1C
06389                                                                   DTSCS1C
06390      SET MSOL-SOL-88 TO TRUE.                                     DTSCS1C
06391                                                                   DTSCS1C
06392      MOVE +0 TO MSOL-LIAB-DATE.                                   DTSCS1C
06393                                                                   DTSCS1C
06394      MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS1C
06395                                                                   DTSCS1C
06396      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS1C
06397                                                                   DTSCS1C
06398                                                                   DTSCS1C
06399      MOVE +0 TO TBL-CNT.                                          DTSCS1C
06400                                                                   DTSCS1C
06401      PERFORM S4511-BROWSE-MSOL THRU S4511-EXIT                    DTSCS1C
06402          UNTIL L810-NO-REC-88.                                    DTSCS1C
06403                                                                   DTSCS1C
06404      IF LCCM-MSG                                                  DTSCS1C
06405          GO TO S4510-EXIT.                                        DTSCS1C
06406                                                                   DTSCS1C
06407                                                                   DTSCS1C
06408      MOVE +0 TO WRK-PRED-WITHDRAW-CNT                             DTSCS1C
06409                 WRK-PRED-TRANSFER-CNT.                            DTSCS1C
06410                                                                   DTSCS1C
06411      MOVE LOW-VALUES TO MQTR-KEY-AREA.                            DTSCS1C
06412                                                                   DTSCS1C
06413      MOVE WRK-PRED-EMP-NO TO MQTR-EMP-NO.                         DTSCS1C
06414                                                                   DTSCS1C
06415      SET MQTR-QTR-88 TO TRUE.                                     DTSCS1C
06416                                                                   DTSCS1C
06417      MOVE +0 TO MQTR-YRQ.                                         DTSCS1C
06418                                                                   DTSCS1C
06419      MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS1C
06420                                                                   DTSCS1C
06421      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS1C
06422                                                                   DTSCS1C
06423      PERFORM                                                      DTSCS1C
06424        UNTIL L810-NO-REC-88                                       DTSCS1C
06425          MOVE MSKL-REC TO MQTR-REC                                DTSCS1C
06426          PERFORM S4514-PROCESS-QTR THRU S4514-EXIT                DTSCS1C
06427          PERFORM S810-READ-NEXT THRU S810-EXIT                    DTSCS1C
06428      END-PERFORM.                                                 DTSCS1C
06429                                                                   DTSCS1C
06430      IF MAP-TRANSFER-YES-88                                       DTSCS1C
06431          IF WRK-PRED-WITHDRAW-CNT = +0                            DTSCS1C
06432              MOVE MSG-E1CD-AREA TO WRK-MSG-AREA                   DTSCS1C
06433              PERFORM S3301-ERROR THRU S3301-EXIT                  DTSCS1C
06434          ELSE                                                     DTSCS1C
06435              IF WRK-PRED-TRANSFER-CNT = +0                        DTSCS1C
06436                  MOVE MSG-E1CE-AREA TO WRK-MSG-AREA               DTSCS1C
06437                  PERFORM S3301-ERROR THRU S3301-EXIT              DTSCS1C
06438              ELSE                                                 DTSCS1C
06439                  NEXT SENTENCE                                    DTSCS1C
06440      ELSE                                                         DTSCS1C
06441      IF MAP-TRANSFER-NO-88                                        DTSCS1C
06442          IF WRK-PRED-WITHDRAW-CNT = +0                            DTSCS1C
06443              MOVE MSG-E1CD-AREA TO WRK-MSG-AREA                   DTSCS1C
06444              PERFORM S3301-ERROR THRU S3301-EXIT                  DTSCS1C
06445          ELSE                                                     DTSCS1C
06446              NEXT SENTENCE                                        DTSCS1C
06447      ELSE                                                         DTSCS1C
06448          IF WRK-PRED-WITHDRAW-CNT = +0                            DTSCS1C
06449              NEXT SENTENCE                                        DTSCS1C
06450          ELSE                                                     DTSCS1C
06451              MOVE MSG-E1C9-AREA TO WRK-MSG-AREA                   DTSCS1C
06452              PERFORM S3301-ERROR THRU S3301-EXIT.                 DTSCS1C
06453  S4510-EXIT. EXIT.                                                DTSCS1C
06454      SKIP3                                                        DTSCS1C
06455  S4511-BROWSE-MSOL.                                               DTSCS1C
06456      MOVE MSKL-REC TO MSOL-REC.                                   DTSCS1C
06457                                                                   DTSCS1C
06458      IF MSOL-INACT-ACTIVE-88                                      DTSCS1C
06459          PERFORM S4512-ACTIVE THRU S4512-EXIT                     DTSCS1C
06460          PERFORM S4513-TABLE THRU S4513-EXIT                      DTSCS1C
06461      ELSE                                                         DTSCS1C
06462          PERFORM S4513-TABLE THRU S4513-EXIT.                     DTSCS1C
06463                                                                   DTSCS1C
06464      PERFORM S810-READ-NEXT THRU S810-EXIT.                       DTSCS1C
06465  S4511-EXIT.                                                      DTSCS1C
06466      EXIT.                                                        DTSCS1C
06467      SKIP3                                                        DTSCS1C
06468  S4512-ACTIVE.                                                    DTSCS1C
06469      IF WRK-LIAB-DATE NOT > MSOL-LIAB-DATE                        DTSCS1C
06470          MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS1C
06471          PERFORM S4501-ERROR THRU S4501-EXIT                      DTSCS1C
06472          GO TO S4512-EXIT.                                        DTSCS1C
06473                                                                   DTSCS1C
06474                                                                   DTSCS1C
06475      MOVE WRK-LIAB-DATE TO L001-FED-8-DATE-9.                     DTSCS1C
06476                                                                   DTSCS1C
06477      SET L001-FROM-FED-8 TO TRUE.                                 DTSCS1C
06478                                                                   DTSCS1C
06479      PERFORM S001-DATE THRU S001-EXIT.                            DTSCS1C
06480                                                                   DTSCS1C
06481      SUBTRACT 1 FROM L001-JUL-ABS-DAY.                            DTSCS1C
06482                                                                   DTSCS1C
06483      SET L001-FROM-ABS-DAY TO TRUE.                               DTSCS1C
06484                                                                   DTSCS1C
06485      PERFORM S001-DATE THRU S001-EXIT.                            DTSCS1C
06486                                                                   DTSCS1C
06487      MOVE L001-FED-8-DATE-9 TO MSOL-INACT-DATE.                   DTSCS1C
06488                                                                   DTSCS1C
06489      SET L004-FROM-DATE TO TRUE.                                  DTSCS1C
06490                                                                   DTSCS1C
06491      MOVE MSOL-INACT-DATE TO L004-DATE.                           DTSCS1C
06492                                                                   DTSCS1C
06493      PERFORM S004-YRQ THRU S004-EXIT.                             DTSCS1C
06494                                                                   DTSCS1C
06495      MOVE L004-QTR-5-9 TO MSOL-LAST-LIAB-YRQ.                     DTSCS1C
06496                                                                   DTSCS1C
06497      MOVE MAP-PRED-INACT-CD TO MSOL-INACT-CD.                     DTSCS1C
06498  S4512-EXIT.                                                      DTSCS1C
06499      EXIT.                                                        DTSCS1C
06500      SKIP3                                                        DTSCS1C
06501  S4513-TABLE.                                                     DTSCS1C
06502      IF TBL-CNT < +50                                             DTSCS1C
06503          NEXT SENTENCE                                            DTSCS1C
06504      ELSE                                                         DTSCS1C
06505          GO TO S4513-EXIT.                                        DTSCS1C
06506                                                                   DTSCS1C
06507                                                                   DTSCS1C
06508      IF (MSOL-INACT-WITHDRAWN-88)                                 DTSCS1C
06509             OR                                                    DTSCS1C
06510         (MSOL-FIRST-LIAB-YRQ = +0)                                DTSCS1C
06511          GO TO S4513-EXIT.                                        DTSCS1C
06512                                                                   DTSCS1C
06513                                                                   DTSCS1C
06514      ADD +1 TO TBL-CNT.                                           DTSCS1C
06515                                                                   DTSCS1C
06516      MOVE MSOL-FIRST-LIAB-YRQ TO TBL-FIRST-YRQ (TBL-CNT).         DTSCS1C
06517                                                                   DTSCS1C
06518      MOVE MSOL-LAST-LIAB-YRQ TO TBL-LAST-YRQ (TBL-CNT).           DTSCS1C
06519  S4513-EXIT.                                                      DTSCS1C
06520      EXIT.                                                        DTSCS1C
06521      SKIP3                                                        DTSCS1C
06522  S4514-PROCESS-QTR.                                               DTSCS1C
06523      MOVE 'Y' TO WRK-PRED-WITHDRAW-IND.                           DTSCS1C
06524                                                                   DTSCS1C
06525      IF MQTR-CURR-ESTIM-88 OR MQTR-CURR-RCVD-88                   DTSCS1C
06526          PERFORM                                                  DTSCS1C
06527            VARYING WRK-SUB1 FROM 1 BY 1                           DTSCS1C
06528            UNTIL (WRK-SUB1 > TBL-CNT)                             DTSCS1C
06529                      OR                                           DTSCS1C
06530                  (WRK-PRED-WITHDRAW-IND = 'N')                    DTSCS1C
06531              IF (MQTR-YRQ < TBL-FIRST-YRQ (WRK-SUB1))             DTSCS1C
06532                    OR                                             DTSCS1C
06533                 (MQTR-YRQ > TBL-LAST-YRQ (WRK-SUB1))              DTSCS1C
06534                  CONTINUE                                         DTSCS1C
06535              ELSE                                                 DTSCS1C
06536                  MOVE 'N' TO WRK-PRED-WITHDRAW-IND                DTSCS1C
06537              END-IF                                               DTSCS1C
06538          END-PERFORM                                              DTSCS1C
06539      ELSE                                                         DTSCS1C
06540          MOVE 'N' TO WRK-PRED-WITHDRAW-IND.                       DTSCS1C
06541                                                                   DTSCS1C
06542      IF WRK-PRED-WITHDRAW-IND = 'N'                               DTSCS1C
06543          GO TO S4514-EXIT.                                        DTSCS1C
06544                                                                   DTSCS1C
06545      ADD +1 TO WRK-PRED-WITHDRAW-CNT.                             DTSCS1C
06546                                                                   DTSCS1C
06547      IF MQTR-CURR-ESTIM-88                                        DTSCS1C
06548          GO TO S4514-EXIT.                                        DTSCS1C
06549                                                                   DTSCS1C
06550      IF MAP-TRANSFER-YES-88                                       DTSCS1C
06551          NEXT SENTENCE                                            DTSCS1C
06552      ELSE                                                         DTSCS1C
06553          GO TO S4514-EXIT.                                        DTSCS1C
06554                                                                   DTSCS1C
06555      IF (MQTR-YRQ < WRK-FIRST-LIAB-YRQ)                           DTSCS1C
06556            OR                                                     DTSCS1C
06557         (MQTR-YRQ > WRK-LAST-LIAB-YRQ)                            DTSCS1C
06558          NEXT SENTENCE                                            DTSCS1C
06559      ELSE                                                         DTSCS1C
06560          ADD +1 TO WRK-PRED-TRANSFER-CNT                          DTSCS1C
06561          GO TO S4514-EXIT.                                        DTSCS1C
06562                                                                   DTSCS1C
06563      PERFORM S810-END-BROWSE THRU S810-EXIT.                      DTSCS1C
06564                                                                   DTSCS1C
06565      MOVE 'N' TO WRK-PRED-TRANSFER-IND.                           DTSCS1C
06566                                                                   DTSCS1C
06567      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSCS1C
06568                                                                   DTSCS1C
06569      MOVE WRK-EMP-NO TO MSKL-EMP-NO.                              DTSCS1C
06570                                                                   DTSCS1C
06571      SET MSKL-SOL-88 TO TRUE.                                     DTSCS1C
06572                                                                   DTSCS1C
06573      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS1C
06574                                                                   DTSCS1C
06575      PERFORM                                                      DTSCS1C
06576        UNTIL L810-NO-REC-88                                       DTSCS1C
06577          MOVE MSKL-REC TO MSOL-REC                                DTSCS1C
06578          PERFORM S4514A-CHECK-MSOL THRU S4514A-EXIT               DTSCS1C
06579          PERFORM S810-READ-NEXT THRU S810-EXIT                    DTSCS1C
06580      END-PERFORM.                                                 DTSCS1C
06581                                                                   DTSCS1C
06582      IF WRK-PRED-TRANSFER-IND = 'Y'                               DTSCS1C
06583          PERFORM S4514B-CHECK-MQTR THRU S4514B-EXIT.              DTSCS1C
06584                                                                   DTSCS1C
06585      MOVE WRK-PRED-EMP-NO TO MQTR-EMP-NO.                         DTSCS1C
06586                                                                   DTSCS1C
06587      MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS1C
06588                                                                   DTSCS1C
06589      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS1C
06590  S4514-EXIT.                                                      DTSCS1C
06591      EXIT.                                                        DTSCS1C
06592      SKIP3                                                        DTSCS1C
06593  S4514A-CHECK-MSOL.                                               DTSCS1C
06594      IF (MQTR-YRQ < MSOL-FIRST-LIAB-YRQ)                          DTSCS1C
06595             OR                                                    DTSCS1C
06596         (MQTR-YRQ > MSOL-LAST-LIAB-YRQ)                           DTSCS1C
06597          NEXT SENTENCE                                            DTSCS1C
06598      ELSE                                                         DTSCS1C
06599          MOVE 'Y' TO WRK-PRED-TRANSFER-IND.                       DTSCS1C
06600  S4514A-EXIT.                                                     DTSCS1C
06601      EXIT.                                                        DTSCS1C
06602      SKIP3                                                        DTSCS1C
06603  S4514B-CHECK-MQTR.                                               DTSCS1C
06604      MOVE WRK-EMP-NO TO MQTR-EMP-NO.                              DTSCS1C
06605                                                                   DTSCS1C
06606      MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS1C
06607                                                                   DTSCS1C
06608      PERFORM S810-READ THRU S810-EXIT.                            DTSCS1C
06609                                                                   DTSCS1C
06610      IF L810-NO-REC-88                                            DTSCS1C
06611          ADD +1 TO WRK-PRED-TRANSFER-CNT                          DTSCS1C
06612          GO TO S4514B-EXIT.                                       DTSCS1C
06613                                                                   DTSCS1C
06614      MOVE MSKL-REC TO MQTR-REC.                                   DTSCS1C
06615                                                                   DTSCS1C
06616      IF MQTR-CURR-RCVD-88                                         DTSCS1C
06617          GO TO S4514B-EXIT.                                       DTSCS1C
06618                                                                   DTSCS1C
06619      ADD +1 TO WRK-PRED-TRANSFER-CNT.                             DTSCS1C
06620  S4514B-EXIT.                                                     DTSCS1C
06621      EXIT.                                                        DTSCS1C
06622 /*****************************************************************DTSCS1C
06623 *                                                                 DTSCS1C
06624 ******************************************************************DTSCS1C
06625  S4600-PRED-INACT-LTR-TYPE.                                       DTSCS1C
06626      IF MAP-PRED-INACT-LTR-TYPE = LOW-VALUES                      DTSCS1C
06627          MOVE SPACES TO MAP-PRED-INACT-LTR-TYPE.                  DTSCS1C
06628                                                                   DTSCS1C
06629      IF MAP-PRED-INACT-LTR-TYPE = SPACES OR LOW-VALUES            DTSCS1C
06630          IF MAP-PRED-INACT-CD = SPACES OR LOW-VALUES              DTSCS1C
06631              NEXT SENTENCE                                        DTSCS1C
06632          ELSE                                                     DTSCS1C
06633 *************SET MAP-PRED-INACT-LTR-DEFAULT-88 TO TRUE            DTSCS1C
06634              MOVE EMSG-FIELD-REQUIRED    TO WRK-MSG-AREA          DTSCS1C
06635              PERFORM S4601-ERROR THRU S4601-EXIT                  DTSCS1C
06636      ELSE                                                         DTSCS1C
06637          IF MAP-PRED-INACT-CD = SPACES OR LOW-VALUES              DTSCS1C
06638              MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA          DTSCS1C
06639              PERFORM S4601-ERROR THRU S4601-EXIT                  DTSCS1C
06640          ELSE                                                     DTSCS1C
06641              IF MAP-PRED-INACT-LTR-VALID-88                       DTSCS1C
06642                  NEXT SENTENCE                                    DTSCS1C
06643              ELSE                                                 DTSCS1C
06644                  MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA        DTSCS1C
06645                  PERFORM S4601-ERROR THRU S4601-EXIT.             DTSCS1C
06646  S4600-EXIT.                                                      DTSCS1C
06647      EXIT.                                                        DTSCS1C
06648      SKIP3                                                        DTSCS1C
06649  S4601-ERROR.                                                     DTSCS1C
06650      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-PRED-INACT-LTR-TYPE-A. DTSCS1C
06651                                                                   DTSCS1C
06652      IF LCCM-NO-MSG                                               DTSCS1C
06653          MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                       DTSCS1C
06654          MOVE CATB-CURSOR TO MAP-PRED-INACT-LTR-TYPE-L            DTSCS1C
06655          SET CURSOR-SET-YES TO TRUE.                              DTSCS1C
06656  S4601-EXIT.                                                      DTSCS1C
06657      EXIT.                                                        DTSCS1C
06658 /*****************************************************************DTSCS1C
06659 *                                                                 DTSCS1C
06660 ******************************************************************DTSCS1C
06661  S4800-RELATIONSHIP.                                              DTSCS1C
06662      PERFORM S4810-RELATIONSHIP-CD THRU S4810-EXIT.               DTSCS1C
06663                                                                   DTSCS1C
06664      PERFORM S4820-EXP-TRNSF-CD THRU S4820-EXIT.                  DTSCS1C
06665  S4800-EXIT.                                                      DTSCS1C
06666      EXIT.                                                        DTSCS1C
06667 /*****************************************************************DTSCS1C
06668 * OPTIONAL CODE IF LIABLE-IND = 'Y' AND PRED-EMP-NO ENTERED      *DTSCS1C
06669 ******************************************************************DTSCS1C
06670  S4810-RELATIONSHIP-CD.                                           DTSCS1C
06671      IF MAP-RELATIONSHIP-CD = LOW-VALUES                          DTSCS1C
06672          MOVE SPACES TO MAP-RELATIONSHIP-CD.                      DTSCS1C
06673                                                                   DTSCS1C
06674      IF MAP-RELATIONSHIP-CD = SPACES                              DTSCS1C
06675         NEXT SENTENCE                                             DTSCS1C
06676      ELSE                                                         DTSCS1C
06677      IF MAP-UI-LIABLE-NO-88                                       DTSCS1C
06678         MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA               DTSCS1C
06679         PERFORM S4811-ERROR THRU S4811-EXIT                       DTSCS1C
06680      ELSE                                                         DTSCS1C
06681      IF WRK-PRED-EMP-NO = ZERO                                    DTSCS1C
06682         MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA               DTSCS1C
06683         PERFORM S4811-ERROR THRU S4811-EXIT                       DTSCS1C
06684      ELSE                                                         DTSCS1C
06685         MOVE MAP-RELATIONSHIP-CD TO L031-CD                       DTSCS1C
06686         SET L031-MREL-RELATIONSHIP-CD TO TRUE                     DTSCS1C
06687         PERFORM S031-REG-CODES THRU S031-EXIT                     DTSCS1C
06688         IF L031-NOT-VALID                                         DTSCS1C
06689            MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA              DTSCS1C
06690            PERFORM S4811-ERROR THRU S4811-EXIT                    DTSCS1C
06691         ELSE                                                      DTSCS1C
06692         IF WRK-LIAB-DATE > +0                                     DTSCS1C
06693            MOVE LOW-VALUES TO MREL-KEY-AREA                       DTSCS1C
06694            MOVE WRK-EMP-NO TO MREL-EMP-NO                         DTSCS1C
06695            SET MREL-REL-88 TO TRUE                                DTSCS1C
06696                                                                   DTSCS1C
06697 ***********MOVE WRK-LIAB-DATE TO L001-FED-8-DATE-9                DTSCS1C
06698 ***********SET L001-FROM-FED-8 TO TRUE                            DTSCS1C
06699 ***********PERFORM S001-DATE THRU S001-EXIT                       DTSCS1C
06700 ***********SUBTRACT 1 FROM L001-JUL-ABS-DAY                       DTSCS1C
06701 ***********SET L001-FROM-ABS-DAY TO TRUE                          DTSCS1C
06702 ***********PERFORM S001-DATE THRU S001-EXIT                       DTSCS1C
06703 ***********MOVE L001-FED-8-DATE-9 TO MREL-EFF-DATE                DTSCS1C
06704                                                                   DTSCS1C
06705            MOVE WRK-LIAB-DATE TO MREL-EFF-DATE                    DTSCS1C
06706                                                                   DTSCS1C
06707            MOVE WRK-PRED-EMP-NO TO MREL-PRED-EMP-NO               DTSCS1C
06708            MOVE MREL-KEY-AREA TO MSKL-KEY-AREA                    DTSCS1C
06709            PERFORM S810-READ THRU S810-EXIT                       DTSCS1C
06710            IF L810-OK-88                                          DTSCS1C
06711               MOVE EMSG-RECORD-EXISTS TO WRK-MSG-AREA             DTSCS1C
06712               PERFORM S4811-ERROR THRU S4811-EXIT.                DTSCS1C
06713                                                                   DTSCS1C
06714  S4810-EXIT. EXIT.                                                DTSCS1C
06715      SKIP3                                                        DTSCS1C
06716  S4811-ERROR.                                                     DTSCS1C
06717      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-RELATIONSHIP-CD-A.    DTSCS1C
06718      IF LCCM-NO-MSG                                               DTSCS1C
06719         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS1C
06720         MOVE CATB-CURSOR TO MAP-RELATIONSHIP-CD-L                 DTSCS1C
06721         SET CURSOR-SET-YES TO TRUE.                               DTSCS1C
06722  S4811-EXIT. EXIT.                                                DTSCS1C
06723 /*****************************************************************DTSCS1C
06724 * REQUIRED IF RELATIONSHIP CODE ENTERED                          *DTSCS1C
06725 ******************************************************************DTSCS1C
06726  S4820-EXP-TRNSF-CD.                                              DTSCS1C
06727      IF MAP-EXP-TRNSF-CD = LOW-VALUES                             DTSCS1C
06728          MOVE SPACES TO MAP-EXP-TRNSF-CD.                         DTSCS1C
06729                                                                   DTSCS1C
06730      IF MAP-EXP-TRNSF-CD = SPACES                                 DTSCS1C
06731         IF MAP-RELATIONSHIP-CD = SPACES                           DTSCS1C
06732            NEXT SENTENCE                                          DTSCS1C
06733         ELSE                                                      DTSCS1C
06734            MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA               DTSCS1C
06735            PERFORM S4829-ERROR THRU S4829-EXIT                    DTSCS1C
06736      ELSE                                                         DTSCS1C
06737      IF MAP-UI-LIABLE-NO-88                                       DTSCS1C
06738         MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA               DTSCS1C
06739         PERFORM S4829-ERROR THRU S4829-EXIT                       DTSCS1C
06740      ELSE                                                         DTSCS1C
06741      IF MAP-RELATIONSHIP-CD = SPACES                              DTSCS1C
06742         MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA               DTSCS1C
06743         PERFORM S4829-ERROR THRU S4829-EXIT                       DTSCS1C
06744      ELSE                                                         DTSCS1C
06745      IF WRK-PRED-EMP-NO = +0                                      DTSCS1C
06746         MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA               DTSCS1C
06747         PERFORM S4829-ERROR THRU S4829-EXIT                       DTSCS1C
06748      ELSE                                                         DTSCS1C
06749         IF NOT MAP-EXP-TRNSF-VALID-88                             DTSCS1C
06750             MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA             DTSCS1C
06751             PERFORM S4829-ERROR THRU S4829-EXIT                   DTSCS1C
06752         ELSE                                                      DTSCS1C
06753             IF MAP-EXP-TRNSF-NO-88                                DTSCS1C
06754                 NEXT SENTENCE                                     DTSCS1C
06755             ELSE                                                  DTSCS1C
06756                 PERFORM S4821-EXP-TRNSF-EDITS THRU S4821-EXIT.    DTSCS1C
06757  S4820-EXIT. EXIT.                                                DTSCS1C
06758         SKIP3                                                     DTSCS1C
06759  S4821-EXP-TRNSF-EDITS.                                           DTSCS1C
06760      IF WRK-EMP-CLASS = MPRF-EMP-CLASS                            DTSCS1C
06761          NEXT SENTENCE                                            DTSCS1C
06762      ELSE                                                         DTSCS1C
06763          MOVE MSG-E1C2-AREA TO WRK-MSG-AREA                       DTSCS1C
06764          PERFORM S4829-ERROR THRU S4829-EXIT.                     DTSCS1C
06765                                                                   DTSCS1C
06766      IF (MPRF-STATUS-ACT-88)                                      DTSCS1C
06767             AND                                                   DTSCS1C
06768         (MAP-PRED-INACT-CD = SPACES)                              DTSCS1C
06769          SET WRK-PRED-ACTIVE-YES-88 TO TRUE                       DTSCS1C
06770      ELSE                                                         DTSCS1C
06771          SET WRK-PRED-ACTIVE-NO-88 TO TRUE.                       DTSCS1C
06772                                                                   DTSCS1C
06773      IF WRK-PRED-ACTIVE-YES-88                                    DTSCS1C
06774          MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS1C
06775          PERFORM S4829-ERROR THRU S4829-EXIT                      DTSCS1C
06776          GO TO S4821-EXIT.                                        DTSCS1C
06777                                                                   DTSCS1C
06778                                                                   DTSCS1C
06779      MOVE +0 TO WRK-PRED-MAX-INACT-DATE.                          DTSCS1C
06780                                                                   DTSCS1C
06781      IF (MAP-PRED-INACT-CD = SPACES)                              DTSCS1C
06782            OR                                                     DTSCS1C
06783         (WRK-LIAB-DATE = +0)                                      DTSCS1C
06784          NEXT SENTENCE                                            DTSCS1C
06785      ELSE                                                         DTSCS1C
06786         MOVE WRK-LIAB-DATE TO L001-FED-8-DATE-9                   DTSCS1C
06787         SET L001-FROM-FED-8 TO TRUE                               DTSCS1C
06788         PERFORM S001-DATE THRU S001-EXIT                          DTSCS1C
06789         SUBTRACT 1 FROM L001-JUL-ABS-DAY                          DTSCS1C
06790         SET L001-FROM-ABS-DAY TO TRUE                             DTSCS1C
06791         PERFORM S001-DATE THRU S001-EXIT                          DTSCS1C
06792         MOVE L001-FED-8-DATE-9 TO WRK-PRED-MAX-INACT-DATE.        DTSCS1C
06793                                                                   DTSCS1C
06794                                                                   DTSCS1C
06795      MOVE LOW-VALUES TO MSOL-KEY-AREA.                            DTSCS1C
06796                                                                   DTSCS1C
06797      MOVE WRK-PRED-EMP-NO TO MSOL-EMP-NO.                         DTSCS1C
06798                                                                   DTSCS1C
06799      SET MSOL-SOL-88 TO TRUE.                                     DTSCS1C
06800                                                                   DTSCS1C
06801      MOVE +0 TO MSOL-LIAB-DATE.                                   DTSCS1C
06802                                                                   DTSCS1C
06803      MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS1C
06804                                                                   DTSCS1C
06805      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS1C
06806                                                                   DTSCS1C
06807      PERFORM S4822-SCAN-MSOL THRU S4822-EXIT                      DTSCS1C
06808          UNTIL L810-NO-REC-88.                                    DTSCS1C
06809                                                                   DTSCS1C
06810      IF WRK-LIAB-DATE = +0                                        DTSCS1C
06811          NEXT SENTENCE                                            DTSCS1C
06812      ELSE                                                         DTSCS1C
06813                                                                   DTSCS1C
06814 ********MOVE WRK-LIAB-DATE TO L001-FED-8-DATE-9                   DTSCS1C
06815 ********SET L001-FROM-FED-8 TO TRUE                               DTSCS1C
06816 ********PERFORM S001-DATE THRU S001-EXIT                          DTSCS1C
06817 ********SUBTRACT 1 FROM L001-JUL-ABS-DAY                          DTSCS1C
06818 ********SET L001-FROM-ABS-DAY TO TRUE                             DTSCS1C
06819 ********PERFORM S001-DATE THRU S001-EXIT                          DTSCS1C
06820 ********IF L001-FED-8-DATE-9 < WRK-PRED-MAX-INACT-DATE            DTSCS1C
06821                                                                   DTSCS1C
06822         IF WRK-LIAB-DATE > WRK-PRED-MAX-INACT-DATE                DTSCS1C
06823             NEXT SENTENCE                                         DTSCS1C
06824         ELSE                                                      DTSCS1C
06825                                                                   DTSCS1C
06826             MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA             DTSCS1C
06827             PERFORM S4829-ERROR THRU S4829-EXIT                   DTSCS1C
06828             GO TO S4821-EXIT.                                     DTSCS1C
06829                                                                   DTSCS1C
06830                                                                   DTSCS1C
06831      MOVE LOW-VALUES TO IPES-KEY-AREA.                            DTSCS1C
06832                                                                   DTSCS1C
06833      SET IPES-PES-88 TO TRUE.                                     DTSCS1C
06834                                                                   DTSCS1C
06835      MOVE WRK-PRED-EMP-NO TO IPES-PRED-EMP-NO.                    DTSCS1C
06836                                                                   DTSCS1C
06837      MOVE IPES-KEY-AREA TO ISKL-KEY-AREA.                         DTSCS1C
06838                                                                   DTSCS1C
06839      PERFORM S821-START-BROWSE THRU S821-EXIT.                    DTSCS1C
06840                                                                   DTSCS1C
06841      PERFORM S4823-SCAN-IPES THRU S4823-EXIT                      DTSCS1C
06842          UNTIL L821-NO-REC-88.                                    DTSCS1C
06843                                                                   DTSCS1C
06844      PERFORM S821-END-BROWSE THRU S821-EXIT.                      DTSCS1C
06845  S4821-EXIT.                                                      DTSCS1C
06846      EXIT.                                                        DTSCS1C
06847      SKIP3                                                        DTSCS1C
06848  S4822-SCAN-MSOL.                                                 DTSCS1C
06849      MOVE MSKL-REC TO MSOL-REC.                                   DTSCS1C
06850                                                                   DTSCS1C
06851      IF MSOL-INACT-INACTIVE-88                                    DTSCS1C
06852          IF MSOL-INACT-DATE > WRK-PRED-MAX-INACT-DATE             DTSCS1C
06853              MOVE MSOL-INACT-DATE TO WRK-PRED-MAX-INACT-DATE.     DTSCS1C
06854                                                                   DTSCS1C
06855      PERFORM S810-READ-NEXT THRU S810-EXIT.                       DTSCS1C
06856  S4822-EXIT.                                                      DTSCS1C
06857      EXIT.                                                        DTSCS1C
06858      SKIP3                                                        DTSCS1C
06859  S4823-SCAN-IPES.                                                 DTSCS1C
06860      MOVE ISKL-REC TO IPES-REC.                                   DTSCS1C
06861                                                                   DTSCS1C
06862      IF IPES-PRED-EMP-NO = WRK-PRED-EMP-NO                        DTSCS1C
06863          NEXT SENTENCE                                            DTSCS1C
06864      ELSE                                                         DTSCS1C
06865          SET L821-NO-REC-88 TO TRUE                               DTSCS1C
06866          GO TO S4823-EXIT.                                        DTSCS1C
06867                                                                   DTSCS1C
06868      IF IPES-EXP-TRNSF-YES-88                                     DTSCS1C
06869          MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS1C
06870          PERFORM S4829-ERROR THRU S4829-EXIT.                     DTSCS1C
06871                                                                   DTSCS1C
06872      PERFORM S821-READ-NEXT THRU S821-EXIT.                       DTSCS1C
06873  S4823-EXIT.                                                      DTSCS1C
06874      EXIT.                                                        DTSCS1C
06875      SKIP3                                                        DTSCS1C
06876  S4829-ERROR.                                                     DTSCS1C
06877      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-EXP-TRNSF-CD-A.        DTSCS1C
06878                                                                   DTSCS1C
06879      IF LCCM-NO-MSG                                               DTSCS1C
06880         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS1C
06881         MOVE CATB-CURSOR TO MAP-EXP-TRNSF-CD-L                    DTSCS1C
06882         SET CURSOR-SET-YES TO TRUE.                               DTSCS1C
06883  S4829-EXIT. EXIT.                                                DTSCS1C
06884 /*****************************************************************DTSCS1C
06885 * LOCK SCREEN FOR UPDATE CONFIRMATION                            *DTSCS1C
06886 ******************************************************************DTSCS1C
06887  S5100-SET-LOCK-ATTRB.                                            DTSCS1C
06888      MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN                      DTSCS1C
06889                                 WRK-ATB-NUM.                      DTSCS1C
06890                                                                   DTSCS1C
06891                                                                   DTSCS1C
06892      MOVE MAP-ATTN-LINE-A TO HOLD-ATTN-LINE-A.                    DTSCS1C
06893                                                                   DTSCS1C
06894      MOVE MAP-DELIV-LINE-1-A TO HOLD-DELIV-LINE-1-A.              DTSCS1C
06895                                                                   DTSCS1C
06896      MOVE MAP-DELIV-LINE-2-A TO HOLD-DELIV-LINE-2-A.              DTSCS1C
06897                                                                   DTSCS1C
06898      MOVE MAP-CITY-A TO HOLD-CITY-A.                              DTSCS1C
06899                                                                   DTSCS1C
06900      MOVE MAP-ST-A TO HOLD-ST-A.                                  DTSCS1C
06901                                                                   DTSCS1C
06902      MOVE MAP-ZIP-A TO HOLD-ZIP-A.                                DTSCS1C
06903                                                                   DTSCS1C
06904                                                                   DTSCS1C
06905      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS1C
06906                                                                   DTSCS1C
06907                                                                   DTSCS1C
06908      IF HOLD-ATTN-LINE-A = CATB-UNPROT-NORM-AN-MDTON              DTSCS1C
06909          MOVE CATB-ASKIP-NORM-MDTON TO MAP-ATTN-LINE-A.           DTSCS1C
06910                                                                   DTSCS1C
06911      IF HOLD-DELIV-LINE-1-A = CATB-UNPROT-NORM-AN-MDTON           DTSCS1C
06912          MOVE CATB-ASKIP-NORM-MDTON TO MAP-DELIV-LINE-1-A.        DTSCS1C
06913                                                                   DTSCS1C
06914      IF HOLD-DELIV-LINE-2-A = CATB-UNPROT-NORM-AN-MDTON           DTSCS1C
06915          MOVE CATB-ASKIP-NORM-MDTON TO MAP-DELIV-LINE-2-A.        DTSCS1C
06916                                                                   DTSCS1C
06917      IF HOLD-CITY-A = CATB-UNPROT-NORM-AN-MDTON                   DTSCS1C
06918          MOVE CATB-ASKIP-NORM-MDTON TO MAP-CITY-A.                DTSCS1C
06919                                                                   DTSCS1C
06920      IF HOLD-ST-A = CATB-UNPROT-NORM-AN-MDTON                     DTSCS1C
06921          MOVE CATB-ASKIP-NORM-MDTON TO MAP-ST-A.                  DTSCS1C
06922                                                                   DTSCS1C
06923      IF HOLD-ZIP-A = CATB-UNPROT-NORM-AN-MDTON                    DTSCS1C
06924          MOVE CATB-ASKIP-NORM-MDTON TO MAP-ZIP-A.                 DTSCS1C
06925                                                                   DTSCS1C
06926                                                                   DTSCS1C
06927      MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A                  DTSCS1C
06928                                   MAP-EMP-NO-2-A                  DTSCS1C
06929                                   MAP-GOTO-A.                     DTSCS1C
06930  S5100-EXIT.                                                      DTSCS1C
06931      EXIT.                                                        DTSCS1C
06932      SKIP3                                                        DTSCS1C
06933 ******************************************************************DTSCS1C
06934 * SET ATTIBUTE BYTES FOR UPDATE ACCESS                           *DTSCS1C
06935 ******************************************************************DTSCS1C
06936  S5200-SET-UPDATE-ATTRB.                                          DTSCS1C
06937      MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN.                 DTSCS1C
06938                                                                   DTSCS1C
06939      MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM.               DTSCS1C
06940                                                                   DTSCS1C
06941                                                                   DTSCS1C
06942      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS1C
06943  S5200-EXIT.                                                      DTSCS1C
06944      EXIT.                                                        DTSCS1C
06945      SKIP3                                                        DTSCS1C
06946 ******************************************************************DTSCS1C
06947 *  SET ATTRIBUTE BYTES FOR INQUIRY STATUS                        *DTSCS1C
06948 ******************************************************************DTSCS1C
06949  S5300-SET-INQ-ATTRB.                                             DTSCS1C
06950      MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN                     DTSCS1C
06951                                    WRK-ATB-NUM.                   DTSCS1C
06952                                                                   DTSCS1C
06953      PERFORM S5900-SET-ATTRB THRU S5900-EXIT.                     DTSCS1C
06954  S5300-EXIT.                                                      DTSCS1C
06955      EXIT.                                                        DTSCS1C
06956      SKIP3                                                        DTSCS1C
06957  S5900-SET-ATTRB.                                                 DTSCS1C
06958      MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A             DTSCS1C
06959                                        MAP-EMP-NO-2-A.            DTSCS1C
06960                                                                   DTSCS1C
06961      MOVE WRK-ATB-AN TO MAP-PRIMARY-NAME-A                        DTSCS1C
06962                            MAP-ATTN-LINE-A                        DTSCS1C
06963                            MAP-DELIV-LINE-1-A                     DTSCS1C
06964                            MAP-DELIV-LINE-2-A                     DTSCS1C
06965                            MAP-CASS-IND-A                         DTSCS1C
06966                            MAP-CITY-A                             DTSCS1C
06967                            MAP-ST-A                               DTSCS1C
06968                            MAP-ZIP-A                              DTSCS1C
06969                            MAP-ORG-TYPE-A                         DTSCS1C
06970                            MAP-FILING-SCHED-A                     DTSCS1C
06971                            MAP-UI-LIABLE-IND-A                    DTSCS1C
06972                            MAP-EMP-CLASS-A                        DTSCS1C
06973                            MAP-581-NEW-IND-A                      DTSCS1C
06974                            MAP-INACT-LTR-TYPE-A                   DTSCS1C
06975                            MAP-TRANSFER-IND-A                     DTSCS1C
06976                            MAP-RPT-PRINT-IND-A                    DTSCS1C
06977                            MAP-WELCOME-LTR-IND-A                  DTSCS1C
06978                            MAP-PRED-INACT-LTR-TYPE-A              DTSCS1C
06979                            MAP-EXP-TRNSF-CD-A                     DTSCS1C
06980                            MAP-NOT-LIABLE-LTR-TYPE-A              DTSCS1C
06981                            MAP-RESP-OP-ID-A.                      DTSCS1C
06982                                                                   DTSCS1C
06983      MOVE WRK-ATB-NUM TO MAP-VOICE-1-AREA-CD-A                    DTSCS1C
06984                          MAP-VOICE-1-PREFIX-A                     DTSCS1C
06985                          MAP-VOICE-1-SUFFIX-A                     DTSCS1C
06986                          MAP-VOICE-1-EXT-A                        DTSCS1C
06987                          MAP-VOICE-2-AREA-CD-A                    DTSCS1C
06988                          MAP-VOICE-2-PREFIX-A                     DTSCS1C
06989                          MAP-VOICE-2-SUFFIX-A                     DTSCS1C
06990                          MAP-VOICE-2-EXT-A                        DTSCS1C
06991                          MAP-FAX-AREA-CD-A                        DTSCS1C
06992                          MAP-FAX-PREFIX-A                         DTSCS1C
06993                          MAP-FAX-SUFFIX-A                         DTSCS1C
06994                          MAP-FAX-EXT-A                            DTSCS1C
06995                          MAP-FEIN-1-A                             DTSCS1C
06996                          MAP-FEIN-2-A                             DTSCS1C
06997                          MAP-LIAB-CD-A                            DTSCS1C
06998                          MAP-LIAB-MO-A                            DTSCS1C
06999                          MAP-LIAB-DA-A                            DTSCS1C
07000                          MAP-LIAB-YR-A                            DTSCS1C
07001                          MAP-LIAB-ESTB-MO-A                       DTSCS1C
07002                          MAP-LIAB-ESTB-DA-A                       DTSCS1C
07003                          MAP-LIAB-ESTB-YR-A                       DTSCS1C
07004                          MAP-INACT-CD-A                           DTSCS1C
07005                          MAP-INACT-MO-A                           DTSCS1C
07006                          MAP-INACT-DA-A                           DTSCS1C
07007                          MAP-INACT-YR-A                           DTSCS1C
07008                          MAP-WAIVER-START-YR-A                    DTSCS1C
07009                          MAP-WAIVER-START-Q-A                     DTSCS1C
07010                          MAP-WAIVER-END-YR-A                      DTSCS1C
07011                          MAP-WAIVER-END-Q-A                       DTSCS1C
07012                          MAP-WAIVER-EXT-MO-A                      DTSCS1C
07013                          MAP-WAIVER-EXT-DA-A                      DTSCS1C
07014                          MAP-WAIVER-EXT-YR-A                      DTSCS1C
07015                          MAP-PRED-EMP-NO-1-A                      DTSCS1C
07016                          MAP-PRED-EMP-NO-2-A                      DTSCS1C
07017                          MAP-PRED-INACT-CD-A                      DTSCS1C
07018                          MAP-RELATIONSHIP-CD-A                    DTSCS1C
07019                          MAP-FOLLOWUP-MO-A                        DTSCS1C
07020                          MAP-FOLLOWUP-DA-A                        DTSCS1C
07021                          MAP-FOLLOWUP-YR-A                        DTSCS1C
07022                                                                   DTSCS1C
07023      PERFORM S5910-RTE-LOOP THRU S5910-EXIT                       DTSCS1C
07024          VARYING WRK-SUB1 FROM 1 BY 1                             DTSCS1C
07025          UNTIL WRK-SUB1 > RTE-OCC-MAX.                            DTSCS1C
07026                                                                   DTSCS1C
07027      MOVE CATB-ASKIP-DRK-MDTOFF     TO MAP-VERIFY-A.              DTSCS1C
07028      MOVE CATB-ASKIP-DRK-MDTOFF     TO MAP-VERIFY-LIT-A.          DTSCS1C
07029                                                                   DTSCS1C
07030      MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A.                 DTSCS1C
07031  S5900-EXIT.                                                      DTSCS1C
07032      EXIT.                                                        DTSCS1C
07033      SKIP3                                                        DTSCS1C
07034  S5910-RTE-LOOP.                                                  DTSCS1C
07035      MOVE WRK-ATB-NUM TO MAP-RTE-EFF-YR-A (WRK-SUB1)              DTSCS1C
07036                          MAP-RTE-EFF-Q-A (WRK-SUB1)               DTSCS1C
07037                          MAP-RTE-RATE-A (WRK-SUB1).               DTSCS1C
07038  S5910-EXIT.                                                      DTSCS1C
07039      EXIT.                                                        DTSCS1C
07040      EJECT                                                        DTSCS1C
07041  S6100-SET-LIAB-YRQ.                                              DTSCS1C
07042      MOVE +0 TO WRK-FIRST-LIAB-YRQ.                               DTSCS1C
07043                                                                   DTSCS1C
07044      MOVE ALL-NINES-YRQ TO WRK-LAST-LIAB-YRQ.                     DTSCS1C
07045                                                                   DTSCS1C
07046      IF WRK-LIAB-DATE = +0                                        DTSCS1C
07047          GO TO S6100-EXIT.                                        DTSCS1C
07048                                                                   DTSCS1C
07049                                                                   DTSCS1C
07050      IF MAP-UI-LIABLE-NO-88                                       DTSCS1C
07051          GO TO S6100-EXIT.                                        DTSCS1C
07052                                                                   DTSCS1C
07053                                                                   DTSCS1C
07054      MOVE WRK-LIAB-DATE TO L004-DATE.                             DTSCS1C
07055                                                                   DTSCS1C
07056      SET L004-FROM-DATE TO TRUE.                                  DTSCS1C
07057                                                                   DTSCS1C
07058      PERFORM S004-YRQ THRU S004-EXIT.                             DTSCS1C
07059                                                                   DTSCS1C
07060      MOVE L004-QTR-5-9 TO WRK-FIRST-LIAB-YRQ.                     DTSCS1C
07061                                                                   DTSCS1C
07062                                                                   DTSCS1C
07063      IF WRK-INACT-DATE = ALL-NINES-DATE                           DTSCS1C
07064          NEXT SENTENCE                                            DTSCS1C
07065      ELSE                                                         DTSCS1C
07066          MOVE WRK-INACT-DATE TO L004-DATE                         DTSCS1C
07067          SET L004-FROM-DATE TO TRUE                               DTSCS1C
07068          PERFORM S004-YRQ THRU S004-EXIT                          DTSCS1C
07069          MOVE L004-QTR-5-9 TO WRK-LAST-LIAB-YRQ.                  DTSCS1C
07070                                                                   DTSCS1C
07071                                                                   DTSCS1C
07072      MOVE MAP-INACT-CD TO MSOL-INACT-CD.                          DTSCS1C
07073                                                                   DTSCS1C
07074      IF MSOL-INACT-WITHDRAWN-88                                   DTSCS1C
07075          MOVE +0 TO WRK-FIRST-LIAB-YRQ                            DTSCS1C
07076                     WRK-LAST-LIAB-YRQ.                            DTSCS1C
07077  S6100-EXIT.                                                      DTSCS1C
07078      EXIT.                                                        DTSCS1C
07079 /*****************************************************************DTSCS1C
07080 * MAP ROUTINES                                                   *DTSCS1C
07081 ******************************************************************DTSCS1C
07082  S9100-RECEIVE.                                                   DTSCS1C
07083      SET L851-RECEIVE-88 TO TRUE.                                 DTSCS1C
07084                                                                   DTSCS1C
07085      MOVE WRK-SCR-ID TO L851-SCR-ID.                              DTSCS1C
07086                                                                   DTSCS1C
07087      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS1C
07088                                                                   DTSCS1C
07089      MOVE L851-AID TO LCCM-AID.                                   DTSCS1C
07090                                                                   DTSCS1C
07091      MOVE L851-CURSOR TO LCCM-CURSOR.                             DTSCS1C
07092  S9100-EXIT.                                                      DTSCS1C
07093      EXIT.                                                        DTSCS1C
07094      SKIP3                                                        DTSCS1C
07095  S9200-SEND-DATAONLY.                                             DTSCS1C
07096      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS1C
07097                                                                   DTSCS1C
07098      IF LCCM-NO-MSG                                               DTSCS1C
07099          NEXT SENTENCE                                            DTSCS1C
07100      ELSE                                                         DTSCS1C
07101          PERFORM S805-MSG-AREA THRU S805-EXIT.                    DTSCS1C
07102                                                                   DTSCS1C
07103      IF CURSOR-SET-GOTO                                           DTSCS1C
07104          MOVE CATB-CURSOR TO MAP-GOTO-L                           DTSCS1C
07105      ELSE                                                         DTSCS1C
07106          MOVE CATB-CURSOR TO MAP-EMP-NO-1-L.                      DTSCS1C
07107                                                                   DTSCS1C
07108      SET L851-SEND-DATAONLY-88 TO TRUE.                           DTSCS1C
07109                                                                   DTSCS1C
07110      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS1C
07111                                                                   DTSCS1C
07112      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS1C
07113  S9200-EXIT.                                                      DTSCS1C
07114      EXIT.                                                        DTSCS1C
07115      SKIP3                                                        DTSCS1C
07116  S9300-SEND-MAP.                                                  DTSCS1C
07117      MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE.              DTSCS1C
07118                                                                   DTSCS1C
07119      MOVE SPACES TO MAP-SYS-TIME.                                 DTSCS1C
07120                                                                   DTSCS1C
07121      MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME.              DTSCS1C
07122                                                                   DTSCS1C
07123      MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME.          DTSCS1C
07124                                                                   DTSCS1C
07125      IF SCR-ACCESS-UPDATE                                         DTSCS1C
07126          PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT               DTSCS1C
07127      ELSE                                                         DTSCS1C
07128          PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT.             DTSCS1C
07129                                                                   DTSCS1C
07130      PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT.                   DTSCS1C
07131                                                                   DTSCS1C
07132      PERFORM S805-MSG-AREA THRU S805-EXIT.                        DTSCS1C
07133                                                                   DTSCS1C
07134      IF CURSOR-SET-NO                                             DTSCS1C
07135          MOVE CATB-CURSOR TO MAP-EMP-NO-1-L.                      DTSCS1C
07136                                                                   DTSCS1C
07137      SET L851-SEND-88 TO TRUE.                                    DTSCS1C
07138                                                                   DTSCS1C
07139      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS1C
07140                                                                   DTSCS1C
07141      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS1C
07142  S9300-EXIT.                                                      DTSCS1C
07143      EXIT.                                                        DTSCS1C
07144      SKIP3                                                        DTSCS1C
07145  S9310-UPDATE-FKEYS.                                              DTSCS1C
07146      MOVE CFKD-MOD TO MAP-KEY-MOD.                                DTSCS1C
07147                                                                   DTSCS1C
07148      IF LCCM-SCR-CLEAR                                            DTSCS1C
07149          MOVE LOW-VALUES TO MAP-KEY-MOD                           DTSCS1C
07150      ELSE                                                         DTSCS1C
07151      IF LCCM-SCR-INQUIRE                                          DTSCS1C
07152          NEXT SENTENCE                                            DTSCS1C
07153      ELSE                                                         DTSCS1C
07154      IF LCCM-SCR-UPDATE-LOCKED                                    DTSCS1C
07155          MOVE LOW-VALUES TO MAP-KEY-MOD                           DTSCS1C
07156      ELSE                                                         DTSCS1C
07157          NEXT SENTENCE.                                           DTSCS1C
07158  S9310-EXIT.                                                      DTSCS1C
07159      EXIT.                                                        DTSCS1C
07160      SKIP3                                                        DTSCS1C
07161  S9320-INQUIRY-FKEYS.                                             DTSCS1C
07162      MOVE LOW-VALUES TO MAP-KEY-MOD.                              DTSCS1C
07163  S9320-EXIT.                                                      DTSCS1C
07164      EXIT.                                                        DTSCS1C
07165      SKIP3                                                        DTSCS1C
07166  S9330-DSCR-FIELDS.                                               DTSCS1C
07167      IF MAP-ORG-TYPE = LOW-VALUES OR SPACES                       DTSCS1C
07168          MOVE LOW-VALUES TO MAP-ORG-TYPE-DESC                     DTSCS1C
07169      ELSE                                                         DTSCS1C
07170          MOVE MAP-ORG-TYPE TO L031-CD                             DTSCS1C
07171          SET L031-MPRF-ORG-TYPE TO TRUE                           DTSCS1C
07172          PERFORM S031-REG-CODES THRU S031-EXIT                    DTSCS1C
07173          MOVE L031-SHORT-DSCR TO MAP-ORG-TYPE-DESC.               DTSCS1C
07174                                                                   DTSCS1C
07175      IF MAP-EMP-CLASS = LOW-VALUES OR SPACES                      DTSCS1C
07176          MOVE LOW-VALUES TO MAP-EMP-CLASS-DESC                    DTSCS1C
07177      ELSE                                                         DTSCS1C
07178          MOVE MAP-EMP-CLASS TO L031-CD                            DTSCS1C
07179          SET L031-MPRF-EMP-CLASS TO TRUE                          DTSCS1C
07180          PERFORM S031-REG-CODES THRU S031-EXIT                    DTSCS1C
07181          MOVE L031-SHORT-DSCR TO MAP-EMP-CLASS-DESC.              DTSCS1C
07182                                                                   DTSCS1C
07183      IF MAP-RESP-OP-ID = LOW-VALUES OR SPACES                     DTSCS1C
07184          MOVE LOW-VALUES TO MAP-RESP-OP-ID-DESC                   DTSCS1C
07185      ELSE                                                         DTSCS1C
07186      IF MAP-RESP-OP-ID = LCCM-OP-ID                               DTSCS1C
07187          MOVE LCCM-OP-NAME TO MAP-RESP-OP-ID-DESC                 DTSCS1C
07188      ELSE                                                         DTSCS1C
07189          MOVE MAP-RESP-OP-ID TO L082-OP-ID                        DTSCS1C
07190          PERFORM S082-OP-ID-LOOKUP THRU S082-EXIT                 DTSCS1C
07191          MOVE L082-NAME TO MAP-RESP-OP-ID-DESC.                   DTSCS1C
07192  S9330-EXIT. EXIT.                                                DTSCS1C
07193      SKIP3                                                        DTSCS1C
07194  S9900-PREPARE-SEND.                                              DTSCS1C
07195      MOVE WRK-SCR-ID TO L851-SCR-ID                               DTSCS1C
07196                         LCCM-SCR-ID.                              DTSCS1C
07197                                                                   DTSCS1C
07198      MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND.                    DTSCS1C
07199                                                                   DTSCS1C
07200      MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE.                         DTSCS1C
07201  S9900-EXIT.                                                      DTSCS1C
07202      EXIT.                                                        DTSCS1C
