00001  IDENTIFICATION DIVISION.                                         05/10/04
00002  PROGRAM-ID.             DTSBD520.                                DTSBD520
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV014
00004  DATE-WRITTEN.           APRIL 1995.                              DTSBD520
00005  DATE-COMPILED.                                                   DTSBD520
00006      SKIP2                                                        DTSBD520
00007 *****                                                             DTSBD520
00008 *                                                                 DTSBD520
00009 *  FUNCTION:                                                      DTSBD520
00010 *                                                                 DTSBD520
00011 *    WAGE FILE EXTRACT STEP OF THE WAGE FILE / TAX FILE           DTSBD520
00012 *    COMPARISON PROCESS.                                          DTSBD520
00013 *                                                                 DTSBD520
00014 *                                                                 DTSBD520
00015 *  MODIFICATION HISTORY:                                          DTSBD520
00016 *                                                                 DTSBD520
00017 *    04/10/95  MODULE WRITTEN.                                    DTSBD520
00018 *              RFP: CR048                         PROGRAMMER: EHH DTSBD520
00019 *                                                                 DTSBD520
00020 *    02/13/1999  REVIEWED AND MODIFIED FOR DC.                    DTSBD520
00021 *                REFERENCE: DC DEVELOPMENT        PROGRAMMER: EHH DTSBD520
00022 *                                                                 DTSBD520
00023 *    05/20/1999  PICKUP MODIFICATIONS.  LIMIT PARAMETER INPUT     DTSBD520
00024 *                YRQ TO GREATER THAN 19924.                       DTSBD520
00025 *                REFERENCE: PICKUP DIR            PROGRAMMER: EHH DTSBD520
00026 *                                                                 DTSBD520
00027 *    12/14/1999  ADDED CALL TO WAGE I-O MODULE TO OPEN FOR INPUT  DTSBD520
00028 *                ONLY IN I0000-INITIATE.                          DTSBD520
00029 *                REFERENCE:                       PROGRAMMER: GD  DTSBD520
00030 *                                                                 DTSBD520
00031 *   04/26/2004  CHANGE WGP-SEGMENT TO WGP-SEGMENT-ONE AND         DTSBD520
00032 *               WGD-SEGEMENT TO WGD-SEGEMENT-TWO         : ZL1    DTSBD520
00033 *                                                                 DTSBD520
00034 *                                                                 DTSBD520
00035 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD520
00036 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD520
00037 *                REFERENCE: XXXXXXXXXXXXXXX       PROGRAMMER: XXX DTSBD520
00038 *                                                                 DTSBD520
00039 *                                                                 DTSBD520
00040 *  DESCRIPTION:                                                   DTSBD520
00041 *                                                                 DTSBD520
00042 *                                                                 DTSBD520
00043 *                                                                 DTSBD520
00044 *                                                                 DTSBD520
00045 *                                                                 DTSBD520
00046 *                                                                 DTSBD520
00047 *                                                                 DTSBD520
00048 *    RECORDS READ:                                                DTSBD520
00049 *                                                                 DTSBD520
00050 *         MPRF                                                    DTSBD520
00051 *         MREL                                                    DTSBD520
00052 *                                                                 DTSBD520
00053 *         WAGE                                                    DTSBD520
00054 *                                                                 DTSBD520
00055 *                                                                 DTSBD520
00056 *    PRINTED OUTPUTS:                                             DTSBD520
00057 *                                                                 DTSBD520
00058 *         NONE                                                    DTSBD520
00059 *                                                                 DTSBD520
00060 *                                                                 DTSBD520
00061 *    RECORDS WRITTEN:                                             DTSBD520
00062 *                                                                 DTSBD520
00063 *         DTSIX737  WAGE FILE / TAX FILE COMPARISON EXTRACT       DTSBD520
00064 *                   RECORD.                                       DTSBD520
00065 *                                                                 DTSBD520
00066 *                                                                 DTSBD520
00067 *    MODULES CALLED:                                              DTSBD520
00068 *                                                                 DTSBD520
00069 *         EWG961D   WAGE FILE ACCESS MODULE                       DTSBD520
00070 *         DTSBU001  DATE CONVERSION MODULE                        DTSBD520
00071 *         DTSBU004  YEAR/QUARTER CONVERSION MODULE                DTSBD520
00072 *         DTSBU910  TAX FILE ACCESS MODULE                        DTSBD520
00073 *                                                                 DTSBD520
00074 *****                                                             DTSBD520
00075      SKIP3                                                        DTSBD520
00076  ENVIRONMENT DIVISION.                                            DTSBD520
00077      SKIP3                                                        DTSBD520
00078  INPUT-OUTPUT SECTION.                                            DTSBD520
00079      SKIP2                                                        DTSBD520
00080  FILE-CONTROL.                                                    DTSBD520
00081      SELECT EXTRACT-FILE ASSIGN TO EXTFILE                        DTSBD520
00082          FILE STATUS IS EXT-FILE-STATUS.                          DTSBD520
00083      SKIP2                                                        DTSBD520
00084  DATA DIVISION.                                                   DTSBD520
00085      SKIP3                                                        DTSBD520
00086  FILE SECTION.                                                    DTSBD520
00087      EJECT                                                        DTSBD520
00088  FD  EXTRACT-FILE                                                 DTSBD520
00089      LABEL RECORDS ARE STANDARD                                   DTSBD520
00090      RECORDING MODE IS F                                          DTSBD520
00091      BLOCK CONTAINS 0 RECORDS.                                    DTSBD520
00092                                                                   DTSBD520
00093  01  EXTRACT-REC.                                                 DTSBD520
00094  ++INCLUDE DTSIX737                                               DTSBD520
00095      EJECT                                                        DTSBD520
00096  WORKING-STORAGE SECTION.                                         DTSBD520
000965 77  PAN-VALET PICTURE X(24) VALUE '014DTSBD520  05/10/04'.       DTSBD520
00097      SKIP3                                                        DTSBD520
00098  01  WRK-AREA.                                                    DTSBD520
00099      05  ABEND-CODE                  PIC S9(04) COMP  VALUE +520. DTSBD520
00100                                                                   DTSBD520
00101      05  MOD-NAME                    PIC  X(08)  VALUE 'DTSBD520'.DTSBD520
00102                                                                   DTSBD520
00103      05  MIN-EMP-NO                  PIC S9(07)  COMP-3           DTSBD520
00104                                                  VALUE +1.        DTSBD520
00105                                                                   DTSBD520
00106      05  MAX-EMP-NO                  PIC S9(07)  COMP-3           DTSBD520
00107                                                  VALUE +999999.   DTSBD520
00108                                                                   DTSBD520
00109      05  WRK-PICKUP-YRQ              PIC S9(05)  COMP-3           DTSBD520
00110                                                  VALUE +19924.    DTSBD520
00111                                                                   DTSBD520
00112                                                                   DTSBD520
00113      05  ABEND-MSG                   PIC  X(60).                  DTSBD520
00114                                                                   DTSBD520
00115                                                                   DTSBD520
00116      05  EXT-FILE-STATUS             PIC  X(02).                  DTSBD520
00117          88  EXT-FILE-OK-88                 VALUE '00'.           DTSBD520
00118                                                                   DTSBD520
00119      05  FILE-COMMAND                PIC  X(10).                  DTSBD520
00120                                                                   DTSBD520
00121                                                                   DTSBD520
00122      05  OUT-EXT-CNT                 PIC S9(09)  COMP-3.          DTSBD520
00123                                                                   DTSBD520
00124      05  DISPLAY-REC-CNT-X           PIC  X(11).                  DTSBD520
00125      05  DISPLAY-REC-CNT REDEFINES DISPLAY-REC-CNT-X              DTSBD520
00126                                      PIC  ZZZ,ZZZ,ZZ9.            DTSBD520
00127                                                                   DTSBD520
00128                                                                   DTSBD520
00129      05  WRK-YEAR-START-DATE             PIC S9(09)  COMP-3.      DTSBD520
00130                                                                   DTSBD520
00131      05  WRK-YEAR-END-DATE               PIC S9(09)  COMP-3.      DTSBD520
00132                                                                   DTSBD520
00133      05  WRK-START-YRQ                   PIC S9(05)  COMP-3.      DTSBD520
00134                                                                   DTSBD520
00135      05  WRK-END-YRQ                     PIC S9(05)  COMP-3.      DTSBD520
00136                                                                   DTSBD520
00137      05  WRK-YRQ-CNT                     PIC S9(04)  COMP.        DTSBD520
00138                                                                   DTSBD520
00139      05  WRK-YRQ OCCURS 4 TIMES                                   DTSBD520
00140                  INDEXED BY WRK-YRQ-IDX  PIC S9(05)  COMP-3.      DTSBD520
00141                                                                   DTSBD520
00142                                                                   DTSBD520
00143      05  MAX-WAGES-EMP-CNT               PIC S9(04)  COMP.        DTSBD520
00144                                                                   DTSBD520
00145      05  MAX-PRED-EMP-CNT                PIC S9(04)  COMP.        DTSBD520
00146                                                                   DTSBD520
00147                                                                   DTSBD520
00148      05  WRK-EMP-NO                      PIC S9(07)  COMP-3.      DTSBD520
00149      EJECT                                                        DTSBD520
00150  01  WAGES-TABLE.                                                 DTSBD520
00151      05  WAGES-EMP-MAX               PIC S9(04)  COMP VALUE +1000.DTSBD520
00152                                                                   DTSBD520
00153      05  WAGES-EMP-SUB               PIC S9(04)  COMP.            DTSBD520
00154                                                                   DTSBD520
00155      05  WAGES-EMP-CNT               PIC S9(04)  COMP.            DTSBD520
00156                                                                   DTSBD520
00157      05  WAGES-EMP-AREA OCCURS 1000 TIMES                         DTSBD520
00158                         INDEXED BY WAGES-EMP-IDX1                 DTSBD520
00159                                    WAGES-EMP-IDX2.                DTSBD520
00160          10  WAGES-EMP-NO            PIC S9(07)  COMP-3.          DTSBD520
00161          10  WAGES-YRQ-AMT OCCURS 4 TIMES                         DTSBD520
00162                            INDEXED BY WAGES-YRQ-IDX               DTSBD520
00163                                      PIC S9(09)V9(02)  COMP-3.    DTSBD520
00164                                                                   DTSBD520
00165                                                                   DTSBD520
00166                                                                   DTSBD520
00167  01  PRED-AREA.                                                   DTSBD520
00168      05  PRED-EMP-MAX                PIC S9(04)  COMP  VALUE +100.DTSBD520
00169                                                                   DTSBD520
00170      05  SUCC-EMP-NO                 PIC S9(07)  COMP-3.          DTSBD520
00171                                                                   DTSBD520
00172      05  PRED-EMP-SUB                PIC S9(04)  COMP.            DTSBD520
00173                                                                   DTSBD520
00174      05  PRED-EMP-CNT                PIC S9(04)  COMP.            DTSBD520
00175                                                                   DTSBD520
00176      05  PRED-EMP-AREA OCCURS 100 TIMES                           DTSBD520
00177                        INDEXED BY PRED-EMP-IDX1                   DTSBD520
00178                                   PRED-EMP-IDX2.                  DTSBD520
00179          10  PRED-EMP-NO             PIC S9(07)  COMP-3.          DTSBD520
00180      EJECT                                                        DTSBD520
00181  01  L001-LINK-AREA.                                              DTSBD520
00182  ++INCLUDE DTSIL001                                               DTSBD520
00183      SKIP3                                                        DTSBD520
00184  01  L004-LINK-AREA.                                              DTSBD520
00185  ++INCLUDE DTSIL004                                               DTSBD520
00186      EJECT                                                        DTSBD520
00187  01  L910-LINK-AREA.                                              DTSBD520
00188  ++INCLUDE DTSIL910                                               DTSBD520
00189      EJECT                                                        DTSBD520
00190  01  MSKL-REC.                                                    DTSBD520
00191  ++INCLUDE DTSIMSKL                                               DTSBD520
00192      EJECT                                                        DTSBD520
00193  01  MPRF-REC.                                                    DTSBD520
00194  ++INCLUDE DTSIMPRF                                               DTSBD520
00195      SKIP3                                                        DTSBD520
00196  01  MREL-REC.                                                    DTSBD520
00197  ++INCLUDE DTSIMREL                                               DTSBD520
00198      EJECT                                                        DTSBD520
00199  ++INCLUDE EWGLINKB                                               DTSBD520
00200      EJECT                                                        DTSBD520
00201  01  EMPLOYER-INDS.                                               DTSBD520
00202      05  EMPLOYER-IND OCCURS 999999 TIMES                         DTSBD520
00203                                          PIC  X(01).              DTSBD520
00204          88  EMP-PRED-EXISTS-NO-88              VALUE '0'.        DTSBD520
00205          88  EMP-PRED-EXISTS-YES-88             VALUE '1'.        DTSBD520
00206          88  EMP-NOT-RATED-88                   VALUE '2'.        DTSBD520
00207      EJECT                                                        DTSBD520
00208  LINKAGE SECTION.                                                 DTSBD520
00209                                                                   DTSBD520
00210  01  PARM-AREA.                                                   DTSBD520
00211      05  PARM-LENGTH                    PIC S9(04)  COMP.         DTSBD520
00212                                                                   DTSBD520
00213      05  PARM-DATA.                                               DTSBD520
00214          10  PARM-YRQ-X                 PIC  X(03).               DTSBD520
00215      EJECT                                                        DTSBD520
00216  PROCEDURE DIVISION USING PARM-AREA.                              DTSBD520
00217                                                                   DTSBD520
00218                                                                   DTSBD520
00219      PERFORM I0000-INITIATE THRU I0000-EXIT.                      DTSBD520
00220                                                                   DTSBD520
00221                                                                   DTSBD520
00222      MOVE LOW-VALUES TO VSAM-WAGEDATA-CONTROL-BLOCK.              DTSBD520
00223                                                                   DTSBD520
00224      SET DBW-SEQUENTIAL-PROCESSING TO TRUE.                       DTSBD520
00225                                                                   DTSBD520
00226      SET DBW-READ-SEGMENT TO TRUE.                                DTSBD520
00227                                                                   DTSBD520
00228      SET DBW-PROFILE-SEGMENT TO TRUE.                             DTSBD520
00229                                                                   DTSBD520
00230      PERFORM S961-WAGE-I THRU S961-EXIT.                          DTSBD520
00231                                                                   DTSBD520
00232                                                                   DTSBD520
00233      PERFORM P0000-PROCESS THRU P0000-EXIT                        DTSBD520
00234          UNTIL DBW-END-OF-FILE.                                   DTSBD520
00235                                                                   DTSBD520
00236                                                                   DTSBD520
00237      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     DTSBD520
00238                                                                   DTSBD520
00239                                                                   DTSBD520
00240      MOVE +0 TO RETURN-CODE.                                      DTSBD520
00241                                                                   DTSBD520
00242                                                                   DTSBD520
00243      GOBACK.                                                      DTSBD520
00244      EJECT                                                        DTSBD520
00245  I0000-INITIATE.                                                  DTSBD520
00246      PERFORM S910-OPEN-READ THRU S910-EXIT.                       DTSBD520
00247                                                                   DTSBD520
00248      PERFORM SEXT-OPEN-OUTPUT THRU SEXT-EXIT.                     DTSBD520
00249                                                                   DTSBD520
00250      SET DBW-OPEN-INPUT      TO TRUE.                             DTSBD520
00251      PERFORM S961-WAGE-I THRU S961-EXIT.                          DTSBD520
00252                                                                   DTSBD520
00253      MOVE +0 TO OUT-EXT-CNT.                                      DTSBD520
00254                                                                   DTSBD520
00255      MOVE +0 TO MAX-WAGES-EMP-CNT                                 DTSBD520
00256                 MAX-PRED-EMP-CNT.                                 DTSBD520
00257                                                                   DTSBD520
00258      PERFORM I1000-PARMS THRU I1000-EXIT.                         DTSBD520
00259                                                                   DTSBD520
00260      PERFORM I2000-PRED-EXISTS-INDS THRU I2000-EXIT.              DTSBD520
00261  I0000-EXIT.                                                      DTSBD520
00262      EXIT.                                                        DTSBD520
00263      SKIP3                                                        DTSBD520
00264  I1000-PARMS.                                                     DTSBD520
00265      IF PARM-LENGTH = +3                                          DTSBD520
00266          NEXT SENTENCE                                            DTSBD520
00267      ELSE                                                         DTSBD520
00268          MOVE 'PARM-LENGTH NOT EQUAL TO 3'                        DTSBD520
00269            TO ABEND-MSG                                           DTSBD520
00270          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD520
00271                                                                   DTSBD520
00272                                                                   DTSBD520
00273      DISPLAY '***'.                                               DTSBD520
00274                                                                   DTSBD520
00275      DISPLAY '*** '                                               DTSBD520
00276              MOD-NAME                                             DTSBD520
00277              ' PARAMETERS: '                                      DTSBD520
00278              PARM-DATA.                                           DTSBD520
00279                                                                   DTSBD520
00280      DISPLAY '***'.                                               DTSBD520
00281                                                                   DTSBD520
00282                                                                   DTSBD520
00283      MOVE PARM-YRQ-X TO L004-QTR-3.                               DTSBD520
00284                                                                   DTSBD520
00285      PERFORM S004-FROM-3 THRU S004-EXIT.                          DTSBD520
00286                                                                   DTSBD520
00287      IF (L004-INVALID-QTR)                                        DTSBD520
00288             OR                                                    DTSBD520
00289         (L004-QTR-5-9 <= WRK-PICKUP-YRQ)                          DTSBD520
00290          MOVE 'PARM-YRQ-X NOT VALID'                              DTSBD520
00291            TO ABEND-MSG                                           DTSBD520
00292          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD520
00293                                                                   DTSBD520
00294      MOVE L004-QTR-5-Q TO WRK-YRQ-CNT.                            DTSBD520
00295                                                                   DTSBD520
00296      MOVE L004-QTR-5-9 TO WRK-END-YRQ.                            DTSBD520
00297                                                                   DTSBD520
00298      MOVE 1 TO L004-QTR-5-Q.                                      DTSBD520
00299                                                                   DTSBD520
00300      MOVE L004-QTR-5-9 TO WRK-START-YRQ.                          DTSBD520
00301                                                                   DTSBD520
00302      PERFORM                                                      DTSBD520
00303        VARYING L004-QTR-5-Q FROM 1 BY 1                           DTSBD520
00304        UNTIL L004-QTR-5-Q > WRK-YRQ-CNT                           DTSBD520
00305          MOVE L004-QTR-5-9 TO WRK-YRQ (L004-QTR-5-Q)              DTSBD520
00306      END-PERFORM.                                                 DTSBD520
00307                                                                   DTSBD520
00308                                                                   DTSBD520
00309      MOVE 1 TO L004-QTR-5-Q.                                      DTSBD520
00310                                                                   DTSBD520
00311      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSBD520
00312                                                                   DTSBD520
00313      MOVE L004-QTR-START-DATE TO WRK-YEAR-START-DATE.             DTSBD520
00314                                                                   DTSBD520
00315                                                                   DTSBD520
00316      MOVE 4 TO L004-QTR-5-Q.                                      DTSBD520
00317                                                                   DTSBD520
00318      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSBD520
00319                                                                   DTSBD520
00320      MOVE L004-QTR-END-DATE TO WRK-YEAR-END-DATE.                 DTSBD520
00321  I1000-EXIT.                                                      DTSBD520
00322      EXIT.                                                        DTSBD520
00323      SKIP3                                                        DTSBD520
00324  I2000-PRED-EXISTS-INDS.                                          DTSBD520
00325      MOVE ALL '0' TO EMPLOYER-INDS.                               DTSBD520
00326                                                                   DTSBD520
00327                                                                   DTSBD520
00328      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSBD520
00329                                                                   DTSBD520
00330      MOVE +0 TO MSKL-EMP-NO.                                      DTSBD520
00331                                                                   DTSBD520
00332      SET MSKL-PRF-88 TO TRUE.                                     DTSBD520
00333                                                                   DTSBD520
00334      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBD520
00335                                                                   DTSBD520
00336      PERFORM I2100-MPRF-SCAN THRU I2100-EXIT                      DTSBD520
00337          UNTIL L910-NO-REC-88.                                    DTSBD520
00338  I2000-EXIT.                                                      DTSBD520
00339      EXIT.                                                        DTSBD520
00340      SKIP3                                                        DTSBD520
00341  I2100-MPRF-SCAN.                                                 DTSBD520
00342      MOVE MSKL-REC TO MPRF-REC.                                   DTSBD520
00343                                                                   DTSBD520
00344                                                                   DTSBD520
00345      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSBD520
00346                                                                   DTSBD520
00347      MOVE MPRF-EMP-NO TO MSKL-EMP-NO.                             DTSBD520
00348                                                                   DTSBD520
00349      SET MSKL-REL-88 TO TRUE.                                     DTSBD520
00350                                                                   DTSBD520
00351      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBD520
00352                                                                   DTSBD520
00353      PERFORM I2110-MREL-SCAN THRU I2110-EXIT                      DTSBD520
00354          UNTIL L910-NO-REC-88.                                    DTSBD520
00355                                                                   DTSBD520
00356                                                                   DTSBD520
00357      IF (MPRF-EMP-NO < MIN-EMP-NO)                                DTSBD520
00358            OR                                                     DTSBD520
00359         (MPRF-EMP-NO > MAX-EMP-NO)                                DTSBD520
00360          NEXT SENTENCE                                            DTSBD520
00361      ELSE                                                         DTSBD520
00362          IF NOT MPRF-CLASS-RATED-88                               DTSBD520
00363              SET EMP-NOT-RATED-88 (MPRF-EMP-NO) TO TRUE.          DTSBD520
00364                                                                   DTSBD520
00365                                                                   DTSBD520
00366      MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD520
00367                                                                   DTSBD520
00368      PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSBD520
00369  I2100-EXIT.                                                      DTSBD520
00370      EXIT.                                                        DTSBD520
00371      SKIP3                                                        DTSBD520
00372  I2110-MREL-SCAN.                                                 DTSBD520
00373      MOVE MSKL-REC TO MREL-REC.                                   DTSBD520
00374                                                                   DTSBD520
00375      PERFORM I2111-EVALUATE-MREL THRU I2111-EXIT.                 DTSBD520
00376                                                                   DTSBD520
00377      PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSBD520
00378  I2110-EXIT.                                                      DTSBD520
00379      EXIT.                                                        DTSBD520
00380      SKIP3                                                        DTSBD520
00381  I2111-EVALUATE-MREL.                                             DTSBD520
00382      IF (MREL-EFF-DATE < WRK-YEAR-START-DATE)                     DTSBD520
00383              OR                                                   DTSBD520
00384         (MREL-EFF-DATE > WRK-YEAR-END-DATE)                       DTSBD520
00385          GO TO I2111-EXIT.                                        DTSBD520
00386                                                                   DTSBD520
00387      IF MREL-EXP-TRNSF-NO-88                                      DTSBD520
00388          GO TO I2111-EXIT.                                        DTSBD520
00389                                                                   DTSBD520
00390      IF (MREL-EMP-NO < MIN-EMP-NO)                                DTSBD520
00391            OR                                                     DTSBD520
00392         (MREL-EMP-NO > MAX-EMP-NO)                                DTSBD520
00393          GO TO I2111-EXIT.                                        DTSBD520
00394                                                                   DTSBD520
00395      SET EMP-PRED-EXISTS-YES-88 (MREL-EMP-NO) TO TRUE.            DTSBD520
00396  I2111-EXIT.                                                      DTSBD520
00397      EXIT.                                                        DTSBD520
00398      EJECT                                                        DTSBD520
00399  P0000-PROCESS.                                                   DTSBD520
00400      MOVE +0 TO WAGES-EMP-CNT.                                    DTSBD520
00401                                                                   DTSBD520
00402                                                                   DTSBD520
00403      SET DBW-RANDOM-PROCESSING TO TRUE.                           DTSBD520
00404                                                                   DTSBD520
00405      SET DBW-WAGE-SEGMENT TO TRUE.                                DTSBD520
00406                                                                   DTSBD520
00407      PERFORM P1000-WGD-LOOP THRU P1000-EXIT                       DTSBD520
00408          UNTIL DBW-NO-RECORD-FOUND.                               DTSBD520
00409                                                                   DTSBD520
00410                                                                   DTSBD520
00411      IF WAGES-EMP-CNT > MAX-WAGES-EMP-CNT                         DTSBD520
00412          MOVE WAGES-EMP-CNT TO MAX-WAGES-EMP-CNT.                 DTSBD520
00413                                                                   DTSBD520
00414                                                                   DTSBD520
00415      PERFORM P2000-EXTRACT-LOOP THRU P2000-EXIT                   DTSBD520
00416          VARYING WAGES-EMP-IDX1 FROM 1 BY 1                       DTSBD520
00417          UNTIL WAGES-EMP-IDX1 > WAGES-EMP-CNT.                    DTSBD520
00418                                                                   DTSBD520
00419                                                                   DTSBD520
00420      SET DBW-SEQUENTIAL-PROCESSING TO TRUE.                       DTSBD520
00421                                                                   DTSBD520
00422      SET DBW-READ-SEGMENT TO TRUE.                                DTSBD520
00423                                                                   DTSBD520
00424      SET DBW-PROFILE-SEGMENT TO TRUE.                             DTSBD520
00425                                                                   DTSBD520
00426      PERFORM S961-WAGE-I THRU S961-EXIT.                          DTSBD520
00427  P0000-EXIT.                                                      DTSBD520
00428      EXIT.                                                        DTSBD520
00429      SKIP3                                                        DTSBD520
00430  P1000-WGD-LOOP.                                                  DTSBD520
00431      SET DBW-READ-SEGMENT TO TRUE.                                DTSBD520
00432                                                                   DTSBD520
00433      PERFORM S961-WAGE-I THRU S961-EXIT.                          DTSBD520
00434                                                                   DTSBD520
00435      IF DBW-NO-RECORD-FOUND                                       DTSBD520
00436          GO TO P1000-EXIT.                                        DTSBD520
00437                                                                   DTSBD520
00438                                                                   DTSBD520
00439      IF WGD-ACCOUNT-NUMBER NOT NUMERIC                            DTSBD520
00440          GO TO P1000-EXIT.                                        DTSBD520
00441                                                                   DTSBD520
00442      IF (WGD-ACCOUNT-NUMBER < MIN-EMP-NO)                         DTSBD520
00443               OR                                                  DTSBD520
00444         (WGD-ACCOUNT-NUMBER > MAX-EMP-NO)                         DTSBD520
00445          GO TO P1000-EXIT.                                        DTSBD520
00446                                                                   DTSBD520
00447                                                                   DTSBD520
00448      IF EMP-NOT-RATED-88 (WGD-ACCOUNT-NUMBER)                     DTSBD520
00449          GO TO P1000-EXIT.                                        DTSBD520
00450                                                                   DTSBD520
00451                                                                   DTSBD520
00452      MOVE WGD-YR TO L004-QTR-3-YR.                                DTSBD520
00453                                                                   DTSBD520
00454      MOVE WGD-QTR TO L004-QTR-3-Q.                                DTSBD520
00455                                                                   DTSBD520
00456      PERFORM S004-FROM-3 THRU S004-EXIT.                          DTSBD520
00457                                                                   DTSBD520
00458      IF L004-INVALID-QTR                                          DTSBD520
00459          GO TO P1000-EXIT.                                        DTSBD520
00460                                                                   DTSBD520
00461      IF (L004-QTR-5-9 < WRK-START-YRQ)                            DTSBD520
00462             OR                                                    DTSBD520
00463         (L004-QTR-5-9 > WRK-END-YRQ)                              DTSBD520
00464          GO TO P1000-EXIT.                                        DTSBD520
00465                                                                   DTSBD520
00466                                                                   DTSBD520
00467      IF WGD-QUARTER-EARNINGS NOT NUMERIC                          DTSBD520
00468          GO TO P1000-EXIT.                                        DTSBD520
00469                                                                   DTSBD520
00470                                                                   DTSBD520
00471      MOVE +0 TO WAGES-EMP-SUB.                                    DTSBD520
00472                                                                   DTSBD520
00473      PERFORM                                                      DTSBD520
00474        VARYING WAGES-EMP-IDX1 FROM 1 BY 1                         DTSBD520
00475        UNTIL (WAGES-EMP-IDX1 > WAGES-EMP-CNT)                     DTSBD520
00476                 OR                                                DTSBD520
00477              (WAGES-EMP-SUB NOT = +0)                             DTSBD520
00478          IF WAGES-EMP-NO (WAGES-EMP-IDX1) = WGD-ACCOUNT-NUMBER    DTSBD520
00479              SET WAGES-EMP-SUB TO WAGES-EMP-IDX1                  DTSBD520
00480          END-IF                                                   DTSBD520
00481      END-PERFORM.                                                 DTSBD520
00482                                                                   DTSBD520
00483                                                                   DTSBD520
00484      IF WAGES-EMP-SUB = +0                                        DTSBD520
00485          IF WAGES-EMP-CNT < WAGES-EMP-MAX                         DTSBD520
00486              ADD +1 TO WAGES-EMP-CNT                              DTSBD520
00487              MOVE WAGES-EMP-CNT TO WAGES-EMP-SUB                  DTSBD520
00488              MOVE WGD-ACCOUNT-NUMBER                              DTSBD520
00489                TO  WAGES-EMP-NO (WAGES-EMP-SUB)                   DTSBD520
00490              MOVE +0 TO WAGES-YRQ-AMT (WAGES-EMP-SUB 1)           DTSBD520
00491                         WAGES-YRQ-AMT (WAGES-EMP-SUB 2)           DTSBD520
00492                         WAGES-YRQ-AMT (WAGES-EMP-SUB 3)           DTSBD520
00493                         WAGES-YRQ-AMT (WAGES-EMP-SUB 4)           DTSBD520
00494          ELSE                                                     DTSBD520
00495              MOVE 'LOGIC ERROR P1000-1' TO ABEND-MSG              DTSBD520
00496              PERFORM S999-ABEND THRU S999-EXIT.                   DTSBD520
00497                                                                   DTSBD520
00498 *****                                                             DTSBD520
00499 *                                                                 DTSBD520
00500 *    PER A 02/15/1999 EMAIL FROM GIL DIMATTIA, IGNORE             DTSBD520
00501 *    WGP-WHOLE-DOLLARS AND ALWAYS USE WGD-QUARTER-EARNINGS.       DTSBD520
00502 *                                                                 DTSBD520
00503 *****                                                             DTSBD520
00504                                                                   DTSBD520
00505 *****IF WGP-WHOLE-DOLLARS                                         DTSBD520
00506 *********ADD WGD-QTR-EARN-WHOLE-DOLLAR                            DTSBD520
00507 **********TO WAGES-YRQ-AMT (WAGES-EMP-SUB L004-QTR-5-Q)           DTSBD520
00508 *****ELSE                                                         DTSBD520
00509                                                                   DTSBD520
00510          ADD WGD-QUARTER-EARNINGS                                 DTSBD520
00511           TO WAGES-YRQ-AMT (WAGES-EMP-SUB L004-QTR-5-Q).          DTSBD520
00512  P1000-EXIT.                                                      DTSBD520
00513      EXIT.                                                        DTSBD520
00514      EJECT                                                        DTSBD520
00515  P2000-EXTRACT-LOOP.                                              DTSBD520
00516      MOVE LOW-VALUES TO EXTRACT-REC.                              DTSBD520
00517                                                                   DTSBD520
00518                                                                   DTSBD520
00519      MOVE WAGES-EMP-NO (WAGES-EMP-IDX1) TO X737-EMP-NO.           DTSBD520
00520                                                                   DTSBD520
00521      MOVE WGP-SSN TO X737-SSN.                                    DTSBD520
00522                                                                   DTSBD520
00523      MOVE WRK-YRQ-CNT TO X737-YRQ-CNT.                            DTSBD520
00524                                                                   DTSBD520
00525      PERFORM P2100-WAGES-TO-X737 THRU P2100-EXIT                  DTSBD520
00526          VARYING WAGES-YRQ-IDX FROM 1 BY 1                        DTSBD520
00527          UNTIL WAGES-YRQ-IDX > X737-YRQ-CNT.                      DTSBD520
00528                                                                   DTSBD520
00529      IF (WAGES-EMP-CNT > +1)                                      DTSBD520
00530             AND                                                   DTSBD520
00531         (EMP-PRED-EXISTS-YES-88 (X737-EMP-NO))                    DTSBD520
00532                                                                   DTSBD520
00533          MOVE +0 TO PRED-EMP-CNT                                  DTSBD520
00534                                                                   DTSBD520
00535          PERFORM P3000-TABLE-PREDECESSORS THRU P3000-EXIT         DTSBD520
00536                                                                   DTSBD520
00537          IF PRED-EMP-CNT > MAX-PRED-EMP-CNT                       DTSBD520
00538              MOVE PRED-EMP-CNT TO MAX-PRED-EMP-CNT                DTSBD520
00539          END-IF                                                   DTSBD520
00540                                                                   DTSBD520
00541          PERFORM P2200-PRED-WAGES THRU P2200-EXIT                 DTSBD520
00542              VARYING WAGES-EMP-IDX2 FROM 1 BY 1                   DTSBD520
00543              UNTIL WAGES-EMP-IDX2 > WAGES-EMP-CNT.                DTSBD520
00544                                                                   DTSBD520
00545                                                                   DTSBD520
00546      PERFORM SEXT-WRITE THRU SEXT-EXIT.                           DTSBD520
00547  P2000-EXIT.                                                      DTSBD520
00548      EXIT.                                                        DTSBD520
00549      SKIP3                                                        DTSBD520
00550  P2100-WAGES-TO-X737.                                             DTSBD520
00551      SET WRK-YRQ-IDX TO WAGES-YRQ-IDX.                            DTSBD520
00552                                                                   DTSBD520
00553      SET X737-YRQ-IDX TO WAGES-YRQ-IDX.                           DTSBD520
00554                                                                   DTSBD520
00555      MOVE WRK-YRQ (WRK-YRQ-IDX)                                   DTSBD520
00556        TO X737-YRQ (X737-YRQ-IDX).                                DTSBD520
00557                                                                   DTSBD520
00558      MOVE WAGES-YRQ-AMT (WAGES-EMP-IDX1 WAGES-YRQ-IDX)            DTSBD520
00559        TO X737-EMP-WAGES (X737-YRQ-IDX).                          DTSBD520
00560                                                                   DTSBD520
00561      MOVE +0 TO X737-PRED-WAGES (X737-YRQ-IDX).                   DTSBD520
00562  P2100-EXIT.                                                      DTSBD520
00563      EXIT.                                                        DTSBD520
00564      SKIP3                                                        DTSBD520
00565  P2200-PRED-WAGES.                                                DTSBD520
00566      MOVE WAGES-EMP-NO (WAGES-EMP-IDX2) TO WRK-EMP-NO.            DTSBD520
00567                                                                   DTSBD520
00568      IF WRK-EMP-NO = X737-EMP-NO                                  DTSBD520
00569          GO TO P2200-EXIT.                                        DTSBD520
00570                                                                   DTSBD520
00571      MOVE +0 TO PRED-EMP-SUB.                                     DTSBD520
00572                                                                   DTSBD520
00573      PERFORM                                                      DTSBD520
00574        VARYING PRED-EMP-IDX1 FROM 1 BY 1                          DTSBD520
00575        UNTIL (PRED-EMP-SUB NOT = +0)                              DTSBD520
00576                  OR                                               DTSBD520
00577              (PRED-EMP-IDX1 > PRED-EMP-CNT)                       DTSBD520
00578          IF WRK-EMP-NO = PRED-EMP-NO (PRED-EMP-IDX1)              DTSBD520
00579              SET PRED-EMP-SUB TO PRED-EMP-IDX1                    DTSBD520
00580          END-IF                                                   DTSBD520
00581      END-PERFORM.                                                 DTSBD520
00582                                                                   DTSBD520
00583      IF PRED-EMP-SUB = +0                                         DTSBD520
00584          GO TO P2200-EXIT.                                        DTSBD520
00585                                                                   DTSBD520
00586      PERFORM P2210-PRED-WAGES-TO-X737 THRU P2210-EXIT             DTSBD520
00587          VARYING WAGES-YRQ-IDX FROM 1 BY 1                        DTSBD520
00588          UNTIL WAGES-YRQ-IDX > X737-YRQ-CNT.                      DTSBD520
00589  P2200-EXIT.                                                      DTSBD520
00590      EXIT.                                                        DTSBD520
00591      SKIP3                                                        DTSBD520
00592  P2210-PRED-WAGES-TO-X737.                                        DTSBD520
00593      SET X737-YRQ-IDX TO WAGES-YRQ-IDX.                           DTSBD520
00594                                                                   DTSBD520
00595      ADD WAGES-YRQ-AMT (WAGES-EMP-IDX2 WAGES-YRQ-IDX)             DTSBD520
00596       TO X737-PRED-WAGES (X737-YRQ-IDX).                          DTSBD520
00597  P2210-EXIT.                                                      DTSBD520
00598      EXIT.                                                        DTSBD520
00599      EJECT                                                        DTSBD520
00600  P3000-TABLE-PREDECESSORS.                                        DTSBD520
00601      MOVE X737-EMP-NO TO SUCC-EMP-NO.                             DTSBD520
00602                                                                   DTSBD520
00603      PERFORM P3900-TABLE-PREDECESSORS THRU P3900-EXIT.            DTSBD520
00604                                                                   DTSBD520
00605      PERFORM P3100-PRED-LOOP THRU P3100-EXIT                      DTSBD520
00606          VARYING PRED-EMP-IDX1 FROM 1 BY 1                        DTSBD520
00607          UNTIL PRED-EMP-IDX1 > PRED-EMP-CNT.                      DTSBD520
00608  P3000-EXIT.                                                      DTSBD520
00609      EXIT.                                                        DTSBD520
00610      SKIP3                                                        DTSBD520
00611  P3100-PRED-LOOP.                                                 DTSBD520
00612      MOVE PRED-EMP-NO (PRED-EMP-IDX1) TO SUCC-EMP-NO.             DTSBD520
00613                                                                   DTSBD520
00614      PERFORM P3900-TABLE-PREDECESSORS THRU P3900-EXIT.            DTSBD520
00615  P3100-EXIT.                                                      DTSBD520
00616      EXIT.                                                        DTSBD520
00617      SKIP3                                                        DTSBD520
00618  P3900-TABLE-PREDECESSORS.                                        DTSBD520
00619      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSBD520
00620                                                                   DTSBD520
00621      MOVE SUCC-EMP-NO TO MSKL-EMP-NO.                             DTSBD520
00622                                                                   DTSBD520
00623      SET MSKL-REL-88 TO TRUE.                                     DTSBD520
00624                                                                   DTSBD520
00625      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBD520
00626                                                                   DTSBD520
00627                                                                   DTSBD520
00628      PERFORM                                                      DTSBD520
00629          UNTIL L910-NO-REC-88                                     DTSBD520
00630            MOVE MSKL-REC TO MREL-REC                              DTSBD520
00631            PERFORM P3910-ANALYZE-MREL THRU P3910-EXIT             DTSBD520
00632            PERFORM S910-READ-NEXT THRU S910-EXIT                  DTSBD520
00633      END-PERFORM.                                                 DTSBD520
00634  P3900-EXIT.                                                      DTSBD520
00635      EXIT.                                                        DTSBD520
00636      SKIP3                                                        DTSBD520
00637  P3910-ANALYZE-MREL.                                              DTSBD520
00638      IF (MREL-EFF-DATE < WRK-YEAR-START-DATE)                     DTSBD520
00639              OR                                                   DTSBD520
00640         (MREL-EFF-DATE > WRK-YEAR-END-DATE)                       DTSBD520
00641          GO TO P3910-EXIT.                                        DTSBD520
00642                                                                   DTSBD520
00643      IF MREL-EXP-TRNSF-NO-88                                      DTSBD520
00644          GO TO P3910-EXIT.                                        DTSBD520
00645                                                                   DTSBD520
00646      IF MREL-PRED-EMP-NO = X737-EMP-NO                            DTSBD520
00647          GO TO P3910-EXIT.                                        DTSBD520
00648                                                                   DTSBD520
00649      MOVE +0 TO PRED-EMP-SUB.                                     DTSBD520
00650                                                                   DTSBD520
00651      PERFORM                                                      DTSBD520
00652        VARYING PRED-EMP-IDX2 FROM 1 BY 1                          DTSBD520
00653        UNTIL (PRED-EMP-IDX2 > PRED-EMP-CNT)                       DTSBD520
00654                  OR                                               DTSBD520
00655              (PRED-EMP-SUB NOT = +0)                              DTSBD520
00656          IF PRED-EMP-NO (PRED-EMP-IDX2) = MREL-PRED-EMP-NO        DTSBD520
00657              SET PRED-EMP-SUB TO PRED-EMP-IDX2                    DTSBD520
00658          END-IF                                                   DTSBD520
00659      END-PERFORM.                                                 DTSBD520
00660                                                                   DTSBD520
00661      IF PRED-EMP-SUB = +0                                         DTSBD520
00662          IF PRED-EMP-CNT < PRED-EMP-MAX                           DTSBD520
00663              ADD +1 TO PRED-EMP-CNT                               DTSBD520
00664              MOVE MREL-PRED-EMP-NO                                DTSBD520
00665                TO PRED-EMP-NO (PRED-EMP-CNT)                      DTSBD520
00666          ELSE                                                     DTSBD520
00667              MOVE 'LOGIC ERROR P3910-1' TO ABEND-MSG              DTSBD520
00668              PERFORM S999-ABEND THRU S999-EXIT.                   DTSBD520
00669  P3910-EXIT.                                                      DTSBD520
00670      EXIT.                                                        DTSBD520
00671      EJECT                                                        DTSBD520
00672  T0000-TERMINATE.                                                 DTSBD520
00673      SET DBW-CLOSE-DATASET TO TRUE.                               DTSBD520
00674                                                                   DTSBD520
00675      PERFORM S961-WAGE-I THRU S961-EXIT.                          DTSBD520
00676                                                                   DTSBD520
00677      PERFORM S910-CLOSE THRU S910-EXIT.                           DTSBD520
00678                                                                   DTSBD520
00679      PERFORM SEXT-CLOSE THRU SEXT-EXIT.                           DTSBD520
00680                                                                   DTSBD520
00681                                                                   DTSBD520
00682      DISPLAY '***'.                                               DTSBD520
00683                                                                   DTSBD520
00684      DISPLAY '*** '                                               DTSBD520
00685              MOD-NAME                                             DTSBD520
00686              ' TERMINATION STATISTICS'.                           DTSBD520
00687                                                                   DTSBD520
00688      DISPLAY '*** '.                                              DTSBD520
00689                                                                   DTSBD520
00690      MOVE WRK-START-YRQ TO L004-QTR-5-9.                          DTSBD520
00691                                                                   DTSBD520
00692      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSBD520
00693                                                                   DTSBD520
00694      DISPLAY '***                 FIRST QUARTER EXTRACTED: '      DTSBD520
00695              L004-SLASH-QTR.                                      DTSBD520
00696                                                                   DTSBD520
00697      DISPLAY '*** '.                                              DTSBD520
00698                                                                   DTSBD520
00699      MOVE WRK-END-YRQ TO L004-QTR-5-9.                            DTSBD520
00700                                                                   DTSBD520
00701      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSBD520
00702                                                                   DTSBD520
00703      DISPLAY '***                  LAST QUARTER EXTRACTED: '      DTSBD520
00704              L004-SLASH-QTR.                                      DTSBD520
00705                                                                   DTSBD520
00706      DISPLAY '*** '.                                              DTSBD520
00707                                                                   DTSBD520
00708      MOVE OUT-EXT-CNT TO DISPLAY-REC-CNT.                         DTSBD520
00709                                                                   DTSBD520
00710      DISPLAY '***                 EXTRACT RECORDS WRITTEN: '      DTSBD520
00711              DISPLAY-REC-CNT-X.                                   DTSBD520
00712                                                                   DTSBD520
00713      DISPLAY '*** '.                                              DTSBD520
00714                                                                   DTSBD520
00715      MOVE MAX-WAGES-EMP-CNT TO DISPLAY-REC-CNT.                   DTSBD520
00716                                                                   DTSBD520
00717      DISPLAY '*** MAXIMUM WAGES-EMP-AREA OCCURRENCES USED: '      DTSBD520
00718              DISPLAY-REC-CNT-X.                                   DTSBD520
00719                                                                   DTSBD520
00720      DISPLAY '*** '.                                              DTSBD520
00721                                                                   DTSBD520
00722      MOVE MAX-PRED-EMP-CNT TO DISPLAY-REC-CNT.                    DTSBD520
00723                                                                   DTSBD520
00724      DISPLAY '***  MAXIMUM PRED-EMP-AREA OCCURRENCES USED: '      DTSBD520
00725              DISPLAY-REC-CNT-X.                                   DTSBD520
00726  T0000-EXIT.                                                      DTSBD520
00727      EXIT.                                                        DTSBD520
00728      EJECT                                                        DTSBD520
00729  S001-FROM-FED-8.                                                 DTSBD520
00730      SET L001-FROM-FED-8 TO TRUE.                                 DTSBD520
00731      GO TO S001-DATE.                                             DTSBD520
00732                                                                   DTSBD520
00733  S001-FROM-ABS-DAY.                                               DTSBD520
00734      SET L001-FROM-ABS-DAY TO TRUE.                               DTSBD520
00735      GO TO S001-DATE.                                             DTSBD520
00736                                                                   DTSBD520
00737  S001-DATE.                                                       DTSBD520
00738      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBD520
00739  S001-EXIT.                                                       DTSBD520
00740      EXIT.                                                        DTSBD520
00741      SKIP3                                                        DTSBD520
00742  S004-FROM-3.                                                     DTSBD520
00743      SET L004-FROM-3 TO TRUE.                                     DTSBD520
00744      GO TO S004-YRQ.                                              DTSBD520
00745                                                                   DTSBD520
00746  S004-FROM-5.                                                     DTSBD520
00747      SET L004-FROM-5 TO TRUE.                                     DTSBD520
00748      GO TO S004-YRQ.                                              DTSBD520
00749                                                                   DTSBD520
00750  S004-YRQ.                                                        DTSBD520
00751      CALL 'DTSBU004' USING L004-LINK-AREA.                        DTSBD520
00752  S004-EXIT.                                                       DTSBD520
00753      EXIT.                                                        DTSBD520
00754      SKIP3                                                        DTSBD520
00755  S910-OPEN-READ.                                                  DTSBD520
00756      SET L910-OPEN-READ-88  TO TRUE.                              DTSBD520
00757      GO TO S910-MSTR-IO.                                          DTSBD520
00758                                                                   DTSBD520
00759  S910-READ.                                                       DTSBD520
00760      SET L910-READ-88  TO TRUE.                                   DTSBD520
00761      GO TO S910-MSTR-IO.                                          DTSBD520
00762                                                                   DTSBD520
00763  S910-READ-NEXT.                                                  DTSBD520
00764      SET L910-READ-NEXT-88 TO TRUE.                               DTSBD520
00765      GO TO S910-MSTR-IO.                                          DTSBD520
00766                                                                   DTSBD520
00767  S910-START-BROWSE.                                               DTSBD520
00768      SET L910-START-BROWSE-88 TO TRUE.                            DTSBD520
00769      GO TO S910-MSTR-IO.                                          DTSBD520
00770                                                                   DTSBD520
00771  S910-CLOSE.                                                      DTSBD520
00772      SET L910-CLOSE-88  TO TRUE.                                  DTSBD520
00773      GO TO S910-MSTR-IO.                                          DTSBD520
00774                                                                   DTSBD520
00775  S910-MSTR-IO.                                                    DTSBD520
00776      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBD520
00777                            MSKL-REC.                              DTSBD520
00778  S910-EXIT.                                                       DTSBD520
00779      EXIT.                                                        DTSBD520
00780      SKIP3                                                        DTSBD520
00781  S961-WAGE-I.                                                     DTSBD520
00782      IF DBW-WAGE-SEGMENT                                          DTSBD520
00783          CALL 'EWG960D'  USING VSAM-WAGEDATA-CONTROL-BLOCK        DTSBD520
00784                                WGD-SEGMENT-TWO                    DTSBD520
00785      ELSE                                                         DTSBD520
00786          CALL 'EWG960D'  USING VSAM-WAGEDATA-CONTROL-BLOCK        DTSBD520
00787                                WGP-SEGMENT-ONE.                   DTSBD520
00788  S961-EXIT.                                                       DTSBD520
00789      EXIT.                                                        DTSBD520
00790      SKIP3                                                        DTSBD520
00791  SEXT-OPEN-OUTPUT.                                                DTSBD520
00792      OPEN OUTPUT EXTRACT-FILE.                                    DTSBD520
00793                                                                   DTSBD520
00794      IF EXT-FILE-OK-88                                            DTSBD520
00795          GO TO SEXT-EXIT                                          DTSBD520
00796      ELSE                                                         DTSBD520
00797          MOVE 'OPEN' TO FILE-COMMAND                              DTSBD520
00798          PERFORM SEXT-UNEXPECTED-FILE-STATUS                      DTSBD520
00799             THRU SEXT-UNEXPECTED-EXIT                             DTSBD520
00800          GO TO SEXT-EXIT.                                         DTSBD520
00801                                                                   DTSBD520
00802  SEXT-WRITE.                                                      DTSBD520
00803      WRITE EXTRACT-REC.                                           DTSBD520
00804                                                                   DTSBD520
00805      IF EXT-FILE-OK-88                                            DTSBD520
00806          ADD +1 TO OUT-EXT-CNT                                    DTSBD520
00807          GO TO SEXT-EXIT                                          DTSBD520
00808      ELSE                                                         DTSBD520
00809          MOVE 'WRITE' TO FILE-COMMAND                             DTSBD520
00810          PERFORM SEXT-UNEXPECTED-FILE-STATUS                      DTSBD520
00811             THRU SEXT-UNEXPECTED-EXIT                             DTSBD520
00812          GO TO SEXT-EXIT.                                         DTSBD520
00813                                                                   DTSBD520
00814  SEXT-CLOSE.                                                      DTSBD520
00815      CLOSE EXTRACT-FILE.                                          DTSBD520
00816                                                                   DTSBD520
00817      IF EXT-FILE-OK-88                                            DTSBD520
00818          GO TO SEXT-EXIT                                          DTSBD520
00819      ELSE                                                         DTSBD520
00820          MOVE 'CLOSE' TO FILE-COMMAND                             DTSBD520
00821          PERFORM SEXT-UNEXPECTED-FILE-STATUS                      DTSBD520
00822             THRU SEXT-UNEXPECTED-EXIT                             DTSBD520
00823          GO TO SEXT-EXIT.                                         DTSBD520
00824                                                                   DTSBD520
00825  SEXT-EXIT.                                                       DTSBD520
00826      EXIT.                                                        DTSBD520
00827                                                                   DTSBD520
00828  SEXT-UNEXPECTED-FILE-STATUS.                                     DTSBD520
00829      MOVE SPACES TO ABEND-MSG.                                    DTSBD520
00830                                                                   DTSBD520
00831      STRING                                                       DTSBD520
00832          'UNEXPECTED EXTRACT FILE STATUS ON '                     DTSBD520
00833            DELIMITED BY SIZE                                      DTSBD520
00834          FILE-COMMAND                                             DTSBD520
00835            DELIMITED BY '  '                                      DTSBD520
00836          ': '                                                     DTSBD520
00837            DELIMITED BY SIZE                                      DTSBD520
00838          EXT-FILE-STATUS                                          DTSBD520
00839            DELIMITED BY SIZE                                      DTSBD520
00840        INTO                                                       DTSBD520
00841          ABEND-MSG.                                               DTSBD520
00842                                                                   DTSBD520
00843      PERFORM S999-ABEND THRU S999-EXIT.                           DTSBD520
00844  SEXT-UNEXPECTED-EXIT.                                            DTSBD520
00845      EXIT.                                                        DTSBD520
00846      SKIP3                                                        DTSBD520
00847  S999-ABEND.                                                      DTSBD520
00848      DISPLAY '***'.                                               DTSBD520
00849      DISPLAY '*** '                                               DTSBD520
00850              MOD-NAME                                             DTSBD520
00851              ' IS ABENDING BECAUSE '                              DTSBD520
00852              ABEND-MSG.                                           DTSBD520
00853      DISPLAY '***'.                                               DTSBD520
00854                                                                   DTSBD520
00855      CALL 'DTSBU999' USING ABEND-CODE.                            DTSBD520
00856  S999-EXIT.                                                       DTSBD520
00857      EXIT.                                                        DTSBD520
