588 lines
46 KiB
COBOL
588 lines
46 KiB
COBOL
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
|