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