00001 IDENTIFICATION DIVISION. 04/30/08 00002 PROGRAM-ID. DTSBD325. DTSBD325 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV024 00004 DATE-WRITTEN. FEBRUARY 1999. DTSBD325 00005 DATE-COMPILED. DTSBD325 00006 SKIP3 DTSBD325 00007 ***** DTSBD325 00008 * DTSBD325 00009 * FUNCTION: DEFERRED PAYMENT CONTRACT PACKAGE. DTSBD325 00010 * DTSBD325 00011 * DTSBD325 00012 * MODIFICATION LOG: DTSBD325 00013 * DTSBD325 00014 * 02/10/1999 CLONED FROM DTSBD321. DTSBD325 00015 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBD325 00016 * DTSBD325 00017 * 10/04/1999 MODIFIED SETTING OF R434-CORPORATION-IND DTSBD325 00018 * IN P1000. ALL EMPLOYERS EXCEPT PARTNERSHIPS DTSBD325 00019 * GET THE CORPORATION TYPE OF DPC. DTSBD325 00020 * REFERENCE: PROGRAMMER: GD DTSBD325 00021 * DTSBD325 00022 * 08/01/2006 PENALTY AND INTEREST CALCULATIONS MODIFIED DTSBD325 00023 * TO EXCLUDE SUR-TAX: P3100. DTSBD325 00024 * REFERENCE: ADMIN ASSESS PROGRAMMER: GD DTSBD325 00025 * DTSBD325 00026 * 01/31/2008 MODIFIED ADMINISTRATIVE ASSESSMENT PROCESS DTSBD325 00027 * TO INCLUDE PENALTY AND INTEREST CALCULATION DTSBD325 00028 * STARTING WITH 2008/1. DTSBD325 00029 * REFERENCE: ADMIN ASSESS PROGRAMMER: RW1 DTSBD325 00030 * DTSBD325 00031 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD325 00032 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD325 00033 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBD325 00034 * DTSBD325 00035 * DTSBD325 00036 * DESCRIPTION: DTSBD325 00037 * DTSBD325 00038 * READ THE MDPC RECORD INDICATED BY T011-ESTB-ABSTIME. DTSBD325 00039 * DTSBD325 00040 * IF MDPC RECORD INDICATED BY T011-ESTB-ABSTIME DOES NOT DTSBD325 00041 * EXIST, THEN THE TRANSACTION IS IN ERROR. DTSBD325 00042 * DTSBD325 00043 * IF NOT (MDPC-STATUS-OPEN-88 OR MDPC-STATUS-PENDING-88), DTSBD325 00044 * THEN THE TRANSACTION IS IN ERROR. DTSBD325 00045 * DTSBD325 00046 * IF NOT (MDPC-FREQ-WEEKLY-88 OR MDPC-FREQ-BIWEEKLY-88 OR DTSBD325 00047 * MDPC-FREQ-MONTHLY-88), THEN THE TRANSACTION IS IN ERROR. DTSBD325 00048 * DTSBD325 00049 * SCAN THE MQTR RECORDS INDICATED BY MDPC-COVERED-YRQ. DTSBD325 00050 * IF NO AMOUNTS ARE DUE IN MDPC-COVERED-YRQ(S), DTSBD325 00051 * THEN CHANGE MDPC STATUS TO MDPC-STATUS-WITHDRAWN-88 DTSBD325 00052 * AND THE TRANSACTION IS IN ERROR. DTSBD325 00053 * DTSBD325 00054 * THE FOLLOWING SPECIFICATIONS ASSUME AMOUNTS ARE DUE DTSBD325 00055 * IN ONE OR MORE OF MDPC-COVERED-YRQ(S). DTSBD325 00056 * DTSBD325 00057 * CONSTRUCT AND WRITE A R434 RECORD. DTSBD325 00058 * DTSBD325 00059 * WRITE AN EVENT LOG RECORD. DTSBD325 00060 * DTSBD325 00061 * THERE IS ONE TRICKY BIT - THE HANDLING OF TOLERANCE. DTSBD325 00062 * DTSBD325 00063 * TOLERANCE IS NOT RESOLVED UNTIL ALL TRANSACTIONS DTSBD325 00064 * FOR THE EMPLOYER HAVE BEEN PROCESSED. THUS, DTSBD325 00065 * THIS MODULE SHOULD DO SOME "PSEUDO" TOLERANCE DTSBD325 00066 * PROCESSING. WHILE PROCESSING MQTR RECORDS, JUST ADD DTSBD325 00067 * UP THE BALANCES DUE (WITHOUT PROJECTING INTEREST). DTSBD325 00068 * IF THE RESULT IS LESS THAN OR EQUAL TO LBCM-QTR-TOL-MAX, DTSBD325 00069 * THEN JUST PRETEND THERE IS NO BALANCE DUE FOR THIS DTSBD325 00070 * QUARTER. DTSBD325 00071 * DTSBD325 00072 * DTSBD325 00073 * SEE DTSCS45 FOR AN EXAMPLE OF DETERMINING THE BALANCE DTSBD325 00074 * DUE IN A PARTICULAR QUARTER AND PROJECTING INTEREST DTSBD325 00075 * THRU A SPECIFIED "COMPUTATION" DATE. DTSBD325 00076 * DTSBD325 00077 * DTSBD325 00078 * MASTER FILE RECORDS READ: DTSBD325 00079 * DTSBD325 00080 * MDPC DTSBD325 00081 * MQTR DTSBD325 00082 * MOPO DTSBD325 00083 * DTSBD325 00084 * DTSBD325 00085 * MASTER FILE RECORDS UPDATED: DTSBD325 00086 * DTSBD325 00087 * MDPC (REWRITE) DTSBD325 00088 * MEVL (WRITE) DTSBD325 00089 * DTSBD325 00090 * DTSBD325 00091 * REPORT RECORDS WRITTEN: DTSBD325 00092 * DTSBD325 00093 * R434 DEFERRED PAYMENT CONTRACT DOCUMENTS. DTSBD325 00094 * R907 EXCEPTION REPORT. DTSBD325 00095 * DTSBD325 00096 * DTSBD325 00097 * MODULES CALLED: DTSBD325 00098 * DTSBD325 00099 * DTSBU001 DATE EDIT/CONVERSION. DTSBD325 00100 * DTSBU004 QUARTER EDIT/CONVERSION. DTSBD325 00101 * DTSBU005 TIME EDIT/CONVERSION. DTSBD325 00102 * DTSBU101 INTEREST CHARGE/ABATEMENT COMPUTATION. DTSBD325 00103 * DTSBU910 MASTER FILE I/O DRIVER. DTSBD325 00104 * DTSBU946 VARIABLE LENGTH RECORD SEQUENTAIL OUTPUT 1. DTSBD325 00105 * DTSBD325 00106 * DTSBD325 00107 ***** DTSBD325 00108 SKIP3 DTSBD325 00109 ENVIRONMENT DIVISION. DTSBD325 00110 EJECT DTSBD325 00111 DATA DIVISION. DTSBD325 00112 SKIP3 DTSBD325 00113 WORKING-STORAGE SECTION. DTSBD325 001135 77 PAN-VALET PICTURE X(24) VALUE '024DTSBD325 04/30/08'. DTSBD325 00114 SKIP3 DTSBD325 00115 01 WRK-AREA. DTSBD325 00116 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +325.DTSBD325 00117 DTSBD325 00118 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBD325'.DTSBD325 00119 DTSBD325 00120 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBD325 00121 DTSBD325 00122 DTSBD325 00123 05 WRK-CNT PIC S9(04) COMP. DTSBD325 00124 DTSBD325 00125 05 WRK-TOT-BALANCE-AMT PIC S9(09)V9(02) COMP-3. DTSBD325 00126 DTSBD325 00127 05 WRK-FIRST-PEN-INT-YRQ PIC S9(05) COMP-3. DTSBD325 00128 DTSBD325 00129 05 WRK-COV-QTRS-TBL. DTSBD325 00130 10 FILLER OCCURS 400. DTSBD325 00131 15 WRK-COV-QTR PIC S9(05) COMP-3. DTSBD325 00132 88 WRK-NOT-COVERED-88 VALUE +0. DTSBD325 00133 15 WRK-COV-SUBJECT-IND PIC X(01). DTSBD325 00134 88 WRK-COV-SUBJECT-YES-88 VALUE 'X'. DTSBD325 00135 88 WRK-COV-SUBJECT-NO-88 VALUE SPACE. DTSBD325 00136 DTSBD325 00137 05 WRK-SMALL-ABS-QTR PIC S9(04) COMP. DTSBD325 00138 DTSBD325 00139 05 WRK-LARGE-ABS-QTR PIC S9(04) COMP. DTSBD325 00140 DTSBD325 00141 05 WRK-EVENT-TXT. DTSBD325 00142 10 FILLER PIC X(36) DTSBD325 00143 VALUE 'DEFERRED PAYMENT CONTRACT PRINTED. '. DTSBD325 00144 EJECT DTSBD325 00145 01 MSG-TABLE. DTSBD325 00146 05 MSG1-MDPC-NOT-FOUND. DTSBD325 00147 10 MSG1-ID PIC X(11) VALUE 'DTSBD325411'. DTSBD325 00148 10 MSG1-SHORT-TEXT PIC X(20) VALUE 'DELETED MDPC '. DTSBD325 00149 10 MSG1-LONG-TEXT. DTSBD325 00150 15 FILLER PIC X(30) DTSBD325 00151 VALUE 'TRANSACTION FAILED - RECORD NO'. DTSBD325 00152 15 FILLER PIC X(30) DTSBD325 00153 VALUE 'T FOUND - NO DPC PRINTED '. DTSBD325 00154 DTSBD325 00155 05 MSG2-MDPC-NOT-OPEN. DTSBD325 00156 10 MSG2-ID PIC X(11) VALUE 'DTSBD325412'. DTSBD325 00157 10 MSG2-SHORT-TEXT PIC X(20) VALUE 'NOT OPEN MDPC '. DTSBD325 00158 10 MSG2-LONG-TEXT. DTSBD325 00159 15 FILLER PIC X(30) DTSBD325 00160 VALUE 'TRANSACTION FAILED - DPC NOT O'. DTSBD325 00161 15 FILLER PIC X(30) DTSBD325 00162 VALUE 'PEN OR PENDING - NO DPC PRNTED'. DTSBD325 00163 DTSBD325 00164 05 MSG3-MDPC-FREQ-INVALID. DTSBD325 00165 10 MSG3-ID PIC X(11) VALUE 'DTSBD325413'. DTSBD325 00166 10 MSG3-SHORT-TEXT PIC X(20) VALUE 'MDPC PMT FREQ '. DTSBD325 00167 10 MSG3-LONG-TEXT. DTSBD325 00168 15 FILLER PIC X(30) DTSBD325 00169 VALUE 'TRANSACTION FAILED - DPC PMT F'. DTSBD325 00170 15 FILLER PIC X(30) DTSBD325 00171 VALUE 'REF NOT WEEK, BIWEEK, OR MNTH '. DTSBD325 00172 DTSBD325 00173 05 MSG4-NO-DUE. DTSBD325 00174 10 MSG4-ID. DTSBD325 00175 15 MSG4-ID-1 PIC X(08) VALUE 'DTSBD325'. DTSBD325 00176 15 MSG4-ID-2 PIC X(03) VALUE '414'. DTSBD325 00177 10 MSG4-SHORT-TEXT PIC X(20) VALUE 'NOTHING DUE '. DTSBD325 00178 10 MSG4-LONG-TEXT. DTSBD325 00179 15 FILLER PIC X(30) DTSBD325 00180 VALUE 'NO AMOUNTS DUE - NO DEFERRED P'. DTSBD325 00181 15 FILLER PIC X(30) DTSBD325 00182 VALUE 'AYMENT CONTRACT PRINTED '. DTSBD325 00183 EJECT DTSBD325 00184 01 L001-LINK-AREA. DTSBD325 00185 ++INCLUDE DTSIL001 DTSBD325 00186 SKIP3 DTSBD325 00187 01 L004-LINK-AREA. DTSBD325 00188 ++INCLUDE DTSIL004 DTSBD325 00189 SKIP3 DTSBD325 00190 01 L005-LINK-AREA. DTSBD325 00191 ++INCLUDE DTSIL005 DTSBD325 00192 SKIP3 DTSBD325 00193 01 L101-LINK-AREA. DTSBD325 00194 ++INCLUDE DTSIL101 DTSBD325 00195 SKIP3 DTSBD325 00196 01 L109-LINK-AREA. DTSBD325 00197 ++INCLUDE DTSIL109 DTSBD325 00198 EJECT DTSBD325 00199 01 L910-LINK-AREA. DTSBD325 00200 ++INCLUDE DTSIL910 DTSBD325 00201 SKIP3 DTSBD325 00202 01 MSKL-REC. DTSBD325 00203 ++INCLUDE DTSIMSKL DTSBD325 00204 SKIP3 DTSBD325 00205 01 MDPC-REC. DTSBD325 00206 ++INCLUDE DTSIMDPC DTSBD325 00207 SKIP3 DTSBD325 00208 01 MQTR-REC. DTSBD325 00209 ++INCLUDE DTSIMQTR DTSBD325 00210 SKIP3 DTSBD325 00211 01 MEVL-REC. DTSBD325 00212 ++INCLUDE DTSIMEVL DTSBD325 00213 SKIP3 DTSBD325 00214 01 MOPO-REC. DTSBD325 00215 ++INCLUDE DTSIMOPO DTSBD325 00216 EJECT DTSBD325 00217 01 MMAX-LITERALS. DTSBD325 00218 ++INCLUDE DTSIMMAX DTSBD325 00219 EJECT DTSBD325 00220 01 R434-REC. DTSBD325 00221 ++INCLUDE DTSIR434 DTSBD325 00222 SKIP3 DTSBD325 00223 01 R907-REC. DTSBD325 00224 ++INCLUDE DTSIR907 DTSBD325 00225 EJECT DTSBD325 00226 LINKAGE SECTION. DTSBD325 00227 SKIP3 DTSBD325 00228 01 LBCM-LINK-AREA. DTSBD325 00229 ++INCLUDE DTSILBCM DTSBD325 00230 EJECT DTSBD325 00231 01 MPRF-REC. DTSBD325 00232 ++INCLUDE DTSIMPRF DTSBD325 00233 EJECT DTSBD325 00234 01 T011-REC. DTSBD325 00235 ++INCLUDE DTSIT011 DTSBD325 00236 EJECT DTSBD325 00237 PROCEDURE DIVISION USING LBCM-LINK-AREA DTSBD325 00238 MPRF-REC DTSBD325 00239 T011-REC. DTSBD325 00240 DTSBD325 00241 DTSBD325 00242 IF FIRST-TIME-IND = 'Y' DTSBD325 00243 PERFORM I0000-FIRST-TIME THRU I0000-EXIT DTSBD325 00244 MOVE 'N' TO FIRST-TIME-IND. DTSBD325 00245 DTSBD325 00246 DTSBD325 00247 IF T011-DPC-PKG DTSBD325 00248 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBD325 00249 ELSE DTSBD325 00250 PERFORM S999-ABEND THRU S999-EXIT. DTSBD325 00251 DTSBD325 00252 DTSBD325 00253 GOBACK. DTSBD325 00254 EJECT DTSBD325 00255 I0000-FIRST-TIME. DTSBD325 00256 MOVE LBCM-TRACE-IND TO L910-TRACE-IND. DTSBD325 00257 DTSBD325 00258 MOVE WRK-MOD-NAME TO L910-MOD-NAME DTSBD325 00259 R907-MODULE-NAME. DTSBD325 00260 DTSBD325 00261 MOVE LENGTH OF R434-REC TO R434-LENGTH. DTSBD325 00262 DTSBD325 00263 MOVE LENGTH OF R907-REC TO R907-LENGTH. DTSBD325 00264 *RW1 DTSBD325 00265 PERFORM S109-FIRST-PEN-INT-YRQ THRU S109-EXIT. DTSBD325 00266 MOVE L109-FIRST-PEN-INT-YRQ TO WRK-FIRST-PEN-INT-YRQ. DTSBD325 00267 *RW2 DTSBD325 00268 I0000-EXIT. DTSBD325 00269 EXIT. DTSBD325 00270 EJECT DTSBD325 00271 P0000-PROCESS. DTSBD325 00272 PERFORM S1000-READ-SUBJECT-MDPC THRU S1000-EXIT. DTSBD325 00273 DTSBD325 00274 IF L910-NO-REC-88 DTSBD325 00275 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD325 00276 MOVE MSG1-MDPC-NOT-FOUND TO LBCM-TRN-MSG-AREA DTSBD325 00277 GO TO P0000-EXIT. DTSBD325 00278 DTSBD325 00279 IF MDPC-STATUS-OPEN-88 OR MDPC-STATUS-PENDING-88 DTSBD325 00280 NEXT SENTENCE DTSBD325 00281 ELSE DTSBD325 00282 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD325 00283 MOVE MSG2-MDPC-NOT-OPEN TO LBCM-TRN-MSG-AREA DTSBD325 00284 GO TO P0000-EXIT. DTSBD325 00285 DTSBD325 00286 IF MDPC-FREQ-WEEKLY-88 DTSBD325 00287 OR DTSBD325 00288 MDPC-FREQ-BIWEEKLY-88 DTSBD325 00289 OR DTSBD325 00290 MDPC-FREQ-MONTHLY-88 DTSBD325 00291 NEXT SENTENCE DTSBD325 00292 ELSE DTSBD325 00293 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD325 00294 MOVE MSG3-MDPC-FREQ-INVALID TO LBCM-TRN-MSG-AREA DTSBD325 00295 GO TO P0000-EXIT. DTSBD325 00296 DTSBD325 00297 PERFORM P1000-START-R434 THRU P1000-EXIT. DTSBD325 00298 DTSBD325 00299 PERFORM P2000-LOAD-COV-TABLE THRU P2000-EXIT. DTSBD325 00300 DTSBD325 00301 MOVE MDPC-COMP-DATE TO L101-RECEIVED-DATE. DTSBD325 00302 DTSBD325 00303 SET L101-WAIVE-INT-NO-88 TO TRUE. DTSBD325 00304 DTSBD325 00305 MOVE LOW-VALUE TO MQTR-KEY-AREA. DTSBD325 00306 DTSBD325 00307 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBD325 00308 DTSBD325 00309 SET MQTR-QTR-88 TO TRUE. DTSBD325 00310 DTSBD325 00311 PERFORM P3000-PROCESS-MQTR THRU P3000-EXIT DTSBD325 00312 VARYING WRK-CNT FROM WRK-SMALL-ABS-QTR BY 1 DTSBD325 00313 UNTIL WRK-CNT > WRK-LARGE-ABS-QTR. DTSBD325 00314 DTSBD325 00315 DTSBD325 00316 PERFORM P4000-WRITE-MDPC-AND-REPORT THRU P4000-EXIT. DTSBD325 00317 P0000-EXIT. DTSBD325 00318 EXIT. DTSBD325 00319 EJECT DTSBD325 00320 P1000-START-R434. DTSBD325 00321 MOVE T011-RESP-OP-ID TO R434-RESP-OP-ID. DTSBD325 00322 DTSBD325 00323 MOVE MPRF-EMP-NO TO R434-EMP-NO. DTSBD325 00324 DTSBD325 00325 DTSBD325 00326 INITIALIZE R434-DATA-AREA. DTSBD325 00327 DTSBD325 00328 ********************************************************** DTSBD325 00329 * R434-CORPORATION-IND DETERNMINES THE TYPE OF DTSBD325 00330 * DPC THE SYSTEM WILL PRINT. THERE IS A SPECIAL DTSBD325 00331 * VERSION FOR PARTNERSHIPS; EVERYONE ELSE GETS DTSBD325 00332 * THE CORPORATION TYPE OF DPC. DTSBD325 00333 ********************************************************** DTSBD325 00334 IF MPRF-ORG-PARTNERSHIP-88 DTSBD325 00335 SET R434-CORPORATION-NO-88 TO TRUE DTSBD325 00336 ELSE DTSBD325 00337 SET R434-CORPORATION-YES-88 TO TRUE. DTSBD325 00338 DTSBD325 00339 MOVE MDPC-STMT-DATE TO R434-STMT-DATE. DTSBD325 00340 DTSBD325 00341 MOVE MPRF-PRIMARY-NAME TO R434-PRIMARY-NAME. DTSBD325 00342 DTSBD325 00343 MOVE MDPC-EMPLOYER-SIGNEE TO R434-EMPLOYER-SIGNEE. DTSBD325 00344 DTSBD325 00345 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD325 00346 DTSBD325 00347 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBD325 00348 DTSBD325 00349 SET MSKL-OPO-88 TO TRUE. DTSBD325 00350 DTSBD325 00351 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD325 00352 DTSBD325 00353 PERFORM DTSBD325 00354 UNTIL L910-NO-REC-88 DTSBD325 00355 MOVE MSKL-REC TO MOPO-REC DTSBD325 00356 IF MOPO-NAME = R434-EMPLOYER-SIGNEE DTSBD325 00357 MOVE MOPO-TITLE TO R434-SIGNEE-TITLE DTSBD325 00358 END-IF DTSBD325 00359 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD325 00360 END-PERFORM. DTSBD325 00361 DTSBD325 00362 IF R434-SIGNEE-TITLE = LOW-VALUES DTSBD325 00363 MOVE SPACES TO R434-SIGNEE-TITLE. DTSBD325 00364 DTSBD325 00365 MOVE MDPC-MAILING-ADDRESS TO R434-MAILING-ADDRESS. DTSBD325 00366 DTSBD325 00367 MOVE MDPC-INSTALL-PMT-AMT TO R434-INSTALL-PMT-AMT. DTSBD325 00368 DTSBD325 00369 MOVE MDPC-PMT-BEGIN-DATE TO R434-PMT-BEGIN-DATE. DTSBD325 00370 DTSBD325 00371 MOVE MDPC-PMT-FREQUENCY TO R434-PMT-FREQUENCY. DTSBD325 00372 P1000-EXIT. DTSBD325 00373 EXIT. DTSBD325 00374 EJECT DTSBD325 00375 P2000-LOAD-COV-TABLE. DTSBD325 00376 INITIALIZE WRK-COV-QTRS-TBL. DTSBD325 00377 DTSBD325 00378 MOVE +400 TO WRK-SMALL-ABS-QTR. DTSBD325 00379 DTSBD325 00380 MOVE +1 TO WRK-LARGE-ABS-QTR. DTSBD325 00381 DTSBD325 00382 DTSBD325 00383 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBD325 00384 DTSBD325 00385 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBD325 00386 DTSBD325 00387 SET MSKL-DPC-88 TO TRUE. DTSBD325 00388 DTSBD325 00389 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD325 00390 DTSBD325 00391 PERFORM DTSBD325 00392 UNTIL L910-NO-REC-88 DTSBD325 00393 MOVE MSKL-REC TO MDPC-REC DTSBD325 00394 IF MDPC-STATUS-ACTIVE-88 OR MDPC-STATUS-PENDING-88 DTSBD325 00395 PERFORM P2100-COVERED-SCAN THRU P2100-EXIT DTSBD325 00396 VARYING MDPC-COV-IDX FROM 1 BY 1 DTSBD325 00397 UNTIL MDPC-COV-IDX > MDPC-COV-CNT DTSBD325 00398 END-IF DTSBD325 00399 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD325 00400 END-PERFORM. DTSBD325 00401 DTSBD325 00402 DTSBD325 00403 PERFORM S1000-READ-SUBJECT-MDPC THRU S1000-EXIT. DTSBD325 00404 DTSBD325 00405 IF L910-NO-REC-88 DTSBD325 00406 PERFORM S999-ABEND THRU S999-EXIT. DTSBD325 00407 P2000-EXIT. DTSBD325 00408 EXIT. DTSBD325 00409 SKIP3 DTSBD325 00410 P2100-COVERED-SCAN. DTSBD325 00411 MOVE MDPC-COVERED-YRQ (MDPC-COV-IDX) TO L004-QTR-5-9. DTSBD325 00412 DTSBD325 00413 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD325 00414 DTSBD325 00415 IF L004-INVALID-QTR DTSBD325 00416 GO TO P2100-EXIT. DTSBD325 00417 DTSBD325 00418 DTSBD325 00419 MOVE L004-QTR-5-9 TO WRK-COV-QTR (L004-ABS-QTR). DTSBD325 00420 DTSBD325 00421 IF MDPC-ESTB-ABSTIME = T011-ESTB-ABSTIME DTSBD325 00422 SET WRK-COV-SUBJECT-YES-88 (L004-ABS-QTR) TO TRUE. DTSBD325 00423 DTSBD325 00424 DTSBD325 00425 IF L004-ABS-QTR < WRK-SMALL-ABS-QTR DTSBD325 00426 MOVE L004-ABS-QTR TO WRK-SMALL-ABS-QTR. DTSBD325 00427 DTSBD325 00428 IF L004-ABS-QTR > WRK-LARGE-ABS-QTR DTSBD325 00429 MOVE L004-ABS-QTR TO WRK-LARGE-ABS-QTR. DTSBD325 00430 P2100-EXIT. DTSBD325 00431 EXIT. DTSBD325 00432 EJECT DTSBD325 00433 P3000-PROCESS-MQTR. DTSBD325 00434 IF WRK-NOT-COVERED-88 (WRK-CNT) DTSBD325 00435 GO TO P3000-EXIT. DTSBD325 00436 DTSBD325 00437 DTSBD325 00438 MOVE WRK-COV-QTR (WRK-CNT) TO MQTR-YRQ. DTSBD325 00439 DTSBD325 00440 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBD325 00441 DTSBD325 00442 PERFORM S910-READ THRU S910-EXIT. DTSBD325 00443 DTSBD325 00444 IF L910-OK-88 DTSBD325 00445 MOVE MSKL-REC TO MQTR-REC DTSBD325 00446 ELSE DTSBD325 00447 GO TO P3000-EXIT. DTSBD325 00448 DTSBD325 00449 DTSBD325 00450 MOVE +0 TO WRK-TOT-BALANCE-AMT DTSBD325 00451 L101-PAID-CHNG. DTSBD325 00452 DTSBD325 00453 DTSBD325 00454 PERFORM P3100-PROCESS-ACCT-AREA THRU P3100-EXIT DTSBD325 00455 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBD325 00456 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT. DTSBD325 00457 DTSBD325 00458 IF WRK-TOT-BALANCE-AMT NOT > LBCM-QTR-TOL-MAX DTSBD325 00459 GO TO P3000-EXIT. DTSBD325 00460 DTSBD325 00461 DTSBD325 00462 MOVE MQTR-TAX-DUE-DATE TO L101-TAX-DUE-DATE. DTSBD325 00463 DTSBD325 00464 MOVE MQTR-INT-AREA TO L101-INT-AREA. DTSBD325 00465 DTSBD325 00466 PERFORM S101-PER-MONTH-NO THRU S101-EXIT. DTSBD325 00467 DTSBD325 00468 ADD L101-INT-CHARGE-CHNG TO WRK-TOT-BALANCE-AMT. DTSBD325 00469 DTSBD325 00470 SUBTRACT L101-INT-WAIVE-CHNG FROM WRK-TOT-BALANCE-AMT. DTSBD325 00471 DTSBD325 00472 DTSBD325 00473 IF WRK-COV-SUBJECT-YES-88 (WRK-CNT) DTSBD325 00474 AND R434-COV-CNT < MMAX-DPC-COV-MAX DTSBD325 00475 ADD +1 TO R434-COV-CNT DTSBD325 00476 MOVE MQTR-YRQ TO R434-COVERED-YRQ (R434-COV-CNT) DTSBD325 00477 ADD WRK-TOT-BALANCE-AMT DTSBD325 00478 TO R434-STMT-DUE-AMT. DTSBD325 00479 P3000-EXIT. DTSBD325 00480 EXIT. DTSBD325 00481 EJECT DTSBD325 00482 P3100-PROCESS-ACCT-AREA. DTSBD325 00483 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) TO WRK-TOT-BALANCE-AMT. DTSBD325 00484 DTSBD325 00485 ************************************************************ DTSBD325 00486 * INCLUDE UI TAX PAYMENTS ONLY FOR CALCULATING INTEREST DTSBD325 00487 ************************************************************ DTSBD325 00488 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSBD325 00489 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBD325 00490 TO L101-PAID-CHNG. DTSBD325 00491 *RW DTSBD325 00492 IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) DTSBD325 00493 IF MQTR-YRQ >= WRK-FIRST-PEN-INT-YRQ DTSBD325 00494 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBD325 00495 TO L101-PAID-CHNG DTSBD325 00496 END-IF DTSBD325 00497 END-IF. DTSBD325 00498 *RW DTSBD325 00499 P3100-EXIT. DTSBD325 00500 EXIT. DTSBD325 00501 EJECT DTSBD325 00502 P4000-WRITE-MDPC-AND-REPORT. DTSBD325 00503 IF MDPC-STMT-DUE-AMT > +0 DTSBD325 00504 MOVE R434-STMT-DUE-AMT TO MDPC-STMT-DUE-AMT DTSBD325 00505 PERFORM S946-WRITE-R434 THRU S946-EXIT DTSBD325 00506 PERFORM P4100-WRITE-MEVL THRU P4100-EXIT DTSBD325 00507 ELSE DTSBD325 00508 MOVE MSG4-ID-2 TO R907-MSG-ID DTSBD325 00509 MOVE MPRF-EMP-NO TO R907-EMP-NO DTSBD325 00510 MOVE MSG4-LONG-TEXT TO R907-MSG-TEXT DTSBD325 00511 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBD325 00512 SET MDPC-STATUS-WITHDRAWN-88 TO TRUE DTSBD325 00513 MOVE LBCM-CURR-RUN-DATE TO MDPC-STATUS-DATE DTSBD325 00514 SET MDPC-STATUS-SYSTEM-88 TO TRUE DTSBD325 00515 MOVE +0 TO MDPC-STMT-DUE-AMT. DTSBD325 00516 DTSBD325 00517 DTSBD325 00518 MOVE LBCM-CURR-RUN-DATE TO MDPC-CHNG-DATE. DTSBD325 00519 DTSBD325 00520 MOVE MDPC-REC TO MSKL-REC. DTSBD325 00521 DTSBD325 00522 PERFORM S910-REWRITE THRU S910-EXIT. DTSBD325 00523 P4000-EXIT. DTSBD325 00524 EXIT. DTSBD325 00525 EJECT DTSBD325 00526 P4100-WRITE-MEVL. DTSBD325 00527 MOVE LOW-VALUE TO MEVL-REC. DTSBD325 00528 DTSBD325 00529 MOVE MPRF-EMP-NO TO MEVL-EMP-NO. DTSBD325 00530 DTSBD325 00531 SET MEVL-EVL-88 TO TRUE. DTSBD325 00532 DTSBD325 00533 ADD +1000 TO LBCM-EMP-ABSTIME. DTSBD325 00534 DTSBD325 00535 MOVE LBCM-EMP-ABSTIME TO L005-ABSTIME. DTSBD325 00536 DTSBD325 00537 PERFORM S005-FROM-ABSTIME THRU S005-EXIT. DTSBD325 00538 DTSBD325 00539 MOVE L005-DATE TO MEVL-DATE. DTSBD325 00540 DTSBD325 00541 MOVE L005-TIME TO MEVL-TIME. DTSBD325 00542 DTSBD325 00543 MOVE +0 TO MEVL-PURGE-DATE. DTSBD325 00544 DTSBD325 00545 MOVE WRK-EVENT-TXT TO MEVL-TEXT. DTSBD325 00546 DTSBD325 00547 SET MEVL-SOURCE-SYSTEM-88 TO TRUE. DTSBD325 00548 DTSBD325 00549 SET MEVL-NOT-CONVERTED-88 TO TRUE. DTSBD325 00550 DTSBD325 00551 MOVE LBCM-CURR-RUN-DATE TO MEVL-ESTB-DATE DTSBD325 00552 MEVL-CHNG-DATE. DTSBD325 00553 DTSBD325 00554 MOVE MEVL-REC TO MSKL-REC. DTSBD325 00555 DTSBD325 00556 PERFORM S910-WRITE THRU S910-EXIT. DTSBD325 00557 P4100-EXIT. DTSBD325 00558 EXIT. DTSBD325 00559 EJECT DTSBD325 00560 S1000-READ-SUBJECT-MDPC. DTSBD325 00561 MOVE LOW-VALUE TO MDPC-KEY-AREA. DTSBD325 00562 DTSBD325 00563 MOVE MPRF-EMP-NO TO MDPC-EMP-NO. DTSBD325 00564 DTSBD325 00565 SET MDPC-DPC-88 TO TRUE. DTSBD325 00566 DTSBD325 00567 MOVE T011-ESTB-ABSTIME TO MDPC-ESTB-ABSTIME. DTSBD325 00568 DTSBD325 00569 MOVE MDPC-KEY-AREA TO MSKL-KEY-AREA. DTSBD325 00570 DTSBD325 00571 PERFORM S910-READ THRU S910-EXIT. DTSBD325 00572 DTSBD325 00573 IF L910-OK-88 DTSBD325 00574 MOVE MSKL-REC TO MDPC-REC. DTSBD325 00575 S1000-EXIT. DTSBD325 00576 EXIT. DTSBD325 00577 EJECT DTSBD325 00578 S004-FROM-5. DTSBD325 00579 SET L004-FROM-5 TO TRUE. DTSBD325 00580 GO TO S004-YRQ. DTSBD325 00581 DTSBD325 00582 S004-YRQ. DTSBD325 00583 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBD325 00584 S004-EXIT. DTSBD325 00585 EXIT. DTSBD325 00586 SKIP3 DTSBD325 00587 S005-FROM-ABSTIME. DTSBD325 00588 SET L005-FROM-ABSTIME TO TRUE. DTSBD325 00589 GO TO S005-TIME. DTSBD325 00590 DTSBD325 00591 S005-TIME. DTSBD325 00592 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBD325 00593 S005-EXIT. DTSBD325 00594 EXIT. DTSBD325 00595 SKIP3 DTSBD325 00596 S101-PER-MONTH-NO. DTSBD325 00597 SET L101-PER-MONTH-NO-88 TO TRUE. DTSBD325 00598 GO TO S101-INTEREST. DTSBD325 00599 DTSBD325 00600 S101-INTEREST. DTSBD325 00601 CALL 'DTSBU101' USING L101-LINK-AREA. DTSBD325 00602 S101-EXIT. DTSBD325 00603 EXIT. DTSBD325 00604 SKIP3 DTSBD325 00605 S109-FIRST-PEN-INT-YRQ. DTSBD325 00606 SET L109-CMND-PEN-INT-QTR-88 TO TRUE. DTSBD325 00607 GO TO S109-SUR-RATE. DTSBD325 00608 DTSBD325 00609 S109-SUR-RATE. DTSBD325 00610 CALL 'DTSBU109' USING L109-LINK-AREA. DTSBD325 00611 S109-EXIT. DTSBD325 00612 EXIT. DTSBD325 00613 SKIP3 DTSBD325 00614 S910-READ. DTSBD325 00615 SET L910-READ-88 TO TRUE. DTSBD325 00616 GO TO S910-MSTR-IO. DTSBD325 00617 DTSBD325 00618 S910-START-BROWSE. DTSBD325 00619 SET L910-START-BROWSE-88 TO TRUE. DTSBD325 00620 GO TO S910-MSTR-IO. DTSBD325 00621 DTSBD325 00622 S910-READ-NEXT. DTSBD325 00623 SET L910-READ-NEXT-88 TO TRUE. DTSBD325 00624 GO TO S910-MSTR-IO. DTSBD325 00625 DTSBD325 00626 *S910-COUNT. DTSBD325 00627 *****SET L910-COUNT-88 TO TRUE. DTSBD325 00628 *****GO TO S910-MSTR-IO. DTSBD325 00629 DTSBD325 00630 S910-WRITE. DTSBD325 00631 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBD325 00632 SET L910-WRITE-88 TO TRUE. DTSBD325 00633 GO TO S910-MSTR-IO. DTSBD325 00634 DTSBD325 00635 S910-REWRITE. DTSBD325 00636 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBD325 00637 SET L910-REWRITE-88 TO TRUE. DTSBD325 00638 GO TO S910-MSTR-IO. DTSBD325 00639 DTSBD325 00640 *S910-DELETE. DTSBD325 00641 *****SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBD325 00642 *****SET L910-DELETE-88 TO TRUE. DTSBD325 00643 *****GO TO S910-MSTR-IO. DTSBD325 00644 DTSBD325 00645 S910-MSTR-IO. DTSBD325 00646 CALL 'DTSBU910' USING L910-LINK-AREA DTSBD325 00647 MSKL-REC. DTSBD325 00648 S910-EXIT. DTSBD325 00649 EXIT. DTSBD325 00650 SKIP3 DTSBD325 00651 S946-WRITE-R434. DTSBD325 00652 CALL 'DTSBU946' USING R434-REC. DTSBD325 00653 GO TO S946-EXIT. DTSBD325 00654 DTSBD325 00655 S946-WRITE-R907. DTSBD325 00656 CALL 'DTSBU907' USING R907-REC. DTSBD325 00657 GO TO S946-EXIT. DTSBD325 00658 DTSBD325 00659 S946-EXIT. DTSBD325 00660 EXIT. DTSBD325 00661 SKIP3 DTSBD325 00662 S999-ABEND. DTSBD325 00663 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBD325 00664 S999-EXIT. DTSBD325 00665 EXIT. DTSBD325