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