00001  IDENTIFICATION DIVISION.                                         03/27/15
00002  PROGRAM-ID.             DTSBD542.                                DTSBD542
00003  AUTHOR.                 NGC.                                        LV008
00004  DATE-WRITTEN.           JUNE 2004.                               DTSBD542
00005  DATE-COMPILED.                                                   DTSBD542
00006      SKIP3                                                        DTSBD542
00007 *****                                                             DTSBD542
00008 *                                                                 DTSBD542
00009 *    FUNCTION:  BUILD EMPLOYEE TRANSFER TRANSACTION FILE (ETT)    DTSBD542
00010 *               FOR ES202 PROCESS.                                DTSBD542
00011 *               STEP 2 - CREATE FILE                              DTSBD542
00012 *                                                                 DTSBD542
00013 *    MODIFICATION LOG:                                            DTSBD542
00014 *                                                                 DTSBD542
00015 *    06/24/2004  INITIAL DEVELOPMENT                              DTSBD542
00016 *                WORK ORDER:                      PROGRAMMER: GD  DTSBD542
00017 *                                                                 DTSBD542
00018 *    10/25/2004  READ THE PARAMETER FILE CONTAINING BOTH PARM     DTSBD542
00019 *                SPECIFIED QTR AND PREVIOUS QTR WHICH CREATED     DTSBD542
00020 *                FROM PGM DTSBD540 FOR THIS PGM PROCESSING.       DTSBD542
00021 *                REFERENCE: LMI REQUIRMENT        PROGRAMMER: RW  DTSBD542
00022 *                                                                 DTSBD542
00023 *    01/02/2015  INCREASED TBL1 FROM 100 TO 120                   DTSBD542
00024 *                REFERENCE: ABEND ON 1/2/15       PROGRAMMER: NH  DTSBD542
00025 *    03/02/2015  INCREASED TBL2 FROM 100 TO 120                   DTSBD542
00026 *                REFERENCE: ABEND ON 3/2/15       PROGRAMMER: NH  DTSBD542
00027 *    03/27/2015  INCREASED TBL2 AND TBL1 FROM 120 TO 500          DTSBD542
00028 *                REFERENCE: ABEND ON 3/2/15       PROGRAMMER: NH  DTSBD542
00029 *    99/99/9999  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD542
00030 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD542
00031 *                WORK ORDER:                      PROGRAMMER: XXX DTSBD542
00032 *                                                                 DTSBD542
00033 *  DESCRIPTION:                                                   DTSBD542
00034 *                                                                 DTSBD542
00035 *    INITIATION:                                                  DTSBD542
00036 *      VSAM WAGE FILE OPEN READ                                   DTSBD542
00037 *                                                                 DTSBD542
00038 *    PARAMETERS INPUT:                                            DTSBD542
00039 *      PARM-EMP-NO PARM-START-YRQ PARM-END-YRQ.                   DTSBD542
00040 *                                                                 DTSBD542
00041 *    PROCESSING:                                                  DTSBD542
00042 *      SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (535R1).       DTSBD542
00043 *                                                                 DTSBD542
00044 *    TERMINATION:                                                 DTSBD542
00045 *      OUTPUT STATISTICAL RECORDS COUNT.                          DTSBD542
00046 *                                                                 DTSBD542
00047 *    RECORDS READ:                                                DTSBD542
00048 *      MASTER:                                                    DTSBD542
00049          VSAM WAGES FILE                                          DTSBD542
00050 *                                                                 DTSBD542
00051 *      ALTERNATE INDEX:                                           DTSBD542
00052 *        NONE.                                                    DTSBD542
00053 *                                                                 DTSBD542
00054 *      REFERENCE:                                                 DTSBD542
00055 *        NONE.                                                    DTSBD542
00056 *                                                                 DTSBD542
00057 *    RECORDS UPDATED:                                             DTSBD542
00058 *        NONE                                                     DTSBD542
00059 *                                                                 DTSBD542
00060 *    REPORT RECORDS WRITTEN:                                      DTSBD542
00061 *        R535  EMPLOYER WAGES RECORD FOR REPORTING                DTSBD542
00062 *                                                                 DTSBD542
00063 *    BATCH TRANSACTION COLLECTION RECORDS WRITTEN:                DTSBD542
00064 *        NONE.                                                    DTSBD542
00065 *                                                                 DTSBD542
00066 *    MODULES CALLED:                                              DTSBD542
00067 *        DTSBU001  DATE CONVERSION/EDIT.                          DTSBD542
00068 *        DTSBU004  QUARERLY SUMMARY REPORT REC.                   DTSBD542
00069 *        DTSBU981  VSAM.WGH FILE I/O.                             DTSBD542
00070 *        DTSBU946  VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1.   DTSBD542
00071 *                                                                 DTSBD542
00072 *    VERMONT REFERENCE:                                           DTSBD542
00073 *        NONE.                                                    DTSBD542
00074 *                                                                 DTSBD542
00075 *****                                                             DTSBD542
00076      SKIP3                                                        DTSBD542
00077  ENVIRONMENT DIVISION.                                            DTSBD542
00078  INPUT-OUTPUT SECTION.                                            DTSBD542
00079      SKIP3                                                        DTSBD542
00080  FILE-CONTROL.                                                    DTSBD542
00081      SELECT INFILE          ASSIGN TO INFILE                      DTSBD542
00082             FILE STATUS IS INFILE-STATUS.                         DTSBD542
00083                                                                   DTSBD542
00084      SELECT ETT-FILE        ASSIGN TO ETTFILE                     DTSBD542
00085             FILE STATUS IS ETT-STATUS.                            DTSBD542
00086                                                                   DTSBD542
00087      SELECT ES202PRM-FILE   ASSIGN TO ES202P2I                    DTSBD542
00088             FILE STATUS IS PARM-STATUS.                           DTSBD542
00089                                                                   DTSBD542
00090      SKIP3                                                        DTSBD542
00091  DATA DIVISION.                                                   DTSBD542
00092  FILE SECTION.                                                    DTSBD542
00093  FD  INFILE                                                       DTSBD542
00094      RECORD CONTAINS 16 CHARACTERS                                DTSBD542
00095      DATA RECORD IS INFILE-REC.                                   DTSBD542
00096      SKIP1                                                        DTSBD542
00097  01  INFILE-REC.                                                  DTSBD542
00098      05  INFILE-SSN                  PIC  9(09).                  DTSBD542
00099      05  INFILE-QTR                  PIC  9(01).                  DTSBD542
00100      05  INFILE-EMP                  PIC  9(06).                  DTSBD542
00101                                                                   DTSBD542
00102  FD  ETT-FILE                                                     DTSBD542
00103      RECORD CONTAINS 20 CHARACTERS                                DTSBD542
00104      DATA RECORD IS ETT-REC.                                      DTSBD542
00105      SKIP1                                                        DTSBD542
00106  01  ETT-REC.                                                     DTSBD542
00107  ++INCLUDE ES2ETTV1                                               DTSBD542
00108                                                                   DTSBD542
00109  FD  ES202PRM-FILE                                                DTSBD542
00110      RECORDING MODE IS F                                          DTSBD542
00111      BLOCK CONTAINS 0 RECORDS.                                    DTSBD542
00112                                                                   DTSBD542
00113  01  ES202-PARM-REC.                                              DTSBD542
00114      05  ES202-PARM-YRQ1             PIC  S9(05) COMP-3.          DTSBD542
00115      05  ES202-PARM-YRQ2             PIC  S9(05) COMP-3.          DTSBD542
00116                                                                   DTSBD542
00117  WORKING-STORAGE SECTION.                                         DTSBD542
001175 77  PAN-VALET PICTURE X(24) VALUE '008DTSBD542  03/27/15'.       DTSBD542
00118  77  PAN-VALET PICTURE X(24) VALUE '004DTSBD542  03/27/15'.       DTSBD542
00119  77  PAN-VALET PICTURE X(24) VALUE '006DTSBD542  03/02/15'.       DTSBD542
00120  77  PAN-VALET PICTURE X(24) VALUE '002DTSBD542  03/02/15'.       DTSBD542
00121  77  PAN-VALET PICTURE X(24) VALUE '004DTSBD542  03/02/15'.       DTSBD542
00122  77  PAN-VALET PICTURE X(24) VALUE '003DTSBD542  01/02/15'.       DTSBD542
00123  77  PAN-VALET PICTURE X(24) VALUE '001DTSBD542  01/21/05'.       DTSBD542
00124                                                                   DTSBD542
00125  01  WRK-AREA.                                                    DTSBD542
00126      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +542.DTSBD542
00127      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBD542'.DTSBD542
00128      05  WRK-ABEND-MSG               PIC  X(60).                  DTSBD542
00129                                                                   DTSBD542
00130      05  WRK-YRQ1                    PIC S9(05)  COMP-3           DTSBD542
00131                                     VALUE +0.                     DTSBD542
00132      05  WRK-YRQ2                    PIC S9(05)  COMP-3           DTSBD542
00133                                     VALUE +0.                     DTSBD542
00134                                                                   DTSBD542
00135      05  WRK-YRQ                     PIC S9(05)  COMP-3 VALUE +0. DTSBD542
00136      05  WRK-EMP-NO                  PIC S9(07)  COMP-3 VALUE +0. DTSBD542
00137      05  WRK-SSN                     PIC S9(09)  COMP-3 VALUE +0. DTSBD542
00138                                                                   DTSBD542
00139      05  INFILE-STATUS               PIC  X(02).                  DTSBD542
00140          88  INFILE-OK-88                      VALUE '00'.        DTSBD542
00141          88  INFILE-EOF-88                     VALUE '10'.        DTSBD542
00142                                                                   DTSBD542
00143      05  ETT-STATUS                  PIC  X(02).                  DTSBD542
00144          88  ETT-OK-88                         VALUE '00'.        DTSBD542
00145                                                                   DTSBD542
00146      05  PARM-STATUS                 PIC  X(02).                  DTSBD542
00147          88  PARM-OK-88                        VALUE '00'.        DTSBD542
00148          88  PARM-EOF-88                       VALUE '10'.        DTSBD542
00149                                                                   DTSBD542
00150      05  WRK-EMP-CNT                 PIC S9(07) COMP-3 VALUE +0.  DTSBD542
00151      05  QTR1-TABLE.                                              DTSBD542
00152          10  SUB1                    PIC S9(04) COMP.             DTSBD542
00153          10  TBL1-CNT                PIC S9(04) COMP              DTSBD542
00154                                        VALUE +0.                  DTSBD542
00155          10  TBL1-MAX                PIC S9(04) COMP              DTSBD542
00156 *                                      VALUE +100.                DTSBD542
00157 *                                      VALUE +120.                DTSBD542
00158                                        VALUE +500.                DTSBD542
00159 *        10  TBL1-ENTRY OCCURS 100 TIMES.                         DTSBD542
00160 *        10  TBL1-ENTRY OCCURS 120 TIMES.                         DTSBD542
00161          10  TBL1-ENTRY OCCURS 500 TIMES.                         DTSBD542
00162              15  TBL1-EMP-9          PIC  9(10).                  DTSBD542
00163              15  TBL1-EMP-X REDEFINES TBL1-EMP-9                  DTSBD542
00164                                      PIC  X(10).                  DTSBD542
00165                                                                   DTSBD542
00166      05  QTR2-TABLE.                                              DTSBD542
00167          10  SUB2                    PIC S9(04) COMP.             DTSBD542
00168          10  TBL2-CNT                PIC S9(04) COMP              DTSBD542
00169                                        VALUE +0.                  DTSBD542
00170          10  TBL2-MAX                PIC S9(04) COMP              DTSBD542
00171 *                                      VALUE +100.                DTSBD542
00172 *                                      VALUE +120.                DTSBD542
00173                                        VALUE +500.                DTSBD542
00174 *        10  TBL2-ENTRY OCCURS 100 TIMES.                         DTSBD542
00175 *        10  TBL2-ENTRY OCCURS 120 TIMES.                         DTSBD542
00176          10  TBL2-ENTRY OCCURS 500 TIMES.                         DTSBD542
00177              15  TBL2-EMP-9          PIC  9(10).                  DTSBD542
00178              15  TBL2-EMP-X REDEFINES TBL2-EMP-9                  DTSBD542
00179                                      PIC  X(10).                  DTSBD542
00180                                                                   DTSBD542
00181      05  WRK-ERROR-IND               PIC  X(01).                  DTSBD542
00182          88 WRK-ERROR-YES-88                VALUE 'Y'.            DTSBD542
00183          88 WRK-ERROR-NO-88                 VALUE 'N'.            DTSBD542
00184                                                                   DTSBD542
00185      05  WRK-INFILE-READ-CNT         PIC S9(07)  COMP-3 VALUE +0. DTSBD542
00186      05  WRK-ETT-WRITE-CNT           PIC S9(07)  COMP-3 VALUE +0. DTSBD542
00187                                                                   DTSBD542
00188                                                                   DTSBD542
00189  PROCEDURE DIVISION.                                              DTSBD542
00190                                                                   DTSBD542
00191       PERFORM I0000-INITIALIZE THRU I0000-EXIT.                   DTSBD542
00192       IF WRK-ERROR-NO-88                                          DTSBD542
00193          PERFORM P0000-PROCESS THRU P0000-EXIT                    DTSBD542
00194       END-IF.                                                     DTSBD542
00195                                                                   DTSBD542
00196       PERFORM T0000-TERMINATE  THRU T0000-EXIT.                   DTSBD542
00197                                                                   DTSBD542
00198      GOBACK.                                                      DTSBD542
00199      EJECT                                                        DTSBD542
00200  I0000-INITIALIZE.                                                DTSBD542
00201                                                                   DTSBD542
00202      SET WRK-ERROR-NO-88     TO TRUE.                             DTSBD542
00203      MOVE ZERO               TO WRK-EMP-NO                        DTSBD542
00204                                 WRK-SSN.                          DTSBD542
00205                                                                   DTSBD542
00206      PERFORM I1000-PROCESS-PARMS THRU I1000-EXIT.                 DTSBD542
00207                                                                   DTSBD542
00208      PERFORM I2000-OPEN-FILES    THRU I2000-EXIT.                 DTSBD542
00209                                                                   DTSBD542
00210      PERFORM I3000-INIT-TABLES   THRU I3000-EXIT.                 DTSBD542
00211                                                                   DTSBD542
00212      PERFORM I4000-WRITE-HEADER  THRU I4000-EXIT.                 DTSBD542
00213                                                                   DTSBD542
00214  I0000-EXIT.                                                      DTSBD542
00215      EXIT.                                                        DTSBD542
00216                                                                   DTSBD542
00217                                                                   DTSBD542
00218  I1000-PROCESS-PARMS.                                             DTSBD542
00219                                                                   DTSBD542
00220      OPEN INPUT ES202PRM-FILE.                                    DTSBD542
00221                                                                   DTSBD542
00222      READ ES202PRM-FILE.                                          DTSBD542
00223      IF NOT PARM-OK-88                                            DTSBD542
00224         DISPLAY '*** PARM FILE STATUS IS : ' PARM-STATUS          DTSBD542
00225         MOVE 'CANNOT OPEN ES202PRM FILE ' TO WRK-ABEND-MSG        DTSBD542
00226         PERFORM S999-ABEND THRU S999-EXIT                         DTSBD542
00227      END-IF.                                                      DTSBD542
00228                                                                   DTSBD542
00229 *************************************************************     DTSBD542
00230 *  YRQ1 = NEW QUARTER                                             DTSBD542
00231 *  YRQ2 = OLD QUARTER                                             DTSBD542
00232 *************************************************************     DTSBD542
00233      MOVE ES202-PARM-YRQ1  TO WRK-YRQ1.                           DTSBD542
00234      MOVE ES202-PARM-YRQ2  TO WRK-YRQ2.                           DTSBD542
00235                                                                   DTSBD542
00236      DISPLAY SPACE.                                               DTSBD542
00237      DISPLAY 'BD542 YRQ1 ' WRK-YRQ1 '  YRQ2 ' WRK-YRQ2.           DTSBD542
00238      DISPLAY SPACE.                                               DTSBD542
00239  I1000-EXIT.                                                      DTSBD542
00240      EXIT.                                                        DTSBD542
00241                                                                   DTSBD542
00242  I2000-OPEN-FILES.                                                DTSBD542
00243      OPEN INPUT  INFILE.                                          DTSBD542
00244      IF NOT INFILE-OK-88                                          DTSBD542
00245         DISPLAY 'CANNOT OPEN INFILE ' INFILE-STATUS               DTSBD542
00246         SET WRK-ERROR-YES-88 TO TRUE                              DTSBD542
00247         GO TO I2000-EXIT.                                         DTSBD542
00248                                                                   DTSBD542
00249      OPEN OUTPUT  ETT-FILE.                                       DTSBD542
00250      IF NOT ETT-OK-88                                             DTSBD542
00251         DISPLAY 'CANNOT OPEN ETT FILE ' ETT-STATUS                DTSBD542
00252         SET WRK-ERROR-YES-88 TO TRUE                              DTSBD542
00253         GO TO I2000-EXIT.                                         DTSBD542
00254                                                                   DTSBD542
00255  I2000-EXIT.                                                      DTSBD542
00256      EXIT.                                                        DTSBD542
00257                                                                   DTSBD542
00258  I3000-INIT-TABLES.                                               DTSBD542
00259      MOVE ZERO               TO TBL1-CNT                          DTSBD542
00260                                 TBL2-CNT.                         DTSBD542
00261                                                                   DTSBD542
00262      PERFORM                                                      DTSBD542
00263        VARYING SUB1 FROM +1 BY +1                                 DTSBD542
00264        UNTIL SUB1 > TBL1-MAX                                      DTSBD542
00265           MOVE ZERO          TO TBL1-EMP-9 (SUB1)                 DTSBD542
00266      END-PERFORM.                                                 DTSBD542
00267                                                                   DTSBD542
00268      PERFORM                                                      DTSBD542
00269        VARYING SUB2 FROM +1 BY +1                                 DTSBD542
00270        UNTIL SUB2 > TBL2-MAX                                      DTSBD542
00271           MOVE ZERO          TO TBL2-EMP-9 (SUB2)                 DTSBD542
00272      END-PERFORM.                                                 DTSBD542
00273                                                                   DTSBD542
00274  I3000-EXIT.                                                      DTSBD542
00275      EXIT.                                                        DTSBD542
00276                                                                   DTSBD542
00277  I4000-WRITE-HEADER.                                              DTSBD542
00278      SET ETT-HEADER-88                TO TRUE.                    DTSBD542
00279      MOVE WRK-YRQ1                    TO ETT-NEW-YRQ.             DTSBD542
00280      MOVE WRK-YRQ2                    TO ETT-OLD-YRQ.             DTSBD542
00281                                                                   DTSBD542
00282      DISPLAY 'BD542 ETT HEADER ' ETT-REC.                         DTSBD542
00283                                                                   DTSBD542
00284      WRITE ETT-REC.                                               DTSBD542
00285      IF ETT-OK-88                                                 DTSBD542
00286         ADD +1    TO WRK-ETT-WRITE-CNT                            DTSBD542
00287      ELSE                                                         DTSBD542
00288         DISPLAY 'CANNOT WRITE ETT FILE ' ETT-STATUS               DTSBD542
00289         SET WRK-ERROR-YES-88 TO TRUE                              DTSBD542
00290      END-IF.                                                      DTSBD542
00291                                                                   DTSBD542
00292  I4000-EXIT.                                                      DTSBD542
00293      EXIT.                                                        DTSBD542
00294                                                                   DTSBD542
00295 **************************************************************    DTSBD542
00296 *  START BROWSE THE VSAM.WGH FILE WITH THE PARM-START-YRQ    *    DTSBD542
00297 *  AND PARM-EMP-NO.                                          *    DTSBD542
00298 **************************************************************    DTSBD542
00299                                                                   DTSBD542
00300  P0000-PROCESS.                                                   DTSBD542
00301      READ INFILE.                                                 DTSBD542
00302      IF NOT INFILE-OK-88                                          DTSBD542
00303         DISPLAY 'INPUT FILE IS EMPTY '                            DTSBD542
00304         SET WRK-ERROR-YES-88  TO TRUE                             DTSBD542
00305         GO TO P0000-EXIT                                          DTSBD542
00306      ELSE                                                         DTSBD542
00307         MOVE INFILE-SSN               TO WRK-SSN                  DTSBD542
00308         ADD +1                        TO WRK-INFILE-READ-CNT      DTSBD542
00309 *&                                                                DTSBD542
00310         DISPLAY 'P0000 ' INFILE-SSN ' ' INFILE-QTR ' ' INFILE-EMP DTSBD542
00311 */&                                                               DTSBD542
00312         PERFORM P1100-MOVE-TO-TABLE   THRU P1100-EXIT             DTSBD542
00313      END-IF.                                                      DTSBD542
00314                                                                   DTSBD542
00315      PERFORM P1000-SCAN-INPUT THRU P1000-EXIT                     DTSBD542
00316         UNTIL INFILE-EOF-88                                       DTSBD542
00317         OR WRK-ERROR-YES-88.                                      DTSBD542
00318                                                                   DTSBD542
00319  P0000-EXIT.                                                      DTSBD542
00320      EXIT.                                                        DTSBD542
00321                                                                   DTSBD542
00322 **************************************************************    DTSBD542
00323 *  SELECT VSAM-WGH RECORDS WHEN WWGH-EMP-NO = PARM-EMP-NO,   *    DTSBD542
00324 *  WWGH-YRQ >= PARM-START-YRQ AND WWGH-YRQ <= PARM-END-YRQ.  *    DTSBD542
00325 **************************************************************    DTSBD542
00326                                                                   DTSBD542
00327  P1000-SCAN-INPUT.                                                DTSBD542
00328      READ INFILE.                                                 DTSBD542
00329      IF INFILE-OK-88                                              DTSBD542
00330         ADD +1                     TO WRK-INFILE-READ-CNT         DTSBD542
00331      ELSE                                                         DTSBD542
00332         IF INFILE-EOF-88                                          DTSBD542
00333            GO TO P1000-EXIT                                       DTSBD542
00334         ELSE                                                      DTSBD542
00335            DISPLAY 'BAD READ OF INPUT FILE ' INFILE-STATUS        DTSBD542
00336            SET WRK-ERROR-YES-88 TO TRUE                           DTSBD542
00337            GO TO P1000-EXIT                                       DTSBD542
00338         END-IF                                                    DTSBD542
00339      END-IF.                                                      DTSBD542
00340                                                                   DTSBD542
00341      IF INFILE-SSN                      = WRK-SSN                 DTSBD542
00342         PERFORM P1100-MOVE-TO-TABLE  THRU P1100-EXIT              DTSBD542
00343      ELSE                                                         DTSBD542
00344         PERFORM P1200-WRITE-ETT      THRU P1200-EXIT              DTSBD542
00345         PERFORM P1300-CLEAR-TABLES   THRU P1300-EXIT              DTSBD542
00346         PERFORM P1100-MOVE-TO-TABLE  THRU P1100-EXIT              DTSBD542
00347      END-IF.                                                      DTSBD542
00348                                                                   DTSBD542
00349                                                                   DTSBD542
00350  P1000-EXIT.                                                      DTSBD542
00351      EXIT.                                                        DTSBD542
00352                                                                   DTSBD542
00353  P1100-MOVE-TO-TABLE.                                             DTSBD542
00354 *&                                                                DTSBD542
00355      IF WRK-INFILE-READ-CNT < 1000                                DTSBD542
00356         DISPLAY 'P1100 ' INFILE-SSN ' ' INFILE-QTR ' ' INFILE-EMP DTSBD542
00357      END-IF.                                                      DTSBD542
00358 */&                                                               DTSBD542
00359      IF INFILE-QTR = 1                                            DTSBD542
00360         PERFORM P1110-TABLE1        THRU P1110-EXIT               DTSBD542
00361      ELSE                                                         DTSBD542
00362         IF INFILE-QTR = 2                                         DTSBD542
00363            PERFORM P1120-TABLE2     THRU P1120-EXIT               DTSBD542
00364         END-IF                                                    DTSBD542
00365      END-IF.                                                      DTSBD542
00366                                                                   DTSBD542
00367  P1100-EXIT.                                                      DTSBD542
00368      EXIT.                                                        DTSBD542
00369                                                                   DTSBD542
00370  P1110-TABLE1.                                                    DTSBD542
00371      IF TBL1-CNT < TBL1-MAX                                       DTSBD542
00372         ADD +1             TO TBL1-CNT                            DTSBD542
00373         MOVE INFILE-EMP    TO TBL1-EMP-9 (TBL1-CNT)               DTSBD542
00374      ELSE                                                         DTSBD542
00375         DISPLAY 'TBL1 LENGTH EXCEEDED ' INFILE-EMP                DTSBD542
00376            '  ' TBL1-CNT                                          DTSBD542
00377         PERFORM S999-ABEND   THRU S999-EXIT                       DTSBD542
00378      END-IF.                                                      DTSBD542
00379                                                                   DTSBD542
00380  P1110-EXIT.                                                      DTSBD542
00381      EXIT.                                                        DTSBD542
00382                                                                   DTSBD542
00383  P1120-TABLE2.                                                    DTSBD542
00384      IF TBL2-CNT < TBL2-MAX                                       DTSBD542
00385         ADD +1             TO TBL2-CNT                            DTSBD542
00386         MOVE INFILE-EMP    TO TBL2-EMP-9 (TBL2-CNT)               DTSBD542
00387      ELSE                                                         DTSBD542
00388         DISPLAY 'TBL2 LENGTH EXCEEDED ' INFILE-EMP                DTSBD542
00389            '  ' TBL2-CNT                                          DTSBD542
00390         PERFORM S999-ABEND   THRU S999-EXIT                       DTSBD542
00391      END-IF.                                                      DTSBD542
00392                                                                   DTSBD542
00393  P1120-EXIT.                                                      DTSBD542
00394      EXIT.                                                        DTSBD542
00395                                                                   DTSBD542
00396  P1200-WRITE-ETT.                                                 DTSBD542
00397 *&                                                                DTSBD542
00398      IF WRK-INFILE-READ-CNT < 1000                                DTSBD542
00399         DISPLAY 'P1200 TBL1 ' TBL1-CNT '  TBL2 ' TBL2-CNT         DTSBD542
00400            '  SSN ' WRK-SSN                                       DTSBD542
00401      END-IF.                                                      DTSBD542
00402 */&                                                               DTSBD542
00403      PERFORM P1210-CHK-NULL-ENTRIES   THRU P1210-EXIT.            DTSBD542
00404                                                                   DTSBD542
00405      PERFORM                                                      DTSBD542
00406        VARYING SUB1 FROM +1 BY +1                                 DTSBD542
00407        UNTIL SUB1 > TBL1-CNT                                      DTSBD542
00408           PERFORM P1220-TABLE2  THRU P1220-EXIT                   DTSBD542
00409      END-PERFORM.                                                 DTSBD542
00410                                                                   DTSBD542
00411  P1200-EXIT.                                                      DTSBD542
00412      EXIT.                                                        DTSBD542
00413                                                                   DTSBD542
00414  P1210-CHK-NULL-ENTRIES.                                          DTSBD542
00415      IF TBL1-CNT = ZERO                                           DTSBD542
00416         IF TBL2-CNT > ZERO                                        DTSBD542
00417            MOVE +1 TO TBL1-CNT                                    DTSBD542
00418            MOVE 'XXXXXXXXXX'  TO TBL1-EMP-X (TBL1-CNT)            DTSBD542
00419         END-IF                                                    DTSBD542
00420      ELSE                                                         DTSBD542
00421         IF TBL2-CNT = ZERO                                        DTSBD542
00422            MOVE +1 TO TBL2-CNT                                    DTSBD542
00423            MOVE 'XXXXXXXXXX'  TO TBL2-EMP-X (TBL2-CNT)            DTSBD542
00424         END-IF                                                    DTSBD542
00425      END-IF.                                                      DTSBD542
00426                                                                   DTSBD542
00427  P1210-EXIT.                                                      DTSBD542
00428      EXIT.                                                        DTSBD542
00429                                                                   DTSBD542
00430  P1220-TABLE2.                                                    DTSBD542
00431      PERFORM                                                      DTSBD542
00432        VARYING SUB2 FROM +1 BY +1                                 DTSBD542
00433        UNTIL SUB2 > TBL2-CNT                                      DTSBD542
00434           MOVE TBL1-EMP-9 (SUB1) TO ETT-PRED-ACCT                 DTSBD542
00435           MOVE TBL2-EMP-9 (SUB2) TO ETT-SUCC-ACCT                 DTSBD542
00436           PERFORM P1230-WRITE     THRU P1230-EXIT                 DTSBD542
00437      END-PERFORM.                                                 DTSBD542
00438                                                                   DTSBD542
00439  P1220-EXIT.                                                      DTSBD542
00440      EXIT.                                                        DTSBD542
00441                                                                   DTSBD542
00442  P1230-WRITE.                                                     DTSBD542
00443      WRITE ETT-REC.                                               DTSBD542
00444      IF ETT-OK-88                                                 DTSBD542
00445         ADD +1    TO WRK-ETT-WRITE-CNT                            DTSBD542
00446      ELSE                                                         DTSBD542
00447         DISPLAY 'CANNOT WRITE ETT FILE ' ETT-STATUS               DTSBD542
00448         SET WRK-ERROR-YES-88 TO TRUE                              DTSBD542
00449      END-IF.                                                      DTSBD542
00450                                                                   DTSBD542
00451  P1230-EXIT.                                                      DTSBD542
00452      EXIT.                                                        DTSBD542
00453                                                                   DTSBD542
00454  P1300-CLEAR-TABLES.                                              DTSBD542
00455      MOVE ZERO               TO TBL1-CNT                          DTSBD542
00456                                 TBL2-CNT.                         DTSBD542
00457                                                                   DTSBD542
00458      PERFORM                                                      DTSBD542
00459        VARYING SUB1 FROM +1 BY +1                                 DTSBD542
00460        UNTIL SUB1 > TBL1-MAX                                      DTSBD542
00461           MOVE ZERO          TO TBL1-EMP-9 (SUB1)                 DTSBD542
00462      END-PERFORM.                                                 DTSBD542
00463                                                                   DTSBD542
00464      PERFORM                                                      DTSBD542
00465        VARYING SUB2 FROM +1 BY +1                                 DTSBD542
00466        UNTIL SUB2 > TBL2-MAX                                      DTSBD542
00467           MOVE ZERO          TO TBL2-EMP-9 (SUB2)                 DTSBD542
00468      END-PERFORM.                                                 DTSBD542
00469                                                                   DTSBD542
00470      MOVE INFILE-SSN         TO WRK-SSN.                          DTSBD542
00471                                                                   DTSBD542
00472  P1300-EXIT.                                                      DTSBD542
00473      EXIT.                                                        DTSBD542
00474                                                                   DTSBD542
00475  T0000-TERMINATE.                                                 DTSBD542
00476                                                                   DTSBD542
00477      DISPLAY ' '.                                                 DTSBD542
00478      DISPLAY ' '.                                                 DTSBD542
00479                                                                   DTSBD542
00480      DISPLAY '*** DTSBD542 TERMINATION STATISTICS ***'.           DTSBD542
00481                                                                   DTSBD542
00482      DISPLAY '  '.                                                DTSBD542
00483      DISPLAY 'INPUT RECORDS READ                        :'        DTSBD542
00484              WRK-INFILE-READ-CNT.                                 DTSBD542
00485                                                                   DTSBD542
00486      DISPLAY 'OUTPUT RECORDS WRITTEN                    :'        DTSBD542
00487              WRK-ETT-WRITE-CNT.                                   DTSBD542
00488                                                                   DTSBD542
00489      CLOSE INFILE                                                 DTSBD542
00490            ETT-FILE                                               DTSBD542
00491            ES202PRM-FILE.                                         DTSBD542
00492                                                                   DTSBD542
00493  T0000-EXIT.                                                      DTSBD542
00494      EXIT.                                                        DTSBD542
00495      EJECT                                                        DTSBD542
00496                                                                   DTSBD542
00497  S999-ABEND.                                                      DTSBD542
00498      DISPLAY '*** DTSBD542 ABENDING : '                           DTSBD542
00499              WRK-ABEND-MSG.                                       DTSBD542
00500                                                                   DTSBD542
00501      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBD542
00502  S999-EXIT.                                                       DTSBD542
00503      EXIT.                                                        DTSBD542
