1450 lines
115 KiB
COBOL
1450 lines
115 KiB
COBOL
00001 IDENTIFICATION DIVISION. 07/11/16
|
|
00002 PROGRAM-ID. DTSBD327. DTSBD327
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV018
|
|
00004 DATE-WRITTEN. AUGUST 1994. DTSBD327
|
|
00005 MODIFIED BY TRW JAN. 1999 DTSBD327
|
|
00006 DATE-COMPILED. DTSBD327
|
|
00007 SKIP3 DTSBD327
|
|
00008 ***** DTSBD327
|
|
00009 * DTSBD327
|
|
00010 * CALLING SEQUENCE: DTSBD320 CALLS DTSBD327
|
|
00011 * DTSBD327 WHICH CREATES DTSIR415 RECORDS DTSBD327
|
|
00012 * DTSBD327 WHICH CREATES DTSIR416 RECORDS DTSBD327
|
|
00013 * DTSBD800 CALLS DTSBD327
|
|
00014 * DTSBR415 WHICH READS DTSIR415 RECORDS DTSBD327
|
|
00015 * DTSBR416 WHICH READS DTSIR416 RECORDS DTSBD327
|
|
00016 * DTSBD327
|
|
00017 * FUNCTION: DEBIT STATEMENT EXTRACT (OVERNIGHT). DTSBD327
|
|
00018 * DTSBD327
|
|
00019 * MODIFICATION LOG: DTSBD327
|
|
00020 * DTSBD327
|
|
00021 * 09/05/2005 NEW PROGRAM COPIED FROM DTSBE414. PROGRAM WILL DTSBD327
|
|
00022 * READ T011 RECORDS FOR STATEMENT OF ACCOUNTS AND DTSBD327
|
|
00023 * FROMAT DTSIR415 RECORD TYPES TO PRINT OVERNIGHT DTSBD327
|
|
00024 * STATEMENTS OF ACCOUNTS. DTSBD327
|
|
00025 * WORK ORDER: SPEC076 PROGRAMMER: ZL1 DTSBD327
|
|
00026 * DTSBD327
|
|
00027 * 09/26/2005 REMOVED EDIT ON T011-OPID WHICH REQUIRED THAT IT DTSBD327
|
|
00028 * BE A VALID USER FOUND IN THE DTSFOPR FILE. DTSBD327
|
|
00029 * WORK ORDER: CREDIT/DEBIT PROGRAMMER: GD DTSBD327
|
|
00030 * DTSBD327
|
|
00031 * 10/26/2005 MODIFIED MEVL WRITE - ADDED T011-RESP-OPID AS DTSBD327
|
|
00032 * MEVL-SOURCE INSTEAD OF 'SYSTEM'. DTSBD327
|
|
00033 * WORK ORDER: CREDIT/DEBIT PROGRAMMER: GD DTSBD327
|
|
00034 * DTSBD327
|
|
00035 * 10/22/2007 MODIFIED PROGRAM NOT TO COMPUTE INTREST ON DTSBD327
|
|
00036 * ADMIN ASSESSMENT OWED. DTSBD327
|
|
00037 * WORK ORDER: SUR TAX PROGRAMMER: ZL1 DTSBD327
|
|
00038 * DTSBD327
|
|
00039 * 01/31/2008 MODIFIED ADMINISTRATIVE ASSESSMENT PROCESS DTSBD327
|
|
00040 * TO INCLUDE PENALTY AND INTEREST CALCULATION DTSBD327
|
|
00041 * STARTING WITH 2008/1. DTSBD327
|
|
00042 * REFERENCE: ADMIN ASSESS PROGRAMMER: RW1 DTSBD327
|
|
00043 * DTSBD327
|
|
00044 * 10/31/2008 MODIFIED ADMINISTRATIVE ASSESSMENT PROCESS: DTSBD327
|
|
00045 * INCLUDE IN INTEREST CALCULATION ONLY FOR DTSBD327
|
|
00046 * RATED EMPLOYERS. DTSBD327
|
|
00047 * RATED EMPLOYERS. DTSBD327
|
|
00048 * REFERENCE: DIR119 PROGRAMMER: GD DTSBD327
|
|
00049 * DTSBD327
|
|
00050 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD327
|
|
00051 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD327
|
|
00052 * WORK ORDER: PROGRAMMER: XXX DTSBD327
|
|
00053 * DTSBD327
|
|
00054 * DTSBD327
|
|
00055 * DESCRIPTION: DTSBD327
|
|
00056 * DTSBD327
|
|
00057 * DTSBD327
|
|
00058 * INITIATION: DTSBD327
|
|
00059 * DTSBD327
|
|
00060 * SET LECM-MST-OPEN-UPDATE-88 TO TRUE. DTSBD327
|
|
00061 * SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBD327
|
|
00062 * DTSBD327
|
|
00063 * NO PARAMETERS ARE INPUT. DTSBD327
|
|
00064 * DTSBD327
|
|
00065 * DTSBD327
|
|
00066 * PROCESSING: DTSBD327
|
|
00067 * DTSBD327
|
|
00068 * SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (414R1 AND DTSBD327
|
|
00069 * R416R1). DTSBD327
|
|
00070 * DTSBD327
|
|
00071 * IF A DEBIT STATEMENT IS NOT GENERATED BECAUSE ALL DTSBD327
|
|
00072 * OCCURRENCES OF MTAD-DEBIT-MEMO-IND INDICATE DTSBD327
|
|
00073 * MTAD-NO-DEBIT-MEMO-88, THEN WRITE A R907 RECORD, DTSBD327
|
|
00074 * REPORTING THE SITUATION. DTSBD327
|
|
00075 * DTSBD327
|
|
00076 * DTSBD327
|
|
00077 * TERMINATION: DTSBD327
|
|
00078 * DTSBD327
|
|
00079 * NONE. DTSBD327
|
|
00080 * DTSBD327
|
|
00081 * DTSBD327
|
|
00082 * RECORDS READ: DTSBD327
|
|
00083 * DTSBD327
|
|
00084 * MASTER: DTSBD327
|
|
00085 * DTSBD327
|
|
00086 * MQTR DTSBD327
|
|
00087 * MAPL DTSBD327
|
|
00088 * MCOL DTSBD327
|
|
00089 * MTAD DTSBD327
|
|
00090 * MTAA DTSBD327
|
|
00091 * MOPO DTSBD327
|
|
00092 * DTSBD327
|
|
00093 * DTSBD327
|
|
00094 * ALTERNATE INDEX: DTSBD327
|
|
00095 * DTSBD327
|
|
00096 * NONE. DTSBD327
|
|
00097 * DTSBD327
|
|
00098 * DTSBD327
|
|
00099 * REFERENCE: DTSBD327
|
|
00100 * DTSBD327
|
|
00101 * NONE. DTSBD327
|
|
00102 * DTSBD327
|
|
00103 * DTSBD327
|
|
00104 * RECORDS UPDATED: DTSBD327
|
|
00105 * DTSBD327
|
|
00106 * MCOL (REWRITE). DTSBD327
|
|
00107 * MEVL (WRITE). DTSBD327
|
|
00108 * DTSBD327
|
|
00109 * DTSBD327
|
|
00110 * REPORT RECORDS WRITTEN: DTSBD327
|
|
00111 * DTSBD327
|
|
00112 * R415 STATEMENT OF ACCOUNT (DEBITS OVERNIGHT). DTSBD327
|
|
00113 * R416 STATEMENT OF ACCOUNT (DEBITS) CONTROL REPORT. DTSBD327
|
|
00114 * R907 UNUSUAL CONDITIONS ENCOUNTERED REPORT RECORD. DTSBD327
|
|
00115 * DTSBD327
|
|
00116 * DTSBD327
|
|
00117 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBD327
|
|
00118 * DTSBD327
|
|
00119 * NONE. DTSBD327
|
|
00120 * DTSBD327
|
|
00121 * DTSBD327
|
|
00122 * MODULES CALLED: DTSBD327
|
|
00123 * DTSBD327
|
|
00124 * DTSBU001 DATE EDIT/CONVERSION. DTSBD327
|
|
00125 * DTSBU005 ABSOLUTE TIME CONVERSION/EDIT. DTSBD327
|
|
00126 * DTSBU082 OP ID VERIFY/DESCRIPTION. DTSBD327
|
|
00127 * DTSBU101 PENALTY AND INTEREST COMPUTATION. DTSBD327
|
|
00128 * DTSBU112 ADDRESS FORMAT. DTSBD327
|
|
00129 * DTSBU910 MASTER FILE I/O DRIVER. DTSBD327
|
|
00130 * DTSBU946 VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1. DTSBD327
|
|
00131 * DTSBD327
|
|
00132 * DTSBD327
|
|
00133 * VERMONT REFERENCE: DTSBD327
|
|
00134 * DTSBD327
|
|
00135 * TXBE311 DTSBD327
|
|
00136 * DTSBD327
|
|
00137 ***** DTSBD327
|
|
00138 SKIP3 DTSBD327
|
|
00139 ENVIRONMENT DIVISION. DTSBD327
|
|
00140 EJECT DTSBD327
|
|
00141 DATA DIVISION. DTSBD327
|
|
00142 SKIP3 DTSBD327
|
|
00143 WORKING-STORAGE SECTION. DTSBD327
|
|
001435 77 PAN-VALET PICTURE X(24) VALUE '018DTSBD327 07/11/16'. DTSBD327
|
|
00144 SKIP3 DTSBD327
|
|
00145 01 WRK-AREA. DTSBD327
|
|
00146 *& DTSBD327
|
|
00147 05 WRK-BYPASS-CNT PIC 9(07) VALUE ZERO. DTSBD327
|
|
00148 05 WRK-ASSESS-CNT PIC 9(07) VALUE ZERO. DTSBD327
|
|
00149 *& DTSBD327
|
|
00150 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +327.DTSBD327
|
|
00151 SKIP1 DTSBD327
|
|
00152 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBD327'.DTSBD327
|
|
00153 SKIP3 DTSBD327
|
|
00154 05 ABEND-MSG PIC X(60). DTSBD327
|
|
00155 SKIP3 DTSBD327
|
|
00156 05 WRK-PARM-INT-COMP-DATE PIC S9(09) COMP-3. DTSBD327
|
|
00157 SKIP1 DTSBD327
|
|
00158 05 WRK-PARM-REIMB-CUTOFF-DATE PIC S9(09) COMP-3. DTSBD327
|
|
00159 SKIP1 DTSBD327
|
|
00160 05 WRK-PARM-RESP-OP-ID PIC X(08). DTSBD327
|
|
00161 SKIP3 DTSBD327
|
|
00162 05 WRK-STMT-DATE PIC S9(09) COMP-3. DTSBD327
|
|
00163 SKIP1 DTSBD327
|
|
00164 05 WRK-LAST-ACCT-UPDATE-DATE PIC S9(09) COMP-3. DTSBD327
|
|
00165 SKIP1 DTSBD327
|
|
00166 05 WRK-FIRST-PEN-INT-YRQ PIC S9(05) COMP-3. DTSBD327
|
|
00167 SKIP1 DTSBD327
|
|
00168 05 WRK-BNK-PETITION-DATE PIC 9(08). DTSBD327
|
|
00169 05 FILLER REDEFINES WRK-BNK-PETITION-DATE. DTSBD327
|
|
00170 10 WRK-BNK-PETITION-DATE-YYYY PIC 9(04). DTSBD327
|
|
00171 10 WRK-BNK-PETITION-DATE-MM PIC 9(02). DTSBD327
|
|
00172 10 WRK-BNK-PETITION-DATE-DD PIC 9(02). DTSBD327
|
|
00173 05 WRK-BNK-PETITION-YRQ PIC 9(05). DTSBD327
|
|
00174 05 FILLER REDEFINES WRK-BNK-PETITION-YRQ. DTSBD327
|
|
00175 10 WRK-BNK-PETITION-YRQ-YYYY PIC 9(04). DTSBD327
|
|
00176 10 WRK-BNK-PETITION-YRQ-Q PIC 9(01). DTSBD327
|
|
00177 SKIP3 DTSBD327
|
|
00178 05 WRK-BNK-FIRST-BILL-YRQ PIC S9(05) COMP-3. DTSBD327
|
|
00179 SKIP1 DTSBD327
|
|
00180 05 WRK-MAPL-YRQ-CNT PIC S9(04) COMP. DTSBD327
|
|
00181 05 WRK-MAPL-YRQ OCCURS 400 TIMES DTSBD327
|
|
00182 INDEXED BY WRK-MAPL-YRQ-IDX DTSBD327
|
|
00183 PIC S9(05) COMP-3. DTSBD327
|
|
00184 SKIP3 DTSBD327
|
|
00185 05 STMT-TEXT-IND PIC X(01). DTSBD327
|
|
00186 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBD327
|
|
00187 DTSBD327
|
|
00188 05 TAD-FORM-CNT PIC S9(04) COMP. DTSBD327
|
|
00189 DTSBD327
|
|
00190 05 TAA-FORM-CNT PIC S9(04) COMP. DTSBD327
|
|
00191 DTSBD327
|
|
00192 05 OPO-FORM-CNT PIC S9(04) COMP. DTSBD327
|
|
00193 DTSBD327
|
|
00194 05 WRK-SUB PIC S9(04) COMP. DTSBD327
|
|
00195 DTSBD327
|
|
00196 05 WRK-EMP-TOT-DUE PIC S9(09)V9(02) COMP-3. DTSBD327
|
|
00197 05 WRK-YRQ PIC 9(05). DTSBD327
|
|
00198 05 FILLER REDEFINES WRK-YRQ. DTSBD327
|
|
00199 10 WRK-YRQ-YR PIC 9(04). DTSBD327
|
|
00200 10 WRK-YRQ-Q PIC 9(01). DTSBD327
|
|
00201 DTSBD327
|
|
00202 05 WRK-CURR-ANN-YRQ PIC 9(05). DTSBD327
|
|
00203 05 FILLER REDEFINES WRK-CURR-ANN-YRQ. DTSBD327
|
|
00204 10 WRK-CURR-ANN-YEAR PIC 9(04). DTSBD327
|
|
00205 10 WRK-CURR-ANN-Q PIC 9(01). DTSBD327
|
|
00206 DTSBD327
|
|
00207 01 WRK-BUCKETS. DTSBD327
|
|
00208 DTSBD327
|
|
00209 05 WRK-TAX-DUE PIC S9(09)V9(02) COMP-3. DTSBD327
|
|
00210 05 WRK-PEN-DUE PIC S9(09)V9(02) COMP-3. DTSBD327
|
|
00211 05 WRK-INT-DUE PIC S9(09)V9(02) COMP-3. DTSBD327
|
|
00212 05 WRK-SUR-DUE PIC S9(09)V9(02) COMP-3. DTSBD327
|
|
00213 05 WRK-TOT-DUE PIC S9(09)V9(02) COMP-3. DTSBD327
|
|
00214 DTSBD327
|
|
00215 05 WRK-TOLERANCE-AMT PIC S9(09)V9(02) COMP-3 DTSBD327
|
|
00216 VALUE +10.00. DTSBD327
|
|
00217 DTSBD327
|
|
00218 05 HOLD-YRQ PIC S9(05) COMP-3. DTSBD327
|
|
00219 DTSBD327
|
|
00220 05 AMT-DISP1 PIC --------9.99. DTSBD327
|
|
00221 DTSBD327
|
|
00222 05 EVL-TEXT. DTSBD327
|
|
00223 10 FILLER PIC X(19) DTSBD327
|
|
00224 VALUE 'DEBIT STATEMENT TO '. DTSBD327
|
|
00225 10 EVL-ADDR-TYPE PIC X(04). DTSBD327
|
|
00226 10 EVL-ADDR-ID-NO PIC ZZ9. DTSBD327
|
|
00227 10 FILLER PIC X(10) DTSBD327
|
|
00228 VALUE '. TOT BAL:'. DTSBD327
|
|
00229 10 EVL-TOT-BAL-AMT PIC ZZZ,ZZZ,ZZ9.99. DTSBD327
|
|
00230 EJECT DTSBD327
|
|
00231 01 MSG-AREA. DTSBD327
|
|
00232 05 MSG1-AREA. DTSBD327
|
|
00233 10 MSG1-ID PIC X(03) DTSBD327
|
|
00234 VALUE '416'. DTSBD327
|
|
00235 10 MSG1-TEXT. DTSBD327
|
|
00236 15 FILLER PIC X(40) DTSBD327
|
|
00237 VALUE 'DEBIT EXISTS BUT ALL MTAD OCCURRENCES IN'. DTSBD327
|
|
00238 15 FILLER PIC X(40) DTSBD327
|
|
00239 VALUE 'DICATE NO DEBIT MEMO. NO DEBIT STATEME'. DTSBD327
|
|
00240 15 FILLER PIC X(20) DTSBD327
|
|
00241 VALUE 'NT TO MTAD GENERATED'. DTSBD327
|
|
00242 SKIP1 DTSBD327
|
|
00243 05 MSG2-AREA. DTSBD327
|
|
00244 10 MSG2-ID PIC X(03) DTSBD327
|
|
00245 VALUE '417'. DTSBD327
|
|
00246 10 MSG2-TEXT. DTSBD327
|
|
00247 15 FILLER PIC X(40) DTSBD327
|
|
00248 VALUE 'MCOL-STMT-TEXT-TYPE INDICATES CREDIT TEX'. DTSBD327
|
|
00249 15 FILLER PIC X(40) DTSBD327
|
|
00250 VALUE 'T. NO TEXT PRINTED ON BATCH GENERATED D'. DTSBD327
|
|
00251 15 FILLER PIC X(20) DTSBD327
|
|
00252 VALUE 'EBIT STATEMENT.'. DTSBD327
|
|
00253 SKIP1 DTSBD327
|
|
00254 05 MSG3-AREA. DTSBD327
|
|
00255 10 MSG3-ID PIC X(03) DTSBD327
|
|
00256 VALUE '418'. DTSBD327
|
|
00257 10 MSG3-TEXT. DTSBD327
|
|
00258 15 FILLER PIC X(40) DTSBD327
|
|
00259 VALUE 'NUMBER OF DEBIT STATEMENT QUARTERS EXCEE'. DTSBD327
|
|
00260 15 FILLER PIC X(40) DTSBD327
|
|
00261 VALUE 'DS 50. DEBIT STATEMENT NOT PRINTED. '. DTSBD327
|
|
00262 15 FILLER PIC X(20) DTSBD327
|
|
00263 VALUE ' '. DTSBD327
|
|
00264 EJECT DTSBD327
|
|
00265 01 R415-REC. DTSBD327
|
|
00266 ++INCLUDE DTSIR415 DTSBD327
|
|
00267 SKIP3 DTSBD327
|
|
00268 01 L001-LINK-AREA. DTSBD327
|
|
00269 ++INCLUDE DTSIL001 DTSBD327
|
|
00270 EJECT DTSBD327
|
|
00271 01 L004-LINK-AREA. DTSBD327
|
|
00272 ++INCLUDE DTSIL004 DTSBD327
|
|
00273 EJECT DTSBD327
|
|
00274 01 L005-LINK-AREA. DTSBD327
|
|
00275 ++INCLUDE DTSIL005 DTSBD327
|
|
00276 EJECT DTSBD327
|
|
00277 01 L082-LINK-AREA. DTSBD327
|
|
00278 ++INCLUDE DTSIL082 DTSBD327
|
|
00279 EJECT DTSBD327
|
|
00280 01 L101-LINK-AREA. DTSBD327
|
|
00281 ++INCLUDE DTSIL101 DTSBD327
|
|
00282 EJECT DTSBD327
|
|
00283 01 L109-LINK-AREA. DTSBD327
|
|
00284 ++INCLUDE DTSIL109 DTSBD327
|
|
00285 EJECT DTSBD327
|
|
00286 01 L111-LINK-AREA. DTSBD327
|
|
00287 ++INCLUDE DTSIL111 DTSBD327
|
|
00288 EJECT DTSBD327
|
|
00289 01 L112-LINK-AREA. DTSBD327
|
|
00290 ++INCLUDE DTSIL112 DTSBD327
|
|
00291 EJECT DTSBD327
|
|
00292 01 L910-LINK-AREA. DTSBD327
|
|
00293 ++INCLUDE DTSIL910 DTSBD327
|
|
00294 SKIP3 DTSBD327
|
|
00295 01 L410-LINK-AREA. DTSBD327
|
|
00296 ++INCLUDE DTSIL410 DTSBD327
|
|
00297 SKIP3 DTSBD327
|
|
00298 01 MSKL-REC. DTSBD327
|
|
00299 ++INCLUDE DTSIMSKL DTSBD327
|
|
00300 SKIP3 DTSBD327
|
|
00301 01 MQTR-REC. DTSBD327
|
|
00302 ++INCLUDE DTSIMQTR DTSBD327
|
|
00303 SKIP3 DTSBD327
|
|
00304 01 MAPL-REC. DTSBD327
|
|
00305 ++INCLUDE DTSIMAPL DTSBD327
|
|
00306 SKIP3 DTSBD327
|
|
00307 01 MCOL-REC. DTSBD327
|
|
00308 ++INCLUDE DTSIMCOL DTSBD327
|
|
00309 SKIP3 DTSBD327
|
|
00310 01 MEVL-REC. DTSBD327
|
|
00311 ++INCLUDE DTSIMEVL DTSBD327
|
|
00312 SKIP3 DTSBD327
|
|
00313 01 MTAD-REC. DTSBD327
|
|
00314 ++INCLUDE DTSIMTAD DTSBD327
|
|
00315 SKIP3 DTSBD327
|
|
00316 01 MTAA-REC. DTSBD327
|
|
00317 ++INCLUDE DTSIMTAA DTSBD327
|
|
00318 SKIP3 DTSBD327
|
|
00319 01 MOPO-REC. DTSBD327
|
|
00320 ++INCLUDE DTSIMOPO DTSBD327
|
|
00321 EJECT DTSBD327
|
|
00322 01 R416-REC. DTSBD327
|
|
00323 ++INCLUDE DTSIR416 DTSBD327
|
|
00324 SKIP3 DTSBD327
|
|
00325 01 R907-REC. DTSBD327
|
|
00326 ++INCLUDE DTSIR907 DTSBD327
|
|
00327 EJECT DTSBD327
|
|
00328 LINKAGE SECTION. DTSBD327
|
|
00329 SKIP3 DTSBD327
|
|
00330 01 LBCM-LINK-AREA. DTSBD327
|
|
00331 ++INCLUDE DTSILBCM DTSBD327
|
|
00332 01 MPRF-LINK-REC. DTSBD327
|
|
00333 ++INCLUDE DTSIMPRF DTSBD327
|
|
00334 EJECT DTSBD327
|
|
00335 01 T011-REC. DTSBD327
|
|
00336 ++INCLUDE DTSIT011 DTSBD327
|
|
00337 EJECT DTSBD327
|
|
00338 *************************************************************** DTSBD327
|
|
00339 * THE PROCEDURE DIVISION FOR DTSBD327 STARTS HERE. DTSBD327
|
|
00340 *************************************************************** DTSBD327
|
|
00341 DTSBD327
|
|
00342 PROCEDURE DIVISION USING LBCM-LINK-AREA DTSBD327
|
|
00343 MPRF-LINK-REC DTSBD327
|
|
00344 T011-REC. DTSBD327
|
|
00345 SKIP2 DTSBD327
|
|
00346 IF FIRST-TIME-IND = 'Y' DTSBD327
|
|
00347 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBD327
|
|
00348 MOVE 'N' TO FIRST-TIME-IND. DTSBD327
|
|
00349 DTSBD327
|
|
00350 IF T011-STMT-OF-ACCT DTSBD327
|
|
00351 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBD327
|
|
00352 ELSE DTSBD327
|
|
00353 MOVE 'INVALID LBCM-CALL-TYPE-IND ENCOUNTERED' DTSBD327
|
|
00354 TO ABEND-MSG DTSBD327
|
|
00355 PERFORM S999-ABEND THRU S999-EXIT. DTSBD327
|
|
00356 SKIP2 DTSBD327
|
|
00357 GOBACK. DTSBD327
|
|
00358 EJECT DTSBD327
|
|
00359 *************************************************************** DTSBD327
|
|
00360 * THE PARAGRAPH CONTROLS THE INITIALIZATION PROCESS FOR DTSBD327
|
|
00361 * DTSBE414. DTSBD327
|
|
00362 *************************************************************** DTSBD327
|
|
00363 DTSBD327
|
|
00364 I0000-INITIALIZE. DTSBD327
|
|
00365 SKIP2 DTSBD327
|
|
00366 MOVE LBCM-TRACE-IND TO L910-TRACE-IND. DTSBD327
|
|
00367 MOVE WRK-MOD-NAME TO L910-MOD-NAME DTSBD327
|
|
00368 R907-MODULE-NAME. DTSBD327
|
|
00369 DTSBD327
|
|
00370 MOVE LENGTH OF R415-REC TO R415-LENGTH. DTSBD327
|
|
00371 MOVE LENGTH OF R416-REC TO R416-LENGTH. DTSBD327
|
|
00372 MOVE LENGTH OF R907-REC TO R907-LENGTH. DTSBD327
|
|
00373 MOVE 99999 TO WRK-CURR-ANN-YRQ. DTSBD327
|
|
00374 MOVE LBCM-CURR-RUN-DATE TO WRK-LAST-ACCT-UPDATE-DATE. DTSBD327
|
|
00375 DTSBD327
|
|
00376 MOVE LBCM-CURR-MAIL-DATE TO WRK-STMT-DATE. DTSBD327
|
|
00377 DTSBD327
|
|
00378 PERFORM I1000-EDIT-AND-DEFAULT-PARMS THRU I1000-EXIT. DTSBD327
|
|
00379 DTSBD327
|
|
00380 PERFORM S2000-INITIALIZE-TABLE THRU S2000-EXIT DTSBD327
|
|
00381 VARYING WRK-SUB FROM 1 BY 1 DTSBD327
|
|
00382 UNTIL WRK-SUB GREATER THAN 50. DTSBD327
|
|
00383 *RW1 DTSBD327
|
|
00384 PERFORM S109-FIRST-PEN-INT-YRQ THRU S109-EXIT. DTSBD327
|
|
00385 MOVE L109-FIRST-PEN-INT-YRQ TO WRK-FIRST-PEN-INT-YRQ. DTSBD327
|
|
00386 *RW2 DTSBD327
|
|
00387 * SET LBCM-MST-OPEN-UPDATE-88 TO TRUE. DTSBD327
|
|
00388 * SET LBCM-REF-OPEN-READ-88 TO TRUE. DTSBD327
|
|
00389 SKIP2 DTSBD327
|
|
00390 I0000-EXIT. DTSBD327
|
|
00391 EXIT. DTSBD327
|
|
00392 SKIP3 DTSBD327
|
|
00393 *************************************************************** DTSBD327
|
|
00394 * THE PARAGRAPH CONTROLS THE EDITING OF THE PARMS. DTSBD327
|
|
00395 *************************************************************** DTSBD327
|
|
00396 DTSBD327
|
|
00397 I1000-EDIT-AND-DEFAULT-PARMS. DTSBD327
|
|
00398 DTSBD327
|
|
00399 PERFORM I1100-RESP-OP-ID THRU I1100-EXIT. DTSBD327
|
|
00400 DTSBD327
|
|
00401 PERFORM I1200-INT-COMP-DATE THRU I1200-EXIT. DTSBD327
|
|
00402 DTSBD327
|
|
00403 PERFORM I1300-REIMB-CUTOFF-DATE THRU I1300-EXIT. DTSBD327
|
|
00404 DTSBD327
|
|
00405 I1000-EXIT. DTSBD327
|
|
00406 EXIT. DTSBD327
|
|
00407 EJECT DTSBD327
|
|
00408 *************************************************************** DTSBD327
|
|
00409 * THE PARAGRAPH EDITS THE RESPONSIBLE OP ID. DTSBD327
|
|
00410 *************************************************************** DTSBD327
|
|
00411 DTSBD327
|
|
00412 I1100-RESP-OP-ID. DTSBD327
|
|
00413 DTSBD327
|
|
00414 IF T011-RESP-OP-ID = SPACES DTSBD327
|
|
00415 MOVE SPACES TO WRK-PARM-RESP-OP-ID DTSBD327
|
|
00416 GO TO I1100-EXIT. DTSBD327
|
|
00417 DTSBD327
|
|
00418 * MOVE 'RESP-OP-ID MISSING' TO ABEND-MSG DTSBD327
|
|
00419 * PERFORM S999-ABEND THRU S999-EXIT. DTSBD327
|
|
00420 DTSBD327
|
|
00421 MOVE T011-RESP-OP-ID TO L082-OP-ID. DTSBD327
|
|
00422 DTSBD327
|
|
00423 PERFORM S082-LOOKUP-OP-ID THRU S082-EXIT. DTSBD327
|
|
00424 DTSBD327
|
|
00425 *& IF L082-NOT-VALID-OP OR L082-INTERNAL-88 DTSBD327
|
|
00426 * MOVE 'T011-RESP-OP-ID NOT VALID' DTSBD327
|
|
00427 * TO ABEND-MSG DTSBD327
|
|
00428 *& PERFORM S999-ABEND THRU S999-EXIT. DTSBD327
|
|
00429 MOVE T011-RESP-OP-ID TO WRK-PARM-RESP-OP-ID. DTSBD327
|
|
00430 DTSBD327
|
|
00431 I1100-EXIT. DTSBD327
|
|
00432 EXIT. DTSBD327
|
|
00433 EJECT DTSBD327
|
|
00434 *************************************************************** DTSBD327
|
|
00435 * THE PARAGRAPH EDITS THE INTEREST COMPUTATION DATE DTSBD327
|
|
00436 *************************************************************** DTSBD327
|
|
00437 DTSBD327
|
|
00438 I1200-INT-COMP-DATE. DTSBD327
|
|
00439 DTSBD327
|
|
00440 MOVE WRK-STMT-DATE TO L001-FED-8-DATE-9 DTSBD327
|
|
00441 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBD327
|
|
00442 ADD +14 TO L001-JUL-ABS-DAY DTSBD327
|
|
00443 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT DTSBD327
|
|
00444 MOVE L001-FED-8-DATE-9 DTSBD327
|
|
00445 TO WRK-PARM-INT-COMP-DATE. DTSBD327
|
|
00446 I1200-EXIT. DTSBD327
|
|
00447 EXIT. DTSBD327
|
|
00448 EJECT DTSBD327
|
|
00449 *************************************************************** DTSBD327
|
|
00450 * THE PARAGRAPH EDITS THE REIMBURSABLE CUTOFF DATE. DTSBD327
|
|
00451 *************************************************************** DTSBD327
|
|
00452 DTSBD327
|
|
00453 I1300-REIMB-CUTOFF-DATE. DTSBD327
|
|
00454 DTSBD327
|
|
00455 MOVE WRK-STMT-DATE TO L001-FED-8-DATE-9 DTSBD327
|
|
00456 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBD327
|
|
00457 SUBTRACT 30 FROM L001-JUL-ABS-DAY DTSBD327
|
|
00458 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT DTSBD327
|
|
00459 MOVE L001-FED-8-DATE-9 TO WRK-PARM-REIMB-CUTOFF-DATE. DTSBD327
|
|
00460 DTSBD327
|
|
00461 IF WRK-PARM-REIMB-CUTOFF-DATE > WRK-LAST-ACCT-UPDATE-DATE DTSBD327
|
|
00462 MOVE DTSBD327
|
|
00463 'REIMB-CUTOFF-DATE IS GREATER THAN LAST-ACCT-UPDATE-DATE' DTSBD327
|
|
00464 TO ABEND-MSG DTSBD327
|
|
00465 PERFORM S999-ABEND THRU S999-EXIT. DTSBD327
|
|
00466 I1300-EXIT. DTSBD327
|
|
00467 EXIT. DTSBD327
|
|
00468 DTSBD327
|
|
00469 EJECT DTSBD327
|
|
00470 DTSBD327
|
|
00471 *************************************************************** DTSBD327
|
|
00472 * THIS IS THE PROCESS PARAGRAPH FOR DTSBD327. DTSBD327
|
|
00473 *************************************************************** DTSBD327
|
|
00474 DTSBD327
|
|
00475 P0000-PROCESS. DTSBD327
|
|
00476 DISPLAY 'BD327 P0000 ' MPRF-EMP-NO. DTSBD327
|
|
00477 DTSBD327
|
|
00478 MOVE +50 TO R415-QTR-CNT. DTSBD327
|
|
00479 MOVE 99999 TO WRK-CURR-ANN-YRQ DTSBD327
|
|
00480 IF MPRF-STATUS-NEVERSUB-88 OR DTSBD327
|
|
00481 MPRF-STATUS-UNK-88 DTSBD327
|
|
00482 GO TO P0000-EXIT. DTSBD327
|
|
00483 DTSBD327
|
|
00484 IF (MPRF-TOT-BALANCE-AMT > +0) CL*18
|
|
00485 OR (MPRF-PURSUED-RPT-CNT > +0) DTSBD327
|
|
00486 NEXT SENTENCE DTSBD327
|
|
00487 ELSE DTSBD327
|
|
00488 GO TO P0000-EXIT. DTSBD327
|
|
00489 DTSBD327
|
|
00490 IF MPRF-NOT-WRITTEN-OFF-88 DTSBD327
|
|
00491 NEXT SENTENCE DTSBD327
|
|
00492 ELSE DTSBD327
|
|
00493 GO TO P0000-EXIT. DTSBD327
|
|
00494 DTSBD327
|
|
00495 MOVE +0 TO WRK-MAPL-YRQ-CNT DTSBD327
|
|
00496 WRK-BNK-PETITION-DATE DTSBD327
|
|
00497 WRK-BNK-PETITION-YRQ DTSBD327
|
|
00498 WRK-BNK-FIRST-BILL-YRQ. DTSBD327
|
|
00499 DTSBD327
|
|
00500 IF MPRF-MAPL-EXISTS-88 DTSBD327
|
|
00501 PERFORM P1000-TABLE-MAPL-OPEN-YRQ THRU P1000-EXIT. DTSBD327
|
|
00502 DTSBD327
|
|
00503 IF MPRF-BANKRP-OPEN-88 DTSBD327
|
|
00504 PERFORM P1500-TABLE-OPEN-BNK-YRQ THRU P1500-EXIT. DTSBD327
|
|
00505 DTSBD327
|
|
00506 MOVE 'N' TO STMT-TEXT-IND. DTSBD327
|
|
00507 DTSBD327
|
|
00508 PERFORM P2000-CONSTRUCT-R415-MISC THRU P2000-EXIT. DTSBD327
|
|
00509 DTSBD327
|
|
00510 DTSBD327
|
|
00511 PERFORM S2000-INITIALIZE-TABLE THRU S2000-EXIT DTSBD327
|
|
00512 VARYING WRK-SUB FROM 1 BY 1 DTSBD327
|
|
00513 UNTIL WRK-SUB GREATER THAN R415-QTR-CNT. DTSBD327
|
|
00514 DTSBD327
|
|
00515 MOVE +0 TO R415-QTR-CNT DTSBD327
|
|
00516 WRK-EMP-TOT-DUE. DTSBD327
|
|
00517 DTSBD327
|
|
00518 PERFORM P3000-CONSTRUCT-R415-QTR THRU P3000-EXIT. DTSBD327
|
|
00519 DTSBD327
|
|
00520 DISPLAY 'BD327 P0000 - 2 ' MPRF-EMP-NO. DTSBD327
|
|
00521 IF R415-QTR-CNT = +0 DTSBD327
|
|
00522 GO TO P0000-EXIT. DTSBD327
|
|
00523 DTSBD327
|
|
00524 IF MPRF-PURSUED-RPT-CNT > +0 DTSBD327
|
|
00525 NEXT SENTENCE DTSBD327
|
|
00526 ELSE DTSBD327
|
|
00527 IF WRK-EMP-TOT-DUE < WRK-TOLERANCE-AMT DTSBD327
|
|
00528 MOVE WRK-EMP-TOT-DUE TO AMT-DISP1 DTSBD327
|
|
00529 DISPLAY ' TOT DUE < TOL ' DTSBD327
|
|
00530 MPRF-EMP-NO ' ' AMT-DISP1 DTSBD327
|
|
00531 GO TO P0000-EXIT DTSBD327
|
|
00532 END-IF DTSBD327
|
|
00533 END-IF. DTSBD327
|
|
00534 DTSBD327
|
|
00535 DISPLAY 'BD327 P0000 - 3 ' MPRF-EMP-NO. DTSBD327
|
|
00536 IF T011-ORIGIN (1:3) = 'WEB' DTSBD327
|
|
00537 NEXT SENTENCE DTSBD327
|
|
00538 ELSE DTSBD327
|
|
00539 IF MPRF-TOT-BALANCE-AMT = +0 DTSBD327
|
|
00540 IF R415-QTR-CNT = +1 DTSBD327
|
|
00541 IF R415-QTR (1) >= LBCM-LAST-PEN-ASSESSED-YRQ DTSBD327
|
|
00542 IF R415-QTR-EST-RPT-NO-88 (1) DTSBD327
|
|
00543 ADD 1 TO WRK-BYPASS-CNT DTSBD327
|
|
00544 GO TO P0000-EXIT DTSBD327
|
|
00545 ELSE DTSBD327
|
|
00546 ADD 1 TO WRK-ASSESS-CNT DTSBD327
|
|
00547 END-IF DTSBD327
|
|
00548 END-IF DTSBD327
|
|
00549 END-IF DTSBD327
|
|
00550 END-IF DTSBD327
|
|
00551 END-IF. DTSBD327
|
|
00552 DTSBD327
|
|
00553 IF R415-QTR-CNT > +50 DTSBD327
|
|
00554 MOVE MSG3-ID TO R907-MSG-ID DTSBD327
|
|
00555 MOVE MPRF-EMP-NO TO R907-EMP-NO DTSBD327
|
|
00556 MOVE MSG3-TEXT TO R907-MSG-TEXT DTSBD327
|
|
00557 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBD327
|
|
00558 GO TO P0000-EXIT. DTSBD327
|
|
00559 DTSBD327
|
|
00560 MOVE +0 TO TAD-FORM-CNT. DTSBD327
|
|
00561 DTSBD327
|
|
00562 PERFORM P4000-PROCESS-MTAD THRU P4000-EXIT. DTSBD327
|
|
00563 DTSBD327
|
|
00564 IF TAD-FORM-CNT = +0 DTSBD327
|
|
00565 MOVE MSG1-ID TO R907-MSG-ID DTSBD327
|
|
00566 MOVE MPRF-EMP-NO TO R907-EMP-NO DTSBD327
|
|
00567 MOVE MSG1-TEXT TO R907-MSG-TEXT DTSBD327
|
|
00568 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBD327
|
|
00569 DTSBD327
|
|
00570 MOVE +0 TO OPO-FORM-CNT. DTSBD327
|
|
00571 DTSBD327
|
|
00572 PERFORM P5000-PROCESS-MOPO THRU P5000-EXIT. DTSBD327
|
|
00573 DTSBD327
|
|
00574 MOVE +0 TO TAA-FORM-CNT. DTSBD327
|
|
00575 DTSBD327
|
|
00576 PERFORM P6000-PROCESS-MTAA THRU P6000-EXIT. DTSBD327
|
|
00577 DTSBD327
|
|
00578 IF STMT-TEXT-IND = 'Y' DTSBD327
|
|
00579 IF ((TAD-FORM-CNT > +0) DTSBD327
|
|
00580 OR (OPO-FORM-CNT > +0) DTSBD327
|
|
00581 OR (TAA-FORM-CNT > +0)) DTSBD327
|
|
00582 PERFORM P7000-REWRITE-MCOL THRU P7000-EXIT. DTSBD327
|
|
00583 P0000-EXIT. DTSBD327
|
|
00584 EXIT. DTSBD327
|
|
00585 EJECT DTSBD327
|
|
00586 *************************************************************** DTSBD327
|
|
00587 * THIS PARAGRAPH STARTS THE BROWSE OF THE MAPL RECORDS. DTSBD327
|
|
00588 *************************************************************** DTSBD327
|
|
00589 DTSBD327
|
|
00590 P1000-TABLE-MAPL-OPEN-YRQ. DTSBD327
|
|
00591 DTSBD327
|
|
00592 MOVE LOW-VALUES TO MAPL-KEY-AREA. DTSBD327
|
|
00593 MOVE MPRF-EMP-NO TO MAPL-EMP-NO. DTSBD327
|
|
00594 SET MAPL-APL-88 TO TRUE. DTSBD327
|
|
00595 MOVE MAPL-KEY-AREA TO MSKL-KEY-AREA. DTSBD327
|
|
00596 DTSBD327
|
|
00597 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD327
|
|
00598 DTSBD327
|
|
00599 PERFORM P1100-SCAN-MAPL THRU P1100-EXIT DTSBD327
|
|
00600 UNTIL L910-NO-REC-88. DTSBD327
|
|
00601 DTSBD327
|
|
00602 P1000-EXIT. DTSBD327
|
|
00603 EXIT. DTSBD327
|
|
00604 SKIP3 DTSBD327
|
|
00605 *************************************************************** DTSBD327
|
|
00606 * THIS PARAGRAPH SCANS ALL MAPL RECORDS. DTSBD327
|
|
00607 *************************************************************** DTSBD327
|
|
00608 DTSBD327
|
|
00609 P1100-SCAN-MAPL. DTSBD327
|
|
00610 DTSBD327
|
|
00611 MOVE MSKL-REC TO MAPL-REC. DTSBD327
|
|
00612 DTSBD327
|
|
00613 IF MAPL-STATUS-OPEN-88 DTSBD327
|
|
00614 PERFORM P1110-SCAN-COVERED-YRQ THRU P1110-EXIT DTSBD327
|
|
00615 VARYING MAPL-COV-IDX FROM 1 BY 1 DTSBD327
|
|
00616 UNTIL MAPL-COV-IDX GREATER THAN MAPL-COVERED-CNT. DTSBD327
|
|
00617 DTSBD327
|
|
00618 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD327
|
|
00619 DTSBD327
|
|
00620 P1100-EXIT. DTSBD327
|
|
00621 EXIT. DTSBD327
|
|
00622 EJECT DTSBD327
|
|
00623 *************************************************************** DTSBD327
|
|
00624 * THIS PARAGRAPH PROCESSES THE QUARTER TABLE IN THE MAPL DTSBD327
|
|
00625 * RECORD, AND SETS ALL NEW QUARTERS UP IN THE WORKING DTSBD327
|
|
00626 * STORAGE TABLE. DTSBD327
|
|
00627 *************************************************************** DTSBD327
|
|
00628 DTSBD327
|
|
00629 P1110-SCAN-COVERED-YRQ. DTSBD327
|
|
00630 DTSBD327
|
|
00631 MOVE MAPL-COVERED-YRQ (MAPL-COV-IDX) TO HOLD-YRQ. DTSBD327
|
|
00632 DTSBD327
|
|
00633 PERFORM P1111-WRK-MAPL-YRQ-LOOP THRU P1111-EXIT DTSBD327
|
|
00634 VARYING WRK-MAPL-YRQ-IDX FROM 1 BY 1 DTSBD327
|
|
00635 UNTIL (WRK-MAPL-YRQ-IDX > WRK-MAPL-YRQ-CNT) DTSBD327
|
|
00636 OR DTSBD327
|
|
00637 (HOLD-YRQ = +0). DTSBD327
|
|
00638 DTSBD327
|
|
00639 IF HOLD-YRQ = +0 DTSBD327
|
|
00640 NEXT SENTENCE DTSBD327
|
|
00641 ELSE DTSBD327
|
|
00642 IF WRK-MAPL-YRQ-CNT < +400 DTSBD327
|
|
00643 ADD +1 TO WRK-MAPL-YRQ-CNT DTSBD327
|
|
00644 MOVE HOLD-YRQ TO WRK-MAPL-YRQ (WRK-MAPL-YRQ-CNT). DTSBD327
|
|
00645 P1110-EXIT. DTSBD327
|
|
00646 EXIT. DTSBD327
|
|
00647 SKIP3 DTSBD327
|
|
00648 *************************************************************** DTSBD327
|
|
00649 * THIS PARAGRAPH LOOKS AT EACH OCCURRENCE OF THE QUARTER TABLE DTSBD327
|
|
00650 * TO DETERMINE IF THE QUARTER HAS ALREADY BEEN LOADED. DTSBD327
|
|
00651 *************************************************************** DTSBD327
|
|
00652 DTSBD327
|
|
00653 P1111-WRK-MAPL-YRQ-LOOP. DTSBD327
|
|
00654 DTSBD327
|
|
00655 IF HOLD-YRQ = WRK-MAPL-YRQ (WRK-MAPL-YRQ-IDX) DTSBD327
|
|
00656 MOVE +0 TO HOLD-YRQ. DTSBD327
|
|
00657 P1111-EXIT. DTSBD327
|
|
00658 EXIT. DTSBD327
|
|
00659 EJECT DTSBD327
|
|
00660 *************************************************************** DTSBD327
|
|
00661 * IF THE EMPLOYER HAS AN OPEN BANKRUPTCY, DO NOT INCLUDE ANY DTSBD327
|
|
00662 * QUARTER LESS THAN THAT IN WHICH THE PETITION DATE OCCURS DTSBD327
|
|
00663 * IN THE DEBIT MEMO. DTSBD327
|
|
00664 *************************************************************** DTSBD327
|
|
00665 P1500-TABLE-OPEN-BNK-YRQ. DTSBD327
|
|
00666 MOVE LOW-VALUES TO MCOL-KEY-AREA. DTSBD327
|
|
00667 MOVE MPRF-EMP-NO TO MCOL-EMP-NO. DTSBD327
|
|
00668 SET MCOL-COL-88 TO TRUE. DTSBD327
|
|
00669 MOVE MCOL-KEY-AREA TO MSKL-KEY-AREA. DTSBD327
|
|
00670 DTSBD327
|
|
00671 PERFORM S910-READ THRU S910-EXIT. DTSBD327
|
|
00672 DTSBD327
|
|
00673 IF NOT L910-OK-88 DTSBD327
|
|
00674 GO TO P1500-EXIT DTSBD327
|
|
00675 ELSE DTSBD327
|
|
00676 MOVE MSKL-REC TO MCOL-REC. DTSBD327
|
|
00677 DTSBD327
|
|
00678 IF MCOL-BNK-PETITION-DATE > +0 DTSBD327
|
|
00679 IF (MCOL-BNK-DISCHRG-CLOSE-DATE = +0 DTSBD327
|
|
00680 AND MCOL-BNK-DISMISS-DATE = +0) DTSBD327
|
|
00681 PERFORM P1510-FIRST-BILL-YRQ THRU P1510-EXIT DTSBD327
|
|
00682 ELSE DTSBD327
|
|
00683 GO TO P1500-EXIT. DTSBD327
|
|
00684 DTSBD327
|
|
00685 P1500-EXIT. DTSBD327
|
|
00686 EXIT. DTSBD327
|
|
00687 DTSBD327
|
|
00688 *************************************************************** DTSBD327
|
|
00689 * DETERMINE THE QUARTER IN WHICH THE PETITION DATE FALLS. DTSBD327
|
|
00690 * THE NEXT QUARTER IS THE FIRST THAT MAY BE INCLUDED IN THE DTSBD327
|
|
00691 * DEBIT MEMO. SET WRK-BNK-PETITION-YRQ = DTSBD327
|
|
00692 * (THE QUARTER IN WHICH THE PETITION DATE FALLS PLUS 1). DTSBD327
|
|
00693 *************************************************************** DTSBD327
|
|
00694 P1510-FIRST-BILL-YRQ. DTSBD327
|
|
00695 MOVE MCOL-BNK-PETITION-DATE TO WRK-BNK-PETITION-DATE. DTSBD327
|
|
00696 MOVE WRK-BNK-PETITION-DATE-YYYY DTSBD327
|
|
00697 TO WRK-BNK-PETITION-YRQ-YYYY. DTSBD327
|
|
00698 EVALUATE WRK-BNK-PETITION-DATE-MM DTSBD327
|
|
00699 WHEN 10 THRU 12 DTSBD327
|
|
00700 MOVE 4 TO WRK-BNK-PETITION-YRQ-Q DTSBD327
|
|
00701 WHEN 7 THRU 9 DTSBD327
|
|
00702 MOVE 3 TO WRK-BNK-PETITION-YRQ-Q DTSBD327
|
|
00703 WHEN 4 THRU 6 DTSBD327
|
|
00704 MOVE 2 TO WRK-BNK-PETITION-YRQ-Q DTSBD327
|
|
00705 WHEN OTHER DTSBD327
|
|
00706 MOVE 1 TO WRK-BNK-PETITION-YRQ-Q DTSBD327
|
|
00707 END-EVALUATE. DTSBD327
|
|
00708 DTSBD327
|
|
00709 MOVE WRK-BNK-PETITION-YRQ TO L004-QTR-5-9. DTSBD327
|
|
00710 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD327
|
|
00711 IF L004-INVALID-QTR DTSBD327
|
|
00712 MOVE 'INVALID PETITION YRQ ENCOUNTERED' DTSBD327
|
|
00713 TO ABEND-MSG DTSBD327
|
|
00714 PERFORM S999-ABEND THRU S999-EXIT. DTSBD327
|
|
00715 DTSBD327
|
|
00716 ADD +1 TO L004-ABS-QTR. DTSBD327
|
|
00717 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBD327
|
|
00718 MOVE L004-QTR-5-9 TO WRK-BNK-FIRST-BILL-YRQ. DTSBD327
|
|
00719 DTSBD327
|
|
00720 P1510-EXIT. DTSBD327
|
|
00721 EXIT. DTSBD327
|
|
00722 DTSBD327
|
|
00723 *************************************************************** DTSBD327
|
|
00724 * THIS PARAGRAPH BUILDS THE R415 REPORT EXTRACT RECORD. DTSBD327
|
|
00725 *************************************************************** DTSBD327
|
|
00726 P2000-CONSTRUCT-R415-MISC. DTSBD327
|
|
00727 DTSBD327
|
|
00728 MOVE T011-RESP-OP-ID TO R415-OP-ID. DTSBD327
|
|
00729 MOVE WRK-STMT-DATE TO R415-STMT-DATE. DTSBD327
|
|
00730 MOVE WRK-PARM-INT-COMP-DATE TO R415-COMP-DATE. DTSBD327
|
|
00731 MOVE WRK-LAST-ACCT-UPDATE-DATE TO R415-LAST-ACCT-UPDATE-DATE.DTSBD327
|
|
00732 DTSBD327
|
|
00733 DTSBD327
|
|
00734 P2000-EXIT. DTSBD327
|
|
00735 EXIT. DTSBD327
|
|
00736 EJECT DTSBD327
|
|
00737 *************************************************************** DTSBD327
|
|
00738 * THIS PARAGRAPH CAUSES ALL THE MQTR RECORDS TO BE READ. DTSBD327
|
|
00739 *************************************************************** DTSBD327
|
|
00740 DTSBD327
|
|
00741 P3000-CONSTRUCT-R415-QTR. DTSBD327
|
|
00742 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBD327
|
|
00743 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBD327
|
|
00744 SET MQTR-QTR-88 TO TRUE. DTSBD327
|
|
00745 MOVE T011-START-YRQ TO MQTR-YRQ DTSBD327
|
|
00746 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBD327
|
|
00747 DTSBD327
|
|
00748 DISPLAY 'BD327 P3000 1 ' MPRF-EMP-NO ' ' MQTR-YRQ. DTSBD327
|
|
00749 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD327
|
|
00750 DTSBD327
|
|
00751 PERFORM P3100-SCAN-MQTR THRU P3100-EXIT DTSBD327
|
|
00752 UNTIL L910-NO-REC-88 OR DTSBD327
|
|
00753 MQTR-YRQ > T011-END-YRQ. DTSBD327
|
|
00754 DTSBD327
|
|
00755 P3000-EXIT. DTSBD327
|
|
00756 EXIT. DTSBD327
|
|
00757 EJECT DTSBD327
|
|
00758 *************************************************************** DTSBD327
|
|
00759 * THIS PARAGRAPH SCANS THE MQTR RECORDS. DTSBD327
|
|
00760 *************************************************************** DTSBD327
|
|
00761 DTSBD327
|
|
00762 P3100-SCAN-MQTR. DTSBD327
|
|
00763 DTSBD327
|
|
00764 MOVE MSKL-REC TO MQTR-REC. DTSBD327
|
|
00765 PERFORM P3110-PROCESS-MQTR THRU P3110-EXIT. DTSBD327
|
|
00766 DTSBD327
|
|
00767 MOVE MQTR-REC TO MSKL-REC. DTSBD327
|
|
00768 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD327
|
|
00769 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD327
|
|
00770 DTSBD327
|
|
00771 P3100-EXIT. DTSBD327
|
|
00772 EXIT. DTSBD327
|
|
00773 EJECT DTSBD327
|
|
00774 *************************************************************** DTSBD327
|
|
00775 * THIS PARAGRAPH PROCESSES THE MQTR RECORDS. DTSBD327
|
|
00776 *************************************************************** DTSBD327
|
|
00777 DTSBD327
|
|
00778 P3110-PROCESS-MQTR. DTSBD327
|
|
00779 DISPLAY 'BD327 P3110 1 ' MPRF-EMP-NO ' ' MQTR-YRQ DTSBD327
|
|
00780 ' R415 CNT ' R415-QTR-CNT. DTSBD327
|
|
00781 DTSBD327
|
|
00782 IF MQTR-YRQ < T011-START-YRQ OR DTSBD327
|
|
00783 MQTR-YRQ > T011-END-YRQ DTSBD327
|
|
00784 GO TO P3110-EXIT DTSBD327
|
|
00785 END-IF. DTSBD327
|
|
00786 DTSBD327
|
|
00787 MOVE ZEROS TO WRK-YRQ. DTSBD327
|
|
00788 IF WRK-BNK-FIRST-BILL-YRQ = ZERO DTSBD327
|
|
00789 NEXT SENTENCE DTSBD327
|
|
00790 ELSE DTSBD327
|
|
00791 IF MQTR-YRQ = LBCM-PICKUP-YRQ DTSBD327
|
|
00792 GO TO P3110-EXIT DTSBD327
|
|
00793 ELSE DTSBD327
|
|
00794 IF MQTR-YRQ < WRK-BNK-FIRST-BILL-YRQ DTSBD327
|
|
00795 GO TO P3110-EXIT DTSBD327
|
|
00796 END-IF DTSBD327
|
|
00797 END-IF DTSBD327
|
|
00798 END-IF. DTSBD327
|
|
00799 DTSBD327
|
|
00800 IF MQTR-RPT-IS-PURSUED-88 DTSBD327
|
|
00801 NEXT SENTENCE DTSBD327
|
|
00802 ELSE DTSBD327
|
|
00803 IF MPRF-CLASS-SELF-INS-88 DTSBD327
|
|
00804 IF MQTR-TAX-DUE-DATE GREATER THAN DTSBD327
|
|
00805 WRK-PARM-REIMB-CUTOFF-DATE DTSBD327
|
|
00806 GO TO P3110-EXIT. DTSBD327
|
|
00807 DISPLAY 'BD327 P3110 2 ' MPRF-EMP-NO ' ' MQTR-YRQ. DTSBD327
|
|
00808 SET L410-MODE-INPUT-YRQ-88 TO TRUE. DTSBD327
|
|
00809 MOVE MPRF-EMP-NO TO L410-EMP-NO. DTSBD327
|
|
00810 MOVE MQTR-YRQ TO L410-YRQ. DTSBD327
|
|
00811 PERFORM S410-FILE-SCHED THRU S410-EXIT. DTSBD327
|
|
00812 IF L410-ANN-SCHED-88 DTSBD327
|
|
00813 MOVE MQTR-YRQ TO WRK-YRQ DTSBD327
|
|
00814 IF WRK-YRQ-YR NOT = WRK-CURR-ANN-YEAR DTSBD327
|
|
00815 MOVE ZEROS TO WRK-TAX-DUE DTSBD327
|
|
00816 WRK-PEN-DUE DTSBD327
|
|
00817 WRK-INT-DUE DTSBD327
|
|
00818 WRK-SUR-DUE DTSBD327
|
|
00819 WRK-TOT-DUE DTSBD327
|
|
00820 END-IF DTSBD327
|
|
00821 ELSE DTSBD327
|
|
00822 MOVE ZEROS TO WRK-TAX-DUE DTSBD327
|
|
00823 WRK-PEN-DUE DTSBD327
|
|
00824 WRK-INT-DUE DTSBD327
|
|
00825 WRK-SUR-DUE DTSBD327
|
|
00826 WRK-TOT-DUE DTSBD327
|
|
00827 END-IF. DTSBD327
|
|
00828 DTSBD327
|
|
00829 PERFORM P3111-PROJECT-INT THRU P3111-EXIT. DTSBD327
|
|
00830 DTSBD327
|
|
00831 ADD WRK-TAX-DUE DTSBD327
|
|
00832 WRK-PEN-DUE DTSBD327
|
|
00833 WRK-INT-DUE DTSBD327
|
|
00834 WRK-SUR-DUE DTSBD327
|
|
00835 GIVING WRK-TOT-DUE. DTSBD327
|
|
00836 DTSBD327
|
|
00837 DISPLAY 'BD327 P3110 4 ' MPRF-EMP-NO ' ' MQTR-YRQ DTSBD327
|
|
00838 ' TOT DUE ' WRK-TOT-DUE ' ' MQTR-PURSUED-RPT-IND. DTSBD327
|
|
00839 IF (WRK-TOT-DUE GREATER THAN ZERO) OR DTSBD327
|
|
00840 (MQTR-RPT-IS-PURSUED-88) DTSBD327
|
|
00841 NEXT SENTENCE DTSBD327
|
|
00842 ELSE DTSBD327
|
|
00843 GO TO P3110-EXIT. DTSBD327
|
|
00844 DTSBD327
|
|
00845 DTSBD327
|
|
00846 IF WRK-YRQ-YR NOT = WRK-CURR-ANN-YEAR DTSBD327
|
|
00847 ADD +1 TO R415-QTR-CNT. DTSBD327
|
|
00848 DTSBD327
|
|
00849 DISPLAY 'BD327 P3110 5 ' MPRF-EMP-NO ' ' MQTR-YRQ DTSBD327
|
|
00850 ' WRK YRQ ' WRK-YRQ ' CURR ANN ' WRK-CURR-ANN-YEAR DTSBD327
|
|
00851 DISPLAY ' R415 CNT ' R415-QTR-CNT. DTSBD327
|
|
00852 IF R415-QTR-CNT GREATER THAN 50 DTSBD327
|
|
00853 GO TO P3110-EXIT. DTSBD327
|
|
00854 DTSBD327
|
|
00855 IF L410-ANN-SCHED-88 DTSBD327
|
|
00856 SET R415-ANN-FILER-YES-88 (R415-QTR-CNT) TO TRUE DTSBD327
|
|
00857 MOVE WRK-YRQ-YR TO WRK-CURR-ANN-YEAR DTSBD327
|
|
00858 MOVE ZERO TO WRK-CURR-ANN-Q DTSBD327
|
|
00859 MOVE WRK-CURR-ANN-YRQ TO R415-QTR (R415-QTR-CNT) DTSBD327
|
|
00860 ELSE DTSBD327
|
|
00861 SET R415-ANN-FILER-NO-88 (R415-QTR-CNT) TO TRUE DTSBD327
|
|
00862 MOVE MQTR-YRQ TO R415-QTR (R415-QTR-CNT) DTSBD327
|
|
00863 END-IF. DTSBD327
|
|
00864 DTSBD327
|
|
00865 IF MQTR-CURR-ESTIM-88 DTSBD327
|
|
00866 SET R415-QTR-EST-RPT-YES-88 (R415-QTR-CNT) TO TRUE DTSBD327
|
|
00867 ELSE DTSBD327
|
|
00868 SET R415-QTR-EST-RPT-NO-88 (R415-QTR-CNT) TO TRUE. DTSBD327
|
|
00869 DTSBD327
|
|
00870 SET R415-QTR-APPEAL-NO-88 (R415-QTR-CNT) TO TRUE. DTSBD327
|
|
00871 DTSBD327
|
|
00872 PERFORM P3112-CHECK-APPEAL THRU P3112-EXIT DTSBD327
|
|
00873 VARYING WRK-MAPL-YRQ-IDX FROM 1 BY 1 DTSBD327
|
|
00874 UNTIL WRK-MAPL-YRQ-IDX GREATER THAN WRK-MAPL-YRQ-CNT OR DTSBD327
|
|
00875 R415-QTR-APPEAL-YES-88 (R415-QTR-CNT). DTSBD327
|
|
00876 DTSBD327
|
|
00877 PERFORM P3113-QTR-STATUS THRU P3113-EXIT. DTSBD327
|
|
00878 DTSBD327
|
|
00879 MOVE WRK-PEN-DUE TO R415-PENALTY-AMT (R415-QTR-CNT). DTSBD327
|
|
00880 MOVE WRK-TAX-DUE TO R415-CONTRIB-AMT (R415-QTR-CNT). DTSBD327
|
|
00881 MOVE WRK-INT-DUE TO R415-INTEREST-AMT (R415-QTR-CNT). DTSBD327
|
|
00882 MOVE WRK-TOT-DUE TO R415-BALANCE-AMT (R415-QTR-CNT). DTSBD327
|
|
00883 MOVE WRK-SUR-DUE TO R415-SURCHRG-AMT (R415-QTR-CNT). DTSBD327
|
|
00884 DTSBD327
|
|
00885 ADD WRK-TOT-DUE TO WRK-EMP-TOT-DUE. DTSBD327
|
|
00886 DTSBD327
|
|
00887 P3110-EXIT. DTSBD327
|
|
00888 EXIT. DTSBD327
|
|
00889 EJECT DTSBD327
|
|
00890 *************************************************************** DTSBD327
|
|
00891 * THIS PARAGRAPH PROJECTS THE INTEREST DUE. DTSBD327
|
|
00892 *************************************************************** DTSBD327
|
|
00893 DTSBD327
|
|
00894 P3111-PROJECT-INT. DTSBD327
|
|
00895 DTSBD327
|
|
00896 MOVE ZERO TO L101-PAID-CHNG. DTSBD327
|
|
00897 DTSBD327
|
|
00898 PERFORM DTSBD327
|
|
00899 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBD327
|
|
00900 UNTIL MQTR-ACCT-IDX GREATER THAN MQTR-ACCT-CNT DTSBD327
|
|
00901 DTSBD327
|
|
00902 PERFORM P3111-1-ACCUM THRU P3111-1-EXIT DTSBD327
|
|
00903 DTSBD327
|
|
00904 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSBD327
|
|
00905 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBD327
|
|
00906 TO L101-PAID-CHNG DTSBD327
|
|
00907 ELSE DTSBD327
|
|
00908 IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) DTSBD327
|
|
00909 IF MPRF-CLASS-RATED-88 DTSBD327
|
|
00910 AND MQTR-YRQ >= WRK-FIRST-PEN-INT-YRQ DTSBD327
|
|
00911 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBD327
|
|
00912 TO L101-PAID-CHNG DTSBD327
|
|
00913 END-IF DTSBD327
|
|
00914 END-IF DTSBD327
|
|
00915 END-IF DTSBD327
|
|
00916 DTSBD327
|
|
00917 END-PERFORM. DTSBD327
|
|
00918 DTSBD327
|
|
00919 IF L101-PAID-CHNG GREATER THAN ZERO DTSBD327
|
|
00920 NEXT SENTENCE DTSBD327
|
|
00921 ELSE DTSBD327
|
|
00922 GO TO P3111-EXIT. DTSBD327
|
|
00923 DTSBD327
|
|
00924 MOVE WRK-PARM-INT-COMP-DATE TO L101-RECEIVED-DATE. DTSBD327
|
|
00925 SET L101-WAIVE-INT-NO-88 TO TRUE. DTSBD327
|
|
00926 MOVE MQTR-TAX-DUE-DATE TO L101-TAX-DUE-DATE. DTSBD327
|
|
00927 MOVE MQTR-INT-AREA TO L101-INT-AREA. DTSBD327
|
|
00928 DTSBD327
|
|
00929 PERFORM S101-PER-MONTH-NO THRU S101-EXIT. DTSBD327
|
|
00930 DTSBD327
|
|
00931 ADD L101-INT-CHARGE-CHNG TO WRK-INT-DUE. DTSBD327
|
|
00932 DTSBD327
|
|
00933 SUBTRACT L101-INT-WAIVE-CHNG FROM WRK-INT-DUE. DTSBD327
|
|
00934 DTSBD327
|
|
00935 P3111-EXIT. DTSBD327
|
|
00936 EXIT. DTSBD327
|
|
00937 EJECT DTSBD327
|
|
00938 *************************************************************** DTSBD327
|
|
00939 * THIS PARAGRAPH ACCUMULATES THE TOTAL TAXES, PENALTY AND DTSBD327
|
|
00940 * INTEREST DUE AND PAID IN THE QUARTER RECORD. DTSBD327
|
|
00941 *************************************************************** DTSBD327
|
|
00942 DTSBD327
|
|
00943 P3111-1-ACCUM. DTSBD327
|
|
00944 DTSBD327
|
|
00945 IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) DTSBD327
|
|
00946 * ADD MQTR-PAID-AMT (MQTR-ACCT-IDX) TO WRK-TAX-PD DTSBD327
|
|
00947 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) TO WRK-SUR-DUE DTSBD327
|
|
00948 ELSE DTSBD327
|
|
00949 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSBD327
|
|
00950 * ADD MQTR-PAID-AMT (MQTR-ACCT-IDX) TO WRK-TAX-PD DTSBD327
|
|
00951 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) TO WRK-TAX-DUE DTSBD327
|
|
00952 ELSE DTSBD327
|
|
00953 IF MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX) OR DTSBD327
|
|
00954 MQTR-ACCT-NSF-PEN-88 (MQTR-ACCT-IDX) OR DTSBD327
|
|
00955 MQTR-ACCT-MISC-PEN-88 (MQTR-ACCT-IDX) DTSBD327
|
|
00956 * ADD MQTR-PAID-AMT (MQTR-ACCT-IDX) TO WRK-PEN-PD DTSBD327
|
|
00957 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) TO WRK-PEN-DUE DTSBD327
|
|
00958 ELSE DTSBD327
|
|
00959 IF MQTR-ACCT-INT-88 (MQTR-ACCT-IDX) DTSBD327
|
|
00960 * ADD MQTR-PAID-AMT (MQTR-ACCT-IDX) TO WRK-INT-PD DTSBD327
|
|
00961 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) TO WRK-INT-DUE. DTSBD327
|
|
00962 DTSBD327
|
|
00963 P3111-1-EXIT. DTSBD327
|
|
00964 EXIT. DTSBD327
|
|
00965 EJECT DTSBD327
|
|
00966 *************************************************************** DTSBD327
|
|
00967 * THIS PARAGRAPH CHECKS TO SEE IF THE QUARTER IS BEING DTSBD327
|
|
00968 * APPEALED. DTSBD327
|
|
00969 *************************************************************** DTSBD327
|
|
00970 DTSBD327
|
|
00971 P3112-CHECK-APPEAL. DTSBD327
|
|
00972 DTSBD327
|
|
00973 IF WRK-MAPL-YRQ (WRK-MAPL-YRQ-IDX) EQUAL MQTR-YRQ DTSBD327
|
|
00974 SET R415-QTR-APPEAL-YES-88 (R415-QTR-CNT) TO TRUE. DTSBD327
|
|
00975 DTSBD327
|
|
00976 P3112-EXIT. DTSBD327
|
|
00977 EXIT. DTSBD327
|
|
00978 EJECT DTSBD327
|
|
00979 *************************************************************** DTSBD327
|
|
00980 * THIS PARAGRAPH CHECKS THE STATUS OF THE QUARTER. DTSBD327
|
|
00981 *************************************************************** DTSBD327
|
|
00982 DTSBD327
|
|
00983 P3113-QTR-STATUS. DTSBD327
|
|
00984 DTSBD327
|
|
00985 SET R415-RPT-MISSING-NO-88 (R415-QTR-CNT) TO TRUE. DTSBD327
|
|
00986 DTSBD327
|
|
00987 IF MQTR-RPT-IS-PURSUED-88 DTSBD327
|
|
00988 SET R415-RPT-MISSING-YES-88 (R415-QTR-CNT) TO TRUE DTSBD327
|
|
00989 GO TO P3113-EXIT. DTSBD327
|
|
00990 DTSBD327
|
|
00991 P3113-EXIT. DTSBD327
|
|
00992 EXIT. DTSBD327
|
|
00993 EJECT DTSBD327
|
|
00994 *************************************************************** DTSBD327
|
|
00995 * THIS PARAGRAPH CAUSES THE MTAD RECORDS TO BE PROCESSED. DTSBD327
|
|
00996 *************************************************************** DTSBD327
|
|
00997 DTSBD327
|
|
00998 P4000-PROCESS-MTAD. DTSBD327
|
|
00999 DTSBD327
|
|
01000 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSBD327
|
|
01001 MOVE MPRF-EMP-NO TO MTAD-EMP-NO. DTSBD327
|
|
01002 SET MTAD-TAD-88 TO TRUE. DTSBD327
|
|
01003 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSBD327
|
|
01004 DTSBD327
|
|
01005 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD327
|
|
01006 DTSBD327
|
|
01007 PERFORM P4100-SCAN-MTAD THRU P4100-EXIT DTSBD327
|
|
01008 UNTIL L910-NO-REC-88. DTSBD327
|
|
01009 DTSBD327
|
|
01010 P4000-EXIT. DTSBD327
|
|
01011 EXIT. DTSBD327
|
|
01012 EJECT DTSBD327
|
|
01013 *************************************************************** DTSBD327
|
|
01014 * THIS PARAGRAPH SCANS THE MTAD RECORDS. DTSBD327
|
|
01015 *************************************************************** DTSBD327
|
|
01016 DTSBD327
|
|
01017 P4100-SCAN-MTAD. DTSBD327
|
|
01018 DTSBD327
|
|
01019 MOVE MSKL-REC TO MTAD-REC. DTSBD327
|
|
01020 DTSBD327
|
|
01021 PERFORM P4110-WRITE-MTAD-REC THRU P4110-EXIT. DTSBD327
|
|
01022 DTSBD327
|
|
01023 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD327
|
|
01024 DTSBD327
|
|
01025 P4100-EXIT. DTSBD327
|
|
01026 EXIT. DTSBD327
|
|
01027 EJECT DTSBD327
|
|
01028 *************************************************************** DTSBD327
|
|
01029 * THIS PARAGRAPH FORMATS AND WRITES THE EXTRACT RECORDS DTSBD327
|
|
01030 * FOR THE MTAD RECORDS. DTSBD327
|
|
01031 *************************************************************** DTSBD327
|
|
01032 DTSBD327
|
|
01033 P4110-WRITE-MTAD-REC. DTSBD327
|
|
01034 DTSBD327
|
|
01035 DISPLAY 'BD327 P4100 - 1 ' MPRF-EMP-NO. DTSBD327
|
|
01036 IF MTAD-UC223-NO-88 DTSBD327
|
|
01037 GO TO P4110-EXIT. DTSBD327
|
|
01038 DTSBD327
|
|
01039 ADD +1 TO TAD-FORM-CNT. DTSBD327
|
|
01040 DTSBD327
|
|
01041 MOVE LOW-VALUES TO L111-RETURN-AREA. DTSBD327
|
|
01042 MOVE MPRF-EMP-NO TO L111-EMP-NO. DTSBD327
|
|
01043 SET L111-LOOKUP-TAD-88 TO TRUE. DTSBD327
|
|
01044 MOVE MTAD-ID-NO TO L111-ID-NO. DTSBD327
|
|
01045 DTSBD327
|
|
01046 PERFORM S111-LOOKUP-ADDR THRU S111-EXIT. DTSBD327
|
|
01047 DTSBD327
|
|
01048 IF L111-ADDR-FOUND-88 DTSBD327
|
|
01049 SET L112-TAD-ADDR-88 TO TRUE DTSBD327
|
|
01050 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA DTSBD327
|
|
01051 PERFORM P4111-FORMAT-ADDR THRU P4111-EXIT DTSBD327
|
|
01052 ELSE DTSBD327
|
|
01053 MOVE ALL '?' TO R415-FMT-ADDR DTSBD327
|
|
01054 R415-ZIP DTSBD327
|
|
01055 R415-ADVANCED-BARCODE. DTSBD327
|
|
01056 DTSBD327
|
|
01057 MOVE 'TAD' TO EVL-ADDR-TYPE. DTSBD327
|
|
01058 MOVE MTAD-ID-NO TO EVL-ADDR-ID-NO. DTSBD327
|
|
01059 MOVE WRK-EMP-TOT-DUE TO EVL-TOT-BAL-AMT. DTSBD327
|
|
01060 DTSBD327
|
|
01061 DISPLAY 'BD327 P4100 - 2 ' MPRF-EMP-NO. DTSBD327
|
|
01062 PERFORM S1000-WRITE-RECS THRU S1000-EXIT. DTSBD327
|
|
01063 DTSBD327
|
|
01064 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSBD327
|
|
01065 PERFORM S910-READ THRU S910-EXIT. DTSBD327
|
|
01066 IF L910-NO-REC-88 DTSBD327
|
|
01067 PERFORM S999-ABEND THRU S999-EXIT. DTSBD327
|
|
01068 DTSBD327
|
|
01069 P4110-EXIT. DTSBD327
|
|
01070 EXIT. DTSBD327
|
|
01071 EJECT DTSBD327
|
|
01072 *************************************************************** DTSBD327
|
|
01073 * THIS PARAGRAPH FORMATS THE ADDRESS. DTSBD327
|
|
01074 *************************************************************** DTSBD327
|
|
01075 DTSBD327
|
|
01076 P4111-FORMAT-ADDR. DTSBD327
|
|
01077 DTSBD327
|
|
01078 SET L112-ANCHOR-FIRST-88 TO TRUE. DTSBD327
|
|
01079 MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME. DTSBD327
|
|
01080 DTSBD327
|
|
01081 PERFORM S112-FORMAT-ADDR THRU S112-EXIT. DTSBD327
|
|
01082 DTSBD327
|
|
01083 MOVE L112-MAILING-ADDRESS TO R415-FMT-ADDR. DTSBD327
|
|
01084 MOVE L112-ZIP TO R415-ZIP. DTSBD327
|
|
01085 MOVE L112-ADVANCED-BARCODE TO R415-ADVANCED-BARCODE. DTSBD327
|
|
01086 DTSBD327
|
|
01087 P4111-EXIT. DTSBD327
|
|
01088 EXIT. DTSBD327
|
|
01089 EJECT DTSBD327
|
|
01090 *************************************************************** DTSBD327
|
|
01091 * THIS PARAGRAPH CAUSES THE MOPO RECORDS TO BE PROCESSED. DTSBD327
|
|
01092 *************************************************************** DTSBD327
|
|
01093 DTSBD327
|
|
01094 P5000-PROCESS-MOPO. DTSBD327
|
|
01095 DTSBD327
|
|
01096 MOVE LOW-VALUES TO MOPO-KEY-AREA. DTSBD327
|
|
01097 MOVE MPRF-EMP-NO TO MOPO-EMP-NO. DTSBD327
|
|
01098 SET MOPO-OPO-88 TO TRUE. DTSBD327
|
|
01099 MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA. DTSBD327
|
|
01100 DTSBD327
|
|
01101 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD327
|
|
01102 DTSBD327
|
|
01103 PERFORM P5100-SCAN-MOPO THRU P5100-EXIT DTSBD327
|
|
01104 UNTIL L910-NO-REC-88. DTSBD327
|
|
01105 DTSBD327
|
|
01106 P5000-EXIT. DTSBD327
|
|
01107 EXIT. DTSBD327
|
|
01108 EJECT DTSBD327
|
|
01109 *************************************************************** DTSBD327
|
|
01110 * THIS PARAGRAPH SCANS THE MOPO RECORDS. DTSBD327
|
|
01111 *************************************************************** DTSBD327
|
|
01112 DTSBD327
|
|
01113 P5100-SCAN-MOPO. DTSBD327
|
|
01114 DTSBD327
|
|
01115 MOVE MSKL-REC TO MOPO-REC. DTSBD327
|
|
01116 DTSBD327
|
|
01117 PERFORM P5110-WRITE-MOPO-REC THRU P5110-EXIT. DTSBD327
|
|
01118 DTSBD327
|
|
01119 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD327
|
|
01120 DTSBD327
|
|
01121 P5100-EXIT. DTSBD327
|
|
01122 EXIT. DTSBD327
|
|
01123 EJECT DTSBD327
|
|
01124 *************************************************************** DTSBD327
|
|
01125 * THIS PARAGRAPH WRITES THE EXTRACT RECORDS FOR MOPO RECORDS. DTSBD327
|
|
01126 *************************************************************** DTSBD327
|
|
01127 DTSBD327
|
|
01128 P5110-WRITE-MOPO-REC. DTSBD327
|
|
01129 DTSBD327
|
|
01130 IF MOPO-UC223-NO-88 DTSBD327
|
|
01131 GO TO P5110-EXIT. DTSBD327
|
|
01132 DTSBD327
|
|
01133 ADD +1 TO OPO-FORM-CNT. DTSBD327
|
|
01134 DTSBD327
|
|
01135 MOVE LOW-VALUES TO L112-NAME-ADDRESS-AREA. DTSBD327
|
|
01136 SET L112-OPO-ADDR-88 TO TRUE. DTSBD327
|
|
01137 MOVE MOPO-NAME TO L112-NAME. DTSBD327
|
|
01138 MOVE MOPO-TITLE TO L112-TITLE. DTSBD327
|
|
01139 MOVE MOPO-ADDRESS TO L112-ADDRESS. DTSBD327
|
|
01140 DTSBD327
|
|
01141 PERFORM P4111-FORMAT-ADDR THRU P4111-EXIT. DTSBD327
|
|
01142 DTSBD327
|
|
01143 MOVE 'OPO' TO EVL-ADDR-TYPE DTSBD327
|
|
01144 MOVE MOPO-ID-NO TO EVL-ADDR-ID-NO. DTSBD327
|
|
01145 MOVE WRK-EMP-TOT-DUE TO EVL-TOT-BAL-AMT. DTSBD327
|
|
01146 DTSBD327
|
|
01147 PERFORM S1000-WRITE-RECS THRU S1000-EXIT. DTSBD327
|
|
01148 DTSBD327
|
|
01149 MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA. DTSBD327
|
|
01150 PERFORM S910-READ THRU S910-EXIT. DTSBD327
|
|
01151 IF L910-NO-REC-88 DTSBD327
|
|
01152 PERFORM S999-ABEND THRU S999-EXIT. DTSBD327
|
|
01153 DTSBD327
|
|
01154 P5110-EXIT. DTSBD327
|
|
01155 EXIT. DTSBD327
|
|
01156 EJECT DTSBD327
|
|
01157 *************************************************************** DTSBD327
|
|
01158 * THIS PARAGRAPH CAUSES THE MTAA RECORDS TO BE PROCESSED. DTSBD327
|
|
01159 *************************************************************** DTSBD327
|
|
01160 DTSBD327
|
|
01161 P6000-PROCESS-MTAA. DTSBD327
|
|
01162 DTSBD327
|
|
01163 MOVE LOW-VALUES TO MTAA-KEY-AREA. DTSBD327
|
|
01164 MOVE MPRF-EMP-NO TO MTAA-EMP-NO. DTSBD327
|
|
01165 SET MTAA-TAA-88 TO TRUE. DTSBD327
|
|
01166 MOVE MTAA-KEY-AREA TO MSKL-KEY-AREA. DTSBD327
|
|
01167 DTSBD327
|
|
01168 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD327
|
|
01169 DTSBD327
|
|
01170 PERFORM P6100-SCAN-MTAA THRU P6100-EXIT DTSBD327
|
|
01171 UNTIL L910-NO-REC-88. DTSBD327
|
|
01172 DTSBD327
|
|
01173 P6000-EXIT. DTSBD327
|
|
01174 EXIT. DTSBD327
|
|
01175 EJECT DTSBD327
|
|
01176 *************************************************************** DTSBD327
|
|
01177 * THIS PARAGRAPH SCANS THE MTAA RECORDS. DTSBD327
|
|
01178 *************************************************************** DTSBD327
|
|
01179 DTSBD327
|
|
01180 P6100-SCAN-MTAA. DTSBD327
|
|
01181 DTSBD327
|
|
01182 MOVE MSKL-REC TO MTAA-REC. DTSBD327
|
|
01183 DTSBD327
|
|
01184 PERFORM P6110-WRITE-MTAA-REC THRU P6110-EXIT. DTSBD327
|
|
01185 DTSBD327
|
|
01186 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD327
|
|
01187 DTSBD327
|
|
01188 P6100-EXIT. DTSBD327
|
|
01189 EXIT. DTSBD327
|
|
01190 EJECT DTSBD327
|
|
01191 *************************************************************** DTSBD327
|
|
01192 * THIS PARAGRAPH WRITES THE EXTRACT RECORDS FOR MTAA RECORDS. DTSBD327
|
|
01193 *************************************************************** DTSBD327
|
|
01194 DTSBD327
|
|
01195 P6110-WRITE-MTAA-REC. DTSBD327
|
|
01196 DTSBD327
|
|
01197 IF MTAA-UC223-NO-88 DTSBD327
|
|
01198 GO TO P6110-EXIT. DTSBD327
|
|
01199 DTSBD327
|
|
01200 ADD +1 TO TAA-FORM-CNT. DTSBD327
|
|
01201 DTSBD327
|
|
01202 MOVE LOW-VALUES TO L112-NAME-ADDRESS-AREA. DTSBD327
|
|
01203 SET L112-TAA-ADDR-88 TO TRUE. DTSBD327
|
|
01204 IF MTAA-NAME = SPACES DTSBD327
|
|
01205 MOVE MPRF-PRIMARY-NAME TO L112-NAME DTSBD327
|
|
01206 ELSE DTSBD327
|
|
01207 MOVE MTAA-NAME TO L112-NAME. DTSBD327
|
|
01208 MOVE MTAA-ADDRESS TO L112-ADDRESS. DTSBD327
|
|
01209 DTSBD327
|
|
01210 PERFORM P4111-FORMAT-ADDR THRU P4111-EXIT. DTSBD327
|
|
01211 DTSBD327
|
|
01212 MOVE 'TAA' TO EVL-ADDR-TYPE DTSBD327
|
|
01213 MOVE MTAA-ID-NO TO EVL-ADDR-ID-NO. DTSBD327
|
|
01214 MOVE WRK-EMP-TOT-DUE TO EVL-TOT-BAL-AMT. DTSBD327
|
|
01215 DTSBD327
|
|
01216 PERFORM S1000-WRITE-RECS THRU S1000-EXIT. DTSBD327
|
|
01217 DTSBD327
|
|
01218 MOVE MTAA-KEY-AREA TO MSKL-KEY-AREA. DTSBD327
|
|
01219 PERFORM S910-READ THRU S910-EXIT. DTSBD327
|
|
01220 IF L910-NO-REC-88 DTSBD327
|
|
01221 PERFORM S999-ABEND THRU S999-EXIT. DTSBD327
|
|
01222 DTSBD327
|
|
01223 P6110-EXIT. DTSBD327
|
|
01224 EXIT. DTSBD327
|
|
01225 EJECT DTSBD327
|
|
01226 *************************************************************** DTSBD327
|
|
01227 * THIS PARAGRAPH REWRITES THE MCOL RECORD IF THE TEXT WAS DTSBD327
|
|
01228 * ONLY TEMPORARY. DTSBD327
|
|
01229 *************************************************************** DTSBD327
|
|
01230 DTSBD327
|
|
01231 P7000-REWRITE-MCOL. DTSBD327
|
|
01232 DTSBD327
|
|
01233 IF MCOL-STMT-TEXT-PERM-YES-88 DTSBD327
|
|
01234 GO TO P7000-EXIT. DTSBD327
|
|
01235 DTSBD327
|
|
01236 SET MCOL-STMT-TEXT-TYPE-NONE-88 TO TRUE. DTSBD327
|
|
01237 SET MCOL-STMT-TEXT-PERM-NONE-88 TO TRUE. DTSBD327
|
|
01238 MOVE +0 TO MCOL-STMT-TEXT-CNT. DTSBD327
|
|
01239 MOVE LBCM-CURR-RUN-DATE TO MCOL-CHNG-DATE. DTSBD327
|
|
01240 MOVE MCOL-REC TO MSKL-REC. DTSBD327
|
|
01241 DTSBD327
|
|
01242 PERFORM S910-REWRITE THRU S910-EXIT. DTSBD327
|
|
01243 DTSBD327
|
|
01244 P7000-EXIT. DTSBD327
|
|
01245 EXIT. DTSBD327
|
|
01246 EJECT DTSBD327
|
|
01247 *************************************************************** DTSBD327
|
|
01248 * THIS PARAGRAPH WRITES THE R415 REPORT EXTRACT RECORDS. DTSBD327
|
|
01249 * IT ALSO WRITES A MEVL RECORD. DTSBD327
|
|
01250 *************************************************************** DTSBD327
|
|
01251 DTSBD327
|
|
01252 S1000-WRITE-RECS. DTSBD327
|
|
01253 DTSBD327
|
|
01254 MOVE LOW-VALUES TO R415-SORT-AREA. DTSBD327
|
|
01255 MOVE '415' TO R415-REC-TYPE. DTSBD327
|
|
01256 MOVE R415-ZIP TO R415-SORT-ZIP. DTSBD327
|
|
01257 MOVE MPRF-EMP-NO TO R415-EMP-NO. DTSBD327
|
|
01258 MOVE MPRF-FEIN TO R415-EMP-FEIN. DTSBD327
|
|
01259 PERFORM S946-WRITE-R415 THRU S946-EXIT. DTSBD327
|
|
01260 DTSBD327
|
|
01261 MOVE '416' TO R416-REC-TYPE. DTSBD327
|
|
01262 MOVE MPRF-EMP-NO TO R416-EMP-NO. DTSBD327
|
|
01263 MOVE WRK-PARM-INT-COMP-DATE TO R416-COMP-DATE. DTSBD327
|
|
01264 PERFORM S946-WRITE-R416 THRU S946-EXIT. DTSBD327
|
|
01265 DTSBD327
|
|
01266 ADD +1000 TO LBCM-EMP-ABSTIME. DTSBD327
|
|
01267 DTSBD327
|
|
01268 MOVE LBCM-EMP-ABSTIME TO L005-ABSTIME. DTSBD327
|
|
01269 PERFORM S005-FROM-ABSTIME THRU S005-EXIT. DTSBD327
|
|
01270 DTSBD327
|
|
01271 MOVE LOW-VALUES TO MEVL-REC. DTSBD327
|
|
01272 DTSBD327
|
|
01273 MOVE MPRF-EMP-NO TO MEVL-EMP-NO. DTSBD327
|
|
01274 SET MEVL-EVL-88 TO TRUE. DTSBD327
|
|
01275 MOVE L005-DATE TO MEVL-DATE. DTSBD327
|
|
01276 MOVE L005-TIME TO MEVL-TIME. DTSBD327
|
|
01277 MOVE +0 TO MEVL-PURGE-DATE. DTSBD327
|
|
01278 MOVE EVL-TEXT TO MEVL-TEXT. DTSBD327
|
|
01279 *** SET MEVL-SOURCE-SYSTEM-88 TO TRUE. DTSBD327
|
|
01280 MOVE T011-RESP-OP-ID TO MEVL-SOURCE. DTSBD327
|
|
01281 SET MEVL-NOT-CONVERTED-88 TO TRUE. DTSBD327
|
|
01282 MOVE LBCM-CURR-RUN-DATE TO MEVL-ESTB-DATE DTSBD327
|
|
01283 MEVL-CHNG-DATE. DTSBD327
|
|
01284 MOVE MEVL-REC TO MSKL-REC. DTSBD327
|
|
01285 DTSBD327
|
|
01286 PERFORM S910-WRITE THRU S910-EXIT. DTSBD327
|
|
01287 DTSBD327
|
|
01288 S1000-EXIT. DTSBD327
|
|
01289 EXIT. DTSBD327
|
|
01290 EJECT DTSBD327
|
|
01291 *************************************************************** DTSBD327
|
|
01292 * THIS PARAGRAPH INITIALIZES THE TABLE IN THE EXTRACT RECORD. DTSBD327
|
|
01293 *************************************************************** DTSBD327
|
|
01294 DTSBD327
|
|
01295 S2000-INITIALIZE-TABLE. DTSBD327
|
|
01296 DTSBD327
|
|
01297 MOVE LOW-VALUES TO R415-QTR-OCCURS (WRK-SUB). DTSBD327
|
|
01298 DTSBD327
|
|
01299 S2000-EXIT. DTSBD327
|
|
01300 EXIT. DTSBD327
|
|
01301 EJECT DTSBD327
|
|
01302 T0000-TERMINATE. DTSBD327
|
|
01303 DISPLAY ' T0000'. DTSBD327
|
|
01304 DISPLAY SPACE. DTSBD327
|
|
01305 DISPLAY '*** BD414 TERMINATION ***'. DTSBD327
|
|
01306 DISPLAY '*** EMPLOYERS BYPASSED: ' DTSBD327
|
|
01307 DISPLAY '*** CURR QTR ONLY DELINQUENT ' DTSBD327
|
|
01308 WRK-BYPASS-CNT. DTSBD327
|
|
01309 DISPLAY '*** EMPLOYERS WITH ASSESSMENTS ' DTSBD327
|
|
01310 WRK-ASSESS-CNT. DTSBD327
|
|
01311 SKIP2 DTSBD327
|
|
01312 T0000-EXIT. DTSBD327
|
|
01313 EXIT. DTSBD327
|
|
01314 EJECT DTSBD327
|
|
01315 S001-FROM-FED-8. DTSBD327
|
|
01316 SET L001-FROM-FED-8 TO TRUE. DTSBD327
|
|
01317 GO TO S001-DATE. DTSBD327
|
|
01318 SKIP1 DTSBD327
|
|
01319 S001-FROM-ABS-DAY. DTSBD327
|
|
01320 SET L001-FROM-ABS-DAY TO TRUE. DTSBD327
|
|
01321 GO TO S001-DATE. DTSBD327
|
|
01322 SKIP1 DTSBD327
|
|
01323 S001-FROM-CAL-6. DTSBD327
|
|
01324 SET L001-FROM-CAL-6 TO TRUE. DTSBD327
|
|
01325 GO TO S001-DATE. DTSBD327
|
|
01326 SKIP1 DTSBD327
|
|
01327 S001-DATE. DTSBD327
|
|
01328 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBD327
|
|
01329 S001-EXIT. DTSBD327
|
|
01330 EXIT. DTSBD327
|
|
01331 SKIP3 DTSBD327
|
|
01332 S004-FROM-5. DTSBD327
|
|
01333 SET L004-FROM-5 TO TRUE. DTSBD327
|
|
01334 GO TO S004-QTR. DTSBD327
|
|
01335 SKIP1 DTSBD327
|
|
01336 S004-FROM-ABS. DTSBD327
|
|
01337 SET L004-FROM-ABS TO TRUE. DTSBD327
|
|
01338 GO TO S004-QTR. DTSBD327
|
|
01339 SKIP1 DTSBD327
|
|
01340 S004-QTR. DTSBD327
|
|
01341 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBD327
|
|
01342 S004-EXIT. DTSBD327
|
|
01343 EXIT. DTSBD327
|
|
01344 SKIP3 DTSBD327
|
|
01345 S005-FROM-ABSTIME. DTSBD327
|
|
01346 SET L005-FROM-ABSTIME TO TRUE. DTSBD327
|
|
01347 GO TO S005-ABSTIME. DTSBD327
|
|
01348 SKIP1 DTSBD327
|
|
01349 S005-ABSTIME. DTSBD327
|
|
01350 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBD327
|
|
01351 S005-EXIT. DTSBD327
|
|
01352 EXIT. DTSBD327
|
|
01353 SKIP3 DTSBD327
|
|
01354 S082-LOOKUP-OP-ID. DTSBD327
|
|
01355 CALL 'DTSBU082' USING L082-LINK-AREA. DTSBD327
|
|
01356 S082-EXIT. DTSBD327
|
|
01357 EXIT. DTSBD327
|
|
01358 SKIP3 DTSBD327
|
|
01359 S101-PER-MONTH-NO. DTSBD327
|
|
01360 SET L101-PER-MONTH-NO-88 TO TRUE. DTSBD327
|
|
01361 GO TO S101-INT-CHARGE. DTSBD327
|
|
01362 DTSBD327
|
|
01363 S101-INT-CHARGE. DTSBD327
|
|
01364 CALL 'DTSBU101' USING L101-LINK-AREA. DTSBD327
|
|
01365 S101-EXIT. DTSBD327
|
|
01366 EXIT. DTSBD327
|
|
01367 SKIP3 DTSBD327
|
|
01368 S109-FIRST-PEN-INT-YRQ. DTSBD327
|
|
01369 SET L109-CMND-PEN-INT-QTR-88 TO TRUE. DTSBD327
|
|
01370 GO TO S109-SUR-RATE. DTSBD327
|
|
01371 DTSBD327
|
|
01372 S109-SUR-RATE. DTSBD327
|
|
01373 CALL 'DTSBU109' USING L109-LINK-AREA. DTSBD327
|
|
01374 S109-EXIT. DTSBD327
|
|
01375 EXIT. DTSBD327
|
|
01376 SKIP3 DTSBD327
|
|
01377 S111-LOOKUP-ADDR. DTSBD327
|
|
01378 CALL 'DTSBU111' USING L111-LINK-AREA. DTSBD327
|
|
01379 S111-EXIT. DTSBD327
|
|
01380 EXIT. DTSBD327
|
|
01381 SKIP3 DTSBD327
|
|
01382 S112-FORMAT-ADDR. DTSBD327
|
|
01383 CALL 'DTSBU112' USING L112-LINK-AREA. DTSBD327
|
|
01384 S112-EXIT. DTSBD327
|
|
01385 EXIT. DTSBD327
|
|
01386 SKIP3 DTSBD327
|
|
01387 S410-FILE-SCHED. DTSBD327
|
|
01388 CALL 'DTSBU410' USING L410-LINK-AREA. DTSBD327
|
|
01389 S410-EXIT. DTSBD327
|
|
01390 EXIT. DTSBD327
|
|
01391 SKIP3 DTSBD327
|
|
01392 S910-READ. DTSBD327
|
|
01393 SET L910-READ-88 TO TRUE. DTSBD327
|
|
01394 GO TO S910-MSTR-IO. DTSBD327
|
|
01395 SKIP1 DTSBD327
|
|
01396 S910-START-BROWSE. DTSBD327
|
|
01397 SET L910-START-BROWSE-88 TO TRUE. DTSBD327
|
|
01398 GO TO S910-MSTR-IO. DTSBD327
|
|
01399 SKIP1 DTSBD327
|
|
01400 S910-READ-NEXT. DTSBD327
|
|
01401 SET L910-READ-NEXT-88 TO TRUE. DTSBD327
|
|
01402 GO TO S910-MSTR-IO. DTSBD327
|
|
01403 SKIP1 DTSBD327
|
|
01404 S910-COUNT. DTSBD327
|
|
01405 SET L910-COUNT-88 TO TRUE. DTSBD327
|
|
01406 GO TO S910-MSTR-IO. DTSBD327
|
|
01407 SKIP1 DTSBD327
|
|
01408 S910-WRITE. DTSBD327
|
|
01409 SET L910-WRITE-88 TO TRUE. DTSBD327
|
|
01410 GO TO S910-MSTR-IO. DTSBD327
|
|
01411 SKIP1 DTSBD327
|
|
01412 S910-REWRITE. DTSBD327
|
|
01413 SET L910-REWRITE-88 TO TRUE. DTSBD327
|
|
01414 GO TO S910-MSTR-IO. DTSBD327
|
|
01415 SKIP1 DTSBD327
|
|
01416 S910-DELETE. DTSBD327
|
|
01417 SET L910-DELETE-88 TO TRUE. DTSBD327
|
|
01418 GO TO S910-MSTR-IO. DTSBD327
|
|
01419 SKIP1 DTSBD327
|
|
01420 S910-MSTR-IO. DTSBD327
|
|
01421 CALL 'DTSBU910' USING L910-LINK-AREA DTSBD327
|
|
01422 MSKL-REC. DTSBD327
|
|
01423 S910-EXIT. DTSBD327
|
|
01424 EXIT. DTSBD327
|
|
01425 SKIP3 DTSBD327
|
|
01426 S946-WRITE-R415. DTSBD327
|
|
01427 CALL 'DTSBU946' USING R415-REC. DTSBD327
|
|
01428 GO TO S946-EXIT. DTSBD327
|
|
01429 SKIP1 DTSBD327
|
|
01430 S946-WRITE-R416. DTSBD327
|
|
01431 CALL 'DTSBU946' USING R416-REC. DTSBD327
|
|
01432 GO TO S946-EXIT. DTSBD327
|
|
01433 SKIP1 DTSBD327
|
|
01434 S946-WRITE-R907. DTSBD327
|
|
01435 MOVE '907' TO R907-REC-TYPE. DTSBD327
|
|
01436 CALL 'DTSBU946' USING R907-REC. DTSBD327
|
|
01437 GO TO S946-EXIT. DTSBD327
|
|
01438 SKIP1 DTSBD327
|
|
01439 S946-EXIT. DTSBD327
|
|
01440 EXIT. DTSBD327
|
|
01441 SKIP3 DTSBD327
|
|
01442 S999-ABEND. DTSBD327
|
|
01443 DISPLAY '*** DTSBD327 ABENDING. ' DTSBD327
|
|
01444 ABEND-MSG. DTSBD327
|
|
01445 SKIP1 DTSBD327
|
|
01446 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBD327
|
|
01447 S999-EXIT. DTSBD327
|
|
01448 EXIT. DTSBD327
|