00001  IDENTIFICATION DIVISION.                                         04/30/08
00002  PROGRAM-ID.             DTSBU109.                                DTSBU109
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV012
00004  DATE-WRITTEN.           MAY 1994.                                DTSBU109
00005  DATE-COMPILED.                                                   DTSBU109
00006      SKIP3                                                        DTSBU109
00007 *****                                                             DTSBU109
00008 *                                                                 DTSBU109
00009 *    FUNCTION:  RATE LOOKUP.                                      DTSBU109
00010 *                                                                 DTSBU109
00011 * TO CHANGE RATES, MODIFY THE WORKING-STORAGE TABLE:              DTSBU109
00012 * WRK-RATE-TABLE.  THE START DATE FOR ADMIN ASSESSMENT            DTSBU109
00013 * IS STORED IN WRK-FIRST-QTR.                                     DTSBU109
00014 *                                                                 DTSBU109
00015 *    MODIFICATION LOG:                                            DTSBU109
00016 *                                                                 DTSBU109
00017 *    05/16/94  INITIAL DEVELOPMENT.                               DTSBU109
00018 *              WORK ORDER:                      PROGRAMMER: TCL   DTSBU109
00019 *                                                                 DTSBU109
00020 *    11/11/1998  REVIEWED AND MODIFIED FOR DC.  AT DEVELOPMENT    DTSBU109
00021 *                TIME SUR RATE ALWAYS EQUAL TO ZERO.  SUR TAX IS  DTSBU109
00022 *                INCORPORATED INTO THE SYSTEM IN ANTICIPATION OF  DTSBU109
00023 *                FUTURE REQUIREMENTS.                             DTSBU109
00024 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH   DTSBU109
00025 *                                                                 DTSBU109
00026 *    11/11/1998  CLONED FROM DTSCU109.                            DTSBU109
00027 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH   DTSBU109
00028 *                                                                 DTSBU109
00029 *    12/19/2005  MODIFIED FOR NEW ADMINISTRATIVE ASSESSMENT.      DTSBU109
00030 *                REFERENCE:                     PROGRAMMER: GD    DTSBU109
00031 *                                                                 DTSBU109
00032 *    02/28/2006  MODIFIED TO CHECK COMMAND CODE IN LINKAGE:       DTSBU109
00033 *                CMND = 0: RETURN FIRST QUARTER FOR WHICH         DTSBU109
00034 *                ADMIN ASSESSMENT IS EFFECTIVE.                   DTSBU109
00035 *                CMND = 1: RETURN TAX RATE FOR QUARTER            DTSBU109
00036 *                SPECIFIED.                                       DTSBU109
00037 *                REFERENCE:                     PROGRAMMER: GD    DTSBU109
00038 *                                                                 DTSBU109
00039 *    01/31/2008  MODIFIED TO ADD COMMAND CODE IN LINKAGE:         DTSBU109
00040 *                CMND = 2: RETURN FIRST PENALTY INTERESR          DTSBU109
00041 *                QUARTER (20081).                                 DTSBU109
00042 *                REFERENCE:                     PROGRAMMER: RW1   DTSBU109
00043 *                                                                 DTSBU109
00044 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBU109
00045 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBU109
00046 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSBU109
00047 *                                                                 DTSBU109
00048 *                                                                 DTSBU109
00049 *    DESCRIPTION:                                                 DTSBU109
00050 *                                                                 DTSBU109
00051 *                                                                 DTSBU109
00052 *****                                                             DTSBU109
00053      SKIP2                                                        DTSBU109
00054  ENVIRONMENT DIVISION.                                            DTSBU109
00055                                                                   DTSBU109
00056                                                                   DTSBU109
00057                                                                   DTSBU109
00058  DATA DIVISION.                                                   DTSBU109
00059                                                                   DTSBU109
00060                                                                   DTSBU109
00061                                                                   DTSBU109
00062  WORKING-STORAGE SECTION.                                         DTSBU109
000625 77  PAN-VALET PICTURE X(24) VALUE '012DTSBU109  04/30/08'.       DTSBU109
00063                                                                   DTSBU109
00064  01  WRK-AREA.                                                    DTSBU109
00065                                                                   DTSBU109
00066      05  WRK-ABEND-CODE              PIC S9(04)  COMP             DTSBU109
00067                                             VALUE +109.           DTSBU109
00068                                                                   DTSBU109
00069      05  WRK-RESP-CODE               PIC S9(08)  COMP.            DTSBU109
00070                                                                   DTSBU109
00071      05  WRK-FIRST-QTR               PIC S9(05) COMP-3            DTSBU109
00072                                       VALUE +20061.               DTSBU109
00073                                                                   DTSBU109
00074      05  WRK-FIRST-PEN-INT-YRQ       PIC S9(05) COMP-3            DTSBU109
00075                                       VALUE +20081.               DTSBU109
00076                                                                   DTSBU109
00077      05  WRK-TAX-WAGE-BASE           PIC S9(07)V99 COMP-3         DTSBU109
00078                                       VALUE +9000.                DTSBU109
00079                                                                   DTSBU109
00080      05  WRK-SURTAX-RATE             PIC S9V9(04) COMP-3.         DTSBU109
00081                                                                   DTSBU109
00082 *********************************************************         DTSBU109
00083      05  WRK-RATE-TABLE.                                          DTSBU109
00084          10  FILLER                  PIC S9(05)   COMP-3          DTSBU109
00085                                       VALUE +00000.               DTSBU109
00086          10  FILLER                  PIC S9(05)   COMP-3          DTSBU109
00087                                       VALUE +20054.               DTSBU109
00088          10  FILLER                  PIC S9V9(04) COMP-3          DTSBU109
00089                                       VALUE +0.000.               DTSBU109
00090          10  FILLER                  PIC S9(05)   COMP-3          DTSBU109
00091                                       VALUE +20061.               DTSBU109
00092          10  FILLER                  PIC S9(05)   COMP-3          DTSBU109
00093                                       VALUE +99999.               DTSBU109
00094          10  FILLER                  PIC S9V9(04) COMP-3          DTSBU109
00095                                       VALUE +0.002.               DTSBU109
00096      05  FILLER REDEFINES WRK-RATE-TABLE.                         DTSBU109
00097          10  WRK-RATE-TABLE-ENTRY  OCCURS 2 TIMES                 DTSBU109
00098                  INDEXED BY RATE-IDX.                             DTSBU109
00099              15  TAB-START-YRQ           PIC S9(05)   COMP-3.     DTSBU109
00100              15  TAB-END-YRQ             PIC S9(05)   COMP-3.     DTSBU109
00101              15  TAB-SURTAX-RATE         PIC S9V9(04) COMP-3.     DTSBU109
00102      EJECT                                                        DTSBU109
00103  LINKAGE SECTION.                                                 DTSBU109
00104      SKIP3                                                        DTSBU109
00105  01  L109-LINK-AREA.                                              DTSBU109
00106  ++INCLUDE DTSIL109                                               DTSBU109
00107      EJECT                                                        DTSBU109
00108  PROCEDURE DIVISION USING L109-LINK-AREA.                         DTSBU109
00109                                                                   DTSBU109
00110                                                                   DTSBU109
00111      PERFORM P0000-PROCESS THRU P0000-EXIT.                       DTSBU109
00112                                                                   DTSBU109
00113                                                                   DTSBU109
00114      GOBACK.                                                      DTSBU109
00115      EJECT                                                        DTSBU109
00116  P0000-PROCESS.                                                   DTSBU109
00117      IF L109-CMND-FIRST-QTR-88                                    DTSBU109
00118         PERFORM P1000-FIRST-QTR     THRU P1000-EXIT               DTSBU109
00119      ELSE                                                         DTSBU109
00120         IF L109-CMND-INPUT-QTR-88                                 DTSBU109
00121            PERFORM P2000-INPUT-QTR  THRU P2000-EXIT               DTSBU109
00122         ELSE                                                      DTSBU109
00123            IF L109-CMND-PEN-INT-QTR-88                            DTSBU109
00124               PERFORM P3000-PEN-INT-QTR THRU P3000-EXIT           DTSBU109
00125            ELSE                                                   DTSBU109
00126               DISPLAY 'DTSBU109 INVALID REQUEST '                 DTSBU109
00127                  L109-CMND-CD                                     DTSBU109
00128               PERFORM S999-ABEND        THRU S999-EXIT            DTSBU109
00129            END-IF                                                 DTSBU109
00130         END-IF                                                    DTSBU109
00131      END-IF.                                                      DTSBU109
00132                                                                   DTSBU109
00133  P0000-EXIT.                                                      DTSBU109
00134      EXIT.                                                        DTSBU109
00135      EJECT                                                        DTSBU109
00136  P1000-FIRST-QTR.                                                 DTSBU109
00137      MOVE WRK-FIRST-QTR          TO L109-YRQ.                     DTSBU109
00138      MOVE WRK-TAX-WAGE-BASE      TO L109-TAX-WAGE-BASE.           DTSBU109
00139      MOVE ZERO                   TO L109-SUR-RATE.                DTSBU109
00140                                                                   DTSBU109
00141  P1000-EXIT.                                                      DTSBU109
00142      EXIT.                                                        DTSBU109
00143                                                                   DTSBU109
00144  P2000-INPUT-QTR.                                                 DTSBU109
00145      MOVE +0         TO WRK-SURTAX-RATE.                          DTSBU109
00146                                                                   DTSBU109
00147      SET RATE-IDX TO 1.                                           DTSBU109
00148      SEARCH WRK-RATE-TABLE-ENTRY                                  DTSBU109
00149         VARYING RATE-IDX                                          DTSBU109
00150            AT END                                                 DTSBU109
00151               DISPLAY 'DTSBU109 - CANNOT FIND SURTAX RATE '       DTSBU109
00152                  L109-YRQ                                         DTSBU109
00153               PERFORM S999-ABEND  THRU S999-EXIT                  DTSBU109
00154            WHEN L109-YRQ >= TAB-START-YRQ (RATE-IDX)              DTSBU109
00155                 AND <= TAB-END-YRQ (RATE-IDX)                     DTSBU109
00156               MOVE TAB-SURTAX-RATE (RATE-IDX)                     DTSBU109
00157                  TO WRK-SURTAX-RATE                               DTSBU109
00158      END-SEARCH.                                                  DTSBU109
00159                                                                   DTSBU109
00160      IF L109-CLASS-RATED-88                                       DTSBU109
00161          PERFORM P2100-CLASS-RATED THRU P2100-EXIT                DTSBU109
00162      ELSE                                                         DTSBU109
00163      IF L109-CLASS-SELF-INS-88                                    DTSBU109
00164          PERFORM P2200-CLASS-SELF-INS THRU P2200-EXIT.            DTSBU109
00165  P2000-EXIT.                                                      DTSBU109
00166      EXIT.                                                        DTSBU109
00167                                                                   DTSBU109
00168  P2100-CLASS-RATED.                                               DTSBU109
00169      MOVE WRK-SURTAX-RATE TO L109-SUR-RATE.                       DTSBU109
00170 ***  DISPLAY 'BU109 YRQ ' L109-YRQ '  RATE ' L109-SUR-RATE.       DTSBU109
00171  P2100-EXIT.                                                      DTSBU109
00172      EXIT.                                                        DTSBU109
00173      SKIP3                                                        DTSBU109
00174  P2200-CLASS-SELF-INS.                                            DTSBU109
00175      MOVE WRK-SURTAX-RATE TO L109-SUR-RATE.                       DTSBU109
00176 ***  DISPLAY 'BU109 YRQ ' L109-YRQ '  RATE ' L109-SUR-RATE.       DTSBU109
00177  P2200-EXIT.                                                      DTSBU109
00178      EXIT.                                                        DTSBU109
00179                                                                   DTSBU109
00180  P3000-PEN-INT-QTR.                                               DTSBU109
00181      MOVE WRK-FIRST-PEN-INT-YRQ  TO L109-FIRST-PEN-INT-YRQ.       DTSBU109
00182                                                                   DTSBU109
00183  P3000-EXIT.                                                      DTSBU109
00184      EXIT.                                                        DTSBU109
00185                                                                   DTSBU109
00186  S999-ABEND.                                                      DTSBU109
00187      CALL 'DTSBU999' USING WRK-ABEND-CODE.                        DTSBU109
00188  S999-EXIT.                                                       DTSBU109
00189      EXIT.                                                        DTSBU109
