300 lines
24 KiB
COBOL
300 lines
24 KiB
COBOL
00001 IDENTIFICATION DIVISION. 05/10/04
|
|
00002 PROGRAM-ID. DTSBD595. DTSBD595
|
|
00003 AUTHOR. TRW LV003
|
|
00004 DATE-WRITTEN. MARCH 2002. DTSBD595
|
|
00005 DATE-COMPILED. DTSBD595
|
|
00006 DTSBD595
|
|
00007 ***** DTSBD595
|
|
00008 * HOUSEHOLD DTSBD595
|
|
00009 * DTSBD595
|
|
00010 * FUNCTION: EXTRACT SSN AND NAME FROM THE CURRENT WAGE MASTER DTSBD595
|
|
00011 * FILE. CREATE A FLAT FILE AS OUTPUT. DTSBD595
|
|
00012 * DTSBD595
|
|
00013 * NOTE: THIS PROGRAM USES SEVERAL BENEFIT MODULES THEREFORE DTSBD595
|
|
00014 * THIS PROGRAM NEEDS THE BENEFIT COMPILE JCL(COB2BBEN) DTSBD595
|
|
00015 * TO RESOLVE ALL THE NEEDED LOAD MODULES. DTSBD595
|
|
00016 * DTSBD595
|
|
00017 * MODIFICATION HISTORY: DTSBD595
|
|
00018 * DTSBD595
|
|
00019 * 03/12/2002 INITIAL DEVELOPMENT AND CLONE FROM DTSBZ211 DTSBD595
|
|
00020 * REFERANCE: PROGRAMMER: RW1 DTSBD595
|
|
00021 * DTSBD595
|
|
00022 * 05/21/2002 COPY OF DTSBZ216 TO BE USED IN DAILY W/HOUSEHOLD DTSBD595
|
|
00023 * REFERANCE: PROGRAMMER: JHP DTSBD595
|
|
00024 * DTSBD595
|
|
00025 * 04/26/2004 CHANGE WGP-SEGMENT TO WGP-SEGMENT-ONE AND DTSBD595
|
|
00026 * WGD-SEGEMENT TO WGD-SEGEMENT-TWO : ZL1 DTSBD595
|
|
00027 * DTSBD595
|
|
00028 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD595
|
|
00029 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD595
|
|
00030 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBD595
|
|
00031 * DTSBD595
|
|
00032 * DESCRIPTION: DTSBD595
|
|
00033 * DTSBD595
|
|
00034 * RECORDS READ: DTSBD595
|
|
00035 * BENEFITS WAGE FILE DTSBD595
|
|
00036 * DTSBD595
|
|
00037 * PRINTED OUTPUTS: DTSBD595
|
|
00038 * NONE. DTSBD595
|
|
00039 * DTSBD595
|
|
00040 * RECORDS WRITTEN: DTSBD595
|
|
00041 * DTSIWNAM WORKER NAME RECORD DTSBD595
|
|
00042 * DTSBD595
|
|
00043 * MODULES CALLED: DTSBD595
|
|
00044 * EWG960R WAGE FILE ACCESS MODULE DTSBD595
|
|
00045 * DTSBU004 YEAR/QUARTER CONVERSION MODULE DTSBD595
|
|
00046 * DTSBD595
|
|
00047 ***** DTSBD595
|
|
00048 DTSBD595
|
|
00049 ENVIRONMENT DIVISION. DTSBD595
|
|
00050 SKIP2 DTSBD595
|
|
00051 INPUT-OUTPUT SECTION. DTSBD595
|
|
00052 SKIP3 DTSBD595
|
|
00053 FILE-CONTROL. DTSBD595
|
|
00054 SELECT WORKER-NAME-FILE ASSIGN TO DTSFNAMO DTSBD595
|
|
00055 FILE STATUS IS WORKER-NAME-STATUS. DTSBD595
|
|
00056 SKIP2 DTSBD595
|
|
00057 DTSBD595
|
|
00058 DATA DIVISION. DTSBD595
|
|
00059 SKIP2 DTSBD595
|
|
00060 FILE SECTION. DTSBD595
|
|
00061 SKIP2 DTSBD595
|
|
00062 FD WORKER-NAME-FILE DTSBD595
|
|
00063 RECORDING MODE IS F DTSBD595
|
|
00064 LABEL RECORDS ARE STANDARD DTSBD595
|
|
00065 BLOCK CONTAINS 0 CHARACTERS. DTSBD595
|
|
00066 SKIP1 DTSBD595
|
|
00067 01 WNAM-CHG-REC. DTSBD595
|
|
00068 ++INCLUDE DTSIWNAM DTSBD595
|
|
00069 DTSBD595
|
|
00070 EJECT DTSBD595
|
|
00071 WORKING-STORAGE SECTION. DTSBD595
|
|
000715 77 PAN-VALET PICTURE X(24) VALUE '003DTSBD595 05/10/04'. DTSBD595
|
|
00072 SKIP3 DTSBD595
|
|
00073 01 WRK-AREA. DTSBD595
|
|
00074 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +216. DTSBD595
|
|
00075 DTSBD595
|
|
00076 05 WRK-PROF-READ-CNT PIC S9(09) COMP-3 VALUE +0. DTSBD595
|
|
00077 05 WRK-WAGE-READ-CNT PIC S9(09) COMP-3 VALUE +0. DTSBD595
|
|
00078 05 WRK-WNAM-WRITE-CNT PIC S9(09) COMP-3 VALUE +0. DTSBD595
|
|
00079 05 WRK-EMP-NO PIC S9(07) COMP-3 VALUE +0. DTSBD595
|
|
00080 05 WRK-NINE-COMPLEMENT-ABSTIME PIC S9(15) COMP-3 VALUE +0.DTSBD595
|
|
00081 05 DISP-TOTAL-EARNINGS PIC Z,ZZZ,ZZ9.99-. DTSBD595
|
|
00082 05 HOLD-WGP-SSN PIC S9(09) COMP-3 VALUE +0. DTSBD595
|
|
00083 05 WRK-SSN PIC 9(09) VALUE ZEROS. DTSBD595
|
|
00084 05 FILLER REDEFINES WRK-SSN. DTSBD595
|
|
00085 10 WRK-SSN-1-3 PIC 9(03). DTSBD595
|
|
00086 10 WRK-SSN-4-5 PIC 9(02). DTSBD595
|
|
00087 10 WRK-SSN-6-9 PIC 9(04). DTSBD595
|
|
00088 DTSBD595
|
|
00089 05 WRK-SUBJECT-YR PIC 9(04) VALUE 2001. DTSBD595
|
|
00090 DTSBD595
|
|
00091 05 WRK-ERROR-IND PIC X(01). DTSBD595
|
|
00092 88 WRK-ERROR-NO-88 VALUE 'N'. DTSBD595
|
|
00093 88 WRK-ERROR-YES-88 VALUE 'Y'. DTSBD595
|
|
00094 DTSBD595
|
|
00095 05 WORKER-NAME-STATUS PIC X(02) VALUE SPACES. DTSBD595
|
|
00096 88 WORKER-NAME-FILE-OK-88 VALUE ZERO. DTSBD595
|
|
00097 DTSBD595
|
|
00098 05 DISP-NINE-COMPLEMENT-ABSTIME PIC X(16) VALUE SPACES. DTSBD595
|
|
00099 DTSBD595
|
|
00100 EJECT DTSBD595
|
|
00101 01 L004-LINK-AREA. DTSBD595
|
|
00102 ++INCLUDE DTSIL004 DTSBD595
|
|
00103 EJECT DTSBD595
|
|
00104 01 L005-COMM-AREA. DTSBD595
|
|
00105 ++INCLUDE DTSIL005 DTSBD595
|
|
00106 EJECT DTSBD595
|
|
00107 01 EWGLINKB-REC. DTSBD595
|
|
00108 ++INCLUDE EWGVSMCB DTSBD595
|
|
00109 ***** DTSBD595
|
|
00110 ***** DTSBD595
|
|
00111 ++INCLUDE EWGSEG01 DTSBD595
|
|
00112 ***** DTSBD595
|
|
00113 ***** DTSBD595
|
|
00114 ++INCLUDE EWGSEG02 DTSBD595
|
|
00115 ***** DTSBD595
|
|
00116 ***** DTSBD595
|
|
00117 ++INCLUDE EWGVSMCD DTSBD595
|
|
00118 EJECT DTSBD595
|
|
00119 DTSBD595
|
|
00120 PROCEDURE DIVISION. DTSBD595
|
|
00121 DTSBD595-MAINLINE. DTSBD595
|
|
00122 SET WRK-ERROR-NO-88 TO TRUE. DTSBD595
|
|
00123 PERFORM I0000-INIT THRU I0000-EXIT. DTSBD595
|
|
00124 IF WRK-ERROR-YES-88 DTSBD595
|
|
00125 GO TO DTSBD595-MAINLINE-EXIT. DTSBD595
|
|
00126 DTSBD595
|
|
00127 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBD595
|
|
00128 DTSBD595
|
|
00129 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBD595
|
|
00130 DTSBD595
|
|
00131 DTSBD595-MAINLINE-EXIT. DTSBD595
|
|
00132 GOBACK. DTSBD595
|
|
00133 DTSBD595
|
|
00134 I0000-INIT. DTSBD595
|
|
00135 OPEN OUTPUT WORKER-NAME-FILE. DTSBD595
|
|
00136 IF NOT WORKER-NAME-FILE-OK-88 DTSBD595
|
|
00137 DISPLAY 'CANNOT OPEN WORKER NAME FILE ' DTSBD595
|
|
00138 WORKER-NAME-STATUS DTSBD595
|
|
00139 SET WRK-ERROR-YES-88 TO TRUE DTSBD595
|
|
00140 GO TO I0000-EXIT. DTSBD595
|
|
00141 DTSBD595
|
|
00142 SET DBW-OPEN-INPUT TO TRUE DTSBD595
|
|
00143 PERFORM S960-WAGE-I THRU S960-EXIT DTSBD595
|
|
00144 IF NOT DBW-SUCCESSFUL-COMPLETION DTSBD595
|
|
00145 DISPLAY 'CANNOT OPEN WAGE FILE ' DTSBD595
|
|
00146 SET WRK-ERROR-YES-88 TO TRUE DTSBD595
|
|
00147 GO TO I0000-EXIT. DTSBD595
|
|
00148 DTSBD595
|
|
00149 SET L005-FROM-SYS TO TRUE DTSBD595
|
|
00150 PERFORM S005-SYS-DATE THRU S005-EXIT DTSBD595
|
|
00151 MOVE L005-NINES-COMPLEMENT-ABSTIME TO DTSBD595
|
|
00152 DISP-NINE-COMPLEMENT-ABSTIME DTSBD595
|
|
00153 WRK-NINE-COMPLEMENT-ABSTIME. DTSBD595
|
|
00154 DISPLAY ' ' DTSBD595
|
|
00155 DISPLAY 'L005-NINES-COMPLEMENT-ABSTIME ' DTSBD595
|
|
00156 DISP-NINE-COMPLEMENT-ABSTIME. DTSBD595
|
|
00157 DTSBD595
|
|
00158 I0000-EXIT. DTSBD595
|
|
00159 EXIT. DTSBD595
|
|
00160 DTSBD595
|
|
00161 P0000-PROCESS. DTSBD595
|
|
00162 SET DBW-SEQUENTIAL-PROCESSING TO TRUE. DTSBD595
|
|
00163 SET DBW-PROFILE-SEGMENT TO TRUE. DTSBD595
|
|
00164 DTSBD595
|
|
00165 PERFORM S960-WAGE-I THRU S960-EXIT. DTSBD595
|
|
00166 DTSBD595
|
|
00167 IF DBW-SUCCESSFUL-COMPLETION DTSBD595
|
|
00168 ADD +1 TO WRK-PROF-READ-CNT DTSBD595
|
|
00169 PERFORM P1000-READ-WAGE-FILE THRU P1000-EXIT DTSBD595
|
|
00170 UNTIL DBW-END-OF-FILE. DTSBD595
|
|
00171 DTSBD595
|
|
00172 P0000-EXIT. DTSBD595
|
|
00173 EXIT. DTSBD595
|
|
00174 DTSBD595
|
|
00175 ************************************************************** DTSBD595
|
|
00176 * THE FOLLOWING READS THE THE NEXT SEGMENT 1, AND RETURN THE DTSBD595
|
|
00177 * AND RETURN THE NEXT SSN ON FILE. DTSBD595
|
|
00178 ************************************************************** DTSBD595
|
|
00179 DTSBD595
|
|
00180 P1000-READ-WAGE-FILE. DTSBD595
|
|
00181 DTSBD595
|
|
00182 SET DBW-RANDOM-PROCESSING TO TRUE. DTSBD595
|
|
00183 SET DBW-WAGE-SEGMENT TO TRUE. DTSBD595
|
|
00184 PERFORM S960-WAGE-I THRU S960-EXIT. DTSBD595
|
|
00185 DTSBD595
|
|
00186 PERFORM P1100-SELECT-WAGES THRU P1100-EXIT DTSBD595
|
|
00187 UNTIL DBW-NO-RECORD-FOUND. DTSBD595
|
|
00188 DTSBD595
|
|
00189 SET DBW-SEQUENTIAL-PROCESSING TO TRUE. DTSBD595
|
|
00190 SET DBW-READ-SEGMENT TO TRUE. DTSBD595
|
|
00191 SET DBW-PROFILE-SEGMENT TO TRUE. DTSBD595
|
|
00192 PERFORM S960-WAGE-I THRU S960-EXIT. DTSBD595
|
|
00193 ADD +1 TO WRK-PROF-READ-CNT. DTSBD595
|
|
00194 DTSBD595
|
|
00195 P1000-EXIT. DTSBD595
|
|
00196 EXIT. DTSBD595
|
|
00197 DTSBD595
|
|
00198 ************************************************************** DTSBD595
|
|
00199 * P1100 FINDS ALL THE WAGE SEGMENT ASSOCIATED WITH THE SSN DTSBD595
|
|
00200 * AND SELECTS THOSE FROM 2001. DTSBD595
|
|
00201 ************************************************************** DTSBD595
|
|
00202 DTSBD595
|
|
00203 P1100-SELECT-WAGES. DTSBD595
|
|
00204 DTSBD595
|
|
00205 SET DBW-READ-SEGMENT TO TRUE. DTSBD595
|
|
00206 PERFORM S960-WAGE-I THRU S960-EXIT. DTSBD595
|
|
00207 DTSBD595
|
|
00208 IF DBW-NO-RECORD-FOUND DTSBD595
|
|
00209 GO TO P1100-EXIT. DTSBD595
|
|
00210 ADD +1 TO WRK-WAGE-READ-CNT. DTSBD595
|
|
00211 MOVE WGP-SSN TO WRK-SSN. DTSBD595
|
|
00212 DTSBD595
|
|
00213 IF WGD-YR NOT = WRK-SUBJECT-YR DTSBD595
|
|
00214 GO TO P1100-EXIT. DTSBD595
|
|
00215 DTSBD595
|
|
00216 IF (WGD-ACCOUNT-NUMBER < 1) DTSBD595
|
|
00217 OR (WGD-ACCOUNT-NUMBER > 999999) DTSBD595
|
|
00218 GO TO P1100-EXIT. DTSBD595
|
|
00219 DTSBD595
|
|
00220 IF (WGP-SSN < 1) DTSBD595
|
|
00221 OR (WGP-SSN > 999999998) DTSBD595
|
|
00222 GO TO P1100-EXIT. DTSBD595
|
|
00223 DTSBD595
|
|
00224 IF WRK-SSN-1-3 = 000 DTSBD595
|
|
00225 OR WRK-SSN-4-5 = 00 DTSBD595
|
|
00226 OR WRK-SSN-6-9 = 0000 DTSBD595
|
|
00227 GO TO P1100-EXIT. DTSBD595
|
|
00228 DTSBD595
|
|
00229 IF WGP-SSN = (111111111 OR 222222222 OR 333333333 OR DTSBD595
|
|
00230 444444444 OR 555555555 OR 666666666 OR DTSBD595
|
|
00231 777777777 OR 888888888) DTSBD595
|
|
00232 GO TO P1100-EXIT. DTSBD595
|
|
00233 DTSBD595
|
|
00234 PERFORM P1200-CONVERT THRU P1200-EXIT. DTSBD595
|
|
00235 DTSBD595
|
|
00236 P1100-EXIT. DTSBD595
|
|
00237 EXIT. DTSBD595
|
|
00238 DTSBD595
|
|
00239 P1200-CONVERT. DTSBD595
|
|
00240 DTSBD595
|
|
00241 IF WGP-SSN = HOLD-WGP-SSN DTSBD595
|
|
00242 GO TO P1200-EXIT DTSBD595
|
|
00243 ELSE DTSBD595
|
|
00244 MOVE +0 TO WNAM-SSN DTSBD595
|
|
00245 MOVE SPACES TO WNAM-NAME DTSBD595
|
|
00246 MOVE WRK-NINE-COMPLEMENT-ABSTIME TO DTSBD595
|
|
00247 WNAM-NINES-COMPLEMENT-ABSTIME DTSBD595
|
|
00248 MOVE WGP-SSN TO WNAM-SSN DTSBD595
|
|
00249 MOVE WGP-NAME-CHK TO WNAM-NAME DTSBD595
|
|
00250 WRITE WNAM-CHG-REC DTSBD595
|
|
00251 ADD +1 TO WRK-WNAM-WRITE-CNT DTSBD595
|
|
00252 MOVE WGP-SSN TO HOLD-WGP-SSN DTSBD595
|
|
00253 END-IF. DTSBD595
|
|
00254 DTSBD595
|
|
00255 P1200-EXIT. DTSBD595
|
|
00256 EXIT. DTSBD595
|
|
00257 DTSBD595
|
|
00258 S005-SYS-DATE. DTSBD595
|
|
00259 CALL 'DTSBU005' USING L005-COMM-AREA. DTSBD595
|
|
00260 DTSBD595
|
|
00261 S005-EXIT. DTSBD595
|
|
00262 EXIT. DTSBD595
|
|
00263 DTSBD595
|
|
00264 S960-WAGE-I. DTSBD595
|
|
00265 IF DBW-WAGE-SEGMENT DTSBD595
|
|
00266 CALL 'EWG960D' USING VSAM-WAGEDATA-CONTROL-BLOCK DTSBD595
|
|
00267 WGD-SEGMENT-TWO DTSBD595
|
|
00268 ELSE DTSBD595
|
|
00269 CALL 'EWG960D' USING VSAM-WAGEDATA-CONTROL-BLOCK DTSBD595
|
|
00270 WGP-SEGMENT-ONE. DTSBD595
|
|
00271 S960-EXIT. DTSBD595
|
|
00272 EXIT. DTSBD595
|
|
00273 DTSBD595
|
|
00274 T0000-TERMINATE. DTSBD595
|
|
00275 DTSBD595
|
|
00276 DISPLAY ' '. DTSBD595
|
|
00277 DISPLAY ' '. DTSBD595
|
|
00278 DTSBD595
|
|
00279 DISPLAY '*** DTSBD595 TERMINATION STATISTICS ***'. DTSBD595
|
|
00280 DTSBD595
|
|
00281 DISPLAY ' '. DTSBD595
|
|
00282 DISPLAY 'WAGE BENEFITS PROFILE SEGMENT RECORDS READ COUNT : 'DTSBD595
|
|
00283 WRK-PROF-READ-CNT. DTSBD595
|
|
00284 DISPLAY 'WAGE BENEFITS WAGE SEGMENT RECORDS READ COUNT : 'DTSBD595
|
|
00285 WRK-WAGE-READ-CNT. DTSBD595
|
|
00286 DISPLAY ' '. DTSBD595
|
|
00287 DISPLAY 'HOUSEHOLD WAGE INFORMATION RECORDS WRITE COUNT : 'DTSBD595
|
|
00288 WRK-WNAM-WRITE-CNT. DTSBD595
|
|
00289 DISPLAY ' '. DTSBD595
|
|
00290 DTSBD595
|
|
00291 CLOSE WORKER-NAME-FILE. DTSBD595
|
|
00292 DTSBD595
|
|
00293 SET DBW-CLOSE-DATASET TO TRUE. DTSBD595
|
|
00294 PERFORM S960-WAGE-I THRU S960-EXIT. DTSBD595
|
|
00295 DTSBD595
|
|
00296 T0000-EXIT. DTSBD595
|
|
00297 EXIT. DTSBD595
|
|
00298 DTSBD595
|