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