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