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