292 lines
23 KiB
COBOL
292 lines
23 KiB
COBOL
00001 IDENTIFICATION DIVISION. 06/29/02
|
|
00002 PROGRAM-ID. DTSBU103. DTSBU103
|
|
00003 AUTHOR. TRW. LV001
|
|
00004 DATE-WRITTEN. FEBRUARY 2002. DTSBU103
|
|
00005 DATE-COMPILED. DTSBU103
|
|
00006 SKIP3 DTSBU103
|
|
00007 ***** DTSBU103
|
|
00008 * DTSBU103
|
|
00009 * FUNCTION: LATE PAYMENT PENALTY CHARGE/WAIVER CALCULATION DTSBU103
|
|
00010 * >> FOR ANNUAL REPORTS << DTSBU103
|
|
00011 * DTSBU103
|
|
00012 * MODIFICATION LOG: DTSBU103
|
|
00013 * DTSBU103
|
|
00014 * 11/14/1998 MODIFIED FROM DTSBU102 DTSBU103
|
|
00015 * REFERENCE: HOUSEHOLD PROGRAMMER: GD DTSBU103
|
|
00016 * DTSBU103
|
|
00017 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU103
|
|
00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU103
|
|
00019 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBU103
|
|
00020 * DTSBU103
|
|
00021 * DTSBU103
|
|
00022 * DESCRIPTION: DTSBU103
|
|
00023 * DTSBU103
|
|
00024 * COMPUTES LATE PAYMENT PENALTY CHARGED (PER SECTION 3.1.3.4 DTSBU103
|
|
00025 * OF THE REQUIREMENTS DOCUMENT AND COMPUTES LATE PAYMENT DTSBU103
|
|
00026 * PENALTY WAIVED (PER SECTION 3.1.4.3 OF THE REQUIREMENTS DTSBU103
|
|
00027 * DOCUMENT. DTSBU103
|
|
00028 * DTSBU103
|
|
00029 ***** DTSBU103
|
|
00030 SKIP3 DTSBU103
|
|
00031 ENVIRONMENT DIVISION. DTSBU103
|
|
00032 EJECT DTSBU103
|
|
00033 DATA DIVISION. DTSBU103
|
|
00034 SKIP3 DTSBU103
|
|
00035 WORKING-STORAGE SECTION. DTSBU103
|
|
000355 77 PAN-VALET PICTURE X(24) VALUE '001DTSBU103 06/29/02'. DTSBU103
|
|
00036 DTSBU103
|
|
00037 01 WRK-AREA. DTSBU103
|
|
00038 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +103.DTSBU103
|
|
00039 DTSBU103
|
|
00040 05 WRK-PEN-PCT PIC S9(01)V9(03) COMP-3 DTSBU103
|
|
00041 VALUE +0.010. DTSBU103
|
|
00042 DTSBU103
|
|
00043 05 WRK-FIXED-PEN PIC S9(03)V9(02) COMP-3 DTSBU103
|
|
00044 VALUE +100.00. DTSBU103
|
|
00045 DTSBU103
|
|
00046 05 WRK-LATE-ORIG-RPT-IND PIC X(01). DTSBU103
|
|
00047 88 WRK-LATE-ORIG-RPT-YES-88 VALUE 'Y'. DTSBU103
|
|
00048 88 WRK-LATE-ORIG-RPT-NO-88 VALUE 'N'. DTSBU103
|
|
00049 DTSBU103
|
|
00050 05 WRK-INIT-COMPLETE-IND PIC X(01) VALUE 'N'. DTSBU103
|
|
00051 88 WRK-INIT-COMPLETE-YES-88 VALUE 'Y'. DTSBU103
|
|
00052 88 WRK-INIT-COMPLETE-NO-88 VALUE 'N'. DTSBU103
|
|
00053 DTSBU103
|
|
00054 05 PEN-CALC-TYPE-IND PIC X(01). DTSBU103
|
|
00055 88 PEN-CALC-FROM-PCT-88 VALUE '0'. DTSBU103
|
|
00056 88 PEN-CALC-FIXED-AMT-88 VALUE '1'. DTSBU103
|
|
00057 88 PEN-CALC-TYPE-VALID-88 VALUE '0' '1'. DTSBU103
|
|
00058 DTSBU103
|
|
00059 05 WRK-BASE-AMT PIC S9(09)V9(02) COMP-3. DTSBU103
|
|
00060 DTSBU103
|
|
00061 05 WRK-TOT-PEN-AMT PIC S9(09)V9(02) COMP-3. DTSBU103
|
|
00062 DTSBU103
|
|
00063 EJECT DTSBU103
|
|
00064 LINKAGE SECTION. DTSBU103
|
|
00065 SKIP3 DTSBU103
|
|
00066 01 L103-LINK-AREA. DTSBU103
|
|
00067 ++INCLUDE DTSIL103 DTSBU103
|
|
00068 EJECT DTSBU103
|
|
00069 PROCEDURE DIVISION USING L103-LINK-AREA. DTSBU103
|
|
00070 DTSBU103-MAINLINE. DTSBU103
|
|
00071 DTSBU103
|
|
00072 IF NOT L103-OPTION-VALID-88 DTSBU103
|
|
00073 DISPLAY '*** DTSBU103 ABENDING: INVALID OPTION ' DTSBU103
|
|
00074 L103-OPTION DTSBU103
|
|
00075 PERFORM S999-ABEND THRU S999-EXIT. DTSBU103
|
|
00076 DTSBU103
|
|
00077 MOVE +0 TO L103-LATE-PEN-CHARGE-CHNG DTSBU103
|
|
00078 L103-LATE-PEN-WAIVE-CHNG. DTSBU103
|
|
00079 DTSBU103
|
|
00080 IF L103-INITIALIZATION-88 DTSBU103
|
|
00081 PERFORM I0000-INIT THRU I0000-EXIT DTSBU103
|
|
00082 GO TO DTSBU103-MAINLINE-EXIT. DTSBU103
|
|
00083 DTSBU103
|
|
00084 IF WRK-INIT-COMPLETE-NO-88 DTSBU103
|
|
00085 OR NOT PEN-CALC-TYPE-VALID-88 DTSBU103
|
|
00086 DISPLAY '*** DTSBU103 ABENDING: INIT NOT COMPLETE' DTSBU103
|
|
00087 PERFORM S999-ABEND THRU S999-EXIT. DTSBU103
|
|
00088 DTSBU103
|
|
00089 IF L103-LIABLE-QTR-CNT = ZERO DTSBU103
|
|
00090 DISPLAY '*** DTSBU103: QTR CNT = ZERO' DTSBU103
|
|
00091 GO TO DTSBU103-MAINLINE-EXIT. DTSBU103
|
|
00092 DTSBU103
|
|
00093 PERFORM P1000-PEN-CHARGE THRU P1000-EXIT. DTSBU103
|
|
00094 DTSBU103
|
|
00095 DTSBU103
|
|
00096 PERFORM P2000-WAIVE THRU P2000-EXIT. DTSBU103
|
|
00097 DTSBU103
|
|
00098 DTSBU103
|
|
00099 DTSBU103-MAINLINE-EXIT. DTSBU103
|
|
00100 GOBACK. DTSBU103
|
|
00101 EJECT DTSBU103
|
|
00102 I0000-INIT. DTSBU103
|
|
00103 SET WRK-INIT-COMPLETE-YES-88 TO TRUE. DTSBU103
|
|
00104 DTSBU103
|
|
00105 IF L103-OR-RECEIVED-DATE > L103-RPT-DUE-DATE DTSBU103
|
|
00106 SET WRK-LATE-ORIG-RPT-YES-88 TO TRUE DTSBU103
|
|
00107 ELSE DTSBU103
|
|
00108 SET WRK-LATE-ORIG-RPT-NO-88 TO TRUE DTSBU103
|
|
00109 END-IF. DTSBU103
|
|
00110 DTSBU103
|
|
00111 *& DTSBU103
|
|
00112 * DISPLAY 'DTSBU103 INIT' DTSBU103
|
|
00113 * ' RCVD ' L103-OR-RECEIVED-DATE DTSBU103
|
|
00114 * ' DUE ' L103-RPT-DUE-DATE DTSBU103
|
|
00115 * IF WRK-LATE-ORIG-RPT-YES-88 DTSBU103
|
|
00116 * DISPLAY ' LATE REPORT' DTSBU103
|
|
00117 * ELSE DTSBU103
|
|
00118 * DISPLAY ' TIMELY REPORT'. DTSBU103
|
|
00119 *& DTSBU103
|
|
00120 IF WRK-LATE-ORIG-RPT-YES-88 DTSBU103
|
|
00121 IF (L103-INIT-TOT-CHG * WRK-PEN-PCT) > WRK-FIXED-PEN DTSBU103
|
|
00122 SET PEN-CALC-FROM-PCT-88 TO TRUE DTSBU103
|
|
00123 ELSE DTSBU103
|
|
00124 SET PEN-CALC-FIXED-AMT-88 TO TRUE DTSBU103
|
|
00125 END-IF DTSBU103
|
|
00126 ELSE DTSBU103
|
|
00127 COMPUTE WRK-TOT-PEN-AMT = DTSBU103
|
|
00128 (L103-INIT-TOT-BAL * WRK-PEN-PCT) DTSBU103
|
|
00129 IF WRK-TOT-PEN-AMT > WRK-FIXED-PEN DTSBU103
|
|
00130 SET PEN-CALC-FROM-PCT-88 TO TRUE DTSBU103
|
|
00131 ELSE DTSBU103
|
|
00132 SET PEN-CALC-FIXED-AMT-88 TO TRUE DTSBU103
|
|
00133 END-IF DTSBU103
|
|
00134 END-IF. DTSBU103
|
|
00135 DTSBU103
|
|
00136 MOVE ZERO TO WRK-TOT-PEN-AMT. DTSBU103
|
|
00137 *& DTSBU103
|
|
00138 * DISPLAY 'DTSBU103 INIT '. DTSBU103
|
|
00139 * DISPLAY ' TOT CHG ' L103-INIT-TOT-CHG. DTSBU103
|
|
00140 * IF PEN-CALC-FROM-PCT-88 DTSBU103
|
|
00141 * DISPLAY ' CALC FROM PERCENT' DTSBU103
|
|
00142 * ELSE DTSBU103
|
|
00143 * DISPLAY ' FIXED PENALTY'. DTSBU103
|
|
00144 *& DTSBU103
|
|
00145 I0000-EXIT. DTSBU103
|
|
00146 EXIT. DTSBU103
|
|
00147 DTSBU103
|
|
00148 P1000-PEN-CHARGE. DTSBU103
|
|
00149 IF L103-PEN-CHARGE-MANUAL-88 DTSBU103
|
|
00150 GO TO P1000-EXIT. DTSBU103
|
|
00151 DTSBU103
|
|
00152 *& DTSBU103
|
|
00153 DISPLAY 'DTSBU103 L103 LAST PEN YRQ ' DTSBU103
|
|
00154 L103-LAST-PEN-ASSESSED-YRQ DTSBU103
|
|
00155 ' YRQ ' L103-MQTR-YRQ. DTSBU103
|
|
00156 *& DTSBU103
|
|
00157 IF L103-LAST-PEN-ASSESSED-YRQ = ZERO DTSBU103
|
|
00158 GO TO P1000-EXIT DTSBU103
|
|
00159 ELSE DTSBU103
|
|
00160 IF L103-MQTR-YRQ > L103-LAST-PEN-ASSESSED-YRQ DTSBU103
|
|
00161 GO TO P1000-EXIT. DTSBU103
|
|
00162 DTSBU103
|
|
00163 IF L103-LATE-PEN-CHARGED-AMT > +0 DTSBU103
|
|
00164 GO TO P1000-EXIT. DTSBU103
|
|
00165 DTSBU103
|
|
00166 SET WRK-LATE-ORIG-RPT-NO-88 TO TRUE. DTSBU103
|
|
00167 MOVE ZERO TO WRK-BASE-AMT. DTSBU103
|
|
00168 DTSBU103
|
|
00169 IF L103-PEN-ASSESSMENT-RUN-88 DTSBU103
|
|
00170 OR L103-ORIGINAL-RPT-88 DTSBU103
|
|
00171 PERFORM P1100-CHK-LATE-ORIG-RPT THRU P1100-EXIT DTSBU103
|
|
00172 PERFORM P1200-CALC-ORIG-BASE-AMT THRU P1200-EXIT DTSBU103
|
|
00173 ELSE DTSBU103
|
|
00174 IF L103-NSF-PAY-REVERSAL-88 DTSBU103
|
|
00175 PERFORM P1300-CALC-NSF-BASE-AMT THRU P1300-EXIT DTSBU103
|
|
00176 ELSE DTSBU103
|
|
00177 IF L103-ESTIMATED-RPT-88 DTSBU103
|
|
00178 MOVE L103-TAX-CHARGED-AMT TO WRK-BASE-AMT DTSBU103
|
|
00179 END-IF DTSBU103
|
|
00180 END-IF DTSBU103
|
|
00181 END-IF. DTSBU103
|
|
00182 DTSBU103
|
|
00183 PERFORM S1000-COMPUTE-PENALTY THRU S1000-EXIT. DTSBU103
|
|
00184 DTSBU103
|
|
00185 P1000-EXIT. DTSBU103
|
|
00186 EXIT. DTSBU103
|
|
00187 DTSBU103
|
|
00188 P1100-CHK-LATE-ORIG-RPT. DTSBU103
|
|
00189 IF L103-OR-RECEIVED-DATE > L103-RPT-DUE-DATE DTSBU103
|
|
00190 SET WRK-LATE-ORIG-RPT-YES-88 TO TRUE DTSBU103
|
|
00191 END-IF. DTSBU103
|
|
00192 DTSBU103
|
|
00193 P1100-EXIT. DTSBU103
|
|
00194 EXIT. DTSBU103
|
|
00195 DTSBU103
|
|
00196 P1200-CALC-ORIG-BASE-AMT. DTSBU103
|
|
00197 IF WRK-LATE-ORIG-RPT-YES-88 DTSBU103
|
|
00198 MOVE L103-TAX-CHARGED-AMT TO WRK-BASE-AMT DTSBU103
|
|
00199 ELSE DTSBU103
|
|
00200 MOVE L103-TAX-BALANCE-AMT TO WRK-BASE-AMT DTSBU103
|
|
00201 END-IF. DTSBU103
|
|
00202 DTSBU103
|
|
00203 P1200-EXIT. DTSBU103
|
|
00204 EXIT. DTSBU103
|
|
00205 DTSBU103
|
|
00206 P1300-CALC-NSF-BASE-AMT. DTSBU103
|
|
00207 MOVE L103-TAX-BALANCE-AMT TO WRK-BASE-AMT. DTSBU103
|
|
00208 DTSBU103
|
|
00209 P1300-EXIT. DTSBU103
|
|
00210 EXIT. DTSBU103
|
|
00211 DTSBU103
|
|
00212 EJECT DTSBU103
|
|
00213 P2000-WAIVE. DTSBU103
|
|
00214 IF L103-LATE-PEN-CHARGE-CHNG > +0 DTSBU103
|
|
00215 NEXT SENTENCE DTSBU103
|
|
00216 ELSE DTSBU103
|
|
00217 GO TO P2000-EXIT. DTSBU103
|
|
00218 DTSBU103
|
|
00219 IF L103-WAIVE-LATE-PEN-YES-88 DTSBU103
|
|
00220 MOVE L103-LATE-PEN-CHARGE-CHNG DTSBU103
|
|
00221 TO L103-LATE-PEN-WAIVE-CHNG DTSBU103
|
|
00222 GO TO P2000-EXIT. DTSBU103
|
|
00223 DTSBU103
|
|
00224 IF (L103-PEN-ASSESSMENT-RUN-88) DTSBU103
|
|
00225 OR DTSBU103
|
|
00226 (L103-ORIGINAL-RPT-88) DTSBU103
|
|
00227 IF (L103-OR-RECEIVED-DATE < L103-WAIVE-PEN-START-DATE) DTSBU103
|
|
00228 OR DTSBU103
|
|
00229 (L103-OR-RECEIVED-DATE > L103-WAIVE-PEN-END-DATE) DTSBU103
|
|
00230 OR DTSBU103
|
|
00231 (L103-OR-RECEIVED-DATE = +0) DTSBU103
|
|
00232 NEXT SENTENCE DTSBU103
|
|
00233 ELSE DTSBU103
|
|
00234 MOVE L103-LATE-PEN-CHARGE-CHNG DTSBU103
|
|
00235 TO L103-LATE-PEN-WAIVE-CHNG. DTSBU103
|
|
00236 P2000-EXIT. DTSBU103
|
|
00237 EXIT. DTSBU103
|
|
00238 EJECT DTSBU103
|
|
00239 S1000-COMPUTE-PENALTY. DTSBU103
|
|
00240 *& DTSBU103
|
|
00241 DISPLAY 'DTSBU103 S1000 1 BAL ' L103-TAX-BALANCE-AMT DTSBU103
|
|
00242 ' PEN BAL ' WRK-TOT-PEN-AMT DTSBU103
|
|
00243 ' LAST QTR ' L103-LAST-LIABLE-YRQ DTSBU103
|
|
00244 ' QTR CNT ' L103-LIABLE-QTR-CNT. DTSBU103
|
|
00245 *& DTSBU103
|
|
00246 IF WRK-LATE-ORIG-RPT-YES-88 DTSBU103
|
|
00247 NEXT SENTENCE DTSBU103
|
|
00248 ELSE DTSBU103
|
|
00249 IF L103-TAX-BALANCE-AMT NOT > ZERO DTSBU103
|
|
00250 GO TO S1000-EXIT DTSBU103
|
|
00251 END-IF DTSBU103
|
|
00252 END-IF. DTSBU103
|
|
00253 DTSBU103
|
|
00254 IF PEN-CALC-FIXED-AMT-88 DTSBU103
|
|
00255 IF L103-MQTR-YRQ > L103-LAST-LIABLE-YRQ DTSBU103
|
|
00256 GO TO S1000-EXIT. DTSBU103
|
|
00257 DTSBU103
|
|
00258 IF PEN-CALC-FROM-PCT-88 DTSBU103
|
|
00259 COMPUTE L103-LATE-PEN-CHARGE-CHNG ROUNDED DTSBU103
|
|
00260 = WRK-BASE-AMT * WRK-PEN-PCT DTSBU103
|
|
00261 ELSE DTSBU103
|
|
00262 COMPUTE L103-LATE-PEN-CHARGE-CHNG = DTSBU103
|
|
00263 (1 / L103-LIABLE-QTR-CNT) * WRK-FIXED-PEN. DTSBU103
|
|
00264 DTSBU103
|
|
00265 *& DTSBU103
|
|
00266 DISPLAY 'DTSBU103 S1000 2 ' L103-MQTR-YRQ DTSBU103
|
|
00267 ' PENALTY ' L103-LATE-PEN-CHARGE-CHNG. DTSBU103
|
|
00268 *& DTSBU103
|
|
00269 ADD L103-LATE-PEN-CHARGE-CHNG TO WRK-TOT-PEN-AMT. DTSBU103
|
|
00270 DTSBU103
|
|
00271 IF PEN-CALC-FIXED-AMT-88 DTSBU103
|
|
00272 IF L103-MQTR-YRQ = L103-LAST-LIABLE-YRQ DTSBU103
|
|
00273 IF WRK-TOT-PEN-AMT < WRK-FIXED-PEN DTSBU103
|
|
00274 COMPUTE L103-LATE-PEN-CHARGE-CHNG = DTSBU103
|
|
00275 L103-LATE-PEN-CHARGE-CHNG + DTSBU103
|
|
00276 (WRK-FIXED-PEN - WRK-TOT-PEN-AMT) DTSBU103
|
|
00277 ADD L103-LATE-PEN-CHARGE-CHNG DTSBU103
|
|
00278 TO WRK-TOT-PEN-AMT. DTSBU103
|
|
00279 DTSBU103
|
|
00280 *& DTSBU103
|
|
00281 DISPLAY 'DTSBU103 S1000 3' L103-MQTR-YRQ DTSBU103
|
|
00282 ' CORRECTED PENALTY ' L103-LATE-PEN-CHARGE-CHNG. DTSBU103
|
|
00283 *& DTSBU103
|
|
00284 S1000-EXIT. DTSBU103
|
|
00285 EXIT. DTSBU103
|
|
00286 EJECT DTSBU103
|
|
00287 S999-ABEND. DTSBU103
|
|
00288 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBU103
|
|
00289 S999-EXIT. DTSBU103
|
|
00290 EXIT. DTSBU103
|