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