00001  IDENTIFICATION DIVISION.                                         02/12/19
00002  PROGRAM-ID.    DTSBX629.                                         DTSBX629
00003                                                                      LV015
00004 ******************************************************************DTSBX629
00005 *                                                                *DTSBX629
00006 *    FUNCTION:                                                   *DTSBX629
00007 *                                                                *DTSBX629
00008 *    PROGRAM WILL READ TDEC X144 FILE (DETAIL WAGE RECORDS SENT  *   CL254
00009 *    TO ESSP) AND REPORT ANY WAGES NOT RETURNED THE SAME DAY.        CL254
00010 *    RECORDS NOT RETURNED MAY BE JOB RAN LATE OR TDEC WAGES WAS  *   CL254
00011 *    REJECTED BY ESSP.                                           *   CL254
00012 *    07/07/18                                              ZL1   *   CL254
00013 *                                                                *   CL*53
00014 ******************************************************************DTSBX629
00015                                                                   DTSBX629
00016  ENVIRONMENT    DIVISION.                                         DTSBX629
00017                                                                   DTSBX629
00018  CONFIGURATION  SECTION.                                          DTSBX629
00019                                                                   DTSBX629
00020  SPECIAL-NAMES. C01 IS TOP-OF-PAGE.                               DTSBX629
00021                                                                   DTSBX629
00022  INPUT-OUTPUT   SECTION.                                          DTSBX629
00023                                                                   DTSBX629
00024  FILE-CONTROL.                                                    DTSBX629
00025                                                                   DTSBX629
00026      SELECT X140RPT-IN  ASSIGN TO  DTSFX140.                         CL239
00027      SELECT X144SSN-IN  ASSIGN TO  DTSFI144.                         CL**1
00028      SELECT X144SSN-OUT ASSIGN TO  DTSFO144.                         CL**1
00029 *    SELECT X147SSN-OUTA ASSIGN TO  DTSFA147.                        CL223
00030 *    SELECT X147SSN-OUTB ASSIGN TO  DTSFB147.                        CL223
00031      SELECT REPORT-FILE ASSIGN TO  RPT627R1.                         CL223
00032                                                                   DTSBX629
00033                                                                   DTSBX629
00034  DATA DIVISION.                                                   DTSBX629
00035  FILE SECTION.                                                    DTSBX629
00036                                                                      CL101
00037  FD  X144SSN-IN                                                      CL101
00038      RECORDING MODE IS F.                                            CL101
00039  01  X144-RECORD-IN                        PIC X(512).               CL101
00040                                                                      CL101
00041  FD  X144SSN-OUT                                                     CL**1
00042      RECORDING MODE IS F.                                            CL**1
00043  01  X144-RECORD-OUT                       PIC X(512).               CL**1
00044                                                                      CL**1
00045                                                                      CL138
00046  FD  X140RPT-IN                                                      CL239
00047      RECORDING MODE IS F.                                            CL239
00048  01  X140-RECORD-IN                        PIC X(512).               CL239
00049                                                                      CL138
00050                                                                   DTSBX629
00051 *FD  X147SSN-IN                                                      CL239
00052 *    RECORDING MODE IS F.                                            CL239
00053 *01  X147-RECORD-IN                        PIC X(80).                CL239
00054                                                                      CL*87
00055 *FD  X147SSN-OUTA                                                    CL223
00056 *    RECORDING MODE IS F.                                            CL223
00057 *01  X147-RECORD-OUTA                      PIC X(512).               CL223
00058                                                                      CL*87
00059 *FD  X147SSN-OUTB                                                    CL223
00060 *    RECORDING MODE IS F.                                            CL223
00061 *01  X147-RECORD-OUTB                      PIC X(512).               CL223
00062                                                                      CL123
00063  FD  REPORT-FILE                                                  DTSBX629
00064      RECORDING MODE     IS  F                                     DTSBX629
00065      RECORD    CONTAINS 133 CHARACTERS                            DTSBX629
00066      BLOCK     CONTAINS 0   RECORDS                               DTSBX629
00067      LABEL     RECORDS  ARE OMITTED                               DTSBX629
00068      DATA      RECORD   IS  PRINT-RECORD.                         DTSBX629
00069                                                                   DTSBX629
00070  01  PRINT-RECORD                         PIC X(133).             DTSBX629
00071                                                                   DTSBX629
00072 ******************************************************************DTSBX629
00073 *                    WORKING STORAGE SECTION                     *DTSBX629
00074 ******************************************************************DTSBX629
00075  WORKING-STORAGE SECTION.                                         DTSBX629
000755 77  PAN-VALET PICTURE X(24) VALUE '015DTSBX629  02/12/19'.       DTSBX629
00076                                                                   DTSBX629
00077  01  ENDOFSEG                          PIC  9    VALUE ZEROES.    DTSBX629
00078                                                                   DTSBX629
00079  01  EMPLOYER-FOUND-IND                PIC  X    VALUE SPACE.        CL*87
00080                                                                   DTSBX629
00081  01  MASTER-END-IND                    PIC  X    VALUE SPACE.     DTSBX629
00082      88 MASTER-END                               VALUE 'Y'.       DTSBX629
00083                                                                   DTSBX629
00084                                                                      CL*70
00085  01  MASUIX-END-IND                    PIC  X    VALUE SPACE.        CL*73
00086      88 MASHIS-END                               VALUE 'Y'.          CL*70
00087  01  WRK-AREA.                                                       CL*79
00088       05  WRK-ABEND-CODE              PIC  X(04)  VALUE 'X552'.      CL*91
00089                                                                      CL*70
00090  01  WRK-SEG01-SSN-FOUND           PIC  9(01) VALUE ZEROES.          CL147
00091  01  WS-X144-NOT-RETURNED          PIC  9(05) VALUE ZEROES.          CL243
00092  01  WS-X144-SSN-FOUND             PIC  9(01) VALUE ZEROES.          CL243
00093  01  WS-CLAIM-SSN-FOUND            PIC  9(01) VALUE ZEROES.          CL182
00094  01  WS-X140-RPT-FOUND             PIC  9(01) VALUE ZEROES.          CL138
00095  01  WS-X147-SSN-NOT-DOCS          PIC  9(05) VALUE ZEROES.          CL168
00096  01  WS-X147-SSN-N99-DOCS          PIC  9(05) VALUE ZEROES.          CL211
00097  01  WS-X147-SSN-IN-DOCS           PIC  9(05) VALUE ZEROES.          CL168
00098  01  SSN-HIT-COUNT                 PIC  9(03) VALUE ZEROES.          CL106
00099  01  WS-HOLD-X147-SSN              PIC  9(09) VALUE ZEROES.          CL*91
00100  01  WS-TOTAL-NO-X144-SSN          PIC  9(05) VALUE ZEROES.          CL108
00101  01  WS-TOTAL-YES-X144-SSN          PIC  9(05) VALUE ZEROES.         CL113
00102  01  WS-TOTAL-OTH-X144-SSN          PIC  9(05) VALUE ZEROES.         CL113
00103  01  WS-HOLD-X147-EMP-NO           PIC  9(06) VALUE ZEROES.          CL*91
00104  01  WS-SAV-X147                   PIC  9(01) VALUE ZEROES.          CL129
00105  01  WRK-MODULE-NAME               PIC  X(08) VALUE 'DTSBX551'.      CL138
00106  01  WRK-ABEND-CD                  PIC  X(04) VALUE 'X551'.          CL138
00107  01  WRK-ABEND-MSG                 PIC  X(60).                       CL*62
00108                                                                   DTSBX629
00109  01  WS-HOLD-PAY-DATE.                                            DTSBX629
00110      05  WS-HOLD-PAY-DATE-CEN          PIC  9(02) VALUE ZEROS.    DTSBX629
00111      05  WS-HOLD-PAY-DATE-YY           PIC  9(02) VALUE ZEROES.   DTSBX629
00112      05  WS-HOLD-PAY-DATE-MM           PIC  9(02) VALUE ZEROES.   DTSBX629
00113      05  WS-HOLD-PAY-DATE-DD           PIC  9(02) VALUE ZEROES.   DTSBX629
00114                                                                   DTSBX629
00115  01  WS-X147-SSN                       PIC  9(09) VALUE ZEROS.       CL106
00116  01  WS-X147-EMP-NO                    PIC  9(06) VALUE ZEROS.       CL104
00117  01  WS-X147-QUARTER.                                                CL150
00118      05 WS-X147-YR                     PIC  9(04) VALUE ZEROS.       CL152
00119      05 WS-X147-QTR                    PIC  9(01) VALUE ZEROS.       CL150
00120                                                                      CL*34
00121  01  WS-X140-QUARTER.                                                CL240
00122      05 WS-X140-YR                     PIC  9(04) VALUE ZEROS.       CL240
00123      05 WS-X140-QTR                    PIC  9(01) VALUE ZEROS.       CL240
00124                                                                      CL240
00125  01  W-X140-REPORT-QTR                 PIC 9(5) VALUE ZEROS.         CL**4
00126  01  WS-INPUT-SSN.                                                DTSBX629
00127      05  WS-INPUT-SSN1                 PIC  9(03) VALUE ZEROES.   DTSBX629
00128      05  WS-INPUT-SSN2                 PIC  9(02) VALUE ZEROES.   DTSBX629
00129      05  WS-INPUT-SSN3                 PIC  9(04) VALUE ZEROES.   DTSBX629
00130                                                                   DTSBX629
00131  01  WS-HOLD-BWE                       PIC  9(08) VALUE ZEROES.   DTSBX629
00132                                                                      CL**8
00133  01  W-RPT-ERROR-IND              PIC  X(01) VALUE 'N'.              CL**8
00134          88 W-RPT-ERROR-YES-88            VALUE 'Y'.                 CL**7
00135          88 W-RPT-ERROR-NO-88             VALUE 'N'.                 CL**7
00136                                                                      CL**7
00137                                                                   DTSBX629
00138  01  WS-HOLD-PAYMENT                   PIC  9(05)V99 VALUE ZEROES.DTSBX629
00139                                                                   DTSBX629
00140  01  WS-HOLD-DATE.                                                   CL*25
00141      05  WS-HOLD-DATE-CEN          PIC  9(02) VALUE ZEROS.           CL*26
00142      05  WS-HOLD-DATE-YY           PIC  9(02) VALUE ZEROES.          CL*26
00143      05  WS-HOLD-DATE-MM           PIC  9(02) VALUE ZEROES.          CL*26
00144      05  WS-HOLD-DATE-DD           PIC  9(02) VALUE ZEROES.          CL*26
00145                                                                   DTSBX629
00146  01  WS-WRK-BWE-DATE.                                                CL*51
00147      05  WS-WRK-BWE-CEN          PIC  9(02) VALUE ZERO.              CL*51
00148      05  WS-WRK-BWE-YY           PIC  9(02) VALUE ZERO.              CL*51
00149      05  WS-WRK-BWE-MM           PIC  9(02) VALUE ZERO.              CL*51
00150      05  WS-WRK-BWE-DD           PIC  9(02) VALUE ZERO.              CL*51
00151                                                                      CL*50
00152  01  WS-X147-SSN-NO.                                                 CL106
00153      05 WS-XSSN                  PIC 9(9)   VALUE ZERO.              CL*85
00154      05 FILLER                   PIC 9(1)   VALUE ZERO.              CL*85
00155                                                                      CL*85
00156  01  WS-X147-QTR-ESSP.                                               CL*86
00157      05 WS-X147-EYY              PIC X(4)   VALUE SPACES.            CL*86
00158      05 FILLER                   PIC X(1)   VALUE SPACES.            CL*86
00159      05 WS-X147-EQ               PIC X(1)   VALUE SPACES.            CL*86
00160                                                                      CL*86
00161                                                                      CL*86
00162  01  WS-X147-QTR-DUTAS.                                              CL*86
00163      05 WS-X147-YY               PIC 9(4)   VALUE ZERO.              CL*86
00164      05 WS-X147-Q                PIC 9(1)   VALUE ZERO.              CL*86
00165  01  WS-X147-QTR-DELETE REDEFINES WS-X147-QTR-DUTAS PIC 9(5).        CL*86
00166                                                                      CL*86
00167  01  WS-DOCS-BASE-QTR                PIC 9(5) VALUE ZEROS.           CL192
00168  01  WS-DOCS-BASE-QTRA REDEFINES WS-DOCS-BASE-QTR.                   CL192
00169      05  WS-DOCS-BASE-QTR-Y          PIC 9(4).                       CL192
00170      05  WS-DOCS-BASE-QTR-Q          PIC 9(1).                       CL192
00171  01  WS-DOCS-BASE-QTR1.                                              CL188
00172      05  WS-DOCS-BASE-QTR1-Y          PIC 9(4).                      CL192
00173      05  WS-DOCS-BASE-QTR1-Q          PIC 9(1).                      CL192
00174  01  WS-DOCS-BASE-QTR2.                                              CL188
00175      05  WS-DOCS-BASE-QTR2-Y          PIC 9(4).                      CL192
00176      05  WS-DOCS-BASE-QTR2-Q          PIC 9(1).                      CL192
00177  01  WS-DOCS-BASE-QTR3.                                              CL188
00178      05  WS-DOCS-BASE-QTR3-Y          PIC 9(4).                      CL192
00179      05  WS-DOCS-BASE-QTR3-Q          PIC 9(1).                      CL192
00180                                                                      CL*86
00181  01  WS-COUNTERS.                                                 DTSBX629
00182      05  LINE-COUNT                    PIC  9(03) VALUE 99.       DTSBX629
00183      05  PAGE-COUNT                    PIC  9(03) VALUE ZEROES.   DTSBX629
00184      05  TRANS-READ-COUNT              PIC  9(06) VALUE ZEROES.   DTSBX629
00185      05  MASTER-READ-COUNT             PIC  9(06) VALUE ZEROES.   DTSBX629
00186      05  WS-TOTAL-READ                 PIC  9(05) VALUE ZEROES.      CL*93
00187      05  WS-TOTAL-NDEL                 PIC  9(05) VALUE ZEROES.      CL*93
00188      05  WS-TOTAL-DELQ                 PIC  9(05) VALUE ZEROES.      CL*93
00189                                                                   DTSBX629
00190  01  WS-OUTPUT.                                                   DTSBX629
00191      03  FILLER                        PIC X(03) VALUE SPACES.       CL*20
00192      03  WS-OUT-EMP-NO                 PIC 9(06).                    CL*92
00193      03  FILLER                        PIC X(04) VALUE SPACES.       CL243
00194      03  WS-OUT-NAME                   PIC X(04).                    CL243
00195      03  FILLER                        PIC X(04) VALUE SPACES.       CL243
00196      03  WS-OUT-QUARTER                PIC X(06).                    CL*92
00197      03  FILLER                        PIC X(04) VALUE SPACES.       CL129
00198      03  WS-OUT-DATE                   PIC X(10).                    CL**2
00199      03  FILLER                        PIC X(04) VALUE SPACES.       CL**2
00200      03  WS-OUT-MESSAGE                PIC X(40).                    CL137
00201                                                                      CL*25
00202                                                                      CL*11
00203  01  WS-TOTAL-LINE1.                                                 CL*92
00204      03 FIL              PIC X(2) VALUE SPACES.                      CL249
00205      03 FIL              PIC X(43) VALUE                             CL126
00206         'TOTAL TDEC REPORTS RECEIVED BY ... DUTAS = '.               CL249
00207      03 WS-OUT-READ    PIC ZZZZ9.                                    CL*93
00208      03  FIL             PIC X(50) VALUE SPACES.                     CL126
00209  01  WS-TOTAL-LINE10.                                                CL211
00210      03 FIL              PIC X(2) VALUE SPACES.                      CL249
00211      03 FIL              PIC X(43) VALUE                             CL211
00212         'TOTAL TDEC REPORTS SENT     TO ...  ESSP = '.               CL251
00213      03 WS-OUT-READ1   PIC ZZZZ9.                                    CL248
00214      03  FIL             PIC X(50) VALUE SPACES.                     CL211
00215  01  WS-TOTAL-LINE11.                                                CL126
00216      03 FIL              PIC X(2) VALUE SPACES.                      CL249
00217      03 FIL              PIC X(43) VALUE                             CL126
00218         'TOTAL TDEC REPORTS RETURED  TO ... DUTAS = '.               CL251
00219      03 WS-OUT-NDEL    PIC ZZZZ9.                                    CL248
00220      03  FIL             PIC X(50) VALUE SPACES.                     CL126
00221  01  WS-TOTAL-LINE12.                                                CL165
00222      03 FIL              PIC X(2) VALUE SPACES.                      CL249
00223      03 FIL              PIC X(43) VALUE                             CL165
00224         'TOTAL TDEC REPORTS MISSING FROM ..  ESSP = '.               CL251
00225      03 WS-OUT-DELQ    PIC ZZZZ9.                                    CL248
00226      03  FIL             PIC X(05) VALUE SPACES.                     CL254
00227      03  FIL             PIC X(45) VALUE 'SEE NOTE1'.                CL254
00228  01  WS-TOTAL-LINE2.                                                 CL*92
00229      03 FIL              PIC X(5) VALUE SPACES.                      CL*92
00230      03 FIL              PIC X(43) VALUE                             CL127
00231         'NOTE1: PLEASE CHECK ESSP (TDEC REJECT FILE)'.               CL254
00232 *    03 WS-OUT-NDEL    PIC ZZZZ9.                                    CL248
00233      03  FIL             PIC X(50) VALUE SPACES.                     CL127
00234                                                                   DTSBX629
00235  01  WS-TOTAL-LINE3.                                                 CL*92
00236      03 FIL              PIC X(5) VALUE SPACES.                      CL*92
00237      03 FIL              PIC X(43) VALUE                             CL126
00238         'TOTAL X147  -   SENT TO DOCS 4 DELETION  = '.               CL175
00239 *    03 WS-OUT-DELQ    PIC ZZZZ9.                                    CL248
00240      03  FIL             PIC X(101) VALUE SPACES.                    CL*92
00241                                                                      CL*92
00242                                                                      CL172
00243  01  WS-TOTAL-LINE4.                                                 CL172
00244      03 FIL                    PIC X(5) VALUE SPACES.                CL172
00245      03 FIL                    PIC X(43) VALUE                       CL172
00246         'TOTAL X140/144 NOT FOUND FOR X147        = '.               CL172
00247      03 RP-TOTAL-NO-X144-SSN   PIC ZZZZ9.                            CL172
00248      03  FIL                   PIC X(101) VALUE SPACES.              CL172
00249                                                                      CL220
00250 *01  WS-TOTAL-LINE45.                                                CL243
00251 *    03 FIL              PIC X(5) VALUE SPACES.                      CL243
00252 *    03 FIL              PIC X(43) VALUE                             CL243
00253 *       '****** PLEASE EMAIL CHANGES BY NOON TO STOP'.               CL243
00254 *    03 FIL              PIC X(43) VALUE                             CL243
00255 *       ' UPDATES/DELETION OF WAGES FROM DOCS...    '.               CL243
00256 *    03  FIL             PIC X(040) VALUE SPACES.                    CL243
00257                                                                      CL220
00258                                                                      CL172
00259  01  WS-RUN-DATE.                                                 DTSBX629
00260      03  RUN-YR          PIC 99.                                     CL*54
00261      03  RUN-MO          PIC 99.                                     CL*54
00262      03  RUN-DA          PIC 99.                                     CL*54
00263                                                                   DTSBX629
00264                                                                   DTSBX629
00265  01  Z147-EMP-NO.                                                    CL233
00266       05 WS-EMP-NOA               PIC 9(3) VALUE ZEROS.              CL233
00267       05 WS-EMP-NOB               PIC 9(3) VALUE ZEROS.              CL233
00268                                                                      CL233
00269  01  HEADER1.                                                     DTSBX629
00270      03  FILLER                        PIC  X(05) VALUE SPACES.   DTSBX629
00271      03  FILLER                        PIC  X(31) VALUE           DTSBX629
00272          'DISTRICT OF COLUMBIA GOVERNMENT'.                       DTSBX629
00273      03  FILLER                        PIC  X(05) VALUE SPACES.      CL247
00274      03  REPORTING-DATE.                                             CL247
00275          05  RUN-MO1  PIC 99.                                        CL247
00276          05  FIL      PIC X VALUE '/'.                               CL247
00277          05  RUN-DA1  PIC 99.                                        CL247
00278          05  FIL      PIC X VALUE '/'.                               CL247
00279          05  RUN-CEN  PIC 99.                                        CL247
00280          05  RUN-YR1  PIC 99.                                        CL247
00281 *                                                                 DTSBX629
00282  01  HEADER2.                                                     DTSBX629
00283      03  FILLER                        PIC  X(04) VALUE SPACES.      CL247
00284      03  FILLER                        PIC  X(33) VALUE           DTSBX629
00285          'DEPARTMENT OF EMPLOYMENT SERVICES'.                     DTSBX629
00286      03  FILLER                        PIC  X(30) VALUE SPACES.      CL*99
00287 *    03  FILLER                        PIC  X(10) VALUE              CL249
00288 *        'PAGE NO.  '.                                               CL249
00289 *    03  HD-PAGE                       PIC  9(03).                   CL249
00290      03  FILLER                        PIC  X(07) VALUE SPACES.   DTSBX629
00291                                                                   DTSBX629
00292  01  HEADER3.                                                     DTSBX629
00293      03  FILLER                        PIC  X(02) VALUE SPACES.      CL249
00294      03  FILLER                        PIC  X(50) VALUE              CL220
00295          'MISSING TDEC REPORTS (X140) FROM ESSP'.                    CL250
00296      03  FILLER                        PIC  X(30) VALUE SPACES.      CL201
00297                                                                   DTSBX629
00298  01  COLUMN-HD1.                                                     CL*44
00299      03  FILLER                   PIC X(03) VALUE SPACES.            CL*54
00300      03  FILLER                   PIC X(06) VALUE 'EMP-NO'.          CL*97
00301      03  FILLER                   PIC X(04) VALUE SPACES.            CL243
00302      03  FILLER                   PIC X(04) VALUE 'NAME'.            CL243
00303      03  FILLER                   PIC X(04) VALUE SPACES.            CL243
00304      03  FILLER                   PIC X(06) VALUE 'YR/QTR'.          CL*96
00305      03  FILLER                   PIC X(04) VALUE SPACES.            CL247
00306      03  FILLER         PIC X(35) VALUE 'DATE SENT TO ESSP'.         CL**3
00307                                                                      CL*15
00308  ++INCLUDE WSDATES                                                DTSBX629
00309  01 L001-LINK-AREA.                                                  CL*61
00310  ++INCLUDE DTSIL001                                                  CL*60
00311  01 Z147-REC.                                                        CL228
00312     05 Z147-EMP-NOA               PIC 9(3).                          CL233
00313     05 FILLER                     PIC X(01).                         CL233
00314     05 Z147-EMP-NOB               PIC 9(3).                          CL233
00315     05 FILLER                     PIC X(73).                         CL233
00316  01 Z144-REC.                                                        CL228
00317     05 FILLER                     PIC X(61).                         CL226
00318     05 Z144-EMP-NO                PIC 9(6).                          CL228
00319     05 Z144-EMP-NAME              PIC X(04).                         CL241
00320     05 FILLER                     PIC X(14).                         CL241
00321     05 Z144-QUARTER               PIC 9(5).                          CL235
00322     05 FILLER                     PIC X(400).                        CL**2
00323     05 Z144-DATE-SENT-ESSP        PIC X(10).                         CL**2
00324     05 FILLER                     PIC X(12).                         CL**2
00325                                                                      CL**4
00326  01  MRPT-REC.                                                       CL**4
00327  ++INCLUDE DTSIMRPT                                                  CL**4
00328  01  L910-LINK-AREA.                                                 CL**6
00329  ++INCLUDE DTSIL910                                                  CL**5
00330  01  MSKL-REC.                                                       CL**5
00331  ++INCLUDE DTSIMSKL                                                  CL**5
00332                                                                      CL**4
00333  ++INCLUDE DTSEX147                                                  CL228
00334  01 X140-REC.                                                        CL228
00335  ++INCLUDE DTSEX140                                                  CL228
00336  01 X144-REC.                                                        CL228
00337  ++INCLUDE DTSEX144                                                  CL228
00338  01  COMMON-LINKAGE-SECTION.                                         CL228
00339  ++INCLUDE ESPLINKB                                                  CL228
00340  ++INCLUDE EWGLINKB                                                  CL228
00341 ******************************************************************DTSBX629
00342 *                        PROCEDURE DIVISION                      *DTSBX629
00343 ******************************************************************DTSBX629
00344                                                                   DTSBX629
00345  PROCEDURE DIVISION.                                              DTSBX629
00346                                                                   DTSBX629
00347  MAIN0100-CONTROL.                                                DTSBX629
00348                                                                   DTSBX629
00349                                                                      CL145
00350      OPEN INPUT  X144SSN-IN.                                         CL239
00351      OPEN OUTPUT X144SSN-OUT.                                        CL**1
00352 *    OPEN OUTPUT X147SSN-OUTB                                        CL226
00353      OPEN OUTPUT REPORT-FILE.                                        CL*87
00354  ++INCLUDE CODEDATE                                               DTSBX629
00355      MOVE ZEROS TO WS-RUN-DATE.                                   DTSBX629
00356      MOVE WS-SYSTEM-DATE TO WS-RUN-DATE.                          DTSBX629
00357      MOVE RUN-DA TO RUN-DA1.                                      DTSBX629
00358      MOVE RUN-MO TO RUN-MO1.                                      DTSBX629
00359      MOVE 20 TO RUN-CEN.                                          DTSBX629
00360      MOVE RUN-YR TO RUN-YR1.                                      DTSBX629
00361                                                                   DTSBX629
00362      PERFORM S910-OPEN-READ THRU S910-EXIT.                          CL**4
00363      ADD 1           TO PAGE-COUNT                                   CL*98
00364 *    MOVE PAGE-COUNT TO HD-PAGE                                      CL249
00365      WRITE PRINT-RECORD FROM HEADER1 AFTER ADVANCING                 CL*98
00366      TOP-OF-PAGE                                                     CL*98
00367      WRITE PRINT-RECORD FROM HEADER2 AFTER ADVANCING 1               CL*98
00368      WRITE PRINT-RECORD FROM HEADER3 AFTER ADVANCING 1               CL*98
00369      MOVE SPACES  TO PRINT-RECORD                                    CL*98
00370      WRITE PRINT-RECORD AFTER ADVANCING 1                            CL*98
00371      WRITE PRINT-RECORD FROM COLUMN-HD1 AFTER 1.                     CL132
00372      MOVE ZEROES TO MASTER-READ-COUNT.                            DTSBX629
00373 ******************************************************************   CL*85
00374 *                 BENEFIT FILE PROCESS                           *   CL*85
00375 ******************************************************************   CL*85
00376  PROC1000-GET-UI-DATA.                                               CL*85
00377      DISPLAY ' '.                                                    CL*85
00378 *    DISPLAY '******  START SEARCH FOR MISSING TDEC REPORTS'.        CL241
00379      DISPLAY '### TDEC REPORT(S) NOT RETURNED FROM ESSP: '           CL241
00380      DISPLAY 'EMP NO   NAME   QTR '.                                 CL241
00381      DISPLAY ' '.                                                    CL241
00382                                                                   DTSBX629
00383      PERFORM PROC2000-UI-PROCESS THRU                             DTSBX629
00384              PROC2000-UI-EXIT                                     DTSBX629
00385      UNTIL MASTER-END.                                               CL195
00386                                                                   DTSBX629
00387      DISPLAY '++++++++++++++++++++++++++++++++++++++++++++++'.    DTSBX629
00388      DISPLAY ' '.                                                 DTSBX629
00389      DISPLAY '  PROGRAM DTSBX627 RECORD COUNTS:'.                    CL230
00390      DISPLAY ' '.                                                 DTSBX629
00391      DISPLAY ' '.                                                    CL**2
00392      DISPLAY 'TOTAL X147 RECORDS READ  = '  MASTER-READ-COUNT.       CL113
00393      DISPLAY ' MATCHING X144 RES FOUND = ' WS-TOTAL-YES-X144-SSN.    CL115
00394      DISPLAY 'TOTAL X147 CLAIMS FOUND  = ' WS-TOTAL-NDEL.            CL115
00395      DISPLAY 'TOTAL X147 REC DELETED   = ' WS-TOTAL-DELQ.            CL115
00396      DISPLAY 'TOTAL X147 DUP OR ALL 9  = ' WS-TOTAL-OTH-X144-SSN.    CL114
00397      DISPLAY 'TOTAL X144 REC NOT FOUND = ' WS-TOTAL-NO-X144-SSN.     CL113
00398      DISPLAY ' '.                                                 DTSBX629
00399      DISPLAY ' '.                                                 DTSBX629
00400      DISPLAY '++++++++++++++++++++++++++++++++++++++++++++++'.    DTSBX629
00401      MOVE MASTER-READ-COUNT     TO  WS-OUT-READ WS-OUT-READ1.        CL248
00402      MOVE WS-TOTAL-NDEL         TO  WS-OUT-NDEL.                     CL126
00403      MOVE WS-TOTAL-DELQ         TO  WS-OUT-DELQ.                     CL126
00404 *    MOVE WS-TOTAL-YES-X144-SSN TO  WS-OUT-M144.                     CL167
00405 *    MOVE WS-X147-SSN-IN-DOCS   TO  RP-X147-SSN-IN-DOCS.             CL248
00406 *    MOVE WS-X147-SSN-NOT-DOCS   TO  RP-X147-SSN-NOT-DOCS.           CL248
00407 *    MOVE WS-TOTAL-NO-X144-SSN   TO  RP-TOTAL-NO-X144-SSN            CL248
00408 *    MOVE WS-X147-SSN-N99-DOCS TO  RP-X147-SSN-N99-DOCS.             CL248
00409                                                                      CL*11
00410      WRITE PRINT-RECORD FROM WS-TOTAL-LINE1 AFTER 2.                 CL*93
00411      WRITE PRINT-RECORD FROM WS-TOTAL-LINE10 AFTER 1.                CL211
00412      WRITE PRINT-RECORD FROM WS-TOTAL-LINE11 AFTER 1.                CL211
00413      WRITE PRINT-RECORD FROM WS-TOTAL-LINE12 AFTER 1.                CL169
00414      WRITE PRINT-RECORD FROM WS-TOTAL-LINE2 AFTER 3.                 CL255
00415 *    WRITE PRINT-RECORD FROM WS-TOTAL-LINE3 AFTER 1.                 CL247
00416 *    WRITE PRINT-RECORD FROM WS-TOTAL-LINE4 AFTER 1.                 CL247
00417 *    WRITE PRINT-RECORD FROM WS-TOTAL-LINE45 AFTER 3.                CL246
00418                                                                      CL*11
00419      MOVE ZEROES TO RETURN-CODE.                                  DTSBX629
00420                                                                   DTSBX629
00421      CLOSE X144SSN-IN, REPORT-FILE.                                  CL239
00422 *    CLOSE X147SSN-OUTB.                                             CL225
00423                                                                   DTSBX629
00424      GOBACK.                                                      DTSBX629
00425                                                                   DTSBX629
00426  MAIN0100-CONTROL-EXIT.                                           DTSBX629
00427      EXIT.                                                        DTSBX629
00428                                                                   DTSBX629
00429 ******************************************************************DTSBX629
00430 *                  PROC2000-UI-PROCESS                           *DTSBX629
00431 ******************************************************************DTSBX629
00432                                                                   DTSBX629
00433  PROC2000-UI-PROCESS.                                             DTSBX629
00434                                                                   DTSBX629
00435      PERFORM PROC3000-READ-MASTER-FILE THRU                       DTSBX629
00436              PROC3000-READ-EXIT.                                  DTSBX629
00437                                                                   DTSBX629
00438      IF MASTER-END                                                DTSBX629
00439       GO TO PROC2000-UI-EXIT.                                     DTSBX629
00440                                                                   DTSBX629
00441 *    MOVE Z147-EMP-NOA TO WS-EMP-NOA                                 CL239
00442 *    MOVE Z147-EMP-NOB TO WS-EMP-NOB                                 CL239
00443 *    IF WS-X144-SSN-FOUND = 3                                        CL133
00444 *       ADD 1 TO WS-TOTAL-OTH-X144-SSN                               CL133
00445 *       GO TO PROC2000-UI-EXIT.                                      CL133
00446                                                                      CL116
00447 *    IF X147-SSN = 999999999                                         CL228
00448 *       ADD 1 TO WS-X147-SSN-N99-DOCS                                CL228
00449 *       GO TO PROC2000-UI-EXIT.                                      CL228
00450                                                                      CL116
00451 *    DISPLAY '------'                                                CL230
00452 *    DISPLAY '+++< TDEC X144 REPORTS MISSING : '                     CL230
00453                                                                      CL195
00454      MOVE 0 TO WS-X144-SSN-FOUND.                                    CL101
00455      MOVE 0 TO WS-X140-RPT-FOUND.                                    CL138
00456 *    OPEN INPUT X144SSN-IN.                                          CL239
00457      OPEN INPUT X140RPT-IN.                                          CL239
00458                                                                      CL161
00459      PERFORM PROC2250-X140-RPT  THRU PROC2250-EXIT.                  CL239
00460                                                                      CL161
00461      IF WS-X140-RPT-FOUND = 0                                        CL*11
00462 *    DISPLAY ' RPT NOT  FOUND= ' WS-X140-RPT-FOUND                   CL*15
00463      PERFORM PROC2275-MPRF-RPT  THRU PROC2275-EXIT.                  CL**4
00464 *    CLOSE X144SSN-IN.                                               CL239
00465      CLOSE X140RPT-IN.                                               CL239
00466                                                                      CL102
00467      IF WS-X140-RPT-FOUND > 0                                        CL**2
00468       ADD  1 TO WS-TOTAL-NDEL                                        CL**2
00469      GO TO PROC2000-UI-EXIT.                                         CL**2
00470                                                                      CL**2
00471       ADD  1 TO WS-TOTAL-DELQ                                        CL249
00472       MOVE Z144-EMP-NO   TO WS-OUT-EMP-NO                            CL243
00473       MOVE Z144-EMP-NAME TO WS-OUT-NAME                              CL243
00474       MOVE Z144-QUARTER  TO WS-OUT-QUARTER                           CL243
00475                                                                      CL**2
00476       IF Z144-DATE-SENT-ESSP > SPACES                                CL**2
00477       MOVE Z144-DATE-SENT-ESSP TO WS-OUT-DATE                        CL**2
00478       ELSE                                                           CL**2
00479       MOVE REPORTING-DATE TO Z144-DATE-SENT-ESSP                     CL**2
00480       MOVE Z144-DATE-SENT-ESSP TO WS-OUT-DATE.                       CL**2
00481                                                                      CL**2
00482      WRITE PRINT-RECORD FROM WS-OUTPUT                               CL247
00483      WRITE X144-RECORD-OUT  FROM Z144-REC                            CL**1
00484                                                                      CL239
00485      GO TO PROC2000-UI-EXIT.                                         CL223
00486                                                                      CL223
00487 *    IF WS-X144-SSN-FOUND = 1                                        CL217
00488 *       ADD 1 TO WS-TOTAL-YES-X144-SSN                               CL217
00489 *       DISPLAY '>+ X144 FOUND FOR X147- DELETE ' X147-SSN           CL217
00490 *       PERFORM PROC2500-DEL-SSN THRU PROC2500-EXIT                  CL187
00491 *    ELSE                                                            CL217
00492 *    IF WS-X144-SSN-FOUND = 0                                        CL217
00493 *       ADD 1 TO WS-TOTAL-NO-X144-SSN                                CL217
00494 *       PERFORM PROC2500-DEL-SSN THRU PROC2500-EXIT                  CL187
00495 *       DISPLAY ' X140/144 NOT FOUND FOR X147 -VERIFY  ' X147-SSN    CL217
00496 *    ELSE                                                            CL217
00497 *    IF WS-X144-SSN-FOUND = 1                                        CL217
00498 *       ADD 1 TO WS-TOTAL-YES-X144-SSN                               CL217
00499 *       PERFORM PROC2500-DEL-SSN THRU PROC2500-EXIT                  CL187
00500 *       DISPLAY 'X144  FOUND FOR X147 -VER: ' X147-SSN               CL217
00501 *    ELSE                                                            CL217
00502 *       ADD 1 TO WS-TOTAL-NO-X144-SSN                                CL217
00503 *       DISPLAY 'X140 OR X144  NOTFOUND FOR X147 -VER: ' X147-SSN.   CL217
00504 *                                                                    CL217
00505 *                                                                    CL195
00506 **** SEARCH DOCS FOR ANY CLAIM ON ESSP SSN MARKED FOR DELETION.      CL195
00507 **** IF CLAIM IS FOUND DO NOT DELETE SSN-- SEND REPORT.              CL195
00508 *                                                                    CL195
00509      MOVE 0 TO WS-CLAIM-SSN-FOUND.                                   CL182
00510                                                                      CL194
00511      PERFORM PROC2700-FIND-CLAIM THRU PROC2700-EXIT.                 CL181
00512                                                                      CL133
00513      IF WS-CLAIM-SSN-FOUND = 1                                       CL214
00514        IF WS-X144-SSN-FOUND = 1                                      CL214
00515         PERFORM PROC2500-DEL-SSN THRU PROC2500-EXIT                  CL205
00516         DISPLAY ' >> CLAIM FOUND WITH X144: REPLACE WAGES '          CL205
00517         ' ' X147-SSN ' ' X147-EMP-NO ' ' X147-QUARTER                CL201
00518        ELSE                                                          CL214
00519         DISPLAY ' >> CLAIM FOUND NO X144: CANNOT DELETE'             CL205
00520         ' ' X147-SSN ' ' X147-EMP-NO ' ' X147-QUARTER                CL216
00521         PERFORM PROC2600-SAV-SSN THRU PROC2600-EXIT                  CL207
00522         ADD 1 TO WS-TOTAL-NDEL                                       CL205
00523      ELSE                                                            CL205
00524      IF WS-CLAIM-SSN-FOUND = 0                                       CL214
00525        IF WS-X144-SSN-FOUND = 1                                      CL214
00526         DISPLAY '++ CLAIM NOT FOUND REPLACE WAGES ' X147-EMP-NO      CL205
00527         PERFORM PROC2500-DEL-SSN THRU PROC2500-EXIT                  CL205
00528        ELSE                                                          CL214
00529         DISPLAY '++ CLAIM NOT FOUND DELETE WAGES ' X147-EMP-NO       CL205
00530         PERFORM PROC2550-DEL-SSN THRU PROC2550-EXIT                  CL215
00531      ELSE                                                            CL214
00532         DISPLAY '++ CHECK IF STATEMENT ========= ' X147-EMP-NO.      CL215
00533                                                                      CL201
00534      GO TO PROC2000-UI-EXIT.                                         CL201
00535                                                                      CL182
00536      IF X147-SSN = WS-HOLD-X147-SSN AND                              CL199
00537         X147-EMP-NO = WS-HOLD-X147-EMP-NO AND                        CL199
00538         EMPLOYER-FOUND-IND = 'Y'                                     CL199
00539         DISPLAY ' >> CLAIM FOUND ----: CANNOT DELETE '               CL199
00540         ' ' X147-SSN ' ' X147-EMP-NO ' ' X147-QUARTER                CL199
00541         PERFORM PROC5000-X147-NOT-DELETED THRU PROC5000-EXIT         CL199
00542         ADD 1 TO WS-TOTAL-NDEL                                       CL199
00543         GO TO PROC2000-UI-EXIT.                                      CL199
00544                                                                      CL*91
00545      MOVE 0 TO ENDOFSEG.                                             CL199
00546      MOVE 'N' TO EMPLOYER-FOUND-IND.                                 CL199
00547                                                                      CL119
00548 *    PERFORM SERV2000-MASTER THRU                                    CL201
00549 *            SERV2000-EXIT.                                          CL201
00550                                                                      CL119
00551                                                                      CL119
00552      PERFORM PROC4000-SEARCH-SEG04 THRU                              CL199
00553              PROC4000-SEG04-EXIT                                     CL199
00554      UNTIL                                                           CL199
00555           ENDOFSEG EQUAL 1.                                          CL199
00556                                                                   DTSBX629
00557      IF EMPLOYER-FOUND-IND = 'Y'                                     CL199
00558       PERFORM PROC5000-X147-NOT-DELETED THRU PROC5000-EXIT           CL199
00559       DISPLAY '>>> CLAIM FOUND --- CANNOT DELETE '                   CL199
00560       ' ' X147-SSN ' ' X147-EMP-NO ' ' X147-QUARTER                  CL199
00561         ADD 1 TO WS-TOTAL-NDEL                                       CL199
00562      ELSE                                                            CL*87
00563         DISPLAY ' << EMP NOT FOUND ON DOCS -DELETE ' X147-EMP-NO     CL195
00564         PERFORM PROC2500-DEL-SSN THRU PROC2500-EXIT.                 CL*87
00565                                                                      CL*87
00566  PROC2000-UI-EXIT.                                                DTSBX629
00567      EXIT.                                                        DTSBX629
00568                                                                      CL146
00569  PROC2100-FIND-SSN.                                                  CL146
00570 *    SET DBW-SEQUENTIAL-PROCESSING TO TRUE.                          CL146
00571      SET DBW-RANDOM-PROCESSING     TO TRUE.                          CL146
00572      SET DBW-READ-SEGMENT          TO TRUE.                          CL146
00573      SET DBW-PROFILE-SEGMENT       TO TRUE.                          CL146
00574                                                                      CL146
00575      MOVE +0  TO WRK-SEG01-SSN-FOUND                                 CL146
00576      MOVE X147-SSN TO DBW-SSN                                        CL146
00577      MOVE SPACES TO DBW-NAME                                         CL146
00578                                                                      CL146
00579      PERFORM S960-SEG01      THRU S960-EXIT.                         CL146
00580                                                                      CL146
00581      IF DBW-NO-RECORD-FOUND                                          CL146
00582         DISPLAY '## SSN- NOT FOUND IN DOCS SEG01: ' X147-SSN         CL194
00583         GO TO PROC2100-EXIT                                          CL146
00584      ELSE                                                            CL146
00585 *       ADD +1  TO WRK-SEG01-READ-CNT                                CL149
00586      DISPLAY '++SSN FOUND ON DOCS SEG01: ' X147-SSN ' ' WGP-SSN.     CL194
00587 *&                                                                   CL146
00588                                                                      CL146
00589      SET DBW-RANDOM-PROCESSING     TO TRUE.                          CL146
00590      SET DBW-WAGE-SEGMENT          TO TRUE.                          CL146
00591      SET DBW-RESET-POINTERS        TO TRUE.                          CL146
00592      PERFORM S961-SEG02            THRU S961-EXIT.                   CL146
00593                                                                      CL146
00594      PERFORM P2150-SELECT-SSN THRU P2150-EXIT                        CL146
00595          UNTIL DBW-NO-RECORD-FOUND.                                  CL146
00596                                                                      CL146
00597                                                                      CL146
00598                                                                   DTSBX629
00599  PROC2100-EXIT.                                                      CL146
00600      EXIT.                                                           CL146
00601  P2150-SELECT-SSN.                                                   CL148
00602      SET DBW-READ-SEGMENT          TO TRUE.                          CL146
00603      PERFORM S961-SEG02       THRU S961-EXIT.                        CL146
00604                                                                      CL146
00605      IF DBW-NO-RECORD-FOUND                                          CL146
00606          GO TO P2150-EXIT.                                           CL148
00607                                                                      CL146
00608 *    ADD +1  TO WRK-SEG02-READ-CNT.                                  CL148
00609      MOVE  X147-YR  TO WS-X147-YR                                    CL151
00610      MOVE  X147-QTR TO WS-X147-QTR                                   CL151
00611                                                                      CL151
00612 *    DISPLAY 'DOCS SSN ' WGP-SSN '  ' WGD-YR-QTR                     CL194
00613 *          '  ' WGD-ACCOUNT-NUMBER '  ' WGD-QUARTER-EARNINGS.        CL194
00614 *    DISPLAY 'ESSP SSN ' X147-SSN '  ' WS-X147-QUARTER               CL194
00615 *          '  ' X147-EMP-NO.                                         CL194
00616                                                                      CL146
00617      IF WGD-YR-QTR = WS-X147-QUARTER AND                             CL150
00618         WGD-ACCOUNT-NUMBER = X147-EMP-NO                             CL148
00619         SET DBW-NO-RECORD-FOUND TO TRUE                              CL153
00620 *       PERFORM P1220-BUILD-W4     THRU P1220-EXIT                   CL146
00621         MOVE +1  TO WRK-SEG01-SSN-FOUND                              CL146
00622         DISPLAY '++SSN FOUND IN DOCS SEG02: ' X147-SSN               CL217
00623 *       PERFORM P1210-EDIT-SSN       THRU P1210-EXIT                 CL146
00624 *       IF WRK-SSN-ERROR-NO-88                                       CL146
00625 *          GO TO P1200-EXIT                                          CL146
00626 *         PERFORM P1220-BUILD-WGH    THRU P1220-EXIT                 CL146
00627 *       END-IF                                                       CL146
00628      END-IF.                                                         CL146
00629                                                                      CL146
00630                                                                      CL146
00631  P2150-EXIT.                                                         CL148
00632      EXIT.                                                           CL146
00633                                                                      CL194
00634  PROC2200-X144-SSN.                                                  CL101
00635                                                                      CL138
00636      READ X144SSN-IN INTO Z144-REC                                   CL239
00637       AT END                                                         CL138
00638 *       MOVE 0 TO WS-X144-SSN-FOUND                                  CL218
00639         DISPLAY '### X144 AT END ' Z144-EMP-NO                       CL228
00640         GO TO PROC2200-EXIT.                                         CL138
00641                                                                      CL138
00642      MOVE 0                   TO WS-SAV-X147.                        CL138
00643                                                                      CL159
00644 *    IF X144-SSN = 999999999                                         CL228
00645 *       MOVE 2 TO WS-X144-SSN-FOUND                                  CL228
00646 *       GO TO PROC2200-EXIT.                                         CL228
00647                                                                      CL159
00648 *    DISPLAY '### X144 '                                             CL174
00649 *        X144-EMP-NO ' ' X144-QUARTER ' ' X144-SSN.                  CL174
00650 *    DISPLAY '### X147 '                                             CL174
00651 *        X147-EMP-NO ' ' X147-QUARTER ' ' X147-SSN.                  CL174
00652                                                                      CL163
00653 *    IF X144-SSN = X147-SSN                                          CL174
00654 *    DISPLAY '### MATCHING X144 SSN '                                CL174
00655                                                                      CL163
00656 *    DISPLAY '### X144 EMP: '                                        CL238
00657 *       ' ' Z144-EMP-NO ' ' Z144-QUARTER.                            CL238
00658 *    DISPLAY '### X147 EMP: '                                        CL238
00659 *       ' ' Z147-EMP-NO ' '.                                         CL238
00660                                                                      CL138
00661      IF Z144-EMP-NO = Z147-EMP-NO AND Z144-QUARTER = 20181           CL237
00662         MOVE 1 TO WS-X144-SSN-FOUND                                  CL138
00663         DISPLAY '### MISSING TDEC RPT FOUND: '                       CL228
00664                 ' ' Z144-EMP-NO ' ' Z144-QUARTER                     CL235
00665         GO TO PROC2200-EXIT.                                         CL138
00666                                                                      CL138
00667      IF Z144-EMP-NO > Z147-EMP-NO                                    CL228
00668         MOVE 0 TO WS-X144-SSN-FOUND                                  CL138
00669         GO TO PROC2200-EXIT.                                         CL138
00670                                                                      CL138
00671      IF Z144-EMP-NO < Z147-EMP-NO                                    CL228
00672         GO TO PROC2200-X144-SSN.                                     CL138
00673                                                                      CL138
00674 *    IF X144-QUARTER > X147-QUARTER                                  CL226
00675 *       MOVE 0 TO WS-X144-SSN-FOUND                                  CL226
00676 *       GO TO PROC2200-EXIT.                                         CL226
00677                                                                      CL157
00678 *    IF X144-QUARTER < X147-QUARTER                                  CL226
00679 *       GO TO PROC2200-X144-SSN.                                     CL226
00680                                                                      CL138
00681                                                                      CL138
00682 *    IF X144-SSN > X147-SSN                                          CL226
00683 *       MOVE 0 TO WS-X144-SSN-FOUND                                  CL226
00684 *       GO TO PROC2200-EXIT.                                         CL226
00685                                                                      CL138
00686 *    IF X144-SSN < X147-SSN                                          CL226
00687 *       GO TO PROC2200-X144-SSN.                                     CL226
00688                                                                      CL138
00689 *    DISPLAY '### MATCHING X147 SSN FOUND '                          CL119
00690 *       ' ' X147-EMP-NO ' ' X147-QUARTER ' ' X147-SSN.               CL119
00691  PROC2200-EXIT.                                                      CL101
00692      EXIT.                                                           CL101
00693                                                                      CL101
00694  PROC2250-X140-RPT.                                                  CL138
00695                                                                      CL138
00696       MOVE 0 TO WS-X140-RPT-FOUND                                    CL239
00697      READ X140RPT-IN INTO X140-REC                                   CL239
00698       AT END                                                         CL239
00699       MOVE 0 TO WS-X140-RPT-FOUND                                    CL239
00700       GO TO PROC2250-EXIT.                                           CL194
00701                                                                      CL138
00702      MOVE 0                   TO WS-SAV-X147.                        CL138
00703                                                                      CL194
00704      MOVE X140-QUARTER-YY TO WS-X140-YR                              CL240
00705      MOVE X140-QUARTER-Q  TO WS-X140-QTR                             CL240
00706                                                                      CL240
00707 *    DISPLAY '### TDEC ' Z144-EMP-NO ' ' Z144-QUARTER.               CL*14
00708 *    DISPLAY '### ESSP ' X140-EMP-NO ' ' WS-X140-QUARTER.            CL*14
00709 *       'X144 ' X144-EMP-NO ' ' X144-QUARTER ' ' X144-SSN.           CL138
00710                                                                      CL138
00711      MOVE WS-X140-QUARTER TO W-X140-REPORT-QTR.                      CL**4
00712      MOVE W-X140-REPORT-QTR TO MRPT-YRQ.                             CL**4
00713      IF X140-EMP-NO = Z144-EMP-NO                                    CL239
00714         AND WS-X140-QUARTER = Z144-QUARTER                           CL240
00715         MOVE 1 TO WS-X140-RPT-FOUND                                  CL138
00716 *    DISPLAY 'P2250; RPT FOUND= ' WS-X140-RPT-FOUND                  CL*14
00717         GO TO PROC2250-EXIT.                                         CL138
00718                                                                      CL138
00719      IF X140-EMP-NO > Z144-EMP-NO                                    CL253
00720         MOVE 0 TO WS-X140-RPT-FOUND                                  CL138
00721         GO TO PROC2250-EXIT.                                         CL138
00722                                                                      CL138
00723      IF X140-EMP-NO < Z144-EMP-NO                                    CL253
00724         GO TO PROC2250-X140-RPT.                                     CL143
00725                                                                      CL138
00726      IF WS-X140-QUARTER > Z144-QUARTER                               CL253
00727         MOVE 0 TO WS-X140-RPT-FOUND                                  CL138
00728         GO TO PROC2250-EXIT.                                         CL142
00729                                                                      CL138
00730      IF WS-X140-QUARTER < Z144-QUARTER                               CL253
00731         GO TO PROC2250-X140-RPT.                                     CL143
00732                                                                      CL138
00733  PROC2250-EXIT.                                                      CL138
00734      EXIT.                                                           CL138
00735  PROC2275-MPRF-RPT.                                                  CL**4
00736                                                                      CL**4
00737      MOVE 0 TO WS-X140-RPT-FOUND                                     CL**4
00738      MOVE LOW-VALUES  TO MRPT-KEY-AREA.                              CL**4
00739 *    MOVE X140-EMP-NO TO MRPT-EMP-NO.                                CL*15
00740 *    MOVE W-X140-REPORT-QTR TO MRPT-YRQ.                             CL*15
00741      MOVE Z144-EMP-NO TO MRPT-EMP-NO.                                CL*15
00742      MOVE Z144-QUARTER TO MRPT-YRQ.                                  CL*15
00743      MOVE ZEROS       TO MRPT-BATCH-NO.                              CL**4
00744      MOVE ZEROS       TO MRPT-ITEM-NO                                CL**4
00745                                                                      CL**4
00746      SET MRPT-RPT-88  TO TRUE.                                       CL**4
00747      MOVE MRPT-REC TO MSKL-REC.                                      CL**4
00748                                                                      CL**4
00749      PERFORM S910-START-BROWSE THRU S910-EXIT.                       CL**4
00750      IF L910-OK-88                                                   CL**4
00751         PERFORM P2016-SCAN-MRPT THRU P2016-EXIT                      CL**4
00752            UNTIL L910-NO-REC-88                                      CL**4
00753      ELSE                                                            CL**4
00754        SET W-RPT-ERROR-NO-88 TO TRUE                                 CL**4
00755      MOVE 0 TO WS-X140-RPT-FOUND                                     CL*15
00756        DISPLAY 'X629 RPT NOT ON DUTAS- '                             CL*15
00757          X140-EMP-NO ' ' W-X140-REPORT-QTR                           CL**7
00758        DISPLAY ' '                                                   CL**4
00759        DISPLAY ' '.                                                  CL**4
00760                                                                      CL**4
00761                                                                      CL**4
00762  PROC2275-EXIT.                                                      CL**4
00763      EXIT.                                                           CL**4
00764                                                                      CL**4
00765  P2016-SCAN-MRPT.                                                    CL**4
00766      MOVE MSKL-REC TO MRPT-REC.                                      CL**4
00767      IF MRPT-YRQ = Z144-QUARTER                                      CL*15
00768         MOVE 1 TO WS-X140-RPT-FOUND                                  CL**4
00769         SET W-RPT-ERROR-NO-88 TO TRUE                                CL**4
00770        SET L910-NO-REC-88  TO TRUE                                   CL**4
00771        GO TO P2016-EXIT                                              CL**4
00772      ELSE                                                            CL**4
00773         IF MRPT-YRQ > Z144-QUARTER                                   CL*15
00774            SET W-RPT-ERROR-NO-88 TO TRUE                             CL**4
00775            SET L910-NO-REC-88  TO TRUE                               CL**4
00776            GO TO P2016-EXIT                                          CL**4
00777         ELSE                                                         CL**4
00778            GO TO P2016-READ-NEXT                                     CL**4
00779         END-IF                                                       CL**4
00780      END-IF.                                                         CL**4
00781                                                                      CL**4
00782 *    IF MRPT-ORIG-88                                                 CL**4
00783 *      SET W-RPT-ERROR-YES-88 TO TRUE                                CL**4
00784 *      SET L910-NO-REC-88  TO TRUE                                   CL**4
00785 *       MOVE SPACES                  TO R140-MESSAGE                 CL**4
00786 *       MOVE W-EMP-NO                TO R140-EMP-NO                  CL**4
00787 *       STRING                                                       CL**4
00788 *          ':-----FAILED - RPT EXIST IN DUTAS '                      CL**4
00789 *             X140-QUARTER                                           CL**4
00790 *           DELIMITED BY SIZE                                        CL**4
00791 *           INTO R140-MESSAGE                                        CL**4
00792 *       END-STRING                                                   CL**4
00793 *           MOVE R140-MESSAGE TO X434-MESSAGE                        CL**4
00794 *       PERFORM S946-WRITE-R140      THRU S946-EXIT                  CL**4
00795 *      GO TO P2016-EXIT                                              CL**4
00796 *    END-IF.                                                         CL**4
00797                                                                      CL**4
00798                                                                      CL**4
00799  P2016-READ-NEXT.                                                    CL**4
00800      PERFORM S910-READ-NEXT THRU S910-EXIT.                          CL**4
00801      IF L910-NO-REC-88                                               CL**4
00802        SET W-RPT-ERROR-NO-88 TO TRUE.                                CL**4
00803  P2016-EXIT.                                                         CL**4
00804                                                                      CL**4
00805                                                                      CL**4
00806                                                                      CL138
00807                                                                      CL**4
00808  PROC2500-DEL-SSN.                                                   CL*87
00809                                                                      CL*87
00810 *    WRITE X147-RECORD-OUTA FROM X144-REC.                           CL125
00811 *    WRITE X147-RECORD-OUTA FROM X147-REC.                           CL229
00812      ADD 1 TO WS-TOTAL-DELQ.                                         CL113
00813                                                                      CL129
00814      IF WS-SAV-X147 = 1                                              CL129
00815         GO TO PROC2500-EXIT.                                         CL129
00816                                                                      CL129
00817      MOVE X147-SSN            TO WS-INPUT-SSN.                       CL126
00818 *    MOVE WS-INPUT-SSN1       TO WS-OUT-SSN1.                        CL244
00819 *    MOVE WS-INPUT-SSN2       TO WS-OUT-SSN2                         CL244
00820 *    MOVE WS-INPUT-SSN3       TO WS-OUT-SSN3.                        CL244
00821 *    MOVE DB-SEQ-9            TO WS-OUT-SEQ.                         CL244
00822                                                                      CL126
00823 *    MOVE X147-EMP-NO         TO WS-OUT-EMP-NO                       CL244
00824 *    MOVE X147-QUARTER        TO WS-OUT-QUARTER.                     CL244
00825 *    MOVE X147-FNAME          TO WS-OUT-FNAME.                       CL244
00826 *    MOVE X147-LNAME          TO WS-OUT-LNAME.                       CL244
00827 *    MOVE X147-WAGES          TO WS-OUT-WAGES.                       CL244
00828 *    IF WS-X144-SSN-FOUND = 1                                        CL244
00829 *    MOVE 'Y '                TO WS-OUT-X144                         CL244
00830 *    ELSE                                                            CL244
00831 *    MOVE 'N '                TO WS-OUT-X144.                        CL244
00832 *    IF WS-X140-RPT-FOUND = 1                                        CL244
00833 *    MOVE 'Y '                TO WS-OUT-X140                         CL244
00834 *    ELSE                                                            CL244
00835 *    MOVE 'N '                TO WS-OUT-X140.                        CL244
00836      IF WS-CLAIM-SSN-FOUND = 1                                       CL205
00837      MOVE '++CLAIM FOUND WAGES REPLACED' TO WS-OUT-MESSAGE           CL205
00838      ELSE                                                            CL205
00839      MOVE '++NO CLAIM -- WAGES REPLACED' TO WS-OUT-MESSAGE.          CL205
00840                                                                      CL126
00841      ADD 1  TO LINE-COUNT.                                           CL206
00842      WRITE PRINT-RECORD FROM WS-OUTPUT.                              CL206
00843  PROC2500-EXIT.                                                      CL*87
00844      EXIT.                                                           CL*87
00845                                                                      CL*87
00846                                                                      CL201
00847  PROC2550-DEL-SSN.                                                   CL201
00848                                                                      CL201
00849 *    WRITE X147-RECORD-OUTA FROM X144-REC.                           CL201
00850 *    WRITE X147-RECORD-OUTA FROM X147-REC.                           CL229
00851      ADD 1 TO WS-TOTAL-DELQ.                                         CL201
00852                                                                      CL201
00853      IF WS-SAV-X147 = 1                                              CL201
00854         GO TO PROC2500-EXIT.                                         CL201
00855                                                                      CL201
00856      MOVE X147-SSN            TO WS-INPUT-SSN.                       CL201
00857 *    MOVE WS-INPUT-SSN1       TO WS-OUT-SSN1.                        CL245
00858 *    MOVE WS-INPUT-SSN2       TO WS-OUT-SSN2                         CL245
00859 *    MOVE WS-INPUT-SSN3       TO WS-OUT-SSN3.                        CL245
00860 *    MOVE DB-SEQ-9            TO WS-OUT-SEQ.                         CL245
00861                                                                      CL201
00862 *    MOVE X147-EMP-NO         TO WS-OUT-EMP-NO                       CL245
00863 *    MOVE X147-QUARTER        TO WS-OUT-QUARTER.                     CL245
00864 *    MOVE X147-FNAME          TO WS-OUT-FNAME.                       CL245
00865 *    MOVE X147-LNAME          TO WS-OUT-LNAME.                       CL245
00866 *    MOVE X147-WAGES          TO WS-OUT-WAGES.                       CL245
00867 *    IF WS-X144-SSN-FOUND = 1                                        CL245
00868 *    MOVE 'Y '                TO WS-OUT-X144                         CL245
00869 *    ELSE                                                            CL245
00870 *    MOVE 'N '                TO WS-OUT-X144.                        CL245
00871 *    IF WS-X140-RPT-FOUND = 1                                        CL245
00872 *    MOVE 'Y '                TO WS-OUT-X140                         CL245
00873 *    ELSE                                                            CL245
00874 *    MOVE 'N '                TO WS-OUT-X140.                        CL245
00875 *    MOVE 'WAGES ---DELETED ' TO WS-OUT-MESSAGE.                     CL245
00876                                                                      CL201
00877      ADD 1  TO LINE-COUNT.                                           CL210
00878      WRITE PRINT-RECORD FROM WS-OUTPUT.                              CL210
00879  PROC2550-EXIT.                                                      CL201
00880      EXIT.                                                           CL201
00881                                                                      CL201
00882                                                                      CL123
00883  PROC2600-SAV-SSN.                                                   CL123
00884                                                                      CL123
00885      MOVE 0                   TO WS-SAV-X147.                        CL129
00886 *    WRITE X147-RECORD-OUTB FROM X147-REC.                           CL229
00887      MOVE X147-SSN            TO WS-INPUT-SSN.                       CL126
00888 *    MOVE WS-INPUT-SSN1       TO WS-OUT-SSN1.                        CL245
00889 *    MOVE WS-INPUT-SSN2       TO WS-OUT-SSN2                         CL245
00890 *    MOVE WS-INPUT-SSN3       TO WS-OUT-SSN3.                        CL245
00891 *    MOVE CPD-SSN-SEQ         TO WS-OUT-SEQ.                         CL245
00892                                                                      CL126
00893 *    MOVE X147-EMP-NO         TO WS-OUT-EMP-NO                       CL245
00894 *    MOVE X147-QUARTER        TO WS-OUT-QUARTER.                     CL245
00895 *    MOVE X147-FNAME          TO WS-OUT-FNAME.                       CL245
00896 *    MOVE X147-LNAME          TO WS-OUT-LNAME.                       CL245
00897 *    MOVE X147-WAGES          TO WS-OUT-WAGES.                       CL245
00898 *    IF WS-X144-SSN-FOUND = 1                                        CL245
00899 *    MOVE 'Y '                TO WS-OUT-X144                         CL245
00900 *    ELSE                                                            CL245
00901 *    MOVE 'N '                TO WS-OUT-X144.                        CL245
00902 *    IF WS-X140-RPT-FOUND = 1                                        CL245
00903 *    MOVE 'Y '                TO WS-OUT-X140                         CL245
00904 *    ELSE                                                            CL245
00905 *    MOVE 'N '                TO WS-OUT-X140.                        CL245
00906 *     IF WRK-SEG01-SSN-FOUND = 0                                     CL245
00907 *        MOVE '++ X147 NOT FOUND IN DOCS -ESSP VERIFY'               CL245
00908 *             TO WS-OUT-MESSAGE                                      CL245
00909 *    ELSE                                                            CL245
00910 *        MOVE '++ CLAIM FOUND NO WAGES CANNOT DELETE '               CL245
00911 *             TO WS-OUT-MESSAGE.                                     CL245
00912 *        MOVE 1                   TO WS-SAV-X147.                    CL245
00913 *        ADD 1  TO LINE-COUNT.                                       CL245
00914      WRITE PRINT-RECORD FROM WS-OUTPUT.                              CL126
00915  PROC2600-EXIT.                                                      CL123
00916      EXIT.                                                           CL123
00917                                                                      CL123
00918  PROC2700-FIND-CLAIM.                                                CL179
00919      MOVE X147-SSN       TO WS-XSSN                                  CL179
00920      MOVE WS-X147-SSN-NO TO DB-SSN.                                  CL179
00921      MOVE ZERO TO DB-SEQ-9.                                          CL179
00922                                                                      CL179
00923      MOVE ZEROS    TO WS-HOLD-X147-SSN                               CL181
00924      SET DB-RANDOM-PROCESSING     TO TRUE.                           CL180
00925      SET DB-READ-SEGMENT          TO TRUE.                           CL180
00926      SET DB-CLAIMANT-PROFILE      TO TRUE.                           CL181
00927      SET DB-RESET-POINTERS        TO TRUE.                           CL184
00928      MOVE 'R'    TO DB-PROCESSING-MODE.                              CL179
00929      MOVE 'SG01' TO DB-SEGNAME.                                      CL179
00930                                                                      CL179
00931      PERFORM SERV1000-MASTER THRU                                    CL179
00932              SERV1000-EXIT.                                          CL179
00933                                                                      CL179
00934      IF DB-END-OF-FILE                                               CL194
00935         DISPLAY '++ESSN NOT FOUND ON DOCS - DELETE ' X147-SSN        CL195
00936 *       PERFORM PROC2500-DEL-SSN THRU PROC2500-EXIT                  CL194
00937       GO TO PROC2700-EXIT.                                           CL194
00938                                                                      CL179
00939      IF DB-NO-RECORD-FOUND                                           CL186
00940         DISPLAY '++DSSN NOT FOUND ON DOCS - DELETE ' X147-SSN        CL195
00941 *       PERFORM PROC2500-DEL-SSN THRU PROC2500-EXIT                  CL187
00942       GO TO PROC2700-EXIT.                                           CL179
00943                                                                      CL181
00944      PERFORM UNTIL DB-NO-RECORD-FOUND OR CPD-SSN > X147-SSN          CL186
00945 *    PERFORM UNTIL NOT DB-SUCCESSFUL-COMPLETION                      CL185
00946 *       ADD +1     TO WRK-SEG01-READ-CNT                             CL183
00947         PERFORM P2750-PROCESS-CLAIM  THRU P2750-EXIT                 CL181
00948         SET DB-SEQUENTIAL-PROCESSING    TO TRUE                      CL181
00949         SET DB-CLAIMANT-PROFILE         TO TRUE                      CL181
00950         SET DB-READ-SEGMENT             TO TRUE                      CL181
00951         CALL 'ESP960D' USING COMMON-LINKAGE-SECTION                  CL181
00952      END-PERFORM.                                                    CL181
00953                                                                      CL181
00954                                                                      CL181
00955  PROC2700-EXIT.                                                      CL181
00956      EXIT.                                                           CL181
00957                                                                      CL179
00958  P2750-PROCESS-CLAIM.                                                CL181
00959       IF CPD-ALTERNATE-BASE-YES                                      CL179
00960          MOVE CPD-ALT-BASE-PERIOD-QTR TO WS-DOCS-BASE-QTR            CL179
00961       ELSE                                                           CL179
00962          MOVE CPD-BASE-PERIOD-QTR-CODE TO WS-DOCS-BASE-QTR.          CL179
00963                                                                      CL179
00964       IF  WS-DOCS-BASE-QTR-Q = 1                                     CL188
00965       MOVE WS-DOCS-BASE-QTR         TO WS-DOCS-BASE-QTR1             CL188
00966       ADD +1                        TO WS-DOCS-BASE-QTR1-Q           CL189
00967       MOVE WS-DOCS-BASE-QTR         TO WS-DOCS-BASE-QTR2             CL188
00968       ADD +2                        TO WS-DOCS-BASE-QTR2-Q           CL189
00969       MOVE WS-DOCS-BASE-QTR         TO WS-DOCS-BASE-QTR3             CL188
00970       ADD +3                        TO WS-DOCS-BASE-QTR3-Q           CL189
00971       ELSE                                                           CL188
00972       IF  WS-DOCS-BASE-QTR-Q = 2                                     CL188
00973       MOVE WS-DOCS-BASE-QTR         TO WS-DOCS-BASE-QTR1             CL188
00974       ADD +1                        TO WS-DOCS-BASE-QTR1-Q           CL189
00975       MOVE WS-DOCS-BASE-QTR         TO WS-DOCS-BASE-QTR2             CL188
00976       ADD +2                        TO WS-DOCS-BASE-QTR2-Q           CL189
00977       ADD +1                        TO WS-DOCS-BASE-QTR-Y            CL188
00978       MOVE +1                       TO WS-DOCS-BASE-QTR-Q            CL188
00979       MOVE WS-DOCS-BASE-QTR         TO WS-DOCS-BASE-QTR3             CL188
00980       ELSE                                                           CL188
00981       IF  WS-DOCS-BASE-QTR-Q = 3                                     CL188
00982       MOVE WS-DOCS-BASE-QTR         TO WS-DOCS-BASE-QTR1             CL188
00983       ADD +1                        TO WS-DOCS-BASE-QTR1-Q           CL189
00984       ADD +1                        TO WS-DOCS-BASE-QTR-Y            CL188
00985       MOVE +1                       TO WS-DOCS-BASE-QTR-Q            CL188
00986       MOVE WS-DOCS-BASE-QTR         TO WS-DOCS-BASE-QTR2             CL188
00987       ADD  +1                       TO WS-DOCS-BASE-QTR-Q            CL188
00988       MOVE WS-DOCS-BASE-QTR         TO WS-DOCS-BASE-QTR3             CL188
00989       ELSE                                                           CL188
00990       IF  WS-DOCS-BASE-QTR-Q = 4                                     CL188
00991       ADD +1                        TO WS-DOCS-BASE-QTR-Y            CL188
00992       MOVE +1                       TO WS-DOCS-BASE-QTR-Q            CL188
00993       MOVE WS-DOCS-BASE-QTR         TO WS-DOCS-BASE-QTR1             CL188
00994       ADD  +1                       TO WS-DOCS-BASE-QTR-Q            CL188
00995       MOVE WS-DOCS-BASE-QTR         TO WS-DOCS-BASE-QTR2             CL188
00996       ADD  +1                       TO WS-DOCS-BASE-QTR-Q            CL188
00997       MOVE WS-DOCS-BASE-QTR         TO WS-DOCS-BASE-QTR3.            CL188
00998                                                                      CL188
00999      MOVE X147-QUARTER     TO WS-X147-QTR-ESSP.                      CL179
01000      MOVE WS-X147-EYY      TO WS-X147-YY                             CL179
01001      MOVE WS-X147-EQ       TO WS-X147-Q                              CL179
01002                                                                      CL179
01003       IF CPD-ALTERNATE-BASE-YES                                      CL193
01004          MOVE CPD-ALT-BASE-PERIOD-QTR TO WS-DOCS-BASE-QTR            CL193
01005       ELSE                                                           CL193
01006          MOVE CPD-BASE-PERIOD-QTR-CODE TO WS-DOCS-BASE-QTR.          CL193
01007                                                                      CL194
01008       DISPLAY ' DOCS BASE QTR: ' WS-DOCS-BASE-QTR.                   CL193
01009       DISPLAY ' CPD  BASE QTR: ' CPD-BASE-PERIOD-QTR-CODE            CL193
01010       DISPLAY ' CPD  ALTB QTR: ' CPD-ALT-BASE-PERIOD-QTR.            CL193
01011                                                                      CL193
01012       DISPLAY '*ESSP: ' X147-SSN ' ' WS-X147-QTR-DELETE              CL194
01013       DISPLAY 'DOCSB: ' CPD-SSN ' ' WS-DOCS-BASE-QTR                 CL184
01014       DISPLAY 'DOCS1: ' CPD-SSN ' ' WS-DOCS-BASE-QTR1                CL186
01015       DISPLAY 'DOCS2: ' CPD-SSN ' ' WS-DOCS-BASE-QTR2                CL186
01016       DISPLAY 'DOCS3: ' CPD-SSN ' ' WS-DOCS-BASE-QTR3.               CL186
01017                                                                      CL179
01018       IF WS-X147-QTR-DELETE = WS-DOCS-BASE-QTR  OR                   CL179
01019          WS-X147-QTR-DELETE = WS-DOCS-BASE-QTR1 OR                   CL179
01020          WS-X147-QTR-DELETE = WS-DOCS-BASE-QTR2 OR                   CL179
01021          WS-X147-QTR-DELETE = WS-DOCS-BASE-QTR3                      CL179
01022          MOVE X147-SSN TO WS-HOLD-X147-SSN                           CL179
01023          SET DB-NO-RECORD-FOUND TO TRUE                              CL185
01024          MOVE 1 TO WS-CLAIM-SSN-FOUND                                CL186
01025          DISPLAY '## SSN FOUND ON DOCS - BASE CLAIM ' X147-SSN.      CL195
01026                                                                      CL179
01027                                                                      CL179
01028  P2750-EXIT.                                                         CL181
01029      EXIT.                                                           CL179
01030 ******************************************************************DTSBX629
01031 *                   PROC3000-READ-MASTER-FILE                    *DTSBX629
01032 ******************************************************************DTSBX629
01033                                                                   DTSBX629
01034  PROC3000-READ-MASTER-FILE.                                       DTSBX629
01035                                                                   DTSBX629
01036      MOVE 0 TO WS-X144-SSN-FOUND.                                    CL116
01037      MOVE 0 TO WS-X140-RPT-FOUND.                                    CL138
01038                                                                      CL116
01039      READ X144SSN-IN INTO Z144-REC                                   CL239
01040       AT END                                                      DTSBX629
01041         MOVE 'Y' TO MASTER-END-IND                                   CL*63
01042         GO TO PROC3000-READ-EXIT.                                 DTSBX629
01043                                                                   DTSBX629
01044 *    IF  X147-EMP-NO = WS-X147-EMP-NO                                CL227
01045 *       AND X147-QUARTER = WS-X147-QUARTER                           CL227
01046 *       MOVE 3 TO WS-X144-SSN-FOUND                                  CL227
01047 *     ELSE                                                           CL227
01048 *       MOVE  X147-SSN     TO WS-X147-SSN                            CL227
01049 *       MOVE  X147-EMP-NO  TO WS-X147-EMP-NO                         CL227
01050 *       MOVE  X147-QUARTER TO WS-X147-QUARTER.                       CL227
01051      ADD 1 TO MASTER-READ-COUNT.                                  DTSBX629
01052                                                                   DTSBX629
01053  PROC3000-READ-EXIT.                                              DTSBX629
01054      EXIT.                                                        DTSBX629
01055                                                                   DTSBX629
01056                                                                   DTSBX629
01057 ******************************************************************DTSBX629
01058 *                   PROC4000-SEARCH-SEG04                        *   CL*87
01059 ******************************************************************DTSBX629
01060                                                                   DTSBX629
01061  PROC4000-SEARCH-SEG04.                                              CL*87
01062                                                                   DTSBX629
01063      SET DB-RANDOM-PROCESSING     TO TRUE.                           CL195
01064 *    SET DB-READ-SEGMENT          TO TRUE.                           CL199
01065      SET DB-BASE-PERIOD-EMP       TO TRUE.                           CL195
01066      SET DB-RESET-POINTERS        TO TRUE.                           CL195
01067 *    MOVE X147-EMP-NO             TO BPE-EMPLOYER-ACCT               CL199
01068      MOVE 'SG04' TO DB-SEGNAME.                                      CL*87
01069                                                                   DTSBX629
01070      CALL 'ESP960D' USING COMMON-LINKAGE-SECTION.                    CL195
01071                                                                      CL195
01072 *    PERFORM SERV1000-MASTER THRU                                    CL195
01073 *            SERV1000-EXIT.                                          CL195
01074                                                                   DTSBX629
01075      DISPLAY 'BPE EMP NO: ' BPE-EMPLOYER-ACCT                        CL197
01076 *    IF DB-NO-RECORD-FOUND OR DB-END-OF-FILE                         CL200
01077 *       DISPLAY '#1 EMP NOT FOUND ON DOCS CLAIM: ' X147-EMP-NO       CL200
01078 *       MOVE 1 TO ENDOFSEG                                           CL200
01079 *       GO TO PROC4000-SEG04-EXIT.                                   CL200
01080                                                                      CL195
01081      PERFORM UNTIL DB-NO-RECORD-FOUND OR                             CL199
01082                 DB-END-OF-FILE                                       CL199
01083         SET DB-RANDOM-PROCESSING        TO TRUE                      CL201
01084 *       SET DB-SEQUENTIAL-PROCESSING    TO TRUE                      CL201
01085         SET DB-BASE-PERIOD-EMP          TO TRUE                      CL195
01086         SET DB-READ-SEGMENT             TO TRUE                      CL195
01087                                                                      CL195
01088         CALL 'ESP960D' USING COMMON-LINKAGE-SECTION                  CL195
01089                                                                      CL197
01090 *      DISPLAY 'BPE EMP NO: ' BPE-EMPLOYER-ACCT                      CL199
01091         IF DB-SUCCESSFUL-COMPLETION AND                              CL197
01092            BPE-EMPLOYER-ACCT = X147-EMP-NO                           CL197
01093         DISPLAY '## BPEEMP FOUND ON DOCS CLAIM: ' X147-EMP-NO        CL199
01094         MOVE 1 TO ENDOFSEG                                           CL197
01095         MOVE X147-EMP-NO TO WS-HOLD-X147-EMP-NO                      CL197
01096         MOVE 'Y' TO EMPLOYER-FOUND-IND                               CL198
01097         SET DB-END-OF-FILE     TO TRUE                               CL197
01098         SET DB-NO-RECORD-FOUND TO TRUE                               CL197
01099         ELSE                                                         CL195
01100            IF NOT DB-NO-RECORD-FOUND OR                              CL197
01101                   DB-END-OF-FILE                                     CL199
01102 *             BPE-EMPLOYER-ACCT > X147-EMP-NO                        CL199
01103         DISPLAY '#2 EMP NOT FOUND ON DOCS CLAIM: ' X147-EMP-NO       CL200
01104               SET DB-END-OF-FILE     TO TRUE                         CL197
01105               SET DB-NO-RECORD-FOUND TO TRUE                         CL197
01106            END-IF                                                    CL195
01107         END-IF                                                       CL195
01108                                                                      CL195
01109      END-PERFORM.                                                    CL195
01110                                                                   DTSBX629
01111 *    IF BPE-EMPLOYER-ACCT = X147-EMP-NO                              CL197
01112 *       MOVE 1 TO ENDOFSEG                                           CL197
01113 *       MOVE X147-EMP-NO TO WS-HOLD-X147-EMP-NO                      CL197
01114 *       MOVE 'Y' TO EMPLOYER-FOUND-IND.                              CL197
01115                                                                      CL*25
01116  PROC4000-SEG04-EXIT.                                                CL*87
01117      EXIT.                                                        DTSBX629
01118                                                                   DTSBX629
01119 ******************************************************************DTSBX629
01120 *                   PROC5000-WRITE-RECORD-PAID                   *DTSBX629
01121 ******************************************************************DTSBX629
01122                                                                   DTSBX629
01123                                                                   DTSBX629
01124  PROC5000-X147-NOT-DELETED.                                          CL*94
01125      MOVE X147-SSN            TO WS-INPUT-SSN.                       CL*92
01126 *    MOVE WS-INPUT-SSN1       TO WS-OUT-SSN1.                        CL245
01127 *    MOVE WS-INPUT-SSN2       TO WS-OUT-SSN2                         CL245
01128 *    MOVE WS-INPUT-SSN3       TO WS-OUT-SSN3.                        CL245
01129 *    MOVE DB-SEQ-9            TO WS-OUT-SEQ.                         CL245
01130 *                                                                    CL245
01131 *    MOVE X147-EMP-NO         TO WS-OUT-EMP-NO                       CL245
01132 *    MOVE X147-QUARTER        TO WS-OUT-QUARTER.                     CL245
01133 *    MOVE X147-FNAME          TO WS-OUT-FNAME.                       CL245
01134 *    MOVE X147-LNAME          TO WS-OUT-LNAME.                       CL245
01135 *    MOVE X147-WAGES          TO WS-OUT-WAGES.                       CL245
01136 *    MOVE 'Y '                TO WS-OUT-X144.                        CL245
01137 *    MOVE '++ CLAIM FOUND ON DOCS - VERIFY'     TO WS-OUT-MESSAGE.   CL245
01138                                                                   DTSBX629
01139 *    IF LINE-COUNT GREATER 55                                        CL*74
01140 *       MOVE ZEROES     TO LINE-COUNT                                CL*74
01141         ADD 1 TO LINE-COUNT.                                         CL126
01142         WRITE PRINT-RECORD FROM WS-OUTPUT.                           CL*92
01143  PROC5000-EXIT.                                                      CL*94
01144      EXIT.                                                        DTSBX629
01145                                                                   DTSBX629
01146                                                                      CL*69
01147  S910-OPEN-READ.                                                     CL**4
01148      SET L910-OPEN-READ-88 TO TRUE.                                  CL**4
01149      GO TO S910-MSTR-IO.                                             CL**4
01150                                                                      CL**4
01151  S910-READ.                                                          CL**4
01152      SET L910-READ-88 TO TRUE.                                       CL**4
01153      GO TO S910-MSTR-IO.                                             CL**4
01154                                                                      CL**4
01155  S910-START-BROWSE.                                                  CL**4
01156      SET L910-START-BROWSE-88 TO TRUE.                               CL**4
01157      GO TO S910-MSTR-IO.                                             CL**4
01158                                                                      CL**4
01159  S910-READ-NEXT.                                                     CL**4
01160      SET L910-READ-NEXT-88 TO TRUE.                                  CL**4
01161      GO TO S910-MSTR-IO.                                             CL**4
01162                                                                      CL**4
01163  S910-CLOSE.                                                         CL**4
01164      SET L910-CLOSE-88     TO TRUE.                                  CL**4
01165      GO TO S910-MSTR-IO.                                             CL**4
01166                                                                      CL**4
01167  S910-MSTR-IO.                                                       CL**4
01168      CALL 'DTSBU910' USING L910-LINK-AREA                            CL**4
01169                            MSKL-REC.                                 CL**4
01170  S910-EXIT.                                                          CL**4
01171      EXIT.                                                           CL**4
01172                                                                      CL**4
01173  S001-FROM-CAL-6.                                                    CL**4
01174      SET L001-FROM-CAL-6 TO TRUE.                                    CL*55
01175      GO TO S001-DATE-CONVERT.                                        CL*55
01176                                                                      CL*55
01177  S001-FROM-ABS-DAY.                                                  CL*55
01178      SET L001-FROM-ABS-DAY TO TRUE.                                  CL*55
01179      GO TO S001-DATE-CONVERT.                                        CL*55
01180                                                                      CL*55
01181  S001-DATE-CONVERT.                                                  CL*55
01182      CALL 'DTSBU001' USING L001-LINK-AREA.                           CL*55
01183  S001-EXIT.                                                          CL*55
01184       EXIT.                                                          CL*55
01185       SKIP3                                                          CL*55
01186  S999-ABEND.                                                         CL*55
01187       DISPLAY '***  '                                                CL*55
01188               WRK-MODULE-NAME                                        CL*55
01189               ' IS ABENDING: '                                       CL*55
01190               WRK-ABEND-MSG.                                         CL*55
01191                                                                      CL*55
01192       CALL 'DTSBU999' USING WRK-ABEND-CD.                            CL*55
01193  S999-EXIT.                                                          CL*55
01194       EXIT.                                                          CL*55
01195 ******************************************************************DTSBX629
01196 *                       READ FILES                               *DTSBX629
01197 ******************************************************************DTSBX629
01198                                                                      CL145
01199  S960-SEG01.                                                         CL145
01200          CALL 'EWG960D'  USING VSAM-WAGEDATA-CONTROL-BLOCK           CL145
01201                                 WGP-SEGMENT-ONE.                     CL145
01202  S960-EXIT.                                                          CL145
01203      EXIT.                                                           CL145
01204  S961-SEG02.                                                         CL145
01205          CALL 'EWG960D'  USING VSAM-WAGEDATA-CONTROL-BLOCK           CL145
01206                                 WGD-SEGMENT-TWO.                     CL145
01207  S961-EXIT.                                                          CL145
01208      EXIT.                                                           CL145
01209                                                                   DTSBX629
01210 ******************************************************************DTSBX629
01211 *                    SERVICE ROUTINES                            *DTSBX629
01212 ******************************************************************DTSBX629
01213                                                                   DTSBX629
01214  SERV1000-MASTER.                                                 DTSBX629
01215                                                                   DTSBX629
01216      MOVE 'R' TO DB-COMMAND-CODE.                                 DTSBX629
01217                                                                   DTSBX629
01218      MOVE 'DTSBX551' TO DB-PROGRAM-NAME.                             CL195
01219                                                                   DTSBX629
01220      CALL 'ESP960D' USING COMMON-LINKAGE-SECTION.                 DTSBX629
01221                                                                   DTSBX629
01222  SERV1000-EXIT.                                                   DTSBX629
01223      EXIT.                                                        DTSBX629
01224                                                                      CL119
01225  SERV2000-MASTER.                                                    CL119
01226                                                                      CL119
01227      MOVE 'S' TO DB-COMMAND-CODE.                                    CL119
01228                                                                      CL119
01229      MOVE 'DTSBX551' TO DB-PROGRAM-NAME.                             CL195
01230                                                                      CL119
01231      CALL 'ESP960D' USING COMMON-LINKAGE-SECTION.                    CL119
01232                                                                      CL119
01233  SERV2000-EXIT.                                                      CL119
01234      EXIT.                                                           CL119
01235  S9999-ABEND.                                                        CL*78
01236       SKIP1                                                          CL*78
01237       CALL 'DTSBU999' USING WRK-ABEND-CODE.                          CL*78
01238       SKIP1                                                          CL*78
01239  S9999-EXIT.                                                         CL*78
01240       EXIT.                                                          CL*78
