00001 IDENTIFICATION DIVISION. 09/24/18 00002 PROGRAM-ID. DTSBX601. DTSBX601 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV124 00004 DATE-WRITTEN. DECEMBER 1998. CL**5 00005 DATE-COMPILED. DTSBX601 00006 SKIP3 DTSBX601 00007 ***** DTSBX601 00008 * DTSBX601 00009 * FUNCTION: REPORT ALL RETURN FLAG UPDATED PRIOR DAY. CL*83 00010 * DTSBX601 00011 * DTSBX601 00012 ***** DTSBX601 00013 SKIP3 DTSBX601 00014 ENVIRONMENT DIVISION. DTSBX601 00015 SKIP2 DTSBX601 00016 CONFIGURATION SECTION. CL*74 00017 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. CL*74 00018 CL*74 00019 INPUT-OUTPUT SECTION. CL193 00020 CL*74 00021 FILE-CONTROL. CL193 00022 SELECT EXP-FILE1 ASSIGN TO DTSFX601 CL*85 00023 FILE STATUS IS EXP-STATUS. CL*85 00024 CL*74 00025 DATA DIVISION. CL*74 00026 CL*74 00027 FILE SECTION. CL193 00028 CL193 00029 FD EXP-FILE1 CL*85 00030 RECORDING MODE IS F. CL*85 00031 01 EXP-REC1 PIC X(80). CL*85 00032 EJECT CL*74 00033 CL*74 00034 WORKING-STORAGE SECTION. DTSBX601 000345 77 PAN-VALET PICTURE X(24) VALUE '124DTSBX601 09/24/18'. DTSBX601 00035 SKIP3 DTSBX601 00036 01 WRK-AREA. DTSBX601 00037 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +400.DTSBX601 00038 DTSBX601 00039 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBD400'. CL**2 00040 CL181 00041 05 WRK-RATE-TYPE-AREA. CL181 00042 10 WRK-RATE-YR-SCHED PIC X(01). CL181 00043 88 WRK-RATE-YR-ANN-88 VALUE 'Y'. CL181 00044 10 WRK-RATE-YR-MINUS-1-SCHED PIC X(01). CL181 00045 88 WRK-RATE-YR-MINUS1-ANN-88 VALUE 'Y'. CL181 00046 10 WRK-RATE-YR-MINUS-2-SCHED PIC X(01). CL181 00047 88 WRK-RATE-YR-MINUS2-ANN-88 VALUE 'Y'. CL181 00048 05 FILLER REDEFINES WRK-RATE-TYPE-AREA PIC X(03). CL181 00049 88 WRK-ESTIMATE-NEEDED-88 VALUE 'YYY' 'NYY'. CL185 00050 88 WRK-TRANSITION-YEAR-88 VALUE 'YYN' 'NYN'. CL185 00051 88 WRK-INIT-VALUES-88 VALUE 'NNN'. CL181 00052 DTSBX601 00053 05 WRK-SEQ PIC 9(05) CL*29 00054 VALUE ZERO. CL*21 00055 05 MLOG-CNT PIC 9(05) CL*86 00056 VALUE ZERO. CL*86 00057 05 WRK-ZIP PIC X(10). CL197 00058 05 FILLER REDEFINES WRK-ZIP. CL197 00059 10 WRK-ZIP5 PIC X(05). CL197 00060 10 FILLER PIC X(05). CL197 00061 CL197 00062 05 EXP-STATUS PIC X(02). CL193 00063 88 EXP-STATUS-OK-88 VALUE '00'. CL194 00064 05 WRK-ERROR-IND PIC X(01). CL193 00065 88 WRK-ERROR-YES-88 VALUE 'Y'. CL193 00066 88 WRK-ERROR-NO-88 VALUE 'N'. CL193 00067 05 WRK-MPRF-IND PIC X(01). CL*93 00068 88 MPRF-OK-YES-88 VALUE 'Y'. CL*93 00069 88 MPRF-NO-REC-88 VALUE 'N'. CL*93 00070 05 WRK-WRITE-REC-IND PIC X(01). CL225 00071 88 WRK-WRITE-REC-YES-88 VALUE 'Y'. CL225 00072 88 WRK-WRITE-REC-NO-88 VALUE 'N'. CL225 00073 05 WRK-OP-ID PIC X(08). CL236 00074 05 WRK-IND-CODE PIC X(06). CL**9 00075 05 WRK-REC1. CL193 00076 10 REC1-EMP-NO PIC 999999. CL*21 00077 10 FILLER PIC X(01) VALUE ','. CL*29 00078 10 REC1-FLAG PIC X(01). CL*99 00079 10 FILLER PIC X(01) VALUE ','. CL*33 00080 10 REC1-DATE PIC 9(08). CL100 00081 10 FILLER PIC X(01) VALUE ','. CL*44 00082 10 REC1-OPID PIC X(08). CL*99 00083 10 WRK-R1-SPACES PIC X(54). CL108 00084 05 WRK-REC1-OLD. CL*21 00085 10 REC1-BALANCE PIC --------9.99. CL*53 00086 10 REC1-LP-BAL PIC --------9.99. CL*53 00087 10 REC1-INT-BAL PIC --------9.99. CL*53 00088 10 REC1-ZIP PIC 9(05). CL*53 00089 10 REC1-ORG-TYPE PIC X(03). CL*47 00090 10 REC1-CLASS PIC X(02). CL*47 00091 10 REC1-LIAB-CD PIC X(02). CL*47 00092 10 REC1-RCVD-DATE PIC X(10). CL*44 00093 10 REC1-BATCH PIC 9(05). CL*44 00094 10 REC1-ITEM PIC 9(03). CL*44 00095 10 REC1-LP-CHG PIC --------9.99. CL*44 00096 10 REC1-INT-CHG PIC --------9.99. CL*37 00097 10 REC1-SOURCE PIC X(02). CL*31 00098 10 REC1-MLOG-DATE PIC X(10). CL**8 00099 10 REC1-IND-CODE PIC X(06). CL**8 00100 10 REC1-OP-ID PIC X(08). CL**8 00101 10 REC1-LIAB-DATE PIC X(10). CL**8 00102 10 REC1-ASSIGN PIC 9(09). CL**5 00103 10 REC1-COUNT PIC 9(07). CL**5 00104 10 REC1-DEPOSIT-DATE PIC X(10). CL253 00105 10 REC1-PROCESS-DATE PIC X(10). CL253 00106 10 REC1-LIAB-ENTER-DATE PIC X(10). CL232 00107 10 REC1-INACT-CODE PIC X(05). CL235 00108 88 REC1-INACT-YES-88 VALUE 'INACT'. CL235 00109 88 REC1-INACT-NO-88 VALUE 'ACT '. CL235 00110 10 REC1-REACT PIC X(05). CL235 00111 88 REC1-REACT-NO-88 VALUE 'NEW '. CL235 00112 88 REC1-REACT-YES-88 VALUE 'REACT'. CL235 00113 10 REC1-CREDIT PIC --------9.99. CL249 00114 10 REC1-AREA PIC X(03). CL249 00115 10 REC1-PFX PIC X(03). CL249 00116 10 REC1-SFX PIC X(04). CL249 00117 10 REC1-EXT PIC X(05). CL249 00118 10 REC1-PAY-TYPE PIC X(02). CL225 00119 10 REC1-AMT PIC --------9.99. CL225 00120 05 WRK-ABS-QTR1 PIC S9(04) COMP-3 CL206 00121 VALUE +0. CL206 00122 05 WRK-ABS-QTR2 PIC S9(04) COMP-3 CL206 00123 VALUE +0. CL206 00124 05 WRK-ABS-DATE1 PIC S9(08) COMP. CL**1 00125 05 WRK-ABS-DATE2 PIC S9(08) COMP. CL**1 00126 05 WRK-EXT-CURRENT-DATE PIC S9(09) COMP-3. CL*84 00127 05 WRK-DIFF PIC S9(07) COMP-3. CL*84 00128 05 WRK-UNDER-30-CNT PIC S9(04) COMP-3 CL*19 00129 VALUE +0. CL220 00130 05 WRK-OVER-31-CNT PIC S9(04) COMP-3 CL*19 00131 VALUE +0. CL220 00132 05 WRK-MEVL-READ-CNT PIC S9(04) COMP-3 CL*72 00133 VALUE +0. CL*72 00134 05 WRK-MPRF-CNT PIC S9(07) COMP-3. CL220 00135 05 WRK-FISCAL-AGENT-CD PIC X(03). CL239 00136 05 WRK-BNK-IND PIC X(02). CL*38 00137 05 WRK-FIRST-NEW-EMP-NO PIC S9(07) COMP-3. CL101 00138 *& VALUE +123778. CL101 00139 05 WRK-FEIN PIC 9(09). CL104 00140 05 WRK-MQTR-BAL PIC S9(11)V99 COMP-3 VALUE +0. CL136 00141 05 WRK-MQTR-CHG PIC S9(09)V99 COMP-3. CL**6 00142 05 WRK-MQTR-ANN-BAL PIC S9(07)V99 COMP-3. CL234 00143 05 WRK-MQTR-PEN-BAL PIC S9(07)V99 COMP-3. CL**1 00144 05 WRK-MQTR-PEN-CHG PIC S9(07)V99 COMP-3. CL*34 00145 05 WRK-MQTR-INT-BAL PIC S9(07)V99 COMP-3. CL**1 00146 05 WRK-MQTR-INT-CHG PIC S9(07)V99 COMP-3. CL*34 00147 05 WRK-RECEIVED-DATE PIC S9(09) COMP-3. CL*18 00148 05 WRK-RPT-BAL-CNT PIC S9(07) COMP-3. CL*18 00149 05 WRK-RPT-CNT PIC S9(07) COMP-3. CL195 00150 05 WRK-BAL-CNT PIC S9(07) COMP-3. CL195 00151 05 WRK-REL-CNT PIC S9(07) COMP-3. CL195 00152 05 WRK-RATED-CNT PIC S9(07) COMP-3. CL*99 00153 05 WRK-SELF-INS-CNT PIC S9(07) COMP-3. CL*99 00154 05 WRK-HOTEL-CNT PIC S9(07) COMP-3 VALUE +0. CL251 00155 05 WRK-TOT-EMPS PIC S9(07) COMP-3 VALUE +0. CL251 00156 05 WRK-TOT-WORKERS PIC S9(11) COMP-3 VALUE +0. CL251 00157 05 WRK-PURSUED-RPT-CNT PIC S9(07) COMP-3. CL205 00158 05 WRK-LATE-RPT-CNT PIC S9(07) COMP-3. CL104 00159 05 WRK-MEVL-DELETED-CNT PIC S9(07) COMP-3. CL*61 00160 05 WRK-UC30-SENT-CNT PIC S9(07) COMP-3. CL188 00161 05 WRK-UC30-RCVD-CNT PIC S9(07) COMP-3. CL188 00162 05 WRK-OVER-1000-CNT PIC S9(07) COMP-3. CL*42 00163 05 WRK-UNDER-1000-CNT PIC S9(07) COMP-3. CL*42 00164 05 WRK-HOUSEHOLD-PAYMENTS PIC S9(11)V99 COMP-3. CL*43 00165 05 WRK-TOT-WAGES PIC S9(11)V99 COMP-3. CL*43 00166 05 WRK-ALL-BNK-RATED PIC S9(11)V99 COMP-3. CL154 00167 05 WRK-OPN-BNK-RATED PIC S9(11)V99 COMP-3. CL154 00168 05 WRK-ALL-BNK-SI PIC S9(11)V99 COMP-3. CL154 00169 05 WRK-OPN-BNK-SI PIC S9(11)V99 COMP-3. CL154 00170 05 WRK-BOND-AMT PIC S9(11)V99 COMP-3. CL142 00171 05 WRK-OVER-100-CNT PIC S9(07) COMP-3 CL112 00172 VALUE +0. CL112 00173 05 WRK-OVER-100-AMT PIC S9(11)V99 COMP-3 CL112 00174 VALUE +0. CL112 00175 05 WRK-1-10-CNT PIC S9(07) COMP-3 CL113 00176 VALUE +0. CL112 00177 05 WRK-1-10-AMT PIC S9(11)V99 COMP-3 CL112 00178 VALUE +0. CL112 00179 05 WRK-11-100-CNT PIC S9(07) COMP-3 CL113 00180 VALUE +0. CL112 00181 05 WRK-11-100-AMT PIC S9(11)V99 COMP-3 CL112 00182 VALUE +0. CL112 00183 05 WRK-OVER-100-WRKRS PIC S9(07) COMP-3. CL190 00184 05 WRK-100-249-CNT PIC S9(07) COMP-3. CL*47 00185 05 WRK-100-249-WRKRS PIC S9(07) COMP-3. CL*56 00186 05 WRK-50-100-CNT PIC S9(07) COMP-3. CL190 00187 05 WRK-50-100-WRKRS PIC S9(07) COMP-3. CL190 00188 05 WRK-25-49-CNT PIC S9(07) COMP-3. CL*59 00189 05 WRK-25-49-WRKRS PIC S9(07) COMP-3. CL190 00190 05 WRK-10-24-CNT PIC S9(07) COMP-3. CL190 00191 05 WRK-10-24-WRKRS PIC S9(07) COMP-3. CL190 00192 05 WRK-6-9-CNT PIC S9(07) COMP-3. CL225 00193 05 WRK-5-9-WRKRS PIC S9(07) COMP-3. CL*94 00194 05 WRK-5-CNT PIC S9(07) COMP-3. CL*97 00195 05 WRK-4-CNT PIC S9(07) COMP-3. CL*97 00196 05 WRK-3-CNT PIC S9(07) COMP-3. CL*97 00197 05 WRK-2-CNT PIC S9(07) COMP-3. CL*97 00198 05 WRK-1-CNT PIC S9(07) COMP-3. CL*97 00199 05 WRK-UNDER-5-CNT PIC S9(07) COMP-3. CL*94 00200 05 WRK-UNDER-5-WRKRS PIC S9(07) COMP-3. CL*94 00201 05 WRK-UNDER-10-CNT PIC S9(07) COMP-3. CL*47 00202 05 WRK-OVER-10-CNT PIC S9(07) COMP-3. CL225 00203 05 WRK-UNDER-10-WRKRS PIC S9(07) COMP-3. CL*56 00204 05 WRK-NO-EMPS-CNT PIC S9(07) COMP-3. CL*52 00205 05 WRK-MRCT-TOT-WAGES PIC S9(11)V99 COMP-3. CL*72 00206 05 WRK-MRCT-TAX-WAGES PIC S9(11)V99 COMP-3. CL*72 00207 05 WRK-MRCT-UI-PAID PIC S9(11)V99 COMP-3. CL*72 00208 05 WRK-TOT-UI PIC S9(11)V99 COMP-3. CL**6 00209 05 WRK-TOT-INT PIC S9(11)V99 COMP-3. CL**6 00210 05 WRK-TOT-PEN PIC S9(11)V99 COMP-3. CL**6 00211 05 WRK-MQTR-ANN-TOT-WAGE PIC S9(12)V99 COMP-3. CL*84 00212 05 WRK-MQTR-ANN-TAX-WAGE PIC S9(12)V99 COMP-3. CL*84 00213 05 WRK-MJRN-TOT-NEG-CHG PIC S9(11)V99 COMP-3 CL252 00214 VALUE +0. CL252 00215 05 WRK-MQTR-TOT-UI-CHARGED PIC S9(11)V99 COMP-3. CL*76 00216 05 WRK-START-DATE PIC S9(09) COMP-3. CL*10 00217 05 WRK-END-DATE PIC S9(09) COMP-3. CL*10 00218 05 WRK-LIAB-DATE PIC S9(09) COMP-3. CL*71 00219 05 WRK-FIRST-LIAB-DATE PIC S9(09) COMP-3. CL*71 00220 05 WRK-ALL-NINES-DATE PIC S9(09) COMP-3 CL*71 00221 VALUE +999999999. CL*71 00222 05 WRK-BNK-PETITION-DATE PIC 9(08). CL*89 00223 05 FILLER REDEFINES WRK-BNK-PETITION-DATE. CL*89 00224 10 WRK-BNK-PETITION-DATE-YYYY PIC 9(04). CL*89 00225 10 WRK-BNK-PETITION-DATE-MM PIC 9(02). CL*89 00226 10 WRK-BNK-PETITION-DATE-DD PIC 9(02). CL*89 00227 05 WRK-BNK-PETITION-YRQ PIC 9(05). CL*89 00228 05 FILLER REDEFINES WRK-BNK-PETITION-YRQ. CL*89 00229 10 WRK-BNK-PETITION-YRQ-YYYY PIC 9(04). CL*89 00230 10 WRK-BNK-PETITION-YRQ-Q PIC 9(01). CL*89 00231 05 WRK-BNK-FIRST-BILL-YRQ PIC S9(05) COMP-3. CL*89 00232 05 WRK-EST-RPT-IND PIC X(01). CL*90 00233 88 WRK-EST-RPT-YES VALUE 'Y'. CL*90 00234 88 WRK-EST-RPT-NO VALUE 'N'. CL*90 00235 CL*19 00236 05 WRK-ZERO-FOUND-IND PIC X(01). CL100 00237 88 WRK-ZERO-FOUND-YES-88 VALUE 'Y'. CL100 00238 88 WRK-ZERO-FOUND-NO-88 VALUE 'N'. CL100 00239 CL*41 00240 05 WRK-WITHDRAWN-IND PIC X(01). CL*41 00241 88 WRK-WITHDRAWN-YES VALUE 'Y'. CL*41 00242 88 WRK-WITHDRAWN-NO VALUE 'N'. CL*41 00243 CL153 00244 05 WRK-ORIG-IND PIC X(01). CL153 00245 88 WRK-ORIG-YES VALUE 'Y'. CL153 00246 88 WRK-ORIG-NO VALUE 'N'. CL153 00247 CL*72 00248 05 WRK-MQTR-CNT PIC S9(07) COMP-3. CL**9 00249 05 WRK-MRPT-CNT PIC S9(07) COMP-3. CL191 00250 05 WRK-MSOL-CNT PIC S9(07) COMP-3. CL*32 00251 05 WRK-MLIN-CNT PIC S9(07) COMP-3. CL118 00252 05 WRK-MFAS-CNT PIC S9(07) COMP-3. CL198 00253 05 WRK-MFAE-CNT PIC S9(07) COMP-3. CL237 00254 05 WRK-MPAY-CNT PIC S9(07) COMP-3. CL150 00255 05 WRK-MADJ-CNT PIC S9(07) COMP-3. CL153 00256 05 WRK-MJRN-CNT PIC S9(08) COMP-3. CL155 00257 05 WRK-MERA-CNT PIC S9(08) COMP-3. CL231 00258 05 WRK-MRTE-CNT PIC S9(08) COMP-3. CL**9 00259 05 WRK-MRTE-CNT1 PIC S9(08) COMP-3. CL163 00260 05 WRK-MLOG-CNT PIC S9(08) COMP-3. DTSBX601 00261 05 WRK-MFSC-CNT PIC S9(08) COMP-3 CL*40 00262 VALUE +0. CL*40 00263 05 WRK-CR-TOL-CNT PIC S9(07) COMP-3. CL146 00264 05 SUB PIC S9(04) COMP. CL147 00265 05 RPT-SUB PIC S9(04) COMP. CL147 00266 05 QTR-SUB PIC S9(04) COMP. CL113 00267 05 WRK-QTR-AREA OCCURS 20 TIMES. CL113 00268 10 WRK-QTR-YRQ PIC S9(05) COMP-3. CL113 00269 10 WRK-QTR-CHG PIC S9(09)V99 COMP-3. CL113 00270 10 WRK-QTR-PAID PIC S9(09)V99 COMP-3. CL113 00271 10 WRK-QTR-WAIVED PIC S9(09)V99 COMP-3. CL113 00272 10 WRK-QTR-TOLERATED PIC S9(09)V99 COMP-3. CL113 00273 05 WRK-TIMELY-PMT-AREA. CL190 00274 10 WRK-PEN-INT-BAL-CNT PIC S9(07) COMP-3. CL181 00275 10 WRK-INT-MANUAL-CNT PIC S9(07) COMP-3. CL181 00276 10 WRK-QTR-TAX-BAL PIC S9(09)V9(02) COMP-3. CL170 00277 10 WRK-QTR-TAX-CHG PIC S9(09)V9(02) COMP-3. CL170 00278 10 WRK-QTR-INT-PEN-BAL PIC S9(09)V9(02) COMP-3. CL170 00279 10 WRK-AVG-PMT PIC S9(09)V9(02) COMP-3. CL116 00280 10 WRK-TIMELY-PMT PIC S9(09)V9(02) COMP-3. CL133 00281 10 WRK-OLD-PEN-CHG PIC S9(09)V9(02) COMP-3. CL132 00282 CL170 00283 05 WRK-YRQ PIC S9(05) COMP-3 CL171 00284 VALUE +20041. CL*51 00285 05 WRK-PCT PIC S9(03)V9(04) COMP-3 CL142 00286 VALUE +0. CL142 00287 05 WRK-AVG-PCT PIC S9(09)V9(04) COMP-3 CL142 00288 VALUE +0. CL142 00289 05 WRK-PCT-DISP PIC Z(02)9.9999. CL118 00290 05 WRK-PCT-DISP1 PIC Z(02)9.9999. CL119 00291 05 WRK-UI-RATE PIC S9(01)V9(04) COMP-3. CL118 00292 05 DISP-UI-RATE1 PIC 9.9(04). CL135 00293 05 DISP-UI-RATE2 PIC 9.9(04). CL135 00294 05 AMT-DISP PIC ---,---,--9.99. CL242 00295 05 WRK-AMT-DISP PIC --------9.99. CL*82 00296 05 AMT-DISP1 PIC Z(11)9.99-. CL102 00297 05 AMT-DISP2 PIC Z(11)9.99-. CL141 00298 05 AMT-DISP3 PIC Z(11)9-. CL237 00299 05 EMP-ACCT-DISP PIC 9(06). CL183 00300 05 EMP-SUCC-DISP PIC 9(06). CL*86 00301 05 EMP-SUCC-DISP-X REDEFINES EMP-SUCC-DISP CL*88 00302 PIC X(06). CL*87 00303 05 DISP-DATE1 PIC X(10). CL232 00304 05 DISP-DATE2 PIC X(10). CL232 00305 05 INACT-LBL PIC X(10). CL*71 00306 05 WRK-MPRF-IND PIC X(01). CL*42 00307 88 WRK-MPRF-OK VALUE 'Y'. CL*42 00308 88 WRK-MPRF-NO-REC VALUE 'N'. CL*42 00309 05 WRK-MQTR-IND PIC X(01). CL*42 00310 88 WRK-MQTR-OK VALUE 'Y'. CL*42 00311 88 WRK-MQTR-NO-REC VALUE 'N'. CL*42 00312 05 WRK-MRPT-IND PIC X(01). CL*77 00313 88 WRK-MRPT-OK VALUE 'Y'. CL*77 00314 88 WRK-MRPT-NO-REC VALUE 'N'. CL*77 00315 05 WRK-MDST-IND PIC X(01). CL169 00316 88 WRK-MDST-OK VALUE 'Y'. CL169 00317 88 WRK-MDST-NO-REC VALUE 'N'. CL169 00318 05 WRK-MEVL-IND PIC X(01). CL111 00319 88 WRK-MEVL-OK VALUE 'Y'. CL111 00320 88 WRK-MEVL-NO-REC VALUE 'N'. CL111 00321 05 WRK-MLIN-IND PIC X(01). CL116 00322 88 WRK-MLIN-OK VALUE 'Y'. CL116 00323 88 WRK-MLIN-NO-REC VALUE 'N'. CL116 00324 05 WRK-MFAS-IND PIC X(01). CL198 00325 88 WRK-MFAS-OK VALUE 'Y'. CL198 00326 88 WRK-MFAS-NO-REC VALUE 'N'. CL198 00327 05 WRK-MFAE-IND PIC X(01). CL237 00328 88 WRK-MFAE-OK VALUE 'Y'. CL237 00329 88 WRK-MFAE-NO-REC VALUE 'N'. CL237 00330 05 WRK-MSOL-IND PIC X(01). CL237 00331 88 WRK-MSOL-OK VALUE 'Y'. CL160 00332 88 WRK-MSOL-NO-REC VALUE 'N'. CL160 00333 05 WRK-MLOG-IND PIC X(01). DTSBX601 00334 88 WRK-MLOG-OK VALUE 'Y'. DTSBX601 00335 88 WRK-MLOG-NO-REC VALUE 'N'. DTSBX601 00336 88 WRK-MLOG-COMPLETE VALUE 'C'. DTSBX601 00337 05 WRK-MRPT-FOUND-IND PIC X(01). CL*96 00338 88 WRK-MRPT-FOUND-YES VALUE 'Y'. CL*98 00339 88 WRK-MRPT-FOUND-NO VALUE 'N'. CL*98 00340 05 WRK-CR-TOL-IND PIC X(01). CL146 00341 88 WRK-CR-TOL-YES VALUE 'Y'. CL146 00342 88 WRK-CR-TOL-NO VALUE 'N'. CL146 00343 05 WRK-DUP-FOUND-IND PIC X(01). CL193 00344 88 WRK-DUP-FOUND-YES VALUE 'Y'. CL193 00345 88 WRK-DUP-FOUND-NO VALUE 'N'. CL193 00346 05 WRK-LAST-MRPT-TYPE PIC X(02). CL*77 00347 05 WRK-DISP-AREA. CL216 00348 10 WRK-DISP-STAR PIC X(01). CL216 00349 10 FILLER PIC X(01) VALUE SPACE. CL216 00350 10 WRK-DISP-AMT PIC Z(10)9.99-. CL216 00351 CL**9 00352 05 WRK-INACT-DATE PIC S9(09) COMP-3 CL184 00353 VALUE +0. CL184 00354 05 WRK-INACT-CODE PIC X(02). CL232 00355 05 WRK-INACT-YRQ PIC S9(05) COMP-3 CL184 00356 VALUE +0. CL184 00357 05 WRK-LAST-YRQ PIC S9(05) COMP-3 CL184 00358 VALUE +0. CL184 00359 05 WRK-FIRST-LIAB-YRQ PIC S9(05) COMP-3 CL232 00360 VALUE +0. CL217 00361 05 WRK-LAST-LIAB-YRQ PIC S9(05) COMP-3 CL232 00362 VALUE +0. CL232 00363 05 WRK-NEXT-YRQ PIC S9(05) COMP-3 CL196 00364 VALUE +0. CL196 00365 05 WRK-UPDATED-CNT PIC S9(07) COMP-3. DTSBX601 00366 DTSBX601 00367 05 PARM-REC-CNT PIC S9(07) COMP-3. DTSBX601 00368 DTSBX601 00369 05 PARM-EOF-IND PIC X(01). DTSBX601 00370 DTSBX601 00371 05 WRK-EMP-NO PIC 9(06). CL*31 00372 DTSBX601 00373 05 WRK-TRACE-IND PIC X(01). DTSBX601 00374 DTSBX601 00375 05 WRK-MST-OPEN-IND PIC X(01). DTSBX601 00376 DTSBX601 00377 05 WRK-REF-OPEN-IND PIC X(01). DTSBX601 00378 CL221 00379 05 WRK-SIC-SCAN-AREA. CL221 00380 10 WRK-RPT-FOUND-IND PIC X(01). CL222 00381 88 WRK-RPT-FOUND-YES VALUE 'Y'. CL222 00382 88 WRK-RPT-FOUND-NO VALUE 'N'. CL222 00383 10 WRK-EMPL-CNT PIC S9(07) COMP-3. CL222 00384 10 WRK-SIC-4 PIC X(04). CL221 00385 10 FILLER REDEFINES WRK-SIC-4. CL221 00386 15 WRK-SIC-3 PIC X(03). CL221 00387 15 FILLER PIC X(01). CL221 00388 10 WRK-NO-SIC-CNT PIC S9(07) COMP-3. CL221 00389 10 WRK-SIC-7911-AREA. CL221 00390 15 WRK-SIC-7911-WORKERS PIC S9(07) COMP-3. CL224 00391 15 WRK-SIC-7911-BUSINESSES PIC S9(07) COMP-3. CL224 00392 10 WRK-SIC-794-AREA. CL221 00393 15 WRK-SIC-794-WORKERS PIC S9(07) COMP-3. CL221 00394 15 WRK-SIC-794-BUSINESSES PIC S9(07) COMP-3. CL221 00395 10 WRK-SIC-799-AREA. CL221 00396 15 WRK-SIC-799-WORKERS PIC S9(07) COMP-3. CL221 00397 15 WRK-SIC-799-BUSINESSES PIC S9(07) COMP-3. CL221 00398 10 WRK-SIC-8351-AREA. CL221 00399 15 WRK-SIC-8351-WORKERS PIC S9(07) COMP-3. CL221 00400 15 WRK-SIC-8351-BUSINESSES PIC S9(07) COMP-3. CL221 00401 10 WRK-SIC-8641-AREA. CL221 00402 15 WRK-SIC-8641-WORKERS PIC S9(07) COMP-3. CL221 00403 15 WRK-SIC-8641-BUSINESSES PIC S9(07) COMP-3. CL221 00404 10 WRK-NAICS-6 PIC X(06). CL217 00405 10 FILLER REDEFINES WRK-NAICS-6. CL217 00406 15 WRK-NAICS-2 PIC X(02). CL217 00407 15 FILLER PIC X(04). CL217 00408 *RW1 CL*74 00409 05 WRK-ABEND-MSG PIC X(60) VALUE SPACES. CL*74 00410 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. CL*74 00411 05 WS-NUMBER-ONE PIC S9(05) COMP-3 VALUE +0. CL*74 00412 CL*80 00413 05 DISP-DATE PIC X(08). CL*80 00414 05 DISP-TIME PIC X(08). CL*81 00415 CL*79 00416 05 WS-LINE-CNT PIC S9(02) COMP-3 VALUE 60. CL*74 00417 05 WS-LINE-CNT2 PIC S9(02) COMP-3 VALUE +0. CL*74 00418 05 WS-PAGE-CNT PIC S9(03) COMP-3 VALUE +0. CL*74 00419 CL*74 00420 01 HEADER-1. CL*74 00421 05 FILLER PIC X(01) VALUE SPACES. CL*74 00422 05 FILLER PIC X(49) VALUE '016R1'. CL*79 00423 05 FILLER PIC X(60) VALUE CL*74 00424 'DISTRICT OF COLUMBIA'. CL*74 00425 05 FILLER PIC X(06) VALUE 'DATE:'. CL*74 00426 05 HDR1-LRCM-SYS-DATE PIC X(08). CL*74 00427 CL*74 00428 01 HEADER-2. CL*74 00429 05 FILLER PIC X(54) VALUE SPACES. CL*74 00430 05 FILLER PIC X(56) VALUE CL*74 00431 'TAX DIVISION'. CL*74 00432 05 FILLER PIC X(06) VALUE 'TIME:'. CL*74 00433 05 HDR2-LRCM-SYS-TIME PIC X(08). CL*74 00434 CL*74 00435 01 HEADER-3. CL*74 00436 05 FILLER PIC X(01) VALUE SPACES. CL*74 00437 05 FILLER PIC X(38) VALUE CL*74 00438 'ROUTE TO: ACCOUNTING UNIT'. CL*74 00439 05 HDR3-LITERAL PIC X(43) VALUE CL*74 00440 ' EMPLOYERS REGISTERED SINCE 09/11/01 '. CL*82 00441 05 FILLER PIC X(28) VALUE SPACES. CL*74 00442 05 FILLER PIC X(06) VALUE 'PAGE:'. CL*74 00443 05 HDR3-PAGE PIC ZZ,ZZ9. CL*74 00444 CL*74 00445 01 HEADER-4. CL*82 00446 05 FILLER PIC X(01) VALUE SPACES. CL*74 00447 05 FILLER PIC X(132) VALUE SPACES. CL*74 00448 CL*74 00449 01 HEADER-5. CL*82 00450 05 FILLER PIC X(01) VALUE SPACES. CL*74 00451 05 FILLER PIC X(05) VALUE SPACES. CL*74 00452 05 FILLER PIC X(06) VALUE CL*74 00453 'EMP NO'. CL*74 00454 05 FILLER PIC X(05) VALUE SPACES. CL*74 00455 05 FILLER PIC X(12) VALUE CL*74 00456 'PRIMARY NAME'. CL*74 00457 05 FILLER PIC X(28) VALUE SPACES. CL*74 00458 05 FILLER PIC X(04) VALUE SPACES. CL*74 00459 05 FILLER PIC X(14) VALUE CL*82 00460 'LIABILITY DATE'. CL*82 00461 05 FILLER PIC X(04) VALUE SPACES. CL*82 00462 05 FILLER PIC X(13) VALUE CL*82 00463 'INACTIVE DATE'. CL*82 00464 05 FILLER PIC X(12) VALUE SPACES. CL*74 00465 05 FILLER PIC X(18) VALUE SPACES. CL*74 00466 CL*74 00467 01 HEADER-6. CL*82 00468 05 FILLER PIC X(01) VALUE SPACES. CL*74 00469 05 FILLER PIC X(132) VALUE SPACES. CL*74 00470 CL*74 00471 01 DETAIL-LINE-1. CL*74 00472 05 FILLER PIC X(05) VALUE SPACES. CL*77 00473 05 WS-EMP-NO PIC 999B999. CL*74 00474 05 FILLER PIC X(02) VALUE SPACES. CL*77 00475 05 WS-PRIMARY-NAME PIC X(40). CL*74 00476 05 FILLER PIC X(02) VALUE SPACES. CL*77 00477 05 WS-DATE1 PIC X(10). CL*77 00478 05 FILLER PIC X(02) VALUE SPACES. CL*77 00479 05 WS-DATE2 PIC X(10). CL*77 00480 * 05 FILLER PIC X(05) VALUE SPACES. CL*77 00481 * 05 WS-BALANCE-AMT PIC ZZZ,ZZZ,ZZ9.99. CL*77 00482 * 05 FILLER PIC X(09) VALUE SPACES. CL*77 00483 * 05 WS-PURSUED-RPT PIC ZZ9. CL*77 00484 * 05 FILLER PIC X(10) VALUE SPACES. CL*77 00485 * 05 WS-DPC PIC X(01). CL*77 00486 * 05 FILLER PIC X(06) VALUE SPACES. CL*77 00487 * 05 WS-LIEN PIC X(01). CL*77 00488 * 05 FILLER PIC X(21) VALUE SPACES. CL*77 00489 CL*74 00490 01 FOOTING-LINE-1 PIC X(133) VALUE SPACES. CL*74 00491 01 FOOTING-LINE-2 PIC X(133) VALUE SPACES. CL*74 00492 CL*74 00493 01 FOOTING-LINE-3. CL*74 00494 05 FILLER PIC X(25) VALUE SPACES. CL*74 00495 05 WS-FOOTING-CNT PIC ZZ,ZZ9. CL*74 00496 05 FILLER PIC X(02) VALUE SPACES. CL*74 00497 05 FILLER PIC X(43) VALUE CL*74 00498 'DEBIT WRITE OFF CANDIDATES LISTED ON REPORT'. CL*74 00499 05 FILLER PIC X(23) VALUE SPACES. CL*74 00500 01 FOOTING-LINE-4 PIC X(133) VALUE SPACES. CL*74 00501 01 FOOTING-LINE-5 PIC X(133) VALUE SPACES. CL*74 00502 01 FOOTING-LINE-6. CL*74 00503 05 FILLER PIC X(25) VALUE SPACES. CL*74 00504 05 FILLER PIC X(17) VALUE CL*74 00505 '*** END OF REPORT'. CL*74 00506 *RW2 CL*74 00507 CL*74 00508 01 L001-LINK-AREA. CL232 00509 ++INCLUDE DTSIL001 CL232 00510 EJECT CL232 00511 01 L005-COMM-AREA. CL*81 00512 ++INCLUDE DTSIL005 CL*79 00513 EJECT CL*79 00514 01 L102-LINK-AREA. CL133 00515 ++INCLUDE DTSIL102 CL133 00516 EJECT CL133 00517 01 L054-LINK-AREA. CL206 00518 ++INCLUDE DTSIL054 CL206 00519 EJECT DTSBX601 00520 01 L410-LINK-AREA. CL*46 00521 ++INCLUDE DTSIL410 CL*46 00522 EJECT CL*46 00523 01 L600-LINK-AREA. CL*86 00524 ++INCLUDE DTSIL600 CL*86 00525 EJECT CL*86 00526 01 L910-LINK-AREA. DTSBX601 00527 ++INCLUDE DTSIL910 CL**2 00528 EJECT DTSBX601 00529 01 MSKL-REC. DTSBX601 00530 ++INCLUDE DTSIMSKL CL**2 00531 EJECT DTSBX601 00532 01 MHDR-REC. CL**9 00533 ++INCLUDE DTSIMHDR CL**2 00534 EJECT DTSBX601 00535 01 MPRF-REC. CL**9 00536 ++INCLUDE DTSIMPRF CL**9 00537 EJECT DTSBX601 00538 01 MQTR-REC. CL**9 00539 ++INCLUDE DTSIMQTR CL**9 00540 EJECT CL**9 00541 01 MRPT-REC. CL*70 00542 ++INCLUDE DTSIMRPT CL*70 00543 EJECT CL*70 00544 01 MSOL-REC. CL*53 00545 ++INCLUDE DTSIMSOL CL*53 00546 EJECT CL*56 00547 01 MRCT-REC. CL*56 00548 ++INCLUDE DTSIMRCT CL*56 00549 EJECT DTSBX601 00550 01 MEVL-REC. CL111 00551 ++INCLUDE DTSIMEVL CL111 00552 EJECT CL111 00553 01 MLIN-REC. CL116 00554 ++INCLUDE DTSIMLIN CL116 00555 EJECT CL116 00556 01 MRTE-REC. CL137 00557 ++INCLUDE DTSIMRTE CL137 00558 EJECT CL137 00559 01 MDST-REC. CL144 00560 ++INCLUDE DTSIMDST CL144 00561 EJECT CL144 00562 01 MPAY-REC. CL151 00563 ++INCLUDE DTSIMPAY CL151 00564 EJECT CL151 00565 01 MADJ-REC. CL153 00566 ++INCLUDE DTSIMADJ CL153 00567 EJECT CL153 00568 01 MJRN-REC. CL155 00569 ++INCLUDE DTSIMJRN CL155 00570 EJECT CL155 00571 01 MERA-REC. CL157 00572 ++INCLUDE DTSIMERA CL157 00573 EJECT CL157 00574 01 MCOL-REC. CL*91 00575 ++INCLUDE DTSIMCOL CL*91 00576 EJECT CL*91 00577 01 MFAS-REC. CL253 00578 ++INCLUDE DTSIMFAS CL253 00579 EJECT CL198 00580 01 MFAE-REC. CL237 00581 ++INCLUDE DTSIMFAE CL237 00582 EJECT CL237 00583 01 MLOG-REC. DTSBX601 00584 ++INCLUDE DTSIMLOG DTSBX601 00585 EJECT DTSBX601 00586 01 MOPO-REC. CL*85 00587 ++INCLUDE DTSIMOPO CL*85 00588 EJECT CL*85 00589 01 MTAD-REC. CL193 00590 ++INCLUDE DTSIMTAD CL193 00591 EJECT CL*86 00592 01 MTAA-REC. CL193 00593 ++INCLUDE DTSIMTAA CL193 00594 EJECT CL193 00595 01 MBAA-REC. CL227 00596 ++INCLUDE DTSIMBAA CL227 00597 EJECT CL227 00598 01 MFSC-REC. CL*39 00599 ++INCLUDE DTSIMFSC CL*39 00600 EJECT CL*39 00601 01 MERD-REC. CL*22 00602 ++INCLUDE DTSIMERD CL*22 00603 EJECT CL*22 00604 01 L921-LINK-AREA. CL*89 00605 ++INCLUDE DTSIL921 CL*89 00606 EJECT CL*89 00607 01 ISKL-REC. CL*89 00608 ++INCLUDE DTSIISKL CL*89 00609 EJECT CL*89 00610 01 L931-LINK-AREA. CL132 00611 ++INCLUDE DTSIL931 CL132 00612 EJECT CL132 00613 01 FSKL-REC. CL132 00614 ++INCLUDE DTSIFSKL CL132 00615 EJECT CL132 00616 01 FQTR-REC. CL132 00617 ++INCLUDE DTSIFQTR CL132 00618 EJECT CL132 00619 01 FFIS-REC. CL239 00620 ++INCLUDE DTSIFFIS CL239 00621 EJECT CL239 00622 01 L004-COMM-AREA. CL239 00623 ++INCLUDE DTSIL004 CL183 00624 CL*53 00625 01 L061-LINK-AREA. CL*54 00626 ++INCLUDE DTSIL061 CL*53 00627 EJECT CL*53 00628 01 L516-LINK-AREA. CL185 00629 ++INCLUDE DTSIL516 CL185 00630 EJECT CL185 00631 PROCEDURE DIVISION. CL183 00632 SKIP2 DTSBX601 00633 PERFORM I0000-INITIATE THRU I0000-EXIT. CL**5 00634 IF WRK-ERROR-NO-88 CL193 00635 PERFORM P0000-PROCESS THRU P0000-EXIT CL193 00636 PERFORM T0000-TERMINATE THRU T0000-EXIT. CL193 00637 SKIP2 DTSBX601 00638 GOBACK. DTSBX601 00639 EJECT DTSBX601 00640 I0000-INITIATE. CL**5 00641 SKIP2 CL**5 00642 MOVE 'N' TO WRK-TRACE-IND. CL**8 00643 SET WRK-ERROR-NO-88 TO TRUE. CL193 00644 DTSBX601 00645 PERFORM I2000-OPEN-FILES-1 THRU I2000-EXIT. CL**5 00646 CL113 00647 SKIP2 DTSBX601 00648 I0000-EXIT. CL**7 00649 EXIT. CL**7 00650 I2000-OPEN-FILES-1. DTSBX601 00651 OPEN OUTPUT EXP-FILE1. CL*86 00652 IF NOT EXP-STATUS-OK-88 CL*86 00653 DISPLAY 'CANNOT OPEN EXP FILE ' EXP-STATUS CL*86 00654 SET WRK-ERROR-YES-88 TO TRUE CL*86 00655 GO TO I2000-EXIT. CL*86 00656 MOVE WRK-TRACE-IND TO L910-TRACE-IND. CL**5 00657 CL**3 00658 MOVE WRK-MOD-NAME TO L910-MOD-NAME. CL**5 00659 DTSBX601 00660 PERFORM S910-OPEN-READ THRU S910-EXIT. CL*68 00661 ** PERFORM S910-OPEN-UPDATE-NO-AIX THRU S910-EXIT. CL*68 00662 CL*89 00663 PERFORM S921-OPEN-READ THRU S921-EXIT. CL*68 00664 DTSBX601 00665 PERFORM S931-OPEN-READ THRU S931-EXIT. CL*68 00666 *** PERFORM S931-OPEN-UPDATE THRU S931-EXIT. CL*34 00667 MOVE LOW-VALUES TO MSKL-KEY-AREA. CL*84 00668 CL*84 00669 MOVE +0 TO MSKL-EMP-NO. CL*84 00670 CL*84 00671 SET MSKL-HDR-88 TO TRUE. CL*84 00672 CL*84 00673 PERFORM S910-READ THRU S910-EXIT. CL*84 00674 CL*84 00675 IF L910-NO-REC-88 CL*84 00676 MOVE 'MHDR RECORD NOT FOUND' CL*84 00677 TO WRK-ABEND-MSG CL*84 00678 PERFORM S999-ABEND THRU S999-EXIT. CL*84 00679 CL*84 00680 MOVE MSKL-REC TO MHDR-REC. CL*84 00681 CL*84 00682 MOVE MHDR-PRIOR-RUN-DATE TO WRK-EXT-CURRENT-DATE. CL*84 00683 CL*84 00684 DISPLAY ' PRIOR RUN DATE: ' MHDR-PRIOR-RUN-DATE. CL*84 00685 CL*21 00686 I2000-EXIT. DTSBX601 00687 EXIT. DTSBX601 00688 CL113 00689 P0000-PROCESS. DTSBX601 00690 DTSBX601 00691 MOVE +0 TO WRK-MPRF-CNT CL**9 00692 CL*16 00693 MOVE LOW-VALUES TO MPRF-KEY-AREA. CL*89 00694 MOVE 0 TO MLOG-CNT. CL*86 00695 SET WRK-MLOG-OK TO TRUE. DTSBX601 00696 MOVE LOW-VALUES TO MPRF-KEY-AREA. CL*92 00697 MOVE +000001 TO MPRF-EMP-NO. CL*92 00698 SET MPRF-PRF-88 TO TRUE. CL*92 00699 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. CL*92 00700 DTSBX601 00701 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX601 00702 IF L910-NO-REC-88 DTSBX601 00703 NEXT SENTENCE CL*83 00704 ELSE DTSBX601 00705 PERFORM P1100-SCAN-MPRF THRU P1100-EXIT CL*89 00706 UNTIL MPRF-NO-REC-88. CL*92 00707 DTSBX601 00708 P0000-EXIT. CL*83 00709 EXIT. CL*83 00710 EJECT CL*83 00711 CL*83 00712 DTSBX601 00713 P1100-SCAN-MPRF. CL*89 00714 CL*84 00715 MOVE MSKL-REC TO MPRF-REC. CL*96 00716 PERFORM P2100-PROCESS-MLOG THRU P2100-EXIT CL*89 00717 MOVE MPRF-REC TO MSKL-REC CL*94 00718 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBX601 00719 IF NOT L910-OK-88 CL*92 00720 SET MPRF-NO-REC-88 TO TRUE. CL*92 00721 DTSBX601 00722 P1100-EXIT. CL*87 00723 EXIT. DTSBX601 00724 SKIP3 CL*56 00725 CL**1 00726 CL*89 00727 P2100-PROCESS-MLOG. CL*89 00728 CL*89 00729 MOVE +0 TO WRK-MPRF-CNT CL*89 00730 CL*89 00731 SET WRK-MLOG-OK TO TRUE. CL*89 00732 MOVE LOW-VALUES TO MLOG-KEY-AREA. CL*89 00733 MOVE MPRF-EMP-NO TO MLOG-EMP-NO. CL*89 00734 SET MLOG-LOG-88 TO TRUE. CL*89 00735 MOVE MLOG-KEY-AREA TO MSKL-KEY-AREA. CL*89 00736 CL*89 00737 PERFORM S910-START-BROWSE THRU S910-EXIT. CL*89 00738 IF L910-NO-REC-88 CL*89 00739 NEXT SENTENCE CL*89 00740 ELSE CL*89 00741 PERFORM P2200-SCAN-MLOG THRU P2200-EXIT CL*89 00742 UNTIL WRK-MLOG-NO-REC. CL*90 00743 CL*89 00744 P2100-EXIT. CL*89 00745 EXIT. CL*89 00746 EJECT CL*89 00747 CL*89 00748 CL*89 00749 P2200-SCAN-MLOG. CL*89 00750 MOVE MSKL-REC TO MLOG-REC. CL*89 00751 ADD 1 TO MLOG-CNT CL*89 00752 IF MLOG-EMP-NO = 010021 OR 010727 OR 010729 CL119 00753 * DISPLAY 'MNAME: ' MLOG-DATA-ELEMENT-NAME(1:20) CL*99 00754 DISPLAY 'MDATE: ' MLOG-EMP-NO ' ' MLOG-ESTB-DATE CL115 00755 ' ' MLOG-OP-ID CL120 00756 ' ' MLOG-DATA-ELEMENT-NAME(1:15). CL120 00757 CL121 00758 * IF MLOG-ESTB-DATE = MHDR-PRIOR-RUN-DATE CL123 00759 IF MLOG-ESTB-DATE = 20180924 CL124 00760 IF MLOG-DATA-ELEMENT-NAME(1:20) = 'MPRF-RETURN-MAIL-IND' CL*97 00761 OR CL103 00762 MLOG-DATA-ELEMENT-NAME(1:12) = 'MRTE-UI-RATE' CL103 00763 OR CL104 00764 MLOG-DATA-ELEMENT-NAME(1:15) = 'RETURN MAIL IND' CL105 00765 MOVE SPACES TO WRK-R1-SPACES CL108 00766 * MOVE MLOG-ESTB-DATE TO REC1-DATE CL123 00767 MOVE 20180924 TO REC1-DATE CL124 00768 MOVE MPRF-RETURN-MAIL-IND TO REC1-FLAG CL*99 00769 MOVE MLOG-EMP-NO TO REC1-EMP-NO CL*99 00770 MOVE MLOG-OP-ID TO REC1-OPID CL113 00771 * SET WRK-MLOG-NO-REC TO TRUE CL120 00772 WRITE EXP-REC1 FROM WRK-REC1. CL121 00773 * GO TO P2200-EXIT. CL121 00774 CL112 00775 PERFORM S910-READ-NEXT THRU S910-EXIT. CL*89 00776 IF L910-NO-REC-88 CL*89 00777 SET L910-OK-88 TO TRUE CL*90 00778 SET WRK-MLOG-NO-REC TO TRUE. CL*89 00779 CL*89 00780 P2200-EXIT. CL*89 00781 EXIT. CL*89 00782 SKIP3 CL*89 00783 CL*89 00784 T0000-TERMINATE. DTSBX601 00785 CL**4 00786 DISPLAY ' '. DTSBX601 00787 CL**4 00788 DISPLAY '*** DTSBX601 TERMINATION STATISTICS ***'. CL*83 00789 CL**4 00790 DISPLAY ' '. DTSBX601 00791 CL**4 00792 PERFORM S910-CLOSE THRU S910-EXIT. CL**4 00793 CLOSE EXP-FILE1. CL*86 00794 DTSBX601 00795 T0000-EXIT. DTSBX601 00796 EXIT. DTSBX601 00797 EJECT DTSBX601 00798 S001-FROM-FED-8. CL232 00799 SET L001-FROM-FED-8 TO TRUE. CL232 00800 GO TO S001-DATE. CL232 00801 CL232 00802 S001-FROM-ABS-DAY. CL*10 00803 SET L001-FROM-ABS-DAY TO TRUE. CL*10 00804 GO TO S001-DATE. CL*10 00805 CL*10 00806 S001-DATE. CL232 00807 CALL 'DTSBU001' USING L001-LINK-AREA. CL232 00808 CL232 00809 S001-EXIT. CL232 00810 EXIT. CL232 00811 SKIP3 DTSBX601 00812 S004-FROM-5. CL*10 00813 SET L004-FROM-5 TO TRUE. CL*10 00814 GO TO S004-EDIT-QTR. CL*10 00815 CL*10 00816 S004-FROM-ABS. CL*10 00817 SET L004-FROM-ABS TO TRUE. CL*10 00818 GO TO S004-EDIT-QTR. CL*10 00819 CL*10 00820 S004-EDIT-QTR. CL183 00821 CALL 'DTSBU004' USING L004-COMM-AREA. CL183 00822 CL183 00823 S004-EXIT. CL183 00824 EXIT. CL183 00825 SKIP3 CL183 00826 S005-SYS-DATE. CL*80 00827 CALL 'DTSBU005' USING L005-COMM-AREA. CL*80 00828 CL*80 00829 S005-EXIT. CL*80 00830 EXIT. CL*80 00831 SKIP3 CL*80 00832 CL*80 00833 S054-RATE-DETERMINATION. CL206 00834 CALL 'DTSBU054' USING L054-LINK-AREA CL206 00835 MRCT-REC. CL206 00836 CL206 00837 S054-EXIT. CL206 00838 EXIT. CL206 00839 SKIP3 CL206 00840 S061-FLD-REP-INFO. CL*53 00841 SKIP1 CL*53 00842 CALL 'DTSBU061' USING L061-LINK-AREA. CL*53 00843 SKIP2 CL*53 00844 S061-EXIT. CL*53 00845 EXIT. CL*53 00846 CL*53 00847 S410-FILING-SCHED. CL*46 00848 CALL 'DTSBU410' USING L410-LINK-AREA. CL*46 00849 CL*46 00850 S410-EXIT. CL*46 00851 EXIT. CL*46 00852 SKIP3 CL*46 00853 S516-LIABILITY. CL185 00854 CALL 'DTSBU516' USING L516-LINK-AREA CL185 00855 MPRF-REC. CL185 00856 CL185 00857 S516-EXIT. CL185 00858 EXIT. CL185 00859 SKIP3 CL185 00860 S910-OPEN-READ. DTSBX601 00861 SET L910-OPEN-READ-88 TO TRUE. DTSBX601 00862 GO TO S910-MSTR-IO. DTSBX601 00863 DTSBX601 00864 S910-OPEN-UPDATE-NO-AIX. CL*18 00865 SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE. CL*18 00866 GO TO S910-MSTR-IO. CL*15 00867 DTSBX601 00868 S910-READ. DTSBX601 00869 SET L910-READ-88 TO TRUE. DTSBX601 00870 GO TO S910-MSTR-IO. DTSBX601 00871 DTSBX601 00872 S910-START-BROWSE. DTSBX601 00873 SET L910-START-BROWSE-88 TO TRUE. DTSBX601 00874 GO TO S910-MSTR-IO. DTSBX601 00875 DTSBX601 00876 S910-READ-NEXT. DTSBX601 00877 SET L910-READ-NEXT-88 TO TRUE. DTSBX601 00878 GO TO S910-MSTR-IO. DTSBX601 00879 DTSBX601 00880 S910-COUNT. CL**9 00881 SET L910-COUNT-88 TO TRUE. CL**9 00882 GO TO S910-MSTR-IO. CL**9 00883 CL**9 00884 S910-REWRITE. CL*15 00885 SET L910-REWRITE-88 TO TRUE. CL*15 00886 GO TO S910-MSTR-IO. CL*15 00887 DTSBX601 00888 S910-DELETE. CL119 00889 SET L910-DELETE-88 TO TRUE. CL119 00890 GO TO S910-MSTR-IO. CL119 00891 CL119 00892 S910-CLOSE. DTSBX601 00893 SET L910-CLOSE-88 TO TRUE. DTSBX601 00894 GO TO S910-MSTR-IO. DTSBX601 00895 DTSBX601 00896 S910-MSTR-IO. DTSBX601 00897 CALL 'DTSBU910' USING L910-LINK-AREA CL**2 00898 MSKL-REC. DTSBX601 00899 S910-EXIT. DTSBX601 00900 EXIT. DTSBX601 00901 SKIP3 DTSBX601 00902 S921-OPEN-READ. CL*89 00903 SET L921-OPEN-READ-88 TO TRUE. CL*89 00904 GO TO S921-AIX-IO. CL*89 00905 CL*89 00906 S921-CLOSE. CL*89 00907 SET L921-CLOSE-88 TO TRUE. CL*89 00908 GO TO S921-AIX-IO. CL*89 00909 CL*89 00910 S921-AIX-IO. CL*89 00911 CALL 'DTSBU921' USING L921-LINK-AREA CL*89 00912 ISKL-REC. CL*89 00913 S921-EXIT. CL*89 00914 EXIT. CL*89 00915 SKIP3 CL*89 00916 CL*89 00917 S931-OPEN-READ. CL132 00918 SET L931-OPEN-READ-88 TO TRUE. CL132 00919 GO TO S931-REF-IO. CL132 00920 CL132 00921 S931-OPEN-UPDATE. CL*31 00922 SET L931-OPEN-UPDATE-88 TO TRUE. CL*31 00923 GO TO S931-REF-IO. CL*31 00924 CL*31 00925 S931-START-BROWSE. CL*31 00926 SET L931-START-BROWSE-88 TO TRUE. CL**6 00927 GO TO S931-REF-IO. CL**6 00928 CL**6 00929 S931-READ. CL132 00930 SET L931-READ-88 TO TRUE. CL132 00931 GO TO S931-REF-IO. CL132 00932 CL133 00933 S931-READ-NEXT. CL**6 00934 SET L931-READ-NEXT-88 TO TRUE. CL**6 00935 GO TO S931-REF-IO. CL**6 00936 CL**6 00937 S931-DELETE. CL*32 00938 SET L931-DELETE-88 TO TRUE. CL*32 00939 GO TO S931-REF-IO. CL*32 00940 CL*32 00941 S931-REWRITE. CL*29 00942 SET L931-REWRITE-88 TO TRUE. CL*29 00943 GO TO S931-REF-IO. CL*29 00944 CL*29 00945 S931-WRITE. CL*33 00946 SET L931-WRITE-88 TO TRUE. CL*33 00947 GO TO S931-REF-IO. CL*33 00948 CL*33 00949 S931-CLOSE. CL134 00950 SET L931-CLOSE-88 TO TRUE. CL133 00951 GO TO S931-REF-IO. CL133 00952 CL133 00953 S931-REF-IO. CL132 00954 CALL 'DTSBU931' USING L931-LINK-AREA CL132 00955 FSKL-REC. CL132 00956 S931-EXIT. CL132 00957 EXIT. CL132 00958 SKIP3 CL132 00959 S999-ABEND. DTSBX601 00960 CALL 'DTSBU999' USING WRK-ABEND-CD. CL**2 00961 S999-EXIT. DTSBX601 00962 EXIT. DTSBX601