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