611 lines
48 KiB
COBOL
611 lines
48 KiB
COBOL
00001 IDENTIFICATION DIVISION. 05/01/09
|
|
00002 PROGRAM-ID. DESBD300. DESBD300
|
|
00003 AUTHOR. TRW LV022
|
|
00004 DATE-WRITTEN. MARCH 2002. DESBD300
|
|
00005 DATE-COMPILED. DESBD300
|
|
00006 DESBD300
|
|
00007 ***** DESBD300
|
|
00008 * DESBD300
|
|
00009 * FUNCTION: EXTRACT WAGE DATA FROM THE BENEFITS WAGE FILE DESBD300
|
|
00010 * TO REBUILD THE EMPLOYER-ORIENTED WAGE FILE (WGH). DESBD300
|
|
00011 * DESBD300 WRITES THE OUTPUT TO A FLAT FIILE. DESBD300
|
|
00012 * DESBD300
|
|
00013 * NOTE: THIS PROGRAM USES SEVERAL BENEFIT MODULES THEREFORE DESBD300
|
|
00014 * THIS PROGRAM NEEDS THE BENEFIT COMPILE JCL(COB2BBEN) DESBD300
|
|
00015 * TO RESOLVE ALL THE NEEDED LOAD MODULES. DESBD300
|
|
00016 * DESBD300
|
|
00017 * MODIFICATION HISTORY: DESBD300
|
|
00018 * DESBD300
|
|
00019 * 03/04/2002 INITIAL DEVELOPMENT AND CLONE FROM DTSBR604 DESBD300
|
|
00020 * REFERENCE: PROGRAMMER: RW1 DESBD300
|
|
00021 * DESBD300
|
|
00022 * DESBD300
|
|
00023 * 04/26/2004 CHANGE WGP-SEGMENT TO WGP-SEGMENT-ONE AND DESBD300
|
|
00024 * WGD-SEGEMENT TO WGD-SEGEMENT-TWO : ZL1 DESBD300
|
|
00025 * DESBD300
|
|
00026 * 05/25/2004 CHANGED FILE NAMES FROM WGE TO WGH. CHANGED DESBD300
|
|
00027 * DD NAMES IN SELECT-ASSIGN TO MATCH NEW JOB STREAM DESBD300
|
|
00028 * REFERENCE: PROGRAMMER: GD DESBD300
|
|
00029 * DESBD300
|
|
00030 * 04/24/2006 MODIFIED TO INCLUDE 2002 WAGES FOR 129918. DESBD300
|
|
00031 * REFERENCE: PROGRAMMER: GD DESBD300
|
|
00032 * DESBD300
|
|
00033 * 09/13/2007 MODIFIED TO INCLUDE AFFIDAVIT WAGES (P1220). DESBD300
|
|
00034 * EXCLUDING THEM RESULTED IN DUPLICATE WAGE DESBD300
|
|
00035 * ITEMS ON SERVER DATABASE, SINCE THEY ALWAYS DESBD300
|
|
00036 * APPEARED AS NEW ENTRIES. DESBD300
|
|
00037 * REFERENCE: PROGRAMMER: GD DESBD300
|
|
00038 * DESBD300
|
|
00039 * 04/30/2009 MODIFIED TO INCLUDE 5 YEARS OF WAGES. DESBD300
|
|
00040 * REFERENCE: PROGRAMMER: GD DESBD300
|
|
00041 * DESBD300
|
|
00042 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DESBD300
|
|
00043 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DESBD300
|
|
00044 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DESBD300
|
|
00045 * DESBD300
|
|
00046 * DESCRIPTION: DESBD300
|
|
00047 * DESBD300
|
|
00048 * DESBD300
|
|
00049 * RECORDS READ: DESBD300
|
|
00050 * WAGE MASTER FILE DESBD300
|
|
00051 * DESBD300
|
|
00052 * PRINTED OUTPUTS: DESBD300
|
|
00053 * NONE. DESBD300
|
|
00054 * DESBD300
|
|
00055 * RECORDS WRITTEN: DESBD300
|
|
00056 * DTSIWWGH EMPLOYER ORIENTED WAGE RECORD DESBD300
|
|
00057 * DESBD300
|
|
00058 * MODULES CALLED: DESBD300
|
|
00059 * EWG960R WAGE FILE ACCESS MODULE DESBD300
|
|
00060 * DTSBU004 YEAR/QUARTER CONVERSION MODULE DESBD300
|
|
00061 * DESBD300
|
|
00062 ***** DESBD300
|
|
00063 DESBD300
|
|
00064 ENVIRONMENT DIVISION. DESBD300
|
|
00065 SKIP2 DESBD300
|
|
00066 INPUT-OUTPUT SECTION. DESBD300
|
|
00067 SKIP3 DESBD300
|
|
00068 FILE-CONTROL. DESBD300
|
|
00069 SELECT OUTPUT-WAGE-FILE ASSIGN TO WGEOUT1 DESBD300
|
|
00070 FILE STATUS IS WAGEOUT-STATUS. DESBD300
|
|
00071 SKIP2 DESBD300
|
|
00072 DESBD300
|
|
00073 DATA DIVISION. DESBD300
|
|
00074 SKIP2 DESBD300
|
|
00075 FILE SECTION. DESBD300
|
|
00076 SKIP2 DESBD300
|
|
00077 FD OUTPUT-WAGE-FILE DESBD300
|
|
00078 RECORDING MODE IS F DESBD300
|
|
00079 LABEL RECORDS ARE STANDARD DESBD300
|
|
00080 BLOCK CONTAINS 0 CHARACTERS. DESBD300
|
|
00081 SKIP1 DESBD300
|
|
00082 01 WWGH-REC. DESBD300
|
|
00083 ++INCLUDE DTSIWWGH DESBD300
|
|
00084 EJECT DESBD300
|
|
00085 WORKING-STORAGE SECTION. DESBD300
|
|
000855 77 PAN-VALET PICTURE X(24) VALUE '022DESBD300 05/01/09'. DESBD300
|
|
00086 SKIP3 DESBD300
|
|
00087 01 WRK-AREA. DESBD300
|
|
00088 05 WRK-ERROR-IND PIC X(01). DESBD300
|
|
00089 88 WRK-ERROR-YES-88 VALUE 'Y'. DESBD300
|
|
00090 88 WRK-ERROR-NO-88 VALUE 'N'. DESBD300
|
|
00091 DESBD300
|
|
00092 05 WRK-SSN-ERROR-IND PIC X(01). DESBD300
|
|
00093 88 WRK-SSN-ERROR-YES-88 VALUE 'Y'. DESBD300
|
|
00094 88 WRK-SSN-ERROR-NO-88 VALUE 'N'. DESBD300
|
|
00095 DESBD300
|
|
00096 05 WRK-NAME-FOUND-IND PIC X(01). DESBD300
|
|
00097 88 WRK-NAME-FOUND-YES-88 VALUE 'Y'. DESBD300
|
|
00098 88 WRK-NAME-FOUND-NO-88 VALUE 'N'. DESBD300
|
|
00099 DESBD300
|
|
00100 05 WRK-INVALID-SSN-CNT PIC S9(07) COMP-3 VALUE +0. DESBD300
|
|
00101 05 WRK-SEG01-READ-CNT PIC S9(07) COMP-3 VALUE +0. DESBD300
|
|
00102 05 WRK-SEG02-READ-CNT PIC S9(07) COMP-3 VALUE +0. DESBD300
|
|
00103 05 WRK-WWGH-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DESBD300
|
|
00104 05 WRK-WNAM-ADD-CNT PIC S9(07) COMP-3 VALUE +0. DESBD300
|
|
00105 05 WRK-WNAM-UPD-CNT PIC S9(07) COMP-3 VALUE +0. DESBD300
|
|
00106 05 WRK-SSN PIC 9(09) VALUE ZEROS. DESBD300
|
|
00107 05 FILLER REDEFINES WRK-SSN. DESBD300
|
|
00108 10 WRK-SSN-1-3 PIC 9(03). DESBD300
|
|
00109 10 WRK-SSN-4-5 PIC 9(02). DESBD300
|
|
00110 10 WRK-SSN-6-9 PIC 9(04). DESBD300
|
|
00111 DESBD300
|
|
00112 05 WRK-FIRST-YEAR PIC 9(04). DESBD300
|
|
00113 05 WRK-ABSTIME PIC S9(15) COMP-3. DESBD300
|
|
00114 05 WRK-LAST-SSN PIC S9(09) COMP-3 VALUE -1. DESBD300
|
|
00115 05 WRK-YRQ-5 PIC 9(05). DESBD300
|
|
00116 05 FILLER REDEFINES WRK-YRQ-5. DESBD300
|
|
00117 10 WRK-YRQ-CC PIC 9(02). DESBD300
|
|
00118 10 WRK-YRQ-YY PIC 9(02). DESBD300
|
|
00119 10 WRK-YRQ-Q PIC 9. DESBD300
|
|
00120 DESBD300
|
|
00121 05 WAGEOUT-STATUS PIC X(02) VALUE SPACES. DESBD300
|
|
00122 88 WAGEOUT-OK-88 VALUE '00'. DESBD300
|
|
00123 DESBD300
|
|
00124 ** ADD ERROR MSG TABLE SET UP DESBD300
|
|
00125 01 MSG-TABLE. DESBD300
|
|
00126 05 MSG1-EMP-TYPE. DESBD300
|
|
00127 10 MSG1-ID. DESBD300
|
|
00128 15 MSG1-ID1 PIC X(08) VALUE 'DESBD300'. DESBD300
|
|
00129 15 MSG1-ID2 PIC X(03) VALUE '300'. DESBD300
|
|
00130 10 MSG1-SHORT-TEXT PIC X(20) DESBD300
|
|
00131 VALUE 'INVALID SSN/EMP-NO :'. DESBD300
|
|
00132 10 MSG1-LONG-TEXT. DESBD300
|
|
00133 15 FILLER PIC X(28) DESBD300
|
|
00134 VALUE 'INVALID WGP-SSN / WGD-EMP-NO'. DESBD300
|
|
00135 15 FILLER PIC X(08) VALUE ' SSN = '. DESBD300
|
|
00136 15 MSG1-SSN PIC 9(09). DESBD300
|
|
00137 15 FILLER PIC X(11) VALUE ' YR-QTR = '. DESBD300
|
|
00138 15 MSG1-YR-QTR PIC 9(05). DESBD300
|
|
00139 15 FILLER PIC X(16) VALUE ' EARN-AMOUNT = '.DESBD300
|
|
00140 15 MSG1-EARN-AMT PIC Z(06)9.99-. DESBD300
|
|
00141 EJECT DESBD300
|
|
00142 01 L004-LINK-AREA. DESBD300
|
|
00143 ++INCLUDE DTSIL004 DESBD300
|
|
00144 EJECT DESBD300
|
|
00145 01 L005-COMM-AREA. DESBD300
|
|
00146 ++INCLUDE DTSIL005 DESBD300
|
|
00147 DESBD300
|
|
00148 01 R907-REC. DESBD300
|
|
00149 ++INCLUDE DTSIR907 DESBD300
|
|
00150 EJECT DESBD300
|
|
00151 01 L982-LINK-AREA. DESBD300
|
|
00152 ++INCLUDE DTSIL982 DESBD300
|
|
00153 01 WNAM-REC. DESBD300
|
|
00154 ++INCLUDE DTSIWNAM DESBD300
|
|
00155 DESBD300
|
|
00156 01 EWGLINKB-REC. DESBD300
|
|
00157 ++INCLUDE EWGVSMCB DESBD300
|
|
00158 ***** DESBD300
|
|
00159 ***** DESBD300
|
|
00160 ++INCLUDE EWGSEG01 DESBD300
|
|
00161 ***** DESBD300
|
|
00162 ***** DESBD300
|
|
00163 ++INCLUDE EWGSEG02 DESBD300
|
|
00164 ***** DESBD300
|
|
00165 ***** DESBD300
|
|
00166 ++INCLUDE EWGVSMCD DESBD300
|
|
00167 EJECT DESBD300
|
|
00168 DESBD300
|
|
00169 PROCEDURE DIVISION. DESBD300
|
|
00170 DESBD300-MAIN. DESBD300
|
|
00171 DESBD300
|
|
00172 SET WRK-ERROR-NO-88 TO TRUE. DESBD300
|
|
00173 PERFORM I0000-INIT THRU I0000-EXIT. DESBD300
|
|
00174 IF WRK-ERROR-YES-88 DESBD300
|
|
00175 GO TO DESBD300-MAIN-EXIT. DESBD300
|
|
00176 DESBD300
|
|
00177 PERFORM P0000-PROCESS THRU P0000-EXIT. DESBD300
|
|
00178 DESBD300
|
|
00179 PERFORM T0000-TERMINATE THRU T0000-EXIT. DESBD300
|
|
00180 DESBD300
|
|
00181 DESBD300-MAIN-EXIT. DESBD300
|
|
00182 GOBACK. DESBD300
|
|
00183 DESBD300
|
|
00184 I0000-INIT. DESBD300
|
|
00185 PERFORM I1000-SET-DATES THRU I1000-EXIT. DESBD300
|
|
00186 DESBD300
|
|
00187 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DESBD300
|
|
00188 DESBD300
|
|
00189 MOVE MSG1-ID1 TO R907-MODULE-NAME. DESBD300
|
|
00190 MOVE LENGTH OF R907-REC TO R907-LENGTH. DESBD300
|
|
00191 DESBD300
|
|
00192 I0000-EXIT. DESBD300
|
|
00193 EXIT. DESBD300
|
|
00194 DESBD300
|
|
00195 I1000-SET-DATES. DESBD300
|
|
00196 SET L005-FROM-SYS TO TRUE. DESBD300
|
|
00197 PERFORM S005-SYS-DATE THRU S005-EXIT. DESBD300
|
|
00198 MOVE L005-ABSTIME TO WRK-ABSTIME. DESBD300
|
|
00199 DESBD300
|
|
00200 DISPLAY 'I1000 ' L005-DATE ' ' L005-SLASH-8-YR. DESBD300
|
|
00201 SUBTRACT 5 FROM L005-SLASH-8-YR. DESBD300
|
|
00202 MOVE L005-SLASH-8-YR TO WRK-FIRST-YEAR DESBD300
|
|
00203 DISPLAY ' ' L005-SLASH-8-YR. DESBD300
|
|
00204 DESBD300
|
|
00205 DISPLAY '**************************'. DESBD300
|
|
00206 DISPLAY '* DESBD300 *'. DESBD300
|
|
00207 DISPLAY '* *'. DESBD300
|
|
00208 DISPLAY '* FIRST YEAR ' WRK-FIRST-YEAR ' *'. DESBD300
|
|
00209 DISPLAY '**************************'. DESBD300
|
|
00210 DESBD300
|
|
00211 I1000-EXIT. DESBD300
|
|
00212 EXIT. DESBD300
|
|
00213 DESBD300
|
|
00214 I2000-OPEN-FILES. DESBD300
|
|
00215 OPEN OUTPUT OUTPUT-WAGE-FILE. DESBD300
|
|
00216 IF NOT WAGEOUT-OK-88 DESBD300
|
|
00217 DISPLAY 'CANNOT OPEN WAGE OUTPUT FILE ' DESBD300
|
|
00218 WAGEOUT-STATUS DESBD300
|
|
00219 SET WRK-ERROR-YES-88 TO TRUE DESBD300
|
|
00220 GO TO I2000-EXIT. DESBD300
|
|
00221 DESBD300
|
|
00222 SET DBW-OPEN-INPUT TO TRUE DESBD300
|
|
00223 PERFORM S960-WAGE-I THRU S960-EXIT DESBD300
|
|
00224 IF NOT DBW-SUCCESSFUL-COMPLETION DESBD300
|
|
00225 SET WRK-ERROR-YES-88 TO TRUE DESBD300
|
|
00226 GO TO I2000-EXIT. DESBD300
|
|
00227 DESBD300
|
|
00228 PERFORM S982A-OPEN THRU S982A-EXIT. DESBD300
|
|
00229 DESBD300
|
|
00230 I2000-EXIT. DESBD300
|
|
00231 EXIT. DESBD300
|
|
00232 DESBD300
|
|
00233 P0000-PROCESS. DESBD300
|
|
00234 SET DBW-SEQUENTIAL-PROCESSING TO TRUE. DESBD300
|
|
00235 SET DBW-READ-SEGMENT TO TRUE. DESBD300
|
|
00236 SET DBW-PROFILE-SEGMENT TO TRUE. DESBD300
|
|
00237 DESBD300
|
|
00238 PERFORM S960-WAGE-I THRU S960-EXIT. DESBD300
|
|
00239 DESBD300
|
|
00240 IF DBW-SUCCESSFUL-COMPLETION DESBD300
|
|
00241 ADD +1 TO WRK-SEG01-READ-CNT DESBD300
|
|
00242 PERFORM P1000-READ-WAGE-FILE THRU P1000-EXIT DESBD300
|
|
00243 UNTIL DBW-END-OF-FILE. DESBD300
|
|
00244 *& OR WRK-SEG01-READ-CNT > 200. DESBD300
|
|
00245 DESBD300
|
|
00246 P0000-EXIT. DESBD300
|
|
00247 EXIT. DESBD300
|
|
00248 DESBD300
|
|
00249 ************************************************************** DESBD300
|
|
00250 * THE FOLLOWING READS THE THE NEXT SEGMENT 1, DESBD300
|
|
00251 * AND RETURNS THE NEXT SSN ON FILE. DESBD300
|
|
00252 ************************************************************** DESBD300
|
|
00253 DESBD300
|
|
00254 P1000-READ-WAGE-FILE. DESBD300
|
|
00255 *& DESBD300
|
|
00256 * IF WRK-SEG01-READ-CNT < 1000 DESBD300
|
|
00257 * IF WGP-SSN = 352266278 OR 577840054 OR DESBD300
|
|
00258 * 578063437 OR 579964051 DESBD300
|
|
00259 * DISPLAY 'P1000 WGP ' WGP-SSN ' ' WRK-LAST-SSN DESBD300
|
|
00260 * END-IF. DESBD300
|
|
00261 *& DESBD300
|
|
00262 IF WGP-SSN NOT = WRK-LAST-SSN DESBD300
|
|
00263 PERFORM P1100-CHECK-NAMES THRU P1100-EXIT. DESBD300
|
|
00264 DESBD300
|
|
00265 SET DBW-RANDOM-PROCESSING TO TRUE. DESBD300
|
|
00266 SET DBW-WAGE-SEGMENT TO TRUE. DESBD300
|
|
00267 SET DBW-RESET-POINTERS TO TRUE. DESBD300
|
|
00268 PERFORM S960-WAGE-I THRU S960-EXIT. DESBD300
|
|
00269 DESBD300
|
|
00270 PERFORM P1200-SELECT-WAGES THRU P1200-EXIT DESBD300
|
|
00271 UNTIL DBW-NO-RECORD-FOUND. DESBD300
|
|
00272 DESBD300
|
|
00273 SET DBW-SEQUENTIAL-PROCESSING TO TRUE. DESBD300
|
|
00274 SET DBW-READ-SEGMENT TO TRUE. DESBD300
|
|
00275 SET DBW-PROFILE-SEGMENT TO TRUE. DESBD300
|
|
00276 PERFORM S960-WAGE-I THRU S960-EXIT. DESBD300
|
|
00277 ADD +1 TO WRK-SEG01-READ-CNT. DESBD300
|
|
00278 DESBD300
|
|
00279 P1000-EXIT. DESBD300
|
|
00280 EXIT. DESBD300
|
|
00281 DESBD300
|
|
00282 P1100-CHECK-NAMES. DESBD300
|
|
00283 MOVE WGP-SSN TO WNAM-SSN. DESBD300
|
|
00284 MOVE ZERO TO WNAM-NINES-COMPLEMENT-ABSTIME. DESBD300
|
|
00285 PERFORM S982B-START-BROWSE THRU S982B-EXIT. DESBD300
|
|
00286 IF L982-NO-REC-88 DESBD300
|
|
00287 PERFORM P1110-ADD-TO-WNAM THRU P1110-EXIT DESBD300
|
|
00288 ELSE DESBD300
|
|
00289 IF WNAM-SSN > WGP-SSN DESBD300
|
|
00290 PERFORM P1110-ADD-TO-WNAM THRU P1110-EXIT DESBD300
|
|
00291 ELSE DESBD300
|
|
00292 IF WNAM-SSN = WGP-SSN DESBD300
|
|
00293 PERFORM P1120-UPDATE-WNAM THRU P1120-EXIT. DESBD300
|
|
00294 DESBD300
|
|
00295 P1100-EXIT. DESBD300
|
|
00296 EXIT. DESBD300
|
|
00297 DESBD300
|
|
00298 P1110-ADD-TO-WNAM. DESBD300
|
|
00299 MOVE WGP-SSN TO WNAM-SSN. DESBD300
|
|
00300 ADD +1 TO WRK-ABSTIME. DESBD300
|
|
00301 MOVE WRK-ABSTIME TO L005-ABSTIME. DESBD300
|
|
00302 SET L005-FROM-ABSTIME TO TRUE. DESBD300
|
|
00303 PERFORM S005-SYS-DATE THRU S005-EXIT. DESBD300
|
|
00304 MOVE L005-NINES-COMPLEMENT-ABSTIME DESBD300
|
|
00305 TO WNAM-NINES-COMPLEMENT-ABSTIME. DESBD300
|
|
00306 DESBD300
|
|
00307 MOVE WGP-NAME-CHK TO WNAM-LAST-NAME. DESBD300
|
|
00308 MOVE SPACES TO WNAM-FIRST-NAME DESBD300
|
|
00309 WNAM-MID-INIT. DESBD300
|
|
00310 SET WNAM-TYPE-3CHAR-88 TO TRUE. DESBD300
|
|
00311 DESBD300
|
|
00312 PERFORM S982D-WRITE THRU S982D-EXIT. DESBD300
|
|
00313 DESBD300
|
|
00314 ADD +1 TO WRK-WNAM-ADD-CNT. DESBD300
|
|
00315 *& DESBD300
|
|
00316 * IF WRK-WNAM-ADD-CNT < +1000 DESBD300
|
|
00317 * IF WGP-SSN = 352266278 OR 577840054 OR DESBD300
|
|
00318 * 578063437 OR 579964051 DESBD300
|
|
00319 * DISPLAY 'P1110 ADD ' WGP-SSN ' ' WNAM-SSN DESBD300
|
|
00320 * ' WNAM ' WNAM-LAST-NAME. DESBD300
|
|
00321 *& DESBD300
|
|
00322 DESBD300
|
|
00323 DESBD300
|
|
00324 P1110-EXIT. DESBD300
|
|
00325 EXIT. DESBD300
|
|
00326 DESBD300
|
|
00327 P1120-UPDATE-WNAM. DESBD300
|
|
00328 *& IF WRK-WNAM-UPD-CNT < +1000 DESBD300
|
|
00329 * IF WGP-SSN = 352266278 OR 577840054 OR DESBD300
|
|
00330 * 578063437 OR 579964051 DESBD300
|
|
00331 * DISPLAY 'P1120 UPD ' WNAM-SSN DESBD300
|
|
00332 * ' WNAM ' WNAM-LAST-NAME DESBD300
|
|
00333 * ' ' WNAM-FIRST-NAME DESBD300
|
|
00334 * ' WGP ' WGP-SSN ' ' WGP-NAME-CHK DESBD300
|
|
00335 * END-IF. DESBD300
|
|
00336 *& DESBD300
|
|
00337 IF WNAM-TYPE-3CHAR-88 DESBD300
|
|
00338 IF WNAM-LAST-NAME (1:3) = WGP-NAME-CHK DESBD300
|
|
00339 GO TO P1120-EXIT DESBD300
|
|
00340 ELSE DESBD300
|
|
00341 PERFORM P1121-READ-NAMES THRU P1121-EXIT DESBD300
|
|
00342 IF WRK-NAME-FOUND-NO-88 DESBD300
|
|
00343 PERFORM P1122-ADD THRU P1122-EXIT DESBD300
|
|
00344 END-IF DESBD300
|
|
00345 END-IF DESBD300
|
|
00346 END-IF. DESBD300
|
|
00347 DESBD300
|
|
00348 P1120-EXIT. DESBD300
|
|
00349 EXIT. DESBD300
|
|
00350 DESBD300
|
|
00351 P1121-READ-NAMES. DESBD300
|
|
00352 SET WRK-NAME-FOUND-NO-88 TO TRUE. DESBD300
|
|
00353 DESBD300
|
|
00354 PERFORM DESBD300
|
|
00355 UNTIL L982-NO-REC-88 DESBD300
|
|
00356 OR WNAM-SSN NOT = WGP-SSN DESBD300
|
|
00357 IF WNAM-LAST-NAME (1:3) = WGP-NAME-CHK DESBD300
|
|
00358 SET WRK-NAME-FOUND-YES-88 TO TRUE DESBD300
|
|
00359 SET L982-NO-REC-88 TO TRUE DESBD300
|
|
00360 ELSE DESBD300
|
|
00361 PERFORM S982C-READ-NEXT THRU S982C-EXIT DESBD300
|
|
00362 END-IF DESBD300
|
|
00363 END-PERFORM. DESBD300
|
|
00364 DESBD300
|
|
00365 P1121-EXIT. DESBD300
|
|
00366 EXIT. DESBD300
|
|
00367 DESBD300
|
|
00368 P1122-ADD. DESBD300
|
|
00369 ADD +1 TO WRK-WNAM-UPD-CNT. DESBD300
|
|
00370 *& IF WRK-WNAM-UPD-CNT < +1000 DESBD300
|
|
00371 * IF WGP-SSN = 352266278 OR 577840054 OR DESBD300
|
|
00372 * 578063437 OR 579964051 DESBD300
|
|
00373 * DISPLAY 'P1122 UPD ' WNAM-SSN DESBD300
|
|
00374 * ' WNAM ' WNAM-LAST-NAME DESBD300
|
|
00375 * ' WGP ' WGP-SSN ' ' WGP-NAME-CHK DESBD300
|
|
00376 * END-IF. DESBD300
|
|
00377 *& DESBD300
|
|
00378 MOVE WGP-SSN TO WNAM-SSN. DESBD300
|
|
00379 ADD +1 TO WRK-ABSTIME. DESBD300
|
|
00380 MOVE WRK-ABSTIME TO L005-ABSTIME. DESBD300
|
|
00381 SET L005-FROM-ABSTIME TO TRUE. DESBD300
|
|
00382 PERFORM S005-SYS-DATE THRU S005-EXIT. DESBD300
|
|
00383 MOVE L005-NINES-COMPLEMENT-ABSTIME DESBD300
|
|
00384 TO WNAM-NINES-COMPLEMENT-ABSTIME. DESBD300
|
|
00385 DESBD300
|
|
00386 MOVE WGP-NAME-CHK TO WNAM-LAST-NAME. DESBD300
|
|
00387 MOVE SPACES TO WNAM-FIRST-NAME DESBD300
|
|
00388 WNAM-MID-INIT. DESBD300
|
|
00389 SET WNAM-TYPE-3CHAR-88 TO TRUE. DESBD300
|
|
00390 PERFORM S982D-WRITE THRU S982D-EXIT. DESBD300
|
|
00391 DESBD300
|
|
00392 P1122-EXIT. DESBD300
|
|
00393 EXIT. DESBD300
|
|
00394 DESBD300
|
|
00395 ************************************************************** DESBD300
|
|
00396 * P1200 FINDS ALL THE WAGE SEGMENT ASSOCIATED WITH THE SSN DESBD300
|
|
00397 * AND SELECTS THOSE FROM 2001. DESBD300
|
|
00398 ************************************************************** DESBD300
|
|
00399 DESBD300
|
|
00400 P1200-SELECT-WAGES. DESBD300
|
|
00401 DESBD300
|
|
00402 SET DBW-READ-SEGMENT TO TRUE. DESBD300
|
|
00403 PERFORM S960-WAGE-I THRU S960-EXIT. DESBD300
|
|
00404 DESBD300
|
|
00405 IF DBW-NO-RECORD-FOUND DESBD300
|
|
00406 GO TO P1200-EXIT. DESBD300
|
|
00407 DESBD300
|
|
00408 ADD +1 TO WRK-SEG02-READ-CNT. DESBD300
|
|
00409 DESBD300
|
|
00410 *& DESBD300
|
|
00411 * IF WGD-ACCOUNT-NUMBER = 012035 OR 013133 OR 019289 DESBD300
|
|
00412 * IF WGP-SSN = 226873221 DESBD300
|
|
00413 * DISPLAY 'P1200 ' WGD-ACCOUNT-NUMBER DESBD300
|
|
00414 * ' ' WGP-SSN DESBD300
|
|
00415 * ' ' WGP-NAME-CHK DESBD300
|
|
00416 * ' ' WGD-YR-QTR DESBD300
|
|
00417 * ' ' WGD-QUARTER-EARNINGS. DESBD300
|
|
00418 * ' ' WRK-CURR-YR. DESBD300
|
|
00419 *& DESBD300
|
|
00420 DESBD300
|
|
00421 IF WGD-YR >= WRK-FIRST-YEAR DESBD300
|
|
00422 SET WRK-SSN-ERROR-NO-88 TO TRUE DESBD300
|
|
00423 PERFORM P1210-EDIT-SSN THRU P1210-EXIT DESBD300
|
|
00424 IF WRK-SSN-ERROR-NO-88 DESBD300
|
|
00425 PERFORM P1220-BUILD-WGH THRU P1220-EXIT DESBD300
|
|
00426 END-IF DESBD300
|
|
00427 END-IF. DESBD300
|
|
00428 DESBD300
|
|
00429 P1200-EXIT. DESBD300
|
|
00430 EXIT. DESBD300
|
|
00431 DESBD300
|
|
00432 P1210-EDIT-SSN. DESBD300
|
|
00433 MOVE WGP-SSN TO WRK-SSN. DESBD300
|
|
00434 DESBD300
|
|
00435 IF (WRK-SSN < 1) OR (WRK-SSN > 999999998) DESBD300
|
|
00436 PERFORM P2000-WRITE-R907-REC THRU P2000-EXIT DESBD300
|
|
00437 GO TO P1210-EXIT. DESBD300
|
|
00438 DESBD300
|
|
00439 IF WRK-SSN-1-3 = 000 DESBD300
|
|
00440 OR WRK-SSN-4-5 = 00 DESBD300
|
|
00441 OR WRK-SSN-6-9 = 0000 DESBD300
|
|
00442 PERFORM P2000-WRITE-R907-REC THRU P2000-EXIT. DESBD300
|
|
00443 *& GO TO P1210-EXIT. DESBD300
|
|
00444 DESBD300
|
|
00445 IF WRK-SSN = 111111111 DESBD300
|
|
00446 OR WRK-SSN = 222222222 DESBD300
|
|
00447 OR WRK-SSN = 333333333 DESBD300
|
|
00448 OR WRK-SSN = 444444444 DESBD300
|
|
00449 OR WRK-SSN = 555555555 DESBD300
|
|
00450 OR WRK-SSN = 666666666 DESBD300
|
|
00451 OR WRK-SSN = 777777777 DESBD300
|
|
00452 OR WRK-SSN = 888888888 DESBD300
|
|
00453 OR WRK-SSN = 999999999 DESBD300
|
|
00454 PERFORM P2000-WRITE-R907-REC THRU P2000-EXIT. DESBD300
|
|
00455 *& GO TO P1210-EXIT. DESBD300
|
|
00456 DESBD300
|
|
00457 P1210-EXIT. DESBD300
|
|
00458 EXIT. DESBD300
|
|
00459 DESBD300
|
|
00460 P1220-BUILD-WGH. DESBD300
|
|
00461 *& DESBD300
|
|
00462 * IF WGD-ACCOUNT-NUMBER = 010021 DESBD300
|
|
00463 * OR WGP-SSN = 254417274 DESBD300
|
|
00464 * DISPLAY 'P1220 ' WGD-ACCOUNT-NUMBER DESBD300
|
|
00465 * ' ' WGP-SSN DESBD300
|
|
00466 * ' ' WGD-YR-QTR DESBD300
|
|
00467 * ' ' WGD-QUARTER-EARNINGS DESBD300
|
|
00468 * ' ' WGD-AFFI-CODE. DESBD300
|
|
00469 *& DESBD300
|
|
00470 DESBD300
|
|
00471 ** IF WGD-AFFI-CODE = 1 DESBD300
|
|
00472 ** GO TO P1220-EXIT. DESBD300
|
|
00473 DESBD300
|
|
00474 INITIALIZE WWGH-REC. DESBD300
|
|
00475 DESBD300
|
|
00476 MOVE WGD-ACCOUNT-NUMBER TO WWGH-EMP-NO. DESBD300
|
|
00477 MOVE WGD-YR-QTR TO WWGH-YRQ. DESBD300
|
|
00478 MOVE WGP-SSN TO WWGH-SSN. DESBD300
|
|
00479 MOVE WGD-QUARTER-EARNINGS TO WWGH-EARNINGS. DESBD300
|
|
00480 DESBD300
|
|
00481 WRITE WWGH-REC. DESBD300
|
|
00482 ADD +1 TO WRK-WWGH-WRITE-CNT. DESBD300
|
|
00483 DESBD300
|
|
00484 P1220-EXIT. DESBD300
|
|
00485 EXIT. DESBD300
|
|
00486 DESBD300
|
|
00487 ************************************************************** DESBD300
|
|
00488 * WRITE R907 RECORDS DESBD300
|
|
00489 ************************************************************** DESBD300
|
|
00490 DESBD300
|
|
00491 P2000-WRITE-R907-REC. DESBD300
|
|
00492 ADD +1 TO WRK-INVALID-SSN-CNT. DESBD300
|
|
00493 MOVE MSG1-ID2 TO R907-MSG-ID DESBD300
|
|
00494 MOVE WGD-ACCOUNT-NUMBER TO R907-EMP-NO. DESBD300
|
|
00495 MOVE WGP-SSN TO MSG1-SSN. DESBD300
|
|
00496 MOVE WGD-YR-QTR TO MSG1-YR-QTR. DESBD300
|
|
00497 MOVE WGD-QUARTER-EARNINGS TO MSG1-EARN-AMT. DESBD300
|
|
00498 MOVE MSG1-LONG-TEXT TO R907-MSG-TEXT. DESBD300
|
|
00499 PERFORM S946-R907-WRITE THRU S946-EXIT. DESBD300
|
|
00500 DESBD300
|
|
00501 P2000-EXIT. DESBD300
|
|
00502 EXIT. DESBD300
|
|
00503 DESBD300
|
|
00504 S005-SYS-DATE. DESBD300
|
|
00505 CALL 'DTSBU005' USING L005-COMM-AREA. DESBD300
|
|
00506 DESBD300
|
|
00507 S005-EXIT. DESBD300
|
|
00508 EXIT. DESBD300
|
|
00509 DESBD300
|
|
00510 S960-WAGE-I. DESBD300
|
|
00511 IF DBW-WAGE-SEGMENT DESBD300
|
|
00512 CALL 'EWG960D' USING VSAM-WAGEDATA-CONTROL-BLOCK DESBD300
|
|
00513 WGD-SEGMENT-TWO DESBD300
|
|
00514 ELSE DESBD300
|
|
00515 CALL 'EWG960D' USING VSAM-WAGEDATA-CONTROL-BLOCK DESBD300
|
|
00516 WGP-SEGMENT-ONE. DESBD300
|
|
00517 S960-EXIT. DESBD300
|
|
00518 EXIT. DESBD300
|
|
00519 DESBD300
|
|
00520 S982A-OPEN. DESBD300
|
|
00521 SET L982-OPEN-UPDATE-88 TO TRUE. DESBD300
|
|
00522 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DESBD300
|
|
00523 DESBD300
|
|
00524 S982A-EXIT. DESBD300
|
|
00525 EXIT. DESBD300
|
|
00526 DESBD300
|
|
00527 S982B-START-BROWSE. DESBD300
|
|
00528 SET L982-START-BROWSE-88 TO TRUE. DESBD300
|
|
00529 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DESBD300
|
|
00530 DESBD300
|
|
00531 S982B-EXIT. DESBD300
|
|
00532 EXIT. DESBD300
|
|
00533 DESBD300
|
|
00534 S982C-READ-NEXT. DESBD300
|
|
00535 SET L982-READ-NEXT-88 TO TRUE. DESBD300
|
|
00536 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DESBD300
|
|
00537 DESBD300
|
|
00538 S982C-EXIT. DESBD300
|
|
00539 EXIT. DESBD300
|
|
00540 DESBD300
|
|
00541 S982D-WRITE. DESBD300
|
|
00542 SET L982-WRITE-88 TO TRUE. DESBD300
|
|
00543 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DESBD300
|
|
00544 DESBD300
|
|
00545 S982D-EXIT. DESBD300
|
|
00546 EXIT. DESBD300
|
|
00547 DESBD300
|
|
00548 S982E-REWRITE. DESBD300
|
|
00549 SET L982-REWRITE-88 TO TRUE. DESBD300
|
|
00550 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DESBD300
|
|
00551 DESBD300
|
|
00552 S982E-EXIT. DESBD300
|
|
00553 EXIT. DESBD300
|
|
00554 DESBD300
|
|
00555 S982F-CLOSE. DESBD300
|
|
00556 SET L982-CLOSE-88 TO TRUE. DESBD300
|
|
00557 PERFORM S982Z-WNAM-IO THRU S982Z-EXIT. DESBD300
|
|
00558 DESBD300
|
|
00559 S982F-EXIT. DESBD300
|
|
00560 EXIT. DESBD300
|
|
00561 DESBD300
|
|
00562 S982Z-WNAM-IO. DESBD300
|
|
00563 CALL 'DTSBU982' USING L982-LINK-AREA DESBD300
|
|
00564 WNAM-REC. DESBD300
|
|
00565 S982Z-EXIT. DESBD300
|
|
00566 EXIT. DESBD300
|
|
00567 DESBD300
|
|
00568 ** ADD ERROR MSG PROCESS PARA. DESBD300
|
|
00569 S946-R907-WRITE. DESBD300
|
|
00570 CALL 'DTSBU946' USING R907-REC. DESBD300
|
|
00571 S946-EXIT. EXIT. DESBD300
|
|
00572 DESBD300
|
|
00573 T0000-TERMINATE. DESBD300
|
|
00574 DESBD300
|
|
00575 DISPLAY ' '. DESBD300
|
|
00576 DISPLAY ' '. DESBD300
|
|
00577 DESBD300
|
|
00578 DISPLAY '*** DESBD300 TERMINATION STATISTICS ***'. DESBD300
|
|
00579 DESBD300
|
|
00580 DISPLAY ' '. DESBD300
|
|
00581 DISPLAY 'WAGE SEG01 RECORDS READ COUNT :' DESBD300
|
|
00582 WRK-SEG01-READ-CNT. DESBD300
|
|
00583 DISPLAY 'WAGE SEG02 SEGMENT RECORDS READ COUNT :' DESBD300
|
|
00584 WRK-SEG02-READ-CNT. DESBD300
|
|
00585 DISPLAY ' '. DESBD300
|
|
00586 DISPLAY 'WAGE OUTPUT RECORDS WRITTEN :' DESBD300
|
|
00587 WRK-WWGH-WRITE-CNT. DESBD300
|
|
00588 DESBD300
|
|
00589 DISPLAY ' '. DESBD300
|
|
00590 DISPLAY 'NAME RECORDS ADDED :' DESBD300
|
|
00591 WRK-WNAM-ADD-CNT. DESBD300
|
|
00592 DESBD300
|
|
00593 DISPLAY ' '. DESBD300
|
|
00594 DISPLAY 'NAME RECORDS UPDATED :' DESBD300
|
|
00595 WRK-WNAM-UPD-CNT. DESBD300
|
|
00596 DESBD300
|
|
00597 DISPLAY ' '. DESBD300
|
|
00598 DISPLAY 'INVALID SSNS FOUND :' DESBD300
|
|
00599 WRK-INVALID-SSN-CNT. DESBD300
|
|
00600 DESBD300
|
|
00601 CLOSE OUTPUT-WAGE-FILE. DESBD300
|
|
00602 DESBD300
|
|
00603 SET DBW-CLOSE-DATASET TO TRUE. DESBD300
|
|
00604 PERFORM S960-WAGE-I THRU S960-EXIT. DESBD300
|
|
00605 PERFORM S982F-CLOSE THRU S982F-EXIT. DESBD300
|
|
00606 DESBD300
|
|
00607 T0000-EXIT. DESBD300
|
|
00608 EXIT. DESBD300
|
|
00609 DESBD300
|