giteaadmin/DUTAS
4
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
62d95f14f0cb5df07cf30450e671122a13fe012d
DUTAS/Batch/DTSBE335.cob
Neeraj Kumar ca3572c5df DUTAS re-platformed to Raincode - Initial Source Code
2025-07-21 11:20:11 -04:00

2140 lines
169 KiB
COBOL
Raw Blame History

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
Reference in New Issue View Git Blame Copy Permalink