1429 lines
113 KiB
COBOL
1429 lines
113 KiB
COBOL
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
|