DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
504
Batch/DTSBD542.cob
Normal file
504
Batch/DTSBD542.cob
Normal file
@ -0,0 +1,504 @@
|
||||
00001 IDENTIFICATION DIVISION. 03/27/15
|
||||
00002 PROGRAM-ID. DTSBD542. DTSBD542
|
||||
00003 AUTHOR. NGC. LV008
|
||||
00004 DATE-WRITTEN. JUNE 2004. DTSBD542
|
||||
00005 DATE-COMPILED. DTSBD542
|
||||
00006 SKIP3 DTSBD542
|
||||
00007 ***** DTSBD542
|
||||
00008 * DTSBD542
|
||||
00009 * FUNCTION: BUILD EMPLOYEE TRANSFER TRANSACTION FILE (ETT) DTSBD542
|
||||
00010 * FOR ES202 PROCESS. DTSBD542
|
||||
00011 * STEP 2 - CREATE FILE DTSBD542
|
||||
00012 * DTSBD542
|
||||
00013 * MODIFICATION LOG: DTSBD542
|
||||
00014 * DTSBD542
|
||||
00015 * 06/24/2004 INITIAL DEVELOPMENT DTSBD542
|
||||
00016 * WORK ORDER: PROGRAMMER: GD DTSBD542
|
||||
00017 * DTSBD542
|
||||
00018 * 10/25/2004 READ THE PARAMETER FILE CONTAINING BOTH PARM DTSBD542
|
||||
00019 * SPECIFIED QTR AND PREVIOUS QTR WHICH CREATED DTSBD542
|
||||
00020 * FROM PGM DTSBD540 FOR THIS PGM PROCESSING. DTSBD542
|
||||
00021 * REFERENCE: LMI REQUIRMENT PROGRAMMER: RW DTSBD542
|
||||
00022 * DTSBD542
|
||||
00023 * 01/02/2015 INCREASED TBL1 FROM 100 TO 120 DTSBD542
|
||||
00024 * REFERENCE: ABEND ON 1/2/15 PROGRAMMER: NH DTSBD542
|
||||
00025 * 03/02/2015 INCREASED TBL2 FROM 100 TO 120 DTSBD542
|
||||
00026 * REFERENCE: ABEND ON 3/2/15 PROGRAMMER: NH DTSBD542
|
||||
00027 * 03/27/2015 INCREASED TBL2 AND TBL1 FROM 120 TO 500 DTSBD542
|
||||
00028 * REFERENCE: ABEND ON 3/2/15 PROGRAMMER: NH DTSBD542
|
||||
00029 * 99/99/9999 XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD542
|
||||
00030 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD542
|
||||
00031 * WORK ORDER: PROGRAMMER: XXX DTSBD542
|
||||
00032 * DTSBD542
|
||||
00033 * DESCRIPTION: DTSBD542
|
||||
00034 * DTSBD542
|
||||
00035 * INITIATION: DTSBD542
|
||||
00036 * VSAM WAGE FILE OPEN READ DTSBD542
|
||||
00037 * DTSBD542
|
||||
00038 * PARAMETERS INPUT: DTSBD542
|
||||
00039 * PARM-EMP-NO PARM-START-YRQ PARM-END-YRQ. DTSBD542
|
||||
00040 * DTSBD542
|
||||
00041 * PROCESSING: DTSBD542
|
||||
00042 * SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (535R1). DTSBD542
|
||||
00043 * DTSBD542
|
||||
00044 * TERMINATION: DTSBD542
|
||||
00045 * OUTPUT STATISTICAL RECORDS COUNT. DTSBD542
|
||||
00046 * DTSBD542
|
||||
00047 * RECORDS READ: DTSBD542
|
||||
00048 * MASTER: DTSBD542
|
||||
00049 VSAM WAGES FILE DTSBD542
|
||||
00050 * DTSBD542
|
||||
00051 * ALTERNATE INDEX: DTSBD542
|
||||
00052 * NONE. DTSBD542
|
||||
00053 * DTSBD542
|
||||
00054 * REFERENCE: DTSBD542
|
||||
00055 * NONE. DTSBD542
|
||||
00056 * DTSBD542
|
||||
00057 * RECORDS UPDATED: DTSBD542
|
||||
00058 * NONE DTSBD542
|
||||
00059 * DTSBD542
|
||||
00060 * REPORT RECORDS WRITTEN: DTSBD542
|
||||
00061 * R535 EMPLOYER WAGES RECORD FOR REPORTING DTSBD542
|
||||
00062 * DTSBD542
|
||||
00063 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBD542
|
||||
00064 * NONE. DTSBD542
|
||||
00065 * DTSBD542
|
||||
00066 * MODULES CALLED: DTSBD542
|
||||
00067 * DTSBU001 DATE CONVERSION/EDIT. DTSBD542
|
||||
00068 * DTSBU004 QUARERLY SUMMARY REPORT REC. DTSBD542
|
||||
00069 * DTSBU981 VSAM.WGH FILE I/O. DTSBD542
|
||||
00070 * DTSBU946 VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1. DTSBD542
|
||||
00071 * DTSBD542
|
||||
00072 * VERMONT REFERENCE: DTSBD542
|
||||
00073 * NONE. DTSBD542
|
||||
00074 * DTSBD542
|
||||
00075 ***** DTSBD542
|
||||
00076 SKIP3 DTSBD542
|
||||
00077 ENVIRONMENT DIVISION. DTSBD542
|
||||
00078 INPUT-OUTPUT SECTION. DTSBD542
|
||||
00079 SKIP3 DTSBD542
|
||||
00080 FILE-CONTROL. DTSBD542
|
||||
00081 SELECT INFILE ASSIGN TO INFILE DTSBD542
|
||||
00082 FILE STATUS IS INFILE-STATUS. DTSBD542
|
||||
00083 DTSBD542
|
||||
00084 SELECT ETT-FILE ASSIGN TO ETTFILE DTSBD542
|
||||
00085 FILE STATUS IS ETT-STATUS. DTSBD542
|
||||
00086 DTSBD542
|
||||
00087 SELECT ES202PRM-FILE ASSIGN TO ES202P2I DTSBD542
|
||||
00088 FILE STATUS IS PARM-STATUS. DTSBD542
|
||||
00089 DTSBD542
|
||||
00090 SKIP3 DTSBD542
|
||||
00091 DATA DIVISION. DTSBD542
|
||||
00092 FILE SECTION. DTSBD542
|
||||
00093 FD INFILE DTSBD542
|
||||
00094 RECORD CONTAINS 16 CHARACTERS DTSBD542
|
||||
00095 DATA RECORD IS INFILE-REC. DTSBD542
|
||||
00096 SKIP1 DTSBD542
|
||||
00097 01 INFILE-REC. DTSBD542
|
||||
00098 05 INFILE-SSN PIC 9(09). DTSBD542
|
||||
00099 05 INFILE-QTR PIC 9(01). DTSBD542
|
||||
00100 05 INFILE-EMP PIC 9(06). DTSBD542
|
||||
00101 DTSBD542
|
||||
00102 FD ETT-FILE DTSBD542
|
||||
00103 RECORD CONTAINS 20 CHARACTERS DTSBD542
|
||||
00104 DATA RECORD IS ETT-REC. DTSBD542
|
||||
00105 SKIP1 DTSBD542
|
||||
00106 01 ETT-REC. DTSBD542
|
||||
00107 ++INCLUDE ES2ETTV1 DTSBD542
|
||||
00108 DTSBD542
|
||||
00109 FD ES202PRM-FILE DTSBD542
|
||||
00110 RECORDING MODE IS F DTSBD542
|
||||
00111 BLOCK CONTAINS 0 RECORDS. DTSBD542
|
||||
00112 DTSBD542
|
||||
00113 01 ES202-PARM-REC. DTSBD542
|
||||
00114 05 ES202-PARM-YRQ1 PIC S9(05) COMP-3. DTSBD542
|
||||
00115 05 ES202-PARM-YRQ2 PIC S9(05) COMP-3. DTSBD542
|
||||
00116 DTSBD542
|
||||
00117 WORKING-STORAGE SECTION. DTSBD542
|
||||
001175 77 PAN-VALET PICTURE X(24) VALUE '008DTSBD542 03/27/15'. DTSBD542
|
||||
00118 77 PAN-VALET PICTURE X(24) VALUE '004DTSBD542 03/27/15'. DTSBD542
|
||||
00119 77 PAN-VALET PICTURE X(24) VALUE '006DTSBD542 03/02/15'. DTSBD542
|
||||
00120 77 PAN-VALET PICTURE X(24) VALUE '002DTSBD542 03/02/15'. DTSBD542
|
||||
00121 77 PAN-VALET PICTURE X(24) VALUE '004DTSBD542 03/02/15'. DTSBD542
|
||||
00122 77 PAN-VALET PICTURE X(24) VALUE '003DTSBD542 01/02/15'. DTSBD542
|
||||
00123 77 PAN-VALET PICTURE X(24) VALUE '001DTSBD542 01/21/05'. DTSBD542
|
||||
00124 DTSBD542
|
||||
00125 01 WRK-AREA. DTSBD542
|
||||
00126 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +542.DTSBD542
|
||||
00127 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBD542'.DTSBD542
|
||||
00128 05 WRK-ABEND-MSG PIC X(60). DTSBD542
|
||||
00129 DTSBD542
|
||||
00130 05 WRK-YRQ1 PIC S9(05) COMP-3 DTSBD542
|
||||
00131 VALUE +0. DTSBD542
|
||||
00132 05 WRK-YRQ2 PIC S9(05) COMP-3 DTSBD542
|
||||
00133 VALUE +0. DTSBD542
|
||||
00134 DTSBD542
|
||||
00135 05 WRK-YRQ PIC S9(05) COMP-3 VALUE +0. DTSBD542
|
||||
00136 05 WRK-EMP-NO PIC S9(07) COMP-3 VALUE +0. DTSBD542
|
||||
00137 05 WRK-SSN PIC S9(09) COMP-3 VALUE +0. DTSBD542
|
||||
00138 DTSBD542
|
||||
00139 05 INFILE-STATUS PIC X(02). DTSBD542
|
||||
00140 88 INFILE-OK-88 VALUE '00'. DTSBD542
|
||||
00141 88 INFILE-EOF-88 VALUE '10'. DTSBD542
|
||||
00142 DTSBD542
|
||||
00143 05 ETT-STATUS PIC X(02). DTSBD542
|
||||
00144 88 ETT-OK-88 VALUE '00'. DTSBD542
|
||||
00145 DTSBD542
|
||||
00146 05 PARM-STATUS PIC X(02). DTSBD542
|
||||
00147 88 PARM-OK-88 VALUE '00'. DTSBD542
|
||||
00148 88 PARM-EOF-88 VALUE '10'. DTSBD542
|
||||
00149 DTSBD542
|
||||
00150 05 WRK-EMP-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD542
|
||||
00151 05 QTR1-TABLE. DTSBD542
|
||||
00152 10 SUB1 PIC S9(04) COMP. DTSBD542
|
||||
00153 10 TBL1-CNT PIC S9(04) COMP DTSBD542
|
||||
00154 VALUE +0. DTSBD542
|
||||
00155 10 TBL1-MAX PIC S9(04) COMP DTSBD542
|
||||
00156 * VALUE +100. DTSBD542
|
||||
00157 * VALUE +120. DTSBD542
|
||||
00158 VALUE +500. DTSBD542
|
||||
00159 * 10 TBL1-ENTRY OCCURS 100 TIMES. DTSBD542
|
||||
00160 * 10 TBL1-ENTRY OCCURS 120 TIMES. DTSBD542
|
||||
00161 10 TBL1-ENTRY OCCURS 500 TIMES. DTSBD542
|
||||
00162 15 TBL1-EMP-9 PIC 9(10). DTSBD542
|
||||
00163 15 TBL1-EMP-X REDEFINES TBL1-EMP-9 DTSBD542
|
||||
00164 PIC X(10). DTSBD542
|
||||
00165 DTSBD542
|
||||
00166 05 QTR2-TABLE. DTSBD542
|
||||
00167 10 SUB2 PIC S9(04) COMP. DTSBD542
|
||||
00168 10 TBL2-CNT PIC S9(04) COMP DTSBD542
|
||||
00169 VALUE +0. DTSBD542
|
||||
00170 10 TBL2-MAX PIC S9(04) COMP DTSBD542
|
||||
00171 * VALUE +100. DTSBD542
|
||||
00172 * VALUE +120. DTSBD542
|
||||
00173 VALUE +500. DTSBD542
|
||||
00174 * 10 TBL2-ENTRY OCCURS 100 TIMES. DTSBD542
|
||||
00175 * 10 TBL2-ENTRY OCCURS 120 TIMES. DTSBD542
|
||||
00176 10 TBL2-ENTRY OCCURS 500 TIMES. DTSBD542
|
||||
00177 15 TBL2-EMP-9 PIC 9(10). DTSBD542
|
||||
00178 15 TBL2-EMP-X REDEFINES TBL2-EMP-9 DTSBD542
|
||||
00179 PIC X(10). DTSBD542
|
||||
00180 DTSBD542
|
||||
00181 05 WRK-ERROR-IND PIC X(01). DTSBD542
|
||||
00182 88 WRK-ERROR-YES-88 VALUE 'Y'. DTSBD542
|
||||
00183 88 WRK-ERROR-NO-88 VALUE 'N'. DTSBD542
|
||||
00184 DTSBD542
|
||||
00185 05 WRK-INFILE-READ-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD542
|
||||
00186 05 WRK-ETT-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD542
|
||||
00187 DTSBD542
|
||||
00188 DTSBD542
|
||||
00189 PROCEDURE DIVISION. DTSBD542
|
||||
00190 DTSBD542
|
||||
00191 PERFORM I0000-INITIALIZE THRU I0000-EXIT. DTSBD542
|
||||
00192 IF WRK-ERROR-NO-88 DTSBD542
|
||||
00193 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBD542
|
||||
00194 END-IF. DTSBD542
|
||||
00195 DTSBD542
|
||||
00196 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBD542
|
||||
00197 DTSBD542
|
||||
00198 GOBACK. DTSBD542
|
||||
00199 EJECT DTSBD542
|
||||
00200 I0000-INITIALIZE. DTSBD542
|
||||
00201 DTSBD542
|
||||
00202 SET WRK-ERROR-NO-88 TO TRUE. DTSBD542
|
||||
00203 MOVE ZERO TO WRK-EMP-NO DTSBD542
|
||||
00204 WRK-SSN. DTSBD542
|
||||
00205 DTSBD542
|
||||
00206 PERFORM I1000-PROCESS-PARMS THRU I1000-EXIT. DTSBD542
|
||||
00207 DTSBD542
|
||||
00208 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBD542
|
||||
00209 DTSBD542
|
||||
00210 PERFORM I3000-INIT-TABLES THRU I3000-EXIT. DTSBD542
|
||||
00211 DTSBD542
|
||||
00212 PERFORM I4000-WRITE-HEADER THRU I4000-EXIT. DTSBD542
|
||||
00213 DTSBD542
|
||||
00214 I0000-EXIT. DTSBD542
|
||||
00215 EXIT. DTSBD542
|
||||
00216 DTSBD542
|
||||
00217 DTSBD542
|
||||
00218 I1000-PROCESS-PARMS. DTSBD542
|
||||
00219 DTSBD542
|
||||
00220 OPEN INPUT ES202PRM-FILE. DTSBD542
|
||||
00221 DTSBD542
|
||||
00222 READ ES202PRM-FILE. DTSBD542
|
||||
00223 IF NOT PARM-OK-88 DTSBD542
|
||||
00224 DISPLAY '*** PARM FILE STATUS IS : ' PARM-STATUS DTSBD542
|
||||
00225 MOVE 'CANNOT OPEN ES202PRM FILE ' TO WRK-ABEND-MSG DTSBD542
|
||||
00226 PERFORM S999-ABEND THRU S999-EXIT DTSBD542
|
||||
00227 END-IF. DTSBD542
|
||||
00228 DTSBD542
|
||||
00229 ************************************************************* DTSBD542
|
||||
00230 * YRQ1 = NEW QUARTER DTSBD542
|
||||
00231 * YRQ2 = OLD QUARTER DTSBD542
|
||||
00232 ************************************************************* DTSBD542
|
||||
00233 MOVE ES202-PARM-YRQ1 TO WRK-YRQ1. DTSBD542
|
||||
00234 MOVE ES202-PARM-YRQ2 TO WRK-YRQ2. DTSBD542
|
||||
00235 DTSBD542
|
||||
00236 DISPLAY SPACE. DTSBD542
|
||||
00237 DISPLAY 'BD542 YRQ1 ' WRK-YRQ1 ' YRQ2 ' WRK-YRQ2. DTSBD542
|
||||
00238 DISPLAY SPACE. DTSBD542
|
||||
00239 I1000-EXIT. DTSBD542
|
||||
00240 EXIT. DTSBD542
|
||||
00241 DTSBD542
|
||||
00242 I2000-OPEN-FILES. DTSBD542
|
||||
00243 OPEN INPUT INFILE. DTSBD542
|
||||
00244 IF NOT INFILE-OK-88 DTSBD542
|
||||
00245 DISPLAY 'CANNOT OPEN INFILE ' INFILE-STATUS DTSBD542
|
||||
00246 SET WRK-ERROR-YES-88 TO TRUE DTSBD542
|
||||
00247 GO TO I2000-EXIT. DTSBD542
|
||||
00248 DTSBD542
|
||||
00249 OPEN OUTPUT ETT-FILE. DTSBD542
|
||||
00250 IF NOT ETT-OK-88 DTSBD542
|
||||
00251 DISPLAY 'CANNOT OPEN ETT FILE ' ETT-STATUS DTSBD542
|
||||
00252 SET WRK-ERROR-YES-88 TO TRUE DTSBD542
|
||||
00253 GO TO I2000-EXIT. DTSBD542
|
||||
00254 DTSBD542
|
||||
00255 I2000-EXIT. DTSBD542
|
||||
00256 EXIT. DTSBD542
|
||||
00257 DTSBD542
|
||||
00258 I3000-INIT-TABLES. DTSBD542
|
||||
00259 MOVE ZERO TO TBL1-CNT DTSBD542
|
||||
00260 TBL2-CNT. DTSBD542
|
||||
00261 DTSBD542
|
||||
00262 PERFORM DTSBD542
|
||||
00263 VARYING SUB1 FROM +1 BY +1 DTSBD542
|
||||
00264 UNTIL SUB1 > TBL1-MAX DTSBD542
|
||||
00265 MOVE ZERO TO TBL1-EMP-9 (SUB1) DTSBD542
|
||||
00266 END-PERFORM. DTSBD542
|
||||
00267 DTSBD542
|
||||
00268 PERFORM DTSBD542
|
||||
00269 VARYING SUB2 FROM +1 BY +1 DTSBD542
|
||||
00270 UNTIL SUB2 > TBL2-MAX DTSBD542
|
||||
00271 MOVE ZERO TO TBL2-EMP-9 (SUB2) DTSBD542
|
||||
00272 END-PERFORM. DTSBD542
|
||||
00273 DTSBD542
|
||||
00274 I3000-EXIT. DTSBD542
|
||||
00275 EXIT. DTSBD542
|
||||
00276 DTSBD542
|
||||
00277 I4000-WRITE-HEADER. DTSBD542
|
||||
00278 SET ETT-HEADER-88 TO TRUE. DTSBD542
|
||||
00279 MOVE WRK-YRQ1 TO ETT-NEW-YRQ. DTSBD542
|
||||
00280 MOVE WRK-YRQ2 TO ETT-OLD-YRQ. DTSBD542
|
||||
00281 DTSBD542
|
||||
00282 DISPLAY 'BD542 ETT HEADER ' ETT-REC. DTSBD542
|
||||
00283 DTSBD542
|
||||
00284 WRITE ETT-REC. DTSBD542
|
||||
00285 IF ETT-OK-88 DTSBD542
|
||||
00286 ADD +1 TO WRK-ETT-WRITE-CNT DTSBD542
|
||||
00287 ELSE DTSBD542
|
||||
00288 DISPLAY 'CANNOT WRITE ETT FILE ' ETT-STATUS DTSBD542
|
||||
00289 SET WRK-ERROR-YES-88 TO TRUE DTSBD542
|
||||
00290 END-IF. DTSBD542
|
||||
00291 DTSBD542
|
||||
00292 I4000-EXIT. DTSBD542
|
||||
00293 EXIT. DTSBD542
|
||||
00294 DTSBD542
|
||||
00295 ************************************************************** DTSBD542
|
||||
00296 * START BROWSE THE VSAM.WGH FILE WITH THE PARM-START-YRQ * DTSBD542
|
||||
00297 * AND PARM-EMP-NO. * DTSBD542
|
||||
00298 ************************************************************** DTSBD542
|
||||
00299 DTSBD542
|
||||
00300 P0000-PROCESS. DTSBD542
|
||||
00301 READ INFILE. DTSBD542
|
||||
00302 IF NOT INFILE-OK-88 DTSBD542
|
||||
00303 DISPLAY 'INPUT FILE IS EMPTY ' DTSBD542
|
||||
00304 SET WRK-ERROR-YES-88 TO TRUE DTSBD542
|
||||
00305 GO TO P0000-EXIT DTSBD542
|
||||
00306 ELSE DTSBD542
|
||||
00307 MOVE INFILE-SSN TO WRK-SSN DTSBD542
|
||||
00308 ADD +1 TO WRK-INFILE-READ-CNT DTSBD542
|
||||
00309 *& DTSBD542
|
||||
00310 DISPLAY 'P0000 ' INFILE-SSN ' ' INFILE-QTR ' ' INFILE-EMP DTSBD542
|
||||
00311 */& DTSBD542
|
||||
00312 PERFORM P1100-MOVE-TO-TABLE THRU P1100-EXIT DTSBD542
|
||||
00313 END-IF. DTSBD542
|
||||
00314 DTSBD542
|
||||
00315 PERFORM P1000-SCAN-INPUT THRU P1000-EXIT DTSBD542
|
||||
00316 UNTIL INFILE-EOF-88 DTSBD542
|
||||
00317 OR WRK-ERROR-YES-88. DTSBD542
|
||||
00318 DTSBD542
|
||||
00319 P0000-EXIT. DTSBD542
|
||||
00320 EXIT. DTSBD542
|
||||
00321 DTSBD542
|
||||
00322 ************************************************************** DTSBD542
|
||||
00323 * SELECT VSAM-WGH RECORDS WHEN WWGH-EMP-NO = PARM-EMP-NO, * DTSBD542
|
||||
00324 * WWGH-YRQ >= PARM-START-YRQ AND WWGH-YRQ <= PARM-END-YRQ. * DTSBD542
|
||||
00325 ************************************************************** DTSBD542
|
||||
00326 DTSBD542
|
||||
00327 P1000-SCAN-INPUT. DTSBD542
|
||||
00328 READ INFILE. DTSBD542
|
||||
00329 IF INFILE-OK-88 DTSBD542
|
||||
00330 ADD +1 TO WRK-INFILE-READ-CNT DTSBD542
|
||||
00331 ELSE DTSBD542
|
||||
00332 IF INFILE-EOF-88 DTSBD542
|
||||
00333 GO TO P1000-EXIT DTSBD542
|
||||
00334 ELSE DTSBD542
|
||||
00335 DISPLAY 'BAD READ OF INPUT FILE ' INFILE-STATUS DTSBD542
|
||||
00336 SET WRK-ERROR-YES-88 TO TRUE DTSBD542
|
||||
00337 GO TO P1000-EXIT DTSBD542
|
||||
00338 END-IF DTSBD542
|
||||
00339 END-IF. DTSBD542
|
||||
00340 DTSBD542
|
||||
00341 IF INFILE-SSN = WRK-SSN DTSBD542
|
||||
00342 PERFORM P1100-MOVE-TO-TABLE THRU P1100-EXIT DTSBD542
|
||||
00343 ELSE DTSBD542
|
||||
00344 PERFORM P1200-WRITE-ETT THRU P1200-EXIT DTSBD542
|
||||
00345 PERFORM P1300-CLEAR-TABLES THRU P1300-EXIT DTSBD542
|
||||
00346 PERFORM P1100-MOVE-TO-TABLE THRU P1100-EXIT DTSBD542
|
||||
00347 END-IF. DTSBD542
|
||||
00348 DTSBD542
|
||||
00349 DTSBD542
|
||||
00350 P1000-EXIT. DTSBD542
|
||||
00351 EXIT. DTSBD542
|
||||
00352 DTSBD542
|
||||
00353 P1100-MOVE-TO-TABLE. DTSBD542
|
||||
00354 *& DTSBD542
|
||||
00355 IF WRK-INFILE-READ-CNT < 1000 DTSBD542
|
||||
00356 DISPLAY 'P1100 ' INFILE-SSN ' ' INFILE-QTR ' ' INFILE-EMP DTSBD542
|
||||
00357 END-IF. DTSBD542
|
||||
00358 */& DTSBD542
|
||||
00359 IF INFILE-QTR = 1 DTSBD542
|
||||
00360 PERFORM P1110-TABLE1 THRU P1110-EXIT DTSBD542
|
||||
00361 ELSE DTSBD542
|
||||
00362 IF INFILE-QTR = 2 DTSBD542
|
||||
00363 PERFORM P1120-TABLE2 THRU P1120-EXIT DTSBD542
|
||||
00364 END-IF DTSBD542
|
||||
00365 END-IF. DTSBD542
|
||||
00366 DTSBD542
|
||||
00367 P1100-EXIT. DTSBD542
|
||||
00368 EXIT. DTSBD542
|
||||
00369 DTSBD542
|
||||
00370 P1110-TABLE1. DTSBD542
|
||||
00371 IF TBL1-CNT < TBL1-MAX DTSBD542
|
||||
00372 ADD +1 TO TBL1-CNT DTSBD542
|
||||
00373 MOVE INFILE-EMP TO TBL1-EMP-9 (TBL1-CNT) DTSBD542
|
||||
00374 ELSE DTSBD542
|
||||
00375 DISPLAY 'TBL1 LENGTH EXCEEDED ' INFILE-EMP DTSBD542
|
||||
00376 ' ' TBL1-CNT DTSBD542
|
||||
00377 PERFORM S999-ABEND THRU S999-EXIT DTSBD542
|
||||
00378 END-IF. DTSBD542
|
||||
00379 DTSBD542
|
||||
00380 P1110-EXIT. DTSBD542
|
||||
00381 EXIT. DTSBD542
|
||||
00382 DTSBD542
|
||||
00383 P1120-TABLE2. DTSBD542
|
||||
00384 IF TBL2-CNT < TBL2-MAX DTSBD542
|
||||
00385 ADD +1 TO TBL2-CNT DTSBD542
|
||||
00386 MOVE INFILE-EMP TO TBL2-EMP-9 (TBL2-CNT) DTSBD542
|
||||
00387 ELSE DTSBD542
|
||||
00388 DISPLAY 'TBL2 LENGTH EXCEEDED ' INFILE-EMP DTSBD542
|
||||
00389 ' ' TBL2-CNT DTSBD542
|
||||
00390 PERFORM S999-ABEND THRU S999-EXIT DTSBD542
|
||||
00391 END-IF. DTSBD542
|
||||
00392 DTSBD542
|
||||
00393 P1120-EXIT. DTSBD542
|
||||
00394 EXIT. DTSBD542
|
||||
00395 DTSBD542
|
||||
00396 P1200-WRITE-ETT. DTSBD542
|
||||
00397 *& DTSBD542
|
||||
00398 IF WRK-INFILE-READ-CNT < 1000 DTSBD542
|
||||
00399 DISPLAY 'P1200 TBL1 ' TBL1-CNT ' TBL2 ' TBL2-CNT DTSBD542
|
||||
00400 ' SSN ' WRK-SSN DTSBD542
|
||||
00401 END-IF. DTSBD542
|
||||
00402 */& DTSBD542
|
||||
00403 PERFORM P1210-CHK-NULL-ENTRIES THRU P1210-EXIT. DTSBD542
|
||||
00404 DTSBD542
|
||||
00405 PERFORM DTSBD542
|
||||
00406 VARYING SUB1 FROM +1 BY +1 DTSBD542
|
||||
00407 UNTIL SUB1 > TBL1-CNT DTSBD542
|
||||
00408 PERFORM P1220-TABLE2 THRU P1220-EXIT DTSBD542
|
||||
00409 END-PERFORM. DTSBD542
|
||||
00410 DTSBD542
|
||||
00411 P1200-EXIT. DTSBD542
|
||||
00412 EXIT. DTSBD542
|
||||
00413 DTSBD542
|
||||
00414 P1210-CHK-NULL-ENTRIES. DTSBD542
|
||||
00415 IF TBL1-CNT = ZERO DTSBD542
|
||||
00416 IF TBL2-CNT > ZERO DTSBD542
|
||||
00417 MOVE +1 TO TBL1-CNT DTSBD542
|
||||
00418 MOVE 'XXXXXXXXXX' TO TBL1-EMP-X (TBL1-CNT) DTSBD542
|
||||
00419 END-IF DTSBD542
|
||||
00420 ELSE DTSBD542
|
||||
00421 IF TBL2-CNT = ZERO DTSBD542
|
||||
00422 MOVE +1 TO TBL2-CNT DTSBD542
|
||||
00423 MOVE 'XXXXXXXXXX' TO TBL2-EMP-X (TBL2-CNT) DTSBD542
|
||||
00424 END-IF DTSBD542
|
||||
00425 END-IF. DTSBD542
|
||||
00426 DTSBD542
|
||||
00427 P1210-EXIT. DTSBD542
|
||||
00428 EXIT. DTSBD542
|
||||
00429 DTSBD542
|
||||
00430 P1220-TABLE2. DTSBD542
|
||||
00431 PERFORM DTSBD542
|
||||
00432 VARYING SUB2 FROM +1 BY +1 DTSBD542
|
||||
00433 UNTIL SUB2 > TBL2-CNT DTSBD542
|
||||
00434 MOVE TBL1-EMP-9 (SUB1) TO ETT-PRED-ACCT DTSBD542
|
||||
00435 MOVE TBL2-EMP-9 (SUB2) TO ETT-SUCC-ACCT DTSBD542
|
||||
00436 PERFORM P1230-WRITE THRU P1230-EXIT DTSBD542
|
||||
00437 END-PERFORM. DTSBD542
|
||||
00438 DTSBD542
|
||||
00439 P1220-EXIT. DTSBD542
|
||||
00440 EXIT. DTSBD542
|
||||
00441 DTSBD542
|
||||
00442 P1230-WRITE. DTSBD542
|
||||
00443 WRITE ETT-REC. DTSBD542
|
||||
00444 IF ETT-OK-88 DTSBD542
|
||||
00445 ADD +1 TO WRK-ETT-WRITE-CNT DTSBD542
|
||||
00446 ELSE DTSBD542
|
||||
00447 DISPLAY 'CANNOT WRITE ETT FILE ' ETT-STATUS DTSBD542
|
||||
00448 SET WRK-ERROR-YES-88 TO TRUE DTSBD542
|
||||
00449 END-IF. DTSBD542
|
||||
00450 DTSBD542
|
||||
00451 P1230-EXIT. DTSBD542
|
||||
00452 EXIT. DTSBD542
|
||||
00453 DTSBD542
|
||||
00454 P1300-CLEAR-TABLES. DTSBD542
|
||||
00455 MOVE ZERO TO TBL1-CNT DTSBD542
|
||||
00456 TBL2-CNT. DTSBD542
|
||||
00457 DTSBD542
|
||||
00458 PERFORM DTSBD542
|
||||
00459 VARYING SUB1 FROM +1 BY +1 DTSBD542
|
||||
00460 UNTIL SUB1 > TBL1-MAX DTSBD542
|
||||
00461 MOVE ZERO TO TBL1-EMP-9 (SUB1) DTSBD542
|
||||
00462 END-PERFORM. DTSBD542
|
||||
00463 DTSBD542
|
||||
00464 PERFORM DTSBD542
|
||||
00465 VARYING SUB2 FROM +1 BY +1 DTSBD542
|
||||
00466 UNTIL SUB2 > TBL2-MAX DTSBD542
|
||||
00467 MOVE ZERO TO TBL2-EMP-9 (SUB2) DTSBD542
|
||||
00468 END-PERFORM. DTSBD542
|
||||
00469 DTSBD542
|
||||
00470 MOVE INFILE-SSN TO WRK-SSN. DTSBD542
|
||||
00471 DTSBD542
|
||||
00472 P1300-EXIT. DTSBD542
|
||||
00473 EXIT. DTSBD542
|
||||
00474 DTSBD542
|
||||
00475 T0000-TERMINATE. DTSBD542
|
||||
00476 DTSBD542
|
||||
00477 DISPLAY ' '. DTSBD542
|
||||
00478 DISPLAY ' '. DTSBD542
|
||||
00479 DTSBD542
|
||||
00480 DISPLAY '*** DTSBD542 TERMINATION STATISTICS ***'. DTSBD542
|
||||
00481 DTSBD542
|
||||
00482 DISPLAY ' '. DTSBD542
|
||||
00483 DISPLAY 'INPUT RECORDS READ :' DTSBD542
|
||||
00484 WRK-INFILE-READ-CNT. DTSBD542
|
||||
00485 DTSBD542
|
||||
00486 DISPLAY 'OUTPUT RECORDS WRITTEN :' DTSBD542
|
||||
00487 WRK-ETT-WRITE-CNT. DTSBD542
|
||||
00488 DTSBD542
|
||||
00489 CLOSE INFILE DTSBD542
|
||||
00490 ETT-FILE DTSBD542
|
||||
00491 ES202PRM-FILE. DTSBD542
|
||||
00492 DTSBD542
|
||||
00493 T0000-EXIT. DTSBD542
|
||||
00494 EXIT. DTSBD542
|
||||
00495 EJECT DTSBD542
|
||||
00496 DTSBD542
|
||||
00497 S999-ABEND. DTSBD542
|
||||
00498 DISPLAY '*** DTSBD542 ABENDING : ' DTSBD542
|
||||
00499 WRK-ABEND-MSG. DTSBD542
|
||||
00500 DTSBD542
|
||||
00501 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBD542
|
||||
00502 S999-EXIT. DTSBD542
|
||||
00503 EXIT. DTSBD542
|
||||
Reference in New Issue
Block a user