00001 IDENTIFICATION DIVISION. 05/22/01 00002 PROGRAM-ID. DESBD200. DESBD200 00003 *AUTHOR. TRW INC. LV001 00004 *DATE-WRITTEN. JANUARY 2001. DESBD200 00005 DATE-COMPILED. DESBD200 00006 DESBD200 00007 ***** DESBD200 00008 * DESBD200 00009 * FUNCTION: DESBD200 00010 * DESBD200 00011 * INTERFACE BETWEEN PROGRAMS THAT EDIT DATA SUBMITTED DESBD200 00012 * ELECTRONICALLY, SUCH AS THE WAGE DATA BY THE FISCAL DESBD200 00013 * AGENTS, AND THE ELECTRONIC MEDIA TRACKING SYSTEMS. DESBD200 00014 * DESBD200 RECORDS THE START AND END OF THE JOBS, DESBD200 00015 * INTERCEPTS INFORMATION ABOUT ANY ERRORS FOUND AND DESBD200 00016 * WRITES MESSAGE RECORDS THAT PROVIDE A HISTORY OF DESBD200 00017 * THE PROCESS. IT ALSO UPDATES THE ELOG RECORD, AND DESBD200 00018 * ADDS EMPLOYER HISTORY (EEMH) RECORDS IF THE DATE DESBD200 00019 * REFER TO SPECIFIC EMPLOYERS. DESBD200 00020 * DESBD200 00021 * INPUT: DESBD200 00022 * DESBD200 00023 * DESIL200 - PROCESSING STATUS PASSED FROM DESBD200 00024 * EDIT PROGRAMS THRU THE LINKAGE SECTION. DESBD200 00025 * DTSIC202 - ERROR INFORMATION PASSED FROM DESBD200 00026 * EDIT PROGRAMS THRU THE LINKAGE SECTION. DESBD200 00027 * DTSIEPRF - VSAM ELECTRONIC FILER PROFILE. DESBD200 00028 * DESBD200 00029 * INPUT-OUTPUT; DESBD200 00030 * DESBD200 00031 * DTSIELOG - VSAM LOG FILE. DESBD200 00032 * DTSIEEMH - VSAM HISTORY FILE. DESBD200 00033 * DTSIEMSG - VSAM STATUS AND ERROR MESSAGE FILE. DESBD200 00034 * DESBD200 00035 ***** DESBD200 00036 DESBD200 00037 ******************************************************************DESBD200 00038 * MODIFICATION HISTORY: *DESBD200 00039 * *DESBD200 00040 * 12-01-2000 INITIAL DEVELOPMENT *DESBD200 00041 * REFERENCE RFP # AUTHOR OF CHANGE - RW *DESBD200 00042 * *DESBD200 00043 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *DESBD200 00044 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *DESBD200 00045 * REFERENCE RFP #**** AUTHOR OF CHANGE - *** *DESBD200 00046 ******************************************************************DESBD200 00047 DESBD200 00048 ENVIRONMENT DIVISION. DESBD200 00049 DESBD200 00050 DATA DIVISION. DESBD200 00051 DESBD200 00052 WORKING-STORAGE SECTION. DESBD200 000525 77 PAN-VALET PICTURE X(24) VALUE '001DESBD200 05/22/01'. DESBD200 00053 DESBD200 00054 01 WRK-AREA. DESBD200 00055 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +200. DESBD200 00056 05 WRK-ABEND-MSG PIC X(60) VALUE SPACES. DESBD200 00057 DESBD200 00058 05 WRK-MOD-NAME PIC X(08) VALUE 'DESBD200'. DESBD200 00059 DESBD200 00060 05 WRK-ELOG-REC-UPDATE PIC S9(07) COMP-3 VALUE +0. DESBD200 00061 05 WRK-EEMH-REC-DELETE PIC S9(07) COMP-3 VALUE +0. DESBD200 00062 05 WRK-EMSG-REC-DELETE PIC S9(07) COMP-3 VALUE +0. DESBD200 00063 05 WRK-EMSG-REC-WRITTEN PIC S9(07) COMP-3 VALUE +0. DESBD200 00064 DESBD200 00065 DESBD200 00066 01 WRK-VARIABLES. DESBD200 00067 05 WRK-TRACE-IND PIC X(01) VALUE SPACE. DESBD200 00068 DESBD200 00069 05 WRK-FATAL-ERROR-IND PIC X(01) VALUE ' '. DESBD200 00070 88 WRK-FATAL-ERROR-YES VALUE 'Y'. DESBD200 00071 88 WRK-FATAL-ERROR-NO VALUE 'N'. DESBD200 00072 DESBD200 00073 05 WRK-LOG-NO PIC 9(10) VALUE 0. DESBD200 00074 05 FILLER REDEFINES WRK-LOG-NO. DESBD200 00075 10 WRK-LOG-NO-PFX PIC 9(04). DESBD200 00076 10 WRK-LOG-NO-SFX PIC 9(06). DESBD200 00077 DESBD200 00078 05 WRK-CURR-DATE PIC S9(09) COMP-3 VALUE +0. DESBD200 00079 05 WRK-DISP-DATE PIC X(08). DESBD200 00080 05 WRK-CURR-TIME PIC S9(07) COMP-3 VALUE +0. DESBD200 00081 05 WRK-DISP-TIME PIC X(08). DESBD200 00082 05 WRK-ABSTIME PIC S9(15) COMP-3 VALUE +0. DESBD200 00083 05 WRK-ABSTIME-XOR PIC S9(15) COMP-3 VALUE +0. DESBD200 00084 DESBD200 00085 05 WRK-EMSG-SEQ PIC 9(05) COMP-3 VALUE 0. DESBD200 00086 05 WRK-EEMH-SEQ PIC 9(04) COMP-3 VALUE 0. DESBD200 00087 05 WRK-TOT-CNT PIC S9(05) COMP-3 VALUE +0. DESBD200 00088 05 WRK-EMP-CNT PIC S9(07) COMP-3 VALUE +0. DESBD200 00089 05 WRK-LAST-EMP-NO PIC S9(07) COMP-3 VALUE +0. DESBD200 00090 05 WRK-SUCCESS-CNT PIC S9(07) COMP-3 VALUE +0. DESBD200 00091 DESBD200 00092 05 WRK-ERR-MESSAGE PIC X(60) VALUE SPACES. DESBD200 00093 DESBD200 00094 05 WRK-RESULT-CD PIC X(02) VALUE ZERO. DESBD200 00095 DESBD200 00096 05 WRK-DATE-TYPE PIC X(03) VALUE SPACES. DESBD200 00097 05 WRK-RPT-DATE PIC 9(08) VALUE 0. DESBD200 00098 05 WRK-RPT-DATE-IN PIC 9(08) VALUE 0. DESBD200 00099 05 FILLER REDEFINES WRK-RPT-DATE-IN. DESBD200 00100 10 FILLER PIC 9(03). DESBD200 00101 10 WRK-RPT-DATE-IN-5 PIC 9(05). DESBD200 00102 05 FILLER REDEFINES WRK-RPT-DATE-IN. DESBD200 00103 10 FILLER PIC 9(05). DESBD200 00104 10 WRK-RPT-DATE-IN-3 PIC 9(03). DESBD200 00105 DESBD200 00106 01 C200-CONSTANTS-AREA. DESBD200 00107 ++INCLUDE DTSIC200 DESBD200 00108 EJECT DESBD200 00109 01 C201-LINK-AREA. DESBD200 00110 ++INCLUDE DTSIC201 DESBD200 00111 EJECT DESBD200 00112 01 L004-LINK-AREA. DESBD200 00113 ++INCLUDE DTSIL004 DESBD200 00114 EJECT DESBD200 00115 01 L005-LINK-AREA. DESBD200 00116 ++INCLUDE DTSIL005 DESBD200 00117 EJECT DESBD200 00118 01 L222-LINK-AREA. DESBD200 00119 ++INCLUDE DTSIL222 DESBD200 00120 EJECT DESBD200 00121 01 L921-LINK-AREA. DESBD200 00122 ++INCLUDE DTSIL921 DESBD200 00123 EJECT DESBD200 00124 01 ISKL-REC. DESBD200 00125 ++INCLUDE DTSIISKL DESBD200 00126 EJECT DESBD200 00127 01 IEAL-REC. DESBD200 00128 ++INCLUDE DTSIIEAL DESBD200 00129 EJECT DESBD200 00130 01 L935-LINK-AREA. DESBD200 00131 ++INCLUDE DTSIL935 DESBD200 00132 EJECT DESBD200 00133 01 ESKL-REC. DESBD200 00134 ++INCLUDE DTSIESKL DESBD200 00135 EJECT DESBD200 00136 01 EPRF-REC. DESBD200 00137 ++INCLUDE DTSIEPRF DESBD200 00138 EJECT DESBD200 00139 01 ELOG-REC. DESBD200 00140 ++INCLUDE DTSIELOG DESBD200 00141 EJECT DESBD200 00142 01 EMSG-REC. DESBD200 00143 ++INCLUDE DTSIEMSG DESBD200 00144 EJECT DESBD200 00145 01 EEMH-REC. DESBD200 00146 ++INCLUDE DTSIEEMH DESBD200 00147 EJECT DESBD200 00148 01 L941-LINK-AREA. DESBD200 00149 ++INCLUDE DTSIL941 DESBD200 00150 EJECT DESBD200 00151 01 RSK4-REC. DESBD200 00152 ++INCLUDE DTSIRSK4 DESBD200 00153 EJECT DESBD200 00154 DESBD200 00155 LINKAGE SECTION. DESBD200 00156 DESBD200 00157 01 L200-LINK-AREA. DESBD200 00158 ++INCLUDE DESIL200 DESBD200 00159 DESBD200 00160 01 C202-LINK-AREA. DESBD200 00161 ++INCLUDE DTSIC202 DESBD200 00162 DESBD200 00163 PROCEDURE DIVISION USING L200-LINK-AREA DESBD200 00164 C202-LINK-AREA. DESBD200 00165 DESBD200 00166 DESBD200-MAIN. DESBD200 00167 DESBD200 00168 SET WRK-FATAL-ERROR-NO TO TRUE. DESBD200 00169 DESBD200 00170 IF L200-CMD-INIT-88 DESBD200 00171 PERFORM I0000-INIT THRU I0000-EXIT DESBD200 00172 IF WRK-FATAL-ERROR-NO DESBD200 00173 PERFORM P2000-WRITE-EMSG THRU P2000-EXIT DESBD200 00174 END-IF DESBD200 00175 ELSE DESBD200 00176 IF L200-CMD-EMP-COMPLETE-88 DESBD200 00177 PERFORM P3000-EMP-COMPLETE THRU P3000-EXIT DESBD200 00178 ELSE DESBD200 00179 IF L200-CMD-TERMINATE-88 DESBD200 00180 PERFORM T0000-TERMINATE THRU T0000-EXIT DESBD200 00181 ELSE DESBD200 00182 DISPLAY 'INVALID L200-COMMAND-CD VALUE ' DESBD200 00183 END-IF DESBD200 00184 END-IF DESBD200 00185 END-IF. DESBD200 00186 DESBD200 00187 DESBD200-EXIT. DESBD200 00188 DESBD200 00189 GOBACK. DESBD200 00190 DESBD200 00191 ******************************************************************DESBD200 00192 * OPEN FILES AND INITIALIZE WORKING-STORAGE AND LINKAGE. *DESBD200 00193 * IF THE EDIT PROGAM HAS ATTEMPTED TO PROCESS THIS ITEM *DESBD200 00194 * PREVIOUSLY, AND IS NOW BEING RE-RUN, DESBD200 00195 * DELETE ANY ERROR MESSAGE RECORDS AND EMPLOYER *DESBD200 00196 * HISTORY RECORDS FROM THE PREVIOUS RUN. DESBD200 00197 ******************************************************************DESBD200 00198 I0000-INIT. DESBD200 00199 DESBD200 00200 PERFORM I1000-OPEN-FILES THRU I1000-EXIT. DESBD200 00201 PERFORM I2000-DATE-TIME THRU I2000-EXIT. DESBD200 00202 PERFORM I3000-INIT-ERR-TAB THRU I3000-EXIT. DESBD200 00203 PERFORM I4000-GET-LOG THRU I4000-EXIT. DESBD200 00204 IF WRK-FATAL-ERROR-YES DESBD200 00205 GO TO I0000-EXIT. DESBD200 00206 DESBD200 00207 I0000-EXIT. DESBD200 00208 EXIT. DESBD200 00209 DESBD200 00210 I1000-OPEN-FILES. DESBD200 00211 MOVE ' ' TO WRK-TRACE-IND. DESBD200 00212 DESBD200 00213 MOVE WRK-TRACE-IND TO L921-TRACE-IND DESBD200 00214 L935-TRACE-IND. DESBD200 00215 DESBD200 00216 MOVE WRK-MOD-NAME TO L921-MOD-NAME DESBD200 00217 L935-MOD-NAME. DESBD200 00218 DESBD200 00219 MOVE ZERO TO WRK-TOT-CNT DESBD200 00220 WRK-EMP-CNT DESBD200 00221 WRK-SUCCESS-CNT. DESBD200 00222 DESBD200 00223 PERFORM S921-OPEN-READ THRU S921-EXIT. DESBD200 00224 PERFORM S935-OPEN-READ THRU S935-EXIT. DESBD200 00225 DESBD200 00226 I1000-EXIT. DESBD200 00227 EXIT. DESBD200 00228 DESBD200 00229 ******************************************************************DESBD200 00230 * GET CURRENT SYSTEM DATE AND TIME *DESBD200 00231 ******************************************************************DESBD200 00232 I2000-DATE-TIME. DESBD200 00233 DESBD200 00234 PERFORM S005-FROM-SYS THRU S005-EXIT. DESBD200 00235 DESBD200 00236 MOVE L005-DATE TO WRK-CURR-DATE. DESBD200 00237 MOVE L005-TIME TO WRK-CURR-TIME. DESBD200 00238 MOVE L005-ABSTIME TO WRK-ABSTIME. DESBD200 00239 MOVE L005-NINES-COMPLEMENT-ABSTIME DESBD200 00240 TO WRK-ABSTIME-XOR. DESBD200 00241 MOVE L005-SLASH-DATE TO WRK-DISP-DATE. DESBD200 00242 MOVE L005-DISPLAY-TIME TO WRK-DISP-TIME. DESBD200 00243 DESBD200 00244 I2000-EXIT. DESBD200 00245 EXIT. DESBD200 00246 DESBD200 00247 ******************************************************************DESBD200 00248 * INITIALIZE WRK-ERROR-TABLE *DESBD200 00249 ******************************************************************DESBD200 00250 I3000-INIT-ERR-TAB. DESBD200 00251 DESBD200 00252 SET EMSG101-SELECTED-NO TO TRUE. DESBD200 00253 SET EMSG102-SELECTED-NO TO TRUE. DESBD200 00254 SET EMSG103-SELECTED-NO TO TRUE. DESBD200 00255 SET EMSG104-SELECTED-NO TO TRUE. DESBD200 00256 SET EMSG105-SELECTED-NO TO TRUE. DESBD200 00257 SET EMSG106-SELECTED-NO TO TRUE. DESBD200 00258 SET EMSG107-SELECTED-NO TO TRUE. DESBD200 00259 SET EMSG108-SELECTED-NO TO TRUE. DESBD200 00260 SET EMSG109-SELECTED-NO TO TRUE. DESBD200 00261 SET EMSG110-SELECTED-NO TO TRUE. DESBD200 00262 SET EMSG111-SELECTED-NO TO TRUE. DESBD200 00263 SET EMSG112-SELECTED-NO TO TRUE. DESBD200 00264 SET EMSG113-SELECTED-NO TO TRUE. DESBD200 00265 SET EMSG114-SELECTED-NO TO TRUE. DESBD200 00266 I3000-EXIT. DESBD200 00267 EXIT. DESBD200 00268 DESBD200 00269 DESBD200 00270 ******************************************************************DESBD200 00271 * GET THE LOG AND PROFILE RECORDS *DESBD200 00272 ******************************************************************DESBD200 00273 I4000-GET-LOG. DESBD200 00274 DESBD200 00275 MOVE ZERO TO WRK-LOG-NO. DESBD200 00276 DESBD200 00277 IF L200-LOG-NO-SFX NOT NUMERIC DESBD200 00278 DISPLAY '>>> DESBD200 ABENDING <<<' DESBD200 00279 DISPLAY '>>> NON-NUMERIC LOG NUMBER ' L200-LOG-NO-SFX DESBD200 00280 PERFORM S999-ABEND THRU S999-EXIT DESBD200 00281 ELSE DESBD200 00282 MOVE L200-LOG-NO-SFX TO WRK-LOG-NO-SFX. DESBD200 00283 DESBD200 00284 PERFORM S1000-READ-ELOG THRU S1000-EXIT. DESBD200 00285 IF WRK-FATAL-ERROR-YES DESBD200 00286 DISPLAY '>>> DESBD200 ABENDING <<<' DESBD200 00287 DISPLAY '>>> INVALID LOG NUMBER ' L200-LOG-NO DESBD200 00288 PERFORM S999-ABEND THRU S999-EXIT. DESBD200 00289 DESBD200 00290 PERFORM S2000-READ-EPRF THRU S2000-EXIT. DESBD200 00291 IF WRK-FATAL-ERROR-YES DESBD200 00292 DISPLAY '>>> DESBD200 ABENDING <<<' DESBD200 00293 DISPLAY '>>> NO PROFILE RECORD ' L200-LOG-NO DESBD200 00294 PERFORM S999-ABEND THRU S999-EXIT. DESBD200 00295 DESBD200 00296 MOVE WRK-LOG-NO TO L200-LOG-NO. DESBD200 00297 I4000-EXIT. DESBD200 00298 EXIT. DESBD200 00299 DESBD200 00300 ******************************************************************DESBD200 00301 * WRITE MESSAGE INDICATING THE JOB HAS BEGUN *DESBD200 00302 ******************************************************************DESBD200 00303 P2000-WRITE-EMSG. DESBD200 00304 MOVE LOW-VALUES TO EMSG-REC. DESBD200 00305 SET EMSG-MSG-88 TO TRUE. DESBD200 00306 MOVE ELOG-LOG-NO TO EMSG-LOG-NO. DESBD200 00307 MOVE WRK-ABSTIME TO EMSG-ABSTIME. DESBD200 00308 ADD 1 TO WRK-EMSG-SEQ. DESBD200 00309 MOVE WRK-EMSG-SEQ TO EMSG-SEQ. DESBD200 00310 DESBD200 00311 SET EMSG-TYPE-STATUS-88 TO TRUE. DESBD200 00312 MOVE WRK-DISP-DATE TO SMSG005-DATE. DESBD200 00313 MOVE WRK-DISP-TIME TO SMSG005-TIME. DESBD200 00314 MOVE SMSG005-PROCESS-START-LONG TO EMSG-FULL-MESSAGE. DESBD200 00315 MOVE SMSG005-PROCESS-START-SHORT TO EMSG-SHORT-MESSAGE. DESBD200 00316 MOVE L200-PROG-NAME TO EMSG-ESTB-OPID. DESBD200 00317 DESBD200 00318 COMPUTE RSK4-LENGTH = DESBD200 00319 (LENGTH OF RSK4-CONTROL-AREA + LENGTH OF EMSG-REC). DESBD200 00320 MOVE ELOG-LOG-NO TO RSK4-LOG-NO. DESBD200 00321 MOVE 'MSG' TO RSK4-REC-TYPE. DESBD200 00322 MOVE EMSG-REC TO RSK4-REC-AREA. DESBD200 00323 PERFORM S946-TRN-REC-O THRU S946-EXIT. DESBD200 00324 DESBD200 00325 P2000-EXIT. DESBD200 00326 EXIT. DESBD200 00327 DESBD200 00328 P3000-EMP-COMPLETE. DESBD200 00329 IF WRK-FATAL-ERROR-YES DESBD200 00330 GO TO P3000-EXIT. DESBD200 00331 DESBD200 00332 IF L200-EMP-NO = ZERO DESBD200 00333 DISPLAY 'L200-EMP-NO = ZERO ' DESBD200 00334 GO TO P3000-EXIT. DESBD200 00335 DESBD200 00336 ADD L200-TOT-CNT TO WRK-TOT-CNT. DESBD200 00337 ADD L200-SUCCESS-CNT TO WRK-SUCCESS-CNT. DESBD200 00338 ADD +1 TO WRK-EMP-CNT. DESBD200 00339 DESBD200 00340 PERFORM P3100-BUILD-EEMH THRU P3100-EXIT. DESBD200 00341 COMPUTE RSK4-LENGTH = DESBD200 00342 (LENGTH OF RSK4-CONTROL-AREA + LENGTH OF EEMH-REC). DESBD200 00343 MOVE ELOG-LOG-NO TO RSK4-LOG-NO. DESBD200 00344 MOVE 'EMH' TO RSK4-REC-TYPE. DESBD200 00345 MOVE EEMH-REC TO RSK4-REC-AREA. DESBD200 00346 PERFORM S946-TRN-REC-O THRU S946-EXIT. DESBD200 00347 DESBD200 00348 MOVE ZERO TO L200-EMP-NO DESBD200 00349 L200-TOT-CNT DESBD200 00350 L200-SUCCESS-CNT. DESBD200 00351 DESBD200 00352 P3000-EXIT. DESBD200 00353 EXIT. DESBD200 00354 DESBD200 00355 P3100-BUILD-EEMH. DESBD200 00356 PERFORM P3110-DATE-TYPE THRU P3110-EXIT. DESBD200 00357 DESBD200 00358 MOVE LOW-VALUES TO EEMH-REC. DESBD200 00359 DESBD200 00360 SET EEMH-EMH-88 TO TRUE. DESBD200 00361 MOVE L200-EMP-NO TO EEMH-EMP-NO DESBD200 00362 WRK-LAST-EMP-NO. DESBD200 00363 MOVE WRK-RPT-DATE TO EEMH-REPORTING-DATE. DESBD200 00364 MOVE ELOG-DATA-TYPE-CD TO EEMH-DATA-TYPE-CD DESBD200 00365 MOVE ELOG-LOG-NO TO EEMH-LOG-NO. DESBD200 00366 MOVE LOW-VALUES TO EEMH-KEY-FILLER. DESBD200 00367 DESBD200 00368 IF L200-SUCCESS-CNT = ZERO DESBD200 00369 SET EEMH-RC-FAILED-88 TO TRUE DESBD200 00370 ELSE DESBD200 00371 IF L200-SUCCESS-CNT < L200-TOT-CNT DESBD200 00372 SET EEMH-RC-PART-SUCCESS-88 TO TRUE DESBD200 00373 ELSE DESBD200 00374 SET EEMH-RC-SUCCESSFUL-88 TO TRUE. DESBD200 00375 DESBD200 00376 MOVE ELOG-ELF-ID TO EEMH-ELF-ID. DESBD200 00377 ADD 1 TO WRK-EEMH-SEQ. DESBD200 00378 MOVE WRK-EEMH-SEQ TO EEMH-EMP-SEQ-NO. DESBD200 00379 MOVE SPACES TO EEMH-FILLER. DESBD200 00380 DESBD200 00381 *& DESBD200 00382 DISPLAY 'EEMH WRITTEN ' EEMH-EMP-NO. DESBD200 00383 DESBD200 00384 P3100-EXIT. DESBD200 00385 EXIT. DESBD200 00386 DESBD200 00387 P3110-DATE-TYPE. DESBD200 00388 MOVE SPACES TO WRK-DATE-TYPE. DESBD200 00389 DESBD200 00390 PERFORM DESBD200 00391 VARYING C200-IDX FROM +1 BY +1 DESBD200 00392 UNTIL C200-IDX > C200-TABLE-MAX DESBD200 00393 IF C200-PROG-NAME (C200-IDX) = L200-PROG-NAME DESBD200 00394 MOVE C200-DATE-TYPE (C200-IDX) TO WRK-DATE-TYPE DESBD200 00395 END-IF DESBD200 00396 END-PERFORM. DESBD200 00397 DESBD200 00398 IF WRK-DATE-TYPE = SPACES DESBD200 00399 DISPLAY 'C200 TABLE ERROR' DESBD200 00400 MOVE WRK-CURR-DATE TO WRK-RPT-DATE DESBD200 00401 GO TO P3110-EXIT. DESBD200 00402 DESBD200 00403 MOVE L200-REPORTING-DATE TO WRK-RPT-DATE-IN. DESBD200 00404 DESBD200 00405 IF WRK-DATE-TYPE = 'Q01' DESBD200 00406 MOVE WRK-RPT-DATE-IN-5 TO L004-QTR-5-X DESBD200 00407 PERFORM S004-FROM-5 THRU S004-EXIT DESBD200 00408 ELSE DESBD200 00409 IF WRK-DATE-TYPE = 'Q02' DESBD200 00410 MOVE WRK-RPT-DATE-IN-3 TO L004-QTR-3-X DESBD200 00411 PERFORM S004-FROM-3 THRU S004-EXIT. DESBD200 00412 DESBD200 00413 IF L004-VALID-QTR DESBD200 00414 MOVE L004-QTR-END-DATE TO WRK-RPT-DATE DESBD200 00415 ELSE DESBD200 00416 DISPLAY 'INVALID QUARTER PASSED ' DESBD200 00417 L200-REPORTING-DATE DESBD200 00418 MOVE WRK-CURR-DATE TO WRK-RPT-DATE. DESBD200 00419 P3110-EXIT. DESBD200 00420 EXIT. DESBD200 00421 DESBD200 00422 DESBD200 00423 T0000-TERMINATE. DESBD200 00424 IF L200-EMP-NO NOT = ZERO DESBD200 00425 PERFORM P3000-EMP-COMPLETE THRU P3000-EXIT DESBD200 00426 END-IF. DESBD200 00427 DESBD200 00428 IF WRK-FATAL-ERROR-NO DESBD200 00429 PERFORM T1000-BUILD-ERR-MSG THRU T1000-EXIT DESBD200 00430 PERFORM T2000-BUILD-SUM-MSG THRU T2000-EXIT DESBD200 00431 DESBD200 00432 PERFORM T4000-CLOSE-FILES THRU T4000-EXIT. DESBD200 00433 DESBD200 00434 T0000-EXIT. DESBD200 00435 EXIT. DESBD200 00436 EJECT DESBD200 00437 DESBD200 00438 T1000-BUILD-ERR-MSG. DESBD200 00439 IF EMSG101-SELECTED-YES DESBD200 00440 MOVE EMSG101-INV-QTR-CD TO WRK-ERR-MESSAGE DESBD200 00441 PERFORM T1100-WRITE-ERROR THRU T1100-EXIT DESBD200 00442 END-IF. DESBD200 00443 DESBD200 00444 IF EMSG102-SELECTED-YES DESBD200 00445 MOVE EMSG102-NONE-NUM-YR TO WRK-ERR-MESSAGE DESBD200 00446 PERFORM T1100-WRITE-ERROR THRU T1100-EXIT DESBD200 00447 END-IF. DESBD200 00448 DESBD200 00449 IF EMSG103-SELECTED-YES DESBD200 00450 MOVE EMSG103-NO-MATCH-PROC-YR TO WRK-ERR-MESSAGE DESBD200 00451 PERFORM T1100-WRITE-ERROR THRU T1100-EXIT DESBD200 00452 END-IF. DESBD200 00453 DESBD200 00454 IF EMSG104-SELECTED-YES DESBD200 00455 MOVE EMSG104-NONE-NUM-SSN TO WRK-ERR-MESSAGE DESBD200 00456 PERFORM T1100-WRITE-ERROR THRU T1100-EXIT DESBD200 00457 END-IF. DESBD200 00458 DESBD200 00459 IF EMSG105-SELECTED-YES DESBD200 00460 MOVE EMSG105-NONE-NUM-EARN TO WRK-ERR-MESSAGE DESBD200 00461 PERFORM T1100-WRITE-ERROR THRU T1100-EXIT DESBD200 00462 END-IF. DESBD200 00463 DESBD200 00464 IF EMSG106-SELECTED-YES DESBD200 00465 MOVE EMSG106-ZERO-EARN TO WRK-ERR-MESSAGE DESBD200 00466 PERFORM T1100-WRITE-ERROR THRU T1100-EXIT DESBD200 00467 END-IF. DESBD200 00468 DESBD200 00469 IF EMSG107-SELECTED-YES DESBD200 00470 MOVE EMSG107-NAME-MISSING TO WRK-ERR-MESSAGE DESBD200 00471 PERFORM T1100-WRITE-ERROR THRU T1100-EXIT DESBD200 00472 END-IF. DESBD200 00473 DESBD200 00474 IF EMSG108-SELECTED-YES DESBD200 00475 MOVE EMSG108-NONE-NUM-ACCT TO WRK-ERR-MESSAGE DESBD200 00476 PERFORM T1100-WRITE-ERROR THRU T1100-EXIT DESBD200 00477 END-IF. DESBD200 00478 DESBD200 00479 IF EMSG109-SELECTED-YES DESBD200 00480 MOVE EMSG109-INV-EMPL-ACCT TO WRK-ERR-MESSAGE DESBD200 00481 PERFORM T1100-WRITE-ERROR THRU T1100-EXIT DESBD200 00482 END-IF. DESBD200 00483 DESBD200 00484 IF EMSG110-SELECTED-YES DESBD200 00485 MOVE EMSG110-EMPL-NAME-SPACE TO WRK-ERR-MESSAGE DESBD200 00486 PERFORM T1100-WRITE-ERROR THRU T1100-EXIT DESBD200 00487 END-IF. DESBD200 00488 DESBD200 00489 IF EMSG111-SELECTED-YES DESBD200 00490 MOVE EMSG111-NAME-CHECK-BLANK TO WRK-ERR-MESSAGE DESBD200 00491 PERFORM T1100-WRITE-ERROR THRU T1100-EXIT DESBD200 00492 END-IF. DESBD200 00493 DESBD200 00494 IF EMSG112-SELECTED-YES DESBD200 00495 MOVE EMSG112-NONE-NUM-TRAN-ID TO WRK-ERR-MESSAGE DESBD200 00496 PERFORM T1100-WRITE-ERROR THRU T1100-EXIT DESBD200 00497 END-IF. DESBD200 00498 DESBD200 00499 IF EMSG113-SELECTED-YES DESBD200 00500 MOVE EMSG113-NONE-NUM-TRAN-DATE TO WRK-ERR-MESSAGE DESBD200 00501 PERFORM T1100-WRITE-ERROR THRU T1100-EXIT DESBD200 00502 END-IF. DESBD200 00503 DESBD200 00504 IF EMSG114-SELECTED-YES DESBD200 00505 MOVE EMSG114-NONE-NUM-TRAN-TIME TO WRK-ERR-MESSAGE DESBD200 00506 PERFORM T1100-WRITE-ERROR THRU T1100-EXIT DESBD200 00507 END-IF. DESBD200 00508 DESBD200 00509 T1000-EXIT. DESBD200 00510 EXIT. DESBD200 00511 DESBD200 00512 T1100-WRITE-ERROR. DESBD200 00513 MOVE LOW-VALUES TO ESKL-KEY-AREA. DESBD200 00514 SET EMSG-MSG-88 TO TRUE. DESBD200 00515 MOVE ELOG-LOG-NO TO EMSG-LOG-NO. DESBD200 00516 MOVE WRK-ABSTIME TO EMSG-ABSTIME. DESBD200 00517 ADD 1 TO WRK-EMSG-SEQ. DESBD200 00518 MOVE WRK-EMSG-SEQ TO EMSG-SEQ. DESBD200 00519 DESBD200 00520 SET EMSG-TYPE-ERROR-88 TO TRUE. DESBD200 00521 MOVE WRK-ERR-MESSAGE TO EMSG-FULL-MESSAGE. DESBD200 00522 MOVE SPACES TO EMSG-SHORT-MESSAGE. DESBD200 00523 MOVE SPACES TO EMSG-FILLER. DESBD200 00524 MOVE L200-PROG-NAME TO EMSG-ESTB-OPID. DESBD200 00525 DESBD200 00526 COMPUTE RSK4-LENGTH = DESBD200 00527 (LENGTH OF RSK4-CONTROL-AREA + LENGTH OF EMSG-REC). DESBD200 00528 MOVE ELOG-LOG-NO TO RSK4-LOG-NO. DESBD200 00529 MOVE 'MSG' TO RSK4-REC-TYPE. DESBD200 00530 MOVE EMSG-REC TO RSK4-REC-AREA. DESBD200 00531 PERFORM S946-TRN-REC-O THRU S946-EXIT. DESBD200 00532 DESBD200 00533 DISPLAY 'ERROR WRITTEN ' WRK-ERR-MESSAGE. DESBD200 00534 T1100-EXIT. DESBD200 00535 EXIT. DESBD200 00536 DESBD200 00537 T2000-BUILD-SUM-MSG. DESBD200 00538 MOVE LOW-VALUES TO ESKL-KEY-AREA. DESBD200 00539 SET EMSG-MSG-88 TO TRUE. DESBD200 00540 MOVE ELOG-LOG-NO TO EMSG-LOG-NO. DESBD200 00541 MOVE WRK-ABSTIME TO EMSG-ABSTIME. DESBD200 00542 ADD 1 TO WRK-EMSG-SEQ. DESBD200 00543 MOVE WRK-EMSG-SEQ TO EMSG-SEQ. DESBD200 00544 DESBD200 00545 SET EMSG-TYPE-SUMMARY-88 TO TRUE. DESBD200 00546 MOVE WRK-TOT-CNT TO EMSG100-TOT-CNT. DESBD200 00547 MOVE WRK-SUCCESS-CNT TO EMSG100-SUCCESS-CNT. DESBD200 00548 MOVE EMSG100-WAGE-SUMMARY TO EMSG-FULL-MESSAGE. DESBD200 00549 DESBD200 00550 IF WRK-SUCCESS-CNT = ZERO DESBD200 00551 MOVE 'FAILED' TO EMSG-SHORT-MESSAGE DESBD200 00552 ELSE DESBD200 00553 IF WRK-SUCCESS-CNT < WRK-TOT-CNT DESBD200 00554 MOVE 'PART SUCCESS' TO EMSG-SHORT-MESSAGE DESBD200 00555 ELSE DESBD200 00556 MOVE 'SUCCESSFUL' TO EMSG-SHORT-MESSAGE. DESBD200 00557 DESBD200 00558 MOVE SPACES TO EMSG-FILLER. DESBD200 00559 DESBD200 00560 MOVE L200-PROG-NAME TO EMSG-ESTB-OPID. DESBD200 00561 DESBD200 00562 COMPUTE RSK4-LENGTH = DESBD200 00563 (LENGTH OF RSK4-CONTROL-AREA + LENGTH OF EMSG-REC). DESBD200 00564 MOVE ELOG-LOG-NO TO RSK4-LOG-NO. DESBD200 00565 MOVE 'MSG' TO RSK4-REC-TYPE. DESBD200 00566 MOVE EMSG-REC TO RSK4-REC-AREA. DESBD200 00567 PERFORM S946-TRN-REC-O THRU S946-EXIT. DESBD200 00568 DESBD200 00569 DESBD200 00570 DISPLAY 'SUMMARY MESSAGE ' EMSG100-WAGE-SUMMARY. DESBD200 00571 T2000-EXIT. DESBD200 00572 EXIT. DESBD200 00573 DESBD200 00574 ******************************************************************DESBD200 00575 * WHEN PROCESS IS COMPLETED SET L222-END-UPDATE *DESBD200 00576 * TO TRUE AND CALL DTSBU222 TO UN-LOCK THE EPRF. *DESBD200 00577 ******************************************************************DESBD200 00578 T4000-CLOSE-FILES. DESBD200 00579 DESBD200 00580 PERFORM S921-CLOSE THRU S921-EXIT. DESBD200 00581 PERFORM S935-CLOSE THRU S935-EXIT. DESBD200 00582 DESBD200 00583 DISPLAY '*** DESBD200 TERMINATION STATISTICS ' DESBD200 00584 DESBD200 00585 MOVE -1 TO RSK4-LENGTH. DESBD200 00586 DESBD200 00587 PERFORM S946-TRN-REC-O THRU S946-EXIT. DESBD200 00588 DESBD200 00589 T4000-EXIT. DESBD200 00590 EXIT. DESBD200 00591 DESBD200 00592 S004-FROM-5. DESBD200 00593 SET L004-FROM-5 TO TRUE. DESBD200 00594 GO TO S004-YRQ. DESBD200 00595 DESBD200 00596 S004-FROM-3. DESBD200 00597 SET L004-FROM-3 TO TRUE. DESBD200 00598 GO TO S004-YRQ. DESBD200 00599 DESBD200 00600 S004-YRQ. DESBD200 00601 CALL 'DTSBU004' USING L004-LINK-AREA. DESBD200 00602 DESBD200 00603 S004-EXIT. DESBD200 00604 EXIT. DESBD200 00605 DESBD200 00606 S005-FROM-SYS. DESBD200 00607 SET L005-FROM-SYS TO TRUE. DESBD200 00608 GO TO S005-ABSTIME. DESBD200 00609 DESBD200 00610 S005-ABSTIME. DESBD200 00611 CALL 'DTSBU005' USING L005-LINK-AREA. DESBD200 00612 DESBD200 00613 S005-EXIT. DESBD200 00614 EXIT. DESBD200 00615 DESBD200 00616 S921-OPEN-READ. DESBD200 00617 SET L921-OPEN-READ-88 TO TRUE. DESBD200 00618 GO TO S921-AIX-IO. DESBD200 00619 DESBD200 00620 S921-READ. DESBD200 00621 SET L921-READ-88 TO TRUE. DESBD200 00622 GO TO S921-AIX-IO. DESBD200 00623 DESBD200 00624 S921-START-BROWSE. DESBD200 00625 SET L921-START-BROWSE-88 TO TRUE. DESBD200 00626 GO TO S921-AIX-IO. DESBD200 00627 DESBD200 00628 S921-READ-NEXT. DESBD200 00629 SET L921-READ-NEXT-88 TO TRUE. DESBD200 00630 GO TO S921-AIX-IO. DESBD200 00631 DESBD200 00632 S921-CLOSE. DESBD200 00633 SET L921-CLOSE-88 TO TRUE. DESBD200 00634 GO TO S921-AIX-IO. DESBD200 00635 DESBD200 00636 S921-AIX-IO. DESBD200 00637 CALL 'DTSBU921' USING L921-LINK-AREA DESBD200 00638 ISKL-REC. DESBD200 00639 S921-EXIT. DESBD200 00640 EXIT. DESBD200 00641 SKIP3 DESBD200 00642 DESBD200 00643 S935-OPEN-READ. DESBD200 00644 SET L935-OPEN-READ-88 TO TRUE. DESBD200 00645 GO TO S935-ELF-IO. DESBD200 00646 DESBD200 00647 S935-READ. DESBD200 00648 SET L935-READ-88 TO TRUE. DESBD200 00649 GO TO S935-ELF-IO. DESBD200 00650 DESBD200 00651 S935-START-BROWSE. DESBD200 00652 SET L935-START-BROWSE-88 TO TRUE. DESBD200 00653 GO TO S935-ELF-IO. DESBD200 00654 DESBD200 00655 S935-READ-NEXT. DESBD200 00656 SET L935-READ-NEXT-88 TO TRUE. DESBD200 00657 GO TO S935-ELF-IO. DESBD200 00658 DESBD200 00659 S935-CLOSE. DESBD200 00660 SET L935-CLOSE-88 TO TRUE. DESBD200 00661 GO TO S935-ELF-IO. DESBD200 00662 DESBD200 00663 S935-ELF-IO. DESBD200 00664 CALL 'DTSBU935' USING L935-LINK-AREA DESBD200 00665 ESKL-REC. DESBD200 00666 S935-EXIT. DESBD200 00667 EXIT. DESBD200 00668 SKIP3 DESBD200 00669 DESBD200 00670 S946-TRN-REC-O. DESBD200 00671 CALL 'DTSBU946' USING RSK4-REC. DESBD200 00672 S946-EXIT. DESBD200 00673 EXIT. DESBD200 00674 DESBD200 00675 S1000-READ-ELOG. DESBD200 00676 MOVE LOW-VALUES TO IEAL-KEY-AREA DESBD200 00677 SET IEAL-EAL-88 TO TRUE DESBD200 00678 MOVE WRK-LOG-NO-SFX TO IEAL-LOG-NO-SFX DESBD200 00679 MOVE ZEROS TO IEAL-LOG-NO DESBD200 00680 MOVE IEAL-REC TO ISKL-REC. DESBD200 00681 PERFORM S921-START-BROWSE THRU S921-EXIT. DESBD200 00682 IF L921-OK-88 DESBD200 00683 MOVE ISKL-REC TO IEAL-REC DESBD200 00684 IF IEAL-LOG-NO-SFX = WRK-LOG-NO-SFX DESBD200 00685 MOVE IEAL-LOG-NO TO WRK-LOG-NO DESBD200 00686 ELSE DESBD200 00687 DISPLAY 'INVALID READ L200-LOG-NO: ' L200-LOG-NO DESBD200 00688 SET WRK-FATAL-ERROR-YES TO TRUE DESBD200 00689 GO TO S1000-EXIT DESBD200 00690 ELSE DESBD200 00691 DISPLAY 'INVALID READ L200-LOG-NO: ' L200-LOG-NO DESBD200 00692 SET WRK-FATAL-ERROR-YES TO TRUE DESBD200 00693 GO TO S1000-EXIT. DESBD200 00694 DESBD200 00695 MOVE LOW-VALUES TO ELOG-REC. DESBD200 00696 MOVE WRK-LOG-NO TO ELOG-LOG-NO. DESBD200 00697 SET ELOG-LOG-88 TO TRUE. DESBD200 00698 MOVE ELOG-KEY-AREA TO ESKL-KEY-AREA. DESBD200 00699 DESBD200 00700 PERFORM S935-READ THRU S935-EXIT. DESBD200 00701 DESBD200 00702 IF L935-NO-REC-88 DESBD200 00703 DISPLAY 'INVALID READ L200-LOG-NO: ' L200-LOG-NO DESBD200 00704 SET WRK-FATAL-ERROR-YES TO TRUE DESBD200 00705 ELSE DESBD200 00706 MOVE ESKL-REC TO ELOG-REC DESBD200 00707 END-IF. DESBD200 00708 DESBD200 00709 DISPLAY 'BD200 S1000 WRK LOG NO ' WRK-LOG-NO. DESBD200 00710 S1000-EXIT. DESBD200 00711 EXIT. DESBD200 00712 DESBD200 00713 S2000-READ-EPRF. DESBD200 00714 DESBD200 00715 MOVE LOW-VALUES TO EPRF-REC. DESBD200 00716 MOVE ELOG-ELF-ID TO EPRF-ELF-ID. DESBD200 00717 MOVE ELOG-DATA-TYPE-CD TO EPRF-DATA-TYPE-CD. DESBD200 00718 SET EPRF-PRF-88 TO TRUE. DESBD200 00719 MOVE EPRF-KEY-AREA TO ESKL-KEY-AREA. DESBD200 00720 DESBD200 00721 PERFORM S935-READ THRU S935-EXIT. DESBD200 00722 DESBD200 00723 IF L935-NO-REC-88 DESBD200 00724 DISPLAY 'NO EPRF REC FOUND ON READ USING ELOG-ELF-ID = ' DESBD200 00725 ELOG-ELF-ID DESBD200 00726 DISPLAY 'ELOG DATA TYPE IS: ' ELOG-DATA-TYPE-CD DESBD200 00727 SET WRK-FATAL-ERROR-YES TO TRUE DESBD200 00728 ELSE DESBD200 00729 MOVE ESKL-REC TO EPRF-REC DESBD200 00730 END-IF. DESBD200 00731 DESBD200 00732 IF EPRF-BATCH-UPD-ACTIVE-88 DESBD200 00733 NEXT SENTENCE DESBD200 00734 ELSE DESBD200 00735 IF EPRF-CICS-UPD-ACTIVE-88 DESBD200 00736 MOVE 'CICS UPDATE IS ACTIVE ' TO WRK-ABEND-MSG DESBD200 00737 PERFORM S999-ABEND THRU S999-EXIT DESBD200 00738 END-IF DESBD200 00739 END-IF. DESBD200 00740 DESBD200 00741 S2000-EXIT. DESBD200 00742 EXIT. DESBD200 00743 DESBD200 00744 S999-ABEND. DESBD200 00745 DISPLAY '**** DESBD200 ABENDING ' WRK-ABEND-MSG. DESBD200 00746 CALL 'DTSBU999' USING WRK-ABEND-CD. DESBD200 00747 S999-EXIT. DESBD200 00748 EXIT. DESBD200 00749 DESBD200