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
