964 lines
76 KiB
COBOL
964 lines
76 KiB
COBOL
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
|