00001 IDENTIFICATION DIVISION. 08/02/02 00002 PROGRAM-ID. OJR0100. OJR0100 00003 AUTHOR. TRW. LV001 00004 DATE-WRITTEN. DECEMBER 2001. OJR0100 00005 DATE-COMPILED. OJR0100 00006 SKIP3 OJR0100 00007 ***** OJR0100 00008 * OJR0100 00009 * FUNCTION: BUILD EXTRACT PARAMETER FILES. OJR0100 00010 * OJR0100 00011 * OJR0100 00012 * MODIFICATION LOG: OJR0100 00013 * OJR0100 00014 * 12/05/2001 INITIAL DEVELOPMENT. OJR0100 00015 * WORK ORDER: ONLINE JOB REQUESTS PROGRAMMER: GD OJR0100 00016 * OJR0100 00017 * OJR0100 00018 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX OJR0100 00019 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX OJR0100 00020 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX OJR0100 00021 * OJR0100 00022 * OJR0100 00023 * DESCRIPTION: OJR0100 00024 * OJR0100 00025 * READ OLA FILE, LOOKING FOR T070 TRANSACTIONS. FOR EACH ONE OJR0100 00026 * FOUND, REFORMAT THE DATA IN THE STANDARD STRUCTURE USED IN OJR0100 00027 * THE BATCH EXTRACT PROCESS, AND WRITE THE PARAMETER RECORD TO OJR0100 00028 * EITHER THE PRE-UPDATE OR POST-UPDATE FILES. OJR0100 00029 * OJR0100 00030 ***** OJR0100 00031 SKIP3 OJR0100 00032 ENVIRONMENT DIVISION. OJR0100 00033 INPUT-OUTPUT SECTION. OJR0100 00034 FILE-CONTROL. OJR0100 00035 SELECT PRIOR-UPD-FILE ASSIGN TO PRIORUPD OJR0100 00036 FILE STATUS IS PRIOR-FILE-STATUS. OJR0100 00037 OJR0100 00038 SELECT POST-UPD-FILE ASSIGN TO POSTUPD OJR0100 00039 FILE STATUS IS POST-FILE-STATUS. OJR0100 00040 OJR0100 00041 SKIP3 OJR0100 00042 DATA DIVISION. OJR0100 00043 FILE SECTION. OJR0100 00044 OJR0100 00045 FD PRIOR-UPD-FILE OJR0100 00046 RECORDING MODE IS F OJR0100 00047 BLOCK CONTAINS 0 RECORDS. OJR0100 00048 OJR0100 00049 01 PRIOR-UPD-REC PIC X(80). OJR0100 00050 OJR0100 00051 FD POST-UPD-FILE OJR0100 00052 RECORDING MODE IS F OJR0100 00053 BLOCK CONTAINS 0 RECORDS. OJR0100 00054 OJR0100 00055 01 POST-UPD-REC PIC X(80). OJR0100 00056 OJR0100 00057 SKIP3 OJR0100 00058 WORKING-STORAGE SECTION. OJR0100 000585 77 PAN-VALET PICTURE X(24) VALUE '001OJR0100 08/02/02'. OJR0100 00059 SKIP3 OJR0100 00060 01 WRK-AREA. OJR0100 00061 *& OJR0100 00062 * 05 T070-PARM-CNT PIC S9(04) COMP VALUE +3. OJR0100 00063 *& OJR0100 00064 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +100.OJR0100 00065 OJR0100 00066 05 WRK-ABEND-MSG PIC X(60). OJR0100 00067 88 PRIOR-OPEN-MSG VALUE OJR0100 00068 'CANNOT OPEN PRIOR UPDATE FILE '. OJR0100 00069 88 POST-OPEN-MSG VALUE OJR0100 00070 'CANNOT OPEN POST UPDATE FILE '. OJR0100 00071 88 PRIOR-WRITE-MSG VALUE OJR0100 00072 'CANNOT WRITE TO PRIOR UPDATE FILE'. OJR0100 00073 88 POST-WRITE-MSG VALUE OJR0100 00074 'CANNOT WRITE TO POST UPDATE FILE '. OJR0100 00075 88 WRK-EXCESS-LEN-MSG VALUE OJR0100 00076 'INPUT PARM EXCEEDS MAXIMUM LENGTH'. OJR0100 00077 OJR0100 00078 05 MOD-NAME PIC X(08) VALUE 'OJR0100 '.OJR0100 00079 SKIP3 OJR0100 00080 05 SYS-TIME. OJR0100 00081 10 SYS-HMS PIC 9(06). OJR0100 00082 10 FILLER PIC X(02). OJR0100 00083 OJR0100 00084 05 PRIOR-FILE-STATUS PIC X(02). OJR0100 00085 88 PRIOR-FILE-OK-88 VALUE '00'. OJR0100 00086 OJR0100 00087 05 POST-FILE-STATUS PIC X(02). OJR0100 00088 88 POST-FILE-OK-88 VALUE '00'. OJR0100 00089 OJR0100 00090 05 WRK-OUT-REC. OJR0100 00091 10 WRK-OUT-REC-JOB PIC X(03). OJR0100 00092 88 WRK-DUMMY-JOB-88 VALUE '000'. OJR0100 00093 10 FILLER PIC X(01) VALUE ','. OJR0100 00094 10 WRK-OUT-REC-PARM PIC X(68). OJR0100 00095 88 WRK-DUMMY-PARM-88 VALUE SPACES. OJR0100 00096 10 FILLER PIC X(08) OJR0100 00097 VALUE SPACES. OJR0100 00098 OJR0100 00099 05 WRK-JOB-NAME PIC X(08). OJR0100 00100 05 FILLER REDEFINES WRK-JOB-NAME. OJR0100 00101 10 FILLER PIC X(05). OJR0100 00102 10 WRK-JOB-NUMBER PIC X(03). OJR0100 00103 OJR0100 00104 05 TBL-SUB PIC S9(04) COMP. OJR0100 00105 05 PARM-LEN PIC S9(04) COMP. OJR0100 00106 05 PARM-SUB PIC S9(04) COMP. OJR0100 00107 05 PARM-MAX-LEN PIC S9(04) COMP OJR0100 00108 VALUE +68. OJR0100 00109 OJR0100 00110 05 JOB-SUB PIC S9(04) COMP. OJR0100 00111 05 SUB PIC S9(04) COMP. OJR0100 00112 05 WRK-JOB-FOUND-IND PIC X(01). OJR0100 00113 88 WRK-JOB-FOUND-YES-88 VALUE 'Y'. OJR0100 00114 88 WRK-JOB-FOUND-NO-88 VALUE 'N'. OJR0100 00115 OJR0100 00116 OJR0100 00117 05 INPUT-PARM-AREA PIC X(32). OJR0100 00118 OJR0100 00119 05 WRK-PARM-AREA PIC X(68). OJR0100 00120 OJR0100 00121 05 WRK-PRIOR-CNT PIC 9(03) COMP-3 OJR0100 00122 VALUE ZERO. OJR0100 00123 05 WRK-POST-CNT PIC 9(03) COMP-3 OJR0100 00124 VALUE ZERO. OJR0100 00125 EJECT OJR0100 00126 01 L924-LINK-AREA. OJR0100 00127 ++INCLUDE DTSIL924 OJR0100 00128 SKIP3 OJR0100 00129 01 RSK3-REC. OJR0100 00130 ++INCLUDE DTSIRSK3 OJR0100 00131 EJECT OJR0100 00132 01 T070-REC. OJR0100 00133 ++INCLUDE DTSIT070 OJR0100 00134 OJR0100 00135 ++INCLUDE OJRIC089 OJR0100 00136 EJECT OJR0100 00137 PROCEDURE DIVISION. OJR0100 00138 SKIP2 OJR0100 00139 PERFORM I0000-INITIATE THRU I0000-EXIT. OJR0100 00140 OJR0100 00141 PERFORM P0000-PROCESS THRU P0000-EXIT. OJR0100 00142 OJR0100 00143 PERFORM T0000-TERMINATE THRU T0000-EXIT. OJR0100 00144 SKIP2 OJR0100 00145 GOBACK. OJR0100 00146 EJECT OJR0100 00147 I0000-INITIATE. OJR0100 00148 PERFORM S1000-OPEN-PRIOR-FILE THRU S1000-EXIT. OJR0100 00149 PERFORM S2000-OPEN-POST-FILE THRU S2000-EXIT. OJR0100 00150 OJR0100 00151 MOVE 'N' TO L924-TRACE-IND. OJR0100 00152 OJR0100 00153 MOVE MOD-NAME TO L924-MOD-NAME. OJR0100 00154 OJR0100 00155 SET L924-OPEN-READ-88 TO TRUE. OJR0100 00156 OJR0100 00157 PERFORM S924-OLA-I THRU S924-EXIT. OJR0100 00158 OJR0100 00159 SET L924-READ-NEXT-88 TO TRUE. OJR0100 00160 OJR0100 00161 I0000-EXIT. OJR0100 00162 EXIT. OJR0100 00163 EJECT OJR0100 00164 P0000-PROCESS. OJR0100 00165 *& OJR0100 00166 * PERFORM P0010-BUILD-T070 THRU P0010-EXIT. OJR0100 00167 * PERFORM P1000-PROCESS-REQUEST THRU P1000-EXIT. OJR0100 00168 *& OJR0100 00169 PERFORM OJR0100 00170 UNTIL L924-NO-REC-88 OJR0100 00171 PERFORM S924-OLA-I THRU S924-EXIT OJR0100 00172 IF L924-OK-88 OJR0100 00173 *& OJR0100 00174 DISPLAY 'REC TYPE ' RSK3-REC-TYPE OJR0100 00175 *& OJR0100 00176 IF RSK3-REC-TYPE = '070' OJR0100 00177 PERFORM P1000-PROCESS-REQUEST THRU P1000-EXIT OJR0100 00178 END-IF OJR0100 00179 END-IF OJR0100 00180 END-PERFORM. OJR0100 00181 OJR0100 00182 P0000-EXIT. OJR0100 00183 EXIT. OJR0100 00184 OJR0100 00185 *P0010-BUILD-T070. OJR0100 00186 * MOVE 'DTSBE423' TO T070-JOB-NAME. OJR0100 00187 * SET T070-JOB-TYPE-POST-UPD TO TRUE. OJR0100 00188 * MOVE '013' TO T070-PARM (1). OJR0100 00189 * MOVE '090101' TO T070-PARM (2). OJR0100 00190 * MOVE '123101' TO T070-PARM (3). OJR0100 00191 *P0010-EXIT. OJR0100 00192 * EXIT. OJR0100 00193 SKIP3 OJR0100 00194 OJR0100 00195 P1000-PROCESS-REQUEST. OJR0100 00196 MOVE RSK3-REC TO T070-REC. OJR0100 00197 MOVE SPACES TO INPUT-PARM-AREA OJR0100 00198 WRK-PARM-AREA. OJR0100 00199 *& OJR0100 00200 DISPLAY 'P1000 ' T070-JOB-NAME OJR0100 00201 ' CNT ' T070-PARM-CNT. OJR0100 00202 *& OJR0100 00203 MOVE T070-JOB-NAME TO WRK-JOB-NAME. OJR0100 00204 MOVE WRK-JOB-NUMBER TO WRK-OUT-REC-JOB. OJR0100 00205 OJR0100 00206 PERFORM P1100-FIND-JOB THRU P1100-EXIT. OJR0100 00207 IF WRK-JOB-FOUND-NO-88 OJR0100 00208 DISPLAY 'JOB NOT IN OJRIC089 ' WRK-JOB-NAME OJR0100 00209 GO TO P1000-EXIT. OJR0100 00210 OJR0100 00211 MOVE +1 TO PARM-SUB. OJR0100 00212 OJR0100 00213 PERFORM P1200-SCAN-TABLE THRU P1200-EXIT OJR0100 00214 VARYING TBL-SUB FROM +1 BY +1 OJR0100 00215 UNTIL TBL-SUB > T070-PARM-CNT. OJR0100 00216 OJR0100 00217 MOVE WRK-PARM-AREA TO WRK-OUT-REC-PARM. OJR0100 00218 IF T070-JOB-TYPE-PRE-UPD OJR0100 00219 PERFORM S1100-WRITE-PRIOR-FILE THRU S1100-EXIT OJR0100 00220 ADD +1 TO WRK-PRIOR-CNT OJR0100 00221 ELSE OJR0100 00222 IF T070-JOB-TYPE-POST-UPD OJR0100 00223 OR T070-JOB-TYPE-READ-ONLY OJR0100 00224 PERFORM S2100-WRITE-POST-FILE THRU S2100-EXIT OJR0100 00225 ADD +1 TO WRK-POST-CNT. OJR0100 00226 OJR0100 00227 P1000-EXIT. OJR0100 00228 EXIT. OJR0100 00229 OJR0100 00230 P1100-FIND-JOB. OJR0100 00231 SET WRK-JOB-FOUND-NO-88 TO TRUE. OJR0100 00232 OJR0100 00233 PERFORM OJR0100 00234 VARYING SUB FROM +1 BY +1 OJR0100 00235 UNTIL SUB > +52 OJR0100 00236 OR WRK-JOB-FOUND-YES-88 OJR0100 00237 IF FOJR-JOB-NAME (SUB) = WRK-JOB-NAME OJR0100 00238 SET WRK-JOB-FOUND-YES-88 TO TRUE OJR0100 00239 MOVE SUB TO JOB-SUB OJR0100 00240 END-IF OJR0100 00241 END-PERFORM. OJR0100 00242 OJR0100 00243 *& OJR0100 00244 DISPLAY 'P1200 ' WRK-JOB-FOUND-IND OJR0100 00245 ' ' JOB-SUB. OJR0100 00246 *& OJR0100 00247 P1100-EXIT. OJR0100 00248 EXIT. OJR0100 00249 OJR0100 00250 P1200-SCAN-TABLE. OJR0100 00251 MOVE T070-PARM (TBL-SUB) TO INPUT-PARM-AREA. OJR0100 00252 OJR0100 00253 MOVE FOJR-PARM-LENGTH (JOB-SUB, TBL-SUB) TO PARM-LEN. OJR0100 00254 OJR0100 00255 *& OJR0100 00256 DISPLAY 'P1200 PARM LEN ' PARM-LEN. OJR0100 00257 *& OJR0100 00258 MOVE INPUT-PARM-AREA (1:PARM-LEN) OJR0100 00259 TO WRK-PARM-AREA (PARM-SUB:PARM-LEN). OJR0100 00260 OJR0100 00261 COMPUTE PARM-SUB = PARM-SUB + PARM-LEN. OJR0100 00262 IF TBL-SUB < T070-PARM-CNT OJR0100 00263 MOVE ',' TO WRK-PARM-AREA (PARM-SUB:1). OJR0100 00264 OJR0100 00265 COMPUTE PARM-SUB = PARM-SUB + 1. OJR0100 00266 IF PARM-SUB > PARM-MAX-LEN OJR0100 00267 SET WRK-EXCESS-LEN-MSG TO TRUE OJR0100 00268 PERFORM S999-ABEND THRU S999-EXIT. OJR0100 00269 OJR0100 00270 *& OJR0100 00271 DISPLAY 'P1200 PARM ' WRK-PARM-AREA. OJR0100 00272 *& OJR0100 00273 P1200-EXIT. OJR0100 00274 EXIT. OJR0100 00275 OJR0100 00276 EJECT OJR0100 00277 T0000-TERMINATE. OJR0100 00278 DISPLAY ' '. OJR0100 00279 OJR0100 00280 DISPLAY '*** OJR0100 TERMINATION STATISTICS ' OJR0100 00281 OJR0100 00282 DISPLAY SPACE. OJR0100 00283 OJR0100 00284 DISPLAY '*** PRIOR UPDATE REQUESTS ' WRK-PRIOR-CNT. OJR0100 00285 DISPLAY '*** POST UPDATE REQUESTS ' WRK-POST-CNT. OJR0100 00286 OJR0100 00287 PERFORM T1000-CHK-DUMMY-REC THRU T1000-EXIT. OJR0100 00288 OJR0100 00289 PERFORM T2000-CLOSE-FILES THRU T2000-EXIT. OJR0100 00290 OJR0100 00291 T0000-EXIT. OJR0100 00292 EXIT. OJR0100 00293 OJR0100 00294 T1000-CHK-DUMMY-REC. OJR0100 00295 * MOVE '413' TO WRK-OUT-REC-JOB. OJR0100 00296 * MOVE '120199' TO WRK-OUT-REC-PARM. OJR0100 00297 * WRITE PRIOR-UPD-REC FROM WRK-OUT-REC. OJR0100 00298 IF WRK-PRIOR-CNT = ZERO OJR0100 00299 SET WRK-DUMMY-JOB-88 TO TRUE OJR0100 00300 SET WRK-DUMMY-PARM-88 TO TRUE OJR0100 00301 DISPLAY 'WRITE DUMMY PRIOR REC' OJR0100 00302 WRITE PRIOR-UPD-REC FROM WRK-OUT-REC. OJR0100 00303 OJR0100 00304 IF WRK-POST-CNT = ZERO OJR0100 00305 SET WRK-DUMMY-JOB-88 TO TRUE OJR0100 00306 SET WRK-DUMMY-PARM-88 TO TRUE OJR0100 00307 DISPLAY 'WRITE DUMMY POST REC' OJR0100 00308 WRITE POST-UPD-REC FROM WRK-OUT-REC. OJR0100 00309 OJR0100 00310 T1000-EXIT. OJR0100 00311 EXIT. OJR0100 00312 OJR0100 00313 T2000-CLOSE-FILES. OJR0100 00314 SET L924-CLOSE-88 TO TRUE. OJR0100 00315 OJR0100 00316 PERFORM S924-OLA-I THRU S924-EXIT. OJR0100 00317 OJR0100 00318 PERFORM S1200-CLOSE-PRIOR-FILE THRU S1200-EXIT. OJR0100 00319 PERFORM S2200-CLOSE-POST-FILE THRU S2200-EXIT. OJR0100 00320 OJR0100 00321 T2000-EXIT. OJR0100 00322 EXIT. OJR0100 00323 OJR0100 00324 EJECT OJR0100 00325 S924-OLA-I. OJR0100 00326 CALL 'DTSBU924' USING L924-LINK-AREA OJR0100 00327 RSK3-REC. OJR0100 00328 S924-EXIT. OJR0100 00329 EXIT. OJR0100 00330 SKIP3 OJR0100 00331 S1000-OPEN-PRIOR-FILE. OJR0100 00332 OPEN OUTPUT PRIOR-UPD-FILE. OJR0100 00333 IF PRIOR-FILE-OK-88 OJR0100 00334 NEXT SENTENCE OJR0100 00335 ELSE OJR0100 00336 SET PRIOR-OPEN-MSG TO TRUE OJR0100 00337 PERFORM S999-ABEND THRU S999-EXIT. OJR0100 00338 OJR0100 00339 S1000-EXIT. OJR0100 00340 EXIT. OJR0100 00341 SKIP3 OJR0100 00342 S1100-WRITE-PRIOR-FILE. OJR0100 00343 WRITE PRIOR-UPD-REC FROM WRK-OUT-REC. OJR0100 00344 IF NOT PRIOR-FILE-OK-88 OJR0100 00345 SET PRIOR-WRITE-MSG TO TRUE OJR0100 00346 PERFORM S999-ABEND THRU S999-EXIT. OJR0100 00347 OJR0100 00348 S1100-EXIT. OJR0100 00349 EXIT. OJR0100 00350 SKIP3 OJR0100 00351 S1200-CLOSE-PRIOR-FILE. OJR0100 00352 CLOSE PRIOR-UPD-FILE. OJR0100 00353 OJR0100 00354 S1200-EXIT. OJR0100 00355 EXIT. OJR0100 00356 SKIP3 OJR0100 00357 S2000-OPEN-POST-FILE. OJR0100 00358 OPEN OUTPUT POST-UPD-FILE. OJR0100 00359 IF POST-FILE-OK-88 OJR0100 00360 NEXT SENTENCE OJR0100 00361 ELSE OJR0100 00362 SET POST-OPEN-MSG TO TRUE OJR0100 00363 PERFORM S999-ABEND THRU S999-EXIT. OJR0100 00364 OJR0100 00365 S2000-EXIT. OJR0100 00366 EXIT. OJR0100 00367 SKIP3 OJR0100 00368 S2100-WRITE-POST-FILE. OJR0100 00369 WRITE POST-UPD-REC FROM WRK-OUT-REC. OJR0100 00370 IF NOT POST-FILE-OK-88 OJR0100 00371 SET POST-WRITE-MSG TO TRUE OJR0100 00372 PERFORM S999-ABEND THRU S999-EXIT. OJR0100 00373 OJR0100 00374 S2100-EXIT. OJR0100 00375 EXIT. OJR0100 00376 SKIP3 OJR0100 00377 S2200-CLOSE-POST-FILE. OJR0100 00378 CLOSE POST-UPD-FILE. OJR0100 00379 OJR0100 00380 S2200-EXIT. OJR0100 00381 EXIT. OJR0100 00382 SKIP3 OJR0100 00383 S999-ABEND. OJR0100 00384 DISPLAY WRK-ABEND-MSG. OJR0100 00385 CALL 'DTSBU999' USING WRK-ABEND-CD. OJR0100 00386 S999-EXIT. OJR0100 00387 EXIT. OJR0100