00001  IDENTIFICATION DIVISION.                                         11/23/09
00002  PROGRAM-ID.             DTSBE460.                                DTSBE460
00003  AUTHOR.                 TDI OUTSOURCES.                             LV005
00004  DATE-WRITTEN.           MARCH 2008.                              DTSBE460
00005  DATE-COMPILED.                                                   DTSBE460
00006      SKIP3                                                        DTSBE460
00007 *****                                                             DTSBE460
00008 *                                                                 DTSBE460
00009 *    CALLING SEQUENCE:  DTSBE400 CALL DTSBE460 TO EXTRACTS AND    DTSBE460
00010 *                       CREATES A CLEAN HAND DISK FILE.           DTSBE460
00011 *                                                                 DTSBE460
00012 *    FUNCTION: CREATE AN OUTPUT FILE OF EMPLOYERS OWING              CL**5
00013 *              MONEY FOR THE CITY-WIDE CLEAN HANDS PROCESS.          CL**5
00014 *                                                                 DTSBE460
00015 *    MODIFICATION LOG:                                            DTSBE460
00016 *                                                                 DTSBE460
00017 *    03/24/2008  INITIAL DEVELOPMENT.                             DTSBE460
00018 *              WORK ORDER:                      PROGRAMMER: RW1   DTSBE460
00019 *                                                                 DTSBE460
00020 *    12/17/2008  MODIFIED TO PUT DATA IN PRODUCTION DATASET.      DTSBE460
00021 *                WORK ORDER:                      PROGRAMMER: gd  DTSBE460
00022 *                                                                 DTSBE460
00023 *    09/14/2009  MODIFIED TO use url instead of ip address.       DTSBE460
00024 *                WORK ORDER:                      PROGRAMMER: gd  DTSBE460
00025 *                                                                 DTSBE460
00026 *    09/21/2009  Corrected URL (in.dc)                            DTSBE460
00027 *                WORK ORDER:                      PROGRAMMER: gd  DTSBE460
00028 *                                                                 DTSBE460
00029 *    11/23/2009  CORRECTED CODE IN P1300 - IT WAS NOT BYPASSING      CL**5
00030 *                THE MOST RECENT QUARTER NOT YET DELINQUENT.         CL**5
00031 *                WORK ORDER:                      PROGRAMMER: gd     CL**5
00032 *                                                                    CL**5
00029 *    02/10/2017  Updated the server and folder location to send      CL**5
00030 *                the CCH file to new CFO server.                     CL**5
00031 *                WORK ORDER:                      PROGRAMMER:NKG     CL**5
00032 *                                                                    CL**5
00032 *                                                                    CL**5
00029 *    01/16/2019  Updated file from comma seperated to pike           CL**5
00031 *                WORK ORDER:                      PROGRAMMER:zl1     CL**5
00032 *                                                                    CL**5
00033 *    XX/XX/XxxX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE460
00034 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE460
00035 *                WORK ORDER:                      PROGRAMMER: XXX DTSBE460
00036 *                                                                 DTSBE460
00037 *  DESCRIPTION:                                                   DTSBE460
00038 *                                                                 DTSBE460
00039 *                                                                 DTSBE460
00040 *    INITIATION:                                                  DTSBE460
00041 *                                                                 DTSBE460
00042 *      SET LECM-MST-OPEN-READ-88 TO TRUE.                         DTSBE460
00043 *      SET LECM-REF-OPEN-READ-88 TO TRUE.                         DTSBE460
00044 *                                                                 DTSBE460
00045 *    PROCESSING:                                                  DTSBE460
00046 *                                                                 DTSBE460
00047 *      SEE DISK FILE RECORD LAYOUTS (DTSIX460).                   DTSBE460
00048 *                                                                 DTSBE460
00049 *                                                                 DTSBE460
00050 *    TERMINATION:                                                 DTSBE460
00051 *                                                                 DTSBE460
00052 *      DISPLAYING OUTPUT RECORDS COUNT.                           DTSBE460
00053 *                                                                 DTSBE460
00054 *                                                                 DTSBE460
00055 *    RECORDS READ:                                                DTSBE460
00056 *                                                                 DTSBE460
00057 *      MASTER:                                                    DTSBE460
00058 *                                                                 DTSBE460
00059 *        MSOL                                                     DTSBE460
00060 *                                                                 DTSBE460
00061 *                                                                 DTSBE460
00062 *      ALTERNATE INDEX:                                           DTSBE460
00063 *                                                                 DTSBE460
00064 *        NONE.                                                    DTSBE460
00065 *                                                                 DTSBE460
00066 *                                                                 DTSBE460
00067 *      REFERENCE:                                                 DTSBE460
00068 *                                                                 DTSBE460
00069 *        NONE.                                                    DTSBE460
00070 *                                                                 DTSBE460
00071 *                                                                 DTSBE460
00072 *    RECORDS UPDATED:                                             DTSBE460
00073 *                                                                 DTSBE460
00074 *        NONE.                                                    DTSBE460
00075 *                                                                 DTSBE460
00076 *                                                                 DTSBE460
00077 *    REPORT RECORDS WRITTEN:                                      DTSBE460
00078 *                                                                 DTSBE460
00079 *        NONE.                                                    DTSBE460
00080 *                                                                 DTSBE460
00081 *                                                                 DTSBE460
00082 *    BATCH TRANSACTION COLLECTION RECORDS WRITTEN:                DTSBE460
00083 *                                                                 DTSBE460
00084 *        NONE.                                                    DTSBE460
00085 *                                                                 DTSBE460
00086 *                                                                 DTSBE460
00087 *    MODULES CALLED:                                              DTSBE460
00088 *                                                                 DTSBE460
00089 *        DTSBU001  DATE CONVERSION/EDIT.                          DTSBE460
00090 *        DTSBU004  QUARTER CONVERSION/EDIT.                       DTSBE460
00091 *        DTSBU910  MASTER FILE I/O.                               DTSBE460
00092 *                                                                 DTSBE460
00093 *                                                                 DTSBE460
00094 *    VERMONT REFERENCE:                                           DTSBE460
00095 *                                                                 DTSBE460
00096 *        NONE.                                                    DTSBE460
00097 *                                                                 DTSBE460
00098 *****                                                             DTSBE460
00099      SKIP3                                                        DTSBE460
00100  ENVIRONMENT DIVISION.                                            DTSBE460
00101  INPUT-OUTPUT SECTION.                                            DTSBE460
00102                                                                   DTSBE460
00103  FILE-CONTROL.                                                    DTSBE460
00104      SELECT FTP-PARM-FILE ASSIGN TO FTPPARM                       DTSBE460
00105                  FILE STATUS IS FTP-PARM-STATUS.                  DTSBE460
00106                                                                   DTSBE460
00107      SELECT CLEAN-FILE  ASSIGN TO DTSCLEAN                        DTSBE460
00108                  FILE STATUS IS CLN-STATUS.                       DTSBE460
00109                                                                   DTSBE460
00110  DATA DIVISION.                                                   DTSBE460
00111                                                                   DTSBE460
00112  FILE SECTION.                                                    DTSBE460
00113  FD  FTP-PARM-FILE                                                DTSBE460
00114      RECORDING MODE IS F                                          DTSBE460
00115      BLOCK CONTAINS 0 RECORDS.                                    DTSBE460
00116                                                                   DTSBE460
00117  01  FTP-PARM-REC                      PIC X(80).                 DTSBE460
00118                                                                   DTSBE460
00119  FD  CLEAN-FILE                                                   DTSBE460
00120      RECORDING MODE IS F                                          DTSBE460
00121      LABEL RECORDS ARE STANDARD                                   DTSBE460
00122      BLOCK CONTAINS 0 CHARACTERS.                                 DTSBE460
00123                                                                   DTSBE460
00124  01  CLEAN-REC                         PIC X(386).                DTSBE460
00125                                                                   DTSBE460
00126  WORKING-STORAGE SECTION.                                         DTSBE460
001265 77  PAN-VALET PICTURE X(24) VALUE '029DTSBE460  01/16/20'.       DTSBE460
00127      SKIP3                                                        DTSBE460
00128  01  WRK-AREA.                                                    DTSBE460
00129      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +460.DTSBE460
00130      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBE460'.DTSBE460
00131      05  ABEND-MSG                   PIC  X(60).                  DTSBE460
00132                                                                   DTSBE460
00133      05  WRK-INACT-DATE              PIC S9(09)  COMP-3 VALUE +0. DTSBE460
00134                                                                   DTSBE460
00135      05  CLN-STATUS                  PIC  X(02).                  DTSBE460
00136          88  CLN-STATUS-OK-88               VALUE '00'.           DTSBE460
00137      05  FTP-PARM-STATUS             PIC  X(02).                  DTSBE460
00138          88  FTP-STATUS-OK-88               VALUE '00'.           DTSBE460
00139                                                                   DTSBE460
00140      05  WRK-CHAR-FOUND-IND          PIC  X(01).                  DTSBE460
00141          88  WRK-CHAR-FOUND-YES-88     VALUE 'Y'.                 DTSBE460
00142          88  WRK-CHAR-FOUND-NO-88      VALUE 'N'.                 DTSBE460
00143                                                                   DTSBE460
00144      05  WRK-ERROR-IND               PIC  X(01).                  DTSBE460
00145          88  WRK-ERROR-YES-88          VALUE 'Y'.                 DTSBE460
00146          88  WRK-ERROR-NO-88           VALUE 'N'.                 DTSBE460
00147                                                                   DTSBE460
00148      05  WRK-SELECT-IND              PIC  X(01).                  DTSBE460
00149          88  WRK-SELECT-YES-88         VALUE 'Y'.                 DTSBE460
00150          88  WRK-SELECT-NO-88          VALUE 'N'.                 DTSBE460
00151                                                                   DTSBE460
00152      05  WRK-SU-CHG-IND              PIC  X(01).                  DTSBE460
00153          88  WRK-SU-CHG-YES-88         VALUE 'Y'.                 DTSBE460
00154          88  WRK-SU-CHG-NO-88          VALUE 'N'.                 DTSBE460
00155                                                                   DTSBE460
00156      05  WRK-LP-CHG-IND              PIC  X(01).                  DTSBE460
00157          88  WRK-LP-CHG-YES-88         VALUE 'Y'.                 DTSBE460
00158          88  WRK-LP-CHG-NO-88          VALUE 'N'.                 DTSBE460
00159                                                                   DTSBE460
00160      05  WRK-TBL-ROW-FOUND-IND       PIC  X(01).                  DTSBE460
00161          88  WRK-TBL-ROW-FOUND-YES-88  VALUE 'Y'.                 DTSBE460
00162          88  WRK-TBL-ROW-FOUND-NO-88   VALUE 'N'.                 DTSBE460
00163                                                                   DTSBE460
00164      05  TSUB                        PIC S9(04)  COMP             DTSBE460
00165                                             VALUE +0.             DTSBE460
00166      05  TMAX                        PIC S9(04)  COMP             DTSBE460
00167                                             VALUE +100.           DTSBE460
00168      05  TLAST                       PIC S9(04)  COMP             DTSBE460
00169                                             VALUE +0.             DTSBE460
00170      05  WRK-MDST-TBL  OCCURS 100 TIMES.                          DTSBE460
00171          10  TBL-DOC.                                             DTSBE460
00172              15  TBL-BATCH           PIC S9(05)     COMP-3.       DTSBE460
00173              15  TBL-ITEM            PIC S9(03)     COMP-3.       DTSBE460
00174          10  TBL-PAY                 PIC S9(11)V99  COMP-3.       DTSBE460
00175                                                                   DTSBE460
00176      05  WRK-TOT-BAL                 PIC S9(11)V99  COMP-3        DTSBE460
00177                                             VALUE +0.             DTSBE460
00178      05  WRK-QTR-BAL                 PIC S9(11)V99  COMP-3        DTSBE460
00179                                             VALUE +0.             DTSBE460
00180                                                                   DTSBE460
00181      05  WRK-FTP-PARM-AREA.                                       DTSBE460
00182 *********************************************************         DTSBE460
00183 *   IP address ending in 197 is production.                       DTSBE460
00184 *   IP address ending in 195 is test.                             DTSBE460
00185 *   changed from IP address to domain name 9/14/2009              DTSBE460
00186 *********************************************************         DTSBE460
00187          10  FTP-LINE-1              PIC X(80)                    DTSBE460
00188 **           VALUE 'cchprod.ocfo.in.dc.gov'.                      DTSBE460
00189              VALUE '10.16.12.216 990'.                            DTSBE460
00189 ***********  VALUE '10.16.135.197'.                               DTSBE460
00190 ***********  VALUE '10.16.135.195'.                               DTSBE460
00191          10  FTP-LINE-2              PIC X(80)                    DTSBE460
00192 *********************************************************         DTSBE460
00193 *   User id: pdoes is for production.                             DTSBE460
00194 *   User id: does is for test.                                    DTSBE460
00195 *********************************************************         DTSBE460
00196              VALUE 'MFDOESDebt-P'.                                DTSBE460
00197 ***********  VALUE 'does'.                                        DTSBE460
00198          10  FTP-LINE-3              PIC X(80)                    DTSBE460
00199              VALUE 'jraib8fI'.                                    DTSBE460
00200 *********************************************************         DTSBE460
00201 *   file directory: pdoes is for production.                      DTSBE460
00202 *   file directory: does is for production.                       DTSBE460
00203 *********************************************************         DTSBE460
00204          10  FTP-LINE-4              PIC X(80)                    DTSBE460
00205              VALUE 'CD \incoming-prod\Debt\'.                     DTSBE460
00206 *        10  FTP-LINE-5              PIC X(80)                    DTSBE460
00207 *            VALUE 'pwd'.                                         DTSBE460
00208 *        10  FTP-LINE-6              PIC X(80)                    DTSBE460
00209 *            VALUE 'ascii'.                                       DTSBE460
00210          10  FTP-LINE-7.                                          DTSBE460
00211              15  FILLER                  PIC X(04)                DTSBE460
00212                  VALUE 'PUT '.                                    DTSBE460
00213              15  FILLER                  PIC X(01)                DTSBE460
00214                  VALUE QUOTE.                                     DTSBE460
00215              15  FILLER                  PIC X(30)                DTSBE460
00216                  VALUE 'ECNTSUP.DOESTAX.PROD.FTP.BE460'.          DTSBE460
00217              15  FILLER                  PIC X(01)                DTSBE460
00218                  VALUE QUOTE.                                     DTSBE460
00219              15  FILLER                  PIC X(10)                DTSBE460
00220                  VALUE ' CCH_DEBT_'.                              DTSBE460
00221              15  FTP-FILENAME-AGY        PIC X(06)                DTSBE460
00222                  VALUE '110000'.                                  DTSBE460
00223              15  FILLER                  PIC X(01)                DTSBE460
00224                  VALUE '_'.                                       DTSBE460
00225              15  FTP-FILENAME-DATE       PIC 9(08).               DTSBE460
00226              15  FILLER                  PIC X(01)                DTSBE460
00227                  VALUE '_'.                                       DTSBE460
00228              15  FTP-FILENAME-SEQ        PIC X(02)                DTSBE460
00229 **               VALUE '02'.                                      DTSBE460
00230                  VALUE '01'.                                      DTSBE460
00231              15  FILLER                  PIC X(04)                DTSBE460
00232                  VALUE '.csv'.                                    DTSBE460
00233          10  FTP-LINE-8              PIC X(80)                    DTSBE460
00234              VALUE 'quit'.                                        DTSBE460
00235                                                                   DTSBE460
00236      05  WRK-CLEAN-CNT               PIC S9(07)  COMP-3 VALUE +0. DTSBE460
00237                                                                   DTSBE460
00238      05  WRK-INACT-YRQ               PIC S9(05)  COMP-3           DTSBE460
00239                                             VALUE +0.             DTSBE460
00240      05  WRK-CUTOFF-YRQ              PIC S9(05)  COMP-3           DTSBE460
00241                                             VALUE +0.             DTSBE460
00242      05  WRK-START-DPC-DT            PIC S9(09)  COMP-3           DTSBE460
00243                                             VALUE +0.             DTSBE460
00244      05  WRK-EMP-START-DPC-DT        PIC S9(09)  COMP-3           DTSBE460
00245                                             VALUE +0.             DTSBE460
00246      05  WRK-DPC-PMT                 PIC S9(11)V99  COMP-3        DTSBE460
00247                                             VALUE +0.             DTSBE460
00248      05  WRK-AVG-DPC-PMT             PIC S9(11)V99  COMP-3        DTSBE460
00249                                             VALUE +0.             DTSBE460
00250      05  WRK-DPC-PMT-CNT             PIC S9(03)     COMP-3        DTSBE460
00251                                             VALUE +0.             DTSBE460
00252      05  WRK-DPC-BYPASS-CNT          PIC S9(07)     COMP-3        DTSBE460
00253                                             VALUE +0.             DTSBE460
00254      05  WRK-MTAD-CNT                PIC S9(07)  COMP-3 VALUE 0.  DTSBE460
00255      05  WRK-NO-MTAD-CNT             PIC S9(07)  COMP-3 VALUE 0.  DTSBE460
00256      05  WRK-STREET-NUMBER           PIC  X(10)  VALUE SPACES.    DTSBE460
00257      05  WRK-STREET-NAME             PIC  X(100) VALUE SPACES.    DTSBE460
00257      05  WRK-addr-line2.                                          DTSBE460
00257          15  WRK-addr-line2a         PIC  X(05) VALUE SPACES.     DTSBE460
00257          15  WRK-addr-line2b         PIC  X(35) VALUE SPACES.     DTSBE460
00258                                                                   DTSBE460
00259      05  WRK-FEIN-13.                                             DTSBE460
00260          10  FILLER                  PIC  9(04) VALUE 0.          DTSBE460
00261          10  WRK-FEIN-9              PIC  9(09) VALUE 0.          DTSBE460
00262 ***  05  WRK-EMP-13.                                              DTSBE460
00263 *        10  FILLER                  PIC  X(07) VALUE SPACES.     DTSBE460
00264 ***      10  WRK-EMP-6               PIC  9(06) VALUE 0.          DTSBE460
00265                                                                   DTSBE460
00266      05  WRK-ZIP.                                                 DTSBE460
00267          10  WRK-ZIP-5               PIC  9(05) VALUE 0.          DTSBE460
00268          10  FILLER                  PIC  X(01) VALUE SPACES.     DTSBE460
00269          10  WRK-ZIP-4               PIC  9(04) VALUE 0.          DTSBE460
00270                                                                   DTSBE460
00271      05  SUB1                        PIC S9(04) COMP.             DTSBE460
00272      05  SUB2                        PIC S9(04) COMP.             DTSBE460
00273      05  SUB3                        PIC S9(04) COMP.             DTSBE460
00274      05  SUB4                        PIC S9(04) COMP.             DTSBE460
00275                                                                   DTSBE460
00276      05  AMT-DISP1                   PIC ----------9.99.          DTSBE460
00277      05  AMT-DISP2                   PIC ----------9.99.          DTSBE460
00278      05  AMT-DISP3                   PIC ----------9.99.          DTSBE460
00279                                                                   DTSBE460
00280  01  WRK-CLEAN-REC.                                               DTSBE460
00281  ++INCLUDE DTSIX460                                               DTSBE460
00282      EJECT                                                        DTSBE460
00283  01  WRK-CLEAN-HEADER.                                            DTSBE460
00284  ++INCLUDE DTSIX461                                               DTSBE460
00285      EJECT                                                        DTSBE460
00286  01  L001-LINK-AREA.                                              DTSBE460
00287  ++INCLUDE DTSIL001                                               DTSBE460
00288      EJECT                                                        DTSBE460
00289  01  L004-LINK-AREA.                                              DTSBE460
00290  ++INCLUDE DTSIL004                                               DTSBE460
00291      EJECT                                                        DTSBE460
00292  01  L910-LINK-AREA.                                              DTSBE460
00293  ++INCLUDE DTSIL910                                               DTSBE460
00294      SKIP3                                                        DTSBE460
00295  01  MSKL-REC.                                                    DTSBE460
00296  ++INCLUDE DTSIMSKL                                               DTSBE460
00297      SKIP3                                                        DTSBE460
00298  01  MHDR-REC.                                                    DTSBE460
00299  ++INCLUDE DTSIMHDR                                               DTSBE460
00300      SKIP3                                                        DTSBE460
00301  01  MSOL-REC.                                                    DTSBE460
00302  ++INCLUDE DTSIMSOL                                               DTSBE460
00303      EJECT                                                        DTSBE460
00304  01  MTAD-REC.                                                    DTSBE460
00305  ++INCLUDE DTSIMTAD                                               DTSBE460
00306      EJECT                                                        DTSBE460
00307  01  MQTR-REC.                                                    DTSBE460
00308  ++INCLUDE DTSIMQTR                                               DTSBE460
00309      EJECT                                                        DTSBE460
00310  01  MDPC-REC.                                                    DTSBE460
00311  ++INCLUDE DTSIMDPC                                               DTSBE460
00312      EJECT                                                        DTSBE460
00313  01  MDST-REC.                                                    DTSBE460
00314  ++INCLUDE DTSIMDST                                               DTSBE460
00315      EJECT                                                        DTSBE460
00316  LINKAGE SECTION.                                                 DTSBE460
00317      SKIP3                                                        DTSBE460
00318  01  LECM-LINK-AREA.                                              DTSBE460
00319  ++INCLUDE DTSILECM                                               DTSBE460
00320      EJECT                                                        DTSBE460
00321  01  MPRF-LINK-REC.                                               DTSBE460
00322  ++INCLUDE DTSIMPRF                                               DTSBE460
00323      EJECT                                                        DTSBE460
00324 **************************************************************    DTSBE460
00325 *  PROCEDURE DIVISION FOR DTSBE460                           *    DTSBE460
00326 *  EXTRACT STARTS HERE.                                      *    DTSBE460
00327 **************************************************************    DTSBE460
00328                                                                   DTSBE460
00329  PROCEDURE DIVISION USING LECM-LINK-AREA                          DTSBE460
00330                           MPRF-LINK-REC.                          DTSBE460
00331      SKIP2                                                        DTSBE460
00332      IF LECM-PROCESS-88                                           DTSBE460
00333          PERFORM P0000-PROCESS THRU P0000-EXIT                    DTSBE460
00334      ELSE                                                         DTSBE460
00335      IF LECM-INITIALIZE-88                                        DTSBE460
00336          PERFORM I0000-INITIALIZE THRU I0000-EXIT                 DTSBE460
00337      ELSE                                                         DTSBE460
00338      IF LECM-TERMINATE-88                                         DTSBE460
00339          PERFORM T0000-TERMINATE THRU T0000-EXIT                  DTSBE460
00340      ELSE                                                         DTSBE460
00341          MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED'            DTSBE460
00342            TO ABEND-MSG                                           DTSBE460
00343          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBE460
00344      SKIP2                                                        DTSBE460
00345      GOBACK.                                                      DTSBE460
00346      EJECT                                                        DTSBE460
00347  I0000-INITIALIZE.                                                DTSBE460
00348                                                                   DTSBE460
00349      MOVE LECM-TRACE-IND TO L910-TRACE-IND.                       DTSBE460
00350      MOVE WRK-MOD-NAME TO L910-MOD-NAME.                          DTSBE460
00351                                                                   DTSBE460
00352      OPEN OUTPUT CLEAN-FILE.                                      DTSBE460
00353      IF NOT CLN-STATUS-OK-88                                      DTSBE460
00354         DISPLAY 'CLEAN FILE OPEN ERROR: ' CLN-STATUS              DTSBE460
00355         MOVE 'CLEAN FILE OPEN ERROR'                              DTSBE460
00356                TO ABEND-MSG                                       DTSBE460
00357         PERFORM S999-ABEND THRU S999-EXIT                         DTSBE460
00358      ELSE                                                         DTSBE460
00359         DISPLAY 'CLEAN FILE OPENED O.K.'                          DTSBE460
00360      END-IF.                                                      DTSBE460
00361                                                                   DTSBE460
00362      SET LECM-MST-OPEN-READ-88 TO TRUE.                           DTSBE460
00363      SET LECM-REF-OPEN-READ-88 TO TRUE.                           DTSBE460
00364                                                                   DTSBE460
00365      PERFORM I1000-READ-MHDR           THRU I1000-EXIT.           DTSBE460
00366                                                                   DTSBE460
00367      PERFORM I2000-DPC-PMT-DATES       THRU I2000-EXIT.           DTSBE460
00368                                                                   DTSBE460
00369      PERFORM I3000-BUILD-FTP-PARM      THRU I3000-EXIT.           DTSBE460
00370                                                                   DTSBE460
00371  I0000-EXIT.                                                      DTSBE460
00372      EXIT.                                                        DTSBE460
00373                                                                   DTSBE460
00374  I1000-READ-MHDR.                                                 DTSBE460
00375      MOVE LOW-VALUES TO MHDR-KEY-AREA.                            DTSBE460
00376      MOVE +0 TO MHDR-EMP-NO.                                      DTSBE460
00377      SET MHDR-HDR-88 TO TRUE.                                     DTSBE460
00378      MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA.                         DTSBE460
00379                                                                   DTSBE460
00380      PERFORM S910-READ THRU S910-EXIT.                            DTSBE460
00381      IF L910-NO-REC-88                                            DTSBE460
00382          MOVE 'MHDR RECORD NOT FOUND' TO ABEND-MSG                DTSBE460
00383          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBE460
00384                                                                   DTSBE460
00385      MOVE MSKL-REC TO MHDR-REC.                                   DTSBE460
00386                                                                   DTSBE460
00387      MOVE MHDR-CMPL-QTR-BEGIN-DATE  TO L004-DATE.                 DTSBE460
00388      PERFORM S004-FROM-DATE         THRU S004-EXIT.               DTSBE460
00389      DISPLAY 'LAST COMPLETED QTR  : ' L004-SLASH-5-QTR.           DTSBE460
00390                                                                   DTSBE460
00391      SUBTRACT 3                     FROM L004-QTR-5-YR.           DTSBE460
00392      PERFORM S004-FROM-FIVE         THRU S004-EXIT.               DTSBE460
00393      MOVE L004-QTR-5-9              TO WRK-CUTOFF-YRQ.            DTSBE460
00394      DISPLAY 'INACT CUTOFF QTR    : ' L004-SLASH-5-QTR.           DTSBE460
00395                                                                   DTSBE460
00396  I1000-EXIT.                                                      DTSBE460
00397      EXIT.                                                        DTSBE460
00398                                                                   DTSBE460
00399  I2000-DPC-PMT-DATES.                                             DTSBE460
00400      MOVE LECM-CURR-RUN-DATE        TO L001-FED-8-DATE-9.         DTSBE460
00401      PERFORM S001-FROM-FED-8        THRU S001-EXIT.               DTSBE460
00402      SUBTRACT +90                   FROM L001-JUL-ABS-DAY.        DTSBE460
00403      PERFORM S001-FROM-ABS-DAY      THRU S001-EXIT.               DTSBE460
00404      MOVE 01                        TO L001-FED-8-DA.             DTSBE460
00405      MOVE L001-FED-8-DATE-9         TO WRK-START-DPC-DT.          DTSBE460
00406      DISPLAY 'DPC START DATE ' L001-FED-8-DATE-9.                 DTSBE460
00407                                                                   DTSBE460
00408  I2000-EXIT.                                                      DTSBE460
00409      EXIT.                                                        DTSBE460
00410                                                                   DTSBE460
00411  I3000-BUILD-FTP-PARM.                                            DTSBE460
00412      MOVE LECM-CURR-RUN-DATE           TO L001-FED-8-DATE-9.      DTSBE460
00413      PERFORM S001-FROM-FED-8           THRU S001-EXIT.            DTSBE460
00414      MOVE L001-CAL-8-DATE-9            TO FTP-FILENAME-DATE.      DTSBE460
00415                                                                   DTSBE460
00416      INSPECT WRK-FTP-PARM-AREA                                    DTSBE460
00417         CONVERTING LOW-VALUES TO SPACES.                          DTSBE460
00418                                                                   DTSBE460
00419 ***  DISPLAY 'PARM ' WRK-FTP-PARM-AREA.                           DTSBE460
00420                                                                   DTSBE460
00421      OPEN OUTPUT FTP-PARM-FILE.                                   DTSBE460
00422      IF NOT FTP-STATUS-OK-88                                      DTSBE460
00423         DISPLAY 'CANNOT OPEN PARMLIB ' FTP-PARM-STATUS            DTSBE460
00424         PERFORM S999-ABEND             THRU S999-EXIT             DTSBE460
00425      ELSE                                                         DTSBE460
00426         PERFORM I3100-WRITE-DATA       THRU I3100-EXIT            DTSBE460
00427         CLOSE FTP-PARM-FILE                                       DTSBE460
00428      END-IF.                                                      DTSBE460
00429                                                                   DTSBE460
00430                                                                   DTSBE460
00431  I3000-EXIT.                                                      DTSBE460
00432      EXIT.                                                        DTSBE460
00433                                                                   DTSBE460
00434  I3100-WRITE-DATA.                                                DTSBE460
00435      MOVE FTP-LINE-1                     TO FTP-PARM-REC.         DTSBE460
00436      PERFORM I3110-WRITE                 THRU I3110-EXIT.         DTSBE460
00437                                                                   DTSBE460
00438      MOVE FTP-LINE-2                     TO FTP-PARM-REC.         DTSBE460
00439      PERFORM I3110-WRITE                 THRU I3110-EXIT.         DTSBE460
00440                                                                   DTSBE460
00441      MOVE FTP-LINE-3                     TO FTP-PARM-REC.         DTSBE460
00442      PERFORM I3110-WRITE                 THRU I3110-EXIT.         DTSBE460
00443                                                                   DTSBE460
00444      MOVE FTP-LINE-4                     TO FTP-PARM-REC.         DTSBE460
00445      PERFORM I3110-WRITE                 THRU I3110-EXIT.         DTSBE460
00446                                                                   DTSBE460
00447 *    MOVE FTP-LINE-5                     TO FTP-PARM-REC.         DTSBE460
00448 *    PERFORM I3110-WRITE                 THRU I3110-EXIT.         DTSBE460
00449                                                                   DTSBE460
00450 *    MOVE FTP-LINE-6                     TO FTP-PARM-REC.         DTSBE460
00451 *    PERFORM I3110-WRITE                 THRU I3110-EXIT.         DTSBE460
00452                                                                   DTSBE460
00453      MOVE FTP-LINE-7                     TO FTP-PARM-REC.         DTSBE460
00454      PERFORM I3110-WRITE                 THRU I3110-EXIT.         DTSBE460
00455                                                                   DTSBE460
00456      MOVE FTP-LINE-8                     TO FTP-PARM-REC.         DTSBE460
00457      PERFORM I3110-WRITE                 THRU I3110-EXIT.         DTSBE460
00458                                                                   DTSBE460
00459  I3100-EXIT.                                                      DTSBE460
00460      EXIT.                                                        DTSBE460
00461                                                                   DTSBE460
00462  I3110-WRITE.                                                     DTSBE460
00463      WRITE FTP-PARM-REC.                                          DTSBE460
00464      IF NOT FTP-STATUS-OK-88                                      DTSBE460
00465         DISPLAY 'CANNOT WRITE FTP-PARM ' FTP-PARM-STATUS          DTSBE460
00466         PERFORM S999-ABEND             THRU S999-EXIT             DTSBE460
00467      END-IF.                                                      DTSBE460
00468                                                                   DTSBE460
00469  I3110-EXIT.                                                      DTSBE460
00470      EXIT.                                                        DTSBE460
00471                                                                   DTSBE460
00472  P0000-PROCESS.                                                   DTSBE460
00473      SET WRK-ERROR-NO-88            TO TRUE.                      DTSBE460
00474      MOVE ZERO                      TO WRK-TOT-BAL.               DTSBE460
00475                                                                   DTSBE460
00476      IF MPRF-CLASS-SUB-88                                         DTSBE460
00477         IF (MPRF-SUSPEND-COLL-NO-88 AND                           DTSBE460
00478             MPRF-NOT-WRITTEN-OFF-88 AND                           DTSBE460
00479             MPRF-BANKRP-NOT-OPEN-88 AND                           DTSBE460
00480             MPRF-NO-MAPL-88)                                      DTSBE460
00481             NEXT SENTENCE                                         DTSBE460
00482         ELSE                                                      DTSBE460
00483            GO TO P0000-EXIT                                       DTSBE460
00484      ELSE                                                         DTSBE460
00485         GO TO P0000-EXIT                                          DTSBE460
00486      END-IF.                                                      DTSBE460
00487                                                                   DTSBE460
00482      if mprf-emp-no = 314960                                      DTSBE460
00483       GO TO P0000-EXIT.                                           DTSBE460
00487                                                                   DTSBE460
00488      IF MPRF-FEIN = ZERO                                          DTSBE460
00489         GO TO P0000-EXIT                                          DTSBE460
00490      END-IF.                                                      DTSBE460
00491                                                                   DTSBE460
00492      IF MPRF-STATUS-INACT-88                                      DTSBE460
00493         PERFORM P1000-LAST-LIAB-YRQ THRU P1000-EXIT               DTSBE460
00494         IF WRK-INACT-YRQ > WRK-CUTOFF-YRQ                         DTSBE460
00495               NEXT SENTENCE                                       DTSBE460
00496         ELSE                                                      DTSBE460
00497            GO TO P0000-EXIT                                       DTSBE460
00498         END-IF                                                    DTSBE460
00499      END-IF.                                                      DTSBE460
00500                                                                   DTSBE460
00501 **   IF MPRF-TOT-BALANCE-AMT > 100                                DTSBE460
00502 **   IF MPRF-TOT-BALANCE-AMT > 1                                  DTSBE460
00503      IF MPRF-TOT-BALANCE-AMT >= 15                                DTSBE460
00504         NEXT SENTENCE                                             DTSBE460
00505      ELSE                                                         DTSBE460
00506         GO TO P0000-EXIT                                          DTSBE460
00507      END-IF.                                                      DTSBE460
00508                                                                   DTSBE460
00509      IF MPRF-MDPC-EXISTS-88                                       DTSBE460
00510         SET WRK-SELECT-NO-88      TO TRUE                         DTSBE460
00511         PERFORM P1100-CHECK-DPC   THRU P1100-EXIT                 DTSBE460
00512         IF WRK-SELECT-NO-88                                       DTSBE460
00513            GO TO P0000-EXIT                                       DTSBE460
00514         END-IF                                                    DTSBE460
00515      END-IF.                                                      DTSBE460
00516                                                                   DTSBE460
00517      PERFORM P1200-FIND-MTAD THRU P1200-EXIT.                     DTSBE460
00518      IF WRK-ERROR-YES-88                                          DTSBE460
00519         GO TO P0000-EXIT                                          DTSBE460
00520      END-IF.                                                      DTSBE460
00521                                                                   DTSBE460
00522      PERFORM P1300-BALANCE-DUE   THRU P1300-EXIT.                 DTSBE460
00523 **   IF WRK-TOT-BAL < 100                                         DTSBE460
00524      IF WRK-TOT-BAL < 15                                          DTSBE460
00525         GO TO P0000-EXIT                                          DTSBE460
00526      END-IF.                                                      DTSBE460
00527                                                                   DTSBE460
00528      PERFORM P1400-BUILD-REC     THRU P1400-EXIT.                 DTSBE460
00529                                                                   DTSBE460
00530  P0000-EXIT.                                                      DTSBE460
00531      EXIT.                                                        DTSBE460
00532                                                                   DTSBE460
00533  P1000-LAST-LIAB-YRQ.                                             DTSBE460
00534      MOVE ZERO TO WRK-INACT-YRQ.                                  DTSBE460
00535                                                                   DTSBE460
00536      MOVE LOW-VALUES  TO MSKL-KEY-AREA.                           DTSBE460
00537      MOVE MPRF-EMP-NO TO MSKL-EMP-NO.                             DTSBE460
00538      SET MSKL-SOL-88  TO TRUE.                                    DTSBE460
00539                                                                   DTSBE460
00540      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBE460
00541      IF L910-NO-REC-88                                            DTSBE460
00542         GO TO P1000-EXIT                                          DTSBE460
00543      ELSE                                                         DTSBE460
00544         PERFORM                                                   DTSBE460
00545          UNTIL L910-NO-REC-88                                     DTSBE460
00546            MOVE MSKL-REC          TO MSOL-REC                     DTSBE460
00547            IF (MSOL-INACT-INACTIVE-88                             DTSBE460
00548                AND NOT MSOL-INACT-WITHDRAWN-88)                   DTSBE460
00549               IF MSOL-LAST-LIAB-YRQ > WRK-INACT-YRQ               DTSBE460
00550                  MOVE MSOL-LAST-LIAB-YRQ TO WRK-INACT-YRQ         DTSBE460
00551               END-IF                                              DTSBE460
00552            END-IF                                                 DTSBE460
00553            PERFORM S910-READ-NEXT THRU S910-EXIT                  DTSBE460
00554         END-PERFORM                                               DTSBE460
00555      END-IF.                                                      DTSBE460
00556                                                                   DTSBE460
00557  P1000-EXIT.                                                      DTSBE460
00558      EXIT.                                                        DTSBE460
00559                                                                   DTSBE460
00560  P1100-CHECK-DPC.                                                 DTSBE460
00561      MOVE LOW-VALUES                 TO MDPC-KEY-AREA.            DTSBE460
00562      MOVE MPRF-EMP-NO                TO MDPC-EMP-NO.              DTSBE460
00563      SET MDPC-DPC-88                 TO TRUE.                     DTSBE460
00564      MOVE MDPC-KEY-AREA              TO MSKL-KEY-AREA.            DTSBE460
00565      PERFORM S910-START-BROWSE       THRU S910-EXIT.              DTSBE460
00566      PERFORM UNTIL L910-NO-REC-88                                 DTSBE460
00567         MOVE MSKL-REC                 TO MDPC-REC                 DTSBE460
00568         IF MDPC-STATUS-ACTIVE-88                                  DTSBE460
00569            PERFORM P1110-FIND-PMT     THRU P1110-EXIT             DTSBE460
00570         END-IF                                                    DTSBE460
00571         PERFORM S910-READ-NEXT        THRU S910-EXIT              DTSBE460
00572      END-PERFORM.                                                 DTSBE460
00573                                                                   DTSBE460
00574  P1100-EXIT.                                                      DTSBE460
00575      EXIT.                                                        DTSBE460
00576                                                                   DTSBE460
00577  P1110-FIND-PMT.                                                  DTSBE460
00578      MOVE ZERO                       TO WRK-DPC-PMT               DTSBE460
00579                                         WRK-AVG-DPC-PMT           DTSBE460
00580                                         WRK-DPC-PMT-CNT           DTSBE460
00581                                         TLAST.                    DTSBE460
00582                                                                   DTSBE460
00583      PERFORM                                                      DTSBE460
00584        VARYING TSUB FROM +1 BY +1                                 DTSBE460
00585        UNTIL TSUB > TMAX                                          DTSBE460
00586          MOVE +0                     TO TBL-BATCH (TSUB)          DTSBE460
00587                                         TBL-ITEM (TSUB)           DTSBE460
00588                                         TBL-PAY (TSUB)            DTSBE460
00589      END-PERFORM.                                                 DTSBE460
00590                                                                   DTSBE460
00591      IF MDPC-PMT-BEGIN-DATE > WRK-START-DPC-DT                    DTSBE460
00592         MOVE MDPC-PMT-BEGIN-DATE     TO WRK-EMP-START-DPC-DT      DTSBE460
00593      ELSE                                                         DTSBE460
00594         MOVE WRK-START-DPC-DT        TO WRK-EMP-START-DPC-DT      DTSBE460
00595      END-IF.                                                      DTSBE460
00596                                                                   DTSBE460
00597      MOVE LOW-VALUES                 TO MDST-KEY-AREA.            DTSBE460
00598      MOVE MPRF-EMP-NO                TO MDST-EMP-NO.              DTSBE460
00599      SET MDST-DST-88                 TO TRUE.                     DTSBE460
00600      MOVE MDST-KEY-AREA              TO MSKL-KEY-AREA.            DTSBE460
00601      PERFORM S910-START-BROWSE       THRU S910-EXIT.              DTSBE460
00602      PERFORM UNTIL L910-NO-REC-88                                 DTSBE460
00603         MOVE MSKL-REC                TO MDST-REC                  DTSBE460
00604         IF MDST-RECEIVED-DATE >= WRK-EMP-START-DPC-DT             DTSBE460
00605            ADD +1                    TO WRK-DPC-PMT-CNT           DTSBE460
00606            PERFORM                                                DTSBE460
00607              VARYING MDST-ACCT-IDX FROM +1 BY +1                  DTSBE460
00608              UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT                  DTSBE460
00609                 PERFORM P1111-TABLE-PMT      THRU P1111-EXIT      DTSBE460
00610            END-PERFORM                                            DTSBE460
00611         END-IF                                                    DTSBE460
00612         PERFORM S910-READ-NEXT        THRU S910-EXIT              DTSBE460
00613      END-PERFORM.                                                 DTSBE460
00614                                                                   DTSBE460
00615      IF TLAST = ZERO                                              DTSBE460
00616         SET WRK-SELECT-YES-88            TO TRUE                  DTSBE460
00617      ELSE                                                         DTSBE460
00618         MOVE TLAST                       TO WRK-DPC-PMT-CNT       DTSBE460
00619         PERFORM                                                   DTSBE460
00620           VARYING TSUB FROM +1 BY +1                              DTSBE460
00621           UNTIL TSUB > TLAST                                      DTSBE460
00622             ADD TBL-PAY (TSUB)           TO WRK-DPC-PMT           DTSBE460
00623         END-PERFORM                                               DTSBE460
00624         COMPUTE WRK-AVG-DPC-PMT =                                 DTSBE460
00625            (WRK-DPC-PMT / WRK-DPC-PMT-CNT)                        DTSBE460
00626         IF WRK-AVG-DPC-PMT < (MDPC-INSTALL-PMT-AMT * .9)          DTSBE460
00627            SET WRK-SELECT-YES-88          TO TRUE                 DTSBE460
00628         END-IF                                                    DTSBE460
00629      END-IF.                                                      DTSBE460
00630                                                                   DTSBE460
00631      IF WRK-SELECT-YES-88                                         DTSBE460
00632         MOVE WRK-AVG-DPC-PMT         TO AMT-DISP1                 DTSBE460
00633         MOVE WRK-DPC-PMT             TO AMT-DISP2                 DTSBE460
00634         MOVE MDPC-INSTALL-PMT-AMT    TO AMT-DISP3                 DTSBE460
00635         DISPLAY SPACE                                             DTSBE460
00636         DISPLAY 'DPC ' MPRF-EMP-NO                                DTSBE460
00637            '  AVG ' AMT-DISP1                                     DTSBE460
00638            '  DPC ' AMT-DISP3                                     DTSBE460
00639            '  TOT ' AMT-DISP2                                     DTSBE460
00640         DISPLAY '   START ' WRK-EMP-START-DPC-DT                  DTSBE460
00641            '  CNT ' WRK-DPC-PMT-CNT                               DTSBE460
00642      ELSE                                                         DTSBE460
00643         ADD +1                        TO WRK-DPC-BYPASS-CNT       DTSBE460
00644      END-IF.                                                      DTSBE460
00645                                                                   DTSBE460
00646  P1110-EXIT.                                                      DTSBE460
00647      EXIT.                                                        DTSBE460
00648                                                                   DTSBE460
00649  P1111-TABLE-PMT.                                                 DTSBE460
00650      SET WRK-TBL-ROW-FOUND-NO-88          TO TRUE.                DTSBE460
00651                                                                   DTSBE460
00652      PERFORM                                                      DTSBE460
00653        VARYING TSUB FROM +1 BY +1                                 DTSBE460
00654        UNTIL TSUB > TLAST                                         DTSBE460
00655        OR WRK-TBL-ROW-FOUND-YES-88                                DTSBE460
00656          IF TBL-DOC (TSUB) = MDST-DOC-NO                          DTSBE460
00657             ADD MDST-AMT (MDST-ACCT-IDX)  TO TBL-PAY (TSUB)       DTSBE460
00658             SET WRK-TBL-ROW-FOUND-YES-88  TO TRUE                 DTSBE460
00659          END-IF                                                   DTSBE460
00660      END-PERFORM.                                                 DTSBE460
00661                                                                   DTSBE460
00662      IF WRK-TBL-ROW-FOUND-NO-88                                   DTSBE460
00663         IF TLAST < TMAX                                           DTSBE460
00664            ADD +1 TO TLAST                                        DTSBE460
00665            MOVE MDST-BATCH-NO            TO TBL-BATCH (TLAST)     DTSBE460
00666            MOVE MDST-ITEM-NO             TO TBL-ITEM (TLAST)      DTSBE460
00667            ADD MDST-AMT (MDST-ACCT-IDX)  TO TBL-PAY (TLAST)       DTSBE460
00668         ELSE                                                      DTSBE460
00669            DISPLAY 'P1111 TABLE LENGTH EXCEEDED '                 DTSBE460
00670            PERFORM S999-ABEND            THRU S999-EXIT           DTSBE460
00671         END-IF                                                    DTSBE460
00672      END-IF.                                                      DTSBE460
00673                                                                   DTSBE460
00674  P1111-EXIT.                                                      DTSBE460
00675      EXIT.                                                        DTSBE460
00676                                                                   DTSBE460
00677  P1200-FIND-MTAD.                                                 DTSBE460
00678      MOVE LOW-VALUES                 TO MTAD-KEY-AREA.            DTSBE460
00679      MOVE MPRF-EMP-NO                TO MTAD-EMP-NO.              DTSBE460
00680      SET MTAD-TAD-88                 TO TRUE.                     DTSBE460
00681*     SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE.                     DTSBE460
00681      SET MTAD-ID-TAX-records-ADDR-88 TO TRUE.                     DTSBE460
00682      MOVE MTAD-KEY-AREA              TO MSKL-KEY-AREA.            DTSBE460
00683      PERFORM S910-READ THRU S910-EXIT.                            DTSBE460
00684      IF L910-OK-88                                                DTSBE460
00685         MOVE MSKL-REC                 TO MTAD-REC                 DTSBE460
00686         ADD 1                         TO WRK-MTAD-CNT             DTSBE460
00687         PERFORM P1210-PARSE-ADDR      THRU P1210-EXIT             DTSBE460
00688      ELSE                                                         DTSBE460
00689         SET WRK-ERROR-YES-88          TO TRUE                     DTSBE460
00690      END-IF.                                                      DTSBE460
00691                                                                   DTSBE460
00692  P1200-EXIT.                                                      DTSBE460
00693      EXIT.                                                        DTSBE460
00694                                                                   DTSBE460
00695  P1210-PARSE-ADDR.                                                DTSBE460
00696      MOVE SPACE             TO WRK-STREET-NAME                    DTSBE460
00697                                WRK-STREET-NUMBER.                 DTSBE460
00698      MOVE ZERO              TO SUB1                               DTSBE460
00699                                SUB2                               DTSBE460
00700                                SUB3                               DTSBE460
00701                                SUB4.                              DTSBE460
00702                                                                   DTSBE460
00709      move spaces            to wrk-addr-line2.                    DTSBE460
00709      move MTAD-DELIV-LINE-2 to wrk-addr-line2.                    DTSBE460
00702                                                                   DTSBE460
00709      IF MTAD-DELIV-LINE-2 = spaces                                DTSBE460
00709         move MTAD-DELIV-LINE-1 to mtad-deliv-line-2               DTSBE460
00702      else                                                         DTSBE460
00709      IF wrk-addr-LINE2b = spaces                                  DTSBE460
00709         move MTAD-DELIV-LINE-1 to mtad-deliv-line-2               DTSBE460
00702      else                                                         DTSBE460
00709      display 'line1: ' MTAD-DELIV-LINE-1                          DTSBE460
00709      display 'line2: ' MTAD-DELIV-LINE-2.                         DTSBE460
00703      SET WRK-CHAR-FOUND-NO-88        TO TRUE.                     DTSBE460
00704                                                                   DTSBE460
00705      PERFORM                                                      DTSBE460
00706        VARYING SUB1 FROM +1 BY +1                                 DTSBE460
00707        UNTIL SUB1 > +40                                           DTSBE460
00708        OR WRK-CHAR-FOUND-YES-88                                   DTSBE460
00709          IF MTAD-DELIV-LINE-2 (SUB1:1) >= '0' AND <= '9'          DTSBE460
00710             ADD +1 TO SUB2                                        DTSBE460
00711             MOVE MTAD-DELIV-LINE-2 (SUB1:1) TO                    DTSBE460
00712                  WRK-STREET-NUMBER (SUB2:1)                       DTSBE460
00713          ELSE                                                     DTSBE460
00714             IF MTAD-DELIV-LINE-2 (SUB1:1) > SPACES                DTSBE460
00715                MOVE SUB1                       TO SUB4            DTSBE460
00716             ELSE                                                  DTSBE460
00717                COMPUTE SUB4 = SUB1 + 1                            DTSBE460
00718             END-IF                                                DTSBE460
00719             COMPUTE SUB3 = 40 - SUB4                              DTSBE460
00720             MOVE MTAD-DELIV-LINE-2 (SUB4:SUB3) TO                 DTSBE460
00721                  WRK-STREET-NAME                                  DTSBE460
00722             SET WRK-CHAR-FOUND-YES-88          TO TRUE            DTSBE460
00723          END-IF                                                   DTSBE460
00724      END-PERFORM.                                                 DTSBE460
00725                                                                   DTSBE460
00726  P1210-EXIT.                                                      DTSBE460
00727      EXIT.                                                        DTSBE460
00728                                                                   DTSBE460
00729  P1300-BALANCE-DUE.                                               DTSBE460
00730      MOVE LOW-VALUES                 TO MQTR-KEY-AREA.            DTSBE460
00731      MOVE MPRF-EMP-NO                TO MQTR-EMP-NO.              DTSBE460
00732      SET MQTR-QTR-88                 TO TRUE.                     DTSBE460
00733      MOVE MQTR-KEY-AREA              TO MSKL-KEY-AREA.            DTSBE460
00734      PERFORM S910-START-BROWSE       THRU S910-EXIT.              DTSBE460
00735      PERFORM UNTIL L910-NO-REC-88                                 DTSBE460
00736         MOVE MSKL-REC                TO MQTR-REC                  DTSBE460
00737         IF MQTR-YRQ > LECM-LAST-UC30-DEL-MAIL-YRQ                 DTSBE460
00738            SET L910-NO-REC-88        TO TRUE                      DTSBE460
00739         ELSE                                                         CL**4
00740            IF NOT MQTR-CURR-ESTIM-88                                 CL**4
00741               PERFORM P1310-TOT-BAL     THRU P1310-EXIT              CL**4
00742            END-IF                                                    CL**4
00743            PERFORM S910-READ-NEXT       THRU S910-EXIT               CL**4
00744         END-IF                                                    DTSBE460
00745      END-PERFORM.                                                 DTSBE460
00746                                                                   DTSBE460
00747  P1300-EXIT.                                                      DTSBE460
00748      EXIT.                                                        DTSBE460
00749                                                                   DTSBE460
00750  P1310-TOT-BAL.                                                   DTSBE460
00751      MOVE +0                  TO WRK-QTR-BAL.                     DTSBE460
00752      SET WRK-SU-CHG-NO-88     TO TRUE.                            DTSBE460
00753      SET WRK-LP-CHG-NO-88     TO TRUE.                            DTSBE460
00754                                                                   DTSBE460
00755      PERFORM                                                      DTSBE460
00756         VARYING MQTR-ACCT-IDX FROM +1 BY +1                       DTSBE460
00757         UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT                       DTSBE460
00758            ADD  MQTR-BALANCE-AMT (MQTR-ACCT-IDX)                  DTSBE460
00759               TO WRK-TOT-BAL                                      DTSBE460
00760                  WRK-QTR-BAL                                      DTSBE460
00761            EVALUATE TRUE                                          DTSBE460
00762              WHEN MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX)                DTSBE460
00763                 IF (MQTR-BALANCE-AMT (MQTR-ACCT-IDX) > +0         DTSBE460
00764                 AND MQTR-BALANCE-AMT (MQTR-ACCT-IDX) < +1)        DTSBE460
00765                    SET WRK-SU-CHG-YES-88   TO TRUE                DTSBE460
00766                 END-IF                                            DTSBE460
00767              WHEN MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX)           DTSBE460
00768                    SET WRK-LP-CHG-YES-88   TO TRUE                DTSBE460
00769            END-EVALUATE                                           DTSBE460
00770      END-PERFORM.                                                 DTSBE460
00771                                                                   DTSBE460
00772      IF WRK-SU-CHG-YES-88                                         DTSBE460
00773      AND WRK-LP-CHG-YES-88                                        DTSBE460
00774      AND (WRK-QTR-BAL > +100 AND < +101)                          DTSBE460
00775         DISPLAY 'BYPASS SU ' MQTR-EMP-NO '  ' MQTR-YRQ            DTSBE460
00776         SUBTRACT WRK-QTR-BAL        FROM WRK-TOT-BAL              DTSBE460
00777         MOVE WRK-TOT-BAL            TO AMT-DISP1                  DTSBE460
00778         MOVE WRK-QTR-BAL            TO AMT-DISP2                  DTSBE460
00779         DISPLAY '   ' AMT-DISP1 '  ' AMT-DISP2                    DTSBE460
00780      END-IF.                                                      DTSBE460
00781                                                                   DTSBE460
00782  P1310-EXIT.                                                      DTSBE460
00783      EXIT.                                                        DTSBE460
00784                                                                   DTSBE460
00785  P1400-BUILD-REC.                                                 DTSBE460
00786      MOVE MPRF-FEIN              TO WRK-FEIN-9                    DTSBE460
00787                                     X460-ENTITY-ID.               DTSBE460
00788      MOVE WRK-FEIN-13            TO X460-AGY-TRACKING-ID.         DTSBE460
00789 *& SPECIAL RUN WITH EMPLOYER NUMBER                               DTSBE460
00790 *&   MOVE MPRF-EMP-NO            TO WRK-EMP-6.                    DTSBE460
00791 *&   MOVE WRK-EMP-13             TO X460-AGY-TRACKING-ID.         DTSBE460
00792 *&                                                                DTSBE460
00793      MOVE '110000'               TO X460-AGY-ID-ADM-DIV.          DTSBE460
00794      SET X460-ENTITY-TYPE-EIN-88 TO TRUE.                         DTSBE460
00795      SET X460-NO-RELATION-88     TO TRUE.                         DTSBE460
00796      MOVE MPRF-PRIMARY-NAME      TO X460-ENTITY-BUSNS-NAME.       DTSBE460
00797      INSPECT X460-ENTITY-BUSNS-NAME                               DTSBE460
00798         REPLACING ALL ',' BY SPACE.                               DTSBE460
00799      INSPECT X460-ENTITY-BUSNS-NAME                               DTSBE460
00800         REPLACING ALL QUOTE BY SPACE.                             DTSBE460
00801      INSPECT X460-ENTITY-BUSNS-NAME                               DTSBE460
00802         REPLACING ALL '"'   BY SPACE.                             DTSBE460
00803      MOVE SPACES                 TO X460-ENTITY-LAST-NAME.        DTSBE460
00804      MOVE SPACES                 TO X460-ENTITY-FIRST-NAME.       DTSBE460
00805      MOVE SPACES                 TO X460-ENTITY-MID-INIT.         DTSBE460
00806      MOVE SPACES                 TO X460-ENTITY-SUFFIX.           DTSBE460
00807      MOVE SPACES                 TO X460-ENTITY-DOB.              DTSBE460
00808                                                                   DTSBE460
00809      MOVE WRK-TOT-BAL            TO X460-DEBT-AMT.                DTSBE460
00810                                                                   DTSBE460
00811      MOVE WRK-STREET-NUMBER      TO X460-STREET-NUMBER.           DTSBE460
00812      STRING                                                       DTSBE460
00813        WRK-STREET-NAME,                                           DTSBE460
00814        MTAD-DELIV-LINE-1                                          DTSBE460
00815      DELIMITED BY SIZE  INTO X460-STREET-NAME.                    DTSBE460
00816      INSPECT X460-STREET-NAME                                     DTSBE460
00817         REPLACING ALL ',' BY SPACE.                               DTSBE460
00818      INSPECT X460-STREET-NAME                                     DTSBE460
00819         REPLACING ALL QUOTE BY SPACE.                             DTSBE460
00820      INSPECT X460-STREET-NAME                                     DTSBE460
00821         REPLACING ALL '"'   BY SPACE.                             DTSBE460
00822      MOVE SPACES                 TO X460-ENTITY-DOB.              DTSBE460
00823      MOVE MTAD-CITY              TO X460-CITY.                    DTSBE460
00824      INSPECT X460-CITY                                            DTSBE460
00825         REPLACING ALL ',' BY SPACE.                               DTSBE460
00826      INSPECT X460-CITY                                            DTSBE460
00827         REPLACING ALL QUOTE BY SPACE.                             DTSBE460
00828      INSPECT X460-CITY                                            DTSBE460
00829         REPLACING ALL '"'   BY SPACE.                             DTSBE460
00830      MOVE MTAD-ST                TO X460-STATE.                   DTSBE460
00831      MOVE MTAD-ZIP               TO WRK-ZIP.                      DTSBE460
00832      MOVE WRK-ZIP-5              TO X460-ZIP.                     DTSBE460
00833      MOVE WRK-ZIP-4              TO X460-ZIP-EXT.                 DTSBE460
00834                                                                   DTSBE460
00835      SET X460-FAIL-TO-FILE-NO-88  TO TRUE.                        DTSBE460
00836 **   IF MPRF-PURSUED-RPT-CNT > 0                                  DTSBE460
00837 *       SET X460-FAIL-TO-FILE-YES-88 TO TRUE                      DTSBE460
00838 *    ELSE                                                         DTSBE460
00839 *       SET X460-FAIL-TO-FILE-NO-88  TO TRUE                      DTSBE460
00840 **   END-IF.                                                      DTSBE460
00841                                                                   DTSBE460
00842      MOVE LECM-CURR-RUN-DATE     TO L001-FED-8-DATE-9.            DTSBE460
00843      PERFORM S001-FROM-FED-8     THRU S001-EXIT.                  DTSBE460
00844      MOVE L001-SLASH-8-DATE      TO X460-AGY-REPORT-DT.           DTSBE460
00845                                                                   DTSBE460
00846      WRITE CLEAN-REC  FROM WRK-CLEAN-REC.                         DTSBE460
00847      IF NOT CLN-STATUS-OK-88                                      DTSBE460
00848         DISPLAY 'CANNOT WRITE TO CLEAN FILE '                     DTSBE460
00849            '  ' CLN-STATUS '  ' MPRF-EMP-NO                       DTSBE460
00850         MOVE 'CLEAN FILE WRITE ERROR'                             DTSBE460
00851                TO ABEND-MSG                                       DTSBE460
00852         PERFORM S999-ABEND THRU S999-EXIT                         DTSBE460
00853      ELSE                                                         DTSBE460
00854         ADD +1 TO WRK-CLEAN-CNT                                   DTSBE460
00855      END-IF.                                                      DTSBE460
00856                                                                   DTSBE460
00857      INITIALIZE WRK-CLEAN-REC.                                    DTSBE460
00858  P1400-EXIT.                                                      DTSBE460
00859      EXIT.                                                        DTSBE460
00860                                                                   DTSBE460
00861  T0000-TERMINATE.                                                 DTSBE460
00862      PERFORM T1000-WRITE-HEADER   THRU T1000-EXIT.                DTSBE460
00863                                                                   DTSBE460
00864      CLOSE CLEAN-FILE.                                            DTSBE460
00865      DISPLAY '*** DTSBE460 OUTPUT RECORDS WRITTEN:     '          DTSBE460
00866         WRK-CLEAN-CNT.                                            DTSBE460
00867      DISPLAY '    '.                                              DTSBE460
00868      DISPLAY '*** DTSBE460 TAX MAILING ADDR FOUND:     '          DTSBE460
00869                    WRK-MTAD-CNT.                                  DTSBE460
00870      DISPLAY '*** DTSBE460 TAX MAILING ADDR NOT FOUND: '          DTSBE460
00871                    WRK-NO-MTAD-CNT.                               DTSBE460
00872      DISPLAY '*** DTSBE460 DPCS BYPASSED             : '          DTSBE460
00873                    WRK-DPC-BYPASS-CNT.                            DTSBE460
00874      DISPLAY '    '.                                              DTSBE460
00875                                                                   DTSBE460
00876  T0000-EXIT.                                                      DTSBE460
00877      EXIT.                                                        DTSBE460
00878                                                                   DTSBE460
00879  T1000-WRITE-HEADER.                                              DTSBE460
00880      MOVE WRK-CLEAN-CNT       TO X461-HEADER-CNT.                 DTSBE460
00881                                                                   DTSBE460
00882      WRITE CLEAN-REC  FROM WRK-CLEAN-HEADER.                      DTSBE460
00883      IF NOT CLN-STATUS-OK-88                                      DTSBE460
00884         DISPLAY 'CANNOT WRITE HEADER '                            DTSBE460
00885            '  ' CLN-STATUS '  ' MPRF-EMP-NO                       DTSBE460
00886         MOVE 'CLEAN FILE WRITE ERROR'                             DTSBE460
00887                TO ABEND-MSG                                       DTSBE460
00888         PERFORM S999-ABEND THRU S999-EXIT                         DTSBE460
00889      END-IF.                                                      DTSBE460
00890                                                                   DTSBE460
00891  T1000-EXIT.                                                      DTSBE460
00892      EXIT.                                                        DTSBE460
00893                                                                   DTSBE460
00894  S001-FROM-FED-8.                                                 DTSBE460
00895      SET L001-FROM-FED-8 TO TRUE.                                 DTSBE460
00896      GO TO S001-DATE.                                             DTSBE460
00897                                                                   DTSBE460
00898  S001-FROM-CAL-6.                                                 DTSBE460
00899      SET L001-FROM-CAL-6 TO TRUE.                                 DTSBE460
00900      GO TO S001-DATE.                                             DTSBE460
00901                                                                   DTSBE460
00902  S001-FROM-ABS-DAY.                                               DTSBE460
00903      SET L001-FROM-ABS-DAY TO TRUE.                               DTSBE460
00904      GO TO S001-DATE.                                             DTSBE460
00905                                                                   DTSBE460
00906  S001-DATE.                                                       DTSBE460
00907      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBE460
00908  S001-EXIT.                                                       DTSBE460
00909      EXIT.                                                        DTSBE460
00910                                                                   DTSBE460
00911  S004-FROM-DATE.                                                  DTSBE460
00912      SET L004-FROM-DATE TO TRUE.                                  DTSBE460
00913      GO TO S004-YRQ.                                              DTSBE460
00914                                                                   DTSBE460
00915  S004-FROM-FIVE.                                                  DTSBE460
00916      SET L004-FROM-5    TO TRUE.                                  DTSBE460
00917      GO TO S004-YRQ.                                              DTSBE460
00918                                                                   DTSBE460
00919  S004-YRQ.                                                        DTSBE460
00920      CALL 'DTSBU004' USING L004-LINK-AREA.                        DTSBE460
00921  S004-EXIT.                                                       DTSBE460
00922      EXIT.                                                        DTSBE460
00923                                                                   DTSBE460
00924  S910-READ.                                                       DTSBE460
00925      SET L910-READ-88 TO TRUE.                                    DTSBE460
00926      GO TO S910-MSTR-IO.                                          DTSBE460
00927                                                                   DTSBE460
00928  S910-START-BROWSE.                                               DTSBE460
00929      SET L910-START-BROWSE-88 TO TRUE.                            DTSBE460
00930      GO TO S910-MSTR-IO.                                          DTSBE460
00931                                                                   DTSBE460
00932  S910-READ-NEXT.                                                  DTSBE460
00933      SET L910-READ-NEXT-88 TO TRUE.                               DTSBE460
00934      GO TO S910-MSTR-IO.                                          DTSBE460
00935                                                                   DTSBE460
00936  S910-COUNT.                                                      DTSBE460
00937      SET L910-COUNT-88 TO TRUE.                                   DTSBE460
00938      GO TO S910-MSTR-IO.                                          DTSBE460
00939                                                                   DTSBE460
00940  S910-MSTR-IO.                                                    DTSBE460
00941      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBE460
00942                            MSKL-REC.                              DTSBE460
00943  S910-EXIT.                                                       DTSBE460
00944      EXIT.                                                        DTSBE460
00945                                                                   DTSBE460
00946  S999-ABEND.                                                      DTSBE460
00947      DISPLAY '*** DTSBE460 ABENDING.  '                           DTSBE460
00948              ABEND-MSG.                                           DTSBE460
00949      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBE460
00950                                                                   DTSBE460
00951  S999-EXIT.                                                       DTSBE460
00952      EXIT.                                                        DTSBE460
00953                                                                   DTSBE460
