00001 IDENTIFICATION DIVISION. 09/14/05 00002 PROGRAM-ID. DTSBD326. DTSBD326 00003 AUTHOR. NGC. LV003 00004 DATE-WRITTEN. APRIL 2004. DTSBD326 00005 DATE-COMPILED. DTSBD326 00006 SKIP3 DTSBD326 00007 ***** DTSBD326 00008 * DTSBD326 00009 * FUNCTION: COMPROMISE SETTLEMENT PROCESSING. DTSBD326 00010 * DTSBD326 00011 * DTSBD326 00012 * MODIFICATION LOG: DTSBD326 00013 * DTSBD326 00014 * 04/30/2004 INITIAL DEVELOPMENT DTSBD326 00015 * REFERENCE: COMPROMISE PROGRAMMER: GD DTSBD326 00016 * DTSBD326 00017 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD326 00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD326 00019 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBD326 00020 * DTSBD326 00021 * DTSBD326 00022 * DESCRIPTION: DTSBD326 00023 * DTSBD326 00024 * READ THE MCMP RECORD INDICATED BY T011-ESTB-ABSTIME. DTSBD326 00025 * DTSBD326 00026 * IF MCMP RECORD INDICATED BY T011-ESTB-ABSTIME DOES NOT DTSBD326 00027 * EXIST, THEN THE TRANSACTION IS IN ERROR. DTSBD326 00028 * DTSBD326 00029 * IF NOT (MCMP-STATUS-PENDING-88), DTSBD326 00030 * THEN THE TRANSACTION IS IN ERROR. DTSBD326 00031 * DTSBD326 00032 * SCAN THE MQTR RECORDS INDICATED BY MCMP-COVERED-YRQ. DTSBD326 00033 * IF NO UI TAX HAS BEEN WAIVED IN MCMP-COVERED-YRQ(S), DTSBD326 00034 * THEN CHANGE MCMP STATUS TO MCMP-STATUS-WITHDRAWN-88 DTSBD326 00035 * AND THE TRANSACTION IS IN ERROR. DTSBD326 00036 * DTSBD326 00037 * THE FOLLOWING SPECIFICATIONS ASSUME AMOUNTS ARE WAIVED DTSBD326 00038 * IN ONE OR MORE OF MCMP-COVERED-YRQ(S). DTSBD326 00039 * DTSBD326 00040 * CONSTRUCT AND WRITE A R436 RECORD. DTSBD326 00041 * DTSBD326 00042 * WRITE AN EVENT LOG RECORD. DTSBD326 00043 * DTSBD326 00044 * DTSBD326 00045 * MASTER FILE RECORDS READ: DTSBD326 00046 * DTSBD326 00047 * MCMP DTSBD326 00048 * MQTR DTSBD326 00049 * MOPO DTSBD326 00050 * DTSBD326 00051 * DTSBD326 00052 * MASTER FILE RECORDS UPDATED: DTSBD326 00053 * DTSBD326 00054 * MCMP (REWRITE) DTSBD326 00055 * MEVL (WRITE) DTSBD326 00056 * DTSBD326 00057 * DTSBD326 00058 * REPORT RECORDS WRITTEN: DTSBD326 00059 * DTSBD326 00060 * R436 COMPROMISE SETTLEMENT DOCUMENT. DTSBD326 00061 * R907 EXCEPTION REPORT. DTSBD326 00062 * DTSBD326 00063 * DTSBD326 00064 * MODULES CALLED: DTSBD326 00065 * DTSBD326 00066 * DTSBU001 DATE EDIT/CONVERSION. DTSBD326 00067 * DTSBU004 QUARTER EDIT/CONVERSION. DTSBD326 00068 * DTSBU005 TIME EDIT/CONVERSION. DTSBD326 00069 * DTSBU101 INTEREST CHARGE/ABATEMENT COMPUTATION. DTSBD326 00070 * DTSBU910 MASTER FILE I/O DRIVER. DTSBD326 00071 * DTSBU946 VARIABLE LENGTH RECORD SEQUENTAIL OUTPUT 1. DTSBD326 00072 * DTSBD326 00073 * DTSBD326 00074 ***** DTSBD326 00075 SKIP3 DTSBD326 00076 ENVIRONMENT DIVISION. DTSBD326 00077 EJECT DTSBD326 00078 DATA DIVISION. DTSBD326 00079 SKIP3 DTSBD326 00080 WORKING-STORAGE SECTION. DTSBD326 000805 77 PAN-VALET PICTURE X(24) VALUE '003DTSBD326 09/14/05'. DTSBD326 00081 SKIP3 DTSBD326 00082 01 WRK-AREA. DTSBD326 00083 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +326.DTSBD326 00084 DTSBD326 00085 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBD326'.DTSBD326 00086 DTSBD326 00087 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBD326 00088 DTSBD326 00089 05 WRK-AMT-DISP1 PIC --------9.99. DTSBD326 00090 05 WRK-AMT-DISP2 PIC --------9.99. DTSBD326 00091 DTSBD326 00092 05 WRK-QTR-FOUND-IND PIC X(01). DTSBD326 00093 88 WRK-QTR-FOUND-YES-88 VALUE 'Y'. DTSBD326 00094 88 WRK-QTR-FOUND-NO-88 VALUE 'N'. DTSBD326 00095 DTSBD326 00096 05 WRK-QTR-WAIVER-IND PIC X(01). DTSBD326 00097 88 WRK-QTR-WAIVER-YES-88 VALUE 'Y'. DTSBD326 00098 88 WRK-QTR-WAIVER-NO-88 VALUE 'N'. DTSBD326 00099 DTSBD326 00100 05 WRK-CNT PIC S9(04) COMP. DTSBD326 00101 05 WRK-AMT PIC S9(09)V9(02) COMP-3. DTSBD326 00102 DTSBD326 00103 05 WRK-TOT-BALANCE-AMT PIC S9(09)V9(02) COMP-3. DTSBD326 00104 05 WRK-YRQ-UI-WAIVED-AMT PIC S9(09)V9(02) COMP-3. DTSBD326 00105 05 WRK-TOT-TAX-WAIVED-AMT PIC S9(09)V9(02) COMP-3. DTSBD326 00106 05 WRK-TOT-PEN-WAIVED-AMT PIC S9(09)V9(02) COMP-3. DTSBD326 00107 05 WRK-TOT-INT-WAIVED-AMT PIC S9(09)V9(02) COMP-3. DTSBD326 00108 DTSBD326 00109 05 WRK-QTR-TBL. DTSBD326 00110 10 WRK-QTR-MAX PIC S9(04) COMP DTSBD326 00111 VALUE +20. DTSBD326 00112 10 WRK-QTR-CNT PIC S9(04) COMP. DTSBD326 00113 10 QTR-SUB PIC S9(04) COMP. DTSBD326 00114 10 FILLER OCCURS 20. DTSBD326 00115 15 WRK-QTR-YRQ PIC S9(05) COMP-3. DTSBD326 00116 15 WRK-QTR-WAIVED-AMT PIC S9(09)V99 COMP-3. DTSBD326 00117 15 WRK-QTR-REVERSE-AMT PIC S9(09)V99 COMP-3. DTSBD326 00118 DTSBD326 00119 05 WRK-REVERSE-TBL. DTSBD326 00120 10 WRK-REV-MAX PIC S9(04) COMP DTSBD326 00121 VALUE +100. DTSBD326 00122 10 REV-CNT PIC S9(04) COMP. DTSBD326 00123 10 REV-SUB PIC S9(04) COMP. DTSBD326 00124 10 FILLER OCCURS 100. DTSBD326 00125 15 WRK-REV-APPLIC-YRQ PIC S9(05) COMP-3. DTSBD326 00126 15 WRK-REV-APPLIC-IND PIC X(02). DTSBD326 00127 15 WRK-REV-AMT PIC S9(09)V99 COMP-3. DTSBD326 00128 DTSBD326 00129 05 WRK-EVENT-TXT. DTSBD326 00130 10 FILLER PIC X(36) DTSBD326 00131 VALUE 'COMPROMISE SETTLEMENT PRINTED. '. DTSBD326 00132 EJECT DTSBD326 00133 01 MSG-TABLE. DTSBD326 00134 05 MSG1-MCMP-NOT-FOUND. DTSBD326 00135 10 MSG1-ID PIC X(11) VALUE 'DTSBD326411'. DTSBD326 00136 10 MSG1-SHORT-TEXT PIC X(20) VALUE 'DELETED MCMP '. DTSBD326 00137 10 MSG1-LONG-TEXT. DTSBD326 00138 15 FILLER PIC X(30) DTSBD326 00139 VALUE 'TRANSACTION FAILED - RECORD NO'. DTSBD326 00140 15 FILLER PIC X(30) DTSBD326 00141 VALUE 'T FOUND - NO CMP PRINTED '. DTSBD326 00142 DTSBD326 00143 05 MSG2-MCMP-NOT-PENDING. DTSBD326 00144 10 MSG2-ID PIC X(11) VALUE 'DTSBD326412'. DTSBD326 00145 10 MSG2-SHORT-TEXT PIC X(20) VALUE 'NOT PENDING '. DTSBD326 00146 10 MSG2-LONG-TEXT. DTSBD326 00147 15 FILLER PIC X(30) DTSBD326 00148 VALUE 'TRANSACTION FAILED - COMPROMIS'. DTSBD326 00149 15 FILLER PIC X(30) DTSBD326 00150 VALUE 'E NOT PENDING - NO CMP PRNTED'. DTSBD326 00151 DTSBD326 00152 05 MSG3-MQTR-NOT-FOUND. DTSBD326 00153 10 MSG3-ID. DTSBD326 00154 15 MSG3-ID-1 PIC X(08) VALUE 'DTSBD326'. DTSBD326 00155 15 MSG3-ID-2 PIC X(03) VALUE '413'. DTSBD326 00156 10 MSG3-SHORT-TEXT PIC X(20) VALUE 'MQTR NOT FOUND'. DTSBD326 00157 10 MSG3-LONG-TEXT. DTSBD326 00158 15 FILLER PIC X(30) DTSBD326 00159 VALUE 'TRANSACTION FAILED - MQTR RECO'. DTSBD326 00160 15 FILLER PIC X(30) DTSBD326 00161 VALUE 'RD NOT FOUND '. DTSBD326 00162 15 MSG3-YRQ PIC X(06). DTSBD326 00163 DTSBD326 00164 05 MSG4-NO-DUE. DTSBD326 00165 10 MSG4-ID. DTSBD326 00166 15 MSG4-ID-1 PIC X(08) VALUE 'DTSBD326'. DTSBD326 00167 15 MSG4-ID-2 PIC X(03) VALUE '414'. DTSBD326 00168 10 MSG4-SHORT-TEXT PIC X(20) VALUE 'NOTHING WAIVED'. DTSBD326 00169 10 MSG4-LONG-TEXT. DTSBD326 00170 15 FILLER PIC X(30) DTSBD326 00171 VALUE 'NOTHING WAIVED - NO COMPROMISE'. DTSBD326 00172 15 FILLER PIC X(30) DTSBD326 00173 VALUE ' SETTLEMENT PRINTED '. DTSBD326 00174 DTSBD326 00175 05 MSG5-NO-WAIVER. DTSBD326 00176 10 MSG5-ID. DTSBD326 00177 15 MSG5-ID-1 PIC X(08) VALUE 'DTSBD326'. DTSBD326 00178 15 MSG5-ID-2 PIC X(03) VALUE '415'. DTSBD326 00179 10 MSG5-SHORT-TEXT PIC X(20) VALUE 'NO WAIVER '. DTSBD326 00180 10 MSG5-LONG-TEXT. DTSBD326 00181 15 FILLER PIC X(30) DTSBD326 00182 VALUE 'UI TAX NOT WAIVED FOR THIS QUA'. DTSBD326 00183 15 FILLER PIC X(05) DTSBD326 00184 VALUE 'RTER '. DTSBD326 00185 15 MSG5-YRQ PIC X(06). DTSBD326 00186 DTSBD326 00187 05 MSG6-ADJ-FAILED. DTSBD326 00188 10 MSG6-ID. DTSBD326 00189 15 MSG6-ID-1 PIC X(08) VALUE 'DTSBD326'. DTSBD326 00190 15 MSG6-ID-2 PIC X(03) VALUE '416'. DTSBD326 00191 10 MSG6-SHORT-TEXT PIC X(20) VALUE 'ADJ FAILED '. DTSBD326 00192 10 MSG6-LONG-TEXT. DTSBD326 00193 15 FILLER PIC X(30) DTSBD326 00194 VALUE 'ADJ TRANSACTION FAILED - WITHD'. DTSBD326 00195 15 FILLER PIC X(16) DTSBD326 00196 VALUE 'RAWAL CANCELLED '. DTSBD326 00197 05 MSG7-ADJ-EDIT-FAILED. DTSBD326 00198 10 MSG7-ID. DTSBD326 00199 15 MSG7-ID-1 PIC X(08) VALUE 'DTSBD326'. DTSBD326 00200 15 MSG7-ID-2 PIC X(03) VALUE '417'. DTSBD326 00201 10 MSG7-SHORT-TEXT PIC X(20) VALUE 'ADJ EDIT FAIL '. DTSBD326 00202 10 MSG7-LONG-TEXT. DTSBD326 00203 15 FILLER PIC X(30) DTSBD326 00204 VALUE 'ADJ WAIVED AMT NOT = QTR WAIVE'. DTSBD326 00205 15 FILLER PIC X(16) DTSBD326 00206 VALUE 'D AMT '. DTSBD326 00207 EJECT DTSBD326 00208 01 L001-LINK-AREA. DTSBD326 00209 ++INCLUDE DTSIL001 DTSBD326 00210 SKIP3 DTSBD326 00211 01 L003-LINK-AREA. DTSBD326 00212 ++INCLUDE DTSIL003 DTSBD326 00213 SKIP3 DTSBD326 00214 01 L004-LINK-AREA. DTSBD326 00215 ++INCLUDE DTSIL004 DTSBD326 00216 SKIP3 DTSBD326 00217 01 L005-LINK-AREA. DTSBD326 00218 ++INCLUDE DTSIL005 DTSBD326 00219 SKIP3 DTSBD326 00220 01 L101-LINK-AREA. DTSBD326 00221 ++INCLUDE DTSIL101 DTSBD326 00222 EJECT DTSBD326 00223 01 ASKL-REC. DTSBD326 00224 ++INCLUDE DTSIASKL DTSBD326 00225 SKIP3 DTSBD326 00226 01 AADJ-REC REDEFINES ASKL-REC. DTSBD326 00227 ++INCLUDE DTSIAADJ DTSBD326 00228 DTSBD326 00229 01 L910-LINK-AREA. DTSBD326 00230 ++INCLUDE DTSIL910 DTSBD326 00231 SKIP3 DTSBD326 00232 01 MSKL-REC. DTSBD326 00233 ++INCLUDE DTSIMSKL DTSBD326 00234 SKIP3 DTSBD326 00235 01 MCMP-REC. DTSBD326 00236 ++INCLUDE DTSIMCMP DTSBD326 00237 SKIP3 DTSBD326 00238 01 MQTR-REC. DTSBD326 00239 ++INCLUDE DTSIMQTR DTSBD326 00240 SKIP3 DTSBD326 00241 01 MEVL-REC. DTSBD326 00242 ++INCLUDE DTSIMEVL DTSBD326 00243 SKIP3 DTSBD326 00244 01 MTCK-REC. DTSBD326 00245 ++INCLUDE DTSIMTCK DTSBD326 00246 EJECT DTSBD326 00247 01 MADJ-REC. DTSBD326 00248 ++INCLUDE DTSIMADJ DTSBD326 00249 EJECT DTSBD326 00250 01 MMAX-LITERALS. DTSBD326 00251 ++INCLUDE DTSIMMAX DTSBD326 00252 EJECT DTSBD326 00253 01 R436-REC. DTSBD326 00254 ++INCLUDE DTSIR436 DTSBD326 00255 SKIP3 DTSBD326 00256 01 L501-LINK-AREA. DTSBD326 00257 ++INCLUDE DTSIL501 DTSBD326 00258 DTSBD326 00259 01 R907-REC. DTSBD326 00260 ++INCLUDE DTSIR907 DTSBD326 00261 EJECT DTSBD326 00262 LINKAGE SECTION. DTSBD326 00263 SKIP3 DTSBD326 00264 01 LBCM-LINK-AREA. DTSBD326 00265 ++INCLUDE DTSILBCM DTSBD326 00266 EJECT DTSBD326 00267 01 MPRF-REC. DTSBD326 00268 ++INCLUDE DTSIMPRF DTSBD326 00269 EJECT DTSBD326 00270 01 T011-REC. DTSBD326 00271 ++INCLUDE DTSIT011 DTSBD326 00272 EJECT DTSBD326 00273 PROCEDURE DIVISION USING LBCM-LINK-AREA DTSBD326 00274 MPRF-REC DTSBD326 00275 T011-REC. DTSBD326 00276 DTSBD326 00277 DTSBD326 00278 IF FIRST-TIME-IND = 'Y' DTSBD326 00279 PERFORM I0000-FIRST-TIME THRU I0000-EXIT DTSBD326 00280 MOVE 'N' TO FIRST-TIME-IND. DTSBD326 00281 DTSBD326 00282 DTSBD326 00283 IF T011-CMP-PKG DTSBD326 00284 OR T011-CMP-TCK DTSBD326 00285 OR T011-CMP-WD DTSBD326 00286 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBD326 00287 ELSE DTSBD326 00288 PERFORM S999-ABEND THRU S999-EXIT. DTSBD326 00289 DTSBD326 00290 DTSBD326 00291 GOBACK. DTSBD326 00292 EJECT DTSBD326 00293 I0000-FIRST-TIME. DTSBD326 00294 MOVE LBCM-TRACE-IND TO L910-TRACE-IND. DTSBD326 00295 DTSBD326 00296 MOVE WRK-MOD-NAME TO L910-MOD-NAME DTSBD326 00297 R907-MODULE-NAME DTSBD326 00298 L501-ORIGIN. DTSBD326 00299 DTSBD326 00300 MOVE LENGTH OF R436-REC TO R436-LENGTH. DTSBD326 00301 DTSBD326 00302 MOVE LENGTH OF R907-REC TO R907-LENGTH. DTSBD326 00303 DTSBD326 00304 I0000-EXIT. DTSBD326 00305 EXIT. DTSBD326 00306 DTSBD326 00307 P0000-PROCESS. DTSBD326 00308 PERFORM S1000-READ-SUBJECT-MCMP THRU S1000-EXIT. DTSBD326 00309 DTSBD326 00310 IF L910-NO-REC-88 DTSBD326 00311 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD326 00312 MOVE MSG1-MCMP-NOT-FOUND TO LBCM-TRN-MSG-AREA DTSBD326 00313 GO TO P0000-EXIT. DTSBD326 00314 DTSBD326 00315 PERFORM S2000-DELETE-MTCK THRU S2000-EXIT. DTSBD326 00316 ************************************************************* DTSBD326 00317 * STATUS MUST BE PENDING. THIS PROGRAM WRITES A TICKLER DTSBD326 00318 * IF THE MCMP CANNOT BE UPDATED SUCCESSFULLY - THE TICKLER DTSBD326 00319 * WILL TRIGGER ON THE NEXT RUN DATE, AND CALL THIS PROGRAM DTSBD326 00320 * TO RE-PROCESS THE MCMP. IF THE T011 TRANSACTION CAME FROM DTSBD326 00321 * THE TICKLER PROCESS (T011-CMP-TCK IS TRUE), AND THE STATUS DTSBD326 00322 * IS NOT PENDING, THEN PROCESSING HAS BEEN COMPLETED, AND DTSBD326 00323 * THE TRIGGER RECORD CAN BE IGNORED. DTSBD326 00324 ************************************************************* DTSBD326 00325 IF MCMP-STATUS-WITHDRAWN-88 DTSBD326 00326 PERFORM P7000-WITHDRAW THRU P7000-EXIT DTSBD326 00327 IF LBCM-TRN-NOT-OK-88 DTSBD326 00328 PERFORM P6000-WRITE-TICKLER THRU P6000-EXIT DTSBD326 00329 END-IF DTSBD326 00330 GO TO P0000-EXIT DTSBD326 00331 ELSE DTSBD326 00332 IF MCMP-STATUS-PENDING-88 DTSBD326 00333 NEXT SENTENCE DTSBD326 00334 ELSE DTSBD326 00335 IF T011-CMP-PKG DTSBD326 00336 GO TO P0000-EXIT DTSBD326 00337 ELSE DTSBD326 00338 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD326 00339 MOVE MSG2-MCMP-NOT-PENDING TO LBCM-TRN-MSG-AREA DTSBD326 00340 GO TO P0000-EXIT DTSBD326 00341 END-IF DTSBD326 00342 END-IF DTSBD326 00343 END-IF. DTSBD326 00344 DTSBD326 00345 PERFORM P1000-START-R436 THRU P1000-EXIT. DTSBD326 00346 DTSBD326 00347 MOVE MCMP-INT-COMP-DATE TO L101-RECEIVED-DATE. DTSBD326 00348 *& DTSBD326 00349 * DISPLAY 'BD326 P0000 INT COMP ' MCMP-INT-COMP-DATE DTSBD326 00350 * ' ABS ' LBCM-ABSTIME. DTSBD326 00351 *& DTSBD326 00352 DTSBD326 00353 SET L101-WAIVE-INT-NO-88 TO TRUE. DTSBD326 00354 DTSBD326 00355 MOVE LOW-VALUE TO MQTR-KEY-AREA. DTSBD326 00356 DTSBD326 00357 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBD326 00358 DTSBD326 00359 SET MQTR-QTR-88 TO TRUE. DTSBD326 00360 DTSBD326 00361 PERFORM P3000-PROCESS-MQTR THRU P3000-EXIT. DTSBD326 00362 DTSBD326 00363 IF LBCM-TRN-OK-88 DTSBD326 00364 PERFORM P4000-WRITE-MCMP-AND-REPORT THRU P4000-EXIT DTSBD326 00365 PERFORM P5000-UPDATE-MQTR THRU P5000-EXIT DTSBD326 00366 ELSE DTSBD326 00367 PERFORM P6000-WRITE-TICKLER THRU P6000-EXIT DTSBD326 00368 END-IF. DTSBD326 00369 DTSBD326 00370 P0000-EXIT. DTSBD326 00371 EXIT. DTSBD326 00372 EJECT DTSBD326 00373 P1000-START-R436. DTSBD326 00374 MOVE T011-RESP-OP-ID TO R436-RESP-OP-ID. DTSBD326 00375 DTSBD326 00376 MOVE MPRF-EMP-NO TO R436-EMP-NO. DTSBD326 00377 DTSBD326 00378 DTSBD326 00379 INITIALIZE R436-DATA-AREA. DTSBD326 00380 MOVE LBCM-CURR-MAIL-DATE TO R436-MAIL-DATE. DTSBD326 00381 DTSBD326 00382 MOVE MCMP-SETTLEMENT-DATE TO R436-SETTLEMENT-DATE DTSBD326 00383 DTSBD326 00384 MOVE MPRF-PRIMARY-NAME TO R436-PRIMARY-NAME. DTSBD326 00385 DTSBD326 00386 MOVE MCMP-MAILING-ADDRESS TO R436-MAILING-ADDRESS. DTSBD326 00387 DTSBD326 00388 P1000-EXIT. DTSBD326 00389 EXIT. DTSBD326 00390 EJECT DTSBD326 00391 P3000-PROCESS-MQTR. DTSBD326 00392 MOVE +0 TO WRK-TOT-BALANCE-AMT DTSBD326 00393 WRK-TOT-TAX-WAIVED-AMT DTSBD326 00394 WRK-TOT-PEN-WAIVED-AMT DTSBD326 00395 WRK-TOT-INT-WAIVED-AMT. DTSBD326 00396 DTSBD326 00397 PERFORM P3100-EACH-QTR THRU P3100-EXIT DTSBD326 00398 VARYING WRK-CNT FROM 1 BY 1 DTSBD326 00399 UNTIL WRK-CNT > MCMP-COV-CNT. DTSBD326 00400 DTSBD326 00401 IF LBCM-TRN-OK-88 DTSBD326 00402 IF WRK-TOT-TAX-WAIVED-AMT = ZERO DTSBD326 00403 DISPLAY 'ERR: TOT WAIVED = ZERO' DTSBD326 00404 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD326 00405 MOVE MSG4-NO-DUE TO LBCM-TRN-MSG-AREA DTSBD326 00406 END-IF DTSBD326 00407 END-IF. DTSBD326 00408 DTSBD326 00409 P3000-EXIT. DTSBD326 00410 EXIT. DTSBD326 00411 DTSBD326 00412 P3100-EACH-QTR. DTSBD326 00413 *& DTSBD326 00414 DISPLAY 'BD326 P3100 ' MPRF-EMP-NO DTSBD326 00415 ' WRK-CNT ' WRK-CNT DTSBD326 00416 ' QTR ' MCMP-COVERED-YRQ (WRK-CNT). DTSBD326 00417 *& DTSBD326 00418 MOVE +0 TO L101-PAID-CHNG. DTSBD326 00419 DTSBD326 00420 SET WRK-QTR-WAIVER-NO-88 TO TRUE. DTSBD326 00421 DTSBD326 00422 MOVE MCMP-COVERED-YRQ (WRK-CNT) TO MQTR-YRQ. DTSBD326 00423 DTSBD326 00424 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBD326 00425 DTSBD326 00426 PERFORM S910-READ THRU S910-EXIT. DTSBD326 00427 DTSBD326 00428 IF L910-OK-88 DTSBD326 00429 MOVE MSKL-REC TO MQTR-REC DTSBD326 00430 ELSE DTSBD326 00431 DISPLAY 'ERR: P3100 NO MQTR' DTSBD326 00432 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD326 00433 MOVE MSG3-ID-2 TO R907-MSG-ID DTSBD326 00434 MOVE MQTR-YRQ TO L004-QTR-5-9 DTSBD326 00435 PERFORM S004-FROM-5 THRU S004-EXIT DTSBD326 00436 MOVE L004-SLASH-5-QTR TO MSG3-YRQ DTSBD326 00437 MOVE MPRF-EMP-NO TO R907-EMP-NO DTSBD326 00438 MOVE MSG3-LONG-TEXT TO R907-MSG-TEXT DTSBD326 00439 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBD326 00440 GO TO P3100-EXIT. DTSBD326 00441 DTSBD326 00442 DTSBD326 00443 PERFORM P3110-PROCESS-ACCT-AREA THRU P3110-EXIT DTSBD326 00444 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBD326 00445 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT. DTSBD326 00446 DTSBD326 00447 IF WRK-QTR-WAIVER-NO-88 DTSBD326 00448 DISPLAY 'ERR: P3100 NOTHING WAIVED' DTSBD326 00449 MOVE MSG5-ID-2 TO R907-MSG-ID DTSBD326 00450 MOVE MQTR-YRQ TO L004-QTR-5-9 DTSBD326 00451 PERFORM S004-FROM-5 THRU S004-EXIT DTSBD326 00452 MOVE L004-SLASH-5-QTR TO MSG5-YRQ DTSBD326 00453 MOVE MPRF-EMP-NO TO R907-EMP-NO DTSBD326 00454 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD326 00455 MOVE MSG5-LONG-TEXT TO R907-MSG-TEXT DTSBD326 00456 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBD326 00457 GO TO P3100-EXIT. DTSBD326 00458 DTSBD326 00459 MOVE MQTR-TAX-DUE-DATE TO L101-TAX-DUE-DATE. DTSBD326 00460 DTSBD326 00461 MOVE MQTR-INT-AREA TO L101-INT-AREA. DTSBD326 00462 DTSBD326 00463 PERFORM S101-PER-MONTH-NO THRU S101-EXIT. DTSBD326 00464 DISPLAY 'INT CHNG ' L101-INT-CHARGE-CHNG. DTSBD326 00465 DTSBD326 00466 ADD L101-INT-CHARGE-CHNG TO WRK-TOT-BALANCE-AMT. DTSBD326 00467 ** WRK-YRQ-INT-WAIVED-AMT. DTSBD326 00468 DTSBD326 00469 SUBTRACT L101-INT-WAIVE-CHNG FROM WRK-TOT-BALANCE-AMT. DTSBD326 00470 ** WRK-YRQ-INT-WAIVED-AMT. DTSBD326 00471 DTSBD326 00472 IF R436-COV-CNT < MMAX-CMP-COV-MAX DTSBD326 00473 ADD +1 TO R436-COV-CNT DTSBD326 00474 MOVE MQTR-YRQ TO R436-COVERED-YRQ (R436-COV-CNT) DTSBD326 00475 END-IF. DTSBD326 00476 DTSBD326 00477 P3100-EXIT. DTSBD326 00478 EXIT. DTSBD326 00479 DTSBD326 00480 P3110-PROCESS-ACCT-AREA. DTSBD326 00481 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) TO WRK-TOT-BALANCE-AMT. DTSBD326 00482 DTSBD326 00483 IF MQTR-ACCT-TAX-88 (MQTR-ACCT-IDX) DTSBD326 00484 IF MQTR-WAIVED-AMT (MQTR-ACCT-IDX) > ZERO DTSBD326 00485 SET WRK-QTR-WAIVER-YES-88 TO TRUE DTSBD326 00486 END-IF DTSBD326 00487 ADD MQTR-WAIVED-AMT (MQTR-ACCT-IDX) DTSBD326 00488 TO WRK-TOT-TAX-WAIVED-AMT DTSBD326 00489 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBD326 00490 TO L101-PAID-CHNG DTSBD326 00491 ELSE DTSBD326 00492 IF MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX) DTSBD326 00493 ADD MQTR-WAIVED-AMT (MQTR-ACCT-IDX) DTSBD326 00494 TO WRK-TOT-PEN-WAIVED-AMT DTSBD326 00495 ELSE DTSBD326 00496 IF MQTR-ACCT-INT-88 (MQTR-ACCT-IDX) DTSBD326 00497 ADD MQTR-WAIVED-AMT (MQTR-ACCT-IDX) DTSBD326 00498 TO WRK-TOT-INT-WAIVED-AMT DTSBD326 00499 END-IF DTSBD326 00500 END-IF DTSBD326 00501 END-IF. DTSBD326 00502 DTSBD326 00503 P3110-EXIT. DTSBD326 00504 EXIT. DTSBD326 00505 EJECT DTSBD326 00506 P4000-WRITE-MCMP-AND-REPORT. DTSBD326 00507 MOVE WRK-TOT-BALANCE-AMT TO MCMP-TOT-BALANCE-AMT DTSBD326 00508 R436-SETTLEMENT-DUE-AMT. DTSBD326 00509 MOVE WRK-TOT-TAX-WAIVED-AMT TO MCMP-TAX-WAIVED-AMT DTSBD326 00510 R436-TAX-WAIVED-AMT. DTSBD326 00511 MOVE WRK-TOT-PEN-WAIVED-AMT TO MCMP-PEN-WAIVED-AMT DTSBD326 00512 R436-PEN-WAIVED-AMT. DTSBD326 00513 MOVE WRK-TOT-INT-WAIVED-AMT TO MCMP-INT-WAIVED-AMT DTSBD326 00514 R436-INT-WAIVED-AMT. DTSBD326 00515 DTSBD326 00516 PERFORM S946-WRITE-R436 THRU S946-EXIT. DTSBD326 00517 DTSBD326 00518 PERFORM P4100-WRITE-MEVL THRU P4100-EXIT. DTSBD326 00519 DTSBD326 00520 SET MCMP-STATUS-FINAL-88 TO TRUE. DTSBD326 00521 DTSBD326 00522 MOVE LBCM-CURR-RUN-DATE TO MCMP-CHNG-DATE. DTSBD326 00523 DTSBD326 00524 MOVE MCMP-REC TO MSKL-REC. DTSBD326 00525 DTSBD326 00526 PERFORM S910-REWRITE THRU S910-EXIT. DTSBD326 00527 P4000-EXIT. DTSBD326 00528 EXIT. DTSBD326 00529 EJECT DTSBD326 00530 P4100-WRITE-MEVL. DTSBD326 00531 MOVE LOW-VALUE TO MEVL-REC. DTSBD326 00532 DTSBD326 00533 MOVE MPRF-EMP-NO TO MEVL-EMP-NO. DTSBD326 00534 DTSBD326 00535 SET MEVL-EVL-88 TO TRUE. DTSBD326 00536 DTSBD326 00537 ADD +1000 TO LBCM-EMP-ABSTIME. DTSBD326 00538 DTSBD326 00539 MOVE LBCM-EMP-ABSTIME TO L005-ABSTIME. DTSBD326 00540 DTSBD326 00541 PERFORM S005-FROM-ABSTIME THRU S005-EXIT. DTSBD326 00542 DTSBD326 00543 MOVE L005-DATE TO MEVL-DATE. DTSBD326 00544 DTSBD326 00545 MOVE L005-TIME TO MEVL-TIME. DTSBD326 00546 DTSBD326 00547 MOVE +0 TO MEVL-PURGE-DATE. DTSBD326 00548 DTSBD326 00549 MOVE WRK-EVENT-TXT TO MEVL-TEXT. DTSBD326 00550 DTSBD326 00551 SET MEVL-SOURCE-SYSTEM-88 TO TRUE. DTSBD326 00552 DTSBD326 00553 SET MEVL-NOT-CONVERTED-88 TO TRUE. DTSBD326 00554 DTSBD326 00555 MOVE LBCM-CURR-RUN-DATE TO MEVL-ESTB-DATE DTSBD326 00556 MEVL-CHNG-DATE. DTSBD326 00557 DTSBD326 00558 MOVE MEVL-REC TO MSKL-REC. DTSBD326 00559 DTSBD326 00560 PERFORM S910-WRITE THRU S910-EXIT. DTSBD326 00561 P4100-EXIT. DTSBD326 00562 EXIT. DTSBD326 00563 DTSBD326 00564 P5000-UPDATE-MQTR. DTSBD326 00565 MOVE LOW-VALUE TO MQTR-KEY-AREA. DTSBD326 00566 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBD326 00567 SET MQTR-QTR-88 TO TRUE. DTSBD326 00568 DTSBD326 00569 PERFORM P5100-PROCESS-MQTR THRU P5100-EXIT DTSBD326 00570 VARYING WRK-CNT FROM 1 BY 1 DTSBD326 00571 UNTIL WRK-CNT > MCMP-COV-CNT. DTSBD326 00572 DTSBD326 00573 P5000-EXIT. DTSBD326 00574 EXIT. DTSBD326 00575 DTSBD326 00576 P5100-PROCESS-MQTR. DTSBD326 00577 MOVE MCMP-COVERED-YRQ (WRK-CNT) TO MQTR-YRQ. DTSBD326 00578 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBD326 00579 DTSBD326 00580 PERFORM S910-READ THRU S910-EXIT. DTSBD326 00581 DTSBD326 00582 IF L910-OK-88 DTSBD326 00583 MOVE MSKL-REC TO MQTR-REC DTSBD326 00584 MOVE MCMP-ESTB-ABSTIME TO MQTR-CMP-ESTB-ABSTIME DTSBD326 00585 MOVE MQTR-REC TO MSKL-REC DTSBD326 00586 PERFORM S910-REWRITE THRU S910-EXIT DTSBD326 00587 ELSE DTSBD326 00588 DISPLAY 'DTSBD326 CANNOT FIND MQTR ' MQTR-YRQ DTSBD326 00589 PERFORM S999-ABEND THRU S999-EXIT DTSBD326 00590 END-IF. DTSBD326 00591 DTSBD326 00592 P5100-EXIT. DTSBD326 00593 EXIT. DTSBD326 00594 DTSBD326 00595 P6000-WRITE-TICKLER. DTSBD326 00596 MOVE LOW-VALUE TO MTCK-REC. DTSBD326 00597 MOVE MPRF-EMP-NO TO MTCK-EMP-NO. DTSBD326 00598 SET MTCK-TCK-88 TO TRUE. DTSBD326 00599 MOVE LBCM-ABSTIME TO MTCK-ESTB-ABSTIME. DTSBD326 00600 MOVE +0 TO MTCK-PURGE-DATE. DTSBD326 00601 INITIALIZE MTCK-DATA-AREA. DTSBD326 00602 SET MTCK-TYPE-CMP-PEND-88 TO TRUE. DTSBD326 00603 DTSBD326 00604 MOVE LBCM-CURR-RUN-DATE TO L001-FED-8-DATE-9. DTSBD326 00605 SET L001-FROM-FED-8 TO TRUE. DTSBD326 00606 PERFORM S001-CONVERT-DATE THRU S001-EXIT. DTSBD326 00607 ADD +1 TO L001-JUL-ABS-DAY. DTSBD326 00608 SET L001-FROM-ABS-DAY TO TRUE. DTSBD326 00609 PERFORM S001-CONVERT-DATE THRU S001-EXIT. DTSBD326 00610 MOVE L001-FED-8-DATE-9 TO MTCK-TRIGGER-DATE. DTSBD326 00611 DTSBD326 00612 SET MTCK-SOURCE-SYSTEM-88 TO TRUE. DTSBD326 00613 SET MTCK-DEST-SYSTEM-88 TO TRUE. DTSBD326 00614 MOVE MCMP-ESTB-ABSTIME TO MTCK-CMP-ESTB-ABSTIME. DTSBD326 00615 SET MTCK-NOT-CONVERTED-88 TO TRUE. DTSBD326 00616 MOVE LBCM-CURR-RUN-DATE TO MTCK-ESTB-DATE DTSBD326 00617 MTCK-CHNG-DATE. DTSBD326 00618 MOVE +0 TO MTCK-TEXT-CNT. DTSBD326 00619 MOVE MTCK-REC TO MSKL-REC. DTSBD326 00620 PERFORM S910-WRITE THRU S910-EXIT. DTSBD326 00621 DTSBD326 00622 P6000-EXIT. DTSBD326 00623 EXIT. DTSBD326 00624 DTSBD326 00625 P7000-WITHDRAW. DTSBD326 00626 DISPLAY 'P7000 ' MPRF-EMP-NO. DTSBD326 00627 PERFORM P7100-FIND-QTRS THRU P7100-EXIT. DTSBD326 00628 PERFORM P7200-EDIT-ADJ THRU P7200-EXIT. DTSBD326 00629 IF LBCM-TRN-OK-88 DTSBD326 00630 PERFORM P7300-WITHDRAW THRU P7300-EXIT DTSBD326 00631 IF LBCM-TRN-OK-88 DTSBD326 00632 PERFORM P7400-UPDATE-MQTR THRU P7400-EXIT DTSBD326 00633 END-IF DTSBD326 00634 END-IF. DTSBD326 00635 DTSBD326 00636 P7000-EXIT. DTSBD326 00637 EXIT. DTSBD326 00638 DTSBD326 00639 P7100-FIND-QTRS. DTSBD326 00640 PERFORM P7110-INIT-QTR-TBL THRU P7110-EXIT. DTSBD326 00641 DTSBD326 00642 MOVE LOW-VALUE TO MQTR-KEY-AREA. DTSBD326 00643 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBD326 00644 SET MQTR-QTR-88 TO TRUE. DTSBD326 00645 DTSBD326 00646 PERFORM DTSBD326 00647 VARYING WRK-CNT FROM 1 BY 1 DTSBD326 00648 UNTIL WRK-CNT > MCMP-COV-CNT DTSBD326 00649 MOVE MCMP-COVERED-YRQ (WRK-CNT) TO MQTR-YRQ DTSBD326 00650 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA DTSBD326 00651 PERFORM S910-READ THRU S910-EXIT DTSBD326 00652 IF L910-OK-88 DTSBD326 00653 MOVE MSKL-REC TO MQTR-REC DTSBD326 00654 MOVE MQTR-YRQ TO WRK-QTR-YRQ (WRK-CNT) DTSBD326 00655 PERFORM P7120-PROCESS-ACCT-AREA THRU P7120-EXIT DTSBD326 00656 END-IF DTSBD326 00657 END-PERFORM. DTSBD326 00658 DTSBD326 00659 P7100-EXIT. DTSBD326 00660 EXIT. DTSBD326 00661 DTSBD326 00662 P7110-INIT-QTR-TBL. DTSBD326 00663 PERFORM DTSBD326 00664 VARYING QTR-SUB FROM +1 BY +1 DTSBD326 00665 UNTIL QTR-SUB > WRK-QTR-MAX DTSBD326 00666 MOVE +0 TO WRK-QTR-YRQ (QTR-SUB) DTSBD326 00667 WRK-QTR-WAIVED-AMT (QTR-SUB) DTSBD326 00668 WRK-QTR-REVERSE-AMT (QTR-SUB) DTSBD326 00669 END-PERFORM. DTSBD326 00670 DTSBD326 00671 P7110-EXIT. DTSBD326 00672 EXIT. DTSBD326 00673 DTSBD326 00674 P7120-PROCESS-ACCT-AREA. DTSBD326 00675 PERFORM DTSBD326 00676 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBD326 00677 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSBD326 00678 ADD MQTR-WAIVED-AMT (MQTR-ACCT-IDX) DTSBD326 00679 TO WRK-QTR-WAIVED-AMT (WRK-CNT) DTSBD326 00680 END-PERFORM. DTSBD326 00681 DTSBD326 00682 P7120-EXIT. DTSBD326 00683 EXIT. DTSBD326 00684 DTSBD326 00685 P7200-EDIT-ADJ. DTSBD326 00686 PERFORM P7210-INIT-REV-TBL THRU P7210-EXIT. DTSBD326 00687 DTSBD326 00688 MOVE LOW-VALUE TO MADJ-KEY-AREA. DTSBD326 00689 MOVE MPRF-EMP-NO TO MADJ-EMP-NO. DTSBD326 00690 SET MADJ-ADJ-88 TO TRUE. DTSBD326 00691 DTSBD326 00692 MOVE MADJ-KEY-AREA TO MSKL-KEY-AREA. DTSBD326 00693 DTSBD326 00694 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD326 00695 DTSBD326 00696 PERFORM DTSBD326 00697 UNTIL L910-NO-REC-88 DTSBD326 00698 MOVE MSKL-REC TO MADJ-REC DTSBD326 00699 DISPLAY 'P7200 ' MPRF-EMP-NO ' ' MADJ-APPLIC-YRQ DTSBD326 00700 IF MADJ-CMP-ESTB-ABSTIME = MCMP-ESTB-ABSTIME DTSBD326 00701 PERFORM P7220-ADD-TO-TBL THRU P7220-EXIT DTSBD326 00702 END-IF DTSBD326 00703 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD326 00704 END-PERFORM. DTSBD326 00705 DTSBD326 00706 PERFORM P7230-CHECK-QTRS THRU P7230-EXIT. DTSBD326 00707 DTSBD326 00708 P7200-EXIT. DTSBD326 00709 EXIT. DTSBD326 00710 DTSBD326 00711 P7210-INIT-REV-TBL. DTSBD326 00712 MOVE +0 TO REV-CNT. DTSBD326 00713 DTSBD326 00714 PERFORM DTSBD326 00715 VARYING REV-SUB FROM +1 BY +1 DTSBD326 00716 UNTIL REV-SUB > WRK-REV-MAX DTSBD326 00717 MOVE +0 TO WRK-REV-AMT (REV-SUB) DTSBD326 00718 WRK-REV-APPLIC-YRQ (REV-SUB) DTSBD326 00719 MOVE SPACES TO WRK-REV-APPLIC-IND (REV-SUB) DTSBD326 00720 END-PERFORM. DTSBD326 00721 DTSBD326 00722 P7210-EXIT. DTSBD326 00723 EXIT. DTSBD326 00724 DTSBD326 00725 P7220-ADD-TO-TBL. DTSBD326 00726 IF REV-CNT < WRK-REV-MAX DTSBD326 00727 ADD +1 TO REV-CNT DTSBD326 00728 ELSE DTSBD326 00729 DISPLAY 'P7220 TABLE LENGTH EXCEEDED ' MPRF-EMP-NO DTSBD326 00730 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD326 00731 GO TO P7220-EXIT DTSBD326 00732 END-IF. DTSBD326 00733 DTSBD326 00734 MOVE MADJ-AMT TO WRK-REV-AMT (REV-CNT). DTSBD326 00735 MOVE MADJ-APPLIC-YRQ TO WRK-REV-APPLIC-YRQ (REV-CNT). DTSBD326 00736 MOVE MADJ-APPLIC-IND TO WRK-REV-APPLIC-IND (REV-CNT). DTSBD326 00737 DTSBD326 00738 PERFORM P7221-UPD-QTR-TBL THRU P7221-EXIT. DTSBD326 00739 DTSBD326 00740 P7220-EXIT. DTSBD326 00741 EXIT. DTSBD326 00742 DTSBD326 00743 P7221-UPD-QTR-TBL. DTSBD326 00744 SET WRK-QTR-FOUND-NO-88 TO TRUE. DTSBD326 00745 DTSBD326 00746 PERFORM DTSBD326 00747 VARYING QTR-SUB FROM +1 BY +1 DTSBD326 00748 UNTIL QTR-SUB > WRK-QTR-MAX DTSBD326 00749 OR WRK-QTR-FOUND-YES-88 DTSBD326 00750 IF WRK-QTR-YRQ (QTR-SUB) = DTSBD326 00751 WRK-REV-APPLIC-YRQ (REV-CNT) DTSBD326 00752 SET WRK-QTR-FOUND-YES-88 TO TRUE DTSBD326 00753 ADD MADJ-AMT TO DTSBD326 00754 WRK-QTR-REVERSE-AMT (QTR-SUB) DTSBD326 00755 END-IF DTSBD326 00756 END-PERFORM. DTSBD326 00757 DTSBD326 00758 P7221-EXIT. DTSBD326 00759 EXIT. DTSBD326 00760 DTSBD326 00761 P7230-CHECK-QTRS. DTSBD326 00762 PERFORM DTSBD326 00763 VARYING QTR-SUB FROM +1 BY +1 DTSBD326 00764 UNTIL QTR-SUB > WRK-QTR-MAX DTSBD326 00765 IF WRK-QTR-WAIVED-AMT (QTR-SUB) NOT = DTSBD326 00766 WRK-QTR-REVERSE-AMT (QTR-SUB) DTSBD326 00767 DISPLAY 'P7230: WAIVE ' DTSBD326 00768 WRK-QTR-WAIVED-AMT (QTR-SUB) DTSBD326 00769 ' REV ' WRK-QTR-REVERSE-AMT (QTR-SUB) DTSBD326 00770 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD326 00771 MOVE MSG7-ADJ-EDIT-FAILED TO LBCM-TRN-MSG-AREA DTSBD326 00772 END-IF DTSBD326 00773 END-PERFORM. DTSBD326 00774 DTSBD326 00775 P7230-EXIT. DTSBD326 00776 EXIT. DTSBD326 00777 DTSBD326 00778 P7300-WITHDRAW. DTSBD326 00779 PERFORM P7310-SCAN-TBL THRU P7310-EXIT DTSBD326 00780 VARYING REV-SUB FROM +1 BY +1 DTSBD326 00781 UNTIL REV-SUB > REV-CNT. DTSBD326 00782 DTSBD326 00783 P7300-EXIT. DTSBD326 00784 EXIT. DTSBD326 00785 DTSBD326 00786 P7310-SCAN-TBL. DTSBD326 00787 MOVE LOW-VALUES TO AADJ-REC. DTSBD326 00788 SET AADJ-ADJ-88 TO TRUE. DTSBD326 00789 MOVE MPRF-PRIMARY-NAME (1:4) TO AADJ-NAME-CHECK. DTSBD326 00790 MOVE MPRF-EMP-NO TO AADJ-EMP-NO. DTSBD326 00791 SET AADJ-WAIVE-88 TO TRUE. DTSBD326 00792 MOVE LBCM-RECEIVED-DATE TO AADJ-RECEIVED-DATE. DTSBD326 00793 MOVE LBCM-DEPOSIT-DATE TO AADJ-DEPOSIT-DATE. DTSBD326 00794 MOVE WRK-REV-AMT (REV-SUB) TO WRK-AMT. DTSBD326 00795 COMPUTE AADJ-AMT = WRK-AMT * -1. DTSBD326 00796 MOVE WRK-REV-APPLIC-YRQ (REV-SUB) TO AADJ-APPLIC-YRQ. DTSBD326 00797 MOVE WRK-REV-APPLIC-IND (REV-SUB) TO AADJ-APPLIC-IND. DTSBD326 00798 MOVE ZEROS TO AADJ-APPLIC-BATCH-NO DTSBD326 00799 AADJ-APPLIC-ITEM-NO DTSBD326 00800 AADJ-DATE-1 DTSBD326 00801 AADJ-DATE-2 DTSBD326 00802 AADJ-INT-RATE DTSBD326 00803 AADJ-CMP-ESTB-ABSTIME. DTSBD326 00804 DTSBD326 00805 MOVE 'N' TO AADJ-DISREGARD-EDITS-IND. DTSBD326 00806 MOVE 'SYS' TO AADJ-RESPONSIBLE-ACTIVITY. DTSBD326 00807 MOVE 'SYSTEM' TO AADJ-RESPONSIBLE-OP-ID. DTSBD326 00808 SET AADJ-NOT-PROCESSED-88 TO TRUE. DTSBD326 00809 DTSBD326 00810 MOVE AADJ-AMT TO WRK-AMT-DISP1. DTSBD326 00811 DISPLAY 'P7310 ' MPRF-EMP-NO ' ' AADJ-APPLIC-YRQ DTSBD326 00812 ' AMT ' WRK-AMT-DISP1. DTSBD326 00813 DTSBD326 00814 SET L501-EXT-TO-ACCT-88 TO TRUE. DTSBD326 00815 PERFORM S501-INTERNAL-ACCT-PROCESS THRU S501-EXIT. DTSBD326 00816 IF L501-TRN-NOT-OK-88 DTSBD326 00817 DISPLAY 'L501 TRAN FAILED' DTSBD326 00818 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD326 00819 MOVE MSG6-ADJ-FAILED TO LBCM-TRN-MSG-AREA DTSBD326 00820 END-IF. DTSBD326 00821 DTSBD326 00822 P7310-EXIT. DTSBD326 00823 EXIT. DTSBD326 00824 DTSBD326 00825 P7400-UPDATE-MQTR. DTSBD326 00826 MOVE LOW-VALUE TO MQTR-KEY-AREA. DTSBD326 00827 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBD326 00828 SET MQTR-QTR-88 TO TRUE. DTSBD326 00829 DTSBD326 00830 PERFORM DTSBD326 00831 VARYING WRK-CNT FROM 1 BY 1 DTSBD326 00832 UNTIL WRK-CNT > MCMP-COV-CNT DTSBD326 00833 MOVE MCMP-COVERED-YRQ (WRK-CNT) TO MQTR-YRQ DTSBD326 00834 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA DTSBD326 00835 PERFORM S910-READ THRU S910-EXIT DTSBD326 00836 IF L910-OK-88 DTSBD326 00837 MOVE MSKL-REC TO MQTR-REC DTSBD326 00838 DISPLAY 'P7400 ' MPRF-EMP-NO ' ' MQTR-YRQ DTSBD326 00839 MOVE ZERO TO MQTR-CMP-ESTB-ABSTIMEDTSBD326 00840 MOVE MQTR-REC TO MSKL-REC DTSBD326 00841 PERFORM S910-REWRITE THRU S910-EXIT DTSBD326 00842 ELSE DTSBD326 00843 PERFORM P7410-ERROR THRU P7410-EXIT DTSBD326 00844 END-IF DTSBD326 00845 END-PERFORM. DTSBD326 00846 DTSBD326 00847 P7400-EXIT. DTSBD326 00848 EXIT. DTSBD326 00849 DTSBD326 00850 P7410-ERROR. DTSBD326 00851 SET LBCM-TRN-NOT-OK-88 TO TRUE. DTSBD326 00852 MOVE MSG3-ID-2 TO R907-MSG-ID. DTSBD326 00853 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSBD326 00854 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD326 00855 MOVE L004-SLASH-5-QTR TO MSG3-YRQ. DTSBD326 00856 MOVE MPRF-EMP-NO TO R907-EMP-NO. DTSBD326 00857 MOVE MSG3-LONG-TEXT TO R907-MSG-TEXT. DTSBD326 00858 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBD326 00859 DTSBD326 00860 P7410-EXIT. DTSBD326 00861 EXIT. DTSBD326 00862 DTSBD326 00863 S1000-READ-SUBJECT-MCMP. DTSBD326 00864 MOVE LOW-VALUE TO MCMP-KEY-AREA. DTSBD326 00865 DTSBD326 00866 MOVE MPRF-EMP-NO TO MCMP-EMP-NO. DTSBD326 00867 DTSBD326 00868 SET MCMP-CMP-88 TO TRUE. DTSBD326 00869 DTSBD326 00870 MOVE T011-ESTB-ABSTIME TO MCMP-ESTB-ABSTIME. DTSBD326 00871 DTSBD326 00872 MOVE MCMP-KEY-AREA TO MSKL-KEY-AREA. DTSBD326 00873 DTSBD326 00874 PERFORM S910-READ THRU S910-EXIT. DTSBD326 00875 DTSBD326 00876 IF L910-OK-88 DTSBD326 00877 MOVE MSKL-REC TO MCMP-REC. DTSBD326 00878 S1000-EXIT. DTSBD326 00879 EXIT. DTSBD326 00880 EJECT DTSBD326 00881 S2000-DELETE-MTCK. DTSBD326 00882 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBD326 00883 DTSBD326 00884 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBD326 00885 DTSBD326 00886 SET MSKL-TCK-88 TO TRUE. DTSBD326 00887 DTSBD326 00888 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD326 00889 DTSBD326 00890 PERFORM DTSBD326 00891 UNTIL L910-NO-REC-88 DTSBD326 00892 MOVE MSKL-REC TO MTCK-REC DTSBD326 00893 IF MTCK-TYPE-CMP-PEND-88 DTSBD326 00894 AND DTSBD326 00895 MTCK-CMP-ESTB-ABSTIME = T011-ESTB-ABSTIME DTSBD326 00896 PERFORM S910-DELETE THRU S910-EXIT DTSBD326 00897 END-IF DTSBD326 00898 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD326 00899 END-PERFORM. DTSBD326 00900 DTSBD326 00901 S2000-EXIT. DTSBD326 00902 EXIT. DTSBD326 00903 EJECT DTSBD326 00904 S001-CONVERT-DATE. DTSBD326 00905 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBD326 00906 S001-EXIT. EXIT. DTSBD326 00907 DTSBD326 00908 S004-FROM-5. DTSBD326 00909 SET L004-FROM-5 TO TRUE. DTSBD326 00910 GO TO S004-YRQ. DTSBD326 00911 DTSBD326 00912 S004-YRQ. DTSBD326 00913 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBD326 00914 S004-EXIT. DTSBD326 00915 EXIT. DTSBD326 00916 SKIP3 DTSBD326 00917 S005-FROM-ABSTIME. DTSBD326 00918 SET L005-FROM-ABSTIME TO TRUE. DTSBD326 00919 GO TO S005-TIME. DTSBD326 00920 DTSBD326 00921 S005-TIME. DTSBD326 00922 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBD326 00923 S005-EXIT. DTSBD326 00924 EXIT. DTSBD326 00925 SKIP3 DTSBD326 00926 S101-PER-MONTH-NO. DTSBD326 00927 SET L101-PER-MONTH-NO-88 TO TRUE. DTSBD326 00928 GO TO S101-INTEREST. DTSBD326 00929 DTSBD326 00930 S101-INTEREST. DTSBD326 00931 CALL 'DTSBU101' USING L101-LINK-AREA. DTSBD326 00932 S101-EXIT. DTSBD326 00933 EXIT. DTSBD326 00934 SKIP3 DTSBD326 00935 S501-INTERNAL-ACCT-PROCESS. DTSBD326 00936 CALL 'DTSBU501' USING L501-LINK-AREA DTSBD326 00937 LBCM-LINK-AREA DTSBD326 00938 MPRF-REC DTSBD326 00939 ASKL-REC. DTSBD326 00940 S501-EXIT. DTSBD326 00941 EXIT. DTSBD326 00942 DTSBD326 00943 S910-READ. DTSBD326 00944 SET L910-READ-88 TO TRUE. DTSBD326 00945 GO TO S910-MSTR-IO. DTSBD326 00946 DTSBD326 00947 S910-START-BROWSE. DTSBD326 00948 SET L910-START-BROWSE-88 TO TRUE. DTSBD326 00949 GO TO S910-MSTR-IO. DTSBD326 00950 DTSBD326 00951 S910-READ-NEXT. DTSBD326 00952 SET L910-READ-NEXT-88 TO TRUE. DTSBD326 00953 GO TO S910-MSTR-IO. DTSBD326 00954 DTSBD326 00955 S910-DELETE. DTSBD326 00956 SET L910-DELETE-88 TO TRUE. DTSBD326 00957 GO TO S910-MSTR-IO. DTSBD326 00958 DTSBD326 00959 S910-WRITE. DTSBD326 00960 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBD326 00961 SET L910-WRITE-88 TO TRUE. DTSBD326 00962 GO TO S910-MSTR-IO. DTSBD326 00963 DTSBD326 00964 S910-REWRITE. DTSBD326 00965 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBD326 00966 SET L910-REWRITE-88 TO TRUE. DTSBD326 00967 GO TO S910-MSTR-IO. DTSBD326 00968 DTSBD326 00969 *S910-DELETE. DTSBD326 00970 *****SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBD326 00971 *****SET L910-DELETE-88 TO TRUE. DTSBD326 00972 *****GO TO S910-MSTR-IO. DTSBD326 00973 DTSBD326 00974 S910-MSTR-IO. DTSBD326 00975 CALL 'DTSBU910' USING L910-LINK-AREA DTSBD326 00976 MSKL-REC. DTSBD326 00977 S910-EXIT. DTSBD326 00978 EXIT. DTSBD326 00979 SKIP3 DTSBD326 00980 S946-WRITE-R436. DTSBD326 00981 CALL 'DTSBU946' USING R436-REC. DTSBD326 00982 GO TO S946-EXIT. DTSBD326 00983 DTSBD326 00984 S946-WRITE-R907. DTSBD326 00985 CALL 'DTSBU946' USING R907-REC. DTSBD326 00986 GO TO S946-EXIT. DTSBD326 00987 DTSBD326 00988 S946-EXIT. DTSBD326 00989 EXIT. DTSBD326 00990 SKIP3 DTSBD326 00991 S999-ABEND. DTSBD326 00992 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBD326 00993 S999-EXIT. DTSBD326 00994 EXIT. DTSBD326