00001 IDENTIFICATION DIVISION. 11/12/98 00002 PROGRAM-ID. DTSBU101. DTSBU101 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV003 00004 DATE-WRITTEN. MAY 1994. DTSBU101 00005 DATE-COMPILED. DTSBU101 00006 SKIP3 DTSBU101 00007 ***** DTSBU101 00008 * DTSBU101 00009 * FUNCTION: INTEREST CHARGE/WAIVER CALCULATION. CL**2 00010 * DTSBU101 00011 * DTSBU101 00012 * MODIFICATION LOG: DTSBU101 00013 * DTSBU101 00014 * 05/22/94 INITIAL DEVELOPMENT. DTSBU101 00015 * WORK ORDER: PROGRAMMER: EHH DTSBU101 00016 * DTSBU101 00017 * 11/12/1998 REWRITTEN FOR DC. CL**2 00018 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH CL**2 00019 * CL**2 00020 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2 00021 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2 00022 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX CL**2 00023 * DTSBU101 00024 * DTSBU101 00025 * DESCRIPTION: DTSBU101 00026 * DTSBU101 00027 ***** DTSBU101 00028 SKIP3 DTSBU101 00029 ENVIRONMENT DIVISION. DTSBU101 00030 EJECT DTSBU101 00031 DATA DIVISION. DTSBU101 00032 SKIP3 DTSBU101 00033 WORKING-STORAGE SECTION. DTSBU101 000335 77 PAN-VALET PICTURE X(24) VALUE '003DTSBU101 11/12/98'. DTSBU101 00034 CL**2 00035 01 WRK-AREA. DTSBU101 00036 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +101.DTSBU101 00037 CL**2 00038 05 DEFAULT-INT-RATE PIC S9(01)V9(04) COMP-3 DTSBU101 00039 VALUE +0.1800. DTSBU101 00040 CL**2 00041 CL**2 00042 05 INT-TABLE. DTSBU101 00043 10 INT-SUB1 PIC S9(04) COMP. DTSBU101 00044 CL**3 00045 10 INT-SPAN-CNT PIC S9(04) COMP. DTSBU101 00046 CL**2 00047 10 INT-SPAN OCCURS 3 TIMES DTSBU101 00048 INDEXED BY INT-IDX. DTSBU101 00049 15 INT-START-MONTH PIC S9(08) COMP. CL**3 00050 15 INT-END-MONTH PIC S9(08) COMP. CL**3 00051 15 INT-MONTH-CNT PIC S9(08) COMP. CL**3 00052 15 INT-RATE PIC S9(01)V9(04) COMP-3. DTSBU101 00053 CL**2 00054 CL**2 00055 05 LOOP-MONTH PIC S9(08) COMP. CL**3 00056 CL**2 00057 05 COUNTED-IND PIC X(01). DTSBU101 00058 CL**2 00059 05 INT-CHARGE OCCURS 3 TIMES PIC S9(09)V9(04) COMP-3. DTSBU101 00060 CL**2 00061 05 INT-MONTH-RATE PIC S9(01)V9(08) COMP-3. CL**3 00062 CL**2 00063 05 WRK-RECEIVED-DATE PIC S9(09) COMP-3. DTSBU101 00064 CL**2 00065 05 WRK-INT-CHARGE-CHNG PIC S9(09)V9(02) COMP-3. DTSBU101 00066 EJECT DTSBU101 00067 01 L001-LINK-AREA. DTSBU101 00068 ++INCLUDE DTSIL001 CL**2 00069 EJECT DTSBU101 00070 LINKAGE SECTION. DTSBU101 00071 SKIP3 DTSBU101 00072 01 L101-LINK-AREA. DTSBU101 00073 ++INCLUDE DTSIL101 CL**2 00074 EJECT DTSBU101 00075 PROCEDURE DIVISION USING L101-LINK-AREA. DTSBU101 00076 CL**2 00077 CL**2 00078 MOVE +0 TO L101-INT-CHARGE-CHNG DTSBU101 00079 L101-INT-WAIVE-CHNG CL**2 00080 L101-INT-PER-MONTH. CL**2 00081 CL**2 00082 CL**2 00083 MOVE L101-RECEIVED-DATE TO WRK-RECEIVED-DATE. DTSBU101 00084 CL**2 00085 MOVE +0 TO WRK-INT-CHARGE-CHNG. DTSBU101 00086 CL**2 00087 PERFORM P1000-INT-CHARGE THRU P1000-EXIT. DTSBU101 00088 CL**2 00089 MOVE WRK-INT-CHARGE-CHNG TO L101-INT-CHARGE-CHNG. DTSBU101 00090 CL**2 00091 CL**2 00092 IF L101-PER-MONTH-YES-88 CL**2 00093 MOVE L101-RECEIVED-DATE TO L001-FED-8-DATE-9 DTSBU101 00094 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBU101 00095 IF L001-INVALID-DATE DTSBU101 00096 PERFORM S999-ABEND THRU S999-EXIT DTSBU101 00097 END-IF DTSBU101 00098 PERFORM S1000-LAST-DAY-OF-NEXT-MONTH THRU S1000-EXIT CL**3 00099 MOVE L001-FED-8-DATE-9 TO WRK-RECEIVED-DATE DTSBU101 00100 MOVE +0 TO WRK-INT-CHARGE-CHNG DTSBU101 00101 PERFORM P1000-INT-CHARGE THRU P1000-EXIT DTSBU101 00102 COMPUTE L101-INT-PER-MONTH CL**2 00103 = WRK-INT-CHARGE-CHNG - L101-INT-CHARGE-CHNG. DTSBU101 00104 CL**2 00105 CL**2 00106 PERFORM P4000-WAIVE THRU P4000-EXIT. CL**2 00107 CL**2 00108 CL**2 00109 GOBACK. DTSBU101 00110 EJECT DTSBU101 00111 P1000-INT-CHARGE. DTSBU101 00112 IF WRK-RECEIVED-DATE > L101-TAX-DUE-DATE DTSBU101 00113 NEXT SENTENCE DTSBU101 00114 ELSE DTSBU101 00115 GO TO P1000-EXIT. DTSBU101 00116 CL**2 00117 IF L101-INT-CHARGE-MANUAL-88 DTSBU101 00118 GO TO P1000-EXIT. DTSBU101 00119 CL**2 00120 PERFORM P1100-BUILD-INT-TABLE THRU P1100-EXIT. DTSBU101 00121 CL**2 00122 MOVE +0 TO INT-CHARGE (1) DTSBU101 00123 INT-CHARGE (2) DTSBU101 00124 INT-CHARGE (3). DTSBU101 00125 CL**2 00126 PERFORM P1200-COMPUTE-CHARGE THRU P1200-EXIT DTSBU101 00127 VARYING INT-SUB1 FROM 1 BY 1 DTSBU101 00128 UNTIL INT-SUB1 > INT-SPAN-CNT. DTSBU101 00129 CL**2 00130 COMPUTE WRK-INT-CHARGE-CHNG ROUNDED DTSBU101 00131 = INT-CHARGE (1) + INT-CHARGE (2) + INT-CHARGE (3). DTSBU101 00132 P1000-EXIT. DTSBU101 00133 EXIT. DTSBU101 00134 SKIP3 DTSBU101 00135 P1100-BUILD-INT-TABLE. DTSBU101 00136 MOVE +0 TO INT-SPAN-CNT. DTSBU101 00137 CL**2 00138 PERFORM P1110-INT-SPAN THRU P1110-EXIT DTSBU101 00139 VARYING L101-INT-IDX FROM 1 BY 1 DTSBU101 00140 UNTIL L101-INT-IDX > L101-INT-CNT. DTSBU101 00141 CL**2 00142 ADD +1 TO INT-SPAN-CNT. DTSBU101 00143 CL**2 00144 MOVE L101-TAX-DUE-DATE TO L001-FED-8-DATE-9. DTSBU101 00145 CL**2 00146 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU101 00147 CL**2 00148 IF L001-INVALID-DATE DTSBU101 00149 PERFORM S999-ABEND THRU S999-EXIT. DTSBU101 00150 CL**2 00151 ADD +1 TO L001-JUL-ABS-DAY. DTSBU101 00152 CL**2 00153 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. CL**3 00154 CL**2 00155 IF L001-INVALID-DATE CL**3 00156 PERFORM S999-ABEND THRU S999-EXIT. CL**3 00157 CL**3 00158 COMPUTE INT-START-MONTH (INT-SPAN-CNT) CL**3 00159 = (L001-FED-8-YR * 12) + L001-FED-8-MO. CL**3 00160 CL**3 00161 MOVE WRK-RECEIVED-DATE TO L001-FED-8-DATE-9. DTSBU101 00162 CL**2 00163 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU101 00164 CL**2 00165 IF L001-INVALID-DATE DTSBU101 00166 PERFORM S999-ABEND THRU S999-EXIT. DTSBU101 00167 CL**3 00168 COMPUTE INT-END-MONTH (INT-SPAN-CNT) CL**3 00169 = (L001-FED-8-YR * 12) + L001-FED-8-MO. CL**3 00170 CL**2 00171 MOVE +0 TO INT-MONTH-CNT (INT-SPAN-CNT). CL**3 00172 CL**2 00173 MOVE DEFAULT-INT-RATE TO INT-RATE (INT-SPAN-CNT). DTSBU101 00174 CL**2 00175 IF INT-SPAN-CNT = +1 DTSBU101 00176 COMPUTE INT-MONTH-CNT (1) CL**3 00177 = INT-END-MONTH (1) - INT-START-MONTH (1) + 1 CL**3 00178 GO TO P1100-EXIT. DTSBU101 00179 CL**2 00180 MOVE INT-START-MONTH (INT-SPAN-CNT) TO LOOP-MONTH. CL**3 00181 CL**2 00182 PERFORM P1120-EXAMINE-MONTH THRU P1120-EXIT CL**3 00183 VARYING LOOP-MONTH FROM LOOP-MONTH BY +1 CL**3 00184 UNTIL LOOP-MONTH > INT-END-MONTH (INT-SPAN-CNT). CL**3 00185 P1100-EXIT. DTSBU101 00186 EXIT. DTSBU101 00187 SKIP3 DTSBU101 00188 P1110-INT-SPAN. DTSBU101 00189 IF (L101-INT-END-DATE (L101-INT-IDX) < L101-TAX-DUE-DATE) DTSBU101 00190 OR DTSBU101 00191 (L101-INT-START-DATE (L101-INT-IDX) DTSBU101 00192 > WRK-RECEIVED-DATE) DTSBU101 00193 GO TO P1110-EXIT. DTSBU101 00194 CL**2 00195 ADD +1 TO INT-SPAN-CNT. DTSBU101 00196 CL**2 00197 MOVE L101-INT-START-DATE (L101-INT-IDX) DTSBU101 00198 TO L001-FED-8-DATE-9. DTSBU101 00199 CL**2 00200 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU101 00201 CL**2 00202 IF L001-INVALID-DATE DTSBU101 00203 PERFORM S999-ABEND THRU S999-EXIT. DTSBU101 00204 CL**2 00205 COMPUTE INT-START-MONTH (INT-SPAN-CNT) CL**3 00206 = (L001-FED-8-YR * 12) + L001-FED-8-MO. CL**3 00207 CL**2 00208 MOVE L101-INT-END-DATE (L101-INT-IDX) DTSBU101 00209 TO L001-FED-8-DATE-9. DTSBU101 00210 CL**2 00211 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBU101 00212 CL**2 00213 IF L001-INVALID-DATE DTSBU101 00214 PERFORM S999-ABEND THRU S999-EXIT. DTSBU101 00215 CL**3 00216 COMPUTE INT-END-MONTH (INT-SPAN-CNT) CL**3 00217 = (L001-FED-8-YR * 12) + L001-FED-8-MO. CL**3 00218 CL**2 00219 MOVE L101-INT-RATE (L101-INT-IDX) DTSBU101 00220 TO INT-RATE (INT-SPAN-CNT). DTSBU101 00221 CL**2 00222 MOVE +0 TO INT-MONTH-CNT (INT-SPAN-CNT). CL**3 00223 P1110-EXIT. DTSBU101 00224 EXIT. DTSBU101 00225 SKIP3 DTSBU101 00226 P1120-EXAMINE-MONTH. CL**3 00227 MOVE 'N' TO COUNTED-IND. DTSBU101 00228 CL**2 00229 PERFORM P1121-INT-ENTRY-LOOP THRU P1121-EXIT DTSBU101 00230 VARYING INT-IDX FROM 1 BY 1 DTSBU101 00231 UNTIL (COUNTED-IND = 'Y') DTSBU101 00232 OR DTSBU101 00233 (INT-IDX > INT-SPAN-CNT). DTSBU101 00234 P1120-EXIT. DTSBU101 00235 EXIT. DTSBU101 00236 SKIP3 DTSBU101 00237 P1121-INT-ENTRY-LOOP. DTSBU101 00238 IF (LOOP-MONTH < INT-START-MONTH (INT-IDX)) CL**3 00239 OR DTSBU101 00240 (LOOP-MONTH > INT-END-MONTH (INT-IDX)) CL**3 00241 NEXT SENTENCE DTSBU101 00242 ELSE DTSBU101 00243 ADD +1 TO INT-MONTH-CNT (INT-IDX) CL**3 00244 MOVE 'Y' TO COUNTED-IND. DTSBU101 00245 P1121-EXIT. DTSBU101 00246 EXIT. DTSBU101 00247 SKIP3 DTSBU101 00248 P1200-COMPUTE-CHARGE. DTSBU101 00249 IF INT-MONTH-CNT (INT-SUB1) = +0 CL**3 00250 GO TO P1200-EXIT. DTSBU101 00251 CL**2 00252 COMPUTE INT-MONTH-RATE ROUNDED CL**3 00253 = INT-RATE (INT-SUB1) / 12 CL**3 00254 ON SIZE ERROR DTSBU101 00255 MOVE +0 TO INT-MONTH-RATE. CL**3 00256 CL**2 00257 COMPUTE INT-CHARGE (INT-SUB1) ROUNDED DTSBU101 00258 = INT-MONTH-CNT (INT-SUB1) * L101-PAID-CHNG CL**3 00259 * INT-MONTH-RATE CL**3 00260 ON SIZE ERROR DTSBU101 00261 MOVE +0 TO INT-CHARGE (INT-SUB1). DTSBU101 00262 P1200-EXIT. DTSBU101 00263 EXIT. DTSBU101 00264 EJECT DTSBU101 00265 P4000-WAIVE. CL**2 00266 IF L101-INT-CHARGE-CHNG > +0 DTSBU101 00267 NEXT SENTENCE DTSBU101 00268 ELSE DTSBU101 00269 GO TO P4000-EXIT. CL**2 00270 CL**2 00271 IF L101-WAIVE-INT-YES-88 CL**2 00272 MOVE L101-INT-CHARGE-CHNG TO L101-INT-WAIVE-CHNG CL**2 00273 GO TO P4000-EXIT. CL**2 00274 CL**2 00275 IF (L101-RECEIVED-DATE < L101-WAIVE-INT-START-DATE) CL**2 00276 OR DTSBU101 00277 (L101-RECEIVED-DATE > L101-WAIVE-INT-END-DATE) CL**2 00278 NEXT SENTENCE DTSBU101 00279 ELSE DTSBU101 00280 MOVE L101-INT-CHARGE-CHNG TO L101-INT-WAIVE-CHNG. CL**2 00281 P4000-EXIT. CL**2 00282 EXIT. DTSBU101 00283 EJECT DTSBU101 00284 S1000-LAST-DAY-OF-NEXT-MONTH. CL**3 00285 ADD 01 TO L001-FED-8-MO. CL**3 00286 CL**3 00287 IF L001-FED-8-MO > 12 CL**3 00288 MOVE 01 TO L001-FED-8-MO CL**3 00289 ADD 1 TO L001-FED-8-YR. CL**3 00290 CL**3 00291 CL**3 00292 ADD 01 TO L001-FED-8-MO. CL**3 00293 CL**3 00294 IF L001-FED-8-MO > 12 CL**3 00295 MOVE 01 TO L001-FED-8-MO CL**3 00296 ADD 1 TO L001-FED-8-YR. CL**3 00297 CL**3 00298 CL**3 00299 MOVE 01 TO L001-FED-8-DA. CL**3 00300 CL**3 00301 PERFORM S001-FROM-FED-8 THRU S001-EXIT. CL**3 00302 CL**3 00303 IF L001-INVALID-DATE CL**3 00304 PERFORM S999-ABEND THRU S999-EXIT. CL**3 00305 CL**3 00306 SUBTRACT 1 FROM L001-JUL-ABS-DAY. CL**3 00307 CL**3 00308 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. CL**3 00309 CL**3 00310 IF L001-INVALID-DATE CL**3 00311 PERFORM S999-ABEND THRU S999-EXIT. CL**3 00312 S1000-EXIT. CL**3 00313 EXIT. CL**3 00314 EJECT CL**3 00315 S001-FROM-FED-8. DTSBU101 00316 SET L001-FROM-FED-8 TO TRUE. DTSBU101 00317 GO TO S001-DATE. DTSBU101 00318 CL**2 00319 S001-FROM-ABS-DAY. DTSBU101 00320 SET L001-FROM-ABS-DAY TO TRUE. DTSBU101 00321 GO TO S001-DATE. DTSBU101 00322 CL**2 00323 S001-DATE. DTSBU101 00324 CALL 'DTSBU001' USING L001-LINK-AREA. CL**2 00325 S001-EXIT. DTSBU101 00326 EXIT. DTSBU101 00327 SKIP3 DTSBU101 00328 S999-ABEND. DTSBU101 00329 CALL 'DTSBU999' USING WRK-ABEND-CD. CL**2 00330 S999-EXIT. DTSBU101 00331 EXIT. DTSBU101