DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
587
Batch/DESBD100.cob
Normal file
587
Batch/DESBD100.cob
Normal file
@ -0,0 +1,587 @@
|
||||
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
|
||||
Reference in New Issue
Block a user