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