505 lines
40 KiB
COBOL
505 lines
40 KiB
COBOL
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
|