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