592 lines
47 KiB
COBOL
592 lines
47 KiB
COBOL
00001 IDENTIFICATION DIVISION. 08/19/13
|
|
00002 PROGRAM-ID. DTSBU032. DTSBU032
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV009
|
|
00004 DATE-WRITTEN. JULY 1994. DTSBU032
|
|
00005 DATE-COMPILED. DTSBU032
|
|
00006 SKIP3 DTSBU032
|
|
00007 ***** DTSBU032
|
|
00008 * DTSBU032
|
|
00009 * FUNCTION: ACCOUNTING CODES EDIT/DESCRIPTION. DTSBU032
|
|
00010 * DTSBU032
|
|
00011 * DTSBU032
|
|
00012 * MODIFICATION LOG: DTSBU032
|
|
00013 * DTSBU032
|
|
00014 * 07/12/94 CLONED FROM DTSCU032. DTSBU032
|
|
00015 * WORK ORDER: PROGRAMMER: RHC DTSBU032
|
|
00016 * DTSBU032
|
|
00017 * 11/05/1998 REVIEWED AND MODIFIED FOR DC. DTSBU032
|
|
00018 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBU032
|
|
00019 * DTSBU032
|
|
00020 * 05/27/1999 RECOMPILED DUE TO PICKUP MODIFICATIONS TO DTSBU032
|
|
00021 * DTSIC032. DTSBU032
|
|
00022 * REFERENCE: PICKUP DIR PROGRAMMER: EHH DTSBU032
|
|
00023 * DTSBU032
|
|
00024 * 07/12/2007 RECOMPILED - ADDED "ANNUAL NOT LIABLE" TO DTSBU032
|
|
00025 * DTSIC032. DTSBU032
|
|
00026 * REFERENCE: PROGRAMMER: GD DTSBU032
|
|
00027 * DTSBU032
|
|
00028 * 03/09/2011 RECOMPILED FOR NP AND NR PAYMENT TYPES FOR DTSBU032
|
|
00029 * NON-DOES CHECKS. DTSBU032
|
|
00030 * REFERENCE: PROGRAMMER: GD DTSBU032
|
|
00031 * DTSBU032
|
|
00032 * 09/27/2012 RECOMPILED FOR CW AND CZ REPORT TYPES DTSBU032
|
|
00033 * REFERENCE: PROGRAMMER: GD DTSBU032
|
|
00034 * DTSBU032
|
|
00035 * 07/26/2013 RECOMPILED FOR SUTA DUMPING PAYMENT TYPE DTSBU032
|
|
00036 * REFERENCE: TICKET 1969 PROGRAMMER: GD DTSBU032
|
|
00037 * DTSBU032
|
|
00038 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU032
|
|
00039 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU032
|
|
00040 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBU032
|
|
00041 * DTSBU032
|
|
00042 * DTSBU032
|
|
00043 * DESCRIPTION: DTSBU032
|
|
00044 * DTSBU032
|
|
00045 * DTSBU032 EDITS ACCOUNTING CODES AND INDICATORS. DTSBU032
|
|
00046 * DTSBU032
|
|
00047 * DTSBU032 RETURNS A RESULT INDICATOR, A SHORT DESCRIPTION DTSBU032
|
|
00048 * OF THE CODE VALUE, AND A LONG DESCRIPTION OF THE CODE DTSBU032
|
|
00049 * VALUE. DTSBU032
|
|
00050 * DTSBU032
|
|
00051 * IF L032-OPTION IS NOT VALID, THEN ABEND THE TASK WITH AN DTSBU032
|
|
00052 * ABEND CODE OF 'U032'. DTSBU032
|
|
00053 * DTSBU032
|
|
00054 * GO TO DEPENDING ON L032-OPTION TO GET TO THE PARAGRAPH DTSBU032
|
|
00055 * THAT CARRIES OUT EDITING FOR THE DATA ELEMENT SPECIFIED DTSBU032
|
|
00056 * BY L032-OPTION. USE A SEARCH STATEMENT TO DETERMINE THE DTSBU032
|
|
00057 * VALIDITY OF L032-CD-*. DTSBU032
|
|
00058 * DTSBU032
|
|
00059 * IF L032-CD-* IS A VALID VALUE DTSBU032
|
|
00060 * MOVE '1' TO L032-RESULT-IND DTSBU032
|
|
00061 * MOVE THE APPROPRIATE C032-*-SHORT-DSCR DTSBU032
|
|
00062 * TO L032-SHORT-DSCR DTSBU032
|
|
00063 * MOVE THE APPROPRIATE C032-*-LONG-DSCR DTSBU032
|
|
00064 * TO L032-LONG-DSCR DTSBU032
|
|
00065 * ELSE DTSBU032
|
|
00066 * MOVE '2' TO L032-RESULT-IND DTSBU032
|
|
00067 * MOVE 'NOT VALID' TO L032-SHORT-DSCR DTSBU032
|
|
00068 * L032-LONG-DSCR. DTSBU032
|
|
00069 * DTSBU032
|
|
00070 ***** DTSBU032
|
|
00071 SKIP3 DTSBU032
|
|
00072 ENVIRONMENT DIVISION. DTSBU032
|
|
00073 SKIP3 DTSBU032
|
|
00074 DATA DIVISION. DTSBU032
|
|
00075 SKIP3 DTSBU032
|
|
00076 WORKING-STORAGE SECTION. DTSBU032
|
|
000765 77 PAN-VALET PICTURE X(24) VALUE '009DTSBU032 08/19/13'. DTSBU032
|
|
00077 77 PAN-VALET PICTURE X(24) VALUE '002DTSBU032 07/26/13'. DTSBU032
|
|
00078 77 PAN-VALET PICTURE X(24) VALUE '007DTSBU032 05/20/13'. DTSBU032
|
|
00079 77 PAN-VALET PICTURE X(24) VALUE '002DTSBU032 09/27/12'. DTSBU032
|
|
00080 77 PAN-VALET PICTURE X(24) VALUE '001DTSBU032 04/12/11'. DTSBU032
|
|
00081 SKIP3 DTSBU032
|
|
00082 01 WRK-AREA. DTSBU032
|
|
00083 05 WRK-ABEND-CD PIC S9(04) COMP DTSBU032
|
|
00084 VALUE +032. DTSBU032
|
|
00085 DTSBU032
|
|
00086 05 WRK-RESP-CODE PIC S9(08) COMP. DTSBU032
|
|
00087 EJECT DTSBU032
|
|
00088 01 C032-LITERALS. DTSBU032
|
|
00089 ++INCLUDE DTSIC032 DTSBU032
|
|
00090 EJECT DTSBU032
|
|
00091 LINKAGE SECTION. DTSBU032
|
|
00092 SKIP3 DTSBU032
|
|
00093 01 L032-COMMAREA. DTSBU032
|
|
00094 ++INCLUDE DTSIL032 DTSBU032
|
|
00095 EJECT DTSBU032
|
|
00096 PROCEDURE DIVISION DTSBU032
|
|
00097 USING L032-COMMAREA. DTSBU032
|
|
00098 DTSBU032
|
|
00099 DTSBU032
|
|
00100 SET L032-NOT-VALID TO TRUE. DTSBU032
|
|
00101 DTSBU032
|
|
00102 MOVE 'NOT VALID' TO L032-SHORT-DSCR DTSBU032
|
|
00103 L032-LONG-DSCR. DTSBU032
|
|
00104 DTSBU032
|
|
00105 PERFORM P1000-PROCESS THRU P1000-EXIT. DTSBU032
|
|
00106 DTSBU032
|
|
00107 DTSBU032
|
|
00108 GOBACK. DTSBU032
|
|
00109 EJECT DTSBU032
|
|
00110 P1000-PROCESS. DTSBU032
|
|
00111 GO TO P1000-01 DTSBU032
|
|
00112 P1000-02 DTSBU032
|
|
00113 P1000-03 DTSBU032
|
|
00114 P1000-04 DTSBU032
|
|
00115 P1000-05 DTSBU032
|
|
00116 P1000-06 DTSBU032
|
|
00117 S999-ABEND DTSBU032
|
|
00118 S999-ABEND DTSBU032
|
|
00119 S999-ABEND DTSBU032
|
|
00120 S999-ABEND DTSBU032
|
|
00121 P1000-11 DTSBU032
|
|
00122 P1000-12 DTSBU032
|
|
00123 S999-ABEND DTSBU032
|
|
00124 S999-ABEND DTSBU032
|
|
00125 S999-ABEND DTSBU032
|
|
00126 P1000-16 DTSBU032
|
|
00127 P1000-17 DTSBU032
|
|
00128 S999-ABEND DTSBU032
|
|
00129 S999-ABEND DTSBU032
|
|
00130 S999-ABEND DTSBU032
|
|
00131 P1000-21 DTSBU032
|
|
00132 P1000-22 DTSBU032
|
|
00133 P1000-23 DTSBU032
|
|
00134 P1000-24 DTSBU032
|
|
00135 P1000-25 DTSBU032
|
|
00136 P1000-26 DTSBU032
|
|
00137 P1000-27 DTSBU032
|
|
00138 P1000-28 DTSBU032
|
|
00139 S999-ABEND DTSBU032
|
|
00140 S999-ABEND DTSBU032
|
|
00141 P1000-31 DTSBU032
|
|
00142 P1000-32 DTSBU032
|
|
00143 P1000-33 DTSBU032
|
|
00144 P1000-34 DTSBU032
|
|
00145 S999-ABEND DTSBU032
|
|
00146 P1000-36 DTSBU032
|
|
00147 P1000-37 DTSBU032
|
|
00148 S999-ABEND DTSBU032
|
|
00149 S999-ABEND DTSBU032
|
|
00150 S999-ABEND DTSBU032
|
|
00151 P1000-41 DTSBU032
|
|
00152 P1000-42 DTSBU032
|
|
00153 P1000-43 DTSBU032
|
|
00154 P1000-44 DTSBU032
|
|
00155 P1000-45 DTSBU032
|
|
00156 P1000-46 DTSBU032
|
|
00157 DEPENDING ON L032-OPTION. DTSBU032
|
|
00158 DTSBU032
|
|
00159 PERFORM S999-ABEND THRU S999-EXIT. DTSBU032
|
|
00160 SKIP3 DTSBU032
|
|
00161 P1000-01. DTSBU032
|
|
00162 SET C032-01-IDX TO 1. DTSBU032
|
|
00163 SEARCH C032-01-ENTRY DTSBU032
|
|
00164 VARYING DTSBU032
|
|
00165 C032-01-IDX DTSBU032
|
|
00166 WHEN L032-CD-1 = C032-01-CD (C032-01-IDX) DTSBU032
|
|
00167 MOVE '1' TO L032-RESULT-IND DTSBU032
|
|
00168 MOVE C032-01-SHORT-DSCR (C032-01-IDX) DTSBU032
|
|
00169 TO L032-SHORT-DSCR DTSBU032
|
|
00170 MOVE C032-01-LONG-DSCR (C032-01-IDX) DTSBU032
|
|
00171 TO L032-LONG-DSCR. DTSBU032
|
|
00172 DTSBU032
|
|
00173 GO TO P1000-EXIT. DTSBU032
|
|
00174 SKIP3 DTSBU032
|
|
00175 P1000-02. DTSBU032
|
|
00176 SET C032-02-IDX TO 1. DTSBU032
|
|
00177 SEARCH C032-02-ENTRY DTSBU032
|
|
00178 VARYING DTSBU032
|
|
00179 C032-02-IDX DTSBU032
|
|
00180 WHEN L032-CD-1 = C032-02-CD (C032-02-IDX) DTSBU032
|
|
00181 MOVE '1' TO L032-RESULT-IND DTSBU032
|
|
00182 MOVE C032-02-SHORT-DSCR (C032-02-IDX) DTSBU032
|
|
00183 TO L032-SHORT-DSCR DTSBU032
|
|
00184 MOVE C032-02-LONG-DSCR (C032-02-IDX) DTSBU032
|
|
00185 TO L032-LONG-DSCR. DTSBU032
|
|
00186 DTSBU032
|
|
00187 GO TO P1000-EXIT. DTSBU032
|
|
00188 SKIP3 DTSBU032
|
|
00189 P1000-03. DTSBU032
|
|
00190 SET C032-03-IDX TO 1. DTSBU032
|
|
00191 SEARCH C032-03-ENTRY DTSBU032
|
|
00192 VARYING DTSBU032
|
|
00193 C032-03-IDX DTSBU032
|
|
00194 WHEN L032-CD-1 = C032-03-CD (C032-03-IDX) DTSBU032
|
|
00195 MOVE '1' TO L032-RESULT-IND DTSBU032
|
|
00196 MOVE C032-03-SHORT-DSCR (C032-03-IDX) DTSBU032
|
|
00197 TO L032-SHORT-DSCR DTSBU032
|
|
00198 MOVE C032-03-LONG-DSCR (C032-03-IDX) DTSBU032
|
|
00199 TO L032-LONG-DSCR. DTSBU032
|
|
00200 DTSBU032
|
|
00201 GO TO P1000-EXIT. DTSBU032
|
|
00202 SKIP3 DTSBU032
|
|
00203 P1000-04. DTSBU032
|
|
00204 SET C032-04-IDX TO 1. DTSBU032
|
|
00205 SEARCH C032-04-ENTRY DTSBU032
|
|
00206 VARYING DTSBU032
|
|
00207 C032-04-IDX DTSBU032
|
|
00208 WHEN L032-CD-1 = C032-04-CD (C032-04-IDX) DTSBU032
|
|
00209 MOVE '1' TO L032-RESULT-IND DTSBU032
|
|
00210 MOVE C032-04-SHORT-DSCR (C032-04-IDX) DTSBU032
|
|
00211 TO L032-SHORT-DSCR DTSBU032
|
|
00212 MOVE C032-04-LONG-DSCR (C032-04-IDX) DTSBU032
|
|
00213 TO L032-LONG-DSCR. DTSBU032
|
|
00214 DTSBU032
|
|
00215 GO TO P1000-EXIT. DTSBU032
|
|
00216 SKIP3 DTSBU032
|
|
00217 P1000-05. DTSBU032
|
|
00218 SET C032-05-IDX TO 1. DTSBU032
|
|
00219 SEARCH C032-05-ENTRY DTSBU032
|
|
00220 VARYING DTSBU032
|
|
00221 C032-05-IDX DTSBU032
|
|
00222 WHEN L032-CD-1 = C032-05-CD (C032-05-IDX) DTSBU032
|
|
00223 MOVE '1' TO L032-RESULT-IND DTSBU032
|
|
00224 MOVE C032-05-SHORT-DSCR (C032-05-IDX) DTSBU032
|
|
00225 TO L032-SHORT-DSCR DTSBU032
|
|
00226 MOVE C032-05-LONG-DSCR (C032-05-IDX) DTSBU032
|
|
00227 TO L032-LONG-DSCR. DTSBU032
|
|
00228 DTSBU032
|
|
00229 GO TO P1000-EXIT. DTSBU032
|
|
00230 SKIP3 DTSBU032
|
|
00231 P1000-06. DTSBU032
|
|
00232 SET C032-06-IDX TO 1. DTSBU032
|
|
00233 SEARCH C032-06-ENTRY DTSBU032
|
|
00234 VARYING DTSBU032
|
|
00235 C032-06-IDX DTSBU032
|
|
00236 WHEN L032-CD-1 = C032-06-CD (C032-06-IDX) DTSBU032
|
|
00237 MOVE '1' TO L032-RESULT-IND DTSBU032
|
|
00238 MOVE C032-06-SHORT-DSCR (C032-06-IDX) DTSBU032
|
|
00239 TO L032-SHORT-DSCR DTSBU032
|
|
00240 MOVE C032-06-LONG-DSCR (C032-06-IDX) DTSBU032
|
|
00241 TO L032-LONG-DSCR. DTSBU032
|
|
00242 DTSBU032
|
|
00243 GO TO P1000-EXIT. DTSBU032
|
|
00244 SKIP3 DTSBU032
|
|
00245 P1000-11. DTSBU032
|
|
00246 SET C032-11-IDX TO 1. DTSBU032
|
|
00247 SEARCH C032-11-ENTRY DTSBU032
|
|
00248 VARYING DTSBU032
|
|
00249 C032-11-IDX DTSBU032
|
|
00250 WHEN L032-CD-2 = C032-11-CD (C032-11-IDX) DTSBU032
|
|
00251 MOVE '1' TO L032-RESULT-IND DTSBU032
|
|
00252 MOVE C032-11-SHORT-DSCR (C032-11-IDX) DTSBU032
|
|
00253 TO L032-SHORT-DSCR DTSBU032
|
|
00254 MOVE C032-11-LONG-DSCR (C032-11-IDX) DTSBU032
|
|
00255 TO L032-LONG-DSCR. DTSBU032
|
|
00256 DTSBU032
|
|
00257 GO TO P1000-EXIT. DTSBU032
|
|
00258 SKIP3 DTSBU032
|
|
00259 P1000-12. DTSBU032
|
|
00260 SET C032-12-IDX TO 1. DTSBU032
|
|
00261 SEARCH C032-12-ENTRY DTSBU032
|
|
00262 VARYING DTSBU032
|
|
00263 C032-12-IDX DTSBU032
|
|
00264 WHEN L032-CD-2 = C032-12-CD (C032-12-IDX) DTSBU032
|
|
00265 MOVE '1' TO L032-RESULT-IND DTSBU032
|
|
00266 MOVE C032-12-SHORT-DSCR (C032-12-IDX) DTSBU032
|
|
00267 TO L032-SHORT-DSCR DTSBU032
|
|
00268 MOVE C032-12-LONG-DSCR (C032-12-IDX) DTSBU032
|
|
00269 TO L032-LONG-DSCR. DTSBU032
|
|
00270 DTSBU032
|
|
00271 GO TO P1000-EXIT. DTSBU032
|
|
00272 SKIP3 DTSBU032
|
|
00273 P1000-16. DTSBU032
|
|
00274 SET C032-16-IDX TO 1. DTSBU032
|
|
00275 SEARCH C032-16-ENTRY DTSBU032
|
|
00276 VARYING DTSBU032
|
|
00277 C032-16-IDX DTSBU032
|
|
00278 WHEN L032-CD-2 = C032-16-CD (C032-16-IDX) DTSBU032
|
|
00279 MOVE '1' TO L032-RESULT-IND DTSBU032
|
|
00280 MOVE C032-16-SHORT-DSCR (C032-16-IDX) DTSBU032
|
|
00281 TO L032-SHORT-DSCR DTSBU032
|
|
00282 MOVE C032-16-LONG-DSCR (C032-16-IDX) DTSBU032
|
|
00283 TO L032-LONG-DSCR. DTSBU032
|
|
00284 DTSBU032
|
|
00285 GO TO P1000-EXIT. DTSBU032
|
|
00286 SKIP3 DTSBU032
|
|
00287 P1000-17. DTSBU032
|
|
00288 SET C032-17-IDX TO 1. DTSBU032
|
|
00289 SEARCH C032-17-ENTRY DTSBU032
|
|
00290 VARYING DTSBU032
|
|
00291 C032-17-IDX DTSBU032
|
|
00292 WHEN L032-CD-1 = C032-17-CD (C032-17-IDX) DTSBU032
|
|
00293 MOVE '1' TO L032-RESULT-IND DTSBU032
|
|
00294 MOVE C032-17-SHORT-DSCR (C032-17-IDX) DTSBU032
|
|
00295 TO L032-SHORT-DSCR DTSBU032
|
|
00296 MOVE C032-17-LONG-DSCR (C032-17-IDX) DTSBU032
|
|
00297 TO L032-LONG-DSCR. DTSBU032
|
|
00298 DTSBU032
|
|
00299 GO TO P1000-EXIT. DTSBU032
|
|
00300 SKIP3 DTSBU032
|
|
00301 P1000-21. DTSBU032
|
|
00302 SET C032-21-22-IDX TO 1. DTSBU032
|
|
00303 SEARCH C032-21-22-ENTRY DTSBU032
|
|
00304 VARYING DTSBU032
|
|
00305 C032-21-22-IDX DTSBU032
|
|
00306 WHEN L032-CD-2 = C032-21-22-CD (C032-21-22-IDX) DTSBU032
|
|
00307 MOVE '1' TO L032-RESULT-IND DTSBU032
|
|
00308 MOVE C032-21-22-SHORT-DSCR (C032-21-22-IDX) DTSBU032
|
|
00309 TO L032-SHORT-DSCR DTSBU032
|
|
00310 MOVE C032-21-22-LONG-DSCR (C032-21-22-IDX) DTSBU032
|
|
00311 TO L032-LONG-DSCR. DTSBU032
|
|
00312 DTSBU032
|
|
00313 GO TO P1000-EXIT. DTSBU032
|
|
00314 SKIP3 DTSBU032
|
|
00315 P1000-22. DTSBU032
|
|
00316 SET C032-21-22-IDX TO 1. DTSBU032
|
|
00317 SEARCH C032-21-22-ENTRY DTSBU032
|
|
00318 VARYING DTSBU032
|
|
00319 C032-21-22-IDX DTSBU032
|
|
00320 WHEN L032-CD-2 = C032-21-22-CD (C032-21-22-IDX) DTSBU032
|
|
00321 MOVE '1' TO L032-RESULT-IND DTSBU032
|
|
00322 MOVE C032-21-22-SHORT-DSCR (C032-21-22-IDX) DTSBU032
|
|
00323 TO L032-SHORT-DSCR DTSBU032
|
|
00324 MOVE C032-21-22-LONG-DSCR (C032-21-22-IDX) DTSBU032
|
|
00325 TO L032-LONG-DSCR. DTSBU032
|
|
00326 DTSBU032
|
|
00327 GO TO P1000-EXIT. DTSBU032
|
|
00328 SKIP3 DTSBU032
|
|
00329 P1000-23. DTSBU032
|
|
00330 SET C032-23-IDX TO 1. DTSBU032
|
|
00331 SEARCH C032-23-ENTRY DTSBU032
|
|
00332 VARYING DTSBU032
|
|
00333 C032-23-IDX DTSBU032
|
|
00334 WHEN L032-CD-2 = C032-23-CD (C032-23-IDX) DTSBU032
|
|
00335 MOVE '1' TO L032-RESULT-IND DTSBU032
|
|
00336 MOVE C032-23-SHORT-DSCR (C032-23-IDX) DTSBU032
|
|
00337 TO L032-SHORT-DSCR DTSBU032
|
|
00338 MOVE C032-23-LONG-DSCR (C032-23-IDX) DTSBU032
|
|
00339 TO L032-LONG-DSCR. DTSBU032
|
|
00340 DTSBU032
|
|
00341 GO TO P1000-EXIT. DTSBU032
|
|
00342 SKIP3 DTSBU032
|
|
00343 P1000-24. DTSBU032
|
|
00344 SET C032-24-IDX TO 1. DTSBU032
|
|
00345 SEARCH C032-24-ENTRY DTSBU032
|
|
00346 VARYING DTSBU032
|
|
00347 C032-24-IDX DTSBU032
|
|
00348 WHEN L032-CD-2 = C032-24-CD (C032-24-IDX) DTSBU032
|
|
00349 MOVE '1' TO L032-RESULT-IND DTSBU032
|
|
00350 MOVE C032-24-SHORT-DSCR (C032-24-IDX) DTSBU032
|
|
00351 TO L032-SHORT-DSCR DTSBU032
|
|
00352 MOVE C032-24-LONG-DSCR (C032-24-IDX) DTSBU032
|
|
00353 TO L032-LONG-DSCR. DTSBU032
|
|
00354 DTSBU032
|
|
00355 GO TO P1000-EXIT. DTSBU032
|
|
00356 SKIP3 DTSBU032
|
|
00357 P1000-25. DTSBU032
|
|
00358 SET C032-25-26-IDX TO 1. DTSBU032
|
|
00359 SEARCH C032-25-26-ENTRY DTSBU032
|
|
00360 VARYING DTSBU032
|
|
00361 C032-25-26-IDX DTSBU032
|
|
00362 WHEN L032-CD-2 = C032-25-26-CD (C032-25-26-IDX) DTSBU032
|
|
00363 MOVE '1' TO L032-RESULT-IND DTSBU032
|
|
00364 MOVE C032-25-26-SHORT-DSCR (C032-25-26-IDX) DTSBU032
|
|
00365 TO L032-SHORT-DSCR DTSBU032
|
|
00366 MOVE C032-25-26-LONG-DSCR (C032-25-26-IDX) DTSBU032
|
|
00367 TO L032-LONG-DSCR. DTSBU032
|
|
00368 DTSBU032
|
|
00369 GO TO P1000-EXIT. DTSBU032
|
|
00370 SKIP3 DTSBU032
|
|
00371 P1000-26. DTSBU032
|
|
00372 SET C032-25-26-IDX TO 1. DTSBU032
|
|
00373 SEARCH C032-25-26-ENTRY DTSBU032
|
|
00374 VARYING DTSBU032
|
|
00375 C032-25-26-IDX DTSBU032
|
|
00376 WHEN L032-CD-2 = C032-25-26-CD (C032-25-26-IDX) DTSBU032
|
|
00377 MOVE '1' TO L032-RESULT-IND DTSBU032
|
|
00378 MOVE C032-25-26-SHORT-DSCR (C032-25-26-IDX) DTSBU032
|
|
00379 TO L032-SHORT-DSCR DTSBU032
|
|
00380 MOVE C032-25-26-LONG-DSCR (C032-25-26-IDX) DTSBU032
|
|
00381 TO L032-LONG-DSCR. DTSBU032
|
|
00382 DTSBU032
|
|
00383 GO TO P1000-EXIT. DTSBU032
|
|
00384 SKIP3 DTSBU032
|
|
00385 P1000-27. DTSBU032
|
|
00386 SET C032-27-28-IDX TO 1. DTSBU032
|
|
00387 SEARCH C032-27-28-ENTRY DTSBU032
|
|
00388 VARYING DTSBU032
|
|
00389 C032-27-28-IDX DTSBU032
|
|
00390 WHEN L032-CD-2 = C032-27-28-CD (C032-27-28-IDX) DTSBU032
|
|
00391 MOVE '1' TO L032-RESULT-IND DTSBU032
|
|
00392 MOVE C032-27-28-SHORT-DSCR (C032-27-28-IDX) DTSBU032
|
|
00393 TO L032-SHORT-DSCR DTSBU032
|
|
00394 MOVE C032-27-28-LONG-DSCR (C032-27-28-IDX) DTSBU032
|
|
00395 TO L032-LONG-DSCR. DTSBU032
|
|
00396 DTSBU032
|
|
00397 GO TO P1000-EXIT. DTSBU032
|
|
00398 SKIP3 DTSBU032
|
|
00399 P1000-28. DTSBU032
|
|
00400 SET C032-27-28-IDX TO 1. DTSBU032
|
|
00401 SEARCH C032-27-28-ENTRY DTSBU032
|
|
00402 VARYING DTSBU032
|
|
00403 C032-27-28-IDX DTSBU032
|
|
00404 WHEN L032-CD-2 = C032-27-28-CD (C032-27-28-IDX) DTSBU032
|
|
00405 MOVE '1' TO L032-RESULT-IND DTSBU032
|
|
00406 MOVE C032-27-28-SHORT-DSCR (C032-27-28-IDX) DTSBU032
|
|
00407 TO L032-SHORT-DSCR DTSBU032
|
|
00408 MOVE C032-27-28-LONG-DSCR (C032-27-28-IDX) DTSBU032
|
|
00409 TO L032-LONG-DSCR. DTSBU032
|
|
00410 DTSBU032
|
|
00411 GO TO P1000-EXIT. DTSBU032
|
|
00412 SKIP3 DTSBU032
|
|
00413 P1000-31. DTSBU032
|
|
00414 SET C032-31--36-IDX TO 1. DTSBU032
|
|
00415 SEARCH C032-31--36-ENTRY DTSBU032
|
|
00416 VARYING DTSBU032
|
|
00417 C032-31--36-IDX DTSBU032
|
|
00418 WHEN L032-CD-2 = C032-31--36-CD (C032-31--36-IDX) DTSBU032
|
|
00419 MOVE '1' TO L032-RESULT-IND DTSBU032
|
|
00420 MOVE C032-31--36-SHORT-DSCR (C032-31--36-IDX) DTSBU032
|
|
00421 TO L032-SHORT-DSCR DTSBU032
|
|
00422 MOVE C032-31--36-LONG-DSCR (C032-31--36-IDX) DTSBU032
|
|
00423 TO L032-LONG-DSCR. DTSBU032
|
|
00424 DTSBU032
|
|
00425 GO TO P1000-EXIT. DTSBU032
|
|
00426 SKIP3 DTSBU032
|
|
00427 P1000-32. DTSBU032
|
|
00428 SET C032-31--36-IDX TO 1. DTSBU032
|
|
00429 SEARCH C032-31--36-ENTRY DTSBU032
|
|
00430 VARYING DTSBU032
|
|
00431 C032-31--36-IDX DTSBU032
|
|
00432 WHEN L032-CD-2 = C032-31--36-CD (C032-31--36-IDX) DTSBU032
|
|
00433 MOVE '1' TO L032-RESULT-IND DTSBU032
|
|
00434 MOVE C032-31--36-SHORT-DSCR (C032-31--36-IDX) DTSBU032
|
|
00435 TO L032-SHORT-DSCR DTSBU032
|
|
00436 MOVE C032-31--36-LONG-DSCR (C032-31--36-IDX) DTSBU032
|
|
00437 TO L032-LONG-DSCR. DTSBU032
|
|
00438 DTSBU032
|
|
00439 GO TO P1000-EXIT. DTSBU032
|
|
00440 SKIP3 DTSBU032
|
|
00441 P1000-33. DTSBU032
|
|
00442 SET C032-33--34-IDX TO 1. DTSBU032
|
|
00443 SEARCH C032-33--34-ENTRY DTSBU032
|
|
00444 VARYING DTSBU032
|
|
00445 C032-33--34-IDX DTSBU032
|
|
00446 WHEN L032-CD-2 = C032-33--34-CD (C032-33--34-IDX) DTSBU032
|
|
00447 MOVE '1' TO L032-RESULT-IND DTSBU032
|
|
00448 MOVE C032-33--34-SHORT-DSCR (C032-33--34-IDX) DTSBU032
|
|
00449 TO L032-SHORT-DSCR DTSBU032
|
|
00450 MOVE C032-33--34-LONG-DSCR (C032-33--34-IDX) DTSBU032
|
|
00451 TO L032-LONG-DSCR. DTSBU032
|
|
00452 DTSBU032
|
|
00453 GO TO P1000-EXIT. DTSBU032
|
|
00454 SKIP3 DTSBU032
|
|
00455 P1000-34. DTSBU032
|
|
00456 SET C032-33--34-IDX TO 1. DTSBU032
|
|
00457 SEARCH C032-33--34-ENTRY DTSBU032
|
|
00458 VARYING DTSBU032
|
|
00459 C032-33--34-IDX DTSBU032
|
|
00460 WHEN L032-CD-2 = C032-33--34-CD (C032-33--34-IDX) DTSBU032
|
|
00461 MOVE '1' TO L032-RESULT-IND DTSBU032
|
|
00462 MOVE C032-33--34-SHORT-DSCR (C032-33--34-IDX) DTSBU032
|
|
00463 TO L032-SHORT-DSCR DTSBU032
|
|
00464 MOVE C032-33--34-LONG-DSCR (C032-33--34-IDX) DTSBU032
|
|
00465 TO L032-LONG-DSCR. DTSBU032
|
|
00466 DTSBU032
|
|
00467 GO TO P1000-EXIT. DTSBU032
|
|
00468 SKIP3 DTSBU032
|
|
00469 P1000-36. DTSBU032
|
|
00470 SET C032-31--36-IDX TO 1. DTSBU032
|
|
00471 SEARCH C032-31--36-ENTRY DTSBU032
|
|
00472 VARYING DTSBU032
|
|
00473 C032-31--36-IDX DTSBU032
|
|
00474 WHEN L032-CD-2 = C032-31--36-CD (C032-31--36-IDX) DTSBU032
|
|
00475 MOVE '1' TO L032-RESULT-IND DTSBU032
|
|
00476 MOVE C032-31--36-SHORT-DSCR (C032-31--36-IDX) DTSBU032
|
|
00477 TO L032-SHORT-DSCR DTSBU032
|
|
00478 MOVE C032-31--36-LONG-DSCR (C032-31--36-IDX) DTSBU032
|
|
00479 TO L032-LONG-DSCR. DTSBU032
|
|
00480 DTSBU032
|
|
00481 GO TO P1000-EXIT. DTSBU032
|
|
00482 SKIP3 DTSBU032
|
|
00483 P1000-37. DTSBU032
|
|
00484 SET C032-37-IDX TO 1. DTSBU032
|
|
00485 SEARCH C032-37-ENTRY DTSBU032
|
|
00486 VARYING DTSBU032
|
|
00487 C032-37-IDX DTSBU032
|
|
00488 WHEN L032-CD-2 = C032-37-CD (C032-37-IDX) DTSBU032
|
|
00489 MOVE '1' TO L032-RESULT-IND DTSBU032
|
|
00490 MOVE C032-37-SHORT-DSCR (C032-37-IDX) DTSBU032
|
|
00491 TO L032-SHORT-DSCR DTSBU032
|
|
00492 MOVE C032-37-LONG-DSCR (C032-37-IDX) DTSBU032
|
|
00493 TO L032-LONG-DSCR. DTSBU032
|
|
00494 DTSBU032
|
|
00495 GO TO P1000-EXIT. DTSBU032
|
|
00496 SKIP3 DTSBU032
|
|
00497 P1000-41. DTSBU032
|
|
00498 SET C032-41-IDX TO 1. DTSBU032
|
|
00499 SEARCH C032-41-ENTRY DTSBU032
|
|
00500 VARYING DTSBU032
|
|
00501 C032-41-IDX DTSBU032
|
|
00502 WHEN L032-CD-3 = C032-41-CD (C032-41-IDX) DTSBU032
|
|
00503 MOVE '1' TO L032-RESULT-IND DTSBU032
|
|
00504 MOVE C032-41-SHORT-DSCR (C032-41-IDX) DTSBU032
|
|
00505 TO L032-SHORT-DSCR DTSBU032
|
|
00506 MOVE C032-41-LONG-DSCR (C032-41-IDX) DTSBU032
|
|
00507 TO L032-LONG-DSCR. DTSBU032
|
|
00508 DTSBU032
|
|
00509 GO TO P1000-EXIT. DTSBU032
|
|
00510 SKIP3 DTSBU032
|
|
00511 P1000-42. DTSBU032
|
|
00512 SET C032-41-IDX TO 1. DTSBU032
|
|
00513 SEARCH C032-41-ENTRY DTSBU032
|
|
00514 VARYING DTSBU032
|
|
00515 C032-41-IDX DTSBU032
|
|
00516 WHEN L032-CD-3 = C032-41-CD (C032-41-IDX) DTSBU032
|
|
00517 MOVE '1' TO L032-RESULT-IND DTSBU032
|
|
00518 MOVE C032-41-SHORT-DSCR (C032-41-IDX) DTSBU032
|
|
00519 TO L032-SHORT-DSCR DTSBU032
|
|
00520 MOVE C032-41-LONG-DSCR (C032-41-IDX) DTSBU032
|
|
00521 TO L032-LONG-DSCR. DTSBU032
|
|
00522 DTSBU032
|
|
00523 GO TO P1000-EXIT. DTSBU032
|
|
00524 SKIP3 DTSBU032
|
|
00525 P1000-43. DTSBU032
|
|
00526 SET C032-41-IDX TO 1. DTSBU032
|
|
00527 SEARCH C032-41-ENTRY DTSBU032
|
|
00528 VARYING DTSBU032
|
|
00529 C032-41-IDX DTSBU032
|
|
00530 WHEN L032-CD-3 = C032-41-CD (C032-41-IDX) DTSBU032
|
|
00531 MOVE '1' TO L032-RESULT-IND DTSBU032
|
|
00532 MOVE C032-41-SHORT-DSCR (C032-41-IDX) DTSBU032
|
|
00533 TO L032-SHORT-DSCR DTSBU032
|
|
00534 MOVE C032-41-LONG-DSCR (C032-41-IDX) DTSBU032
|
|
00535 TO L032-LONG-DSCR. DTSBU032
|
|
00536 DTSBU032
|
|
00537 GO TO P1000-EXIT. DTSBU032
|
|
00538 SKIP3 DTSBU032
|
|
00539 P1000-44. DTSBU032
|
|
00540 SET C032-41-IDX TO 1. DTSBU032
|
|
00541 SEARCH C032-41-ENTRY DTSBU032
|
|
00542 VARYING DTSBU032
|
|
00543 C032-41-IDX DTSBU032
|
|
00544 WHEN L032-CD-3 = C032-41-CD (C032-41-IDX) DTSBU032
|
|
00545 MOVE '1' TO L032-RESULT-IND DTSBU032
|
|
00546 MOVE C032-41-SHORT-DSCR (C032-41-IDX) DTSBU032
|
|
00547 TO L032-SHORT-DSCR DTSBU032
|
|
00548 MOVE C032-41-LONG-DSCR (C032-41-IDX) DTSBU032
|
|
00549 TO L032-LONG-DSCR. DTSBU032
|
|
00550 DTSBU032
|
|
00551 GO TO P1000-EXIT. DTSBU032
|
|
00552 SKIP3 DTSBU032
|
|
00553 P1000-45. DTSBU032
|
|
00554 SET C032-41-IDX TO 1. DTSBU032
|
|
00555 SEARCH C032-41-ENTRY DTSBU032
|
|
00556 VARYING DTSBU032
|
|
00557 C032-41-IDX DTSBU032
|
|
00558 WHEN L032-CD-3 = C032-41-CD (C032-41-IDX) DTSBU032
|
|
00559 MOVE '1' TO L032-RESULT-IND DTSBU032
|
|
00560 MOVE C032-41-SHORT-DSCR (C032-41-IDX) DTSBU032
|
|
00561 TO L032-SHORT-DSCR DTSBU032
|
|
00562 MOVE C032-41-LONG-DSCR (C032-41-IDX) DTSBU032
|
|
00563 TO L032-LONG-DSCR. DTSBU032
|
|
00564 DTSBU032
|
|
00565 GO TO P1000-EXIT. DTSBU032
|
|
00566 SKIP3 DTSBU032
|
|
00567 P1000-46. DTSBU032
|
|
00568 SET C032-41-IDX TO 1. DTSBU032
|
|
00569 SEARCH C032-41-ENTRY DTSBU032
|
|
00570 VARYING DTSBU032
|
|
00571 C032-41-IDX DTSBU032
|
|
00572 WHEN L032-CD-3 = C032-41-CD (C032-41-IDX) DTSBU032
|
|
00573 MOVE '1' TO L032-RESULT-IND DTSBU032
|
|
00574 MOVE C032-41-SHORT-DSCR (C032-41-IDX) DTSBU032
|
|
00575 TO L032-SHORT-DSCR DTSBU032
|
|
00576 MOVE C032-41-LONG-DSCR (C032-41-IDX) DTSBU032
|
|
00577 TO L032-LONG-DSCR. DTSBU032
|
|
00578 DTSBU032
|
|
00579 GO TO P1000-EXIT. DTSBU032
|
|
00580 SKIP3 DTSBU032
|
|
00581 P1000-EXIT. DTSBU032
|
|
00582 EXIT. DTSBU032
|
|
00583 EJECT DTSBU032
|
|
00584 S999-ABEND. DTSBU032
|
|
00585 DTSBU032
|
|
00586 CALL 'DTSBU999' DTSBU032
|
|
00587 USING WRK-ABEND-CD. DTSBU032
|
|
00588 DTSBU032
|
|
00589 S999-EXIT. EXIT. DTSBU032
|
|
00590 EXIT. DTSBU032
|