giteaadmin/DUTAS
4
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
2a54f65e13ffdac7ccbe8ea99bd8eb7cbb392cec
DUTAS/CICS/DTSCS1C.cob
Neeraj Kumar ca3572c5df DUTAS re-platformed to Raincode - Initial Source Code
2025-07-21 11:20:11 -04:00

7204 lines
563 KiB
COBOL
Raw Blame History

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
Reference in New Issue View Git Blame Copy Permalink