00001  IDENTIFICATION DIVISION.                                         06/25/09
00002  PROGRAM-ID.             DTSBD541.                                DTSBD541
00003  AUTHOR.                 NGC.                                        LV003
00004  DATE-WRITTEN.           JUNE 2004.                               DTSBD541
00005  DATE-COMPILED.                                                   DTSBD541
00006      SKIP3                                                        DTSBD541
00007 *****                                                             DTSBD541
00008 *    FUNCTION:  BUILD EMPLOYEE TRANSFER TRANSACTION FILE (ETT)    DTSBD541
00009 *               FOR ES202 PROCESS.                                DTSBD541
00010 *               STEP 1 - EXTRACT DATA FROM 2 CONSECUTIVE QUARTERS DTSBD541
00011 *                                                                 DTSBD541
00012 *    MODIFICATION LOG:                                            DTSBD541
00013 *                                                                 DTSBD541
00014 *    06/24/2004  INITIAL DEVELOPMENT                              DTSBD541
00015 *                WORK ORDER:                      PROGRAMMER: GD  DTSBD541
00016 *                                                                 DTSBD541
00017 *    08/25/2004  ADDED WAGE FILE                                  DTSBD541
00018 *                WORK ORDER:                      PROGRAMMER: GD  DTSBD541
00019 *                                                                 DTSBD541
00020 *    10/25/2004  READ THE PARAMETER FILE CONTAINING BOTH PARM     DTSBD541
00021 *                SPECIFIED QTR AND PREVIOUS QTR WHICH CREATED     DTSBD541
00022 *                FROM PGM DTSBD540 FOR THIS PGM PROCESSING.       DTSBD541
00023 *                REFERENCE: LMI REQUIRMENT        PROGRAMMER: RW  DTSBD541
00024 *                                                                 DTSBD541
00025 *    99/99/9999  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD541
00026 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD541
00027 *                WORK ORDER:                      PROGRAMMER: XXX DTSBD541
00028 *                                                                 DTSBD541
00029 *  DESCRIPTION:                                                   DTSBD541
00030 *                                                                 DTSBD541
00031 *    INITIATION:                                                  DTSBD541
00032 *      VSAM WAGE FILE OPEN READ                                   DTSBD541
00033 *                                                                 DTSBD541
00034 *    PARAMETERS INPUT:                                            DTSBD541
00035 *      PARM-EMP-NO PARM-START-YRQ PARM-END-YRQ.                   DTSBD541
00036 *                                                                 DTSBD541
00037 *    PROCESSING:                                                  DTSBD541
00038 *      SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (535R1).       DTSBD541
00039 *                                                                 DTSBD541
00040 *    TERMINATION:                                                 DTSBD541
00041 *      OUTPUT STATISTICAL RECORDS COUNT.                          DTSBD541
00042 *                                                                 DTSBD541
00043 *    RECORDS READ:                                                DTSBD541
00044 *      MASTER:                                                    DTSBD541
00045          VSAM WAGES FILE                                          DTSBD541
00046 *                                                                 DTSBD541
00047 *      ALTERNATE INDEX:                                           DTSBD541
00048 *        NONE.                                                    DTSBD541
00049 *                                                                 DTSBD541
00050 *      REFERENCE:                                                 DTSBD541
00051 *        NONE.                                                    DTSBD541
00052 *                                                                 DTSBD541
00053 *    RECORDS UPDATED:                                             DTSBD541
00054 *        NONE                                                     DTSBD541
00055 *                                                                 DTSBD541
00056 *    REPORT RECORDS WRITTEN:                                      DTSBD541
00057 *        NONE.                                                    DTSBD541
00058 *                                                                 DTSBD541
00059 *    BATCH TRANSACTION COLLECTION RECORDS WRITTEN:                DTSBD541
00060 *        NONE.                                                    DTSBD541
00061 *                                                                 DTSBD541
00062 *    MODULES CALLED:                                              DTSBD541
00063 *        DTSBU001  DATE CONVERSION/EDIT.                          DTSBD541
00064 *        DTSBU004  QUARERLY SUMMARY REPORT REC.                   DTSBD541
00065 *        DTSBU981  VSAM.WGH FILE I/O.                             DTSBD541
00066 *        DTSBU946  VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1.   DTSBD541
00067 *                                                                 DTSBD541
00068 *    VERMONT REFERENCE:                                           DTSBD541
00069 *        NONE.                                                    DTSBD541
00070 *                                                                 DTSBD541
00071 *****                                                             DTSBD541
00072      SKIP3                                                        DTSBD541
00073  ENVIRONMENT DIVISION.                                            DTSBD541
00074  INPUT-OUTPUT SECTION.                                            DTSBD541
00075      SKIP3                                                        DTSBD541
00076  FILE-CONTROL.                                                    DTSBD541
00077      SELECT ES202PRM-FILE   ASSIGN TO ES202P1I                    DTSBD541
00078             FILE STATUS IS PARM-STATUS.                           DTSBD541
00079                                                                   DTSBD541
00080      SELECT OUTFILE1        ASSIGN TO OUTFILE1                    DTSBD541
00081             FILE STATUS IS OUTFILE1-STATUS.                       DTSBD541
00082                                                                   DTSBD541
00083      SELECT ES2WAGE         ASSIGN TO ES2WAGE                     DTSBD541
00084             FILE STATUS IS ES2WAGE-STATUS.                        DTSBD541
00085                                                                   DTSBD541
00086      SELECT EXPORT-WAGE     ASSIGN TO EXPWAGE                     DTSBD541
00087             FILE STATUS IS EXPWAGE-STATUS.                        DTSBD541
00088                                                                   DTSBD541
00089      SKIP3                                                        DTSBD541
00090  DATA DIVISION.                                                   DTSBD541
00091  FILE SECTION.                                                    DTSBD541
00092  FD  ES202PRM-FILE                                                DTSBD541
00093      RECORDING MODE IS F                                          DTSBD541
00094      BLOCK CONTAINS 0 RECORDS.                                    DTSBD541
00095                                                                   DTSBD541
00096  01  ES202-PARM-REC.                                              DTSBD541
00097      05  ES202-PARM-YRQ1             PIC  S9(05) COMP-3.          DTSBD541
00098      05  ES202-PARM-YRQ2             PIC  S9(05) COMP-3.          DTSBD541
00099                                                                   DTSBD541
00100  FD  OUTFILE1                                                     DTSBD541
00101      RECORD CONTAINS 16 CHARACTERS                                DTSBD541
00102      DATA RECORD IS OUTFILE1-REC.                                 DTSBD541
00103                                                                   DTSBD541
00104  01  OUTFILE1-REC.                                                DTSBD541
00105      05  OUTFILE1-SSN                PIC  9(09).                  DTSBD541
00106      05  OUTFILE1-QTR                PIC  9(01).                  DTSBD541
00107      05  OUTFILE1-EMP-NO             PIC  9(06).                  DTSBD541
00108                                                                   DTSBD541
00109  FD  ES2WAGE                                                      DTSBD541
00110      RECORD CONTAINS 26 CHARACTERS                                DTSBD541
00111      DATA RECORD IS ES2WAGE-REC.                                  DTSBD541
00112      SKIP1                                                        DTSBD541
00113  01  ES2WAGE-REC.                                                 DTSBD541
00114  ++INCLUDE ES2WAGV1                                               DTSBD541
00115                                                                   DTSBD541
00116  FD  EXPORT-WAGE                                                  DTSBD541
00117      RECORD CONTAINS 92 CHARACTERS                                DTSBD541
00118      DATA RECORD IS EXPWAGE-REC.                                  DTSBD541
00119      SKIP1                                                        DTSBD541
00120  01  EXPWAGE-REC                     PIC X(92).                   DTSBD541
00121                                                                   DTSBD541
00122  WORKING-STORAGE SECTION.                                         DTSBD541
001225 77  PAN-VALET PICTURE X(24) VALUE '003DTSBD541  06/25/09'.       DTSBD541
00123                                                                   DTSBD541
00124  01  WRK-AREA.                                                    DTSBD541
00125      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +541.DTSBD541
00126      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBD541'.DTSBD541
00127      05  WRK-ABEND-MSG               PIC  X(60).                  DTSBD541
00128                                                                   DTSBD541
00129      05  DISP-PARM-START-YRQ         PIC  X(05).                  DTSBD541
00130      05  DISP-PARM-END-YRQ           PIC  X(05).                  DTSBD541
00131      05  DISP-ESTB-DATE              PIC  X(10).                  DTSBD541
00132      05  RUN-DATE                    PIC S9(09)  COMP-3.          DTSBD541
00133      05  WRK-YRQ1                    PIC S9(05)  COMP-3.          DTSBD541
00134      05  WRK-YRQ2                    PIC S9(05)  COMP-3.          DTSBD541
00135      05  WRK-EMP-NO                  PIC S9(07)  COMP-3           DTSBD541
00136                                       VALUE +0.                   DTSBD541
00137      05  WRK-EMPLOYEE                PIC S9(07)  COMP-3           DTSBD541
00138                                       VALUE +0.                   DTSBD541
00139      05  WRK-TOT-EARNINGS            PIC S9(11)V99 COMP-3         DTSBD541
00140                                       VALUE +0.                   DTSBD541
00141                                                                   DTSBD541
00142                                                                   DTSBD541
00143      05  WRK-SUBJECT-IND             PIC  X(01) VALUE 'N'.        DTSBD541
00144          88 WRK-SUBJECT-YES-88              VALUE 'Y'.            DTSBD541
00145          88 WRK-SUBJECT-NO-88               VALUE 'N'.            DTSBD541
00146                                                                   DTSBD541
00147      05  PARM-STATUS                 PIC  X(02).                  DTSBD541
00148          88  PARM-OK-88                        VALUE '00'.        DTSBD541
00149          88  PARM-EOF-88                       VALUE '10'.        DTSBD541
00150                                                                   DTSBD541
00151      05  OUTFILE1-STATUS             PIC  X(02).                  DTSBD541
00152          88  OUTFILE1-OK-88                    VALUE '00'.        DTSBD541
00153                                                                   DTSBD541
00154      05  ES2WAGE-STATUS              PIC  X(02).                  DTSBD541
00155          88  ES2WAGE-OK-88                     VALUE '00'.        DTSBD541
00156                                                                   DTSBD541
00157      05  EXPWAGE-STATUS              PIC  X(02).                  DTSBD541
00158          88  EXPWAGE-OK-88                     VALUE '00'.        DTSBD541
00159                                                                   DTSBD541
00160      05  WRK-EOF-IND                 PIC  X(03)                   DTSBD541
00161                                             VALUE 'NO '.          DTSBD541
00162                                                                   DTSBD541
00163      05  WRK-ERROR-IND               PIC  X(01).                  DTSBD541
00164          88 WRK-ERROR-YES-88                VALUE 'Y'.            DTSBD541
00165          88 WRK-ERROR-NO-88                 VALUE 'N'.            DTSBD541
00166                                                                   DTSBD541
00167      05  WRK-WWGH-READ-CNT           PIC S9(07)  COMP-3 VALUE +0. DTSBD541
00168      05  WRK-OUTFILE1-WRITE-CNT      PIC S9(07)  COMP-3 VALUE +0. DTSBD541
00169      05  WRK-ES2WAGE-WRITE-CNT       PIC S9(09)  COMP-3 VALUE +0. DTSBD541
00170      05  WRK-EXPWAGE-WRITE-CNT       PIC S9(09)  COMP-3 VALUE +0. DTSBD541
00171      05  PARM-REC-CNT                PIC S9(05)  COMP-3 VALUE +0. DTSBD541
00172                                                                   DTSBD541
00173      05  WRK-PARM-START-YRQ          PIC S9(05) COMP-3.           DTSBD541
00174      05  WRK-PARM-END-YRQ            PIC S9(05) COMP-3.           DTSBD541
00175                                                                   DTSBD541
00176  01  WRK-YRQ                         PIC 9(05).                   DTSBD541
00177  01  FILLER REDEFINES WRK-YRQ.                                    DTSBD541
00178      05  WRK-YRQ-YEAR                PIC 9(4).                    DTSBD541
00179      05  WRK-YRQ-QTR                 PIC 9(1).                    DTSBD541
00180      EJECT                                                        DTSBD541
00181                                                                   DTSBD541
00182  01  WRK-EXPWAGE-REC.                                             DTSBD541
00183      05  EXP-SSN                     PIC 9(09).                   DTSBD541
00184      05  EXP-FIRST-NAME              PIC X(15).                   DTSBD541
00185      05  EXP-MIDDLE-INITIAL          PIC X(01).                   DTSBD541
00186      05  EXP-LAST-NAME               PIC X(20).                   DTSBD541
00187      05  EXP-STATE-FIPS              PIC 9(02).                   DTSBD541
00188      05  EXP-UI-ACCOUNT              PIC 9(10).                   DTSBD541
00189      05  EXP-REPORTING-UNIT          PIC 9(05).                   DTSBD541
00190      05  EXP-FEIN                    PIC 9(09).                   DTSBD541
00191      05  EXP-YEAR                    PIC 9(04).                   DTSBD541
00192      05  EXP-QUARTER                 PIC 9(01).                   DTSBD541
00193      05  EXP-WAGES                   PIC 9(10).                   DTSBD541
00194      05  EXP-HOURS                   PIC 9(03).                   DTSBD541
00195      05  EXP-WEEKS                   PIC 9(03).                   DTSBD541
00196                                                                   DTSBD541
00197  01  L001-LINK-AREA.                                              DTSBD541
00198  ++INCLUDE DTSIL001                                               DTSBD541
00199      EJECT                                                        DTSBD541
00200  01  L004-LINK-AREA.                                              DTSBD541
00201  ++INCLUDE DTSIL004                                               DTSBD541
00202      EJECT                                                        DTSBD541
00203  01  L910-LINK-AREA.                                              DTSBD541
00204  ++INCLUDE DTSIL910                                               DTSBD541
00205      EJECT                                                        DTSBD541
00206  01  MSKL-REC.                                                    DTSBD541
00207  ++INCLUDE DTSIMSKL                                               DTSBD541
00208                                                                   DTSBD541
00209  01  MPRF-REC.                                                    DTSBD541
00210  ++INCLUDE DTSIMPRF                                               DTSBD541
00211                                                                   DTSBD541
00212  01  L981-LINK-AREA.                                              DTSBD541
00213  ++INCLUDE DTSIL981                                               DTSBD541
00214      SKIP3                                                        DTSBD541
00215  01  WWGH-REC.                                                    DTSBD541
00216  ++INCLUDE DTSIWWGH                                               DTSBD541
00217      EJECT                                                        DTSBD541
00218  PROCEDURE DIVISION.                                              DTSBD541
00219                                                                   DTSBD541
00220       PERFORM I0000-INITIALIZE THRU I0000-EXIT.                   DTSBD541
00221       IF WRK-ERROR-NO-88                                          DTSBD541
00222          PERFORM P0000-PROCESS THRU P0000-EXIT                    DTSBD541
00223          PERFORM T0000-TERMINATE THRU T0000-EXIT                  DTSBD541
00224       END-IF.                                                     DTSBD541
00225                                                                   DTSBD541
00226      GOBACK.                                                      DTSBD541
00227      EJECT                                                        DTSBD541
00228  I0000-INITIALIZE.                                                DTSBD541
00229                                                                   DTSBD541
00230      SET WRK-ERROR-NO-88     TO TRUE.                             DTSBD541
00231                                                                   DTSBD541
00232      PERFORM I1000-PROCESS-PARMS THRU I1000-EXIT.                 DTSBD541
00233                                                                   DTSBD541
00234      PERFORM I2000-OPEN-FILES    THRU I2000-EXIT.                 DTSBD541
00235                                                                   DTSBD541
00236      MOVE WRK-MOD-NAME TO L981-MOD-NAME.                          DTSBD541
00237                                                                   DTSBD541
00238  I0000-EXIT.                                                      DTSBD541
00239      EXIT.                                                        DTSBD541
00240                                                                   DTSBD541
00241  I1000-PROCESS-PARMS.                                             DTSBD541
00242                                                                   DTSBD541
00243      OPEN INPUT ES202PRM-FILE.                                    DTSBD541
00244      READ ES202PRM-FILE.                                          DTSBD541
00245      IF NOT PARM-OK-88                                            DTSBD541
00246         DISPLAY '*** FILE STATUS IS : ' PARM-STATUS               DTSBD541
00247         MOVE 'CANNOT OPEN ES202PRM FILE ' TO WRK-ABEND-MSG        DTSBD541
00248         PERFORM S999-ABEND THRU S999-EXIT                         DTSBD541
00249      END-IF.                                                      DTSBD541
00250                                                                   DTSBD541
00251 *************************************************************     DTSBD541
00252 *  YRQ1 = NEW QUARTER                                             DTSBD541
00253 *  YRQ2 = OLD QUARTER                                             DTSBD541
00254 *************************************************************     DTSBD541
00255      MOVE ES202-PARM-YRQ1  TO WRK-YRQ1.                           DTSBD541
00256      MOVE ES202-PARM-YRQ2  TO WRK-YRQ2.                           DTSBD541
00257                                                                   DTSBD541
00258      DISPLAY SPACE.                                               DTSBD541
00259      DISPLAY 'BD541 YRQ1 ' WRK-YRQ1 '  YRQ2 ' WRK-YRQ2.           DTSBD541
00260      DISPLAY SPACE.                                               DTSBD541
00261  I1000-EXIT.                                                      DTSBD541
00262      EXIT.                                                        DTSBD541
00263      SKIP3                                                        DTSBD541
00264                                                                   DTSBD541
00265  I2000-OPEN-FILES.                                                DTSBD541
00266      OPEN OUTPUT OUTFILE1.                                        DTSBD541
00267      IF NOT OUTFILE1-OK-88                                        DTSBD541
00268         DISPLAY 'CANNOT OPEN OUTFILE1 ' OUTFILE1-STATUS           DTSBD541
00269         SET WRK-ERROR-YES-88 TO TRUE                              DTSBD541
00270         GO TO I2000-EXIT                                          DTSBD541
00271      END-IF.                                                      DTSBD541
00272                                                                   DTSBD541
00273      OPEN OUTPUT ES2WAGE.                                         DTSBD541
00274      IF NOT ES2WAGE-OK-88                                         DTSBD541
00275         DISPLAY 'CANNOT OPEN ES2WAGE ' ES2WAGE-STATUS             DTSBD541
00276         SET WRK-ERROR-YES-88 TO TRUE                              DTSBD541
00277         GO TO I2000-EXIT                                          DTSBD541
00278      END-IF.                                                      DTSBD541
00279                                                                   DTSBD541
00280      OPEN OUTPUT EXPORT-WAGE.                                     DTSBD541
00281      IF NOT EXPWAGE-OK-88                                         DTSBD541
00282         DISPLAY 'CANNOT OPEN EXPWAGE ' EXPWAGE-STATUS             DTSBD541
00283         SET WRK-ERROR-YES-88 TO TRUE                              DTSBD541
00284         GO TO I2000-EXIT                                          DTSBD541
00285      END-IF.                                                      DTSBD541
00286                                                                   DTSBD541
00287      PERFORM S910A-OPEN-READ   THRU S910A-EXIT.                   DTSBD541
00288      PERFORM S981A-OPEN-READ   THRU S981A-EXIT.                   DTSBD541
00289                                                                   DTSBD541
00290  I2000-EXIT.                                                      DTSBD541
00291      EXIT.                                                        DTSBD541
00292      SKIP3                                                        DTSBD541
00293 **************************************************************    DTSBD541
00294 *  START BROWSE THE VSAM.WGH FILE WITH THE PARM-START-YRQ    *    DTSBD541
00295 *  AND PARM-EMP-NO.                                          *    DTSBD541
00296 **************************************************************    DTSBD541
00297                                                                   DTSBD541
00298  P0000-PROCESS.                                                   DTSBD541
00299      MOVE LOW-VALUES            TO  WWGH-REC.                     DTSBD541
00300      MOVE ZERO                  TO  WWGH-EMP-NO                   DTSBD541
00301                                     WWGH-YRQ                      DTSBD541
00302                                     WWGH-SSN.                     DTSBD541
00303                                                                   DTSBD541
00304      PERFORM S981D-START-BROWSE  THRU S981D-EXIT.                 DTSBD541
00305      IF L981-NO-REC-88                                            DTSBD541
00306          MOVE '1ST START BROWSE FIND NO REC ' TO WRK-ABEND-MSG    DTSBD541
00307          PERFORM S999-ABEND THRU S999-EXIT                        DTSBD541
00308          GO TO P0000-EXIT                                         DTSBD541
00309      ELSE                                                         DTSBD541
00310         PERFORM P1000-SCAN-WAGES THRU P1000-EXIT                  DTSBD541
00311            UNTIL L981-NO-REC-88                                   DTSBD541
00312            OR WRK-ERROR-YES-88.                                   DTSBD541
00313                                                                   DTSBD541
00314  P0000-EXIT.                                                      DTSBD541
00315      EXIT.                                                        DTSBD541
00316                                                                   DTSBD541
00317 **************************************************************    DTSBD541
00318 *  SELECT VSAM-WGH RECORDS FOR ETT AND WAGE FILES.           *    DTSBD541
00319 *  FOR THE ETT FILE, SELECT WAGES FROM YRQ1 AND YRQ2.        *    DTSBD541
00320 *  FOR THE WAGE FILE, SELECT WAGES FROM YRQ1 ONLY.           *    DTSBD541
00321 **************************************************************    DTSBD541
00322                                                                   DTSBD541
00323  P1000-SCAN-WAGES.                                                DTSBD541
00324                                                                   DTSBD541
00325      ADD +1                        TO WRK-WWGH-READ-CNT.          DTSBD541
00326                                                                   DTSBD541
00327 ***  IF WWGH-SSN < 1000000                                        DTSBD541
00328      IF WWGH-EMP-NO = ZERO                                        DTSBD541
00329         NEXT SENTENCE                                             DTSBD541
00330      ELSE                                                         DTSBD541
00331         PERFORM P2000-WRITE-OUTPUT THRU P2000-EXIT                DTSBD541
00332      END-IF.                                                      DTSBD541
00333                                                                   DTSBD541
00334      PERFORM S981E-READ-NEXT       THRU S981E-EXIT.               DTSBD541
00335                                                                   DTSBD541
00336  P1000-EXIT.                                                      DTSBD541
00337      EXIT.                                                        DTSBD541
00338                                                                   DTSBD541
00339 **************************************************************    DTSBD541
00340 *  CREATE OUTPUT RECORDS, BASED ON QUARTER                   *    DTSBD541
00341 **************************************************************    DTSBD541
00342                                                                   DTSBD541
00343  P2000-WRITE-OUTPUT.                                              DTSBD541
00344      IF WWGH-YRQ = WRK-YRQ1                                       DTSBD541
00345      OR WWGH-YRQ = WRK-YRQ2                                       DTSBD541
00346         PERFORM P2100-WRITE-OUTFILE1        THRU P2100-EXIT       DTSBD541
00347         IF WRK-ERROR-NO-88                                        DTSBD541
00348            IF WWGH-YRQ = WRK-YRQ1                                 DTSBD541
00349               PERFORM P2200-WRITE-WAGES     THRU P2200-EXIT       DTSBD541
00350            END-IF                                                 DTSBD541
00351         END-IF                                                    DTSBD541
00352      END-IF.                                                      DTSBD541
00353                                                                   DTSBD541
00354  P2000-EXIT.                                                      DTSBD541
00355      EXIT.                                                        DTSBD541
00356                                                                   DTSBD541
00357  P2100-WRITE-OUTFILE1.                                            DTSBD541
00358      MOVE WWGH-EMP-NO                 TO OUTFILE1-EMP-NO.         DTSBD541
00359      MOVE WWGH-SSN                    TO OUTFILE1-SSN.            DTSBD541
00360                                                                   DTSBD541
00361      IF WWGH-YRQ                       = WRK-YRQ1                 DTSBD541
00362         MOVE 1                        TO OUTFILE1-QTR             DTSBD541
00363      ELSE                                                         DTSBD541
00364         IF WWGH-YRQ                    = WRK-YRQ2                 DTSBD541
00365            MOVE 2                     TO OUTFILE1-QTR             DTSBD541
00366         ELSE                                                      DTSBD541
00367            GO TO P2100-EXIT                                       DTSBD541
00368         END-IF                                                    DTSBD541
00369      END-IF.                                                      DTSBD541
00370                                                                   DTSBD541
00371      WRITE OUTFILE1-REC.                                          DTSBD541
00372      IF OUTFILE1-OK-88                                            DTSBD541
00373         ADD +1    TO WRK-OUTFILE1-WRITE-CNT                       DTSBD541
00374      ELSE                                                         DTSBD541
00375         DISPLAY 'CANNOT WRITE OUTFILE1 ' OUTFILE1-STATUS          DTSBD541
00376         SET WRK-ERROR-YES-88 TO TRUE                              DTSBD541
00377         PERFORM S999-ABEND THRU S999-EXIT                         DTSBD541
00378      END-IF.                                                      DTSBD541
00379                                                                   DTSBD541
00380  P2100-EXIT.                                                      DTSBD541
00381      EXIT.                                                        DTSBD541
00382                                                                   DTSBD541
00383  P2200-WRITE-WAGES.                                               DTSBD541
00384      IF WRK-EMP-NO                   = ZERO                       DTSBD541
00385         PERFORM P2210-CHECK-EMP     THRU P2210-EXIT               DTSBD541
00386         IF WRK-SUBJECT-NO-88                                      DTSBD541
00387            GO TO P2200-EXIT                                       DTSBD541
00388         ELSE                                                      DTSBD541
00389            MOVE WWGH-EMP-NO         TO WRK-EMP-NO                 DTSBD541
00390         END-IF                                                    DTSBD541
00391      END-IF.                                                      DTSBD541
00392                                                                   DTSBD541
00393      IF WWGH-EMP-NO                  = WRK-EMP-NO                 DTSBD541
00394         IF WRK-SUBJECT-NO-88                                      DTSBD541
00395            GO TO P2200-EXIT                                       DTSBD541
00396         ELSE                                                      DTSBD541
00397            ADD WWGH-EARNINGS        TO WRK-TOT-EARNINGS           DTSBD541
00398            ADD +1                   TO WRK-EMPLOYEE               DTSBD541
00399         END-IF                                                    DTSBD541
00400      ELSE                                                         DTSBD541
00401         PERFORM P2220-ES2WAGE       THRU P2220-EXIT               DTSBD541
00402         MOVE ZERO                   TO WRK-TOT-EARNINGS           DTSBD541
00403                                        WRK-EMPLOYEE               DTSBD541
00404         MOVE WWGH-EMP-NO            TO WRK-EMP-NO                 DTSBD541
00405         PERFORM P2210-CHECK-EMP     THRU P2210-EXIT               DTSBD541
00406         IF WRK-SUBJECT-NO-88                                      DTSBD541
00407            GO TO P2200-EXIT                                       DTSBD541
00408         ELSE                                                      DTSBD541
00409            MOVE WWGH-EARNINGS       TO WRK-TOT-EARNINGS           DTSBD541
00410            MOVE +1                  TO WRK-EMPLOYEE               DTSBD541
00411         END-IF                                                    DTSBD541
00412      END-IF.                                                      DTSBD541
00413                                                                   DTSBD541
00414      PERFORM P2230-EXPWAGE          THRU P2230-EXIT.              DTSBD541
00415                                                                   DTSBD541
00416  P2200-EXIT.                                                      DTSBD541
00417      EXIT.                                                        DTSBD541
00418                                                                   DTSBD541
00419  P2210-CHECK-EMP.                                                 DTSBD541
00420      SET WRK-SUBJECT-NO-88         TO TRUE.                       DTSBD541
00421      MOVE LOW-VALUES               TO MSKL-KEY-AREA.              DTSBD541
00422      MOVE WWGH-EMP-NO              TO MSKL-EMP-NO.                DTSBD541
00423      SET MSKL-PRF-88               TO TRUE.                       DTSBD541
00424                                                                   DTSBD541
00425      PERFORM S910B-READ            THRU S910B-EXIT.               DTSBD541
00426      IF L910-OK-88                                                DTSBD541
00427         MOVE MSKL-REC              TO MPRF-REC                    DTSBD541
00428         IF MPRF-CLASS-SUB-88                                      DTSBD541
00429            SET WRK-SUBJECT-YES-88  TO TRUE                        DTSBD541
00430         END-IF                                                    DTSBD541
00431      END-IF.                                                      DTSBD541
00432                                                                   DTSBD541
00433  P2210-EXIT.                                                      DTSBD541
00434      EXIT.                                                        DTSBD541
00435                                                                   DTSBD541
00436  P2220-ES2WAGE.                                                   DTSBD541
00437      MOVE ZERO                  TO WAG-EMP-ACCT.                  DTSBD541
00438      MOVE WRK-EMP-NO            TO WAG-DC-ACCT.                   DTSBD541
00439      MOVE WRK-EMPLOYEE          TO WAG-EMPLOYEE.                  DTSBD541
00440      MOVE WRK-TOT-EARNINGS      TO WAG-WAGE-AMT.                  DTSBD541
00441                                                                   DTSBD541
00442      WRITE ES2WAGE-REC.                                           DTSBD541
00443      IF ES2WAGE-OK-88                                             DTSBD541
00444         ADD +1    TO WRK-ES2WAGE-WRITE-CNT                        DTSBD541
00445      ELSE                                                         DTSBD541
00446         DISPLAY 'CANNOT WRITE ES2WAGE ' ES2WAGE-STATUS            DTSBD541
00447         SET WRK-ERROR-YES-88 TO TRUE                              DTSBD541
00448         PERFORM S999-ABEND THRU S999-EXIT                         DTSBD541
00449      END-IF.                                                      DTSBD541
00450                                                                   DTSBD541
00451  P2220-EXIT.                                                      DTSBD541
00452      EXIT.                                                        DTSBD541
00453                                                                   DTSBD541
00454  P2230-EXPWAGE.                                                   DTSBD541
00455      MOVE WWGH-SSN            TO EXP-SSN.                         DTSBD541
00456      MOVE SPACES              TO EXP-FIRST-NAME                   DTSBD541
00457                                  EXP-MIDDLE-INITIAL               DTSBD541
00458                                  EXP-LAST-NAME.                   DTSBD541
00459      MOVE WWGH-EMP-NO         TO EXP-UI-ACCOUNT.                  DTSBD541
00460      MOVE 11                  TO EXP-STATE-FIPS.                  DTSBD541
00461      MOVE ZERO                TO EXP-REPORTING-UNIT.              DTSBD541
00462      MOVE MPRF-FEIN           TO EXP-FEIN.                        DTSBD541
00463      MOVE WWGH-YRQ            TO WRK-YRQ.                         DTSBD541
00464      MOVE WRK-YRQ-YEAR        TO EXP-YEAR.                        DTSBD541
00465      MOVE WRK-YRQ-QTR         TO EXP-QUARTER.                     DTSBD541
00466      MOVE WWGH-EARNINGS       TO EXP-WAGES.                       DTSBD541
00467      MOVE ZERO                TO EXP-HOURS                        DTSBD541
00468                                  EXP-WEEKS.                       DTSBD541
00469                                                                   DTSBD541
00470      WRITE EXPWAGE-REC   FROM WRK-EXPWAGE-REC.                    DTSBD541
00471      IF EXPWAGE-OK-88                                             DTSBD541
00472         ADD +1    TO WRK-EXPWAGE-WRITE-CNT                        DTSBD541
00473      ELSE                                                         DTSBD541
00474         DISPLAY 'CANNOT WRITE EXPWAGE ' EXPWAGE-STATUS            DTSBD541
00475         SET WRK-ERROR-YES-88 TO TRUE                              DTSBD541
00476         PERFORM S999-ABEND THRU S999-EXIT                         DTSBD541
00477      END-IF.                                                      DTSBD541
00478                                                                   DTSBD541
00479  P2230-EXIT.                                                      DTSBD541
00480      EXIT.                                                        DTSBD541
00481                                                                   DTSBD541
00482  T0000-TERMINATE.                                                 DTSBD541
00483                                                                   DTSBD541
00484      DISPLAY ' '.                                                 DTSBD541
00485      DISPLAY ' '.                                                 DTSBD541
00486                                                                   DTSBD541
00487      DISPLAY '*** DTSBD541 TERMINATION STATISTICS ***'.           DTSBD541
00488                                                                   DTSBD541
00489      DISPLAY '  '.                                                DTSBD541
00490      DISPLAY 'WGH INPUT RECORDS READ                        :'    DTSBD541
00491              WRK-WWGH-READ-CNT.                                   DTSBD541
00492                                                                   DTSBD541
00493      DISPLAY 'ETT OUTPUT RECORDS WRITTEN                    :'    DTSBD541
00494              WRK-OUTFILE1-WRITE-CNT.                              DTSBD541
00495                                                                   DTSBD541
00496      DISPLAY 'ES-202 WAGE OUTPUT RECORDS WRITTEN            :'    DTSBD541
00497              WRK-ES2WAGE-WRITE-CNT.                               DTSBD541
00498                                                                   DTSBD541
00499      DISPLAY 'EXPORT WAGE OUTPUT RECORDS WRITTEN            :'    DTSBD541
00500              WRK-EXPWAGE-WRITE-CNT.                               DTSBD541
00501                                                                   DTSBD541
00502      PERFORM S910C-CLOSE THRU S910C-EXIT.                         DTSBD541
00503      PERFORM S981C-CLOSE THRU S981C-EXIT.                         DTSBD541
00504      CLOSE OUTFILE1                                               DTSBD541
00505            ES2WAGE                                                DTSBD541
00506            EXPORT-WAGE                                            DTSBD541
00507            ES202PRM-FILE.                                         DTSBD541
00508                                                                   DTSBD541
00509  T0000-EXIT.                                                      DTSBD541
00510      EXIT.                                                        DTSBD541
00511      EJECT                                                        DTSBD541
00512                                                                   DTSBD541
00513  S001-FROM-FED-8.                                                 DTSBD541
00514      SET L001-FROM-FED-8 TO TRUE.                                 DTSBD541
00515      GO TO S001-DATE.                                             DTSBD541
00516                                                                   DTSBD541
00517  S001-FROM-ABS-DAY.                                               DTSBD541
00518      SET L001-FROM-ABS-DAY TO TRUE.                               DTSBD541
00519      GO TO S001-DATE.                                             DTSBD541
00520                                                                   DTSBD541
00521  S001-FROM-CAL-6.                                                 DTSBD541
00522      SET L001-FROM-CAL-6 TO TRUE.                                 DTSBD541
00523      GO TO S001-DATE.                                             DTSBD541
00524                                                                   DTSBD541
00525  S001-DATE.                                                       DTSBD541
00526      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBD541
00527  S001-EXIT.                                                       DTSBD541
00528      EXIT.                                                        DTSBD541
00529                                                                   DTSBD541
00530  S004-FROM-3.                                                     DTSBD541
00531      SET L004-FROM-3        TO TRUE.                              DTSBD541
00532      GO TO S004-YRQ.                                              DTSBD541
00533                                                                   DTSBD541
00534  S004-YRQ.                                                        DTSBD541
00535      CALL 'DTSBU004' USING L004-LINK-AREA.                        DTSBD541
00536                                                                   DTSBD541
00537  S004-EXIT.                                                       DTSBD541
00538      EXIT.                                                        DTSBD541
00539                                                                   DTSBD541
00540  S910A-OPEN-READ.                                                 DTSBD541
00541      SET L910-OPEN-READ-88 TO TRUE.                               DTSBD541
00542      PERFORM S910Z-MSTR-IO THRU S910Z-EXIT.                       DTSBD541
00543                                                                   DTSBD541
00544  S910A-EXIT.                                                      DTSBD541
00545      EXIT.                                                        DTSBD541
00546                                                                   DTSBD541
00547  S910B-READ.                                                      DTSBD541
00548      SET L910-READ-88 TO TRUE.                                    DTSBD541
00549      PERFORM S910Z-MSTR-IO THRU S910Z-EXIT.                       DTSBD541
00550                                                                   DTSBD541
00551  S910B-EXIT.                                                      DTSBD541
00552      EXIT.                                                        DTSBD541
00553                                                                   DTSBD541
00554  S910C-CLOSE.                                                     DTSBD541
00555      SET L910-CLOSE-88     TO TRUE.                               DTSBD541
00556      PERFORM S910Z-MSTR-IO THRU S910Z-EXIT.                       DTSBD541
00557                                                                   DTSBD541
00558  S910C-EXIT.                                                      DTSBD541
00559      EXIT.                                                        DTSBD541
00560                                                                   DTSBD541
00561  S910Z-MSTR-IO.                                                   DTSBD541
00562      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBD541
00563                            MSKL-REC.                              DTSBD541
00564  S910Z-EXIT.                                                      DTSBD541
00565      EXIT.                                                        DTSBD541
00566                                                                   DTSBD541
00567  S981A-OPEN-READ.                                                 DTSBD541
00568      SET L981-OPEN-READ-88 TO TRUE.                               DTSBD541
00569      PERFORM S981Z-WAGE-I  THRU S981Z-EXIT.                       DTSBD541
00570                                                                   DTSBD541
00571  S981A-EXIT.                                                      DTSBD541
00572      EXIT.                                                        DTSBD541
00573                                                                   DTSBD541
00574  S981B-OPEN-UPDATE.                                               DTSBD541
00575      SET L981-OPEN-UPDATE-88 TO TRUE.                             DTSBD541
00576      PERFORM S981Z-WAGE-I  THRU S981Z-EXIT.                       DTSBD541
00577                                                                   DTSBD541
00578  S981B-EXIT.                                                      DTSBD541
00579      EXIT.                                                        DTSBD541
00580                                                                   DTSBD541
00581  S981C-CLOSE.                                                     DTSBD541
00582      SET L981-CLOSE-88 TO TRUE.                                   DTSBD541
00583      PERFORM S981Z-WAGE-I  THRU S981Z-EXIT.                       DTSBD541
00584                                                                   DTSBD541
00585  S981C-EXIT.                                                      DTSBD541
00586      EXIT.                                                        DTSBD541
00587                                                                   DTSBD541
00588  S981D-START-BROWSE.                                              DTSBD541
00589      SET L981-START-BROWSE-88 TO TRUE.                            DTSBD541
00590      PERFORM S981Z-WAGE-I  THRU S981Z-EXIT.                       DTSBD541
00591                                                                   DTSBD541
00592  S981D-EXIT.                                                      DTSBD541
00593      EXIT.                                                        DTSBD541
00594                                                                   DTSBD541
00595  S981E-READ-NEXT.                                                 DTSBD541
00596      SET L981-READ-NEXT-88 TO TRUE.                               DTSBD541
00597      PERFORM S981Z-WAGE-I  THRU S981Z-EXIT.                       DTSBD541
00598                                                                   DTSBD541
00599  S981E-EXIT.                                                      DTSBD541
00600      EXIT.                                                        DTSBD541
00601                                                                   DTSBD541
00602  S981Z-WAGE-I.                                                    DTSBD541
00603      CALL 'DTSBU981' USING L981-LINK-AREA                         DTSBD541
00604                            WWGH-REC.                              DTSBD541
00605  S981Z-EXIT.                                                      DTSBD541
00606      EXIT.                                                        DTSBD541
00607                                                                   DTSBD541
00608  S999-ABEND.                                                      DTSBD541
00609      DISPLAY '*** DTSBD541 ABENDING : '                           DTSBD541
00610              WRK-ABEND-MSG.                                       DTSBD541
00611                                                                   DTSBD541
00612      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBD541
00613  S999-EXIT.                                                       DTSBD541
00614      EXIT.                                                        DTSBD541
