355 lines
28 KiB
COBOL
355 lines
28 KiB
COBOL
00001 IDENTIFICATION DIVISION. 11/23/15
|
|
00002 PROGRAM-ID. DTSBU102. DTSBU102
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV035
|
|
00004 DATE-WRITTEN. NOVEMBER 1998 DTSBU102
|
|
00005 DATE-COMPILED. DTSBU102
|
|
00006 SKIP3 DTSBU102
|
|
00007 ***** DTSBU102
|
|
00008 * DTSBU102
|
|
00009 * FUNCTION: LATE PAYMENT PENALTY CHARGE/WAIVER CALCULATION. DTSBU102
|
|
00010 * DTSBU102
|
|
00011 * DTSBU102
|
|
00012 * MODIFICATION LOG: DTSBU102
|
|
00013 * DTSBU102
|
|
00014 * 11/14/1998 INITIAL DEVELOPMENT. DTSBU102
|
|
00015 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBU102
|
|
00016 * DTSBU102
|
|
00017 * 03/20/1999 ADDED L102-ESTIMATED-RPT-88 PROCESSING. DTSBU102
|
|
00018 * REFERENCE: DIR 059 PROGRAMMER: EHH DTSBU102
|
|
00019 * DTSBU102
|
|
00020 * 07/28/1999 PER INSTRUCTIONS FROM LYNNETTE STERN, WHEN DTSBU102
|
|
00021 * L102-ORIGINAL-RPT-88 AND REPORT RECEIVED DATE DTSBU102
|
|
00022 * IS <= REPORT DUE DATE, THEN DO NOT CHARGE DTSBU102
|
|
00023 * PENALTY. DTSBU102
|
|
00024 * REFERENCE: ORDERS FROM MS STERN PROGRAMM: EHH DTSBU102
|
|
00025 * DTSBU102
|
|
00026 * 01/28/2000 PER INSTRUCTIONS FROM GIL, WHEN L102-ORIGINAL- DTSBU102
|
|
00027 * RPT-88 AND REPORT RECEIVED DATE IS <= REPORT DTSBU102
|
|
00028 * DUE DATE, THEN CHARGE PENALTY BASED ON L102- DTSBU102
|
|
00029 * TAX-BALANCE-AMT (SEE INITIALIZATION OF L102- DTSBU102
|
|
00030 * TAX-BALANCE-AMT IN DTSBD371). DTSBU102
|
|
00031 * REFERENCE: PEN CHARGE MOD PROGRAMMER: EHH DTSBU102
|
|
00032 * DTSBU102
|
|
00033 * 05/24/2000 REVISED BASED ON REQUIREMENTS LISTED IN DTSBU102
|
|
00034 * DIR00076. DTSBU102
|
|
00035 * REFERENCE: DIR00076 PROGRAMMER: GD DTSBU102
|
|
00036 * DTSBU102
|
|
00037 * 03/17/2005 REVISED BASED ON REQUIREMENTS LISTED IN DTSBU102
|
|
00038 * DIR00107. THE NEW PROCESS WILL ASSESS PENALTY DTSBU102
|
|
00039 * FOR LATE REPORTS AS THEY ARE PROCESSED (I.E. DTSBU102
|
|
00040 * BEFORE THE BATCH PROCESS TRIGGERED WHEN THE DTSBU102
|
|
00041 * QUARTER IS DECLARED DELINQUENT. IT WILL ALSO DTSBU102
|
|
00042 * ASSESS PENALTY FOR MISSING REPORTS. DTSBU102
|
|
00043 * REFERENCE: DIR00107 PROGRAMMER: GD DTSBU102
|
|
00044 * DTSBU102
|
|
00045 * 10/14/2005 MODIFIED HANDLING OF TIMELY REPORTS. WHEN DTSBU102
|
|
00046 * PROCESSING TIMELY REPORTS ON A DAILY BASIS, DTSBU102
|
|
00047 * DTSBU102 WILL NOT ASSESS PENALTY ON ANY DTSBU102
|
|
00048 * BALANCE DUE UNLESS THE QUARTER HAS ALREADY DTSBU102
|
|
00049 * BEEN DECLARED DELINQUENT. THIS COVERS THE DTSBU102
|
|
00050 * SITUATION WHERE A REPORT IS ENTERED WITH A DTSBU102
|
|
00051 * TIMELY RECEIVED DATE AFTER THE QUARTERLY DTSBU102
|
|
00052 * PENALTY ASSESSMENT PROCESS. DTSBU102
|
|
00053 * REFERENCE: PROGRAMMER: GD DTSBU102
|
|
00054 * DTSBU102
|
|
00055 * 09/06/2007 ADDED CHECK FOR SELF-INSURED EMPLOYERS. WHEN DTSBU102
|
|
00056 * PROCESSING A TIMELY REPORT, DO NOT CHECK FOR DTSBU102
|
|
00057 * PAYMENT IN FULL DURING A DELINQUENCY RUN IF DTSBU102
|
|
00058 * THE CURRENT RUN DATE IS LESS THAN THE TAX DTSBU102
|
|
00059 * DUE DATE. DTSBU102
|
|
00060 * REFERENCE: PROGRAMMER: GD DTSBU102
|
|
00061 * DTSBU102
|
|
00062 * 07/21/2008 MODIFIED P1200: DO NOT CHARGE LATE PAYMENT DTSBU102
|
|
00063 * PENALTY IF THE BALANCE DUE IS LESS THAN $15.00. DTSBU102
|
|
00064 * 09/17/2008 CUTOFF FOR TRIGGERING PENALTY SET TO $15.00 DTSBU102
|
|
00065 * BY TAX CHIEF - DIR 117. DTSBU102
|
|
00066 * REFERENCE: PROGRAMMER: GD DTSBU102
|
|
00067 * DTSBU102
|
|
00068 * 02/13/2013 MODIFIED FOR CHANGE IN DELINQUENCY PROCESS. DTSBU102
|
|
00069 * DTSBU102
|
|
00070 * REFERENCE: TICKET 1688 PROGRAMMER: GD DTSBU102
|
|
00071 * DTSBU102
|
|
00072 * DTSBU102
|
|
00073 * 10/16/2015 MODIFIED FOR CHANGE IN PENALTY PROCESS. DTSBU102
|
|
00074 * AS OF 10/01/15 ALL TOLERANCE WAS REMOVED FROM DTSBU102
|
|
00075 * DUTAS, THEREFORE LATE PENALTY WILL BE CHARGED DTSBU102
|
|
00076 * FOR ANY AMOUNT NOT PAID. ALTHOUGH THE EMPLOYER DTSBU102
|
|
00077 * WILL STILL OWE THE PENNY OWED THE EMPLOYER SHOULD DTSBU102
|
|
00078 * NOT BE CHARGED PENALTY IF UNDERPAID BY 50.00 CL*35
|
|
00079 * CURRENT AMOUNT SET FOR TESTING IS 50.00. CL*35
|
|
00080 * IF EMPLOYER UNDERPAID UI TAX BY 50.00 NO PENALTY CL*35
|
|
00081 * WILL BE CHARGED BUT THE MONEY WILL BE OWED BY DTSBU102
|
|
00082 * EMPLOYER. DTSBU102
|
|
00083 * REFERENCE: TICKET PENALTY PROGRAMMER: ZL1 DTSBU102
|
|
00084 * DTSBU102
|
|
00085 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU102
|
|
00086 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU102
|
|
00087 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBU102
|
|
00088 * DTSBU102
|
|
00089 * DTSBU102
|
|
00090 * DESCRIPTION: DTSBU102
|
|
00091 * DTSBU102
|
|
00092 * COMPUTES LATE PAYMENT PENALTY CHARGED (PER SECTION 3.1.3.4 DTSBU102
|
|
00093 * OF THE REQUIREMENTS DOCUMENT AND COMPUTES LATE PAYMENT DTSBU102
|
|
00094 * PENALTY WAIVED (PER SECTION 3.1.4.3 OF THE REQUIREMENTS DTSBU102
|
|
00095 * DOCUMENT. DTSBU102
|
|
00096 * DTSBU102
|
|
00097 ***** DTSBU102
|
|
00098 SKIP3 DTSBU102
|
|
00099 ENVIRONMENT DIVISION. DTSBU102
|
|
00100 EJECT DTSBU102
|
|
00101 DATA DIVISION. DTSBU102
|
|
00102 SKIP3 DTSBU102
|
|
00103 WORKING-STORAGE SECTION. DTSBU102
|
|
001035 77 PAN-VALET PICTURE X(24) VALUE '035DTSBU102 11/23/15'. DTSBU102
|
|
00104 77 PAN-VALET PICTURE X(24) VALUE '007DTSBU102 11/19/15'. DTSBU102
|
|
00105 77 PAN-VALET PICTURE X(24) VALUE '032DTSBU102 06/10/13'. DTSBU102
|
|
00106 77 PAN-VALET PICTURE X(24) VALUE '002DTSBU102 06/10/13'. DTSBU102
|
|
00107 77 PAN-VALET PICTURE X(24) VALUE '030DTSBU102 04/01/13'. DTSBU102
|
|
00108 77 PAN-VALET PICTURE X(24) VALUE '010DTSBU102 02/19/13'. DTSBU102
|
|
00109 77 PAN-VALET PICTURE X(24) VALUE '028DTSBU102 12/04/08'. DTSBU102
|
|
00110 DTSBU102
|
|
00111 01 WRK-AREA. DTSBU102
|
|
00112 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +102.DTSBU102
|
|
00113 DTSBU102
|
|
00114 05 WRK-LATE-ORIG-RPT-IND PIC X(01). DTSBU102
|
|
00115 88 WRK-LATE-ORIG-RPT-YES-88 VALUE 'Y'. DTSBU102
|
|
00116 88 WRK-LATE-ORIG-RPT-NO-88 VALUE 'N'. DTSBU102
|
|
00117 DTSBU102
|
|
00118 *************************************************************** DTSBU102
|
|
00119 * NO PENALTY CHARGED FOR BALANCE LESS THAN WRK-TOLERANCE-AMT. DTSBU102
|
|
00120 *************************************************************** DTSBU102
|
|
00121 05 WRK-TOLERANCE-AMT PIC S9(09)V9(02) COMP-3 DTSBU102
|
|
00122 * VALUE +99.99. DTSBU102
|
|
00123 VALUE +50.00. DTSBU102
|
|
00124 DTSBU102
|
|
00125 *************************************************************** DTSBU102
|
|
00126 * MINIMUM PENALTY AMOUNT. DTSBU102
|
|
00127 *************************************************************** DTSBU102
|
|
00128 05 WRK-MINIMUM-PENALTY PIC S9(05)V9(02) COMP-3 DTSBU102
|
|
00129 VALUE +100.00. DTSBU102
|
|
00130 DTSBU102
|
|
00131 05 WRK-BASE-AMT PIC S9(09)V9(02) COMP-3. DTSBU102
|
|
00132 DTSBU102
|
|
00133 05 WRK-SELECTED-IND PIC X(01). DTSBU102
|
|
00134 88 WRK-SELECTED-YES-88 VALUE 'Y'. DTSBU102
|
|
00135 88 WRK-SELECTED-NO-88 VALUE 'N'. DTSBU102
|
|
00136 DTSBU102
|
|
00137 01 L120-LINK-AREA. DTSBU102
|
|
00138 ++INCLUDE DTSIL120 DTSBU102
|
|
00139 DTSBU102
|
|
00140 LINKAGE SECTION. DTSBU102
|
|
00141 SKIP3 DTSBU102
|
|
00142 01 L102-LINK-AREA. DTSBU102
|
|
00143 ++INCLUDE DTSIL102 DTSBU102
|
|
00144 EJECT DTSBU102
|
|
00145 PROCEDURE DIVISION USING L102-LINK-AREA. DTSBU102
|
|
00146 DTSBU102
|
|
00147 DTSBU102
|
|
00148 IF NOT L102-OPTION-VALID-88 DTSBU102
|
|
00149 DISPLAY '*** DTSBU102 ABENDING: INVALID OPTION ' DTSBU102
|
|
00150 L102-OPTION DTSBU102
|
|
00151 PERFORM S999-ABEND THRU S999-EXIT. DTSBU102
|
|
00152 DTSBU102
|
|
00153 PERFORM I0000-INIT THRU I0000-EXIT. DTSBU102
|
|
00154 DTSBU102
|
|
00155 DTSBU102
|
|
00156 PERFORM P1000-PEN-CHARGE THRU P1000-EXIT. DTSBU102
|
|
00157 DTSBU102
|
|
00158 DTSBU102
|
|
00159 PERFORM P2000-WAIVE THRU P2000-EXIT. DTSBU102
|
|
00160 DTSBU102
|
|
00161 DTSBU102
|
|
00162 GOBACK. DTSBU102
|
|
00163 DTSBU102
|
|
00164 I0000-INIT. DTSBU102
|
|
00165 MOVE +0 TO L102-LATE-PEN-CHARGE-CHNG DTSBU102
|
|
00166 L102-LATE-PEN-WAIVE-CHNG. DTSBU102
|
|
00167 DTSBU102
|
|
00168 MOVE L102-MQTR-YRQ TO L120-YRQ. DTSBU102
|
|
00169 CALL 'DTSBU120' USING L120-LINK-AREA. DTSBU102
|
|
00170 DTSBU102
|
|
00171 I0000-EXIT. DTSBU102
|
|
00172 EXIT. DTSBU102
|
|
00173 DTSBU102
|
|
00174 P1000-PEN-CHARGE. DTSBU102
|
|
00175 IF L102-PEN-CHARGE-MANUAL-88 DTSBU102
|
|
00176 GO TO P1000-EXIT DTSBU102
|
|
00177 END-IF. DTSBU102
|
|
00178 DTSBU102
|
|
00179 ** IF L102-CONTRIB-PEN-ASSESS-88 DTSBU102
|
|
00180 * OR L102-REIMB-PEN-ASSESS-88 DTSBU102
|
|
00181 * OR L102-DELINQUENCY-RUN-88 DTSBU102
|
|
00182 * IF L102-MQTR-YRQ > L102-LAST-PEN-ASSESSED-YRQ DTSBU102
|
|
00183 * GO TO P1000-EXIT DTSBU102
|
|
00184 * END-IF DTSBU102
|
|
00185 ** END-IF. DTSBU102
|
|
00186 DTSBU102
|
|
00187 IF L102-PEN-ASSESSMENT-RUN-88 DTSBU102
|
|
00188 OR L102-DELINQUENCY-RUN-88 DTSBU102
|
|
00189 IF L102-MQTR-YRQ > L102-LAST-PEN-ASSESSED-YRQ DTSBU102
|
|
00190 GO TO P1000-EXIT DTSBU102
|
|
00191 END-IF DTSBU102
|
|
00192 END-IF. DTSBU102
|
|
00193 DTSBU102
|
|
00194 IF L102-LATE-PEN-CHARGED-AMT > +0 DTSBU102
|
|
00195 GO TO P1000-EXIT DTSBU102
|
|
00196 END-IF. DTSBU102
|
|
00197 DTSBU102
|
|
00198 SET WRK-LATE-ORIG-RPT-NO-88 TO TRUE. DTSBU102
|
|
00199 SET WRK-SELECTED-YES-88 TO TRUE. DTSBU102
|
|
00200 MOVE ZERO TO WRK-BASE-AMT. DTSBU102
|
|
00201 DTSBU102
|
|
00202 EVALUATE TRUE DTSBU102
|
|
00203 WHEN L102-PEN-ASSESSMENT-RUN-88 DTSBU102
|
|
00204 PERFORM P1100-CHK-LATE-ORIG-RPT THRU P1100-EXIT DTSBU102
|
|
00205 PERFORM P1200-CALC-ORIG-BASE-AMT THRU P1200-EXIT DTSBU102
|
|
00206 DTSBU102
|
|
00207 WHEN L102-DELINQUENCY-RUN-88 DTSBU102
|
|
00208 IF L102-CLASS-SELF-INS-88 DTSBU102
|
|
00209 PERFORM P1200-CALC-ORIG-BASE-AMT THRU P1200-EXIT DTSBU102
|
|
00210 END-IF DTSBU102
|
|
00211 DTSBU102
|
|
00212 WHEN L102-ORIGINAL-RPT-88 DTSBU102
|
|
00213 PERFORM P1100-CHK-LATE-ORIG-RPT THRU P1100-EXIT DTSBU102
|
|
00214 PERFORM P1200-CALC-ORIG-BASE-AMT THRU P1200-EXIT DTSBU102
|
|
00215 IF WRK-LATE-ORIG-RPT-NO-88 DTSBU102
|
|
00216 IF L102-MQTR-YRQ > L102-LAST-PEN-ASSESSED-YRQ DTSBU102
|
|
00217 SET WRK-SELECTED-NO-88 TO TRUE DTSBU102
|
|
00218 END-IF DTSBU102
|
|
00219 END-IF DTSBU102
|
|
00220 DTSBU102
|
|
00221 WHEN L102-NSF-PAY-REVERSAL-88 DTSBU102
|
|
00222 IF L102-TRAN-RECEIVED-DATE > L102-TAX-DUE-DATE DTSBU102
|
|
00223 PERFORM P1300-CALC-NSF-BASE-AMT THRU P1300-EXIT DTSBU102
|
|
00224 ELSE DTSBU102
|
|
00225 SET WRK-SELECTED-NO-88 TO TRUE DTSBU102
|
|
00226 END-IF DTSBU102
|
|
00227 DTSBU102
|
|
00228 WHEN L102-ESTIMATED-RPT-88 DTSBU102
|
|
00229 MOVE L102-TAX-CHARGED-AMT TO WRK-BASE-AMT DTSBU102
|
|
00230 DTSBU102
|
|
00231 END-EVALUATE. DTSBU102
|
|
00232 DTSBU102
|
|
00233 IF WRK-SELECTED-NO-88 DTSBU102
|
|
00234 GO TO P1000-EXIT DTSBU102
|
|
00235 ELSE DTSBU102
|
|
00236 PERFORM S1000-COMPUTE-PENALTY THRU S1000-EXIT DTSBU102
|
|
00237 END-IF. DTSBU102
|
|
00238 DTSBU102
|
|
00239 P1000-EXIT. DTSBU102
|
|
00240 EXIT. DTSBU102
|
|
00241 DTSBU102
|
|
00242 P1100-CHK-LATE-ORIG-RPT. DTSBU102
|
|
00243 IF L102-OR-RECEIVED-DATE > L102-RPT-DUE-DATE DTSBU102
|
|
00244 SET WRK-LATE-ORIG-RPT-YES-88 TO TRUE DTSBU102
|
|
00245 END-IF. DTSBU102
|
|
00246 DTSBU102
|
|
00247 P1100-EXIT. DTSBU102
|
|
00248 EXIT. DTSBU102
|
|
00249 DTSBU102
|
|
00250 P1200-CALC-ORIG-BASE-AMT. DTSBU102
|
|
00251 IF L102-CLASS-SELF-INS-88 DTSBU102
|
|
00252 IF L102-TAX-DUE-DATE > L102-CURR-RUN-DATE DTSBU102
|
|
00253 MOVE ZERO TO WRK-BASE-AMT DTSBU102
|
|
00254 ELSE DTSBU102
|
|
00255 MOVE L102-TAX-BALANCE-AMT TO WRK-BASE-AMT DTSBU102
|
|
00256 ** COMPUTE WRK-BASE-AMT = DTSBU102
|
|
00257 ** (L102-TAX-CHARGED-AMT - L102-TIMELY-SI-PAY-AMT) DTSBU102
|
|
00258 END-IF DTSBU102
|
|
00259 ELSE DTSBU102
|
|
00260 IF WRK-LATE-ORIG-RPT-YES-88 DTSBU102
|
|
00261 MOVE L102-TAX-CHARGED-AMT TO WRK-BASE-AMT DTSBU102
|
|
00262 ELSE DTSBU102
|
|
00263 MOVE L102-TAX-BALANCE-AMT TO WRK-BASE-AMT DTSBU102
|
|
00264 END-IF DTSBU102
|
|
00265 END-IF. DTSBU102
|
|
00266 DTSBU102
|
|
00267 *************************************************************** DTSBU102
|
|
00268 * PREVENT CHARGING OF PENALTY FOR BALANCES OF LESS THAN $100.00. DTSBU102
|
|
00269 *************************************************************** DTSBU102
|
|
00270 IF WRK-BASE-AMT < WRK-TOLERANCE-AMT DTSBU102
|
|
00271 MOVE +0 TO WRK-BASE-AMT DTSBU102
|
|
00272 END-IF. DTSBU102
|
|
00273 DTSBU102
|
|
00274 P1200-EXIT. DTSBU102
|
|
00275 EXIT. DTSBU102
|
|
00276 DTSBU102
|
|
00277 P1300-CALC-NSF-BASE-AMT. DTSBU102
|
|
00278 IF L102-CLASS-SELF-INS-88 DTSBU102
|
|
00279 * COMPUTE WRK-BASE-AMT = DTSBU102
|
|
00280 * (L102-TAX-CHARGED-AMT - L102-TIMELY-SI-PAY-AMT) DTSBU102
|
|
00281 MOVE L102-TAX-BALANCE-AMT TO WRK-BASE-AMT DTSBU102
|
|
00282 ELSE DTSBU102
|
|
00283 MOVE L102-TAX-BALANCE-AMT TO WRK-BASE-AMT DTSBU102
|
|
00284 END-IF. DTSBU102
|
|
00285 DTSBU102
|
|
00286 *************************************************************** DTSBU102
|
|
00287 * PREVENT CHARGING OF PENALTY FOR BALANCES OF LESS THAN $99.99 DTSBU102
|
|
00288 *************************************************************** DTSBU102
|
|
00289 IF WRK-BASE-AMT < WRK-TOLERANCE-AMT DTSBU102
|
|
00290 MOVE +0 TO WRK-BASE-AMT DTSBU102
|
|
00291 END-IF. DTSBU102
|
|
00292 DTSBU102
|
|
00293 P1300-EXIT. DTSBU102
|
|
00294 EXIT. DTSBU102
|
|
00295 DTSBU102
|
|
00296 EJECT DTSBU102
|
|
00297 P2000-WAIVE. DTSBU102
|
|
00298 IF L102-LATE-PEN-CHARGE-CHNG > +0 DTSBU102
|
|
00299 NEXT SENTENCE DTSBU102
|
|
00300 ELSE DTSBU102
|
|
00301 GO TO P2000-EXIT. DTSBU102
|
|
00302 DTSBU102
|
|
00303 IF L102-WAIVE-LATE-PEN-YES-88 DTSBU102
|
|
00304 MOVE L102-LATE-PEN-CHARGE-CHNG DTSBU102
|
|
00305 TO L102-LATE-PEN-WAIVE-CHNG DTSBU102
|
|
00306 GO TO P2000-EXIT. DTSBU102
|
|
00307 DTSBU102
|
|
00308 IF (L102-PEN-ASSESSMENT-RUN-88 DTSBU102
|
|
00309 OR L102-ORIGINAL-RPT-88 DTSBU102
|
|
00310 OR L102-DELINQUENCY-RUN-88) DTSBU102
|
|
00311 IF (L102-OR-RECEIVED-DATE < L102-WAIVE-PEN-START-DATE) DTSBU102
|
|
00312 OR DTSBU102
|
|
00313 (L102-OR-RECEIVED-DATE > L102-WAIVE-PEN-END-DATE) DTSBU102
|
|
00314 OR DTSBU102
|
|
00315 (L102-OR-RECEIVED-DATE = +0) DTSBU102
|
|
00316 NEXT SENTENCE DTSBU102
|
|
00317 ELSE DTSBU102
|
|
00318 MOVE L102-LATE-PEN-CHARGE-CHNG DTSBU102
|
|
00319 TO L102-LATE-PEN-WAIVE-CHNG. DTSBU102
|
|
00320 P2000-EXIT. DTSBU102
|
|
00321 EXIT. DTSBU102
|
|
00322 EJECT DTSBU102
|
|
00323 S1000-COMPUTE-PENALTY. DTSBU102
|
|
00324 * DISPLAY 'BU102 ' MPRF-EMP-NO DTSBU102
|
|
00325 * ' ' L120-LATE-PENALTY-PCT DTSBU102
|
|
00326 * ' ' WRK-LATE-ORIG-RPT-IND DTSBU102
|
|
00327 * ' ' WRK-TOLERANCE-AMT DTSBU102
|
|
00328 * ' ' WRK-BASE-AMT. DTSBU102
|
|
00329 DTSBU102
|
|
00330 IF WRK-LATE-ORIG-RPT-YES-88 DTSBU102
|
|
00331 OR L102-DELINQUENCY-RUN-88 DTSBU102
|
|
00332 NEXT SENTENCE DTSBU102
|
|
00333 ELSE DTSBU102
|
|
00334 IF WRK-BASE-AMT NOT > ZERO DTSBU102
|
|
00335 GO TO S1000-EXIT DTSBU102
|
|
00336 END-IF DTSBU102
|
|
00337 END-IF. DTSBU102
|
|
00338 DTSBU102
|
|
00339 COMPUTE L102-LATE-PEN-CHARGE-CHNG ROUNDED DTSBU102
|
|
00340 = WRK-BASE-AMT * L120-LATE-PENALTY-PCT. DTSBU102
|
|
00341 DTSBU102
|
|
00342 IF L102-LATE-PEN-CHARGE-CHNG < WRK-MINIMUM-PENALTY DTSBU102
|
|
00343 MOVE WRK-MINIMUM-PENALTY TO L102-LATE-PEN-CHARGE-CHNG DTSBU102
|
|
00344 * MOVE ZEROS TO L102-LATE-PEN-CHARGE-CHNG DTSBU102
|
|
00345 END-IF. DTSBU102
|
|
00346 DTSBU102
|
|
00347 S1000-EXIT. DTSBU102
|
|
00348 EXIT. DTSBU102
|
|
00349 EJECT DTSBU102
|
|
00350 S999-ABEND. DTSBU102
|
|
00351 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBU102
|
|
00352 S999-EXIT. DTSBU102
|
|
00353 EXIT. DTSBU102
|