00001 IDENTIFICATION DIVISION. 09/11/08 00002 PROGRAM-ID. DTSBX342. DTSBX342 00003 AUTHOR. NGC. LV004 00004 DATE-WRITTEN. OCTOBER 2007. DTSBX342 00005 DATE-COMPILED. DTSBX342 00006 SKIP3 DTSBX342 00007 ***** DTSBX342 00008 * DTSBX342 00009 * FUNCTION: INTERNAL WEB MAINFRAME EXTRACT - ACCOUNTING DTSBX342 00010 * >>> DAILY INCREMENTAL UPDATE <<< DTSBX342 00011 * FOR INITIAL CONVERSION, USE DTSBX343 DTSBX342 00012 * DTSBX342 00013 * MODIFICATION LOG: DTSBX342 00014 * DTSBX342 00015 * 10/22/2007 INITIAL DEVELOPMENT. DTSBX342 00016 * REFERENCE: PROGRAMMER: GD DTSBX342 00017 * DTSBX342 00018 * 04/27/2008 CORRECTED SELECTION FOR REPORTS IN P3100. DTSBX342 00019 * THE PROCESS THAT ATTEMPTED TO COMBINE 4 DTSBX342 00020 * QUARTERLY REPORTS INTO ONE ANNUAL REPORT DTSBX342 00021 * HAD A PROBLEM WITH THE READS AND RESULTED DTSBX342 00022 * IN SOME NON-ANNUAL REPORTS BEING BYPASSED. DTSBX342 00023 * THE ANNUAL REPORTS ARE NOW WRITTEN IN DTSBX342 00024 * EXACTLY THE SAME WAY AS QUARTERLY REPORTS. DTSBX342 00025 * REFERENCE: PROGRAMMER: GD DTSBX342 00026 * DTSBX342 00027 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX342 00028 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX342 00029 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBX342 00030 * DTSBX342 00031 * DTSBX342 00032 * DESCRIPTION: DTSBX342 00033 * DTSBX342 00034 * DTSBX342 00035 * INITIATION: DTSBX342 00036 * DTSBX342 00037 * DTSBX342 00038 * DTSBX342 00039 * PROCESSING: DTSBX342 00040 * DTSBX342 00041 * DTSBX342 00042 * TERMINATION: DTSBX342 00043 * DTSBX342 00044 * DTSBX342 00045 * DTSBX342 00046 * RECORDS READ: DTSBX342 00047 * DTSBX342 00048 * MASTER: DTSBX342 00049 * DTSBX342 00050 * MSOL DTSBX342 00051 * MQTR DTSBX342 00052 * DTSBX342 00053 * DTSBX342 00054 * ALTERNATE INDEX: DTSBX342 00055 * DTSBX342 00056 * NONE. DTSBX342 00057 * DTSBX342 00058 * DTSBX342 00059 * REFERENCE: DTSBX342 00060 * DTSBX342 00061 * DTSBX342 00062 * DTSBX342 00063 * RECORDS UPDATED: DTSBX342 00064 * DTSBX342 00065 * NONE DTSBX342 00066 * DTSBX342 00067 * DTSBX342 00068 * OUTPUT RECORDS WRITTEN: DTSBX342 00069 * DTSBX342 00070 * DTSBX331 DTSBX342 00071 * DTSBX342 00072 * DTSBX342 00073 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBX342 00074 * DTSBX342 00075 * NONE. DTSBX342 00076 * DTSBX342 00077 * DTSBX342 00078 * MODULES CALLED: DTSBX342 00079 * DTSBX342 00080 * DTSBU001 DATE EDIT/CONVERSION. DTSBX342 00081 * DTSBU004 QUARTER EDIT/CONVERSION. DTSBX342 00082 * DTSBU910 MASTER FILE I/O. DTSBX342 00083 * DTSBX342 00084 * DTSBX342 00085 * DTSBX342 00086 ***** DTSBX342 00087 SKIP3 DTSBX342 00088 ENVIRONMENT DIVISION. DTSBX342 00089 INPUT-OUTPUT SECTION. DTSBX342 00090 FILE-CONTROL. DTSBX342 00091 SELECT ACCT-FILE ASSIGN TO DTSFACC2 DTSBX342 00092 FILE STATUS IS ACCT-STATUS. DTSBX342 00093 DTSBX342 00094 SELECT TRAN-FILE ASSIGN TO DTSFTRN2 DTSBX342 00095 FILE STATUS IS TRAN-STATUS. DTSBX342 00096 DTSBX342 00097 SELECT QTR-FILE ASSIGN TO DTSFQTR2 DTSBX342 00098 FILE STATUS IS QTR-STATUS. DTSBX342 00099 DTSBX342 00100 SELECT SUMMARY-FILE ASSIGN TO DTSFSUM2 DTSBX342 00101 FILE STATUS IS SUMMARY-STATUS. DTSBX342 00102 DTSBX342 00103 SELECT PAY-DIST-FILE ASSIGN TO DTSFDST2 DTSBX342 00104 FILE STATUS IS PAYDIST-STATUS. DTSBX342 00105 DTSBX342 00106 DATA DIVISION. DTSBX342 00107 FILE SECTION. DTSBX342 00108 FD ACCT-FILE DTSBX342 00109 RECORDING MODE IS F DTSBX342 00110 LABEL RECORDS ARE STANDARD DTSBX342 00111 BLOCK CONTAINS 0 CHARACTERS. DTSBX342 00112 DTSBX342 00113 01 ACCT-REC PIC X(61). DTSBX342 00114 DTSBX342 00115 FD TRAN-FILE DTSBX342 00116 RECORDING MODE IS F DTSBX342 00117 LABEL RECORDS ARE STANDARD DTSBX342 00118 BLOCK CONTAINS 0 CHARACTERS. DTSBX342 00119 DTSBX342 00120 01 TRAN-REC PIC X(128). DTSBX342 00121 DTSBX342 00122 FD QTR-FILE DTSBX342 00123 RECORDING MODE IS F DTSBX342 00124 LABEL RECORDS ARE STANDARD DTSBX342 00125 BLOCK CONTAINS 0 CHARACTERS. DTSBX342 00126 DTSBX342 00127 01 QTR-REC PIC X(52). DTSBX342 00128 DTSBX342 00129 FD SUMMARY-FILE DTSBX342 00130 RECORDING MODE IS F. DTSBX342 00131 01 SUMMARY-REC PIC X(73). DTSBX342 00132 DTSBX342 00133 FD PAY-DIST-FILE DTSBX342 00134 RECORDING MODE IS F. DTSBX342 00135 01 PAY-DIST-REC PIC X(50). DTSBX342 00136 DTSBX342 00137 WORKING-STORAGE SECTION. DTSBX342 001375 77 PAN-VALET PICTURE X(24) VALUE '004DTSBX342 09/11/08'. DTSBX342 00138 SKIP3 DTSBX342 00139 01 W-AREA. DTSBX342 00140 05 W-ABEND-CD PIC S9(04) COMP VALUE +342.DTSBX342 00141 DTSBX342 00142 DTSBX342 00143 05 ABEND-MSG PIC X(60). DTSBX342 00144 DTSBX342 00145 05 PARM-STATUS PIC X(02). DTSBX342 00146 88 PARM-STATUS-OK-88 VALUE '00'. DTSBX342 00147 05 ACCT-STATUS PIC X(02). DTSBX342 00148 88 ACCT-STATUS-OK-88 VALUE '00'. DTSBX342 00149 88 ACCT-STATUS-EOF-88 VALUE '10'. DTSBX342 00150 05 TRAN-STATUS PIC X(02). DTSBX342 00151 88 TRAN-STATUS-OK-88 VALUE '00'. DTSBX342 00152 05 QTR-STATUS PIC X(02). DTSBX342 00153 88 QTR-STATUS-OK-88 VALUE '00'. DTSBX342 00154 05 SUMMARY-STATUS PIC X(02). DTSBX342 00155 88 SUMMARY-STATUS-OK-88 VALUE '00'. DTSBX342 00156 05 PAYDIST-STATUS PIC X(02). DTSBX342 00157 88 PAYDIST-STATUS-OK-88 VALUE '00'. DTSBX342 00158 DTSBX342 00159 05 EMP-STATUS PIC X(02). DTSBX342 00160 88 EMP-STATUS-OK-88 VALUE '00'. DTSBX342 00161 DTSBX342 00162 05 W-ERROR-IND PIC X(01) VALUE 'N'. DTSBX342 00163 88 W-ERROR-YES-88 VALUE 'Y'. DTSBX342 00164 88 W-ERROR-NO-88 VALUE 'N'. DTSBX342 00165 DTSBX342 00166 05 W-RPT-COMPLETE-IND PIC X(01). DTSBX342 00167 88 W-RPT-COMPLETE-YES-88 VALUE 'Y'. DTSBX342 00168 88 W-RPT-COMPLETE-NO-88 VALUE 'N'. DTSBX342 00169 88 W-RPT-COMPLETE-NULL-88 VALUE ' '. DTSBX342 00170 DTSBX342 00171 05 W-UI-CHARGE-IND PIC X(01). DTSBX342 00172 88 W-UI-CHARGE-YES-88 VALUE 'Y'. DTSBX342 00173 88 W-UI-CHARGE-NO-88 VALUE 'N'. DTSBX342 00174 05 W-LP-CHARGE-IND PIC X(01). DTSBX342 00175 88 W-LP-CHARGE-YES-88 VALUE 'Y'. DTSBX342 00176 88 W-LP-CHARGE-NO-88 VALUE 'N'. DTSBX342 00177 DTSBX342 00178 05 W-STATUS-CD PIC X(02). DTSBX342 00179 88 W-STATUS-WITHDRAWN-88 VALUE '04', '05'. DTSBX342 00180 DTSBX342 00181 05 CONV-QTR-SUB PIC S9(04) COMP. DTSBX342 00182 05 QSUB PIC S9(04) COMP. DTSBX342 00183 05 QMAX PIC S9(04) COMP VALUE +400. DTSBX342 00184 05 QTR-TABLE OCCURS 400 TIMES. DTSBX342 00185 10 TBL-QTR-IND PIC X(01). DTSBX342 00186 88 TBL-QTR-YES-88 VALUE 'Y'. DTSBX342 00187 88 TBL-QTR-NO-88 VALUE 'N'. DTSBX342 00188 DTSBX342 00189 05 W-AMT PIC S9(11)V99 COMP-3. DTSBX342 00190 05 W-TOT-CHG PIC S9(11)V99 COMP-3 DTSBX342 00191 VALUE +0. DTSBX342 00192 05 W-TOT-PD PIC S9(11)V99 COMP-3 DTSBX342 00193 VALUE +0. DTSBX342 00194 DTSBX342 00195 05 W-DEFAULT-DATE PIC X(10) DTSBX342 00196 VALUE '12/31/1994'. DTSBX342 00197 DTSBX342 00198 05 W-MPRF-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX342 00199 05 W-MJRN-READ-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX342 00200 05 W-ERROR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX342 00201 05 W-ACCT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX342 00202 05 W-TRAN-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX342 00203 05 W-RPT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX342 00204 05 W-ANN-RPT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX342 00205 05 W-PAY-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX342 00206 05 W-ADJ-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX342 00207 05 W-QTR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX342 00208 05 W-SUMMARY-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX342 00209 05 W-PAY-DIST-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX342 00210 05 W-BATCH PIC S9(05) COMP-3 VALUE +0. DTSBX342 00211 05 W-ITEM PIC S9(03) COMP-3 VALUE +0. DTSBX342 00212 05 ADJ-CHG PIC S9(09)V99 COMP-3. DTSBX342 00213 05 ADJ-PD PIC S9(09)V99 COMP-3. DTSBX342 00214 05 ADJ-WV PIC S9(09)V99 COMP-3. DTSBX342 00215 05 ADJ-WO PIC S9(09)V99 COMP-3. DTSBX342 00216 05 ADJ-TL PIC S9(09)V99 COMP-3. DTSBX342 00217 05 W-CHG PIC S9(09)V99 COMP-3. DTSBX342 00218 05 W-PD PIC S9(09)V99 COMP-3. DTSBX342 00219 05 W-WV PIC S9(09)V99 COMP-3. DTSBX342 00220 05 W-WO PIC S9(09)V99 COMP-3. DTSBX342 00221 05 W-TL PIC S9(09)V99 COMP-3. DTSBX342 00222 05 W-BAL PIC S9(09)V99 COMP-3. DTSBX342 00223 05 W-QTR-BAL PIC S9(11)V99 COMP-3. DTSBX342 00224 05 W-RATE PIC S9(03)V9(04) COMP-3. DTSBX342 00225 DTSBX342 00226 05 ASUB PIC S9(04) COMP. DTSBX342 00227 05 ASUB1 PIC S9(04) COMP. DTSBX342 00228 05 ASUB-MAX PIC S9(04) COMP VALUE +50. DTSBX342 00229 05 ASUB-LAST PIC S9(04) COMP VALUE +0. DTSBX342 00230 05 ANN-RPT-TABLE OCCURS 50 TIMES. DTSBX342 00231 10 W-ANN-RPT-TYPE PIC X(02). DTSBX342 00232 10 W-ANN-YRQ PIC 9(05). DTSBX342 00233 10 FILLER REDEFINES W-ANN-YRQ. DTSBX342 00234 15 W-ANN-YRQ-CCYY PIC 9(04). DTSBX342 00235 15 W-ANN-YRQ-Q PIC 9(01). DTSBX342 00236 DTSBX342 00237 10 W-ANN-BATCH PIC S9(05) COMP-3. DTSBX342 00238 10 W-ANN-ITEM PIC S9(03) COMP-3. DTSBX342 00239 10 W-ANN-RATE PIC S9(03)V9(04) COMP-3. DTSBX342 00240 10 W-ANN-REMIT PIC S9(09)V99 COMP-3. DTSBX342 00241 10 W-ANN-TOT-WAGE PIC S9(09)V99 COMP-3. DTSBX342 00242 10 W-ANN-TAX-WAGE PIC S9(09)V99 COMP-3. DTSBX342 00243 10 W-ANN-EXCESS-WAGE PIC S9(09)V99 COMP-3. DTSBX342 00244 10 W-ANN-RCVD-DT PIC S9(09) COMP-3. DTSBX342 00245 10 W-ANN-PROCESS-DT PIC S9(09) COMP-3. DTSBX342 00246 DTSBX342 00247 05 W-LAST-ANN-YRQ PIC S9(05) COMP-3. DTSBX342 00248 DTSBX342 00249 05 W-ACCT-REC. DTSBX342 00250 10 ACCT-EMP-NO PIC 9(06). DTSBX342 00251 10 FILLER PIC X(01) VALUE ','. DTSBX342 00252 10 ACCT-YRQ PIC X(06). DTSBX342 00253 10 FILLER PIC X(01) VALUE ','. DTSBX342 00254 10 ACCT-BATCH PIC 9(05). DTSBX342 00255 10 FILLER PIC X(01) VALUE ','. DTSBX342 00256 10 ACCT-ITEM PIC 9(03). DTSBX342 00257 10 FILLER PIC X(01) VALUE ','. DTSBX342 00258 10 ACCT-TRAN PIC X(02). DTSBX342 00259 10 FILLER PIC X(01) VALUE ','. DTSBX342 00260 10 ACCT-ROW PIC X(02). DTSBX342 00261 10 FILLER PIC X(01) VALUE ','. DTSBX342 00262 10 ACCT-COL PIC X(02). DTSBX342 00263 10 FILLER PIC X(01) VALUE ','. DTSBX342 00264 10 ACCT-AMT PIC ---------9.99. DTSBX342 00265 10 ACCT-AMT-9 REDEFINES ACCT-AMT PIC 9(10).99. DTSBX342 00266 10 FILLER PIC X(01) VALUE ','. DTSBX342 00267 10 ACCT-CAT PIC X(01). DTSBX342 00268 10 FILLER PIC X(01) VALUE ','. DTSBX342 00269 10 ACCT-PROCESS-DT PIC X(10). DTSBX342 00270 10 FILLER PIC X(01) VALUE ','. DTSBX342 00271 10 ACCT-SOURCE PIC X(01). DTSBX342 00272 88 ACCT-SOURCE-CR-DB-88 VALUE '1'. DTSBX342 00273 88 ACCT-SOURCE-STATUS-88 VALUE '2'. DTSBX342 00274 88 ACCT-SOURCE-ERROR-88 VALUE '3'. DTSBX342 00275 DTSBX342 00276 05 W-TRAN-REC. DTSBX342 00277 10 TRAN-EMP-NO PIC 9(06). DTSBX342 00278 10 FILLER PIC X(01) VALUE ','. DTSBX342 00279 10 TRAN-YRQ PIC X(06). DTSBX342 00280 10 FILLER PIC X(01) VALUE ','. DTSBX342 00281 10 TRAN-BATCH PIC 9(05). DTSBX342 00282 10 FILLER PIC X(01) VALUE ','. DTSBX342 00283 10 TRAN-ITEM PIC 9(03). DTSBX342 00284 10 FILLER PIC X(01) VALUE ','. DTSBX342 00285 10 TRAN-TRANS PIC X(02). DTSBX342 00286 10 FILLER PIC X(01) VALUE ','. DTSBX342 00287 10 TRAN-AMT PIC --------9.99. DTSBX342 00288 10 FILLER PIC X(01) VALUE ','. DTSBX342 00289 10 TRAN-TOT-WAGE PIC ----------9.99. DTSBX342 00290 10 TRAN-TOT-WAGE-X REDEFINES TRAN-TOT-WAGE DTSBX342 00291 PIC X(14). DTSBX342 00292 10 FILLER PIC X(01) VALUE ','. DTSBX342 00293 10 TRAN-TAX-WAGE PIC ----------9.99. DTSBX342 00294 10 TRAN-TAX-WAGE-X REDEFINES TRAN-TAX-WAGE DTSBX342 00295 PIC X(14). DTSBX342 00296 10 FILLER PIC X(01) VALUE ','. DTSBX342 00297 10 TRAN-EXC-WAGE PIC ----------9.99. DTSBX342 00298 10 TRAN-EXC-WAGE-X REDEFINES TRAN-EXC-WAGE DTSBX342 00299 PIC X(14). DTSBX342 00300 10 FILLER PIC X(01) VALUE ','. DTSBX342 00301 10 TRAN-RATE PIC Z9.9. DTSBX342 00302 10 TRAN-RATE-X REDEFINES TRAN-RATE DTSBX342 00303 PIC X(04). DTSBX342 00304 10 FILLER PIC X(01) VALUE ','. DTSBX342 00305 10 TRAN-ACCT PIC X(02). DTSBX342 00306 10 FILLER PIC X(01) VALUE ','. DTSBX342 00307 10 TRAN-CAT PIC X(01). DTSBX342 00308 10 FILLER PIC X(01) VALUE ','. DTSBX342 00309 10 TRAN-SOURCE PIC X(01). DTSBX342 00310 88 TRAN-SOURCE-CR-DB-88 VALUE '1'. DTSBX342 00311 88 TRAN-SOURCE-STATUS-88 VALUE '2'. DTSBX342 00312 88 TRAN-SOURCE-ERROR-88 VALUE '3'. DTSBX342 00313 10 FILLER PIC X(01) VALUE ','. DTSBX342 00314 10 TRAN-RCVD-DT PIC X(10). DTSBX342 00315 10 FILLER PIC X(01) VALUE ','. DTSBX342 00316 10 TRAN-PROCESS-DT PIC X(10). DTSBX342 00317 10 FILLER PIC X(01) VALUE ','. DTSBX342 00318 10 TRAN-APPLIC-BATCH PIC 9(05). DTSBX342 00319 10 FILLER PIC X(01) VALUE ','. DTSBX342 00320 10 TRAN-APPLIC-ITEM PIC 9(03). DTSBX342 00321 DTSBX342 00322 05 W-QTR-REC. DTSBX342 00323 10 QTR-EMP-NO PIC 9(06). DTSBX342 00324 10 FILLER PIC X(01) VALUE ','. DTSBX342 00325 10 QTR-QUARTER PIC X(06). DTSBX342 00326 10 FILLER PIC X(01) VALUE ','. DTSBX342 00327 10 QTR-RPT-STATUS PIC X(01). DTSBX342 00328 10 FILLER PIC X(01) VALUE ','. DTSBX342 00329 10 QTR-DUE-DT PIC X(10). DTSBX342 00330 10 FILLER PIC X(01) VALUE ','. DTSBX342 00331 10 QTR-BAL-DUE PIC ----------9.99. DTSBX342 00332 10 FILLER PIC X(01) VALUE ','. DTSBX342 00333 10 QTR-PROCESS-DT PIC X(10). DTSBX342 00334 DTSBX342 00335 05 W-SUMMARY-REC. DTSBX342 00336 10 SUMMARY-PROCESS-DT PIC X(10). DTSBX342 00337 10 FILLER PIC X(01) VALUE ','. DTSBX342 00338 10 SUMMARY-MESSAGE PIC X(40). DTSBX342 00339 10 FILLER PIC X(01) VALUE ','. DTSBX342 00340 10 SUMMARY-EMP-NO PIC 9(06). DTSBX342 00341 10 FILLER PIC X(01) VALUE ','. DTSBX342 00342 10 SUMMARY-BATCH PIC 9(05). DTSBX342 00343 10 FILLER PIC X(01) VALUE ','. DTSBX342 00344 10 SUMMARY-ITEM PIC 9(03). DTSBX342 00345 10 FILLER PIC X(01) VALUE ','. DTSBX342 00346 10 SUMMARY-TRAN PIC X(02). DTSBX342 00347 10 FILLER PIC X(01) VALUE ','. DTSBX342 00348 10 SUMMARY-SOURCE PIC X(01). DTSBX342 00349 88 SUMMARY-SOURCE-CR-DB-88 VALUE '1'. DTSBX342 00350 88 SUMMARY-SOURCE-STATUS-88 VALUE '2'. DTSBX342 00351 88 SUMMARY-SOURCE-ERROR-88 VALUE '3'. DTSBX342 00352 DTSBX342 00353 05 W-PAY-DIST-REC. DTSBX342 00354 10 DST-EMP-NO PIC 9(06). DTSBX342 00355 10 FILLER PIC X(01) VALUE ','. DTSBX342 00356 10 DST-BATCH PIC 9(05). DTSBX342 00357 10 FILLER PIC X(01) VALUE ','. DTSBX342 00358 10 DST-ITEM PIC 9(03). DTSBX342 00359 10 FILLER PIC X(01) VALUE ','. DTSBX342 00360 10 DST-QTR PIC X(06). DTSBX342 00361 10 FILLER PIC X(01) VALUE ','. DTSBX342 00362 10 DST-ACCT PIC X(02). DTSBX342 00363 10 FILLER PIC X(01) VALUE ','. DTSBX342 00364 10 DST-AMT PIC --------9.99. DTSBX342 00365 10 FILLER PIC X(01) VALUE ','. DTSBX342 00366 10 DST-CHNG-DT PIC X(10). DTSBX342 00367 DTSBX342 00368 05 W-CURR-UI-TOT PIC S9(11)V99 COMP-3 DTSBX342 00369 VALUE +0. DTSBX342 00370 DTSBX342 00371 05 DISPLAY-CNT PIC Z(06)9. DTSBX342 00372 DTSBX342 00373 05 DISPLAY-AMT1-X PIC X(14). DTSBX342 00374 05 DISPLAY-AMT1 REDEFINES DISPLAY-AMT1-X DTSBX342 00375 PIC ---,---,--9.99. DTSBX342 00376 05 DISPLAY-AMT2-X PIC X(14). DTSBX342 00377 05 DISPLAY-AMT2 REDEFINES DISPLAY-AMT2-X DTSBX342 00378 PIC ---,---,--9.99. DTSBX342 00379 05 DISPLAY-AMT3-X PIC X(14). DTSBX342 00380 05 DISPLAY-AMT3 REDEFINES DISPLAY-AMT3-X DTSBX342 00381 PIC ---,---,--9.99. DTSBX342 00382 05 DISPLAY-AMT4-X PIC X(14). DTSBX342 00383 05 DISPLAY-AMT4 REDEFINES DISPLAY-AMT4-X DTSBX342 00384 PIC ---,---,--9.99. DTSBX342 00385 EJECT DTSBX342 00386 01 L001-LINK-AREA. DTSBX342 00387 ++INCLUDE DTSIL001 DTSBX342 00388 EJECT DTSBX342 00389 01 L004-LINK-AREA. DTSBX342 00390 ++INCLUDE DTSIL004 DTSBX342 00391 EJECT DTSBX342 00392 01 L005-LINK-AREA. DTSBX342 00393 ++INCLUDE DTSIL005 DTSBX342 00394 DTSBX342 00395 01 L910-LINK-AREA. DTSBX342 00396 ++INCLUDE DTSIL910 DTSBX342 00397 SKIP3 DTSBX342 00398 01 MSKL-REC. DTSBX342 00399 ++INCLUDE DTSIMSKL DTSBX342 00400 SKIP3 DTSBX342 00401 01 MHDR-REC. DTSBX342 00402 ++INCLUDE DTSIMHDR DTSBX342 00403 SKIP3 DTSBX342 00404 01 MQTR-REC. DTSBX342 00405 ++INCLUDE DTSIMQTR DTSBX342 00406 SKIP3 DTSBX342 00407 01 MJRN-REC. DTSBX342 00408 ++INCLUDE DTSIMJRN DTSBX342 00409 SKIP3 DTSBX342 00410 01 MRPT-REC. DTSBX342 00411 ++INCLUDE DTSIMRPT DTSBX342 00412 SKIP3 DTSBX342 00413 01 MADJ-REC. DTSBX342 00414 ++INCLUDE DTSIMADJ DTSBX342 00415 SKIP3 DTSBX342 00416 01 MPAY-REC. DTSBX342 00417 ++INCLUDE DTSIMPAY DTSBX342 00418 SKIP3 DTSBX342 00419 01 MRTE-REC. DTSBX342 00420 ++INCLUDE DTSIMRTE DTSBX342 00421 SKIP3 DTSBX342 00422 01 MEVL-REC. DTSBX342 00423 ++INCLUDE DTSIMEVL DTSBX342 00424 SKIP3 DTSBX342 00425 01 MSOL-REC. DTSBX342 00426 ++INCLUDE DTSIMSOL DTSBX342 00427 SKIP3 DTSBX342 00428 01 MFSC-REC. DTSBX342 00429 ++INCLUDE DTSIMFSC DTSBX342 00430 SKIP3 DTSBX342 00431 01 MTAD-REC. DTSBX342 00432 ++INCLUDE DTSIMTAD DTSBX342 00433 SKIP3 DTSBX342 00434 01 MTAA-REC. DTSBX342 00435 ++INCLUDE DTSIMTAA DTSBX342 00436 SKIP3 DTSBX342 00437 01 MLOG-REC. DTSBX342 00438 ++INCLUDE DTSIMLOG DTSBX342 00439 SKIP3 DTSBX342 00440 01 MDST-REC. DTSBX342 00441 ++INCLUDE DTSIMDST DTSBX342 00442 SKIP3 DTSBX342 00443 01 L931-LINK-AREA. DTSBX342 00444 ++INCLUDE DTSIL931 DTSBX342 00445 SKIP3 DTSBX342 00446 01 FSKL-REC. DTSBX342 00447 ++INCLUDE DTSIFSKL DTSBX342 00448 SKIP3 DTSBX342 00449 01 FQTR-REC. DTSBX342 00450 ++INCLUDE DTSIFQTR DTSBX342 00451 DTSBX342 00452 LINKAGE SECTION. DTSBX342 00453 DTSBX342 00454 01 LX34-LINK-AREA. DTSBX342 00455 ++INCLUDE DTSILX34 DTSBX342 00456 DTSBX342 00457 01 MPRF-REC. DTSBX342 00458 ++INCLUDE DTSIMPRF DTSBX342 00459 EJECT DTSBX342 00460 PROCEDURE DIVISION USING LX34-LINK-AREA DTSBX342 00461 MPRF-REC. DTSBX342 00462 DTSBX342 00463 EVALUATE TRUE DTSBX342 00464 WHEN LX34-INITIALIZE-88 DTSBX342 00465 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBX342 00466 WHEN LX34-PROCESS-88 DTSBX342 00467 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBX342 00468 WHEN LX34-TERMINATE-88 DTSBX342 00469 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBX342 00470 END-EVALUATE. DTSBX342 00471 DTSBX342 00472 GOBACK. DTSBX342 00473 DTSBX342 00474 I0000-INITIALIZE. DTSBX342 00475 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBX342 00476 DTSBX342 00477 I0000-EXIT. DTSBX342 00478 EXIT. DTSBX342 00479 DTSBX342 00480 I2000-OPEN-FILES. DTSBX342 00481 OPEN OUTPUT ACCT-FILE. DTSBX342 00482 IF NOT ACCT-STATUS-OK-88 DTSBX342 00483 DISPLAY 'ACCT FILE OPEN ERROR: ' ACCT-STATUS DTSBX342 00484 MOVE 'FILE OPEN ERROR' DTSBX342 00485 TO ABEND-MSG DTSBX342 00486 PERFORM S999-ABEND THRU S999-EXIT DTSBX342 00487 END-IF. DTSBX342 00488 DTSBX342 00489 OPEN OUTPUT TRAN-FILE. DTSBX342 00490 IF NOT TRAN-STATUS-OK-88 DTSBX342 00491 DISPLAY 'TRAN FILE OPEN ERROR: ' TRAN-STATUS DTSBX342 00492 MOVE 'FILE OPEN ERROR' DTSBX342 00493 TO ABEND-MSG DTSBX342 00494 PERFORM S999-ABEND THRU S999-EXIT DTSBX342 00495 END-IF. DTSBX342 00496 DTSBX342 00497 OPEN OUTPUT QTR-FILE. DTSBX342 00498 IF NOT QTR-STATUS-OK-88 DTSBX342 00499 DISPLAY 'QTR FILE OPEN ERROR: ' QTR-STATUS DTSBX342 00500 MOVE 'FILE OPEN ERROR' DTSBX342 00501 TO ABEND-MSG DTSBX342 00502 PERFORM S999-ABEND THRU S999-EXIT DTSBX342 00503 END-IF. DTSBX342 00504 DTSBX342 00505 OPEN OUTPUT SUMMARY-FILE DTSBX342 00506 IF NOT SUMMARY-STATUS-OK-88 DTSBX342 00507 DISPLAY 'SUM FILE OPEN ERROR: ' SUMMARY-STATUS DTSBX342 00508 MOVE 'FILE OPEN ERROR' DTSBX342 00509 TO ABEND-MSG DTSBX342 00510 PERFORM S999-ABEND THRU S999-EXIT DTSBX342 00511 END-IF. DTSBX342 00512 DTSBX342 00513 OPEN OUTPUT PAY-DIST-FILE. DTSBX342 00514 IF NOT PAYDIST-STATUS-OK-88 DTSBX342 00515 DISPLAY 'BX343 PAY DIST FILE OPEN ERROR: ' DTSBX342 00516 PAYDIST-STATUS DTSBX342 00517 MOVE 'FILE OPEN ERROR' DTSBX342 00518 TO ABEND-MSG DTSBX342 00519 PERFORM S999-ABEND THRU S999-EXIT DTSBX342 00520 END-IF. DTSBX342 00521 DTSBX342 00522 I2000-EXIT. DTSBX342 00523 EXIT. DTSBX342 00524 DTSBX342 00525 P0000-PROCESS. DTSBX342 00526 PERFORM P0100-INIT-TABLE THRU P0100-EXIT. DTSBX342 00527 DTSBX342 00528 PERFORM P2000-ACCTS-RECEIVABLE THRU P2000-EXIT DTSBX342 00529 PERFORM P3000-TRANSACTION-DETAIL THRU P3000-EXIT DTSBX342 00530 PERFORM P4000-UPDATE-QTRS THRU P4000-EXIT. DTSBX342 00531 IF MPRF-TOT-CREDIT-AMT > ZERO DTSBX342 00532 PERFORM P5000-PAY-DISTRIBUTION THRU P5000-EXIT DTSBX342 00533 END-IF. DTSBX342 00534 DTSBX342 00535 P0000-EXIT. DTSBX342 00536 EXIT. DTSBX342 00537 DTSBX342 00538 P0100-INIT-TABLE. DTSBX342 00539 PERFORM DTSBX342 00540 VARYING QSUB FROM +1 BY +1 DTSBX342 00541 UNTIL QSUB > QMAX DTSBX342 00542 SET TBL-QTR-NO-88 (QSUB) TO TRUE DTSBX342 00543 END-PERFORM. DTSBX342 00544 DTSBX342 00545 P0100-EXIT. DTSBX342 00546 EXIT. DTSBX342 00547 DTSBX342 00548 DTSBX342 00549 P2000-ACCTS-RECEIVABLE. DTSBX342 00550 MOVE LOW-VALUES TO MJRN-KEY-AREA. DTSBX342 00551 MOVE MPRF-EMP-NO TO MJRN-EMP-NO. DTSBX342 00552 SET MJRN-JRN-88 TO TRUE. DTSBX342 00553 MOVE LX34-ABSTIME TO MJRN-ESTB-ABSTIME. DTSBX342 00554 MOVE MJRN-KEY-AREA TO MSKL-KEY-AREA. DTSBX342 00555 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX342 00556 PERFORM UNTIL L910-NO-REC-88 DTSBX342 00557 MOVE MSKL-REC TO MJRN-REC DTSBX342 00558 ADD +1 TO W-MJRN-READ-CNT DTSBX342 00559 IF MJRN-ESTB-DATE = LX34-PRIOR-RUN-DATE DTSBX342 00560 PERFORM P2100-BUILD-ACCT THRU P2100-EXIT DTSBX342 00561 END-IF DTSBX342 00562 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX342 00563 END-PERFORM. DTSBX342 00564 DTSBX342 00565 P2000-EXIT. DTSBX342 00566 EXIT. DTSBX342 00567 DTSBX342 00568 P2100-BUILD-ACCT. DTSBX342 00569 PERFORM DTSBX342 00570 VARYING MJRN-OCC-IDX FROM +1 BY +1 DTSBX342 00571 UNTIL MJRN-OCC-IDX > MJRN-OCC-CNT DTSBX342 00572 PERFORM P2110-WRITE-ACCT THRU P2110-EXIT DTSBX342 00573 END-PERFORM. DTSBX342 00574 DTSBX342 00575 P2100-EXIT. DTSBX342 00576 EXIT. DTSBX342 00577 DTSBX342 00578 P2110-WRITE-ACCT. DTSBX342 00579 IF MJRN-YRQ (MJRN-OCC-IDX) = 99999 DTSBX342 00580 MOVE SPACES TO ACCT-YRQ DTSBX342 00581 ELSE DTSBX342 00582 MOVE MJRN-YRQ (MJRN-OCC-IDX) TO L004-QTR-5-9 DTSBX342 00583 PERFORM S004-FROM-5 THRU S004-EXIT DTSBX342 00584 MOVE L004-SLASH-5-QTR TO ACCT-YRQ DTSBX342 00585 MOVE L004-ABS-QTR TO QSUB DTSBX342 00586 SET TBL-QTR-YES-88 (QSUB) TO TRUE DTSBX342 00587 DISPLAY 'P2000 ACCT ' MPRF-EMP-NO DTSBX342 00588 ' ' MJRN-YRQ (MJRN-OCC-IDX) DTSBX342 00589 ' ' QSUB DTSBX342 00590 END-IF. DTSBX342 00591 DTSBX342 00592 MOVE MJRN-BATCH-NO TO ACCT-BATCH. DTSBX342 00593 MOVE MJRN-ITEM-NO TO ACCT-ITEM. DTSBX342 00594 MOVE MPRF-EMP-NO TO ACCT-EMP-NO. DTSBX342 00595 MOVE MJRN-TRAN-TYPE TO ACCT-TRAN. DTSBX342 00596 MOVE MJRN-ACCT-ROW (MJRN-OCC-IDX) TO ACCT-ROW. DTSBX342 00597 MOVE MJRN-ACCT-COL (MJRN-OCC-IDX) TO ACCT-COL. DTSBX342 00598 IF ACCT-ROW = 'CR' DTSBX342 00599 MOVE MJRN-AMT (MJRN-OCC-IDX) TO ACCT-AMT DTSBX342 00600 ELSE DTSBX342 00601 IF ACCT-COL NOT = 'CH' DTSBX342 00602 COMPUTE ACCT-AMT = DTSBX342 00603 (MJRN-AMT (MJRN-OCC-IDX) * -1) DTSBX342 00604 ELSE DTSBX342 00605 MOVE MJRN-AMT (MJRN-OCC-IDX) TO ACCT-AMT DTSBX342 00606 END-IF DTSBX342 00607 END-IF. DTSBX342 00608 DTSBX342 00609 MOVE MJRN-TRAN-CATEGORY TO ACCT-CAT. DTSBX342 00610 MOVE MJRN-ESTB-DATE TO L001-FED-8-DATE-9. DTSBX342 00611 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX342 00612 IF L001-VALID-DATE DTSBX342 00613 MOVE L001-SLASH-8-DATE TO ACCT-PROCESS-DT DTSBX342 00614 ELSE DTSBX342 00615 MOVE LX34-SYS-DATE TO ACCT-PROCESS-DT DTSBX342 00616 END-IF. DTSBX342 00617 SET ACCT-SOURCE-CR-DB-88 TO TRUE. DTSBX342 00618 DTSBX342 00619 WRITE ACCT-REC FROM W-ACCT-REC DTSBX342 00620 IF NOT ACCT-STATUS-OK-88 DTSBX342 00621 DISPLAY 'CANNOT WRITE TO ACCT FILE ' DTSBX342 00622 ' ' ACCT-STATUS ' ' ACCT-EMP-NO DTSBX342 00623 ELSE DTSBX342 00624 ADD +1 TO W-ACCT-CNT DTSBX342 00625 END-IF. DTSBX342 00626 DTSBX342 00627 ** IF MPRF-EMP-NO = 122233 DTSBX342 00628 * DISPLAY 'P2110 ' MPRF-EMP-NO ' ' ACCT-YRQ DTSBX342 00629 * ' ' ACCT-BATCH '/' ACCT-ITEM DTSBX342 00630 * DISPLAY ' ' ACCT-ROW ' ' ACCT-COL DTSBX342 00631 * ' ' ACCT-TRAN ' ' ACCT-AMT DTSBX342 00632 ** END-IF. DTSBX342 00633 DTSBX342 00634 P2110-EXIT. DTSBX342 00635 EXIT. DTSBX342 00636 DTSBX342 00637 DTSBX342 00638 P3000-TRANSACTION-DETAIL. DTSBX342 00639 PERFORM P3100-REPORTS THRU P3100-EXIT. DTSBX342 00640 PERFORM P3200-PAYMENT THRU P3200-EXIT. DTSBX342 00641 PERFORM P3300-ADJUSTMENT THRU P3300-EXIT. DTSBX342 00642 DTSBX342 00643 P3000-EXIT. DTSBX342 00644 EXIT. DTSBX342 00645 DTSBX342 00646 DTSBX342 00647 P3100-REPORTS. DTSBX342 00648 MOVE LOW-VALUES TO MRPT-KEY-AREA. DTSBX342 00649 MOVE MPRF-EMP-NO TO MRPT-EMP-NO. DTSBX342 00650 SET MRPT-RPT-88 TO TRUE. DTSBX342 00651 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. DTSBX342 00652 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX342 00653 IF L910-NO-REC-88 DTSBX342 00654 GO TO P3100-EXIT DTSBX342 00655 ELSE DTSBX342 00656 PERFORM DTSBX342 00657 UNTIL L910-NO-REC-88 DTSBX342 00658 MOVE MSKL-REC TO MRPT-REC DTSBX342 00659 IF MRPT-ESTB-DATE = LX34-PRIOR-RUN-DATE DTSBX342 00660 IF MRPT-STATUS-CHNG-YES-88 DTSBX342 00661 PERFORM P3130-STATUS-CHANGE THRU P3130-EXIT DTSBX342 00662 END-IF DTSBX342 00663 PERFORM P3110-WRITE THRU P3110-EXIT DTSBX342 00664 END-IF DTSBX342 00665 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX342 00666 END-PERFORM DTSBX342 00667 END-IF. DTSBX342 00668 DTSBX342 00669 P3100-EXIT. DTSBX342 00670 EXIT. DTSBX342 00671 DTSBX342 00672 P3110-WRITE. DTSBX342 00673 MOVE MRPT-RPT-TYPE TO TRAN-TRANS. DTSBX342 00674 MOVE MRPT-BATCH-NO TO TRAN-BATCH. DTSBX342 00675 MOVE MRPT-ITEM-NO TO TRAN-ITEM. DTSBX342 00676 MOVE MPRF-EMP-NO TO TRAN-EMP-NO. DTSBX342 00677 MOVE MRPT-YRQ TO L004-QTR-5-9. DTSBX342 00678 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX342 00679 MOVE L004-SLASH-5-QTR TO TRAN-YRQ. DTSBX342 00680 MOVE L004-ABS-QTR TO QSUB. DTSBX342 00681 SET TBL-QTR-YES-88 (QSUB) TO TRUE. DTSBX342 00682 DISPLAY 'P3110 RPT ' MPRF-EMP-NO DTSBX342 00683 ' ' MRPT-YRQ DTSBX342 00684 ' ' QSUB. DTSBX342 00685 MOVE MRPT-REMIT-AMT TO TRAN-AMT. DTSBX342 00686 MOVE MRPT-TOT-WAGE TO TRAN-TOT-WAGE. DTSBX342 00687 MOVE MRPT-TAX-WAGE TO TRAN-TAX-WAGE. DTSBX342 00688 MOVE MRPT-EXCESS-WAGE TO TRAN-EXC-WAGE. DTSBX342 00689 IF MPRF-CLASS-SELF-INS-88 DTSBX342 00690 MOVE ZERO TO TRAN-RATE DTSBX342 00691 ELSE DTSBX342 00692 COMPUTE W-RATE = (MRPT-UI-RATE * 100) DTSBX342 00693 MOVE W-RATE TO TRAN-RATE DTSBX342 00694 END-IF DTSBX342 00695 MOVE SPACES TO TRAN-ACCT. DTSBX342 00696 MOVE ZEROS TO TRAN-APPLIC-BATCH DTSBX342 00697 TRAN-APPLIC-ITEM. DTSBX342 00698 IF MRPT-ANNUAL-YES-88 DTSBX342 00699 MOVE 'T' TO TRAN-CAT DTSBX342 00700 ELSE DTSBX342 00701 MOVE 'R' TO TRAN-CAT DTSBX342 00702 END-IF. DTSBX342 00703 SET TRAN-SOURCE-CR-DB-88 TO TRUE. DTSBX342 00704 MOVE MRPT-RECEIVED-DATE TO L001-FED-8-DATE-9. DTSBX342 00705 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX342 00706 MOVE L001-SLASH-8-DATE TO TRAN-RCVD-DT. DTSBX342 00707 MOVE MRPT-ESTB-DATE TO L001-FED-8-DATE-9. DTSBX342 00708 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX342 00709 IF L001-VALID-DATE DTSBX342 00710 MOVE L001-SLASH-8-DATE TO TRAN-PROCESS-DT DTSBX342 00711 ELSE DTSBX342 00712 MOVE TRAN-RCVD-DT TO TRAN-PROCESS-DT DTSBX342 00713 END-IF. DTSBX342 00714 DTSBX342 00715 WRITE TRAN-REC FROM W-TRAN-REC DTSBX342 00716 IF NOT TRAN-STATUS-OK-88 DTSBX342 00717 DISPLAY 'CANNOT WRITE TO TRAN FILE ' DTSBX342 00718 ' ' TRAN-STATUS ' ' TRAN-EMP-NO DTSBX342 00719 ELSE DTSBX342 00720 ADD +1 TO W-TRAN-CNT DTSBX342 00721 W-RPT-CNT DTSBX342 00722 END-IF. DTSBX342 00723 DTSBX342 00724 P3110-EXIT. DTSBX342 00725 EXIT. DTSBX342 00726 DTSBX342 00727 *P3120-ANNUAL. DTSBX342 00728 ** DISPLAY 'ANNUAL ' MPRF-EMP-NO ' ' MRPT-YRQ. DTSBX342 00729 * DTSBX342 00730 * PERFORM P3122-INIT-ANN-TBL THRU P3122-EXIT. DTSBX342 00731 * DTSBX342 00732 * SET W-RPT-COMPLETE-NULL-88 TO TRUE. DTSBX342 00733 * DTSBX342 00734 * MOVE MRPT-YRQ TO L004-QTR-5-9. DTSBX342 00735 * MOVE 4 TO L004-QTR-5-Q. DTSBX342 00736 * MOVE L004-QTR-5-9 TO W-LAST-ANN-YRQ. DTSBX342 00737 * DTSBX342 00738 * MOVE MRPT-BATCH-NO TO W-BATCH. DTSBX342 00739 * MOVE MRPT-ITEM-NO TO W-ITEM. DTSBX342 00740 * DTSBX342 00741 * PERFORM DTSBX342 00742 * UNTIL L910-NO-REC-88 OR W-RPT-COMPLETE-YES-88 DTSBX342 00743 * MOVE MSKL-REC TO MRPT-REC DTSBX342 00744 * IF MRPT-YRQ > W-LAST-ANN-YRQ DTSBX342 00745 * OR MPRF-EMP-NO DTSBX342 00746 * SET W-RPT-COMPLETE-YES-88 TO TRUE DTSBX342 00747 * ELSE DTSBX342 00748 * PERFORM P3121-SUM-DATA THRU P3121-EXIT DTSBX342 00749 * PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX342 00750 * END-IF DTSBX342 00751 * END-PERFORM. DTSBX342 00752 * DTSBX342 00753 * PERFORM DTSBX342 00754 * VARYING ASUB FROM +1 BY +1 DTSBX342 00755 * UNTIL ASUB > ASUB-LAST DTSBX342 00756 * PERFORM P3123-WRITE THRU P3123-EXIT DTSBX342 00757 * END-PERFORM. DTSBX342 00758 * DTSBX342 00759 * DTSBX342 00760 *P3120-EXIT. DTSBX342 00761 * EXIT. DTSBX342 00762 * DTSBX342 00763 *P3121-SUM-DATA. DTSBX342 00764 * MOVE +0 TO ASUB. DTSBX342 00765 * PERFORM DTSBX342 00766 * VARYING ASUB1 FROM +1 BY +1 DTSBX342 00767 * UNTIL ASUB > +0 DTSBX342 00768 * OR ASUB1 > ASUB-LAST DTSBX342 00769 * IF W-ANN-BATCH (ASUB1) = MRPT-BATCH-NO DTSBX342 00770 * AND W-ANN-ITEM (ASUB1) = MRPT-ITEM-NO DTSBX342 00771 * MOVE ASUB1 TO ASUB DTSBX342 00772 * END-IF DTSBX342 00773 * END-PERFORM. DTSBX342 00774 * DTSBX342 00775 * IF ASUB = ZERO DTSBX342 00776 * ADD +1 TO ASUB-LAST DTSBX342 00777 * MOVE ASUB-LAST TO ASUB DTSBX342 00778 * ELSE DTSBX342 00779 * ADD MRPT-REMIT-AMT TO W-ANN-REMIT (ASUB) DTSBX342 00780 * ADD MRPT-TOT-WAGE TO W-ANN-TOT-WAGE (ASUB) DTSBX342 00781 * ADD MRPT-TAX-WAGE TO W-ANN-TAX-WAGE (ASUB) DTSBX342 00782 * ADD MRPT-EXCESS-WAGE TO W-ANN-EXCESS-WAGE (ASUB) DTSBX342 00783 * GO TO P3121-EXIT DTSBX342 00784 * END-IF. DTSBX342 00785 * DTSBX342 00786 * MOVE MRPT-RPT-TYPE DTSBX342 00787 * TO W-ANN-RPT-TYPE (ASUB). DTSBX342 00788 * MOVE MRPT-YRQ TO W-ANN-YRQ (ASUB). DTSBX342 00789 * MOVE MRPT-BATCH-NO TO W-ANN-BATCH (ASUB). DTSBX342 00790 * MOVE MRPT-ITEM-NO TO W-ANN-ITEM (ASUB). DTSBX342 00791 * ADD MRPT-REMIT-AMT TO W-ANN-REMIT (ASUB). DTSBX342 00792 * ADD MRPT-TOT-WAGE TO W-ANN-TOT-WAGE (ASUB). DTSBX342 00793 * ADD MRPT-TAX-WAGE TO W-ANN-TAX-WAGE (ASUB). DTSBX342 00794 * ADD MRPT-EXCESS-WAGE TO W-ANN-EXCESS-WAGE (ASUB). DTSBX342 00795 * MOVE MRPT-UI-RATE TO W-ANN-RATE (ASUB). DTSBX342 00796 * MOVE MRPT-RECEIVED-DATE TO W-ANN-RCVD-DT (ASUB). DTSBX342 00797 * MOVE MRPT-ESTB-DATE TO W-ANN-PROCESS-DT (ASUB). DTSBX342 00798 * DTSBX342 00799 *P3121-EXIT. DTSBX342 00800 * EXIT. DTSBX342 00801 * DTSBX342 00802 *P3122-INIT-ANN-TBL. DTSBX342 00803 * MOVE ZERO TO ASUB-LAST. DTSBX342 00804 * PERFORM DTSBX342 00805 * VARYING ASUB FROM +1 BY +1 DTSBX342 00806 * UNTIL ASUB > ASUB-MAX DTSBX342 00807 * MOVE SPACES TO W-ANN-RPT-TYPE (ASUB) DTSBX342 00808 * MOVE ZERO TO W-ANN-YRQ (ASUB) DTSBX342 00809 * W-ANN-RATE (ASUB) DTSBX342 00810 * W-ANN-REMIT (ASUB) DTSBX342 00811 * W-ANN-BATCH (ASUB) DTSBX342 00812 * W-ANN-ITEM (ASUB) DTSBX342 00813 * W-ANN-TOT-WAGE (ASUB) DTSBX342 00814 * W-ANN-TAX-WAGE (ASUB) DTSBX342 00815 * W-ANN-EXCESS-WAGE (ASUB) DTSBX342 00816 * W-ANN-RCVD-DT (ASUB) DTSBX342 00817 * W-ANN-PROCESS-DT (ASUB) DTSBX342 00818 * END-PERFORM. DTSBX342 00819 * DTSBX342 00820 *P3122-EXIT. DTSBX342 00821 * EXIT. DTSBX342 00822 * DTSBX342 00823 *P3123-WRITE. DTSBX342 00824 * MOVE W-ANN-RPT-TYPE (ASUB) TO TRAN-TRANS. DTSBX342 00825 * MOVE W-ANN-BATCH (ASUB) TO TRAN-BATCH. DTSBX342 00826 * MOVE W-ANN-ITEM (ASUB) TO TRAN-ITEM. DTSBX342 00827 * MOVE MPRF-EMP-NO TO TRAN-EMP-NO. DTSBX342 00828 * MOVE 1 TO W-ANN-YRQ-Q (ASUB). DTSBX342 00829 * MOVE W-ANN-YRQ (ASUB) TO L004-QTR-5-9 DTSBX342 00830 * PERFORM S004-FROM-5 THRU S004-EXIT DTSBX342 00831 * MOVE L004-SLASH-5-QTR TO TRAN-YRQ DTSBX342 00832 * MOVE L004-ABS-QTR TO QSUB. DTSBX342 00833 * SET TBL-QTR-YES-88 (QSUB) TO TRUE. DTSBX342 00834 * MOVE W-ANN-REMIT (ASUB) TO TRAN-AMT. DTSBX342 00835 * MOVE W-ANN-TOT-WAGE (ASUB) TO TRAN-TOT-WAGE. DTSBX342 00836 * MOVE W-ANN-TAX-WAGE (ASUB) TO TRAN-TAX-WAGE. DTSBX342 00837 * MOVE W-ANN-EXCESS-WAGE (ASUB) TO TRAN-EXC-WAGE. DTSBX342 00838 * COMPUTE W-RATE = (W-ANN-RATE (ASUB) * 100). DTSBX342 00839 * MOVE W-RATE TO TRAN-RATE. DTSBX342 00840 * MOVE SPACES TO TRAN-ACCT. DTSBX342 00841 * MOVE 'T' TO TRAN-CAT. DTSBX342 00842 * SET TRAN-SOURCE-CR-DB-88 TO TRUE. DTSBX342 00843 * MOVE W-ANN-RCVD-DT (ASUB) TO L001-FED-8-DATE-9. DTSBX342 00844 * PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX342 00845 * MOVE L001-SLASH-8-DATE TO TRAN-RCVD-DT. DTSBX342 00846 * MOVE W-ANN-PROCESS-DT (ASUB) TO L001-FED-8-DATE-9. DTSBX342 00847 * PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX342 00848 * MOVE L001-SLASH-8-DATE TO TRAN-PROCESS-DT. DTSBX342 00849 * DTSBX342 00850 * WRITE TRAN-REC FROM W-TRAN-REC. DTSBX342 00851 * IF NOT TRAN-STATUS-OK-88 DTSBX342 00852 * DISPLAY 'CANNOT WRITE TO TRAN FILE ' DTSBX342 00853 * ' ' TRAN-STATUS ' ' TRAN-EMP-NO DTSBX342 00854 * ELSE DTSBX342 00855 * ADD +1 TO W-TRAN-CNT DTSBX342 00856 * W-ANN-RPT-CNT DTSBX342 00857 * END-IF. DTSBX342 00858 * DTSBX342 00859 *P3123-EXIT. DTSBX342 00860 * EXIT. DTSBX342 00861 DTSBX342 00862 P3130-STATUS-CHANGE. DTSBX342 00863 *** DISPLAY 'STATUS ' MRPT-EMP-NO ' ' MRPT-BATCH-NO DTSBX342 00864 *** ' ' MRPT-ITEM-NO. DTSBX342 00865 MOVE LX34-PRIOR-RUN-DATE TO L001-FED-8-DATE-9. DTSBX342 00866 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX342 00867 MOVE L001-SLASH-8-DATE TO SUMMARY-PROCESS-DT. DTSBX342 00868 MOVE 'STATUS CHANGE ' TO SUMMARY-MESSAGE. DTSBX342 00869 MOVE MRPT-EMP-NO TO SUMMARY-EMP-NO DTSBX342 00870 DTSBX342 00871 MOVE MRPT-BATCH-NO TO SUMMARY-BATCH. DTSBX342 00872 MOVE MRPT-ITEM-NO TO SUMMARY-ITEM. DTSBX342 00873 MOVE MRPT-RPT-TYPE TO SUMMARY-TRAN. DTSBX342 00874 SET SUMMARY-SOURCE-STATUS-88 TO TRUE DTSBX342 00875 DTSBX342 00876 WRITE SUMMARY-REC FROM W-SUMMARY-REC. DTSBX342 00877 ADD +1 TO W-SUMMARY-CNT. DTSBX342 00878 DTSBX342 00879 P3130-EXIT. DTSBX342 00880 EXIT. DTSBX342 00881 DTSBX342 00882 P3200-PAYMENT. DTSBX342 00883 MOVE LOW-VALUES TO MPAY-KEY-AREA. DTSBX342 00884 MOVE MPRF-EMP-NO TO MPAY-EMP-NO. DTSBX342 00885 SET MPAY-PAY-88 TO TRUE. DTSBX342 00886 MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA. DTSBX342 00887 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX342 00888 IF L910-NO-REC-88 DTSBX342 00889 GO TO P3200-EXIT DTSBX342 00890 ELSE DTSBX342 00891 PERFORM DTSBX342 00892 UNTIL L910-NO-REC-88 DTSBX342 00893 MOVE MSKL-REC TO MPAY-REC DTSBX342 00894 IF MPAY-ESTB-DATE = LX34-PRIOR-RUN-DATE DTSBX342 00895 PERFORM P3210-WRITE THRU P3210-EXIT DTSBX342 00896 END-IF DTSBX342 00897 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX342 00898 END-PERFORM DTSBX342 00899 END-IF. DTSBX342 00900 DTSBX342 00901 P3200-EXIT. DTSBX342 00902 EXIT. DTSBX342 00903 DTSBX342 00904 P3210-WRITE. DTSBX342 00905 MOVE MPAY-PAY-TYPE TO TRAN-TRANS. DTSBX342 00906 IF MPAY-APPLIC-YRQ > ZERO DTSBX342 00907 MOVE MPAY-APPLIC-YRQ TO L004-QTR-5-9 DTSBX342 00908 PERFORM S004-FROM-5 THRU S004-EXIT DTSBX342 00909 MOVE L004-SLASH-5-QTR TO TRAN-YRQ DTSBX342 00910 ELSE DTSBX342 00911 MOVE SPACES TO TRAN-YRQ DTSBX342 00912 END-IF. DTSBX342 00913 MOVE MPRF-EMP-NO TO TRAN-EMP-NO. DTSBX342 00914 MOVE MPAY-BATCH-NO TO TRAN-BATCH. DTSBX342 00915 MOVE MPAY-ITEM-NO TO TRAN-ITEM. DTSBX342 00916 MOVE MPAY-REMIT-AMT TO TRAN-AMT. DTSBX342 00917 DTSBX342 00918 MOVE ZERO TO TRAN-TAX-WAGE DTSBX342 00919 TRAN-TOT-WAGE DTSBX342 00920 TRAN-EXC-WAGE DTSBX342 00921 TRAN-RATE. DTSBX342 00922 MOVE MPAY-APPLIC-IND TO TRAN-ACCT. DTSBX342 00923 MOVE MPAY-APPLIC-BATCH-NO TO TRAN-APPLIC-BATCH. DTSBX342 00924 MOVE MPAY-APPLIC-ITEM-NO TO TRAN-APPLIC-ITEM. DTSBX342 00925 MOVE 'P' TO TRAN-CAT. DTSBX342 00926 SET TRAN-SOURCE-CR-DB-88 TO TRUE. DTSBX342 00927 MOVE MPAY-RECEIVED-DATE TO L001-FED-8-DATE-9. DTSBX342 00928 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX342 00929 MOVE L001-SLASH-8-DATE TO TRAN-RCVD-DT. DTSBX342 00930 MOVE MPAY-ESTB-DATE TO L001-FED-8-DATE-9. DTSBX342 00931 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX342 00932 IF L001-VALID-DATE DTSBX342 00933 MOVE L001-SLASH-8-DATE TO TRAN-PROCESS-DT DTSBX342 00934 ELSE DTSBX342 00935 MOVE TRAN-RCVD-DT TO TRAN-PROCESS-DT DTSBX342 00936 ** MOVE W-DEFAULT-DATE TO TRAN-PROCESS-DT DTSBX342 00937 END-IF. DTSBX342 00938 DTSBX342 00939 WRITE TRAN-REC FROM W-TRAN-REC DTSBX342 00940 IF NOT TRAN-STATUS-OK-88 DTSBX342 00941 DISPLAY 'CANNOT WRITE TO TRAN FILE ' DTSBX342 00942 ' ' TRAN-STATUS ' ' TRAN-EMP-NO DTSBX342 00943 ELSE DTSBX342 00944 ADD +1 TO W-TRAN-CNT DTSBX342 00945 W-PAY-CNT DTSBX342 00946 END-IF. DTSBX342 00947 DTSBX342 00948 P3210-EXIT. DTSBX342 00949 EXIT. DTSBX342 00950 DTSBX342 00951 P3300-ADJUSTMENT. DTSBX342 00952 MOVE LOW-VALUES TO MADJ-KEY-AREA. DTSBX342 00953 MOVE MPRF-EMP-NO TO MADJ-EMP-NO. DTSBX342 00954 SET MADJ-ADJ-88 TO TRUE. DTSBX342 00955 MOVE MADJ-KEY-AREA TO MSKL-KEY-AREA. DTSBX342 00956 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX342 00957 IF L910-NO-REC-88 DTSBX342 00958 GO TO P3300-EXIT DTSBX342 00959 ELSE DTSBX342 00960 PERFORM DTSBX342 00961 UNTIL L910-NO-REC-88 DTSBX342 00962 MOVE MSKL-REC TO MADJ-REC DTSBX342 00963 IF MADJ-ESTB-DATE = LX34-PRIOR-RUN-DATE DTSBX342 00964 PERFORM P3310-WRITE THRU P3310-EXIT DTSBX342 00965 END-IF DTSBX342 00966 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX342 00967 END-PERFORM DTSBX342 00968 END-IF. DTSBX342 00969 DTSBX342 00970 P3300-EXIT. DTSBX342 00971 EXIT. DTSBX342 00972 DTSBX342 00973 P3310-WRITE. DTSBX342 00974 IF MADJ-CHRG-88 DTSBX342 00975 OR MADJ-WAIVE-88 DTSBX342 00976 OR MADJ-TOLER-88 DTSBX342 00977 OR MADJ-WRITE-OFF-88 DTSBX342 00978 OR MADJ-WRITE-OFF-REV-88 DTSBX342 00979 NEXT SENTENCE DTSBX342 00980 ELSE DTSBX342 00981 GO TO P3310-EXIT DTSBX342 00982 END-IF. DTSBX342 00983 DTSBX342 00984 MOVE MADJ-ADJ-TYPE TO TRAN-TRANS. DTSBX342 00985 MOVE MADJ-BATCH-NO TO TRAN-BATCH. DTSBX342 00986 MOVE MADJ-ITEM-NO TO TRAN-ITEM. DTSBX342 00987 IF MADJ-APPLIC-YRQ > ZERO DTSBX342 00988 MOVE MADJ-APPLIC-YRQ TO L004-QTR-5-9 DTSBX342 00989 PERFORM S004-FROM-5 THRU S004-EXIT DTSBX342 00990 MOVE L004-SLASH-5-QTR TO TRAN-YRQ DTSBX342 00991 MOVE L004-ABS-QTR TO QSUB DTSBX342 00992 SET TBL-QTR-YES-88 (QSUB) TO TRUE DTSBX342 00993 DISPLAY 'P3310 ADJ ' MPRF-EMP-NO DTSBX342 00994 ' ' MADJ-APPLIC-YRQ DTSBX342 00995 ' ' QSUB DTSBX342 00996 ELSE DTSBX342 00997 MOVE SPACES TO TRAN-YRQ DTSBX342 00998 END-IF. DTSBX342 00999 MOVE MPRF-EMP-NO TO TRAN-EMP-NO. DTSBX342 01000 MOVE MADJ-AMT TO TRAN-AMT. DTSBX342 01001 DTSBX342 01002 MOVE ZERO TO TRAN-TOT-WAGE DTSBX342 01003 TRAN-TAX-WAGE DTSBX342 01004 TRAN-EXC-WAGE DTSBX342 01005 TRAN-RATE. DTSBX342 01006 MOVE MADJ-APPLIC-IND TO TRAN-ACCT. DTSBX342 01007 MOVE MADJ-APPLIC-BATCH-NO TO TRAN-APPLIC-BATCH. DTSBX342 01008 MOVE MADJ-APPLIC-ITEM-NO TO TRAN-APPLIC-ITEM. DTSBX342 01009 MOVE 'A' TO TRAN-CAT. DTSBX342 01010 SET TRAN-SOURCE-CR-DB-88 TO TRUE. DTSBX342 01011 MOVE MADJ-RECEIVED-DATE TO L001-FED-8-DATE-9. DTSBX342 01012 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX342 01013 MOVE L001-SLASH-8-DATE TO TRAN-RCVD-DT. DTSBX342 01014 MOVE MADJ-ESTB-DATE TO L001-FED-8-DATE-9. DTSBX342 01015 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX342 01016 IF L001-VALID-DATE DTSBX342 01017 MOVE L001-SLASH-8-DATE TO TRAN-PROCESS-DT DTSBX342 01018 ELSE DTSBX342 01019 MOVE TRAN-RCVD-DT TO TRAN-PROCESS-DT DTSBX342 01020 ** MOVE W-DEFAULT-DATE TO TRAN-PROCESS-DT DTSBX342 01021 END-IF. DTSBX342 01022 DTSBX342 01023 WRITE TRAN-REC FROM W-TRAN-REC DTSBX342 01024 IF NOT TRAN-STATUS-OK-88 DTSBX342 01025 DISPLAY 'CANNOT WRITE TO TRAN FILE ' DTSBX342 01026 ' ' TRAN-STATUS ' ' TRAN-EMP-NO DTSBX342 01027 ELSE DTSBX342 01028 ADD +1 TO W-TRAN-CNT DTSBX342 01029 W-ADJ-CNT DTSBX342 01030 END-IF. DTSBX342 01031 DTSBX342 01032 P3310-EXIT. DTSBX342 01033 EXIT. DTSBX342 01034 DTSBX342 01035 P4000-UPDATE-QTRS. DTSBX342 01036 PERFORM DTSBX342 01037 VARYING QSUB FROM +1 BY +1 DTSBX342 01038 UNTIL QSUB > QMAX DTSBX342 01039 IF TBL-QTR-YES-88 (QSUB) DTSBX342 01040 PERFORM P4100-BUILD-QTR THRU P4100-EXIT DTSBX342 01041 END-IF DTSBX342 01042 END-PERFORM. DTSBX342 01043 DTSBX342 01044 P4000-EXIT. DTSBX342 01045 EXIT. DTSBX342 01046 DTSBX342 01047 P4100-BUILD-QTR. DTSBX342 01048 DISPLAY 'P4100 ' MPRF-EMP-NO ' ' MQTR-YRQ. DTSBX342 01049 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBX342 01050 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBX342 01051 SET MQTR-QTR-88 TO TRUE. DTSBX342 01052 MOVE QSUB TO L004-ABS-QTR. DTSBX342 01053 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBX342 01054 MOVE L004-QTR-5-9 TO MQTR-YRQ. DTSBX342 01055 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBX342 01056 PERFORM S910-READ THRU S910-EXIT. DTSBX342 01057 IF L910-NO-REC-88 DTSBX342 01058 GO TO P4100-EXIT DTSBX342 01059 ELSE DTSBX342 01060 MOVE MSKL-REC TO MQTR-REC DTSBX342 01061 END-IF. DTSBX342 01062 DTSBX342 01063 ** MOVE MQTR-YRQ TO L004-QTR-5-9. DTSBX342 01064 ** PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX342 01065 ** MOVE L004-ABS-QTR TO LX34-SUB. DTSBX342 01066 MOVE QSUB TO LX34-SUB. DTSBX342 01067 IF LX34-QTR-EXISTS-YES-88 (LX34-SUB) DTSBX342 01068 GO TO P4100-EXIT DTSBX342 01069 ELSE DTSBX342 01070 SET LX34-QTR-EXISTS-YES-88 (LX34-SUB) TO TRUE DTSBX342 01071 END-IF. DTSBX342 01072 DTSBX342 01073 DISPLAY 'P4100 - 2 ' MPRF-EMP-NO ' ' MQTR-YRQ. DTSBX342 01074 MOVE ZERO TO W-QTR-BAL. DTSBX342 01075 IF MPRF-TOT-BALANCE-AMT > ZERO DTSBX342 01076 PERFORM P4110-BAL-DUE THRU P4110-EXIT DTSBX342 01077 END-IF. DTSBX342 01078 DTSBX342 01079 MOVE MQTR-EMP-NO TO QTR-EMP-NO. DTSBX342 01080 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSBX342 01081 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX342 01082 IF L004-VALID-QTR DTSBX342 01083 MOVE L004-SLASH-5-QTR TO QTR-QUARTER DTSBX342 01084 ELSE DTSBX342 01085 GO TO P4100-EXIT DTSBX342 01086 END-IF. DTSBX342 01087 MOVE MQTR-CURR-RPT-TYPE TO QTR-RPT-STATUS. DTSBX342 01088 MOVE MQTR-RPT-DUE-DATE TO L001-FED-8-DATE-9. DTSBX342 01089 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX342 01090 MOVE L001-SLASH-8-DATE TO QTR-DUE-DT. DTSBX342 01091 MOVE W-QTR-BAL TO QTR-BAL-DUE. DTSBX342 01092 DTSBX342 01093 MOVE MQTR-ESTB-DATE TO L001-FED-8-DATE-X. DTSBX342 01094 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX342 01095 IF L001-VALID-DATE DTSBX342 01096 MOVE L001-SLASH-8-DATE TO QTR-PROCESS-DT DTSBX342 01097 ELSE DTSBX342 01098 MOVE W-DEFAULT-DATE TO QTR-PROCESS-DT DTSBX342 01099 END-IF. DTSBX342 01100 DTSBX342 01101 IF QTR-PROCESS-DT = W-DEFAULT-DATE DTSBX342 01102 MOVE MQTR-CHNG-DATE TO L001-FED-8-DATE-X DTSBX342 01103 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX342 01104 IF L001-VALID-DATE DTSBX342 01105 MOVE L001-SLASH-8-DATE TO QTR-PROCESS-DT DTSBX342 01106 END-IF DTSBX342 01107 END-IF. DTSBX342 01108 DTSBX342 01109 WRITE QTR-REC FROM W-QTR-REC DTSBX342 01110 IF NOT QTR-STATUS-OK-88 DTSBX342 01111 DISPLAY 'CANNOT WRITE TO QTR FILE ' DTSBX342 01112 ' ' QTR-STATUS ' ' QTR-EMP-NO DTSBX342 01113 ELSE DTSBX342 01114 ADD +1 TO W-QTR-CNT DTSBX342 01115 END-IF. DTSBX342 01116 DTSBX342 01117 P4100-EXIT. DTSBX342 01118 EXIT. DTSBX342 01119 DTSBX342 01120 P4110-BAL-DUE. DTSBX342 01121 PERFORM DTSBX342 01122 VARYING MQTR-ACCT-IDX FROM +1 BY +1 DTSBX342 01123 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSBX342 01124 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) TO W-QTR-BAL DTSBX342 01125 END-PERFORM. DTSBX342 01126 DTSBX342 01127 P4110-EXIT. DTSBX342 01128 EXIT. DTSBX342 01129 DTSBX342 01130 P5000-PAY-DISTRIBUTION. DTSBX342 01131 MOVE LOW-VALUES TO MDST-KEY-AREA. DTSBX342 01132 MOVE MPRF-EMP-NO TO MDST-EMP-NO. DTSBX342 01133 SET MDST-DST-88 TO TRUE. DTSBX342 01134 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBX342 01135 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX342 01136 PERFORM UNTIL L910-NO-REC-88 DTSBX342 01137 MOVE MSKL-REC TO MDST-REC DTSBX342 01138 PERFORM P5100-BUILD-OUTPUT THRU P5100-EXIT DTSBX342 01139 MOVE MDST-REC TO MSKL-REC DTSBX342 01140 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX342 01141 END-PERFORM. DTSBX342 01142 DTSBX342 01143 P5000-EXIT. DTSBX342 01144 EXIT. DTSBX342 01145 DTSBX342 01146 P5100-BUILD-OUTPUT. DTSBX342 01147 IF MPRF-EMP-NO = 014121 DTSBX342 01148 DISPLAY 'P5100 ' MPRF-EMP-NO ' ' MDST-BATCH-NO DTSBX342 01149 ' ' MDST-ITEM-NO DTSBX342 01150 END-IF. DTSBX342 01151 DTSBX342 01152 MOVE MDST-EMP-NO TO DST-EMP-NO. DTSBX342 01153 MOVE MDST-BATCH-NO TO DST-BATCH. DTSBX342 01154 MOVE MDST-ITEM-NO TO DST-ITEM. DTSBX342 01155 MOVE MDST-YRQ TO L004-QTR-5-9. DTSBX342 01156 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX342 01157 MOVE L004-SLASH-5-QTR TO DST-QTR DTSBX342 01158 MOVE MDST-CHNG-DATE TO L001-FED-8-DATE-9. DTSBX342 01159 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX342 01160 MOVE L001-SLASH-8-DATE TO DST-CHNG-DT. DTSBX342 01161 IF L001-INVALID-DATE DTSBX342 01162 DISPLAY 'P5100 INVALID MDST-CHNG-DATE ' DTSBX342 01163 MDST-EMP-NO ' ' MDST-BATCH-NO DTSBX342 01164 ' ' MDST-ITEM-NO DTSBX342 01165 GO TO P5100-EXIT DTSBX342 01166 ELSE DTSBX342 01167 PERFORM DTSBX342 01168 VARYING MDST-ACCT-IDX FROM +1 BY +1 DTSBX342 01169 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT DTSBX342 01170 MOVE MDST-ACCT-IND (MDST-ACCT-IDX) TO DST-ACCT DTSBX342 01171 MOVE MDST-AMT (MDST-ACCT-IDX) TO DST-AMT DTSBX342 01172 PERFORM P5110-WRITE THRU P5110-EXIT DTSBX342 01173 END-PERFORM DTSBX342 01174 END-IF. DTSBX342 01175 DTSBX342 01176 P5100-EXIT. DTSBX342 01177 EXIT. DTSBX342 01178 DTSBX342 01179 P5110-WRITE. DTSBX342 01180 IF MPRF-EMP-NO = 014121 DTSBX342 01181 DISPLAY 'P5110 ' DST-EMP-NO ' ' DST-BATCH DTSBX342 01182 ' ' DST-ITEM ' ' DST-ACCT ' ' DST-AMT DTSBX342 01183 END-IF. DTSBX342 01184 WRITE PAY-DIST-REC FROM W-PAY-DIST-REC. DTSBX342 01185 IF NOT PAYDIST-STATUS-OK-88 DTSBX342 01186 DISPLAY 'CANNOT WRITE TO PAY DIST FILE ' DTSBX342 01187 ' ' PAYDIST-STATUS ' ' DST-EMP-NO DTSBX342 01188 ELSE DTSBX342 01189 ADD +1 TO W-PAY-DIST-CNT DTSBX342 01190 END-IF. DTSBX342 01191 DTSBX342 01192 P5110-EXIT. DTSBX342 01193 EXIT. DTSBX342 01194 DTSBX342 01195 T0000-TERMINATE. DTSBX342 01196 CLOSE ACCT-FILE DTSBX342 01197 QTR-FILE DTSBX342 01198 TRAN-FILE DTSBX342 01199 SUMMARY-FILE DTSBX342 01200 PAY-DIST-FILE. DTSBX342 01201 DTSBX342 01202 DISPLAY '*********************************************'. DTSBX342 01203 DISPLAY '** DTSBX342 TERMINATION STATISTICS **'. DTSBX342 01204 DISPLAY '** **'. DTSBX342 01205 DISPLAY '** QUARTERS ' W-QTR-CNT DTSBX342 01206 ' **'. DTSBX342 01207 DISPLAY '** ACOUNTING ' W-ACCT-CNT DTSBX342 01208 ' **'. DTSBX342 01209 DISPLAY '** TRANSACTIONS ' W-TRAN-CNT DTSBX342 01210 ' **'. DTSBX342 01211 DISPLAY '** REPORTS ' W-RPT-CNT DTSBX342 01212 ' **'. DTSBX342 01213 DISPLAY '** ANN REPORTS ' W-ANN-RPT-CNT DTSBX342 01214 ' **'. DTSBX342 01215 DISPLAY '** PAYMENTS ' W-PAY-CNT DTSBX342 01216 ' **'. DTSBX342 01217 DISPLAY '** ADJUST ' W-ADJ-CNT DTSBX342 01218 ' **'. DTSBX342 01219 DISPLAY '** STATUS CHNG ' W-SUMMARY-CNT DTSBX342 01220 ' **'. DTSBX342 01221 DISPLAY '** PAY DIST ' W-PAY-DIST-CNT DTSBX342 01222 ' **'. DTSBX342 01223 DISPLAY '** **'. DTSBX342 01224 DISPLAY '** **'. DTSBX342 01225 DISPLAY '*********************************************'. DTSBX342 01226 DTSBX342 01227 DTSBX342 01228 T0000-EXIT. DTSBX342 01229 EXIT. DTSBX342 01230 DTSBX342 01231 DTSBX342 01232 S001-FROM-FED-8. DTSBX342 01233 SET L001-FROM-FED-8 TO TRUE. DTSBX342 01234 GO TO S001-DATE. DTSBX342 01235 DTSBX342 01236 S001-FROM-ABS-DAY. DTSBX342 01237 SET L001-FROM-ABS-DAY TO TRUE. DTSBX342 01238 GO TO S001-DATE. DTSBX342 01239 DTSBX342 01240 S001-FROM-CAL-6. DTSBX342 01241 SET L001-FROM-CAL-6 TO TRUE. DTSBX342 01242 GO TO S001-DATE. DTSBX342 01243 DTSBX342 01244 S001-DATE. DTSBX342 01245 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX342 01246 S001-EXIT. DTSBX342 01247 EXIT. DTSBX342 01248 SKIP3 DTSBX342 01249 S004-FROM-5. DTSBX342 01250 SET L004-FROM-5 TO TRUE. DTSBX342 01251 GO TO S004-QTR. DTSBX342 01252 DTSBX342 01253 S004-FROM-ABS. DTSBX342 01254 SET L004-FROM-ABS TO TRUE. DTSBX342 01255 GO TO S004-QTR. DTSBX342 01256 DTSBX342 01257 S004-FROM-3. DTSBX342 01258 SET L004-FROM-3 TO TRUE. DTSBX342 01259 GO TO S004-QTR. DTSBX342 01260 DTSBX342 01261 S004-FROM-DATE. DTSBX342 01262 SET L004-FROM-DATE TO TRUE. DTSBX342 01263 GO TO S004-QTR. DTSBX342 01264 DTSBX342 01265 S004-QTR. DTSBX342 01266 DTSBX342 01267 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX342 01268 DTSBX342 01269 S004-EXIT. DTSBX342 01270 EXIT. DTSBX342 01271 SKIP3 DTSBX342 01272 S005-FROM-DATE-TIME. DTSBX342 01273 SET L005-FROM-DATE-TIME TO TRUE. DTSBX342 01274 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBX342 01275 S005-EXIT. DTSBX342 01276 EXIT. DTSBX342 01277 DTSBX342 01278 S910-OPEN-READ. DTSBX342 01279 SET L910-OPEN-READ-88 TO TRUE. DTSBX342 01280 GO TO S910-MSTR-IO. DTSBX342 01281 DTSBX342 01282 S910-READ. DTSBX342 01283 SET L910-READ-88 TO TRUE. DTSBX342 01284 GO TO S910-MSTR-IO. DTSBX342 01285 DTSBX342 01286 S910-START-BROWSE. DTSBX342 01287 SET L910-START-BROWSE-88 TO TRUE. DTSBX342 01288 GO TO S910-MSTR-IO. DTSBX342 01289 DTSBX342 01290 S910-READ-NEXT. DTSBX342 01291 SET L910-READ-NEXT-88 TO TRUE. DTSBX342 01292 GO TO S910-MSTR-IO. DTSBX342 01293 DTSBX342 01294 S910-COUNT. DTSBX342 01295 SET L910-COUNT-88 TO TRUE. DTSBX342 01296 GO TO S910-MSTR-IO. DTSBX342 01297 DTSBX342 01298 S910-REWRITE. DTSBX342 01299 SET L910-REWRITE-88 TO TRUE. DTSBX342 01300 GO TO S910-MSTR-IO. DTSBX342 01301 DTSBX342 01302 S910-CLOSE. DTSBX342 01303 SET L910-CLOSE-88 TO TRUE. DTSBX342 01304 GO TO S910-MSTR-IO. DTSBX342 01305 DTSBX342 01306 S910-MSTR-IO. DTSBX342 01307 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX342 01308 MSKL-REC. DTSBX342 01309 S910-EXIT. DTSBX342 01310 EXIT. DTSBX342 01311 SKIP3 DTSBX342 01312 DTSBX342 01313 S931-READ. DTSBX342 01314 SET L931-READ-88 TO TRUE. DTSBX342 01315 GO TO S931-REF-IO. DTSBX342 01316 DTSBX342 01317 S931-REF-IO. DTSBX342 01318 CALL 'DTSBU931' USING L931-LINK-AREA DTSBX342 01319 FSKL-REC. DTSBX342 01320 S931-EXIT. DTSBX342 01321 EXIT. DTSBX342 01322 DTSBX342 01323 S999-ABEND. DTSBX342 01324 DISPLAY '*** DTSBE335 ABENDING. ' DTSBX342 01325 ABEND-MSG. DTSBX342 01326 DTSBX342 01327 CALL 'DTSBU999' USING W-ABEND-CD. DTSBX342 01328 S999-EXIT. DTSBX342 01329 EXIT. DTSBX342