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
