00001  IDENTIFICATION DIVISION.                                         11/08/22
00002  PROGRAM-ID.             DTSBZTOP.                                DTSTOP01
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV022
00004  DATE-WRITTEN.           DECEMBER 1998.                           DTSTOP01
00005  DATE-COMPILED.                                                   DTSTOP01
00006      SKIP3                                                        DTSTOP01
00007 *****                                                             DTSTOP01
00008 *                                                                 DTSTOP01
00009 *    FUNCTION:  LIST EMPLOYERS WITH BALANCE GT ZERO               DTSTOP01
00010 *                                                                 DTSTOP01
00011 *                                                                 DTSTOP01
00012 *****                                                             DTSTOP01
00013      SKIP3                                                        DTSTOP01
00014  ENVIRONMENT DIVISION.                                            DTSTOP01
00015  INPUT-OUTPUT SECTION.                                            DTSTOP01
00016      SKIP3                                                        DTSTOP01
00017  FILE-CONTROL.                                                    DTSTOP01
00018      SELECT IN-FILE           ASSIGN TO DTSIZ058                  DTSTOP01
00019             FILE STATUS IS ZI57-STATUS.                           DTSTOP01
00020                                                                   DTSTOP01
00021      SELECT OUT-FILE          ASSIGN TO DTSOZ058                  DTSTOP01
00022             FILE STATUS IS Z057-STATUS.                           DTSTOP01
00023      SKIP2                                                        DTSTOP01
00024  DATA DIVISION.                                                   DTSTOP01
00025  FILE SECTION.                                                    DTSTOP01
00026                                                                   DTSTOP01
00027  FD  IN-FILE                                                      DTSTOP01
00028      RECORDING MODE IS F                                          DTSTOP01
00029      BLOCK CONTAINS 0 RECORDS                                     DTSTOP01
00030      LABEL RECORDS ARE OMITTED.                                   DTSTOP01
00031                                                                   DTSTOP01
00032                                                                   DTSTOP01
00033  01  IN-REC.                                                      DTSTOP01
00034      05  IN-EAN                 PIC X(06).                        DTSTOP01
00035      05  FILLER                 PIC X(14).                           CL**7
00036                                                                   DTSTOP01
00037  FD  OUT-FILE                                                     DTSTOP01
00038      RECORDING MODE IS F                                          DTSTOP01
00039      BLOCK CONTAINS 0 RECORDS                                     DTSTOP01
00040      LABEL RECORDS ARE OMITTED.                                   DTSTOP01
00041                                                                   DTSTOP01
00042                                                                   DTSTOP01
00043  01  OUT-REC                         PIC  X(200).                 DTSTOP01
00044                                                                   DTSTOP01
00045                                                                   DTSTOP01
00046  WORKING-STORAGE SECTION.                                         DTSTOP01
000465 77  PAN-VALET PICTURE X(24) VALUE '022DTSTOP01  11/08/22'.       DTSTOP01
00047      SKIP3                                                        DTSTOP01
00048  01  WRK-AREA.                                                    DTSTOP01
00049      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +057.DTSTOP01
00050      05  ABEND-MSG                   PIC  X(60).                  DTSTOP01
00051                                                                   DTSTOP01
00052      05  W-IN-QTR                    PIC S9(05)  COMP-3.          DTSTOP01
00053      05  HOLD-LAST-USED-BATCH-NO     PIC S9(05)  COMP-3.          DTSTOP01
00054                                                                   DTSTOP01
00055      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBZ057'.DTSTOP01
00056                                                                   DTSTOP01
00057      05  Z057-STATUS                 PIC  X(02).                  DTSTOP01
00058          88  Z057-FILE-OK-88          VALUE '00'.                 DTSTOP01
00059                                                                   DTSTOP01
00060      05  ZI57-STATUS                 PIC  X(02).                  DTSTOP01
00061          88  ZI57-FILE-OK-88          VALUE '00'.                 DTSTOP01
00062                                                                   DTSTOP01
00063      05  SEQ                         PIC S9(07)  COMP-3 VALUE +0. DTSTOP01
00064      05  WRK-MPRF-CNT                PIC S9(07)  COMP-3.          DTSTOP01
00065      05  WRK-UPDATE-CNT              PIC S9(07)  COMP-3.          DTSTOP01
00066      05  WRK-READ-CNT                PIC  9(07)  VALUE 0.            CL*17
00067      05  WRK-EXCLUDE-CNT             PIC S9(07)  COMP-3.          DTSTOP01
00068      05  WRK-MPRF-AMT                PIC S9(09)V99  COMP-3.       DTSTOP01
00069      05  WRK-INTEREST-AMT            PIC S9(09)V99  COMP-3.       DTSTOP01
00070      05  WRK-PENALTY-AMT             PIC S9(09)V99 COMP-3 VALUE 0.DTSTOP01
00071      05  WRK-TOT-MLIN-AMT            PIC  9(12)V99  VALUE 0.         CL*13
00072      05  WRK-MLIN-AMT                PIC  9(10)V99  VALUE 0.         CL*13
00073      05  WRK-LIEN-AMT                PIC  9(10)V99  VALUE 0.         CL*13
00074      05  WRK-MLIN-AMTD               PIC $$$$$$$$9.99.               CL*15
00075      05  DIS-MLIN-AMT                PIC --------9.99.               CL*16
00076      05  DIS-MPRF-AMT                PIC --------9.99.               CL*16
00077      05  WRK-REMIT-AMT               PIC S9(09)V99  COMP-3.       DTSTOP01
00078      05  WRK-UI-BAL                  PIC S9(09)V99  COMP-3.       DTSTOP01
00079      05  WRK-MLIN-IND                PIC  X(01).                  DTSTOP01
00080          88 WRK-MLIN-OK           VALUE 'Y'.                      DTSTOP01
00081          88 WRK-MLIN-NO-REC       VALUE 'N'.                      DTSTOP01
00082                                                                   DTSTOP01
00083      05  WS-ALPHA   OCCURS 20 TIMES    PIC X(1).                  DTSTOP01
00084                                                                   DTSTOP01
00085                                                                   DTSTOP01
00086      05  TOP-HEADER-OUT.                                          DTSTOP01
00087          10  OUT-IND                PIC X(09)                     DTSTOP01
00088                            VALUE '       T1'.                     DTSTOP01
00089          10  OUT-BATCH-ID.                                        DTSTOP01
00090              15 OUT-BATCH-YR        PIC X(04).                    DTSTOP01
00091              15 OUT-BATCH-MM        PIC X(02).                    DTSTOP01
00092              15 OUT-BATCH-DD        PIC X(02).                    DTSTOP01
00093          10  FILLER                 PIC X(182) VALUE SPACES.      DTSTOP01
00094          10  FILLER                 PIC X(1)   VALUE '%'.         DTSTOP01
00095                                                                   DTSTOP01
00096      05  TOP-DETAIL-REC1.                                         DTSTOP01
00097          10  OUT-AGENCY-ID           PIC X(08) VALUE 'D4      '.  DTSTOP01
00098          10  OUT-AGENCY-SITE-ID      PIC X(08) VALUE 'TX      '.  DTSTOP01
00099          10  OUT-SEQ-NO              PIC 9(18).                   DTSTOP01
00100          10  OUT-ACTION              PIC X(01) VALUE 'A'.         DTSTOP01
00101          10  OUT-REC-TYPE            PIC X(01) VALUE '1'.         DTSTOP01
00102          10  OUT-FEIN                PIC X(09).                   DTSTOP01
00103          10  OUT-EMP-LNAME           PIC X(35).                   DTSTOP01
00104          10  OUT-EMP-FNAME           PIC X(35).                   DTSTOP01
00105          10  OUT-EMP-MNAME           PIC X(01) VALUE SPACES.      DTSTOP01
00106          10  OUT-DEL-DATE            PIC X(08).                   DTSTOP01
00107          10  OUT-CONTACT-CODE        PIC X(03) VALUE SPACES.      DTSTOP01
00108          10  FILLER                  PIC X(04) VALUE SPACES.      DTSTOP01
00109          10  OUT-DEBTOR-STATUS       PIC X(02) VALUE SPACES.      DTSTOP01
00110          10  FILLER                  PIC X(01) VALUE SPACES.      DTSTOP01
00111          10  OUT-AMOUNT              PIC 9(10)V99.                   CL*14
00112          10  OUT-DEBT-TYPE           PIC X(02) VALUE 'UT'.           CL**5
00113          10  OUT-FEIN-TYPE           PIC X(01) VALUE 'B'.         DTSTOP01
00114          10  OUT-JUDGE-DEBT          PIC X(01) VALUE 'J'.         DTSTOP01
00115          10  FILLER                  PIC X(49) VALUE SPACES.      DTSTOP01
00116          10  FILLER                  PIC X(01) VALUE '%'.         DTSTOP01
00117      05  TOP-DETAIL-REC2.                                         DTSTOP01
00118          10  OUT-AGENCY-ID-2         PIC X(08) VALUE 'D4      '.  DTSTOP01
00119          10  OUT-AGENCY-SITE-ID-2    PIC X(08) VALUE 'TX      '.  DTSTOP01
00120          10  OUT-SEQ-NO-2            PIC 9(18).                   DTSTOP01
00121          10  OUT-ACTION-2            PIC X(01) VALUE 'A'.         DTSTOP01
00122          10  OUT-REC-TYPE-2          PIC X(01) VALUE '2'.         DTSTOP01
00123          10  OUT-EMP-ADDRESS-1       PIC X(30).                   DTSTOP01
00124          10  OUT-EMP-ADDRESS-2       PIC X(30) VALUE SPACES.      DTSTOP01
00125          10  OUT-EMP-CITY            PIC X(25) VALUE SPACES.      DTSTOP01
00126          10  OUT-EMP-STATE           PIC X(02).                   DTSTOP01
00127          10  OUT-EMP-ZIP             PIC X(09) VALUE SPACES.      DTSTOP01
00128          10  OUT-EMP-COUNTRY         PIC X(03) VALUE SPACES.      DTSTOP01
00129          10  OUT-DATE-DEBT           PIC X(08) VALUE SPACES.      DTSTOP01
00130          10  OUT-AMOUNT-2            PIC 9(10)V99.                   CL*14
00131          10  FILLER                  PIC X(44) VALUE SPACES.      DTSTOP01
00132          10  FILLER                  PIC X(1)  VALUE '%'.         DTSTOP01
00133      05  TOP-TRAILER.                                             DTSTOP01
00134          10  FILLER                  PIC X(04) VALUE 'TOP '.      DTSTOP01
00135          10  OUT-RECORDS             PIC 9(08) VALUE ZERO.        DTSTOP01
00136          10  OUT-TOTAL-DEBT          PIC 99999999999999.          DTSTOP01
00137          10  OUT-BATCH-DATE.                                      DTSTOP01
00138              15 OUT-BATCH-YEAR       PIC 9(04).                   DTSTOP01
00139              15 OUT-BATCH-MONTH      PIC 9(02).                   DTSTOP01
00140              15 OUT-BATCH-DAY        PIC 9(02).                   DTSTOP01
00141          10  FILLER                  PIC X(165) VALUE SPACES.     DTSTOP01
00142          10  FILLER                  PIC X(1)   VALUE '%'.        DTSTOP01
00143                                                                   DTSTOP01
00144      05  WRK-MQTR-CNT                PIC S9(07)  COMP-3.          DTSTOP01
00145      05  EMP-ACCT-DISP               PIC  9(06).                  DTSTOP01
00146      05  WRK-TIMELY-PMT-AREA.                                     DTSTOP01
00147          10  WRK-ERROR-IND           PIC X(01).                   DTSTOP01
00148              88  WRK-ERROR-YES-88        VALUE 'Y'.               DTSTOP01
00149              88  WRK-ERROR-NO-88         VALUE 'N'.               DTSTOP01
00150          10  WRK-MPAY-FOUND-IND      PIC X(01).                   DTSTOP01
00151              88  WRK-MPAY-FOUND-YES      VALUE 'Y'.               DTSTOP01
00152              88  WRK-MPAY-FOUND-NO       VALUE 'N'.               DTSTOP01
00153          10  WRK-MRPT-FOUND-IND      PIC X(01).                   DTSTOP01
00154              88  WRK-MRPT-FOUND-YES      VALUE 'Y'.               DTSTOP01
00155              88  WRK-MRPT-FOUND-NO       VALUE 'N'.               DTSTOP01
00156          10  WRK-EMP-SELECTED-IND    PIC X(01).                   DTSTOP01
00157              88  WRK-EMP-SELECTED-YES    VALUE 'Y'.               DTSTOP01
00158              88  WRK-EMP-SELECTED-NO     VALUE 'N'.               DTSTOP01
00159          10  WRK-SUPPL-RPT-IND       PIC X(01).                   DTSTOP01
00160              88  WRK-SUPPL-RPT-YES       VALUE 'Y'.               DTSTOP01
00161              88  WRK-SUPPL-RPT-NO        VALUE 'N'.               DTSTOP01
00162          10  WRK-WITHDRAWN-RPT-IND   PIC X(01).                   DTSTOP01
00163              88  WRK-WITHDRAWN-RPT-YES   VALUE 'Y'.               DTSTOP01
00164              88  WRK-WITHDRAWN-RPT-NO    VALUE 'N'.               DTSTOP01
00165          10  WRK-RPT-BATCH-NO        PIC S9(05)  COMP-3.          DTSTOP01
00166          10  WRK-RPT-ITEM-NO         PIC S9(03)  COMP-3.          DTSTOP01
00167          10  WRK-OPID                PIC X(08).                   DTSTOP01
00168          10  WRITE-OFF               PIC X(01)  VALUE SPACES.     DTSTOP01
00169          10  WRK-BALANCE-AMT         PIC ----------9.99.          DTSTOP01
00170                                                                   DTSTOP01
00171      05  WRK-CERTIFICATE-DATE        PIC 9(8) VALUE 0.            DTSTOP01
00172      05  WRK-TIMELY-RPT-AREA.                                     DTSTOP01
00173          10  WRK-RPT-RECEIVED-DATE   PIC S9(09)  COMP-3.          DTSTOP01
00174                                                                   DTSTOP01
00175      05  WRK-MNTE-MSG-LINE1.                                      DTSTOP01
00176          10  WRK-MNTE-MSG-YR         PIC X(04).                   DTSTOP01
00177          10  FILLER                  PIC X(01) VALUE '/'.         DTSTOP01
00178          10  WRK-MNTE-MSG-QTR        PIC X(01).                   DTSTOP01
00179          10  FILLER                  PIC X(44)  VALUE             DTSTOP01
00180          ' QUARTER ANNUAL REPORT FROM TDEC WAS PROCESS'.          DTSTOP01
00181          10  FILLER                  PIC  X(23)  VALUE            DTSTOP01
00182          'ED INCORRECTLY BY ESSP '.                               DTSTOP01
00183      05  WRK-MNTE-MSG-LINE2.                                      DTSTOP01
00184          10  FILLER                  PIC  X(48)  VALUE            DTSTOP01
00185          'REPORT WITHDRAWN AND REPOSTED CORRECTLY.        '.      DTSTOP01
00186          10  FILLER                  PIC  X(23)  VALUE            DTSTOP01
00187          '                       '.                               DTSTOP01
00188      05  WRK-MNTE-MSG-LINE3.                                      DTSTOP01
00189          10  FILLER                  PIC  X(12)  VALUE            DTSTOP01
00190          '            '.                                          DTSTOP01
00191                                                                   DTSTOP01
00192      05  WRK-MPRF-IND                PIC  X(01).                  DTSTOP01
00193          88 WRK-MPRF-OK           VALUE 'Y'.                      DTSTOP01
00194          88 WRK-MPRF-NO-REC       VALUE 'N'.                      DTSTOP01
00195      05  WRK-MQTR-IND                PIC  X(01).                  DTSTOP01
00196          88 WRK-MQTR-OK           VALUE 'Y'.                      DTSTOP01
00197          88 WRK-MQTR-NO-REC       VALUE 'N'.                      DTSTOP01
00198      05  WRK-MRPT-IND                PIC  X(01).                  DTSTOP01
00199          88 WRK-MRPT-OK           VALUE 'Y'.                      DTSTOP01
00200          88 WRK-MRPT-NO-REC       VALUE 'N'.                      DTSTOP01
00201                                                                   DTSTOP01
00202      05  WRK-T003-CNT                PIC S9(07)  COMP-3 VALUE +0. DTSTOP01
00203      05  PARM-REC-CNT                PIC S9(07)  COMP-3.          DTSTOP01
00204                                                                   DTSTOP01
00205      05  PARM-EOF-IND                    PIC  X(01).              DTSTOP01
00206                                                                   DTSTOP01
00207      05  WRK-EMP-NO                  PIC  9(06).                  DTSTOP01
00208                                                                   DTSTOP01
00209      05  WRK-TRACE-IND                   PIC  X(01).              DTSTOP01
00210                                                                   DTSTOP01
00211      05  WRK-ADDR-CNT                    PIC  9(01).              DTSTOP01
00212                                                                   DTSTOP01
00213      05  WRK-MST-OPEN-IND                PIC  X(01).              DTSTOP01
00214                                                                   DTSTOP01
00215      05  WRK-REF-OPEN-IND                PIC  X(01).              DTSTOP01
00216                                                                   DTSTOP01
00217 **   EJECT                                                        DTSTOP01
00218  01  TSKL-REC.                                                    DTSTOP01
00219  ++INCLUDE DTSITSKL                                               DTSTOP01
00220                                                                   DTSTOP01
00221  01  L005-LINK-AREA.                                              DTSTOP01
00222  ++INCLUDE DTSIL005                                               DTSTOP01
00223                                                                   DTSTOP01
00224  01  L910-LINK-AREA.                                              DTSTOP01
00225  ++INCLUDE DTSIL910                                               DTSTOP01
00226      EJECT                                                        DTSTOP01
00227  01  MSKL-REC.                                                    DTSTOP01
00228  ++INCLUDE DTSIMSKL                                               DTSTOP01
00229      EJECT                                                        DTSTOP01
00230  01  MHDR-REC.                                                    DTSTOP01
00231  ++INCLUDE DTSIMHDR                                               DTSTOP01
00232      EJECT                                                        DTSTOP01
00233  01  MPRF-REC.                                                    DTSTOP01
00234  ++INCLUDE DTSIMPRF                                               DTSTOP01
00235      EJECT                                                        DTSTOP01
00236  01  MQTR-REC.                                                    DTSTOP01
00237  ++INCLUDE DTSIMQTR                                               DTSTOP01
00238      EJECT                                                        DTSTOP01
00239  01  MRPT-REC.                                                    DTSTOP01
00240  ++INCLUDE DTSIMRPT                                               DTSTOP01
00241      EJECT                                                        DTSTOP01
00242  01  MDST-REC.                                                    DTSTOP01
00243  ++INCLUDE DTSIMDST                                               DTSTOP01
00244      EJECT                                                        DTSTOP01
00245  01  L111-LINK-AREA.                                              DTSTOP01
00246  ++INCLUDE DTSIL111                                               DTSTOP01
00247      EJECT                                                        DTSTOP01
00248  01  MPAY-REC.                                                    DTSTOP01
00249  ++INCLUDE DTSIMPAY                                               DTSTOP01
00250      EJECT                                                        DTSTOP01
00251  01  MTAD-REC.                                                    DTSTOP01
00252  ++INCLUDE DTSIMTAD                                               DTSTOP01
00253      EJECT                                                        DTSTOP01
00254  01  MNTE-REC.                                                    DTSTOP01
00255  ++INCLUDE DTSIMNTE                                               DTSTOP01
00256      EJECT                                                        DTSTOP01
00257  01  L923-LINK-AREA.                                              DTSTOP01
00258  ++INCLUDE DTSIL923                                               DTSTOP01
00259      EJECT                                                        DTSTOP01
00260  01  ASKL-REC.                                                    DTSTOP01
00261  ++INCLUDE DTSIASKL                                               DTSTOP01
00262      EJECT                                                        DTSTOP01
00263  01  MLIN-REC.                                                    DTSTOP01
00264  ++INCLUDE DTSIMLIN                                               DTSTOP01
00265      EJECT                                                        DTSTOP01
00266  01  AHDR-REC.                                                    DTSTOP01
00267  ++INCLUDE DTSIAHDR                                               DTSTOP01
00268      EJECT                                                        DTSTOP01
00269  01  ARPT-REC.                                                    DTSTOP01
00270  ++INCLUDE DTSIARPT                                               DTSTOP01
00271      EJECT                                                        DTSTOP01
00272  01  APAY-REC.                                                    DTSTOP01
00273  ++INCLUDE DTSIAPAY                                               DTSTOP01
00274      EJECT                                                        DTSTOP01
00275  01  L927-LINK-AREA.                                              DTSTOP01
00276  ++INCLUDE DTSIL927                                               DTSTOP01
00277                                                                   DTSTOP01
00278  01  L101-LINK-AREA.                                              DTSTOP01
00279  ++INCLUDE DTSIL101                                               DTSTOP01
00280                                                                   DTSTOP01
00281  01  L004-COMM-AREA.                                              DTSTOP01
00282  ++INCLUDE DTSIL004                                               DTSTOP01
00283      EJECT                                                        DTSTOP01
00284  01  TOP-HEADER.                                                  DTSTOP01
00285  ++INCLUDE DTSIXTPH                                               DTSTOP01
00286                                                                   DTSTOP01
00287  01  TOP-REC-1.                                                   DTSTOP01
00288  ++INCLUDE DTSIXTD1                                               DTSTOP01
00289                                                                   DTSTOP01
00290  01  L001-LINK-AREA.                                              DTSTOP01
00291  ++INCLUDE DTSIL001                                               DTSTOP01
00292  01  L112-LINK-AREA.                                              DTSTOP01
00293  ++INCLUDE DTSIL112                                               DTSTOP01
00294      EJECT                                                        DTSTOP01
00295                                                                   DTSTOP01
00296  PROCEDURE DIVISION.                                              DTSTOP01
00297                                                                   DTSTOP01
00298      PERFORM I0000-INITIATE THRU I0000-EXIT.                      DTSTOP01
00299      PERFORM P0000-PROCESS THRU P0000-EXIT.                       DTSTOP01
00300                                                                   DTSTOP01
00301      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     DTSTOP01
00302      SKIP2                                                        DTSTOP01
00303      GOBACK.                                                      DTSTOP01
00304      EJECT                                                        DTSTOP01
00305  I0000-INITIATE.                                                  DTSTOP01
00306                                                                   DTSTOP01
00307      MOVE 'N' TO WRK-TRACE-IND.                                   DTSTOP01
00308                                                                   DTSTOP01
00309      PERFORM I2000-OPEN-FILES-1        THRU I2000-EXIT.           DTSTOP01
00310                                                                   DTSTOP01
00311      PERFORM I3000-BATCH-HEADER        THRU I3000-EXIT.           DTSTOP01
00312                                                                   DTSTOP01
00313      PERFORM S005-FROM-SYS             THRU S005-EXIT.            DTSTOP01
00314                                                                   DTSTOP01
00315  I0000-EXIT.                                                      DTSTOP01
00316      EXIT.                                                        DTSTOP01
00317                                                                   DTSTOP01
00318  I2000-OPEN-FILES-1.                                              DTSTOP01
00319      MOVE WRK-TRACE-IND TO L910-TRACE-IND.                        DTSTOP01
00320                                                                   DTSTOP01
00321      MOVE WRK-MOD-NAME TO L910-MOD-NAME.                          DTSTOP01
00322                                                                   DTSTOP01
00323      PERFORM S910-OPEN-READ THRU S910-EXIT.                       DTSTOP01
00324 **   PERFORM S910-OPEN-UPDATE-NO-AIX THRU S910-EXIT.              DTSTOP01
00325 **   PERFORM S910-OPEN-UPDATE-HDR    THRU S910-EXIT.              DTSTOP01
00326      PERFORM S923-OPEN-READ THRU S923-EXIT.                       DTSTOP01
00327 **   PERFORM S927-OPEN-UPDATE         THRU S927-EXIT.             DTSTOP01
00328                                                                   DTSTOP01
00329      OPEN OUTPUT OUT-FILE.                                        DTSTOP01
00330      IF NOT Z057-FILE-OK-88                                       DTSTOP01
00331         DISPLAY 'OUTPUT FILE OPEN ERROR: ' Z057-STATUS            DTSTOP01
00332         PERFORM S999-ABEND THRU S999-EXIT                         DTSTOP01
00333      END-IF.                                                      DTSTOP01
00334                                                                   DTSTOP01
00335      OPEN INPUT  IN-FILE.                                         DTSTOP01
00336      IF NOT ZI57-FILE-OK-88                                       DTSTOP01
00337         DISPLAY 'INPUT  FILE OPEN ERROR: ' ZI57-STATUS            DTSTOP01
00338         PERFORM S999-ABEND THRU S999-EXIT                         DTSTOP01
00339      END-IF.                                                      DTSTOP01
00340                                                                   DTSTOP01
00341  I2000-EXIT.                                                      DTSTOP01
00342      EXIT.                                                        DTSTOP01
00343                                                                   DTSTOP01
00344  I3000-BATCH-HEADER.                                              DTSTOP01
00345      MOVE LOW-VALUES        TO MHDR-KEY-AREA.                     DTSTOP01
00346      MOVE +0 TO MHDR-EMP-NO.                                      DTSTOP01
00347      SET MHDR-HDR-88 TO TRUE.                                     DTSTOP01
00348      MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA.                         DTSTOP01
00349      PERFORM S910-READ THRU S910-EXIT.                            DTSTOP01
00350                                                                   DTSTOP01
00351      IF L910-NO-REC-88                                            DTSTOP01
00352         MOVE 'MHDR RECORD NOT FOUND (I0000)'                      DTSTOP01
00353           TO ABEND-MSG                                            DTSTOP01
00354         PERFORM S999-ABEND THRU S999-EXIT.                        DTSTOP01
00355                                                                   DTSTOP01
00356      MOVE MSKL-REC TO MHDR-REC.                                   DTSTOP01
00357                                                                   DTSTOP01
00358      MOVE MHDR-CURR-RUN-DATE     TO L001-FED-8-DATE-9             DTSTOP01
00359      PERFORM S001-FROM-FED-8     THRU S001-EXIT                   DTSTOP01
00360      MOVE L001-SLASH-8-DATE(1:2) TO OUT-BATCH-MM                  DTSTOP01
00361                                     OUT-BATCH-MONTH.              DTSTOP01
00362      MOVE L001-SLASH-8-DATE(4:2) TO OUT-BATCH-DD                  DTSTOP01
00363                                     OUT-BATCH-DAY.                DTSTOP01
00364      MOVE L001-SLASH-8-DATE(7:4) TO OUT-BATCH-YR                  DTSTOP01
00365                                     OUT-BATCH-YEAR.               DTSTOP01
00366      WRITE OUT-REC FROM TOP-HEADER-OUT.                           DTSTOP01
00367                                                                   DTSTOP01
00368 **   PERFORM S1000-INITIATE-AHDR       THRU S1000-EXIT.           DTSTOP01
00369      DISPLAY 'FIRST BATCH: ' AHDR-BATCH-NO.                       DTSTOP01
00370                                                                   DTSTOP01
00371  I3000-EXIT.                                                      DTSTOP01
00372      EXIT.                                                        DTSTOP01
00373                                                                   DTSTOP01
00374      EJECT                                                        DTSTOP01
00375  P0000-PROCESS.                                                   DTSTOP01
00376                                                                   DTSTOP01
00377      READ IN-FILE AT END GO TO P0000-EXIT.                        DTSTOP01
00378                                                                   DTSTOP01
00379      MOVE +0 TO WRK-MPRF-CNT                                      DTSTOP01
00380                 WRK-EXCLUDE-CNT                                   DTSTOP01
00381                 WRK-UPDATE-CNT                                    DTSTOP01
00382                 DIS-MLIN-AMT                                      DTSTOP01
00383                 DIS-MPRF-AMT                                      DTSTOP01
00384                 WRK-INTEREST-AMT.                                 DTSTOP01
00385      SET WRK-ERROR-NO-88     TO TRUE.                             DTSTOP01
00386                                                                   DTSTOP01
00387      MOVE 'A'         TO WS-ALPHA(1).                             DTSTOP01
00388      MOVE 'B'         TO WS-ALPHA(2).                             DTSTOP01
00389      MOVE 'C'         TO WS-ALPHA(3).                             DTSTOP01
00390      MOVE 'D'         TO WS-ALPHA(4).                             DTSTOP01
00391      MOVE 'E'         TO WS-ALPHA(5).                             DTSTOP01
00392      MOVE 'F'         TO WS-ALPHA(6).                             DTSTOP01
00393      MOVE 'G'         TO WS-ALPHA(7).                             DTSTOP01
00394      MOVE 'H'         TO WS-ALPHA(8).                             DTSTOP01
00395      MOVE 'I'         TO WS-ALPHA(9).                             DTSTOP01
00396      MOVE 'J'         TO WS-ALPHA(10).                            DTSTOP01
00397      MOVE 'K'         TO WS-ALPHA(11).                            DTSTOP01
00398      MOVE 'L'         TO WS-ALPHA(12).                            DTSTOP01
00399      MOVE 'M'         TO WS-ALPHA(13).                            DTSTOP01
00400      MOVE 'N'         TO WS-ALPHA(14).                            DTSTOP01
00401      MOVE 'O'         TO WS-ALPHA(15).                            DTSTOP01
00402      MOVE 'P'         TO WS-ALPHA(16).                            DTSTOP01
00403      MOVE 'Q'         TO WS-ALPHA(17).                            DTSTOP01
00404      MOVE 'R'         TO WS-ALPHA(18).                            DTSTOP01
00405      MOVE 'S'         TO WS-ALPHA(19).                            DTSTOP01
00406      MOVE 'T'         TO WS-ALPHA(20).                            DTSTOP01
00407                                                                   DTSTOP01
00408      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSTOP01
00409      MOVE LOW-VALUES TO MPRF-KEY-AREA.                            DTSTOP01
00410                                                                   DTSTOP01
00411      MOVE +0     TO MSKL-EMP-NO.                                  DTSTOP01
00412                                                                   DTSTOP01
00413      SET MPRF-PRF-88 TO TRUE.                                     DTSTOP01
00414      MOVE IN-EAN     TO MPRF-EMP-NO                               DTSTOP01
00415      MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA.                         DTSTOP01
00416      PERFORM S910-READ THRU S910-EXIT.                            DTSTOP01
00417      IF L910-OK-88                                                DTSTOP01
00418         MOVE MSKL-REC TO MPRF-REC                                 DTSTOP01
00419         SET WRK-MPRF-OK TO TRUE                                   DTSTOP01
00420      ELSE                                                         DTSTOP01
00421         DISPLAY 'BAD FIRST READ ' L910-RESULT-IND                 DTSTOP01
00422         SET L910-NO-REC-88 TO TRUE                                DTSTOP01
00423         GO TO P0000-EXIT.                                         DTSTOP01
00424                                                                   DTSTOP01
00425      DISPLAY 'LIST OF EMPLOYERS WITH BALANCE DUE GT ZERO.  '.     DTSTOP01
00426 *    DISPLAY 'REPORT DTSBZ063 - AUTOMATIC WITHDRAWALS      '.     DTSTOP01
00427 *    DISPLAY SPACE.                                               DTSTOP01
00428                                                                   DTSTOP01
00429      PERFORM P1000-READ-NEXT THRU P1000-EXIT                      DTSTOP01
00430         UNTIL WRK-MPRF-NO-REC                                     DTSTOP01
00431         OR WRK-ERROR-YES-88.                                      DTSTOP01
00432 **      OR MPRF-EMP-NO > 020999.                                  DTSTOP01
00433 **      OR WRK-REL-CNT > +100.                                    DTSTOP01
00434  P0000-EXIT.                                                      DTSTOP01
00435      EXIT.                                                        DTSTOP01
00436      EJECT                                                        DTSTOP01
00437  P1000-READ-NEXT.                                                 DTSTOP01
00438                                                                   DTSTOP01
00439      IF MPRF-BANKRP-OPEN-88                                       DTSTOP01
00440         DISPLAY 'IN-EAN1'   IN-EAN                                DTSTOP01
00441         GO TO P1000-READ-CONTINUE.                                DTSTOP01
00442                                                                   DTSTOP01
00443      IF MPRF-TOT-BALANCE-AMT < 99                                 DTSTOP01
00444         DISPLAY 'IN-EAN2'   IN-EAN                                DTSTOP01
00445         GO TO P1000-READ-CONTINUE.                                DTSTOP01
00446                                                                   DTSTOP01
00447      IF MPRF-ORG-HSEHLD-DMSTIC-88                                 DTSTOP01
00448         DISPLAY 'IN-EAN3'   IN-EAN                                DTSTOP01
00449         GO TO P1000-READ-CONTINUE.                                DTSTOP01
00450                                                                   DTSTOP01
00451 **   IF MPRF-ESTB-DATE < 20050101                                 DTSTOP01
00452 **      DISPLAY 'IN-EAN4'   IN-EAN                                DTSTOP01
00453 **      GO TO P1000-READ-CONTINUE.                                DTSTOP01
00454                                                                   DTSTOP01
00455 **   IF MPRF-ESTB-DATE > 20140701                                 DTSTOP01
00456 **      DISPLAY 'IN-EAN5'   IN-EAN                                DTSTOP01
00457 **      GO TO P1000-READ-CONTINUE.                                DTSTOP01
00458                                                                   DTSTOP01
00459      IF MPRF-NOT-WRITTEN-OFF-88                                   DTSTOP01
00460         MOVE 'N' TO WRITE-OFF                                     DTSTOP01
00461      ELSE                                                         DTSTOP01
00462         MOVE 'Y' TO WRITE-OFF.                                    DTSTOP01
00463                                                                   DTSTOP01
00464      MOVE ZEROS TO  DIS-MLIN-AMT WRK-MLIN-AMT                     DTSTOP01
00465                     DIS-MPRF-AMT WRK-MPRF-AMT.                    DTSTOP01
00466 **   MOVE ZEROS TO WRK-CERTIFICATE-DATE                           DTSTOP01
00467      ADD 1 TO WRK-READ-CNT.                                          CL*17
00468         DISPLAY '>>>>>>INREC-EAN  ' IN-EAN                           CL*17
00469      IF MPRF-MLIN-IND NOT = 'Y'                                      CL**9
00470         DISPLAY '>>>>>>MLIN-NOT Y ' MPRF-MLIN-IND                    CL*17
00471            GO TO P1000-READ-CONTINUE.                                CL**9
00472         MOVE MPRF-FEIN      TO OUT-FEIN                           DTSTOP01
00473         MOVE MPRF-PRIMARY-NAME TO OUT-EMP-LNAME                   DTSTOP01
00474         PERFORM P7000-SCAN-LIN THRU P7000-EXIT                    DTSTOP01
00475         MOVE WRK-MLIN-AMT   TO OUT-AMOUNT-2                          CL**5
00476         DISPLAY 'MLIN-AMT; ' WRK-MLIN-AMT                            CL*10
00477         DISPLAY 'MLIN-OUT; ' OUT-AMOUNT-2                            CL*10
00478         ADD WRK-MLIN-AMT    TO WRK-LIEN-AMT                       DTSTOP01
00479         IF WRK-MLIN-AMT > 0.00                                    DTSTOP01
00480            MOVE ZEROS  TO OUT-SEQ-NO(1:17)                        DTSTOP01
00481                           OUT-SEQ-NO-2(1:17)                      DTSTOP01
00482            MOVE IN-EAN TO OUT-SEQ-NO(12:6)                        DTSTOP01
00483                           OUT-SEQ-NO-2(12:6)                      DTSTOP01
00484            MOVE  MPRF-EMP-STATUS  TO OUT-DEBTOR-STATUS            DTSTOP01
00485 **      ELSE                                                      DTSTOP01
00486 **         GO TO P1000-READ-CONTINUE                              DTSTOP01
00487                                                                   DTSTOP01
00488 **      MOVE  MPRF-EMP-STATUS  TO OUT-DEBTOR-STATUS               DTSTOP01
00489                                                                   DTSTOP01
00490 **      IF OUT-DEBTOR-STATUS = 'A'                                DTSTOP01
00491            MOVE SPACES TO OUT-DEBTOR-STATUS                       DTSTOP01
00492 **      END-IF                                                    DTSTOP01
00493 **      WRITE OUT-REC FROM TOP-DETAIL-REC1                        DTSTOP01
00494         MOVE 1 TO WRK-ADDR-CNT                                    DTSTOP01
00495 *       DISPLAY 'MLIN-COVERED-YRQ '  MLIN-COVERED-YRQ(1)             CL**4
00496         PERFORM P4000-PROCESS-MTAD THRU P4000-EXIT.                  CL**8
00497 *           UNTIL L910-NO-REC-88.                                    CL**8
00498                                                                      CL*11
00499            GO TO P1000-READ-CONTINUE.                                CL*11
00500                                                                   DTSTOP01
00501  P4000-PROCESS-MTAD.                                              DTSTOP01
00502      IF MPRF-EMP-NO = 022647                                      DTSTOP01
00503         DISPLAY 'P4 ' MPRF-EMP-NO                                 DTSTOP01
00504      END-IF.                                                      DTSTOP01
00505                                                                   DTSTOP01
00506      MOVE LOW-VALUES             TO  MTAD-KEY-AREA.               DTSTOP01
00507      MOVE MPRF-EMP-NO            TO  MTAD-EMP-NO.                 DTSTOP01
00508      SET MTAD-TAD-88             TO  TRUE.                        DTSTOP01
00509      SET MTAD-ID-TAX-MAILING-ADDR-88 TO   TRUE.                      CL**4
00510                                                                      CL**4
00511      MOVE MTAD-KEY-AREA          TO  MSKL-KEY-AREA.               DTSTOP01
00512                                                                   DTSTOP01
00513 *    PERFORM S910-START-BROWSE  THRU  S910-EXIT.                     CL**4
00514      PERFORM S910-READ          THRU  S910-EXIT.                     CL**4
00515                                                                   DTSTOP01
00516      PERFORM P4100-SCAN-MTAD  THRU  P4100-EXIT.                      CL**4
00517 *        UNTIL L910-NO-REC-88.                                       CL**4
00518                                                                   DTSTOP01
00519  P4000-EXIT.                                                      DTSTOP01
00520      EXIT.                                                        DTSTOP01
00521      EJECT                                                        DTSTOP01
00522                                                                   DTSTOP01
00523                                                                   DTSTOP01
00524  P4100-SCAN-MTAD.                                                 DTSTOP01
00525                                                                   DTSTOP01
00526      MOVE MSKL-REC               TO  MTAD-REC.                    DTSTOP01
00527      IF MTAD-ID-NO = +001                                         DTSTOP01
00528 **                        AND WRK-ADDR-CNT = 0                    DTSTOP01
00529         PERFORM P4110-WRITE-MTAD-REC  THRU  P4110-EXIT.           DTSTOP01
00530                                                                   DTSTOP01
00531 *       PERFORM S910-READ-NEXT  THRU  S910-EXIT.                     CL**4
00532                                                                   DTSTOP01
00533  P4100-EXIT.                                                      DTSTOP01
00534      EXIT.                                                        DTSTOP01
00535      EJECT                                                        DTSTOP01
00536                                                                   DTSTOP01
00537                                                                   DTSTOP01
00538  P4110-WRITE-MTAD-REC.                                            DTSTOP01
00539                                                                   DTSTOP01
00540      MOVE LOW-VALUES           TO  L111-RETURN-AREA.              DTSTOP01
00541      MOVE MPRF-EMP-NO          TO  L111-EMP-NO.                   DTSTOP01
00542      SET L111-LOOKUP-TAD-88    TO  TRUE.                          DTSTOP01
00543                                                                   DTSTOP01
00544      SET L111-ID-NO-TAD-MAIL-88 TO TRUE.                          DTSTOP01
00545      MOVE MTAD-ID-NO           TO  L111-ID-NO.                    DTSTOP01
00546                                                                   DTSTOP01
00547      PERFORM S111-LOOKUP-ADDR  THRU  S111-EXIT.                   DTSTOP01
00548                                                                   DTSTOP01
00549      IF L111-ADDR-FOUND-88                                        DTSTOP01
00550          MOVE L111-ADDR-TYPE TO L112-ADDR-TYPE                    DTSTOP01
00551          SET L112-ANCHOR-FIRST-88  TO  TRUE.                      DTSTOP01
00552          SET L112-TAD-ADDR-88  TO  TRUE                           DTSTOP01
00553          MOVE L111-RETURN-AREA TO  L112-NAME-ADDRESS-AREA         DTSTOP01
00554 **       PERFORM P4111-FORMAT-ADDR  THRU P4111-EXIT               DTSTOP01
00555                                                                   DTSTOP01
00556                                                                   DTSTOP01
00557 *    MOVE MTAD-KEY-AREA        TO  MSKL-KEY-AREA.                    CL**4
00558 *    PERFORM S910-READ  THRU  S910-EXIT.                             CL**4
00559 *    IF L910-NO-REC-88                                               CL**4
00560 *        PERFORM S999-ABEND  THRU S999-EXIT.                         CL**4
00561                                                                   DTSTOP01
00562                                                                   DTSTOP01
00563 *    MOVE MSKL-REC               TO MTAD-REC.                        CL**4
00564                                                                   DTSTOP01
00565      IF MTAD-DELIV-LINE-2 > SPACES                                   CL*21
00566         MOVE MTAD-DELIV-LINE-1      TO OUT-EMP-ADDRESS-1          DTSTOP01
00567         MOVE MTAD-DELIV-LINE-2      TO OUT-EMP-ADDRESS-2          DTSTOP01
00568      ELSE                                                            CL*21
00569         MOVE MTAD-DELIV-LINE-1 TO OUT-EMP-ADDRESS-2                  CL*20
00570         MOVE SPACES            TO OUT-EMP-ADDRESS-1                  CL*20
00571      END-IF.                                                         CL*20
00572                                                                      CL*21
00573      MOVE MTAD-CITY              TO OUT-EMP-CITY                  DTSTOP01
00574      MOVE MTAD-ST                TO OUT-EMP-STATE                 DTSTOP01
00575      MOVE MTAD-ZIP(1:5)          TO OUT-EMP-ZIP(1:5)              DTSTOP01
00576      MOVE MTAD-ZIP(7:4)          TO OUT-EMP-ZIP(6:4)              DTSTOP01
00577                                                                      CL**4
00578      GO TO  P4110-CONTINUE.                                          CL**4
00579                                                                      CL**4
00580      IF MTAD-ID-NO = +001 AND WRK-ADDR-CNT = 1                    DTSTOP01
00581 *       PERFORM                                                      CL**5
00582 *       VARYING MLIN-COV-IDX  FROM +1 BY +1                          CL**5
00583 *       UNTIL MLIN-COV-IDX  > MLIN-COV-CNT                           CL**5
00584         PERFORM P5000-READ-MQTR THRU P5000-EXIT                      CL**4
00585          IF  L101-PAID-CHNG > ZEROS                                  CL**4
00586            MOVE MLIN-COVERED-YRQ(MLIN-COV-IDX) TO OUT-DEL-DATE       CL**4
00587           IF OUT-DEL-DATE(5:1) = 1                                   CL**4
00588            MOVE 0101 TO OUT-DEL-DATE(5:4)                         DTSTOP01
00589           ELSE                                                       CL**4
00590            IF OUT-DEL-DATE(5:1) = 2                               DTSTOP01
00591               MOVE 0401 TO OUT-DEL-DATE(5:4)                      DTSTOP01
00592            ELSE                                                   DTSTOP01
00593               IF OUT-DEL-DATE(5:1) = 3                            DTSTOP01
00594                  MOVE 0701 TO OUT-DEL-DATE(5:4)                   DTSTOP01
00595               ELSE                                                DTSTOP01
00596                  MOVE 1001 TO OUT-DEL-DATE(5:4)                   DTSTOP01
00597               END-IF                                              DTSTOP01
00598            END-IF                                                 DTSTOP01
00599          END-IF                                                      CL**4
00600         END-IF                                                       CL**4
00601         ADD 2 TO OUT-RECORDS.                                        CL**5
00602                                                                      CL**5
00603  P4110-CONTINUE.                                                     CL**4
00604         MOVE WS-ALPHA(MLIN-COV-IDX)  TO OUT-SEQ-NO(18:1)          DTSTOP01
00605                                         OUT-SEQ-NO-2(18:1)        DTSTOP01
00606         MOVE WRK-MPRF-AMT   TO OUT-AMOUNT                            CL**4
00607 *       MOVE WRK-LIEN-AMT   TO OUT-AMOUNT                            CL**4
00608 *       DISPLAY 'WAMT ' WRK-LIEN-AMT                                 CL**4
00609 *       DISPLAY 'OAMT ' OUT-AMOUNT                                   CL**4
00610         WRITE OUT-REC FROM TOP-DETAIL-REC1                        DTSTOP01
00611         WRITE OUT-REC FROM TOP-DETAIL-REC2                        DTSTOP01
00612 *       END-PERFORM                                                  CL**5
00613 *    END-IF.                                                         CL**5
00614                                                                   DTSTOP01
00615      ADD 1 TO WRK-ADDR-CNT.                                       DTSTOP01
00616         DISPLAY 'OUT-RECORDS '   OUT-RECORDS.                     DTSTOP01
00617 **   ELSE                                                         DTSTOP01
00618 **   PERFORM P1000-READ-CONTINUE.                                 DTSTOP01
00619                                                                   DTSTOP01
00620  P4110-EXIT.                                                      DTSTOP01
00621       EXIT.                                                       DTSTOP01
00622                                                                   DTSTOP01
00623  P1000-READ-CONTINUE.                                             DTSTOP01
00624                                                                   DTSTOP01
00625      READ IN-FILE AT END                                          DTSTOP01
00626         SET WRK-MPRF-NO-REC TO TRUE                               DTSTOP01
00627         GO TO P1000-EXIT.                                         DTSTOP01
00628      SET MPRF-PRF-88 TO TRUE.                                     DTSTOP01
00629      MOVE IN-EAN     TO MPRF-EMP-NO                               DTSTOP01
00630      MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA.                         DTSTOP01
00631      PERFORM S910-READ THRU S910-EXIT.                            DTSTOP01
00632      IF L910-OK-88                                                DTSTOP01
00633         MOVE MSKL-REC TO MPRF-REC                                 DTSTOP01
00634         SET WRK-MPRF-OK TO TRUE                                   DTSTOP01
00635      ELSE                                                         DTSTOP01
00636 **      DISPLAY 'BAD FIRST READ ' L910-RESULT-IND                 DTSTOP01
00637         SET L910-NO-REC-88 TO TRUE                                DTSTOP01
00638         GO TO P0000-EXIT.                                         DTSTOP01
00639 **   PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSTOP01
00640                                                                   DTSTOP01
00641 **   MOVE IN-EAN   TO MSKL-REC.                                   DTSTOP01
00642                                                                   DTSTOP01
00643 **   READ IN-FILE AT END                                          DTSTOP01
00644 **      SET WRK-MPRF-NO-REC TO TRUE                               DTSTOP01
00645 **      GO TO P1000-EXIT.                                         DTSTOP01
00646                                                                   DTSTOP01
00647 **   IF NOT L910-OK-88                                            DTSTOP01
00648 **      SET WRK-MPRF-NO-REC TO TRUE                               DTSTOP01
00649 **   ELSE                                                         DTSTOP01
00650 **      SET WRK-MPRF-OK TO TRUE                                   DTSTOP01
00651 **      MOVE MSKL-REC TO MPRF-REC.                                DTSTOP01
00652                                                                   DTSTOP01
00653  P1000-EXIT.                                                      DTSTOP01
00654      EXIT.                                                        DTSTOP01
00655                                                                   DTSTOP01
00656  P7000-SCAN-LIN.                                                  DTSTOP01
00657                                                                   DTSTOP01
00658      MOVE 'Y' TO WRK-MLIN-IND.                                    DTSTOP01
00659      MOVE ZEROS TO WRK-MLIN-AMT                                   DTSTOP01
00660      MOVE ZEROS TO DIS-MLIN-AMT                                   DTSTOP01
00661      MOVE LOW-VALUES  TO MLIN-KEY-AREA.                           DTSTOP01
00662      MOVE MPRF-EMP-NO TO MLIN-EMP-NO.                             DTSTOP01
00663      SET MLIN-LIN-88  TO TRUE.                                    DTSTOP01
00664      MOVE MLIN-KEY-AREA TO MSKL-KEY-AREA.                         DTSTOP01
00665                                                                   DTSTOP01
00666      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSTOP01
00667      IF L910-NO-REC-88                                            DTSTOP01
00668         GO TO P7000-EXIT                                          DTSTOP01
00669      ELSE                                                         DTSTOP01
00670         PERFORM P7100-SCAN-MLIN THRU P7100-EXIT                   DTSTOP01
00671           UNTIL WRK-MLIN-NO-REC.                                  DTSTOP01
00672                                                                   DTSTOP01
00673  P7000-EXIT.                                                      DTSTOP01
00674      EXIT.                                                        DTSTOP01
00675  P7100-SCAN-MLIN.                                                 DTSTOP01
00676                                                                   DTSTOP01
00677                                                                   DTSTOP01
00678      MOVE MSKL-REC TO MLIN-REC.                                   DTSTOP01
00679                                                                   DTSTOP01
00680      IF MLIN-STATUS-ACTIVE-88                                     DTSTOP01
00681 *       PERFORM 7200-READ-PROFILE THRU 7200-EXIT                  DTSTOP01
00682 *       MOVE MLIN-COMP-DATE TO WRK-CERTIFICATE-DATE               DTSTOP01
00683         P5000-READ-MQTR THRU P5000-EXIT                              CL*22
00684         ADD  MLIN-STMT-DUE-AMT TO WRK-TOT-MLIN-AMT                   CL*19
00685         ADD  MLIN-STMT-DUE-AMT TO WRK-MLIN-AMT                       CL*19
00686         MOVE WRK-MLIN-AMT      TO WRK-MLIN-AMTD.                     CL*15
00687 **      SET WRK-MLIN-NO-REC TO TRUE                               DTSTOP01
00688 **      GO TO P7100-EXIT.                                         DTSTOP01
00689                                                                   DTSTOP01
00690      PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSTOP01
00691      IF L910-NO-REC-88                                            DTSTOP01
00692        DISPLAY '>>>> LIEN AMT: ' MLIN-EMP-NO ' ' WRK-MLIN-AMT        CL*19
00693        DISPLAY ' DISPLIEN AMT: ' WRK-MLIN-AMTD                       CL*19
00694         SET WRK-MLIN-NO-REC TO TRUE.                              DTSTOP01
00695                                                                   DTSTOP01
00696  P7100-EXIT.                                                      DTSTOP01
00697      EXIT.                                                        DTSTOP01
00698                                                                   DTSTOP01
00699  P5000-READ-MQTR.                                                 DTSTOP01
00700        DISPLAY '>>>> P5000-READ-MQTR>>>> ' MPRF-EMP-NO.           DTSTOP01
00701      MOVE LOW-VALUES  TO MQTR-KEY-AREA.                           DTSTOP01
00702      MOVE MPRF-EMP-NO TO MQTR-EMP-NO.                             DTSTOP01
00703      MOVE MLIN-COVERED-YRQ(MLIN-COV-IDX) TO                       DTSTOP01
00704                             MQTR-YRQ.                             DTSTOP01
00705      MOVE ZEROS  TO WRK-MPRF-AMT.                                 DTSTOP01
00706                                                                   DTSTOP01
00707      SET MQTR-QTR-88  TO TRUE.                                    DTSTOP01
00708      MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSTOP01
00709                                                                   DTSTOP01
00710      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSTOP01
00711                                                                   DTSTOP01
00712      IF L910-NO-REC-88                                            DTSTOP01
00713         DISPLAY ' BQTR REC NOT FOUND ' MPRF-EMP-NO                DTSTOP01
00714         GO TO P5000-EXIT.                                         DTSTOP01
00715      PERFORM S910-READ THRU S910-EXIT.                            DTSTOP01
00716                                                                   DTSTOP01
00717      IF L910-NO-REC-88                                            DTSTOP01
00718         DISPLAY ' RQTR REC NOT FOUND ' MPRF-EMP-NO                DTSTOP01
00719         GO TO P5000-EXIT.                                         DTSTOP01
00720                                                                   DTSTOP01
00721      MOVE MSKL-REC TO MQTR-REC.                                   DTSTOP01
00722      PERFORM P5100-MQTR-SCAN THRU P5100-EXIT.                     DTSTOP01
00723 **         UNTIL L910-NO-REC-88.                                  DTSTOP01
00724                                                                   DTSTOP01
00725                                                                   DTSTOP01
00726  P5000-EXIT.                                                      DTSTOP01
00727      EXIT.                                                        DTSTOP01
00728                                                                   DTSTOP01
00729  P5100-MQTR-SCAN.                                                 DTSTOP01
00730        DISPLAY '>>>> P5100-READ-MQTR>>> ' MPRF-EMP-NO.            DTSTOP01
00731      MOVE ZEROS TO L101-PAID-CHNG.                                DTSTOP01
00732 **   PERFORM                                                      DTSTOP01
00733 **      VARYING MQTR-ACCT-IDX FROM +1 BY +1                       DTSTOP01
00734 **      UNTIL MQTR-ACCT-IDX > 3                                   DTSTOP01
00735 **      VARYING                                                   DTSTOP01
00736 **      UNTIL  MLIN-COVERED-YRQ(MLIN-COV-IDX) =                   DTSTOP01
00737 **                              MQTR-YRQ                          DTSTOP01
00738                                                                   DTSTOP01
00739 **   DISPLAY ' MLIN-COVERED-YRQ(MLIN-COV-IDX) '                   DTSTOP01
00740 **               MLIN-COVERED-YRQ(MLIN-COV-IDX)                   DTSTOP01
00741 *    DISPLAY ' MQTR-BALANCE-AMT '                                    CL**4
00742 *                MQTR-BALANCE-AMT(1)                                 CL**4
00743 *        MOVE MQTR-BALANCE-AMT (1)                                   CL**4
00744 *                             TO WRK-MPRF-AMT                        CL**4
00745 *       ADD WRK-MPRF-AMT   TO  WRK-MLIN-AMT                          CL**4
00746 *       DISPLAY 'WRK-MPRF-AMT ' WRK-MPRF-AMT                         CL**4
00747 *       DISPLAY 'WRK-MLIN-AMT '  WRK-MLIN-AMT                        CL**4
00748 **   END-PERFORM.                                                 DTSTOP01
00749 *    DISPLAY 'MQTR AMT: ' MQTR-BALANCE-AMT (MQTR-ACCT-IDX)           CL**4
00750 *    DISPLAY 'WRK  AMT: ' WRK-MPRF-AMT.                              CL**4
00751 *    IF MQTR-BALANCE-AMT (MQTR-ACCT-IDX) > 0                      DTSTOP01
00752 *       PERFORM P5001-READ-MRPT THRU P5001-EXIT                   DTSTOP01
00753 *      END-IF                                                     DTSTOP01
00754      IF MQTR-ACCT-TAX-88 (MQTR-ACCT-IDX)                             CL**4
00755          ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX)                        CL**4
00756           TO L101-PAID-CHNG                                          CL**4
00757      END-IF                                                          CL**4
00758                                                                      CL**4
00759       IF L101-PAID-CHNG > +0                                         CL**4
00760           NEXT SENTENCE                                              CL**4
00761       ELSE                                                           CL**4
00762           GO TO P5100-EXIT.                                          CL**5
00763                                                                      CL**4
00764      MOVE MHDR-CURR-RUN-DATE TO L101-RECEIVED-DATE.                  CL**4
00765 *    IF L101-RECEIVED-DATE > 0                                    DTSTOP01
00766 *         NEXT SENTENCE                                           DTSTOP01
00767 *     ELSE                                                        DTSTOP01
00768 *       DISPLAY ' RPT REC NOT FOUND- NO INT ' MPRF-EMP-NO         DTSTOP01
00769 *         GO TO P5100-CONTINUE.                                   DTSTOP01
00770 *                                                                 DTSTOP01
00771       SET L101-WAIVE-INT-NO-88 TO TRUE.                              CL**4
00772 *     SET L101-ABATE-PEN-NO-88 TO TRUE.                              CL**5
00773 *                                                                 DTSTOP01
00774       MOVE MQTR-TAX-DUE-DATE TO L101-TAX-DUE-DATE.                   CL**4
00775 *                                                                 DTSTOP01
00776       MOVE MQTR-INT-AREA TO L101-INT-AREA.                           CL**4
00777 *                                                                 DTSTOP01
00778       PERFORM S101-PER-MONTH-YES THRU S101-EXIT.                     CL**4
00779 *                                                                 DTSTOP01
00780 *     ADD L101-INT-CHARGE-CHNG TO WRK-MPRF-AMT.                      CL**4
00781       MOVE L101-INT-CHARGE-CHNG TO WRK-MPRF-AMT.                     CL**4
00782 *                                                                 DTSTOP01
00783 *P5100-CONTINUE.                                                  DTSTOP01
00784 *     MOVE MQTR-REC TO MSKL-REC.                                  DTSTOP01
00785 *      PERFORM S910-READ-NEXT THRU S910-EXIT.                     DTSTOP01
00786 *      IF L910-NO-REC-88                                          DTSTOP01
00787 *       SET L910-NO-REC-88 TO TRUE                                DTSTOP01
00788 *       GO TO P5100-EXIT.                                         DTSTOP01
00789 *                                                                 DTSTOP01
00790 *     MOVE MSKL-REC TO MQTR-REC.                                  DTSTOP01
00791                                                                   DTSTOP01
00792  P5100-EXIT.                                                      DTSTOP01
00793      EXIT.                                                        DTSTOP01
00794                                                                   DTSTOP01
00795  P5001-READ-MRPT.                                                 DTSTOP01
00796 *      DISPLAY '>>>> P5001-READ-MRPT>>>>> ' MPRF-EMP-NO.          DTSTOP01
00797      MOVE LOW-VALUES  TO MRPT-KEY-AREA.                           DTSTOP01
00798      MOVE MPRF-EMP-NO TO MRPT-EMP-NO.                             DTSTOP01
00799      MOVE MQTR-YRQ    TO MRPT-YRQ                                 DTSTOP01
00800                                                                   DTSTOP01
00801      SET MRPT-RPT-88  TO TRUE.                                    DTSTOP01
00802      MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA.                         DTSTOP01
00803                                                                   DTSTOP01
00804      MOVE ZEROS              TO L101-RECEIVED-DATE.               DTSTOP01
00805      PERFORM S910-START-BROWSE  THRU S910-EXIT.                   DTSTOP01
00806                                                                   DTSTOP01
00807      IF L910-NO-REC-88                                            DTSTOP01
00808         DISPLAY ' RPT REC NOT FOUND ' MPRF-EMP-NO                 DTSTOP01
00809         MOVE MHDR-CURR-RUN-DATE TO L101-RECEIVED-DATE             DTSTOP01
00810         GO TO P5001-EXIT.                                         DTSTOP01
00811                                                                   DTSTOP01
00812      PERFORM P5002-MRPT-SCAN THRU P5002-EXIT                      DTSTOP01
00813            UNTIL L910-NO-REC-88.                                  DTSTOP01
00814                                                                   DTSTOP01
00815                                                                   DTSTOP01
00816  P5001-EXIT.                                                      DTSTOP01
00817      EXIT.                                                        DTSTOP01
00818                                                                   DTSTOP01
00819  P5002-MRPT-SCAN.                                                 DTSTOP01
00820 *      DISPLAY '>>>> P5002-SCAN-MRPT>>> ' MPRF-EMP-NO.            DTSTOP01
00821      MOVE MSKL-REC TO MRPT-REC.                                   DTSTOP01
00822      IF MRPT-ORIG-88 OR MRPT-ESTIM-88                             DTSTOP01
00823         MOVE MRPT-RECEIVED-DATE TO L101-RECEIVED-DATE             DTSTOP01
00824         SET L910-NO-REC-88 TO TRUE                                DTSTOP01
00825         GO TO P5002-EXIT.                                         DTSTOP01
00826                                                                   DTSTOP01
00827       MOVE MRPT-REC TO MSKL-REC.                                  DTSTOP01
00828        PERFORM S910-READ-NEXT THRU S910-EXIT.                     DTSTOP01
00829        IF L910-NO-REC-88                                          DTSTOP01
00830         SET L910-NO-REC-88 TO TRUE                                DTSTOP01
00831         GO TO P5002-EXIT.                                         DTSTOP01
00832                                                                   DTSTOP01
00833                                                                   DTSTOP01
00834  P5002-EXIT.                                                      DTSTOP01
00835      EXIT.                                                        DTSTOP01
00836  P5111-SUM-PENALTY.                                               DTSTOP01
00837      PERFORM                                                      DTSTOP01
00838         VARYING MQTR-ACCT-IDX FROM +1 BY +1                       DTSTOP01
00839         UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT                       DTSTOP01
00840            IF MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX)               DTSTOP01
00841               ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX)                DTSTOP01
00842                                 TO WRK-PENALTY-AMT                DTSTOP01
00843            ELSE                                                   DTSTOP01
00844               IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX)                  DTSTOP01
00845                  ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX)             DTSTOP01
00846                                 TO WRK-UI-BAL                     DTSTOP01
00847               END-IF                                              DTSTOP01
00848            END-IF                                                 DTSTOP01
00849      END-PERFORM.                                                 DTSTOP01
00850                                                                   DTSTOP01
00851  P5111-EXIT.                                                      DTSTOP01
00852      EXIT.                                                        DTSTOP01
00853                                                                   DTSTOP01
00854                                                                   DTSTOP01
00855 **5120-FIND-REPORT.                                               DTSTOP01
00856 **                                                                DTSTOP01
00857 **   DISPLAY '*** P5120-1 ' MPRF-EMP-NO                           DTSTOP01
00858 **         '  ' MQTR-YRQ.                                         DTSTOP01
00859 **                                                                DTSTOP01
00860 **   SET WRK-EMP-SELECTED-NO TO TRUE                              DTSTOP01
00861 **   MOVE ZERO TO WRK-RPT-RECEIVED-DATE                           DTSTOP01
00862 **                WRK-RPT-BATCH-NO                                DTSTOP01
00863 **                WRK-RPT-ITEM-NO.                                DTSTOP01
00864 **   SET WRK-SUPPL-RPT-NO TO TRUE.                                DTSTOP01
00865 **   SET WRK-WITHDRAWN-RPT-NO TO TRUE.                            DTSTOP01
00866 **                                                                DTSTOP01
00867 **   MOVE LOW-VALUES  TO MRPT-KEY-AREA.                           DTSTOP01
00868 **   MOVE MPRF-EMP-NO TO MRPT-EMP-NO.                             DTSTOP01
00869 **   MOVE MQTR-YRQ    TO MRPT-YRQ.                                DTSTOP01
00870 **   MOVE ZEROS       TO MRPT-BATCH-NO.                           DTSTOP01
00871 **   MOVE ZEROS       TO MRPT-ITEM-NO                             DTSTOP01
00872 **                                                                DTSTOP01
00873 **   SET MRPT-RPT-88  TO TRUE.                                    DTSTOP01
00874 **   MOVE MRPT-REC TO MSKL-REC.                                   DTSTOP01
00875 **                                                                DTSTOP01
00876 **   PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSTOP01
00877 **   IF L910-OK-88                                                DTSTOP01
00878 **      PERFORM P5121-SCAN-MRPT THRU P5121-EXIT                   DTSTOP01
00879 **         UNTIL L910-NO-REC-88.                                  DTSTOP01
00880 **                                                                DTSTOP01
00881 **   IF WRK-EMP-SELECTED-YES                                      DTSTOP01
00882 **      SET WRK-MRPT-OK     TO TRUE                               DTSTOP01
00883 **      DISPLAY ' MRPT REPORT SELECTED ' MPRF-EMP-NO ' ' MRPT-YRQ DTSTOP01
00884 **      GO TO P5120-EXIT                                          DTSTOP01
00885 **   END-IF.                                                      DTSTOP01
00886 **                                                                DTSTOP01
00887 **                                                                DTSTOP01
00888 **5120-EXIT.                                                      DTSTOP01
00889 **   EXIT.                                                        DTSTOP01
00890                                                                   DTSTOP01
00891 **5121-SCAN-MRPT.                                                 DTSTOP01
00892 **   MOVE MSKL-REC TO MRPT-REC.                                   DTSTOP01
00893      IF MRPT-YRQ = MQTR-YRQ                                       DTSTOP01
00894         NEXT SENTENCE                                             DTSTOP01
00895      ELSE                                                         DTSTOP01
00896         IF MRPT-YRQ > MQTR-YRQ                                    DTSTOP01
00897            SET WRK-EMP-SELECTED-NO TO TRUE                        DTSTOP01
00898            SET L910-NO-REC-88  TO TRUE                            DTSTOP01
00899            GO TO P5121-EXIT                                       DTSTOP01
00900         ELSE                                                      DTSTOP01
00901            GO TO P5121-READ-NEXT                                  DTSTOP01
00902         END-IF                                                    DTSTOP01
00903      END-IF.                                                      DTSTOP01
00904                                                                   DTSTOP01
00905      IF MRPT-ORIG-88 AND MRPT-RESPONSIBLE-OP-ID = 'WEBESSP '      DTSTOP01
00906               MOVE MRPT-BATCH-NO TO WRK-RPT-BATCH-NO              DTSTOP01
00907               MOVE MRPT-ITEM-NO TO WRK-RPT-ITEM-NO                DTSTOP01
00908               SET WRK-EMP-SELECTED-YES TO TRUE                    DTSTOP01
00909               SET L910-NO-REC-88  TO TRUE                         DTSTOP01
00910               GO TO P5121-EXIT                                    DTSTOP01
00911      END-IF.                                                      DTSTOP01
00912                                                                   DTSTOP01
00913                                                                   DTSTOP01
00914  P5121-READ-NEXT.                                                 DTSTOP01
00915      PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSTOP01
00916      IF L910-NO-REC-88                                            DTSTOP01
00917         SET WRK-MRPT-NO-REC TO TRUE.                              DTSTOP01
00918                                                                   DTSTOP01
00919  P5121-EXIT.                                                      DTSTOP01
00920      EXIT.                                                        DTSTOP01
00921                                                                   DTSTOP01
00922                                                                   DTSTOP01
00923  P5131-READ-MRPT-MPAY.                                            DTSTOP01
00924 **   DISPLAY 'P5131 READ MRPT MPAY '                              DTSTOP01
00925      SET WRK-MPAY-FOUND-YES TO TRUE.                              DTSTOP01
00926      SET WRK-MRPT-FOUND-YES TO TRUE.                              DTSTOP01
00927      MOVE ZERO TO WRK-REMIT-AMT.                                  DTSTOP01
00928                                                                   DTSTOP01
00929      MOVE LOW-VALUES  TO MRPT-KEY-AREA.                           DTSTOP01
00930      MOVE MPRF-EMP-NO TO MRPT-EMP-NO.                             DTSTOP01
00931      MOVE MQTR-YRQ    TO MRPT-YRQ.                                DTSTOP01
00932      MOVE WRK-RPT-BATCH-NO TO MRPT-BATCH-NO                       DTSTOP01
00933      MOVE WRK-RPT-ITEM-NO  TO MRPT-ITEM-NO.                       DTSTOP01
00934      SET MRPT-RPT-88  TO TRUE.                                    DTSTOP01
00935      MOVE MRPT-REC TO MSKL-REC.                                   DTSTOP01
00936                                                                   DTSTOP01
00937      PERFORM S910-READ         THRU S910-EXIT.                    DTSTOP01
00938      IF L910-OK-88                                                DTSTOP01
00939         DISPLAY ' MRPT-EMP-NO '   MRPT-EMP-NO                     DTSTOP01
00940         DISPLAY ' MRPT-YRQ '      MRPT-YRQ                        DTSTOP01
00941         DISPLAY ' MRPT-BATCH-NO ' MRPT-BATCH-NO                   DTSTOP01
00942         DISPLAY ' MRPT-ITEM-NO ' MRPT-ITEM-NO                     DTSTOP01
00943         MOVE MSKL-REC TO MRPT-REC                                 DTSTOP01
00944      ELSE                                                         DTSTOP01
00945         DISPLAY 'CANNOT FIND MRPT ' MPRF-EMP-NO                   DTSTOP01
00946         SET WRK-MRPT-FOUND-NO TO TRUE                             DTSTOP01
00947         GO TO P5131-EXIT.                                         DTSTOP01
00948                                                                   DTSTOP01
00949      MOVE LOW-VALUES  TO MPAY-KEY-AREA.                           DTSTOP01
00950      MOVE MPRF-EMP-NO TO MPAY-EMP-NO.                             DTSTOP01
00951      MOVE WRK-RPT-BATCH-NO TO MPAY-BATCH-NO                       DTSTOP01
00952      MOVE WRK-RPT-ITEM-NO  TO MPAY-ITEM-NO.                       DTSTOP01
00953      SET MPAY-PAY-88  TO TRUE.                                    DTSTOP01
00954      MOVE MPAY-REC TO MSKL-REC.                                   DTSTOP01
00955                                                                   DTSTOP01
00956      PERFORM S910-READ         THRU S910-EXIT.                    DTSTOP01
00957      IF L910-OK-88                                                DTSTOP01
00958         MOVE MSKL-REC TO MPAY-REC                                 DTSTOP01
00959         MOVE MPAY-REMIT-AMT TO WRK-REMIT-AMT                      DTSTOP01
00960         DISPLAY 'MPAY-EMP-NO '  MPAY-EMP-NO                       DTSTOP01
00961         DISPLAY 'MPAY-BATCH-NO ' MPAY-BATCH-NO                    DTSTOP01
00962         DISPLAY 'MPAY-ITEM-NO ' MPAY-ITEM-NO                      DTSTOP01
00963      ELSE                                                         DTSTOP01
00964         DISPLAY 'CANNOT FIND MPAY ' MPRF-EMP-NO                   DTSTOP01
00965         SET WRK-MPAY-FOUND-NO TO TRUE                             DTSTOP01
00966         GO TO P5131-EXIT.                                         DTSTOP01
00967                                                                   DTSTOP01
00968  P5131-EXIT.                                                      DTSTOP01
00969      EXIT.                                                        DTSTOP01
00970                                                                   DTSTOP01
00971  P5132-WITHDRAW-MRPT.                                             DTSTOP01
00972 *    DISPLAY 'P5132 WITHDRAW MRPT '                               DTSTOP01
00973      IF WRK-MRPT-FOUND-NO                                         DTSTOP01
00974         GO TO P5132-EXIT.                                         DTSTOP01
00975                                                                   DTSTOP01
00976      MOVE LOW-VALUES TO ARPT-REC.                                 DTSTOP01
00977                                                                   DTSTOP01
00978      IF AHDR-ATC-FILE-TRAN-CNT < +999                             DTSTOP01
00979         NEXT SENTENCE                                             DTSTOP01
00980      ELSE                                                         DTSTOP01
00981         PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT              DTSTOP01
00982 **      PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT.              DTSTOP01
00983                                                                   DTSTOP01
00984      MOVE AHDR-BATCH-NO TO ARPT-BATCH-NO.                         DTSTOP01
00985      ADD +1 TO AHDR-ATC-FILE-TRAN-CNT.                            DTSTOP01
00986      MOVE AHDR-ATC-FILE-TRAN-CNT TO ARPT-ITEM-NO.                 DTSTOP01
00987      SET ARPT-RPT-88 TO TRUE.                                     DTSTOP01
00988                                                                   DTSTOP01
00989      MOVE MPRF-PRIMARY-NAME TO ARPT-NAME-CHECK.                   DTSTOP01
00990      MOVE MPRF-EMP-NO TO ARPT-EMP-NO.                             DTSTOP01
00991      SET ARPT-WITHDRW-88 TO TRUE.                                 DTSTOP01
00992      MOVE MQTR-YRQ       TO ARPT-YRQ.                             DTSTOP01
00993                                                                   DTSTOP01
00994      COMPUTE ARPT-TOT-WAGE =                                      DTSTOP01
00995         -1 * MRPT-TOT-WAGE.                                       DTSTOP01
00996      COMPUTE ARPT-TAX-WAGE =                                      DTSTOP01
00997         -1 * MRPT-TAX-WAGE.                                       DTSTOP01
00998      COMPUTE ARPT-EXCESS-WAGE =                                   DTSTOP01
00999         -1 * MRPT-EXCESS-WAGE.                                    DTSTOP01
01000                                                                   DTSTOP01
01001      MOVE +0 TO ARPT-REMIT-AMT.                                   DTSTOP01
01002      SET ARPT-WAGE-RPT-NO-ENTRY-88 TO TRUE.                       DTSTOP01
01003      SET ARPT-WAIVE-BOTH-NO-88                                    DTSTOP01
01004          ARPT-WAIVE-INT-NO-88                                     DTSTOP01
01005          ARPT-WAIVE-LATE-PEN-NO-88                                DTSTOP01
01006          ARPT-STATUS-CHNG-NO-88    TO TRUE.                       DTSTOP01
01007                                                                   DTSTOP01
01008      SET ARPT-TOTAL-NO-ENTRY-88                                   DTSTOP01
01009          ARPT-1ST-MTH-NO-ENTRY-88                                 DTSTOP01
01010          ARPT-2ND-MTH-NO-ENTRY-88                                 DTSTOP01
01011          ARPT-3RD-MTH-NO-ENTRY-88 TO TRUE.                        DTSTOP01
01012                                                                   DTSTOP01
01013      SET ARPT-VERIFIED-NO-88 TO TRUE.                             DTSTOP01
01014      MOVE +0 TO ARPT-RECEIVED-DATE                                DTSTOP01
01015                 ARPT-DEPOSIT-DATE.                                DTSTOP01
01016      MOVE 'SYS' TO ARPT-RESPONSIBLE-ACTIVITY.                     DTSTOP01
01017      MOVE SPACES TO ARPT-RESPONSIBLE-OP-ID.                       DTSTOP01
01018      MOVE SPACE TO ARPT-DISREGARD-EDITS-IND.                      DTSTOP01
01019      SET ARPT-PASSED-FULL-EDITS-YES-88 TO TRUE.                   DTSTOP01
01020      MOVE +0 TO ARPT-PROCESSED-DATE                               DTSTOP01
01021                 ARPT-TRACE-NO                                     DTSTOP01
01022                 ARPT-PSEUDO-BATCH-NO                              DTSTOP01
01023                 ARPT-PSEUDO-ITEM-NO.                              DTSTOP01
01024                                                                   DTSTOP01
01025      MOVE ARPT-REC TO ASKL-REC.                                   DTSTOP01
01026 **   DISPLAY 'ARPT-NAME-CHECK '   ARPT-NAME-CHECK                 DTSTOP01
01027 **   DISPLAY 'ARPT-EMP-NO '   ARPT-EMP-NO                         DTSTOP01
01028 **   DISPLAY 'ARPT-YRQ ' ARPT-YRQ                                 DTSTOP01
01029      PERFORM S923-WRITE THRU S923-EXIT.                           DTSTOP01
01030                                                                   DTSTOP01
01031      DISPLAY 'P5132 REPORT WITHDRAWN ' ARPT-EMP-NO ' ' ARPT-YRQ.  DTSTOP01
01032  P5132-EXIT.                                                      DTSTOP01
01033      EXIT.                                                        DTSTOP01
01034                                                                   DTSTOP01
01035  P5133-REVERSE-MPAY.                                              DTSTOP01
01036                                                                   DTSTOP01
01037 **   DISPLAY 'P5133 REVERSE MPAY '                                DTSTOP01
01038      IF WRK-MPAY-FOUND-NO                                         DTSTOP01
01039         GO TO P5133-EXIT.                                         DTSTOP01
01040                                                                   DTSTOP01
01041      MOVE LOW-VALUES TO APAY-REC.                                 DTSTOP01
01042                                                                   DTSTOP01
01043      IF AHDR-ATC-FILE-TRAN-CNT < +999                             DTSTOP01
01044         NEXT SENTENCE                                             DTSTOP01
01045      ELSE                                                         DTSTOP01
01046         PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT              DTSTOP01
01047 **      PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT.              DTSTOP01
01048                                                                   DTSTOP01
01049      MOVE AHDR-BATCH-NO TO APAY-BATCH-NO.                         DTSTOP01
01050      ADD +1 TO AHDR-ATC-FILE-TRAN-CNT.                            DTSTOP01
01051      MOVE AHDR-ATC-FILE-TRAN-CNT TO APAY-ITEM-NO.                 DTSTOP01
01052      SET APAY-PAY-88 TO TRUE.                                     DTSTOP01
01053                                                                   DTSTOP01
01054      MOVE MPRF-PRIMARY-NAME TO APAY-NAME-CHECK.                   DTSTOP01
01055      MOVE MPRF-EMP-NO TO APAY-EMP-NO.                             DTSTOP01
01056      SET APAY-PAY-REV-88 TO TRUE.                                 DTSTOP01
01057                                                                   DTSTOP01
01058      COMPUTE APAY-REMIT-AMT =                                     DTSTOP01
01059         -1 * MPAY-REMIT-AMT.                                      DTSTOP01
01060                                                                   DTSTOP01
01061      ADD APAY-REMIT-AMT    TO AHDR-ATC-FILE-REMIT-AMT.            DTSTOP01
01062                                                                   DTSTOP01
01063      SET APAY-WAIVE-INT-NO-88                                     DTSTOP01
01064          APAY-WAIVE-LATE-PEN-NO-88                                DTSTOP01
01065          APAY-NSF-PEN-CHARGE-NO-88 TO TRUE.                       DTSTOP01
01066                                                                   DTSTOP01
01067      MOVE +0 TO APAY-RECEIVED-DATE                                DTSTOP01
01068                 APAY-DEPOSIT-DATE                                 DTSTOP01
01069                 APAY-APPLIC-YRQ.                                  DTSTOP01
01070      MOVE SPACES TO APAY-APPLIC-IND.                              DTSTOP01
01071                                                                   DTSTOP01
01072      MOVE MPAY-BATCH-NO TO APAY-APPLIC-BATCH-NO.                  DTSTOP01
01073      MOVE MPAY-ITEM-NO  TO APAY-APPLIC-ITEM-NO.                   DTSTOP01
01074                                                                   DTSTOP01
01075      MOVE 'SYS' TO APAY-RESPONSIBLE-ACTIVITY.                     DTSTOP01
01076      MOVE SPACES TO APAY-RESPONSIBLE-OP-ID.                       DTSTOP01
01077      MOVE SPACE TO APAY-DISREGARD-EDITS-IND.                      DTSTOP01
01078      MOVE +0 TO APAY-PROCESSED-DATE.                              DTSTOP01
01079      MOVE +0 TO APAY-NSF-MNTE-ABSTIME.                            DTSTOP01
01080      MOVE +0 TO APAY-TRACE-NO.                                    DTSTOP01
01081      SET APAY-ANNUAL-RPT-NULL-88   TO TRUE.                       DTSTOP01
01082 **   DISPLAY 'MPAY-BATCH-NO ' MPAY-BATCH-NO                       DTSTOP01
01083 **   DISPLAY 'MPAY-ITEM-NO  ' MPAY-ITEM-NO                        DTSTOP01
01084      MOVE APAY-REC TO ASKL-REC.                                   DTSTOP01
01085                                                                   DTSTOP01
01086      PERFORM S923-WRITE THRU S923-EXIT.                           DTSTOP01
01087                                                                   DTSTOP01
01088      DISPLAY 'MPAY REVERSED ' MPAY-BATCH-NO ' ' MPAY-ITEM-NO      DTSTOP01
01089               ' ' MPAY-EMP-NO.                                    DTSTOP01
01090  P5133-EXIT.                                                      DTSTOP01
01091      EXIT.                                                        DTSTOP01
01092                                                                   DTSTOP01
01093  P5134-ENTER-ARPT.                                                DTSTOP01
01094                                                                   DTSTOP01
01095 **   DISPLAY 'P5134 ENTER APRT '                                  DTSTOP01
01096                                                                   DTSTOP01
01097      IF WRK-MRPT-FOUND-NO                                         DTSTOP01
01098         GO TO P5134-EXIT.                                         DTSTOP01
01099                                                                   DTSTOP01
01100      MOVE LOW-VALUES TO ARPT-REC.                                 DTSTOP01
01101                                                                   DTSTOP01
01102      IF AHDR-ATC-FILE-TRAN-CNT < +999                             DTSTOP01
01103         NEXT SENTENCE                                             DTSTOP01
01104      ELSE                                                         DTSTOP01
01105         PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT              DTSTOP01
01106 **      PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT.              DTSTOP01
01107                                                                   DTSTOP01
01108      MOVE AHDR-BATCH-NO TO ARPT-BATCH-NO.                         DTSTOP01
01109      ADD +1 TO AHDR-ATC-FILE-TRAN-CNT.                            DTSTOP01
01110      MOVE AHDR-ATC-FILE-TRAN-CNT TO ARPT-ITEM-NO.                 DTSTOP01
01111      SET ARPT-RPT-88 TO TRUE.                                     DTSTOP01
01112                                                                   DTSTOP01
01113      MOVE MPRF-PRIMARY-NAME TO ARPT-NAME-CHECK.                   DTSTOP01
01114      MOVE MPRF-EMP-NO TO ARPT-EMP-NO.                             DTSTOP01
01115      SET ARPT-ORIG-88    TO TRUE.                                 DTSTOP01
01116      MOVE MQTR-YRQ       TO ARPT-YRQ.                             DTSTOP01
01117                                                                   DTSTOP01
01118      COMPUTE ARPT-TOT-WAGE =                                      DTSTOP01
01119              MRPT-TOT-WAGE.                                       DTSTOP01
01120      COMPUTE ARPT-TAX-WAGE =                                      DTSTOP01
01121              MRPT-TAX-WAGE.                                       DTSTOP01
01122      COMPUTE ARPT-EXCESS-WAGE =                                   DTSTOP01
01123              MRPT-EXCESS-WAGE.                                    DTSTOP01
01124                                                                   DTSTOP01
01125      MOVE WRK-REMIT-AMT TO ARPT-REMIT-AMT.                        DTSTOP01
01126      ADD ARPT-REMIT-AMT    TO AHDR-ATC-FILE-REMIT-AMT.            DTSTOP01
01127      SET ARPT-WAGE-RPT-NO-ENTRY-88 TO TRUE.                       DTSTOP01
01128      SET ARPT-WAIVE-BOTH-NO-88                                    DTSTOP01
01129          ARPT-WAIVE-INT-NO-88                                     DTSTOP01
01130          ARPT-WAIVE-LATE-PEN-NO-88 TO TRUE.                       DTSTOP01
01131                                                                   DTSTOP01
01132      MOVE MRPT-TOTAL-EMPL-CNT   TO ARPT-TOTAL-EMPL-CNT.           DTSTOP01
01133      MOVE MRPT-1ST-MTH-EMPL-CNT TO ARPT-1ST-MTH-EMPL-CNT.         DTSTOP01
01134      MOVE MRPT-2ND-MTH-EMPL-CNT TO ARPT-2ND-MTH-EMPL-CNT.         DTSTOP01
01135      MOVE MRPT-3RD-MTH-EMPL-CNT TO ARPT-3RD-MTH-EMPL-CNT.         DTSTOP01
01136                                                                   DTSTOP01
01137      SET ARPT-VERIFIED-NO-88 TO TRUE.                             DTSTOP01
01138 ****FIX RECEIVED DATE HERE                                        DTSTOP01
01139      EVALUATE MPRF-EMP-NO                                         DTSTOP01
01140           WHEN 179242                                             DTSTOP01
01141                MOVE 20131127 TO ARPT-RECEIVED-DATE                DTSTOP01
01142                                 ARPT-DEPOSIT-DATE                 DTSTOP01
01143           WHEN 173938                                             DTSTOP01
01144                MOVE 20131120 TO ARPT-RECEIVED-DATE                DTSTOP01
01145                                 ARPT-DEPOSIT-DATE                 DTSTOP01
01146           WHEN 178627                                             DTSTOP01
01147                MOVE 20131125 TO ARPT-RECEIVED-DATE                DTSTOP01
01148                                 ARPT-DEPOSIT-DATE                 DTSTOP01
01149           WHEN 178646                                             DTSTOP01
01150                MOVE 20131125 TO ARPT-RECEIVED-DATE                DTSTOP01
01151                                 ARPT-DEPOSIT-DATE                 DTSTOP01
01152           WHEN 178842                                             DTSTOP01
01153                MOVE 20131125 TO ARPT-RECEIVED-DATE                DTSTOP01
01154                                 ARPT-DEPOSIT-DATE                 DTSTOP01
01155           WHEN 179229                                             DTSTOP01
01156                MOVE 20131125 TO ARPT-RECEIVED-DATE                DTSTOP01
01157                                 ARPT-DEPOSIT-DATE                 DTSTOP01
01158           WHEN 179678                                             DTSTOP01
01159                MOVE 20131125 TO ARPT-RECEIVED-DATE                DTSTOP01
01160                                 ARPT-DEPOSIT-DATE                 DTSTOP01
01161           WHEN 179748                                             DTSTOP01
01162                MOVE 20131125 TO ARPT-RECEIVED-DATE                DTSTOP01
01163                                 ARPT-DEPOSIT-DATE                 DTSTOP01
01164           WHEN OTHER                                              DTSTOP01
01165                DISPLAY 'ERROR IN FIXING RECEIVED DATE'            DTSTOP01
01166      END-EVALUATE.                                                DTSTOP01
01167                                                                   DTSTOP01
01168      MOVE          MRPT-RESPONSIBLE-ACTIVITY                      DTSTOP01
01169                 TO ARPT-RESPONSIBLE-ACTIVITY                      DTSTOP01
01170      MOVE 'SYS' TO ARPT-RESPONSIBLE-ACTIVITY.                     DTSTOP01
01171      MOVE     MRPT-RESPONSIBLE-OP-ID                              DTSTOP01
01172            TO ARPT-RESPONSIBLE-OP-ID.                             DTSTOP01
01173      MOVE SPACE TO ARPT-DISREGARD-EDITS-IND.                      DTSTOP01
01174      SET ARPT-PASSED-FULL-EDITS-YES-88 TO TRUE.                   DTSTOP01
01175      MOVE +0 TO ARPT-PROCESSED-DATE.                              DTSTOP01
01176      MOVE +0 TO ARPT-PSEUDO-BATCH-NO                              DTSTOP01
01177                 ARPT-PSEUDO-ITEM-NO                               DTSTOP01
01178                 ARPT-TRACE-NO.                                    DTSTOP01
01179      SET ARPT-STATUS-CHNG-NO-88  TO TRUE.                         DTSTOP01
01180                                                                   DTSTOP01
01181      MOVE ARPT-REC TO ASKL-REC.                                   DTSTOP01
01182 **   DISPLAY 'ARPT-BATCH-NO '  ARPT-BATCH-NO                      DTSTOP01
01183 **   DISPLAY 'ARPT-EMP-NO '   ARPT-EMP-NO                         DTSTOP01
01184 **   DISPLAY 'ARPT-YRQ '  ARPT-YRQ                                DTSTOP01
01185      PERFORM S923-WRITE THRU S923-EXIT.                           DTSTOP01
01186                                                                   DTSTOP01
01187                                                                   DTSTOP01
01188  P5134-EXIT.                                                      DTSTOP01
01189      EXIT.                                                        DTSTOP01
01190                                                                   DTSTOP01
01191                                                                   DTSTOP01
01192  P5141-READ-MRPT.                                                 DTSTOP01
01193      SET WRK-MRPT-FOUND-YES TO TRUE.                              DTSTOP01
01194                                                                   DTSTOP01
01195      MOVE LOW-VALUES  TO MRPT-KEY-AREA.                           DTSTOP01
01196      MOVE MPRF-EMP-NO TO MRPT-EMP-NO.                             DTSTOP01
01197      MOVE MQTR-YRQ    TO MRPT-YRQ.                                DTSTOP01
01198      MOVE WRK-RPT-BATCH-NO TO MRPT-BATCH-NO                       DTSTOP01
01199      MOVE WRK-RPT-ITEM-NO  TO MRPT-ITEM-NO.                       DTSTOP01
01200      SET MRPT-RPT-88  TO TRUE.                                    DTSTOP01
01201      MOVE MRPT-REC TO MSKL-REC.                                   DTSTOP01
01202                                                                   DTSTOP01
01203      PERFORM S910-READ         THRU S910-EXIT.                    DTSTOP01
01204      IF L910-OK-88                                                DTSTOP01
01205         MOVE MSKL-REC TO MRPT-REC                                 DTSTOP01
01206      ELSE                                                         DTSTOP01
01207 **      DISPLAY 'CANNOT FIND MRPT ' MPRF-EMP-NO                   DTSTOP01
01208         SET WRK-MRPT-FOUND-NO TO TRUE                             DTSTOP01
01209         GO TO P5141-EXIT.                                         DTSTOP01
01210                                                                   DTSTOP01
01211  P5141-EXIT.                                                      DTSTOP01
01212      EXIT.                                                        DTSTOP01
01213                                                                   DTSTOP01
01214  T0000-TERMINATE.                                                 DTSTOP01
01215                                                                   DTSTOP01
01216 *    PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT.                DTSTOP01
01217      MOVE WRK-LIEN-AMT  TO OUT-TOTAL-DEBT.                        DTSTOP01
01218 **   MOVE OUT-SEQ-NO    TO OUT-RECORDS.                           DTSTOP01
01219      WRITE OUT-REC FROM TOP-TRAILER.                              DTSTOP01
01220      PERFORM S923-CLOSE THRU S923-EXIT.                           DTSTOP01
01221 **   PERFORM S927-CLOSE THRU S927-EXIT.                           DTSTOP01
01222                                                                   DTSTOP01
01223 *    MOVE MHDR-LAST-USED-BATCH-NO TO HOLD-LAST-USED-BATCH-NO.     DTSTOP01
01224                                                                   DTSTOP01
01225 *    MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA.                         DTSTOP01
01226                                                                   DTSTOP01
01227 *    PERFORM S910-READ THRU S910-EXIT.                            DTSTOP01
01228 *    IF L910-NO-REC-88                                            DTSTOP01
01229 *       MOVE 'MHDR RECORD NOT FOUND (T0000)'                      DTSTOP01
01230 *         TO ABEND-MSG                                            DTSTOP01
01231 *       PERFORM S999-ABEND THRU S999-EXIT.                        DTSTOP01
01232                                                                   DTSTOP01
01233 *    MOVE MSKL-REC TO MHDR-REC.                                   DTSTOP01
01234 *    MOVE HOLD-LAST-USED-BATCH-NO TO MHDR-LAST-USED-BATCH-NO.     DTSTOP01
01235 *    MOVE MHDR-CURR-RUN-DATE TO MHDR-CHNG-DATE.                   DTSTOP01
01236 *    MOVE MHDR-REC TO MSKL-REC.                                   DTSTOP01
01237                                                                   DTSTOP01
01238 *    PERFORM S910-REWRITE THRU S910-EXIT.                         DTSTOP01
01239 *    DISPLAY 'LAST BATCH: '  AHDR-BATCH-NO.                       DTSTOP01
01240                                                                   DTSTOP01
01241      DISPLAY ' '.                                                 DTSTOP01
01242                                                                   DTSTOP01
01243      DISPLAY '*** DTSBZ058 TERMINATION STATISTICS ***'.           DTSTOP01
01244                                                                   DTSTOP01
01245      DISPLAY ' '.                                                 DTSTOP01
01246                                                                   DTSTOP01
01247      DISPLAY 'NUMBER OF MASTER FILE PROFILE RECORDS ENCOUNTERED: 'DTSTOP01
01248              WRK-MPRF-CNT.                                        DTSTOP01
01249                                                                   DTSTOP01
01250      DISPLAY 'NUMBER OF ACCOUNTS READ                          : '   CL*17
01251              WRK-READ-CNT.                                           CL*17
01252                                                                   DTSTOP01
01253      DISPLAY 'NUMBER OF EMPLOYERS EXCLUDED                     : 'DTSTOP01
01254              WRK-EXCLUDE-CNT.                                     DTSTOP01
01255                                                                   DTSTOP01
01256      DISPLAY 'NOTEPAD RECORDS CREATED                          : 'DTSTOP01
01257              WRK-T003-CNT.                                        DTSTOP01
01258                                                                   DTSTOP01
01259      DISPLAY 'AMOUNT OF INTEREST REVERSED                      : 'DTSTOP01
01260              WRK-INTEREST-AMT.                                    DTSTOP01
01261                                                                   DTSTOP01
01262      PERFORM S910-CLOSE THRU S910-EXIT.                           DTSTOP01
01263      CLOSE IN-FILE                                                DTSTOP01
01264            OUT-FILE.                                              DTSTOP01
01265                                                                   DTSTOP01
01266  T0000-EXIT.                                                      DTSTOP01
01267      EXIT.                                                        DTSTOP01
01268      EJECT                                                        DTSTOP01
01269                                                                   DTSTOP01
01270 **1000-INITIATE-AHDR.                                             DTSTOP01
01271 **   MOVE LOW-VALUES TO AHDR-REC.                                 DTSTOP01
01272 **                                                                DTSTOP01
01273 **   IF MHDR-LAST-USED-BATCH-NO < +99999                          DTSTOP01
01274 **      COMPUTE AHDR-BATCH-NO = MHDR-LAST-USED-BATCH-NO + 1       DTSTOP01
01275 **   ELSE                                                         DTSTOP01
01276 **      MOVE +1 TO AHDR-BATCH-NO.                                 DTSTOP01
01277 **                                                                DTSTOP01
01278 **   MOVE +0 TO AHDR-ITEM-NO.                                     DTSTOP01
01279 **   SET AHDR-HDR-88 TO TRUE.                                     DTSTOP01
01280 **   SET AHDR-BATCH-BALANCED-YES-88 TO TRUE.                      DTSTOP01
01281 **   SET AHDR-BATCH-HELD-NO-88  TO TRUE.                          DTSTOP01
01282 **   SET AHDR-ESTB-SYSTEM-88 TO TRUE.                             DTSTOP01
01283 **   MOVE SPACES TO AHDR-CHNG-OP-ID.                              DTSTOP01
01284 **   MOVE +0 TO AHDR-CHNG-DATE.                                   DTSTOP01
01285 **   MOVE MHDR-CURR-RUN-DATE TO AHDR-ESTB-DATE                    DTSTOP01
01286 **                              AHDR-RECEIVED-DATE                DTSTOP01
01287 **                              AHDR-DEPOSIT-DATE.                DTSTOP01
01288 **   MOVE +0 TO AHDR-LAST-USED-ITEM-NO                            DTSTOP01
01289 **              AHDR-CONTROL-TRAN-CNT                             DTSTOP01
01290 **              AHDR-ATC-FILE-TRAN-CNT                            DTSTOP01
01291 **              AHDR-PROC-TRAN-CNT                                DTSTOP01
01292 **              AHDR-CONTROL-REMIT-AMT                            DTSTOP01
01293 **              AHDR-ATC-FILE-REMIT-AMT                           DTSTOP01
01294 **              AHDR-PROC-REMIT-AMT                               DTSTOP01
01295 **              AHDR-BANK-BATCH-NO.                               DTSTOP01
01296 **                                                                DTSTOP01
01297 **1000-EXIT.                                                      DTSTOP01
01298 **   EXIT.                                                        DTSTOP01
01299                                                                   DTSTOP01
01300  S2000-TERMINATE-AHDR.                                            DTSTOP01
01301      IF AHDR-ATC-FILE-TRAN-CNT = +0                               DTSTOP01
01302         GO TO S2000-EXIT.                                         DTSTOP01
01303                                                                   DTSTOP01
01304      MOVE AHDR-BATCH-NO TO MHDR-LAST-USED-BATCH-NO.               DTSTOP01
01305      MOVE AHDR-ATC-FILE-TRAN-CNT TO AHDR-LAST-USED-ITEM-NO.       DTSTOP01
01306      MOVE AHDR-ATC-FILE-TRAN-CNT TO AHDR-CONTROL-TRAN-CNT.        DTSTOP01
01307      MOVE AHDR-ATC-FILE-REMIT-AMT TO AHDR-CONTROL-REMIT-AMT.      DTSTOP01
01308      MOVE AHDR-REC TO ASKL-REC.                                   DTSTOP01
01309                                                                   DTSTOP01
01310      PERFORM S923-WRITE THRU S923-EXIT.                           DTSTOP01
01311                                                                   DTSTOP01
01312  S2000-EXIT.                                                      DTSTOP01
01313      EXIT.                                                        DTSTOP01
01314                                                                   DTSTOP01
01315  S004-EDIT-QTR.                                                   DTSTOP01
01316      CALL 'DTSBU004' USING L004-COMM-AREA.                        DTSTOP01
01317                                                                   DTSTOP01
01318  S004-EXIT.                                                       DTSTOP01
01319      EXIT.                                                        DTSTOP01
01320      SKIP3                                                        DTSTOP01
01321  S005-FROM-SYS.                                                   DTSTOP01
01322      SET L005-FROM-SYS   TO TRUE.                                 DTSTOP01
01323      CALL 'DTSBU005' USING L005-LINK-AREA.                        DTSTOP01
01324                                                                   DTSTOP01
01325  S005-EXIT.                                                       DTSTOP01
01326      EXIT.                                                        DTSTOP01
01327                                                                   DTSTOP01
01328                                                                   DTSTOP01
01329   S001-FROM-FED-8.                                                DTSTOP01
01330       SET L001-FROM-FED-8 TO TRUE.                                DTSTOP01
01331       GO TO S001-DATE.                                            DTSTOP01
01332                                                                   DTSTOP01
01333                                                                   DTSTOP01
01334   S001-DATE.                                                      DTSTOP01
01335       CALL 'DTSBU001' USING L001-LINK-AREA.                       DTSTOP01
01336   S001-EXIT.                                                      DTSTOP01
01337       EXIT.                                                       DTSTOP01
01338                                                                   DTSTOP01
01339   S101-PER-MONTH-NO.                                              DTSTOP01
01340       SET L101-PER-MONTH-NO-88 TO TRUE.                           DTSTOP01
01341       GO TO S101-INT-PEN-COMP.                                    DTSTOP01
01342                                                                   DTSTOP01
01343   S101-PER-MONTH-YES.                                             DTSTOP01
01344       SET L101-PER-MONTH-YES-88 TO TRUE.                          DTSTOP01
01345       GO TO S101-INT-PEN-COMP.                                    DTSTOP01
01346                                                                   DTSTOP01
01347   S101-INT-PEN-COMP.                                              DTSTOP01
01348      CALL 'DTSBU101' USING L101-LINK-AREA.                        DTSTOP01
01349   S101-EXIT.                                                      DTSTOP01
01350       EXIT.                                                       DTSTOP01
01351  S910-OPEN-READ.                                                  DTSTOP01
01352      SET L910-OPEN-READ-88 TO TRUE.                               DTSTOP01
01353      GO TO S910-MSTR-IO.                                          DTSTOP01
01354                                                                   DTSTOP01
01355  S910-OPEN-UPDATE-NO-AIX.                                         DTSTOP01
01356      SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE.                      DTSTOP01
01357      GO TO S910-MSTR-IO.                                          DTSTOP01
01358                                                                   DTSTOP01
01359  S910-OPEN-UPDATE-HDR.                                            DTSTOP01
01360      SET L910-OPEN-UPDATE-HDR-88    TO TRUE.                      DTSTOP01
01361      GO TO S910-MSTR-IO.                                          DTSTOP01
01362                                                                   DTSTOP01
01363  S910-READ.                                                       DTSTOP01
01364      SET L910-READ-88 TO TRUE.                                    DTSTOP01
01365      GO TO S910-MSTR-IO.                                          DTSTOP01
01366                                                                   DTSTOP01
01367  S910-START-BROWSE.                                               DTSTOP01
01368      SET L910-START-BROWSE-88 TO TRUE.                            DTSTOP01
01369      GO TO S910-MSTR-IO.                                          DTSTOP01
01370                                                                   DTSTOP01
01371  S910-READ-NEXT.                                                  DTSTOP01
01372      SET L910-READ-NEXT-88 TO TRUE.                               DTSTOP01
01373      GO TO S910-MSTR-IO.                                          DTSTOP01
01374                                                                   DTSTOP01
01375  S910-COUNT.                                                      DTSTOP01
01376      SET L910-COUNT-88 TO TRUE.                                   DTSTOP01
01377      GO TO S910-MSTR-IO.                                          DTSTOP01
01378                                                                   DTSTOP01
01379  S910-REWRITE.                                                    DTSTOP01
01380      SET L910-REWRITE-88 TO TRUE.                                 DTSTOP01
01381      GO TO S910-MSTR-IO.                                          DTSTOP01
01382                                                                   DTSTOP01
01383  S910-DELETE.                                                     DTSTOP01
01384      SET L910-DELETE-88 TO TRUE.                                  DTSTOP01
01385      GO TO S910-MSTR-IO.                                          DTSTOP01
01386                                                                   DTSTOP01
01387  S910-CLOSE.                                                      DTSTOP01
01388      SET L910-CLOSE-88     TO TRUE.                               DTSTOP01
01389      GO TO S910-MSTR-IO.                                          DTSTOP01
01390                                                                   DTSTOP01
01391  S910-MSTR-IO.                                                    DTSTOP01
01392      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSTOP01
01393                            MSKL-REC.                              DTSTOP01
01394  S910-EXIT.                                                       DTSTOP01
01395      EXIT.                                                        DTSTOP01
01396      SKIP3                                                        DTSTOP01
01397  S111-LOOKUP-ADDR.                                                DTSTOP01
01398      CALL 'DTSBU111' USING L111-LINK-AREA.                        DTSTOP01
01399  S111-EXIT.                                                       DTSTOP01
01400      EXIT.                                                        DTSTOP01
01401  S923-OPEN-UPDATE.                                                DTSTOP01
01402      SET L923-OPEN-UPDATE-88 TO TRUE.                             DTSTOP01
01403      GO TO S923-ATC-IO.                                           DTSTOP01
01404                                                                   DTSTOP01
01405  S923-OPEN-READ.                                                  DTSTOP01
01406      SET L923-OPEN-READ-88 TO TRUE.                               DTSTOP01
01407      GO TO S923-ATC-IO.                                           DTSTOP01
01408                                                                   DTSTOP01
01409  S923-READ.                                                       DTSTOP01
01410      SET L923-READ-88 TO TRUE.                                    DTSTOP01
01411      GO TO S923-ATC-IO.                                           DTSTOP01
01412                                                                   DTSTOP01
01413  S923-START-BROWSE.                                               DTSTOP01
01414      SET L923-START-BROWSE-88 TO TRUE.                            DTSTOP01
01415      GO TO S923-ATC-IO.                                           DTSTOP01
01416                                                                   DTSTOP01
01417  S923-READ-NEXT.                                                  DTSTOP01
01418      SET L923-READ-NEXT-88 TO TRUE.                               DTSTOP01
01419      GO TO S923-ATC-IO.                                           DTSTOP01
01420                                                                   DTSTOP01
01421  S923-WRITE.                                                      DTSTOP01
01422 **   DISPLAY 'S923 WRITE '                                        DTSTOP01
01423      SET L923-WRITE-88 TO TRUE.                                   DTSTOP01
01424      GO TO S923-ATC-IO.                                           DTSTOP01
01425                                                                   DTSTOP01
01426  S923-REWRITE.                                                    DTSTOP01
01427      SET L923-REWRITE-88 TO TRUE.                                 DTSTOP01
01428      GO TO S923-ATC-IO.                                           DTSTOP01
01429                                                                   DTSTOP01
01430  S923-DELETE.                                                     DTSTOP01
01431      SET L923-DELETE-88 TO TRUE.                                  DTSTOP01
01432      GO TO S923-ATC-IO.                                           DTSTOP01
01433                                                                   DTSTOP01
01434  S923-CLOSE.                                                      DTSTOP01
01435      SET L923-CLOSE-88 TO TRUE.                                   DTSTOP01
01436      GO TO S923-ATC-IO.                                           DTSTOP01
01437                                                                   DTSTOP01
01438  S923-ATC-IO.                                                     DTSTOP01
01439 **    DISPLAY 'DTSBU923 '                                         DTSTOP01
01440 **   DISPLAY 'L923 LINK AREA '   L923-LINK-AREA                   DTSTOP01
01441      CALL 'DTSBU923' USING L923-LINK-AREA                         DTSTOP01
01442                            ASKL-REC.                              DTSTOP01
01443  S923-EXIT.                                                       DTSTOP01
01444      EXIT.                                                        DTSTOP01
01445      SKIP3                                                        DTSTOP01
01446  S927-OPEN-UPDATE.                                                DTSTOP01
01447      SET L927-OPEN-UPDATE-88 TO TRUE.                             DTSTOP01
01448      GO TO S927-BTC-O.                                            DTSTOP01
01449                                                                   DTSTOP01
01450  S927-WRITE.                                                      DTSTOP01
01451      SET L927-WRITE-88 TO TRUE.                                   DTSTOP01
01452      GO TO S927-BTC-O.                                            DTSTOP01
01453                                                                   DTSTOP01
01454  S927-CLOSE.                                                      DTSTOP01
01455      SET L927-CLOSE-88 TO TRUE.                                   DTSTOP01
01456      GO TO S927-BTC-O.                                            DTSTOP01
01457                                                                   DTSTOP01
01458  S927-BTC-O.                                                      DTSTOP01
01459      CALL 'DTSBU927' USING L927-LINK-AREA                         DTSTOP01
01460                            TSKL-REC.                              DTSTOP01
01461  S927-EXIT.                                                       DTSTOP01
01462      EXIT.                                                        DTSTOP01
01463                                                                   DTSTOP01
01464      SKIP3                                                        DTSTOP01
01465  S999-ABEND.                                                      DTSTOP01
01466      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSTOP01
01467  S999-EXIT.                                                       DTSTOP01
01468      EXIT.                                                        DTSTOP01
