1331 lines
105 KiB
COBOL
1331 lines
105 KiB
COBOL
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
|