00001 IDENTIFICATION DIVISION. 03/21/03 00002 PROGRAM-ID. DESBD100. DESBD100 00003 AUTHOR. TRW. LV005 00004 DATE-WRITTEN. MARCH 2001. DESBD100 00005 DATE-COMPILED. DESBD100 00006 SKIP3 DESBD100 00007 ***** DESBD100 00008 * DESBD100 00009 * FUNCTION: BUILD DAILY PRINT REPORT RECORDS FOR DESBD100 00010 * ELECTRONIC MEDIA TRACKING SYSTEM DESBD100 00011 * DESBD100 00012 * MODIFIED ON 03/29/02 GB DESBD100 00013 * ADDED EPRF-FORMAT-CD, EPRF-DATA-TYPE-CD, EPRF-MEDIUM-TYPE. DESBD100 00014 * TO PACKING LIST REPORT. DESBD100 00015 * DESBD100 00016 ***** DESBD100 00017 SKIP3 DESBD100 00018 ENVIRONMENT DIVISION. DESBD100 00019 *INPUT-OUTPUT SECTION. DESBD100 00020 *FILE-CONTROL. DESBD100 00021 * SELECT BD100-PARM-FILE ASSIGN TO DESBD100 DESBD100 00022 * FILE STATUS IS BD100-PARM-STATUS. DESBD100 00023 SKIP2 DESBD100 00024 DATA DIVISION. DESBD100 00025 *FILE SECTION. DESBD100 00026 *FD BD100-PARM-FILE DESBD100 00027 * RECORDING MODE IS F DESBD100 00028 * BLOCK CONTAINS 0 RECORDS. DESBD100 00029 * DESBD100 00030 *01 BD100-PARM-REC. DESBD100 00031 * 05 BD100-PARM-LAST-ABSTIME PIC 9(15). DESBD100 00032 * 05 FILLER PIC X(65). DESBD100 00033 DESBD100 00034 WORKING-STORAGE SECTION. DESBD100 000345 77 PAN-VALET PICTURE X(24) VALUE '005DESBD100 03/21/03'. DESBD100 00035 SKIP3 DESBD100 00036 01 WRK-AREA. DESBD100 00037 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +100. DESBD100 00038 DESBD100 00039 05 WRK-MOD-NAME PIC X(08) VALUE 'DESBD100'. DESBD100 00040 DESBD100 00041 05 ERR-SUB PIC S9(04) COMP. DESBD100 00042 DESBD100 00043 05 WRK-LOG-NO PIC 9(10) VALUE 0. DESBD100 00044 DESBD100 00045 05 WRK-TRG-CNT PIC 9(05) COMP-3 VALUE 0. DESBD100 00046 05 WRK-TRG-SELECTED-CNT PIC 9(05) COMP-3 VALUE 0. DESBD100 00047 05 WRK-101-CNT PIC 9(05) COMP-3 VALUE 0. DESBD100 00048 05 WRK-102-CNT PIC 9(05) COMP-3 VALUE 0. DESBD100 00049 05 WRK-CNT-DISP PIC Z(04)9. DESBD100 00050 DESBD100 00051 05 BD100-PARM-STATUS PIC X(02). DESBD100 00052 88 BD100-PARM-FILE-OK-88 VALUE '00'. DESBD100 00053 DESBD100 00054 05 WRK-LAST-ABSTIME PIC S9(15) COMP-3 VALUE +0. DESBD100 00055 05 WRK-NEW-ABSTIME PIC S9(15) COMP-3 VALUE +0. DESBD100 00056 DESBD100 00057 05 WRK-ERROR-IND PIC X(01). DESBD100 00058 88 WRK-ERROR-YES-88 VALUE 'Y'. DESBD100 00059 88 WRK-ERROR-NO-88 VALUE 'N'. DESBD100 00060 DESBD100 00061 05 WRK-TRACE-IND PIC X(01) VALUE ' '. DESBD100 00062 DESBD100 00063 01 L041-LINK-AREA. DESBD100 00064 ++INCLUDE DTSIL041 DESBD100 00065 EJECT DESBD100 00066 01 L111-LINK-AREA. DESBD100 00067 ++INCLUDE DTSIL111 DESBD100 00068 EJECT DESBD100 00069 01 L112-LINK-AREA. DESBD100 00070 ++INCLUDE DTSIL112 DESBD100 00071 EJECT DESBD100 00072 01 C200-CONSTANTS. DESBD100 00073 ++INCLUDE DTSIC200 DESBD100 00074 EJECT DESBD100 00075 01 T060-REC. DESBD100 00076 ++INCLUDE DTSIT060 DESBD100 00077 EJECT DESBD100 00078 01 R101-REC. DESBD100 00079 ++INCLUDE DESIR101 DESBD100 00080 EJECT DESBD100 00081 01 R102-REC. DESBD100 00082 ++INCLUDE DESIR102 DESBD100 00083 EJECT DESBD100 00084 01 L921-LINK-AREA. DESBD100 00085 ++INCLUDE DTSIL921 DESBD100 00086 EJECT DESBD100 00087 01 ISKL-REC. DESBD100 00088 ++INCLUDE DTSIISKL DESBD100 00089 EJECT DESBD100 00090 01 IENM-REC. DESBD100 00091 ++INCLUDE DTSIIENM DESBD100 00092 EJECT DESBD100 00093 01 IEAL-REC. DESBD100 00094 ++INCLUDE DTSIIEAL DESBD100 00095 EJECT DESBD100 00096 01 IEAE-REC. DESBD100 00097 ++INCLUDE DTSIIEAE DESBD100 00098 EJECT DESBD100 00099 01 IEBX-REC. DESBD100 00100 ++INCLUDE DTSIIEBX DESBD100 00101 EJECT DESBD100 00102 01 IEOP-REC. DESBD100 00103 ++INCLUDE DTSIIEOP DESBD100 00104 EJECT DESBD100 00105 01 IESR-REC. DESBD100 00106 ++INCLUDE DTSIIESR DESBD100 00107 EJECT DESBD100 00108 01 IEER-REC. DESBD100 00109 ++INCLUDE DTSIIEER DESBD100 00110 EJECT DESBD100 00111 01 IEET-REC. DESBD100 00112 ++INCLUDE DTSIIEET DESBD100 00113 EJECT DESBD100 00114 01 IEPR-REC. DESBD100 00115 ++INCLUDE DTSIIEPR DESBD100 00116 EJECT DESBD100 00117 01 L924-LINK-AREA. DESBD100 00118 ++INCLUDE DTSIL924 DESBD100 00119 EJECT DESBD100 00120 01 RSK3-REC. DESBD100 00121 ++INCLUDE DTSIRSK3 DESBD100 00122 DESBD100 00123 01 TRIG-REC REDEFINES RSK3-REC. DESBD100 00124 05 TRIG-REC-LENGTH PIC S9(04) COMP. DESBD100 00125 05 TRIG-REC-TYPE PIC X(03). DESBD100 00126 88 TRIG-REC-TYPE-EMEDIA-88 VALUE '060' '061'. DESBD100 00127 05 FILLER PIC X(4084). DESBD100 00128 EJECT DESBD100 00129 01 L935-LINK-AREA. DESBD100 00130 ++INCLUDE DTSIL935 DESBD100 00131 EJECT DESBD100 00132 01 ESKL-REC. DESBD100 00133 ++INCLUDE DTSIESKL DESBD100 00134 EJECT DESBD100 00135 01 EPRF-REC. DESBD100 00136 ++INCLUDE DTSIEPRF DESBD100 00137 DESBD100 00138 01 ELOG-REC. DESBD100 00139 ++INCLUDE DTSIELOG DESBD100 00140 DESBD100 00141 01 EMSG-REC. DESBD100 00142 ++INCLUDE DTSIEMSG DESBD100 00143 EJECT DESBD100 00144 DESBD100 00145 PROCEDURE DIVISION. DESBD100 00146 DESBD100 00147 DESBD100-MAIN. DESBD100 00148 PERFORM I0000-INITIATE THRU I0000-EXIT. DESBD100 00149 IF WRK-ERROR-YES-88 DESBD100 00150 GO TO DESBD100-MAIN-EXIT. DESBD100 00151 DESBD100 00152 PERFORM P0000-PROCESS THRU P0000-EXIT. DESBD100 00153 DESBD100 00154 PERFORM T0000-TERMINATE THRU T0000-EXIT. DESBD100 00155 DESBD100 00156 DESBD100-MAIN-EXIT. DESBD100 00157 GOBACK. DESBD100 00158 EJECT DESBD100 00159 I0000-INITIATE. DESBD100 00160 SET WRK-ERROR-NO-88 TO TRUE. DESBD100 00161 DESBD100 00162 MOVE LENGTH OF R101-REC TO R101-LENGTH. DESBD100 00163 MOVE '101' TO R101-REC-TYPE. DESBD100 00164 DESBD100 00165 MOVE LENGTH OF R102-REC TO R102-LENGTH. DESBD100 00166 MOVE '102' TO R102-REC-TYPE. DESBD100 00167 DESBD100 00168 PERFORM I1000-OPEN-FILES THRU I1000-EXIT. DESBD100 00169 DESBD100 00170 *** PERFORM I2000-GET-LAST-PRINT-TIME THRU I2000-EXIT. DESBD100 00171 DESBD100 00172 I0000-EXIT. DESBD100 00173 EXIT. DESBD100 00174 DESBD100 00175 I1000-OPEN-FILES. DESBD100 00176 MOVE WRK-TRACE-IND TO L935-TRACE-IND DESBD100 00177 L921-TRACE-IND DESBD100 00178 L924-TRACE-IND. DESBD100 00179 DESBD100 00180 MOVE WRK-MOD-NAME TO L921-MOD-NAME DESBD100 00181 L924-MOD-NAME DESBD100 00182 L935-MOD-NAME. DESBD100 00183 DESBD100 00184 PERFORM S921-OPEN-READ THRU S921-EXIT. DESBD100 00185 PERFORM S935-OPEN-READ THRU S935-EXIT. DESBD100 00186 DESBD100 00187 SET L924-OPEN-READ-88 TO TRUE. DESBD100 00188 DESBD100 00189 PERFORM S924-OLA-I THRU S924-EXIT. DESBD100 00190 DESBD100 00191 I1000-EXIT. DESBD100 00192 EXIT. DESBD100 00193 DESBD100 00194 *I2000-GET-LAST-PRINT-TIME. DESBD100 00195 * OPEN INPUT BD100-PARM-FILE. DESBD100 00196 * IF NOT BD100-PARM-FILE-OK-88 DESBD100 00197 * DISPLAY 'PARM FILE OPEN ERROR: ' BD100-PARM-STATUS DESBD100 00198 * SET WRK-ERROR-YES-88 TO TRUE DESBD100 00199 * GO TO I2000-EXIT. DESBD100 00200 * DESBD100 00201 * READ BD100-PARM-FILE. DESBD100 00202 * IF NOT BD100-PARM-FILE-OK-88 DESBD100 00203 * DISPLAY 'PARM FILE READ ERROR: ' BD100-PARM-STATUS DESBD100 00204 * SET WRK-ERROR-YES-88 TO TRUE DESBD100 00205 * GO TO I2000-EXIT. DESBD100 00206 * DESBD100 00207 * IF BD100-PARM-LAST-ABSTIME NUMERIC DESBD100 00208 * MOVE BD100-PARM-LAST-ABSTIME TO WRK-LAST-ABSTIME DESBD100 00209 * ELSE DESBD100 00210 * DISPLAY 'INVALID PARM ABSTIME ' DESBD100 00211 * SET WRK-ERROR-YES-88 TO TRUE DESBD100 00212 * GO TO I2000-EXIT. DESBD100 00213 * DESBD100 00214 * CLOSE BD100-PARM-FILE. DESBD100 00215 * DESBD100 00216 * DISPLAY 'LAST UPDATE TIME ' WRK-LAST-ABSTIME. DESBD100 00217 * DESBD100 00218 *I2000-EXIT. DESBD100 00219 * EXIT. DESBD100 00220 EJECT DESBD100 00221 P0000-PROCESS. DESBD100 00222 DESBD100 00223 SET L924-READ-NEXT-88 TO TRUE. DESBD100 00224 DESBD100 00225 PERFORM S924-OLA-I THRU S924-EXIT. DESBD100 00226 DESBD100 00227 IF L924-OK-88 DESBD100 00228 PERFORM P1000-SCAN-OLA THRU P1000-EXIT DESBD100 00229 UNTIL L924-NO-REC-88 DESBD100 00230 ELSE DESBD100 00231 DISPLAY 'NO TRIGGER REC' DESBD100 00232 GO TO P0000-EXIT DESBD100 00233 END-IF. DESBD100 00234 DESBD100 00235 P0000-EXIT. DESBD100 00236 EXIT. DESBD100 00237 EJECT DESBD100 00238 DESBD100 00239 P1000-SCAN-OLA. DESBD100 00240 ADD +1 TO WRK-TRG-CNT. DESBD100 00241 DESBD100 00242 DESBD100 00243 IF RSK3-REC-TYPE = '060' DESBD100 00244 MOVE RSK3-REC TO T060-REC DESBD100 00245 *& IF T060-ABSTIME > WRK-LAST-ABSTIME DESBD100 00246 * IF T060-ABSTIME > WRK-NEW-ABSTIME DESBD100 00247 * MOVE T060-ABSTIME TO WRK-NEW-ABSTIME DESBD100 00248 *& END-IF DESBD100 00249 ADD +1 TO WRK-TRG-SELECTED-CNT DESBD100 00250 PERFORM P2000-BUILD-RPT-RECS THRU P2000-EXIT. DESBD100 00251 DESBD100 00252 PERFORM S924-OLA-I THRU S924-EXIT. DESBD100 00253 DESBD100 00254 P1000-EXIT. DESBD100 00255 EXIT. DESBD100 00256 DESBD100 00257 P2000-BUILD-RPT-RECS. DESBD100 00258 MOVE T060-LOG-NO TO WRK-LOG-NO. DESBD100 00259 SET WRK-ERROR-NO-88 TO TRUE DESBD100 00260 PERFORM S1000-READ-LOG-PRF THRU S1000-EXIT DESBD100 00261 IF WRK-ERROR-YES-88 DESBD100 00262 GO TO P2000-EXIT DESBD100 00263 END-IF. DESBD100 00264 DESBD100 00265 IF T060-TYPE-PCK-LST-88 DESBD100 00266 PERFORM P2100-BUILD-R101 THRU P2100-EXIT DESBD100 00267 ELSE DESBD100 00268 IF T060-TYPE-NOTICE-88 DESBD100 00269 PERFORM P2200-BUILD-R102 THRU P2200-EXIT. DESBD100 00270 DESBD100 00271 P2000-EXIT. DESBD100 00272 EXIT. DESBD100 00273 DESBD100 00274 P2100-BUILD-R101. DESBD100 00275 ADD +1 TO WRK-101-CNT. DESBD100 00276 DESBD100 00277 PERFORM P2110-FIND-JOB THRU P2110-EXIT. DESBD100 00278 DESBD100 00279 MOVE ELOG-BOX-NO TO R101-BOX-NO. DESBD100 00280 MOVE ELOG-LOG-NO TO R101-LOG-NO. DESBD100 00281 MOVE EPRF-ELF-ID TO R101-ELF-ID. DESBD100 00282 MOVE EPRF-ELF-NAME TO R101-ELF-NAME. DESBD100 00283 MOVE EPRF-FORMAT-CD TO R101-FORMAT-CD. DESBD100 00284 MOVE EPRF-DATA-TYPE-CD TO R101-DATA-TYPE-CD. DESBD100 00285 MOVE EPRF-MEDIUM-TYPE-CD TO R101-MEDIUM-TYPE-CD. DESBD100 00286 MOVE ELOG-CHNG-OPID TO R101-OPID. DESBD100 00287 DESBD100 00288 PERFORM S946-WRITE-R101 THRU S946-EXIT. DESBD100 00289 DESBD100 00290 P2100-EXIT. DESBD100 00291 EXIT. DESBD100 00292 DESBD100 00293 P2110-FIND-JOB. DESBD100 00294 IF EPRF-JOB-NAME NOT = SPACES DESBD100 00295 MOVE EPRF-JOB-NAME TO R101-JOBNAME DESBD100 00296 ELSE DESBD100 00297 PERFORM DESBD100 00298 VARYING C200-JOB-IDX FROM +1 BY +1 DESBD100 00299 UNTIL C200-JOB-IDX > C200-JOB-TABLE-MAX DESBD100 00300 IF (C200-FORMAT (C200-JOB-IDX) DESBD100 00301 = EPRF-FORMAT-CD DESBD100 00302 AND C200-MEDIUM (C200-JOB-IDX) DESBD100 00303 = EPRF-MEDIUM-TYPE-CD) DESBD100 00304 MOVE C200-JOB (C200-JOB-IDX) DESBD100 00305 TO R101-JOBNAME DESBD100 00306 END-IF DESBD100 00307 END-PERFORM DESBD100 00308 END-IF. DESBD100 00309 DESBD100 00310 P2110-EXIT. DESBD100 00311 EXIT. DESBD100 00312 DESBD100 00313 P2200-BUILD-R102. DESBD100 00314 ADD +1 TO WRK-102-CNT. DESBD100 00315 DESBD100 00316 MOVE ELOG-BOX-NO TO R102-BOX-NO. DESBD100 00317 MOVE ELOG-LOG-NO TO R102-LOG-NO. DESBD100 00318 MOVE EPRF-ELF-ID TO R102-ELF-ID. DESBD100 00319 MOVE EPRF-FORMAT-CD TO R102-FORMAT-CD. DESBD100 00320 DESBD100 00321 SET L112-FID-MAILING-ADDR-88 TO TRUE. DESBD100 00322 SET L112-ANCHOR-FIRST-88 TO TRUE. DESBD100 00323 MOVE EPRF-ELF-NAME TO L112-NAME. DESBD100 00324 MOVE EPRF-ADDRESS TO L112-ADDRESS. DESBD100 00325 PERFORM S112-ADDR-FORMAT THRU S112-EXIT. DESBD100 00326 MOVE L112-MAILING-ADDRESS TO R102-FMT-ADDR. DESBD100 00327 MOVE L112-ZIP TO R102-ZIP. DESBD100 00328 MOVE L112-ADVANCED-BARCODE TO R102-ADVANCED-BARCODE. DESBD100 00329 DESBD100 00330 MOVE ELOG-CHNG-OPID TO R102-OPID. DESBD100 00331 MOVE ZERO TO R102-MAIL-DATE. DESBD100 00332 *& MOVE LECM-CURR-MAIL-DATE TO R102-MAIL-DATE. DESBD100 00333 DESBD100 00334 MOVE ZERO TO ERR-SUB. DESBD100 00335 PERFORM P2210-ERRORS THRU P2210-EXIT. DESBD100 00336 DESBD100 00337 IF ERR-SUB = ZERO DESBD100 00338 SET R102-RPT-TYPE-CONFIRM-88 TO TRUE DESBD100 00339 ELSE DESBD100 00340 SET R102-RPT-TYPE-ERROR-88 TO TRUE. DESBD100 00341 DESBD100 00342 PERFORM S946-WRITE-R102 THRU S946-EXIT. DESBD100 00343 DESBD100 00344 P2200-EXIT. DESBD100 00345 EXIT. DESBD100 00346 DESBD100 00347 P2210-ERRORS. DESBD100 00348 MOVE LOW-VALUES TO EMSG-REC. DESBD100 00349 DESBD100 00350 SET EMSG-MSG-88 TO TRUE. DESBD100 00351 MOVE ELOG-LOG-NO TO EMSG-LOG-NO DESBD100 00352 MOVE ZERO TO EMSG-ABSTIME DESBD100 00353 EMSG-SEQ. DESBD100 00354 MOVE EMSG-KEY-AREA TO ESKL-KEY-AREA. DESBD100 00355 DESBD100 00356 PERFORM S935-START-BROWSE THRU S935-EXIT. DESBD100 00357 IF L935-OK-88 DESBD100 00358 PERFORM P2211-SCAN-MSG THRU P2211-EXIT DESBD100 00359 UNTIL L935-NO-REC-88 DESBD100 00360 ELSE DESBD100 00361 DISPLAY 'CANNOT READ MESSAGE' DESBD100 00362 GO TO P2210-EXIT DESBD100 00363 END-IF. DESBD100 00364 DESBD100 00365 P2210-EXIT. DESBD100 00366 EXIT. DESBD100 00367 DESBD100 00368 P2211-SCAN-MSG. DESBD100 00369 MOVE ESKL-REC TO EMSG-REC. DESBD100 00370 IF EMSG-TYPE-ERROR-88 DESBD100 00371 OR EMSG-TYPE-MANUAL-88 DESBD100 00372 IF ERR-SUB < +50 DESBD100 00373 ADD +1 TO ERR-SUB DESBD100 00374 MOVE EMSG-FULL-MESSAGE TO R102-ERROR (ERR-SUB) DESBD100 00375 MOVE ERR-SUB TO R102-ERR-CNT. DESBD100 00376 DESBD100 00377 PERFORM S935-READ-NEXT THRU S935-EXIT. DESBD100 00378 DESBD100 00379 P2211-EXIT. DESBD100 00380 EXIT. DESBD100 00381 DESBD100 00382 T0000-TERMINATE. DESBD100 00383 DESBD100 00384 DISPLAY ' '. DESBD100 00385 DESBD100 00386 DISPLAY '*** DESBD100 TERMINATION STATISTICS ***'. DESBD100 00387 DESBD100 00388 DISPLAY ' '. DESBD100 00389 DESBD100 00390 MOVE WRK-TRG-CNT TO WRK-CNT-DISP. DESBD100 00391 DISPLAY ' TRIGGER RECORDS READ: ' DESBD100 00392 WRK-CNT-DISP. DESBD100 00393 DESBD100 00394 MOVE WRK-TRG-SELECTED-CNT TO WRK-CNT-DISP. DESBD100 00395 DISPLAY ' TRIGGER RECORDS SELECTED: ' DESBD100 00396 WRK-CNT-DISP. DESBD100 00397 DESBD100 00398 MOVE WRK-101-CNT TO WRK-CNT-DISP. DESBD100 00399 DISPLAY ' R101 RECORDS WRITTEN: ' DESBD100 00400 WRK-CNT-DISP. DESBD100 00401 DESBD100 00402 MOVE WRK-102-CNT TO WRK-CNT-DISP. DESBD100 00403 DISPLAY ' R102 RECORDS WRITTEN: ' DESBD100 00404 WRK-CNT-DISP. DESBD100 00405 DESBD100 00406 DISPLAY SPACE. DESBD100 00407 DESBD100 00408 *& PERFORM T1000-UPD-LAST-PRINT-TIME THRU T1000-EXIT. DESBD100 00409 DESBD100 00410 T0000-EXIT. DESBD100 00411 EXIT. DESBD100 00412 DESBD100 00413 *T1000-UPD-LAST-PRINT-TIME. DESBD100 00414 * IF WRK-NEW-ABSTIME > ZERO DESBD100 00415 * PERFORM T1100-UPDATE-PARM THRU T1100-EXIT. DESBD100 00416 * DESBD100 00417 * DISPLAY 'NEW UPDATE TIME ' WRK-NEW-ABSTIME. DESBD100 00418 * DESBD100 00419 *T1000-EXIT. DESBD100 00420 * EXIT. DESBD100 00421 * DESBD100 00422 *T1100-UPDATE-PARM. DESBD100 00423 * OPEN OUTPUT BD100-PARM-FILE. DESBD100 00424 * IF NOT BD100-PARM-FILE-OK-88 DESBD100 00425 * DISPLAY 'PARM FILE OPEN ERROR: ' BD100-PARM-STATUS DESBD100 00426 * GO TO T1100-EXIT. DESBD100 00427 * DESBD100 00428 * MOVE WRK-NEW-ABSTIME TO BD100-PARM-LAST-ABSTIME. DESBD100 00429 * DESBD100 00430 * WRITE BD100-PARM-REC. DESBD100 00431 * IF NOT BD100-PARM-FILE-OK-88 DESBD100 00432 * DISPLAY 'PARM FILE WRITE ERROR: ' BD100-PARM-STATUS DESBD100 00433 * GO TO T1100-EXIT. DESBD100 00434 * DESBD100 00435 * CLOSE BD100-PARM-FILE. DESBD100 00436 * DESBD100 00437 *T1100-EXIT. DESBD100 00438 * EXIT. DESBD100 00439 * EJECT DESBD100 00440 S112-ADDR-FORMAT. DESBD100 00441 CALL 'DTSBU112' USING L112-LINK-AREA. DESBD100 00442 DESBD100 00443 S112-EXIT. DESBD100 00444 EXIT. DESBD100 00445 EJECT DESBD100 00446 S921-OPEN-READ. DESBD100 00447 SET L921-OPEN-READ-88 TO TRUE. DESBD100 00448 GO TO S921-AIX-IO. DESBD100 00449 DESBD100 00450 S921-OPEN-UPDATE. DESBD100 00451 SET L921-OPEN-UPDATE-88 TO TRUE. DESBD100 00452 GO TO S921-AIX-IO. DESBD100 00453 DESBD100 00454 S921-START-BROWSE. DESBD100 00455 SET L921-START-BROWSE-88 TO TRUE. DESBD100 00456 GO TO S921-AIX-IO. DESBD100 00457 DESBD100 00458 S921-READ-NEXT. DESBD100 00459 SET L921-READ-NEXT-88 TO TRUE. DESBD100 00460 GO TO S921-AIX-IO. DESBD100 00461 DESBD100 00462 S921-CLOSE. DESBD100 00463 SET L921-CLOSE-88 TO TRUE. DESBD100 00464 GO TO S921-AIX-IO. DESBD100 00465 DESBD100 00466 S921-AIX-IO. DESBD100 00467 CALL 'DTSBU921' USING L921-LINK-AREA DESBD100 00468 ISKL-REC. DESBD100 00469 S921-EXIT. DESBD100 00470 EXIT. DESBD100 00471 DESBD100 00472 S924-OLA-I. DESBD100 00473 CALL 'DTSBU924' USING L924-LINK-AREA DESBD100 00474 RSK3-REC. DESBD100 00475 DESBD100 00476 S924-EXIT. DESBD100 00477 EXIT. DESBD100 00478 DESBD100 00479 S935-OPEN-READ. DESBD100 00480 SET L935-OPEN-READ-88 TO TRUE. DESBD100 00481 GO TO S935-MSTR-IO. DESBD100 00482 DESBD100 00483 S935-OPEN-UPDATE. DESBD100 00484 SET L935-OPEN-UPDATE-88 TO TRUE. DESBD100 00485 GO TO S935-MSTR-IO. DESBD100 00486 DESBD100 00487 S935-OPEN-UPDATE-NO-AIX. DESBD100 00488 SET L935-OPEN-UPDATE-NO-AIX-88 TO TRUE. DESBD100 00489 GO TO S935-MSTR-IO. DESBD100 00490 DESBD100 00491 S935-READ. DESBD100 00492 SET L935-READ-88 TO TRUE. DESBD100 00493 GO TO S935-MSTR-IO. DESBD100 00494 DESBD100 00495 S935-START-BROWSE. DESBD100 00496 SET L935-START-BROWSE-88 TO TRUE. DESBD100 00497 GO TO S935-MSTR-IO. DESBD100 00498 DESBD100 00499 S935-READ-NEXT. DESBD100 00500 SET L935-READ-NEXT-88 TO TRUE. DESBD100 00501 GO TO S935-MSTR-IO. DESBD100 00502 DESBD100 00503 S935-DELETE. DESBD100 00504 SET L935-DELETE-88 TO TRUE. DESBD100 00505 GO TO S935-MSTR-IO. DESBD100 00506 DESBD100 00507 S935-WRITE. DESBD100 00508 SET L935-WRITE-88 TO TRUE. DESBD100 00509 GO TO S935-MSTR-IO. DESBD100 00510 DESBD100 00511 S935-REWRITE. DESBD100 00512 SET L935-REWRITE-88 TO TRUE. DESBD100 00513 GO TO S935-MSTR-IO. DESBD100 00514 DESBD100 00515 S935-CLOSE. DESBD100 00516 SET L935-CLOSE-88 TO TRUE. DESBD100 00517 GO TO S935-MSTR-IO. DESBD100 00518 DESBD100 00519 S935-MSTR-IO. DESBD100 00520 CALL 'DTSBU935' USING L935-LINK-AREA DESBD100 00521 ESKL-REC. DESBD100 00522 S935-EXIT. DESBD100 00523 EXIT. DESBD100 00524 DESBD100 00525 S946-WRITE-R101. DESBD100 00526 CALL 'DTSBU946' USING R101-REC. DESBD100 00527 GO TO S946-EXIT. DESBD100 00528 DESBD100 00529 S946-WRITE-R102. DESBD100 00530 CALL 'DTSBU946' USING R102-REC. DESBD100 00531 GO TO S946-EXIT. DESBD100 00532 DESBD100 00533 S946-EXIT. DESBD100 00534 EXIT. DESBD100 00535 DESBD100 00536 S1000-READ-LOG-PRF. DESBD100 00537 PERFORM S1010-READ-ELOG THRU S1010-EXIT. DESBD100 00538 IF WRK-ERROR-YES-88 DESBD100 00539 GO TO S1000-EXIT. DESBD100 00540 DESBD100 00541 PERFORM S1020-READ-EPRF THRU S1020-EXIT. DESBD100 00542 DESBD100 00543 S1000-EXIT. DESBD100 00544 EXIT. DESBD100 00545 DESBD100 00546 S1010-READ-ELOG. DESBD100 00547 MOVE LOW-VALUES TO ELOG-REC. DESBD100 00548 MOVE WRK-LOG-NO TO ELOG-LOG-NO. DESBD100 00549 SET ELOG-LOG-88 TO TRUE. DESBD100 00550 MOVE ELOG-KEY-AREA TO ESKL-KEY-AREA. DESBD100 00551 DESBD100 00552 PERFORM S935-READ THRU S935-EXIT. DESBD100 00553 IF L935-NO-REC-88 DESBD100 00554 DISPLAY 'INVALID READ: ' WRK-LOG-NO DESBD100 00555 SET WRK-ERROR-YES-88 TO TRUE DESBD100 00556 ELSE DESBD100 00557 MOVE ESKL-REC TO ELOG-REC DESBD100 00558 END-IF. DESBD100 00559 DESBD100 00560 S1010-EXIT. DESBD100 00561 EXIT. DESBD100 00562 DESBD100 00563 S1020-READ-EPRF. DESBD100 00564 MOVE LOW-VALUES TO EPRF-REC. DESBD100 00565 MOVE ELOG-ELF-ID TO EPRF-ELF-ID. DESBD100 00566 MOVE ELOG-DATA-TYPE-CD TO EPRF-DATA-TYPE-CD. DESBD100 00567 SET EPRF-PRF-88 TO TRUE. DESBD100 00568 MOVE EPRF-KEY-AREA TO ESKL-KEY-AREA. DESBD100 00569 DESBD100 00570 PERFORM S935-READ THRU S935-EXIT. DESBD100 00571 IF L935-NO-REC-88 DESBD100 00572 DISPLAY 'INVALID READ ELOG-ELF-ID: ' ELOG-ELF-ID DESBD100 00573 ELOG-DATA-TYPE-CD DESBD100 00574 SET WRK-ERROR-YES-88 TO TRUE DESBD100 00575 ELSE DESBD100 00576 MOVE ESKL-REC TO EPRF-REC DESBD100 00577 END-IF. DESBD100 00578 DESBD100 00579 S1020-EXIT. DESBD100 00580 EXIT. DESBD100 00581 DESBD100 00582 SKIP3 DESBD100 00583 S9999-ABEND. DESBD100 00584 CALL 'DTSBU999' USING WRK-ABEND-CD. DESBD100 00585 S9999-EXIT. DESBD100 00586 EXIT. DESBD100