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