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