1448 lines
114 KiB
COBOL
1448 lines
114 KiB
COBOL
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
|