00001 IDENTIFICATION DIVISION. 10/02/24 00002 PROGRAM-ID. DTSBX655. DTSBX655 00003 AUTHOR. NGUPTA LV238 00004 DATE-WRITTEN. JAN2017 CL154 00005 DATE-COMPILED. DTSBX655 00006 SKIP3 DTSBX655 00007 ***** DTSBX655 00008 * DTSBX655 00009 * FUNCTION: UPDATE MPRF RETURN MAIL FLAG TO Y AND ADD CL217 00010 * EVENT LOGH. CL217 00011 * DTSBX655 00012 ***** DTSBX655 00013 SKIP3 DTSBX655 00014 ENVIRONMENT DIVISION. DTSBX655 00015 SKIP2 DTSBX655 00016 CONFIGURATION SECTION. DTSBX655 00017 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSBX655 00018 DTSBX655 00019 INPUT-OUTPUT SECTION. DTSBX655 00020 DTSBX655 00021 FILE-CONTROL. DTSBX655 00022 SELECT EMP-FILE1 ASSIGN TO EMPFILE1 CL122 00023 FILE STATUS IS EXP-STATUS. DTSBX655 00024 DTSBX655 00025 CL*71 00026 DATA DIVISION. DTSBX655 00027 DTSBX655 00028 FILE SECTION. DTSBX655 00029 DTSBX655 00030 FD EMP-FILE1 CL122 00031 RECORDING MODE IS F. DTSBX655 00032 01 EMP-REC1. CL122 00033 * 05 FILLER PIC X(215). CL233 00034 05 INEMP-NO PIC 9(06). CL217 00035 05 FILLER PIC X(74). CL233 00036 * 05 FILLER PIC X(331). CL233 00037 EJECT DTSBX655 00038 DTSBX655 00039 CL*71 00040 WORKING-STORAGE SECTION. DTSBX655 000405 77 PAN-VALET PICTURE X(24) VALUE '238DTSBX655 10/02/24'. DTSBX655 00041 SKIP3 DTSBX655 00042 01 WRK-AREA. DTSBX655 00043 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +400.DTSBX655 00044 05 WRK-SYS-ABSTIME PIC S9(15) COMP-3 VALUE +0. CL211 00045 05 WRK-ABSTIME PIC S9(15) COMP-3 VALUE +1000. CL211 00046 DTSBX655 00047 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBD400'.DTSBX655 00048 DTSBX655 00049 ** 05 WRK-RPT-DATE PIC S9(09) COMP-3 DTSBX655 00050 * VALUE +20070328. DTSBX655 00051 * 05 WRK-YRQ PIC S9(05) COMP-3 DTSBX655 00052 ** VALUE +20061. DTSBX655 00053 05 WRK-RPT-DATE PIC S9(09) COMP-3 DTSBX655 00054 VALUE +20170124. CL154 00055 05 WRK-YRQ PIC S9(05) COMP-3 DTSBX655 00056 VALUE +0. DTSBX655 00057 05 WRK-MPRF-REC-CNT PIC S9(07) COMP-3. CL192 00058 05 WRK-RATE-TYPE-AREA. DTSBX655 00059 10 WRK-RATE-YR-SCHED PIC X(01). DTSBX655 00060 88 WRK-RATE-YR-ANN-88 VALUE 'Y'. DTSBX655 00061 10 WRK-RATE-YR-MINUS-1-SCHED PIC X(01). DTSBX655 00062 88 WRK-RATE-YR-MINUS1-ANN-88 VALUE 'Y'. DTSBX655 00063 10 WRK-RATE-YR-MINUS-2-SCHED PIC X(01). DTSBX655 00064 88 WRK-RATE-YR-MINUS2-ANN-88 VALUE 'Y'. DTSBX655 00065 05 FILLER REDEFINES WRK-RATE-TYPE-AREA PIC X(03). DTSBX655 00066 88 WRK-ESTIMATE-NEEDED-88 VALUE 'YYY' 'NYY'. DTSBX655 00067 88 WRK-TRANSITION-YEAR-88 VALUE 'YYN' 'NYN'. DTSBX655 00068 88 WRK-INIT-VALUES-88 VALUE 'NNN'. DTSBX655 00069 DTSBX655 00070 05 WRK-CLASSIFIED-IND PIC X(01). DTSBX655 00071 88 WRK-CLASSIFIED-YES-88 VALUE 'Y'. DTSBX655 00072 88 WRK-CLASSIFIED-NO-88 VALUE 'N'. DTSBX655 00073 05 WRK-EXIT-LOOP-IND PIC X(01). DTSBX655 00074 88 WRK-EXIT-LOOP-YES-88 VALUE 'Y'. DTSBX655 00075 88 WRK-EXIT-LOOP-NO-88 VALUE 'N'. DTSBX655 00076 05 WRK-BATCH PIC S9(05) COMP-3. DTSBX655 00077 05 WRK-ITEM PIC S9(03) COMP-3. DTSBX655 00078 05 WRK-SEQ PIC 9(05) DTSBX655 00079 VALUE ZERO. DTSBX655 00080 05 WRK-UCFE-FEIN PIC 9(09) DTSBX655 00081 VALUE 000000000. DTSBX655 00082 05 WRK-UCX-FEIN PIC 9(09) DTSBX655 00083 VALUE 330000000. DTSBX655 00084 05 WRK-CWC-FEIN PIC 9(09) DTSBX655 00085 VALUE 440000000. DTSBX655 00086 05 WRK-FED-EMP PIC 9(06). DTSBX655 00087 05 FILLER REDEFINES WRK-FED-EMP. DTSBX655 00088 10 FILLER PIC X(02). DTSBX655 00089 10 WRK-FED-EMP-3 PIC X(01). DTSBX655 00090 88 WRK-FED-EMP-BYPASS-88 VALUE '1'. DTSBX655 00091 10 FILLER PIC 9(03). DTSBX655 00092 05 WRK-ZIP PIC X(10). DTSBX655 00093 05 FILLER REDEFINES WRK-ZIP. DTSBX655 00094 10 WRK-ZIP5 PIC X(05). DTSBX655 00095 10 FILLER PIC X(05). DTSBX655 00096 DTSBX655 00097 05 WS-EMP-NO1 PIC X(06). CL159 00098 05 EXP-STATUS PIC X(02). DTSBX655 00099 88 EXP-STATUS-OK-88 VALUE '00'. DTSBX655 00100 05 EXP2-STATUS PIC X(02). CL*71 00101 88 EXP2-STATUS-OK-88 VALUE '00'. CL*71 00102 05 WRK-ERROR-IND PIC X(01). DTSBX655 00103 88 WRK-ERROR-YES-88 VALUE 'Y'. DTSBX655 00104 88 WRK-ERROR-NO-88 VALUE 'N'. DTSBX655 00105 05 WRK-WRITE-REC-IND PIC X(01). DTSBX655 00106 88 WRK-WRITE-REC-YES-88 VALUE 'Y'. DTSBX655 00107 88 WRK-WRITE-REC-NO-88 VALUE 'N'. DTSBX655 00108 05 WRK-OP-ID PIC X(08). DTSBX655 00109 05 WRK-ASSIGN PIC 9(09). DTSBX655 00110 05 FILLER REDEFINES WRK-ASSIGN. DTSBX655 00111 10 WRK-ASSIGN-CC PIC 9(02). DTSBX655 00112 10 WRK-ASSIGN-YY PIC 9(02). DTSBX655 00113 10 WRK-ASSIGN-NBR PIC 9(05). DTSBX655 00114 05 WRK-FLD-ASSIGN. DTSBX655 00115 10 WRK-FLD-ASSIGN-YEAR PIC 9(02). DTSBX655 00116 10 FILLER PIC X(01) VALUE SPACE. DTSBX655 00117 10 WRK-FLD-ASSIGN-NBR PIC 9(05). DTSBX655 00118 05 WRK-LIEN PIC 9(08). CL*25 00119 05 WRK-LIEN-X REDEFINES WRK-LIEN. CL*25 00120 10 FILLER PIC X(02). CL*26 00121 10 WRK-LIEN6 PIC X(06). CL*25 00122 05 WRK-LIEN-REF. CL*23 00123 10 WRK-LIEN-YR PIC 9(02). CL*23 00124 10 WRK-LIEN-NBR PIC 9(04). CL*23 00125 DTSBX655 00126 05 WRK-IND-CODE PIC X(06). DTSBX655 00127 05 WRK-REC1. DTSBX655 00128 10 REC1-EMP-NO PIC 999999. DTSBX655 00129 10 FILLER PIC X(01) VALUE ';'. DTSBX655 00130 ** 10 REC1-NAME PIC X(32). CL100 00131 ** 10 REC1-EARLY-LIAB-DT PIC X(32). CL110 00132 10 REC1-EARLY-LIAB-DT PIC X(10). CL110 00133 10 FILLER PIC X(01) VALUE ';'. CL*82 00134 ** 10 REC1-YRQ2 PIC X(06). CL100 00135 ** 10 FILLER PIC X(01) VALUE ';'. CL100 00136 10 REC1-FIRS-DATE PIC X(10). CL100 00137 10 FILLER PIC X(01) VALUE ';'. CL*88 00138 10 REC1-PRIOR PIC 9.9999. CL100 00139 10 FILLER PIC X(01) VALUE ';'. CL*95 00140 10 REC1-CURR PIC 9.9999. CL100 00141 10 FILLER PIC X(01) VALUE ';'. CL*98 00142 CL*75 00143 05 WRK-REC1-OLD. CL*15 00144 10 REC1-ESTB-DATE PIC X(10). CL*98 00145 10 REC1-LIEN-NO PIC 9(08). CL*98 00146 10 REC1-STATUS PIC X(01). CL*98 00147 10 REC1-SOURCE PIC X(02). CL*88 00148 10 REC1-YRQ PIC X(06). CL*85 00149 10 REC1-OP-ID PIC X(08). CL*75 00150 10 REC1-STATUS-OP-ID PIC X(08). CL*75 00151 10 REC1-STMT-DATE PIC X(10). CL*95 00152 10 REC1-STATUS-DATE PIC X(10). CL*75 00153 10 REC1-BALANCE PIC --------9.99. CL*75 00154 10 REC1-FREQUENCY PIC X(01). CL*75 00155 10 REC1-START-DATE PIC X(10). CL*75 00156 10 REC1-TAX-DUE PIC --------9.99. CL*75 00157 10 REC1-DATA-ELEMENT PIC X(40). CL*68 00158 10 REC1-PRE-MOD-VALUE PIC X(40). CL*68 00159 10 REC1-POST-MOD-VALUE PIC X(40). CL*68 00160 10 REC1-MLOG-DATE PIC X(10). CL*68 00161 10 REC1-EMP-NAME PIC X(40). CL*68 00162 10 REC1-CURR-RESERVE PIC --------9.99. CL*59 00163 10 REC1-ATTN PIC X(40). CL*57 00164 10 REC1-STREET2 PIC X(40). CL*57 00165 10 REC1-STREET1 PIC X(40). CL*57 00166 10 REC1-CITY PIC X(25). CL*57 00167 10 REC1-STATE PIC X(02). CL*57 00168 10 REC1-ZIP PIC X(10). CL*57 00169 10 REC1-PHONE PIC X(15). CL*57 00170 10 REC1-FAX PIC X(15). CL*57 00171 10 REC1-EMAIL PIC X(40). CL*57 00172 10 REC1-ASSIGN PIC X(08). CL*51 00173 10 REC1-ASSIGN-TYPE PIC X(02). CL*51 00174 10 REC1-PROCESS-DATE PIC X(10). CL*51 00175 10 REC1-COMP-DATE PIC X(10). CL*51 00176 10 REC1-FLD-REP-ID PIC X(02). CL*46 00177 10 REC1-INACT-OPID PIC X(08). CL*43 00178 10 REC1-INACT-ENTER-DT PIC X(10). CL*38 00179 10 REC1-OPO-NAME PIC X(32). CL*27 00180 10 REC1-ELIG-CD PIC 9(03). CL*17 00181 10 REC1-FEIN PIC 9(09). DTSBX655 00182 10 REC1-COUNT PIC 9(07). DTSBX655 00183 10 REC1-CLASS PIC X(02). DTSBX655 00184 10 REC1-MLIN-STATUS PIC X(01). DTSBX655 00185 10 REC1-BATCH PIC 9(05). DTSBX655 00186 10 REC1-ITEM PIC 9(03). DTSBX655 00187 10 REC1-RPTS-DUE PIC 999. DTSBX655 00188 10 REC1-COMPLETE-DATE PIC X(10). DTSBX655 00189 10 REC1-PAY-TYPE PIC X(02). DTSBX655 00190 10 REC1-TAX-PAID PIC --------9.99. DTSBX655 00191 10 REC1-DEPOSIT-DATE PIC X(10). DTSBX655 00192 10 REC1-NAICS PIC X(06). DTSBX655 00193 10 REC1-SIC PIC X(04). DTSBX655 00194 10 REC1-YEAR PIC 9(04). DTSBX655 00195 10 REC1-AMT PIC ----------9.99. DTSBX655 00196 10 REC1-OPO-SSN PIC X(09). DTSBX655 00197 10 REC1-PRIOR-RESERVE PIC --------9.99. DTSBX655 00198 10 REC1-INTEREST PIC --------9.99. DTSBX655 00199 10 REC1-BEN-CHG PIC --------9.99. DTSBX655 00200 10 REC1-AVG-TAX-WAGE PIC --------9.99. DTSBX655 00201 10 REC1-RATE-PCT PIC 9.9. DTSBX655 00202 10 REC1-DUE-DATE PIC X(10). DTSBX655 00203 10 REC1-INACT-YRQ PIC X(06). DTSBX655 00204 10 REC1-RCVD-DATE PIC X(10). DTSBX655 00205 10 REC1-TOT-WAGE PIC ----------9.99. DTSBX655 00206 10 REC1-SUR-BAL PIC ----------9.99. DTSBX655 00207 10 REC1-LP-BAL PIC ----------9.99. DTSBX655 00208 10 REC1-INT-BAL PIC ----------9.99. DTSBX655 00209 10 REC1-SEQ PIC 999999. DTSBX655 00210 10 REC1-PRED PIC 999999. DTSBX655 00211 10 REC1-REL-CD PIC X(02). DTSBX655 00212 10 REC1-TRAN PIC X(02). DTSBX655 00213 10 REC1-CREDIT PIC --------9.99. DTSBX655 00214 10 REC1-ACCOUNT PIC X(02). DTSBX655 00215 10 REC1-NEW-RATE PIC 9.9999. DTSBX655 00216 10 REC1-EMP-TYPE PIC X(05). DTSBX655 00217 10 REC1-CHG PIC --------9.99. DTSBX655 00218 10 REC1-DESC PIC X(40). DTSBX655 00219 10 REC1-LIAB-QTRS PIC 999. DTSBX655 00220 10 REC1-ORG-TYPE PIC X(03). DTSBX655 00221 10 REC1-LIAB-CD PIC X(02). DTSBX655 00222 10 REC1-LP-CHG PIC --------9.99. DTSBX655 00223 10 REC1-INT-CHG PIC --------9.99. DTSBX655 00224 10 REC1-IND-CODE PIC X(06). DTSBX655 00225 10 REC1-LIAB-ENTER-DATE PIC X(10). DTSBX655 00226 10 REC1-INACT-CODE PIC X(05). DTSBX655 00227 88 REC1-INACT-YES-88 VALUE 'INACT'. DTSBX655 00228 88 REC1-INACT-NO-88 VALUE 'ACT '. DTSBX655 00229 10 REC1-REACT PIC X(05). DTSBX655 00230 88 REC1-REACT-NO-88 VALUE 'NEW '. DTSBX655 00231 88 REC1-REACT-YES-88 VALUE 'REACT'. DTSBX655 00232 10 REC1-AREA PIC X(03). DTSBX655 00233 10 REC1-PFX PIC X(03). DTSBX655 00234 10 REC1-SFX PIC X(04). DTSBX655 00235 10 REC1-EXT PIC X(05). DTSBX655 00236 10 REC1-INT-CHARGE-IND PIC X(01). CL*84 00237 88 REC1-INT-CHARGE-MANUAL-88 VALUE 'M'. CL*84 00238 88 REC1-INT-CHARGE-AUTO-88 VALUE 'A'. CL*84 00239 10 FILLER PIC X(01) VALUE ';'. CL*84 00240 10 REC1-INT-START-DATE1 PIC X(10). CL*84 00241 10 FILLER PIC X(01) VALUE ';'. CL*84 00242 10 REC1-INT-END-DATE1 PIC X(10). CL*84 00243 10 FILLER PIC X(01) VALUE ';'. CL*84 00244 10 REC1-INT-RATE1 PIC 9.9999. CL*84 00245 10 FILLER PIC X(01) VALUE ';'. CL*84 00246 10 REC1-INT-START-DATE2 PIC X(10). CL*84 00247 10 FILLER PIC X(01) VALUE ';'. CL*84 00248 10 REC1-INT-END-DATE2 PIC X(10). CL*84 00249 10 FILLER PIC X(01) VALUE ';'. CL*84 00250 10 REC1-INT-RATE2 PIC 9.9999. CL*84 00251 10 FILLER PIC X(01) VALUE ';'. CL*84 00252 10 REC1-WAIVE-INT-START-DATE PIC X(10). CL*84 00253 10 FILLER PIC X(01) VALUE ';'. CL*84 00254 10 REC1-WAIVE-INT-END-DATE PIC X(10). CL*84 00255 CL*71 00256 05 WRK-REC2. CL*71 00257 10 REC2-EMP-NO PIC 999999. CL*71 00258 10 FILLER PIC X(01) VALUE ';'. CL*71 00259 10 REC2-ESTB-DATE PIC X(10). CL*71 00260 10 FILLER PIC X(01) VALUE ';'. CL*71 00261 10 REC2-QTR PIC X(06). CL*71 00262 CL*71 00263 05 WRK-ABS-QTR1 PIC S9(04) COMP-3 DTSBX655 00264 VALUE +0. DTSBX655 00265 05 WRK-ABS-QTR2 PIC S9(04) COMP-3 DTSBX655 00266 VALUE +0. DTSBX655 00267 05 WRK-ABS-DATE1 PIC S9(08) COMP. DTSBX655 00268 05 WRK-ABS-DATE2 PIC S9(08) COMP. DTSBX655 00269 05 WRK-DIFF PIC S9(07) COMP-3. DTSBX655 00270 05 WRK-UNDER-30-CNT PIC S9(04) COMP-3 DTSBX655 00271 VALUE +0. DTSBX655 00272 05 WRK-OVER-31-CNT PIC S9(04) COMP-3 DTSBX655 00273 VALUE +0. DTSBX655 00274 05 WRK-MPRF-CNT PIC S9(07) COMP-3. DTSBX655 00275 05 WRK-FISCAL-AGENT-CD PIC X(03). DTSBX655 00276 05 WRK-BNK-IND PIC X(02). DTSBX655 00277 05 WRK-FIRST-NEW-EMP-NO PIC S9(07) COMP-3. DTSBX655 00278 *& VALUE +123778. DTSBX655 00279 05 WRK-FEIN PIC 9(09). DTSBX655 00280 05 WRK-MQTR-BAL PIC S9(11)V99 COMP-3 VALUE +0. DTSBX655 00281 05 WRK-MQTR-BAL1 PIC S9(11)V99 COMP-3 VALUE +0. DTSBX655 00282 05 WRK-MQTR-BAL2 PIC S9(11)V99 COMP-3 VALUE +0. DTSBX655 00283 05 WRK-MQTR-BAL3 PIC S9(11)V99 COMP-3 VALUE +0. DTSBX655 00284 05 WRK-RESERVE PIC S9(09)V99 COMP-3. DTSBX655 00285 05 WRK-MQTR-CHG PIC S9(09)V99 COMP-3. DTSBX655 00286 05 WRK-MQTR-ANN-BAL PIC S9(07)V99 COMP-3. DTSBX655 00287 05 WRK-MQTR-PEN-BAL PIC S9(07)V99 COMP-3. DTSBX655 00288 05 WRK-MQTR-PEN-CHG PIC S9(07)V99 COMP-3. DTSBX655 00289 05 WRK-MQTR-INT-BAL PIC S9(07)V99 COMP-3. DTSBX655 00290 05 WRK-MQTR-INT-CHG PIC S9(07)V99 COMP-3. DTSBX655 00291 05 WRK-RECEIVED-DATE PIC S9(09) COMP-3 CL*91 00292 VALUE +0. CL*91 00293 05 WRK-RPT-BAL-CNT PIC S9(07) COMP-3. DTSBX655 00294 05 WRK-RPT-CNT PIC S9(07) COMP-3. DTSBX655 00295 05 WRK-BAL-CNT PIC S9(07) COMP-3. DTSBX655 00296 05 WRK-REL-CNT PIC S9(07) COMP-3. DTSBX655 00297 05 WRK-RATED-CNT PIC S9(07) COMP-3. DTSBX655 00298 05 WRK-SELF-INS-CNT PIC S9(07) COMP-3. DTSBX655 00299 05 WRK-HOTEL-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX655 00300 05 WRK-TOT-EMPS PIC S9(07) COMP-3 VALUE +0. DTSBX655 00301 05 WRK-TOT-WORKERS PIC S9(11) COMP-3 VALUE +0. DTSBX655 00302 05 WRK-PURSUED-RPT-CNT PIC S9(07) COMP-3. DTSBX655 00303 05 WRK-LATE-RPT-CNT PIC S9(07) COMP-3. DTSBX655 00304 05 WRK-MEVL-REWRITE-CNT PIC S9(03) COMP-3 VALUE 0. CL141 00305 05 WRK-MEVL-DELETED-CNT PIC S9(03) COMP-3 VALUE 0. CL141 00306 05 WRK-MEVL-FOUND-CNT PIC S9(03) COMP-3 VALUE 0. CL128 00307 05 WRK-MQTR-UPDATED-CNT PIC S9(03) COMP-3 VALUE 0. CL128 00308 05 WRK-MQTR-FOUND-CNT PIC S9(03) COMP-3 VALUE 0. CL128 00309 05 MPRF-REC-CNT PIC S9(03) COMP-3 VALUE 0. CL128 00310 05 MPRF-WRK-CNT PIC S9(03) COMP-3 VALUE 0. CL128 00311 05 IN-REC-CNT PIC S9(03) COMP-3 VALUE 0. CL128 00312 05 WRK-UC30-SENT-CNT PIC S9(07) COMP-3. DTSBX655 00313 05 WRK-UC30-RCVD-CNT PIC S9(07) COMP-3. DTSBX655 00314 05 WRK-OVER-1000-CNT PIC S9(07) COMP-3. DTSBX655 00315 05 WRK-UNDER-1000-CNT PIC S9(07) COMP-3. DTSBX655 00316 05 WRK-HOUSEHOLD-PAYMENTS PIC S9(11)V99 COMP-3. DTSBX655 00317 05 WRK-TOT-WAGES PIC S9(11)V99 COMP-3. DTSBX655 00318 05 WRK-ALL-BNK-RATED PIC S9(11)V99 COMP-3. DTSBX655 00319 05 WRK-OPN-BNK-RATED PIC S9(11)V99 COMP-3. DTSBX655 00320 05 WRK-ALL-BNK-SI PIC S9(11)V99 COMP-3. DTSBX655 00321 05 WRK-OPN-BNK-SI PIC S9(11)V99 COMP-3. DTSBX655 00322 05 WRK-BOND-AMT PIC S9(11)V99 COMP-3. DTSBX655 00323 05 WRK-OVER-100-CNT PIC S9(07) COMP-3 DTSBX655 00324 VALUE +0. DTSBX655 00325 05 WRK-OVER-100-AMT PIC S9(11)V99 COMP-3 DTSBX655 00326 VALUE +0. DTSBX655 00327 05 WRK-1-10-CNT PIC S9(07) COMP-3 DTSBX655 00328 VALUE +0. DTSBX655 00329 05 WRK-1-10-AMT PIC S9(11)V99 COMP-3 DTSBX655 00330 VALUE +0. DTSBX655 00331 05 WRK-11-100-CNT PIC S9(07) COMP-3 DTSBX655 00332 VALUE +0. DTSBX655 00333 05 WRK-11-100-AMT PIC S9(11)V99 COMP-3 DTSBX655 00334 VALUE +0. DTSBX655 00335 05 WRK-OVER-100-WRKRS PIC S9(07) COMP-3. DTSBX655 00336 05 WRK-100-249-CNT PIC S9(07) COMP-3. DTSBX655 00337 05 WRK-100-249-WRKRS PIC S9(07) COMP-3. DTSBX655 00338 05 WRK-50-100-CNT PIC S9(07) COMP-3. DTSBX655 00339 05 WRK-50-100-WRKRS PIC S9(07) COMP-3. DTSBX655 00340 05 WRK-25-49-CNT PIC S9(07) COMP-3. DTSBX655 00341 05 WRK-25-49-WRKRS PIC S9(07) COMP-3. DTSBX655 00342 05 WRK-10-24-CNT PIC S9(07) COMP-3. DTSBX655 00343 05 WRK-10-24-WRKRS PIC S9(07) COMP-3. DTSBX655 00344 05 WRK-6-9-CNT PIC S9(07) COMP-3. DTSBX655 00345 05 WRK-5-9-WRKRS PIC S9(07) COMP-3. DTSBX655 00346 05 WRK-5-CNT PIC S9(07) COMP-3. DTSBX655 00347 05 WRK-4-CNT PIC S9(07) COMP-3. DTSBX655 00348 05 WRK-3-CNT PIC S9(07) COMP-3. DTSBX655 00349 05 WRK-2-CNT PIC S9(07) COMP-3. DTSBX655 00350 05 WRK-1-CNT PIC S9(07) COMP-3. DTSBX655 00351 05 WRK-UNDER-5-CNT PIC S9(07) COMP-3. DTSBX655 00352 05 WRK-UNDER-5-WRKRS PIC S9(07) COMP-3. DTSBX655 00353 05 WRK-UNDER-10-CNT PIC S9(07) COMP-3. DTSBX655 00354 05 WRK-OVER-10-CNT PIC S9(07) COMP-3. DTSBX655 00355 05 WRK-UNDER-10-WRKRS PIC S9(07) COMP-3. DTSBX655 00356 05 WRK-NO-EMPS-CNT PIC S9(07) COMP-3. DTSBX655 00357 05 WRK-MRCT-TOT-WAGES PIC S9(11)V99 COMP-3. DTSBX655 00358 05 WRK-MRCT-TAX-WAGES PIC S9(11)V99 COMP-3. DTSBX655 00359 05 WRK-MRCT-UI-PAID PIC S9(11)V99 COMP-3. DTSBX655 00360 05 WRK-TOT-UI PIC S9(11)V99 COMP-3. DTSBX655 00361 05 WRK-TOT-INT PIC S9(11)V99 COMP-3. DTSBX655 00362 05 WRK-TOT-PEN PIC S9(11)V99 COMP-3. DTSBX655 00363 05 WRK-MQTR-ANN-TOT-WAGE PIC S9(12)V99 COMP-3. DTSBX655 00364 05 WRK-MQTR-ANN-TAX-WAGE PIC S9(12)V99 COMP-3. DTSBX655 00365 05 WRK-MJRN-TOT-NEG-CHG PIC S9(11)V99 COMP-3 DTSBX655 00366 VALUE +0. DTSBX655 00367 05 WRK-MQTR-TOT-UI-CHARGED PIC S9(11)V99 COMP-3. DTSBX655 00368 05 WRK-START-DATE PIC S9(09) COMP-3. DTSBX655 00369 05 WRK-END-DATE PIC S9(09) COMP-3. DTSBX655 00370 05 WRK-LIAB-DATE PIC S9(09) COMP-3. DTSBX655 00371 05 WRK-FIRST-LIAB-DATE PIC S9(09) COMP-3. DTSBX655 00372 05 WRK-ALL-NINES-DATE PIC S9(09) COMP-3 DTSBX655 00373 VALUE +999999999. DTSBX655 00374 CL104 00375 05 WRK-UI-RATE-CATEGORY PIC X(01). CL104 00376 88 WRK-CLASSIFIED-88 VALUE 'C'. CL104 00377 88 WRK-NONCLASSIFIED-88 VALUE 'N'. CL104 00378 CL104 00379 CL104 00380 05 WRK-BNK-PETITION-DATE PIC 9(08). DTSBX655 00381 05 FILLER REDEFINES WRK-BNK-PETITION-DATE. DTSBX655 00382 10 WRK-BNK-PETITION-DATE-YYYY PIC 9(04). DTSBX655 00383 10 WRK-BNK-PETITION-DATE-MM PIC 9(02). DTSBX655 00384 10 WRK-BNK-PETITION-DATE-DD PIC 9(02). DTSBX655 00385 05 WRK-BNK-PETITION-YRQ PIC 9(05). DTSBX655 00386 05 FILLER REDEFINES WRK-BNK-PETITION-YRQ. DTSBX655 00387 10 WRK-BNK-PETITION-YRQ-YYYY PIC 9(04). DTSBX655 00388 10 WRK-BNK-PETITION-YRQ-Q PIC 9(01). DTSBX655 00389 05 WRK-BNK-FIRST-BILL-YRQ PIC S9(05) COMP-3. DTSBX655 00390 05 WRK-EST-RPT-IND PIC X(01). DTSBX655 00391 88 WRK-EST-RPT-YES VALUE 'Y'. DTSBX655 00392 88 WRK-EST-RPT-NO VALUE 'N'. DTSBX655 00393 DTSBX655 00394 05 WRK-ZERO-FOUND-IND PIC X(01). DTSBX655 00395 88 WRK-ZERO-FOUND-YES-88 VALUE 'Y'. DTSBX655 00396 88 WRK-ZERO-FOUND-NO-88 VALUE 'N'. DTSBX655 00397 DTSBX655 00398 05 WRK-WITHDRAWN-IND PIC X(01). DTSBX655 00399 88 WRK-WITHDRAWN-YES VALUE 'Y'. DTSBX655 00400 88 WRK-WITHDRAWN-NO VALUE 'N'. DTSBX655 00401 DTSBX655 00402 05 WRK-ORIG-IND PIC X(01). DTSBX655 00403 88 WRK-ORIG-YES VALUE 'Y'. DTSBX655 00404 88 WRK-ORIG-NO VALUE 'N'. DTSBX655 00405 DTSBX655 00406 05 WRK-MQTR-CNT PIC S9(07) COMP-3. DTSBX655 00407 05 WRK-MRPT-CNT PIC S9(07) COMP-3. DTSBX655 00408 05 WRK-MSOL-CNT PIC S9(07) COMP-3. DTSBX655 00409 05 WRK-MLIN-CNT PIC S9(07) COMP-3. DTSBX655 00410 05 WRK-MFAS-CNT PIC S9(07) COMP-3. DTSBX655 00411 05 WRK-MFAE-CNT PIC S9(07) COMP-3. DTSBX655 00412 05 WRK-MPAY-CNT PIC S9(07) COMP-3. DTSBX655 00413 05 WRK-MADJ-CNT PIC S9(07) COMP-3. DTSBX655 00414 05 WRK-MJRN-CNT PIC S9(08) COMP-3. DTSBX655 00415 05 WRK-MERA-CNT PIC S9(08) COMP-3. DTSBX655 00416 05 WRK-MRTE-CNT PIC S9(08) COMP-3. DTSBX655 00417 05 WRK-MRTE-CNT1 PIC S9(08) COMP-3. DTSBX655 00418 05 WRK-MLOG-CNT PIC S9(08) COMP-3. DTSBX655 00419 05 WRK-MFSC-CNT PIC S9(08) COMP-3 DTSBX655 00420 VALUE +0. DTSBX655 00421 05 WRK-CR-TOL-CNT PIC S9(07) COMP-3. DTSBX655 00422 05 SUB PIC S9(04) COMP. DTSBX655 00423 05 RPT-SUB PIC S9(04) COMP. DTSBX655 00424 05 QTR-SUB PIC S9(04) COMP. DTSBX655 00425 05 WRK-QTR-AREA OCCURS 20 TIMES. DTSBX655 00426 10 WRK-QTR-YRQ PIC S9(05) COMP-3. DTSBX655 00427 10 WRK-QTR-CHG PIC S9(09)V99 COMP-3. DTSBX655 00428 10 WRK-QTR-PAID PIC S9(09)V99 COMP-3. DTSBX655 00429 10 WRK-QTR-WAIVED PIC S9(09)V99 COMP-3. DTSBX655 00430 10 WRK-QTR-TOLERATED PIC S9(09)V99 COMP-3. DTSBX655 00431 05 WRK-JRN-AREA OCCURS 100 TIMES. DTSBX655 00432 *** 10 WRK-JRN-EMP-NO PIC 9(06). DTSBX655 00433 *** 10 WRK-JRN-EMP-NAME PIC X(40). DTSBX655 00434 10 WRK-JRN-RCVD PIC X(10). DTSBX655 00435 10 WRK-JRN-TRAN PIC X(02). DTSBX655 00436 10 WRK-JRN-BATCH PIC 9(05). DTSBX655 00437 10 WRK-JRN-ITEM PIC 9(03). DTSBX655 00438 10 WRK-JRN-AMT PIC --------9.99. DTSBX655 00439 05 WRK-TIMELY-PMT-AREA. DTSBX655 00440 10 WRK-PEN-INT-BAL-CNT PIC S9(07) COMP-3. DTSBX655 00441 10 WRK-INT-MANUAL-CNT PIC S9(07) COMP-3. DTSBX655 00442 10 WRK-QTR-TAX-BAL PIC S9(09)V9(02) COMP-3. DTSBX655 00443 10 WRK-QTR-TAX-CHG PIC S9(09)V9(02) COMP-3. DTSBX655 00444 10 WRK-QTR-INT-PEN-BAL PIC S9(09)V9(02) COMP-3. DTSBX655 00445 10 WRK-AVG-PMT PIC S9(09)V9(02) COMP-3. DTSBX655 00446 10 WRK-TIMELY-PMT PIC S9(09)V9(02) COMP-3. DTSBX655 00447 10 WRK-OLD-PEN-CHG PIC S9(09)V9(02) COMP-3. DTSBX655 00448 DTSBX655 00449 05 WRK-PCT PIC S9(03)V9(04) COMP-3 DTSBX655 00450 VALUE +0. DTSBX655 00451 05 WRK-AVG-PCT PIC S9(09)V9(04) COMP-3 DTSBX655 00452 VALUE +0. DTSBX655 00453 05 WRK-PCT-DISP PIC Z(02)9.9999. DTSBX655 00454 05 WRK-PCT-DISP1 PIC Z(02)9.9999. DTSBX655 00455 05 WRK-UI-RATE PIC S9(01)V9(04) COMP-3. DTSBX655 00456 05 DISP-UI-RATE1 PIC 9.9(04). DTSBX655 00457 05 DISP-UI-RATE2 PIC 9.9(04). DTSBX655 00458 05 AMT-DISP PIC ---,---,--9.99. DTSBX655 00459 05 AMT-DISP1 PIC Z(11)9.99-. DTSBX655 00460 05 AMT-DISP2 PIC Z(11)9.99-. DTSBX655 00461 05 AMT-DISP3 PIC Z(11)9-. DTSBX655 00462 05 EMP-ACCT-DISP PIC 9(06). DTSBX655 00463 05 EMP-SUCC-DISP PIC 9(06). DTSBX655 00464 05 EMP-SUCC-DISP-X REDEFINES EMP-SUCC-DISP DTSBX655 00465 PIC X(06). DTSBX655 00466 05 DISP-DATE1 PIC X(10). DTSBX655 00467 05 DISP-DATE2 PIC X(10). DTSBX655 00468 05 INACT-LBL PIC X(10). DTSBX655 00469 05 WRK-MPRF-IND PIC X(01). DTSBX655 00470 88 WRK-MPRF-OK VALUE 'Y'. DTSBX655 00471 88 WRK-MPRF-NO-REC VALUE 'N'. DTSBX655 00472 05 WRK-MQTR-IND PIC X(01). DTSBX655 00473 88 WRK-MQTR-OK VALUE 'Y'. DTSBX655 00474 88 WRK-MQTR-NO-REC VALUE 'N'. DTSBX655 00475 05 WRK-MRPT-IND PIC X(01). DTSBX655 00476 88 WRK-MRPT-OK VALUE 'Y'. DTSBX655 00477 88 WRK-MRPT-NO-REC VALUE 'N'. DTSBX655 00478 05 WRK-MDST-IND PIC X(01). DTSBX655 00479 88 WRK-MDST-OK VALUE 'Y'. DTSBX655 00480 88 WRK-MDST-NO-REC VALUE 'N'. DTSBX655 00481 05 WRK-MEVL-IND PIC X(01). DTSBX655 00482 88 WRK-MEVL-OK VALUE 'Y'. DTSBX655 00483 88 WRK-MEVL-NO-REC VALUE 'N'. DTSBX655 00484 05 WRK-MLIN-IND PIC X(01). DTSBX655 00485 88 WRK-MLIN-OK VALUE 'Y'. DTSBX655 00486 88 WRK-MLIN-NO-REC VALUE 'N'. DTSBX655 00487 05 WRK-MDPC-IND PIC X(01). DTSBX655 00488 88 WRK-MDPC-OK VALUE 'Y'. DTSBX655 00489 88 WRK-MDPC-NO-REC VALUE 'N'. DTSBX655 00490 05 WRK-MFAS-IND PIC X(01). DTSBX655 00491 88 WRK-MFAS-OK VALUE 'Y'. DTSBX655 00492 88 WRK-MFAS-NO-REC VALUE 'N'. DTSBX655 00493 05 WRK-MFAE-IND PIC X(01). DTSBX655 00494 88 WRK-MFAE-OK VALUE 'Y'. DTSBX655 00495 88 WRK-MFAE-NO-REC VALUE 'N'. DTSBX655 00496 05 WRK-MSOL-IND PIC X(01). DTSBX655 00497 88 WRK-MSOL-OK VALUE 'Y'. DTSBX655 00498 88 WRK-MSOL-NO-REC VALUE 'N'. DTSBX655 00499 05 WRK-MLOG-IND PIC X(01). DTSBX655 00500 88 WRK-MLOG-OK VALUE 'Y'. DTSBX655 00501 88 WRK-MLOG-NO-REC VALUE 'N'. DTSBX655 00502 88 WRK-MLOG-COMPLETE VALUE 'C'. DTSBX655 00503 05 WRK-MRPT-FOUND-IND PIC X(01). DTSBX655 00504 88 WRK-MRPT-FOUND-YES VALUE 'Y'. DTSBX655 00505 88 WRK-MRPT-FOUND-NO VALUE 'N'. DTSBX655 00506 05 WRK-MTAD-FOUND-IND PIC X(01). CL**6 00507 88 WRK-MTAD-FOUND-YES VALUE 'Y'. CL**6 00508 88 WRK-MTAD-FOUND-NO VALUE 'N'. CL**6 00509 05 WRK-CR-TOL-IND PIC X(01). DTSBX655 00510 88 WRK-CR-TOL-YES VALUE 'Y'. DTSBX655 00511 88 WRK-CR-TOL-NO VALUE 'N'. DTSBX655 00512 05 WRK-DUP-FOUND-IND PIC X(01). DTSBX655 00513 88 WRK-DUP-FOUND-YES VALUE 'Y'. DTSBX655 00514 88 WRK-DUP-FOUND-NO VALUE 'N'. DTSBX655 00515 05 WRK-SELECT-IND PIC X(01). DTSBX655 00516 88 WRK-SELECT-YES-88 VALUE 'Y'. DTSBX655 00517 88 WRK-SELECT-NO-88 VALUE 'N'. DTSBX655 00518 05 WRK-LAST-MRPT-TYPE PIC X(02). DTSBX655 00519 05 WRK-DISP-AREA. DTSBX655 00520 10 WRK-DISP-STAR PIC X(01). DTSBX655 00521 10 FILLER PIC X(01) VALUE SPACE. DTSBX655 00522 10 WRK-DISP-AMT PIC Z(10)9.99-. DTSBX655 00523 DTSBX655 00524 05 WRK-INACT-DATE PIC S9(09) COMP-3 DTSBX655 00525 VALUE +0. DTSBX655 00526 05 WRK-INACT-CODE PIC X(02). DTSBX655 00527 05 WRK-INACT-YRQ PIC S9(05) COMP-3 DTSBX655 00528 VALUE +0. DTSBX655 00529 05 WRK-LAST-YRQ PIC S9(05) COMP-3 DTSBX655 00530 VALUE +0. DTSBX655 00531 05 WRK-FIRST-LIAB-YRQ PIC S9(05) COMP-3 DTSBX655 00532 VALUE +0. DTSBX655 00533 05 WRK-LAST-LIAB-YRQ PIC S9(05) COMP-3 DTSBX655 00534 VALUE +0. DTSBX655 00535 05 WRK-NEXT-YRQ PIC S9(05) COMP-3 DTSBX655 00536 VALUE +0. DTSBX655 00537 05 WRK-UPDATED-CNT PIC S9(07) COMP-3. DTSBX655 00538 DTSBX655 00539 05 PARM-REC-CNT PIC S9(07) COMP-3. DTSBX655 00540 DTSBX655 00541 05 PARM-EOF-IND PIC X(01). DTSBX655 00542 DTSBX655 00543 05 WRK-EMP-NO PIC 9(06). DTSBX655 00544 DTSBX655 00545 05 WRK-TRACE-IND PIC X(01). DTSBX655 00546 DTSBX655 00547 05 WRK-MST-OPEN-IND PIC X(01). DTSBX655 00548 DTSBX655 00549 05 WRK-REF-OPEN-IND PIC X(01). DTSBX655 00550 DTSBX655 00551 05 WRK-SIC-SCAN-AREA. DTSBX655 00552 10 WRK-RPT-FOUND-IND PIC X(01). DTSBX655 00553 88 WRK-RPT-FOUND-YES VALUE 'Y'. DTSBX655 00554 88 WRK-RPT-FOUND-NO VALUE 'N'. DTSBX655 00555 10 WRK-EMPL-CNT PIC S9(07) COMP-3. DTSBX655 00556 10 WRK-SIC-4 PIC X(04). DTSBX655 00557 10 FILLER REDEFINES WRK-SIC-4. DTSBX655 00558 15 WRK-SIC-3 PIC X(03). DTSBX655 00559 15 FILLER PIC X(01). DTSBX655 00560 10 WRK-NO-SIC-CNT PIC S9(07) COMP-3. DTSBX655 00561 10 WRK-SIC-7911-AREA. DTSBX655 00562 15 WRK-SIC-7911-WORKERS PIC S9(07) COMP-3. DTSBX655 00563 15 WRK-SIC-7911-BUSINESSES PIC S9(07) COMP-3. DTSBX655 00564 10 WRK-SIC-794-AREA. DTSBX655 00565 15 WRK-SIC-794-WORKERS PIC S9(07) COMP-3. DTSBX655 00566 15 WRK-SIC-794-BUSINESSES PIC S9(07) COMP-3. DTSBX655 00567 10 WRK-SIC-799-AREA. DTSBX655 00568 15 WRK-SIC-799-WORKERS PIC S9(07) COMP-3. DTSBX655 00569 15 WRK-SIC-799-BUSINESSES PIC S9(07) COMP-3. DTSBX655 00570 10 WRK-SIC-8351-AREA. DTSBX655 00571 15 WRK-SIC-8351-WORKERS PIC S9(07) COMP-3. DTSBX655 00572 15 WRK-SIC-8351-BUSINESSES PIC S9(07) COMP-3. DTSBX655 00573 10 WRK-SIC-8641-AREA. DTSBX655 00574 15 WRK-SIC-8641-WORKERS PIC S9(07) COMP-3. DTSBX655 00575 15 WRK-SIC-8641-BUSINESSES PIC S9(07) COMP-3. DTSBX655 00576 10 WRK-NAICS-6 PIC X(06). DTSBX655 00577 10 FILLER REDEFINES WRK-NAICS-6. DTSBX655 00578 15 WRK-NAICS-2 PIC X(02). DTSBX655 00579 15 FILLER PIC X(04). DTSBX655 00580 *RW1 DTSBX655 00581 05 WRK-ABEND-MSG PIC X(60) VALUE SPACES. DTSBX655 00582 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBX655 00583 05 WS-NUMBER-ONE PIC S9(05) COMP-3 VALUE +0. DTSBX655 00584 DTSBX655 00585 05 DISP-DATE PIC X(08). DTSBX655 00586 05 DISP-TIME PIC X(08). DTSBX655 00587 DTSBX655 00588 05 WS-LINE-CNT PIC S9(02) COMP-3 VALUE 60. DTSBX655 00589 05 WS-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. DTSBX655 00590 05 WS-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. DTSBX655 00591 05 WRK-T003-CNT PIC S9(07) COMP-3 VALUE +0. CL184 00592 DTSBX655 00593 * 05 EVL-TEXT PIC X(50). CL154 00594 01 MNT-LOG-AREA. CL183 00595 10 WRK-MNTE-MSG-LINE1. CL183 00596 15 FILLER PIC X(53) VALUE CL214 00597 'AT THE REQUEST OF PROGRAM, ACCT RETURN MAIL FLAG HAS '. CL234 00598 15 FILLER PIC X(20) VALUE CL217 00599 'BEEN UPDATED TO "Y" '. CL238 00600 10 WRK-MNTE-MSG-LINE2. CL183 00601 15 FILLER PIC X(53) VALUE CL214 00602 '(BAD ADDRRESS). '. CL238 00603 15 FILLER PIC X(19) VALUE CL214 00604 ' '. CL229 00605 10 WRK-MNTE-MSG-LINE3. CL183 00606 15 FILLER PIC X(53) VALUE CL214 00607 ' '. CL229 00608 15 FILLER PIC X(19) VALUE CL214 00609 ' '. CL216 00610 * 'CORRESPONDENCE RESUMED.'. CL198 00611 * CL190 00612 01 HEADER-1. DTSBX655 00613 05 FILLER PIC X(01) VALUE SPACES. DTSBX655 00614 05 FILLER PIC X(49) VALUE '016R1'. DTSBX655 00615 05 FILLER PIC X(60) VALUE DTSBX655 00616 'DISTRICT OF COLUMBIA'. DTSBX655 00617 05 FILLER PIC X(06) VALUE 'DATE:'. DTSBX655 00618 05 HDR1-LRCM-SYS-DATE PIC X(08). DTSBX655 00619 DTSBX655 00620 01 HEADER-2. DTSBX655 00621 05 FILLER PIC X(54) VALUE SPACES. DTSBX655 00622 05 FILLER PIC X(56) VALUE DTSBX655 00623 'TAX DIVISION'. DTSBX655 00624 05 FILLER PIC X(06) VALUE 'TIME:'. DTSBX655 00625 05 HDR2-LRCM-SYS-TIME PIC X(08). DTSBX655 00626 DTSBX655 00627 01 HEADER-3. DTSBX655 00628 05 FILLER PIC X(01) VALUE SPACES. DTSBX655 00629 05 FILLER PIC X(38) VALUE DTSBX655 00630 'ROUTE TO: ACCOUNTING UNIT'. DTSBX655 00631 05 HDR3-LITERAL PIC X(43) VALUE DTSBX655 00632 ' EMPLOYERS REGISTERED SINCE 09/11/01 '. DTSBX655 00633 05 FILLER PIC X(28) VALUE SPACES. DTSBX655 00634 05 FILLER PIC X(06) VALUE 'PAGE:'. DTSBX655 00635 05 HDR3-PAGE PIC ZZ,ZZ9. DTSBX655 00636 DTSBX655 00637 01 HEADER-4. DTSBX655 00638 05 FILLER PIC X(01) VALUE SPACES. DTSBX655 00639 05 FILLER PIC X(132) VALUE SPACES. DTSBX655 00640 DTSBX655 00641 01 HEADER-5. DTSBX655 00642 05 FILLER PIC X(01) VALUE SPACES. DTSBX655 00643 05 FILLER PIC X(05) VALUE SPACES. DTSBX655 00644 05 FILLER PIC X(06) VALUE DTSBX655 00645 'EMP NO'. DTSBX655 00646 05 FILLER PIC X(05) VALUE SPACES. DTSBX655 00647 05 FILLER PIC X(12) VALUE DTSBX655 00648 'PRIMARY NAME'. DTSBX655 00649 05 FILLER PIC X(28) VALUE SPACES. DTSBX655 00650 05 FILLER PIC X(04) VALUE SPACES. DTSBX655 00651 05 FILLER PIC X(14) VALUE DTSBX655 00652 'LIABILITY DATE'. DTSBX655 00653 05 FILLER PIC X(04) VALUE SPACES. DTSBX655 00654 05 FILLER PIC X(13) VALUE DTSBX655 00655 'INACTIVE DATE'. DTSBX655 00656 05 FILLER PIC X(12) VALUE SPACES. DTSBX655 00657 05 FILLER PIC X(18) VALUE SPACES. DTSBX655 00658 DTSBX655 00659 01 HEADER-6. DTSBX655 00660 05 FILLER PIC X(01) VALUE SPACES. DTSBX655 00661 05 FILLER PIC X(132) VALUE SPACES. DTSBX655 00662 DTSBX655 00663 01 DETAIL-LINE-1. DTSBX655 00664 05 FILLER PIC X(05) VALUE SPACES. DTSBX655 00665 05 WS-EMP-NO PIC 999B999. DTSBX655 00666 05 FILLER PIC X(02) VALUE SPACES. DTSBX655 00667 05 WS-PRIMARY-NAME PIC X(40). DTSBX655 00668 05 FILLER PIC X(02) VALUE SPACES. DTSBX655 00669 05 WS-DATE1 PIC X(10). DTSBX655 00670 05 FILLER PIC X(02) VALUE SPACES. DTSBX655 00671 05 WS-DATE2 PIC X(10). DTSBX655 00672 * 05 FILLER PIC X(05) VALUE SPACES. DTSBX655 00673 * 05 WS-BALANCE-AMT PIC ZZZ,ZZZ,ZZ9.99. DTSBX655 00674 * 05 FILLER PIC X(09) VALUE SPACES. DTSBX655 00675 * 05 WS-PURSUED-RPT PIC ZZ9. DTSBX655 00676 * 05 FILLER PIC X(10) VALUE SPACES. DTSBX655 00677 * 05 WS-DPC PIC X(01). DTSBX655 00678 * 05 FILLER PIC X(06) VALUE SPACES. DTSBX655 00679 * 05 WS-LIEN PIC X(01). DTSBX655 00680 * 05 FILLER PIC X(21) VALUE SPACES. DTSBX655 00681 DTSBX655 00682 01 FOOTING-LINE-1 PIC X(133) VALUE SPACES. DTSBX655 00683 01 FOOTING-LINE-2 PIC X(133) VALUE SPACES. DTSBX655 00684 DTSBX655 00685 01 FOOTING-LINE-3. DTSBX655 00686 05 FILLER PIC X(25) VALUE SPACES. DTSBX655 00687 05 WS-FOOTING-CNT PIC ZZ,ZZ9. DTSBX655 00688 05 FILLER PIC X(02) VALUE SPACES. DTSBX655 00689 05 FILLER PIC X(43) VALUE DTSBX655 00690 'DEBIT WRITE OFF CANDIDATES LISTED ON REPORT'.DTSBX655 00691 05 FILLER PIC X(23) VALUE SPACES. DTSBX655 00692 01 FOOTING-LINE-4 PIC X(133) VALUE SPACES. DTSBX655 00693 01 FOOTING-LINE-5 PIC X(133) VALUE SPACES. DTSBX655 00694 01 FOOTING-LINE-6. DTSBX655 00695 05 FILLER PIC X(25) VALUE SPACES. DTSBX655 00696 05 FILLER PIC X(17) VALUE DTSBX655 00697 '*** END OF REPORT'. DTSBX655 00698 *RW2 DTSBX655 00699 DTSBX655 00700 01 TSKL-REC. CL183 00701 ++INCLUDE DTSITSKL CL183 00702 EJECT CL183 00703 01 T003-REC. CL183 00704 ++INCLUDE DTSIT003 CL183 00705 EJECT CL183 00706 01 L001-LINK-AREA. DTSBX655 00707 ++INCLUDE DTSIL001 DTSBX655 00708 EJECT DTSBX655 00709 01 L005-LINK-AREA. CL157 00710 ++INCLUDE DTSIL005 DTSBX655 00711 EJECT DTSBX655 00712 01 L331-LINK-AREA. CL209 00713 ++INCLUDE DTSIL331 CL209 00714 EJECT DTSBX655 00715 01 L039-LINK-AREA. CL209 00716 ++INCLUDE DTSIL039 CL209 00717 EJECT CL209 00718 01 L101-LINK-AREA. CL*23 00719 ++INCLUDE DTSIL101 CL*23 00720 EJECT DTSBX655 00721 01 L102-LINK-AREA. CL*23 00722 ++INCLUDE DTSIL102 CL*23 00723 EJECT CL*23 00724 01 L109-LINK-AREA. CL*23 00725 ++INCLUDE DTSIL109 CL*23 00726 CL*23 00727 01 L054-LINK-AREA. DTSBX655 00728 ++INCLUDE DTSIL054 DTSBX655 00729 EJECT DTSBX655 00730 01 L410-LINK-AREA. DTSBX655 00731 ++INCLUDE DTSIL410 DTSBX655 00732 EJECT DTSBX655 00733 01 L600-LINK-AREA. DTSBX655 00734 ++INCLUDE DTSIL600 DTSBX655 00735 EJECT DTSBX655 00736 01 L910-LINK-AREA. DTSBX655 00737 ++INCLUDE DTSIL910 DTSBX655 00738 EJECT DTSBX655 00739 01 MSKL-REC. DTSBX655 00740 ++INCLUDE DTSIMSKL DTSBX655 00741 EJECT DTSBX655 00742 01 MNTE-REC. CL183 00743 ++INCLUDE DTSIMNTE CL183 00744 EJECT CL183 00745 01 MHDR-REC. DTSBX655 00746 ++INCLUDE DTSIMHDR DTSBX655 00747 EJECT DTSBX655 00748 01 MPRF-REC. CL164 00749 ++INCLUDE DTSIMPRF CL164 00750 EJECT CL164 00751 01 MQTR-REC. DTSBX655 00752 ++INCLUDE DTSIMQTR DTSBX655 00753 EJECT DTSBX655 00754 01 MRPT-REC. DTSBX655 00755 ++INCLUDE DTSIMRPT DTSBX655 00756 EJECT DTSBX655 00757 01 MSOL-REC. DTSBX655 00758 ++INCLUDE DTSIMSOL DTSBX655 00759 EJECT DTSBX655 00760 01 MRCT-REC. DTSBX655 00761 ++INCLUDE DTSIMRCT DTSBX655 00762 EJECT DTSBX655 00763 01 MREL-REC. DTSBX655 00764 ++INCLUDE DTSIMREL DTSBX655 00765 EJECT DTSBX655 00766 01 MEVL-REC. DTSBX655 00767 ++INCLUDE DTSIMEVL DTSBX655 00768 EJECT DTSBX655 00769 01 MLIN-REC. DTSBX655 00770 ++INCLUDE DTSIMLIN DTSBX655 00771 EJECT DTSBX655 00772 01 MRTE-REC. DTSBX655 00773 ++INCLUDE DTSIMRTE DTSBX655 00774 EJECT DTSBX655 00775 01 MDST-REC. DTSBX655 00776 ++INCLUDE DTSIMDST DTSBX655 00777 EJECT DTSBX655 00778 01 MPAY-REC. DTSBX655 00779 ++INCLUDE DTSIMPAY DTSBX655 00780 EJECT DTSBX655 00781 01 MADJ-REC. DTSBX655 00782 ++INCLUDE DTSIMADJ DTSBX655 00783 EJECT DTSBX655 00784 01 MJRN-REC. DTSBX655 00785 ++INCLUDE DTSIMJRN DTSBX655 00786 EJECT DTSBX655 00787 01 MERA-REC. DTSBX655 00788 ++INCLUDE DTSIMERA DTSBX655 00789 EJECT DTSBX655 00790 01 MCOL-REC. DTSBX655 00791 ++INCLUDE DTSIMCOL DTSBX655 00792 EJECT DTSBX655 00793 01 MFAS-REC. DTSBX655 00794 ++INCLUDE DTSIMFAS DTSBX655 00795 01 MAUR-REC. DTSBX655 00796 ++INCLUDE DTSIMAUR DTSBX655 00797 EJECT DTSBX655 00798 01 MFAE-REC. DTSBX655 00799 ++INCLUDE DTSIMFAE DTSBX655 00800 EJECT DTSBX655 00801 01 MLOG-REC. DTSBX655 00802 ++INCLUDE DTSIMLOG DTSBX655 00803 EJECT DTSBX655 00804 01 MOPO-REC. DTSBX655 00805 ++INCLUDE DTSIMOPO DTSBX655 00806 EJECT DTSBX655 00807 01 MTAD-REC. DTSBX655 00808 ++INCLUDE DTSIMTAD DTSBX655 00809 EJECT DTSBX655 00810 01 MTAA-REC. DTSBX655 00811 ++INCLUDE DTSIMTAA DTSBX655 00812 EJECT DTSBX655 00813 01 MBAA-REC. DTSBX655 00814 ++INCLUDE DTSIMBAA DTSBX655 00815 EJECT DTSBX655 00816 01 MFSC-REC. DTSBX655 00817 ++INCLUDE DTSIMFSC DTSBX655 00818 EJECT DTSBX655 00819 01 MERD-REC. DTSBX655 00820 ++INCLUDE DTSIMERD DTSBX655 00821 EJECT DTSBX655 00822 01 MDPC-REC. DTSBX655 00823 ++INCLUDE DTSIMDPC DTSBX655 00824 EJECT DTSBX655 00825 01 L921-LINK-AREA. DTSBX655 00826 ++INCLUDE DTSIL921 DTSBX655 00827 EJECT DTSBX655 00828 01 ISKL-REC. DTSBX655 00829 ++INCLUDE DTSIISKL DTSBX655 00830 EJECT DTSBX655 00831 01 IPES-REC. DTSBX655 00832 ++INCLUDE DTSIIPES DTSBX655 00833 EJECT DTSBX655 00834 01 L931-LINK-AREA. DTSBX655 00835 ++INCLUDE DTSIL931 DTSBX655 00836 EJECT DTSBX655 00837 01 FSKL-REC. DTSBX655 00838 ++INCLUDE DTSIFSKL DTSBX655 00839 EJECT DTSBX655 00840 01 FQTR-REC. DTSBX655 00841 ++INCLUDE DTSIFQTR DTSBX655 00842 EJECT DTSBX655 00843 01 FFIS-REC. DTSBX655 00844 ++INCLUDE DTSIFFIS DTSBX655 00845 EJECT DTSBX655 00846 01 FFAZ-REC. DTSBX655 00847 ++INCLUDE DTSIFFAZ DTSBX655 00848 EJECT DTSBX655 00849 01 FOPR-REC. DTSBX655 00850 ++INCLUDE DTSIFOPR DTSBX655 00851 EJECT DTSBX655 00852 01 L933-LINK-AREA. DTSBX655 00853 ++INCLUDE DTSIL933 DTSBX655 00854 EJECT DTSBX655 00855 01 XSIC-REC. DTSBX655 00856 ++INCLUDE DTSIXSIC DTSBX655 00857 EJECT DTSBX655 00858 01 L004-COMM-AREA. DTSBX655 00859 ++INCLUDE DTSIL004 DTSBX655 00860 DTSBX655 00861 01 L061-LINK-AREA. DTSBX655 00862 ++INCLUDE DTSIL061 DTSBX655 00863 DTSBX655 00864 01 L062-LINK-AREA. DTSBX655 00865 ++INCLUDE DTSIL062 DTSBX655 00866 DTSBX655 00867 01 L516-LINK-AREA. DTSBX655 00868 ++INCLUDE DTSIL516 DTSBX655 00869 EJECT DTSBX655 00870 01 LBCM-LINK-AREA. CL173 00871 ++INCLUDE DTSILBCM CL173 00872 EJECT CL154 00873 01 L923-LINK-AREA. CL183 00874 ++INCLUDE DTSIL923 CL183 00875 EJECT CL183 00876 01 ASKL-REC. CL183 00877 ++INCLUDE DTSIASKL CL183 00878 EJECT CL183 00879 01 AHDR-REC. CL183 00880 ++INCLUDE DTSIAHDR CL183 00881 EJECT CL183 00882 01 AADJ-REC. CL183 00883 ++INCLUDE DTSIAADJ CL183 00884 EJECT CL183 00885 01 L927-LINK-AREA. CL183 00886 ++INCLUDE DTSIL927 CL183 00887 EJECT CL183 00888 PROCEDURE DIVISION. CL228 00889 CL164 00890 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBX655 00891 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBX655 00892 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBX655 00893 SKIP2 DTSBX655 00894 GOBACK. DTSBX655 00895 EJECT DTSBX655 00896 I0000-INITIATE. DTSBX655 00897 SKIP2 DTSBX655 00898 MOVE 'N' TO WRK-TRACE-IND. DTSBX655 00899 SET WRK-ERROR-NO-88 TO TRUE. DTSBX655 00900 MOVE +0 TO WRK-MPRF-REC-CNT CL193 00901 DTSBX655 00902 PERFORM I2000-OPEN-FILES-1 THRU I2000-EXIT. DTSBX655 00903 DTSBX655 00904 MOVE +0 TO WRK-MPRF-CNT CL120 00905 WRK-MQTR-CNT CL120 00906 WRK-MLOG-CNT CL120 00907 WRK-MEVL-DELETED-CNT. CL120 00908 CL120 00909 I0000-EXIT. DTSBX655 00910 EXIT. DTSBX655 00911 I2000-OPEN-FILES-1. DTSBX655 00912 DISPLAY 'UPDATE RETURN FLAG TO Y - BAD ADDRESS FROM NCOA' CL220 00913 DISPLAY ' '. CL220 00914 OPEN INPUT EMP-FILE1. CL120 00915 IF NOT EXP-STATUS-OK-88 DTSBX655 00916 DISPLAY 'CANNOT OPEN EXP FILE ' EXP-STATUS DTSBX655 00917 SET WRK-ERROR-YES-88 TO TRUE DTSBX655 00918 GO TO I2000-EXIT. DTSBX655 00919 MOVE WRK-TRACE-IND TO L910-TRACE-IND. DTSBX655 00920 DTSBX655 00921 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSBX655 00922 DTSBX655 00923 * PERFORM S910-OPEN-READ THRU S910-EXIT. CL171 00924 PERFORM S910-OPEN-UPDATE-NO-AIX THRU S910-EXIT. CL176 00925 PERFORM S923-OPEN-UPDATE THRU S923-EXIT. CL189 00926 PERFORM S927-OPEN-UPDATE THRU S927-EXIT. CL189 00927 DTSBX655 00928 * PERFORM S921-OPEN-READ THRU S921-EXIT. CL123 00929 PERFORM S005-FROM-SYS THRU S005-EXIT. CL187 00930 DTSBX655 00931 ** PERFORM S931-OPEN-READ THRU S931-EXIT. CL122 00932 * PERFORM S931-OPEN-UPDATE THRU S931-EXIT. CL176 00933 DTSBX655 00934 MOVE WRK-MOD-NAME TO L933-MOD-NAME. DTSBX655 00935 DTSBX655 00936 *** PERFORM S933-OPEN-READ THRU S933-EXIT. DTSBX655 00937 DTSBX655 00938 I2000-EXIT. DTSBX655 00939 EXIT. DTSBX655 00940 DTSBX655 00941 P0000-PROCESS. DTSBX655 00942 * DISPLAY 'IN P0000-PROCESS'. CL220 00943 READ EMP-FILE1 AT END GO TO P0000-EXIT. CL122 00944 DTSBX655 00945 MOVE INEMP-NO TO WS-EMP-NO1. CL196 00946 ADD 1 TO IN-REC-CNT. CL122 00947 MOVE LOW-VALUES TO MPRF-KEY-AREA. CL129 00948 SET MPRF-PRF-88 TO TRUE. CL129 00949 DTSBX655 00950 MOVE WS-EMP-NO1 TO MPRF-EMP-NO. CL159 00951 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. CL119 00952 DTSBX655 00953 PERFORM S910-READ THRU S910-EXIT. DTSBX655 00954 IF L910-NO-REC-88 CL119 00955 DISPLAY ' EMP NOT FOUND ' INEMP-NO CL196 00956 GO TO P0000-PROCESS. CL119 00957 ADD 1 TO MPRF-REC-CNT. CL122 00958 MOVE MSKL-REC TO MPRF-REC CL119 00959 * DISPLAY'MPRF-RETURN-MAIL-FLAG: ' MPRF-EMP-NO CL217 00960 * ' ' MPRF-RETURN-MAIL-IND. CL217 00961 * PERFORM P6000-SCAN-EVL THRU P6000-EXIT. CL207 00962 * GO TO P0000-PROCESS. CL207 00963 CL204 00964 * IF MPRF-TOT-CREDIT-AMT < 1 CL231 00965 * DISPLAY MPRF-EMP-NO ';' CL231 00966 * ';' MPRF-RETURN-MAIL-IND ';' MPRF-TOT-CREDIT-AMT CL231 00967 * ELSE CL231 00968 * DISPLAY MPRF-EMP-NO ';' CL231 00969 * ';' MPRF-RETURN-MAIL-IND ';' MPRF-TOT-CREDIT-AMT. CL231 00970 CL226 00971 * IF MPRF-RETURN-MAIL-NO-88 CL232 00972 * DISPLAY MPRF-EMP-NO ' DUTAS RTN MAIL FLAG = N NCOA = Y '. CL232 00973 * '---- RTN FLAG NOT UPDATED' CL231 00974 * GO TO P0000-PROCESS. CL231 00975 CL227 00976 PERFORM P6000-SCAN-EVL THRU P6000-EXIT. CL231 00977 CL231 00978 IF WRK-MEVL-REWRITE-CNT = 1 CL231 00979 DISPLAY MEVL-EMP-NO ' MEVL REWRITTEN AFTER NCOA ' CL231 00980 GO TO P0000-PROCESS. CL231 00981 CL231 00982 PERFORM P1100-CHECK-FOR-MLOG THRU P1100-EXIT. CL217 00983 PERFORM P3000-ADD-MNTE THRU P3000-EXIT CL225 00984 SET MPRF-RETURN-MAIL-YES-88 TO TRUE CL221 00985 MOVE L005-DATE TO MPRF-CHNG-DATE CL228 00986 MOVE MPRF-REC TO MSKL-REC CL228 00987 PERFORM S910-REWRITE THRU S910-EXIT CL221 00988 DISPLAY MPRF-EMP-NO ' DUTAS RTN MAIL UPDATED; NCOA = Y '. CL232 00989 ADD +1 TO WRK-MPRF-REC-CNT CL221 00990 GO TO P0000-PROCESS. CL155 00991 P0000-EXIT. CL119 00992 EXIT. DTSBX655 00993 P1100-CHECK-FOR-MLOG. CL208 00994 ADD +5000 TO WRK-ABSTIME CL222 00995 PERFORM S005-FROM-SYS THRU S005-EXIT CL208 00996 MOVE L005-ABSTIME TO WRK-SYS-ABSTIME CL208 00997 MOVE MPRF-EMP-NO TO L331-EMP-NO WRK-EMP-NO CL208 00998 MOVE L005-DATE TO L331-CURR-RUN-DATE CL212 00999 ADD WRK-ABSTIME TO WRK-SYS-ABSTIME CL208 01000 MOVE WRK-SYS-ABSTIME TO L331-UPDATE-ABSTIME CL208 01001 MOVE 'NCOAX655' TO L331-OP-ID CL224 01002 MOVE 'RETURN MAIL IND' TO L331-FIELD-NAME CL208 01003 MOVE MPRF-RETURN-MAIL-IND TO L331-FROM-VALUE CL221 01004 * MOVE 'N' TO L331-FROM-VALUE CL221 01005 MOVE 'Y' TO L331-TO-VALUE CL213 01006 MOVE 'Y' TO MPRF-RETURN-MAIL-IND CL213 01007 * MOVE +1 TO WRK-MPRF-MAIL-UPD-CNT CL211 01008 * DISPLAY ' RETURN MAIL UPDATED: ' WRK-EMP-NO CL220 01009 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL208 01010 P1100-EXIT. EXIT. CL208 01011 DTSBX655 01012 P6000-SCAN-EVL. CL122 01013 MOVE +0 TO WRK-MEVL-REWRITE-CNT CL231 01014 SET WRK-MEVL-OK TO TRUE. CL122 01015 MOVE +0 TO WRK-RECEIVED-DATE. CL122 01016 MOVE LOW-VALUES TO MEVL-KEY-AREA. CL122 01017 MOVE MPRF-EMP-NO TO MEVL-EMP-NO. CL122 01018 MOVE +0 TO MEVL-DATE. CL122 01019 SET MEVL-EVL-88 TO TRUE. CL122 01020 MOVE MEVL-KEY-AREA TO MSKL-KEY-AREA. CL122 01021 CL122 01022 PERFORM S910-START-BROWSE THRU S910-EXIT. CL122 01023 IF L910-NO-REC-88 CL122 01024 DISPLAY ' EVENT LOG NOT FOUND ' MPRF-EMP-NO CL122 01025 SET WRK-MEVL-NO-REC TO TRUE CL206 01026 GO TO P6000-EXIT CL122 01027 ELSE CL122 01028 PERFORM P6100-SCAN-MEVL THRU P6100-EXIT CL122 01029 UNTIL WRK-MEVL-NO-REC. CL122 01030 CL122 01031 P6000-EXIT. CL122 01032 EXIT. CL122 01033 P6100-SCAN-MEVL. CL122 01034 MOVE MSKL-REC TO MEVL-REC. DTSBX655 01035 CL126 01036 IF MEVL-DATE > 20190527 CL231 01037 IF MEVL-TEXT (1:20) = 'MPRF-RETURN-MAIL-IND' OR CL200 01038 MEVL-TEXT (1:15) = 'RETURN MAIL IND' CL200 01039 MOVE +1 TO WRK-MEVL-REWRITE-CNT CL231 01040 DISPLAY ' MEVL REWRITTEN ' MEVL-EMP-NO ' ' MEVL-TEXT CL203 01041 SET WRK-MEVL-NO-REC TO TRUE CL204 01042 GO TO P6100-EXIT. CL204 01043 CL204 01044 P6100-READ-NEXT. CL204 01045 CL132 01046 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBX655 01047 IF L910-NO-REC-88 DTSBX655 01048 SET WRK-MEVL-NO-REC TO TRUE. DTSBX655 01049 DTSBX655 01050 P6100-EXIT. DTSBX655 01051 EXIT. DTSBX655 01052 DTSBX655 01053 S6000-WRITE-MEVL. CL154 01054 MOVE LOW-VALUES TO MEVL-REC. CL165 01055 MOVE LOW-VALUES TO LBCM-RUN-AREA. CL173 01056 CL173 01057 MOVE ZERO TO LBCM-EMP-ABSTIME. CL173 01058 MOVE MPRF-EMP-NO TO MEVL-EMP-NO. CL165 01059 DISPLAY'EMPNO:', MPRF-EMP-NO. CL166 01060 SET MEVL-EVL-88 TO TRUE. CL165 01061 ADD +6000 TO LBCM-EMP-ABSTIME. CL182 01062 CL154 01063 MOVE LBCM-EMP-ABSTIME TO L005-ABSTIME. CL173 01064 CL154 01065 PERFORM S005-FROM-ABSTIME THRU S005-A-EXIT. CL173 01066 CL154 01067 CL154 01068 DISPLAY'EMPNO:', MPRF-EMP-NO. CL166 01069 CL154 01070 MOVE L005-DATE TO MEVL-DATE. CL181 01071 CL154 01072 MOVE L005-TIME TO MEVL-TIME. CL181 01073 CL154 01074 DISPLAY'EMPNO:', MPRF-EMP-NO. CL166 01075 CL154 01076 MOVE ZEROS TO MEVL-PURGE-DATE. CL154 01077 CL154 01078 CL154 01079 * MOVE EVL-TEXT TO MEVL-TEXT. CL184 01080 CL154 01081 **** SET MEVL-SOURCE-SYSTEM-88 TO TRUE. CL154 01082 ** MOVE MPAY-RESPONSIBLE-OP-ID TO MEVL-SOURCE. CL180 01083 CL154 01084 SET MEVL-NOT-CONVERTED-88 TO TRUE. CL154 01085 * MOVE LBCM-CURR-RUN-DATE TO MEVL-ESTB-DATE CL180 01086 MOVE 20170127 TO MEVL-ESTB-DATE CL180 01087 MEVL-CHNG-DATE. CL154 01088 CL154 01089 CL154 01090 MOVE MEVL-REC TO MSKL-REC. CL154 01091 CL154 01092 PERFORM S910-WRITE THRU S910-EXIT. CL154 01093 S6000-EXIT. CL154 01094 EXIT. CL154 01095 EJECT CL154 01096 DTSBX655 01097 P3000-ADD-MNTE. CL183 01098 MOVE LENGTH OF T003-REC TO T003-LENGTH. CL183 01099 MOVE '003' TO T003-REC-TYPE. CL183 01100 MOVE 'SYSTEM ' TO T003-ORIGIN. CL183 01101 MOVE L005-DATE TO T003-SYS-DATE. CL183 01102 MOVE L005-TIME TO T003-SYS-TIME. CL183 01103 SET T003-ADD-MNTE-88 TO TRUE. CL183 01104 CL183 01105 MOVE LOW-VALUES TO CL183 01106 MNTE-KEY-AREA. CL183 01107 MOVE MPRF-EMP-NO TO MNTE-EMP-NO. CL183 01108 SET MNTE-NTE-88 TO TRUE. CL183 01109 MOVE +0 TO MNTE-PURGE-DATE. CL183 01110 SET MNTE-NOT-CONVERTED-88 TO TRUE. CL183 01111 CL183 01112 MOVE L005-DATE TO MNTE-ESTB-DATE CL183 01113 MNTE-CHNG-DATE. CL183 01114 MOVE ZERO TO MNTE-KEY-ESTB-ABSTIME CL183 01115 MNTE-DATA-ESTB-ABSTIME CL183 01116 MNTE-CHNG-ABSTIME. CL183 01117 MOVE 'DTSBX655' TO MNTE-ESTB-OP-ID CL234 01118 MNTE-CHNG-OP-ID. CL183 01119 CL183 01120 MOVE 'RETURN MAIL FLAG UPDATED TO YES ' CL229 01121 TO MNTE-SUBJECT. CL183 01122 CL183 01123 MOVE +3 TO MNTE-TEXT-CNT. CL190 01124 CL183 01125 MOVE WRK-MNTE-MSG-LINE1 TO MNTE-TEXT (1). CL183 01126 MOVE WRK-MNTE-MSG-LINE2 TO MNTE-TEXT (2). CL183 01127 * MOVE WRK-MNTE-MSG-LINE3 TO MNTE-TEXT (3). CL229 01128 CL183 01129 MOVE MPRF-EMP-NO TO T003-EMP-NO. CL183 01130 MOVE MNTE-REC TO T003-MNTE-REC. CL183 01131 CL183 01132 MOVE T003-REC TO TSKL-REC. CL183 01133 PERFORM S927-WRITE THRU S927-EXIT. CL183 01134 ADD +1 TO WRK-T003-CNT. CL183 01135 CL183 01136 P3000-EXIT. CL183 01137 EXIT. CL183 01138 CL183 01139 SKIP3 CL183 01140 T0000-TERMINATE. DTSBX655 01141 DTSBX655 01142 DISPLAY ' '. DTSBX655 01143 DTSBX655 01144 DISPLAY '*** DTSBX655 TERMINATION STATISTICS ***'. CL238 01145 DTSBX655 01146 DISPLAY ' '. DTSBX655 01147 DTSBX655 01148 DISPLAY 'INPUT RECORDS READ : ' CL123 01149 IN-REC-CNT CL123 01150 CL123 01151 DISPLAY 'RETURN MAIL UPDATE : ' CL192 01152 WRK-MPRF-REC-CNT CL192 01153 CL192 01154 CL123 01155 DISPLAY 'ACTIVE EMPLOYERS FOUND : ' CL123 01156 MPRF-WRK-CNT. CL123 01157 CL123 01158 DISPLAY 'QTR RECS FOUND : ' CL123 01159 WRK-MQTR-FOUND-CNT. CL123 01160 CL123 01161 DISPLAY 'QTR RECS UPDATED : ' CL123 01162 WRK-MQTR-UPDATED-CNT. CL123 01163 DTSBX655 01164 DISPLAY 'MEVL REC FOUND : ' CL123 01165 WRK-MEVL-FOUND-CNT. CL123 01166 DTSBX655 01167 DISPLAY 'MEVL REC UPDATED : ' CL123 01168 ** WRK-MEVL-DELETED-CNT. CL149 01169 WRK-MEVL-REWRITE-CNT. CL149 01170 CL123 01171 CLOSE EMP-FILE1. CL123 01172 DTSBX655 01173 PERFORM S923-CLOSE THRU S923-EXIT. CL189 01174 PERFORM S927-CLOSE THRU S927-EXIT. CL189 01175 CL183 01176 PERFORM S910-CLOSE THRU S910-EXIT. CL176 01177 * PERFORM S921-CLOSE THRU S921-EXIT. CL123 01178 * PERFORM S931-CLOSE THRU S931-EXIT. CL176 01179 *** PERFORM S933-CLOSE THRU S933-EXIT. DTSBX655 01180 DTSBX655 01181 T0000-EXIT. DTSBX655 01182 EXIT. DTSBX655 01183 EJECT DTSBX655 01184 S001-FROM-FED-8. DTSBX655 01185 SET L001-FROM-FED-8 TO TRUE. DTSBX655 01186 GO TO S001-DATE. DTSBX655 01187 DTSBX655 01188 S001-FROM-ABS-DAY. DTSBX655 01189 SET L001-FROM-ABS-DAY TO TRUE. DTSBX655 01190 GO TO S001-DATE. DTSBX655 01191 DTSBX655 01192 S001-DATE. DTSBX655 01193 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX655 01194 DTSBX655 01195 S001-EXIT. DTSBX655 01196 EXIT. DTSBX655 01197 SKIP3 DTSBX655 01198 S004-FROM-5. DTSBX655 01199 SET L004-FROM-5 TO TRUE. DTSBX655 01200 GO TO S004-EDIT-QTR. DTSBX655 01201 DTSBX655 01202 S004-FROM-ABS. DTSBX655 01203 SET L004-FROM-ABS TO TRUE. DTSBX655 01204 GO TO S004-EDIT-QTR. DTSBX655 01205 DTSBX655 01206 S004-EDIT-QTR. DTSBX655 01207 CALL 'DTSBU004' USING L004-COMM-AREA. DTSBX655 01208 DTSBX655 01209 S004-EXIT. DTSBX655 01210 EXIT. DTSBX655 01211 SKIP3 DTSBX655 01212 DTSBX655 01213 S005-FROM-SYS. CL187 01214 SET L005-FROM-SYS TO TRUE. CL187 01215 CALL 'DTSBU005' USING L005-LINK-AREA. CL187 01216 CL187 01217 S005-EXIT. CL187 01218 EXIT. CL187 01219 CL187 01220 S005-FROM-ABSTIME. CL156 01221 SET L005-FROM-ABSTIME TO TRUE. CL156 01222 GO TO S005-ABSTIME. CL156 01223 CL156 01224 S005-ABSTIME. CL156 01225 CALL 'DTSBU005' USING L005-LINK-AREA. CL156 01226 S005-A-EXIT. CL156 01227 EXIT. CL156 01228 SKIP3 CL156 01229 S910-WRITE. CL156 01230 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. CL173 01231 SET L910-WRITE-88 TO TRUE. CL156 01232 GO TO S910-MSTR-IO. CL156 01233 S039-SIC-EDIT. DTSBX655 01234 CALL 'DTSBU039' USING L039-LINK-AREA. DTSBX655 01235 S039-EXIT. DTSBX655 01236 EXIT. DTSBX655 01237 DTSBX655 01238 S054-RATE-DETERMINATION. DTSBX655 01239 CALL 'DTSBU054' USING L054-LINK-AREA DTSBX655 01240 MRCT-REC. DTSBX655 01241 DTSBX655 01242 S054-EXIT. DTSBX655 01243 EXIT. DTSBX655 01244 SKIP3 DTSBX655 01245 S061-FLD-REP-INFO. DTSBX655 01246 SKIP1 DTSBX655 01247 CALL 'DTSBU061' USING L061-LINK-AREA. DTSBX655 01248 SKIP2 DTSBX655 01249 S061-EXIT. DTSBX655 01250 EXIT. DTSBX655 01251 DTSBX655 01252 S062-FLD-REP-LOOKUP. DTSBX655 01253 DTSBX655 01254 CALL 'DTSBU062' USING L062-LINK-AREA. DTSBX655 01255 DTSBX655 01256 S062-EXIT. DTSBX655 01257 EXIT. DTSBX655 01258 DTSBX655 01259 S101-PER-MONTH-NO. CL*23 01260 SET L101-PER-MONTH-NO-88 TO TRUE. CL*23 01261 GO TO S101-INT-CHARGE. CL*23 01262 CL*23 01263 S101-INT-CHARGE. CL*23 01264 CALL 'DTSBU101' USING L101-LINK-AREA. CL*23 01265 S101-EXIT. CL*23 01266 EXIT. CL*23 01267 CL*23 01268 S109-FIRST-PEN-INT-YRQ. CL*23 01269 SET L109-CMND-PEN-INT-QTR-88 TO TRUE. CL*23 01270 CALL 'DTSBU109' USING L109-LINK-AREA. CL*23 01271 S109-EXIT. CL*23 01272 EXIT. CL*23 01273 S331-WRITE-MLOG. CL210 01274 CALL 'DTSBU331' USING L331-LINK-AREA. CL210 01275 S331-EXIT. CL210 01276 EXIT. CL210 01277 SKIP3 CL210 01278 CL*23 01279 S410-FILING-SCHED. DTSBX655 01280 CALL 'DTSBU410' USING L410-LINK-AREA. DTSBX655 01281 DTSBX655 01282 S410-EXIT. DTSBX655 01283 EXIT. DTSBX655 01284 SKIP3 DTSBX655 01285 S516-LIABILITY. DTSBX655 01286 CALL 'DTSBU516' USING L516-LINK-AREA DTSBX655 01287 MPRF-REC. DTSBX655 01288 DTSBX655 01289 S516-EXIT. DTSBX655 01290 EXIT. DTSBX655 01291 SKIP3 DTSBX655 01292 S910-OPEN-READ. DTSBX655 01293 SET L910-OPEN-READ-88 TO TRUE. DTSBX655 01294 GO TO S910-MSTR-IO. DTSBX655 01295 DTSBX655 01296 S910-OPEN-UPDATE-NO-AIX. DTSBX655 01297 SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE. DTSBX655 01298 GO TO S910-MSTR-IO. DTSBX655 01299 DTSBX655 01300 S910-READ. DTSBX655 01301 SET L910-READ-88 TO TRUE. DTSBX655 01302 GO TO S910-MSTR-IO. DTSBX655 01303 DTSBX655 01304 S910-START-BROWSE. DTSBX655 01305 SET L910-START-BROWSE-88 TO TRUE. DTSBX655 01306 GO TO S910-MSTR-IO. DTSBX655 01307 DTSBX655 01308 S910-READ-NEXT. DTSBX655 01309 SET L910-READ-NEXT-88 TO TRUE. DTSBX655 01310 GO TO S910-MSTR-IO. DTSBX655 01311 DTSBX655 01312 S910-COUNT. DTSBX655 01313 SET L910-COUNT-88 TO TRUE. DTSBX655 01314 GO TO S910-MSTR-IO. DTSBX655 01315 DTSBX655 01316 S910-REWRITE. DTSBX655 01317 SET L910-REWRITE-88 TO TRUE. DTSBX655 01318 GO TO S910-MSTR-IO. DTSBX655 01319 DTSBX655 01320 S910-DELETE. DTSBX655 01321 SET L910-DELETE-88 TO TRUE. DTSBX655 01322 GO TO S910-MSTR-IO. DTSBX655 01323 DTSBX655 01324 S910-CLOSE. DTSBX655 01325 SET L910-CLOSE-88 TO TRUE. DTSBX655 01326 GO TO S910-MSTR-IO. DTSBX655 01327 DTSBX655 01328 S910-MSTR-IO. DTSBX655 01329 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX655 01330 MSKL-REC. DTSBX655 01331 S910-EXIT. DTSBX655 01332 EXIT. DTSBX655 01333 SKIP3 DTSBX655 01334 S921-OPEN-READ. DTSBX655 01335 SET L921-OPEN-READ-88 TO TRUE. DTSBX655 01336 GO TO S921-AIX-IO. DTSBX655 01337 DTSBX655 01338 S921-START-BROWSE. DTSBX655 01339 SET L921-START-BROWSE-88 TO TRUE. DTSBX655 01340 GO TO S921-AIX-IO. DTSBX655 01341 DTSBX655 01342 S921-CLOSE. DTSBX655 01343 SET L921-CLOSE-88 TO TRUE. DTSBX655 01344 GO TO S921-AIX-IO. DTSBX655 01345 DTSBX655 01346 S923-CLOSE. CL183 01347 SET L923-CLOSE-88 TO TRUE. CL183 01348 GO TO S923-ATC-IO. CL183 01349 CL183 01350 S923-ATC-IO. CL183 01351 CALL 'DTSBU923' USING L923-LINK-AREA CL183 01352 ASKL-REC. CL183 01353 S923-EXIT. CL183 01354 EXIT. CL183 01355 SKIP3 CL183 01356 S921-AIX-IO. DTSBX655 01357 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX655 01358 ISKL-REC. DTSBX655 01359 S921-EXIT. DTSBX655 01360 EXIT. DTSBX655 01361 SKIP3 DTSBX655 01362 DTSBX655 01363 S923-OPEN-UPDATE. CL183 01364 SET L923-OPEN-UPDATE-88 TO TRUE. CL183 01365 GO TO S923-ATC-IO. CL183 01366 CL183 01367 SKIP3 CL183 01368 S927-OPEN-UPDATE. CL183 01369 SET L927-OPEN-UPDATE-88 TO TRUE. CL183 01370 GO TO S927-BTC-O. CL183 01371 CL183 01372 S927-WRITE. CL183 01373 SET L927-WRITE-88 TO TRUE. CL183 01374 GO TO S927-BTC-O. CL183 01375 CL183 01376 S927-CLOSE. CL183 01377 SET L927-CLOSE-88 TO TRUE. CL183 01378 GO TO S927-BTC-O. CL183 01379 CL183 01380 S927-BTC-O. CL183 01381 CALL 'DTSBU927' USING L927-LINK-AREA CL183 01382 TSKL-REC. CL183 01383 S927-EXIT. CL183 01384 EXIT. CL183 01385 CL183 01386 SKIP3 CL183 01387 S931-OPEN-READ. DTSBX655 01388 SET L931-OPEN-READ-88 TO TRUE. DTSBX655 01389 GO TO S931-REF-IO. DTSBX655 01390 DTSBX655 01391 S931-OPEN-UPDATE. DTSBX655 01392 SET L931-OPEN-UPDATE-88 TO TRUE. DTSBX655 01393 GO TO S931-REF-IO. DTSBX655 01394 DTSBX655 01395 S931-START-BROWSE. DTSBX655 01396 SET L931-START-BROWSE-88 TO TRUE. DTSBX655 01397 GO TO S931-REF-IO. DTSBX655 01398 DTSBX655 01399 S931-READ. DTSBX655 01400 SET L931-READ-88 TO TRUE. DTSBX655 01401 GO TO S931-REF-IO. DTSBX655 01402 DTSBX655 01403 S931-READ-NEXT. DTSBX655 01404 SET L931-READ-NEXT-88 TO TRUE. DTSBX655 01405 GO TO S931-REF-IO. DTSBX655 01406 DTSBX655 01407 S931-DELETE. DTSBX655 01408 SET L931-DELETE-88 TO TRUE. DTSBX655 01409 GO TO S931-REF-IO. DTSBX655 01410 DTSBX655 01411 S931-REWRITE. DTSBX655 01412 SET L931-REWRITE-88 TO TRUE. DTSBX655 01413 GO TO S931-REF-IO. DTSBX655 01414 DTSBX655 01415 S931-WRITE. DTSBX655 01416 SET L931-WRITE-88 TO TRUE. DTSBX655 01417 GO TO S931-REF-IO. DTSBX655 01418 DTSBX655 01419 S931-CLOSE. DTSBX655 01420 SET L931-CLOSE-88 TO TRUE. DTSBX655 01421 GO TO S931-REF-IO. DTSBX655 01422 DTSBX655 01423 S931-REF-IO. DTSBX655 01424 CALL 'DTSBU931' USING L931-LINK-AREA DTSBX655 01425 FSKL-REC. DTSBX655 01426 S931-EXIT. DTSBX655 01427 EXIT. DTSBX655 01428 SKIP3 DTSBX655 01429 S933-OPEN-READ. DTSBX655 01430 SET L933-OPEN-READ-88 TO TRUE. DTSBX655 01431 GO TO S933-SIC-I. DTSBX655 01432 DTSBX655 01433 S933-CLOSE. DTSBX655 01434 SET L933-CLOSE-88 TO TRUE. DTSBX655 01435 GO TO S933-SIC-I. DTSBX655 01436 DTSBX655 01437 S933-SIC-I. DTSBX655 01438 CALL 'DTSBU933' USING L933-LINK-AREA DTSBX655 01439 XSIC-REC. DTSBX655 01440 S933-EXIT. DTSBX655 01441 EXIT. DTSBX655 01442 DTSBX655 01443 S999-ABEND. DTSBX655 01444 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX655 01445 S999-EXIT. DTSBX655 01446 EXIT. DTSBX655