00001  IDENTIFICATION DIVISION.                                         01/22/25
00002  PROGRAM-ID.             DTSTOP00.                                DTSTOP00
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV097
00004  DATE-WRITTEN.           DECEMBER 1998.                           DTSTOP00
00005  DATE-COMPILED.                                                   DTSTOP00
00006      SKIP3                                                        DTSTOP00
00007 *****                                                             DTSTOP00
00008 *                                                                 DTSTOP00
00009 *    FUNCTION:  CALCULATE TOP AMOUNT OWED AND WRITE PRINT FILE       CL*95
00010 *               FOR PROGRAM DTSTOP01.                                CL*95
00011 *                                                                 DTSTOP00
00012 *****                                                             DTSTOP00
00013      SKIP3                                                        DTSTOP00
00014  ENVIRONMENT DIVISION.                                            DTSTOP00
00015  INPUT-OUTPUT SECTION.                                            DTSTOP00
00016      SKIP3                                                        DTSTOP00
00017  FILE-CONTROL.                                                    DTSTOP00
00018      SELECT IN-FILE           ASSIGN TO DTSIZ058                  DTSTOP00
00019             FILE STATUS IS ZI57-STATUS.                           DTSTOP00
00020                                                                   DTSTOP00
00021      SELECT OUT-FILE          ASSIGN TO DTSOZ058                  DTSTOP00
00022             FILE STATUS IS Z057-STATUS.                           DTSTOP00
00023      SELECT LET-FILE          ASSIGN TO DTSOTOPL                     CL*36
00024             FILE STATUS IS Z057-STATUS.                              CL*36
00025      SKIP2                                                        DTSTOP00
00026  DATA DIVISION.                                                   DTSTOP00
00027  FILE SECTION.                                                    DTSTOP00
00028                                                                   DTSTOP00
00029  FD  IN-FILE                                                      DTSTOP00
00030      RECORDING MODE IS F                                          DTSTOP00
00031      BLOCK CONTAINS 0 RECORDS                                     DTSTOP00
00032      LABEL RECORDS ARE OMITTED.                                   DTSTOP00
00033                                                                   DTSTOP00
00034                                                                   DTSTOP00
00035  01  IN-REC.                                                      DTSTOP00
00036      05  IN-EAN                 PIC X(06).                        DTSTOP00
00037      05  FILLER                 PIC X(194).                          CL*67
00038                                                                   DTSTOP00
00039  FD  OUT-FILE                                                     DTSTOP00
00040      RECORDING MODE IS F                                          DTSTOP00
00041      BLOCK CONTAINS 0 RECORDS                                     DTSTOP00
00042      LABEL RECORDS ARE OMITTED.                                   DTSTOP00
00043                                                                   DTSTOP00
00044  01  OUT-REC                         PIC  X(200).                 DTSTOP00
00045                                                                      CL*35
00046  FD  LET-FILE                                                        CL*35
00047      RECORDING MODE IS F                                             CL*35
00048      BLOCK CONTAINS 0 RECORDS                                        CL*35
00049      LABEL RECORDS ARE OMITTED.                                      CL*35
00050                                                                      CL*35
00051  01  LET-REC                         PIC  X(200).                    CL*35
00052                                                                   DTSTOP00
00053                                                                   DTSTOP00
00054  WORKING-STORAGE SECTION.                                         DTSTOP00
000545 77  PAN-VALET PICTURE X(24) VALUE '097DTSTOP00  01/22/25'.       DTSTOP00
00055      SKIP3                                                        DTSTOP00
00056  01  WRK-AREA.                                                    DTSTOP00
00057      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +057.DTSTOP00
00058      05  ABEND-MSG                   PIC  X(60).                  DTSTOP00
00059                                                                   DTSTOP00
00060      05  W-IN-QTR                    PIC S9(05)  COMP-3.          DTSTOP00
00061      05  HOLD-LAST-USED-BATCH-NO     PIC S9(05)  COMP-3.          DTSTOP00
00062                                                                   DTSTOP00
00063      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBZ057'.DTSTOP00
00064                                                                      CL*37
00065      05 WS-AMT                    PIC 9(10)V99  VALUE 0.             CL*37
00066      05 WS-AMT-DISP               PIC 9999999999.99.                 CL*56
00067                                                                   DTSTOP00
00068      05  Z057-STATUS                 PIC  X(02).                  DTSTOP00
00069          88  Z057-FILE-OK-88          VALUE '00'.                 DTSTOP00
00070                                                                   DTSTOP00
00071      05  ZI57-STATUS                 PIC  X(02).                  DTSTOP00
00072          88  ZI57-FILE-OK-88          VALUE '00'.                 DTSTOP00
00073                                                                   DTSTOP00
00074      05  SEQ                         PIC S9(07)  COMP-3 VALUE +0. DTSTOP00
00075      05  WRK-MPRF-CNT                PIC S9(07)  COMP-3.          DTSTOP00
00076      05  WRK-UPDATE-CNT              PIC S9(07)  COMP-3.          DTSTOP00
00077      05  WRK-READ-CNT                PIC  9(07)  VALUE 0.         DTSTOP00
00078      05  WRK-LIEN-CNT                PIC  9(07)  VALUE 0.            CL*70
00079      05  WRK-FEIN-CNT                PIC  9(07)  VALUE 0.            CL*70
00080      05  WRK-BANK-CNT                PIC  9(07)  VALUE 0.            CL*70
00081      05  WRK-COLL-CNT                PIC  9(07)  VALUE 0.            CL*70
00082      05  WRK-WOFF-CNT                PIC  9(07)  VALUE 0.            CL*70
00083      05  WRK-WAPP-CNT                PIC  9(07)  VALUE 0.            CL*70
00084      05  WRK-WDPC-CNT                PIC  9(07)  VALUE 0.            CL*70
00085      05  WRK-PRNT-CNT                PIC  9(07)  VALUE 0.            CL*70
00086      05  WRK-FILE-CNT                PIC  9(07)  VALUE 0.            CL*70
00087      05  WRK-LESS-CNT                PIC  9(07)  VALUE 0.            CL*70
00088      05  WRK-ADDR-CNT                PIC  9(07)  VALUE 0.            CL*71
00089      05  WRK-APPS-CNT                PIC  9(07)  VALUE 0.            CL*70
00090      05  WS-REC-CNT                  PIC  9(07)  VALUE 0.            CL*17
00091      05  ACNT                        PIC  9(02)  VALUE 0.            CL*64
00092      05  LET-COUNT                   PIC  9(07)  VALUE 0.            CL*64
00093      05  PRINT-LETTER                PIC  9(01)  VALUE 0.            CL*37
00094      05  WRK-T1-CNT                  PIC  9(07)  VALUE 0.            CL*17
00095      05  WRK-EXCLUDE-CNT             PIC S9(07)  COMP-3.          DTSTOP00
00096      05  WRK-MPRF-AMT                PIC S9(09)V99  COMP-3.       DTSTOP00
00097      05  WRK-INTEREST-AMT            PIC S9(09)V99  COMP-3.       DTSTOP00
00098      05  WRK-PENALTY-AMT             PIC S9(09)V99 COMP-3 VALUE 0.DTSTOP00
00099      05  WRK-T1-AMT                  PIC  9(12)V99  VALUE 0.         CL*30
00100      05  WRK-TOT-T1-AMT              PIC  9(12)V99  VALUE 0.         CL*30
00101      05  WRK-TOT-EMP-AMT             PIC  9(12)V99  VALUE 0.         CL*97
00102      05  WRK-SUR-DUE                 PIC  9(10)V99  VALUE 0.         CL*51
00103      05  WRK-SUR-BAL                 PIC  9(10)V99  VALUE 0.         CL*51
00104      05  WRK-INT-DUE                 PIC  9(10)V99  VALUE 0.         CL*51
00105      05  WRK-NSF-DUE                 PIC  9(10)V99  VALUE 0.         CL*43
00106      05  WRK-MIS-DUE                 PIC  9(10)V99  VALUE 0.         CL*43
00107      05  WRK-LP-DUE                 PIC  9(10)V99  VALUE 0.          CL*43
00108      05  WRK-MLIN-QTR-AMT            PIC  9(10)V99  VALUE 0.         CL*42
00109      05  WRK-MLIN-EMP-AMT            PIC  9(10)V99  VALUE 0.         CL*59
00110      05  WRK-MLIN-AMT                PIC  9(10)V99  VALUE 0.         CL*30
00111      05  WRK-LIEN-AMT                PIC  9(10)V99  VALUE 0.         CL*30
00112      05  WRK-MLIN-AMTD               PIC $$$$$$$$9.99.            DTSTOP00
00113      05  DIS-MLIN-AMT                PIC --------9.99.            DTSTOP00
00114      05  DIS-MPRF-AMT                PIC --------9.99.            DTSTOP00
00115      05  WRK-REMIT-AMT               PIC S9(09)V99  COMP-3.       DTSTOP00
00116      05  WRK-UI-BAL                  PIC S9(09)V99  COMP-3.       DTSTOP00
00117      05  WRK-MLIN-IND                PIC  X(01).                  DTSTOP00
00118          88 WRK-MLIN-OK           VALUE 'Y'.                      DTSTOP00
00119          88 WRK-MLIN-NO-REC       VALUE 'N'.                      DTSTOP00
00120                                                                   DTSTOP00
00121      05  WS-ALPHA   OCCURS 26 TIMES    PIC X(1).                     CL*32
00122                                                                   DTSTOP00
00123                                                                   DTSTOP00
00124      05  WRK-MQTR-CNT                PIC S9(07)  COMP-3.          DTSTOP00
00125      05  EMP-ACCT-DISP               PIC  9(06).                  DTSTOP00
00126      05  WRK-TIMELY-PMT-AREA.                                     DTSTOP00
00127          10  WRK-ERROR-IND           PIC X(01).                   DTSTOP00
00128              88  WRK-ERROR-YES-88        VALUE 'Y'.               DTSTOP00
00129              88  WRK-ERROR-NO-88         VALUE 'N'.               DTSTOP00
00130          10  WRK-MPAY-FOUND-IND      PIC X(01).                   DTSTOP00
00131              88  WRK-MPAY-FOUND-YES      VALUE 'Y'.               DTSTOP00
00132              88  WRK-MPAY-FOUND-NO       VALUE 'N'.               DTSTOP00
00133          10  WRK-MRPT-FOUND-IND      PIC X(01).                   DTSTOP00
00134              88  WRK-MRPT-FOUND-YES      VALUE 'Y'.               DTSTOP00
00135              88  WRK-MRPT-FOUND-NO       VALUE 'N'.               DTSTOP00
00136          10  WRK-EMP-SELECTED-IND    PIC X(01).                   DTSTOP00
00137              88  WRK-EMP-SELECTED-YES    VALUE 'Y'.               DTSTOP00
00138              88  WRK-EMP-SELECTED-NO     VALUE 'N'.               DTSTOP00
00139          10  WRK-SUPPL-RPT-IND       PIC X(01).                   DTSTOP00
00140              88  WRK-SUPPL-RPT-YES       VALUE 'Y'.               DTSTOP00
00141              88  WRK-SUPPL-RPT-NO        VALUE 'N'.               DTSTOP00
00142          10  WRK-WITHDRAWN-RPT-IND   PIC X(01).                   DTSTOP00
00143              88  WRK-WITHDRAWN-RPT-YES   VALUE 'Y'.               DTSTOP00
00144              88  WRK-WITHDRAWN-RPT-NO    VALUE 'N'.               DTSTOP00
00145          10  WRK-RPT-BATCH-NO        PIC S9(05)  COMP-3.          DTSTOP00
00146          10  WRK-RPT-ITEM-NO         PIC S9(03)  COMP-3.          DTSTOP00
00147          10  WRK-OPID                PIC X(08).                   DTSTOP00
00148          10  WRITE-OFF               PIC X(01)  VALUE SPACES.     DTSTOP00
00149          10  WRK-BALANCE-AMT         PIC ----------9.99.          DTSTOP00
00150                                                                   DTSTOP00
00151      05  WRK-CERTIFICATE-DATE        PIC 9(8) VALUE 0.            DTSTOP00
00152      05  WRK-TIMELY-RPT-AREA.                                     DTSTOP00
00153          10  WRK-RPT-RECEIVED-DATE   PIC S9(09)  COMP-3.          DTSTOP00
00154                                                                   DTSTOP00
00155      05  WRK-MNTE-MSG-LINE1.                                      DTSTOP00
00156          10  WRK-MNTE-MSG-YR         PIC X(04).                   DTSTOP00
00157          10  FILLER                  PIC X(01) VALUE '/'.         DTSTOP00
00158          10  WRK-MNTE-MSG-QTR        PIC X(01).                   DTSTOP00
00159          10  FILLER                  PIC X(44)  VALUE             DTSTOP00
00160          ' QUARTER ANNUAL REPORT FROM TDEC WAS PROCESS'.          DTSTOP00
00161          10  FILLER                  PIC  X(23)  VALUE            DTSTOP00
00162          'ED INCORRECTLY BY ESSP '.                               DTSTOP00
00163      05  WRK-MNTE-MSG-LINE2.                                      DTSTOP00
00164          10  FILLER                  PIC  X(48)  VALUE            DTSTOP00
00165          'REPORT WITHDRAWN AND REPOSTED CORRECTLY.        '.      DTSTOP00
00166          10  FILLER                  PIC  X(23)  VALUE            DTSTOP00
00167          '                       '.                               DTSTOP00
00168      05  WRK-MNTE-MSG-LINE3.                                      DTSTOP00
00169          10  FILLER                  PIC  X(12)  VALUE            DTSTOP00
00170          '            '.                                          DTSTOP00
00171                                                                   DTSTOP00
00172      05  WRK-MPRF-IND                PIC  X(01).                  DTSTOP00
00173          88 WRK-MPRF-OK           VALUE 'Y'.                      DTSTOP00
00174          88 WRK-MPRF-NO-REC       VALUE 'N'.                      DTSTOP00
00175      05  WRK-MQTR-IND                PIC  X(01).                  DTSTOP00
00176          88 WRK-MQTR-OK           VALUE 'Y'.                      DTSTOP00
00177          88 WRK-MQTR-NO-REC       VALUE 'N'.                      DTSTOP00
00178      05  WRK-MRPT-IND                PIC  X(01).                  DTSTOP00
00179          88 WRK-MRPT-OK           VALUE 'Y'.                      DTSTOP00
00180          88 WRK-MRPT-NO-REC       VALUE 'N'.                      DTSTOP00
00181                                                                   DTSTOP00
00182      05  WRK-T003-CNT                PIC S9(07)  COMP-3 VALUE +0. DTSTOP00
00183      05  PARM-REC-CNT                PIC S9(07)  COMP-3.          DTSTOP00
00184                                                                   DTSTOP00
00185      05  PARM-EOF-IND                    PIC  X(01).              DTSTOP00
00186                                                                   DTSTOP00
00187      05  WRK-EMP-NO                  PIC  9(06).                  DTSTOP00
00188                                                                   DTSTOP00
00189      05  WRK-TRACE-IND                   PIC  X(01).              DTSTOP00
00190                                                                   DTSTOP00
00191                                                                   DTSTOP00
00192      05  WRK-MST-OPEN-IND                PIC  X(01).              DTSTOP00
00193                                                                   DTSTOP00
00194      05  WRK-REF-OPEN-IND                PIC  X(01).              DTSTOP00
00195  01  TOP-LETTER.                                                     CL*36
00196          10  LET-EMP-NO              PIC  999999.                    CL*36
00197          10  FILLER                  PIC  X  VALUE ';'.              CL*36
00198          10  LET-EMP-FEIN            PIC  999999999.                 CL*39
00199          10  FILLER                  PIC  X  VALUE ';'.              CL*36
00200          10  LET-EMP-NAME            PIC  X(40).                     CL*36
00201          10  FILLER                  PIC  X  VALUE ';'.              CL*36
00202          10  LET-EMP-ADDR1           PIC  X(40).                     CL*36
00203          10  FILLER                  PIC  X  VALUE ';'.              CL*36
00204          10  LET-EMP-ADDR2           PIC  X(40).                     CL*36
00205          10  FILLER                  PIC  X  VALUE ';'.              CL*36
00206          10  LET-EMP-CITZ            PIC  X(20).                     CL*36
00207          10  FILLER                  PIC  X  VALUE ';'.              CL*36
00208          10  LET-EMP-ST              PIC  X(02).                     CL*36
00209          10  FILLER                  PIC  X  VALUE ';'.              CL*36
00210          10  LET-EMP-ZIPP            PIC  X(10).                     CL*36
00211          10  FILLER                  PIC  X  VALUE ';'.              CL*36
00212          10  LET-EMP-AMT             PIC  9999999.99.                CL*36
00213                                                                   DTSTOP00
00214  01  TOP-T1-REC.                                                     CL*11
00215  ++INCLUDE DTST1TOP                                                  CL*11
00216                                                                      CL*11
00217                                                                      CL*11
00218  01  TOP-D1-REC.                                                     CL*11
00219  ++INCLUDE DTSD1TOP                                                  CL*11
00220                                                                      CL*11
00221                                                                      CL*11
00222  01  TOP-D2-REC.                                                     CL*11
00223  ++INCLUDE DTSD2TOP                                                  CL*11
00224                                                                      CL*11
00225  01  TOP-TC-REC.                                                     CL*11
00226  ++INCLUDE DTSTCTOP                                                  CL*11
00227                                                                      CL*11
00228                                                                      CL*11
00229 **   EJECT                                                        DTSTOP00
00230  01  TSKL-REC.                                                    DTSTOP00
00231  ++INCLUDE DTSITSKL                                               DTSTOP00
00232                                                                   DTSTOP00
00233  01  L005-LINK-AREA.                                              DTSTOP00
00234  ++INCLUDE DTSIL005                                               DTSTOP00
00235                                                                   DTSTOP00
00236  01  L910-LINK-AREA.                                              DTSTOP00
00237  ++INCLUDE DTSIL910                                               DTSTOP00
00238      EJECT                                                        DTSTOP00
00239  01  MSKL-REC.                                                    DTSTOP00
00240  ++INCLUDE DTSIMSKL                                               DTSTOP00
00241      EJECT                                                        DTSTOP00
00242  01  MHDR-REC.                                                    DTSTOP00
00243  ++INCLUDE DTSIMHDR                                               DTSTOP00
00244      EJECT                                                        DTSTOP00
00245  01  MPRF-REC.                                                    DTSTOP00
00246  ++INCLUDE DTSIMPRF                                               DTSTOP00
00247      EJECT                                                        DTSTOP00
00248  01  MQTR-REC.                                                    DTSTOP00
00249  ++INCLUDE DTSIMQTR                                               DTSTOP00
00250      EJECT                                                        DTSTOP00
00251  01  MRPT-REC.                                                    DTSTOP00
00252  ++INCLUDE DTSIMRPT                                               DTSTOP00
00253      EJECT                                                        DTSTOP00
00254  01  MDST-REC.                                                    DTSTOP00
00255  ++INCLUDE DTSIMDST                                               DTSTOP00
00256      EJECT                                                        DTSTOP00
00257  01  L111-LINK-AREA.                                              DTSTOP00
00258  ++INCLUDE DTSIL111                                               DTSTOP00
00259      EJECT                                                        DTSTOP00
00260  01  MPAY-REC.                                                    DTSTOP00
00261  ++INCLUDE DTSIMPAY                                               DTSTOP00
00262      EJECT                                                        DTSTOP00
00263  01  MTAD-REC.                                                    DTSTOP00
00264  ++INCLUDE DTSIMTAD                                               DTSTOP00
00265      EJECT                                                        DTSTOP00
00266  01  MNTE-REC.                                                    DTSTOP00
00267  ++INCLUDE DTSIMNTE                                               DTSTOP00
00268      EJECT                                                        DTSTOP00
00269  01  L923-LINK-AREA.                                              DTSTOP00
00270  ++INCLUDE DTSIL923                                               DTSTOP00
00271      EJECT                                                        DTSTOP00
00272  01  ASKL-REC.                                                    DTSTOP00
00273  ++INCLUDE DTSIASKL                                               DTSTOP00
00274      EJECT                                                        DTSTOP00
00275  01  MLIN-REC.                                                    DTSTOP00
00276  ++INCLUDE DTSIMLIN                                               DTSTOP00
00277      EJECT                                                        DTSTOP00
00278  01  AHDR-REC.                                                    DTSTOP00
00279  ++INCLUDE DTSIAHDR                                               DTSTOP00
00280      EJECT                                                        DTSTOP00
00281  01  ARPT-REC.                                                    DTSTOP00
00282  ++INCLUDE DTSIARPT                                               DTSTOP00
00283      EJECT                                                        DTSTOP00
00284  01  APAY-REC.                                                    DTSTOP00
00285  ++INCLUDE DTSIAPAY                                               DTSTOP00
00286      EJECT                                                        DTSTOP00
00287  01  L927-LINK-AREA.                                              DTSTOP00
00288  ++INCLUDE DTSIL927                                               DTSTOP00
00289                                                                   DTSTOP00
00290  01  L101-LINK-AREA.                                              DTSTOP00
00291  ++INCLUDE DTSIL101                                               DTSTOP00
00292                                                                      CL*48
00293  01  L109-LINK-AREA.                                                 CL*50
00294  ++INCLUDE DTSIL109                                                  CL*48
00295                                                                   DTSTOP00
00296  01  L004-COMM-AREA.                                              DTSTOP00
00297  ++INCLUDE DTSIL004                                               DTSTOP00
00298      EJECT                                                        DTSTOP00
00299  01  TOP-HEADER.                                                  DTSTOP00
00300  ++INCLUDE DTSIXTPH                                               DTSTOP00
00301                                                                   DTSTOP00
00302  01  TOP-REC-1.                                                   DTSTOP00
00303  ++INCLUDE DTSIXTD1                                               DTSTOP00
00304                                                                   DTSTOP00
00305  01  L001-LINK-AREA.                                              DTSTOP00
00306  ++INCLUDE DTSIL001                                               DTSTOP00
00307  01  L112-LINK-AREA.                                              DTSTOP00
00308  ++INCLUDE DTSIL112                                               DTSTOP00
00309      EJECT                                                        DTSTOP00
00310                                                                   DTSTOP00
00311  PROCEDURE DIVISION.                                              DTSTOP00
00312                                                                   DTSTOP00
00313      PERFORM I0000-INITIATE THRU I0000-EXIT.                      DTSTOP00
00314      PERFORM P0000-PROCESS THRU P0000-EXIT.                       DTSTOP00
00315                                                                   DTSTOP00
00316      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     DTSTOP00
00317      SKIP2                                                        DTSTOP00
00318      GOBACK.                                                      DTSTOP00
00319      EJECT                                                        DTSTOP00
00320  I0000-INITIATE.                                                  DTSTOP00
00321                                                                   DTSTOP00
00322      MOVE 'N' TO WRK-TRACE-IND.                                   DTSTOP00
00323                                                                   DTSTOP00
00324      PERFORM I2000-OPEN-FILES-1        THRU I2000-EXIT.           DTSTOP00
00325                                                                   DTSTOP00
00326      PERFORM I3000-BATCH-HEADER        THRU I3000-EXIT.           DTSTOP00
00327                                                                   DTSTOP00
00328      PERFORM S005-FROM-SYS             THRU S005-EXIT.            DTSTOP00
00329                                                                   DTSTOP00
00330  I0000-EXIT.                                                      DTSTOP00
00331      EXIT.                                                        DTSTOP00
00332                                                                   DTSTOP00
00333  I2000-OPEN-FILES-1.                                              DTSTOP00
00334      MOVE WRK-TRACE-IND TO L910-TRACE-IND.                        DTSTOP00
00335                                                                   DTSTOP00
00336      MOVE WRK-MOD-NAME TO L910-MOD-NAME.                          DTSTOP00
00337                                                                   DTSTOP00
00338      PERFORM S910-OPEN-READ THRU S910-EXIT.                       DTSTOP00
00339 **   PERFORM S910-OPEN-UPDATE-NO-AIX THRU S910-EXIT.              DTSTOP00
00340 **   PERFORM S910-OPEN-UPDATE-HDR    THRU S910-EXIT.              DTSTOP00
00341      PERFORM S923-OPEN-READ THRU S923-EXIT.                       DTSTOP00
00342 **   PERFORM S927-OPEN-UPDATE         THRU S927-EXIT.             DTSTOP00
00343                                                                   DTSTOP00
00344      OPEN OUTPUT OUT-FILE.                                        DTSTOP00
00345      IF NOT Z057-FILE-OK-88                                       DTSTOP00
00346         DISPLAY 'OUTPUT FILE OPEN ERROR: ' Z057-STATUS            DTSTOP00
00347         PERFORM S999-ABEND THRU S999-EXIT                         DTSTOP00
00348      END-IF.                                                      DTSTOP00
00349                                                                   DTSTOP00
00350      OPEN OUTPUT LET-FILE.                                           CL*37
00351      IF NOT Z057-FILE-OK-88                                          CL*37
00352         DISPLAY 'LETTER FILE OPEN ERROR: ' Z057-STATUS               CL*37
00353         PERFORM S999-ABEND THRU S999-EXIT                            CL*37
00354      END-IF.                                                         CL*37
00355                                                                      CL*37
00356      OPEN INPUT  IN-FILE.                                         DTSTOP00
00357      IF NOT ZI57-FILE-OK-88                                       DTSTOP00
00358         DISPLAY 'INPUT  FILE OPEN ERROR: ' ZI57-STATUS            DTSTOP00
00359         PERFORM S999-ABEND THRU S999-EXIT                         DTSTOP00
00360      END-IF.                                                      DTSTOP00
00361                                                                   DTSTOP00
00362  I2000-EXIT.                                                      DTSTOP00
00363      EXIT.                                                        DTSTOP00
00364                                                                   DTSTOP00
00365  I3000-BATCH-HEADER.                                              DTSTOP00
00366      MOVE LOW-VALUES        TO MHDR-KEY-AREA.                     DTSTOP00
00367      MOVE +0 TO MHDR-EMP-NO.                                      DTSTOP00
00368      SET MHDR-HDR-88 TO TRUE.                                     DTSTOP00
00369      MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA.                         DTSTOP00
00370      PERFORM S910-READ THRU S910-EXIT.                            DTSTOP00
00371                                                                   DTSTOP00
00372      IF L910-NO-REC-88                                            DTSTOP00
00373         MOVE 'MHDR RECORD NOT FOUND (I0000)'                      DTSTOP00
00374           TO ABEND-MSG                                            DTSTOP00
00375         PERFORM S999-ABEND THRU S999-EXIT.                        DTSTOP00
00376                                                                   DTSTOP00
00377      MOVE MSKL-REC TO MHDR-REC.                                   DTSTOP00
00378                                                                   DTSTOP00
00379      MOVE MHDR-CURR-RUN-DATE     TO L001-FED-8-DATE-9             DTSTOP00
00380      PERFORM S001-FROM-FED-8     THRU S001-EXIT                   DTSTOP00
00381      MOVE L001-SLASH-8-DATE(1:2) TO T1-BATCH-MM                      CL*11
00382                                     TC-BATCH-MONTH.                  CL*11
00383      MOVE L001-SLASH-8-DATE(4:2) TO T1-BATCH-DD                      CL*11
00384                                     TC-BATCH-DAY.                    CL*11
00385      MOVE L001-SLASH-8-DATE(7:4) TO T1-BATCH-YR                      CL*11
00386                                     TC-BATCH-YEAR.                   CL*11
00387      WRITE OUT-REC FROM T1-HEADER.                                   CL*11
00388                                                                   DTSTOP00
00389 **   PERFORM S1000-INITIATE-AHDR       THRU S1000-EXIT.           DTSTOP00
00390      DISPLAY 'FIRST BATCH: ' AHDR-BATCH-NO.                       DTSTOP00
00391                                                                   DTSTOP00
00392  I3000-EXIT.                                                      DTSTOP00
00393      EXIT.                                                        DTSTOP00
00394                                                                   DTSTOP00
00395      EJECT                                                        DTSTOP00
00396  P0000-PROCESS.                                                   DTSTOP00
00397                                                                   DTSTOP00
00398      READ IN-FILE AT END GO TO P0000-EXIT.                        DTSTOP00
00399                                                                   DTSTOP00
00400      MOVE +0 TO WRK-MPRF-CNT                                      DTSTOP00
00401                 WRK-EXCLUDE-CNT                                   DTSTOP00
00402                 WRK-UPDATE-CNT                                    DTSTOP00
00403                 DIS-MLIN-AMT                                      DTSTOP00
00404                 DIS-MPRF-AMT                                      DTSTOP00
00405                 WRK-INTEREST-AMT.                                 DTSTOP00
00406      SET WRK-ERROR-NO-88     TO TRUE.                             DTSTOP00
00407                                                                   DTSTOP00
00408      MOVE 'A'         TO WS-ALPHA(1).                             DTSTOP00
00409      MOVE 'B'         TO WS-ALPHA(2).                             DTSTOP00
00410      MOVE 'C'         TO WS-ALPHA(3).                             DTSTOP00
00411      MOVE 'D'         TO WS-ALPHA(4).                             DTSTOP00
00412      MOVE 'E'         TO WS-ALPHA(5).                             DTSTOP00
00413      MOVE 'F'         TO WS-ALPHA(6).                             DTSTOP00
00414      MOVE 'G'         TO WS-ALPHA(7).                             DTSTOP00
00415      MOVE 'H'         TO WS-ALPHA(8).                             DTSTOP00
00416      MOVE 'I'         TO WS-ALPHA(9).                             DTSTOP00
00417      MOVE 'J'         TO WS-ALPHA(10).                            DTSTOP00
00418      MOVE 'K'         TO WS-ALPHA(11).                            DTSTOP00
00419      MOVE 'L'         TO WS-ALPHA(12).                            DTSTOP00
00420      MOVE 'M'         TO WS-ALPHA(13).                            DTSTOP00
00421      MOVE 'N'         TO WS-ALPHA(14).                            DTSTOP00
00422      MOVE 'O'         TO WS-ALPHA(15).                            DTSTOP00
00423      MOVE 'P'         TO WS-ALPHA(16).                            DTSTOP00
00424      MOVE 'Q'         TO WS-ALPHA(17).                            DTSTOP00
00425      MOVE 'R'         TO WS-ALPHA(18).                            DTSTOP00
00426      MOVE 'S'         TO WS-ALPHA(19).                            DTSTOP00
00427      MOVE 'T'         TO WS-ALPHA(20).                            DTSTOP00
00428      MOVE 'U'         TO WS-ALPHA(21).                               CL*31
00429      MOVE 'V'         TO WS-ALPHA(22).                               CL*31
00430      MOVE 'W'         TO WS-ALPHA(23).                               CL*31
00431      MOVE 'X'         TO WS-ALPHA(24).                               CL*31
00432      MOVE 'Y'         TO WS-ALPHA(25).                               CL*31
00433      MOVE 'Z'         TO WS-ALPHA(26).                               CL*31
00434                                                                   DTSTOP00
00435      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSTOP00
00436      MOVE LOW-VALUES TO MPRF-KEY-AREA.                            DTSTOP00
00437                                                                   DTSTOP00
00438      MOVE +0     TO MSKL-EMP-NO.                                  DTSTOP00
00439                                                                   DTSTOP00
00440      SET MPRF-PRF-88 TO TRUE.                                     DTSTOP00
00441      MOVE IN-EAN     TO MPRF-EMP-NO                               DTSTOP00
00442      MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA.                         DTSTOP00
00443      PERFORM S910-READ THRU S910-EXIT.                            DTSTOP00
00444      IF L910-OK-88                                                DTSTOP00
00445         MOVE MSKL-REC TO MPRF-REC                                 DTSTOP00
00446         SET WRK-MPRF-OK TO TRUE                                   DTSTOP00
00447      ELSE                                                         DTSTOP00
00448         DISPLAY 'BAD FIRST READ ' L910-RESULT-IND                 DTSTOP00
00449         SET L910-NO-REC-88 TO TRUE                                DTSTOP00
00450         GO TO P1000-READ-CONTINUE.                                   CL**2
00451                                                                   DTSTOP00
00452      DISPLAY 'LIST OF EMPLOYERS -FOR TOP FILE AND LETTERS  '.        CL**3
00453                                                                   DTSTOP00
00454      PERFORM P1000-READ-NEXT THRU P1000-EXIT                      DTSTOP00
00455         UNTIL WRK-MPRF-NO-REC                                     DTSTOP00
00456         OR WRK-ERROR-YES-88.                                      DTSTOP00
00457 **      OR MPRF-EMP-NO > 020999.                                  DTSTOP00
00458 **      OR WRK-REL-CNT > +100.                                    DTSTOP00
00459  P0000-EXIT.                                                      DTSTOP00
00460      EXIT.                                                        DTSTOP00
00461      EJECT                                                        DTSTOP00
00462  P1000-READ-NEXT.                                                 DTSTOP00
00463                                                                   DTSTOP00
00464      MOVE ZEROS TO  DIS-MLIN-AMT WRK-MLIN-AMT                     DTSTOP00
00465                     DIS-MPRF-AMT WRK-MPRF-AMT.                    DTSTOP00
00466 *    MOVE ZEROS TO WRK-CERTIFICATE-DATE                              CL**2
00467                                                                      CL**2
00468      ADD 1 TO WRK-READ-CNT.                                       DTSTOP00
00469         DISPLAY '>>>>>>INREC-EAN  ' IN-EAN                        DTSTOP00
00470                                                                      CL**2
00471      IF MPRF-MLIN-IND NOT = 'Y'                                      CL*68
00472         ADD 1 TO WRK-LIEN-CNT                                        CL*69
00473         DISPLAY '>>>>>>MLIN-NOT Y ' MPRF-MLIN-IND.                   CL*71
00474 *       GO TO P1000-READ-CONTINUE.                                   CL*69
00475 *                                                                    CL*13
00476 *+++++ CANNOT SEND ZEROS FEIN TO IRS                                 CL*13
00477 *                                                                    CL*13
00478      IF MPRF-FEIN = ZEROS                                            CL*10
00479         ADD 1 TO WRK-FEIN-CNT                                        CL*69
00480         DISPLAY '>>>>>>FEIN ZEROS ' MPRF-FEIN                        CL*10
00481         GO TO P1000-READ-CONTINUE.                                   CL*10
00482                                                                      CL*69
00483      IF MPRF-RETURN-MAIL-IND = 'Y'                                   CL*71
00484         ADD 1 TO WRK-ADDR-CNT                                        CL*71
00485         DISPLAY '>>>>>>BAD ADDR   ' MPRF-EMP-NO.                     CL*71
00486 *       GO TO P1000-READ-CONTINUE.                                   CL*71
00487                                                                      CL*71
00488      IF MPRF-BANKRP-OPEN-88                                          CL*33
00489         ADD 1 TO WRK-BANK-CNT                                        CL*69
00490         DISPLAY 'IN-BANKRUPT  '   IN-EAN                             CL*74
00491       GO TO P1000-READ-CONTINUE.                                     CL*74
00492                                                                      CL*69
00493      IF MPRF-SUSPEND-COLL-IND = 'Y'                                  CL*33
00494         ADD 1 TO WRK-COLL-CNT                                        CL*69
00495       DISPLAY 'IN-SUS COLL '   IN-EAN                                CL*74
00496      GO TO P1000-READ-CONTINUE.                                      CL*74
00497                                                                      CL*69
00498      IF MPRF-WRITE-OFF-DATE > 0                                      CL*33
00499         ADD 1 TO WRK-WOFF-CNT                                        CL*69
00500       DISPLAY 'IN-WRITTEN OFF '   IN-EAN                             CL*74
00501      GO TO P1000-READ-CONTINUE.                                      CL*74
00502                                                                      CL*69
00503      IF MPRF-MAPL-IND  = 'Y'                                         CL*33
00504         ADD 1 TO WRK-WAPP-CNT                                        CL*69
00505      DISPLAY 'IN-APPEAL  '   IN-EAN                                  CL*74
00506      GO TO P1000-READ-CONTINUE.                                      CL*74
00507                                                                      CL*69
00508      IF MPRF-MDPC-IND  = 'Y'                                         CL*33
00509         ADD 1 TO WRK-WDPC-CNT                                        CL*69
00510       DISPLAY 'IN-DPC     '   IN-EAN                                 CL*74
00511      GO TO P1000-READ-CONTINUE.                                      CL*74
00512                                                                      CL**2
00513      PERFORM S109-SUR-TAX-QTR THRU S109-EXIT.                        CL*49
00514                                                                      CL*49
00515       MOVE ZEROS TO ACNT                                             CL*78
00516      MOVE ZERO TO PRINT-LETTER.                                      CL*36
00517 *    PERFORM P7000-SCAN-LIN THRU P7000-EXIT.                         CL*73
00518      PERFORM P5000-READ-MQTR THRU P5000-EXIT                         CL*73
00519                                                                      CL*36
00520      MOVE WRK-MLIN-EMP-AMT   TO WS-AMT                               CL*88
00521                                                                      CL*88
00522      IF WS-AMT > 1000.00                                             CL*89
00523         NEXT SENTENCE                                                CL*88
00524      ELSE                                                            CL*88
00525       DISPLAY 'AMT LESS THAN 1000 ' MPRF-EMP-NO ' ' WS-AMT           CL*90
00526      GO TO P1000-READ-CONTINUE.                                      CL*90
00527                                                                      CL*88
00528      IF PRINT-LETTER = 1                                             CL*36
00529         PERFORM P9000-LETTER   THRU P9000-EXIT.                      CL*88
00530                                                                   DTSTOP00
00531  P1000-READ-CONTINUE.                                             DTSTOP00
00532                                                                   DTSTOP00
00533      READ IN-FILE AT END                                          DTSTOP00
00534         SET WRK-MPRF-NO-REC TO TRUE                               DTSTOP00
00535         GO TO P1000-EXIT.                                         DTSTOP00
00536      SET MPRF-PRF-88 TO TRUE.                                     DTSTOP00
00537      MOVE IN-EAN     TO MPRF-EMP-NO                               DTSTOP00
00538      MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA.                         DTSTOP00
00539      PERFORM S910-READ THRU S910-EXIT.                            DTSTOP00
00540      IF L910-OK-88                                                DTSTOP00
00541         MOVE MSKL-REC TO MPRF-REC                                 DTSTOP00
00542         SET WRK-MPRF-OK TO TRUE                                   DTSTOP00
00543      ELSE                                                         DTSTOP00
00544 **      DISPLAY 'BAD FIRST READ ' L910-RESULT-IND                 DTSTOP00
00545         SET L910-NO-REC-88 TO TRUE.                                  CL**3
00546                                                                   DTSTOP00
00547  P1000-EXIT.                                                      DTSTOP00
00548      EXIT.                                                        DTSTOP00
00549                                                                   DTSTOP00
00550  P7000-SCAN-LIN.                                                  DTSTOP00
00551                                                                   DTSTOP00
00552      MOVE 'Y' TO WRK-MLIN-IND.                                    DTSTOP00
00553      MOVE ZEROS TO WRK-MLIN-AMT                                   DTSTOP00
00554      MOVE ZEROS TO DIS-MLIN-AMT                                   DTSTOP00
00555       MOVE ZEROS TO WRK-MLIN-EMP-AMT                                 CL*60
00556      MOVE LOW-VALUES  TO MLIN-KEY-AREA.                           DTSTOP00
00557      MOVE MPRF-EMP-NO TO MLIN-EMP-NO.                             DTSTOP00
00558      SET MLIN-LIN-88  TO TRUE.                                    DTSTOP00
00559      MOVE MLIN-KEY-AREA TO MSKL-KEY-AREA.                         DTSTOP00
00560                                                                   DTSTOP00
00561      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSTOP00
00562      IF L910-NO-REC-88                                            DTSTOP00
00563         GO TO P7000-EXIT                                          DTSTOP00
00564      ELSE                                                         DTSTOP00
00565         PERFORM P7100-SCAN-MLIN THRU P7100-EXIT                   DTSTOP00
00566           UNTIL WRK-MLIN-NO-REC.                                  DTSTOP00
00567                                                                   DTSTOP00
00568  P7000-EXIT.                                                      DTSTOP00
00569      EXIT.                                                        DTSTOP00
00570  P7100-SCAN-MLIN.                                                 DTSTOP00
00571                                                                   DTSTOP00
00572                                                                   DTSTOP00
00573       MOVE ZEROS TO ACNT                                             CL*65
00574      MOVE MSKL-REC TO MLIN-REC.                                   DTSTOP00
00575                                                                   DTSTOP00
00576      DISPLAY 'P7100 ' MLIN-EMP-NO ' ' MLIN-STMT-DUE-AMT              CL*26
00577                 ' CNT '  MLIN-COV-CNT.                               CL*26
00578      IF MLIN-STATUS-ACTIVE-88                                     DTSTOP00
00579      PERFORM                                                         CL**3
00580       VARYING MLIN-COV-IDX  FROM +1 BY +1                            CL**3
00581         UNTIL MLIN-COV-IDX  > MLIN-COV-CNT                           CL**3
00582         PERFORM P5000-READ-MQTR THRU P5000-EXIT                      CL**3
00583      END-PERFORM.                                                    CL**3
00584                                                                   DTSTOP00
00585      MOVE MLIN-REC TO MSKL-REC.                                      CL**8
00586      PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSTOP00
00587      IF L910-NO-REC-88                                            DTSTOP00
00588        DISPLAY '>>>> LIEN AMT: ' MLIN-EMP-NO ' ' WRK-MLIN-AMT     DTSTOP00
00589         SET WRK-MLIN-NO-REC TO TRUE.                              DTSTOP00
00590                                                                   DTSTOP00
00591  P7100-EXIT.                                                      DTSTOP00
00592      EXIT.                                                        DTSTOP00
00593                                                                   DTSTOP00
00594  P9000-LETTER.                                                       CL*36
00595      ADD 1 TO WRK-PRNT-CNT.                                          CL*69
00596      MOVE IN-EAN             TO  LET-EMP-NO.                         CL*36
00597      MOVE D1-EMP-LNAME      TO  LET-EMP-NAME.                        CL*36
00598      IF D2-EMP-ADDR-LINE2 > SPACES                                   CL*63
00599       MOVE D2-EMP-ADDR-LINE1 TO LET-EMP-ADDR1                        CL*96
00600       MOVE D2-EMP-ADDR-LINE2 TO LET-EMP-ADDR2                        CL*37
00601      ELSE                                                            CL*36
00602       MOVE D2-EMP-ADDR-LINE1 TO LET-EMP-ADDR2                        CL*37
00603       MOVE SPACES            TO LET-EMP-ADDR1.                       CL*36
00604      MOVE D2-EMP-CITY     TO LET-EMP-CITZ.                           CL*36
00605      MOVE D2-EMP-STATE    TO LET-EMP-ST.                             CL*36
00606      MOVE D2-EMP-ZIP      TO LET-EMP-ZIPP.                           CL*36
00607      MOVE D1-EMP-FEIN         TO LET-EMP-FEIN.                       CL*39
00608      MOVE WRK-MLIN-EMP-AMT   TO WS-AMT                               CL*58
00609      MOVE WS-AMT           TO WS-AMT-DISP.                           CL*36
00610      MOVE WS-AMT-DISP      TO LET-EMP-AMT.                           CL*36
00611      WRITE LET-REC FROM TOP-LETTER.                                  CL*36
00612                                                                      CL*96
00613 *     ADD WRK-MLIN-QTR-AMT TO WRK-TOT-T1-AMT.                        CL*96
00614       ADD WRK-MLIN-EMP-AMT TO WRK-TOT-EMP-AMT.                       CL*97
00615                                                                      CL*36
00616       DISPLAY 'QTR-EMP-AMT ' LET-EMP-NO ' ' WRK-MLIN-EMP-AMT.        CL*97
00617       DISPLAY 'TOT-EMP-AMT ' LET-EMP-NO ' ' WRK-TOT-EMP-AMT.         CL*97
00618       DISPLAY 'TOT TOP AMT ' LET-EMP-NO ' ' WRK-TOT-T1-AMT.          CL*96
00619  P9000-EXIT.                                                         CL*36
00620      EXIT.                                                           CL*36
00621                                                                      CL*36
00622  P5000-READ-MQTR.                                                    CL*36
00623       MOVE ZEROS TO ACNT                                             CL*82
00624      MOVE ZEROS TO WRK-MLIN-AMT                                      CL*80
00625      MOVE ZEROS TO DIS-MLIN-AMT                                      CL*80
00626       MOVE ZEROS TO WRK-MLIN-EMP-AMT                                 CL*80
00627 *      DISPLAY '>>>> P5000-READ-MQTR>>>> ' MPRF-EMP-NO               CL*73
00628 *           '  '   MLIN-COVERED-YRQ(MLIN-COV-IDX)                    CL*73
00629 *            ' CNT '  MLIN-COV-CNT.                                  CL*73
00630      MOVE LOW-VALUES  TO MQTR-KEY-AREA.                           DTSTOP00
00631      MOVE MPRF-EMP-NO TO MQTR-EMP-NO.                             DTSTOP00
00632 *    MOVE MLIN-COVERED-YRQ(MLIN-COV-IDX) TO                          CL*73
00633                                                                      CL*73
00634      MOVE 20001 TO          MQTR-YRQ.                                CL*74
00635      MOVE ZEROS  TO WRK-T1-AMT.                                      CL*13
00636                                                                   DTSTOP00
00637      SET MQTR-QTR-88  TO TRUE.                                    DTSTOP00
00638      MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSTOP00
00639                                                                   DTSTOP00
00640 *    PERFORM S910-READ THRU S910-EXIT.                               CL*74
00641      PERFORM S910-START-BROWSE  THRU S910-EXIT.                      CL*74
00642                                                                   DTSTOP00
00643      IF L910-NO-REC-88                                            DTSTOP00
00644         DISPLAY ' MQTR REC NOT FOUND ' MPRF-EMP-NO ' ' MQTR-YRQ      CL*13
00645         PERFORM S999-ABEND THRU S999-EXIT.                           CL*13
00646                                                                      CL*13
00647                                                                   DTSTOP00
00648      MOVE MSKL-REC TO MQTR-REC.                                   DTSTOP00
00649         DISPLAY ' MQTR ' MPRF-EMP-NO ' ' MQTR-YRQ                    CL*26
00650      PERFORM P5100-MQTR-SCAN THRU P5100-EXIT                         CL*73
00651            UNTIL L910-NO-REC-88.                                     CL*73
00652                                                                   DTSTOP00
00653                                                                   DTSTOP00
00654  P5000-EXIT.                                                      DTSTOP00
00655      EXIT.                                                        DTSTOP00
00656                                                                   DTSTOP00
00657  P5100-MQTR-SCAN.                                                 DTSTOP00
00658 *    DISPLAY '>>>> P5100-READ-MQTR>>> ' MPRF-EMP-NO ' ' MQTR-YRQ.    CL*75
00659                                                                      CL*87
00660      IF MQTR-CURR-MISSING-88                                         CL*91
00661         GO TO P5100-READ-NEXT.                                       CL*94
00662                                                                      CL*87
00663       MOVE ZEROS TO WRK-MLIN-QTR-AMT                                 CL*66
00664      MOVE ZEROS TO L101-INT-CHARGE-CHNG.                             CL*44
00665      MOVE ZEROS TO L101-PAID-CHNG WRK-SUR-DUE WRK-SUR-BAL            CL*51
00666      MOVE ZEROS  TO WRK-T1-CNT.                                      CL*13
00667      MOVE ZEROS TO WRK-INT-DUE WRK-LP-DUE WRK-NSF-DUE WRK-MIS-DUE    CL*43
00668      PERFORM                                                         CL**6
00669         VARYING MQTR-ACCT-IDX FROM +1 BY +1                          CL**6
00670         UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT                          CL**6
00671           EVALUATE TRUE                                              CL**6
00672             WHEN MQTR-ACCT-UI-88 (MQTR-ACCT-IDX)                     CL*45
00673                  ADD  MQTR-BALANCE-AMT (MQTR-ACCT-IDX)               CL**6
00674                     TO L101-PAID-CHNG                                CL**6
00675 *            DISPLAY 'UI  DUE ' MQTR-BALANCE-AMT (MQTR-ACCT-IDX)     CL*75
00676             WHEN MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX)                    CL*51
00677                  ADD  MQTR-BALANCE-AMT (MQTR-ACCT-IDX)               CL*45
00678                     TO WRK-SUR-DUE                                   CL*51
00679 *            DISPLAY 'SUR DUE ' MQTR-BALANCE-AMT (MQTR-ACCT-IDX)     CL*75
00680             WHEN MQTR-ACCT-INT-88 (MQTR-ACCT-IDX)                    CL*42
00681                  ADD  MQTR-BALANCE-AMT (MQTR-ACCT-IDX)               CL*42
00682                     TO WRK-INT-DUE                                   CL*42
00683 *            DISPLAY 'INT DUE ' MQTR-BALANCE-AMT (MQTR-ACCT-IDX)     CL*75
00684             WHEN MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX)               CL*33
00685                  ADD  MQTR-BALANCE-AMT (MQTR-ACCT-IDX)               CL*33
00686                     TO WRK-LP-DUE                                    CL*43
00687 *            DISPLAY 'LP  DUE ' MQTR-BALANCE-AMT (MQTR-ACCT-IDX)     CL*75
00688             WHEN MQTR-ACCT-NSF-PEN-88 (MQTR-ACCT-IDX)                CL*34
00689                  ADD  MQTR-BALANCE-AMT (MQTR-ACCT-IDX)               CL*33
00690                     TO WRK-NSF-DUE                                   CL*43
00691 *            DISPLAY 'NSF DUE ' MQTR-BALANCE-AMT (MQTR-ACCT-IDX)     CL*75
00692             WHEN MQTR-ACCT-MISC-PEN-88 (MQTR-ACCT-IDX)               CL*33
00693                  ADD  MQTR-BALANCE-AMT (MQTR-ACCT-IDX)               CL*33
00694                     TO WRK-MIS-DUE                                   CL*43
00695 *            DISPLAY 'MIS DUE ' MQTR-BALANCE-AMT (MQTR-ACCT-IDX)     CL*75
00696           END-EVALUATE                                               CL**7
00697       END-PERFORM.                                                   CL**6
00698                                                                      CL**6
00699         IF MQTR-YRQ >= L109-FIRST-PEN-INT-YRQ                        CL*51
00700            ADD WRK-SUR-DUE TO L101-PAID-CHNG                         CL*51
00701         ELSE                                                         CL*51
00702           MOVE WRK-SUR-DUE TO WRK-SUR-BAL.                           CL*52
00703                                                                      CL*51
00704       IF L101-PAID-CHNG > +0                                      DTSTOP00
00705           NEXT SENTENCE                                           DTSTOP00
00706       ELSE                                                        DTSTOP00
00707        DISPLAY 'NO BALANE DUE   : ' MQTR-EMP-NO ' ' MQTR-YRQ         CL*33
00708        GO TO P5100-CONTINUE.                                         CL*44
00709                                                                   DTSTOP00
00710 *     DISPLAY 'BAL DUE ' L101-PAID-CHNG                              CL*75
00711 *    ADD 1 TO WRK-T1-CNT.                                            CL*25
00712      MOVE 20240710           TO L101-RECEIVED-DATE.                  CL*69
00713 *                                                                 DTSTOP00
00714       SET L101-WAIVE-INT-NO-88 TO TRUE.                           DTSTOP00
00715 *                                                                 DTSTOP00
00716       MOVE MQTR-TAX-DUE-DATE TO L101-TAX-DUE-DATE.                DTSTOP00
00717 *                                                                 DTSTOP00
00718       MOVE MQTR-INT-AREA TO L101-INT-AREA.                        DTSTOP00
00719 *                                                                 DTSTOP00
00720       PERFORM S101-PER-MONTH-YES THRU S101-EXIT.                  DTSTOP00
00721 *                                                                 DTSTOP00
00722  P5100-CONTINUE.                                                     CL*44
00723 *     DISPLAY ' INT CHRG ' MQTR-EMP-NO ' ' L101-INT-CHARGE-CHNG      CL*75
00724                                                                      CL*13
00725       COMPUTE WRK-MLIN-QTR-AMT = L101-INT-CHARGE-CHNG +              CL*27
00726               L101-PAID-CHNG + WRK-INT-DUE + WRK-LP-DUE              CL*43
00727               + WRK-NSF-DUE  + WRK-MIS-DUE + WRK-SUR-BAL.            CL*51
00728 *     DISPLAY 'BAL DUE ' L101-PAID-CHNG                              CL*75
00729                                                                      CL*53
00730       MOVE WRK-MLIN-QTR-AMT TO WS-AMT                                CL*55
00731       MOVE WS-AMT TO WS-AMT-DISP                                     CL*55
00732 *     DISPLAY 'QTR DUE ' MQTR-YRQ '  ' WS-AMT-DISP                   CL*81
00733                                                                      CL*76
00734       IF  WS-AMT  < 24.95                                            CL*57
00735 *     DISPLAY 'QTR DUE LESS 2495 ' WS-AMT                            CL*77
00736       ADD 1 TO WRK-LESS-CNT                                          CL*69
00737        GO TO P5100-READ-NEXT.                                        CL*76
00738                                                                      CL*73
00739       ADD 1 TO WRK-FILE-CNT                                          CL*69
00740       ADD WRK-MLIN-QTR-AMT TO WRK-TOT-T1-AMT.                        CL*27
00741       ADD WRK-MLIN-QTR-AMT TO WRK-MLIN-EMP-AMT.                      CL*58
00742       MOVE WRK-MLIN-QTR-AMT TO WRK-MLIN-AMT.                         CL*62
00743 *                                                                 DTSTOP00
00744 *    DISPLAY 'MQTR YRQ '   MQTR-EMP-NO ' ' MQTR-YRQ.                 CL*75
00745 *    DISPLAY 'LIEN YRQ '   MLIN-EMP-NO                               CL*74
00746 *            ' ' MLIN-COVERED-YRQ(MLIN-COV-IDX)                      CL*74
00747 *     MOVE  MLIN-COVERED-YRQ(MLIN-COV-IDX) TO D1-LIEN-DATE           CL*74
00748       MOVE  MQTR-YRQ    TO D1-LIEN-DATE                              CL*74
00749        IF D1-LIEN-DATE(5:1) = 1                                      CL*17
00750            MOVE 0531 TO D1-LIEN-DATE(5:4)                            CL*74
00751        ELSE                                                          CL**3
00752         IF D1-LIEN-DATE(5:1) = 2                                     CL*17
00753            MOVE 0831 TO D1-LIEN-DATE(5:4)                            CL*74
00754          ELSE                                                        CL**3
00755           IF D1-LIEN-DATE(5:1) = 3                                   CL*17
00756              MOVE 1130 TO D1-LIEN-DATE(5:4)                          CL*74
00757           ELSE                                                       CL**3
00758             MOVE 0228 TO D1-LIEN-DATE(5:4).                          CL*74
00759                                                                      CL**2
00760      ADD 1 TO ACNT.                                                  CL*77
00761                                                                      CL*77
00762 *    DISPLAY 'ALPH ' WS-ALPHA(MLIN-COV-IDX)  ' ' IN-EAN ' '          CL*74
00763 *    DISPLAY 'ALPH ' WS-ALPHA(ACNT)  ' ' IN-EAN ' '                  CL*77
00764 *            ' CNT ' MLIN-COV-CNT  ' '                               CL*78
00765 *        ' D1 ' D1-SEQ-NO(18:1)                                      CL*78
00766 *        ' D2 ' D1-SEQ-NO(18:1).                                     CL*78
00767      MOVE WRK-MLIN-AMT    TO D1-DEBT-AMOUNT                          CL*17
00768                                                                      CL**3
00769      MOVE MPRF-FEIN         TO D1-EMP-FEIN                           CL*17
00770      MOVE MPRF-PRIMARY-NAME(1:35) TO D1-EMP-LNAME                    CL*22
00771                                                                      CL**3
00772                                                                      CL**3
00773 *    MOVE WRK-MLIN-AMT   TO D2-DEBT-AMT                              CL*19
00774      DISPLAY '*<<<<TOP-QTR-AMT : ' MQTR-EMP-NO ' Q ' WRK-MLIN-AMT    CL*28
00775               ' ' MQTR-YRQ ' TOT ' WRK-TOT-T1-AMT.                   CL*28
00776 *    DISPLAY 'MLIN-OUT; ' D2-DEBT-AMT                                CL*19
00777                                                                      CL**3
00778      MOVE ZEROS  TO D1-SEQ-NO(1:18)                                  CL*77
00779                     D2-SEQ-NO(1:18)                                  CL*77
00780      MOVE IN-EAN TO D1-SEQ-NO(11:6)                                  CL*83
00781                     D2-SEQ-NO(11:6)                                  CL*83
00782                                                                      CL**3
00783 *    DISPLAY 'ALPH ' WS-ALPHA(ACNT)  ' ' IN-EAN ' ' ACNT.            CL*83
00784      MOVE ACNT   TO D1-SEQ-NO(17:2)                                  CL*83
00785                     D2-SEQ-NO(17:2).                                 CL*83
00786                                                                      CL*80
00787      MOVE SPACES TO D1-DEBTOR-STATUS                                 CL*17
00788                                                                      CL**3
00789                                                                      CL**3
00790      MOVE LOW-VALUES             TO  MTAD-KEY-AREA.                  CL**3
00791      MOVE MPRF-EMP-NO            TO  MTAD-EMP-NO.                    CL**3
00792      SET MTAD-TAD-88             TO  TRUE.                           CL**3
00793      SET MTAD-ID-TAX-MAILING-ADDR-88 TO   TRUE.                      CL**3
00794                                                                      CL**3
00795      MOVE MTAD-KEY-AREA          TO  MSKL-KEY-AREA.                  CL**3
00796                                                                      CL**3
00797      PERFORM S910-READ          THRU  S910-EXIT.                     CL**3
00798                                                                      CL**3
00799      IF L910-OK-88                                                   CL**3
00800         MOVE MSKL-REC TO MTAD-REC                                    CL**3
00801      ELSE                                                            CL**3
00802         DISPLAY '--NO MTAD REC  ' L910-RESULT-IND                    CL**3
00803 *       SET L910-NO-REC-88 TO TRUE                                   CL*76
00804         GO TO P5100-READ-NEXT.                                       CL*76
00805                                                                      CL**3
00806                                                                      CL**3
00807      IF MTAD-DELIV-LINE-1 > SPACES                                   CL*19
00808         MOVE MTAD-DELIV-LINE-1(1:30) TO D2-EMP-ADDR-LINE1            CL*21
00809         MOVE MTAD-DELIV-LINE-2(1:30) TO D2-EMP-ADDR-LINE2            CL*21
00810      ELSE                                                            CL*19
00811         MOVE MTAD-DELIV-LINE-2 TO D2-EMP-ADDR-LINE1                  CL*20
00812         MOVE SPACES            TO D2-EMP-ADDR-LINE2                  CL*20
00813      END-IF.                                                         CL*20
00814                                                                      CL**3
00815      MOVE MTAD-CITY              TO D2-EMP-CITY                      CL*11
00816      MOVE MTAD-ST                TO D2-EMP-STATE                     CL*11
00817      MOVE MTAD-ZIP(1:5)          TO D2-EMP-ZIP(1:5)                  CL*11
00818      MOVE MTAD-ZIP(7:4)          TO D2-EMP-ZIP(6:4).                 CL*11
00819      MOVE 1 TO PRINT-LETTER.                                         CL*36
00820         WRITE OUT-REC FROM TOP-D1-REC                                CL*17
00821         WRITE OUT-REC FROM TOP-D2-REC.                               CL*17
00822      ADD 2 TO WS-REC-CNT.                                            CL*11
00823                                                                      CL*76
00824  P5100-READ-NEXT.                                                    CL*76
00825       MOVE ZEROS TO WRK-MLIN-QTR-AMT                                 CL*77
00826      MOVE ZEROS TO L101-INT-CHARGE-CHNG.                             CL*77
00827      MOVE ZEROS TO L101-PAID-CHNG WRK-SUR-DUE WRK-SUR-BAL            CL*77
00828      MOVE ZEROS  TO WRK-T1-CNT.                                      CL*77
00829      MOVE ZEROS TO WRK-INT-DUE WRK-LP-DUE WRK-NSF-DUE WRK-MIS-DUE    CL*77
00830       MOVE MQTR-REC TO MSKL-REC.                                     CL*74
00831        PERFORM S910-READ-NEXT THRU S910-EXIT.                        CL*74
00832        IF L910-NO-REC-88                                             CL*74
00833         SET L910-NO-REC-88 TO TRUE                                   CL*74
00834         GO TO P5100-EXIT.                                            CL*74
00835                                                                      CL*74
00836       MOVE MSKL-REC TO MQTR-REC.                                     CL*74
00837       IF MQTR-YRQ > 20234                                            CL*85
00838         SET L910-NO-REC-88 TO TRUE.                                  CL*74
00839                                                                   DTSTOP00
00840  P5100-EXIT.                                                      DTSTOP00
00841      EXIT.                                                        DTSTOP00
00842                                                                   DTSTOP00
00843                                                                   DTSTOP00
00844  T0000-TERMINATE.                                                 DTSTOP00
00845                                                                   DTSTOP00
00846 *    PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT.                DTSTOP00
00847      MOVE WRK-TOT-T1-AMT  TO TC-TOTAL-DEBT.                          CL*14
00848      MOVE WS-REC-CNT        TO TC-RECORD-CNT.                        CL*11
00849      WRITE OUT-REC FROM TC-REC.                                      CL*11
00850      PERFORM S923-CLOSE THRU S923-EXIT.                           DTSTOP00
00851 **   PERFORM S927-CLOSE THRU S927-EXIT.                           DTSTOP00
00852                                                                   DTSTOP00
00853 *    MOVE MHDR-LAST-USED-BATCH-NO TO HOLD-LAST-USED-BATCH-NO.     DTSTOP00
00854                                                                   DTSTOP00
00855 *    MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA.                         DTSTOP00
00856                                                                   DTSTOP00
00857 *    PERFORM S910-READ THRU S910-EXIT.                            DTSTOP00
00858 *    IF L910-NO-REC-88                                            DTSTOP00
00859 *       MOVE 'MHDR RECORD NOT FOUND (T0000)'                      DTSTOP00
00860 *         TO ABEND-MSG                                            DTSTOP00
00861 *       PERFORM S999-ABEND THRU S999-EXIT.                        DTSTOP00
00862                                                                   DTSTOP00
00863 *    MOVE MSKL-REC TO MHDR-REC.                                   DTSTOP00
00864 *    MOVE HOLD-LAST-USED-BATCH-NO TO MHDR-LAST-USED-BATCH-NO.     DTSTOP00
00865 *    MOVE MHDR-CURR-RUN-DATE TO MHDR-CHNG-DATE.                   DTSTOP00
00866 *    MOVE MHDR-REC TO MSKL-REC.                                   DTSTOP00
00867                                                                   DTSTOP00
00868 *    PERFORM S910-REWRITE THRU S910-EXIT.                         DTSTOP00
00869 *    DISPLAY 'LAST BATCH: '  AHDR-BATCH-NO.                       DTSTOP00
00870                                                                   DTSTOP00
00871      DISPLAY ' '.                                                 DTSTOP00
00872                                                                   DTSTOP00
00873      DISPLAY '*** DTSTOP00 TERMINATION STATISTICS ***'.              CL*68
00874                                                                   DTSTOP00
00875      DISPLAY ' '.                                                 DTSTOP00
00876                                                                   DTSTOP00
00877 *    DISPLAY 'NUMBER OF MASTER FILE PROFILE RECORDS ENCOUNTERED: '   CL*68
00878 *            WRK-MPRF-CNT.                                           CL*68
00879                                                                   DTSTOP00
00880      DISPLAY 'NUMBER OF ACCOUNTS READ FOR TOP SELECTION        : '   CL*68
00881              WRK-READ-CNT.                                        DTSTOP00
00882                                                                   DTSTOP00
00883      DISPLAY 'MUMBER OF EMPLOYERS HAS NO LIEN                  : '   CL*68
00884              WRK-LIEN-CNT.                                           CL*68
00885                                                                      CL*68
00886      DISPLAY 'MUMBER OF EMPLOYERS WITH FEIN = 0                : '   CL*68
00887              WRK-FEIN-CNT.                                           CL*68
00888                                                                      CL*68
00889      DISPLAY 'MUMBER OF EMPLOYERS WITH DPC                     : '   CL*69
00890              WRK-WDPC-CNT.                                           CL*69
00891                                                                      CL*69
00892      DISPLAY 'MUMBER OF EMPLOYERS WRITTEN OFF                  : '   CL*69
00893              WRK-WOFF-CNT.                                           CL*69
00894                                                                      CL*69
00895      DISPLAY 'MUMBER OF EMPLOYERS WITH COLLECTIONS SUSPENDED   : '   CL*69
00896              WRK-COLL-CNT.                                           CL*69
00897                                                                      CL*69
00898      DISPLAY 'MUMBER OF EMPLOYERS IN BANKRUPTCY                : '   CL*69
00899              WRK-BANK-CNT.                                           CL*69
00900                                                                      CL*69
00901      DISPLAY 'MUMBER OF EMPLOYERS WITH BAD ADDRESS             : '   CL*69
00902              WRK-ADDR-CNT.                                           CL*69
00903                                                                      CL*69
00904      DISPLAY 'MUMBER OF EMPLOYERS WITH APPEALS                 : '   CL*69
00905              WRK-APPS-CNT.                                           CL*69
00906                                                                      CL*69
00907      DISPLAY 'MUMBER OF LETTERS TO BE PRINTED                  : '   CL*69
00908              WRK-PRNT-CNT.                                           CL*69
00909                                                                      CL*69
00910      DISPLAY 'MUMBER OF EMPLOYERS SENT TO TOPS                 : '   CL*69
00911              WRK-FILE-CNT.                                           CL*69
00912                                                                   DTSTOP00
00913      PERFORM S910-CLOSE THRU S910-EXIT.                           DTSTOP00
00914      CLOSE IN-FILE                                                DTSTOP00
00915            LET-FILE                                                  CL*37
00916            OUT-FILE.                                                 CL*37
00917                                                                   DTSTOP00
00918  T0000-EXIT.                                                      DTSTOP00
00919      EXIT.                                                        DTSTOP00
00920      EJECT                                                        DTSTOP00
00921                                                                   DTSTOP00
00922 **1000-INITIATE-AHDR.                                             DTSTOP00
00923 **   MOVE LOW-VALUES TO AHDR-REC.                                 DTSTOP00
00924 **                                                                DTSTOP00
00925 **   IF MHDR-LAST-USED-BATCH-NO < +99999                          DTSTOP00
00926 **      COMPUTE AHDR-BATCH-NO = MHDR-LAST-USED-BATCH-NO + 1       DTSTOP00
00927 **   ELSE                                                         DTSTOP00
00928 **      MOVE +1 TO AHDR-BATCH-NO.                                 DTSTOP00
00929 **                                                                DTSTOP00
00930 **   MOVE +0 TO AHDR-ITEM-NO.                                     DTSTOP00
00931 **   SET AHDR-HDR-88 TO TRUE.                                     DTSTOP00
00932 **   SET AHDR-BATCH-BALANCED-YES-88 TO TRUE.                      DTSTOP00
00933 **   SET AHDR-BATCH-HELD-NO-88  TO TRUE.                          DTSTOP00
00934 **   SET AHDR-ESTB-SYSTEM-88 TO TRUE.                             DTSTOP00
00935 **   MOVE SPACES TO AHDR-CHNG-OP-ID.                              DTSTOP00
00936 **   MOVE +0 TO AHDR-CHNG-DATE.                                   DTSTOP00
00937 **   MOVE MHDR-CURR-RUN-DATE TO AHDR-ESTB-DATE                    DTSTOP00
00938 **                              AHDR-RECEIVED-DATE                DTSTOP00
00939 **                              AHDR-DEPOSIT-DATE.                DTSTOP00
00940 **   MOVE +0 TO AHDR-LAST-USED-ITEM-NO                            DTSTOP00
00941 **              AHDR-CONTROL-TRAN-CNT                             DTSTOP00
00942 **              AHDR-ATC-FILE-TRAN-CNT                            DTSTOP00
00943 **              AHDR-PROC-TRAN-CNT                                DTSTOP00
00944 **              AHDR-CONTROL-REMIT-AMT                            DTSTOP00
00945 **              AHDR-ATC-FILE-REMIT-AMT                           DTSTOP00
00946 **              AHDR-PROC-REMIT-AMT                               DTSTOP00
00947 **              AHDR-BANK-BATCH-NO.                               DTSTOP00
00948 **                                                                DTSTOP00
00949 **1000-EXIT.                                                      DTSTOP00
00950 **   EXIT.                                                        DTSTOP00
00951                                                                   DTSTOP00
00952  S2000-TERMINATE-AHDR.                                            DTSTOP00
00953      IF AHDR-ATC-FILE-TRAN-CNT = +0                               DTSTOP00
00954         GO TO S2000-EXIT.                                         DTSTOP00
00955                                                                   DTSTOP00
00956      MOVE AHDR-BATCH-NO TO MHDR-LAST-USED-BATCH-NO.               DTSTOP00
00957      MOVE AHDR-ATC-FILE-TRAN-CNT TO AHDR-LAST-USED-ITEM-NO.       DTSTOP00
00958      MOVE AHDR-ATC-FILE-TRAN-CNT TO AHDR-CONTROL-TRAN-CNT.        DTSTOP00
00959      MOVE AHDR-ATC-FILE-REMIT-AMT TO AHDR-CONTROL-REMIT-AMT.      DTSTOP00
00960      MOVE AHDR-REC TO ASKL-REC.                                   DTSTOP00
00961                                                                   DTSTOP00
00962      PERFORM S923-WRITE THRU S923-EXIT.                           DTSTOP00
00963                                                                   DTSTOP00
00964  S2000-EXIT.                                                      DTSTOP00
00965      EXIT.                                                        DTSTOP00
00966                                                                   DTSTOP00
00967  S004-EDIT-QTR.                                                   DTSTOP00
00968      CALL 'DTSBU004' USING L004-COMM-AREA.                        DTSTOP00
00969                                                                   DTSTOP00
00970  S004-EXIT.                                                       DTSTOP00
00971      EXIT.                                                        DTSTOP00
00972      SKIP3                                                        DTSTOP00
00973  S005-FROM-SYS.                                                   DTSTOP00
00974      SET L005-FROM-SYS   TO TRUE.                                 DTSTOP00
00975      CALL 'DTSBU005' USING L005-LINK-AREA.                        DTSTOP00
00976                                                                   DTSTOP00
00977  S005-EXIT.                                                       DTSTOP00
00978      EXIT.                                                        DTSTOP00
00979                                                                   DTSTOP00
00980                                                                   DTSTOP00
00981   S001-FROM-FED-8.                                                DTSTOP00
00982       SET L001-FROM-FED-8 TO TRUE.                                DTSTOP00
00983       GO TO S001-DATE.                                            DTSTOP00
00984                                                                   DTSTOP00
00985                                                                   DTSTOP00
00986   S001-DATE.                                                      DTSTOP00
00987       CALL 'DTSBU001' USING L001-LINK-AREA.                       DTSTOP00
00988   S001-EXIT.                                                      DTSTOP00
00989       EXIT.                                                       DTSTOP00
00990                                                                   DTSTOP00
00991   S101-PER-MONTH-NO.                                              DTSTOP00
00992       SET L101-PER-MONTH-NO-88 TO TRUE.                           DTSTOP00
00993       GO TO S101-INT-PEN-COMP.                                    DTSTOP00
00994                                                                   DTSTOP00
00995   S101-PER-MONTH-YES.                                             DTSTOP00
00996       SET L101-PER-MONTH-YES-88 TO TRUE.                          DTSTOP00
00997       GO TO S101-INT-PEN-COMP.                                    DTSTOP00
00998                                                                   DTSTOP00
00999   S101-INT-PEN-COMP.                                              DTSTOP00
01000      CALL 'DTSBU101' USING L101-LINK-AREA.                        DTSTOP00
01001   S101-EXIT.                                                      DTSTOP00
01002       EXIT.                                                       DTSTOP00
01003  S109-SUR-TAX-QTR.                                                   CL*49
01004        SET L109-CMND-PEN-INT-QTR-88  TO TRUE.                        CL*49
01005                                                                      CL*49
01006      CALL 'DTSBU109' USING L109-LINK-AREA.                           CL*49
01007  S109-EXIT.                                                          CL*49
01008      EXIT.                                                           CL*49
01009  S910-OPEN-READ.                                                  DTSTOP00
01010      SET L910-OPEN-READ-88 TO TRUE.                               DTSTOP00
01011      GO TO S910-MSTR-IO.                                          DTSTOP00
01012                                                                   DTSTOP00
01013  S910-OPEN-UPDATE-NO-AIX.                                         DTSTOP00
01014      SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE.                      DTSTOP00
01015      GO TO S910-MSTR-IO.                                          DTSTOP00
01016                                                                   DTSTOP00
01017  S910-OPEN-UPDATE-HDR.                                            DTSTOP00
01018      SET L910-OPEN-UPDATE-HDR-88    TO TRUE.                      DTSTOP00
01019      GO TO S910-MSTR-IO.                                          DTSTOP00
01020                                                                   DTSTOP00
01021  S910-READ.                                                       DTSTOP00
01022      SET L910-READ-88 TO TRUE.                                    DTSTOP00
01023      GO TO S910-MSTR-IO.                                          DTSTOP00
01024                                                                   DTSTOP00
01025  S910-START-BROWSE.                                               DTSTOP00
01026      SET L910-START-BROWSE-88 TO TRUE.                            DTSTOP00
01027      GO TO S910-MSTR-IO.                                          DTSTOP00
01028                                                                   DTSTOP00
01029  S910-READ-NEXT.                                                  DTSTOP00
01030      SET L910-READ-NEXT-88 TO TRUE.                               DTSTOP00
01031      GO TO S910-MSTR-IO.                                          DTSTOP00
01032                                                                   DTSTOP00
01033  S910-COUNT.                                                      DTSTOP00
01034      SET L910-COUNT-88 TO TRUE.                                   DTSTOP00
01035      GO TO S910-MSTR-IO.                                          DTSTOP00
01036                                                                   DTSTOP00
01037  S910-REWRITE.                                                    DTSTOP00
01038      SET L910-REWRITE-88 TO TRUE.                                 DTSTOP00
01039      GO TO S910-MSTR-IO.                                          DTSTOP00
01040                                                                   DTSTOP00
01041  S910-DELETE.                                                     DTSTOP00
01042      SET L910-DELETE-88 TO TRUE.                                  DTSTOP00
01043      GO TO S910-MSTR-IO.                                          DTSTOP00
01044                                                                   DTSTOP00
01045  S910-CLOSE.                                                      DTSTOP00
01046      SET L910-CLOSE-88     TO TRUE.                               DTSTOP00
01047      GO TO S910-MSTR-IO.                                          DTSTOP00
01048                                                                   DTSTOP00
01049  S910-MSTR-IO.                                                    DTSTOP00
01050      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSTOP00
01051                            MSKL-REC.                              DTSTOP00
01052  S910-EXIT.                                                       DTSTOP00
01053      EXIT.                                                        DTSTOP00
01054      SKIP3                                                        DTSTOP00
01055  S111-LOOKUP-ADDR.                                                DTSTOP00
01056      CALL 'DTSBU111' USING L111-LINK-AREA.                        DTSTOP00
01057  S111-EXIT.                                                       DTSTOP00
01058      EXIT.                                                        DTSTOP00
01059  S923-OPEN-UPDATE.                                                DTSTOP00
01060      SET L923-OPEN-UPDATE-88 TO TRUE.                             DTSTOP00
01061      GO TO S923-ATC-IO.                                           DTSTOP00
01062                                                                   DTSTOP00
01063  S923-OPEN-READ.                                                  DTSTOP00
01064      SET L923-OPEN-READ-88 TO TRUE.                               DTSTOP00
01065      GO TO S923-ATC-IO.                                           DTSTOP00
01066                                                                   DTSTOP00
01067  S923-READ.                                                       DTSTOP00
01068      SET L923-READ-88 TO TRUE.                                    DTSTOP00
01069      GO TO S923-ATC-IO.                                           DTSTOP00
01070                                                                   DTSTOP00
01071  S923-START-BROWSE.                                               DTSTOP00
01072      SET L923-START-BROWSE-88 TO TRUE.                            DTSTOP00
01073      GO TO S923-ATC-IO.                                           DTSTOP00
01074                                                                   DTSTOP00
01075  S923-READ-NEXT.                                                  DTSTOP00
01076      SET L923-READ-NEXT-88 TO TRUE.                               DTSTOP00
01077      GO TO S923-ATC-IO.                                           DTSTOP00
01078                                                                   DTSTOP00
01079  S923-WRITE.                                                      DTSTOP00
01080 **   DISPLAY 'S923 WRITE '                                        DTSTOP00
01081      SET L923-WRITE-88 TO TRUE.                                   DTSTOP00
01082      GO TO S923-ATC-IO.                                           DTSTOP00
01083                                                                   DTSTOP00
01084  S923-REWRITE.                                                    DTSTOP00
01085      SET L923-REWRITE-88 TO TRUE.                                 DTSTOP00
01086      GO TO S923-ATC-IO.                                           DTSTOP00
01087                                                                   DTSTOP00
01088  S923-DELETE.                                                     DTSTOP00
01089      SET L923-DELETE-88 TO TRUE.                                  DTSTOP00
01090      GO TO S923-ATC-IO.                                           DTSTOP00
01091                                                                   DTSTOP00
01092  S923-CLOSE.                                                      DTSTOP00
01093      SET L923-CLOSE-88 TO TRUE.                                   DTSTOP00
01094      GO TO S923-ATC-IO.                                           DTSTOP00
01095                                                                   DTSTOP00
01096  S923-ATC-IO.                                                     DTSTOP00
01097 **    DISPLAY 'DTSBU923 '                                         DTSTOP00
01098 **   DISPLAY 'L923 LINK AREA '   L923-LINK-AREA                   DTSTOP00
01099      CALL 'DTSBU923' USING L923-LINK-AREA                         DTSTOP00
01100                            ASKL-REC.                              DTSTOP00
01101  S923-EXIT.                                                       DTSTOP00
01102      EXIT.                                                        DTSTOP00
01103      SKIP3                                                        DTSTOP00
01104  S927-OPEN-UPDATE.                                                DTSTOP00
01105      SET L927-OPEN-UPDATE-88 TO TRUE.                             DTSTOP00
01106      GO TO S927-BTC-O.                                            DTSTOP00
01107                                                                   DTSTOP00
01108  S927-WRITE.                                                      DTSTOP00
01109      SET L927-WRITE-88 TO TRUE.                                   DTSTOP00
01110      GO TO S927-BTC-O.                                            DTSTOP00
01111                                                                   DTSTOP00
01112  S927-CLOSE.                                                      DTSTOP00
01113      SET L927-CLOSE-88 TO TRUE.                                   DTSTOP00
01114      GO TO S927-BTC-O.                                            DTSTOP00
01115                                                                   DTSTOP00
01116  S927-BTC-O.                                                      DTSTOP00
01117      CALL 'DTSBU927' USING L927-LINK-AREA                         DTSTOP00
01118                            TSKL-REC.                              DTSTOP00
01119  S927-EXIT.                                                       DTSTOP00
01120      EXIT.                                                        DTSTOP00
01121                                                                   DTSTOP00
01122      SKIP3                                                        DTSTOP00
01123  S999-ABEND.                                                      DTSTOP00
01124      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSTOP00
01125  S999-EXIT.                                                       DTSTOP00
01126      EXIT.                                                        DTSTOP00
