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