00001 IDENTIFICATION DIVISION. 11/11/02 00002 PROGRAM-ID. DTSBD510. DTSBD510 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV013 00004 DATE-WRITTEN. JANUARY 1991. DTSBD510 00005 DATE-COMPILED. DTSBD510 00006 SKIP3 DTSBD510 00007 ***** DTSBD510 00008 * DTSBD510 00009 * FUNCTION: ACCOUNTING SUMMARY EXTRACT. DTSBD510 00010 * DTSBD510 00011 * DTSBD510 00012 * MODIFICATION LOG: DTSBD510 00013 * DTSBD510 00014 * 01/25/92 INITIAL DEVELOPMENT. DTSBD510 00015 * WORK ORDER: PROGRAMMER: TCL DTSBD510 00016 * DTSBD510 00017 * 10/28/94 MODIFIED FOR MONTANA. DTSBD510 00018 * WORK ORDER: PROGRAMMER: TCL DTSBD510 00019 * DTSBD510 00020 * 02/10/1999 REVIEWED AND MODIFIED FOR DC. DTSBD510 00021 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBD510 00022 * DTSBD510 00023 * 05/20/1999 PICKUP MODIFICATIONS. LIMIT PREC-*-YRQ TO DTSBD510 00024 * 'PU ' OR >= 19931. DTSBD510 00025 * REFERENCE: PICKUP DIR PROGRAMMER: EHH DTSBD510 00026 * DTSBD510 00027 * 10/16/2002 ADDED A NEW VALUE TO THE RUNTYPE PARM. WHEN DTSBD510 00028 * THE RUNTYPE IS SET TO ' D', THE PROGRAM DTSBD510 00029 * WILL SET THE START AND END PROCESS DATE DTSBD510 00030 * PARAMETERS TO THE PRIOR RUN DATE. DTSBD510 00031 * REFERENCE: PROGRAMMER: GD DTSBD510 00032 * DTSBD510 00033 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD510 00034 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD510 00035 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBD510 00036 * DTSBD510 00037 * DTSBD510 00038 * DESCRIPTION: DTSBD510 00039 * DTSBD510 00040 * READ PARAMETER CARDS SPECIFYING THE JOURNAL RECORDS TO BE DTSBD510 00041 * REPORTED. TABLE THE PARAMETER CARDS. PERMIT 10 REQUESTS DTSBD510 00042 * PER RUN. DTSBD510 00043 * DTSBD510 00044 * INITIALIZE A COUNTS TABLE ASSOCIATED WITH EACH REQUEST DTSBD510 00045 * CARD. DTSBD510 00046 * DTSBD510 00047 * READ THE JOURNAL RECORDS FROM THE TAX MASTER FILE. DTSBD510 00048 * EVALUATE EACH RECORD FOR INCLUSION IN THE TABLED REQUESTS. DTSBD510 00049 * SUM THE RECORD AMOUNT INTO THE APPROPRIATE COUNTER IN ZERO DTSBD510 00050 * ONE, OR MANY OF THE REQUEST TABLES. DTSBD510 00051 * DTSBD510 00052 * READ THE MHDR RECORD. IF ANY OCCURRENCE OF DTSBD510 00053 * WRK-START-PROCESS-DATE IS LESS THAN OR EQUAL TO DTSBD510 00054 * MHDR-LAST-MJRN-PURGE-DATE, THEN CALL DTSBU961 TO DTSBD510 00055 * OPEN THE TAX MASTER ARCHIVE TAPE AND READ NEXT DTSBD510 00056 * THRU THE TAX MASTER ARCHIVE TAPE, EVALUATING AND DTSBD510 00057 * COUNTING MJRN RECORDS FOUND ON THE TAX MASTER ARCHIVE DTSBD510 00058 * TAPE. DTSBD510 00059 * DTSBD510 00060 * AT TERMINATION WRITE OUT A SET OF R306 RECORDS FOR EACH DTSBD510 00061 * TABLED REQUEST. DTSBD510 00062 * DTSBD510 00063 * OF COURSE, WE COULD ELIMINATE THE TABLING OF COUNTS, BUT DTSBD510 00064 * THAT WOULD LEAD TO THE WRITING OF MILLIONS OF REPORT DTSBD510 00065 * RECORDS. WE HAVE COMPROMISED FLEXIBILITY IN ORDER TO DTSBD510 00066 * SAVE RESOURCES. DTSBD510 00067 * DTSBD510 00068 * PARAMETERS INPUT: DTSBD510 00069 * DTSBD510 00070 * UP TO 10 PARAMTER CARDS. DTSBD510 00071 * DTSBD510 00072 * DTSBD510 00073 * REPORT RECORDS INPUT: DTSBD510 00074 * DTSBD510 00075 * NONE DTSBD510 00076 * DTSBD510 00077 * DTSBD510 00078 * TAPES INPUT: DTSBD510 00079 * DTSBD510 00080 * ARCHIVED TAX MASTER FILE TAPE (VIA DTSBU961). DTSBD510 00081 * DTSBD510 00082 * DTSBD510 00083 * MASTER FILE RECORDS READ: DTSBD510 00084 * DTSBD510 00085 * MHDR DTSBD510 00086 * MPRF DTSBD510 00087 * MJRN DTSBD510 00088 * DTSBD510 00089 * MASTER FILE RECORDS UPDATED: DTSBD510 00090 * DTSBD510 00091 * NONE. DTSBD510 00092 * DTSBD510 00093 * DTSBD510 00094 * REPORT RECORDS WRITTEN: DTSBD510 00095 * DTSBD510 00096 * R306 ACCOUNTING SUMMARY REPORT RECORD. DTSBD510 00097 * DTSBD510 00098 * DTSBD510 00099 * MODULES CALLED: DTSBD510 00100 * DTSBD510 00101 * DTSBU946 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 1. DTSBD510 00102 * DTSBD510 00103 * DTSBD510 00104 ***** DTSBD510 00105 SKIP3 DTSBD510 00106 ENVIRONMENT DIVISION. DTSBD510 00107 SKIP2 DTSBD510 00108 INPUT-OUTPUT SECTION. DTSBD510 00109 SKIP2 DTSBD510 00110 FILE-CONTROL. DTSBD510 00111 SELECT PARM-FILE ASSIGN TO SYSIN. DTSBD510 00112 EJECT DTSBD510 00113 DATA DIVISION. DTSBD510 00114 SKIP3 DTSBD510 00115 FILE SECTION. DTSBD510 00116 SKIP3 DTSBD510 00117 FD PARM-FILE DTSBD510 00118 LABEL RECORDS ARE STANDARD DTSBD510 00119 RECORDING MODE IS F DTSBD510 00120 BLOCK CONTAINS 0 RECORDS. DTSBD510 00121 SKIP2 DTSBD510 00122 01 PARM-REC. DTSBD510 00123 05 PREC-EMP-CLASS PIC X(01). DTSBD510 00124 05 FILLER PIC X(01). DTSBD510 00125 05 PREC-START-PROCESS-DATE PIC X(06). DTSBD510 00126 05 FILLER PIC X(01). DTSBD510 00127 05 PREC-END-PROCESS-DATE PIC X(06). DTSBD510 00128 05 FILLER PIC X(01). DTSBD510 00129 05 PREC-START-DEPOSIT-DATE PIC X(06). DTSBD510 00130 05 FILLER PIC X(01). DTSBD510 00131 05 PREC-END-DEPOSIT-DATE PIC X(06). DTSBD510 00132 05 FILLER PIC X(01). DTSBD510 00133 05 PREC-START-YRQ PIC X(03). DTSBD510 00134 05 FILLER PIC X(01). DTSBD510 00135 05 PREC-END-YRQ PIC X(03). DTSBD510 00136 05 FILLER PIC X(01). DTSBD510 00137 05 PREC-START-BATCH-NO PIC X(05). DTSBD510 00138 05 FILLER PIC X(01). DTSBD510 00139 05 PREC-END-BATCH-NO PIC X(05). DTSBD510 00140 05 FILLER PIC X(01). DTSBD510 00141 05 PREC-RESPONSIBLE-ACTIVITY PIC X(03). DTSBD510 00142 05 FILLER PIC X(01). DTSBD510 00143 05 PREC-TRAN-CATEGORY PIC X(01). DTSBD510 00144 05 FILLER PIC X(01). DTSBD510 00145 05 PREC-TRAN-TYPE-AREA OCCURS 05 TIMES. DTSBD510 00146 10 PREC-TRAN-TYPE PIC X(02). DTSBD510 00147 10 FILLER PIC X(01). DTSBD510 00148 05 FILLER PIC X(09). DTSBD510 00149 EJECT DTSBD510 00150 WORKING-STORAGE SECTION. DTSBD510 001505 77 PAN-VALET PICTURE X(24) VALUE '013DTSBD510 11/11/02'. DTSBD510 00151 SKIP3 DTSBD510 00152 01 WRK-AREA. DTSBD510 00153 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +510.DTSBD510 00154 DTSBD510 00155 05 WRK-NINES-DATE PIC S9(09) COMP-3 DTSBD510 00156 VALUE +999999999.DTSBD510 00157 DTSBD510 00158 05 WRK-NINES-YRQ PIC S9(05) COMP-3 DTSBD510 00159 VALUE +99999. DTSBD510 00160 DTSBD510 00161 05 WRK-PICKUP-YRQ PIC S9(05) COMP-3 DTSBD510 00162 VALUE +19924. DTSBD510 00163 DTSBD510 00164 05 WRK-NINES-BATCH-NO PIC S9(05) COMP-3 DTSBD510 00165 VALUE +99999. DTSBD510 00166 DTSBD510 00167 05 PARM-ZEROS-DATE PIC X(06) VALUE '000000'. DTSBD510 00168 DTSBD510 00169 05 PARM-ZEROS-YRQ PIC X(03) VALUE '000'. DTSBD510 00170 DTSBD510 00171 05 PARM-NINES-DATE PIC X(06) VALUE '999999'. DTSBD510 00172 DTSBD510 00173 05 PARM-NINES-YRQ PIC X(03) VALUE '999'. DTSBD510 00174 DTSBD510 00175 05 PARM-ZEROS-BATCH-NO PIC X(05) VALUE '00000'. DTSBD510 00176 DTSBD510 00177 05 PARM-NINES-BATCH-NO PIC X(05) VALUE '99999'. DTSBD510 00178 DTSBD510 00179 05 WRK-PARM-MAX PIC S9(04) COMP VALUE +10. DTSBD510 00180 DTSBD510 00181 05 WRK-ACCT-ROW-MAX PIC S9(04) COMP VALUE +7. DTSBD510 00182 DTSBD510 00183 05 WRK-ACCT-COL-MAX PIC S9(04) COMP VALUE +5. DTSBD510 00184 DTSBD510 00185 05 WRK-TRAN-TYPE-MAX PIC S9(04) COMP VALUE +05. DTSBD510 00186 DTSBD510 00187 05 ABEND-MSG PIC X(60). DTSBD510 00188 DTSBD510 00189 05 WRK-PARM-REC-CNT PIC S9(07) COMP-3. DTSBD510 00190 DTSBD510 00191 05 WRK-MJRN-REC-CNT PIC S9(07) COMP-3. DTSBD510 00192 DTSBD510 00193 05 WRK-ARCH-MJRN-REC-CNT PIC S9(07) COMP-3. DTSBD510 00194 DTSBD510 00195 05 WRK-R306-REC-CNT PIC S9(07) COMP-3. DTSBD510 00196 DTSBD510 00197 05 SUB1 PIC S9(04) COMP. DTSBD510 00198 DTSBD510 00199 05 SUB2 PIC S9(04) COMP. DTSBD510 00200 DTSBD510 00201 05 SUB3 PIC S9(04) COMP. DTSBD510 00202 DTSBD510 00203 05 WRK-RUN-TYPE PIC X(02). DTSBD510 00204 DTSBD510 00205 05 WRK-ONLY-CHECK-PARM-IND PIC X(01). DTSBD510 00206 DTSBD510 00207 05 DEFAULT-START-PROCESS-DATE PIC S9(09) COMP-3. DTSBD510 00208 DTSBD510 00209 05 DEFAULT-END-PROCESS-DATE PIC S9(09) COMP-3. DTSBD510 00210 DTSBD510 00211 05 WRK-PARM-EOF-IND PIC X(01). DTSBD510 00212 DTSBD510 00213 05 WRK-TRAN-TYPE-FOUND-IND PIC X(01). DTSBD510 00214 DTSBD510 00215 05 WRK-ARCHIVE-REQUIRED-IND PIC X(01). DTSBD510 00216 DTSBD510 00217 05 WRK-EXTRACT-AREA OCCURS 10 TIMES DTSBD510 00218 INDEXED BY WRK-EXTRACT-IDX. DTSBD510 00219 10 WRK-EMP-CLASS PIC X(01). DTSBD510 00220 10 WRK-START-PROCESS-DATE PIC S9(09) COMP-3. DTSBD510 00221 10 WRK-END-PROCESS-DATE PIC S9(09) COMP-3. DTSBD510 00222 10 WRK-START-DEPOSIT-DATE PIC S9(09) COMP-3. DTSBD510 00223 10 WRK-END-DEPOSIT-DATE PIC S9(09) COMP-3. DTSBD510 00224 10 WRK-START-YRQ PIC S9(05) COMP-3. DTSBD510 00225 10 WRK-END-YRQ PIC S9(05) COMP-3. DTSBD510 00226 10 WRK-START-BATCH-NO PIC S9(05) COMP-3. DTSBD510 00227 10 WRK-END-BATCH-NO PIC S9(05) COMP-3. DTSBD510 00228 10 WRK-RESPONSIBLE-ACTIVITY PIC X(03). DTSBD510 00229 10 WRK-TRAN-CATEGORY PIC X(01). DTSBD510 00230 10 WRK-TRAN-TYPE-CNT PIC S9(04) COMP. DTSBD510 00231 10 WRK-TRAN-TYPE-AREA. DTSBD510 00232 15 WRK-TRAN-TYPE OCCURS 05 TIMES DTSBD510 00233 INDEXED BY WRK-TRAN-IDX DTSBD510 00234 PIC X(02). DTSBD510 00235 10 WRK-MATCH-FOUND PIC X(01). DTSBD510 00236 10 WRK-APP-ACCT-ROW OCCURS 7 TIMES DTSBD510 00237 INDEXED BY WRK-APP-ACCT-ROW-IDX. DTSBD510 00238 15 WRK-APP-ACCT-IND PIC X(02). DTSBD510 00239 15 WRK-APP-CAT-TBL OCCURS 5 TIMES DTSBD510 00240 INDEXED BY WRK-APP-ACCT-COL-IDX. DTSBD510 00241 20 WRK-APP-ACCT-COL PIC X(02). DTSBD510 00242 20 WRK-APP-AMT PIC S9(11)V9(02). DTSBD510 00243 DTSBD510 00244 EJECT DTSBD510 00245 01 L001-LINK-AREA. DTSBD510 00246 ++INCLUDE DTSIL001 DTSBD510 00247 SKIP3 DTSBD510 00248 01 L004-LINK-AREA. DTSBD510 00249 ++INCLUDE DTSIL004 DTSBD510 00250 SKIP3 DTSBD510 00251 01 L032-LINK-AREA. DTSBD510 00252 ++INCLUDE DTSIL032 DTSBD510 00253 EJECT DTSBD510 00254 01 L910-LINK-AREA. DTSBD510 00255 ++INCLUDE DTSIL910 DTSBD510 00256 EJECT DTSBD510 00257 01 MSKL-REC. DTSBD510 00258 ++INCLUDE DTSIMSKL DTSBD510 00259 EJECT DTSBD510 00260 01 MHDR-REC. DTSBD510 00261 ++INCLUDE DTSIMHDR DTSBD510 00262 EJECT DTSBD510 00263 01 MPRF-REC. DTSBD510 00264 ++INCLUDE DTSIMPRF DTSBD510 00265 EJECT DTSBD510 00266 01 MJRN-REC. DTSBD510 00267 ++INCLUDE DTSIMJRN DTSBD510 00268 EJECT DTSBD510 00269 01 L961-LINK-AREA. DTSBD510 00270 ++INCLUDE DTSIL961 DTSBD510 00271 EJECT DTSBD510 00272 01 R306-REC. DTSBD510 00273 ++INCLUDE DTSIR306 DTSBD510 00274 EJECT DTSBD510 00275 01 CACT-AREA. DTSBD510 00276 ++INCLUDE DTSICACT DTSBD510 00277 EJECT DTSBD510 00278 LINKAGE SECTION. DTSBD510 00279 SKIP3 DTSBD510 00280 01 PARM-AREA. DTSBD510 00281 05 PARM-LENGTH PIC S9(04) COMP. DTSBD510 00282 05 PARM-DATA. DTSBD510 00283 10 PARM-RUN-TYPE PIC X(02). DTSBD510 00284 10 FILLER PIC X(01). DTSBD510 00285 10 PARM-ONLY-CHECK-PARM-IND PIC X(01). DTSBD510 00286 EJECT DTSBD510 00287 PROCEDURE DIVISION USING PARM-AREA. DTSBD510 00288 DTSBD510 00289 DTSBD510 00290 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBD510 00291 DTSBD510 00292 DTSBD510 00293 IF WRK-ONLY-CHECK-PARM-IND = 'Y' DTSBD510 00294 NEXT SENTENCE DTSBD510 00295 ELSE DTSBD510 00296 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBD510 00297 DTSBD510 00298 DTSBD510 00299 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBD510 00300 DTSBD510 00301 DTSBD510 00302 GOBACK. DTSBD510 00303 EJECT DTSBD510 00304 I0000-INITIATE. DTSBD510 00305 PERFORM I1000-OPEN-FILES THRU I1000-EXIT. DTSBD510 00306 DTSBD510 00307 DTSBD510 00308 PERFORM I2000-MISC-INIT THRU I2000-EXIT. DTSBD510 00309 DTSBD510 00310 DTSBD510 00311 PERFORM I3000-PROCESS-PARMS THRU I3000-EXIT. DTSBD510 00312 I0000-EXIT. DTSBD510 00313 EXIT. DTSBD510 00314 EJECT DTSBD510 00315 I1000-OPEN-FILES. DTSBD510 00316 DTSBD510 00317 DTSBD510 00318 I1000-EXIT. DTSBD510 00319 EXIT. DTSBD510 00320 EJECT DTSBD510 00321 I2000-MISC-INIT. DTSBD510 00322 MOVE +0 TO WRK-PARM-REC-CNT DTSBD510 00323 WRK-R306-REC-CNT DTSBD510 00324 WRK-MJRN-REC-CNT DTSBD510 00325 WRK-ARCH-MJRN-REC-CNT. DTSBD510 00326 DTSBD510 00327 DTSBD510 00328 MOVE LENGTH OF R306-REC TO R306-LENGTH. DTSBD510 00329 DTSBD510 00330 DTSBD510 00331 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBD510 00332 DTSBD510 00333 DTSBD510 00334 MOVE LOW-VALUES TO MHDR-KEY-AREA. DTSBD510 00335 DTSBD510 00336 MOVE +0 TO MHDR-EMP-NO. DTSBD510 00337 DTSBD510 00338 SET MHDR-HDR-88 TO TRUE. DTSBD510 00339 DTSBD510 00340 MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA. DTSBD510 00341 DTSBD510 00342 PERFORM S910-READ THRU S910-EXIT. DTSBD510 00343 DTSBD510 00344 IF L910-NO-REC-88 DTSBD510 00345 MOVE 'MHDR RECORD NOT FOUND' DTSBD510 00346 TO ABEND-MSG DTSBD510 00347 PERFORM S999-ABEND THRU S999-EXIT. DTSBD510 00348 DTSBD510 00349 MOVE MSKL-REC TO MHDR-REC. DTSBD510 00350 DTSBD510 00351 DTSBD510 00352 PERFORM S910-CLOSE THRU S910-EXIT. DTSBD510 00353 DTSBD510 00354 DTSBD510 00355 PERFORM I2100-INIT-TABLE THRU I2100-EXIT DTSBD510 00356 VARYING SUB1 FROM 1 BY 1 DTSBD510 00357 UNTIL SUB1 > WRK-PARM-MAX. DTSBD510 00358 I2000-EXIT. DTSBD510 00359 EXIT. DTSBD510 00360 EJECT DTSBD510 00361 I2100-INIT-TABLE. DTSBD510 00362 MOVE SPACE TO WRK-EMP-CLASS (SUB1). DTSBD510 00363 DTSBD510 00364 MOVE +0 TO WRK-START-PROCESS-DATE (SUB1) DTSBD510 00365 DTSBD510 00366 MOVE WRK-NINES-DATE TO WRK-END-PROCESS-DATE (SUB1). DTSBD510 00367 DTSBD510 00368 MOVE +0 TO WRK-START-DEPOSIT-DATE (SUB1) DTSBD510 00369 DTSBD510 00370 MOVE WRK-NINES-DATE TO WRK-END-DEPOSIT-DATE (SUB1). DTSBD510 00371 DTSBD510 00372 MOVE +0 TO WRK-START-YRQ (SUB1). DTSBD510 00373 DTSBD510 00374 MOVE WRK-NINES-YRQ TO WRK-END-YRQ (SUB1). DTSBD510 00375 DTSBD510 00376 MOVE +0 TO WRK-START-BATCH-NO (SUB1). DTSBD510 00377 DTSBD510 00378 MOVE WRK-NINES-BATCH-NO TO WRK-END-BATCH-NO (SUB1). DTSBD510 00379 DTSBD510 00380 MOVE SPACES TO WRK-RESPONSIBLE-ACTIVITY (SUB1). DTSBD510 00381 DTSBD510 00382 MOVE SPACES TO WRK-TRAN-CATEGORY (SUB1). DTSBD510 00383 DTSBD510 00384 MOVE +0 TO WRK-TRAN-TYPE-CNT (SUB1). DTSBD510 00385 DTSBD510 00386 MOVE 'N' TO WRK-MATCH-FOUND (SUB1). DTSBD510 00387 DTSBD510 00388 PERFORM I2200-INIT-ACCT-TABLE THRU I2200-EXIT DTSBD510 00389 VARYING SUB2 FROM 1 BY 1 DTSBD510 00390 UNTIL SUB2 > WRK-ACCT-ROW-MAX. DTSBD510 00391 I2100-EXIT. DTSBD510 00392 EXIT. DTSBD510 00393 EJECT DTSBD510 00394 I2200-INIT-ACCT-TABLE. DTSBD510 00395 MOVE CACT-ACCT-LIT (SUB2) DTSBD510 00396 TO WRK-APP-ACCT-ROW (SUB1 SUB2). DTSBD510 00397 DTSBD510 00398 PERFORM I2300-INIT-COL-TABLE THRU I2300-EXIT DTSBD510 00399 VARYING SUB3 FROM 1 BY 1 DTSBD510 00400 UNTIL SUB3 > WRK-ACCT-COL-MAX. DTSBD510 00401 I2200-EXIT. DTSBD510 00402 EXIT. DTSBD510 00403 EJECT DTSBD510 00404 I2300-INIT-COL-TABLE. DTSBD510 00405 MOVE CACT-CAT-LIT (SUB3) DTSBD510 00406 TO WRK-APP-ACCT-COL (SUB1 SUB2 SUB3). DTSBD510 00407 DTSBD510 00408 MOVE ZEROES TO WRK-APP-AMT (SUB1 SUB2 SUB3). DTSBD510 00409 I2300-EXIT. DTSBD510 00410 EXIT. DTSBD510 00411 EJECT DTSBD510 00412 I3000-PROCESS-PARMS. DTSBD510 00413 IF PARM-LENGTH = +4 DTSBD510 00414 NEXT SENTENCE DTSBD510 00415 ELSE DTSBD510 00416 MOVE 'INVALID PARM-LENGTH ENCOUNTERED' DTSBD510 00417 TO ABEND-MSG DTSBD510 00418 PERFORM S999-ABEND THRU S999-EXIT. DTSBD510 00419 DTSBD510 00420 IF PARM-RUN-TYPE = 'OR' OR 'WE' OR 'ME' OR 'QE' OR 'YE' DTSBD510 00421 OR ' D' DTSBD510 00422 MOVE PARM-RUN-TYPE TO WRK-RUN-TYPE DTSBD510 00423 ELSE DTSBD510 00424 MOVE 'INVALID PARM-RUN-TYPE ENCOUNTERED' DTSBD510 00425 TO ABEND-MSG DTSBD510 00426 PERFORM S999-ABEND THRU S999-EXIT. DTSBD510 00427 DTSBD510 00428 IF PARM-ONLY-CHECK-PARM-IND = 'N' OR 'Y' DTSBD510 00429 MOVE PARM-ONLY-CHECK-PARM-IND DTSBD510 00430 TO WRK-ONLY-CHECK-PARM-IND DTSBD510 00431 ELSE DTSBD510 00432 MOVE 'INVALID PARM-ONLY-CHECK-PARM-IND ENCOUNTERED' DTSBD510 00433 TO ABEND-MSG DTSBD510 00434 PERFORM S999-ABEND THRU S999-EXIT. DTSBD510 00435 DTSBD510 00436 DTSBD510 00437 OPEN INPUT PARM-FILE. DTSBD510 00438 DTSBD510 00439 DISPLAY ' '. DTSBD510 00440 DTSBD510 00441 DISPLAY '*** DTSBD510 PARAMETERS ***'. DTSBD510 00442 DTSBD510 00443 MOVE 'N' TO WRK-PARM-EOF-IND. DTSBD510 00444 DTSBD510 00445 PERFORM I3100-READ-PARM THRU I3100-EXIT DTSBD510 00446 UNTIL WRK-PARM-EOF-IND = 'Y'. DTSBD510 00447 DTSBD510 00448 IF PARM-RUN-TYPE = 'OR' DTSBD510 00449 NEXT SENTENCE DTSBD510 00450 ELSE DTSBD510 00451 IF WRK-PARM-REC-CNT > +0 DTSBD510 00452 MOVE 'PARAMETERS SPECIFIED, BUT RUN-TYPE NOT EQUAL "OR"' DTSBD510 00453 TO ABEND-MSG DTSBD510 00454 PERFORM S999-ABEND THRU S999-EXIT. DTSBD510 00455 DTSBD510 00456 DTSBD510 00457 IF WRK-PARM-REC-CNT < +1 DTSBD510 00458 PERFORM I3200-DEFAULT-PARM THRU I3200-EXIT. DTSBD510 00459 DTSBD510 00460 DTSBD510 00461 IF WRK-PARM-REC-CNT < 1 DTSBD510 00462 MOVE 'NO PARAMETERS SPECIFIED' TO ABEND-MSG DTSBD510 00463 PERFORM S999-ABEND THRU S999-EXIT. DTSBD510 00464 DTSBD510 00465 DTSBD510 00466 CLOSE PARM-FILE. DTSBD510 00467 I3000-EXIT. DTSBD510 00468 EXIT. DTSBD510 00469 EJECT DTSBD510 00470 I3100-READ-PARM. DTSBD510 00471 READ PARM-FILE DTSBD510 00472 AT END DTSBD510 00473 MOVE 'Y' TO WRK-PARM-EOF-IND DTSBD510 00474 GO TO I3100-EXIT. DTSBD510 00475 DTSBD510 00476 DISPLAY '*** ' DTSBD510 00477 PARM-REC. DTSBD510 00478 DTSBD510 00479 IF PREC-EMP-CLASS = '*' DTSBD510 00480 GO TO I3100-EXIT. DTSBD510 00481 DTSBD510 00482 ADD +1 TO WRK-PARM-REC-CNT. DTSBD510 00483 DTSBD510 00484 IF WRK-PARM-REC-CNT > 10 DTSBD510 00485 MOVE 'MORE THAN 10 PARAMETER RECORDS ENCOUNTERED' DTSBD510 00486 TO ABEND-MSG DTSBD510 00487 PERFORM S999-ABEND THRU S999-EXIT. DTSBD510 00488 DTSBD510 00489 MOVE WRK-PARM-REC-CNT TO SUB1. DTSBD510 00490 DTSBD510 00491 PERFORM I3110-EMP-CLASS THRU I3110-EXIT. DTSBD510 00492 DTSBD510 00493 PERFORM I3120-PROCESS-DATE THRU I3120-EXIT. DTSBD510 00494 DTSBD510 00495 PERFORM I3130-DEPOSIT-DATE THRU I3130-EXIT. DTSBD510 00496 DTSBD510 00497 PERFORM I3140-YRQ THRU I3140-EXIT. DTSBD510 00498 DTSBD510 00499 PERFORM I3150-BATCH-NO THRU I3150-EXIT. DTSBD510 00500 DTSBD510 00501 PERFORM I3160-RESPONSIBLE-ACTIVITY THRU I3160-EXIT. DTSBD510 00502 DTSBD510 00503 PERFORM I3170-TRAN-CATEGORY THRU I3170-EXIT. DTSBD510 00504 DTSBD510 00505 PERFORM I3180-TRAN-TYPE THRU I3180-EXIT. DTSBD510 00506 I3100-EXIT. DTSBD510 00507 EXIT. DTSBD510 00508 SKIP3 DTSBD510 00509 I3110-EMP-CLASS. DTSBD510 00510 MOVE PREC-EMP-CLASS TO MPRF-EMP-CLASS. DTSBD510 00511 DTSBD510 00512 IF (PREC-EMP-CLASS = SPACES) DTSBD510 00513 OR DTSBD510 00514 (MPRF-CLASS-SUB-88) DTSBD510 00515 NEXT SENTENCE DTSBD510 00516 ELSE DTSBD510 00517 MOVE 'INVALID PARM-EMP-CLASS ENCOUNTERED' DTSBD510 00518 TO ABEND-MSG DTSBD510 00519 PERFORM S999-ABEND THRU S999-EXIT. DTSBD510 00520 DTSBD510 00521 MOVE PREC-EMP-CLASS TO WRK-EMP-CLASS (SUB1). DTSBD510 00522 I3110-EXIT. DTSBD510 00523 EXIT. DTSBD510 00524 SKIP3 DTSBD510 00525 I3120-PROCESS-DATE. DTSBD510 00526 IF PREC-START-PROCESS-DATE = SPACES DTSBD510 00527 MOVE 'MISSING PARM-START-PROCESS-DATE ENCOUNTERED' DTSBD510 00528 TO ABEND-MSG DTSBD510 00529 PERFORM S999-ABEND THRU S999-EXIT DTSBD510 00530 ELSE DTSBD510 00531 IF PREC-START-PROCESS-DATE = PARM-ZEROS-DATE DTSBD510 00532 MOVE +0 TO WRK-START-PROCESS-DATE (SUB1) DTSBD510 00533 ELSE DTSBD510 00534 IF PREC-START-PROCESS-DATE = PARM-NINES-DATE DTSBD510 00535 MOVE WRK-NINES-DATE TO WRK-START-PROCESS-DATE (SUB1) DTSBD510 00536 ELSE DTSBD510 00537 MOVE PREC-START-PROCESS-DATE TO L001-CAL-6-DATE-X DTSBD510 00538 PERFORM S001-FROM-CAL-6 THRU S001-EXIT DTSBD510 00539 IF L001-VALID-DATE DTSBD510 00540 MOVE L001-FED-8-DATE-9 DTSBD510 00541 TO WRK-START-PROCESS-DATE (SUB1) DTSBD510 00542 ELSE DTSBD510 00543 MOVE 'INVALID PARM-START-PROCESS-DATE ENCOUNTERED' DTSBD510 00544 TO ABEND-MSG DTSBD510 00545 PERFORM S999-ABEND THRU S999-EXIT. DTSBD510 00546 DTSBD510 00547 IF PREC-END-PROCESS-DATE = SPACES DTSBD510 00548 MOVE 'MISSING PARM-END-PROCESS-DATE ENCOUNTERED' DTSBD510 00549 TO ABEND-MSG DTSBD510 00550 PERFORM S999-ABEND THRU S999-EXIT DTSBD510 00551 ELSE DTSBD510 00552 IF PREC-END-PROCESS-DATE = PARM-ZEROS-DATE DTSBD510 00553 MOVE +0 TO WRK-END-PROCESS-DATE (SUB1) DTSBD510 00554 ELSE DTSBD510 00555 IF PREC-END-PROCESS-DATE = PARM-NINES-DATE DTSBD510 00556 MOVE WRK-NINES-DATE TO WRK-END-PROCESS-DATE (SUB1) DTSBD510 00557 ELSE DTSBD510 00558 MOVE PREC-END-PROCESS-DATE TO L001-CAL-6-DATE-X DTSBD510 00559 PERFORM S001-FROM-CAL-6 THRU S001-EXIT DTSBD510 00560 IF L001-VALID-DATE DTSBD510 00561 MOVE L001-FED-8-DATE-9 DTSBD510 00562 TO WRK-END-PROCESS-DATE (SUB1) DTSBD510 00563 ELSE DTSBD510 00564 MOVE 'INVALID PARM-END-PROCESS-DATE ENCOUNTERED' DTSBD510 00565 TO ABEND-MSG DTSBD510 00566 PERFORM S999-ABEND THRU S999-EXIT. DTSBD510 00567 DTSBD510 00568 IF WRK-START-PROCESS-DATE (SUB1) DTSBD510 00569 > WRK-END-PROCESS-DATE (SUB1) DTSBD510 00570 MOVE 'PARM-START-PROCESS-DATE > PARM-END-PROCESS-DATE' DTSBD510 00571 TO ABEND-MSG DTSBD510 00572 PERFORM S999-ABEND THRU S999-EXIT. DTSBD510 00573 I3120-EXIT. DTSBD510 00574 EXIT. DTSBD510 00575 SKIP3 DTSBD510 00576 I3130-DEPOSIT-DATE. DTSBD510 00577 IF PREC-START-DEPOSIT-DATE = SPACES DTSBD510 00578 MOVE +0 TO WRK-START-DEPOSIT-DATE (SUB1) DTSBD510 00579 ELSE DTSBD510 00580 IF PREC-START-DEPOSIT-DATE = PARM-ZEROS-DATE DTSBD510 00581 MOVE +0 TO WRK-START-DEPOSIT-DATE (SUB1) DTSBD510 00582 ELSE DTSBD510 00583 IF PREC-START-DEPOSIT-DATE = PARM-NINES-DATE DTSBD510 00584 MOVE WRK-NINES-DATE TO WRK-START-DEPOSIT-DATE (SUB1) DTSBD510 00585 ELSE DTSBD510 00586 MOVE PREC-START-DEPOSIT-DATE TO L001-CAL-6-DATE-X DTSBD510 00587 PERFORM S001-FROM-CAL-6 THRU S001-EXIT DTSBD510 00588 IF L001-VALID-DATE DTSBD510 00589 MOVE L001-FED-8-DATE-9 DTSBD510 00590 TO WRK-START-DEPOSIT-DATE (SUB1) DTSBD510 00591 ELSE DTSBD510 00592 MOVE 'INVALID PARM-START-DEPOSIT-DATE ENCOUNTERED' DTSBD510 00593 TO ABEND-MSG DTSBD510 00594 PERFORM S999-ABEND THRU S999-EXIT. DTSBD510 00595 DTSBD510 00596 IF PREC-END-DEPOSIT-DATE = SPACES DTSBD510 00597 MOVE WRK-NINES-DATE TO WRK-END-DEPOSIT-DATE (SUB1) DTSBD510 00598 ELSE DTSBD510 00599 IF PREC-END-DEPOSIT-DATE = PARM-ZEROS-DATE DTSBD510 00600 MOVE +0 TO WRK-END-DEPOSIT-DATE (SUB1) DTSBD510 00601 ELSE DTSBD510 00602 IF PREC-END-DEPOSIT-DATE = PARM-NINES-DATE DTSBD510 00603 MOVE WRK-NINES-DATE TO WRK-END-DEPOSIT-DATE (SUB1) DTSBD510 00604 ELSE DTSBD510 00605 MOVE PREC-END-DEPOSIT-DATE TO L001-CAL-6-DATE-X DTSBD510 00606 PERFORM S001-FROM-CAL-6 THRU S001-EXIT DTSBD510 00607 IF L001-VALID-DATE DTSBD510 00608 MOVE L001-FED-8-DATE-9 DTSBD510 00609 TO WRK-END-DEPOSIT-DATE (SUB1) DTSBD510 00610 ELSE DTSBD510 00611 MOVE 'INVALID PARM-END-DEPOSIT-DATE ENCOUNTERED' DTSBD510 00612 TO ABEND-MSG DTSBD510 00613 PERFORM S999-ABEND THRU S999-EXIT. DTSBD510 00614 DTSBD510 00615 IF WRK-START-DEPOSIT-DATE (SUB1) DTSBD510 00616 > WRK-END-DEPOSIT-DATE (SUB1) DTSBD510 00617 MOVE 'PARM-START-DEPOSIT-DATE > PARM-END-DEPOSIT-DATE' DTSBD510 00618 TO ABEND-MSG DTSBD510 00619 PERFORM S999-ABEND THRU S999-EXIT. DTSBD510 00620 I3130-EXIT. DTSBD510 00621 EXIT. DTSBD510 00622 SKIP3 DTSBD510 00623 I3140-YRQ. DTSBD510 00624 IF PREC-START-YRQ = SPACES DTSBD510 00625 MOVE +0 TO WRK-START-YRQ (SUB1) DTSBD510 00626 ELSE DTSBD510 00627 IF PREC-START-YRQ = PARM-ZEROS-YRQ DTSBD510 00628 MOVE +0 TO WRK-START-YRQ (SUB1) DTSBD510 00629 ELSE DTSBD510 00630 IF PREC-START-YRQ = PARM-NINES-YRQ DTSBD510 00631 MOVE WRK-NINES-YRQ TO WRK-START-YRQ (SUB1) DTSBD510 00632 ELSE DTSBD510 00633 IF PREC-START-YRQ = 'PU ' DTSBD510 00634 MOVE WRK-PICKUP-YRQ TO WRK-START-YRQ (SUB1) DTSBD510 00635 ELSE DTSBD510 00636 MOVE PREC-START-YRQ TO L004-QTR-3-X DTSBD510 00637 PERFORM S004-FROM-3 THRU S004-EXIT DTSBD510 00638 IF (L004-VALID-QTR) DTSBD510 00639 AND DTSBD510 00640 (L004-QTR-5-9 > WRK-PICKUP-YRQ) DTSBD510 00641 MOVE L004-QTR-5-9 TO WRK-START-YRQ (SUB1) DTSBD510 00642 ELSE DTSBD510 00643 MOVE 'INVALID PARM-START-YRQ ENCOUNTERED' DTSBD510 00644 TO ABEND-MSG DTSBD510 00645 PERFORM S999-ABEND THRU S999-EXIT. DTSBD510 00646 DTSBD510 00647 IF PREC-END-YRQ = SPACES DTSBD510 00648 MOVE WRK-NINES-YRQ TO WRK-END-YRQ (SUB1) DTSBD510 00649 ELSE DTSBD510 00650 IF PREC-END-YRQ = PARM-ZEROS-YRQ DTSBD510 00651 MOVE +0 TO WRK-END-YRQ (SUB1) DTSBD510 00652 ELSE DTSBD510 00653 IF PREC-END-YRQ = PARM-NINES-YRQ DTSBD510 00654 MOVE WRK-NINES-YRQ TO WRK-END-YRQ (SUB1) DTSBD510 00655 ELSE DTSBD510 00656 IF PREC-END-YRQ = 'PU ' DTSBD510 00657 MOVE WRK-PICKUP-YRQ TO WRK-END-YRQ (SUB1) DTSBD510 00658 ELSE DTSBD510 00659 MOVE PREC-END-YRQ TO L004-QTR-3-X DTSBD510 00660 PERFORM S004-FROM-3 THRU S004-EXIT DTSBD510 00661 IF (L004-VALID-QTR) DTSBD510 00662 AND DTSBD510 00663 (L004-QTR-5-9 > WRK-PICKUP-YRQ) DTSBD510 00664 MOVE L004-QTR-5-9 TO WRK-END-YRQ (SUB1) DTSBD510 00665 ELSE DTSBD510 00666 MOVE 'INVALID PARM-END-YRQ ENCOUNTERED' DTSBD510 00667 TO ABEND-MSG DTSBD510 00668 PERFORM S999-ABEND THRU S999-EXIT. DTSBD510 00669 DTSBD510 00670 IF WRK-START-YRQ (SUB1) > WRK-END-YRQ (SUB1) DTSBD510 00671 MOVE 'PARM-START-YRQ > PARM-END-YRQ' DTSBD510 00672 TO ABEND-MSG DTSBD510 00673 PERFORM S999-ABEND THRU S999-EXIT. DTSBD510 00674 I3140-EXIT. DTSBD510 00675 EXIT. DTSBD510 00676 SKIP3 DTSBD510 00677 I3150-BATCH-NO. DTSBD510 00678 IF PREC-START-BATCH-NO = SPACES DTSBD510 00679 MOVE +0 TO WRK-START-BATCH-NO (SUB1) DTSBD510 00680 ELSE DTSBD510 00681 IF PREC-START-BATCH-NO = PARM-ZEROS-BATCH-NO DTSBD510 00682 MOVE +0 TO WRK-START-BATCH-NO (SUB1) DTSBD510 00683 ELSE DTSBD510 00684 IF PREC-START-BATCH-NO = PARM-NINES-BATCH-NO DTSBD510 00685 MOVE WRK-NINES-BATCH-NO TO WRK-START-BATCH-NO (SUB1) DTSBD510 00686 ELSE DTSBD510 00687 IF PREC-START-BATCH-NO NUMERIC DTSBD510 00688 MOVE PREC-START-BATCH-NO TO WRK-START-BATCH-NO (SUB1)DTSBD510 00689 ELSE DTSBD510 00690 MOVE 'INVALID PARM-START-BATCH-NO ENCOUNTERED' DTSBD510 00691 TO ABEND-MSG DTSBD510 00692 PERFORM S999-ABEND THRU S999-EXIT. DTSBD510 00693 DTSBD510 00694 IF PREC-END-BATCH-NO = SPACES DTSBD510 00695 MOVE WRK-NINES-BATCH-NO TO WRK-END-BATCH-NO (SUB1) DTSBD510 00696 ELSE DTSBD510 00697 IF PREC-END-BATCH-NO = PARM-ZEROS-BATCH-NO DTSBD510 00698 MOVE +0 TO WRK-END-BATCH-NO (SUB1) DTSBD510 00699 ELSE DTSBD510 00700 IF PREC-END-BATCH-NO = PARM-NINES-BATCH-NO DTSBD510 00701 MOVE WRK-NINES-BATCH-NO TO WRK-END-BATCH-NO (SUB1) DTSBD510 00702 ELSE DTSBD510 00703 IF PREC-END-BATCH-NO NUMERIC DTSBD510 00704 MOVE PREC-END-BATCH-NO TO WRK-END-BATCH-NO (SUB1) DTSBD510 00705 ELSE DTSBD510 00706 MOVE 'INVALID PARM-END-BATCH-NO ENCOUNTERED' DTSBD510 00707 TO ABEND-MSG DTSBD510 00708 PERFORM S999-ABEND THRU S999-EXIT. DTSBD510 00709 DTSBD510 00710 IF WRK-START-BATCH-NO (SUB1) > WRK-END-BATCH-NO (SUB1) DTSBD510 00711 MOVE 'PARM-START-BATCH-NO > PARM-END-BATCH-NO' DTSBD510 00712 TO ABEND-MSG DTSBD510 00713 PERFORM S999-ABEND THRU S999-EXIT. DTSBD510 00714 I3150-EXIT. DTSBD510 00715 EXIT. DTSBD510 00716 SKIP3 DTSBD510 00717 I3160-RESPONSIBLE-ACTIVITY. DTSBD510 00718 IF PREC-RESPONSIBLE-ACTIVITY = SPACES DTSBD510 00719 MOVE SPACES TO WRK-RESPONSIBLE-ACTIVITY (SUB1) DTSBD510 00720 GO TO I3160-EXIT. DTSBD510 00721 DTSBD510 00722 DTSBD510 00723 MOVE PREC-RESPONSIBLE-ACTIVITY TO L032-CD. DTSBD510 00724 DTSBD510 00725 DTSBD510 00726 PERFORM S032-MRPT-RESPONSIBLE-ACTIVITY THRU S032-EXIT. DTSBD510 00727 DTSBD510 00728 IF L032-VALID DTSBD510 00729 MOVE PREC-RESPONSIBLE-ACTIVITY DTSBD510 00730 TO WRK-RESPONSIBLE-ACTIVITY (SUB1) DTSBD510 00731 GO TO I3160-EXIT. DTSBD510 00732 DTSBD510 00733 DTSBD510 00734 PERFORM S032-MPAY-RESPONSIBLE-ACTIVITY THRU S032-EXIT. DTSBD510 00735 DTSBD510 00736 IF L032-VALID DTSBD510 00737 MOVE PREC-RESPONSIBLE-ACTIVITY DTSBD510 00738 TO WRK-RESPONSIBLE-ACTIVITY (SUB1) DTSBD510 00739 GO TO I3160-EXIT. DTSBD510 00740 DTSBD510 00741 DTSBD510 00742 PERFORM S032-MADJ-RESPONSIBLE-ACTIVITY THRU S032-EXIT. DTSBD510 00743 DTSBD510 00744 IF L032-VALID DTSBD510 00745 MOVE PREC-RESPONSIBLE-ACTIVITY DTSBD510 00746 TO WRK-RESPONSIBLE-ACTIVITY (SUB1) DTSBD510 00747 GO TO I3160-EXIT. DTSBD510 00748 DTSBD510 00749 DTSBD510 00750 MOVE SPACES TO ABEND-MSG. DTSBD510 00751 DTSBD510 00752 STRING 'INVALID PARM-RESPONSIBLE-ACTIVITY: ' DTSBD510 00753 DELIMITED BY SIZE DTSBD510 00754 PREC-RESPONSIBLE-ACTIVITY DELIMITED BY SIZE DTSBD510 00755 ' ENCOUNTERED' DELIMITED BY SIZE DTSBD510 00756 INTO ABEND-MSG. DTSBD510 00757 DTSBD510 00758 PERFORM S999-ABEND THRU S999-EXIT. DTSBD510 00759 I3160-EXIT. DTSBD510 00760 EXIT. DTSBD510 00761 SKIP3 DTSBD510 00762 I3170-TRAN-CATEGORY. DTSBD510 00763 MOVE PREC-TRAN-CATEGORY TO MJRN-TRAN-CATEGORY. DTSBD510 00764 DTSBD510 00765 IF (PREC-TRAN-CATEGORY = SPACES) DTSBD510 00766 OR DTSBD510 00767 (MJRN-TRAN-RPT-88 DTSBD510 00768 OR DTSBD510 00769 MJRN-TRAN-PAY-88 DTSBD510 00770 OR DTSBD510 00771 MJRN-TRAN-ADJ-88) DTSBD510 00772 NEXT SENTENCE DTSBD510 00773 ELSE DTSBD510 00774 MOVE 'INVALID PARM-EMP-CLASS ENCOUNTERED' DTSBD510 00775 TO ABEND-MSG DTSBD510 00776 PERFORM S999-ABEND THRU S999-EXIT. DTSBD510 00777 DTSBD510 00778 MOVE PREC-TRAN-CATEGORY TO WRK-TRAN-CATEGORY (SUB1). DTSBD510 00779 I3170-EXIT. DTSBD510 00780 EXIT. DTSBD510 00781 SKIP3 DTSBD510 00782 I3180-TRAN-TYPE. DTSBD510 00783 PERFORM I3181-TRAN-TYPE-MOVE THRU I3181-EXIT DTSBD510 00784 VARYING SUB2 FROM 1 BY 1 DTSBD510 00785 UNTIL SUB2 > WRK-TRAN-TYPE-MAX. DTSBD510 00786 I3180-EXIT. DTSBD510 00787 EXIT. DTSBD510 00788 SKIP3 DTSBD510 00789 I3181-TRAN-TYPE-MOVE. DTSBD510 00790 IF PREC-TRAN-TYPE (SUB2) = SPACES DTSBD510 00791 GO TO I3181-EXIT. DTSBD510 00792 DTSBD510 00793 PERFORM I3182-TRAN-TYPE-EDIT THRU I3182-EXIT. DTSBD510 00794 DTSBD510 00795 ADD +1 TO WRK-TRAN-TYPE-CNT (SUB1). DTSBD510 00796 DTSBD510 00797 MOVE WRK-TRAN-TYPE-CNT (SUB1) TO SUB3. DTSBD510 00798 DTSBD510 00799 MOVE PREC-TRAN-TYPE (SUB2) DTSBD510 00800 TO WRK-TRAN-TYPE (SUB1 SUB3). DTSBD510 00801 I3181-EXIT. DTSBD510 00802 EXIT. DTSBD510 00803 SKIP3 DTSBD510 00804 I3182-TRAN-TYPE-EDIT. DTSBD510 00805 MOVE PREC-TRAN-TYPE (SUB2) TO L032-CD. DTSBD510 00806 DTSBD510 00807 DTSBD510 00808 PERFORM S032-MRPT-RPT-TYPE THRU S032-EXIT. DTSBD510 00809 DTSBD510 00810 IF L032-VALID DTSBD510 00811 GO TO I3182-EXIT. DTSBD510 00812 DTSBD510 00813 DTSBD510 00814 PERFORM S032-MPAY-PAY-TYPE THRU S032-EXIT. DTSBD510 00815 DTSBD510 00816 IF L032-VALID DTSBD510 00817 GO TO I3182-EXIT. DTSBD510 00818 DTSBD510 00819 DTSBD510 00820 PERFORM S032-MADJ-ADJ-TYPE THRU S032-EXIT. DTSBD510 00821 DTSBD510 00822 IF L032-VALID DTSBD510 00823 GO TO I3182-EXIT. DTSBD510 00824 DTSBD510 00825 DTSBD510 00826 MOVE SPACES TO ABEND-MSG. DTSBD510 00827 DTSBD510 00828 STRING 'INVALID PARM-TRAN-TYPE: ' DELIMITED BY SIZE DTSBD510 00829 PREC-TRAN-TYPE (SUB2) DELIMITED BY SIZE DTSBD510 00830 ' ENCOUNTERED' DELIMITED BY SIZE DTSBD510 00831 INTO ABEND-MSG. DTSBD510 00832 DTSBD510 00833 PERFORM S999-ABEND THRU S999-EXIT. DTSBD510 00834 I3182-EXIT. DTSBD510 00835 EXIT. DTSBD510 00836 SKIP3 DTSBD510 00837 I3200-DEFAULT-PARM. DTSBD510 00838 IF WRK-RUN-TYPE = ' D' DTSBD510 00839 MOVE MHDR-PRIOR-RUN-DATE DTSBD510 00840 TO DEFAULT-START-PROCESS-DATE DTSBD510 00841 DEFAULT-END-PROCESS-DATE DTSBD510 00842 ELSE DTSBD510 00843 IF WRK-RUN-TYPE = 'WE' DTSBD510 00844 MOVE MHDR-CMPL-WEEK-BEGIN-DATE DTSBD510 00845 TO DEFAULT-START-PROCESS-DATE DTSBD510 00846 MOVE MHDR-CMPL-WEEK-END-DATE DTSBD510 00847 TO DEFAULT-END-PROCESS-DATE DTSBD510 00848 ELSE DTSBD510 00849 IF WRK-RUN-TYPE = 'ME' DTSBD510 00850 MOVE MHDR-CMPL-MONTH-BEGIN-DATE DTSBD510 00851 TO DEFAULT-START-PROCESS-DATE DTSBD510 00852 MOVE MHDR-CMPL-MONTH-END-DATE DTSBD510 00853 TO DEFAULT-END-PROCESS-DATE DTSBD510 00854 ELSE DTSBD510 00855 IF WRK-RUN-TYPE = 'QE' DTSBD510 00856 MOVE MHDR-CMPL-QTR-BEGIN-DATE DTSBD510 00857 TO DEFAULT-START-PROCESS-DATE DTSBD510 00858 MOVE MHDR-CMPL-QTR-END-DATE DTSBD510 00859 TO DEFAULT-END-PROCESS-DATE DTSBD510 00860 ELSE DTSBD510 00861 IF WRK-RUN-TYPE = 'YE' DTSBD510 00862 MOVE MHDR-CMPL-YEAR-BEGIN-DATE DTSBD510 00863 TO DEFAULT-START-PROCESS-DATE DTSBD510 00864 MOVE MHDR-CMPL-YEAR-END-DATE DTSBD510 00865 TO DEFAULT-END-PROCESS-DATE DTSBD510 00866 ELSE DTSBD510 00867 GO TO I3200-EXIT. DTSBD510 00868 DTSBD510 00869 DTSBD510 00870 ADD +1 TO WRK-PARM-REC-CNT. DTSBD510 00871 DTSBD510 00872 SET MPRF-CLASS-RATED-88 TO TRUE. DTSBD510 00873 DTSBD510 00874 MOVE MPRF-EMP-CLASS DTSBD510 00875 TO WRK-EMP-CLASS (WRK-PARM-REC-CNT). DTSBD510 00876 DTSBD510 00877 MOVE DEFAULT-START-PROCESS-DATE DTSBD510 00878 TO WRK-START-PROCESS-DATE (WRK-PARM-REC-CNT). DTSBD510 00879 DTSBD510 00880 MOVE DEFAULT-END-PROCESS-DATE DTSBD510 00881 TO WRK-END-PROCESS-DATE (WRK-PARM-REC-CNT). DTSBD510 00882 DTSBD510 00883 DTSBD510 00884 ADD +1 TO WRK-PARM-REC-CNT. DTSBD510 00885 DTSBD510 00886 SET MPRF-CLASS-SELF-INS-88 TO TRUE. DTSBD510 00887 DTSBD510 00888 MOVE MPRF-EMP-CLASS DTSBD510 00889 TO WRK-EMP-CLASS (WRK-PARM-REC-CNT). DTSBD510 00890 DTSBD510 00891 MOVE DEFAULT-START-PROCESS-DATE DTSBD510 00892 TO WRK-START-PROCESS-DATE (WRK-PARM-REC-CNT). DTSBD510 00893 DTSBD510 00894 MOVE DEFAULT-END-PROCESS-DATE DTSBD510 00895 TO WRK-END-PROCESS-DATE (WRK-PARM-REC-CNT). DTSBD510 00896 DTSBD510 00897 DTSBD510 00898 ADD +1 TO WRK-PARM-REC-CNT. DTSBD510 00899 DTSBD510 00900 SET MPRF-CLASS-SELF-INS-88 TO TRUE. DTSBD510 00901 DTSBD510 00902 MOVE MPRF-EMP-CLASS DTSBD510 00903 TO WRK-EMP-CLASS (WRK-PARM-REC-CNT). DTSBD510 00904 DTSBD510 00905 MOVE DEFAULT-START-PROCESS-DATE DTSBD510 00906 TO WRK-START-PROCESS-DATE (WRK-PARM-REC-CNT). DTSBD510 00907 DTSBD510 00908 MOVE DEFAULT-END-PROCESS-DATE DTSBD510 00909 TO WRK-END-PROCESS-DATE (WRK-PARM-REC-CNT). DTSBD510 00910 DTSBD510 00911 MOVE DEFAULT-END-PROCESS-DATE TO L004-DATE. DTSBD510 00912 DTSBD510 00913 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSBD510 00914 DTSBD510 00915 MOVE L004-QTR-5-9 DTSBD510 00916 TO WRK-START-YRQ (WRK-PARM-REC-CNT) DTSBD510 00917 WRK-END-YRQ (WRK-PARM-REC-CNT). DTSBD510 00918 DTSBD510 00919 DTSBD510 00920 ADD +1 TO WRK-PARM-REC-CNT. DTSBD510 00921 DTSBD510 00922 MOVE SPACES DTSBD510 00923 TO WRK-EMP-CLASS (WRK-PARM-REC-CNT). DTSBD510 00924 DTSBD510 00925 MOVE DEFAULT-START-PROCESS-DATE DTSBD510 00926 TO WRK-START-PROCESS-DATE (WRK-PARM-REC-CNT). DTSBD510 00927 DTSBD510 00928 MOVE DEFAULT-END-PROCESS-DATE DTSBD510 00929 TO WRK-END-PROCESS-DATE (WRK-PARM-REC-CNT). DTSBD510 00930 I3200-EXIT. DTSBD510 00931 EXIT. DTSBD510 00932 EJECT DTSBD510 00933 P0000-PROCESS. DTSBD510 00934 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBD510 00935 DTSBD510 00936 DTSBD510 00937 MOVE LOW-VALUES TO MSKL-REC. DTSBD510 00938 DTSBD510 00939 MOVE +0 TO MSKL-EMP-NO. DTSBD510 00940 DTSBD510 00941 SET MSKL-PRF-88 TO TRUE. DTSBD510 00942 DTSBD510 00943 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD510 00944 DTSBD510 00945 DTSBD510 00946 PERFORM P1000-MPRF-SCAN THRU P1000-EXIT DTSBD510 00947 UNTIL L910-NO-REC-88. DTSBD510 00948 DTSBD510 00949 DTSBD510 00950 PERFORM S910-CLOSE THRU S910-EXIT. DTSBD510 00951 DTSBD510 00952 DTSBD510 00953 MOVE 'N' TO WRK-ARCHIVE-REQUIRED-IND. DTSBD510 00954 DTSBD510 00955 PERFORM DTSBD510 00956 VARYING SUB1 FROM 1 BY 1 DTSBD510 00957 UNTIL SUB1 > WRK-PARM-REC-CNT DTSBD510 00958 IF WRK-START-PROCESS-DATE (SUB1) DTSBD510 00959 NOT > MHDR-LAST-MJRN-PURGE-DATE DTSBD510 00960 MOVE 'Y' TO WRK-ARCHIVE-REQUIRED-IND DTSBD510 00961 END-IF DTSBD510 00962 END-PERFORM. DTSBD510 00963 DTSBD510 00964 DTSBD510 00965 IF WRK-ARCHIVE-REQUIRED-IND = 'Y' DTSBD510 00966 PERFORM S961-OPEN-READ THRU S961-EXIT DTSBD510 00967 PERFORM S961-READ-NEXT THRU S961-EXIT DTSBD510 00968 PERFORM P2000-ARCHIVE-SCAN THRU P2000-EXIT DTSBD510 00969 UNTIL L961-NO-REC-88 DTSBD510 00970 PERFORM S961-CLOSE THRU S961-EXIT. DTSBD510 00971 DTSBD510 00972 DTSBD510 00973 PERFORM P5000-PROCESS-TABLE THRU P5000-EXIT DTSBD510 00974 VARYING SUB1 FROM 1 BY 1 DTSBD510 00975 UNTIL SUB1 > WRK-PARM-REC-CNT. DTSBD510 00976 P0000-EXIT. DTSBD510 00977 EXIT. DTSBD510 00978 EJECT DTSBD510 00979 P1000-MPRF-SCAN. DTSBD510 00980 MOVE MSKL-REC TO MPRF-REC. DTSBD510 00981 DTSBD510 00982 DTSBD510 00983 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD510 00984 DTSBD510 00985 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBD510 00986 DTSBD510 00987 SET MSKL-JRN-88 TO TRUE. DTSBD510 00988 DTSBD510 00989 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD510 00990 DTSBD510 00991 PERFORM P1100-MJRN-SCAN THRU P1100-EXIT DTSBD510 00992 UNTIL L910-NO-REC-88. DTSBD510 00993 DTSBD510 00994 DTSBD510 00995 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSBD510 00996 DTSBD510 00997 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD510 00998 P1000-EXIT. DTSBD510 00999 EXIT. DTSBD510 01000 SKIP3 DTSBD510 01001 P1100-MJRN-SCAN. DTSBD510 01002 MOVE MSKL-REC TO MJRN-REC. DTSBD510 01003 DTSBD510 01004 ADD +1 TO WRK-MJRN-REC-CNT. DTSBD510 01005 DTSBD510 01006 PERFORM P3000-MATCH-TABLE THRU P3000-EXIT. DTSBD510 01007 DTSBD510 01008 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD510 01009 P1100-EXIT. DTSBD510 01010 EXIT. DTSBD510 01011 EJECT DTSBD510 01012 P2000-ARCHIVE-SCAN. DTSBD510 01013 IF MSKL-JRN-88 DTSBD510 01014 MOVE MSKL-REC TO MJRN-REC DTSBD510 01015 ADD +1 TO WRK-ARCH-MJRN-REC-CNT DTSBD510 01016 PERFORM P3000-MATCH-TABLE THRU P3000-EXIT. DTSBD510 01017 DTSBD510 01018 PERFORM S961-READ-NEXT THRU S961-EXIT. DTSBD510 01019 P2000-EXIT. DTSBD510 01020 EXIT. DTSBD510 01021 EJECT DTSBD510 01022 P3000-MATCH-TABLE. DTSBD510 01023 IF MJRN-TRAN-CNVR-88 DTSBD510 01024 GO TO P3000-EXIT. DTSBD510 01025 DTSBD510 01026 PERFORM P3100-MATCH-LOOP THRU P3100-EXIT DTSBD510 01027 VARYING WRK-EXTRACT-IDX FROM 1 BY 1 DTSBD510 01028 UNTIL WRK-EXTRACT-IDX > WRK-PARM-REC-CNT. DTSBD510 01029 P3000-EXIT. DTSBD510 01030 EXIT. DTSBD510 01031 EJECT DTSBD510 01032 P3100-MATCH-LOOP. DTSBD510 01033 IF (MJRN-ESTB-DATE DTSBD510 01034 < WRK-START-PROCESS-DATE (WRK-EXTRACT-IDX)) DTSBD510 01035 OR DTSBD510 01036 (MJRN-ESTB-DATE DTSBD510 01037 > WRK-END-PROCESS-DATE (WRK-EXTRACT-IDX)) DTSBD510 01038 GO TO P3100-EXIT. DTSBD510 01039 DTSBD510 01040 IF (MJRN-DEPOSIT-DATE DTSBD510 01041 < WRK-START-DEPOSIT-DATE (WRK-EXTRACT-IDX)) DTSBD510 01042 OR DTSBD510 01043 (MJRN-DEPOSIT-DATE DTSBD510 01044 > WRK-END-DEPOSIT-DATE (WRK-EXTRACT-IDX)) DTSBD510 01045 GO TO P3100-EXIT. DTSBD510 01046 SKIP3 DTSBD510 01047 ***** DTSBD510 01048 * DTSBD510 01049 * IT IS POSSIBLE TO ENTER PAYMENT TRANSACTIONS AGAINST DTSBD510 01050 * MPRF-CLASS-UNK-88 EMPLOYERS. DTSBD510 01051 * DTSBD510 01052 * TO AVOID CONFUSING SYSTEM USERS, THE "TRIAL BALANCE" AND DTSBD510 01053 * "ACCOUNTING SUMMARY" REPRESENTING SUCH TRANSACTIONS IS DTSBD510 01054 * LUMPED WITH THE ACCOUNTING BALANCES FOR "REGULAR" EMPLOYERS. DTSBD510 01055 * DTSBD510 01056 * THE THREE LOCATIONS WHERE CODE RELATED TO THIS FUNCTION DTSBD510 01057 * RESIDES ARE: DTSBD510 01058 * DTSBD510 01059 * DTSCS1C S2510 DTSBD510 01060 * DTSBD510 01061 * DTSBD510 P3100 DTSBD510 01062 * DTSBD510 01063 * DTSBE305 P0000 DTSBD510 01064 * DTSBD510 01065 * THE CODE IN DTSCS1C IS RATHER SUBTLE. THE DTSCS1C CODE DTSBD510 01066 * SAYS THAT IF A PAYMENT HAS BEEN INPUT AGAINST A DTSBD510 01067 * MPRF-CLASS-UNK-88 EMPLOYER, THEN THE EMPLOYER MAY BE FOUND DTSBD510 01068 * LIABLE ONLY AS A MPRF-CLASS-REG-88 EMPLOYER. THIS EDIT KEEPSDTSBD510 01069 * THE "TRAIL BALANCE" AND "ACCOUNTING SUMMARY" IN BALANCE DTSBD510 01070 * WITHOUT REQUIRING THE SYSTEM TO GENERATE "REVERSING" JOURNAL DTSBD510 01071 * RECORDS. DTSBD510 01072 * DTSBD510 01073 * BEFORE MODIFYING ANY OF THE ABOVE REFERENCED CODE, THINK DTSBD510 01074 * CAREFULLY ABOUT THE CONSEQUENCES OF THE MODIFICATIONS FOR DTSBD510 01075 * THE ACCOUNTING BALANCES. DTSBD510 01076 * DTSBD510 01077 ***** DTSBD510 01078 DTSBD510 01079 IF WRK-EMP-CLASS (WRK-EXTRACT-IDX) = SPACES DTSBD510 01080 NEXT SENTENCE DTSBD510 01081 ELSE DTSBD510 01082 IF MJRN-EMP-CLASS = WRK-EMP-CLASS (WRK-EXTRACT-IDX) DTSBD510 01083 NEXT SENTENCE DTSBD510 01084 ELSE DTSBD510 01085 IF WRK-EMP-CLASS (WRK-EXTRACT-IDX) = 'R' DTSBD510 01086 IF (MJRN-EMP-CHG-ONLY-88) DTSBD510 01087 OR DTSBD510 01088 (MJRN-EMP-UNK-88) DTSBD510 01089 NEXT SENTENCE DTSBD510 01090 ELSE DTSBD510 01091 GO TO P3100-EXIT DTSBD510 01092 ELSE DTSBD510 01093 GO TO P3100-EXIT. DTSBD510 01094 DTSBD510 01095 IF (MJRN-BATCH-NO DTSBD510 01096 < WRK-START-BATCH-NO (WRK-EXTRACT-IDX)) DTSBD510 01097 OR DTSBD510 01098 (MJRN-BATCH-NO DTSBD510 01099 > WRK-END-BATCH-NO (WRK-EXTRACT-IDX)) DTSBD510 01100 GO TO P3100-EXIT. DTSBD510 01101 DTSBD510 01102 IF WRK-RESPONSIBLE-ACTIVITY (WRK-EXTRACT-IDX) = SPACES DTSBD510 01103 NEXT SENTENCE DTSBD510 01104 ELSE DTSBD510 01105 IF MJRN-RESPONSIBLE-ACTIVITY DTSBD510 01106 = WRK-RESPONSIBLE-ACTIVITY (WRK-EXTRACT-IDX) DTSBD510 01107 NEXT SENTENCE DTSBD510 01108 ELSE DTSBD510 01109 GO TO P3100-EXIT. DTSBD510 01110 DTSBD510 01111 IF WRK-TRAN-CATEGORY (WRK-EXTRACT-IDX) = SPACES DTSBD510 01112 NEXT SENTENCE DTSBD510 01113 ELSE DTSBD510 01114 IF MJRN-TRAN-CATEGORY DTSBD510 01115 = WRK-TRAN-CATEGORY (WRK-EXTRACT-IDX) DTSBD510 01116 NEXT SENTENCE DTSBD510 01117 ELSE DTSBD510 01118 GO TO P3100-EXIT. DTSBD510 01119 DTSBD510 01120 IF WRK-TRAN-TYPE-CNT (WRK-EXTRACT-IDX) > +0 DTSBD510 01121 MOVE 'N' TO WRK-TRAN-TYPE-FOUND-IND DTSBD510 01122 PERFORM DTSBD510 01123 VARYING WRK-TRAN-IDX FROM 1 BY 1 DTSBD510 01124 UNTIL (WRK-TRAN-IDX DTSBD510 01125 > WRK-TRAN-TYPE-CNT (WRK-EXTRACT-IDX)) DTSBD510 01126 OR DTSBD510 01127 (WRK-TRAN-TYPE-FOUND-IND = 'Y') DTSBD510 01128 IF MJRN-TRAN-TYPE DTSBD510 01129 = WRK-TRAN-TYPE (WRK-EXTRACT-IDX WRK-TRAN-IDX) DTSBD510 01130 MOVE 'Y' TO WRK-TRAN-TYPE-FOUND-IND DTSBD510 01131 END-IF DTSBD510 01132 END-PERFORM DTSBD510 01133 ELSE DTSBD510 01134 MOVE 'Y' TO WRK-TRAN-TYPE-FOUND-IND. DTSBD510 01135 DTSBD510 01136 IF WRK-TRAN-TYPE-FOUND-IND = 'N' DTSBD510 01137 GO TO P3100-EXIT. DTSBD510 01138 DTSBD510 01139 PERFORM P3110-MJRN-ACCT-GROUP THRU P3110-EXIT DTSBD510 01140 VARYING MJRN-OCC-IDX FROM 1 BY 1 DTSBD510 01141 UNTIL MJRN-OCC-IDX > MJRN-OCC-CNT. DTSBD510 01142 P3100-EXIT. DTSBD510 01143 EXIT. DTSBD510 01144 SKIP3 DTSBD510 01145 P3110-MJRN-ACCT-GROUP. DTSBD510 01146 IF (MJRN-YRQ (MJRN-OCC-IDX) DTSBD510 01147 < WRK-START-YRQ (WRK-EXTRACT-IDX)) DTSBD510 01148 OR DTSBD510 01149 (MJRN-YRQ (MJRN-OCC-IDX) DTSBD510 01150 > WRK-END-YRQ (WRK-EXTRACT-IDX)) DTSBD510 01151 GO TO P3110-EXIT. DTSBD510 01152 DTSBD510 01153 MOVE 'Y' TO WRK-MATCH-FOUND (WRK-EXTRACT-IDX). DTSBD510 01154 DTSBD510 01155 IF MJRN-ROW-UI-88 (MJRN-OCC-IDX) DTSBD510 01156 SET WRK-APP-ACCT-ROW-IDX TO +1 DTSBD510 01157 ELSE DTSBD510 01158 IF MJRN-ROW-SUR-88 (MJRN-OCC-IDX) DTSBD510 01159 SET WRK-APP-ACCT-ROW-IDX TO +2 DTSBD510 01160 ELSE DTSBD510 01161 IF MJRN-ROW-INT-88 (MJRN-OCC-IDX) DTSBD510 01162 SET WRK-APP-ACCT-ROW-IDX TO +3 DTSBD510 01163 ELSE DTSBD510 01164 IF MJRN-ROW-LATE-PEN-88 (MJRN-OCC-IDX) DTSBD510 01165 SET WRK-APP-ACCT-ROW-IDX TO +4 DTSBD510 01166 ELSE DTSBD510 01167 IF MJRN-ROW-NSF-PEN-88 (MJRN-OCC-IDX) DTSBD510 01168 SET WRK-APP-ACCT-ROW-IDX TO +5 DTSBD510 01169 ELSE DTSBD510 01170 IF MJRN-ROW-MISC-PEN-88 (MJRN-OCC-IDX) DTSBD510 01171 SET WRK-APP-ACCT-ROW-IDX TO +6 DTSBD510 01172 ELSE DTSBD510 01173 IF MJRN-ROW-CREDIT-88 (MJRN-OCC-IDX) DTSBD510 01174 SET WRK-APP-ACCT-ROW-IDX TO +7 DTSBD510 01175 ELSE DTSBD510 01176 MOVE 'INVALID MJRN-ACCT-ROW ENCOUNTERED' DTSBD510 01177 TO ABEND-MSG DTSBD510 01178 PERFORM S999-ABEND THRU S999-EXIT. DTSBD510 01179 DTSBD510 01180 IF MJRN-COL-CHARGED-88 (MJRN-OCC-IDX) DTSBD510 01181 SET WRK-APP-ACCT-COL-IDX TO +1 DTSBD510 01182 ELSE DTSBD510 01183 IF MJRN-COL-PAID-88 (MJRN-OCC-IDX) DTSBD510 01184 SET WRK-APP-ACCT-COL-IDX TO +2 DTSBD510 01185 ELSE DTSBD510 01186 IF MJRN-COL-WAIVED-88 (MJRN-OCC-IDX) DTSBD510 01187 SET WRK-APP-ACCT-COL-IDX TO +3 DTSBD510 01188 ELSE DTSBD510 01189 IF MJRN-COL-WRITTEN-OFF-88 (MJRN-OCC-IDX) DTSBD510 01190 SET WRK-APP-ACCT-COL-IDX TO +4 DTSBD510 01191 ELSE DTSBD510 01192 IF MJRN-COL-TOLERATED-88 (MJRN-OCC-IDX) DTSBD510 01193 SET WRK-APP-ACCT-COL-IDX TO +5 DTSBD510 01194 ELSE DTSBD510 01195 MOVE 'INVALID MJRN-ACCT-COL ENCOUNTERED' DTSBD510 01196 TO ABEND-MSG DTSBD510 01197 PERFORM S999-ABEND THRU S999-EXIT. DTSBD510 01198 DTSBD510 01199 ADD MJRN-AMT (MJRN-OCC-IDX) DTSBD510 01200 TO WRK-APP-AMT DTSBD510 01201 (WRK-EXTRACT-IDX WRK-APP-ACCT-ROW-IDX DTSBD510 01202 WRK-APP-ACCT-COL-IDX). DTSBD510 01203 P3110-EXIT. DTSBD510 01204 EXIT. DTSBD510 01205 EJECT DTSBD510 01206 P5000-PROCESS-TABLE. DTSBD510 01207 MOVE SUB1 TO R306-PARM-ID. DTSBD510 01208 DTSBD510 01209 MOVE +9999 TO R306-ACCT-SUB. DTSBD510 01210 DTSBD510 01211 MOVE HIGH-VALUES TO R306-ACCT-IND. DTSBD510 01212 DTSBD510 01213 MOVE WRK-EMP-CLASS (SUB1) TO R306-EMP-CLASS. DTSBD510 01214 DTSBD510 01215 MOVE WRK-START-DEPOSIT-DATE (SUB1) DTSBD510 01216 TO R306-START-DEPOSIT-DATE. DTSBD510 01217 DTSBD510 01218 MOVE WRK-END-DEPOSIT-DATE (SUB1) DTSBD510 01219 TO R306-END-DEPOSIT-DATE. DTSBD510 01220 DTSBD510 01221 MOVE WRK-START-PROCESS-DATE (SUB1) DTSBD510 01222 TO R306-START-PROCESS-DATE. DTSBD510 01223 DTSBD510 01224 MOVE WRK-END-PROCESS-DATE (SUB1) DTSBD510 01225 TO R306-END-PROCESS-DATE. DTSBD510 01226 DTSBD510 01227 MOVE WRK-START-YRQ (SUB1) TO R306-START-YRQ. DTSBD510 01228 DTSBD510 01229 MOVE WRK-END-YRQ (SUB1) TO R306-END-YRQ. DTSBD510 01230 DTSBD510 01231 MOVE WRK-START-BATCH-NO (SUB1) DTSBD510 01232 TO R306-START-BATCH-NO. DTSBD510 01233 DTSBD510 01234 MOVE WRK-END-BATCH-NO (SUB1) DTSBD510 01235 TO R306-END-BATCH-NO. DTSBD510 01236 DTSBD510 01237 MOVE WRK-RESPONSIBLE-ACTIVITY (SUB1) DTSBD510 01238 TO R306-RESPONSIBLE-ACTIVITY. DTSBD510 01239 DTSBD510 01240 MOVE WRK-TRAN-CATEGORY (SUB1) DTSBD510 01241 TO R306-TRAN-CATEGORY. DTSBD510 01242 DTSBD510 01243 MOVE WRK-TRAN-TYPE-CNT (SUB1) TO R306-TRAN-TYPE-CNT. DTSBD510 01244 DTSBD510 01245 PERFORM DTSBD510 01246 VARYING R306-TRAN-IDX FROM 1 BY 1 DTSBD510 01247 UNTIL R306-TRAN-IDX > WRK-TRAN-TYPE-MAX DTSBD510 01248 MOVE SPACES TO R306-TRAN-TYPE (R306-TRAN-IDX) DTSBD510 01249 END-PERFORM. DTSBD510 01250 DTSBD510 01251 PERFORM DTSBD510 01252 VARYING SUB2 FROM 1 BY 1 DTSBD510 01253 UNTIL SUB2 > WRK-TRAN-TYPE-CNT (SUB1) DTSBD510 01254 MOVE WRK-TRAN-TYPE (SUB1 SUB2) DTSBD510 01255 TO R306-TRAN-TYPE (SUB2) DTSBD510 01256 END-PERFORM. DTSBD510 01257 DTSBD510 01258 PERFORM P5100-ACCT-LOOP THRU P5100-EXIT DTSBD510 01259 VARYING SUB2 FROM 1 BY 1 DTSBD510 01260 UNTIL SUB2 > WRK-ACCT-ROW-MAX. DTSBD510 01261 P5000-EXIT. DTSBD510 01262 EXIT. DTSBD510 01263 EJECT DTSBD510 01264 P5100-ACCT-LOOP. DTSBD510 01265 MOVE SUB2 TO R306-ACCT-SUB. DTSBD510 01266 DTSBD510 01267 MOVE WRK-APP-ACCT-ROW (SUB1 SUB2) TO R306-ACCT-IND. DTSBD510 01268 DTSBD510 01269 MOVE WRK-APP-AMT (SUB1 SUB2 1) TO R306-CHARGED-AMT. DTSBD510 01270 DTSBD510 01271 MOVE WRK-APP-AMT (SUB1 SUB2 2) TO R306-PAID-AMT. DTSBD510 01272 DTSBD510 01273 MOVE WRK-APP-AMT (SUB1 SUB2 3) TO R306-WAIVED-AMT. DTSBD510 01274 DTSBD510 01275 MOVE WRK-APP-AMT (SUB1 SUB2 4) TO R306-WRITTEN-OFF-AMT. DTSBD510 01276 DTSBD510 01277 MOVE WRK-APP-AMT (SUB1 SUB2 5) TO R306-TOLER-AMT. DTSBD510 01278 DTSBD510 01279 COMPUTE R306-BALANCE-AMT DTSBD510 01280 = R306-CHARGED-AMT DTSBD510 01281 - R306-PAID-AMT DTSBD510 01282 - R306-WAIVED-AMT DTSBD510 01283 - R306-WRITTEN-OFF-AMT DTSBD510 01284 - R306-TOLER-AMT. DTSBD510 01285 DTSBD510 01286 PERFORM S946-WRITE-R306 THRU S946-EXIT. DTSBD510 01287 DTSBD510 01288 ADD +1 TO WRK-R306-REC-CNT. DTSBD510 01289 P5100-EXIT. DTSBD510 01290 EXIT. DTSBD510 01291 EJECT DTSBD510 01292 T0000-TERMINATE. DTSBD510 01293 DISPLAY DTSBD510 01294 ' NUMBER OF PARM RECORDS PROCESSED: 'DTSBD510 01295 WRK-PARM-REC-CNT. DTSBD510 01296 DTSBD510 01297 DISPLAY DTSBD510 01298 ' NUMBER OF ON-LINE MASTER FILE JOURNAL RECORDS PROCESSED: 'DTSBD510 01299 WRK-MJRN-REC-CNT. DTSBD510 01300 DTSBD510 01301 DISPLAY DTSBD510 01302 'NUMBER OF ARCHIVED MASTER FILE JOURNAL RECORDS PROCESSED: 'DTSBD510 01303 WRK-ARCH-MJRN-REC-CNT. DTSBD510 01304 DTSBD510 01305 DISPLAY DTSBD510 01306 ' NUMBER OF R306 RECORDS CREATED: 'DTSBD510 01307 WRK-R306-REC-CNT. DTSBD510 01308 DTSBD510 01309 MOVE -1 TO R306-LENGTH. DTSBD510 01310 DTSBD510 01311 PERFORM S946-WRITE-R306 THRU S946-EXIT. DTSBD510 01312 T0000-EXIT. DTSBD510 01313 EXIT. DTSBD510 01314 EJECT DTSBD510 01315 S001-FROM-CAL-6. DTSBD510 01316 SET L001-FROM-CAL-6 TO TRUE. DTSBD510 01317 GO TO S001-DATE. DTSBD510 01318 DTSBD510 01319 S001-DATE. DTSBD510 01320 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBD510 01321 S001-EXIT. DTSBD510 01322 EXIT. DTSBD510 01323 SKIP3 DTSBD510 01324 S004-FROM-3. DTSBD510 01325 SET L004-FROM-3 TO TRUE. DTSBD510 01326 GO TO S004-YRQ. DTSBD510 01327 DTSBD510 01328 S004-FROM-DATE. DTSBD510 01329 SET L004-FROM-DATE TO TRUE. DTSBD510 01330 GO TO S004-YRQ. DTSBD510 01331 DTSBD510 01332 S004-YRQ. DTSBD510 01333 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBD510 01334 S004-EXIT. DTSBD510 01335 EXIT. DTSBD510 01336 SKIP3 DTSBD510 01337 S032-MRPT-RESPONSIBLE-ACTIVITY. DTSBD510 01338 SET L032-MRPT-RESPONSIBLE-ACTIVITY TO TRUE. DTSBD510 01339 GO TO S032-ACCOUNTING-CODE-EDIT. DTSBD510 01340 DTSBD510 01341 S032-MPAY-RESPONSIBLE-ACTIVITY. DTSBD510 01342 SET L032-MPAY-RESPONSIBLE-ACTIVITY TO TRUE. DTSBD510 01343 GO TO S032-ACCOUNTING-CODE-EDIT. DTSBD510 01344 DTSBD510 01345 S032-MADJ-RESPONSIBLE-ACTIVITY. DTSBD510 01346 SET L032-MADJ-RESPONSIBLE-ACTIVITY TO TRUE. DTSBD510 01347 GO TO S032-ACCOUNTING-CODE-EDIT. DTSBD510 01348 DTSBD510 01349 S032-MRPT-RPT-TYPE. DTSBD510 01350 SET L032-MRPT-RPT-TYPE TO TRUE. DTSBD510 01351 GO TO S032-ACCOUNTING-CODE-EDIT. DTSBD510 01352 DTSBD510 01353 S032-MPAY-PAY-TYPE. DTSBD510 01354 SET L032-MPAY-PAY-TYPE TO TRUE. DTSBD510 01355 GO TO S032-ACCOUNTING-CODE-EDIT. DTSBD510 01356 DTSBD510 01357 S032-MADJ-ADJ-TYPE. DTSBD510 01358 SET L032-MADJ-ADJ-TYPE TO TRUE. DTSBD510 01359 GO TO S032-ACCOUNTING-CODE-EDIT. DTSBD510 01360 DTSBD510 01361 S032-ACCOUNTING-CODE-EDIT. DTSBD510 01362 CALL 'DTSBU032' USING L032-LINK-AREA. DTSBD510 01363 S032-EXIT. DTSBD510 01364 EXIT. DTSBD510 01365 SKIP3 DTSBD510 01366 S910-OPEN-READ. DTSBD510 01367 SET L910-OPEN-READ-88 TO TRUE. DTSBD510 01368 GO TO S910-MSTR-CALL. DTSBD510 01369 DTSBD510 01370 S910-READ. DTSBD510 01371 SET L910-READ-88 TO TRUE. DTSBD510 01372 GO TO S910-MSTR-CALL. DTSBD510 01373 DTSBD510 01374 S910-START-BROWSE. DTSBD510 01375 SET L910-START-BROWSE-88 TO TRUE. DTSBD510 01376 GO TO S910-MSTR-CALL. DTSBD510 01377 DTSBD510 01378 S910-READ-NEXT. DTSBD510 01379 SET L910-READ-NEXT-88 TO TRUE. DTSBD510 01380 GO TO S910-MSTR-CALL. DTSBD510 01381 DTSBD510 01382 *S910-COUNT. DTSBD510 01383 *****SET L910-COUNT-88 TO TRUE. DTSBD510 01384 *****GO TO S910-MSTR-CALL. DTSBD510 01385 DTSBD510 01386 S910-CLOSE. DTSBD510 01387 SET L910-CLOSE-88 TO TRUE. DTSBD510 01388 GO TO S910-MSTR-CALL. DTSBD510 01389 DTSBD510 01390 S910-MSTR-CALL. DTSBD510 01391 CALL 'DTSBU910' USING L910-LINK-AREA DTSBD510 01392 MSKL-REC. DTSBD510 01393 S910-EXIT. DTSBD510 01394 EXIT. DTSBD510 01395 SKIP3 DTSBD510 01396 S946-WRITE-R306. DTSBD510 01397 CALL 'DTSBU946' USING R306-REC. DTSBD510 01398 GO TO S946-EXIT. DTSBD510 01399 DTSBD510 01400 S946-EXIT. DTSBD510 01401 EXIT. DTSBD510 01402 SKIP3 DTSBD510 01403 S961-OPEN-READ. DTSBD510 01404 SET L961-OPEN-READ-88 TO TRUE. DTSBD510 01405 GO TO S961-MSTR-I. DTSBD510 01406 DTSBD510 01407 S961-READ-NEXT. DTSBD510 01408 SET L961-READ-NEXT-88 TO TRUE. DTSBD510 01409 GO TO S961-MSTR-I. DTSBD510 01410 DTSBD510 01411 S961-CLOSE. DTSBD510 01412 SET L961-CLOSE-88 TO TRUE. DTSBD510 01413 GO TO S961-MSTR-I. DTSBD510 01414 DTSBD510 01415 S961-MSTR-I. DTSBD510 01416 CALL 'DTSBU961' USING L961-LINK-AREA DTSBD510 01417 MSKL-REC. DTSBD510 01418 S961-EXIT. DTSBD510 01419 EXIT. DTSBD510 01420 SKIP3 DTSBD510 01421 S999-ABEND. DTSBD510 01422 DISPLAY '*** DTSBD510 ABENDING. ' DTSBD510 01423 ABEND-MSG. DTSBD510 01424 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBD510 01425 S999-EXIT. DTSBD510 01426 EXIT. DTSBD510 01427 EJECT DTSBD510