00001  IDENTIFICATION DIVISION.                                         12/11/13
00002  PROGRAM-ID.             DTSBD145.                                DTSBD145
00003  AUTHOR.                 NGC.                                        LV001
00004  DATE-WRITTEN.           JULY 2013.                               DTSBD145
00005  DATE-COMPILED.                                                   DTSBD145
00006      SKIP3                                                        DTSBD145
00007 *****                                                             DTSBD145
00008 *                                                                 DTSBD145
00009 *    FUNCTION:  PRE-UPDTE ACCOUNTING TRANSACTION COLLECTION       DTSBD145
00010 *               FILE SCAN.                                        DTSBD145
00011 *                                                                 DTSBD145
00012 *    MODIFICATION LOG:                                            DTSBD145
00013 *                                                                 DTSBD145
00014 *    07/08/2013  INITIAL DEVELOPMENT.                             DTSBD145
00015 *                WORK ORDER: TICKET 1915        PROGRAMMER: GD    DTSBD145
00016 *                                                                 DTSBD145
00017 *                                                                 DTSBD145
00018 *  DESCRIPTION:                                                   DTSBD145
00019 *                                                                 DTSBD145
00020 *                                                                 DTSBD145
00021 *****                                                             DTSBD145
00022      SKIP3                                                        DTSBD145
00023  ENVIRONMENT DIVISION.                                            DTSBD145
00024  INPUT-OUTPUT SECTION.                                            DTSBD145
00025  FILE-CONTROL.                                                    DTSBD145
00026      SELECT NOT-LIABLE-FILE         ASSIGN TO DTSF145             DTSBD145
00027           FILE STATUS IS F145-STATUS.                             DTSBD145
00028                                                                   DTSBD145
00029  DATA DIVISION.                                                   DTSBD145
00030      SKIP3                                                        DTSBD145
00031  FILE SECTION.                                                    DTSBD145
00032                                                                   DTSBD145
00033  FD  NOT-LIABLE-FILE                                              DTSBD145
00034      RECORDING MODE IS F                                          DTSBD145
00035      LABEL RECORDS ARE STANDARD                                   DTSBD145
00036      BLOCK CONTAINS 0 CHARACTERS.                                 DTSBD145
00037      SKIP1                                                        DTSBD145
00038  01  NOT-LIABLE-REC                  PIC X(64).                   DTSBD145
00039                                                                   DTSBD145
00040  WORKING-STORAGE SECTION.                                         DTSBD145
000405 77  PAN-VALET PICTURE X(24) VALUE '001DTSBD145  12/11/13'.       DTSBD145
00041  77  PAN-VALET PICTURE X(24) VALUE '041DTSBD145  10/10/13'.       DTSBD145
00042  77  PAN-VALET PICTURE X(24) VALUE '016DTSBD150  03/04/11'.       DTSBD145
00043      SKIP3                                                        DTSBD145
00044  01  WRK-AREA.                                                    DTSBD145
00045      05  W-ABEND-CD                  PIC S9(04)  COMP  VALUE +145.DTSBD145
00046                                                                   DTSBD145
00047      05  W-MODULE-ID                 PIC  X(08)  VALUE 'DTSBD145'.DTSBD145
00048                                                                   DTSBD145
00049      05  F145-STATUS                 PIC  X(02).                  DTSBD145
00050          88  F145-STATUS-OK-88         VALUE '00'.                DTSBD145
00051                                                                   DTSBD145
00052      05  W-BATCH-NO                  PIC S9(05)       COMP-3      DTSBD145
00053                                        VALUE +0.                  DTSBD145
00054                                                                   DTSBD145
00055      05  W-ERROR-IND                 PIC  X(01).                  DTSBD145
00056          88  W-ERROR-YES-88            VALUE 'Y'.                 DTSBD145
00057          88  W-ERROR-NO-88             VALUE 'N'.                 DTSBD145
00058                                                                   DTSBD145
00059      05  W-START-FOUND-IND           PIC  X(01).                  DTSBD145
00060          88  W-START-FOUND-YES-88      VALUE 'Y'.                 DTSBD145
00061          88  W-START-FOUND-NO-88       VALUE 'N'.                 DTSBD145
00062                                                                   DTSBD145
00063      05  W-REWRITE-IND               PIC  X(01).                  DTSBD145
00064          88  W-REWRITE-YES-88          VALUE 'Y'.                 DTSBD145
00065          88  W-REWRITE-NO-88           VALUE 'N'.                 DTSBD145
00066                                                                   DTSBD145
00067      05  WRK-MNTE-MSG-LINE1.                                      DTSBD145
00068          10  FILLER                  PIC X(53)  VALUE             DTSBD145
00069          'REPORT TRANSACTION WAS DELETED DUE TO ZERO WAGES OR '.  DTSBD145
00070      05  WRK-MNTE-MSG-LINE2.                                      DTSBD145
00071          10  FILLER                  PIC  X(41)  VALUE            DTSBD145
00072          'EMPLOYER WAS FOUND NOT LIABLE.           '.             DTSBD145
00073      05  WRK-MNTE-MSG-LINE3.                                      DTSBD145
00074          10  FILLER                  PIC  X(46)  VALUE            DTSBD145
00075          '                                              '.        DTSBD145
00076                                                                   DTSBD145
00077      05  W-HOLD-HDR-REC              PIC  X(128).                 DTSBD145
00078      05  FILLER REDEFINES W-HOLD-HDR-REC.                         DTSBD145
00079          10  W-HOLD-BATCH-NO         PIC S9(05)       COMP-3.     DTSBD145
00080          10  FILLER                  PIC  X(125).                 DTSBD145
00081                                                                   DTSBD145
00082      05  W-NL-REC.                                                DTSBD145
00083          10  W-NL-BATCH              PIC 9(05).                   DTSBD145
00084          10  FILLER                  PIC X(01) VALUE ';'.         DTSBD145
00085          10  W-NL-ITEM               PIC 9(03).                   DTSBD145
00086          10  FILLER                  PIC X(01) VALUE ';'.         DTSBD145
00087          10  W-NL-EMP                PIC 9(06).                   DTSBD145
00088          10  FILLER                  PIC X(01) VALUE ';'.         DTSBD145
00089          10  W-NL-QTR                PIC X(06).                   DTSBD145
00090          10  FILLER                  PIC X(01) VALUE ';'.         DTSBD145
00091          10  W-NL-TYPE               PIC X(40).                   DTSBD145
00092                                                                   DTSBD145
00093      05  WRK-T003-CNT                PIC S9(05)       COMP-3      DTSBD145
00094                                        VALUE +0.                  DTSBD145
00095      05  W-TRAN-DELETE-CNT           PIC S9(05)       COMP-3      DTSBD145
00096                                        VALUE +0.                  DTSBD145
00097      05  W-HDR-UPDATE-CNT            PIC S9(05)       COMP-3      DTSBD145
00098                                        VALUE +0.                  DTSBD145
00099                                                                   DTSBD145
00100  01  TSKL-REC.                                                    DTSBD145
00101  ++INCLUDE DTSITSKL                                               DTSBD145
00102                                                                   DTSBD145
00103  01  T003-REC.                                                    DTSBD145
00104  ++INCLUDE DTSIT003                                               DTSBD145
00105                                                                   DTSBD145
00106  01  MNTE-REC.                                                    DTSBD145
00107  ++INCLUDE DTSIMNTE                                               DTSBD145
00108                                                                   DTSBD145
00109  01  L927-LINK-AREA.                                              DTSBD145
00110  ++INCLUDE DTSIL927                                               DTSBD145
00111                                                                   DTSBD145
00112  01  L001-LINK-AREA.                                              DTSBD145
00113  ++INCLUDE DTSIL001                                               DTSBD145
00114                                                                   DTSBD145
00115  01  L003-LINK-AREA.                                              DTSBD145
00116  ++INCLUDE DTSIL003                                               DTSBD145
00117                                                                   DTSBD145
00118  01  L004-LINK-AREA.                                              DTSBD145
00119  ++INCLUDE DTSIL004                                               DTSBD145
00120                                                                   DTSBD145
00121  01  L005-LINK-AREA.                                              DTSBD145
00122  ++INCLUDE DTSIL005                                               DTSBD145
00123                                                                   DTSBD145
00124  01  L516-LINK-AREA.                                              DTSBD145
00125  ++INCLUDE DTSIL516                                               DTSBD145
00126                                                                   DTSBD145
00127  01  L910-LINK-AREA.                                              DTSBD145
00128  ++INCLUDE DTSIL910                                               DTSBD145
00129                                                                   DTSBD145
00130  01  MSKL-REC.                                                    DTSBD145
00131  ++INCLUDE DTSIMSKL                                               DTSBD145
00132                                                                   DTSBD145
00133  01  MPRF-REC.                                                    DTSBD145
00134  ++INCLUDE DTSIMPRF                                               DTSBD145
00135                                                                   DTSBD145
00136  01  MSOL-REC.                                                    DTSBD145
00137  ++INCLUDE DTSIMSOL                                               DTSBD145
00138                                                                   DTSBD145
00139  01  L923-LINK-AREA.                                              DTSBD145
00140  ++INCLUDE DTSIL923                                               DTSBD145
00141      SKIP3                                                        DTSBD145
00142  01  ASKL-REC.                                                    DTSBD145
00143  ++INCLUDE DTSIASKL                                               DTSBD145
00144      SKIP3                                                        DTSBD145
00145  01  AHDR-REC.                                                    DTSBD145
00146  ++INCLUDE DTSIAHDR                                               DTSBD145
00147      SKIP3                                                        DTSBD145
00148  01  ARPT-REC.                                                    DTSBD145
00149  ++INCLUDE DTSIARPT                                               DTSBD145
00150      SKIP3                                                        DTSBD145
00151  01  AATX-REC.                                                    DTSBD145
00152  ++INCLUDE DTSIAATX                                               DTSBD145
00153      SKIP3                                                        DTSBD145
00154  01  APAY-REC.                                                    DTSBD145
00155  ++INCLUDE DTSIAPAY                                               DTSBD145
00156      SKIP3                                                        DTSBD145
00157  01  AADJ-REC.                                                    DTSBD145
00158  ++INCLUDE DTSIAADJ                                               DTSBD145
00159                                                                   DTSBD145
00160  01  L931-LINK-AREA.                                              DTSBD145
00161  ++INCLUDE DTSIL931                                               DTSBD145
00162                                                                   DTSBD145
00163  01  FSKL-REC.                                                    DTSBD145
00164  ++INCLUDE DTSIFSKL                                               DTSBD145
00165                                                                   DTSBD145
00166  01  R907-REC.                                                    DTSBD145
00167  ++INCLUDE DTSIR907                                               DTSBD145
00168                                                                   DTSBD145
00169  PROCEDURE DIVISION.                                              DTSBD145
00170                                                                   DTSBD145
00171      PERFORM I0000-INITIATE              THRU I0000-EXIT.         DTSBD145
00172                                                                   DTSBD145
00173      IF W-ERROR-NO-88                                             DTSBD145
00174         PERFORM P0000-PROCESS            THRU P0000-EXIT          DTSBD145
00175         PERFORM T0000-TERMINATE          THRU T0000-EXIT          DTSBD145
00176      END-IF.                                                      DTSBD145
00177                                                                   DTSBD145
00178      GOBACK.                                                      DTSBD145
00179                                                                   DTSBD145
00180  I0000-INITIATE.                                                  DTSBD145
00181      SET W-ERROR-NO-88                   TO TRUE.                 DTSBD145
00182      PERFORM I2000-OPEN-FILES            THRU I2000-EXIT.         DTSBD145
00183                                                                   DTSBD145
00184      PERFORM S005-FROM-SYS               THRU S005-EXIT.          DTSBD145
00185                                                                   DTSBD145
00186      MOVE LENGTH OF T003-REC     TO T003-LENGTH.                  DTSBD145
00187      MOVE '003'                  TO T003-REC-TYPE.                DTSBD145
00188      MOVE 'SYSTEM'               TO T003-ORIGIN.                  DTSBD145
00189      MOVE L005-DATE              TO T003-SYS-DATE.                DTSBD145
00190      MOVE L005-TIME              TO T003-SYS-TIME.                DTSBD145
00191      SET T003-ADD-MNTE-88        TO TRUE.                         DTSBD145
00192                                                                   DTSBD145
00193                                                                   DTSBD145
00194      PERFORM I3000-START-BATCH           THRU I3000-EXIT.         DTSBD145
00195                                                                   DTSBD145
00196  I0000-EXIT.                                                      DTSBD145
00197      EXIT.                                                        DTSBD145
00198                                                                   DTSBD145
00199  I2000-OPEN-FILES.                                                DTSBD145
00200      OPEN OUTPUT NOT-LIABLE-FILE.                                 DTSBD145
00201      IF NOT F145-STATUS-OK-88                                     DTSBD145
00202         DISPLAY 'CANNOT OPEN NOT LIABLE FILE '                    DTSBD145
00203            F145-STATUS                                            DTSBD145
00204         SET W-ERROR-YES-88               TO TRUE                  DTSBD145
00205         GO TO I2000-EXIT                                          DTSBD145
00206      END-IF.                                                      DTSBD145
00207                                                                   DTSBD145
00208      PERFORM S910-OPEN-READ              THRU S910-EXIT.          DTSBD145
00209      PERFORM S927-OPEN-UPDATE            THRU S927-EXIT.          DTSBD145
00210      PERFORM S923-OPEN-UPDATE            THRU S923-EXIT.          DTSBD145
00211 *&   PERFORM S923-OPEN-READ              THRU S923-EXIT.          DTSBD145
00212      PERFORM S931-OPEN-READ              THRU S931-EXIT.          DTSBD145
00213                                                                   DTSBD145
00214  I2000-EXIT.                                                      DTSBD145
00215      EXIT.                                                        DTSBD145
00216                                                                   DTSBD145
00217 **************************************************************    DTSBD145
00218 * SCAN THE ATC FILE UNTIL FINDING THE FIRST BATCH ESTABLISHED     DTSBD145
00219 * AFTER W-START-DATE.                                             DTSBD145
00220 **************************************************************    DTSBD145
00221  I3000-START-BATCH.                                               DTSBD145
00222      SET W-START-FOUND-NO-88             TO TRUE.                 DTSBD145
00223                                                                   DTSBD145
00224      MOVE +0                             TO AHDR-BATCH-NO         DTSBD145
00225                                             AHDR-ITEM-NO.         DTSBD145
00226                                                                   DTSBD145
00227      MOVE AHDR-KEY-AREA                  TO ASKL-KEY-AREA.        DTSBD145
00228                                                                   DTSBD145
00229      PERFORM S923-START-BROWSE           THRU S923-EXIT.          DTSBD145
00230                                                                   DTSBD145
00231      PERFORM UNTIL L923-NO-REC-88 OR W-START-FOUND-YES-88         DTSBD145
00232        MOVE ASKL-REC                     TO AHDR-REC              DTSBD145
00233        IF ASKL-HDR-88                                             DTSBD145
00234           IF AHDR-ESTB-DATE NOT NUMERIC                           DTSBD145
00235              DISPLAY 'NON-NUM ESTB ' AHDR-BATCH-NO                DTSBD145
00236              PERFORM S923-READ-NEXT      THRU S923-EXIT           DTSBD145
00237           ELSE                                                    DTSBD145
00238              IF AHDR-ESTB-SYSTEM-88                               DTSBD145
00239              OR AHDR-ESTB-DATE < 20130501                         DTSBD145
00240                 PERFORM S923-READ-NEXT   THRU S923-EXIT           DTSBD145
00241              ELSE                                                 DTSBD145
00242                 SET W-START-FOUND-YES-88 TO TRUE                  DTSBD145
00243              END-IF                                               DTSBD145
00244           END-IF                                                  DTSBD145
00245        ELSE                                                       DTSBD145
00246           PERFORM S923-READ-NEXT         THRU S923-EXIT           DTSBD145
00247        END-IF                                                     DTSBD145
00248      END-PERFORM.                                                 DTSBD145
00249                                                                   DTSBD145
00250  I3000-EXIT.                                                      DTSBD145
00251      EXIT.                                                        DTSBD145
00252                                                                   DTSBD145
00253  P0000-PROCESS.                                                   DTSBD145
00254      MOVE +0                             TO W-HOLD-BATCH-NO.      DTSBD145
00255                                                                   DTSBD145
00256      PERFORM UNTIL L923-NO-REC-88 OR W-ERROR-YES-88               DTSBD145
00257         IF ASKL-HDR-88                                            DTSBD145
00258            PERFORM P1000-PROCESS-HDR     THRU P1000-EXIT          DTSBD145
00259         ELSE                                                      DTSBD145
00260            MOVE ASKL-REC                 TO ARPT-REC              DTSBD145
00261            PERFORM P2000-CHECK-TRAN      THRU P2000-EXIT          DTSBD145
00262            PERFORM S923-READ-NEXT        THRU S923-EXIT           DTSBD145
00263         END-IF                                                    DTSBD145
00264      END-PERFORM.                                                 DTSBD145
00265                                                                   DTSBD145
00266      IF W-REWRITE-YES-88                                          DTSBD145
00267         DISPLAY 'UPDATE LAST HEADER '                             DTSBD145
00268         PERFORM P1100-UPD-OLD-HEADER     THRU P1100-EXIT          DTSBD145
00269      END-IF.                                                      DTSBD145
00270                                                                   DTSBD145
00271  P0000-EXIT.                                                      DTSBD145
00272      EXIT.                                                        DTSBD145
00273                                                                   DTSBD145
00274  P1000-PROCESS-HDR.                                               DTSBD145
00275 ****************                                                  DTSBD145
00276 * SAVE THE NEW HEADER RECORD JUST READ                            DTSBD145
00277 ****************                                                  DTSBD145
00278      DISPLAY 'P1000 ' ASKL-BATCH-NO '  ' ASKL-ITEM-NO.            DTSBD145
00279      IF W-HOLD-BATCH-NO = 0                                       DTSBD145
00280         MOVE ASKL-REC                    TO AHDR-REC              DTSBD145
00281                                             W-HOLD-HDR-REC        DTSBD145
00282         PERFORM S923-READ-NEXT           THRU S923-EXIT           DTSBD145
00283         GO TO P1000-EXIT                                          DTSBD145
00284      ELSE                                                         DTSBD145
00285         MOVE ASKL-REC                    TO W-HOLD-HDR-REC        DTSBD145
00286      END-IF.                                                      DTSBD145
00287                                                                   DTSBD145
00288 ****************                                                  DTSBD145
00289 * UPDATE THE HEADER FOR THE BATCH JUST PROCESSED                  DTSBD145
00290 ****************                                                  DTSBD145
00291      IF W-REWRITE-YES-88                                          DTSBD145
00292         PERFORM P1100-UPD-OLD-HEADER     THRU P1100-EXIT          DTSBD145
00293      END-IF.                                                      DTSBD145
00294                                                                   DTSBD145
00295 ****************                                                  DTSBD145
00296 * RE-READ THE NEW HEADER RECORD, SAVE IT, AND GET THE FIRST       DTSBD145
00297 * TRANSACTION IN THE NEW BATCH.                                   DTSBD145
00298 ****************                                                  DTSBD145
00299                                                                   DTSBD145
00300      PERFORM P1200-START-NEXT-BATCH      THRU P1200-EXIT.         DTSBD145
00301                                                                   DTSBD145
00302  P1000-EXIT.                                                      DTSBD145
00303      EXIT.                                                        DTSBD145
00304                                                                   DTSBD145
00305  P1100-UPD-OLD-HEADER.                                            DTSBD145
00306      MOVE AHDR-KEY-AREA                  TO ASKL-KEY-AREA.        DTSBD145
00307      PERFORM S923-READ                   THRU S923-EXIT.          DTSBD145
00308                                                                   DTSBD145
00309      IF L923-NO-REC-88                                            DTSBD145
00310         SET W-ERROR-YES-88               TO TRUE                  DTSBD145
00311         DISPLAY 'CANNOT READ OLD HEADER ' W-HOLD-BATCH-NO         DTSBD145
00312            '  ' ASKL-BATCH-NO                                     DTSBD145
00313         GO TO P1100-EXIT                                          DTSBD145
00314      ELSE                                                         DTSBD145
00315         ADD +1                           TO W-HDR-UPDATE-CNT      DTSBD145
00316         DISPLAY 'CTL UPD ' AHDR-CONTROL-TRAN-CNT                  DTSBD145
00317         MOVE AHDR-REC                    TO ASKL-REC              DTSBD145
00318         PERFORM S923-REWRITE             THRU S923-EXIT           DTSBD145
00319         DISPLAY 'REWRITE ' AHDR-BATCH-NO                          DTSBD145
00320      END-IF.                                                      DTSBD145
00321                                                                   DTSBD145
00322  P1100-EXIT.                                                      DTSBD145
00323      EXIT.                                                        DTSBD145
00324                                                                   DTSBD145
00325  P1200-START-NEXT-BATCH.                                          DTSBD145
00326 *******************                                               DTSBD145
00327 * RE-READ THE NEW HEADER RECORD, THEN DO A START-BROWSE           DTSBD145
00328 * TO GET THE FIRST TRANSACTION IN THE NEW BATCH.                  DTSBD145
00329 *******************                                               DTSBD145
00330      MOVE W-HOLD-HDR-REC                 TO ASKL-REC.             DTSBD145
00331      PERFORM S923-START-BROWSE           THRU S923-EXIT.          DTSBD145
00332 ***  IF ASKL-BATCH-NO NOT = W-HOLD-BATCH-NO                       DTSBD145
00333      IF L923-NO-REC-88                                            DTSBD145
00334         SET W-ERROR-YES-88               TO TRUE                  DTSBD145
00335         DISPLAY 'CANNOT READ OLD HEADER ' W-HOLD-BATCH-NO         DTSBD145
00336            '  ' ASKL-BATCH-NO                                     DTSBD145
00337         GO TO P1200-EXIT                                          DTSBD145
00338      ELSE                                                         DTSBD145
00339         MOVE ASKL-REC                    TO AHDR-REC              DTSBD145
00340         SET W-REWRITE-NO-88              TO TRUE                  DTSBD145
00341         PERFORM S923-READ-NEXT           THRU S923-EXIT           DTSBD145
00342      END-IF.                                                      DTSBD145
00343                                                                   DTSBD145
00344  P1200-EXIT.                                                      DTSBD145
00345      EXIT.                                                        DTSBD145
00346                                                                   DTSBD145
00347  P2000-CHECK-TRAN.                                                DTSBD145
00348      DISPLAY ' P2000 ' ARPT-EMP-NO.                               DTSBD145
00349      IF ASKL-RPT-88                                               DTSBD145
00350         MOVE ASKL-REC                    TO ARPT-REC              DTSBD145
00351         IF  ARPT-ORIG-88                                          DTSBD145
00352         AND ARPT-TOT-WAGE = ZERO                                  DTSBD145
00353         AND ARPT-NOT-PROCESSED-88                                 DTSBD145
00354            PERFORM P2100-FIND-MPRF       THRU P2100-EXIT          DTSBD145
00355            IF L910-OK-88                                          DTSBD145
00356               PERFORM P2200-LIABILITY    THRU P2200-EXIT          DTSBD145
00357            END-IF                                                 DTSBD145
00358         END-IF                                                    DTSBD145
00359      END-IF.                                                      DTSBD145
00360                                                                   DTSBD145
00361  P2000-EXIT.                                                      DTSBD145
00362      EXIT.                                                        DTSBD145
00363                                                                   DTSBD145
00364  P2100-FIND-MPRF.                                                 DTSBD145
00365      DISPLAY ' P2100 ' ARPT-EMP-NO.                               DTSBD145
00366      MOVE LOW-VALUES                     TO MPRF-KEY-AREA.        DTSBD145
00367      MOVE ARPT-EMP-NO                    TO MPRF-EMP-NO.          DTSBD145
00368      SET MPRF-PRF-88                     TO TRUE.                 DTSBD145
00369      MOVE MPRF-KEY-AREA                  TO MSKL-KEY-AREA.        DTSBD145
00370      PERFORM S910-READ                   THRU S910-EXIT.          DTSBD145
00371      IF L910-OK-88                                                DTSBD145
00372         MOVE MSKL-REC                    TO MPRF-REC              DTSBD145
00373      ELSE                                                         DTSBD145
00374         DISPLAY 'CANNOT FIND MPRF ' ARPT-EMP-NO                   DTSBD145
00375 *       SET W-ERROR-YES-88               TO TRUE                  DTSBD145
00376         SET W-REWRITE-NO-88             TO TRUE                   DTSBD145
00377         GO TO P2100-EXIT                                          DTSBD145
00378      END-IF.                                                      DTSBD145
00379                                                                   DTSBD145
00380  P2100-EXIT.                                                      DTSBD145
00381      EXIT.                                                        DTSBD145
00382                                                                   DTSBD145
00383  P2200-LIABILITY.                                                 DTSBD145
00384      DISPLAY ' P2200 ' ARPT-EMP-NO.                               DTSBD145
00385      IF ARPT-YRQ > ZERO                                           DTSBD145
00386         MOVE ARPT-YRQ                    TO L516-YRQ              DTSBD145
00387         PERFORM S516-LIABILITY-INFO      THRU S516-EXIT           DTSBD145
00388         IF L516-NOT-LIABLE-88                                     DTSBD145
00389            PERFORM P2210-NOT-LIABLE      THRU P2210-EXIT          DTSBD145
00390         ELSE                                                      DTSBD145
00391            PERFORM P2220-FIRST-LIAB-QTR  THRU P2220-EXIT          DTSBD145
00392         END-IF                                                    DTSBD145
00393      ELSE                                                         DTSBD145
00394         DISPLAY 'NO QUARTER ' ARPT-BATCH-NO                       DTSBD145
00395            '  ' ARPT-ITEM-NO '  ' ARPT-EMP-NO                     DTSBD145
00396         GO TO P2200-EXIT                                          DTSBD145
00397      END-IF.                                                      DTSBD145
00398                                                                   DTSBD145
00399  P2200-EXIT.                                                      DTSBD145
00400      EXIT.                                                        DTSBD145
00401                                                                   DTSBD145
00402  P2210-NOT-LIABLE.                                                DTSBD145
00403      DISPLAY ' P2210 ' ARPT-EMP-NO.                               DTSBD145
00404      PERFORM P2300-UPD-HDR               THRU P2300-EXIT.         DTSBD145
00405                                                                   DTSBD145
00406      MOVE 'NOT LIABLE'                   TO W-NL-TYPE.            DTSBD145
00407      PERFORM P2400-WRITE-F145            THRU P2400-EXIT.         DTSBD145
00408      PERFORM S923-DELETE                 THRU S923-EXIT.          DTSBD145
00409      PERFORM P2500-NOTEPAD               THRU P2500-EXIT.         DTSBD145
00410      ADD +1                              TO W-TRAN-DELETE-CNT.    DTSBD145
00411                                                                   DTSBD145
00412      DISPLAY 'NOT LIABLE ' MPRF-EMP-NO '  ' ARPT-YRQ              DTSBD145
00413         '  ' ARPT-BATCH-NO '  ' ARPT-ITEM-NO.                     DTSBD145
00414                                                                   DTSBD145
00415  P2210-EXIT.                                                      DTSBD145
00416      EXIT.                                                        DTSBD145
00417                                                                   DTSBD145
00418  P2220-FIRST-LIAB-QTR.                                            DTSBD145
00419      DISPLAY ' P2220 ' ARPT-EMP-NO.                               DTSBD145
00420      MOVE LOW-VALUES                     TO MSOL-KEY-AREA.        DTSBD145
00421      MOVE MPRF-EMP-NO                    TO MSOL-EMP-NO.          DTSBD145
00422      SET MSOL-SOL-88                     TO TRUE.                 DTSBD145
00423      MOVE MSOL-KEY-AREA                  TO MSKL-KEY-AREA.        DTSBD145
00424      PERFORM S910-START-BROWSE           THRU S910-EXIT.          DTSBD145
00425                                                                   DTSBD145
00426      PERFORM UNTIL L910-NO-REC-88                                 DTSBD145
00427         MOVE MSKL-REC                    TO MSOL-REC              DTSBD145
00428         IF ARPT-YRQ = MSOL-FIRST-LIAB-YRQ                         DTSBD145
00429            PERFORM P2300-UPD-HDR         THRU P2300-EXIT          DTSBD145
00430            MOVE 'FIRST LIAB QTR ZERO WAGE'                        DTSBD145
00431                                          TO W-NL-TYPE             DTSBD145
00432            PERFORM P2400-WRITE-F145      THRU P2400-EXIT          DTSBD145
00433            PERFORM S923-DELETE           THRU S923-EXIT           DTSBD145
00434            PERFORM P2500-NOTEPAD         THRU P2500-EXIT          DTSBD145
00435            ADD +1                        TO W-TRAN-DELETE-CNT     DTSBD145
00436            DISPLAY 'FIRST LIAB QTR ZERO WAGE ' MPRF-EMP-NO        DTSBD145
00437               '  ' ARPT-YRQ '  ' ARPT-BATCH-NO                    DTSBD145
00438               '  ' ARPT-ITEM-NO                                   DTSBD145
00439            SET L910-NO-REC-88            TO TRUE                  DTSBD145
00440         ELSE                                                      DTSBD145
00441            PERFORM S910-READ-NEXT        THRU S910-EXIT           DTSBD145
00442         END-IF                                                    DTSBD145
00443                                                                   DTSBD145
00444      END-PERFORM.                                                 DTSBD145
00445                                                                   DTSBD145
00446  P2220-EXIT.                                                      DTSBD145
00447      EXIT.                                                        DTSBD145
00448                                                                   DTSBD145
00449  P2300-UPD-HDR.                                                   DTSBD145
00450      SET W-REWRITE-YES-88           TO TRUE.                      DTSBD145
00451      DISPLAY 'CTL CNT ' AHDR-CONTROL-TRAN-CNT.                    DTSBD145
00452      SUBTRACT +1                    FROM AHDR-CONTROL-TRAN-CNT    DTSBD145
00453                                          AHDR-ATC-FILE-TRAN-CNT.  DTSBD145
00454                                                                   DTSBD145
00455  P2300-EXIT.                                                      DTSBD145
00456      EXIT.                                                        DTSBD145
00457                                                                   DTSBD145
00458  P2400-WRITE-F145.                                                DTSBD145
00459      MOVE ARPT-BATCH-NO                  TO W-NL-BATCH.           DTSBD145
00460      MOVE ARPT-ITEM-NO                   TO W-NL-ITEM.            DTSBD145
00461      MOVE ARPT-EMP-NO                    TO W-NL-EMP.             DTSBD145
00462      MOVE ARPT-YRQ                       TO L004-QTR-5-9.         DTSBD145
00463      PERFORM S004-FROM-5                 THRU S004-EXIT.          DTSBD145
00464      MOVE L004-SLASH-5-QTR               TO W-NL-QTR.             DTSBD145
00465                                                                   DTSBD145
00466      WRITE NOT-LIABLE-REC                FROM W-NL-REC.           DTSBD145
00467                                                                   DTSBD145
00468  P2400-EXIT.                                                      DTSBD145
00469      EXIT.                                                        DTSBD145
00470                                                                   DTSBD145
00471  P2500-NOTEPAD.                                                   DTSBD145
00472      DISPLAY ' P2500 ' ARPT-EMP-NO.                               DTSBD145
00473       MOVE LOW-VALUES              TO MNTE-KEY-AREA.              DTSBD145
00474       MOVE MPRF-EMP-NO             TO MNTE-EMP-NO.                DTSBD145
00475       SET MNTE-NTE-88              TO TRUE.                       DTSBD145
00476       MOVE +0                      TO MNTE-PURGE-DATE.            DTSBD145
00477       SET MNTE-NOT-CONVERTED-88    TO TRUE.                       DTSBD145
00478                                                                   DTSBD145
00479       MOVE L005-DATE               TO MNTE-ESTB-DATE              DTSBD145
00480                                       MNTE-CHNG-DATE.             DTSBD145
00481       MOVE ZERO                    TO MNTE-KEY-ESTB-ABSTIME       DTSBD145
00482                                       MNTE-DATA-ESTB-ABSTIME      DTSBD145
00483                                      MNTE-CHNG-ABSTIME.           DTSBD145
00484       MOVE 'SYSTEM'                TO MNTE-ESTB-OP-ID             DTSBD145
00485                                       MNTE-CHNG-OP-ID.            DTSBD145
00486       MOVE 'REPORT TRANSACTION DELETED ZERO WAGES'                DTSBD145
00487                                    TO MNTE-SUBJECT.               DTSBD145
00488                                                                   DTSBD145
00489       MOVE +3                      TO MNTE-TEXT-CNT.              DTSBD145
00490                                                                   DTSBD145
00491       MOVE WRK-MNTE-MSG-LINE1      TO MNTE-TEXT (1).              DTSBD145
00492       MOVE WRK-MNTE-MSG-LINE2      TO MNTE-TEXT (2).              DTSBD145
00493       MOVE WRK-MNTE-MSG-LINE3      TO MNTE-TEXT (3).              DTSBD145
00494       PERFORM P2510-WRITE-T003     THRU P2510-EXIT.               DTSBD145
00495                                                                   DTSBD145
00496  P2500-EXIT.                                                      DTSBD145
00497      EXIT.                                                        DTSBD145
00498  P2510-WRITE-T003.                                                DTSBD145
00499        MOVE MPRF-EMP-NO               TO T003-EMP-NO.             DTSBD145
00500        MOVE MNTE-REC                  TO T003-MNTE-REC.           DTSBD145
00501                                                                   DTSBD145
00502        MOVE T003-REC                  TO TSKL-REC.                DTSBD145
00503        PERFORM S927-WRITE             THRU S927-EXIT.             DTSBD145
00504        ADD +1                         TO WRK-T003-CNT.            DTSBD145
00505                                                                   DTSBD145
00506  P2510-EXIT.                                                      DTSBD145
00507        EXIT.                                                      DTSBD145
00508                                                                   DTSBD145
00509                                                                   DTSBD145
00510                                                                   DTSBD145
00511  T0000-TERMINATE.                                                 DTSBD145
00512      DISPLAY ' '.                                                 DTSBD145
00513                                                                   DTSBD145
00514      DISPLAY '*** DTSBD145 TERMINATION STATISTICS ***'.           DTSBD145
00515      DISPLAY SPACE.                                               DTSBD145
00516      DISPLAY '     TRANSACTIONS DELETED: ' W-TRAN-DELETE-CNT.     DTSBD145
00517      DISPLAY '     HEADERS UPDATED     : ' W-HDR-UPDATE-CNT.      DTSBD145
00518      DISPLAY ' NO OF NOTEPAD REC ADDED : ' WRK-T003-CNT.          DTSBD145
00519                                                                   DTSBD145
00520      CLOSE NOT-LIABLE-FILE.                                       DTSBD145
00521                                                                   DTSBD145
00522      PERFORM S910-CLOSE     THRU S910-EXIT.                       DTSBD145
00523      PERFORM S923-CLOSE     THRU S923-EXIT.                       DTSBD145
00524      PERFORM S927-CLOSE     THRU S927-EXIT.                       DTSBD145
00525      PERFORM S931-CLOSE     THRU S931-EXIT.                       DTSBD145
00526                                                                   DTSBD145
00527  T0000-EXIT.                                                      DTSBD145
00528      EXIT.                                                        DTSBD145
00529                                                                   DTSBD145
00530  S001-FROM-FED-8.                                                 DTSBD145
00531      SET L001-FROM-FED-8 TO TRUE.                                 DTSBD145
00532      GO TO S001-DATE.                                             DTSBD145
00533                                                                   DTSBD145
00534  S001-FROM-CAL-8.                                                 DTSBD145
00535      SET L001-FROM-CAL-8 TO TRUE.                                 DTSBD145
00536      GO TO S001-DATE.                                             DTSBD145
00537                                                                   DTSBD145
00538  S001-FROM-ABS-DAY.                                               DTSBD145
00539      SET L001-FROM-ABS-DAY TO TRUE.                               DTSBD145
00540      GO TO S001-DATE.                                             DTSBD145
00541                                                                   DTSBD145
00542  S001-DATE.                                                       DTSBD145
00543      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBD145
00544  S001-EXIT.                                                       DTSBD145
00545      EXIT.                                                        DTSBD145
00546                                                                   DTSBD145
00547  S003-AGENCY-DAY.                                                 DTSBD145
00548      SET L003-AGENCY-DAY TO TRUE.                                 DTSBD145
00549      GO TO S003-WORK-DAY.                                         DTSBD145
00550                                                                   DTSBD145
00551  S003-WORK-DAY.                                                   DTSBD145
00552      CALL 'DTSBU003' USING L003-LINK-AREA.                        DTSBD145
00553  S003-EXIT.                                                       DTSBD145
00554      EXIT.                                                        DTSBD145
00555                                                                   DTSBD145
00556  S004-FROM-5.                                                     DTSBD145
00557      SET L004-FROM-5        TO TRUE.                              DTSBD145
00558      GO TO S004-YRQ.                                              DTSBD145
00559                                                                   DTSBD145
00560  S004-FROM-DATE.                                                  DTSBD145
00561      SET L004-FROM-DATE     TO TRUE.                              DTSBD145
00562      GO TO S004-YRQ.                                              DTSBD145
00563                                                                   DTSBD145
00564  S004-FROM-ABS.                                                   DTSBD145
00565      SET L004-FROM-ABS      TO TRUE.                              DTSBD145
00566      GO TO S004-YRQ.                                              DTSBD145
00567                                                                   DTSBD145
00568  S004-YRQ.                                                        DTSBD145
00569      CALL 'DTSBU004' USING L004-LINK-AREA.                        DTSBD145
00570                                                                   DTSBD145
00571  S004-EXIT.                                                       DTSBD145
00572      EXIT.                                                        DTSBD145
00573                                                                   DTSBD145
00574  S005-FROM-SYS.                                                   DTSBD145
00575      SET L005-FROM-SYS TO TRUE.                                   DTSBD145
00576      GO TO S005-ABSTIME.                                          DTSBD145
00577                                                                   DTSBD145
00578  S005-ABSTIME.                                                    DTSBD145
00579      CALL 'DTSBU005' USING L005-LINK-AREA.                        DTSBD145
00580  S005-EXIT.                                                       DTSBD145
00581      EXIT.                                                        DTSBD145
00582                                                                   DTSBD145
00583  S516-LIABILITY-INFO.                                             DTSBD145
00584      CALL 'DTSBU516' USING L516-LINK-AREA                         DTSBD145
00585                            MPRF-REC.                              DTSBD145
00586  S516-EXIT.                                                       DTSBD145
00587      EXIT.                                                        DTSBD145
00588                                                                   DTSBD145
00589  S910-OPEN-READ.                                                  DTSBD145
00590      SET L910-OPEN-READ-88   TO TRUE.                             DTSBD145
00591      GO TO S910-MSTR-IO.                                          DTSBD145
00592                                                                   DTSBD145
00593  S910-READ.                                                       DTSBD145
00594      SET L910-READ-88 TO TRUE.                                    DTSBD145
00595      GO TO S910-MSTR-IO.                                          DTSBD145
00596                                                                   DTSBD145
00597  S910-START-BROWSE.                                               DTSBD145
00598      SET L910-START-BROWSE-88 TO TRUE.                            DTSBD145
00599      GO TO S910-MSTR-IO.                                          DTSBD145
00600                                                                   DTSBD145
00601  S910-READ-NEXT.                                                  DTSBD145
00602      SET L910-READ-NEXT-88 TO TRUE.                               DTSBD145
00603      GO TO S910-MSTR-IO.                                          DTSBD145
00604                                                                   DTSBD145
00605  S910-CLOSE.                                                      DTSBD145
00606      SET L910-CLOSE-88 TO TRUE.                                   DTSBD145
00607      GO TO S910-MSTR-IO.                                          DTSBD145
00608                                                                   DTSBD145
00609  S910-MSTR-IO.                                                    DTSBD145
00610      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBD145
00611                            MSKL-REC.                              DTSBD145
00612  S910-EXIT.                                                       DTSBD145
00613      EXIT.                                                        DTSBD145
00614                                                                   DTSBD145
00615  S923-OPEN-UPDATE.                                                DTSBD145
00616      SET L923-OPEN-UPDATE-88 TO TRUE.                             DTSBD145
00617      GO TO S923-ATC-IO.                                           DTSBD145
00618                                                                   DTSBD145
00619  S923-OPEN-READ.                                                  DTSBD145
00620      SET L923-OPEN-READ-88   TO TRUE.                             DTSBD145
00621      GO TO S923-ATC-IO.                                           DTSBD145
00622                                                                   DTSBD145
00623  S923-READ.                                                       DTSBD145
00624      SET L923-READ-88 TO TRUE.                                    DTSBD145
00625      GO TO S923-ATC-IO.                                           DTSBD145
00626                                                                   DTSBD145
00627  S923-START-BROWSE.                                               DTSBD145
00628      SET L923-START-BROWSE-88 TO TRUE.                            DTSBD145
00629      GO TO S923-ATC-IO.                                           DTSBD145
00630                                                                   DTSBD145
00631  S923-READ-NEXT.                                                  DTSBD145
00632      SET L923-READ-NEXT-88 TO TRUE.                               DTSBD145
00633      GO TO S923-ATC-IO.                                           DTSBD145
00634                                                                   DTSBD145
00635 *S923-WRITE.                                                      DTSBD145
00636 *****SET L923-WRITE-88 TO TRUE.                                   DTSBD145
00637 *****GO TO S923-ATC-IO.                                           DTSBD145
00638                                                                   DTSBD145
00639  S923-REWRITE.                                                    DTSBD145
00640      SET L923-REWRITE-88 TO TRUE.                                 DTSBD145
00641      GO TO S923-ATC-IO.                                           DTSBD145
00642                                                                   DTSBD145
00643  S923-DELETE.                                                     DTSBD145
00644      SET L923-DELETE-88 TO TRUE.                                  DTSBD145
00645      GO TO S923-ATC-IO.                                           DTSBD145
00646                                                                   DTSBD145
00647  S923-CLOSE.                                                      DTSBD145
00648      SET L923-CLOSE-88 TO TRUE.                                   DTSBD145
00649      GO TO S923-ATC-IO.                                           DTSBD145
00650                                                                   DTSBD145
00651  S923-ATC-IO.                                                     DTSBD145
00652      CALL 'DTSBU923' USING L923-LINK-AREA                         DTSBD145
00653                            ASKL-REC.                              DTSBD145
00654  S923-EXIT.                                                       DTSBD145
00655      EXIT.                                                        DTSBD145
00656                                                                   DTSBD145
00657  S927-OPEN-UPDATE.                                                DTSBD145
00658       SET L927-OPEN-UPDATE-88 TO TRUE.                            DTSBD145
00659       GO TO S927-BTC-O.                                           DTSBD145
00660                                                                   DTSBD145
00661  S927-WRITE.                                                      DTSBD145
00662       SET L927-WRITE-88 TO TRUE.                                  DTSBD145
00663       GO TO S927-BTC-O.                                           DTSBD145
00664                                                                   DTSBD145
00665  S927-CLOSE.                                                      DTSBD145
00666       SET L927-CLOSE-88 TO TRUE.                                  DTSBD145
00667       GO TO S927-BTC-O.                                           DTSBD145
00668                                                                   DTSBD145
00669  S927-BTC-O.                                                      DTSBD145
00670       CALL 'DTSBU927' USING L927-LINK-AREA                        DTSBD145
00671                             TSKL-REC.                             DTSBD145
00672  S927-EXIT.                                                       DTSBD145
00673       EXIT.                                                       DTSBD145
00674       SKIP3                                                       DTSBD145
00675  S931-OPEN-READ.                                                  DTSBD145
00676      SET L931-OPEN-READ-88 TO TRUE.                               DTSBD145
00677      GO TO S931-REF-IO.                                           DTSBD145
00678                                                                   DTSBD145
00679  S931-CLOSE.                                                      DTSBD145
00680      SET L931-CLOSE-88 TO TRUE.                                   DTSBD145
00681      GO TO S931-REF-IO.                                           DTSBD145
00682                                                                   DTSBD145
00683  S931-REF-IO.                                                     DTSBD145
00684      CALL 'DTSBU931' USING L931-LINK-AREA                         DTSBD145
00685                            FSKL-REC.                              DTSBD145
00686  S931-EXIT.                                                       DTSBD145
00687      EXIT.                                                        DTSBD145
00688                                                                   DTSBD145
00689 *S947-WRITE-R907.                                                 DTSBD145
00690 *    CALL 'DTSBU947' USING R907-REC.                              DTSBD145
00691 *    GO TO S947-EXIT.                                             DTSBD145
00692 *                                                                 DTSBD145
00693 *S947-EXIT.                                                       DTSBD145
00694 *    EXIT.                                                        DTSBD145
00695                                                                   DTSBD145
00696  S999-ABEND.                                                      DTSBD145
00697      CALL 'DTSBU999' USING W-ABEND-CD.                            DTSBD145
00698  S999-EXIT.                                                       DTSBD145
00699      EXIT.                                                        DTSBD145
