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