00001  IDENTIFICATION DIVISION.                                         08/13/98
00002  PROGRAM-ID.             DTSBU056.                                DTSBU056
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV002
00004  DATE-WRITTEN.           JULY 1994.                               DTSBU056
00005  DATE-COMPILED.                                                   DTSBU056
00006      SKIP3                                                        DTSBU056
00007 *****                                                             DTSBU056
00008 *                                                                 DTSBU056
00009 *    FUNCTION:  RATE DESCRIPTION.                                 DTSBU056
00010 *                                                                 DTSBU056
00011 *                                                                 DTSBU056
00012 *    MODIFICATION LOG:                                            DTSBU056
00013 *                                                                 DTSBU056
00014 *    07/12/94  CLONED FROM DTSCU056.                                 CL**2
00015 *              WORK ORDER:                      PROGRAMMER: RHC   DTSBU056
00016 *                                                                 DTSBU056
00017 *    08/16/94  NEW OPTIONS ADDED TO DISPLAY JUST 3 DIGITS TO THE  DTSBU056
00018 *              RIGHT OF THE DECIMAL POINT FOR MT TAX BUREAU USERS.DTSBU056
00019 *              WORK ORDER:RAP                   PROGRAMMER: SFW   DTSBU056
00020 *                                                                 DTSBU056
00021 *    09/11/94  NEW OPTIONS ADDED TO ALWAYS DISPLAY 2 DIGITS TO    DTSBU056
00022 *              THE RIGHT OF THE DECIMAL POINT FOR PERCENTAGES     DTSBU056
00023 *              FOR MT TAX BUREAU USERS.                           DTSBU056
00024 *              WORK ORDER:RAP                   PROGRAMMER: SFW   DTSBU056
00025 *                                                                 DTSBU056
00026 *    08/13/1998  REVIEWED AND MODIFIED FOR DC.                       CL**2
00027 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH      CL**2
00028 *                                                                    CL**2
00029 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX      CL**2
00030 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX      CL**2
00031 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX      CL**2
00032 *                                                                 DTSBU056
00033 *                                                                 DTSBU056
00034 *    DESCRIPTION:                                                 DTSBU056
00035 *                                                                 DTSBU056
00036 *    DTSBU056 IS PASSED L056-OPTION AND L056-RATE.                   CL**2
00037 *                                                                 DTSBU056
00038 *    DTSBU056 RETURNS L056-DISP-RATE (IN A FORMAT DEPENDING ON       CL**2
00039 *    L056-OPTION).                                                DTSBU056
00040 *                                                                 DTSBU056
00041 *    SEE THE COMMENTS IN DTSIL056 FOR THE FORMAT OF L056-DISP-RATE   CL**2
00042 *                                                                 DTSBU056
00043 *****                                                             DTSBU056
00044      SKIP3                                                        DTSBU056
00045  ENVIRONMENT DIVISION.                                            DTSBU056
00046      SKIP3                                                        DTSBU056
00047  DATA DIVISION.                                                   DTSBU056
00048      SKIP3                                                        DTSBU056
00049  WORKING-STORAGE SECTION.                                         DTSBU056
000495 77  PAN-VALET PICTURE X(24) VALUE '002DTSBU056  08/13/98'.       DTSBU056
00050      SKIP3                                                        DTSBU056
00051  01  WRK-AREA.                                                    DTSBU056
00052      05  WRK-ABEND-CODE              PIC S9(04)  COMP             DTSBU056
00053                                                  VALUE +056.      DTSBU056
00054      05  WRK-RESP-CODE               PIC S9(08)  COMP.            DTSBU056
00055                                                                      CL**2
00056      05  WRK-OPTION                  PIC  9(02).                  DTSBU056
00057      05  WRK-UNPACK-RATE             PIC  9(01)V9(04).            DTSBU056
00058                                                                      CL**2
00059      05  WRK-DISP-1RIGHT.                                         DTSBU056
00060          10  FILLER                  PIC  X(01).                  DTSBU056
00061          10  WRK-DISP-1LEFT-2ALL PIC X(07).                       DTSBU056
00062          10  WRK-DISP-LEFT-1P1 REDEFINES WRK-DISP-1LEFT-2ALL      DTSBU056
00063                                          PIC  9.9.                DTSBU056
00064          10  WRK-DISP-LEFT-1P2 REDEFINES WRK-DISP-1LEFT-2ALL      DTSBU056
00065                                          PIC  9.99.               DTSBU056
00066          10  WRK-DISP-LEFT-2P1 REDEFINES WRK-DISP-1LEFT-2ALL      DTSBU056
00067                                          PIC  99.9.               DTSBU056
00068          10  WRK-DISP-LEFT-2P2 REDEFINES WRK-DISP-1LEFT-2ALL      DTSBU056
00069                                          PIC  99.99.              DTSBU056
00070          10  WRK-DISP-LEFT-3P1 REDEFINES WRK-DISP-1LEFT-2ALL      DTSBU056
00071                                          PIC  999.9.              DTSBU056
00072          10  WRK-DISP-LEFT-3P2 REDEFINES WRK-DISP-1LEFT-2ALL      DTSBU056
00073                                          PIC  999.99.             DTSBU056
00074          10  WRK-DISP-RIGHT-P1 REDEFINES WRK-DISP-1LEFT-2ALL      DTSBU056
00075                                          PIC  ZZZ9.9.             DTSBU056
00076          10  WRK-DISP-RIGHT-P2 REDEFINES WRK-DISP-1LEFT-2ALL      DTSBU056
00077                                          PIC  ZZ9.99.             DTSBU056
00078                                                                      CL**2
00079      05  WRK-DISP-3ALL               PIC  X(07).                  DTSBU056
00080      05  WRK-DISP3-LEFT-0P3 REDEFINES WRK-DISP-3ALL               DTSBU056
00081                                      PIC  .999.                   DTSBU056
00082      05  WRK-DISP3-LEFT-1P3 REDEFINES WRK-DISP-3ALL               DTSBU056
00083                                      PIC  9.999.                  DTSBU056
00084      05  WRK-DISP3-RIGHT    REDEFINES WRK-DISP-3ALL               DTSBU056
00085                                      PIC  ZZZ.999.                DTSBU056
00086                                                                      CL**2
00087      05  WRK-DISP-4ALL               PIC  X(07).                  DTSBU056
00088      05  WRK-DISP4-LEFT-0P4 REDEFINES WRK-DISP-4ALL               DTSBU056
00089                                      PIC  .9999.                  DTSBU056
00090      05  WRK-DISP4-LEFT-1P4 REDEFINES WRK-DISP-4ALL               DTSBU056
00091                                      PIC  9.9999.                 DTSBU056
00092      05  WRK-DISP4-RIGHT    REDEFINES WRK-DISP-4ALL               DTSBU056
00093                                      PIC  ZZ.9999.                DTSBU056
00094      EJECT                                                        DTSBU056
00095  LINKAGE SECTION.                                                 DTSBU056
00096      SKIP3                                                        DTSBU056
00097  01  L056-LINK-AREA.                                              DTSBU056
00098  ++INCLUDE DTSIL056                                                  CL**2
00099      EJECT                                                        DTSBU056
00100  PROCEDURE DIVISION                                               DTSBU056
00101      USING L056-LINK-AREA.                                        DTSBU056
00102      SKIP2                                                        DTSBU056
00103      MOVE SPACE TO L056-DISP-RATE.                                DTSBU056
00104                                                                      CL**2
00105      IF L056-NO-RATE-88                                           DTSBU056
00106          GO TO PROCEDURE-EXIT.                                    DTSBU056
00107                                                                      CL**2
00108      MOVE SPACE TO WRK-DISP-1RIGHT                                DTSBU056
00109                    WRK-DISP-3ALL                                  DTSBU056
00110                    WRK-DISP-4ALL.                                 DTSBU056
00111      MOVE L056-RATE TO WRK-UNPACK-RATE.                           DTSBU056
00112                                                                      CL**2
00113      IF L056-OPTION NUMERIC                                       DTSBU056
00114          MOVE L056-OPTION TO WRK-OPTION                           DTSBU056
00115      ELSE                                                         DTSBU056
00116          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU056
00117                                                                      CL**2
00118      GO TO                                                        DTSBU056
00119          P1000-DISP1-LEFT                                         DTSBU056
00120          P2000-DISP1-RIGHT                                        DTSBU056
00121          P3000-DISP2-LEFT                                         DTSBU056
00122          P4000-DISP2-RIGHT                                        DTSBU056
00123          P5000-DISP3-LEFT                                         DTSBU056
00124          P6000-DISP3-RIGHT                                        DTSBU056
00125          P7000-DISP4-LEFT                                         DTSBU056
00126          P8000-DISP4-RIGHT                                        DTSBU056
00127          P9000-DISP1-LEFT-PCT                                     DTSBU056
00128          P10000-DISP1-RIGHT-PCT                                   DTSBU056
00129          P11000-DISP2-LEFT-PCT                                    DTSBU056
00130          P12000-DISP2-RIGHT-PCT                                   DTSBU056
00131        DEPENDING ON WRK-OPTION.                                   DTSBU056
00132                                                                      CL**2
00133      PERFORM S999-ABEND THRU S999-EXIT.                           DTSBU056
00134      SKIP3                                                        DTSBU056
00135  P1000-DISP1-LEFT.                                                DTSBU056
00136                                                                      CL**2
00137      IF WRK-UNPACK-RATE (5:1) = '0'                               DTSBU056
00138          IF WRK-UNPACK-RATE (1:1) = '0'                           DTSBU056
00139              IF WRK-UNPACK-RATE (2:1) = '0'                       DTSBU056
00140                  COMPUTE WRK-DISP-LEFT-1P1 = L056-RATE * 100      DTSBU056
00141              ELSE                                                 DTSBU056
00142                  COMPUTE WRK-DISP-LEFT-2P1 = L056-RATE * 100      DTSBU056
00143          ELSE                                                     DTSBU056
00144              COMPUTE WRK-DISP-LEFT-3P1 = L056-RATE * 100          DTSBU056
00145      ELSE                                                         DTSBU056
00146          IF WRK-UNPACK-RATE (1:1) = '0'                           DTSBU056
00147              IF WRK-UNPACK-RATE (2:1) = '0'                       DTSBU056
00148                  COMPUTE WRK-DISP-LEFT-1P2 = L056-RATE * 100      DTSBU056
00149              ELSE                                                 DTSBU056
00150                  COMPUTE WRK-DISP-LEFT-2P2 = L056-RATE * 100      DTSBU056
00151          ELSE                                                     DTSBU056
00152              COMPUTE WRK-DISP-LEFT-3P2 = L056-RATE * 100.         DTSBU056
00153                                                                      CL**2
00154      MOVE WRK-DISP-1LEFT-2ALL TO L056-DISP-RATE.                  DTSBU056
00155                                                                      CL**2
00156      GO TO PROCEDURE-EXIT.                                        DTSBU056
00157      SKIP3                                                        DTSBU056
00158  P2000-DISP1-RIGHT.                                               DTSBU056
00159                                                                      CL**2
00160      IF WRK-UNPACK-RATE (5:1) = '0'                               DTSBU056
00161          COMPUTE WRK-DISP-RIGHT-P1 = L056-RATE * 100              DTSBU056
00162      ELSE                                                         DTSBU056
00163          COMPUTE WRK-DISP-RIGHT-P2 = L056-RATE * 100.             DTSBU056
00164                                                                      CL**2
00165      MOVE WRK-DISP-1RIGHT TO L056-DISP-RATE.                      DTSBU056
00166                                                                      CL**2
00167      GO TO PROCEDURE-EXIT.                                        DTSBU056
00168      SKIP3                                                        DTSBU056
00169  P3000-DISP2-LEFT.                                                DTSBU056
00170                                                                      CL**2
00171      IF WRK-UNPACK-RATE (1:1) = '0'                               DTSBU056
00172          IF WRK-UNPACK-RATE (2:1) = '0'                           DTSBU056
00173              COMPUTE WRK-DISP-LEFT-1P2 = L056-RATE * 100          DTSBU056
00174          ELSE                                                     DTSBU056
00175              COMPUTE WRK-DISP-LEFT-2P2 = L056-RATE * 100          DTSBU056
00176      ELSE                                                         DTSBU056
00177          COMPUTE WRK-DISP-LEFT-3P2 = L056-RATE * 100.             DTSBU056
00178                                                                      CL**2
00179      MOVE WRK-DISP-1LEFT-2ALL TO L056-DISP-RATE.                  DTSBU056
00180                                                                      CL**2
00181      GO TO PROCEDURE-EXIT.                                        DTSBU056
00182      SKIP3                                                        DTSBU056
00183  P4000-DISP2-RIGHT.                                               DTSBU056
00184                                                                      CL**2
00185      COMPUTE WRK-DISP-RIGHT-P2 = L056-RATE * 100.                 DTSBU056
00186                                                                      CL**2
00187      MOVE WRK-DISP-1RIGHT TO L056-DISP-RATE.                      DTSBU056
00188                                                                      CL**2
00189      GO TO PROCEDURE-EXIT.                                        DTSBU056
00190      SKIP3                                                        DTSBU056
00191  P5000-DISP3-LEFT.                                                DTSBU056
00192                                                                      CL**2
00193      IF WRK-UNPACK-RATE (5:1) = '0'                               DTSBU056
00194          NEXT SENTENCE                                            DTSBU056
00195      ELSE                                                         DTSBU056
00196          GO TO P7000-DISP4-LEFT.                                  DTSBU056
00197      IF WRK-UNPACK-RATE (1:1) = '0'                               DTSBU056
00198         MOVE L056-RATE TO WRK-DISP3-LEFT-0P3                      DTSBU056
00199      ELSE                                                         DTSBU056
00200         MOVE L056-RATE TO WRK-DISP3-LEFT-1P3.                     DTSBU056
00201                                                                      CL**2
00202      MOVE WRK-DISP-3ALL TO L056-DISP-RATE.                        DTSBU056
00203                                                                      CL**2
00204      GO TO PROCEDURE-EXIT.                                        DTSBU056
00205      SKIP3                                                        DTSBU056
00206  P6000-DISP3-RIGHT.                                               DTSBU056
00207                                                                      CL**2
00208      IF WRK-UNPACK-RATE (5:1) = '0'                               DTSBU056
00209          NEXT SENTENCE                                            DTSBU056
00210      ELSE                                                         DTSBU056
00211          GO TO P8000-DISP4-RIGHT.                                 DTSBU056
00212      MOVE L056-RATE TO WRK-DISP3-RIGHT.                           DTSBU056
00213                                                                      CL**2
00214      MOVE WRK-DISP-3ALL TO L056-DISP-RATE.                        DTSBU056
00215                                                                      CL**2
00216      GO TO PROCEDURE-EXIT.                                        DTSBU056
00217      SKIP3                                                        DTSBU056
00218  P7000-DISP4-LEFT.                                                DTSBU056
00219                                                                      CL**2
00220      IF WRK-UNPACK-RATE (1:1) = '0'                               DTSBU056
00221         MOVE L056-RATE TO WRK-DISP4-LEFT-0P4                      DTSBU056
00222      ELSE                                                         DTSBU056
00223         MOVE L056-RATE TO WRK-DISP4-LEFT-1P4.                     DTSBU056
00224                                                                      CL**2
00225      MOVE WRK-DISP-4ALL TO L056-DISP-RATE.                        DTSBU056
00226                                                                      CL**2
00227      GO TO PROCEDURE-EXIT.                                        DTSBU056
00228      SKIP3                                                        DTSBU056
00229  P8000-DISP4-RIGHT.                                               DTSBU056
00230                                                                      CL**2
00231      MOVE L056-RATE TO WRK-DISP4-RIGHT.                           DTSBU056
00232                                                                      CL**2
00233      MOVE WRK-DISP-4ALL TO L056-DISP-RATE.                        DTSBU056
00234                                                                      CL**2
00235      GO TO PROCEDURE-EXIT.                                        DTSBU056
00236      SKIP3                                                        DTSBU056
00237  P9000-DISP1-LEFT-PCT.                                            DTSBU056
00238                                                                      CL**2
00239      IF WRK-UNPACK-RATE (5:1) = '0'                               DTSBU056
00240          IF WRK-UNPACK-RATE (1:1) = '0'                           DTSBU056
00241              IF WRK-UNPACK-RATE (2:1) = '0'                       DTSBU056
00242                  COMPUTE WRK-DISP-LEFT-1P1 = L056-RATE * 100      DTSBU056
00243                  MOVE '%' TO WRK-DISP-1LEFT-2ALL (4:1)            DTSBU056
00244              ELSE                                                 DTSBU056
00245                  COMPUTE WRK-DISP-LEFT-2P1 = L056-RATE * 100      DTSBU056
00246                  MOVE '%' TO WRK-DISP-1LEFT-2ALL (5:1)            DTSBU056
00247          ELSE                                                     DTSBU056
00248              COMPUTE WRK-DISP-LEFT-3P1 = L056-RATE * 100          DTSBU056
00249              MOVE '%' TO WRK-DISP-1LEFT-2ALL (6:1)                DTSBU056
00250      ELSE                                                         DTSBU056
00251          IF WRK-UNPACK-RATE (1:1) = '0'                           DTSBU056
00252              IF WRK-UNPACK-RATE (2:1) = '0'                       DTSBU056
00253                  COMPUTE WRK-DISP-LEFT-1P2 = L056-RATE * 100      DTSBU056
00254                  MOVE '%' TO WRK-DISP-1LEFT-2ALL (5:1)            DTSBU056
00255              ELSE                                                 DTSBU056
00256                  COMPUTE WRK-DISP-LEFT-2P2 = L056-RATE * 100      DTSBU056
00257                  MOVE '%' TO WRK-DISP-1LEFT-2ALL (6:1)            DTSBU056
00258          ELSE                                                     DTSBU056
00259              COMPUTE WRK-DISP-LEFT-3P2 = L056-RATE * 100          DTSBU056
00260              MOVE '%' TO WRK-DISP-1LEFT-2ALL (7:1).               DTSBU056
00261                                                                      CL**2
00262      MOVE WRK-DISP-1LEFT-2ALL TO L056-DISP-RATE.                  DTSBU056
00263                                                                      CL**2
00264      GO TO PROCEDURE-EXIT.                                        DTSBU056
00265      SKIP3                                                        DTSBU056
00266  P10000-DISP1-RIGHT-PCT.                                          DTSBU056
00267                                                                      CL**2
00268      IF WRK-UNPACK-RATE (5:1) = '0'                               DTSBU056
00269          COMPUTE WRK-DISP-RIGHT-P1 = L056-RATE * 100              DTSBU056
00270      ELSE                                                         DTSBU056
00271          COMPUTE WRK-DISP-RIGHT-P2 = L056-RATE * 100.             DTSBU056
00272                                                                      CL**2
00273      MOVE '%' TO WRK-DISP-1LEFT-2ALL (7:1).                       DTSBU056
00274                                                                      CL**2
00275      MOVE WRK-DISP-1LEFT-2ALL TO L056-DISP-RATE.                  DTSBU056
00276                                                                      CL**2
00277      GO TO PROCEDURE-EXIT.                                        DTSBU056
00278      SKIP3                                                        DTSBU056
00279  P11000-DISP2-LEFT-PCT.                                           DTSBU056
00280                                                                      CL**2
00281      IF WRK-UNPACK-RATE (1:1) = '0'                               DTSBU056
00282          IF WRK-UNPACK-RATE (2:1) = '0'                           DTSBU056
00283              COMPUTE WRK-DISP-LEFT-1P2 = L056-RATE * 100          DTSBU056
00284              MOVE '%' TO WRK-DISP-1LEFT-2ALL (5:1)                DTSBU056
00285          ELSE                                                     DTSBU056
00286              COMPUTE WRK-DISP-LEFT-2P2 = L056-RATE * 100          DTSBU056
00287              MOVE '%' TO WRK-DISP-1LEFT-2ALL (6:1)                DTSBU056
00288      ELSE                                                         DTSBU056
00289          COMPUTE WRK-DISP-LEFT-3P2 = L056-RATE * 100              DTSBU056
00290          MOVE '%' TO WRK-DISP-1LEFT-2ALL (7:1).                   DTSBU056
00291                                                                      CL**2
00292      MOVE WRK-DISP-1LEFT-2ALL TO L056-DISP-RATE.                  DTSBU056
00293                                                                      CL**2
00294      GO TO PROCEDURE-EXIT.                                        DTSBU056
00295      SKIP3                                                        DTSBU056
00296  P12000-DISP2-RIGHT-PCT.                                          DTSBU056
00297                                                                      CL**2
00298      COMPUTE WRK-DISP-RIGHT-P2 = L056-RATE * 100.                 DTSBU056
00299                                                                      CL**2
00300      MOVE '%' TO WRK-DISP-1LEFT-2ALL (7:1).                       DTSBU056
00301                                                                      CL**2
00302      MOVE WRK-DISP-1LEFT-2ALL TO L056-DISP-RATE.                  DTSBU056
00303                                                                      CL**2
00304      GO TO PROCEDURE-EXIT.                                        DTSBU056
00305      SKIP3                                                        DTSBU056
00306  PROCEDURE-EXIT.                                                  DTSBU056
00307      SKIP2                                                        DTSBU056
00308      GOBACK.                                                      DTSBU056
00309      SKIP3                                                        DTSBU056
00310  S999-ABEND.                                                      DTSBU056
00311                                                                      CL**2
00312      CALL 'DTSBU999'                                                 CL**2
00313          USING WRK-ABEND-CODE.                                    DTSBU056
00314                                                                      CL**2
00315  S999-EXIT.                                                       DTSBU056
00316      EXIT.                                                        DTSBU056
