3127 lines
247 KiB
COBOL
3127 lines
247 KiB
COBOL
00001 IDENTIFICATION DIVISION. 11/16/00
|
|
00002 PROGRAM-ID. DTSBE999. DTSBE999
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV060
|
|
00004 DATE-WRITTEN. SEPTEMBER 1994. DTSBE999
|
|
00005 DATE-COMPILED. DTSBE999
|
|
00006 SKIP3 DTSBE999
|
|
00007 ***** DTSBE999
|
|
00008 * DTSBE999
|
|
00009 * FUNCTION: MASTER FILE INTEGRITY CHECK. DTSBE999
|
|
00010 * DTSBE999
|
|
00011 * DTSBE999
|
|
00012 * DTSBE999
|
|
00013 * MODIFICATION LOG: DTSBE999
|
|
00014 * DTSBE999
|
|
00015 * 03/10/95 INITIAL DEVELOPMENT. DTSBE999
|
|
00016 * WORK ORDER: PROGRAMMER: TCL DTSBE999
|
|
00017 * DTSBE999
|
|
00018 * 05/16/95 HAVING AN OPEN BANKRUPTCY IN A SPAN OF LIABILITY DTSBE999
|
|
00019 * IS NOW ALLOWED. DTSBE999
|
|
00020 * WORK ORDER: CR086 PROGRAMMER: RHC DTSBE999
|
|
00021 * DTSBE999
|
|
00022 * 06/05/95 CHANGE DUE DATE LOGIC. DTSBE999
|
|
00023 * WORK ORDER: CR092 PROGRAMMER: RHC DTSBE999
|
|
00024 * DTSBE999
|
|
00025 * 06/12/95 CHANGE CREDIT TOLERANCE LOGIC. DTSBE999
|
|
00026 * WORK ORDER: CR094 PROGRAMMER: RHC DTSBE999
|
|
00027 * DTSBE999
|
|
00028 * 03/20/1999 REVIEWIED AND MODIFIED FOR DC. DTSBE999
|
|
00029 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBE999
|
|
00030 * DTSBE999
|
|
00031 * 05/27/1999 PICKUP MODIFICATIONS. NO MQTR WITH MQTR-YRQ DTSBE999
|
|
00032 * < MQTR-PICKUP-YRQ ALLOWED. SPECIAL EDITS DTSBE999
|
|
00033 * ON MQTR-YRQ = LCCM-PICKUP-YRQ MQTR OCCURRENCE. DTSBE999
|
|
00034 * REFERENCE: PICKUP DIR PROGRAMMER: EHH DTSBE999
|
|
00035 * DTSBE999
|
|
00036 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE999
|
|
00037 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE999
|
|
00038 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBE999
|
|
00039 * DTSBE999
|
|
00040 * DTSBE999
|
|
00041 * DESCRIPTION: DTSBE999
|
|
00042 * DTSBE999
|
|
00043 * DTSBE999
|
|
00044 * INITIATION: DTSBE999
|
|
00045 * DTSBE999
|
|
00046 * SET LECM-MST-OPEN-READ-88 TO TRUE. DTSBE999
|
|
00047 * SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBE999
|
|
00048 * DTSBE999
|
|
00049 * EDIT AND DEFAULT PARAMETERS. DTSBE999
|
|
00050 * DTSBE999
|
|
00051 * DTSBE999
|
|
00052 * PROCESSING: DTSBE999
|
|
00053 * DTSBE999
|
|
00054 * CHECK THE INTEGRITY OF THE MASTER FILE. DTSBE999
|
|
00055 * DTSBE999
|
|
00056 * DTSBE999
|
|
00057 * TERMINATION: DTSBE999
|
|
00058 * DTSBE999
|
|
00059 * NONE. DTSBE999
|
|
00060 * DTSBE999
|
|
00061 * DTSBE999
|
|
00062 * RECORDS READ: DTSBE999
|
|
00063 * DTSBE999
|
|
00064 * MASTER: DTSBE999
|
|
00065 * DTSBE999
|
|
00066 * ALL DTSBE999
|
|
00067 * DTSBE999
|
|
00068 * DTSBE999
|
|
00069 * ALTERNATE INDEX: DTSBE999
|
|
00070 * DTSBE999
|
|
00071 * NONE. DTSBE999
|
|
00072 * DTSBE999
|
|
00073 * DTSBE999
|
|
00074 * REFERENCE: DTSBE999
|
|
00075 * DTSBE999
|
|
00076 * FQTR. DTSBE999
|
|
00077 * DTSBE999
|
|
00078 * DTSBE999
|
|
00079 * RECORDS UPDATED: DTSBE999
|
|
00080 * DTSBE999
|
|
00081 * NONE. DTSBE999
|
|
00082 * DTSBE999
|
|
00083 * DTSBE999
|
|
00084 * REPORT RECORDS WRITTEN: DTSBE999
|
|
00085 * DTSBE999
|
|
00086 * R907 UNUSUAL CONDITIONS ENCOUNTERED. DTSBE999
|
|
00087 * DTSBE999
|
|
00088 * DTSBE999
|
|
00089 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBE999
|
|
00090 * DTSBE999
|
|
00091 * NONE. DTSBE999
|
|
00092 * DTSBE999
|
|
00093 * DTSBE999
|
|
00094 * MODULES CALLED: DTSBE999
|
|
00095 * DTSBE999
|
|
00096 * DTSBU910 MASTER FILE I/O. DTSBE999
|
|
00097 * DTSBU931 REFERENCE FILE I/O. DTSBE999
|
|
00098 * DTSBU946 REPORT RECORD OUTPUT. DTSBE999
|
|
00099 * DTSBE999
|
|
00100 ***** DTSBE999
|
|
00101 SKIP3 DTSBE999
|
|
00102 ENVIRONMENT DIVISION. DTSBE999
|
|
00103 EJECT DTSBE999
|
|
00104 DATA DIVISION. DTSBE999
|
|
00105 SKIP3 DTSBE999
|
|
00106 WORKING-STORAGE SECTION. DTSBE999
|
|
001065 77 PAN-VALET PICTURE X(24) VALUE '060DTSBE999 11/16/00'. DTSBE999
|
|
00107 SKIP3 DTSBE999
|
|
00108 01 WRK-AREA. DTSBE999
|
|
00109 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +999.DTSBE999
|
|
00110 DTSBE999
|
|
00111 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBE999'.DTSBE999
|
|
00112 DTSBE999
|
|
00113 05 ALL-NINES-YRQ PIC S9(05) COMP-3 DTSBE999
|
|
00114 VALUE +99999. DTSBE999
|
|
00115 DTSBE999
|
|
00116 05 ALL-NINES-DATE PIC S9(09) COMP-3 DTSBE999
|
|
00117 VALUE +999999999. DTSBE999
|
|
00118 DTSBE999
|
|
00119 05 QTR-TOL-MAX PIC S9(09)V9(02) COMP-3 DTSBE999
|
|
00120 VALUE +14.99. DTSBE999
|
|
00121 DTSBE999
|
|
00122 05 CREDIT-TOL-MAX PIC S9(09)V9(02) COMP-3 DTSBE999
|
|
00123 VALUE +9.99. DTSBE999
|
|
00124 DTSBE999
|
|
00125 05 ABEND-MSG PIC X(60). DTSBE999
|
|
00126 DTSBE999
|
|
00127 DTSBE999
|
|
00128 05 WRK-PARM-FIRST-EMP-NO PIC S9(07) COMP-3. DTSBE999
|
|
00129 DTSBE999
|
|
00130 05 WRK-PARM-LAST-EMP-NO PIC S9(07) COMP-3. DTSBE999
|
|
00131 DTSBE999
|
|
00132 DTSBE999
|
|
00133 05 MAX-DST-BY-QTR-CNT-USED PIC S9(04) COMP. DTSBE999
|
|
00134 DTSBE999
|
|
00135 05 MAX-DST-BY-DOC-CNT-USED PIC S9(04) COMP. DTSBE999
|
|
00136 DTSBE999
|
|
00137 05 MAX-SOL-CNT-USED PIC S9(04) COMP. DTSBE999
|
|
00138 DTSBE999
|
|
00139 05 MAX-RTE-CNT-USED PIC S9(04) COMP. DTSBE999
|
|
00140 SKIP3 DTSBE999
|
|
00141 05 YES PIC X(01) VALUE 'Y'. DTSBE999
|
|
00142 DTSBE999
|
|
00143 05 WRK-CNT PIC S9(04) COMP. DTSBE999
|
|
00144 DTSBE999
|
|
00145 05 WRK-X-1-TO-9-1. DTSBE999
|
|
00146 10 WRK-9-1 PIC 9. DTSBE999
|
|
00147 DTSBE999
|
|
00148 05 WRK-BNK-END-DATE PIC S9(09) COMP-3. DTSBE999
|
|
00149 DTSBE999
|
|
00150 DTSBE999
|
|
00151 05 DST-CR-AVAIL-AMT PIC S9(09)V9(02) COMP-3. DTSBE999
|
|
00152 DTSBE999
|
|
00153 05 DST-CR-WRITE-OFF-AMT PIC S9(09)V9(02) COMP-3. DTSBE999
|
|
00154 DTSBE999
|
|
00155 05 WRK-SLASH-QTR PIC X(04). DTSBE999
|
|
00156 DTSBE999
|
|
00157 05 WRK-QTR-DEFAULT-DUE-DATE PIC S9(09) COMP-3. DTSBE999
|
|
00158 DTSBE999
|
|
00159 05 WRK-BALANCE-AMT PIC S9(09)V9(02) COMP-3. DTSBE999
|
|
00160 DTSBE999
|
|
00161 05 QTR-BALANCE-AMT PIC S9(09)V9(02) COMP-3. DTSBE999
|
|
00162 DTSBE999
|
|
00163 05 WRK-BY-DOC-AMT PIC S9(09)V9(02) COMP-3. DTSBE999
|
|
00164 DTSBE999
|
|
00165 05 WRK-TAX-WAGE PIC S9(11)V9(02) COMP-3. DTSBE999
|
|
00166 DTSBE999
|
|
00167 DTSBE999
|
|
00168 01 SOL-INDICATORS. DTSBE999
|
|
00169 05 SOL-LIAB-RATED-IND PIC X(01). DTSBE999
|
|
00170 05 SOL-LIAB-SELF-INS-IND PIC X(01). DTSBE999
|
|
00171 05 SOL-LIAB-ACTIVE-CNT PIC S9(03) COMP-3. DTSBE999
|
|
00172 05 SOL-SMALLEST-FIRST-LIAB-YRQ PIC S9(05) COMP-3. DTSBE999
|
|
00173 05 SOL-LARGEST-LAST-LIAB-YRQ PIC S9(05) COMP-3. DTSBE999
|
|
00174 DTSBE999
|
|
00175 DTSBE999
|
|
00176 01 SOL-TABLE. DTSBE999
|
|
00177 05 SOL-MAX PIC S9(04) COMP VALUE +100.DTSBE999
|
|
00178 05 SOL-CNT PIC S9(04) COMP. DTSBE999
|
|
00179 05 SOL-AREA OCCURS 100 TIMES DTSBE999
|
|
00180 INDEXED BY SOL-IDX. DTSBE999
|
|
00181 10 SOL-FIRST-LIAB-DATE PIC S9(09) COMP-3. DTSBE999
|
|
00182 10 SOL-LAST-LIAB-DATE PIC S9(09) COMP-3. DTSBE999
|
|
00183 10 SOL-FIRST-LIAB-YRQ PIC S9(05) COMP-3. DTSBE999
|
|
00184 10 SOL-LAST-LIAB-YRQ PIC S9(05) COMP-3. DTSBE999
|
|
00185 10 SOL-ESTB-LIAB-YRQ PIC S9(05) COMP-3. DTSBE999
|
|
00186 DTSBE999
|
|
00187 DTSBE999
|
|
00188 01 TAD-INDICATORS. DTSBE999
|
|
00189 05 TAD-IND-ZIP-AREA OCCURS 2 TIMES DTSBE999
|
|
00190 INDEXED BY TAD-AREA-IDX. DTSBE999
|
|
00191 10 TAD-EXISTS-IND PIC X(01). DTSBE999
|
|
00192 10 TAD-ST PIC X(02). DTSBE999
|
|
00193 10 TAD-ZIP PIC X(10). DTSBE999
|
|
00194 DTSBE999
|
|
00195 DTSBE999
|
|
00196 01 RTE-TABLE. DTSBE999
|
|
00197 05 RTE-MAX PIC S9(04) COMP VALUE +100.DTSBE999
|
|
00198 05 RTE-CNT PIC S9(04) COMP. DTSBE999
|
|
00199 05 RTE-AREA OCCURS 100 TIMES DTSBE999
|
|
00200 INDEXED BY RTE-IDX. DTSBE999
|
|
00201 10 RTE-EFF-YRQ PIC S9(05) COMP-3. DTSBE999
|
|
00202 10 RTE-END-YRQ PIC S9(05) COMP-3. DTSBE999
|
|
00203 10 RTE-UI-RATE PIC S9(01)V9(04) COMP-3. DTSBE999
|
|
00204 DTSBE999
|
|
00205 DTSBE999
|
|
00206 01 QTR-AREA. DTSBE999
|
|
00207 05 QTR-FIRST-ON-FILE-YRQ PIC S9(05) COMP-3. DTSBE999
|
|
00208 DTSBE999
|
|
00209 05 QTR-LAST-ON-FILE-YRQ PIC S9(05) COMP-3. DTSBE999
|
|
00210 DTSBE999
|
|
00211 05 QTR-PURSUED-RPT-CNT PIC S9(03) COMP-3. DTSBE999
|
|
00212 DTSBE999
|
|
00213 05 QTR-TOT-BALANCE-AMT PIC S9(09)V9(02) COMP-3. DTSBE999
|
|
00214 DTSBE999
|
|
00215 05 QTR-FIRST-CHECK-YRQ PIC S9(05) COMP-3. DTSBE999
|
|
00216 DTSBE999
|
|
00217 05 QTR-LAST-CHECK-YRQ PIC S9(05) COMP-3. DTSBE999
|
|
00218 DTSBE999
|
|
00219 05 QTR-CURR-CHECK-ABS-QTR PIC S9(04) COMP. DTSBE999
|
|
00220 DTSBE999
|
|
00221 05 QTR-LAST-CHECK-ABS-QTR PIC S9(04) COMP. DTSBE999
|
|
00222 DTSBE999
|
|
00223 05 QTR-INT-CHARGED-AMT PIC S9(09)V9(02) COMP-3. DTSBE999
|
|
00224 DTSBE999
|
|
00225 *****05 QTR-PEN-CHARGED-AMT PIC S9(09)V9(02) COMP-3. DTSBE999
|
|
00226 DTSBE999
|
|
00227 *****05 WRK-PEN-CHARGED-AMT PIC S9(09)V9(02) COMP-3. DTSBE999
|
|
00228 DTSBE999
|
|
00229 05 WRK-INT-CHARGED-AMT PIC S9(09)V9(02) COMP-3. DTSBE999
|
|
00230 DTSBE999
|
|
00231 05 WRK-CHARGED-DIFF-AMT PIC S9(09)V9(02) COMP-3. DTSBE999
|
|
00232 DTSBE999
|
|
00233 DTSBE999
|
|
00234 01 DST-BY-QTR-TABLE. DTSBE999
|
|
00235 05 DST-BY-QTR-SUB PIC S9(04) COMP. DTSBE999
|
|
00236 DTSBE999
|
|
00237 05 DST-BY-QTR-CNT PIC S9(04) COMP. DTSBE999
|
|
00238 DTSBE999
|
|
00239 ***** DTSBE999
|
|
00240 * DTSBE999
|
|
00241 * ONE OCCURRENCE PER DST-BY-QTR-YRQ VALUE. DTSBE999
|
|
00242 * DTSBE999
|
|
00243 * ASCENDING ON DST-BY-QTR-YRQ VALUE. DTSBE999
|
|
00244 * DTSBE999
|
|
00245 ***** DTSBE999
|
|
00246 DTSBE999
|
|
00247 05 DST-BY-QTR-AREA OCCURS 401 TIMES DTSBE999
|
|
00248 INDEXED BY DST-BY-QTR-IDX. DTSBE999
|
|
00249 10 DST-BY-QTR-YRQ PIC S9(05) COMP-3. DTSBE999
|
|
00250 88 DST-BY-QTR-CREDIT-88 VALUE +99999. DTSBE999
|
|
00251 10 DST-BY-QTR-UI-AMT PIC S9(09)V9(02) COMP-3. DTSBE999
|
|
00252 10 DST-BY-QTR-SUR-AMT PIC S9(09)V9(02) COMP-3. DTSBE999
|
|
00253 10 DST-BY-QTR-INT-AMT PIC S9(09)V9(02) COMP-3. DTSBE999
|
|
00254 10 DST-BY-QTR-LATE-PEN-AMT PIC S9(09)V9(02) COMP-3. DTSBE999
|
|
00255 10 DST-BY-QTR-NSF-PEN-AMT PIC S9(09)V9(02) COMP-3. DTSBE999
|
|
00256 10 DST-BY-QTR-MISC-PEN-AMT PIC S9(09)V9(02) COMP-3. DTSBE999
|
|
00257 10 DST-BY-QTR-CR-AVAIL-AMT PIC S9(09)V9(02) COMP-3. DTSBE999
|
|
00258 10 DST-BY-QTR-CR-WRITE-OFF-AMT DTSBE999
|
|
00259 PIC S9(09)V9(02) COMP-3. DTSBE999
|
|
00260 10 DST-BY-QTR-CR-TOL-AMT PIC S9(09)V9(02) COMP-3. DTSBE999
|
|
00261 DTSBE999
|
|
00262 DTSBE999
|
|
00263 01 DST-BY-DOC-TABLE. DTSBE999
|
|
00264 05 DST-BY-DOC-SUB PIC S9(04) COMP. DTSBE999
|
|
00265 05 DST-BY-DOC-CNT PIC S9(04) COMP. DTSBE999
|
|
00266 05 DST-BY-DOC-MAX PIC S9(04) COMP VALUE +1000.DTSBE999
|
|
00267 DTSBE999
|
|
00268 ***** DTSBE999
|
|
00269 * DTSBE999
|
|
00270 * ONE OCCURRENCE PER DST-BY-DOC-DOC-NO VALUE. DTSBE999
|
|
00271 * DTSBE999
|
|
00272 * ASCENDING ON DST-BY-DOC-DOC-NO VALUE. DTSBE999
|
|
00273 * DTSBE999
|
|
00274 ***** DTSBE999
|
|
00275 DTSBE999
|
|
00276 05 DST-BY-DOC-ARRAY. DTSBE999
|
|
00277 10 DST-BY-DOC-AREA OCCURS 1000 TIMES DTSBE999
|
|
00278 INDEXED BY DST-BY-DOC-IDX. DTSBE999
|
|
00279 15 DST-BY-DOC-DOC-NO. DTSBE999
|
|
00280 20 DST-BY-DOC-BATCH-NO PIC S9(05) COMP-3. DTSBE999
|
|
00281 20 DST-BY-DOC-ITEM-NO PIC S9(03) COMP-3. DTSBE999
|
|
00282 15 DST-RECEIVED-DATE PIC S9(09) COMP-3.DTSBE999
|
|
00283 15 DST-BY-DOC-QTR-AMT PIC S9(09)V9(02) COMP-3.DTSBE999
|
|
00284 15 DST-BY-DOC-CREDIT-AMT PIC S9(09)V9(02) COMP-3.DTSBE999
|
|
00285 15 DST-BY-DOC-REV-AMT PIC S9(09)V9(02) COMP-3.DTSBE999
|
|
00286 DTSBE999
|
|
00287 DTSBE999
|
|
00288 *01 SORT-FIELDS. DTSBE999
|
|
00289 *****05 SORT-ITEM-CNT PIC S9(09) COMP. DTSBE999
|
|
00290 *****05 SORT-ITEM-LENGTH PIC S9(09) COMP. DTSBE999
|
|
00291 *****05 SORT-KEY-START PIC S9(09) COMP. DTSBE999
|
|
00292 *****05 SORT-KEY-LENGTH PIC S9(09) COMP. DTSBE999
|
|
00293 *****05 SORT-KEY-TYPE PIC S9(09) COMP. DTSBE999
|
|
00294 EJECT DTSBE999
|
|
00295 01 MSG-ID. DTSBE999
|
|
00296 05 FILLER PIC X(01) VALUE 'R'. DTSBE999
|
|
00297 05 MSG-NO PIC 9(02). DTSBE999
|
|
00298 SKIP3 DTSBE999
|
|
00299 01 MSG-TABLE. DTSBE999
|
|
00300 05 MSG01-TEXT. DTSBE999
|
|
00301 10 FILLER PIC X(40) DTSBE999
|
|
00302 VALUE 'MORE THAN ONE ACTIVE SPAN OF LIABILITY. '. DTSBE999
|
|
00303 10 FILLER PIC X(40) DTSBE999
|
|
00304 VALUE ' '. DTSBE999
|
|
00305 DTSBE999
|
|
00306 05 MSG02-TEXT. DTSBE999
|
|
00307 10 FILLER PIC X(40) DTSBE999
|
|
00308 VALUE 'MORE THAN ONE TYPE OF EMPLOYER CLASS IN '. DTSBE999
|
|
00309 10 FILLER PIC X(40) DTSBE999
|
|
00310 VALUE 'THE SPANS OF LIABILITY. '. DTSBE999
|
|
00311 DTSBE999
|
|
00312 05 MSG03-TEXT. DTSBE999
|
|
00313 10 FILLER PIC X(16) DTSBE999
|
|
00314 VALUE 'MPRF-EMP-CLASS "'. DTSBE999
|
|
00315 10 MSG03-FIELD1 PIC X(01). DTSBE999
|
|
00316 10 FILLER PIC X(23) DTSBE999
|
|
00317 VALUE '" DOES NOT AGREE WITH S'. DTSBE999
|
|
00318 10 FILLER PIC X(40) DTSBE999
|
|
00319 VALUE 'PANS OF LIABILITY. '. DTSBE999
|
|
00320 DTSBE999
|
|
00321 05 MSG04-TEXT. DTSBE999
|
|
00322 10 FILLER PIC X(17) DTSBE999
|
|
00323 VALUE 'MPRF-EMP-STATUS "'. DTSBE999
|
|
00324 10 MSG04-FIELD1 PIC X(01). DTSBE999
|
|
00325 10 FILLER PIC X(22) DTSBE999
|
|
00326 VALUE '" DOES NOT AGREE WITH '. DTSBE999
|
|
00327 10 FILLER PIC X(40) DTSBE999
|
|
00328 VALUE 'SPANS OF LIABILITY. '. DTSBE999
|
|
00329 DTSBE999
|
|
00330 05 MSG05-TEXT. DTSBE999
|
|
00331 10 FILLER PIC X(40) DTSBE999
|
|
00332 VALUE 'MSOL-*-LIAB-YRQ NOT CONSISTENT WITH MSOL'. DTSBE999
|
|
00333 10 FILLER PIC X(40) DTSBE999
|
|
00334 VALUE '-INACT-WITHDRAWN-88. '. DTSBE999
|
|
00335 DTSBE999
|
|
00336 05 MSG06-TEXT. DTSBE999
|
|
00337 10 FILLER PIC X(40) DTSBE999
|
|
00338 VALUE 'MSOL-FIRST-LIAB-YRQ NOT CONSISTENT WITH '. DTSBE999
|
|
00339 10 FILLER PIC X(40) DTSBE999
|
|
00340 VALUE 'MSOL-LIAB-DATE. '. DTSBE999
|
|
00341 DTSBE999
|
|
00342 05 MSG07-TEXT. DTSBE999
|
|
00343 10 FILLER PIC X(40) DTSBE999
|
|
00344 VALUE 'MSOL-LAST-LIAB-YRQ NOT CONSISTENT WITH M'. DTSBE999
|
|
00345 10 FILLER PIC X(40) DTSBE999
|
|
00346 VALUE 'SOL-INACTIVE-DATE. '. DTSBE999
|
|
00347 DTSBE999
|
|
00348 05 MSG08-TEXT. DTSBE999
|
|
00349 10 FILLER PIC X(40) DTSBE999
|
|
00350 VALUE 'OPEN BANKRUPTCY / ACTIVE EMPLOYER CONFLI'. DTSBE999
|
|
00351 10 FILLER PIC X(40) DTSBE999
|
|
00352 VALUE 'CT. '. DTSBE999
|
|
00353 DTSBE999
|
|
00354 05 MSG09-TEXT. DTSBE999
|
|
00355 10 FILLER PIC X(40) DTSBE999
|
|
00356 VALUE 'BANKRUPTCY PERIOD / SPAN OF SUBJECTIVITY'. DTSBE999
|
|
00357 10 FILLER PIC X(40) DTSBE999
|
|
00358 VALUE ' CONFLICT. '. DTSBE999
|
|
00359 DTSBE999
|
|
00360 05 MSG10-TEXT. DTSBE999
|
|
00361 10 FILLER PIC X(40) DTSBE999
|
|
00362 VALUE ' '. DTSBE999
|
|
00363 10 FILLER PIC X(40) DTSBE999
|
|
00364 VALUE ' '. DTSBE999
|
|
00365 DTSBE999
|
|
00366 05 MSG11-TEXT. DTSBE999
|
|
00367 10 FILLER PIC X(40) DTSBE999
|
|
00368 VALUE 'UI TAX MAILING ADDRESS NOT FOUND '. DTSBE999
|
|
00369 10 FILLER PIC X(40) DTSBE999
|
|
00370 VALUE ' '. DTSBE999
|
|
00371 DTSBE999
|
|
00372 05 MSG12-TEXT. DTSBE999
|
|
00373 10 FILLER PIC X(40) DTSBE999
|
|
00374 VALUE 'MPRF-TAX-REC-ADDR-EXISTS-IND NOT CONSIST'. DTSBE999
|
|
00375 10 FILLER PIC X(40) DTSBE999
|
|
00376 VALUE 'ENT WITH MTAD RECORD OCCURRENCES '. DTSBE999
|
|
00377 DTSBE999
|
|
00378 05 MSG13-TEXT. DTSBE999
|
|
00379 10 FILLER PIC X(40) DTSBE999
|
|
00380 VALUE 'MPRF-BEN-MAIL-ADDR-EXISTS-IND NOT CONSIS'. DTSBE999
|
|
00381 10 FILLER PIC X(40) DTSBE999
|
|
00382 VALUE 'TENT WITH MBAA RECORD OCCURRENCES '. DTSBE999
|
|
00383 DTSBE999
|
|
00384 05 MSG14-TEXT. DTSBE999
|
|
00385 10 FILLER PIC X(40) DTSBE999
|
|
00386 VALUE 'MPRF-FLD-ZIP-ST DOES NOT MATCH TAX ADDRE'. DTSBE999
|
|
00387 10 FILLER PIC X(40) DTSBE999
|
|
00388 VALUE 'SS. '. DTSBE999
|
|
00389 DTSBE999
|
|
00390 05 MSG15-TEXT. DTSBE999
|
|
00391 10 FILLER PIC X(40) DTSBE999
|
|
00392 VALUE ' '. DTSBE999
|
|
00393 10 FILLER PIC X(40) DTSBE999
|
|
00394 VALUE ' '. DTSBE999
|
|
00395 DTSBE999
|
|
00396 05 MSG16-TEXT. DTSBE999
|
|
00397 10 FILLER PIC X(40) DTSBE999
|
|
00398 VALUE ' '. DTSBE999
|
|
00399 10 FILLER PIC X(40) DTSBE999
|
|
00400 VALUE ' '. DTSBE999
|
|
00401 DTSBE999
|
|
00402 05 MSG17-TEXT. DTSBE999
|
|
00403 10 FILLER PIC X(40) DTSBE999
|
|
00404 VALUE ' '. DTSBE999
|
|
00405 10 FILLER PIC X(40) DTSBE999
|
|
00406 VALUE ' '. DTSBE999
|
|
00407 DTSBE999
|
|
00408 05 MSG18-TEXT. DTSBE999
|
|
00409 10 FILLER PIC X(40) DTSBE999
|
|
00410 VALUE ' '. DTSBE999
|
|
00411 10 FILLER PIC X(40) DTSBE999
|
|
00412 VALUE ' '. DTSBE999
|
|
00413 DTSBE999
|
|
00414 05 MSG19-TEXT. DTSBE999
|
|
00415 10 FILLER PIC X(40) DTSBE999
|
|
00416 VALUE ' '. DTSBE999
|
|
00417 10 FILLER PIC X(40) DTSBE999
|
|
00418 VALUE ' '. DTSBE999
|
|
00419 DTSBE999
|
|
00420 05 MSG20-TEXT. DTSBE999
|
|
00421 10 FILLER PIC X(34) DTSBE999
|
|
00422 VALUE 'MPRF-LAST-ARCHIVED-YRQ NOT VALID: '. DTSBE999
|
|
00423 10 MSG20-SLASH-QTR PIC X(04). DTSBE999
|
|
00424 10 FILLER PIC X(42) VALUE SPACES. DTSBE999
|
|
00425 DTSBE999
|
|
00426 05 MSG21-TEXT. DTSBE999
|
|
00427 10 FILLER PIC X(40) DTSBE999
|
|
00428 VALUE 'MPRF-BANKRUPTCY-OPEN-IND IS NOT CONSISTE'. DTSBE999
|
|
00429 10 FILLER PIC X(40) DTSBE999
|
|
00430 VALUE 'NT WITH THE MCOL RECORD. '. DTSBE999
|
|
00431 DTSBE999
|
|
00432 05 MSG22-TEXT. DTSBE999
|
|
00433 10 FILLER PIC X(40) DTSBE999
|
|
00434 VALUE 'MPRF-MAPL-IND IS NOT CONSISTENT WITH THE'. DTSBE999
|
|
00435 10 FILLER PIC X(40) DTSBE999
|
|
00436 VALUE ' MAPL RECORD OCCURRENCES. '. DTSBE999
|
|
00437 DTSBE999
|
|
00438 05 MSG23-TEXT. DTSBE999
|
|
00439 10 FILLER PIC X(40) DTSBE999
|
|
00440 VALUE 'MPRF-MLIN-IND IS NOT CONSISTENT WITH THE'. DTSBE999
|
|
00441 10 FILLER PIC X(40) DTSBE999
|
|
00442 VALUE ' MLIN RECORD OCCURRENCES. '. DTSBE999
|
|
00443 DTSBE999
|
|
00444 05 MSG24-TEXT. DTSBE999
|
|
00445 10 FILLER PIC X(40) DTSBE999
|
|
00446 VALUE 'MPRF-MDPC-IND IS NOT CONSISTENT WITH THE'. DTSBE999
|
|
00447 10 FILLER PIC X(40) DTSBE999
|
|
00448 VALUE ' MDPC RECORD OCCURRENCES. '. DTSBE999
|
|
00449 DTSBE999
|
|
00450 05 MSG25-TEXT. DTSBE999
|
|
00451 10 FILLER PIC X(40) DTSBE999
|
|
00452 VALUE 'MPRF-MFAS-IND IS NOT CONSISTENT WITH THE'. DTSBE999
|
|
00453 10 FILLER PIC X(40) DTSBE999
|
|
00454 VALUE ' MFAS RECORD OCCURRENCES. '. DTSBE999
|
|
00455 DTSBE999
|
|
00456 05 MSG26-TEXT. DTSBE999
|
|
00457 10 FILLER PIC X(40) DTSBE999
|
|
00458 VALUE 'MQTR-TAX-DUE-DATE GREATER THAN DEFAULT T'. DTSBE999
|
|
00459 10 FILLER PIC X(19) DTSBE999
|
|
00460 VALUE 'AX DUE DATE. YRQ: '. DTSBE999
|
|
00461 10 MSG26-SLASH-QTR PIC X(04). DTSBE999
|
|
00462 10 FILLER PIC X(17) VALUE SPACES. DTSBE999
|
|
00463 DTSBE999
|
|
00464 05 MSG27-TEXT. DTSBE999
|
|
00465 10 FILLER PIC X(40) DTSBE999
|
|
00466 VALUE 'NEGATIVE DST-BY-DOC-AMT ENCOUNTERED. BA'. DTSBE999
|
|
00467 10 FILLER PIC X(08) DTSBE999
|
|
00468 VALUE 'TCH-NO: '. DTSBE999
|
|
00469 10 MSG27-BATCH-NO PIC 9(05). DTSBE999
|
|
00470 10 FILLER PIC X(11) DTSBE999
|
|
00471 VALUE ' ITEM-NO: '. DTSBE999
|
|
00472 10 MSG27-ITEM-NO PIC 9(03). DTSBE999
|
|
00473 10 FILLER PIC X(13) VALUE SPACES. DTSBE999
|
|
00474 DTSBE999
|
|
00475 05 MSG28-TEXT. DTSBE999
|
|
00476 10 FILLER PIC X(28) DTSBE999
|
|
00477 VALUE 'DST-BY-DOC RESIDUE. BATCH: '. DTSBE999
|
|
00478 10 MSG28-BATCH-NO PIC 9(05). DTSBE999
|
|
00479 10 FILLER PIC X(08) DTSBE999
|
|
00480 VALUE ' ITEM: '. DTSBE999
|
|
00481 10 MSG28-ITEM-NO PIC 9(03). DTSBE999
|
|
00482 10 FILLER PIC X(07) DTSBE999
|
|
00483 VALUE ' AMT: '. DTSBE999
|
|
00484 10 MSG28-AMT PIC ZZZ,ZZZ,ZZ9.99-. DTSBE999
|
|
00485 10 FILLER PIC X(14) VALUE SPACES. DTSBE999
|
|
00486 DTSBE999
|
|
00487 05 MSG29-TEXT. DTSBE999
|
|
00488 10 FILLER PIC X(36) DTSBE999
|
|
00489 VALUE 'QTR BALANCE <= TOLERANCE MAX. YRQ: '. DTSBE999
|
|
00490 10 MSG29-SLASH-QTR PIC X(04). DTSBE999
|
|
00491 10 FILLER PIC X(40) DTSBE999
|
|
00492 VALUE ' '. DTSBE999
|
|
00493 DTSBE999
|
|
00494 05 MSG30-TEXT. DTSBE999
|
|
00495 10 FILLER PIC X(40) DTSBE999
|
|
00496 VALUE 'CREDIT BALANCE <= TOLERANCE MAX. '. DTSBE999
|
|
00497 10 FILLER PIC X(40) DTSBE999
|
|
00498 VALUE ' '. DTSBE999
|
|
00499 DTSBE999
|
|
00500 05 MSG31-TEXT. DTSBE999
|
|
00501 10 FILLER PIC X(40) DTSBE999
|
|
00502 VALUE 'MPRF-PURSUED-RPT-CNT DOES NOT AGREE WITH'. DTSBE999
|
|
00503 10 FILLER PIC X(40) DTSBE999
|
|
00504 VALUE ' THE QUARTER RECORDS. '. DTSBE999
|
|
00505 DTSBE999
|
|
00506 05 MSG32-TEXT. DTSBE999
|
|
00507 10 FILLER PIC X(40) DTSBE999
|
|
00508 VALUE 'MPRF-TOT-BALANCE-AMT DOES NOT AGREE WITH'. DTSBE999
|
|
00509 10 FILLER PIC X(40) DTSBE999
|
|
00510 VALUE ' THE QUARTER RECORDS. '. DTSBE999
|
|
00511 DTSBE999
|
|
00512 05 MSG33-TEXT. DTSBE999
|
|
00513 10 FILLER PIC X(40) DTSBE999
|
|
00514 VALUE 'INCONSISTENT MDST-RECEIVED-DATE ENCOUNTE'. DTSBE999
|
|
00515 10 FILLER PIC X(13) DTSBE999
|
|
00516 VALUE 'RED. BATCH: '. DTSBE999
|
|
00517 10 MSG33-BATCH-NO PIC 9(05). DTSBE999
|
|
00518 10 FILLER PIC X(08) DTSBE999
|
|
00519 VALUE ' ITEM: '. DTSBE999
|
|
00520 10 MSG33-ITEM-NO PIC 9(03). DTSBE999
|
|
00521 10 FILLER PIC X(11) VALUE SPACES. DTSBE999
|
|
00522 DTSBE999
|
|
00523 05 MSG34-TEXT. DTSBE999
|
|
00524 10 FILLER PIC X(40) DTSBE999
|
|
00525 VALUE 'INCONSISTENT MQTR-TAX-DUE-DATE ENCOUNTER'. DTSBE999
|
|
00526 10 FILLER PIC X(10) DTSBE999
|
|
00527 VALUE 'ED. YRQ: '. DTSBE999
|
|
00528 10 MSG34-SLASH-QTR PIC X(04). DTSBE999
|
|
00529 10 FILLER PIC X(26) VALUE SPACES. DTSBE999
|
|
00530 DTSBE999
|
|
00531 05 MSG35-TEXT. DTSBE999
|
|
00532 10 FILLER PIC X(40) DTSBE999
|
|
00533 VALUE 'INCONSISTENT MQTR-RPT-DUE-DATE ENCOUNTER'. DTSBE999
|
|
00534 10 FILLER PIC X(10) DTSBE999
|
|
00535 VALUE 'ED. YRQ: '. DTSBE999
|
|
00536 10 MSG35-SLASH-QTR PIC X(04). DTSBE999
|
|
00537 10 FILLER PIC X(26) VALUE SPACES. DTSBE999
|
|
00538 DTSBE999
|
|
00539 05 MSG36-TEXT. DTSBE999
|
|
00540 10 FILLER PIC X(39) DTSBE999
|
|
00541 VALUE 'NEGATIVE MQTR-*-AMT ENCOUNTERED. YRQ: '. DTSBE999
|
|
00542 10 MSG36-SLASH-QTR PIC X(04). DTSBE999
|
|
00543 10 FILLER PIC X(08) DTSBE999
|
|
00544 VALUE ' ACCT: '. DTSBE999
|
|
00545 10 MSG36-ACCT-IND PIC X(02). DTSBE999
|
|
00546 10 FILLER PIC X(07) DTSBE999
|
|
00547 VALUE ' CAT: '. DTSBE999
|
|
00548 10 MSG36-ACCT-CAT PIC X(02). DTSBE999
|
|
00549 10 FILLER PIC X(18) VALUE SPACES. DTSBE999
|
|
00550 DTSBE999
|
|
00551 05 MSG37-TEXT. DTSBE999
|
|
00552 10 FILLER PIC X(40) DTSBE999
|
|
00553 VALUE 'INCONSISTENT MQTR-BALANCE-AMT ENCOUNTERE'. DTSBE999
|
|
00554 10 FILLER PIC X(09) DTSBE999
|
|
00555 VALUE 'D. YRQ: '. DTSBE999
|
|
00556 10 MSG37-SLASH-QTR PIC X(04). DTSBE999
|
|
00557 10 FILLER PIC X(08) DTSBE999
|
|
00558 VALUE ' ACCT: '. DTSBE999
|
|
00559 10 MSG37-ACCT-IND PIC X(02). DTSBE999
|
|
00560 10 FILLER PIC X(17) VALUE SPACES. DTSBE999
|
|
00561 DTSBE999
|
|
00562 05 MSG38-TEXT. DTSBE999
|
|
00563 10 FILLER PIC X(40) DTSBE999
|
|
00564 VALUE 'NOT WRITTEN OFF/MQTR-WRITTEN-OFF-AMT CON'. DTSBE999
|
|
00565 10 FILLER PIC X(13) DTSBE999
|
|
00566 VALUE 'FLICT. YRQ: '. DTSBE999
|
|
00567 10 MSG38-SLASH-QTR PIC X(04). DTSBE999
|
|
00568 10 FILLER PIC X(08) DTSBE999
|
|
00569 VALUE ' ACCT: '. DTSBE999
|
|
00570 10 MSG38-ACCT-IND PIC X(02). DTSBE999
|
|
00571 10 FILLER PIC X(13) VALUE SPACES. DTSBE999
|
|
00572 DTSBE999
|
|
00573 05 MSG39-TEXT. DTSBE999
|
|
00574 10 FILLER PIC X(40) DTSBE999
|
|
00575 VALUE 'WRITTEN OFF/MQTR-BALANCE-AMT CONFLICT. Y'. DTSBE999
|
|
00576 10 FILLER PIC X(04) DTSBE999
|
|
00577 VALUE 'RQ: '. DTSBE999
|
|
00578 10 MSG39-SLASH-QTR PIC X(04). DTSBE999
|
|
00579 10 FILLER PIC X(08) DTSBE999
|
|
00580 VALUE ' ACCT: '. DTSBE999
|
|
00581 10 MSG39-ACCT-IND PIC X(02). DTSBE999
|
|
00582 10 FILLER PIC X(22) VALUE SPACES. DTSBE999
|
|
00583 DTSBE999
|
|
00584 05 MSG40-TEXT. DTSBE999
|
|
00585 10 FILLER PIC X(40) DTSBE999
|
|
00586 VALUE 'INVALID MQTR-ACCT-IND ENCOUNTERED. YRQ:'. DTSBE999
|
|
00587 10 FILLER PIC X(01) DTSBE999
|
|
00588 VALUE ' '. DTSBE999
|
|
00589 10 MSG40-SLASH-QTR PIC X(04). DTSBE999
|
|
00590 10 FILLER PIC X(08) DTSBE999
|
|
00591 VALUE ' ACCT: '. DTSBE999
|
|
00592 10 MSG40-ACCT-IND PIC X(02). DTSBE999
|
|
00593 10 FILLER PIC X(25) VALUE SPACES. DTSBE999
|
|
00594 DTSBE999
|
|
00595 05 MSG41-TEXT. DTSBE999
|
|
00596 10 FILLER PIC X(40) DTSBE999
|
|
00597 VALUE 'UNKNOWN MDST-ACCT-IND. '. DTSBE999
|
|
00598 10 FILLER PIC X(40) DTSBE999
|
|
00599 VALUE ' '. DTSBE999
|
|
00600 DTSBE999
|
|
00601 05 MSG42-TEXT. DTSBE999
|
|
00602 10 FILLER PIC X(40) DTSBE999
|
|
00603 VALUE 'CHECKING QTR WHEN EMPLOYER NOT SUBJECT. '. DTSBE999
|
|
00604 10 FILLER PIC X(06) VALUE 'YRQ = '. DTSBE999
|
|
00605 10 MSG42-SLASH-QTR PIC X(04). DTSBE999
|
|
00606 10 FILLER PIC X(30) DTSBE999
|
|
00607 VALUE ' '. DTSBE999
|
|
00608 DTSBE999
|
|
00609 05 MSG43-TEXT. DTSBE999
|
|
00610 10 FILLER PIC X(40) DTSBE999
|
|
00611 VALUE 'WRITE OFF / CREDIT CONFLICT. '. DTSBE999
|
|
00612 10 FILLER PIC X(40) DTSBE999
|
|
00613 VALUE ' '. DTSBE999
|
|
00614 DTSBE999
|
|
00615 05 MSG44-TEXT. DTSBE999
|
|
00616 10 FILLER PIC X(40) DTSBE999
|
|
00617 VALUE 'MPRF-TOT-CREDIT-AMT / MDST-ACCT-CR-AVAIL'. DTSBE999
|
|
00618 10 FILLER PIC X(40) DTSBE999
|
|
00619 VALUE ' CONFLICT. '. DTSBE999
|
|
00620 DTSBE999
|
|
00621 05 MSG45-TEXT. DTSBE999
|
|
00622 10 FILLER PIC X(26) DTSBE999
|
|
00623 VALUE 'DST-BY-QTR RESIDUE. YRQ: '. DTSBE999
|
|
00624 10 MSG45-SLASH-QTR PIC X(04). DTSBE999
|
|
00625 10 FILLER PIC X(10) DTSBE999
|
|
00626 VALUE ' ACCT: '. DTSBE999
|
|
00627 10 MSG45-ACCT-LIT PIC X(02). DTSBE999
|
|
00628 10 FILLER PIC X(10) DTSBE999
|
|
00629 VALUE ' AMT: '. DTSBE999
|
|
00630 10 MSG45-AMT PIC ZZZ,ZZZ,ZZ9.99-. DTSBE999
|
|
00631 10 FILLER PIC X(13) VALUE SPACES. DTSBE999
|
|
00632 DTSBE999
|
|
00633 05 MSG46-TEXT. DTSBE999
|
|
00634 10 FILLER PIC X(27) DTSBE999
|
|
00635 VALUE 'MQTR RECORD MISSING. YRQ: '. DTSBE999
|
|
00636 10 MSG46-SLASH-QTR PIC X(04). DTSBE999
|
|
00637 10 FILLER PIC X(49) DTSBE999
|
|
00638 VALUE ' '. DTSBE999
|
|
00639 DTSBE999
|
|
00640 05 MSG47-TEXT. DTSBE999
|
|
00641 10 FILLER PIC X(40) DTSBE999
|
|
00642 VALUE 'INCONSISTENT MQTR-CURR-RPT-TYPE ENCOUNTE'. DTSBE999
|
|
00643 10 FILLER PIC X(11) DTSBE999
|
|
00644 VALUE 'RED. YRQ: '. DTSBE999
|
|
00645 10 MSG47-SLASH-QTR PIC X(04). DTSBE999
|
|
00646 10 FILLER PIC X(25) VALUE SPACES. DTSBE999
|
|
00647 DTSBE999
|
|
00648 05 MSG48-TEXT. DTSBE999
|
|
00649 10 FILLER PIC X(40) DTSBE999
|
|
00650 VALUE 'INCONSISTENT MQTR-PURSUED-RPT-IND ENCOUN'. DTSBE999
|
|
00651 10 FILLER PIC X(13) DTSBE999
|
|
00652 VALUE 'TERED. YRQ: '. DTSBE999
|
|
00653 10 MSG48-SLASH-QTR PIC X(04). DTSBE999
|
|
00654 10 FILLER PIC X(23) VALUE SPACES. DTSBE999
|
|
00655 DTSBE999
|
|
00656 05 MSG49-TEXT. DTSBE999
|
|
00657 10 FILLER PIC X(40) DTSBE999
|
|
00658 VALUE 'INCONSISTENT MQTR-UI-RATE ENCOUNTERED. '. DTSBE999
|
|
00659 10 FILLER PIC X(07) DTSBE999
|
|
00660 VALUE ' YRQ: '. DTSBE999
|
|
00661 10 MSG49-SLASH-QTR PIC X(04). DTSBE999
|
|
00662 10 FILLER PIC X(29) VALUE SPACES. DTSBE999
|
|
00663 DTSBE999
|
|
00664 05 MSG50-TEXT. DTSBE999
|
|
00665 10 FILLER PIC X(40) DTSBE999
|
|
00666 VALUE 'NON ZERO WAGE AMOUNT ENCOUNTERED ON PKUP'. DTSBE999
|
|
00667 10 FILLER PIC X(07) DTSBE999
|
|
00668 VALUE ' YRQ: '. DTSBE999
|
|
00669 10 MSG50-SLASH-QTR PIC X(04). DTSBE999
|
|
00670 10 FILLER PIC X(29) VALUE SPACES. DTSBE999
|
|
00671 DTSBE999
|
|
00672 05 MSG51-TEXT. DTSBE999
|
|
00673 10 FILLER PIC X(40) DTSBE999
|
|
00674 VALUE 'INVALID SELF INS WAGE AMOUNT ENCOUNTERED'. DTSBE999
|
|
00675 10 FILLER PIC X(07) DTSBE999
|
|
00676 VALUE ' YRQ: '. DTSBE999
|
|
00677 10 MSG51-SLASH-QTR PIC X(04). DTSBE999
|
|
00678 10 FILLER PIC X(29) VALUE SPACES. DTSBE999
|
|
00679 DTSBE999
|
|
00680 05 MSG52-TEXT. DTSBE999
|
|
00681 10 FILLER PIC X(40) DTSBE999
|
|
00682 VALUE 'INVALID RATED EMP WAGE AMT ENCOUNTERED '. DTSBE999
|
|
00683 10 FILLER PIC X(07) DTSBE999
|
|
00684 VALUE ' YRQ: '. DTSBE999
|
|
00685 10 MSG52-SLASH-QTR PIC X(04). DTSBE999
|
|
00686 10 FILLER PIC X(29) VALUE SPACES. DTSBE999
|
|
00687 DTSBE999
|
|
00688 05 MSG53-TEXT. DTSBE999
|
|
00689 10 FILLER PIC X(40) DTSBE999
|
|
00690 VALUE 'TOT WAGE - EXC WAGE NOT EQUAL TAX WAGE '. DTSBE999
|
|
00691 10 FILLER PIC X(07) DTSBE999
|
|
00692 VALUE ' YRQ: '. DTSBE999
|
|
00693 10 MSG53-SLASH-QTR PIC X(04). DTSBE999
|
|
00694 10 FILLER PIC X(29) VALUE SPACES. DTSBE999
|
|
00695 DTSBE999
|
|
00696 05 MSG54-TEXT. DTSBE999
|
|
00697 10 FILLER PIC X(40) DTSBE999
|
|
00698 VALUE 'MANUAL DUE DATE IND ENCOUNTERED ON PKUP '. DTSBE999
|
|
00699 10 FILLER PIC X(07) DTSBE999
|
|
00700 VALUE ' YRQ: '. DTSBE999
|
|
00701 10 MSG54-SLASH-QTR PIC X(04). DTSBE999
|
|
00702 10 FILLER PIC X(29) VALUE SPACES. DTSBE999
|
|
00703 DTSBE999
|
|
00704 05 MSG55-TEXT. DTSBE999
|
|
00705 10 FILLER PIC X(40) DTSBE999
|
|
00706 VALUE 'AUTOMATIC CHARGE IND ENCOUNTERED ON PKUP'. DTSBE999
|
|
00707 10 FILLER PIC X(07) DTSBE999
|
|
00708 VALUE ' YRQ: '. DTSBE999
|
|
00709 10 MSG55-SLASH-QTR PIC X(04). DTSBE999
|
|
00710 10 FILLER PIC X(29) VALUE SPACES. DTSBE999
|
|
00711 DTSBE999
|
|
00712 DTSBE999
|
|
00713 01 FILLER REDEFINES MSG-TABLE. DTSBE999
|
|
00714 05 MSG-TEXT OCCURS 55 PIC X(80). DTSBE999
|
|
00715 EJECT DTSBE999
|
|
00716 01 L001-LINK-AREA. DTSBE999
|
|
00717 ++INCLUDE DTSIL001 DTSBE999
|
|
00718 EJECT DTSBE999
|
|
00719 01 L004-LINK-AREA. DTSBE999
|
|
00720 ++INCLUDE DTSIL004 DTSBE999
|
|
00721 EJECT DTSBE999
|
|
00722 01 L101-LINK-AREA. DTSBE999
|
|
00723 ++INCLUDE DTSIL101 DTSBE999
|
|
00724 EJECT DTSBE999
|
|
00725 *01 L113-LINK-AREA. DTSBE999
|
|
00726 ***INCLUDE DTSIL113 DTSBE999
|
|
00727 EJECT DTSBE999
|
|
00728 01 L516-LINK-AREA. DTSBE999
|
|
00729 ++INCLUDE DTSIL516 DTSBE999
|
|
00730 EJECT DTSBE999
|
|
00731 01 L910-LINK-AREA. DTSBE999
|
|
00732 ++INCLUDE DTSIL910 DTSBE999
|
|
00733 SKIP3 DTSBE999
|
|
00734 01 MSKL-REC. DTSBE999
|
|
00735 ++INCLUDE DTSIMSKL DTSBE999
|
|
00736 SKIP3 DTSBE999
|
|
00737 01 MADJ-REC. DTSBE999
|
|
00738 ++INCLUDE DTSIMADJ DTSBE999
|
|
00739 SKIP3 DTSBE999
|
|
00740 01 MAPL-REC. DTSBE999
|
|
00741 ++INCLUDE DTSIMAPL DTSBE999
|
|
00742 SKIP3 DTSBE999
|
|
00743 01 MAUR-REC. DTSBE999
|
|
00744 ++INCLUDE DTSIMAUR DTSBE999
|
|
00745 SKIP3 DTSBE999
|
|
00746 01 MAUY-REC. DTSBE999
|
|
00747 ++INCLUDE DTSIMAUY DTSBE999
|
|
00748 SKIP3 DTSBE999
|
|
00749 01 MBAA-REC. DTSBE999
|
|
00750 ++INCLUDE DTSIMBAA DTSBE999
|
|
00751 SKIP3 DTSBE999
|
|
00752 01 MCOL-REC. DTSBE999
|
|
00753 ++INCLUDE DTSIMCOL DTSBE999
|
|
00754 SKIP3 DTSBE999
|
|
00755 01 MDPC-REC. DTSBE999
|
|
00756 ++INCLUDE DTSIMDPC DTSBE999
|
|
00757 SKIP3 DTSBE999
|
|
00758 01 MDST-REC. DTSBE999
|
|
00759 ++INCLUDE DTSIMDST DTSBE999
|
|
00760 SKIP3 DTSBE999
|
|
00761 01 MELF-REC. DTSBE999
|
|
00762 ++INCLUDE DTSIMELF DTSBE999
|
|
00763 SKIP3 DTSBE999
|
|
00764 01 MERA-REC. DTSBE999
|
|
00765 ++INCLUDE DTSIMERA DTSBE999
|
|
00766 SKIP3 DTSBE999
|
|
00767 01 MERD-REC. DTSBE999
|
|
00768 ++INCLUDE DTSIMERD DTSBE999
|
|
00769 SKIP3 DTSBE999
|
|
00770 01 MEVL-REC. DTSBE999
|
|
00771 ++INCLUDE DTSIMEVL DTSBE999
|
|
00772 SKIP3 DTSBE999
|
|
00773 01 MFAR-REC. DTSBE999
|
|
00774 ++INCLUDE DTSIMFAR DTSBE999
|
|
00775 SKIP3 DTSBE999
|
|
00776 01 MFAS-REC. DTSBE999
|
|
00777 ++INCLUDE DTSIMFAS DTSBE999
|
|
00778 SKIP3 DTSBE999
|
|
00779 01 MHDR-REC. DTSBE999
|
|
00780 ++INCLUDE DTSIMHDR DTSBE999
|
|
00781 SKIP3 DTSBE999
|
|
00782 01 MJRN-REC. DTSBE999
|
|
00783 ++INCLUDE DTSIMJRN DTSBE999
|
|
00784 SKIP3 DTSBE999
|
|
00785 01 MLEV-REC. DTSBE999
|
|
00786 ++INCLUDE DTSIMLEV DTSBE999
|
|
00787 SKIP3 DTSBE999
|
|
00788 01 MLIN-REC. DTSBE999
|
|
00789 ++INCLUDE DTSIMLIN DTSBE999
|
|
00790 SKIP3 DTSBE999
|
|
00791 01 MLOG-REC. DTSBE999
|
|
00792 ++INCLUDE DTSIMLOG DTSBE999
|
|
00793 SKIP3 DTSBE999
|
|
00794 01 MNTE-REC. DTSBE999
|
|
00795 ++INCLUDE DTSIMNTE DTSBE999
|
|
00796 SKIP3 DTSBE999
|
|
00797 01 MOPO-REC. DTSBE999
|
|
00798 ++INCLUDE DTSIMOPO DTSBE999
|
|
00799 SKIP3 DTSBE999
|
|
00800 01 MPAY-REC. DTSBE999
|
|
00801 ++INCLUDE DTSIMPAY DTSBE999
|
|
00802 SKIP3 DTSBE999
|
|
00803 01 MQTR-REC. DTSBE999
|
|
00804 ++INCLUDE DTSIMQTR DTSBE999
|
|
00805 SKIP3 DTSBE999
|
|
00806 01 MRCT-REC. DTSBE999
|
|
00807 ++INCLUDE DTSIMRCT DTSBE999
|
|
00808 SKIP3 DTSBE999
|
|
00809 01 MREL-REC. DTSBE999
|
|
00810 ++INCLUDE DTSIMREL DTSBE999
|
|
00811 SKIP3 DTSBE999
|
|
00812 01 MREV-REC. DTSBE999
|
|
00813 ++INCLUDE DTSIMREV DTSBE999
|
|
00814 SKIP3 DTSBE999
|
|
00815 01 MRPT-REC. DTSBE999
|
|
00816 ++INCLUDE DTSIMRPT DTSBE999
|
|
00817 SKIP3 DTSBE999
|
|
00818 01 MRTE-REC. DTSBE999
|
|
00819 ++INCLUDE DTSIMRTE DTSBE999
|
|
00820 SKIP3 DTSBE999
|
|
00821 01 MSOL-REC. DTSBE999
|
|
00822 ++INCLUDE DTSIMSOL DTSBE999
|
|
00823 SKIP3 DTSBE999
|
|
00824 01 MTAA-REC. DTSBE999
|
|
00825 ++INCLUDE DTSIMTAA DTSBE999
|
|
00826 SKIP3 DTSBE999
|
|
00827 01 MTAD-REC. DTSBE999
|
|
00828 ++INCLUDE DTSIMTAD DTSBE999
|
|
00829 SKIP3 DTSBE999
|
|
00830 01 MTCK-REC. DTSBE999
|
|
00831 ++INCLUDE DTSIMTCK DTSBE999
|
|
00832 EJECT DTSBE999
|
|
00833 01 L921-LINK-AREA. DTSBE999
|
|
00834 ++INCLUDE DTSIL921 DTSBE999
|
|
00835 SKIP3 DTSBE999
|
|
00836 01 ISKL-REC. DTSBE999
|
|
00837 ++INCLUDE DTSIISKL DTSBE999
|
|
00838 EJECT DTSBE999
|
|
00839 01 IEIN-REC. DTSBE999
|
|
00840 ++INCLUDE DTSIIEIN DTSBE999
|
|
00841 SKIP3 DTSBE999
|
|
00842 01 IPES-REC. DTSBE999
|
|
00843 ++INCLUDE DTSIIPES DTSBE999
|
|
00844 EJECT DTSBE999
|
|
00845 01 L931-LINK-AREA. DTSBE999
|
|
00846 ++INCLUDE DTSIL931 DTSBE999
|
|
00847 SKIP3 DTSBE999
|
|
00848 01 FSKL-REC. DTSBE999
|
|
00849 ++INCLUDE DTSIFSKL DTSBE999
|
|
00850 EJECT DTSBE999
|
|
00851 01 FQTR-REC. DTSBE999
|
|
00852 ++INCLUDE DTSIFQTR DTSBE999
|
|
00853 EJECT DTSBE999
|
|
00854 01 R907-REC. DTSBE999
|
|
00855 ++INCLUDE DTSIR907 DTSBE999
|
|
00856 EJECT DTSBE999
|
|
00857 01 CACT-LITERALS. DTSBE999
|
|
00858 ++INCLUDE DTSICACT DTSBE999
|
|
00859 EJECT DTSBE999
|
|
00860 LINKAGE SECTION. DTSBE999
|
|
00861 DTSBE999
|
|
00862 01 LECM-LINK-AREA. DTSBE999
|
|
00863 ++INCLUDE DTSILECM DTSBE999
|
|
00864 DTSBE999
|
|
00865 DTSBE999
|
|
00866 10 FILLER REDEFINES LECM-EXTRACT-PARMS. DTSBE999
|
|
00867 15 LECM-PARM-FIRST-EMP-NO-X PIC X(06). DTSBE999
|
|
00868 15 LECM-PARM-FIRST-EMP-NO REDEFINES DTSBE999
|
|
00869 LECM-PARM-FIRST-EMP-NO-X PIC 9(06). DTSBE999
|
|
00870 15 FILLER PIC X(01). DTSBE999
|
|
00871 15 LECM-PARM-LAST-EMP-NO-X PIC X(06). DTSBE999
|
|
00872 15 LECM-PARM-LAST-EMP-NO REDEFINES DTSBE999
|
|
00873 LECM-PARM-LAST-EMP-NO-X PIC 9(06). DTSBE999
|
|
00874 15 FILLER PIC X(55). DTSBE999
|
|
00875 EJECT DTSBE999
|
|
00876 01 MPRF-LINK-REC. DTSBE999
|
|
00877 ++INCLUDE DTSIMPRF DTSBE999
|
|
00878 EJECT DTSBE999
|
|
00879 PROCEDURE DIVISION USING LECM-LINK-AREA DTSBE999
|
|
00880 MPRF-LINK-REC. DTSBE999
|
|
00881 DTSBE999
|
|
00882 DTSBE999
|
|
00883 IF LECM-PROCESS-88 DTSBE999
|
|
00884 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBE999
|
|
00885 ELSE DTSBE999
|
|
00886 IF LECM-INITIALIZE-88 DTSBE999
|
|
00887 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBE999
|
|
00888 ELSE DTSBE999
|
|
00889 IF LECM-TERMINATE-88 DTSBE999
|
|
00890 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBE999
|
|
00891 ELSE DTSBE999
|
|
00892 MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED' DTSBE999
|
|
00893 TO ABEND-MSG DTSBE999
|
|
00894 PERFORM S999-ABEND THRU S999-EXIT. DTSBE999
|
|
00895 DTSBE999
|
|
00896 DTSBE999
|
|
00897 GOBACK. DTSBE999
|
|
00898 EJECT DTSBE999
|
|
00899 I0000-INITIALIZE. DTSBE999
|
|
00900 MOVE LECM-TRACE-IND TO L910-TRACE-IND DTSBE999
|
|
00901 L921-TRACE-IND DTSBE999
|
|
00902 L516-TRACE-IND. DTSBE999
|
|
00903 DTSBE999
|
|
00904 MOVE WRK-MOD-NAME TO L910-MOD-NAME DTSBE999
|
|
00905 L921-MOD-NAME DTSBE999
|
|
00906 R907-MODULE-NAME. DTSBE999
|
|
00907 DTSBE999
|
|
00908 DTSBE999
|
|
00909 MOVE LENGTH OF R907-REC TO R907-LENGTH. DTSBE999
|
|
00910 DTSBE999
|
|
00911 MOVE '907' TO R907-REC-TYPE. DTSBE999
|
|
00912 DTSBE999
|
|
00913 DTSBE999
|
|
00914 PERFORM I1000-EDIT-AND-DEFAULT-PARMS THRU I1000-EXIT. DTSBE999
|
|
00915 DTSBE999
|
|
00916 DTSBE999
|
|
00917 MOVE +0 TO MAX-DST-BY-QTR-CNT-USED DTSBE999
|
|
00918 MAX-DST-BY-DOC-CNT-USED DTSBE999
|
|
00919 MAX-SOL-CNT-USED DTSBE999
|
|
00920 MAX-RTE-CNT-USED. DTSBE999
|
|
00921 DTSBE999
|
|
00922 DTSBE999
|
|
00923 SET LECM-MST-OPEN-READ-88 TO TRUE. DTSBE999
|
|
00924 DTSBE999
|
|
00925 SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBE999
|
|
00926 I0000-EXIT. DTSBE999
|
|
00927 EXIT. DTSBE999
|
|
00928 EJECT DTSBE999
|
|
00929 I1000-EDIT-AND-DEFAULT-PARMS. DTSBE999
|
|
00930 PERFORM I1100-FIRST-EMP-NO THRU I1100-EXIT. DTSBE999
|
|
00931 DTSBE999
|
|
00932 DTSBE999
|
|
00933 PERFORM I1200-LAST-EMP-NO THRU I1200-EXIT. DTSBE999
|
|
00934 DTSBE999
|
|
00935 DTSBE999
|
|
00936 IF WRK-PARM-LAST-EMP-NO < WRK-PARM-FIRST-EMP-NO DTSBE999
|
|
00937 MOVE 'LAST-EMP-NO < FIRST-EMP-NO' DTSBE999
|
|
00938 TO ABEND-MSG DTSBE999
|
|
00939 PERFORM S999-ABEND THRU S999-EXIT. DTSBE999
|
|
00940 I1000-EXIT. DTSBE999
|
|
00941 EXIT. DTSBE999
|
|
00942 SKIP3 DTSBE999
|
|
00943 I1100-FIRST-EMP-NO. DTSBE999
|
|
00944 IF LECM-PARM-FIRST-EMP-NO-X = SPACES DTSBE999
|
|
00945 MOVE +0 TO WRK-PARM-FIRST-EMP-NO DTSBE999
|
|
00946 ELSE DTSBE999
|
|
00947 IF LECM-PARM-FIRST-EMP-NO NUMERIC DTSBE999
|
|
00948 MOVE LECM-PARM-FIRST-EMP-NO DTSBE999
|
|
00949 TO WRK-PARM-FIRST-EMP-NO DTSBE999
|
|
00950 ELSE DTSBE999
|
|
00951 MOVE 'FIRST-EMP-NO NOT NUMERIC' DTSBE999
|
|
00952 TO ABEND-MSG DTSBE999
|
|
00953 PERFORM S999-ABEND THRU S999-EXIT. DTSBE999
|
|
00954 I1100-EXIT. DTSBE999
|
|
00955 EXIT. DTSBE999
|
|
00956 SKIP3 DTSBE999
|
|
00957 I1200-LAST-EMP-NO. DTSBE999
|
|
00958 IF LECM-PARM-LAST-EMP-NO-X = SPACES DTSBE999
|
|
00959 MOVE +9999999 TO WRK-PARM-LAST-EMP-NO DTSBE999
|
|
00960 ELSE DTSBE999
|
|
00961 IF LECM-PARM-LAST-EMP-NO NUMERIC DTSBE999
|
|
00962 MOVE LECM-PARM-LAST-EMP-NO DTSBE999
|
|
00963 TO WRK-PARM-LAST-EMP-NO DTSBE999
|
|
00964 ELSE DTSBE999
|
|
00965 MOVE 'LAST-EMP-NO NOT NUMERIC' DTSBE999
|
|
00966 TO ABEND-MSG DTSBE999
|
|
00967 PERFORM S999-ABEND THRU S999-EXIT. DTSBE999
|
|
00968 I1200-EXIT. DTSBE999
|
|
00969 EXIT. DTSBE999
|
|
00970 EJECT DTSBE999
|
|
00971 P0000-PROCESS. DTSBE999
|
|
00972 IF (MPRF-EMP-NO < WRK-PARM-FIRST-EMP-NO) DTSBE999
|
|
00973 OR DTSBE999
|
|
00974 (MPRF-EMP-NO > WRK-PARM-LAST-EMP-NO) DTSBE999
|
|
00975 GO TO P0000-EXIT. DTSBE999
|
|
00976 DTSBE999
|
|
00977 DTSBE999
|
|
00978 PERFORM P1110-SET-SOL-AREA THRU P1110-EXIT. DTSBE999
|
|
00979 DTSBE999
|
|
00980 PERFORM P1120-CHECK-SOL-CONSISTENCY THRU P1120-EXIT. DTSBE999
|
|
00981 DTSBE999
|
|
00982 PERFORM P1130-CHECK-EMP-CLASS THRU P1130-EXIT. DTSBE999
|
|
00983 DTSBE999
|
|
00984 PERFORM P1140-CHECK-EMP-STATUS THRU P1140-EXIT. DTSBE999
|
|
00985 DTSBE999
|
|
00986 DTSBE999
|
|
00987 PERFORM P1210-SET-TAD-AREA THRU P1210-EXIT. DTSBE999
|
|
00988 DTSBE999
|
|
00989 PERFORM P1220-CHECK-ADDR-IND THRU P1220-EXIT. DTSBE999
|
|
00990 DTSBE999
|
|
00991 PERFORM P1230-CHECK-FLD-ZIP-ST THRU P1230-EXIT. DTSBE999
|
|
00992 DTSBE999
|
|
00993 *****PERFORM P1240-CHECK-JS-ZIP THRU P1240-EXIT. DTSBE999
|
|
00994 DTSBE999
|
|
00995 DTSBE999
|
|
00996 PERFORM P1310-CHECK-BANKRUPT-OPEN-IND THRU P1310-EXIT. DTSBE999
|
|
00997 DTSBE999
|
|
00998 PERFORM P1320-CHECK-MAPL-IND THRU P1320-EXIT. DTSBE999
|
|
00999 DTSBE999
|
|
01000 PERFORM P1330-CHECK-MLIN-IND THRU P1330-EXIT. DTSBE999
|
|
01001 DTSBE999
|
|
01002 PERFORM P1340-CHECK-MDPC-IND THRU P1340-EXIT. DTSBE999
|
|
01003 DTSBE999
|
|
01004 PERFORM P1350-CHECK-MFAS-IND THRU P1350-EXIT. DTSBE999
|
|
01005 DTSBE999
|
|
01006 PERFORM P1360-CHECK-LAST-ARCHIVED-YRQ THRU P1360-EXIT. DTSBE999
|
|
01007 DTSBE999
|
|
01008 DTSBE999
|
|
01009 PERFORM P1410-SET-QTR-AREA THRU P1410-EXIT. DTSBE999
|
|
01010 DTSBE999
|
|
01011 PERFORM P1420-CHECK-PURSUED-RPT-CNT THRU P1420-EXIT. DTSBE999
|
|
01012 DTSBE999
|
|
01013 PERFORM P1430-CHECK-TOT-BALANCE-AMT THRU P1430-EXIT. DTSBE999
|
|
01014 DTSBE999
|
|
01015 DTSBE999
|
|
01016 MOVE +0 TO DST-BY-QTR-CNT DTSBE999
|
|
01017 DST-BY-DOC-CNT. DTSBE999
|
|
01018 DTSBE999
|
|
01019 PERFORM P2100-SET-DST-BY-TABLES THRU P2100-EXIT. DTSBE999
|
|
01020 DTSBE999
|
|
01021 PERFORM P2200-CHECK-MQTR THRU P2200-EXIT. DTSBE999
|
|
01022 DTSBE999
|
|
01023 PERFORM P2300-CHECK-MPAY THRU P2300-EXIT. DTSBE999
|
|
01024 DTSBE999
|
|
01025 IF DST-BY-QTR-CNT > MAX-DST-BY-QTR-CNT-USED DTSBE999
|
|
01026 MOVE DST-BY-QTR-CNT TO MAX-DST-BY-QTR-CNT-USED. DTSBE999
|
|
01027 DTSBE999
|
|
01028 IF DST-BY-DOC-CNT > MAX-DST-BY-DOC-CNT-USED DTSBE999
|
|
01029 MOVE DST-BY-DOC-CNT TO MAX-DST-BY-DOC-CNT-USED. DTSBE999
|
|
01030 P0000-EXIT. DTSBE999
|
|
01031 EXIT. DTSBE999
|
|
01032 EJECT DTSBE999
|
|
01033 P1110-SET-SOL-AREA. DTSBE999
|
|
01034 ***** DTSBE999
|
|
01035 * DTSBE999
|
|
01036 * SCAN MSOL RECORDS, SETTING SOL-INDICATORS DATA ELEMENTS. DTSBE999
|
|
01037 * DTSBE999
|
|
01038 * IF MSOL-INACT-WITHDRAWN-88, THEN MSOL RECORD IS NOT USED DTSBE999
|
|
01039 * IN SOL-SMALLEST-FIRST-LIAB-YRQ AND SOL-GREATEST-LAST-LIAB DTSBE999
|
|
01040 * -YRQ. DTSBE999
|
|
01041 * DTSBE999
|
|
01042 ***** DTSBE999
|
|
01043 DTSBE999
|
|
01044 INITIALIZE SOL-INDICATORS. DTSBE999
|
|
01045 DTSBE999
|
|
01046 MOVE ALL-NINES-YRQ TO SOL-SMALLEST-FIRST-LIAB-YRQ. DTSBE999
|
|
01047 DTSBE999
|
|
01048 DTSBE999
|
|
01049 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBE999
|
|
01050 DTSBE999
|
|
01051 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBE999
|
|
01052 DTSBE999
|
|
01053 SET MSKL-SOL-88 TO TRUE. DTSBE999
|
|
01054 DTSBE999
|
|
01055 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE999
|
|
01056 DTSBE999
|
|
01057 MOVE +0 TO SOL-CNT. DTSBE999
|
|
01058 DTSBE999
|
|
01059 PERFORM P1111-SCAN-SOL THRU P1111-EXIT DTSBE999
|
|
01060 UNTIL L910-NO-REC-88. DTSBE999
|
|
01061 DTSBE999
|
|
01062 DTSBE999
|
|
01063 IF SOL-CNT > MAX-SOL-CNT-USED DTSBE999
|
|
01064 MOVE SOL-CNT TO MAX-SOL-CNT-USED. DTSBE999
|
|
01065 DTSBE999
|
|
01066 DTSBE999
|
|
01067 IF SOL-SMALLEST-FIRST-LIAB-YRQ = ALL-NINES-YRQ DTSBE999
|
|
01068 MOVE +0 TO SOL-SMALLEST-FIRST-LIAB-YRQ. DTSBE999
|
|
01069 P1110-EXIT. DTSBE999
|
|
01070 EXIT. DTSBE999
|
|
01071 SKIP3 DTSBE999
|
|
01072 P1111-SCAN-SOL. DTSBE999
|
|
01073 MOVE MSKL-REC TO MSOL-REC. DTSBE999
|
|
01074 DTSBE999
|
|
01075 DTSBE999
|
|
01076 IF MSOL-LIAB-REG-88 DTSBE999
|
|
01077 MOVE YES TO SOL-LIAB-RATED-IND DTSBE999
|
|
01078 ELSE DTSBE999
|
|
01079 IF MSOL-LIAB-SELF-88 DTSBE999
|
|
01080 MOVE YES TO SOL-LIAB-SELF-INS-IND. DTSBE999
|
|
01081 DTSBE999
|
|
01082 DTSBE999
|
|
01083 IF MSOL-INACT-ACTIVE-88 DTSBE999
|
|
01084 ADD +1 TO SOL-LIAB-ACTIVE-CNT. DTSBE999
|
|
01085 DTSBE999
|
|
01086 DTSBE999
|
|
01087 IF NOT MSOL-INACT-WITHDRAWN-88 DTSBE999
|
|
01088 PERFORM P1111A-TABLE-SOL THRU P1111A-EXIT DTSBE999
|
|
01089 IF MSOL-FIRST-LIAB-YRQ < SOL-SMALLEST-FIRST-LIAB-YRQ DTSBE999
|
|
01090 MOVE MSOL-FIRST-LIAB-YRQ DTSBE999
|
|
01091 TO SOL-SMALLEST-FIRST-LIAB-YRQ DTSBE999
|
|
01092 END-IF DTSBE999
|
|
01093 IF MSOL-LAST-LIAB-YRQ > SOL-LARGEST-LAST-LIAB-YRQ DTSBE999
|
|
01094 MOVE MSOL-LAST-LIAB-YRQ DTSBE999
|
|
01095 TO SOL-LARGEST-LAST-LIAB-YRQ DTSBE999
|
|
01096 END-IF DTSBE999
|
|
01097 END-IF. DTSBE999
|
|
01098 DTSBE999
|
|
01099 DTSBE999
|
|
01100 PERFORM P1111B-CHECK-LIAB-YRQ THRU P1111B-EXIT. DTSBE999
|
|
01101 DTSBE999
|
|
01102 DTSBE999
|
|
01103 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE999
|
|
01104 P1111-EXIT. DTSBE999
|
|
01105 EXIT. DTSBE999
|
|
01106 SKIP3 DTSBE999
|
|
01107 P1111A-TABLE-SOL. DTSBE999
|
|
01108 IF SOL-CNT < SOL-MAX DTSBE999
|
|
01109 NEXT SENTENCE DTSBE999
|
|
01110 ELSE DTSBE999
|
|
01111 MOVE 'P1111A-1 LOGIC ERROR' TO ABEND-MSG DTSBE999
|
|
01112 PERFORM S999-ABEND THRU S999-EXIT. DTSBE999
|
|
01113 DTSBE999
|
|
01114 ADD +1 TO SOL-CNT. DTSBE999
|
|
01115 DTSBE999
|
|
01116 MOVE MSOL-LIAB-DATE DTSBE999
|
|
01117 TO SOL-FIRST-LIAB-DATE (SOL-CNT). DTSBE999
|
|
01118 DTSBE999
|
|
01119 MOVE MSOL-INACT-DATE DTSBE999
|
|
01120 TO SOL-LAST-LIAB-DATE (SOL-CNT). DTSBE999
|
|
01121 DTSBE999
|
|
01122 MOVE MSOL-FIRST-LIAB-YRQ DTSBE999
|
|
01123 TO SOL-FIRST-LIAB-YRQ (SOL-CNT). DTSBE999
|
|
01124 DTSBE999
|
|
01125 MOVE MSOL-LAST-LIAB-YRQ DTSBE999
|
|
01126 TO SOL-LAST-LIAB-YRQ (SOL-CNT). DTSBE999
|
|
01127 DTSBE999
|
|
01128 IF MSOL-LIAB-ESTB-DATE = MSOL-LIAB-DATE DTSBE999
|
|
01129 MOVE MSOL-FIRST-LIAB-YRQ DTSBE999
|
|
01130 TO SOL-ESTB-LIAB-YRQ (SOL-CNT) DTSBE999
|
|
01131 ELSE DTSBE999
|
|
01132 MOVE MSOL-LIAB-ESTB-DATE TO L004-DATE DTSBE999
|
|
01133 PERFORM S004-FROM-DATE THRU S004-EXIT DTSBE999
|
|
01134 MOVE L004-QTR-5-9 TO SOL-ESTB-LIAB-YRQ (SOL-CNT). DTSBE999
|
|
01135 P1111A-EXIT. DTSBE999
|
|
01136 EXIT. DTSBE999
|
|
01137 SKIP3 DTSBE999
|
|
01138 P1111B-CHECK-LIAB-YRQ. DTSBE999
|
|
01139 IF MSOL-INACT-WITHDRAWN-88 DTSBE999
|
|
01140 IF (MSOL-FIRST-LIAB-YRQ = +0) DTSBE999
|
|
01141 AND DTSBE999
|
|
01142 (MSOL-LAST-LIAB-YRQ = +0) DTSBE999
|
|
01143 GO TO P1111B-EXIT DTSBE999
|
|
01144 ELSE DTSBE999
|
|
01145 MOVE 05 TO MSG-NO DTSBE999
|
|
01146 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBE999
|
|
01147 GO TO P1111B-EXIT. DTSBE999
|
|
01148 DTSBE999
|
|
01149 MOVE MSOL-LIAB-DATE TO L004-DATE. DTSBE999
|
|
01150 DTSBE999
|
|
01151 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSBE999
|
|
01152 DTSBE999
|
|
01153 IF L004-QTR-5-9 = MSOL-FIRST-LIAB-YRQ DTSBE999
|
|
01154 NEXT SENTENCE DTSBE999
|
|
01155 ELSE DTSBE999
|
|
01156 MOVE 06 TO MSG-NO DTSBE999
|
|
01157 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
01158 DTSBE999
|
|
01159 IF MSOL-INACT-DATE = ALL-NINES-DATE DTSBE999
|
|
01160 IF MSOL-LAST-LIAB-YRQ = ALL-NINES-YRQ DTSBE999
|
|
01161 NEXT SENTENCE DTSBE999
|
|
01162 ELSE DTSBE999
|
|
01163 MOVE 07 TO MSG-NO DTSBE999
|
|
01164 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBE999
|
|
01165 ELSE DTSBE999
|
|
01166 MOVE MSOL-INACT-DATE TO L004-DATE DTSBE999
|
|
01167 PERFORM S004-FROM-DATE THRU S004-EXIT DTSBE999
|
|
01168 IF L004-QTR-5-9 = MSOL-LAST-LIAB-YRQ DTSBE999
|
|
01169 NEXT SENTENCE DTSBE999
|
|
01170 ELSE DTSBE999
|
|
01171 MOVE 07 TO MSG-NO DTSBE999
|
|
01172 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
01173 P1111B-EXIT. DTSBE999
|
|
01174 EXIT. DTSBE999
|
|
01175 SKIP3 DTSBE999
|
|
01176 P1120-CHECK-SOL-CONSISTENCY. DTSBE999
|
|
01177 ***** DTSBE999
|
|
01178 * DTSBE999
|
|
01179 * 1. SOL-LIAB-ACTIVE-CNT EQUAL TO 0 OR 1. DTSBE999
|
|
01180 * DTSBE999
|
|
01181 * 2. ZERO OR ONE OF SOL-LIAB-RATED-IND AND DTSBE999
|
|
01182 * SOL-LIAB-SELF-INS-IND IS EQUAL TO 'Y'. DTSBE999
|
|
01183 * DTSBE999
|
|
01184 ***** DTSBE999
|
|
01185 DTSBE999
|
|
01186 IF SOL-LIAB-ACTIVE-CNT > +1 DTSBE999
|
|
01187 MOVE 01 TO MSG-NO DTSBE999
|
|
01188 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
01189 DTSBE999
|
|
01190 IF SOL-LIAB-RATED-IND = YES DTSBE999
|
|
01191 IF SOL-LIAB-SELF-INS-IND = YES DTSBE999
|
|
01192 MOVE 02 TO MSG-NO DTSBE999
|
|
01193 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
01194 P1120-EXIT. DTSBE999
|
|
01195 EXIT. DTSBE999
|
|
01196 SKIP3 DTSBE999
|
|
01197 P1130-CHECK-EMP-CLASS. DTSBE999
|
|
01198 ***** DTSBE999
|
|
01199 * DTSBE999
|
|
01200 * 1. IS MPRF-EMP-CLASS CONSISTENT WITH SOL-INDICATORS? DTSBE999
|
|
01201 * DTSBE999
|
|
01202 ***** DTSBE999
|
|
01203 DTSBE999
|
|
01204 IF MPRF-CLASS-RATED-88 DTSBE999
|
|
01205 IF SOL-LIAB-RATED-IND = YES DTSBE999
|
|
01206 GO TO P1130-EXIT DTSBE999
|
|
01207 ELSE DTSBE999
|
|
01208 MOVE MPRF-EMP-CLASS TO MSG03-FIELD1 DTSBE999
|
|
01209 MOVE 03 TO MSG-NO DTSBE999
|
|
01210 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBE999
|
|
01211 GO TO P1130-EXIT. DTSBE999
|
|
01212 DTSBE999
|
|
01213 DTSBE999
|
|
01214 IF MPRF-CLASS-SELF-INS-88 DTSBE999
|
|
01215 IF SOL-LIAB-SELF-INS-IND = YES DTSBE999
|
|
01216 GO TO P1130-EXIT DTSBE999
|
|
01217 ELSE DTSBE999
|
|
01218 MOVE MPRF-EMP-CLASS TO MSG03-FIELD1 DTSBE999
|
|
01219 MOVE 03 TO MSG-NO DTSBE999
|
|
01220 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBE999
|
|
01221 GO TO P1130-EXIT. DTSBE999
|
|
01222 DTSBE999
|
|
01223 IF SOL-LIAB-RATED-IND = SPACE DTSBE999
|
|
01224 AND DTSBE999
|
|
01225 SOL-LIAB-SELF-INS-IND = SPACE DTSBE999
|
|
01226 GO TO P1130-EXIT. DTSBE999
|
|
01227 DTSBE999
|
|
01228 MOVE MPRF-EMP-CLASS TO MSG03-FIELD1. DTSBE999
|
|
01229 DTSBE999
|
|
01230 MOVE 03 TO MSG-NO. DTSBE999
|
|
01231 DTSBE999
|
|
01232 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
01233 P1130-EXIT. DTSBE999
|
|
01234 EXIT. DTSBE999
|
|
01235 SKIP3 DTSBE999
|
|
01236 P1140-CHECK-EMP-STATUS. DTSBE999
|
|
01237 ***** DTSBE999
|
|
01238 * DTSBE999
|
|
01239 * 1. IS MPRF-EMP-STATUS CONSISTENT WITH SOL-INDICATORS? DTSBE999
|
|
01240 * DTSBE999
|
|
01241 ***** DTSBE999
|
|
01242 DTSBE999
|
|
01243 IF MPRF-STATUS-ACT-88 DTSBE999
|
|
01244 IF SOL-LIAB-ACTIVE-CNT = +1 DTSBE999
|
|
01245 GO TO P1140-EXIT. DTSBE999
|
|
01246 DTSBE999
|
|
01247 DTSBE999
|
|
01248 IF MPRF-STATUS-INACT-88 DTSBE999
|
|
01249 IF SOL-LIAB-ACTIVE-CNT = +0 DTSBE999
|
|
01250 IF SOL-LIAB-RATED-IND = YES DTSBE999
|
|
01251 OR DTSBE999
|
|
01252 SOL-LIAB-SELF-INS-IND = YES DTSBE999
|
|
01253 GO TO P1140-EXIT. DTSBE999
|
|
01254 DTSBE999
|
|
01255 DTSBE999
|
|
01256 IF NOT MPRF-STATUS-SUB-88 DTSBE999
|
|
01257 IF SOL-LARGEST-LAST-LIAB-YRQ = +0 DTSBE999
|
|
01258 GO TO P1140-EXIT. DTSBE999
|
|
01259 DTSBE999
|
|
01260 DTSBE999
|
|
01261 MOVE MPRF-EMP-STATUS TO MSG04-FIELD1. DTSBE999
|
|
01262 DTSBE999
|
|
01263 MOVE 04 TO MSG-NO. DTSBE999
|
|
01264 DTSBE999
|
|
01265 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
01266 P1140-EXIT. DTSBE999
|
|
01267 EXIT. DTSBE999
|
|
01268 EJECT DTSBE999
|
|
01269 P1210-SET-TAD-AREA. DTSBE999
|
|
01270 ***** DTSBE999
|
|
01271 * DTSBE999
|
|
01272 * SCAN MTAD RECORDS, SETTING TAD-INDICATORS DATA ELEMENTS. DTSBE999
|
|
01273 * DTSBE999
|
|
01274 ***** DTSBE999
|
|
01275 DTSBE999
|
|
01276 INITIALIZE TAD-INDICATORS. DTSBE999
|
|
01277 DTSBE999
|
|
01278 PERFORM DTSBE999
|
|
01279 VARYING WRK-CNT FROM 1 BY 1 DTSBE999
|
|
01280 UNTIL WRK-CNT > 2 DTSBE999
|
|
01281 MOVE LOW-VALUE TO MTAD-KEY-AREA DTSBE999
|
|
01282 MOVE MPRF-EMP-NO TO MTAD-EMP-NO DTSBE999
|
|
01283 SET MTAD-TAD-88 TO TRUE DTSBE999
|
|
01284 MOVE WRK-CNT TO MTAD-ID-NO DTSBE999
|
|
01285 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA DTSBE999
|
|
01286 PERFORM S910-READ THRU S910-EXIT DTSBE999
|
|
01287 IF L910-OK-88 DTSBE999
|
|
01288 MOVE MSKL-REC TO MTAD-REC DTSBE999
|
|
01289 MOVE YES TO TAD-EXISTS-IND (WRK-CNT) DTSBE999
|
|
01290 MOVE MTAD-ZIP TO TAD-ZIP (WRK-CNT) DTSBE999
|
|
01291 MOVE MTAD-ST TO TAD-ST (WRK-CNT) DTSBE999
|
|
01292 END-IF DTSBE999
|
|
01293 END-PERFORM. DTSBE999
|
|
01294 P1210-EXIT. DTSBE999
|
|
01295 EXIT. DTSBE999
|
|
01296 SKIP3 DTSBE999
|
|
01297 P1220-CHECK-ADDR-IND. DTSBE999
|
|
01298 ***** DTSBE999
|
|
01299 * DTSBE999
|
|
01300 * 1. ARE MPRF-TAX-REC-ADDR-IND AND MPRF-BEN-MAIL-ADDR-IND DTSBE999
|
|
01301 * CONSISTENT WITH EXISTENCE OF ADDRESS RECORD OCCURRENCES? DTSBE999
|
|
01302 * DTSBE999
|
|
01303 ***** DTSBE999
|
|
01304 DTSBE999
|
|
01305 IF TAD-EXISTS-IND (1) = SPACE DTSBE999
|
|
01306 MOVE 11 TO MSG-NO DTSBE999
|
|
01307 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
01308 DTSBE999
|
|
01309 DTSBE999
|
|
01310 IF MPRF-TAX-REC-ADDR-YES-88 DTSBE999
|
|
01311 IF TAD-EXISTS-IND (2) = YES DTSBE999
|
|
01312 NEXT SENTENCE DTSBE999
|
|
01313 ELSE DTSBE999
|
|
01314 MOVE 12 TO MSG-NO DTSBE999
|
|
01315 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBE999
|
|
01316 ELSE DTSBE999
|
|
01317 IF TAD-EXISTS-IND (2) = SPACES DTSBE999
|
|
01318 NEXT SENTENCE DTSBE999
|
|
01319 ELSE DTSBE999
|
|
01320 MOVE 12 TO MSG-NO DTSBE999
|
|
01321 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
01322 DTSBE999
|
|
01323 DTSBE999
|
|
01324 MOVE LOW-VALUES TO MBAA-KEY-AREA. DTSBE999
|
|
01325 DTSBE999
|
|
01326 MOVE MPRF-EMP-NO TO MBAA-EMP-NO. DTSBE999
|
|
01327 DTSBE999
|
|
01328 SET MBAA-BAA-88 TO TRUE. DTSBE999
|
|
01329 DTSBE999
|
|
01330 SET MBAA-PRIMARY-BEN-MAIL-ADDR-88 TO TRUE. DTSBE999
|
|
01331 DTSBE999
|
|
01332 MOVE MBAA-KEY-AREA TO MSKL-KEY-AREA. DTSBE999
|
|
01333 DTSBE999
|
|
01334 PERFORM S910-READ THRU S910-EXIT. DTSBE999
|
|
01335 DTSBE999
|
|
01336 IF L910-OK-88 DTSBE999
|
|
01337 MOVE MSKL-REC TO MBAA-REC DTSBE999
|
|
01338 IF MBAA-ADDRESS = SPACES OR LOW-VALUES DTSBE999
|
|
01339 SET L910-NO-REC-88 TO TRUE. DTSBE999
|
|
01340 DTSBE999
|
|
01341 DTSBE999
|
|
01342 IF MPRF-BEN-MAIL-ADDR-YES-88 DTSBE999
|
|
01343 IF L910-OK-88 DTSBE999
|
|
01344 NEXT SENTENCE DTSBE999
|
|
01345 ELSE DTSBE999
|
|
01346 MOVE 13 TO MSG-NO DTSBE999
|
|
01347 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBE999
|
|
01348 ELSE DTSBE999
|
|
01349 IF L910-NO-REC-88 DTSBE999
|
|
01350 NEXT SENTENCE DTSBE999
|
|
01351 ELSE DTSBE999
|
|
01352 MOVE 13 TO MSG-NO DTSBE999
|
|
01353 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
01354 P1220-EXIT. DTSBE999
|
|
01355 EXIT. DTSBE999
|
|
01356 SKIP3 DTSBE999
|
|
01357 P1230-CHECK-FLD-ZIP-ST. DTSBE999
|
|
01358 ***** DTSBE999
|
|
01359 * DTSBE999
|
|
01360 * 1. IS MPRF-FLD-ZIP-ST CONSISTENT WITH TAD ADDRESSES? DTSBE999
|
|
01361 * DTSBE999
|
|
01362 ***** DTSBE999
|
|
01363 DTSBE999
|
|
01364 IF MPRF-TAX-REC-ADDR-YES-88 DTSBE999
|
|
01365 MOVE 2 TO WRK-9-1 DTSBE999
|
|
01366 ELSE DTSBE999
|
|
01367 MOVE 1 TO WRK-9-1. DTSBE999
|
|
01368 DTSBE999
|
|
01369 DTSBE999
|
|
01370 IF (TAD-ZIP (WRK-9-1) NOT = MPRF-FLD-ZIP) DTSBE999
|
|
01371 OR DTSBE999
|
|
01372 (TAD-ST (WRK-9-1) NOT = MPRF-FLD-ST) DTSBE999
|
|
01373 MOVE 14 TO MSG-NO DTSBE999
|
|
01374 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
01375 P1230-EXIT. DTSBE999
|
|
01376 EXIT. DTSBE999
|
|
01377 SKIP3 DTSBE999
|
|
01378 *P1240-CHECK-JS-ZIP. DTSBE999
|
|
01379 ***** DTSBE999
|
|
01380 * DTSBE999
|
|
01381 * 1. IS MPRF-JS-ZIP CONSISTENT WITH TAD-INDICATORS? DTSBE999
|
|
01382 * DTSBE999
|
|
01383 ***** DTSBE999
|
|
01384 DTSBE999
|
|
01385 *****IF TAD-EXISTS-IND (2) = YES DTSBE999
|
|
01386 *********IF TAD-ZIP (2) NOT = MPRF-JS-ZIP DTSBE999
|
|
01387 *************MOVE 15 TO MSG-NO DTSBE999
|
|
01388 *************PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBE999
|
|
01389 *********END-IF DTSBE999
|
|
01390 *****ELSE DTSBE999
|
|
01391 *********IF TAD-ZIP (1) NOT = MPRF-JS-ZIP DTSBE999
|
|
01392 *************MOVE 15 TO MSG-NO DTSBE999
|
|
01393 *************PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
01394 *P1240-EXIT. DTSBE999
|
|
01395 *****EXIT. DTSBE999
|
|
01396 EJECT DTSBE999
|
|
01397 P1310-CHECK-BANKRUPT-OPEN-IND. DTSBE999
|
|
01398 ***** DTSBE999
|
|
01399 * DTSBE999
|
|
01400 * 1. IS MPRF-BANKRUPTCY-OPEN-IND CONSISTENT WITH MCOL DTSBE999
|
|
01401 * BANKRUPTCY DATA ELEMENTS? DTSBE999
|
|
01402 * DTSBE999
|
|
01403 ***** DTSBE999
|
|
01404 DTSBE999
|
|
01405 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBE999
|
|
01406 DTSBE999
|
|
01407 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBE999
|
|
01408 DTSBE999
|
|
01409 SET MSKL-COL-88 TO TRUE. DTSBE999
|
|
01410 DTSBE999
|
|
01411 PERFORM S910-READ THRU S910-EXIT. DTSBE999
|
|
01412 DTSBE999
|
|
01413 IF L910-NO-REC-88 DTSBE999
|
|
01414 IF MPRF-BANKRP-OPEN-88 DTSBE999
|
|
01415 MOVE 21 TO MSG-NO DTSBE999
|
|
01416 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBE999
|
|
01417 END-IF DTSBE999
|
|
01418 ELSE DTSBE999
|
|
01419 MOVE MSKL-REC TO MCOL-REC DTSBE999
|
|
01420 *********PERFORM P1311-OPEN-BANKRUPT-LIAB-XREF THRU P1311-EXIT DTSBE999
|
|
01421 IF (MCOL-BNK-PETITION-DATE NOT = +0) DTSBE999
|
|
01422 AND (MCOL-BNK-DISCHRG-CLOSE-DATE = +0) DTSBE999
|
|
01423 AND (MCOL-BNK-DISMISS-DATE = +0) DTSBE999
|
|
01424 IF MPRF-BANKRP-NOT-OPEN-88 DTSBE999
|
|
01425 MOVE 21 TO MSG-NO DTSBE999
|
|
01426 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBE999
|
|
01427 END-IF DTSBE999
|
|
01428 ELSE DTSBE999
|
|
01429 IF MPRF-BANKRP-OPEN-88 DTSBE999
|
|
01430 MOVE 21 TO MSG-NO DTSBE999
|
|
01431 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
01432 P1310-EXIT. DTSBE999
|
|
01433 EXIT. DTSBE999
|
|
01434 SKIP3 DTSBE999
|
|
01435 *P1311-OPEN-BANKRUPT-LIAB-XREF. DTSBE999
|
|
01436 *****IF*MCOL-BNK-PETITION-DATE = +0 DTSBE999
|
|
01437 *********GO TO P1311-EXIT. DTSBE999
|
|
01438 ********* DTSBE999
|
|
01439 *****IF*(MCOL-BNK-DISCHRG-CLOSE-DATE = +0) DTSBE999
|
|
01440 ********* AND DTSBE999
|
|
01441 ********(MCOL-BNK-DISMISS-DATE = +0) DTSBE999
|
|
01442 ********* IF MPRF-STATUS-ACT-88 DTSBE999
|
|
01443 ********* MOVE 08 TO MSG-NO DTSBE999
|
|
01444 ********* PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
01445 ********* DTSBE999
|
|
01446 *****MOVE ALL-NINES-DATE TO WRK-BNK-END-DATE. DTSBE999
|
|
01447 ********* DTSBE999
|
|
01448 *****IF*MCOL-BNK-DISCHRG-CLOSE-DATE > +0 DTSBE999
|
|
01449 *********MOVE MCOL-BNK-DISCHRG-CLOSE-DATE TO WRK-BNK-END-DATE. DTSBE999
|
|
01450 ********* DTSBE999
|
|
01451 *****IF*MCOL-BNK-DISMISS-DATE > +0 DTSBE999
|
|
01452 *********MOVE MCOL-BNK-DISMISS-DATE TO WRK-BNK-END-DATE. DTSBE999
|
|
01453 ********* DTSBE999
|
|
01454 *****PERFORM DTSBE999
|
|
01455 *******VARYING SOL-IDX FROM 1 BY 1 DTSBE999
|
|
01456 *******UNTIL SOL-IDX > SOL-CNT DTSBE999
|
|
01457 *********IF (SOL-FIRST-LIAB-DATE (SOL-CNT) > WRK-BNK-END-DATE) DTSBE999
|
|
01458 ********* OR DTSBE999
|
|
01459 ********* (SOL-LAST-LIAB-DATE (SOL-CNT) DTSBE999
|
|
01460 ********* < MCOL-BNK-PETITION-DATE) DTSBE999
|
|
01461 ********* CONTINUE DTSBE999
|
|
01462 *********ELSE DTSBE999
|
|
01463 ********* MOVE 09 TO MSG-NO DTSBE999
|
|
01464 ********* PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBE999
|
|
01465 *********END-IF DTSBE999
|
|
01466 *****END-PERFORM. DTSBE999
|
|
01467 *P1311-EXIT. DTSBE999
|
|
01468 *****EXIT. DTSBE999
|
|
01469 SKIP3 DTSBE999
|
|
01470 P1320-CHECK-MAPL-IND. DTSBE999
|
|
01471 ***** DTSBE999
|
|
01472 * DTSBE999
|
|
01473 * 1. IS MPRF-MAPL-IND CONSISTENT WITH MAPL RECORDS? DTSBE999
|
|
01474 * DTSBE999
|
|
01475 ***** DTSBE999
|
|
01476 DTSBE999
|
|
01477 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBE999
|
|
01478 DTSBE999
|
|
01479 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBE999
|
|
01480 DTSBE999
|
|
01481 SET MSKL-APL-88 TO TRUE. DTSBE999
|
|
01482 DTSBE999
|
|
01483 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE999
|
|
01484 DTSBE999
|
|
01485 IF L910-OK-88 DTSBE999
|
|
01486 IF MPRF-NO-MAPL-88 DTSBE999
|
|
01487 MOVE 22 TO MSG-NO DTSBE999
|
|
01488 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBE999
|
|
01489 END-IF DTSBE999
|
|
01490 ELSE DTSBE999
|
|
01491 IF MPRF-MAPL-EXISTS-88 DTSBE999
|
|
01492 MOVE 22 TO MSG-NO DTSBE999
|
|
01493 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
01494 P1320-EXIT. DTSBE999
|
|
01495 EXIT. DTSBE999
|
|
01496 SKIP3 DTSBE999
|
|
01497 P1330-CHECK-MLIN-IND. DTSBE999
|
|
01498 ***** DTSBE999
|
|
01499 * DTSBE999
|
|
01500 * 1. IS MPRF-MLIN-IND CONSISTENT WITH MLIN RECORDS? DTSBE999
|
|
01501 * DTSBE999
|
|
01502 ***** DTSBE999
|
|
01503 DTSBE999
|
|
01504 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBE999
|
|
01505 DTSBE999
|
|
01506 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBE999
|
|
01507 DTSBE999
|
|
01508 SET MSKL-LIN-88 TO TRUE. DTSBE999
|
|
01509 DTSBE999
|
|
01510 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE999
|
|
01511 DTSBE999
|
|
01512 IF L910-OK-88 DTSBE999
|
|
01513 IF MPRF-NO-MLIN-88 DTSBE999
|
|
01514 MOVE 23 TO MSG-NO DTSBE999
|
|
01515 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBE999
|
|
01516 END-IF DTSBE999
|
|
01517 ELSE DTSBE999
|
|
01518 IF MPRF-MLIN-EXISTS-88 DTSBE999
|
|
01519 MOVE 23 TO MSG-NO DTSBE999
|
|
01520 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
01521 P1330-EXIT. DTSBE999
|
|
01522 EXIT. DTSBE999
|
|
01523 SKIP3 DTSBE999
|
|
01524 P1340-CHECK-MDPC-IND. DTSBE999
|
|
01525 ***** DTSBE999
|
|
01526 * DTSBE999
|
|
01527 * 1. IS MPRF-MDPC-IND CONSISTENT WITH MDPC RECORDS? DTSBE999
|
|
01528 * DTSBE999
|
|
01529 ***** DTSBE999
|
|
01530 DTSBE999
|
|
01531 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBE999
|
|
01532 DTSBE999
|
|
01533 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBE999
|
|
01534 DTSBE999
|
|
01535 SET MSKL-DPC-88 TO TRUE. DTSBE999
|
|
01536 DTSBE999
|
|
01537 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE999
|
|
01538 DTSBE999
|
|
01539 IF L910-OK-88 DTSBE999
|
|
01540 IF MPRF-NO-MDPC-88 DTSBE999
|
|
01541 MOVE 24 TO MSG-NO DTSBE999
|
|
01542 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBE999
|
|
01543 END-IF DTSBE999
|
|
01544 ELSE DTSBE999
|
|
01545 IF MPRF-MDPC-EXISTS-88 DTSBE999
|
|
01546 MOVE 24 TO MSG-NO DTSBE999
|
|
01547 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
01548 P1340-EXIT. DTSBE999
|
|
01549 EXIT. DTSBE999
|
|
01550 SKIP3 DTSBE999
|
|
01551 P1350-CHECK-MFAS-IND. DTSBE999
|
|
01552 ***** DTSBE999
|
|
01553 * DTSBE999
|
|
01554 * 1. IS MPRF-MFAS-IND CONSISTENT WITH MFAS RECORDS? DTSBE999
|
|
01555 * DTSBE999
|
|
01556 ***** DTSBE999
|
|
01557 DTSBE999
|
|
01558 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBE999
|
|
01559 DTSBE999
|
|
01560 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBE999
|
|
01561 DTSBE999
|
|
01562 SET MSKL-FAS-88 TO TRUE. DTSBE999
|
|
01563 DTSBE999
|
|
01564 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE999
|
|
01565 DTSBE999
|
|
01566 IF L910-OK-88 DTSBE999
|
|
01567 IF MPRF-NO-MFAS-88 DTSBE999
|
|
01568 MOVE 25 TO MSG-NO DTSBE999
|
|
01569 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBE999
|
|
01570 END-IF DTSBE999
|
|
01571 ELSE DTSBE999
|
|
01572 IF MPRF-MFAS-EXISTS-88 DTSBE999
|
|
01573 MOVE 25 TO MSG-NO DTSBE999
|
|
01574 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
01575 P1350-EXIT. DTSBE999
|
|
01576 EXIT. DTSBE999
|
|
01577 SKIP3 DTSBE999
|
|
01578 P1360-CHECK-LAST-ARCHIVED-YRQ. DTSBE999
|
|
01579 IF MPRF-LAST-ARCHIVED-YRQ < LECM-PICKUP-YRQ DTSBE999
|
|
01580 IF MPRF-LAST-ARCHIVED-YRQ = +0 DTSBE999
|
|
01581 MOVE 'ZERO' TO MSG20-SLASH-QTR DTSBE999
|
|
01582 MOVE 20 TO MSG-NO DTSBE999
|
|
01583 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBE999
|
|
01584 ELSE DTSBE999
|
|
01585 MOVE MPRF-LAST-ARCHIVED-YRQ TO L004-QTR-5-9 DTSBE999
|
|
01586 PERFORM S004-FROM-5 THRU S004-EXIT DTSBE999
|
|
01587 MOVE L004-SLASH-QTR TO MSG20-SLASH-QTR DTSBE999
|
|
01588 MOVE 20 TO MSG-NO DTSBE999
|
|
01589 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
01590 P1360-EXIT. DTSBE999
|
|
01591 EXIT. DTSBE999
|
|
01592 EJECT DTSBE999
|
|
01593 P1410-SET-QTR-AREA. DTSBE999
|
|
01594 ***** DTSBE999
|
|
01595 * DTSBE999
|
|
01596 * SCAN MQTR RECORDS, SETTING QTR-AREA DATA ELEMENTS. DTSBE999
|
|
01597 * DTSBE999
|
|
01598 ***** DTSBE999
|
|
01599 DTSBE999
|
|
01600 INITIALIZE QTR-AREA. DTSBE999
|
|
01601 DTSBE999
|
|
01602 DTSBE999
|
|
01603 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBE999
|
|
01604 DTSBE999
|
|
01605 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBE999
|
|
01606 DTSBE999
|
|
01607 SET MSKL-QTR-88 TO TRUE. DTSBE999
|
|
01608 DTSBE999
|
|
01609 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE999
|
|
01610 DTSBE999
|
|
01611 PERFORM P1411-FIRST-SCAN-QTR THRU P1411-EXIT DTSBE999
|
|
01612 UNTIL L910-NO-REC-88. DTSBE999
|
|
01613 P1410-EXIT. DTSBE999
|
|
01614 EXIT. DTSBE999
|
|
01615 SKIP3 DTSBE999
|
|
01616 P1411-FIRST-SCAN-QTR. DTSBE999
|
|
01617 MOVE MSKL-REC TO MQTR-REC. DTSBE999
|
|
01618 DTSBE999
|
|
01619 DTSBE999
|
|
01620 IF QTR-FIRST-ON-FILE-YRQ = +0 DTSBE999
|
|
01621 MOVE MQTR-YRQ TO QTR-FIRST-ON-FILE-YRQ. DTSBE999
|
|
01622 DTSBE999
|
|
01623 MOVE MQTR-YRQ TO QTR-LAST-ON-FILE-YRQ. DTSBE999
|
|
01624 DTSBE999
|
|
01625 DTSBE999
|
|
01626 IF MQTR-RPT-IS-PURSUED-88 DTSBE999
|
|
01627 ADD +1 TO QTR-PURSUED-RPT-CNT. DTSBE999
|
|
01628 DTSBE999
|
|
01629 DTSBE999
|
|
01630 PERFORM DTSBE999
|
|
01631 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBE999
|
|
01632 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSBE999
|
|
01633 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBE999
|
|
01634 TO QTR-TOT-BALANCE-AMT DTSBE999
|
|
01635 END-PERFORM. DTSBE999
|
|
01636 DTSBE999
|
|
01637 DTSBE999
|
|
01638 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE999
|
|
01639 P1411-EXIT. DTSBE999
|
|
01640 EXIT. DTSBE999
|
|
01641 SKIP3 DTSBE999
|
|
01642 P1420-CHECK-PURSUED-RPT-CNT. DTSBE999
|
|
01643 ***** DTSBE999
|
|
01644 * DTSBE999
|
|
01645 * 1. IS MPRF-PURSUED-RPT-CNT EQUAL TO QTR-PURSUED-RPT-CNT? DTSBE999
|
|
01646 * DTSBE999
|
|
01647 ***** DTSBE999
|
|
01648 DTSBE999
|
|
01649 IF MPRF-PURSUED-RPT-CNT NOT = QTR-PURSUED-RPT-CNT DTSBE999
|
|
01650 MOVE 31 TO MSG-NO DTSBE999
|
|
01651 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
01652 P1420-EXIT. DTSBE999
|
|
01653 EXIT. DTSBE999
|
|
01654 SKIP3 DTSBE999
|
|
01655 P1430-CHECK-TOT-BALANCE-AMT. DTSBE999
|
|
01656 ***** DTSBE999
|
|
01657 * DTSBE999
|
|
01658 * 1. IS MPRF-TOT-BALANCE-AMT EQUAL TO QTR-TOT-BALANCE-AMT? DTSBE999
|
|
01659 * DTSBE999
|
|
01660 ***** DTSBE999
|
|
01661 DTSBE999
|
|
01662 IF MPRF-TOT-BALANCE-AMT NOT = QTR-TOT-BALANCE-AMT DTSBE999
|
|
01663 MOVE 32 TO MSG-NO DTSBE999
|
|
01664 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
01665 P1430-EXIT. DTSBE999
|
|
01666 EXIT. DTSBE999
|
|
01667 EJECT DTSBE999
|
|
01668 P2100-SET-DST-BY-TABLES. DTSBE999
|
|
01669 ***** DTSBE999
|
|
01670 * DTSBE999
|
|
01671 * SCAN MDST RECORDS, CONSTRUCTING DST-BY-QTR-AREA OCCURRENCES DTSBE999
|
|
01672 * AND DST-BY-DOC-AREA OCCURRENCES. DTSBE999
|
|
01673 * DTSBE999
|
|
01674 * SCAN THE MREV RECORDS COMPLETING CONSTRUCTION OF THE DTSBE999
|
|
01675 * DST-BY-DOC-AREA OCCURRENCES. DTSBE999
|
|
01676 * DTSBE999
|
|
01677 ***** DTSBE999
|
|
01678 DTSBE999
|
|
01679 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBE999
|
|
01680 DTSBE999
|
|
01681 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBE999
|
|
01682 DTSBE999
|
|
01683 SET MSKL-DST-88 TO TRUE. DTSBE999
|
|
01684 DTSBE999
|
|
01685 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE999
|
|
01686 DTSBE999
|
|
01687 PERFORM P2110-SCAN-DST THRU P2110-EXIT DTSBE999
|
|
01688 UNTIL L910-NO-REC-88. DTSBE999
|
|
01689 DTSBE999
|
|
01690 DTSBE999
|
|
01691 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBE999
|
|
01692 DTSBE999
|
|
01693 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBE999
|
|
01694 DTSBE999
|
|
01695 SET MSKL-REV-88 TO TRUE. DTSBE999
|
|
01696 DTSBE999
|
|
01697 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE999
|
|
01698 DTSBE999
|
|
01699 PERFORM DTSBE999
|
|
01700 UNTIL L910-NO-REC-88 DTSBE999
|
|
01701 MOVE MSKL-REC TO MREV-REC DTSBE999
|
|
01702 PERFORM P2130-SET-DST-BY-DOC-SUB THRU P2130-EXIT DTSBE999
|
|
01703 ADD MREV-AMT TO DST-BY-DOC-REV-AMT (DST-BY-DOC-SUB) DTSBE999
|
|
01704 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE999
|
|
01705 END-PERFORM. DTSBE999
|
|
01706 DTSBE999
|
|
01707 DTSBE999
|
|
01708 PERFORM P2120-SORT-DST-BY-DOC THRU P2120-EXIT. DTSBE999
|
|
01709 P2100-EXIT. DTSBE999
|
|
01710 EXIT. DTSBE999
|
|
01711 SKIP3 DTSBE999
|
|
01712 P2110-SCAN-DST. DTSBE999
|
|
01713 MOVE MSKL-REC TO MDST-REC. DTSBE999
|
|
01714 DTSBE999
|
|
01715 DTSBE999
|
|
01716 IF (DST-BY-QTR-CNT = +0) DTSBE999
|
|
01717 OR DTSBE999
|
|
01718 (MDST-YRQ NOT = DST-BY-QTR-YRQ (DST-BY-QTR-CNT)) DTSBE999
|
|
01719 ADD +1 TO DST-BY-QTR-CNT DTSBE999
|
|
01720 INITIALIZE DST-BY-QTR-AREA (DST-BY-QTR-CNT) DTSBE999
|
|
01721 MOVE MDST-YRQ TO DST-BY-QTR-YRQ (DST-BY-QTR-CNT). DTSBE999
|
|
01722 DTSBE999
|
|
01723 DTSBE999
|
|
01724 MOVE +0 TO DST-BY-DOC-SUB. DTSBE999
|
|
01725 DTSBE999
|
|
01726 PERFORM DTSBE999
|
|
01727 VARYING DST-BY-DOC-IDX FROM 1 BY 1 DTSBE999
|
|
01728 UNTIL (DST-BY-DOC-IDX > DST-BY-DOC-CNT) DTSBE999
|
|
01729 OR DTSBE999
|
|
01730 (DST-BY-DOC-SUB > +0) DTSBE999
|
|
01731 IF MDST-DOC-NO = DST-BY-DOC-DOC-NO (DST-BY-DOC-IDX) DTSBE999
|
|
01732 SET DST-BY-DOC-SUB TO DST-BY-DOC-IDX DTSBE999
|
|
01733 END-IF DTSBE999
|
|
01734 END-PERFORM. DTSBE999
|
|
01735 DTSBE999
|
|
01736 DTSBE999
|
|
01737 IF DST-BY-DOC-SUB > +0 DTSBE999
|
|
01738 IF MDST-RECEIVED-DATE DTSBE999
|
|
01739 = DST-RECEIVED-DATE (DST-BY-DOC-SUB) DTSBE999
|
|
01740 NEXT SENTENCE DTSBE999
|
|
01741 ELSE DTSBE999
|
|
01742 MOVE MDST-BATCH-NO TO MSG33-BATCH-NO DTSBE999
|
|
01743 MOVE MDST-ITEM-NO TO MSG33-ITEM-NO DTSBE999
|
|
01744 MOVE 33 TO MSG-NO DTSBE999
|
|
01745 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBE999
|
|
01746 ELSE DTSBE999
|
|
01747 IF DST-BY-DOC-CNT < DST-BY-DOC-MAX DTSBE999
|
|
01748 ADD +1 TO DST-BY-DOC-CNT DTSBE999
|
|
01749 INITIALIZE DST-BY-DOC-AREA (DST-BY-DOC-CNT) DTSBE999
|
|
01750 MOVE MDST-DOC-NO DTSBE999
|
|
01751 TO DST-BY-DOC-DOC-NO (DST-BY-DOC-CNT) DTSBE999
|
|
01752 MOVE MDST-RECEIVED-DATE DTSBE999
|
|
01753 TO DST-RECEIVED-DATE (DST-BY-DOC-CNT) DTSBE999
|
|
01754 MOVE DST-BY-DOC-CNT TO DST-BY-DOC-SUB DTSBE999
|
|
01755 ELSE DTSBE999
|
|
01756 MOVE 'DST-BY-DOC TABLE OVERFLOW' TO ABEND-MSG DTSBE999
|
|
01757 PERFORM S999-ABEND THRU S999-EXIT. DTSBE999
|
|
01758 DTSBE999
|
|
01759 DTSBE999
|
|
01760 PERFORM P2111-STORE-AMOUNT THRU P2111-EXIT DTSBE999
|
|
01761 VARYING MDST-ACCT-IDX FROM 1 BY 1 DTSBE999
|
|
01762 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT. DTSBE999
|
|
01763 DTSBE999
|
|
01764 DTSBE999
|
|
01765 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE999
|
|
01766 P2110-EXIT. DTSBE999
|
|
01767 EXIT. DTSBE999
|
|
01768 SKIP3 DTSBE999
|
|
01769 P2111-STORE-AMOUNT. DTSBE999
|
|
01770 IF MDST-ACCT-UI-88 (MDST-ACCT-IDX) DTSBE999
|
|
01771 ADD MDST-AMT (MDST-ACCT-IDX) DTSBE999
|
|
01772 TO DST-BY-QTR-UI-AMT (DST-BY-QTR-CNT) DTSBE999
|
|
01773 ELSE DTSBE999
|
|
01774 IF MDST-ACCT-SUR-88 (MDST-ACCT-IDX) DTSBE999
|
|
01775 ADD MDST-AMT (MDST-ACCT-IDX) DTSBE999
|
|
01776 TO DST-BY-QTR-SUR-AMT (DST-BY-QTR-CNT) DTSBE999
|
|
01777 ELSE DTSBE999
|
|
01778 IF MDST-ACCT-INT-88 (MDST-ACCT-IDX) DTSBE999
|
|
01779 ADD MDST-AMT (MDST-ACCT-IDX) DTSBE999
|
|
01780 TO DST-BY-QTR-INT-AMT (DST-BY-QTR-CNT) DTSBE999
|
|
01781 ELSE DTSBE999
|
|
01782 IF MDST-ACCT-LATE-PEN-88 (MDST-ACCT-IDX) DTSBE999
|
|
01783 ADD MDST-AMT (MDST-ACCT-IDX) DTSBE999
|
|
01784 TO DST-BY-QTR-LATE-PEN-AMT (DST-BY-QTR-CNT) DTSBE999
|
|
01785 ELSE DTSBE999
|
|
01786 IF MDST-ACCT-NSF-PEN-88 (MDST-ACCT-IDX) DTSBE999
|
|
01787 ADD MDST-AMT (MDST-ACCT-IDX) DTSBE999
|
|
01788 TO DST-BY-QTR-NSF-PEN-AMT (DST-BY-QTR-CNT) DTSBE999
|
|
01789 ELSE DTSBE999
|
|
01790 IF MDST-ACCT-MISC-PEN-88 (MDST-ACCT-IDX) DTSBE999
|
|
01791 ADD MDST-AMT (MDST-ACCT-IDX) DTSBE999
|
|
01792 TO DST-BY-QTR-MISC-PEN-AMT (DST-BY-QTR-CNT) DTSBE999
|
|
01793 ELSE DTSBE999
|
|
01794 IF MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-IDX) DTSBE999
|
|
01795 ADD MDST-AMT (MDST-ACCT-IDX) DTSBE999
|
|
01796 TO DST-BY-QTR-CR-AVAIL-AMT (DST-BY-QTR-CNT) DTSBE999
|
|
01797 ELSE DTSBE999
|
|
01798 IF MDST-ACCT-CR-WRITE-OFF-88 (MDST-ACCT-IDX) DTSBE999
|
|
01799 ADD MDST-AMT (MDST-ACCT-IDX) DTSBE999
|
|
01800 TO DST-BY-QTR-CR-WRITE-OFF-AMT (DST-BY-QTR-CNT) DTSBE999
|
|
01801 ELSE DTSBE999
|
|
01802 IF MDST-ACCT-CR-TOL-88 (MDST-ACCT-IDX) DTSBE999
|
|
01803 ADD MDST-AMT (MDST-ACCT-IDX) DTSBE999
|
|
01804 TO DST-BY-QTR-CR-TOL-AMT (DST-BY-QTR-CNT) DTSBE999
|
|
01805 ELSE DTSBE999
|
|
01806 MOVE 41 TO MSG-NO DTSBE999
|
|
01807 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
01808 DTSBE999
|
|
01809 DTSBE999
|
|
01810 IF MDST-ACCT-CREDIT-88 (MDST-ACCT-IDX) DTSBE999
|
|
01811 ADD MDST-AMT (MDST-ACCT-IDX) DTSBE999
|
|
01812 TO DST-BY-DOC-CREDIT-AMT (DST-BY-DOC-SUB) DTSBE999
|
|
01813 ELSE DTSBE999
|
|
01814 ADD MDST-AMT (MDST-ACCT-IDX) DTSBE999
|
|
01815 TO DST-BY-DOC-QTR-AMT (DST-BY-DOC-SUB). DTSBE999
|
|
01816 P2111-EXIT. DTSBE999
|
|
01817 EXIT. DTSBE999
|
|
01818 SKIP3 DTSBE999
|
|
01819 P2120-SORT-DST-BY-DOC. DTSBE999
|
|
01820 DTSBE999
|
|
01821 ***** DTSBE999
|
|
01822 * DTSBE999
|
|
01823 * AS OF 05/16/95, NO CODE IN THIS MODULE REQUIRES THE DTSBE999
|
|
01824 * DST-BY-DOC-AREA OCCURRENCES TO BE IN ANY PARTICULAR DTSBE999
|
|
01825 * SEQUENCE. DTSBE999
|
|
01826 * DTSBE999
|
|
01827 ***** DTSBE999
|
|
01828 *****IF DST-BY-DOC-CNT > +1 DTSBE999
|
|
01829 *********MOVE DST-BY-DOC-CNT TO SORT-ITEM-CNT DTSBE999
|
|
01830 *********MOVE +28 TO SORT-ITEM-LENGTH DTSBE999
|
|
01831 *********MOVE +0 TO SORT-KEY-START DTSBE999
|
|
01832 *********MOVE +5 TO SORT-KEY-LENGTH DTSBE999
|
|
01833 *********MOVE +0 TO SORT-KEY-TYPE DTSBE999
|
|
01834 *********CALL 'SORT2' USING DST-BY-DOC-ARRAY DTSBE999
|
|
01835 ****************************SORT-ITEM-CNT DTSBE999
|
|
01836 ****************************SORT-ITEM-LENGTH DTSBE999
|
|
01837 ****************************SORT-KEY-START DTSBE999
|
|
01838 ****************************SORT-KEY-LENGTH DTSBE999
|
|
01839 ****************************SORT-KEY-TYPE. DTSBE999
|
|
01840 P2120-EXIT. DTSBE999
|
|
01841 EXIT. DTSBE999
|
|
01842 SKIP3 DTSBE999
|
|
01843 P2130-SET-DST-BY-DOC-SUB. DTSBE999
|
|
01844 MOVE +0 TO DST-BY-DOC-SUB. DTSBE999
|
|
01845 DTSBE999
|
|
01846 PERFORM DTSBE999
|
|
01847 VARYING DST-BY-DOC-IDX FROM 1 BY 1 DTSBE999
|
|
01848 UNTIL (DST-BY-DOC-IDX > DST-BY-DOC-CNT) DTSBE999
|
|
01849 OR DTSBE999
|
|
01850 (DST-BY-DOC-SUB > +0) DTSBE999
|
|
01851 IF MREV-PA-DOC-NO = DST-BY-DOC-DOC-NO (DST-BY-DOC-IDX) DTSBE999
|
|
01852 SET DST-BY-DOC-SUB TO DST-BY-DOC-IDX DTSBE999
|
|
01853 END-IF DTSBE999
|
|
01854 END-PERFORM. DTSBE999
|
|
01855 DTSBE999
|
|
01856 DTSBE999
|
|
01857 IF DST-BY-DOC-SUB > +0 DTSBE999
|
|
01858 NEXT SENTENCE DTSBE999
|
|
01859 ELSE DTSBE999
|
|
01860 IF DST-BY-DOC-CNT < DST-BY-DOC-MAX DTSBE999
|
|
01861 ADD +1 TO DST-BY-DOC-CNT DTSBE999
|
|
01862 INITIALIZE DST-BY-DOC-AREA (DST-BY-DOC-CNT) DTSBE999
|
|
01863 MOVE MREV-PA-DOC-NO DTSBE999
|
|
01864 TO DST-BY-DOC-DOC-NO (DST-BY-DOC-CNT) DTSBE999
|
|
01865 MOVE ALL-NINES-DATE DTSBE999
|
|
01866 TO DST-RECEIVED-DATE (DST-BY-DOC-CNT) DTSBE999
|
|
01867 MOVE DST-BY-DOC-CNT TO DST-BY-DOC-SUB DTSBE999
|
|
01868 ELSE DTSBE999
|
|
01869 MOVE 'DST-BY-DOC TABLE OVERFLOW' TO ABEND-MSG DTSBE999
|
|
01870 PERFORM S999-ABEND THRU S999-EXIT. DTSBE999
|
|
01871 P2130-EXIT. DTSBE999
|
|
01872 EXIT. DTSBE999
|
|
01873 EJECT DTSBE999
|
|
01874 P2200-CHECK-MQTR. DTSBE999
|
|
01875 MOVE +0 TO RTE-CNT. DTSBE999
|
|
01876 DTSBE999
|
|
01877 DTSBE999
|
|
01878 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBE999
|
|
01879 DTSBE999
|
|
01880 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBE999
|
|
01881 DTSBE999
|
|
01882 SET MSKL-RTE-88 TO TRUE. DTSBE999
|
|
01883 DTSBE999
|
|
01884 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE999
|
|
01885 DTSBE999
|
|
01886 PERFORM DTSBE999
|
|
01887 UNTIL L910-NO-REC-88 DTSBE999
|
|
01888 MOVE MSKL-REC TO MRTE-REC DTSBE999
|
|
01889 PERFORM P2201-TABLE-RTE THRU P2201-EXIT DTSBE999
|
|
01890 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE999
|
|
01891 END-PERFORM. DTSBE999
|
|
01892 DTSBE999
|
|
01893 IF RTE-CNT > MAX-RTE-CNT-USED DTSBE999
|
|
01894 MOVE RTE-CNT TO MAX-RTE-CNT-USED. DTSBE999
|
|
01895 DTSBE999
|
|
01896 DTSBE999
|
|
01897 PERFORM P2202-CHECK-CREDIT THRU P2202-EXIT. DTSBE999
|
|
01898 DTSBE999
|
|
01899 DTSBE999
|
|
01900 PERFORM P2210-SET-FIRST-LAST-CHECK THRU P2210-EXIT. DTSBE999
|
|
01901 DTSBE999
|
|
01902 DTSBE999
|
|
01903 IF QTR-FIRST-CHECK-YRQ = +0 DTSBE999
|
|
01904 GO TO P2200-EXIT. DTSBE999
|
|
01905 DTSBE999
|
|
01906 DTSBE999
|
|
01907 *****DISPLAY MPRF-EMP-NO DTSBE999
|
|
01908 *************' ' DTSBE999
|
|
01909 *************QTR-FIRST-CHECK-YRQ DTSBE999
|
|
01910 *************' ' DTSBE999
|
|
01911 *************QTR-LAST-CHECK-YRQ. DTSBE999
|
|
01912 DTSBE999
|
|
01913 DTSBE999
|
|
01914 MOVE QTR-FIRST-CHECK-YRQ TO L004-QTR-5-9. DTSBE999
|
|
01915 DTSBE999
|
|
01916 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE999
|
|
01917 DTSBE999
|
|
01918 IF L004-INVALID-QTR DTSBE999
|
|
01919 MOVE 'P2200-1 LOGIC ERROR' TO ABEND-MSG DTSBE999
|
|
01920 PERFORM S999-ABEND THRU S999-EXIT. DTSBE999
|
|
01921 DTSBE999
|
|
01922 MOVE L004-ABS-QTR TO QTR-CURR-CHECK-ABS-QTR. DTSBE999
|
|
01923 DTSBE999
|
|
01924 DTSBE999
|
|
01925 MOVE QTR-LAST-CHECK-YRQ TO L004-QTR-5-9. DTSBE999
|
|
01926 DTSBE999
|
|
01927 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE999
|
|
01928 DTSBE999
|
|
01929 IF L004-INVALID-QTR DTSBE999
|
|
01930 MOVE 'P2200-2 LOGIC ERROR' TO ABEND-MSG DTSBE999
|
|
01931 PERFORM S999-ABEND THRU S999-EXIT. DTSBE999
|
|
01932 DTSBE999
|
|
01933 MOVE L004-ABS-QTR TO QTR-LAST-CHECK-ABS-QTR. DTSBE999
|
|
01934 DTSBE999
|
|
01935 DTSBE999
|
|
01936 PERFORM P2220-MQTR THRU P2220-EXIT DTSBE999
|
|
01937 VARYING QTR-CURR-CHECK-ABS-QTR DTSBE999
|
|
01938 FROM QTR-CURR-CHECK-ABS-QTR BY 1 DTSBE999
|
|
01939 UNTIL QTR-CURR-CHECK-ABS-QTR > QTR-LAST-CHECK-ABS-QTR. DTSBE999
|
|
01940 DTSBE999
|
|
01941 DTSBE999
|
|
01942 PERFORM P2209-CHECK-BY-QTR-RESIDUE THRU P2209-EXIT DTSBE999
|
|
01943 VARYING DST-BY-QTR-IDX FROM 1 BY 1 DTSBE999
|
|
01944 UNTIL DST-BY-QTR-IDX > DST-BY-QTR-CNT. DTSBE999
|
|
01945 P2200-EXIT. DTSBE999
|
|
01946 EXIT. DTSBE999
|
|
01947 SKIP3 DTSBE999
|
|
01948 P2201-TABLE-RTE. DTSBE999
|
|
01949 IF RTE-CNT < RTE-MAX DTSBE999
|
|
01950 NEXT SENTENCE DTSBE999
|
|
01951 ELSE DTSBE999
|
|
01952 MOVE 'P2201-1 LOGIC ERROR' TO ABEND-MSG DTSBE999
|
|
01953 PERFORM S999-ABEND THRU S999-EXIT. DTSBE999
|
|
01954 DTSBE999
|
|
01955 ADD +1 TO RTE-CNT. DTSBE999
|
|
01956 DTSBE999
|
|
01957 MOVE MRTE-EFF-YRQ TO RTE-EFF-YRQ (RTE-CNT). DTSBE999
|
|
01958 DTSBE999
|
|
01959 MOVE MRTE-END-YRQ TO RTE-END-YRQ (RTE-CNT). DTSBE999
|
|
01960 DTSBE999
|
|
01961 MOVE MRTE-UI-RATE TO RTE-UI-RATE (RTE-CNT). DTSBE999
|
|
01962 P2201-EXIT. DTSBE999
|
|
01963 EXIT. DTSBE999
|
|
01964 SKIP3 DTSBE999
|
|
01965 P2202-CHECK-CREDIT. DTSBE999
|
|
01966 MOVE +0 TO DST-CR-AVAIL-AMT DTSBE999
|
|
01967 DST-CR-WRITE-OFF-AMT. DTSBE999
|
|
01968 DTSBE999
|
|
01969 DTSBE999
|
|
01970 IF DST-BY-QTR-CNT > +0 DTSBE999
|
|
01971 IF DST-BY-QTR-CREDIT-88 (DST-BY-QTR-CNT) DTSBE999
|
|
01972 MOVE DST-BY-QTR-CR-AVAIL-AMT (DST-BY-QTR-CNT) DTSBE999
|
|
01973 TO DST-CR-AVAIL-AMT DTSBE999
|
|
01974 MOVE DST-BY-QTR-CR-WRITE-OFF-AMT (DST-BY-QTR-CNT) DTSBE999
|
|
01975 TO DST-CR-WRITE-OFF-AMT DTSBE999
|
|
01976 MOVE +0 DTSBE999
|
|
01977 TO DST-BY-QTR-CR-AVAIL-AMT (DST-BY-QTR-CNT) DTSBE999
|
|
01978 DST-BY-QTR-CR-WRITE-OFF-AMT (DST-BY-QTR-CNT) DTSBE999
|
|
01979 DST-BY-QTR-CR-TOL-AMT (DST-BY-QTR-CNT). DTSBE999
|
|
01980 DTSBE999
|
|
01981 DTSBE999
|
|
01982 IF MPRF-NOT-WRITTEN-OFF-88 DTSBE999
|
|
01983 NEXT SENTENCE DTSBE999
|
|
01984 ELSE DTSBE999
|
|
01985 IF (MPRF-TOT-CREDIT-AMT = +0) DTSBE999
|
|
01986 AND DTSBE999
|
|
01987 (DST-CR-AVAIL-AMT = +0) DTSBE999
|
|
01988 GO TO P2202-EXIT DTSBE999
|
|
01989 ELSE DTSBE999
|
|
01990 MOVE 43 TO MSG-NO DTSBE999
|
|
01991 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBE999
|
|
01992 GO TO P2202-EXIT. DTSBE999
|
|
01993 DTSBE999
|
|
01994 DTSBE999
|
|
01995 IF DST-CR-WRITE-OFF-AMT = +0 DTSBE999
|
|
01996 NEXT SENTENCE DTSBE999
|
|
01997 ELSE DTSBE999
|
|
01998 MOVE 43 TO MSG-NO DTSBE999
|
|
01999 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
02000 DTSBE999
|
|
02001 DTSBE999
|
|
02002 IF MPRF-TOT-CREDIT-AMT = DST-CR-AVAIL-AMT DTSBE999
|
|
02003 NEXT SENTENCE DTSBE999
|
|
02004 ELSE DTSBE999
|
|
02005 MOVE 44 TO MSG-NO DTSBE999
|
|
02006 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
02007 DTSBE999
|
|
02008 DTSBE999
|
|
02009 IF (MPRF-TOT-CREDIT-AMT > +0) DTSBE999
|
|
02010 AND DTSBE999
|
|
02011 (MPRF-TOT-CREDIT-AMT <= CREDIT-TOL-MAX) DTSBE999
|
|
02012 MOVE 30 TO MSG-NO DTSBE999
|
|
02013 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
02014 P2202-EXIT. DTSBE999
|
|
02015 EXIT. DTSBE999
|
|
02016 SKIP3 DTSBE999
|
|
02017 P2209-CHECK-BY-QTR-RESIDUE. DTSBE999
|
|
02018 IF DST-BY-QTR-UI-AMT (DST-BY-QTR-IDX) = +0 DTSBE999
|
|
02019 NEXT SENTENCE DTSBE999
|
|
02020 ELSE DTSBE999
|
|
02021 MOVE DST-BY-QTR-YRQ (DST-BY-QTR-IDX) TO L004-QTR-5-9 DTSBE999
|
|
02022 PERFORM S004-FROM-5 THRU S004-EXIT DTSBE999
|
|
02023 MOVE L004-SLASH-QTR TO MSG45-SLASH-QTR DTSBE999
|
|
02024 MOVE CACT-ACCT-UI TO MSG45-ACCT-LIT DTSBE999
|
|
02025 MOVE DST-BY-QTR-UI-AMT (DST-BY-QTR-IDX) DTSBE999
|
|
02026 TO MSG45-AMT DTSBE999
|
|
02027 MOVE 45 TO MSG-NO DTSBE999
|
|
02028 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
02029 DTSBE999
|
|
02030 IF DST-BY-QTR-SUR-AMT (DST-BY-QTR-IDX) = +0 DTSBE999
|
|
02031 NEXT SENTENCE DTSBE999
|
|
02032 ELSE DTSBE999
|
|
02033 MOVE DST-BY-QTR-YRQ (DST-BY-QTR-IDX) TO L004-QTR-5-9 DTSBE999
|
|
02034 PERFORM S004-FROM-5 THRU S004-EXIT DTSBE999
|
|
02035 MOVE L004-SLASH-QTR TO MSG45-SLASH-QTR DTSBE999
|
|
02036 MOVE CACT-ACCT-SUR TO MSG45-ACCT-LIT DTSBE999
|
|
02037 MOVE DST-BY-QTR-SUR-AMT (DST-BY-QTR-IDX) DTSBE999
|
|
02038 TO MSG45-AMT DTSBE999
|
|
02039 MOVE 45 TO MSG-NO DTSBE999
|
|
02040 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
02041 DTSBE999
|
|
02042 IF DST-BY-QTR-INT-AMT (DST-BY-QTR-IDX) = +0 DTSBE999
|
|
02043 NEXT SENTENCE DTSBE999
|
|
02044 ELSE DTSBE999
|
|
02045 MOVE DST-BY-QTR-YRQ (DST-BY-QTR-IDX) TO L004-QTR-5-9 DTSBE999
|
|
02046 PERFORM S004-FROM-5 THRU S004-EXIT DTSBE999
|
|
02047 MOVE L004-SLASH-QTR TO MSG45-SLASH-QTR DTSBE999
|
|
02048 MOVE CACT-ACCT-INT TO MSG45-ACCT-LIT DTSBE999
|
|
02049 MOVE DST-BY-QTR-INT-AMT (DST-BY-QTR-IDX) DTSBE999
|
|
02050 TO MSG45-AMT DTSBE999
|
|
02051 MOVE 45 TO MSG-NO DTSBE999
|
|
02052 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
02053 DTSBE999
|
|
02054 IF DST-BY-QTR-LATE-PEN-AMT (DST-BY-QTR-IDX) = +0 DTSBE999
|
|
02055 NEXT SENTENCE DTSBE999
|
|
02056 ELSE DTSBE999
|
|
02057 MOVE DST-BY-QTR-YRQ (DST-BY-QTR-IDX) TO L004-QTR-5-9 DTSBE999
|
|
02058 PERFORM S004-FROM-5 THRU S004-EXIT DTSBE999
|
|
02059 MOVE L004-SLASH-QTR TO MSG45-SLASH-QTR DTSBE999
|
|
02060 MOVE CACT-ACCT-LATE-PEN TO MSG45-ACCT-LIT DTSBE999
|
|
02061 MOVE DST-BY-QTR-LATE-PEN-AMT (DST-BY-QTR-IDX) DTSBE999
|
|
02062 TO MSG45-AMT DTSBE999
|
|
02063 MOVE 45 TO MSG-NO DTSBE999
|
|
02064 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
02065 DTSBE999
|
|
02066 IF DST-BY-QTR-NSF-PEN-AMT (DST-BY-QTR-IDX) = +0 DTSBE999
|
|
02067 NEXT SENTENCE DTSBE999
|
|
02068 ELSE DTSBE999
|
|
02069 MOVE DST-BY-QTR-YRQ (DST-BY-QTR-IDX) TO L004-QTR-5-9 DTSBE999
|
|
02070 PERFORM S004-FROM-5 THRU S004-EXIT DTSBE999
|
|
02071 MOVE L004-SLASH-QTR TO MSG45-SLASH-QTR DTSBE999
|
|
02072 MOVE CACT-ACCT-NSF-PEN TO MSG45-ACCT-LIT DTSBE999
|
|
02073 MOVE DST-BY-QTR-NSF-PEN-AMT (DST-BY-QTR-IDX) DTSBE999
|
|
02074 TO MSG45-AMT DTSBE999
|
|
02075 MOVE 45 TO MSG-NO DTSBE999
|
|
02076 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
02077 DTSBE999
|
|
02078 IF DST-BY-QTR-MISC-PEN-AMT (DST-BY-QTR-IDX) = +0 DTSBE999
|
|
02079 NEXT SENTENCE DTSBE999
|
|
02080 ELSE DTSBE999
|
|
02081 MOVE DST-BY-QTR-YRQ (DST-BY-QTR-IDX) TO L004-QTR-5-9 DTSBE999
|
|
02082 PERFORM S004-FROM-5 THRU S004-EXIT DTSBE999
|
|
02083 MOVE L004-SLASH-QTR TO MSG45-SLASH-QTR DTSBE999
|
|
02084 MOVE CACT-ACCT-MISC-PEN TO MSG45-ACCT-LIT DTSBE999
|
|
02085 MOVE DST-BY-QTR-MISC-PEN-AMT (DST-BY-QTR-IDX) DTSBE999
|
|
02086 TO MSG45-AMT DTSBE999
|
|
02087 MOVE 45 TO MSG-NO DTSBE999
|
|
02088 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
02089 P2209-EXIT. DTSBE999
|
|
02090 EXIT. DTSBE999
|
|
02091 EJECT DTSBE999
|
|
02092 P2210-SET-FIRST-LAST-CHECK. DTSBE999
|
|
02093 IF MPRF-CLASS-SUB-88 DTSBE999
|
|
02094 NEXT SENTENCE DTSBE999
|
|
02095 ELSE DTSBE999
|
|
02096 MOVE QTR-FIRST-ON-FILE-YRQ TO QTR-FIRST-CHECK-YRQ DTSBE999
|
|
02097 MOVE QTR-LAST-ON-FILE-YRQ TO QTR-LAST-CHECK-YRQ DTSBE999
|
|
02098 IF QTR-LAST-CHECK-YRQ < QTR-FIRST-CHECK-YRQ DTSBE999
|
|
02099 MOVE QTR-FIRST-CHECK-YRQ TO QTR-LAST-CHECK-YRQ DTSBE999
|
|
02100 END-IF DTSBE999
|
|
02101 GO TO P2210-EXIT. DTSBE999
|
|
02102 DTSBE999
|
|
02103 DTSBE999
|
|
02104 MOVE ALL-NINES-YRQ TO QTR-FIRST-CHECK-YRQ. DTSBE999
|
|
02105 DTSBE999
|
|
02106 IF MPRF-LAST-ARCHIVED-YRQ = +0 DTSBE999
|
|
02107 NEXT SENTENCE DTSBE999
|
|
02108 ELSE DTSBE999
|
|
02109 MOVE MPRF-LAST-ARCHIVED-YRQ TO L004-QTR-5-9 DTSBE999
|
|
02110 PERFORM S004-FROM-5 THRU S004-EXIT DTSBE999
|
|
02111 ADD +1 TO L004-ABS-QTR DTSBE999
|
|
02112 PERFORM S004-FROM-ABS THRU S004-EXIT DTSBE999
|
|
02113 MOVE L004-QTR-5-9 TO QTR-FIRST-CHECK-YRQ. DTSBE999
|
|
02114 DTSBE999
|
|
02115 IF QTR-FIRST-CHECK-YRQ = ALL-NINES-YRQ DTSBE999
|
|
02116 IF SOL-SMALLEST-FIRST-LIAB-YRQ = +0 DTSBE999
|
|
02117 NEXT SENTENCE DTSBE999
|
|
02118 ELSE DTSBE999
|
|
02119 MOVE SOL-SMALLEST-FIRST-LIAB-YRQ DTSBE999
|
|
02120 TO QTR-FIRST-CHECK-YRQ. DTSBE999
|
|
02121 DTSBE999
|
|
02122 IF QTR-FIRST-ON-FILE-YRQ = +0 DTSBE999
|
|
02123 NEXT SENTENCE DTSBE999
|
|
02124 ELSE DTSBE999
|
|
02125 IF QTR-FIRST-ON-FILE-YRQ < QTR-FIRST-CHECK-YRQ DTSBE999
|
|
02126 MOVE QTR-FIRST-ON-FILE-YRQ TO QTR-FIRST-CHECK-YRQ. DTSBE999
|
|
02127 DTSBE999
|
|
02128 IF QTR-FIRST-CHECK-YRQ = ALL-NINES-YRQ DTSBE999
|
|
02129 MOVE +0 TO QTR-FIRST-CHECK-YRQ DTSBE999
|
|
02130 GO TO P2210-EXIT. DTSBE999
|
|
02131 DTSBE999
|
|
02132 MOVE +0 TO QTR-LAST-CHECK-YRQ. DTSBE999
|
|
02133 DTSBE999
|
|
02134 IF LECM-LAST-UC30-MASS-MAIL-YRQ > SOL-LARGEST-LAST-LIAB-YRQ DTSBE999
|
|
02135 MOVE SOL-LARGEST-LAST-LIAB-YRQ TO QTR-LAST-CHECK-YRQ DTSBE999
|
|
02136 ELSE DTSBE999
|
|
02137 MOVE LECM-LAST-UC30-MASS-MAIL-YRQ TO QTR-LAST-CHECK-YRQ. DTSBE999
|
|
02138 DTSBE999
|
|
02139 IF QTR-LAST-ON-FILE-YRQ = +0 DTSBE999
|
|
02140 NEXT SENTENCE DTSBE999
|
|
02141 ELSE DTSBE999
|
|
02142 IF QTR-LAST-ON-FILE-YRQ > QTR-LAST-CHECK-YRQ DTSBE999
|
|
02143 MOVE QTR-LAST-ON-FILE-YRQ DTSBE999
|
|
02144 TO QTR-LAST-CHECK-YRQ. DTSBE999
|
|
02145 DTSBE999
|
|
02146 IF QTR-LAST-CHECK-YRQ < QTR-FIRST-CHECK-YRQ DTSBE999
|
|
02147 MOVE QTR-FIRST-CHECK-YRQ TO QTR-LAST-CHECK-YRQ. DTSBE999
|
|
02148 P2210-EXIT. DTSBE999
|
|
02149 EXIT. DTSBE999
|
|
02150 EJECT DTSBE999
|
|
02151 P2220-MQTR. DTSBE999
|
|
02152 MOVE QTR-CURR-CHECK-ABS-QTR TO L004-ABS-QTR. DTSBE999
|
|
02153 DTSBE999
|
|
02154 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBE999
|
|
02155 DTSBE999
|
|
02156 IF L004-INVALID-QTR DTSBE999
|
|
02157 MOVE 'P2220-1 LOGIC ERROR' TO ABEND-MSG DTSBE999
|
|
02158 PERFORM S999-ABEND THRU S999-EXIT. DTSBE999
|
|
02159 DTSBE999
|
|
02160 DTSBE999
|
|
02161 IF MPRF-CLASS-SUB-88 DTSBE999
|
|
02162 NEXT SENTENCE DTSBE999
|
|
02163 ELSE DTSBE999
|
|
02164 MOVE L004-SLASH-QTR TO MSG42-SLASH-QTR DTSBE999
|
|
02165 MOVE 42 TO MSG-NO DTSBE999
|
|
02166 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBE999
|
|
02167 GO TO P2220-EXIT. DTSBE999
|
|
02168 DTSBE999
|
|
02169 DTSBE999
|
|
02170 MOVE L004-QTR-5-9 TO L516-YRQ. DTSBE999
|
|
02171 DTSBE999
|
|
02172 MOVE L004-SLASH-QTR TO WRK-SLASH-QTR. DTSBE999
|
|
02173 DTSBE999
|
|
02174 MOVE L004-QTR-DEFAULT-DUE-DATE DTSBE999
|
|
02175 TO WRK-QTR-DEFAULT-DUE-DATE. DTSBE999
|
|
02176 DTSBE999
|
|
02177 PERFORM S516-QTR-LIABILITY-RATE THRU S516-EXIT. DTSBE999
|
|
02178 DTSBE999
|
|
02179 DTSBE999
|
|
02180 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBE999
|
|
02181 DTSBE999
|
|
02182 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBE999
|
|
02183 DTSBE999
|
|
02184 SET MQTR-QTR-88 TO TRUE. DTSBE999
|
|
02185 DTSBE999
|
|
02186 MOVE L516-YRQ TO MQTR-YRQ. DTSBE999
|
|
02187 DTSBE999
|
|
02188 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBE999
|
|
02189 DTSBE999
|
|
02190 PERFORM S910-READ THRU S910-EXIT. DTSBE999
|
|
02191 DTSBE999
|
|
02192 IF L910-NO-REC-88 DTSBE999
|
|
02193 PERFORM P2230-NO-MQTR-EXISTS THRU P2230-EXIT DTSBE999
|
|
02194 ELSE DTSBE999
|
|
02195 MOVE MSKL-REC TO MQTR-REC DTSBE999
|
|
02196 PERFORM P2240-MQTR-EXISTS THRU P2240-EXIT. DTSBE999
|
|
02197 P2220-EXIT. DTSBE999
|
|
02198 EXIT. DTSBE999
|
|
02199 EJECT DTSBE999
|
|
02200 P2230-NO-MQTR-EXISTS. DTSBE999
|
|
02201 IF MQTR-YRQ > MPRF-LAST-ARCHIVED-YRQ DTSBE999
|
|
02202 NEXT SENTENCE DTSBE999
|
|
02203 ELSE DTSBE999
|
|
02204 GO TO P2230-EXIT. DTSBE999
|
|
02205 DTSBE999
|
|
02206 DTSBE999
|
|
02207 IF MQTR-YRQ > LECM-LAST-UC30-DEL-MAIL-YRQ DTSBE999
|
|
02208 GO TO P2230-EXIT. DTSBE999
|
|
02209 DTSBE999
|
|
02210 *& LINES ADDED FOR TESTING 8/1/1999 - GD DTSBE999
|
|
02211 * IF MPRF-CLASS-SELF-INS-88 DTSBE999
|
|
02212 * DISPLAY 'S.I. MISSING MQTR ' MPRF-EMP-NO DTSBE999
|
|
02213 * ' ' MQTR-YRQ DTSBE999
|
|
02214 * ELSE DTSBE999
|
|
02215 * IF MQTR-YRQ = 19991 DTSBE999
|
|
02216 * GO TO P2230-EXIT. DTSBE999
|
|
02217 *& DTSBE999
|
|
02218 DTSBE999
|
|
02219 IF L516-LIABLE-88 DTSBE999
|
|
02220 MOVE WRK-SLASH-QTR TO MSG46-SLASH-QTR DTSBE999
|
|
02221 MOVE 46 TO MSG-NO DTSBE999
|
|
02222 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBE999
|
|
02223 GO TO P2230-EXIT. DTSBE999
|
|
02224 P2230-EXIT. DTSBE999
|
|
02225 EXIT. DTSBE999
|
|
02226 EJECT DTSBE999
|
|
02227 P2240-MQTR-EXISTS. DTSBE999
|
|
02228 *****IF MQTR-YRQ <= MPRF-LAST-ARCHIVED-YRQ DTSBE999
|
|
02229 *********DISPLAY MPRF-EMP-NO DTSBE999
|
|
02230 *****************' ' DTSBE999
|
|
02231 *****************MQTR-YRQ DTSBE999
|
|
02232 *****************' MQTR-YRQ <= MPRF-LAST-ARCHIVED-YRQ'. DTSBE999
|
|
02233 DTSBE999
|
|
02234 PERFORM P2241-CURR-RPT-TYPE THRU P2241-EXIT. DTSBE999
|
|
02235 DTSBE999
|
|
02236 DTSBE999
|
|
02237 PERFORM P2242-PURSUED-RPT-IND THRU P2242-EXIT. DTSBE999
|
|
02238 DTSBE999
|
|
02239 DTSBE999
|
|
02240 PERFORM P2243-UI-RATE THRU P2243-EXIT. DTSBE999
|
|
02241 DTSBE999
|
|
02242 DTSBE999
|
|
02243 PERFORM P2244-TAX-DUE-DATE THRU P2244-EXIT. DTSBE999
|
|
02244 DTSBE999
|
|
02245 DTSBE999
|
|
02246 PERFORM P2245-RPT-DUE-DATE THRU P2245-EXIT. DTSBE999
|
|
02247 DTSBE999
|
|
02248 PERFORM P2246-WAGE-AMOUNTS THRU P2246-EXIT. DTSBE999
|
|
02249 DTSBE999
|
|
02250 PERFORM P2247-DUE-DATE-INDS THRU P2247-EXIT. DTSBE999
|
|
02251 DTSBE999
|
|
02252 PERFORM P2248-CHARGE-INDS THRU P2248-EXIT. DTSBE999
|
|
02253 DTSBE999
|
|
02254 DTSBE999
|
|
02255 MOVE +0 TO DST-BY-QTR-SUB. DTSBE999
|
|
02256 DTSBE999
|
|
02257 PERFORM DTSBE999
|
|
02258 VARYING DST-BY-QTR-IDX FROM 1 BY 1 DTSBE999
|
|
02259 UNTIL (DST-BY-QTR-IDX > DST-BY-QTR-CNT) DTSBE999
|
|
02260 OR DTSBE999
|
|
02261 (DST-BY-QTR-SUB NOT = +0) DTSBE999
|
|
02262 IF MQTR-YRQ = DST-BY-QTR-YRQ (DST-BY-QTR-IDX) DTSBE999
|
|
02263 SET DST-BY-QTR-SUB TO DST-BY-QTR-IDX DTSBE999
|
|
02264 END-IF DTSBE999
|
|
02265 END-PERFORM. DTSBE999
|
|
02266 DTSBE999
|
|
02267 DTSBE999
|
|
02268 IF DST-BY-QTR-SUB = +0 DTSBE999
|
|
02269 ADD +1 TO DST-BY-QTR-CNT DTSBE999
|
|
02270 INITIALIZE DST-BY-QTR-AREA (DST-BY-QTR-CNT) DTSBE999
|
|
02271 MOVE MQTR-YRQ TO DST-BY-QTR-YRQ (DST-BY-QTR-CNT) DTSBE999
|
|
02272 MOVE DST-BY-QTR-CNT TO DST-BY-QTR-SUB. DTSBE999
|
|
02273 DTSBE999
|
|
02274 SET DST-BY-QTR-IDX TO DST-BY-QTR-SUB. DTSBE999
|
|
02275 DTSBE999
|
|
02276 DTSBE999
|
|
02277 MOVE +0 TO QTR-BALANCE-AMT. DTSBE999
|
|
02278 DTSBE999
|
|
02279 MOVE +0 TO QTR-INT-CHARGED-AMT. DTSBE999
|
|
02280 ****************QTR-PEN-CHARGED-AMT. DTSBE999
|
|
02281 DTSBE999
|
|
02282 PERFORM P2250-MQTR-ACCT-CHECK THRU P2250-EXIT DTSBE999
|
|
02283 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBE999
|
|
02284 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT. DTSBE999
|
|
02285 DTSBE999
|
|
02286 DTSBE999
|
|
02287 IF (QTR-BALANCE-AMT > +0) DTSBE999
|
|
02288 AND DTSBE999
|
|
02289 (QTR-BALANCE-AMT <= QTR-TOL-MAX) DTSBE999
|
|
02290 MOVE WRK-SLASH-QTR TO MSG29-SLASH-QTR DTSBE999
|
|
02291 MOVE 29 TO MSG-NO DTSBE999
|
|
02292 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
02293 DTSBE999
|
|
02294 DTSBE999
|
|
02295 ***** DTSBE999
|
|
02296 * DTSBE999
|
|
02297 * P2260-RECOMPUTE-INT INCREASES THE COST OF THIS EXTRACT DTSBE999
|
|
02298 * BY A FACTOR OF 3. IF YOU DECIDE TO EXERCISE THE P2260- DTSBE999
|
|
02299 * RECOMPUTE-INT, THEN MAKE SURE YOU SPECIFY PLENTY OF DTSBE999
|
|
02300 * CPU TIME. DTSBE999
|
|
02301 * DTSBE999
|
|
02302 ***** DTSBE999
|
|
02303 DTSBE999
|
|
02304 *****PERFORM P2260-RECOMPUTE-INT THRU P2260-EXIT. DTSBE999
|
|
02305 P2240-EXIT. DTSBE999
|
|
02306 EXIT. DTSBE999
|
|
02307 SKIP3 DTSBE999
|
|
02308 P2241-CURR-RPT-TYPE. DTSBE999
|
|
02309 *& NOTE: CALL TO P2241A ADDED FOR DEBUGGING - GD 7/20/1999 DTSBE999
|
|
02310 IF MQTR-YRQ = LECM-PICKUP-YRQ DTSBE999
|
|
02311 IF MQTR-CURR-PICKUP-88 DTSBE999
|
|
02312 GO TO P2241-EXIT DTSBE999
|
|
02313 ELSE DTSBE999
|
|
02314 MOVE WRK-SLASH-QTR TO MSG47-SLASH-QTR DTSBE999
|
|
02315 MOVE 47 TO MSG-NO DTSBE999
|
|
02316 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBE999
|
|
02317 GO TO P2241-EXIT. DTSBE999
|
|
02318 DTSBE999
|
|
02319 DTSBE999
|
|
02320 IF L516-NOT-LIABLE-88 DTSBE999
|
|
02321 IF MQTR-CURR-NOT-LIABLE-88 DTSBE999
|
|
02322 GO TO P2241-EXIT DTSBE999
|
|
02323 ELSE DTSBE999
|
|
02324 MOVE WRK-SLASH-QTR TO MSG47-SLASH-QTR DTSBE999
|
|
02325 MOVE 47 TO MSG-NO DTSBE999
|
|
02326 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBE999
|
|
02327 PERFORM P2241A-DISPLAY THRU P2241A-EXIT DTSBE999
|
|
02328 GO TO P2241-EXIT. DTSBE999
|
|
02329 DTSBE999
|
|
02330 DTSBE999
|
|
02331 IF MQTR-CURR-ESTIM-88 OR MQTR-CURR-RCVD-88 DTSBE999
|
|
02332 GO TO P2241-EXIT. DTSBE999
|
|
02333 DTSBE999
|
|
02334 DTSBE999
|
|
02335 IF MQTR-RPT-DUE-DATE = WRK-QTR-DEFAULT-DUE-DATE DTSBE999
|
|
02336 IF MQTR-YRQ > LECM-LAST-UC30-DEL-MAIL-YRQ DTSBE999
|
|
02337 IF MQTR-CURR-NOT-DUE-88 DTSBE999
|
|
02338 NEXT SENTENCE DTSBE999
|
|
02339 ELSE DTSBE999
|
|
02340 MOVE WRK-SLASH-QTR TO MSG47-SLASH-QTR DTSBE999
|
|
02341 MOVE 47 TO MSG-NO DTSBE999
|
|
02342 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBE999
|
|
02343 PERFORM P2241A-DISPLAY THRU P2241A-EXIT DTSBE999
|
|
02344 ELSE DTSBE999
|
|
02345 IF MQTR-CURR-DELINQ-88 DTSBE999
|
|
02346 NEXT SENTENCE DTSBE999
|
|
02347 ELSE DTSBE999
|
|
02348 MOVE WRK-SLASH-QTR TO MSG47-SLASH-QTR DTSBE999
|
|
02349 MOVE 47 TO MSG-NO DTSBE999
|
|
02350 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBE999
|
|
02351 PERFORM P2241A-DISPLAY THRU P2241A-EXIT DTSBE999
|
|
02352 ELSE DTSBE999
|
|
02353 IF MQTR-RPT-DUE-DATE > LECM-PRIOR-RUN-DATE DTSBE999
|
|
02354 IF MQTR-CURR-NOT-DUE-88 DTSBE999
|
|
02355 NEXT SENTENCE DTSBE999
|
|
02356 ELSE DTSBE999
|
|
02357 MOVE WRK-SLASH-QTR TO MSG47-SLASH-QTR DTSBE999
|
|
02358 MOVE 47 TO MSG-NO DTSBE999
|
|
02359 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBE999
|
|
02360 PERFORM P2241A-DISPLAY THRU P2241A-EXIT DTSBE999
|
|
02361 ELSE DTSBE999
|
|
02362 IF MQTR-CURR-DELINQ-88 DTSBE999
|
|
02363 NEXT SENTENCE DTSBE999
|
|
02364 ELSE DTSBE999
|
|
02365 MOVE WRK-SLASH-QTR TO MSG47-SLASH-QTR DTSBE999
|
|
02366 MOVE 47 TO MSG-NO DTSBE999
|
|
02367 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBE999
|
|
02368 PERFORM P2241A-DISPLAY THRU P2241A-EXIT. DTSBE999
|
|
02369 P2241-EXIT. DTSBE999
|
|
02370 EXIT. DTSBE999
|
|
02371 P2241A-DISPLAY. DTSBE999
|
|
02372 DISPLAY 'P2241 YRQ ' L516-YRQ ' LIAB IND ' L516-LIABLE-IND DTSBE999
|
|
02373 ' MQTR-CURR-RPT ' MQTR-CURR-RPT-TYPE. DTSBE999
|
|
02374 DISPLAY ' MQTR-RPT-DUE ' MQTR-RPT-DUE-DATE DTSBE999
|
|
02375 ' WRK-QTR-DEFAULT-DUE ' WRK-QTR-DEFAULT-DUE-DATE. DTSBE999
|
|
02376 DTSBE999
|
|
02377 P2241A-EXIT. DTSBE999
|
|
02378 EXIT. DTSBE999
|
|
02379 SKIP3 DTSBE999
|
|
02380 P2242-PURSUED-RPT-IND. DTSBE999
|
|
02381 IF (MQTR-CURR-MISSING-88) DTSBE999
|
|
02382 AND DTSBE999
|
|
02383 (MPRF-NOT-WRITTEN-OFF-88) DTSBE999
|
|
02384 AND DTSBE999
|
|
02385 (MQTR-YRQ >= LECM-FIRST-PURSUED-RPT-YRQ) DTSBE999
|
|
02386 IF MQTR-RPT-IS-PURSUED-88 DTSBE999
|
|
02387 NEXT SENTENCE DTSBE999
|
|
02388 ELSE DTSBE999
|
|
02389 MOVE WRK-SLASH-QTR TO MSG48-SLASH-QTR DTSBE999
|
|
02390 MOVE 48 TO MSG-NO DTSBE999
|
|
02391 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBE999
|
|
02392 ELSE DTSBE999
|
|
02393 IF MQTR-RPT-NOT-PURSUED-88 DTSBE999
|
|
02394 NEXT SENTENCE DTSBE999
|
|
02395 ELSE DTSBE999
|
|
02396 MOVE WRK-SLASH-QTR TO MSG48-SLASH-QTR DTSBE999
|
|
02397 MOVE 48 TO MSG-NO DTSBE999
|
|
02398 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
02399 P2242-EXIT. DTSBE999
|
|
02400 EXIT. DTSBE999
|
|
02401 SKIP3 DTSBE999
|
|
02402 P2243-UI-RATE. DTSBE999
|
|
02403 *& MODIFIED TO SKIP THE LAST QUARTER ON FILE - GD 8/20/1999 DTSBE999
|
|
02404 IF MQTR-YRQ = 19992 DTSBE999
|
|
02405 GO TO P2243-EXIT. DTSBE999
|
|
02406 *& DTSBE999
|
|
02407 DTSBE999
|
|
02408 IF MQTR-YRQ = LECM-PICKUP-YRQ DTSBE999
|
|
02409 IF MQTR-NO-UI-RATE-88 DTSBE999
|
|
02410 GO TO P2243-EXIT DTSBE999
|
|
02411 ELSE DTSBE999
|
|
02412 MOVE WRK-SLASH-QTR TO MSG49-SLASH-QTR DTSBE999
|
|
02413 MOVE 49 TO MSG-NO DTSBE999
|
|
02414 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBE999
|
|
02415 GO TO P2243-EXIT. DTSBE999
|
|
02416 DTSBE999
|
|
02417 DTSBE999
|
|
02418 IF MQTR-UI-RATE = L516-UI-RATE DTSBE999
|
|
02419 NEXT SENTENCE DTSBE999
|
|
02420 ELSE DTSBE999
|
|
02421 *& MODIFIED TO REPORT INCONSISTENT RATES ONLY FOR DTSBE999
|
|
02422 * ACTIVE ACCOUNTS. GD 08/18/1999 DTSBE999
|
|
02423 IF MPRF-STATUS-ACT-88 DTSBE999
|
|
02424 *& DTSBE999
|
|
02425 MOVE WRK-SLASH-QTR TO MSG49-SLASH-QTR DTSBE999
|
|
02426 MOVE 49 TO MSG-NO DTSBE999
|
|
02427 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
02428 P2243-EXIT. DTSBE999
|
|
02429 EXIT. DTSBE999
|
|
02430 SKIP3 DTSBE999
|
|
02431 P2244-TAX-DUE-DATE. DTSBE999
|
|
02432 IF MQTR-YRQ = LECM-PICKUP-YRQ DTSBE999
|
|
02433 GO TO P2244-EXIT. DTSBE999
|
|
02434 DTSBE999
|
|
02435 IF MQTR-TAX-DUE-DATE-AUTO-88 DTSBE999
|
|
02436 IF MQTR-TAX-DUE-DATE = L516-DEFAULT-TAX-DUE-DATE DTSBE999
|
|
02437 NEXT SENTENCE DTSBE999
|
|
02438 ELSE DTSBE999
|
|
02439 MOVE WRK-SLASH-QTR TO MSG34-SLASH-QTR DTSBE999
|
|
02440 MOVE 34 TO MSG-NO DTSBE999
|
|
02441 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBE999
|
|
02442 ELSE DTSBE999
|
|
02443 IF MQTR-TAX-DUE-DATE > L516-DEFAULT-TAX-DUE-DATE DTSBE999
|
|
02444 MOVE WRK-SLASH-QTR TO MSG26-SLASH-QTR DTSBE999
|
|
02445 MOVE 26 TO MSG-NO DTSBE999
|
|
02446 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
02447 P2244-EXIT. DTSBE999
|
|
02448 EXIT. DTSBE999
|
|
02449 SKIP3 DTSBE999
|
|
02450 P2245-RPT-DUE-DATE. DTSBE999
|
|
02451 IF MQTR-YRQ = LECM-PICKUP-YRQ DTSBE999
|
|
02452 GO TO P2245-EXIT. DTSBE999
|
|
02453 DTSBE999
|
|
02454 IF MQTR-RPT-DUE-DATE-AUTO-88 DTSBE999
|
|
02455 IF MQTR-RPT-DUE-DATE = L516-DEFAULT-RPT-DUE-DATE DTSBE999
|
|
02456 NEXT SENTENCE DTSBE999
|
|
02457 ELSE DTSBE999
|
|
02458 MOVE WRK-SLASH-QTR TO MSG35-SLASH-QTR DTSBE999
|
|
02459 MOVE 35 TO MSG-NO DTSBE999
|
|
02460 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
02461 P2245-EXIT. DTSBE999
|
|
02462 EXIT. DTSBE999
|
|
02463 SKIP3 DTSBE999
|
|
02464 P2246-WAGE-AMOUNTS. DTSBE999
|
|
02465 IF MQTR-YRQ = LECM-PICKUP-YRQ DTSBE999
|
|
02466 IF (MQTR-TOT-WAGE = +0) DTSBE999
|
|
02467 AND DTSBE999
|
|
02468 (MQTR-EXCESS-WAGE = +0) DTSBE999
|
|
02469 AND DTSBE999
|
|
02470 (MQTR-TAX-WAGE = +0) DTSBE999
|
|
02471 GO TO P2246-EXIT DTSBE999
|
|
02472 ELSE DTSBE999
|
|
02473 MOVE WRK-SLASH-QTR TO MSG50-SLASH-QTR DTSBE999
|
|
02474 MOVE 50 TO MSG-NO DTSBE999
|
|
02475 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBE999
|
|
02476 GO TO P2246-EXIT. DTSBE999
|
|
02477 DTSBE999
|
|
02478 IF MPRF-CLASS-SELF-INS-88 DTSBE999
|
|
02479 IF (MQTR-TOT-WAGE >= +0) DTSBE999
|
|
02480 AND DTSBE999
|
|
02481 (MQTR-EXCESS-WAGE = +0) DTSBE999
|
|
02482 AND DTSBE999
|
|
02483 (MQTR-TAX-WAGE = +0) DTSBE999
|
|
02484 GO TO P2246-EXIT DTSBE999
|
|
02485 ELSE DTSBE999
|
|
02486 MOVE WRK-SLASH-QTR TO MSG51-SLASH-QTR DTSBE999
|
|
02487 MOVE 51 TO MSG-NO DTSBE999
|
|
02488 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBE999
|
|
02489 GO TO P2246-EXIT. DTSBE999
|
|
02490 DTSBE999
|
|
02491 IF (MQTR-TOT-WAGE >= +0) DTSBE999
|
|
02492 AND DTSBE999
|
|
02493 (MQTR-EXCESS-WAGE >= +0) DTSBE999
|
|
02494 AND DTSBE999
|
|
02495 (MQTR-TAX-WAGE >= +0) DTSBE999
|
|
02496 NEXT SENTENCE DTSBE999
|
|
02497 ELSE DTSBE999
|
|
02498 MOVE WRK-SLASH-QTR TO MSG52-SLASH-QTR DTSBE999
|
|
02499 MOVE 52 TO MSG-NO DTSBE999
|
|
02500 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBE999
|
|
02501 GO TO P2246-EXIT. DTSBE999
|
|
02502 DTSBE999
|
|
02503 COMPUTE WRK-TAX-WAGE = MQTR-TOT-WAGE - MQTR-EXCESS-WAGE. DTSBE999
|
|
02504 DTSBE999
|
|
02505 IF WRK-TAX-WAGE = MQTR-TAX-WAGE DTSBE999
|
|
02506 NEXT SENTENCE DTSBE999
|
|
02507 ELSE DTSBE999
|
|
02508 MOVE WRK-SLASH-QTR TO MSG53-SLASH-QTR DTSBE999
|
|
02509 MOVE 53 TO MSG-NO DTSBE999
|
|
02510 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBE999
|
|
02511 GO TO P2246-EXIT. DTSBE999
|
|
02512 P2246-EXIT. DTSBE999
|
|
02513 EXIT. DTSBE999
|
|
02514 SKIP3 DTSBE999
|
|
02515 P2247-DUE-DATE-INDS. DTSBE999
|
|
02516 IF MQTR-YRQ = LECM-PICKUP-YRQ DTSBE999
|
|
02517 IF (MQTR-TAX-DUE-DATE-AUTO-88) DTSBE999
|
|
02518 AND DTSBE999
|
|
02519 (MQTR-RPT-DUE-DATE-AUTO-88) DTSBE999
|
|
02520 GO TO P2247-EXIT DTSBE999
|
|
02521 ELSE DTSBE999
|
|
02522 MOVE WRK-SLASH-QTR TO MSG54-SLASH-QTR DTSBE999
|
|
02523 MOVE 54 TO MSG-NO DTSBE999
|
|
02524 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBE999
|
|
02525 GO TO P2247-EXIT. DTSBE999
|
|
02526 P2247-EXIT. DTSBE999
|
|
02527 EXIT. DTSBE999
|
|
02528 SKIP3 DTSBE999
|
|
02529 P2248-CHARGE-INDS. DTSBE999
|
|
02530 IF MQTR-YRQ = LECM-PICKUP-YRQ DTSBE999
|
|
02531 IF (MQTR-INT-CHARGE-MANUAL-88) DTSBE999
|
|
02532 AND DTSBE999
|
|
02533 (MQTR-PEN-CHARGE-MANUAL-88) DTSBE999
|
|
02534 GO TO P2248-EXIT DTSBE999
|
|
02535 ELSE DTSBE999
|
|
02536 MOVE WRK-SLASH-QTR TO MSG55-SLASH-QTR DTSBE999
|
|
02537 MOVE 55 TO MSG-NO DTSBE999
|
|
02538 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBE999
|
|
02539 GO TO P2248-EXIT. DTSBE999
|
|
02540 P2248-EXIT. DTSBE999
|
|
02541 EXIT. DTSBE999
|
|
02542 EJECT DTSBE999
|
|
02543 P2250-MQTR-ACCT-CHECK. DTSBE999
|
|
02544 IF MQTR-CHARGED-AMT (MQTR-ACCT-IDX) < +0 DTSBE999
|
|
02545 MOVE WRK-SLASH-QTR TO MSG36-SLASH-QTR DTSBE999
|
|
02546 MOVE MQTR-ACCT-IND (MQTR-ACCT-IDX) TO MSG36-ACCT-IND DTSBE999
|
|
02547 MOVE CACT-CAT-CHARGED TO MSG36-ACCT-CAT DTSBE999
|
|
02548 MOVE 36 TO MSG-NO DTSBE999
|
|
02549 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
02550 DTSBE999
|
|
02551 IF MQTR-PAID-AMT (MQTR-ACCT-IDX) < +0 DTSBE999
|
|
02552 MOVE WRK-SLASH-QTR TO MSG36-SLASH-QTR DTSBE999
|
|
02553 MOVE MQTR-ACCT-IND (MQTR-ACCT-IDX) TO MSG36-ACCT-IND DTSBE999
|
|
02554 MOVE CACT-CAT-PAID TO MSG36-ACCT-CAT DTSBE999
|
|
02555 MOVE 36 TO MSG-NO DTSBE999
|
|
02556 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
02557 DTSBE999
|
|
02558 IF MQTR-WAIVED-AMT (MQTR-ACCT-IDX) < +0 DTSBE999
|
|
02559 MOVE WRK-SLASH-QTR TO MSG36-SLASH-QTR DTSBE999
|
|
02560 MOVE MQTR-ACCT-IND (MQTR-ACCT-IDX) TO MSG36-ACCT-IND DTSBE999
|
|
02561 MOVE CACT-CAT-WAIVED TO MSG36-ACCT-CAT DTSBE999
|
|
02562 MOVE 36 TO MSG-NO DTSBE999
|
|
02563 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
02564 DTSBE999
|
|
02565 IF MQTR-WRITTEN-OFF-AMT (MQTR-ACCT-IDX) < +0 DTSBE999
|
|
02566 MOVE WRK-SLASH-QTR TO MSG36-SLASH-QTR DTSBE999
|
|
02567 MOVE MQTR-ACCT-IND (MQTR-ACCT-IDX) TO MSG36-ACCT-IND DTSBE999
|
|
02568 MOVE CACT-CAT-WRITTEN-OFF TO MSG36-ACCT-CAT DTSBE999
|
|
02569 MOVE 36 TO MSG-NO DTSBE999
|
|
02570 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
02571 DTSBE999
|
|
02572 IF MQTR-TOLER-AMT (MQTR-ACCT-IDX) < +0 DTSBE999
|
|
02573 MOVE WRK-SLASH-QTR TO MSG36-SLASH-QTR DTSBE999
|
|
02574 MOVE MQTR-ACCT-IND (MQTR-ACCT-IDX) TO MSG36-ACCT-IND DTSBE999
|
|
02575 MOVE CACT-CAT-TOLER TO MSG36-ACCT-CAT DTSBE999
|
|
02576 MOVE 36 TO MSG-NO DTSBE999
|
|
02577 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
02578 DTSBE999
|
|
02579 IF MQTR-BALANCE-AMT (MQTR-ACCT-IDX) < +0 DTSBE999
|
|
02580 MOVE WRK-SLASH-QTR TO MSG36-SLASH-QTR DTSBE999
|
|
02581 MOVE MQTR-ACCT-IND (MQTR-ACCT-IDX) TO MSG36-ACCT-IND DTSBE999
|
|
02582 MOVE 'BL' TO MSG36-ACCT-CAT DTSBE999
|
|
02583 MOVE 36 TO MSG-NO DTSBE999
|
|
02584 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
02585 DTSBE999
|
|
02586 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) TO QTR-BALANCE-AMT. DTSBE999
|
|
02587 DTSBE999
|
|
02588 COMPUTE WRK-BALANCE-AMT DTSBE999
|
|
02589 = MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSBE999
|
|
02590 - MQTR-PAID-AMT (MQTR-ACCT-IDX) DTSBE999
|
|
02591 - MQTR-WAIVED-AMT (MQTR-ACCT-IDX) DTSBE999
|
|
02592 - MQTR-WRITTEN-OFF-AMT (MQTR-ACCT-IDX) DTSBE999
|
|
02593 - MQTR-TOLER-AMT (MQTR-ACCT-IDX). DTSBE999
|
|
02594 DTSBE999
|
|
02595 IF WRK-BALANCE-AMT = MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBE999
|
|
02596 NEXT SENTENCE DTSBE999
|
|
02597 ELSE DTSBE999
|
|
02598 MOVE WRK-SLASH-QTR TO MSG37-SLASH-QTR DTSBE999
|
|
02599 MOVE MQTR-ACCT-IND (MQTR-ACCT-IDX) TO MSG37-ACCT-IND DTSBE999
|
|
02600 MOVE 37 TO MSG-NO DTSBE999
|
|
02601 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
02602 DTSBE999
|
|
02603 IF MPRF-NOT-WRITTEN-OFF-88 DTSBE999
|
|
02604 IF MQTR-WRITTEN-OFF-AMT (MQTR-ACCT-IDX) = +0 DTSBE999
|
|
02605 NEXT SENTENCE DTSBE999
|
|
02606 ELSE DTSBE999
|
|
02607 MOVE WRK-SLASH-QTR TO MSG38-SLASH-QTR DTSBE999
|
|
02608 MOVE MQTR-ACCT-IND (MQTR-ACCT-IDX) TO MSG38-ACCT-IND DTSBE999
|
|
02609 MOVE 38 TO MSG-NO DTSBE999
|
|
02610 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBE999
|
|
02611 ELSE DTSBE999
|
|
02612 IF MQTR-BALANCE-AMT (MQTR-ACCT-IDX) = +0 DTSBE999
|
|
02613 NEXT SENTENCE DTSBE999
|
|
02614 ELSE DTSBE999
|
|
02615 MOVE WRK-SLASH-QTR TO MSG39-SLASH-QTR DTSBE999
|
|
02616 MOVE MQTR-ACCT-IND (MQTR-ACCT-IDX) TO MSG39-ACCT-IND DTSBE999
|
|
02617 MOVE 39 TO MSG-NO DTSBE999
|
|
02618 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
02619 DTSBE999
|
|
02620 *****IF MQTR-ACCT-PEN-88 (MQTR-ACCT-IDX) DTSBE999
|
|
02621 *********MOVE MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSBE999
|
|
02622 ***********TO QTR-PEN-CHARGED-AMT. DTSBE999
|
|
02623 DTSBE999
|
|
02624 IF MQTR-ACCT-INT-88 (MQTR-ACCT-IDX) DTSBE999
|
|
02625 MOVE MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSBE999
|
|
02626 TO QTR-INT-CHARGED-AMT. DTSBE999
|
|
02627 DTSBE999
|
|
02628 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSBE999
|
|
02629 SUBTRACT MQTR-PAID-AMT (MQTR-ACCT-IDX) DTSBE999
|
|
02630 FROM DST-BY-QTR-UI-AMT (DST-BY-QTR-IDX) DTSBE999
|
|
02631 ELSE DTSBE999
|
|
02632 IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) DTSBE999
|
|
02633 SUBTRACT MQTR-PAID-AMT (MQTR-ACCT-IDX) DTSBE999
|
|
02634 FROM DST-BY-QTR-SUR-AMT (DST-BY-QTR-IDX) DTSBE999
|
|
02635 ELSE DTSBE999
|
|
02636 IF MQTR-ACCT-INT-88 (MQTR-ACCT-IDX) DTSBE999
|
|
02637 SUBTRACT MQTR-PAID-AMT (MQTR-ACCT-IDX) DTSBE999
|
|
02638 FROM DST-BY-QTR-INT-AMT (DST-BY-QTR-IDX) DTSBE999
|
|
02639 ELSE DTSBE999
|
|
02640 IF MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX) DTSBE999
|
|
02641 SUBTRACT MQTR-PAID-AMT (MQTR-ACCT-IDX) DTSBE999
|
|
02642 FROM DST-BY-QTR-LATE-PEN-AMT (DST-BY-QTR-IDX) DTSBE999
|
|
02643 ELSE DTSBE999
|
|
02644 IF MQTR-ACCT-NSF-PEN-88 (MQTR-ACCT-IDX) DTSBE999
|
|
02645 SUBTRACT MQTR-PAID-AMT (MQTR-ACCT-IDX) DTSBE999
|
|
02646 FROM DST-BY-QTR-NSF-PEN-AMT (DST-BY-QTR-IDX) DTSBE999
|
|
02647 ELSE DTSBE999
|
|
02648 IF MQTR-ACCT-MISC-PEN-88 (MQTR-ACCT-IDX) DTSBE999
|
|
02649 SUBTRACT MQTR-PAID-AMT (MQTR-ACCT-IDX) DTSBE999
|
|
02650 FROM DST-BY-QTR-MISC-PEN-AMT (DST-BY-QTR-IDX) DTSBE999
|
|
02651 ELSE DTSBE999
|
|
02652 MOVE WRK-SLASH-QTR TO MSG40-SLASH-QTR DTSBE999
|
|
02653 MOVE MQTR-ACCT-IND (MQTR-ACCT-IDX) TO MSG40-ACCT-IND DTSBE999
|
|
02654 MOVE 40 TO MSG-NO DTSBE999
|
|
02655 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
02656 P2250-EXIT. DTSBE999
|
|
02657 EXIT. DTSBE999
|
|
02658 EJECT DTSBE999
|
|
02659 P2260-RECOMPUTE-PEN. DTSBE999
|
|
02660 SET L101-WAIVE-INT-NO-88 TO TRUE. DTSBE999
|
|
02661 DTSBE999
|
|
02662 *****SET L101-WAIVE-PEN-NO-88 TO TRUE. DTSBE999
|
|
02663 DTSBE999
|
|
02664 MOVE MQTR-TAX-DUE-DATE TO L101-TAX-DUE-DATE. DTSBE999
|
|
02665 DTSBE999
|
|
02666 *****MOVE +0 TO L101-PEN-CHARGED-AMT. DTSBE999
|
|
02667 DTSBE999
|
|
02668 MOVE MQTR-INT-AREA TO L101-INT-AREA. DTSBE999
|
|
02669 DTSBE999
|
|
02670 *****MOVE +0 TO L101-SUBJ10-AMT DTSBE999
|
|
02671 ****************L101-SUBJ15-AMT. DTSBE999
|
|
02672 DTSBE999
|
|
02673 MOVE +0 TO WRK-INT-CHARGED-AMT. DTSBE999
|
|
02674 ****************WRK-PEN-CHARGED-AMT. DTSBE999
|
|
02675 DTSBE999
|
|
02676 MOVE LOW-VALUES TO MDST-KEY-AREA. DTSBE999
|
|
02677 DTSBE999
|
|
02678 MOVE MPRF-EMP-NO TO MDST-EMP-NO. DTSBE999
|
|
02679 DTSBE999
|
|
02680 SET MDST-DST-88 TO TRUE. DTSBE999
|
|
02681 DTSBE999
|
|
02682 MOVE MQTR-YRQ TO MDST-YRQ. DTSBE999
|
|
02683 DTSBE999
|
|
02684 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBE999
|
|
02685 DTSBE999
|
|
02686 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE999
|
|
02687 DTSBE999
|
|
02688 PERFORM P2261-SCAN-MDST THRU P2261-EXIT DTSBE999
|
|
02689 UNTIL L910-NO-REC-88. DTSBE999
|
|
02690 DTSBE999
|
|
02691 DTSBE999
|
|
02692 *****IF L101-SUBJ10-AMT = MQTR-TAX-PAID-SUBJ10-AMT DTSBE999
|
|
02693 *********NEXT SENTENCE DTSBE999
|
|
02694 *****ELSE DTSBE999
|
|
02695 *********MOVE WRK-SLASH-QTR TO MSG16-SLASH-QTR DTSBE999
|
|
02696 *********COMPUTE MSG16-DISCREPANCY-AMT DTSBE999
|
|
02697 ***********= MQTR-TAX-PAID-SUBJ10-AMT - L101-SUBJ10-AMT DTSBE999
|
|
02698 *********MOVE 16 TO MSG-NO DTSBE999
|
|
02699 *********PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
02700 DTSBE999
|
|
02701 DTSBE999
|
|
02702 *****IF L101-SUBJ15-AMT = MQTR-TAX-PAID-SUBJ15-AMT DTSBE999
|
|
02703 *********NEXT SENTENCE DTSBE999
|
|
02704 *****ELSE DTSBE999
|
|
02705 *********MOVE WRK-SLASH-QTR TO MSG17-SLASH-QTR DTSBE999
|
|
02706 *********COMPUTE MSG17-DISCREPANCY-AMT DTSBE999
|
|
02707 ***********= MQTR-TAX-PAID-SUBJ15-AMT - L101-SUBJ15-AMT DTSBE999
|
|
02708 *********MOVE 17 TO MSG-NO DTSBE999
|
|
02709 *********PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
02710 *P2260-EXIT. DTSBE999
|
|
02711 *****EXIT. DTSBE999
|
|
02712 SKIP3 DTSBE999
|
|
02713 P2261-SCAN-MDST. DTSBE999
|
|
02714 MOVE MSKL-REC TO MDST-REC. DTSBE999
|
|
02715 DTSBE999
|
|
02716 IF MDST-YRQ = MQTR-YRQ DTSBE999
|
|
02717 NEXT SENTENCE DTSBE999
|
|
02718 ELSE DTSBE999
|
|
02719 SET L910-NO-REC-88 TO TRUE DTSBE999
|
|
02720 GO TO P2261-EXIT. DTSBE999
|
|
02721 DTSBE999
|
|
02722 DTSBE999
|
|
02723 PERFORM P2261A-SCAN-ACCT THRU P2261A-EXIT DTSBE999
|
|
02724 VARYING MDST-ACCT-IDX FROM 1 BY 1 DTSBE999
|
|
02725 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT. DTSBE999
|
|
02726 DTSBE999
|
|
02727 DTSBE999
|
|
02728 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE999
|
|
02729 P2261-EXIT. DTSBE999
|
|
02730 EXIT. DTSBE999
|
|
02731 SKIP3 DTSBE999
|
|
02732 P2261A-SCAN-ACCT. DTSBE999
|
|
02733 IF MDST-ACCT-TAX-88 (MDST-ACCT-IDX) DTSBE999
|
|
02734 NEXT SENTENCE DTSBE999
|
|
02735 ELSE DTSBE999
|
|
02736 GO TO P2261A-EXIT. DTSBE999
|
|
02737 DTSBE999
|
|
02738 DTSBE999
|
|
02739 IF MDST-RECEIVED-DATE > MQTR-TAX-DUE-DATE DTSBE999
|
|
02740 NEXT SENTENCE DTSBE999
|
|
02741 ELSE DTSBE999
|
|
02742 GO TO P2261A-EXIT. DTSBE999
|
|
02743 DTSBE999
|
|
02744 DTSBE999
|
|
02745 MOVE MDST-AMT (MDST-ACCT-IDX) TO L101-PAID-CHNG. DTSBE999
|
|
02746 DTSBE999
|
|
02747 MOVE MDST-RECEIVED-DATE TO L101-RECEIVED-DATE. DTSBE999
|
|
02748 DTSBE999
|
|
02749 PERFORM S101-PER-MONTH-NO THRU S101-EXIT. DTSBE999
|
|
02750 DTSBE999
|
|
02751 ADD L101-INT-CHARGE-CHNG TO WRK-INT-CHARGED-AMT. DTSBE999
|
|
02752 DTSBE999
|
|
02753 *****ADD L101-PEN-CHARGE-CHNG TO WRK-PEN-CHARGED-AMT DTSBE999
|
|
02754 *********************************L101-PEN-CHARGED-AMT. DTSBE999
|
|
02755 DTSBE999
|
|
02756 *****ADD L101-SUBJ10-CHNG TO L101-SUBJ10-AMT. DTSBE999
|
|
02757 DTSBE999
|
|
02758 *****ADD L101-SUBJ15-CHNG TO L101-SUBJ15-AMT. DTSBE999
|
|
02759 P2261A-EXIT. DTSBE999
|
|
02760 EXIT. DTSBE999
|
|
02761 EJECT DTSBE999
|
|
02762 P2300-CHECK-MPAY. DTSBE999
|
|
02763 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBE999
|
|
02764 DTSBE999
|
|
02765 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBE999
|
|
02766 DTSBE999
|
|
02767 SET MSKL-PAY-88 TO TRUE. DTSBE999
|
|
02768 DTSBE999
|
|
02769 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE999
|
|
02770 DTSBE999
|
|
02771 PERFORM DTSBE999
|
|
02772 UNTIL L910-NO-REC-88 DTSBE999
|
|
02773 MOVE MSKL-REC TO MPAY-REC DTSBE999
|
|
02774 PERFORM P2310-PROCESS-MPAY THRU P2310-EXIT DTSBE999
|
|
02775 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE999
|
|
02776 END-PERFORM. DTSBE999
|
|
02777 DTSBE999
|
|
02778 DTSBE999
|
|
02779 PERFORM P2320-CHECK-BY-DOC-RESIDUE THRU P2320-EXIT DTSBE999
|
|
02780 VARYING DST-BY-DOC-IDX FROM 1 BY 1 DTSBE999
|
|
02781 UNTIL DST-BY-DOC-IDX > DST-BY-DOC-CNT. DTSBE999
|
|
02782 P2300-EXIT. DTSBE999
|
|
02783 EXIT. DTSBE999
|
|
02784 SKIP3 DTSBE999
|
|
02785 P2310-PROCESS-MPAY. DTSBE999
|
|
02786 IF MPAY-PAYMENT-88 DTSBE999
|
|
02787 NEXT SENTENCE DTSBE999
|
|
02788 ELSE DTSBE999
|
|
02789 GO TO P2310-EXIT. DTSBE999
|
|
02790 DTSBE999
|
|
02791 DTSBE999
|
|
02792 MOVE +0 TO DST-BY-DOC-SUB. DTSBE999
|
|
02793 DTSBE999
|
|
02794 PERFORM DTSBE999
|
|
02795 VARYING DST-BY-DOC-IDX FROM 1 BY 1 DTSBE999
|
|
02796 UNTIL (DST-BY-DOC-IDX > DST-BY-DOC-CNT) DTSBE999
|
|
02797 OR DTSBE999
|
|
02798 (DST-BY-DOC-SUB NOT = +0) DTSBE999
|
|
02799 IF MPAY-DOC-NO = DST-BY-DOC-DOC-NO (DST-BY-DOC-IDX) DTSBE999
|
|
02800 SET DST-BY-DOC-SUB TO DST-BY-DOC-IDX DTSBE999
|
|
02801 END-IF DTSBE999
|
|
02802 END-PERFORM. DTSBE999
|
|
02803 DTSBE999
|
|
02804 DTSBE999
|
|
02805 IF DST-BY-DOC-SUB = +0 DTSBE999
|
|
02806 IF DST-BY-DOC-CNT < DST-BY-DOC-MAX DTSBE999
|
|
02807 ADD +1 TO DST-BY-DOC-CNT DTSBE999
|
|
02808 MOVE MPAY-DOC-NO DTSBE999
|
|
02809 TO DST-BY-DOC-DOC-NO (DST-BY-DOC-CNT) DTSBE999
|
|
02810 MOVE MPAY-RECEIVED-DATE DTSBE999
|
|
02811 TO DST-RECEIVED-DATE (DST-BY-DOC-CNT) DTSBE999
|
|
02812 MOVE +0 DTSBE999
|
|
02813 TO DST-BY-DOC-QTR-AMT (DST-BY-DOC-CNT) DTSBE999
|
|
02814 DST-BY-DOC-CREDIT-AMT (DST-BY-DOC-CNT) DTSBE999
|
|
02815 DST-BY-DOC-REV-AMT (DST-BY-DOC-CNT) DTSBE999
|
|
02816 MOVE DST-BY-DOC-CNT TO DST-BY-DOC-SUB DTSBE999
|
|
02817 ELSE DTSBE999
|
|
02818 MOVE 'DST-BY-DOC TABLE OVERFLOW' TO ABEND-MSG DTSBE999
|
|
02819 PERFORM S999-ABEND THRU S999-EXIT. DTSBE999
|
|
02820 DTSBE999
|
|
02821 DTSBE999
|
|
02822 SET DST-BY-DOC-IDX TO DST-BY-DOC-SUB. DTSBE999
|
|
02823 DTSBE999
|
|
02824 IF DST-BY-DOC-QTR-AMT (DST-BY-DOC-IDX) < +0 DTSBE999
|
|
02825 MOVE MPAY-BATCH-NO TO MSG27-BATCH-NO DTSBE999
|
|
02826 MOVE MPAY-ITEM-NO TO MSG27-ITEM-NO DTSBE999
|
|
02827 MOVE 27 TO MSG-NO DTSBE999
|
|
02828 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
02829 DTSBE999
|
|
02830 IF DST-BY-DOC-CREDIT-AMT (DST-BY-DOC-IDX) < +0 DTSBE999
|
|
02831 MOVE MPAY-BATCH-NO TO MSG27-BATCH-NO DTSBE999
|
|
02832 MOVE MPAY-ITEM-NO TO MSG27-ITEM-NO DTSBE999
|
|
02833 MOVE 27 TO MSG-NO DTSBE999
|
|
02834 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
02835 DTSBE999
|
|
02836 IF DST-BY-DOC-REV-AMT (DST-BY-DOC-IDX) < +0 DTSBE999
|
|
02837 MOVE MPAY-BATCH-NO TO MSG27-BATCH-NO DTSBE999
|
|
02838 MOVE MPAY-ITEM-NO TO MSG27-ITEM-NO DTSBE999
|
|
02839 MOVE 27 TO MSG-NO DTSBE999
|
|
02840 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
02841 DTSBE999
|
|
02842 ADD DST-BY-DOC-QTR-AMT (DST-BY-DOC-IDX) DTSBE999
|
|
02843 DST-BY-DOC-CREDIT-AMT (DST-BY-DOC-IDX) DTSBE999
|
|
02844 DST-BY-DOC-REV-AMT (DST-BY-DOC-IDX) DTSBE999
|
|
02845 GIVING DTSBE999
|
|
02846 WRK-BY-DOC-AMT. DTSBE999
|
|
02847 DTSBE999
|
|
02848 MOVE +0 TO DST-BY-DOC-QTR-AMT (DST-BY-DOC-IDX) DTSBE999
|
|
02849 DST-BY-DOC-CREDIT-AMT (DST-BY-DOC-IDX) DTSBE999
|
|
02850 DST-BY-DOC-REV-AMT (DST-BY-DOC-IDX). DTSBE999
|
|
02851 DTSBE999
|
|
02852 IF WRK-BY-DOC-AMT = MPAY-REMIT-AMT DTSBE999
|
|
02853 NEXT SENTENCE DTSBE999
|
|
02854 ELSE DTSBE999
|
|
02855 COMPUTE DST-BY-DOC-QTR-AMT (DST-BY-DOC-IDX) DTSBE999
|
|
02856 = WRK-BY-DOC-AMT - MPAY-REMIT-AMT. DTSBE999
|
|
02857 DTSBE999
|
|
02858 IF (DST-RECEIVED-DATE (DST-BY-DOC-IDX) = ALL-NINES-DATE) DTSBE999
|
|
02859 OR DTSBE999
|
|
02860 (MPAY-RECEIVED-DATE DTSBE999
|
|
02861 = DST-RECEIVED-DATE (DST-BY-DOC-IDX)) DTSBE999
|
|
02862 NEXT SENTENCE DTSBE999
|
|
02863 ELSE DTSBE999
|
|
02864 *********DISPLAY 'DST-RECEIVED-DATE: ' DTSBE999
|
|
02865 *****************DST-RECEIVED-DATE (DST-BY-DOC-IDX) DTSBE999
|
|
02866 *****************' MPAY-RECEIVED-DATE : ' DTSBE999
|
|
02867 *****************MPAY-RECEIVED-DATE DTSBE999
|
|
02868 *****************' MPAY-BATCH-NO: ' DTSBE999
|
|
02869 *****************MPAY-BATCH-NO DTSBE999
|
|
02870 *****************' MPAY-ITEM-NO: ' DTSBE999
|
|
02871 *****************MPAY-ITEM-NO DTSBE999
|
|
02872 MOVE MPAY-BATCH-NO TO MSG33-BATCH-NO DTSBE999
|
|
02873 MOVE MPAY-ITEM-NO TO MSG33-ITEM-NO DTSBE999
|
|
02874 MOVE 33 TO MSG-NO DTSBE999
|
|
02875 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
02876 P2310-EXIT. DTSBE999
|
|
02877 EXIT. DTSBE999
|
|
02878 SKIP3 DTSBE999
|
|
02879 P2320-CHECK-BY-DOC-RESIDUE. DTSBE999
|
|
02880 IF DST-BY-DOC-QTR-AMT (DST-BY-DOC-IDX) = +0 DTSBE999
|
|
02881 NEXT SENTENCE DTSBE999
|
|
02882 ELSE DTSBE999
|
|
02883 MOVE DST-BY-DOC-BATCH-NO (DST-BY-DOC-IDX) DTSBE999
|
|
02884 TO MSG28-BATCH-NO DTSBE999
|
|
02885 MOVE DST-BY-DOC-ITEM-NO (DST-BY-DOC-IDX) DTSBE999
|
|
02886 TO MSG28-ITEM-NO DTSBE999
|
|
02887 MOVE DST-BY-DOC-QTR-AMT (DST-BY-DOC-IDX) DTSBE999
|
|
02888 TO MSG28-AMT DTSBE999
|
|
02889 MOVE 28 TO MSG-NO DTSBE999
|
|
02890 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
02891 DTSBE999
|
|
02892 IF DST-BY-DOC-CREDIT-AMT (DST-BY-DOC-IDX) = +0 DTSBE999
|
|
02893 NEXT SENTENCE DTSBE999
|
|
02894 ELSE DTSBE999
|
|
02895 MOVE DST-BY-DOC-BATCH-NO (DST-BY-DOC-IDX) DTSBE999
|
|
02896 TO MSG28-BATCH-NO DTSBE999
|
|
02897 MOVE DST-BY-DOC-ITEM-NO (DST-BY-DOC-IDX) DTSBE999
|
|
02898 TO MSG28-ITEM-NO DTSBE999
|
|
02899 MOVE DST-BY-DOC-CREDIT-AMT (DST-BY-DOC-IDX) DTSBE999
|
|
02900 TO MSG28-AMT DTSBE999
|
|
02901 MOVE 28 TO MSG-NO DTSBE999
|
|
02902 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
02903 DTSBE999
|
|
02904 IF DST-BY-DOC-REV-AMT (DST-BY-DOC-IDX) = +0 DTSBE999
|
|
02905 NEXT SENTENCE DTSBE999
|
|
02906 ELSE DTSBE999
|
|
02907 MOVE DST-BY-DOC-BATCH-NO (DST-BY-DOC-IDX) DTSBE999
|
|
02908 TO MSG28-BATCH-NO DTSBE999
|
|
02909 MOVE DST-BY-DOC-ITEM-NO (DST-BY-DOC-IDX) DTSBE999
|
|
02910 TO MSG28-ITEM-NO DTSBE999
|
|
02911 MOVE DST-BY-DOC-REV-AMT (DST-BY-DOC-IDX) DTSBE999
|
|
02912 TO MSG28-AMT DTSBE999
|
|
02913 MOVE 28 TO MSG-NO DTSBE999
|
|
02914 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE999
|
|
02915 P2320-EXIT. DTSBE999
|
|
02916 EXIT. DTSBE999
|
|
02917 EJECT DTSBE999
|
|
02918 T0000-TERMINATE. DTSBE999
|
|
02919 DISPLAY '***'. DTSBE999
|
|
02920 DTSBE999
|
|
02921 DISPLAY '*** DTSBE999 TERMINATION STATISTICS'. DTSBE999
|
|
02922 DTSBE999
|
|
02923 DISPLAY '***'. DTSBE999
|
|
02924 DTSBE999
|
|
02925 DISPLAY '*** ' DTSBE999
|
|
02926 MAX-DST-BY-QTR-CNT-USED DTSBE999
|
|
02927 ' MAX-DST-BY-QTR-CNT-USED'. DTSBE999
|
|
02928 DTSBE999
|
|
02929 DISPLAY '*** ' DTSBE999
|
|
02930 MAX-DST-BY-DOC-CNT-USED DTSBE999
|
|
02931 ' MAX-DST-BY-DOC-CNT-USED'. DTSBE999
|
|
02932 DTSBE999
|
|
02933 DISPLAY '*** ' DTSBE999
|
|
02934 MAX-SOL-CNT-USED DTSBE999
|
|
02935 ' MAX-SOL-CNT-USED'. DTSBE999
|
|
02936 DTSBE999
|
|
02937 DISPLAY '*** ' DTSBE999
|
|
02938 MAX-RTE-CNT-USED DTSBE999
|
|
02939 ' MAX-RTE-CNT-USED'. DTSBE999
|
|
02940 DTSBE999
|
|
02941 DISPLAY '***'. DTSBE999
|
|
02942 T0000-EXIT. DTSBE999
|
|
02943 EXIT. DTSBE999
|
|
02944 EJECT DTSBE999
|
|
02945 S001-FROM-FED-8. DTSBE999
|
|
02946 SET L001-FROM-FED-8 TO TRUE. DTSBE999
|
|
02947 GO TO S001-DATE. DTSBE999
|
|
02948 DTSBE999
|
|
02949 S001-FROM-ABS-DAY. DTSBE999
|
|
02950 SET L001-FROM-ABS-DAY TO TRUE. DTSBE999
|
|
02951 GO TO S001-DATE. DTSBE999
|
|
02952 DTSBE999
|
|
02953 S001-DATE. DTSBE999
|
|
02954 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBE999
|
|
02955 S001-EXIT. DTSBE999
|
|
02956 EXIT. DTSBE999
|
|
02957 SKIP3 DTSBE999
|
|
02958 S004-FROM-5. DTSBE999
|
|
02959 SET L004-FROM-5 TO TRUE. DTSBE999
|
|
02960 GO TO S004-QTR. DTSBE999
|
|
02961 DTSBE999
|
|
02962 S004-FROM-DATE. DTSBE999
|
|
02963 SET L004-FROM-DATE TO TRUE. DTSBE999
|
|
02964 GO TO S004-QTR. DTSBE999
|
|
02965 DTSBE999
|
|
02966 S004-FROM-ABS. DTSBE999
|
|
02967 SET L004-FROM-ABS TO TRUE. DTSBE999
|
|
02968 GO TO S004-QTR. DTSBE999
|
|
02969 DTSBE999
|
|
02970 S004-QTR. DTSBE999
|
|
02971 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBE999
|
|
02972 S004-EXIT. DTSBE999
|
|
02973 EXIT. DTSBE999
|
|
02974 SKIP3 DTSBE999
|
|
02975 S101-PER-MONTH-NO. DTSBE999
|
|
02976 SET L101-PER-MONTH-NO-88 TO TRUE. DTSBE999
|
|
02977 GO TO S101-INT-PEN-CALC. DTSBE999
|
|
02978 DTSBE999
|
|
02979 S101-INT-PEN-CALC. DTSBE999
|
|
02980 CALL 'DTSBU101' USING L101-LINK-AREA. DTSBE999
|
|
02981 S101-EXIT. DTSBE999
|
|
02982 EXIT. DTSBE999
|
|
02983 SKIP3 DTSBE999
|
|
02984 *S113-RELATED-EMPLOYER. DTSBE999
|
|
02985 *****CALL 'DTSBU113' USING L113-LINK-AREA. DTSBE999
|
|
02986 *S113-EXIT. DTSBE999
|
|
02987 *****EXIT. DTSBE999
|
|
02988 SKIP3 DTSBE999
|
|
02989 S516-QTR-LIABILITY-RATE. DTSBE999
|
|
02990 SET L516-NOT-LIABLE-88 TO TRUE. DTSBE999
|
|
02991 DTSBE999
|
|
02992 MOVE +0 TO L516-DEFAULT-RPT-DUE-DATE DTSBE999
|
|
02993 L516-DEFAULT-TAX-DUE-DATE. DTSBE999
|
|
02994 DTSBE999
|
|
02995 DTSBE999
|
|
02996 PERFORM DTSBE999
|
|
02997 VARYING SOL-IDX FROM 1 BY 1 DTSBE999
|
|
02998 UNTIL (L516-LIABLE-88) DTSBE999
|
|
02999 OR DTSBE999
|
|
03000 (SOL-IDX > SOL-CNT) DTSBE999
|
|
03001 IF (L516-YRQ < SOL-FIRST-LIAB-YRQ (SOL-IDX)) DTSBE999
|
|
03002 OR DTSBE999
|
|
03003 (L516-YRQ > SOL-LAST-LIAB-YRQ (SOL-IDX)) DTSBE999
|
|
03004 CONTINUE DTSBE999
|
|
03005 ELSE DTSBE999
|
|
03006 SET L516-LIABLE-88 TO TRUE DTSBE999
|
|
03007 END-IF DTSBE999
|
|
03008 END-PERFORM. DTSBE999
|
|
03009 DTSBE999
|
|
03010 DTSBE999
|
|
03011 MOVE L516-YRQ TO L004-QTR-5-9. DTSBE999
|
|
03012 DTSBE999
|
|
03013 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE999
|
|
03014 DTSBE999
|
|
03015 MOVE L004-QTR-DEFAULT-DUE-DATE DTSBE999
|
|
03016 TO L516-DEFAULT-RPT-DUE-DATE DTSBE999
|
|
03017 L516-DEFAULT-TAX-DUE-DATE. DTSBE999
|
|
03018 DTSBE999
|
|
03019 IF MPRF-CLASS-SELF-INS-88 DTSBE999
|
|
03020 MOVE LOW-VALUES TO FQTR-KEY-AREA DTSBE999
|
|
03021 SET FQTR-QTR-88 TO TRUE DTSBE999
|
|
03022 MOVE L516-YRQ TO FQTR-YRQ DTSBE999
|
|
03023 MOVE FQTR-KEY-AREA TO FSKL-KEY-AREA DTSBE999
|
|
03024 PERFORM S931-READ THRU S931-EXIT DTSBE999
|
|
03025 IF L931-OK-88 DTSBE999
|
|
03026 MOVE FSKL-REC TO FQTR-REC DTSBE999
|
|
03027 IF (FQTR-SELF-INS-TAX-DUE-DATE NUMERIC) DTSBE999
|
|
03028 AND DTSBE999
|
|
03029 (FQTR-SELF-INS-TAX-DUE-DATE > +0) DTSBE999
|
|
03030 MOVE FQTR-SELF-INS-TAX-DUE-DATE DTSBE999
|
|
03031 TO L516-DEFAULT-TAX-DUE-DATE. DTSBE999
|
|
03032 DTSBE999
|
|
03033 DTSBE999
|
|
03034 SET L516-NO-RATE-88 TO TRUE. DTSBE999
|
|
03035 DTSBE999
|
|
03036 MOVE -9.9999 TO L516-UI-RATE. DTSBE999
|
|
03037 DTSBE999
|
|
03038 PERFORM DTSBE999
|
|
03039 VARYING RTE-IDX FROM 1 BY 1 DTSBE999
|
|
03040 UNTIL (L516-RATE-88) DTSBE999
|
|
03041 OR DTSBE999
|
|
03042 (RTE-IDX > RTE-CNT) DTSBE999
|
|
03043 IF (L516-YRQ < RTE-EFF-YRQ (RTE-IDX)) DTSBE999
|
|
03044 OR DTSBE999
|
|
03045 (L516-YRQ > RTE-END-YRQ (RTE-IDX)) DTSBE999
|
|
03046 CONTINUE DTSBE999
|
|
03047 ELSE DTSBE999
|
|
03048 SET L516-RATE-88 TO TRUE DTSBE999
|
|
03049 MOVE RTE-UI-RATE (RTE-IDX) TO L516-UI-RATE DTSBE999
|
|
03050 END-IF DTSBE999
|
|
03051 END-PERFORM. DTSBE999
|
|
03052 S516-EXIT. DTSBE999
|
|
03053 EXIT. DTSBE999
|
|
03054 EJECT DTSBE999
|
|
03055 S910-READ. DTSBE999
|
|
03056 SET L910-READ-88 TO TRUE. DTSBE999
|
|
03057 GO TO S910-MSTR-IO. DTSBE999
|
|
03058 DTSBE999
|
|
03059 S910-START-BROWSE. DTSBE999
|
|
03060 SET L910-START-BROWSE-88 TO TRUE. DTSBE999
|
|
03061 GO TO S910-MSTR-IO. DTSBE999
|
|
03062 DTSBE999
|
|
03063 S910-READ-NEXT. DTSBE999
|
|
03064 SET L910-READ-NEXT-88 TO TRUE. DTSBE999
|
|
03065 GO TO S910-MSTR-IO. DTSBE999
|
|
03066 DTSBE999
|
|
03067 *S910-COUNT. DTSBE999
|
|
03068 *****SET L910-COUNT-88 TO TRUE. DTSBE999
|
|
03069 *****GO TO S910-MSTR-IO. DTSBE999
|
|
03070 DTSBE999
|
|
03071 S910-MSTR-IO. DTSBE999
|
|
03072 CALL 'DTSBU910' USING L910-LINK-AREA DTSBE999
|
|
03073 MSKL-REC. DTSBE999
|
|
03074 S910-EXIT. DTSBE999
|
|
03075 EXIT. DTSBE999
|
|
03076 SKIP3 DTSBE999
|
|
03077 S921-READ. DTSBE999
|
|
03078 SET L921-READ-88 TO TRUE. DTSBE999
|
|
03079 GO TO S921-AIX-IO. DTSBE999
|
|
03080 DTSBE999
|
|
03081 S921-START-BROWSE. DTSBE999
|
|
03082 SET L921-START-BROWSE-88 TO TRUE. DTSBE999
|
|
03083 GO TO S921-AIX-IO. DTSBE999
|
|
03084 DTSBE999
|
|
03085 S921-READ-NEXT. DTSBE999
|
|
03086 SET L921-READ-NEXT-88 TO TRUE. DTSBE999
|
|
03087 GO TO S921-AIX-IO. DTSBE999
|
|
03088 DTSBE999
|
|
03089 S921-AIX-IO. DTSBE999
|
|
03090 CALL 'DTSBU921' USING L921-LINK-AREA DTSBE999
|
|
03091 ISKL-REC. DTSBE999
|
|
03092 S921-EXIT. DTSBE999
|
|
03093 EXIT. DTSBE999
|
|
03094 SKIP3 DTSBE999
|
|
03095 S931-READ. DTSBE999
|
|
03096 SET L931-READ-88 TO TRUE. DTSBE999
|
|
03097 GO TO S931-REF-IO. DTSBE999
|
|
03098 DTSBE999
|
|
03099 S931-REF-IO. DTSBE999
|
|
03100 CALL 'DTSBU931' USING L931-LINK-AREA DTSBE999
|
|
03101 FSKL-REC. DTSBE999
|
|
03102 S931-EXIT. DTSBE999
|
|
03103 EXIT. DTSBE999
|
|
03104 EJECT DTSBE999
|
|
03105 S946-WRITE-R907. DTSBE999
|
|
03106 MOVE MSG-ID TO R907-MSG-ID. DTSBE999
|
|
03107 DTSBE999
|
|
03108 MOVE MPRF-EMP-NO TO R907-EMP-NO. DTSBE999
|
|
03109 DTSBE999
|
|
03110 MOVE MSG-TEXT (MSG-NO) TO R907-MSG-TEXT. DTSBE999
|
|
03111 DTSBE999
|
|
03112 CALL 'DTSBU946' USING R907-REC. DTSBE999
|
|
03113 DTSBE999
|
|
03114 GO TO S946-EXIT. DTSBE999
|
|
03115 DTSBE999
|
|
03116 S946-EXIT. DTSBE999
|
|
03117 EXIT. DTSBE999
|
|
03118 SKIP3 DTSBE999
|
|
03119 S999-ABEND. DTSBE999
|
|
03120 DISPLAY '*** DTSBE999 ABENDING. ' DTSBE999
|
|
03121 ABEND-MSG. DTSBE999
|
|
03122 DTSBE999
|
|
03123 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBE999
|
|
03124 S999-EXIT. DTSBE999
|
|
03125 EXIT. DTSBE999
|