00001 IDENTIFICATION DIVISION. 11/23/09 00002 PROGRAM-ID. DTSBE459. 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 DTSBE459 TO EXTRACTS AND DTSBE460 00010 * CREATES A daily 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 '033DTSBE459 06/20/24'. DTSBE460 00127 SKIP3 DTSBE460 00128 01 WRK-AREA. DTSBE460 00129 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +459.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 \DoesDebt-Daily\incoming-prod\'. 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.BE459'. DTSBE460 00217 15 FILLER PIC X(01) DTSBE460 00218 VALUE QUOTE. DTSBE460 00219 15 FILLER PIC X(11) DTSBE460 00220 VALUE ' CCH_DDEBT_'. 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 >= 5 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