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