00001 IDENTIFICATION DIVISION. 05/03/07 00002 PROGRAM-ID. DTSBE335. DTSBE335 00003 AUTHOR. NGC. LV015 00004 DATE-WRITTEN. OCTOBER 2004. DTSBE335 00005 DATE-COMPILED. DTSBE335 00006 SKIP3 DTSBE335 00007 ***** DTSBE335 00008 * DTSBE335 00009 * FUNCTION: EXTRACT CREDIT/DEBIT DATA FOR WEB CREDIT/DEBIT DTSBE335 00010 * APPLICATION. DTSBE335 00011 * DTSBE335 00012 * MODIFICATION LOG: DTSBE335 00013 * DTSBE335 00014 * 10/28/2004 INITIAL DEVELOPMENT. DTSBE335 00015 * REFERENCE: PROGRAMMER: GD DTSBE335 00016 * DTSBE335 00017 * 12/05/2005 CORRECTED ADDRESS SELECTION IN P0400. DTSBE335 00018 * REFERENCE: PROGRAMMER: GD DTSBE335 00019 * DTSBE335 00020 * 12/15/2005 CORRECTED HANDLING OF STARTING BALANCE RECORDS. DTSBE335 00021 * WRK-EMP-START-YRQ NEEDS TO BE USED IN P3200. DTSBE335 00022 * REFERENCE: PROGRAMMER: GD DTSBE335 00023 * DTSBE335 00024 * 12/23/2005 MODIFIED P3000 TO INCLUDE ALL QUARTERS WHERE DTSBE335 00025 * THE REPORT IS MISSING, EVEN IF EARLIER THAN DTSBE335 00026 * THE START QUARTER. DTSBE335 00027 * REFERENCE: PROGRAMMER: GD DTSBE335 00028 * DTSBE335 00029 * 03/08/2006 MODIFIED P0000 TO INCLUDE INACTIVE EMPLOYERS DTSBE335 00030 * IF THERE IS ANY ACCOUNTING ACTIVITY SINCE DTSBE335 00031 * THE START DATE. DTSBE335 00032 * REFERENCE: PROGRAMMER: GD DTSBE335 00033 * DTSBE335 00034 * 04/06/2006 MODIFIED P3000 TO CALCULATE TOTAL BALANCE DUE DTSBE335 00035 * FOR EACH QUARTER. DTSBE335 00036 * REFERENCE: PROGRAMMER: GD DTSBE335 00037 * DTSBE335 00038 * 02/23/2007 EXPANDED DISPLAY NUMERIC FIELDS TO AVOID DTSBE335 00039 * TRUNCATION WHERE NUMBER OF DIGITS PLUS THE DTSBE335 00040 * SIGN MIGHT EXCEED THE LENGTH OF THE FIELD. DTSBE335 00041 * REFERENCE: PROGRAMMER: GD DTSBE335 00042 * DTSBE335 00043 * 04/24/2007 CORRECTED TRANSACTION RECORDS FOR ANNUAL DTSBE335 00044 * REPORTS - PROCESSED DATE WAS MISSING. DTSBE335 00045 * CHANGED SELECTION OF INACTIVE EMPLOYERS - DTSBE335 00046 * SELECT IF LAST LIABLE QUARTER IS WITHIN THE DTSBE335 00047 * LAST 13 QUARTERS. DTSBE335 00048 * REFERENCE: PROGRAMMER: GD DTSBE335 00049 * DTSBE335 00050 * 05/03/2007 MODIFIED P2120, P2121 TO HANDLE AMENDED DTSBE335 00051 * ANNUAL REPORTS CORRECTLY. WITHIN EACH YEAR DTSBE335 00052 * WAGES ARE SUMMED FOR THE 4 QUARTERS COVERED DTSBE335 00053 * BY THE REPORT, PRODUCING A SINGLE OUTPUT DTSBE335 00054 * RECORD FOR EACH ANNUAL REPORT. DTSBE335 00055 * REFERENCE: PROGRAMMER: GD DTSBE335 00056 * DTSBE335 00057 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE335 00058 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE335 00059 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBE335 00060 * DTSBE335 00061 * DTSBE335 00062 * DESCRIPTION: DTSBE335 00063 * DTSBE335 00064 * DTSBE335 00065 * INITIATION: DTSBE335 00066 * DTSBE335 00067 * SET LECM-MST-OPEN-READ-88 TO TRUE. DTSBE335 00068 * SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBE335 00069 * DTSBE335 00070 * EDIT AND DEFAULT PARAMETERS. DTSBE335 00071 * DTSBE335 00072 * DTSBE335 00073 * PROCESSING: DTSBE335 00074 * DTSBE335 00075 * DTSBE335 00076 * TERMINATION: DTSBE335 00077 * DTSBE335 00078 * DTSBE335 00079 * DTSBE335 00080 * RECORDS READ: DTSBE335 00081 * DTSBE335 00082 * MASTER: DTSBE335 00083 * DTSBE335 00084 * MSOL DTSBE335 00085 * MQTR DTSBE335 00086 * DTSBE335 00087 * DTSBE335 00088 * ALTERNATE INDEX: DTSBE335 00089 * DTSBE335 00090 * NONE. DTSBE335 00091 * DTSBE335 00092 * DTSBE335 00093 * REFERENCE: DTSBE335 00094 * DTSBE335 00095 * DTSBE335 00096 * DTSBE335 00097 * RECORDS UPDATED: DTSBE335 00098 * DTSBE335 00099 * NONE DTSBE335 00100 * DTSBE335 00101 * DTSBE335 00102 * OUTPUT RECORDS WRITTEN: DTSBE335 00103 * DTSBE335 00104 * DTSBX331 DTSBE335 00105 * DTSBE335 00106 * DTSBE335 00107 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBE335 00108 * DTSBE335 00109 * NONE. DTSBE335 00110 * DTSBE335 00111 * DTSBE335 00112 * MODULES CALLED: DTSBE335 00113 * DTSBE335 00114 * DTSBU001 DATE EDIT/CONVERSION. DTSBE335 00115 * DTSBU004 QUARTER EDIT/CONVERSION. DTSBE335 00116 * DTSBU910 MASTER FILE I/O. DTSBE335 00117 * DTSBE335 00118 * DTSBE335 00119 * DTSBE335 00120 ***** DTSBE335 00121 SKIP3 DTSBE335 00122 ENVIRONMENT DIVISION. DTSBE335 00123 INPUT-OUTPUT SECTION. DTSBE335 00124 FILE-CONTROL. DTSBE335 00125 SELECT PARM-FILE ASSIGN TO DTSFPARM DTSBE335 00126 FILE STATUS IS PARM-STATUS. DTSBE335 00127 DTSBE335 00128 SELECT PROFILE-FILE ASSIGN TO DTSFPRF DTSBE335 00129 FILE STATUS IS PROFILE-STATUS. DTSBE335 00130 DTSBE335 00131 SELECT DETERM-FILE ASSIGN TO DTSFDET DTSBE335 00132 FILE STATUS IS DETERM-STATUS. DTSBE335 00133 DTSBE335 00134 SELECT FSCHED-FILE ASSIGN TO DTSFFSC DTSBE335 00135 FILE STATUS IS FSC-STATUS. DTSBE335 00136 DTSBE335 00137 SELECT ADDRESS-FILE ASSIGN TO DTSFADR DTSBE335 00138 FILE STATUS IS ADR-STATUS. DTSBE335 00139 DTSBE335 00140 SELECT ACCT-FILE ASSIGN TO DTSFACCT DTSBE335 00141 FILE STATUS IS ACCT-STATUS. DTSBE335 00142 DTSBE335 00143 SELECT TRAN-FILE ASSIGN TO DTSFTRAN DTSBE335 00144 FILE STATUS IS TRAN-STATUS. DTSBE335 00145 DTSBE335 00146 SELECT QTR-FILE ASSIGN TO DTSFQTR DTSBE335 00147 FILE STATUS IS QTR-STATUS. DTSBE335 00148 DTSBE335 00149 SELECT RATE-FILE ASSIGN TO DTSFRATE DTSBE335 00150 FILE STATUS IS RATE-STATUS. DTSBE335 00151 DTSBE335 00152 SELECT QTR-COLL-FILE ASSIGN TO DTSFQCOL DTSBE335 00153 FILE STATUS IS QCOLL-STATUS. DTSBE335 00154 DTSBE335 00155 SELECT SUMMARY-FILE ASSIGN TO DTSFSUM DTSBE335 00156 FILE STATUS IS SUMMARY-STATUS. DTSBE335 00157 DTSBE335 00158 DATA DIVISION. DTSBE335 00159 FILE SECTION. DTSBE335 00160 FD PARM-FILE DTSBE335 00161 RECORDING MODE IS F DTSBE335 00162 LABEL RECORDS ARE STANDARD DTSBE335 00163 BLOCK CONTAINS 0 CHARACTERS. DTSBE335 00164 DTSBE335 00165 01 PARM-REC. DTSBE335 00166 05 PARM-START-YRQ PIC S9(05) COMP-3. DTSBE335 00167 05 PARM-SUBJECT-YRQ PIC S9(05) COMP-3. DTSBE335 00168 05 PARM-PRIOR-RUN-DT PIC S9(09) COMP-3. DTSBE335 00169 05 FILLER PIC X(05). DTSBE335 00170 DTSBE335 00171 FD PROFILE-FILE DTSBE335 00172 RECORDING MODE IS F DTSBE335 00173 LABEL RECORDS ARE STANDARD DTSBE335 00174 BLOCK CONTAINS 0 CHARACTERS. DTSBE335 00175 DTSBE335 00176 01 PROFILE-REC PIC X(72). DTSBE335 00177 DTSBE335 00178 FD DETERM-FILE DTSBE335 00179 RECORDING MODE IS F DTSBE335 00180 LABEL RECORDS ARE STANDARD DTSBE335 00181 BLOCK CONTAINS 0 CHARACTERS. DTSBE335 00182 DTSBE335 00183 01 DETERM-REC PIC X(59). DTSBE335 00184 DTSBE335 00185 FD FSCHED-FILE DTSBE335 00186 RECORDING MODE IS F DTSBE335 00187 LABEL RECORDS ARE STANDARD DTSBE335 00188 BLOCK CONTAINS 0 CHARACTERS. DTSBE335 00189 DTSBE335 00190 01 FSCHED-REC PIC X(22). DTSBE335 00191 DTSBE335 00192 FD ADDRESS-FILE DTSBE335 00193 RECORDING MODE IS F DTSBE335 00194 LABEL RECORDS ARE STANDARD DTSBE335 00195 BLOCK CONTAINS 0 CHARACTERS. DTSBE335 00196 DTSBE335 00197 01 ADDRESS-REC PIC X(249). DTSBE335 00198 DTSBE335 00199 FD ACCT-FILE DTSBE335 00200 RECORDING MODE IS F DTSBE335 00201 LABEL RECORDS ARE STANDARD DTSBE335 00202 BLOCK CONTAINS 0 CHARACTERS. DTSBE335 00203 DTSBE335 00204 01 ACCT-REC PIC X(61). DTSBE335 00205 DTSBE335 00206 FD TRAN-FILE DTSBE335 00207 RECORDING MODE IS F DTSBE335 00208 LABEL RECORDS ARE STANDARD DTSBE335 00209 BLOCK CONTAINS 0 CHARACTERS. DTSBE335 00210 DTSBE335 00211 01 TRAN-REC PIC X(128). DTSBE335 00212 DTSBE335 00213 FD QTR-FILE DTSBE335 00214 RECORDING MODE IS F DTSBE335 00215 LABEL RECORDS ARE STANDARD DTSBE335 00216 BLOCK CONTAINS 0 CHARACTERS. DTSBE335 00217 DTSBE335 00218 01 QTR-REC PIC X(41). DTSBE335 00219 DTSBE335 00220 FD RATE-FILE DTSBE335 00221 RECORDING MODE IS F DTSBE335 00222 LABEL RECORDS ARE STANDARD DTSBE335 00223 BLOCK CONTAINS 0 CHARACTERS. DTSBE335 00224 DTSBE335 00225 01 RATE-REC PIC X(29). DTSBE335 00226 DTSBE335 00227 FD QTR-COLL-FILE DTSBE335 00228 RECORDING MODE IS F DTSBE335 00229 LABEL RECORDS ARE STANDARD DTSBE335 00230 BLOCK CONTAINS 0 CHARACTERS. DTSBE335 00231 DTSBE335 00232 01 QTR-COLL-REC PIC X(35). DTSBE335 00233 DTSBE335 00234 FD SUMMARY-FILE DTSBE335 00235 RECORDING MODE IS F. DTSBE335 00236 01 SUMMARY-REC PIC X(73). DTSBE335 00237 DTSBE335 00238 WORKING-STORAGE SECTION. DTSBE335 002385 77 PAN-VALET PICTURE X(24) VALUE '015DTSBE335 05/03/07'. DTSBE335 00239 SKIP3 DTSBE335 00240 01 WRK-AREA. DTSBE335 00241 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +331.DTSBE335 00242 DTSBE335 00243 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBE331'.DTSBE335 00244 DTSBE335 00245 05 ABEND-MSG PIC X(60). DTSBE335 00246 DTSBE335 00247 05 PARM-STATUS PIC X(02). DTSBE335 00248 88 PARM-STATUS-OK-88 VALUE '00'. DTSBE335 00249 05 PROFILE-STATUS PIC X(02). DTSBE335 00250 88 PROFILE-STATUS-OK-88 VALUE '00'. DTSBE335 00251 05 DETERM-STATUS PIC X(02). DTSBE335 00252 88 DETERM-STATUS-OK-88 VALUE '00'. DTSBE335 00253 05 FSC-STATUS PIC X(02). DTSBE335 00254 88 FSC-STATUS-OK-88 VALUE '00'. DTSBE335 00255 05 ADR-STATUS PIC X(02). DTSBE335 00256 88 ADR-STATUS-OK-88 VALUE '00'. DTSBE335 00257 05 ACCT-STATUS PIC X(02). DTSBE335 00258 88 ACCT-STATUS-OK-88 VALUE '00'. DTSBE335 00259 05 TRAN-STATUS PIC X(02). DTSBE335 00260 88 TRAN-STATUS-OK-88 VALUE '00'. DTSBE335 00261 05 QTR-STATUS PIC X(02). DTSBE335 00262 88 QTR-STATUS-OK-88 VALUE '00'. DTSBE335 00263 05 RATE-STATUS PIC X(02). DTSBE335 00264 88 RATE-STATUS-OK-88 VALUE '00'. DTSBE335 00265 05 QCOLL-STATUS PIC X(02). DTSBE335 00266 88 QCOLL-STATUS-OK-88 VALUE '00'. DTSBE335 00267 05 SUMMARY-STATUS PIC X(02). DTSBE335 00268 88 SUMMARY-STATUS-OK-88 VALUE '00'. DTSBE335 00269 DTSBE335 00270 05 EMP-STATUS PIC X(02). DTSBE335 00271 88 EMP-STATUS-OK-88 VALUE '00'. DTSBE335 00272 DTSBE335 00273 05 WRK-RPT-COMPLETE-IND PIC X(01). DTSBE335 00274 88 WRK-RPT-COMPLETE-YES-88 VALUE 'Y'. DTSBE335 00275 88 WRK-RPT-COMPLETE-NO-88 VALUE 'N'. DTSBE335 00276 88 WRK-RPT-COMPLETE-NULL-88 VALUE ' '. DTSBE335 00277 DTSBE335 00278 05 WRK-SUBJECT-DATE PIC S9(09) COMP-3 VALUE +0. DTSBE335 00279 05 WRK-PRIOR-RUN-DT PIC S9(09) COMP-3 VALUE +0. DTSBE335 00280 05 WRK-ABSTIME PIC S9(15) COMP-3 VALUE +0. DTSBE335 00281 05 WRK-START-YRQ PIC S9(05) COMP-3. DTSBE335 00282 05 WRK-ANN-START-YRQ PIC S9(05) COMP-3. DTSBE335 00283 05 WRK-EMP-START-YRQ PIC S9(05) COMP-3. DTSBE335 00284 05 WRK-SUBJECT-YRQ PIC S9(05) COMP-3. DTSBE335 00285 05 WRK-DEFAULT-DATE PIC X(10) DTSBE335 00286 VALUE '01/01/1994'. DTSBE335 00287 05 ALL-NINES-DT PIC S9(09) COMP-3 DTSBE335 00288 VALUE +999999999. DTSBE335 00289 05 ALL-NINES-DT-DISP PIC X(10) VALUE '12/31/9999'. DTSBE335 00290 05 ALL-NINES-QTR PIC S9(05) COMP-3 DTSBE335 00291 VALUE +99999. DTSBE335 00292 05 ALL-NINES-QTR-DISP PIC X(06) VALUE '9999/9'. DTSBE335 00293 DTSBE335 00294 05 WRK-MPRF-CNT PIC S9(07) COMP-3 VALUE +0. DTSBE335 00295 05 WRK-MJRN-READ-CNT PIC S9(07) COMP-3 VALUE +0. DTSBE335 00296 05 WRK-INACT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBE335 00297 05 WRK-BATCH PIC S9(05) COMP-3 VALUE +0. DTSBE335 00298 05 WRK-ITEM PIC S9(03) COMP-3 VALUE +0. DTSBE335 00299 05 WRK-UI-BAL PIC S9(09)V99 COMP-3. DTSBE335 00300 05 WRK-SU-BAL PIC S9(09)V99 COMP-3. DTSBE335 00301 05 WRK-LP-BAL PIC S9(09)V99 COMP-3. DTSBE335 00302 05 WRK-NP-BAL PIC S9(09)V99 COMP-3. DTSBE335 00303 05 WRK-MP-BAL PIC S9(09)V99 COMP-3. DTSBE335 00304 05 WRK-CR-BAL PIC S9(09)V99 COMP-3. DTSBE335 00305 05 WRK-INT-BAL PIC S9(09)V99 COMP-3. DTSBE335 00306 05 WRK-QTR-BAL PIC S9(11)V99 COMP-3. DTSBE335 00307 05 WRK-RATE PIC S99V9 COMP-3. DTSBE335 00308 05 WRK-LAST-LIAB-YRQ PIC S9(05) COMP-3 VALUE +0. DTSBE335 00309 05 WRK-YRQ-MINUS-13 PIC S9(05) COMP-3 VALUE +0. DTSBE335 00310 05 WRK-EMP-NO PIC S9(07) COMP-3 VALUE +0. DTSBE335 00311 DTSBE335 00312 05 ASUB PIC S9(04) COMP. DTSBE335 00313 05 ASUB1 PIC S9(04) COMP. DTSBE335 00314 05 ASUB-MAX PIC S9(04) COMP VALUE +50. DTSBE335 00315 05 ASUB-LAST PIC S9(04) COMP VALUE +0. DTSBE335 00316 05 ANN-RPT-TABLE OCCURS 50 TIMES. DTSBE335 00317 10 WRK-ANN-RPT-TYPE PIC X(02). DTSBE335 00318 10 WRK-ANN-YRQ PIC 9(05). DTSBE335 00319 10 FILLER REDEFINES WRK-ANN-YRQ. DTSBE335 00320 15 WRK-ANN-YRQ-CCYY PIC 9(04). DTSBE335 00321 15 WRK-ANN-YRQ-Q PIC 9(01). DTSBE335 00322 10 WRK-ANN-BATCH PIC S9(05) COMP-3. DTSBE335 00323 10 WRK-ANN-ITEM PIC S9(03) COMP-3. DTSBE335 00324 10 WRK-ANN-RATE PIC S9(01)V9999 COMP-3. DTSBE335 00325 10 WRK-ANN-REMIT PIC S9(09)V99 COMP-3. DTSBE335 00326 10 WRK-ANN-TOT-WAGE PIC S9(09)V99 COMP-3. DTSBE335 00327 10 WRK-ANN-TAX-WAGE PIC S9(09)V99 COMP-3. DTSBE335 00328 10 WRK-ANN-EXCESS-WAGE PIC S9(09)V99 COMP-3. DTSBE335 00329 10 WRK-ANN-RCVD-DT PIC S9(09) COMP-3. DTSBE335 00330 10 WRK-ANN-PROCESS-DT PIC S9(09) COMP-3. DTSBE335 00331 DTSBE335 00332 05 WRK-LAST-ANN-YRQ PIC S9(05) COMP-3. DTSBE335 00333 05 WRK-CREDIT-BAL PIC S9(09)V99 COMP-3. DTSBE335 00334 05 WRK-AMT PIC S9(09)V99 COMP-3. DTSBE335 00335 DTSBE335 00336 05 WRK-ADDRESS. DTSBE335 00337 10 WRK-ATTN-LINE PIC X(40). DTSBE335 00338 10 WRK-DELIV-LINE-1 PIC X(40). DTSBE335 00339 10 WRK-DELIV-LINE-2 PIC X(40). DTSBE335 00340 10 WRK-CITY PIC X(25). DTSBE335 00341 10 WRK-ST PIC X(02). DTSBE335 00342 10 WRK-ZIP PIC X(10). DTSBE335 00343 10 WRK-ADVANCED-BARCODE PIC X(14). DTSBE335 00344 DTSBE335 00345 05 WRK-PHONE PIC X(15). DTSBE335 00346 05 WRK-FAX PIC X(15). DTSBE335 00347 05 WRK-EMAIL PIC X(40). DTSBE335 00348 DTSBE335 00349 05 WRK-ACCT-CNT PIC S9(07) COMP-3 DTSBE335 00350 VALUE +0. DTSBE335 00351 05 WRK-TRAN-CNT PIC S9(07) COMP-3 DTSBE335 00352 VALUE +0. DTSBE335 00353 05 WRK-QTR-CNT PIC S9(07) COMP-3 DTSBE335 00354 VALUE +0. DTSBE335 00355 05 WRK-RATE-CNT PIC S9(07) COMP-3 DTSBE335 00356 VALUE +0. DTSBE335 00357 05 WRK-QCOLL-CNT PIC S9(07) COMP-3 DTSBE335 00358 VALUE +0. DTSBE335 00359 05 WRK-PRF-CNT PIC S9(07) COMP-3 DTSBE335 00360 VALUE +0. DTSBE335 00361 05 WRK-DET-CNT PIC S9(07) COMP-3 DTSBE335 00362 VALUE +0. DTSBE335 00363 05 WRK-FSC-CNT PIC S9(07) COMP-3 DTSBE335 00364 VALUE +0. DTSBE335 00365 05 X110-CNT PIC S9(07) COMP-3 DTSBE335 00366 VALUE +0. DTSBE335 00367 05 WRK-SUMMARY-CNT PIC S9(07) COMP-3 DTSBE335 00368 VALUE +0. DTSBE335 00369 DTSBE335 00370 05 WRK-QTR-3-AREA. DTSBE335 00371 10 WRK-QTR-3-YY PIC X(02). DTSBE335 00372 10 FILLER PIC X(01). DTSBE335 00373 10 WRK-QTR-3-Q PIC X(01). DTSBE335 00374 DTSBE335 00375 05 WRK-DISP-EMP PIC S9(07) COMP-3 DTSBE335 00376 VALUE +010169. DTSBE335 00377 DTSBE335 00378 05 WRK-PRF-REC. DTSBE335 00379 10 PRF-EMP-NO PIC 9(06). DTSBE335 00380 10 FILLER PIC X(01) VALUE ','. DTSBE335 00381 10 PRF-EMP-CLASS PIC X(01). DTSBE335 00382 10 FILLER PIC X(01) VALUE ','. DTSBE335 00383 10 PRF-EMP-NAME PIC X(40). DTSBE335 00384 10 FILLER PIC X(01) VALUE ','. DTSBE335 00385 10 PRF-FEIN PIC 9(09). DTSBE335 00386 10 FILLER PIC X(01) VALUE ','. DTSBE335 00387 10 PRF-EMP-STATUS PIC X(01). DTSBE335 00388 10 FILLER PIC X(01) VALUE ','. DTSBE335 00389 10 PRF-PROCESS-DT PIC X(10). DTSBE335 00390 DTSBE335 00391 05 WRK-DET-REC. DTSBE335 00392 10 DET-EMP-NO PIC 9(06). DTSBE335 00393 10 FILLER PIC X(01) VALUE ','. DTSBE335 00394 10 DET-LIABLE-START-DT PIC X(10). DTSBE335 00395 10 FILLER PIC X(01) VALUE ','. DTSBE335 00396 10 DET-LIABLE-START-QTR PIC X(06). DTSBE335 00397 10 FILLER PIC X(01) VALUE ','. DTSBE335 00398 10 DET-LIABLE-END-DT PIC X(10). DTSBE335 00399 10 FILLER PIC X(01) VALUE ','. DTSBE335 00400 10 DET-LIABLE-END-QTR PIC X(06). DTSBE335 00401 10 FILLER PIC X(01) VALUE ','. DTSBE335 00402 10 DET-LIABLE-CD PIC X(02). DTSBE335 00403 10 FILLER PIC X(01) VALUE ','. DTSBE335 00404 10 DET-INACTIVE-CD PIC X(02). DTSBE335 00405 10 FILLER PIC X(01) VALUE ','. DTSBE335 00406 10 DET-PROCESS-DT PIC X(10). DTSBE335 00407 DTSBE335 00408 05 WRK-FSC-REC. DTSBE335 00409 10 FSC-EMP-NO PIC 9(06). DTSBE335 00410 10 FILLER PIC X(01) VALUE ','. DTSBE335 00411 10 FSC-SCHEDULE PIC X(01). DTSBE335 00412 10 FILLER PIC X(01) VALUE ','. DTSBE335 00413 10 FSC-START-QTR PIC X(06). DTSBE335 00414 10 FILLER PIC X(01) VALUE ','. DTSBE335 00415 10 FSC-END-QTR PIC X(06). DTSBE335 00416 DTSBE335 00417 05 WRK-ADDRESS-REC. DTSBE335 00418 ++INCLUDE DTSIX110 DTSBE335 00419 DTSBE335 00420 05 WRK-ACCT-REC. DTSBE335 00421 10 ACCT-YRQ PIC X(06). DTSBE335 00422 10 FILLER PIC X(01) VALUE ','. DTSBE335 00423 10 ACCT-BATCH PIC 9(05). DTSBE335 00424 10 FILLER PIC X(01) VALUE ','. DTSBE335 00425 10 ACCT-ITEM PIC 9(03). DTSBE335 00426 10 FILLER PIC X(01) VALUE ','. DTSBE335 00427 10 ACCT-EMP-NO PIC 9(06). DTSBE335 00428 10 FILLER PIC X(01) VALUE ','. DTSBE335 00429 10 ACCT-TRAN PIC X(02). DTSBE335 00430 10 FILLER PIC X(01) VALUE ','. DTSBE335 00431 10 ACCT-ROW PIC X(02). DTSBE335 00432 10 FILLER PIC X(01) VALUE ','. DTSBE335 00433 10 ACCT-COL PIC X(02). DTSBE335 00434 10 FILLER PIC X(01) VALUE ','. DTSBE335 00435 10 ACCT-AMT PIC ---------9.99. DTSBE335 00436 10 FILLER PIC X(01) VALUE ','. DTSBE335 00437 10 ACCT-CAT PIC X(01). DTSBE335 00438 10 FILLER PIC X(01) VALUE ','. DTSBE335 00439 10 ACCT-PROCESS-DT PIC X(10). DTSBE335 00440 10 FILLER PIC X(01) VALUE ','. DTSBE335 00441 10 ACCT-SOURCE PIC X(01). DTSBE335 00442 88 ACCT-SOURCE-CR-DB-88 VALUE '1'. DTSBE335 00443 88 ACCT-SOURCE-STATUS-88 VALUE '2'. DTSBE335 00444 88 ACCT-SOURCE-ERROR-88 VALUE '3'. DTSBE335 00445 DTSBE335 00446 05 WRK-TRAN-REC. DTSBE335 00447 10 TRAN-BATCH PIC 9(05). DTSBE335 00448 10 FILLER PIC X(01) VALUE ','. DTSBE335 00449 10 TRAN-ITEM PIC 9(03). DTSBE335 00450 10 FILLER PIC X(01) VALUE ','. DTSBE335 00451 10 TRAN-TRANS PIC X(02). DTSBE335 00452 10 FILLER PIC X(01) VALUE ','. DTSBE335 00453 10 TRAN-EMP-NO PIC 9(06). DTSBE335 00454 10 FILLER PIC X(01) VALUE ','. DTSBE335 00455 10 TRAN-YRQ PIC X(06). DTSBE335 00456 10 FILLER PIC X(01) VALUE ','. DTSBE335 00457 10 TRAN-AMT PIC --------9.99. DTSBE335 00458 10 FILLER PIC X(01) VALUE ','. DTSBE335 00459 10 TRAN-TOT-WAGE PIC ----------9.99. DTSBE335 00460 10 TRAN-TOT-WAGE-X REDEFINES TRAN-TOT-WAGE DTSBE335 00461 PIC X(14). DTSBE335 00462 10 FILLER PIC X(01) VALUE ','. DTSBE335 00463 10 TRAN-TAX-WAGE PIC ----------9.99. DTSBE335 00464 10 TRAN-TAX-WAGE-X REDEFINES TRAN-TAX-WAGE DTSBE335 00465 PIC X(14). DTSBE335 00466 10 FILLER PIC X(01) VALUE ','. DTSBE335 00467 10 TRAN-EXC-WAGE PIC ----------9.99. DTSBE335 00468 10 TRAN-EXC-WAGE-X REDEFINES TRAN-EXC-WAGE DTSBE335 00469 PIC X(14). DTSBE335 00470 10 FILLER PIC X(01) VALUE ','. DTSBE335 00471 10 TRAN-RATE PIC Z9.9. DTSBE335 00472 10 TRAN-RATE-X REDEFINES TRAN-RATE DTSBE335 00473 PIC X(04). DTSBE335 00474 10 FILLER PIC X(01) VALUE ','. DTSBE335 00475 10 TRAN-ACCT PIC X(02). DTSBE335 00476 10 FILLER PIC X(01) VALUE ','. DTSBE335 00477 10 TRAN-CAT PIC X(01). DTSBE335 00478 10 FILLER PIC X(01) VALUE ','. DTSBE335 00479 10 TRAN-SOURCE PIC X(01). DTSBE335 00480 88 TRAN-SOURCE-CR-DB-88 VALUE '1'. DTSBE335 00481 88 TRAN-SOURCE-STATUS-88 VALUE '2'. DTSBE335 00482 88 TRAN-SOURCE-ERROR-88 VALUE '3'. DTSBE335 00483 10 FILLER PIC X(01) VALUE ','. DTSBE335 00484 10 TRAN-RCVD-DT PIC X(10). DTSBE335 00485 10 FILLER PIC X(01) VALUE ','. DTSBE335 00486 10 TRAN-PROCESS-DT PIC X(10). DTSBE335 00487 10 FILLER PIC X(01) VALUE ','. DTSBE335 00488 10 TRAN-APPLIC-BATCH PIC 9(05). DTSBE335 00489 10 FILLER PIC X(01) VALUE ','. DTSBE335 00490 10 TRAN-APPLIC-ITEM PIC 9(03). DTSBE335 00491 DTSBE335 00492 05 WRK-QTR-REC. DTSBE335 00493 10 QTR-EMP-NO PIC 9(06). DTSBE335 00494 10 FILLER PIC X(01) VALUE ','. DTSBE335 00495 10 QTR-QUARTER PIC X(06). DTSBE335 00496 10 FILLER PIC X(01) VALUE ','. DTSBE335 00497 10 QTR-RPT-STATUS PIC X(01). DTSBE335 00498 10 FILLER PIC X(01) VALUE ','. DTSBE335 00499 10 QTR-DUE-DT PIC X(10). DTSBE335 00500 10 FILLER PIC X(01) VALUE ','. DTSBE335 00501 10 QTR-BAL-DUE PIC ----------9.99. DTSBE335 00502 DTSBE335 00503 05 WRK-QTR-COLL-REC. DTSBE335 00504 10 QTR-COLL-EMP-NO PIC 9(06). DTSBE335 00505 10 FILLER PIC X(01) VALUE ','. DTSBE335 00506 10 QTR-COLL-QUARTER PIC X(06). DTSBE335 00507 10 FILLER PIC X(01) VALUE ','. DTSBE335 00508 10 QTR-COLL-TYPE PIC X(02). DTSBE335 00509 88 QTR-COLL-FIRST-DELINQ-88 VALUE '01'. DTSBE335 00510 88 QTR-COLL-FINAL-DELINQ-88 VALUE '02'. DTSBE335 00511 88 QTR-COLL-DEBIT-MEMO-88 VALUE '03'. DTSBE335 00512 10 FILLER PIC X(01) VALUE ','. DTSBE335 00513 10 QTR-COLL-PROCESS-DT PIC X(10). DTSBE335 00514 10 FILLER PIC X(01) VALUE ','. DTSBE335 00515 10 QTR-COLL-OPID PIC X(07). DTSBE335 00516 DTSBE335 00517 05 WRK-RATE-REC. DTSBE335 00518 10 RATE-EMP-NO PIC 9(06). DTSBE335 00519 10 FILLER PIC X(01) VALUE ','. DTSBE335 00520 10 RATE-EFF-QTR PIC X(06). DTSBE335 00521 10 FILLER PIC X(01) VALUE ','. DTSBE335 00522 10 RATE-UI-RATE PIC Z9.9. DTSBE335 00523 10 RATE-UI-RATE-X REDEFINES RATE-UI-RATE DTSBE335 00524 PIC X(04). DTSBE335 00525 10 FILLER PIC X(01) VALUE ','. DTSBE335 00526 10 RATE-PROCESS-DT PIC X(10). DTSBE335 00527 DTSBE335 00528 05 WRK-SUMMARY-REC. DTSBE335 00529 10 SUMMARY-PROCESS-DT PIC X(10). DTSBE335 00530 10 FILLER PIC X(01) VALUE ','. DTSBE335 00531 10 SUMMARY-MESSAGE PIC X(40). DTSBE335 00532 10 FILLER PIC X(01) VALUE ','. DTSBE335 00533 10 SUMMARY-EMP-NO PIC 9(06). DTSBE335 00534 10 FILLER PIC X(01) VALUE ','. DTSBE335 00535 10 SUMMARY-BATCH PIC 9(05). DTSBE335 00536 10 FILLER PIC X(01) VALUE ','. DTSBE335 00537 10 SUMMARY-ITEM PIC 9(03). DTSBE335 00538 10 FILLER PIC X(01) VALUE ','. DTSBE335 00539 10 SUMMARY-TRAN PIC X(02). DTSBE335 00540 10 FILLER PIC X(01) VALUE ','. DTSBE335 00541 10 SUMMARY-SOURCE PIC X(01). DTSBE335 00542 88 SUMMARY-SOURCE-CR-DB-88 VALUE '1'. DTSBE335 00543 88 SUMMARY-SOURCE-STATUS-88 VALUE '2'. DTSBE335 00544 88 SUMMARY-SOURCE-ERROR-88 VALUE '3'. DTSBE335 00545 DTSBE335 00546 05 DISPLAY-CNT PIC Z(06)9. DTSBE335 00547 DTSBE335 00548 05 DISPLAY-AMT1-X PIC X(15). DTSBE335 00549 05 DISPLAY-AMT1 REDEFINES DISPLAY-AMT1-X DTSBE335 00550 PIC ---,---,--9.99. DTSBE335 00551 05 DISPLAY-AMT2-X PIC X(15). DTSBE335 00552 05 DISPLAY-AMT2 REDEFINES DISPLAY-AMT2-X DTSBE335 00553 PIC ---,---,--9.99. DTSBE335 00554 05 DISPLAY-AMT3-X PIC X(15). DTSBE335 00555 05 DISPLAY-AMT3 REDEFINES DISPLAY-AMT3-X DTSBE335 00556 PIC ---,---,--9.99. DTSBE335 00557 EJECT DTSBE335 00558 01 L001-LINK-AREA. DTSBE335 00559 ++INCLUDE DTSIL001 DTSBE335 00560 EJECT DTSBE335 00561 01 L004-LINK-AREA. DTSBE335 00562 ++INCLUDE DTSIL004 DTSBE335 00563 EJECT DTSBE335 00564 01 L005-LINK-AREA. DTSBE335 00565 ++INCLUDE DTSIL005 DTSBE335 00566 DTSBE335 00567 01 L910-LINK-AREA. DTSBE335 00568 ++INCLUDE DTSIL910 DTSBE335 00569 SKIP3 DTSBE335 00570 01 MSKL-REC. DTSBE335 00571 ++INCLUDE DTSIMSKL DTSBE335 00572 SKIP3 DTSBE335 00573 01 MHDR-REC. DTSBE335 00574 ++INCLUDE DTSIMHDR DTSBE335 00575 SKIP3 DTSBE335 00576 01 MQTR-REC. DTSBE335 00577 ++INCLUDE DTSIMQTR DTSBE335 00578 SKIP3 DTSBE335 00579 01 MJRN-REC. DTSBE335 00580 ++INCLUDE DTSIMJRN DTSBE335 00581 SKIP3 DTSBE335 00582 01 MRPT-REC. DTSBE335 00583 ++INCLUDE DTSIMRPT DTSBE335 00584 SKIP3 DTSBE335 00585 01 MADJ-REC. DTSBE335 00586 ++INCLUDE DTSIMADJ DTSBE335 00587 SKIP3 DTSBE335 00588 01 MPAY-REC. DTSBE335 00589 ++INCLUDE DTSIMPAY DTSBE335 00590 SKIP3 DTSBE335 00591 01 MRTE-REC. DTSBE335 00592 ++INCLUDE DTSIMRTE DTSBE335 00593 SKIP3 DTSBE335 00594 01 MEVL-REC. DTSBE335 00595 ++INCLUDE DTSIMEVL DTSBE335 00596 SKIP3 DTSBE335 00597 01 MSOL-REC. DTSBE335 00598 ++INCLUDE DTSIMSOL DTSBE335 00599 SKIP3 DTSBE335 00600 01 MFSC-REC. DTSBE335 00601 ++INCLUDE DTSIMFSC DTSBE335 00602 SKIP3 DTSBE335 00603 01 MTAD-REC. DTSBE335 00604 ++INCLUDE DTSIMTAD DTSBE335 00605 SKIP3 DTSBE335 00606 01 MTAA-REC. DTSBE335 00607 ++INCLUDE DTSIMTAA DTSBE335 00608 SKIP3 DTSBE335 00609 01 L931-LINK-AREA. DTSBE335 00610 ++INCLUDE DTSIL931 DTSBE335 00611 SKIP3 DTSBE335 00612 01 FSKL-REC. DTSBE335 00613 ++INCLUDE DTSIFSKL DTSBE335 00614 SKIP3 DTSBE335 00615 01 FQTR-REC. DTSBE335 00616 ++INCLUDE DTSIFQTR DTSBE335 00617 DTSBE335 00618 LINKAGE SECTION. DTSBE335 00619 SKIP3 DTSBE335 00620 01 LECM-LINK-AREA. DTSBE335 00621 ++INCLUDE DTSILECM DTSBE335 00622 SKIP3 DTSBE335 00623 10 FILLER REDEFINES LECM-EXTRACT-PARMS. DTSBE335 00624 15 LECM-PARM-SUBJECT-DATE PIC X(06). DTSBE335 00625 15 FILLER PIC X(62). DTSBE335 00626 EJECT DTSBE335 00627 01 MPRF-LINK-REC. DTSBE335 00628 ++INCLUDE DTSIMPRF DTSBE335 00629 EJECT DTSBE335 00630 PROCEDURE DIVISION USING LECM-LINK-AREA DTSBE335 00631 MPRF-LINK-REC. DTSBE335 00632 DTSBE335 00633 IF LECM-PROCESS-88 DTSBE335 00634 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBE335 00635 ELSE DTSBE335 00636 IF LECM-INITIALIZE-88 DTSBE335 00637 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBE335 00638 ELSE DTSBE335 00639 IF LECM-TERMINATE-88 DTSBE335 00640 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBE335 00641 ELSE DTSBE335 00642 MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED' DTSBE335 00643 TO ABEND-MSG DTSBE335 00644 PERFORM S999-ABEND THRU S999-EXIT. DTSBE335 00645 SKIP2 DTSBE335 00646 GOBACK. DTSBE335 00647 EJECT DTSBE335 00648 I0000-INITIALIZE. DTSBE335 00649 SKIP2 DTSBE335 00650 MOVE LECM-TRACE-IND TO L910-TRACE-IND. DTSBE335 00651 DTSBE335 00652 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSBE335 00653 DTSBE335 00654 PERFORM I1000-EDIT-AND-DEFAULT-PARMS THRU I1000-EXIT. DTSBE335 00655 DTSBE335 00656 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBE335 00657 DTSBE335 00658 PERFORM I3000-WRITE-PARM THRU I3000-EXIT. DTSBE335 00659 DTSBE335 00660 SET LECM-MST-OPEN-READ-88 TO TRUE. DTSBE335 00661 DTSBE335 00662 SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBE335 00663 DTSBE335 00664 I0000-EXIT. DTSBE335 00665 EXIT. DTSBE335 00666 EJECT DTSBE335 00667 I1000-EDIT-AND-DEFAULT-PARMS. DTSBE335 00668 IF LECM-PARM-SUBJECT-DATE = SPACES DTSBE335 00669 PERFORM I1200-DEFAULT-DATE THRU I1200-EXIT DTSBE335 00670 PERFORM I1100-SET-DATES THRU I1100-EXIT DTSBE335 00671 ELSE DTSBE335 00672 MOVE LECM-PARM-SUBJECT-DATE TO L001-CAL-6-DATE-X DTSBE335 00673 PERFORM S001-FROM-CAL-6 THRU S001-EXIT DTSBE335 00674 IF L001-VALID-DATE DTSBE335 00675 IF L001-FED-8-DATE-9 <= LECM-PRIOR-RUN-DATE DTSBE335 00676 MOVE L001-FED-8-DATE-9 TO WRK-SUBJECT-DATE DTSBE335 00677 PERFORM I1100-SET-DATES THRU I1100-EXIT DTSBE335 00678 ELSE DTSBE335 00679 PERFORM I1002-ERROR THRU I1002-EXIT DTSBE335 00680 ELSE DTSBE335 00681 PERFORM I1001-ERROR THRU I1001-EXIT DTSBE335 00682 END-IF DTSBE335 00683 END-IF. DTSBE335 00684 DTSBE335 00685 DTSBE335 00686 I1000-EXIT. DTSBE335 00687 EXIT. DTSBE335 00688 DTSBE335 00689 I1001-ERROR. DTSBE335 00690 DISPLAY 'INVALID PARM DATE ' L001-FED-8-DATE-X. DTSBE335 00691 MOVE 'INVALID PARM DATE' TO ABEND-MSG. DTSBE335 00692 PERFORM S999-ABEND THRU S999-EXIT. DTSBE335 00693 I1001-EXIT. DTSBE335 00694 EXIT. DTSBE335 00695 DTSBE335 00696 DTSBE335 00697 I1002-ERROR. DTSBE335 00698 DISPLAY 'SUBJECT DATE CANNOT BE > PRIOR RUN DATE ' DTSBE335 00699 L001-FED-8-DATE-X. DTSBE335 00700 MOVE 'FUTURE DATE' TO ABEND-MSG. DTSBE335 00701 PERFORM S999-ABEND THRU S999-EXIT. DTSBE335 00702 I1002-EXIT. DTSBE335 00703 EXIT. DTSBE335 00704 DTSBE335 00705 I1100-SET-DATES. DTSBE335 00706 DTSBE335 00707 MOVE WRK-SUBJECT-DATE TO L001-FED-8-DATE-9. DTSBE335 00708 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBE335 00709 * MOVE L001-FED-8-DATE-9 TO WRK-SUBJECT-DATE. DTSBE335 00710 * MOVE L001-JUL-ABS-DAY TO WRK-ABSTIME. DTSBE335 00711 MOVE L001-FED-8-DATE-9 TO L004-DATE. DTSBE335 00712 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSBE335 00713 MOVE L004-QTR-5-9 TO WRK-START-YRQ. DTSBE335 00714 MOVE 1 TO L004-QTR-5-Q. DTSBE335 00715 MOVE L004-QTR-5-9 TO WRK-ANN-START-YRQ. DTSBE335 00716 MOVE L004-QTR-START-DATE TO WRK-SUBJECT-DATE DTSBE335 00717 L001-FED-8-DATE-9. DTSBE335 00718 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBE335 00719 MOVE L001-JUL-ABS-DAY TO WRK-ABSTIME. DTSBE335 00720 DTSBE335 00721 MOVE LECM-PRIOR-RUN-DATE TO L004-DATE. DTSBE335 00722 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSBE335 00723 SUBTRACT 1 FROM L004-ABS-QTR. DTSBE335 00724 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBE335 00725 MOVE L004-QTR-5-9 TO WRK-SUBJECT-YRQ. DTSBE335 00726 DTSBE335 00727 MOVE LECM-PRIOR-RUN-DATE TO WRK-PRIOR-RUN-DT. DTSBE335 00728 DTSBE335 00729 MOVE LECM-PRIOR-RUN-DATE TO L004-DATE. DTSBE335 00730 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSBE335 00731 SUBTRACT 13 FROM L004-ABS-QTR. DTSBE335 00732 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBE335 00733 MOVE L004-QTR-5-9 TO WRK-YRQ-MINUS-13. DTSBE335 00734 DTSBE335 00735 DISPLAY 'SUBJECT DATE ' WRK-SUBJECT-DATE. DTSBE335 00736 DISPLAY 'ABSTIME ' WRK-ABSTIME. DTSBE335 00737 DISPLAY 'START QUARTER ' WRK-START-YRQ. DTSBE335 00738 DISPLAY 'PRIOR RUN DT ' WRK-PRIOR-RUN-DT. DTSBE335 00739 I1100-EXIT. DTSBE335 00740 EXIT. DTSBE335 00741 DTSBE335 00742 I1200-DEFAULT-DATE. DTSBE335 00743 MOVE LECM-PRIOR-RUN-DATE TO L001-FED-8-DATE-9. DTSBE335 00744 SUBTRACT 1 FROM L001-FED-8-YR. DTSBE335 00745 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBE335 00746 MOVE L001-FED-8-DATE-9 TO WRK-SUBJECT-DATE. DTSBE335 00747 DTSBE335 00748 I1200-EXIT. DTSBE335 00749 EXIT. DTSBE335 00750 DTSBE335 00751 I2000-OPEN-FILES. DTSBE335 00752 OPEN OUTPUT PROFILE-FILE. DTSBE335 00753 IF NOT PROFILE-STATUS-OK-88 DTSBE335 00754 DISPLAY 'PROFILE FILE OPEN ERROR: ' PROFILE-STATUS DTSBE335 00755 MOVE 'FILE OPEN ERROR' DTSBE335 00756 TO ABEND-MSG DTSBE335 00757 PERFORM S999-ABEND THRU S999-EXIT DTSBE335 00758 END-IF. DTSBE335 00759 DTSBE335 00760 OPEN OUTPUT DETERM-FILE. DTSBE335 00761 IF NOT DETERM-STATUS-OK-88 DTSBE335 00762 DISPLAY 'DETERM FILE OPEN ERROR: ' DETERM-STATUS DTSBE335 00763 MOVE 'FILE OPEN ERROR' DTSBE335 00764 TO ABEND-MSG DTSBE335 00765 PERFORM S999-ABEND THRU S999-EXIT DTSBE335 00766 END-IF. DTSBE335 00767 DTSBE335 00768 OPEN OUTPUT FSCHED-FILE. DTSBE335 00769 IF NOT FSC-STATUS-OK-88 DTSBE335 00770 DISPLAY 'FSCHED FILE OPEN ERROR: ' FSC-STATUS DTSBE335 00771 MOVE 'FILE OPEN ERROR' DTSBE335 00772 TO ABEND-MSG DTSBE335 00773 PERFORM S999-ABEND THRU S999-EXIT DTSBE335 00774 END-IF. DTSBE335 00775 DTSBE335 00776 OPEN OUTPUT ADDRESS-FILE DTSBE335 00777 IF NOT ADR-STATUS-OK-88 DTSBE335 00778 DISPLAY 'ADDRESS FILE OPEN ERROR: ' ADR-STATUS DTSBE335 00779 MOVE 'FILE OPEN ERROR' DTSBE335 00780 TO ABEND-MSG DTSBE335 00781 PERFORM S999-ABEND THRU S999-EXIT DTSBE335 00782 END-IF. DTSBE335 00783 DTSBE335 00784 OPEN OUTPUT ACCT-FILE. DTSBE335 00785 IF NOT ACCT-STATUS-OK-88 DTSBE335 00786 DISPLAY 'ACCT FILE OPEN ERROR: ' ACCT-STATUS DTSBE335 00787 MOVE 'FILE OPEN ERROR' DTSBE335 00788 TO ABEND-MSG DTSBE335 00789 PERFORM S999-ABEND THRU S999-EXIT DTSBE335 00790 END-IF. DTSBE335 00791 DTSBE335 00792 OPEN OUTPUT TRAN-FILE. DTSBE335 00793 IF NOT TRAN-STATUS-OK-88 DTSBE335 00794 DISPLAY 'TRAN FILE OPEN ERROR: ' TRAN-STATUS DTSBE335 00795 MOVE 'FILE OPEN ERROR' DTSBE335 00796 TO ABEND-MSG DTSBE335 00797 PERFORM S999-ABEND THRU S999-EXIT DTSBE335 00798 END-IF. DTSBE335 00799 DTSBE335 00800 OPEN OUTPUT QTR-FILE. DTSBE335 00801 IF NOT QTR-STATUS-OK-88 DTSBE335 00802 DISPLAY 'QTR FILE OPEN ERROR: ' QTR-STATUS DTSBE335 00803 MOVE 'FILE OPEN ERROR' DTSBE335 00804 TO ABEND-MSG DTSBE335 00805 PERFORM S999-ABEND THRU S999-EXIT DTSBE335 00806 END-IF. DTSBE335 00807 DTSBE335 00808 OPEN OUTPUT RATE-FILE. DTSBE335 00809 IF NOT RATE-STATUS-OK-88 DTSBE335 00810 DISPLAY 'RATE FILE OPEN ERROR: ' RATE-STATUS DTSBE335 00811 MOVE 'FILE OPEN ERROR' DTSBE335 00812 TO ABEND-MSG DTSBE335 00813 PERFORM S999-ABEND THRU S999-EXIT DTSBE335 00814 END-IF. DTSBE335 00815 DTSBE335 00816 OPEN OUTPUT QTR-COLL-FILE. DTSBE335 00817 IF NOT QCOLL-STATUS-OK-88 DTSBE335 00818 DISPLAY 'QTR-COLL FILE OPEN ERROR: ' QCOLL-STATUS DTSBE335 00819 MOVE 'FILE OPEN ERROR' DTSBE335 00820 TO ABEND-MSG DTSBE335 00821 PERFORM S999-ABEND THRU S999-EXIT DTSBE335 00822 END-IF. DTSBE335 00823 DTSBE335 00824 OPEN OUTPUT SUMMARY-FILE DTSBE335 00825 IF NOT SUMMARY-STATUS-OK-88 DTSBE335 00826 DISPLAY 'SUMMARY FILE OPEN ERROR: ' SUMMARY-STATUS DTSBE335 00827 MOVE 'FILE OPEN ERROR' DTSBE335 00828 TO ABEND-MSG DTSBE335 00829 PERFORM S999-ABEND THRU S999-EXIT DTSBE335 00830 END-IF. DTSBE335 00831 DTSBE335 00832 I2000-EXIT. DTSBE335 00833 EXIT. DTSBE335 00834 DTSBE335 00835 I3000-WRITE-PARM. DTSBE335 00836 OPEN OUTPUT PARM-FILE. DTSBE335 00837 IF NOT PARM-STATUS-OK-88 DTSBE335 00838 DISPLAY 'PARM FILE OPEN ERROR: ' PARM-STATUS DTSBE335 00839 MOVE 'FILE OPEN ERROR' DTSBE335 00840 TO ABEND-MSG DTSBE335 00841 PERFORM S999-ABEND THRU S999-EXIT DTSBE335 00842 END-IF. DTSBE335 00843 DTSBE335 00844 MOVE LOW-VALUES TO PARM-REC. DTSBE335 00845 MOVE WRK-START-YRQ TO PARM-START-YRQ. DTSBE335 00846 MOVE WRK-SUBJECT-YRQ TO PARM-SUBJECT-YRQ. DTSBE335 00847 MOVE WRK-PRIOR-RUN-DT TO PARM-PRIOR-RUN-DT. DTSBE335 00848 DTSBE335 00849 WRITE PARM-REC. DTSBE335 00850 IF NOT PARM-STATUS-OK-88 DTSBE335 00851 DISPLAY 'CANNOT WRITE PARM ' PARM-STATUS DTSBE335 00852 PERFORM S999-ABEND THRU S999-EXIT DTSBE335 00853 ELSE DTSBE335 00854 CLOSE PARM-FILE DTSBE335 00855 END-IF. DTSBE335 00856 DTSBE335 00857 I3000-EXIT. DTSBE335 00858 EXIT. DTSBE335 00859 DTSBE335 00860 P0000-PROCESS. DTSBE335 00861 MOVE ZERO TO WRK-LAST-LIAB-YRQ. DTSBE335 00862 DTSBE335 00863 IF MPRF-CLASS-SUB-88 DTSBE335 00864 OR MPRF-ELIGIBLE-DC-GOV-88 DTSBE335 00865 NEXT SENTENCE DTSBE335 00866 ELSE DTSBE335 00867 GO TO P0000-EXIT DTSBE335 00868 END-IF. DTSBE335 00869 DTSBE335 00870 IF MPRF-STATUS-INACT-88 DTSBE335 00871 MOVE LOW-VALUES TO MSOL-REC DTSBE335 00872 MOVE MPRF-EMP-NO TO MSOL-EMP-NO DTSBE335 00873 SET MSOL-SOL-88 TO TRUE DTSBE335 00874 MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA DTSBE335 00875 PERFORM S910-START-BROWSE THRU S910-EXIT DTSBE335 00876 PERFORM UNTIL L910-NO-REC-88 DTSBE335 00877 MOVE MSKL-REC TO MSOL-REC DTSBE335 00878 IF NOT MSOL-INACT-WITHDRAWN-88 DTSBE335 00879 IF MSOL-INACT-INACTIVE-88 DTSBE335 00880 MOVE MSOL-LAST-LIAB-YRQ TO WRK-LAST-LIAB-YRQ DTSBE335 00881 END-IF DTSBE335 00882 END-IF DTSBE335 00883 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE335 00884 END-PERFORM DTSBE335 00885 IF WRK-LAST-LIAB-YRQ < WRK-YRQ-MINUS-13 DTSBE335 00886 GO TO P0000-EXIT DTSBE335 00887 ELSE DTSBE335 00888 ADD +1 TO WRK-INACT-CNT DTSBE335 00889 END-IF DTSBE335 00890 END-IF. DTSBE335 00891 DTSBE335 00892 *** IF MPRF-STATUS-INACT-88 DTSBE335 00893 * MOVE LOW-VALUES TO MJRN-KEY-AREA DTSBE335 00894 * MOVE MPRF-EMP-NO TO MJRN-EMP-NO DTSBE335 00895 * SET MJRN-JRN-88 TO TRUE DTSBE335 00896 * MOVE WRK-ABSTIME TO MJRN-ESTB-ABSTIME DTSBE335 00897 * MOVE MJRN-KEY-AREA TO MSKL-KEY-AREA DTSBE335 00898 * PERFORM S910-START-BROWSE THRU S910-EXIT DTSBE335 00899 * IF L910-OK-88 DTSBE335 00900 * NEXT SENTENCE DTSBE335 00901 * ELSE DTSBE335 00902 * IF MPRF-TOT-BALANCE-AMT > ZERO DTSBE335 00903 * OR MPRF-TOT-CREDIT-AMT > ZERO DTSBE335 00904 * OR MPRF-PURSUED-RPT-CNT > ZERO DTSBE335 00905 * NEXT SENTENCE DTSBE335 00906 * ELSE DTSBE335 00907 * GO TO P0000-EXIT DTSBE335 00908 * END-IF DTSBE335 00909 * END-IF DTSBE335 00910 *** END-IF. DTSBE335 00911 DTSBE335 00912 ADD +1 TO WRK-MPRF-CNT. DTSBE335 00913 DTSBE335 00914 * DISPLAY 'P0000 ' MPRF-EMP-NO. DTSBE335 00915 PERFORM P0100-PROFILE THRU P0100-EXIT. DTSBE335 00916 PERFORM P0200-DETERM THRU P0200-EXIT. DTSBE335 00917 PERFORM P0300-FILING-SCHED THRU P0300-EXIT. DTSBE335 00918 PERFORM P0400-ADDRESS THRU P0400-EXIT. DTSBE335 00919 PERFORM P1000-ACCTS-RECEIVABLE THRU P1000-EXIT. DTSBE335 00920 PERFORM P2000-TRANSACTION-DETAIL THRU P2000-EXIT. DTSBE335 00921 PERFORM P3000-QUARTER THRU P3000-EXIT. DTSBE335 00922 PERFORM P4000-RATE THRU P4000-EXIT. DTSBE335 00923 PERFORM P5000-QTR-COLL THRU P5000-EXIT. DTSBE335 00924 DTSBE335 00925 DTSBE335 00926 P0000-EXIT. DTSBE335 00927 EXIT. DTSBE335 00928 DTSBE335 00929 P0100-PROFILE. DTSBE335 00930 MOVE MPRF-EMP-NO TO PRF-EMP-NO. DTSBE335 00931 MOVE MPRF-EMP-CLASS TO PRF-EMP-CLASS. DTSBE335 00932 MOVE MPRF-PRIMARY-NAME TO PRF-EMP-NAME. DTSBE335 00933 INSPECT PRF-EMP-NAME REPLACING ALL ',' BY SPACE. DTSBE335 00934 MOVE MPRF-FEIN TO PRF-FEIN. DTSBE335 00935 MOVE MPRF-EMP-STATUS TO PRF-EMP-STATUS. DTSBE335 00936 IF MPRF-ESTB-DATE NOT = ZERO DTSBE335 00937 MOVE MPRF-ESTB-DATE TO L001-FED-8-DATE-9 DTSBE335 00938 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBE335 00939 IF L001-VALID-DATE DTSBE335 00940 MOVE L001-SLASH-8-DATE TO PRF-PROCESS-DT DTSBE335 00941 ELSE DTSBE335 00942 MOVE WRK-DEFAULT-DATE TO PRF-PROCESS-DT DTSBE335 00943 END-IF DTSBE335 00944 ELSE DTSBE335 00945 MOVE WRK-DEFAULT-DATE TO PRF-PROCESS-DT DTSBE335 00946 END-IF. DTSBE335 00947 DTSBE335 00948 WRITE PROFILE-REC FROM WRK-PRF-REC. DTSBE335 00949 IF PROFILE-STATUS-OK-88 DTSBE335 00950 ADD +1 TO WRK-PRF-CNT DTSBE335 00951 ELSE DTSBE335 00952 DISPLAY 'CANNOT WRITE PROFILE ' MPRF-EMP-NO DTSBE335 00953 END-IF. DTSBE335 00954 DTSBE335 00955 P0100-EXIT. DTSBE335 00956 EXIT. DTSBE335 00957 DTSBE335 00958 P0200-DETERM. DTSBE335 00959 MOVE LOW-VALUES TO MSOL-REC. DTSBE335 00960 MOVE MPRF-EMP-NO TO MSOL-EMP-NO. DTSBE335 00961 SET MSOL-SOL-88 TO TRUE. DTSBE335 00962 MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA. DTSBE335 00963 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE335 00964 DTSBE335 00965 PERFORM DTSBE335 00966 UNTIL L910-NO-REC-88 DTSBE335 00967 MOVE MSKL-REC TO MSOL-REC DTSBE335 00968 IF NOT MSOL-INACT-WITHDRAWN-88 DTSBE335 00969 PERFORM P0210-WRITE THRU P0210-EXIT DTSBE335 00970 END-IF DTSBE335 00971 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE335 00972 END-PERFORM. DTSBE335 00973 DTSBE335 00974 P0200-EXIT. DTSBE335 00975 EXIT. DTSBE335 00976 DTSBE335 00977 P0210-WRITE. DTSBE335 00978 MOVE MPRF-EMP-NO TO DET-EMP-NO. DTSBE335 00979 MOVE MSOL-LIAB-DATE TO L001-FED-8-DATE-9 DTSBE335 00980 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBE335 00981 IF L001-VALID-DATE DTSBE335 00982 MOVE L001-SLASH-8-DATE TO DET-LIABLE-START-DT DTSBE335 00983 ELSE DTSBE335 00984 DISPLAY 'INVALID LIABLE START DT ' MPRF-EMP-NO DTSBE335 00985 GO TO P0210-EXIT DTSBE335 00986 END-IF. DTSBE335 00987 DTSBE335 00988 MOVE MSOL-FIRST-LIAB-YRQ TO L004-QTR-5-9. DTSBE335 00989 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE335 00990 IF L004-VALID-QTR DTSBE335 00991 MOVE L004-SLASH-5-QTR TO DET-LIABLE-START-QTR DTSBE335 00992 ELSE DTSBE335 00993 DISPLAY 'INVALID LIABLE START QTR ' MPRF-EMP-NO DTSBE335 00994 GO TO P0210-EXIT DTSBE335 00995 END-IF. DTSBE335 00996 DTSBE335 00997 MOVE MSOL-LIAB-CD TO DET-LIABLE-CD. DTSBE335 00998 DTSBE335 00999 IF MSOL-INACT-DATE = ALL-NINES-DT DTSBE335 01000 MOVE ALL-NINES-DT-DISP TO DET-LIABLE-END-DT DTSBE335 01001 ELSE DTSBE335 01002 MOVE MSOL-INACT-DATE TO L001-FED-8-DATE-9 DTSBE335 01003 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBE335 01004 IF L001-VALID-DATE DTSBE335 01005 MOVE L001-SLASH-8-DATE TO DET-LIABLE-END-DT DTSBE335 01006 ELSE DTSBE335 01007 GO TO P0210-EXIT DTSBE335 01008 END-IF DTSBE335 01009 END-IF. DTSBE335 01010 DTSBE335 01011 IF MSOL-LAST-LIAB-YRQ = ALL-NINES-QTR DTSBE335 01012 MOVE ALL-NINES-QTR-DISP TO DET-LIABLE-END-QTR DTSBE335 01013 ELSE DTSBE335 01014 MOVE MSOL-LAST-LIAB-YRQ TO L004-QTR-5-9 DTSBE335 01015 PERFORM S004-FROM-5 THRU S004-EXIT DTSBE335 01016 IF L004-VALID-QTR DTSBE335 01017 MOVE L004-SLASH-5-QTR TO DET-LIABLE-END-QTR DTSBE335 01018 ELSE DTSBE335 01019 GO TO P0210-EXIT DTSBE335 01020 END-IF DTSBE335 01021 END-IF. DTSBE335 01022 DTSBE335 01023 MOVE MSOL-INACT-CD TO DET-INACTIVE-CD. DTSBE335 01024 DTSBE335 01025 MOVE MSOL-ESTB-DATE TO L001-FED-8-DATE-9 DTSBE335 01026 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBE335 01027 IF L001-VALID-DATE DTSBE335 01028 MOVE L001-SLASH-8-DATE TO DET-PROCESS-DT DTSBE335 01029 ELSE DTSBE335 01030 MOVE WRK-DEFAULT-DATE TO DET-PROCESS-DT DTSBE335 01031 END-IF. DTSBE335 01032 DTSBE335 01033 WRITE DETERM-REC FROM WRK-DET-REC. DTSBE335 01034 IF DETERM-STATUS-OK-88 DTSBE335 01035 ADD +1 TO WRK-DET-CNT DTSBE335 01036 ELSE DTSBE335 01037 DISPLAY 'CANNOT WRITE DETERM ' MPRF-EMP-NO DTSBE335 01038 END-IF. DTSBE335 01039 DTSBE335 01040 P0210-EXIT. DTSBE335 01041 EXIT. DTSBE335 01042 DTSBE335 01043 P0300-FILING-SCHED. DTSBE335 01044 MOVE LOW-VALUES TO MFSC-REC. DTSBE335 01045 MOVE MPRF-EMP-NO TO MFSC-EMP-NO. DTSBE335 01046 SET MFSC-FSC-88 TO TRUE. DTSBE335 01047 MOVE MFSC-KEY-AREA TO MSKL-KEY-AREA. DTSBE335 01048 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE335 01049 DTSBE335 01050 PERFORM DTSBE335 01051 UNTIL L910-NO-REC-88 DTSBE335 01052 MOVE MSKL-REC TO MFSC-REC DTSBE335 01053 IF MFSC-STATUS-OPEN-88 DTSBE335 01054 PERFORM P0310-WRITE THRU P0310-EXIT DTSBE335 01055 END-IF DTSBE335 01056 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE335 01057 END-PERFORM. DTSBE335 01058 DTSBE335 01059 P0300-EXIT. DTSBE335 01060 EXIT. DTSBE335 01061 DTSBE335 01062 P0310-WRITE. DTSBE335 01063 MOVE MPRF-EMP-NO TO FSC-EMP-NO. DTSBE335 01064 DTSBE335 01065 MOVE MFSC-FILING-SCHEDULE-CD TO FSC-SCHEDULE. DTSBE335 01066 DTSBE335 01067 MOVE MFSC-START-YRQ TO L004-QTR-5-9. DTSBE335 01068 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE335 01069 IF L004-VALID-QTR DTSBE335 01070 MOVE L004-SLASH-5-QTR TO FSC-START-QTR DTSBE335 01071 ELSE DTSBE335 01072 DISPLAY 'INVALID START QTR ' MPRF-EMP-NO DTSBE335 01073 GO TO P0310-EXIT DTSBE335 01074 END-IF. DTSBE335 01075 IF MFSC-END-YRQ = ALL-NINES-QTR DTSBE335 01076 MOVE ALL-NINES-QTR-DISP TO FSC-END-QTR DTSBE335 01077 ELSE DTSBE335 01078 MOVE MFSC-END-YRQ TO L004-QTR-5-9 DTSBE335 01079 PERFORM S004-FROM-5 THRU S004-EXIT DTSBE335 01080 IF L004-VALID-QTR DTSBE335 01081 MOVE L004-SLASH-5-QTR TO FSC-END-QTR DTSBE335 01082 ELSE DTSBE335 01083 DISPLAY 'INVALID END QTR ' MPRF-EMP-NO DTSBE335 01084 GO TO P0310-EXIT DTSBE335 01085 END-IF DTSBE335 01086 END-IF. DTSBE335 01087 DTSBE335 01088 WRITE FSCHED-REC FROM WRK-FSC-REC. DTSBE335 01089 IF FSC-STATUS-OK-88 DTSBE335 01090 ADD +1 TO WRK-FSC-CNT DTSBE335 01091 ELSE DTSBE335 01092 DISPLAY 'CANNOT WRITE FILING SCHEDULE ' MPRF-EMP-NO DTSBE335 01093 END-IF. DTSBE335 01094 DTSBE335 01095 P0310-EXIT. DTSBE335 01096 EXIT. DTSBE335 01097 DTSBE335 01098 P0400-ADDRESS. DTSBE335 01099 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSBE335 01100 MOVE MPRF-EMP-NO TO MTAD-EMP-NO. DTSBE335 01101 SET MTAD-TAD-88 TO TRUE. DTSBE335 01102 SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE. DTSBE335 01103 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSBE335 01104 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE335 01105 PERFORM UNTIL L910-NO-REC-88 DTSBE335 01106 MOVE MSKL-REC TO MTAD-REC DTSBE335 01107 MOVE MTAD-ADDRESS TO WRK-ADDRESS DTSBE335 01108 IF MTAD-ID-TAX-MAILING-ADDR-88 DTSBE335 01109 SET X110-ADDR-TYPE-MAIL-88 TO TRUE DTSBE335 01110 ELSE DTSBE335 01111 SET X110-ADDR-TYPE-RECS-88 TO TRUE DTSBE335 01112 END-IF DTSBE335 01113 MOVE MTAD-VOICE-1 TO WRK-PHONE DTSBE335 01114 MOVE MTAD-FAX TO WRK-FAX DTSBE335 01115 MOVE MTAD-EMAIL-ADDRESS TO WRK-EMAIL DTSBE335 01116 PERFORM P0410-WRITE-X110 THRU P0410-EXIT DTSBE335 01117 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE335 01118 END-PERFORM. DTSBE335 01119 DTSBE335 01120 MOVE LOW-VALUES TO MTAA-KEY-AREA. DTSBE335 01121 MOVE MPRF-EMP-NO TO MTAA-EMP-NO. DTSBE335 01122 SET MTAA-TAA-88 TO TRUE. DTSBE335 01123 MOVE MTAA-KEY-AREA TO MSKL-KEY-AREA. DTSBE335 01124 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE335 01125 PERFORM UNTIL L910-NO-REC-88 DTSBE335 01126 MOVE MSKL-REC TO MTAA-REC DTSBE335 01127 MOVE MTAA-ADDRESS TO WRK-ADDRESS DTSBE335 01128 SET X110-ADDR-TYPE-WORK-88 TO TRUE DTSBE335 01129 MOVE MTAA-VOICE-1 TO WRK-PHONE DTSBE335 01130 MOVE MTAA-FAX TO WRK-FAX DTSBE335 01131 MOVE MTAA-EMAIL-ADDRESS TO WRK-EMAIL DTSBE335 01132 PERFORM P0410-WRITE-X110 THRU P0410-EXIT DTSBE335 01133 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE335 01134 END-PERFORM. DTSBE335 01135 DTSBE335 01136 P0400-EXIT. DTSBE335 01137 EXIT. DTSBE335 01138 DTSBE335 01139 P0410-WRITE-X110. DTSBE335 01140 MOVE MPRF-EMP-NO TO X110-EMP-NO. DTSBE335 01141 MOVE WRK-ATTN-LINE TO X110-ATTENTION. DTSBE335 01142 MOVE WRK-DELIV-LINE-1 TO X110-STREET-1. DTSBE335 01143 MOVE WRK-DELIV-LINE-2 TO X110-STREET-2. DTSBE335 01144 MOVE WRK-CITY TO X110-CITY. DTSBE335 01145 MOVE WRK-ST TO X110-STATE. DTSBE335 01146 MOVE WRK-ZIP TO X110-ZIP. DTSBE335 01147 MOVE WRK-PHONE TO X110-PHONE. DTSBE335 01148 MOVE WRK-FAX TO X110-FAX. DTSBE335 01149 IF WRK-EMAIL = LOW-VALUES DTSBE335 01150 MOVE SPACES TO X110-EMAIL DTSBE335 01151 ELSE DTSBE335 01152 MOVE WRK-EMAIL TO X110-EMAIL DTSBE335 01153 END-IF. DTSBE335 01154 DTSBE335 01155 INSPECT X110-ATTENTION REPLACING ALL ',' BY DTSBE335 01156 SPACE. DTSBE335 01157 INSPECT X110-STREET-1 REPLACING ALL ',' BY SPACE. DTSBE335 01158 INSPECT X110-STREET-2 REPLACING ALL ',' BY SPACE. DTSBE335 01159 INSPECT X110-EMAIL REPLACING ALL ',' BY SPACE. DTSBE335 01160 DTSBE335 01161 WRITE ADDRESS-REC FROM WRK-ADDRESS-REC DTSBE335 01162 IF ADR-STATUS-OK-88 DTSBE335 01163 ADD +1 TO X110-CNT DTSBE335 01164 ELSE DTSBE335 01165 DISPLAY 'CANNOT WRITE X110 ' MPRF-EMP-NO DTSBE335 01166 END-IF. DTSBE335 01167 DTSBE335 01168 P0410-EXIT. DTSBE335 01169 EXIT. DTSBE335 01170 DTSBE335 01171 P1000-ACCTS-RECEIVABLE. DTSBE335 01172 MOVE WRK-START-YRQ TO WRK-EMP-START-YRQ. DTSBE335 01173 DTSBE335 01174 MOVE LOW-VALUES TO MJRN-KEY-AREA. DTSBE335 01175 MOVE MPRF-EMP-NO TO MJRN-EMP-NO. DTSBE335 01176 SET MJRN-JRN-88 TO TRUE. DTSBE335 01177 MOVE WRK-ABSTIME TO MJRN-ESTB-ABSTIME. DTSBE335 01178 MOVE MJRN-KEY-AREA TO MSKL-KEY-AREA. DTSBE335 01179 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE335 01180 PERFORM UNTIL L910-NO-REC-88 DTSBE335 01181 MOVE MSKL-REC TO MJRN-REC DTSBE335 01182 ADD +1 TO WRK-MJRN-READ-CNT DTSBE335 01183 IF NOT MJRN-TRAN-CNVR-88 DTSBE335 01184 PERFORM P1200-BUILD-ACCT THRU P1200-EXIT DTSBE335 01185 END-IF DTSBE335 01186 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE335 01187 END-PERFORM. DTSBE335 01188 DTSBE335 01189 P1000-EXIT. DTSBE335 01190 EXIT. DTSBE335 01191 DTSBE335 01192 P1200-BUILD-ACCT. DTSBE335 01193 PERFORM DTSBE335 01194 VARYING MJRN-OCC-IDX FROM +1 BY +1 DTSBE335 01195 UNTIL MJRN-OCC-IDX > MJRN-OCC-CNT DTSBE335 01196 IF MJRN-ACCT-ROW (MJRN-OCC-IDX) = 'CR' DTSBE335 01197 *** IF MJRN-ESTB-DATE >= WRK-SUBJECT-DATE DTSBE335 01198 PERFORM P1210-WRITE-ACCT THRU P1210-EXIT DTSBE335 01199 *** END-IF DTSBE335 01200 ELSE DTSBE335 01201 IF MJRN-TRAN-ATX-88 DTSBE335 01202 PERFORM P1201-ANNUAL THRU P1201-EXIT DTSBE335 01203 ELSE DTSBE335 01204 PERFORM P1202-QUARTERLY THRU P1202-EXIT DTSBE335 01205 END-IF DTSBE335 01206 END-IF DTSBE335 01207 END-PERFORM. DTSBE335 01208 DTSBE335 01209 P1200-EXIT. DTSBE335 01210 EXIT. DTSBE335 01211 DTSBE335 01212 P1201-ANNUAL. DTSBE335 01213 IF MJRN-YRQ (MJRN-OCC-IDX) < WRK-ANN-START-YRQ DTSBE335 01214 IF MJRN-ESTB-DATE >= WRK-SUBJECT-DATE DTSBE335 01215 IF MJRN-YRQ (MJRN-OCC-IDX) < WRK-EMP-START-YRQ DTSBE335 01216 MOVE MJRN-YRQ (MJRN-OCC-IDX) TO WRK-EMP-START-YRQ DTSBE335 01217 END-IF DTSBE335 01218 PERFORM P1210-WRITE-ACCT THRU P1210-EXIT DTSBE335 01219 END-IF DTSBE335 01220 ELSE DTSBE335 01221 PERFORM P1210-WRITE-ACCT THRU P1210-EXIT DTSBE335 01222 END-IF. DTSBE335 01223 DTSBE335 01224 P1201-EXIT. DTSBE335 01225 EXIT. DTSBE335 01226 DTSBE335 01227 P1202-QUARTERLY. DTSBE335 01228 *& DTSBE335 01229 IF MPRF-EMP-NO = 123878 DTSBE335 01230 DISPLAY MPRF-EMP-NO ' ' MJRN-YRQ (MJRN-OCC-IDX) DTSBE335 01231 ' ' MJRN-ESTB-DATE DTSBE335 01232 END-IF. DTSBE335 01233 *& DTSBE335 01234 IF MJRN-YRQ (MJRN-OCC-IDX) < WRK-START-YRQ DTSBE335 01235 IF MJRN-ESTB-DATE >= WRK-SUBJECT-DATE DTSBE335 01236 IF MJRN-YRQ (MJRN-OCC-IDX) < WRK-EMP-START-YRQ DTSBE335 01237 MOVE MJRN-YRQ (MJRN-OCC-IDX) TO WRK-EMP-START-YRQ DTSBE335 01238 END-IF DTSBE335 01239 PERFORM P1210-WRITE-ACCT THRU P1210-EXIT DTSBE335 01240 END-IF DTSBE335 01241 ELSE DTSBE335 01242 PERFORM P1210-WRITE-ACCT THRU P1210-EXIT DTSBE335 01243 END-IF. DTSBE335 01244 DTSBE335 01245 P1202-EXIT. DTSBE335 01246 EXIT. DTSBE335 01247 DTSBE335 01248 P1210-WRITE-ACCT. DTSBE335 01249 IF MJRN-YRQ (MJRN-OCC-IDX) = 99999 DTSBE335 01250 MOVE SPACES TO ACCT-YRQ DTSBE335 01251 ELSE DTSBE335 01252 MOVE MJRN-YRQ (MJRN-OCC-IDX) TO L004-QTR-5-9 DTSBE335 01253 PERFORM S004-FROM-5 THRU S004-EXIT DTSBE335 01254 MOVE L004-SLASH-5-QTR TO ACCT-YRQ DTSBE335 01255 END-IF. DTSBE335 01256 MOVE MJRN-BATCH-NO TO ACCT-BATCH. DTSBE335 01257 MOVE MJRN-ITEM-NO TO ACCT-ITEM. DTSBE335 01258 MOVE MPRF-EMP-NO TO ACCT-EMP-NO. DTSBE335 01259 MOVE MJRN-TRAN-TYPE TO ACCT-TRAN. DTSBE335 01260 MOVE MJRN-ACCT-ROW (MJRN-OCC-IDX) TO ACCT-ROW. DTSBE335 01261 MOVE MJRN-ACCT-COL (MJRN-OCC-IDX) TO ACCT-COL. DTSBE335 01262 IF ACCT-ROW = 'CR' DTSBE335 01263 MOVE MJRN-AMT (MJRN-OCC-IDX) TO ACCT-AMT DTSBE335 01264 ELSE DTSBE335 01265 IF ACCT-COL NOT = 'CH' DTSBE335 01266 COMPUTE ACCT-AMT = DTSBE335 01267 (MJRN-AMT (MJRN-OCC-IDX) * -1) DTSBE335 01268 ELSE DTSBE335 01269 MOVE MJRN-AMT (MJRN-OCC-IDX) TO ACCT-AMT DTSBE335 01270 END-IF DTSBE335 01271 END-IF. DTSBE335 01272 DTSBE335 01273 MOVE MJRN-TRAN-CATEGORY TO ACCT-CAT. DTSBE335 01274 MOVE MJRN-ESTB-DATE TO L001-FED-8-DATE-9. DTSBE335 01275 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBE335 01276 IF L001-VALID-DATE DTSBE335 01277 MOVE L001-SLASH-8-DATE TO ACCT-PROCESS-DT DTSBE335 01278 ELSE DTSBE335 01279 MOVE WRK-DEFAULT-DATE TO ACCT-PROCESS-DT DTSBE335 01280 END-IF. DTSBE335 01281 SET ACCT-SOURCE-CR-DB-88 TO TRUE. DTSBE335 01282 DTSBE335 01283 WRITE ACCT-REC FROM WRK-ACCT-REC DTSBE335 01284 IF NOT ACCT-STATUS-OK-88 DTSBE335 01285 DISPLAY 'CANNOT WRITE TO ACCT FILE ' DTSBE335 01286 ' ' ACCT-STATUS ' ' ACCT-EMP-NO DTSBE335 01287 ELSE DTSBE335 01288 ADD +1 TO WRK-ACCT-CNT DTSBE335 01289 END-IF. DTSBE335 01290 DTSBE335 01291 P1210-EXIT. DTSBE335 01292 EXIT. DTSBE335 01293 DTSBE335 01294 DTSBE335 01295 P2000-TRANSACTION-DETAIL. DTSBE335 01296 PERFORM P2100-REPORTS THRU P2100-EXIT. DTSBE335 01297 PERFORM P2200-PAYMENT THRU P2200-EXIT. DTSBE335 01298 PERFORM P2300-ADJUSTMENT THRU P2300-EXIT. DTSBE335 01299 DTSBE335 01300 P2000-EXIT. DTSBE335 01301 EXIT. DTSBE335 01302 DTSBE335 01303 DTSBE335 01304 P2100-REPORTS. DTSBE335 01305 MOVE LOW-VALUES TO MRPT-KEY-AREA. DTSBE335 01306 MOVE MPRF-EMP-NO TO MRPT-EMP-NO. DTSBE335 01307 SET MRPT-RPT-88 TO TRUE. DTSBE335 01308 MOVE WRK-EMP-START-YRQ TO MRPT-YRQ. DTSBE335 01309 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. DTSBE335 01310 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE335 01311 IF L910-NO-REC-88 DTSBE335 01312 GO TO P2100-EXIT DTSBE335 01313 ELSE DTSBE335 01314 PERFORM DTSBE335 01315 UNTIL L910-NO-REC-88 DTSBE335 01316 MOVE MSKL-REC TO MRPT-REC DTSBE335 01317 IF MRPT-STATUS-CHNG-YES-88 DTSBE335 01318 PERFORM P2130-STATUS-CHANGE THRU P2130-EXIT DTSBE335 01319 END-IF DTSBE335 01320 IF MRPT-ANNUAL-YES-88 DTSBE335 01321 PERFORM P2120-ANNUAL THRU P2120-EXIT DTSBE335 01322 ELSE DTSBE335 01323 PERFORM P2110-WRITE THRU P2110-EXIT DTSBE335 01324 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE335 01325 END-IF DTSBE335 01326 END-PERFORM DTSBE335 01327 END-IF. DTSBE335 01328 DTSBE335 01329 P2100-EXIT. DTSBE335 01330 EXIT. DTSBE335 01331 DTSBE335 01332 P2110-WRITE. DTSBE335 01333 MOVE MRPT-RPT-TYPE TO TRAN-TRANS. DTSBE335 01334 MOVE MRPT-BATCH-NO TO TRAN-BATCH. DTSBE335 01335 MOVE MRPT-ITEM-NO TO TRAN-ITEM. DTSBE335 01336 MOVE MPRF-EMP-NO TO TRAN-EMP-NO. DTSBE335 01337 MOVE MRPT-YRQ TO L004-QTR-5-9 DTSBE335 01338 PERFORM S004-FROM-5 THRU S004-EXIT DTSBE335 01339 MOVE L004-SLASH-5-QTR TO TRAN-YRQ DTSBE335 01340 MOVE MRPT-REMIT-AMT TO TRAN-AMT. DTSBE335 01341 MOVE MRPT-TOT-WAGE TO TRAN-TOT-WAGE. DTSBE335 01342 MOVE MRPT-TAX-WAGE TO TRAN-TAX-WAGE. DTSBE335 01343 IF MPRF-CLASS-SELF-INS-88 DTSBE335 01344 MOVE ZERO TO TRAN-RATE DTSBE335 01345 ELSE DTSBE335 01346 MOVE MRPT-EXCESS-WAGE TO TRAN-EXC-WAGE DTSBE335 01347 COMPUTE WRK-RATE = (MRPT-UI-RATE * 100) DTSBE335 01348 MOVE WRK-RATE TO TRAN-RATE DTSBE335 01349 END-IF DTSBE335 01350 MOVE SPACES TO TRAN-ACCT. DTSBE335 01351 MOVE ZEROS TO TRAN-APPLIC-BATCH DTSBE335 01352 TRAN-APPLIC-ITEM. DTSBE335 01353 MOVE 'R' TO TRAN-CAT. DTSBE335 01354 SET TRAN-SOURCE-CR-DB-88 TO TRUE. DTSBE335 01355 MOVE MRPT-RECEIVED-DATE TO L001-FED-8-DATE-9. DTSBE335 01356 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBE335 01357 MOVE L001-SLASH-8-DATE TO TRAN-RCVD-DT. DTSBE335 01358 MOVE MRPT-ESTB-DATE TO L001-FED-8-DATE-9. DTSBE335 01359 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBE335 01360 IF L001-VALID-DATE DTSBE335 01361 MOVE L001-SLASH-8-DATE TO TRAN-PROCESS-DT DTSBE335 01362 ELSE DTSBE335 01363 MOVE WRK-DEFAULT-DATE TO TRAN-PROCESS-DT DTSBE335 01364 END-IF. DTSBE335 01365 DTSBE335 01366 WRITE TRAN-REC FROM WRK-TRAN-REC DTSBE335 01367 IF NOT TRAN-STATUS-OK-88 DTSBE335 01368 DISPLAY 'CANNOT WRITE TO TRAN FILE ' DTSBE335 01369 ' ' TRAN-STATUS ' ' TRAN-EMP-NO DTSBE335 01370 ELSE DTSBE335 01371 ADD +1 TO WRK-TRAN-CNT DTSBE335 01372 END-IF. DTSBE335 01373 DTSBE335 01374 P2110-EXIT. DTSBE335 01375 EXIT. DTSBE335 01376 DTSBE335 01377 P2120-ANNUAL. DTSBE335 01378 PERFORM P2122-INIT-ANN-TBL THRU P2122-EXIT. DTSBE335 01379 SET WRK-RPT-COMPLETE-NULL-88 TO TRUE. DTSBE335 01380 DTSBE335 01381 DTSBE335 01382 MOVE MRPT-YRQ TO L004-QTR-5-9. DTSBE335 01383 MOVE 4 TO L004-QTR-5-Q. DTSBE335 01384 MOVE L004-QTR-5-9 TO WRK-LAST-ANN-YRQ. DTSBE335 01385 ** DISPLAY 'P2120 LAST ANN YRQ ' MRPT-EMP-NO DTSBE335 01386 ** ' ' WRK-LAST-ANN-YRQ. DTSBE335 01387 DTSBE335 01388 ** MOVE MRPT-BATCH-NO TO WRK-BATCH. DTSBE335 01389 ** MOVE MRPT-ITEM-NO TO WRK-ITEM. DTSBE335 01390 ** MOVE ZERO TO WRK-ANN-REMIT DTSBE335 01391 ** WRK-ANN-TOT-WAGE DTSBE335 01392 ** WRK-ANN-TAX-WAGE DTSBE335 01393 ** WRK-ANN-EXCESS-WAGE. DTSBE335 01394 DTSBE335 01395 PERFORM DTSBE335 01396 UNTIL L910-NO-REC-88 OR WRK-RPT-COMPLETE-YES-88 DTSBE335 01397 MOVE MSKL-REC TO MRPT-REC DTSBE335 01398 IF MRPT-YRQ > WRK-LAST-ANN-YRQ DTSBE335 01399 SET WRK-RPT-COMPLETE-YES-88 TO TRUE DTSBE335 01400 ELSE DTSBE335 01401 PERFORM P2121-SUM-DATA THRU P2121-EXIT DTSBE335 01402 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE335 01403 END-IF DTSBE335 01404 END-PERFORM. DTSBE335 01405 DTSBE335 01406 PERFORM DTSBE335 01407 VARYING ASUB FROM +1 BY +1 DTSBE335 01408 UNTIL ASUB > ASUB-LAST DTSBE335 01409 PERFORM P2123-WRITE THRU P2123-EXIT DTSBE335 01410 END-PERFORM. DTSBE335 01411 DTSBE335 01412 P2120-EXIT. DTSBE335 01413 EXIT. DTSBE335 01414 DTSBE335 01415 P2121-SUM-DATA. DTSBE335 01416 MOVE +0 TO ASUB. DTSBE335 01417 PERFORM DTSBE335 01418 VARYING ASUB1 FROM +1 BY +1 DTSBE335 01419 UNTIL ASUB > +0 DTSBE335 01420 OR ASUB1 > ASUB-LAST DTSBE335 01421 IF WRK-ANN-BATCH (ASUB1) = MRPT-BATCH-NO DTSBE335 01422 AND WRK-ANN-ITEM (ASUB1) = MRPT-ITEM-NO DTSBE335 01423 MOVE ASUB1 TO ASUB DTSBE335 01424 END-IF DTSBE335 01425 END-PERFORM. DTSBE335 01426 DTSBE335 01427 IF ASUB = ZERO DTSBE335 01428 ADD +1 TO ASUB-LAST DTSBE335 01429 MOVE ASUB-LAST TO ASUB DTSBE335 01430 ELSE DTSBE335 01431 ADD MRPT-REMIT-AMT TO WRK-ANN-REMIT (ASUB) DTSBE335 01432 ADD MRPT-TOT-WAGE TO WRK-ANN-TOT-WAGE (ASUB) DTSBE335 01433 ADD MRPT-TAX-WAGE TO WRK-ANN-TAX-WAGE (ASUB) DTSBE335 01434 ADD MRPT-EXCESS-WAGE TO WRK-ANN-EXCESS-WAGE (ASUB) DTSBE335 01435 *& DTSBE335 01436 * MOVE MRPT-TOT-WAGE TO DISPLAY-AMT1 DTSBE335 01437 * MOVE WRK-ANN-TOT-WAGE (ASUB) TO DISPLAY-AMT2 DTSBE335 01438 * DISPLAY 'P2121 - 2 ' MRPT-EMP-NO ' ' MRPT-BATCH-NO DTSBE335 01439 * ' ' MRPT-ITEM-NO DTSBE335 01440 * DISPLAY ' MRPT ' DISPLAY-AMT1 DTSBE335 01441 * ' SUM ' DISPLAY-AMT2 ' ' ASUB DTSBE335 01442 *& DTSBE335 01443 GO TO P2121-EXIT DTSBE335 01444 END-IF. DTSBE335 01445 DTSBE335 01446 MOVE MRPT-RPT-TYPE TO WRK-ANN-RPT-TYPE (ASUB). DTSBE335 01447 MOVE MRPT-YRQ TO WRK-ANN-YRQ (ASUB). DTSBE335 01448 MOVE MRPT-BATCH-NO TO WRK-ANN-BATCH (ASUB). DTSBE335 01449 MOVE MRPT-ITEM-NO TO WRK-ANN-ITEM (ASUB). DTSBE335 01450 ADD MRPT-REMIT-AMT TO WRK-ANN-REMIT (ASUB). DTSBE335 01451 ADD MRPT-TOT-WAGE TO WRK-ANN-TOT-WAGE (ASUB). DTSBE335 01452 ADD MRPT-TAX-WAGE TO WRK-ANN-TAX-WAGE (ASUB). DTSBE335 01453 ADD MRPT-EXCESS-WAGE TO WRK-ANN-EXCESS-WAGE (ASUB). DTSBE335 01454 MOVE MRPT-UI-RATE TO WRK-ANN-RATE (ASUB). DTSBE335 01455 MOVE MRPT-RECEIVED-DATE TO WRK-ANN-RCVD-DT (ASUB). DTSBE335 01456 MOVE MRPT-ESTB-DATE TO WRK-ANN-PROCESS-DT (ASUB). DTSBE335 01457 *& DTSBE335 01458 * MOVE MRPT-TOT-WAGE TO DISPLAY-AMT1. DTSBE335 01459 * MOVE WRK-ANN-TOT-WAGE (ASUB) TO DISPLAY-AMT2. DTSBE335 01460 * DISPLAY 'P2121 - 1 ' MRPT-EMP-NO ' ' MRPT-BATCH-NO DTSBE335 01461 * ' ' MRPT-ITEM-NO. DTSBE335 01462 * DISPLAY ' MRPT ' DISPLAY-AMT1 DTSBE335 01463 * ' SUM ' DISPLAY-AMT2 ' ' ASUB. DTSBE335 01464 *& DTSBE335 01465 P2121-EXIT. DTSBE335 01466 EXIT. DTSBE335 01467 DTSBE335 01468 P2122-INIT-ANN-TBL. DTSBE335 01469 MOVE ZERO TO ASUB-LAST. DTSBE335 01470 PERFORM DTSBE335 01471 VARYING ASUB FROM +1 BY +1 DTSBE335 01472 UNTIL ASUB > ASUB-MAX DTSBE335 01473 MOVE SPACES TO WRK-ANN-RPT-TYPE (ASUB) DTSBE335 01474 MOVE ZERO TO WRK-ANN-YRQ (ASUB) DTSBE335 01475 WRK-ANN-RATE (ASUB) DTSBE335 01476 WRK-ANN-REMIT (ASUB) DTSBE335 01477 WRK-ANN-BATCH (ASUB) DTSBE335 01478 WRK-ANN-ITEM (ASUB) DTSBE335 01479 WRK-ANN-TOT-WAGE (ASUB) DTSBE335 01480 WRK-ANN-TAX-WAGE (ASUB) DTSBE335 01481 WRK-ANN-EXCESS-WAGE (ASUB) DTSBE335 01482 WRK-ANN-RCVD-DT (ASUB) DTSBE335 01483 WRK-ANN-PROCESS-DT (ASUB) DTSBE335 01484 END-PERFORM. DTSBE335 01485 DTSBE335 01486 P2122-EXIT. DTSBE335 01487 EXIT. DTSBE335 01488 DTSBE335 01489 P2123-WRITE. DTSBE335 01490 MOVE WRK-ANN-RPT-TYPE (ASUB) TO TRAN-TRANS. DTSBE335 01491 MOVE WRK-ANN-BATCH (ASUB) TO TRAN-BATCH. DTSBE335 01492 MOVE WRK-ANN-ITEM (ASUB) TO TRAN-ITEM. DTSBE335 01493 MOVE MPRF-EMP-NO TO TRAN-EMP-NO. DTSBE335 01494 MOVE 1 TO WRK-ANN-YRQ-Q (ASUB). DTSBE335 01495 MOVE WRK-ANN-YRQ (ASUB) TO L004-QTR-5-9 DTSBE335 01496 PERFORM S004-FROM-5 THRU S004-EXIT DTSBE335 01497 MOVE L004-SLASH-5-QTR TO TRAN-YRQ DTSBE335 01498 MOVE WRK-ANN-REMIT (ASUB) TO TRAN-AMT. DTSBE335 01499 MOVE WRK-ANN-TOT-WAGE (ASUB) TO TRAN-TOT-WAGE. DTSBE335 01500 MOVE WRK-ANN-TAX-WAGE (ASUB) TO TRAN-TAX-WAGE. DTSBE335 01501 MOVE WRK-ANN-EXCESS-WAGE (ASUB) TO TRAN-EXC-WAGE. DTSBE335 01502 COMPUTE WRK-RATE = (WRK-ANN-RATE (ASUB) * 100). DTSBE335 01503 MOVE WRK-RATE TO TRAN-RATE. DTSBE335 01504 MOVE SPACES TO TRAN-ACCT. DTSBE335 01505 MOVE 'T' TO TRAN-CAT. DTSBE335 01506 SET TRAN-SOURCE-CR-DB-88 TO TRUE. DTSBE335 01507 MOVE WRK-ANN-RCVD-DT (ASUB) TO L001-FED-8-DATE-9. DTSBE335 01508 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBE335 01509 MOVE L001-SLASH-8-DATE TO TRAN-RCVD-DT. DTSBE335 01510 MOVE WRK-ANN-PROCESS-DT (ASUB) TO L001-FED-8-DATE-9. DTSBE335 01511 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBE335 01512 MOVE L001-SLASH-8-DATE TO TRAN-PROCESS-DT. DTSBE335 01513 DTSBE335 01514 WRITE TRAN-REC FROM WRK-TRAN-REC. DTSBE335 01515 IF NOT TRAN-STATUS-OK-88 DTSBE335 01516 DISPLAY 'CANNOT WRITE TO TRAN FILE ' DTSBE335 01517 ' ' TRAN-STATUS ' ' TRAN-EMP-NO DTSBE335 01518 ELSE DTSBE335 01519 ADD +1 TO WRK-TRAN-CNT DTSBE335 01520 END-IF. DTSBE335 01521 DTSBE335 01522 P2123-EXIT. DTSBE335 01523 EXIT. DTSBE335 01524 DTSBE335 01525 P2130-STATUS-CHANGE. DTSBE335 01526 *** DISPLAY 'STATUS ' MRPT-EMP-NO ' ' MRPT-BATCH-NO DTSBE335 01527 *** ' ' MRPT-ITEM-NO. DTSBE335 01528 MOVE LECM-PRIOR-RUN-DATE TO L001-FED-8-DATE-9. DTSBE335 01529 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBE335 01530 MOVE L001-SLASH-8-DATE TO SUMMARY-PROCESS-DT. DTSBE335 01531 MOVE 'STATUS CHANGE ' TO SUMMARY-MESSAGE. DTSBE335 01532 MOVE MRPT-EMP-NO TO SUMMARY-EMP-NO DTSBE335 01533 DTSBE335 01534 MOVE MRPT-BATCH-NO TO SUMMARY-BATCH. DTSBE335 01535 MOVE MRPT-ITEM-NO TO SUMMARY-ITEM. DTSBE335 01536 MOVE MRPT-RPT-TYPE TO SUMMARY-TRAN. DTSBE335 01537 SET SUMMARY-SOURCE-STATUS-88 TO TRUE DTSBE335 01538 DTSBE335 01539 WRITE SUMMARY-REC FROM WRK-SUMMARY-REC. DTSBE335 01540 ADD +1 TO WRK-SUMMARY-CNT. DTSBE335 01541 DTSBE335 01542 P2130-EXIT. DTSBE335 01543 EXIT. DTSBE335 01544 DTSBE335 01545 P2200-PAYMENT. DTSBE335 01546 MOVE LOW-VALUES TO MPAY-KEY-AREA. DTSBE335 01547 MOVE MPRF-EMP-NO TO MPAY-EMP-NO. DTSBE335 01548 SET MPAY-PAY-88 TO TRUE. DTSBE335 01549 MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA. DTSBE335 01550 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE335 01551 IF L910-NO-REC-88 DTSBE335 01552 GO TO P2200-EXIT DTSBE335 01553 ELSE DTSBE335 01554 PERFORM DTSBE335 01555 UNTIL L910-NO-REC-88 DTSBE335 01556 MOVE MSKL-REC TO MPAY-REC DTSBE335 01557 * DISPLAY 'P2200 ' MPRF-EMP-NO ' ' MPAY-BATCH-NO DTSBE335 01558 * ' ' MPAY-ITEM-NO DTSBE335 01559 PERFORM P2210-WRITE THRU P2210-EXIT DTSBE335 01560 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE335 01561 END-PERFORM DTSBE335 01562 END-IF. DTSBE335 01563 DTSBE335 01564 P2200-EXIT. DTSBE335 01565 EXIT. DTSBE335 01566 DTSBE335 01567 P2210-WRITE. DTSBE335 01568 IF MPAY-ESTB-DATE < WRK-SUBJECT-DATE DTSBE335 01569 GO TO P2210-EXIT DTSBE335 01570 END-IF. DTSBE335 01571 MOVE MPAY-PAY-TYPE TO TRAN-TRANS. DTSBE335 01572 IF MPAY-APPLIC-YRQ > ZERO DTSBE335 01573 MOVE MPAY-APPLIC-YRQ TO L004-QTR-5-9 DTSBE335 01574 PERFORM S004-FROM-5 THRU S004-EXIT DTSBE335 01575 MOVE L004-SLASH-5-QTR TO TRAN-YRQ DTSBE335 01576 ELSE DTSBE335 01577 MOVE SPACES TO TRAN-YRQ DTSBE335 01578 END-IF. DTSBE335 01579 MOVE MPRF-EMP-NO TO TRAN-EMP-NO. DTSBE335 01580 MOVE MPAY-BATCH-NO TO TRAN-BATCH. DTSBE335 01581 MOVE MPAY-ITEM-NO TO TRAN-ITEM. DTSBE335 01582 MOVE MPAY-REMIT-AMT TO TRAN-AMT. DTSBE335 01583 DTSBE335 01584 MOVE ZERO TO TRAN-TAX-WAGE DTSBE335 01585 TRAN-TOT-WAGE DTSBE335 01586 TRAN-EXC-WAGE DTSBE335 01587 TRAN-RATE. DTSBE335 01588 MOVE MPAY-APPLIC-IND TO TRAN-ACCT. DTSBE335 01589 MOVE MPAY-APPLIC-BATCH-NO TO TRAN-APPLIC-BATCH. DTSBE335 01590 MOVE MPAY-APPLIC-ITEM-NO TO TRAN-APPLIC-ITEM. DTSBE335 01591 MOVE 'P' TO TRAN-CAT. DTSBE335 01592 SET TRAN-SOURCE-CR-DB-88 TO TRUE. DTSBE335 01593 MOVE MPAY-RECEIVED-DATE TO L001-FED-8-DATE-9. DTSBE335 01594 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBE335 01595 MOVE L001-SLASH-8-DATE TO TRAN-RCVD-DT. DTSBE335 01596 MOVE MPAY-ESTB-DATE TO L001-FED-8-DATE-9. DTSBE335 01597 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBE335 01598 IF L001-VALID-DATE DTSBE335 01599 MOVE L001-SLASH-8-DATE TO TRAN-PROCESS-DT DTSBE335 01600 ELSE DTSBE335 01601 MOVE WRK-DEFAULT-DATE TO TRAN-PROCESS-DT DTSBE335 01602 END-IF. DTSBE335 01603 DTSBE335 01604 WRITE TRAN-REC FROM WRK-TRAN-REC DTSBE335 01605 IF NOT TRAN-STATUS-OK-88 DTSBE335 01606 DISPLAY 'CANNOT WRITE TO TRAN FILE ' DTSBE335 01607 ' ' TRAN-STATUS ' ' TRAN-EMP-NO DTSBE335 01608 ELSE DTSBE335 01609 ADD +1 TO WRK-TRAN-CNT DTSBE335 01610 END-IF. DTSBE335 01611 DTSBE335 01612 P2210-EXIT. DTSBE335 01613 EXIT. DTSBE335 01614 DTSBE335 01615 P2300-ADJUSTMENT. DTSBE335 01616 MOVE LOW-VALUES TO MADJ-KEY-AREA. DTSBE335 01617 MOVE MPRF-EMP-NO TO MADJ-EMP-NO. DTSBE335 01618 SET MADJ-ADJ-88 TO TRUE. DTSBE335 01619 MOVE MADJ-KEY-AREA TO MSKL-KEY-AREA. DTSBE335 01620 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE335 01621 IF L910-NO-REC-88 DTSBE335 01622 GO TO P2300-EXIT DTSBE335 01623 ELSE DTSBE335 01624 PERFORM DTSBE335 01625 UNTIL L910-NO-REC-88 DTSBE335 01626 MOVE MSKL-REC TO MADJ-REC DTSBE335 01627 * DISPLAY 'P2123 ' MPRF-EMP-NO ' ' MADJ-BATCH-NO DTSBE335 01628 * ' ' MADJ-ITEM-NO DTSBE335 01629 PERFORM P2310-WRITE THRU P2310-EXIT DTSBE335 01630 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE335 01631 END-PERFORM DTSBE335 01632 END-IF. DTSBE335 01633 DTSBE335 01634 P2300-EXIT. DTSBE335 01635 EXIT. DTSBE335 01636 DTSBE335 01637 P2310-WRITE. DTSBE335 01638 IF MADJ-ESTB-DATE < WRK-SUBJECT-DATE DTSBE335 01639 GO TO P2310-EXIT DTSBE335 01640 END-IF. DTSBE335 01641 IF MADJ-CHRG-88 DTSBE335 01642 OR MADJ-WAIVE-88 DTSBE335 01643 OR MADJ-TOLER-88 DTSBE335 01644 OR MADJ-WRITE-OFF-88 DTSBE335 01645 OR MADJ-WRITE-OFF-REV-88 DTSBE335 01646 NEXT SENTENCE DTSBE335 01647 ELSE DTSBE335 01648 GO TO P2310-EXIT DTSBE335 01649 END-IF. DTSBE335 01650 MOVE MADJ-ADJ-TYPE TO TRAN-TRANS. DTSBE335 01651 MOVE MADJ-BATCH-NO TO TRAN-BATCH. DTSBE335 01652 MOVE MADJ-ITEM-NO TO TRAN-ITEM. DTSBE335 01653 IF MADJ-APPLIC-YRQ > ZERO DTSBE335 01654 MOVE MADJ-APPLIC-YRQ TO L004-QTR-5-9 DTSBE335 01655 PERFORM S004-FROM-5 THRU S004-EXIT DTSBE335 01656 MOVE L004-SLASH-5-QTR TO TRAN-YRQ DTSBE335 01657 ELSE DTSBE335 01658 MOVE SPACES TO TRAN-YRQ DTSBE335 01659 END-IF. DTSBE335 01660 MOVE MPRF-EMP-NO TO TRAN-EMP-NO. DTSBE335 01661 MOVE MADJ-AMT TO TRAN-AMT. DTSBE335 01662 DTSBE335 01663 MOVE ZERO TO TRAN-TOT-WAGE DTSBE335 01664 TRAN-TAX-WAGE DTSBE335 01665 TRAN-EXC-WAGE DTSBE335 01666 TRAN-RATE. DTSBE335 01667 MOVE MADJ-APPLIC-IND TO TRAN-ACCT. DTSBE335 01668 MOVE MADJ-APPLIC-BATCH-NO TO TRAN-APPLIC-BATCH. DTSBE335 01669 MOVE MADJ-APPLIC-ITEM-NO TO TRAN-APPLIC-ITEM. DTSBE335 01670 MOVE 'A' TO TRAN-CAT. DTSBE335 01671 SET TRAN-SOURCE-CR-DB-88 TO TRUE. DTSBE335 01672 MOVE MADJ-RECEIVED-DATE TO L001-FED-8-DATE-9. DTSBE335 01673 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBE335 01674 MOVE L001-SLASH-8-DATE TO TRAN-RCVD-DT. DTSBE335 01675 MOVE MADJ-ESTB-DATE TO L001-FED-8-DATE-9. DTSBE335 01676 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBE335 01677 IF L001-VALID-DATE DTSBE335 01678 MOVE L001-SLASH-8-DATE TO TRAN-PROCESS-DT DTSBE335 01679 ELSE DTSBE335 01680 MOVE WRK-DEFAULT-DATE TO TRAN-PROCESS-DT DTSBE335 01681 END-IF. DTSBE335 01682 DTSBE335 01683 WRITE TRAN-REC FROM WRK-TRAN-REC DTSBE335 01684 IF NOT TRAN-STATUS-OK-88 DTSBE335 01685 DISPLAY 'CANNOT WRITE TO TRAN FILE ' DTSBE335 01686 ' ' TRAN-STATUS ' ' TRAN-EMP-NO DTSBE335 01687 ELSE DTSBE335 01688 ADD +1 TO WRK-TRAN-CNT DTSBE335 01689 END-IF. DTSBE335 01690 DTSBE335 01691 P2310-EXIT. DTSBE335 01692 EXIT. DTSBE335 01693 DTSBE335 01694 P3000-QUARTER. DTSBE335 01695 DTSBE335 01696 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBE335 01697 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBE335 01698 SET MQTR-QTR-88 TO TRUE. DTSBE335 01699 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBE335 01700 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE335 01701 PERFORM UNTIL L910-NO-REC-88 DTSBE335 01702 MOVE MSKL-REC TO MQTR-REC DTSBE335 01703 MOVE ZERO TO WRK-QTR-BAL DTSBE335 01704 IF MPRF-TOT-BALANCE-AMT > ZERO DTSBE335 01705 PERFORM P3010-BAL-DUE THRU P3010-EXIT DTSBE335 01706 END-IF DTSBE335 01707 IF MQTR-YRQ >= WRK-EMP-START-YRQ DTSBE335 01708 PERFORM P3100-BUILD-QTR THRU P3100-EXIT DTSBE335 01709 ELSE DTSBE335 01710 PERFORM P3200-START-BAL THRU P3200-EXIT DTSBE335 01711 IF MQTR-CURR-MISSING-88 DTSBE335 01712 OR WRK-QTR-BAL > ZERO DTSBE335 01713 PERFORM P3100-BUILD-QTR THRU P3100-EXIT DTSBE335 01714 END-IF DTSBE335 01715 END-IF DTSBE335 01716 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE335 01717 END-PERFORM. DTSBE335 01718 DTSBE335 01719 P3000-EXIT. DTSBE335 01720 EXIT. DTSBE335 01721 DTSBE335 01722 P3010-BAL-DUE. DTSBE335 01723 PERFORM DTSBE335 01724 VARYING MQTR-ACCT-IDX FROM +1 BY +1 DTSBE335 01725 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSBE335 01726 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) TO WRK-QTR-BAL DTSBE335 01727 END-PERFORM. DTSBE335 01728 DTSBE335 01729 P3010-EXIT. DTSBE335 01730 EXIT. DTSBE335 01731 DTSBE335 01732 P3100-BUILD-QTR. DTSBE335 01733 MOVE MQTR-EMP-NO TO QTR-EMP-NO. DTSBE335 01734 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSBE335 01735 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE335 01736 IF L004-VALID-QTR DTSBE335 01737 MOVE L004-SLASH-5-QTR TO QTR-QUARTER DTSBE335 01738 ELSE DTSBE335 01739 GO TO P3100-EXIT DTSBE335 01740 END-IF. DTSBE335 01741 MOVE MQTR-CURR-RPT-TYPE TO QTR-RPT-STATUS. DTSBE335 01742 MOVE MQTR-RPT-DUE-DATE TO L001-FED-8-DATE-9. DTSBE335 01743 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBE335 01744 MOVE L001-SLASH-8-DATE TO QTR-DUE-DT. DTSBE335 01745 MOVE WRK-QTR-BAL TO QTR-BAL-DUE. DTSBE335 01746 DTSBE335 01747 WRITE QTR-REC FROM WRK-QTR-REC DTSBE335 01748 IF NOT QTR-STATUS-OK-88 DTSBE335 01749 DISPLAY 'CANNOT WRITE TO QTR FILE ' DTSBE335 01750 ' ' QTR-STATUS ' ' QTR-EMP-NO DTSBE335 01751 ELSE DTSBE335 01752 ADD +1 TO WRK-QTR-CNT DTSBE335 01753 END-IF. DTSBE335 01754 DTSBE335 01755 P3100-EXIT. DTSBE335 01756 EXIT. DTSBE335 01757 DTSBE335 01758 P3200-START-BAL. DTSBE335 01759 MOVE ZERO TO WRK-UI-BAL DTSBE335 01760 WRK-SU-BAL DTSBE335 01761 WRK-LP-BAL DTSBE335 01762 WRK-NP-BAL DTSBE335 01763 WRK-MP-BAL DTSBE335 01764 WRK-INT-BAL. DTSBE335 01765 DTSBE335 01766 PERFORM DTSBE335 01767 VARYING MQTR-ACCT-IDX FROM +1 BY +1 DTSBE335 01768 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSBE335 01769 EVALUATE TRUE DTSBE335 01770 WHEN MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSBE335 01771 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBE335 01772 TO WRK-UI-BAL DTSBE335 01773 DTSBE335 01774 WHEN MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) DTSBE335 01775 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBE335 01776 TO WRK-SU-BAL DTSBE335 01777 DTSBE335 01778 WHEN MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX) DTSBE335 01779 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBE335 01780 TO WRK-LP-BAL DTSBE335 01781 DTSBE335 01782 WHEN MQTR-ACCT-MISC-PEN-88 (MQTR-ACCT-IDX) DTSBE335 01783 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBE335 01784 TO WRK-MP-BAL DTSBE335 01785 DTSBE335 01786 WHEN MQTR-ACCT-NSF-PEN-88 (MQTR-ACCT-IDX) DTSBE335 01787 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBE335 01788 TO WRK-NP-BAL DTSBE335 01789 DTSBE335 01790 WHEN MQTR-ACCT-INT-88 (MQTR-ACCT-IDX) DTSBE335 01791 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBE335 01792 TO WRK-INT-BAL DTSBE335 01793 DTSBE335 01794 END-EVALUATE DTSBE335 01795 END-PERFORM. DTSBE335 01796 DTSBE335 01797 * IF MQTR-EMP-NO = 030450 DTSBE335 01798 * IF MQTR-YRQ > 20041 DTSBE335 01799 * IF WRK-UI-BAL NOT = ZERO DTSBE335 01800 * OR WRK-LP-BAL NOT = ZERO DTSBE335 01801 * OR WRK-NP-BAL NOT = ZERO DTSBE335 01802 * OR WRK-INT-BAL NOT = ZERO DTSBE335 01803 * DISPLAY 'P3200 ' MPRF-EMP-NO ' ' MQTR-YRQ. DTSBE335 01804 DTSBE335 01805 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSBE335 01806 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE335 01807 IF L004-VALID-QTR DTSBE335 01808 MOVE L004-SLASH-5-QTR TO ACCT-YRQ DTSBE335 01809 ELSE DTSBE335 01810 GO TO P3200-EXIT DTSBE335 01811 END-IF. DTSBE335 01812 MOVE ZERO TO ACCT-BATCH DTSBE335 01813 ACCT-ITEM. DTSBE335 01814 MOVE MPRF-EMP-NO TO ACCT-EMP-NO. DTSBE335 01815 MOVE 'SB' TO ACCT-TRAN. DTSBE335 01816 MOVE 'B' TO ACCT-CAT. DTSBE335 01817 MOVE MQTR-ESTB-DATE TO L001-FED-8-DATE-9. DTSBE335 01818 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBE335 01819 IF L001-VALID-DATE DTSBE335 01820 MOVE L001-SLASH-8-DATE TO ACCT-PROCESS-DT DTSBE335 01821 ELSE DTSBE335 01822 MOVE WRK-DEFAULT-DATE TO ACCT-PROCESS-DT DTSBE335 01823 END-IF. DTSBE335 01824 DTSBE335 01825 SET ACCT-SOURCE-CR-DB-88 TO TRUE. DTSBE335 01826 DTSBE335 01827 IF WRK-UI-BAL NOT = ZERO DTSBE335 01828 MOVE 'UI' TO ACCT-ROW DTSBE335 01829 MOVE 'CH' TO ACCT-COL DTSBE335 01830 MOVE WRK-UI-BAL TO ACCT-AMT DTSBE335 01831 PERFORM P3210-WRITE-ACCT THRU P3210-EXIT DTSBE335 01832 END-IF. DTSBE335 01833 DTSBE335 01834 IF WRK-SU-BAL NOT = ZERO DTSBE335 01835 MOVE 'SU' TO ACCT-ROW DTSBE335 01836 MOVE 'CH' TO ACCT-COL DTSBE335 01837 MOVE WRK-SU-BAL TO ACCT-AMT DTSBE335 01838 PERFORM P3210-WRITE-ACCT THRU P3210-EXIT DTSBE335 01839 END-IF. DTSBE335 01840 DTSBE335 01841 IF WRK-LP-BAL NOT = ZERO DTSBE335 01842 MOVE 'LP' TO ACCT-ROW DTSBE335 01843 MOVE 'CH' TO ACCT-COL DTSBE335 01844 MOVE WRK-LP-BAL TO ACCT-AMT DTSBE335 01845 PERFORM P3210-WRITE-ACCT THRU P3210-EXIT DTSBE335 01846 END-IF. DTSBE335 01847 DTSBE335 01848 IF WRK-NP-BAL NOT = ZERO DTSBE335 01849 MOVE 'NP' TO ACCT-ROW DTSBE335 01850 MOVE 'CH' TO ACCT-COL DTSBE335 01851 MOVE WRK-NP-BAL TO ACCT-AMT DTSBE335 01852 PERFORM P3210-WRITE-ACCT THRU P3210-EXIT DTSBE335 01853 END-IF. DTSBE335 01854 DTSBE335 01855 IF WRK-MP-BAL NOT = ZERO DTSBE335 01856 MOVE 'MP' TO ACCT-ROW DTSBE335 01857 MOVE 'CH' TO ACCT-COL DTSBE335 01858 MOVE WRK-MP-BAL TO ACCT-AMT DTSBE335 01859 PERFORM P3210-WRITE-ACCT THRU P3210-EXIT DTSBE335 01860 END-IF. DTSBE335 01861 DTSBE335 01862 IF WRK-INT-BAL NOT = ZERO DTSBE335 01863 MOVE 'I ' TO ACCT-ROW DTSBE335 01864 MOVE 'CH' TO ACCT-COL DTSBE335 01865 MOVE WRK-INT-BAL TO ACCT-AMT DTSBE335 01866 PERFORM P3210-WRITE-ACCT THRU P3210-EXIT DTSBE335 01867 END-IF. DTSBE335 01868 DTSBE335 01869 P3200-EXIT. DTSBE335 01870 EXIT. DTSBE335 01871 DTSBE335 01872 P3210-WRITE-ACCT. DTSBE335 01873 WRITE ACCT-REC FROM WRK-ACCT-REC DTSBE335 01874 IF NOT ACCT-STATUS-OK-88 DTSBE335 01875 DISPLAY 'CANNOT WRITE TO ACCT FILE ' DTSBE335 01876 ' ' ACCT-STATUS ' ' ACCT-EMP-NO DTSBE335 01877 ELSE DTSBE335 01878 ADD +1 TO WRK-ACCT-CNT DTSBE335 01879 END-IF. DTSBE335 01880 DTSBE335 01881 IF MQTR-EMP-NO = 030450 DTSBE335 01882 IF MQTR-YRQ > 20041 DTSBE335 01883 DISPLAY 'P3210 ' MPRF-EMP-NO ' ' MQTR-YRQ DTSBE335 01884 ' ' ACCT-TRAN ' ' ACCT-ROW ' ' ACCT-COL DTSBE335 01885 ' ' ACCT-AMT. DTSBE335 01886 P3210-EXIT. DTSBE335 01887 EXIT. DTSBE335 01888 DTSBE335 01889 P4000-RATE. DTSBE335 01890 MOVE LOW-VALUES TO MRTE-KEY-AREA. DTSBE335 01891 MOVE MPRF-EMP-NO TO MRTE-EMP-NO. DTSBE335 01892 SET MRTE-RTE-88 TO TRUE. DTSBE335 01893 MOVE MRTE-KEY-AREA TO MSKL-KEY-AREA. DTSBE335 01894 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE335 01895 PERFORM UNTIL L910-NO-REC-88 DTSBE335 01896 MOVE MSKL-REC TO MRTE-REC DTSBE335 01897 PERFORM P4100-BUILD-RATE THRU P4100-EXIT DTSBE335 01898 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE335 01899 END-PERFORM. DTSBE335 01900 DTSBE335 01901 P4000-EXIT. DTSBE335 01902 EXIT. DTSBE335 01903 DTSBE335 01904 P4100-BUILD-RATE. DTSBE335 01905 MOVE MPRF-EMP-NO TO RATE-EMP-NO. DTSBE335 01906 MOVE MRTE-EFF-YRQ TO L004-QTR-5-9. DTSBE335 01907 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE335 01908 MOVE L004-SLASH-5-QTR TO RATE-EFF-QTR. DTSBE335 01909 COMPUTE WRK-RATE = (MRTE-UI-RATE * 100). DTSBE335 01910 MOVE WRK-RATE TO RATE-UI-RATE. DTSBE335 01911 MOVE MRTE-ESTB-DATE TO L001-FED-8-DATE-9. DTSBE335 01912 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBE335 01913 IF L001-VALID-DATE DTSBE335 01914 MOVE L001-SLASH-8-DATE TO RATE-PROCESS-DT DTSBE335 01915 ELSE DTSBE335 01916 MOVE WRK-DEFAULT-DATE TO RATE-PROCESS-DT DTSBE335 01917 END-IF. DTSBE335 01918 DTSBE335 01919 WRITE RATE-REC FROM WRK-RATE-REC DTSBE335 01920 IF NOT RATE-STATUS-OK-88 DTSBE335 01921 DISPLAY 'CANNOT WRITE TO RATE FILE ' DTSBE335 01922 ' ' RATE-STATUS ' ' RATE-EMP-NO DTSBE335 01923 ELSE DTSBE335 01924 ADD +1 TO WRK-RATE-CNT DTSBE335 01925 END-IF. DTSBE335 01926 DTSBE335 01927 P4100-EXIT. DTSBE335 01928 EXIT. DTSBE335 01929 DTSBE335 01930 P5000-QTR-COLL. DTSBE335 01931 MOVE LOW-VALUES TO MEVL-KEY-AREA. DTSBE335 01932 MOVE MPRF-EMP-NO TO MEVL-EMP-NO. DTSBE335 01933 SET MEVL-EVL-88 TO TRUE. DTSBE335 01934 MOVE MEVL-KEY-AREA TO MSKL-KEY-AREA. DTSBE335 01935 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE335 01936 PERFORM UNTIL L910-NO-REC-88 DTSBE335 01937 MOVE MSKL-REC TO MEVL-REC DTSBE335 01938 PERFORM P5100-BUILD-QCOLL THRU P5100-EXIT DTSBE335 01939 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE335 01940 END-PERFORM. DTSBE335 01941 DTSBE335 01942 P5000-EXIT. DTSBE335 01943 EXIT. DTSBE335 01944 DTSBE335 01945 P5100-BUILD-QCOLL. DTSBE335 01946 IF MEVL-SOURCE-SYSTEM-88 DTSBE335 01947 IF MEVL-TEXT (1:14) = 'MISSING REPORT' DTSBE335 01948 OR MEVL-TEXT (1:13) = 'FINAL MISSING' DTSBE335 01949 OR MEVL-TEXT (1:5) = 'DEBIT' DTSBE335 01950 NEXT SENTENCE DTSBE335 01951 ELSE DTSBE335 01952 GO TO P5100-EXIT DTSBE335 01953 END-IF DTSBE335 01954 ELSE DTSBE335 01955 GO TO P5100-EXIT DTSBE335 01956 END-IF. DTSBE335 01957 DTSBE335 01958 *& DTSBE335 01959 * DISPLAY 'P5100 ' MPRF-EMP-NO ' ' MEVL-TEXT (1:14) DTSBE335 01960 * ' ' MEVL-TEXT (27:4) ' ' MEVL-TEXT (30:4). DTSBE335 01961 *& DTSBE335 01962 MOVE MPRF-EMP-NO TO QTR-COLL-EMP-NO. DTSBE335 01963 IF MEVL-TEXT (1:14) = 'MISSING REPORT' DTSBE335 01964 SET QTR-COLL-FIRST-DELINQ-88 TO TRUE DTSBE335 01965 MOVE MEVL-TEXT (27:4) TO WRK-QTR-3-AREA DTSBE335 01966 MOVE WRK-QTR-3-YY TO L004-QTR-3-YR DTSBE335 01967 MOVE WRK-QTR-3-Q TO L004-QTR-3-Q DTSBE335 01968 PERFORM S004-FROM-3 THRU S004-EXIT DTSBE335 01969 IF L004-VALID-QTR DTSBE335 01970 MOVE L004-SLASH-5-QTR TO QTR-COLL-QUARTER DTSBE335 01971 ELSE DTSBE335 01972 MOVE SPACES TO QTR-COLL-QUARTER DTSBE335 01973 END-IF DTSBE335 01974 END-IF. DTSBE335 01975 DTSBE335 01976 IF MEVL-TEXT (1:13) = 'FINAL MISSING' DTSBE335 01977 SET QTR-COLL-FINAL-DELINQ-88 TO TRUE DTSBE335 01978 MOVE MEVL-TEXT (30:4) TO WRK-QTR-3-AREA DTSBE335 01979 MOVE WRK-QTR-3-YY TO L004-QTR-3-YR DTSBE335 01980 MOVE WRK-QTR-3-Q TO L004-QTR-3-Q DTSBE335 01981 PERFORM S004-FROM-3 THRU S004-EXIT DTSBE335 01982 IF L004-VALID-QTR DTSBE335 01983 MOVE L004-SLASH-5-QTR TO QTR-COLL-QUARTER DTSBE335 01984 ELSE DTSBE335 01985 MOVE SPACES TO QTR-COLL-QUARTER DTSBE335 01986 END-IF DTSBE335 01987 END-IF. DTSBE335 01988 DTSBE335 01989 MOVE MEVL-ESTB-DATE TO L001-FED-8-DATE-9. DTSBE335 01990 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBE335 01991 IF L001-VALID-DATE DTSBE335 01992 MOVE L001-SLASH-8-DATE TO QTR-COLL-PROCESS-DT DTSBE335 01993 ELSE DTSBE335 01994 MOVE WRK-DEFAULT-DATE TO QTR-COLL-PROCESS-DT DTSBE335 01995 END-IF. DTSBE335 01996 DTSBE335 01997 MOVE MEVL-SOURCE TO QTR-COLL-OPID. DTSBE335 01998 DTSBE335 01999 WRITE QTR-COLL-REC FROM WRK-QTR-COLL-REC DTSBE335 02000 IF NOT QCOLL-STATUS-OK-88 DTSBE335 02001 DISPLAY 'CANNOT WRITE TO QTR COLL FILE ' DTSBE335 02002 ' ' QCOLL-STATUS ' ' QTR-COLL-EMP-NO DTSBE335 02003 ELSE DTSBE335 02004 ADD +1 TO WRK-QCOLL-CNT DTSBE335 02005 END-IF. DTSBE335 02006 DTSBE335 02007 P5100-EXIT. DTSBE335 02008 EXIT. DTSBE335 02009 DTSBE335 02010 DTSBE335 02011 T0000-TERMINATE. DTSBE335 02012 CLOSE PROFILE-FILE DTSBE335 02013 DETERM-FILE DTSBE335 02014 FSCHED-FILE DTSBE335 02015 ADDRESS-FILE DTSBE335 02016 ACCT-FILE DTSBE335 02017 TRAN-FILE DTSBE335 02018 QTR-FILE DTSBE335 02019 RATE-FILE DTSBE335 02020 SUMMARY-FILE DTSBE335 02021 QTR-COLL-FILE. DTSBE335 02022 DTSBE335 02023 DTSBE335 02024 DISPLAY '*********************************************'. DTSBE335 02025 DISPLAY '** DTSBE335 TERMINATION STATISTICS **'. DTSBE335 02026 DISPLAY '** **'. DTSBE335 02027 DISPLAY '** ACCT ' WRK-ACCT-CNT DTSBE335 02028 ' **'. DTSBE335 02029 DISPLAY '** TRAN ' WRK-TRAN-CNT DTSBE335 02030 ' **'. DTSBE335 02031 DISPLAY '** QTR ' WRK-QTR-CNT DTSBE335 02032 ' **'. DTSBE335 02033 DISPLAY '** PRF ' WRK-PRF-CNT DTSBE335 02034 ' **'. DTSBE335 02035 DISPLAY '** DET ' WRK-DET-CNT DTSBE335 02036 ' **'. DTSBE335 02037 DISPLAY '** FSC ' WRK-FSC-CNT DTSBE335 02038 ' **'. DTSBE335 02039 DISPLAY '** **'. DTSBE335 02040 DISPLAY '** INACTIVE ' WRK-INACT-CNT DTSBE335 02041 ' **'. DTSBE335 02042 DISPLAY '** **'. DTSBE335 02043 DISPLAY '*********************************************'. DTSBE335 02044 DTSBE335 02045 T0000-EXIT. DTSBE335 02046 EXIT. DTSBE335 02047 DTSBE335 02048 S001-FROM-FED-8. DTSBE335 02049 SET L001-FROM-FED-8 TO TRUE. DTSBE335 02050 GO TO S001-DATE. DTSBE335 02051 DTSBE335 02052 S001-FROM-ABS-DAY. DTSBE335 02053 SET L001-FROM-ABS-DAY TO TRUE. DTSBE335 02054 GO TO S001-DATE. DTSBE335 02055 DTSBE335 02056 S001-FROM-CAL-6. DTSBE335 02057 SET L001-FROM-CAL-6 TO TRUE. DTSBE335 02058 GO TO S001-DATE. DTSBE335 02059 DTSBE335 02060 S001-DATE. DTSBE335 02061 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBE335 02062 S001-EXIT. DTSBE335 02063 EXIT. DTSBE335 02064 SKIP3 DTSBE335 02065 S004-FROM-5. DTSBE335 02066 SET L004-FROM-5 TO TRUE. DTSBE335 02067 GO TO S004-QTR. DTSBE335 02068 DTSBE335 02069 S004-FROM-ABS. DTSBE335 02070 SET L004-FROM-ABS TO TRUE. DTSBE335 02071 GO TO S004-QTR. DTSBE335 02072 DTSBE335 02073 S004-FROM-3. DTSBE335 02074 SET L004-FROM-3 TO TRUE. DTSBE335 02075 GO TO S004-QTR. DTSBE335 02076 DTSBE335 02077 S004-FROM-DATE. DTSBE335 02078 SET L004-FROM-DATE TO TRUE. DTSBE335 02079 GO TO S004-QTR. DTSBE335 02080 DTSBE335 02081 S004-QTR. DTSBE335 02082 DTSBE335 02083 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBE335 02084 DTSBE335 02085 S004-EXIT. DTSBE335 02086 EXIT. DTSBE335 02087 SKIP3 DTSBE335 02088 S005-FROM-DATE-TIME. DTSBE335 02089 SET L005-FROM-DATE-TIME TO TRUE. DTSBE335 02090 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBE335 02091 S005-EXIT. DTSBE335 02092 EXIT. DTSBE335 02093 DTSBE335 02094 S910-READ. DTSBE335 02095 SET L910-READ-88 TO TRUE. DTSBE335 02096 GO TO S910-MSTR-IO. DTSBE335 02097 DTSBE335 02098 S910-START-BROWSE. DTSBE335 02099 SET L910-START-BROWSE-88 TO TRUE. DTSBE335 02100 GO TO S910-MSTR-IO. DTSBE335 02101 DTSBE335 02102 S910-READ-NEXT. DTSBE335 02103 SET L910-READ-NEXT-88 TO TRUE. DTSBE335 02104 GO TO S910-MSTR-IO. DTSBE335 02105 DTSBE335 02106 *S910-COUNT. DTSBE335 02107 *****SET L910-COUNT-88 TO TRUE. DTSBE335 02108 *****GO TO S910-MSTR-IO. DTSBE335 02109 DTSBE335 02110 S910-REWRITE. DTSBE335 02111 SET L910-REWRITE-88 TO TRUE. DTSBE335 02112 SET LECM-EMP-UPDATED-YES-88 TO TRUE. DTSBE335 02113 GO TO S910-MSTR-IO. DTSBE335 02114 DTSBE335 02115 S910-MSTR-IO. DTSBE335 02116 CALL 'DTSBU910' USING L910-LINK-AREA DTSBE335 02117 MSKL-REC. DTSBE335 02118 S910-EXIT. DTSBE335 02119 EXIT. DTSBE335 02120 SKIP3 DTSBE335 02121 DTSBE335 02122 S931-READ. DTSBE335 02123 SET L931-READ-88 TO TRUE. DTSBE335 02124 GO TO S931-REF-IO. DTSBE335 02125 DTSBE335 02126 S931-REF-IO. DTSBE335 02127 CALL 'DTSBU931' USING L931-LINK-AREA DTSBE335 02128 FSKL-REC. DTSBE335 02129 S931-EXIT. DTSBE335 02130 EXIT. DTSBE335 02131 DTSBE335 02132 S999-ABEND. DTSBE335 02133 DISPLAY '*** DTSBE335 ABENDING. ' DTSBE335 02134 ABEND-MSG. DTSBE335 02135 DTSBE335 02136 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBE335 02137 S999-EXIT. DTSBE335 02138 EXIT. DTSBE335