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