00001 IDENTIFICATION DIVISION. 02/13/02 00002 PROGRAM-ID. DTSCU400. DTSCU400 00003 AUTHOR. TRW. LV005 00004 DATE-WRITTEN. OCTOBER 20001. DTSCU400 00005 DATE-COMPILED. DTSCU400 00006 DTSCU4KIP3 DTSCU400 00007 ***** DTSCU400 00008 * DTSCU400 00009 * FUNCTION: FILING SCHEDULE MAINTENANCE MODULE DTSCU400 00010 * DTSCU400 00011 * DTSCU400 00012 * MODIFICATION LOG: DTSCU400 00013 * DTSCU400 00014 * 10/15/2001 INITIAL DEVELOPMENT. DTSCU400 00015 * WORK ORDER: PROGRAMMER: GD DTSCU400 00016 * DTSCU400 00017 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU400 00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU400 00019 * WORK ORDER: PROGRAMMER: XXX DTSCU400 00020 ***** DTSCU400 00021 * DTSCU400 00022 * DESCRIPTION: DTSCU400 00023 * DTSCU400 00024 * DTSCU400 PERFORMS COMMON FUNCTIONS NEEDED TO ADD AND UPDATE DTSCU400 00025 * MFSC RECORDS. DTSCU400 00026 * DTSCU400 00027 * DTSCU400 00028 ***** DTSCU400 00029 SKIP3 DTSCU400 00030 ENVIRONMENT DIVISION. DTSCU400 00031 SKIP3 DTSCU400 00032 DATA DIVISION. DTSCU400 00033 SKIP3 DTSCU400 00034 WORKING-STORAGE SECTION. DTSCU400 000345 77 PAN-VALET PICTURE X(24) VALUE '005DTSCU400 02/13/02'. DTSCU400 00035 SKIP3 DTSCU400 00036 01 WRK-AREA. DTSCU400 00037 05 WRK-ABEND-CODE PIC X(04) VALUE 'U400'. DTSCU400 00038 05 WRK-RESP-CODE PIC S9(08) COMP. DTSCU400 00039 DTSCU400 00040 05 WRK-EMP-NO PIC S9(07) COMP-3 DTSCU400 00041 VALUE +0. DTSCU400 00042 05 WRK-ABS-QTR PIC S9(04) COMP. DTSCU400 00043 05 WRK-START-YRQ PIC S9(05) COMP-3. DTSCU400 00044 05 WRK-PRIOR-START-YRQ PIC S9(05) COMP-3. DTSCU400 00045 05 WRK-PRIOR-MFSC-KEY PIC X(16). DTSCU400 00046 05 WRK-NEXT-START-YRQ PIC S9(05) COMP-3. DTSCU400 00047 DTSCU400 00048 05 WRK-PENDING-MFSC-KEY PIC X(16). DTSCU400 00049 DTSCU400 00050 05 WRK-OPEN-CNT PIC S9(04) COMP DTSCU400 00051 VALUE +0. DTSCU400 00052 05 WRK-ALL-NINES-YRQ PIC S9(05) COMP-3 DTSCU400 00053 VALUE +99999. DTSCU400 00054 DTSCU400 00055 05 WRK-RETURN-AREA. DTSCU400 00056 10 WRK-PRIOR-STATE-IND PIC X(01). DTSCU400 00057 88 WRK-PENDING-MFSC-88 VALUE '1'. DTSCU400 00058 88 WRK-ORIG-DETERM-88 VALUE '2'. DTSCU400 00059 88 WRK-REDETERM-88 VALUE '3'. DTSCU400 00060 10 WRK-NOTICE-SENT-IND PIC X(01). DTSCU400 00061 88 WRK-NOTICE-SENT-YES-88 VALUE 'Y'. DTSCU400 00062 88 WRK-NOTICE-SENT-NO-88 VALUE 'N'. DTSCU400 00063 DTSCU400 00064 05 WRK-T001-RPT-TYPE PIC X(02). DTSCU400 00065 88 WRK-POT-HOUSEHOLD-88 VALUE '01'. DTSCU400 00066 88 WRK-ADMIN-REACT-88 VALUE '21'. DTSCU400 00067 DTSCU400 00068 05 WRK-R907-MSG-TABLE. DTSCU400 00069 10 WRK-R907-MSG1. DTSCU400 00070 15 WRK-R907-MSG1-ID PIC X(11) DTSCU400 00071 VALUE 'DTSCU400401'. DTSCU400 00072 15 WRK-R907-MSG1-SHORT-TEXT PIC X(20) DTSCU400 00073 VALUE 'MFSC ALREADY EXISTS'. DTSCU400 00074 15 WRK-R907-MSG1-LONG-TEXT. DTSCU400 00075 20 FILLER PIC X(30) DTSCU400 00076 VALUE 'MFSC ALREADY EXISTS - USING EX'. DTSCU400 00077 20 FILLER PIC X(30) DTSCU400 00078 VALUE 'ISTING RECORD '. DTSCU400 00079 10 WRK-R907-MSG2. DTSCU400 00080 15 WRK-R907-MSG2-ID PIC X(11) DTSCU400 00081 VALUE 'DTSCU400402'. DTSCU400 00082 15 WRK-R907-MSG2-SHORT-TEXT PIC X(20) DTSCU400 00083 VALUE 'MFSC ALREADY EXISTS'. DTSCU400 00084 15 WRK-R907-MSG2-LONG-TEXT. DTSCU400 00085 20 FILLER PIC X(30) DTSCU400 00086 VALUE 'MFSC EXISTS - REPLACING FILING'. DTSCU400 00087 20 FILLER PIC X(30) DTSCU400 00088 VALUE ' SCHEDULE '. DTSCU400 00089 10 WRK-R907-MSG3. DTSCU400 00090 15 WRK-R907-MSG3-ID PIC X(11) DTSCU400 00091 VALUE 'DTSCU400403'. DTSCU400 00092 15 WRK-R907-MSG3-SHORT-TEXT PIC X(20) DTSCU400 00093 VALUE 'MFSC FILE ERROR '. DTSCU400 00094 15 WRK-R907-MSG3-LONG-TEXT. DTSCU400 00095 20 FILLER PIC X(30) DTSCU400 00096 VALUE 'PRIOR MFSC NOT FOUND - NO RECO'. DTSCU400 00097 20 FILLER PIC X(30) DTSCU400 00098 VALUE 'RD ADDED '. DTSCU400 00099 DTSCU400 00100 01 L810-COMM-AREA. DTSCU400 00101 05 L810-CONTROL-BLOCK. DTSCU400 00102 ++INCLUDE DTSIL810 DTSCU400 00103 05 MSKL-REC. DTSCU400 00104 ++INCLUDE DTSIMSKL DTSCU400 00105 EJECT DTSCU400 00106 01 MFSC-REC. DTSCU400 00107 ++INCLUDE DTSIMFSC DTSCU400 00108 EJECT DTSCU400 00109 01 L004-COMM-AREA. DTSCU400 00110 ++INCLUDE DTSIL004 DTSCU400 00111 EJECT DTSCU400 00112 01 L005-COMM-AREA. DTSCU400 00113 ++INCLUDE DTSIL005 DTSCU400 00114 EJECT DTSCU400 00115 01 L825-COMM-AREA. DTSCU400 00116 05 L825-CONTROL-BLOCK. DTSCU400 00117 ++INCLUDE DTSIL825 DTSCU400 00118 05 RSKL-REC. DTSCU400 00119 ++INCLUDE DTSIRSK1 DTSCU400 00120 EJECT DTSCU400 00121 01 T001-REC. DTSCU400 00122 ++INCLUDE DTSIT001 DTSCU400 00123 EJECT DTSCU400 00124 01 R907-REC. DTSCU400 00125 ++INCLUDE DTSIR907 DTSCU400 00126 EJECT DTSCU400 00127 LINKAGE SECTION. DTSCU400 00128 SKIP3 DTSCU400 00129 01 DFHCOMMAREA. DTSCU400 00130 ++INCLUDE DTSIL400 DTSCU400 00131 EJECT DTSCU400 00132 01 MPRF-REC. DTSCU400 00133 ++INCLUDE DTSIMPRF DTSCU400 00134 EJECT DTSCU400 00135 PROCEDURE DIVISION. DTSCU400 00136 SKIP2 DTSCU400 00137 DTSCU400-MAINLINE. DTSCU400 00138 PERFORM I0000-INITIALIZE THRU I0000-EXIT. DTSCU400 00139 DTSCU400 00140 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSCU400 00141 DTSCU400 00142 DTSCU400-MAINLINE-EXIT. DTSCU400 00143 EXEC CICS DTSCU400 00144 RETURN DTSCU400 00145 END-EXEC. DTSCU400 00146 DTSCU400 00147 EJECT DTSCU400 00148 I0000-INITIALIZE. DTSCU400 00149 PERFORM I1000-EDIT-INPUT THRU I1000-EXIT. DTSCU400 00150 PERFORM I2000-INIT-RETURN THRU I2000-EXIT. DTSCU400 00151 PERFORM I3000-INIT-WS THRU I3000-EXIT. DTSCU400 00152 DTSCU400 00153 I0000-EXIT. DTSCU400 00154 EXIT. DTSCU400 00155 I1000-EDIT-INPUT. DTSCU400 00156 IF L400-EMP-NO NOT NUMERIC DTSCU400 00157 PERFORM S899-ABEND THRU S899-EXIT DTSCU400 00158 ELSE DTSCU400 00159 MOVE L400-EMP-NO TO WRK-EMP-NO. DTSCU400 00160 DTSCU400 00161 IF L400-ADD-PENDING-1A-88 DTSCU400 00162 OR L400-LIAB-DETERM-88 DTSCU400 00163 PERFORM I1100-ADD-UPD THRU I1100-EXIT. DTSCU400 00164 DTSCU400 00165 I1000-EXIT. DTSCU400 00166 EXIT. DTSCU400 00167 DTSCU400 00168 I1100-ADD-UPD. DTSCU400 00169 IF L400-FIRST-LIAB-YRQ NOT NUMERIC DTSCU400 00170 PERFORM S899-ABEND THRU S899-EXIT. DTSCU400 00171 DTSCU400 00172 IF L400-CURR-RUN-DATE NOT > ZERO DTSCU400 00173 PERFORM S899-ABEND THRU S899-EXIT. DTSCU400 00174 DTSCU400 00175 I1100-EXIT. DTSCU400 00176 EXIT. DTSCU400 00177 DTSCU400 00178 I2000-INIT-RETURN. DTSCU400 00179 MOVE SPACES TO L400-PRIOR-STATE-IND. DTSCU400 00180 DTSCU400 00181 I2000-EXIT. DTSCU400 00182 EXIT. DTSCU400 00183 DTSCU400 00184 I3000-INIT-WS. DTSCU400 00185 SET L005-FROM-SYS TO TRUE. DTSCU400 00186 PERFORM S005-ABSTIME THRU S005-EXIT. DTSCU400 00187 DTSCU400 00188 MOVE ZERO TO WRK-ABS-QTR DTSCU400 00189 WRK-START-YRQ DTSCU400 00190 WRK-PRIOR-START-YRQ DTSCU400 00191 WRK-OPEN-CNT. DTSCU400 00192 MOVE LOW-VALUES TO WRK-PENDING-MFSC-KEY DTSCU400 00193 WRK-PRIOR-MFSC-KEY. DTSCU400 00194 DTSCU400 00195 MOVE WRK-ALL-NINES-YRQ TO WRK-NEXT-START-YRQ. DTSCU400 00196 MOVE SPACES TO WRK-PRIOR-STATE-IND DTSCU400 00197 WRK-T001-RPT-TYPE. DTSCU400 00198 SET WRK-NOTICE-SENT-NO-88 TO TRUE. DTSCU400 00199 DTSCU400 00200 I3000-EXIT. DTSCU400 00201 EXIT. DTSCU400 00202 DTSCU400 00203 P0000-PROCESS. DTSCU400 00204 IF L400-FIND-PRIOR-88 DTSCU400 00205 OR L400-NOT-LIAB-DETERM-88 DTSCU400 00206 NEXT SENTENCE DTSCU400 00207 ELSE DTSCU400 00208 PERFORM S1000-START-YRQ THRU S1000-EXIT. DTSCU400 00209 DTSCU400 00210 PERFORM P1000-FIND-PRIOR THRU P1000-EXIT. DTSCU400 00211 DTSCU400 00212 IF L400-FIND-PRIOR-88 DTSCU400 00213 GO TO P0000-EXIT. DTSCU400 00214 DTSCU400 00215 IF L400-ADD-PENDING-1A-88 DTSCU400 00216 OR L400-DETERM-PENDING-88 DTSCU400 00217 PERFORM P2000-ADD-MFSC-T001 THRU P2000-EXIT DTSCU400 00218 ELSE DTSCU400 00219 IF L400-LIAB-DETERM-88 DTSCU400 00220 PERFORM P0100-LIAB-DETERM THRU P0100-EXIT DTSCU400 00221 ELSE DTSCU400 00222 IF L400-NOT-LIAB-DETERM-88 DTSCU400 00223 PERFORM P3000-UPDATE-MFSC THRU P3000-EXIT DTSCU400 00224 ELSE DTSCU400 00225 IF L400-ORG-TYPE-CHANGE-88 DTSCU400 00226 PERFORM P5000-ORG-TYPE-CHNG THRU P5000-EXIT. DTSCU400 00227 DTSCU400 00228 P0000-EXIT. DTSCU400 00229 EXIT. DTSCU400 00230 DTSCU400 00231 P0100-LIAB-DETERM. DTSCU400 00232 IF WRK-ORIG-DETERM-88 DTSCU400 00233 PERFORM P2000-ADD-MFSC-T001 THRU P2000-EXIT DTSCU400 00234 ELSE DTSCU400 00235 IF WRK-PENDING-MFSC-88 DTSCU400 00236 PERFORM P3000-UPDATE-MFSC THRU P3000-EXIT DTSCU400 00237 *& ELSE DTSCU400 00238 *& PERFORM P4000-REACTIVATE THRU P4000-EXIT DTSCU400 00239 END-IF DTSCU400 00240 END-IF. DTSCU400 00241 DTSCU400 00242 P0100-EXIT. DTSCU400 00243 EXIT. DTSCU400 00244 DTSCU400 00245 P1000-FIND-PRIOR. DTSCU400 00246 MOVE LOW-VALUES TO MFSC-KEY-AREA. DTSCU400 00247 MOVE WRK-EMP-NO TO MFSC-EMP-NO. DTSCU400 00248 SET MFSC-FSC-88 TO TRUE. DTSCU400 00249 MOVE MFSC-KEY-AREA TO MSKL-KEY-AREA. DTSCU400 00250 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCU400 00251 IF L810-NO-REC-88 DTSCU400 00252 SET WRK-ORIG-DETERM-88 TO TRUE DTSCU400 00253 ELSE DTSCU400 00254 MOVE ZERO TO WRK-OPEN-CNT DTSCU400 00255 PERFORM P1100-SCAN-MFSC THRU P1100-EXIT DTSCU400 00256 UNTIL L810-NO-REC-88 DTSCU400 00257 OR WRK-PENDING-MFSC-88. DTSCU400 00258 DTSCU400 00259 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCU400 00260 DTSCU400 00261 IF WRK-PENDING-MFSC-88 DTSCU400 00262 OR WRK-ORIG-DETERM-88 DTSCU400 00263 NEXT SENTENCE DTSCU400 00264 ELSE DTSCU400 00265 IF WRK-OPEN-CNT = ZERO DTSCU400 00266 SET WRK-ORIG-DETERM-88 TO TRUE DTSCU400 00267 ELSE DTSCU400 00268 SET WRK-REDETERM-88 TO TRUE DTSCU400 00269 END-IF DTSCU400 00270 END-IF. DTSCU400 00271 DTSCU400 00272 MOVE WRK-PRIOR-STATE-IND TO L400-PRIOR-STATE-IND. DTSCU400 00273 MOVE WRK-NOTICE-SENT-IND TO L400-NOTICE-SENT-IND. DTSCU400 00274 DTSCU400 00275 P1000-EXIT. DTSCU400 00276 EXIT. DTSCU400 00277 DTSCU400 00278 P1100-SCAN-MFSC. DTSCU400 00279 MOVE MSKL-REC TO MFSC-REC. DTSCU400 00280 DTSCU400 00281 IF MFSC-STATUS-PENDING-88 DTSCU400 00282 PERFORM P1110-PENDING THRU P1110-EXIT DTSCU400 00283 GO TO P1100-EXIT DTSCU400 00284 ELSE DTSCU400 00285 IF MFSC-STATUS-OPEN-88 DTSCU400 00286 ADD +1 TO WRK-OPEN-CNT DTSCU400 00287 IF MFSC-START-YRQ <= WRK-START-YRQ DTSCU400 00288 IF MFSC-START-YRQ > WRK-PRIOR-START-YRQ DTSCU400 00289 MOVE MFSC-START-YRQ TO WRK-PRIOR-START-YRQ DTSCU400 00290 MOVE MFSC-KEY-AREA TO WRK-PRIOR-MFSC-KEY DTSCU400 00291 END-IF DTSCU400 00292 ELSE DTSCU400 00293 IF MFSC-START-YRQ < WRK-NEXT-START-YRQ DTSCU400 00294 MOVE MFSC-START-YRQ TO WRK-NEXT-START-YRQ DTSCU400 00295 END-IF DTSCU400 00296 END-IF DTSCU400 00297 END-IF DTSCU400 00298 END-IF. DTSCU400 00299 DTSCU400 00300 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCU400 00301 DTSCU400 00302 P1100-EXIT. DTSCU400 00303 EXIT. DTSCU400 00304 DTSCU400 00305 P1110-PENDING. DTSCU400 00306 MOVE MSKL-KEY-AREA TO WRK-PENDING-MFSC-KEY. DTSCU400 00307 DTSCU400 00308 IF MFSC-INITIAL-MAIL-DATE > ZERO DTSCU400 00309 SET WRK-NOTICE-SENT-YES-88 TO TRUE DTSCU400 00310 END-IF. DTSCU400 00311 DTSCU400 00312 IF MFSC-STATUS-PENDING-88 DTSCU400 00313 SET WRK-PENDING-MFSC-88 TO TRUE. DTSCU400 00314 DTSCU400 00315 P1110-EXIT. DTSCU400 00316 EXIT. DTSCU400 00317 DTSCU400 00318 ************************************************************** DTSCU400 00319 * THIS PARAGRAPH EXECUTES IN THREE SITUATIONS: DTSCU400 00320 * 1. WHEN DTSCU400 IS CALLED FROM SCREEN 1A TO ADD A DTSCU400 00321 * PENDING MFSC AND T001 REPORT TRANSACTION. DTSCU400 00322 * 2. WHEN DTSCU400 IS CALLED FROM SCREEN 1A TO ADD A DTSCU400 00323 * T001 REPORT TRANSACTION ONLY. DTSCU400 00324 * 3. WHEN DTSCU400 IS CALLED FROM SCREEN 1C AND THIS DTSCU400 00325 * IS AN ORIGINAL DETERMINATION. DTSCU400 00326 * DTSCU400 00327 * IF THIS IS AN ORIGINAL DETERMINATION, ONLY ADD AN DTSCU400 00328 * MFSC IF THE ORGANIZATION TYPE IS 'HOUSEHOLD.' DTSCU400 00329 * DTSCU400 00330 * WHEN CALLED FROM SCREEN 1A, IF THERE IS ALREADY A PENDING DTSCU400 00331 * MFSC ON FILE AND THE INITIAL NOTICE DATE = ZERO, THIS IS DTSCU400 00332 * A REQUEST TO PRINT THE NOTICES ONLY. DTSCU400 00333 * DTSCU400 00334 * ADD A PENDING MFSC UNLESS THE EMPLOYER HAS BEEN DTSCU400 00335 * DETERMINED LIABLE AND INACTIVATED AT THE SAME TIME. DTSCU400 00336 * IN THIS CASE, ADD A QUARTERLY MFSC AND DO NOT PRINT DTSCU400 00337 * ANY NOTICES. DTSCU400 00338 ************************************************************** DTSCU400 00339 P2000-ADD-MFSC-T001. DTSCU400 00340 IF L400-ADD-PENDING-1A-88 DTSCU400 00341 OR L400-DETERM-PENDING-88 DTSCU400 00342 IF WRK-ORIG-DETERM-88 DTSCU400 00343 PERFORM P2100-BUILD-MFSC THRU P2100-EXIT DTSCU400 00344 ELSE DTSCU400 00345 IF WRK-PENDING-MFSC-88 DTSCU400 00346 AND WRK-NOTICE-SENT-NO-88 DTSCU400 00347 PERFORM P2200-NOTICE-ONLY THRU P2200-EXIT DTSCU400 00348 END-IF DTSCU400 00349 END-IF DTSCU400 00350 ELSE DTSCU400 00351 IF L400-ORG-HOUSEHOLD-88 DTSCU400 00352 PERFORM P2100-BUILD-MFSC THRU P2100-EXIT. DTSCU400 00353 DTSCU400 00354 P2000-EXIT. DTSCU400 00355 EXIT. DTSCU400 00356 DTSCU400 00357 P2100-BUILD-MFSC. DTSCU400 00358 DTSCU400 00359 PERFORM S2000-INIT-MFSC THRU S2000-EXIT. DTSCU400 00360 DTSCU400 00361 IF L400-ADD-PENDING-1A-88 DTSCU400 00362 OR L400-DETERM-PENDING-88 DTSCU400 00363 SET MFSC-STATUS-PENDING-88 DTSCU400 00364 TO TRUE DTSCU400 00365 MOVE SPACES TO MFSC-FILING-SCHEDULE-CD DTSCU400 00366 ELSE DTSCU400 00367 SET MFSC-STATUS-OPEN-88 TO TRUE DTSCU400 00368 MOVE L400-FILING-SCHED TO MFSC-FILING-SCHEDULE-CD. DTSCU400 00369 DTSCU400 00370 IF MFSC-STATUS-OPEN-88 DTSCU400 00371 AND WRK-PRIOR-MFSC-KEY NOT = LOW-VALUES DTSCU400 00372 PERFORM P2110-CHK-DUPLICATE THRU P2110-EXIT DTSCU400 00373 ELSE DTSCU400 00374 MOVE MFSC-REC TO MSKL-REC DTSCU400 00375 PERFORM S810-WRITE THRU S810-EXIT. DTSCU400 00376 DTSCU400 00377 IF L400-ADD-PENDING-1A-88 DTSCU400 00378 OR L400-DETERM-PENDING-88 DTSCU400 00379 SET WRK-POT-HOUSEHOLD-88 TO TRUE DTSCU400 00380 PERFORM S825-WRITE-T001 THRU S825-EXIT. DTSCU400 00381 DTSCU400 00382 P2100-EXIT. DTSCU400 00383 EXIT. DTSCU400 00384 DTSCU400 00385 ************************************************************* DTSCU400 00386 * IF THERE IS AN MFSC RECORD ALREADY ON FILE WITH THE SAME DTSCU400 00387 * START YRQ: DTSCU400 00388 * IF THE FILING SCHEDULES ARE THE SAME, LEAVE THE DTSCU400 00389 * EXISTING MFSC UNCHANGED AND WRITE AN R907 RECORD. DTSCU400 00390 * IF THE FILING SCHEDULES ARE DIFFERENT, CHANGE THE DTSCU400 00391 * FILING SCHEDULE ON THE EXISTING MFSC, REWRITE IT AND DTSCU400 00392 * WRITE AN R907 RECORD. DTSCU400 00393 * IF THERE IS NO PREVIOUS MFSC, ADD THE NEW RECORD. DTSCU400 00394 ************************************************************* DTSCU400 00395 P2110-CHK-DUPLICATE. DTSCU400 00396 MOVE WRK-PRIOR-MFSC-KEY TO MSKL-KEY-AREA. DTSCU400 00397 PERFORM S810-READ THRU S810-EXIT DTSCU400 00398 IF L810-OK-88 DTSCU400 00399 MOVE MSKL-REC TO MFSC-REC DTSCU400 00400 IF MFSC-FILING-SCHEDULE-CD = L400-FILING-SCHED DTSCU400 00401 PERFORM P2111-ERR-MSG1 THRU P2111-EXIT DTSCU400 00402 ELSE DTSCU400 00403 MOVE L400-FILING-SCHED TO MFSC-FILING-SCHEDULE-CD DTSCU400 00404 PERFORM S810-REWRITE THRU S810-EXIT DTSCU400 00405 PERFORM P2112-ERR-MSG2 THRU P2112-EXIT DTSCU400 00406 END-IF DTSCU400 00407 ELSE DTSCU400 00408 MOVE MFSC-REC TO MSKL-REC DTSCU400 00409 PERFORM S810-WRITE THRU S810-EXIT DTSCU400 00410 END-IF. DTSCU400 00411 DTSCU400 00412 P2110-EXIT. DTSCU400 00413 EXIT. DTSCU400 00414 DTSCU400 00415 P2111-ERR-MSG1. DTSCU400 00416 MOVE '401' TO R907-MSG-ID. DTSCU400 00417 MOVE WRK-R907-MSG1-LONG-TEXT TO R907-MSG-TEXT. DTSCU400 00418 PERFORM S825-WRITE-R907 THRU S825-EXIT. DTSCU400 00419 DTSCU400 00420 P2111-EXIT. DTSCU400 00421 EXIT. DTSCU400 00422 DTSCU400 00423 P2112-ERR-MSG2. DTSCU400 00424 MOVE '402' TO R907-MSG-ID. DTSCU400 00425 MOVE WRK-R907-MSG2-LONG-TEXT TO R907-MSG-TEXT. DTSCU400 00426 PERFORM S825-WRITE-R907 THRU S825-EXIT. DTSCU400 00427 DTSCU400 00428 P2112-EXIT. DTSCU400 00429 EXIT. DTSCU400 00430 DTSCU400 00431 P2200-NOTICE-ONLY. DTSCU400 00432 MOVE ZERO TO WRK-START-YRQ. DTSCU400 00433 SET WRK-POT-HOUSEHOLD-88 TO TRUE DTSCU400 00434 PERFORM S825-WRITE-T001 THRU S825-EXIT. DTSCU400 00435 DTSCU400 00436 P2200-EXIT. DTSCU400 00437 EXIT. DTSCU400 00438 DTSCU400 00439 DTSCU400 00440 ************************************************************* DTSCU400 00441 * THIS PARAGRAPH UPDATES AN MFSC CREATED FROM SCREEN 1A DTSCU400 00442 * ONCE THE LIABILITY DATE IS KNOWN. SINCE THE KEY CHANGES DTSCU400 00443 * WHEN MFSC-ABS-QTR IS UPDATED, THE RECORD MUST FIRST BE DTSCU400 00444 * DELETED. THE ORIGINAL DATA REMAINS IN WORKING-STORAGE IN DTSCU400 00445 * THE MFSC-REC AREA. THE PARAGRAPH UPDATES THIS DATA AND DTSCU400 00446 * WRITES THE NEW RECORD. DTSCU400 00447 ************************************************************* DTSCU400 00448 P3000-UPDATE-MFSC. DTSCU400 00449 IF WRK-PENDING-MFSC-88 DTSCU400 00450 NEXT SENTENCE DTSCU400 00451 ELSE DTSCU400 00452 GO TO P3000-EXIT. DTSCU400 00453 DTSCU400 00454 IF NOT L400-ORG-HOUSEHOLD-88 DTSCU400 00455 OR L400-NOT-LIAB-DETERM-88 DTSCU400 00456 PERFORM P3100-WITHDRAW THRU P3100-EXIT DTSCU400 00457 ELSE DTSCU400 00458 PERFORM P3200-UPDATE THRU P3200-EXIT. DTSCU400 00459 DTSCU400 00460 P3000-EXIT. DTSCU400 00461 EXIT. DTSCU400 00462 DTSCU400 00463 P3100-WITHDRAW. DTSCU400 00464 MOVE WRK-PENDING-MFSC-KEY TO MSKL-KEY-AREA. DTSCU400 00465 PERFORM S810-READ THRU S810-EXIT. DTSCU400 00466 MOVE MSKL-REC TO MFSC-REC. DTSCU400 00467 DTSCU400 00468 SET MFSC-STATUS-WITHDRAWN-88 TO TRUE. DTSCU400 00469 MOVE L400-CURR-RUN-DATE TO MFSC-CHNG-DATE. DTSCU400 00470 SET MFSC-CHNG-SYSTEM-88 TO TRUE. DTSCU400 00471 DTSCU400 00472 MOVE MFSC-REC TO MSKL-REC. DTSCU400 00473 PERFORM S810-REWRITE THRU S810-EXIT. DTSCU400 00474 DTSCU400 00475 P3100-EXIT. DTSCU400 00476 EXIT. DTSCU400 00477 DTSCU400 00478 P3200-UPDATE. DTSCU400 00479 MOVE WRK-PENDING-MFSC-KEY TO MSKL-KEY-AREA. DTSCU400 00480 PERFORM S810-READ THRU S810-EXIT. DTSCU400 00481 MOVE MSKL-REC TO MFSC-REC. DTSCU400 00482 DTSCU400 00483 PERFORM S810-DELETE THRU S810-EXIT. DTSCU400 00484 DTSCU400 00485 MOVE WRK-ABS-QTR TO MFSC-ABS-QTR. DTSCU400 00486 MOVE WRK-START-YRQ TO MFSC-START-YRQ. DTSCU400 00487 DTSCU400 00488 SET MFSC-STATUS-OPEN-88 TO TRUE. DTSCU400 00489 MOVE L400-FILING-SCHED TO MFSC-FILING-SCHEDULE-CD. DTSCU400 00490 DTSCU400 00491 MOVE L400-OP-ID TO MFSC-CHNG-OP-ID. DTSCU400 00492 MOVE L400-CURR-RUN-DATE TO MFSC-CHNG-DATE. DTSCU400 00493 DTSCU400 00494 MOVE MFSC-REC TO MSKL-REC. DTSCU400 00495 PERFORM S810-WRITE THRU S810-EXIT. DTSCU400 00496 DTSCU400 00497 P3200-EXIT. DTSCU400 00498 EXIT. DTSCU400 00499 DTSCU400 00500 *P4000-REACTIVATE. DTSCU400 00501 * IF L400-DELINQUENT-YES-88 DTSCU400 00502 * IF MFSC-FILING-SCHED-ANN-88 DTSCU400 00503 * PERFORM P4100-TERMINATE-CURR-MFSC THRU P4100-EXIT DTSCU400 00504 * PERFORM P4200-ADD-QTRLY THRU P4200-EXIT DTSCU400 00505 * SET WRK-ADMIN-REACT-88 TO TRUE DTSCU400 00506 * PERFORM S825-WRITE-T001 THRU S825-EXIT DTSCU400 00507 * END-IF DTSCU400 00508 * END-IF. DTSCU400 00509 * DTSCU400 00510 *P4000-EXIT. DTSCU400 00511 * EXIT. DTSCU400 00512 * DTSCU400 00513 *P4100-TERMINATE-CURR-MFSC. DTSCU400 00514 * MOVE WRK-PRIOR-MFSC-KEY TO MSKL-KEY-AREA. DTSCU400 00515 * PERFORM S810-READ THRU S810-EXIT. DTSCU400 00516 * MOVE MSKL-REC TO MFSC-REC. DTSCU400 00517 * DTSCU400 00518 * MOVE WRK-ABS-QTR TO L004-ABS-QTR. DTSCU400 00519 * SUBTRACT +1 FROM L004-ABS-QTR. DTSCU400 00520 * PERFORM S004-FROM-ABS THRU S004-EXIT. DTSCU400 00521 * MOVE L004-QTR-5-9 TO MFSC-END-YRQ. DTSCU400 00522 * DTSCU400 00523 * MOVE L400-CURR-RUN-DATE TO MFSC-CHNG-DATE. DTSCU400 00524 * SET MFSC-CHNG-SYSTEM-88 TO TRUE. DTSCU400 00525 * MOVE MFSC-REC TO MSKL-REC. DTSCU400 00526 * DTSCU400 00527 * PERFORM S810-REWRITE THRU S810-EXIT. DTSCU400 00528 * DTSCU400 00529 *P4100-EXIT. DTSCU400 00530 * EXIT. DTSCU400 00531 * DTSCU400 00532 *P4200-ADD-QTRLY. DTSCU400 00533 * PERFORM S2000-INIT-MFSC THRU S2000-EXIT. DTSCU400 00534 * DTSCU400 00535 * SET MFSC-STATUS-OPEN-88 TO TRUE. DTSCU400 00536 * DTSCU400 00537 * SET MFSC-FILING-SCHED-QTR-88 TO TRUE. DTSCU400 00538 * DTSCU400 00539 * SET MFSC-REQ-ADMIN-88 TO TRUE. DTSCU400 00540 * DTSCU400 00541 * MOVE MFSC-REC TO MSKL-REC. DTSCU400 00542 * PERFORM S810-WRITE THRU S810-EXIT. DTSCU400 00543 * DTSCU400 00544 *P4200-EXIT. DTSCU400 00545 * EXIT. DTSCU400 00546 DTSCU400 00547 P5000-ORG-TYPE-CHNG. DTSCU400 00548 PERFORM S2000-INIT-MFSC THRU S2000-EXIT. DTSCU400 00549 DTSCU400 00550 SET MFSC-STATUS-OPEN-88 TO TRUE DTSCU400 00551 SET MFSC-FILING-SCHED-QTR-88 TO TRUE. DTSCU400 00552 SET MFSC-REQ-ORG-TYPE-88 TO TRUE. DTSCU400 00553 DTSCU400 00554 MOVE MFSC-REC TO MSKL-REC. DTSCU400 00555 PERFORM S810-WRITE THRU S810-EXIT. DTSCU400 00556 DTSCU400 00557 SET WRK-POT-HOUSEHOLD-88 TO TRUE. DTSCU400 00558 PERFORM S825-WRITE-T001 THRU S825-EXIT. DTSCU400 00559 DTSCU400 00560 P5000-EXIT. DTSCU400 00561 EXIT. DTSCU400 00562 DTSCU400 00563 S004-FROM-5. DTSCU400 00564 SET L004-FROM-5 TO TRUE. DTSCU400 00565 GO TO S004-LINK. DTSCU400 00566 DTSCU400 00567 S004-FROM-ABS. DTSCU400 00568 SET L004-FROM-ABS TO TRUE. DTSCU400 00569 GO TO S004-LINK. DTSCU400 00570 DTSCU400 00571 S004-LINK. DTSCU400 00572 EXEC CICS LINK DTSCU400 00573 PROGRAM('DTSCU004') DTSCU400 00574 COMMAREA(L004-COMM-AREA) DTSCU400 00575 END-EXEC. DTSCU400 00576 S004-EXIT. DTSCU400 00577 EXIT. DTSCU400 00578 DTSCU400 00579 S005-ABSTIME. DTSCU400 00580 EXEC CICS LINK DTSCU400 00581 PROGRAM('DTSCU005') DTSCU400 00582 COMMAREA(L005-COMM-AREA) DTSCU400 00583 END-EXEC. DTSCU400 00584 S005-EXIT. DTSCU400 00585 EXIT. DTSCU400 00586 DTSCU400 00587 S810-READ. DTSCU400 00588 SET L810-READ-88 TO TRUE. DTSCU400 00589 GO TO S810-IO. DTSCU400 00590 DTSCU400 00591 S810-READ-UPDATE. DTSCU400 00592 SET L810-READ-UPDATE-88 TO TRUE. DTSCU400 00593 GO TO S810-IO. DTSCU400 00594 DTSCU400 00595 S810-START-BROWSE. DTSCU400 00596 SET L810-START-BROWSE-88 TO TRUE. DTSCU400 00597 GO TO S810-IO. DTSCU400 00598 DTSCU400 00599 S810-READ-NEXT. DTSCU400 00600 SET L810-READ-NEXT-88 TO TRUE. DTSCU400 00601 GO TO S810-IO. DTSCU400 00602 DTSCU400 00603 S810-READ-PREV. DTSCU400 00604 SET L810-READ-PREV-88 TO TRUE. DTSCU400 00605 GO TO S810-IO. DTSCU400 00606 DTSCU400 00607 S810-END-BROWSE. DTSCU400 00608 SET L810-END-BROWSE-88 TO TRUE. DTSCU400 00609 GO TO S810-IO. DTSCU400 00610 DTSCU400 00611 S810-COUNT. DTSCU400 00612 SET L810-COUNT-88 TO TRUE. DTSCU400 00613 GO TO S810-IO. DTSCU400 00614 DTSCU400 00615 S810-REWRITE. DTSCU400 00616 SET L810-REWRITE-88 TO TRUE. DTSCU400 00617 GO TO S810-IO. DTSCU400 00618 DTSCU400 00619 S810-REWRITE-UPDATE. DTSCU400 00620 SET L810-REWRITE-UPDATE-88 TO TRUE. DTSCU400 00621 GO TO S810-IO. DTSCU400 00622 DTSCU400 00623 S810-WRITE. DTSCU400 00624 SET L810-WRITE-88 TO TRUE. DTSCU400 00625 GO TO S810-IO. DTSCU400 00626 DTSCU400 00627 S810-DELETE. DTSCU400 00628 SET L810-DELETE-88 TO TRUE. DTSCU400 00629 GO TO S810-IO. DTSCU400 00630 DTSCU400 00631 S810-IO. DTSCU400 00632 EXEC CICS LINK DTSCU400 00633 PROGRAM ('DTSCU810') DTSCU400 00634 COMMAREA (L810-COMM-AREA) DTSCU400 00635 END-EXEC. DTSCU400 00636 DTSCU400 00637 S810-EXIT. DTSCU400 00638 EXIT. DTSCU400 00639 DTSCU400 00640 S825-WRITE-T001. DTSCU400 00641 MOVE '001' TO T001-REC-TYPE. DTSCU400 00642 MOVE LENGTH OF T001-REC TO T001-LENGTH. DTSCU400 00643 MOVE WRK-EMP-NO TO T001-EMP-NO. DTSCU400 00644 MOVE L400-OP-ID TO T001-OP-ID DTSCU400 00645 T001-RESP-OP-ID. DTSCU400 00646 MOVE '1A' TO T001-SCR-ID DTSCU400 00647 MOVE L005-DATE TO T001-SYS-DATE. DTSCU400 00648 MOVE L005-TIME TO T001-SYS-TIME. DTSCU400 00649 SET T001-HSEHLD-NOTICES TO TRUE. DTSCU400 00650 MOVE WRK-T001-RPT-TYPE TO T001-HSEHLD-RPT-TYPE. DTSCU400 00651 MOVE WRK-START-YRQ TO T001-HH-START-YRQ. DTSCU400 00652 MOVE SPACES TO T001-INACT-LTR-TYPE DTSCU400 00653 T001-NOT-LIABLE-LTR-TYPE DTSCU400 00654 T001-WELCOME-LTR-IND. DTSCU400 00655 MOVE T001-REC TO RSKL-REC. DTSCU400 00656 DTSCU400 00657 SET L825-WRITE-88 TO TRUE. DTSCU400 00658 GO TO S825-O. DTSCU400 00659 DTSCU400 00660 S825-WRITE-R907. DTSCU400 00661 MOVE LENGTH OF R907-REC TO R907-LENGTH. DTSCU400 00662 MOVE WRK-EMP-NO TO R907-EMP-NO. DTSCU400 00663 MOVE 'DTSCU400' TO R907-MODULE-NAME. DTSCU400 00664 MOVE R907-REC TO RSKL-REC. DTSCU400 00665 DTSCU400 00666 SET L825-WRITE-88 TO TRUE. DTSCU400 00667 GO TO S825-O. DTSCU400 00668 DTSCU400 00669 S825-O. DTSCU400 00670 EXEC CICS LINK DTSCU400 00671 PROGRAM ('DTSCU825') DTSCU400 00672 COMMAREA (L825-COMM-AREA) DTSCU400 00673 END-EXEC. DTSCU400 00674 DTSCU400 00675 IF L825-FILE-CLOSED-88 DTSCU400 00676 PERFORM S899-ABEND THRU S899-EXIT. DTSCU400 00677 DTSCU400 00678 S825-EXIT. DTSCU400 00679 EXIT. DTSCU400 00680 DTSCU400 00681 S1000-START-YRQ. DTSCU400 00682 IF L400-ADD-PENDING-1A-88 DTSCU400 00683 OR L400-DETERM-PENDING-88 DTSCU400 00684 MOVE ZERO TO WRK-ABS-QTR DTSCU400 00685 WRK-START-YRQ DTSCU400 00686 GO TO S1000-EXIT DTSCU400 00687 END-IF. DTSCU400 00688 DTSCU400 00689 MOVE L400-FIRST-LIAB-YRQ TO L004-QTR-5-9 DTSCU400 00690 MOVE 1 TO L004-QTR-5-Q DTSCU400 00691 PERFORM S004-FROM-5 THRU S004-EXIT DTSCU400 00692 IF L004-VALID-QTR DTSCU400 00693 MOVE L004-ABS-QTR TO WRK-ABS-QTR DTSCU400 00694 MOVE L004-QTR-5-9 TO WRK-START-YRQ DTSCU400 00695 ELSE DTSCU400 00696 PERFORM S899-ABEND THRU S899-EXIT. DTSCU400 00697 DTSCU400 00698 S1000-EXIT. DTSCU400 00699 EXIT. DTSCU400 00700 DTSCU400 00701 S2000-INIT-MFSC. DTSCU400 00702 MOVE LOW-VALUE TO MFSC-REC. DTSCU400 00703 DTSCU400 00704 MOVE WRK-EMP-NO TO MFSC-EMP-NO. DTSCU400 00705 SET MFSC-FSC-88 TO TRUE. DTSCU400 00706 MOVE WRK-ABS-QTR TO MFSC-ABS-QTR. DTSCU400 00707 MOVE L005-ABSTIME TO MFSC-ABSTIME. DTSCU400 00708 DTSCU400 00709 MOVE ZERO TO MFSC-PURGE-DATE DTSCU400 00710 MFSC-INITIAL-MAIL-DATE DTSCU400 00711 MFSC-CONFIRM-MAIL-DATE DTSCU400 00712 MFSC-DENIAL-MAIL-DATE. DTSCU400 00713 DTSCU400 00714 MOVE WRK-START-YRQ TO MFSC-START-YRQ. DTSCU400 00715 MOVE +99999 TO MFSC-END-YRQ. DTSCU400 00716 SET MFSC-REQ-LIAB-DETERM-88 TO TRUE. DTSCU400 00717 MOVE SPACES TO MFSC-CHANGE-REASON-CD DTSCU400 00718 MFSC-INIT-NOTICE-TYPE DTSCU400 00719 MFSC-CONFIRM-NOTICE-TYPE DTSCU400 00720 MFSC-DENIAL-NOTICE-TYPE. DTSCU400 00721 MOVE L400-OP-ID TO MFSC-CHNG-OP-ID. DTSCU400 00722 MOVE L400-CURR-RUN-DATE TO MFSC-ESTB-DATE DTSCU400 00723 MFSC-CHNG-DATE. DTSCU400 00724 MOVE ZERO TO MFSC-NOTE-CNT. DTSCU400 00725 DTSCU400 00726 DTSCU400 00727 S2000-EXIT. DTSCU400 00728 EXIT. DTSCU400 00729 DTSCU400 00730 S899-ABEND. DTSCU400 00731 SKIP1 DTSCU400 00732 EXEC CICS DTSCU400 00733 ABEND DTSCU400 00734 ABCODE (WRK-ABEND-CODE) DTSCU400 00735 END-EXEC. DTSCU400 00736 SKIP1 DTSCU400 00737 S899-EXIT. DTSCU400 00738 EXIT. DTSCU400