424 lines
34 KiB
COBOL
424 lines
34 KiB
COBOL
00001 IDENTIFICATION DIVISION. 11/04/04
|
|
00002 PROGRAM-ID. DTSBX330. DTSBX330
|
|
00003 AUTHOR. TRW. LV023
|
|
00004 DATE-WRITTEN. NOVEMBER 2002. DTSBX330
|
|
00005 DATE-COMPILED. DTSBX330
|
|
00006 SKIP3 DTSBX330
|
|
00007 ***** DTSBX330
|
|
00008 * DTSBX330
|
|
00009 * DTSBX330
|
|
00010 * FUNCTION: BUILD REPORT RECORDS FOR DAILY CREDITS AND DEBITS CL*15
|
|
00011 * ESTABLISHED REPORT FROM X330 RECORDS PASSED FROM CL*18
|
|
00012 * DTSBE330. CL*18
|
|
00013 * CL*15
|
|
00014 * DTSBX330
|
|
00015 * MODIFICATION LOG: DTSBX330
|
|
00016 * DTSBX330
|
|
00017 * 11/28/2002 INITIAL DEVELOPMENT. DTSBX330
|
|
00018 * REFERENCE: PROGRAMMER: GD CL*15
|
|
00019 * DTSBX330
|
|
00020 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX330
|
|
00021 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX330
|
|
00022 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBX330
|
|
00023 * DTSBX330
|
|
00024 * DTSBX330
|
|
00025 * DESCRIPTION: DTSBX330
|
|
00026 * DTSBX330
|
|
00027 * DTSBX330
|
|
00028 * INITIATION: DTSBX330
|
|
00029 * DTSBX330
|
|
00030 * OPEN DTSX774 DTSBX330
|
|
00031 * DTSBX330
|
|
00032 * DTSBX330
|
|
00033 * DTSBX330
|
|
00034 * PROCESSING: DTSBX330
|
|
00035 * DTSBX330
|
|
00036 * BUILD X774 OUTPUT RECORDS FROM DTSIY774 INPUT. DTSBX330
|
|
00037 * DTSBX330
|
|
00038 * DTSBX330
|
|
00039 * TERMINATION: DTSBX330
|
|
00040 * DTSBX330
|
|
00041 * CLOSE DTSX774 DTSBX330
|
|
00042 * DTSBX330
|
|
00043 * RECORDS READ: DTSBX330
|
|
00044 * DTSBX330
|
|
00045 * MASTER: DTSBX330
|
|
00046 * DTSBX330
|
|
00047 * NONE DTSBX330
|
|
00048 * DTSBX330
|
|
00049 * ALTERNATE INDEX: DTSBX330
|
|
00050 * DTSBX330
|
|
00051 * NONE. DTSBX330
|
|
00052 * DTSBX330
|
|
00053 * DTSBX330
|
|
00054 * REFERENCE: DTSBX330
|
|
00055 * DTSBX330
|
|
00056 * DTSBX330
|
|
00057 * DTSBX330
|
|
00058 * RECORDS UPDATED: DTSBX330
|
|
00059 * DTSBX330
|
|
00060 * NONE DTSBX330
|
|
00061 * DTSBX330
|
|
00062 * DTSBX330
|
|
00063 * OUTPUT RECORDS WRITTEN: DTSBX330
|
|
00064 * DTSBX330
|
|
00065 * DTSIR330 CL*22
|
|
00066 * DTSBX330
|
|
00067 * DTSBX330
|
|
00068 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBX330
|
|
00069 * DTSBX330
|
|
00070 * NONE. DTSBX330
|
|
00071 * DTSBX330
|
|
00072 * DTSBX330
|
|
00073 * MODULES CALLED: DTSBX330
|
|
00074 * DTSBX330
|
|
00075 * DTSBU001 DATE EDIT/CONVERSION. DTSBX330
|
|
00076 * DTSBU004 QUARTER EDIT/CONVERSION. DTSBX330
|
|
00077 * DTSBX330
|
|
00078 * DTSBX330
|
|
00079 * DTSBX330
|
|
00080 ***** DTSBX330
|
|
00081 SKIP3 DTSBX330
|
|
00082 ENVIRONMENT DIVISION. DTSBX330
|
|
00083 INPUT-OUTPUT SECTION. DTSBX330
|
|
00084 FILE-CONTROL. DTSBX330
|
|
00085 SELECT X330-FILE ASSIGN TO DTSX330 CL*18
|
|
00086 FILE STATUS IS X330-STATUS. CL*18
|
|
00087 CL*15
|
|
00088 SELECT BE330-PARM-FILE ASSIGN TO BE330PRM CL*18
|
|
00089 FILE STATUS IS PARM-STATUS. CL*17
|
|
00090 EJECT CL*15
|
|
00091 DATA DIVISION. DTSBX330
|
|
00092 FILE SECTION. DTSBX330
|
|
00093 FD X330-FILE CL*18
|
|
00094 RECORDING MODE IS F DTSBX330
|
|
00095 LABEL RECORDS ARE STANDARD DTSBX330
|
|
00096 BLOCK CONTAINS 0 RECORDS. DTSBX330
|
|
00097 01 X330-REC. CL*18
|
|
00098 ++INCLUDE DTSIX330 CL*18
|
|
00099 CL*15
|
|
00100 FD BE330-PARM-FILE CL*18
|
|
00101 RECORDING MODE IS F CL*15
|
|
00102 LABEL RECORDS ARE STANDARD CL*15
|
|
00103 BLOCK CONTAINS 0 CHARACTERS. CL*15
|
|
00104 CL*15
|
|
00105 01 BE330-PARM-REC PIC S9(09) COMP-3. CL*18
|
|
00106 CL*15
|
|
00107 WORKING-STORAGE SECTION. DTSBX330
|
|
001075 77 PAN-VALET PICTURE X(24) VALUE '023DTSBX330 11/04/04'. DTSBX330
|
|
00108 SKIP3 DTSBX330
|
|
00109 01 WRK-AREA. DTSBX330
|
|
00110 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +330. CL*18
|
|
00111 DTSBX330
|
|
00112 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBX330'. CL*18
|
|
00113 DTSBX330
|
|
00114 05 ABEND-MSG PIC X(60). DTSBX330
|
|
00115 DTSBX330
|
|
00116 05 X330-STATUS PIC X(02) VALUE SPACES. CL*18
|
|
00117 88 X330-STATUS-OK-88 VALUE ZEROS. CL*18
|
|
00118 88 X330-STATUS-EOF-88 VALUE '10'. CL*18
|
|
00119 DTSBX330
|
|
00120 05 PARM-STATUS PIC X(02) VALUE SPACES. CL*17
|
|
00121 88 PARM-STATUS-OK-88 VALUE ZEROS. CL*15
|
|
00122 88 PARM-STATUS-EOF-88 VALUE '10'. CL*15
|
|
00123 CL*15
|
|
00124 05 WRK-SUBJECT-DATE PIC S9(09) COMP-3 CL*16
|
|
00125 VALUE +0. CL*16
|
|
00126 05 WRK-EMP-NO PIC S9(07) COMP-3 CL**2
|
|
00127 VALUE +0. CL**2
|
|
00128 05 WRK-YRQ PIC S9(05) COMP-3 CL**2
|
|
00129 VALUE +0. CL**2
|
|
00130 05 WRK-TRAN-TYPE PIC X(02). CL*16
|
|
00131 CL*16
|
|
00132 05 WRK-QTR-BAL PIC S9(11)V99 COMP-3 CL**6
|
|
00133 VALUE +0. CL**6
|
|
00134 DTSBX330
|
|
00135 05 WRK-REC-AREA PIC X(155). DTSBX330
|
|
00136 DTSBX330
|
|
00137 ******************************************************************DTSBX330
|
|
00138 * THE RECEIVABLE TABLE CONTAINS ONE ENTRY FOR EACH RECEIVABLE DTSBX330
|
|
00139 * FOR A GIVEN EMPLOYER/QUARTER. THE PROCESSED DATE, RECEIVED DTSBX330
|
|
00140 * DATE AND AMOUNT COME FROM THE DTSIY774 RECORD. THE OTHER DTSBX330
|
|
00141 * FIELDS ARE CALCULATED. THE START BALANCE IS THE RECEIVABLE DTSBX330
|
|
00142 * BALANCE DUE BEFORE APPLYING ANY REPORT QUARTER LIQUIDATIONS. DTSBX330
|
|
00143 * THE END BALANCE IS THE RECEIVABLE BALANCE DUE AFTER APPLYING DTSBX330
|
|
00144 * ANY REPORT QUARTER LIQUIDATIONS. DTSBX330
|
|
00145 ******************************************************************DTSBX330
|
|
00146 05 QTR-SUB PIC S9(04) COMP VALUE +0. CL**2
|
|
00147 05 QTR-LAST PIC S9(04) COMP VALUE +0. CL**2
|
|
00148 05 QTR-MAX PIC S9(04) COMP VALUE +200. CL**2
|
|
00149 05 QTR-TABLE OCCURS 200 TIMES. CL**2
|
|
00150 10 QTR-BATCH-NO PIC S9(05) COMP-3. CL*12
|
|
00151 10 QTR-ITEM-NO PIC S9(03) COMP-3. CL*12
|
|
00152 10 QTR-TRAN-TYPE PIC X(02). CL*15
|
|
00153 10 QTR-AMT PIC S9(09)V99 COMP-3. CL**2
|
|
00154 DTSBX330
|
|
00155 05 WRK-BATCH-NO PIC S9(05) COMP-3. CL*12
|
|
00156 05 WRK-ITEM-NO PIC S9(03) COMP-3. CL*12
|
|
00157 CL*12
|
|
00158 05 WRK-R330-CNT PIC S9(07) COMP-3 CL*19
|
|
00159 VALUE +0. DTSBX330
|
|
00160 DTSBX330
|
|
00161 05 WRK-DISP-EMP PIC S9(07) COMP-3 DTSBX330
|
|
00162 VALUE +010169. DTSBX330
|
|
00163 DTSBX330
|
|
00164 05 DISPLAY-CNT PIC Z(06)9. DTSBX330
|
|
00165 05 DISPLAY-AMT-X PIC X(15). DTSBX330
|
|
00166 05 DISPLAY-AMT REDEFINES DISPLAY-AMT-X DTSBX330
|
|
00167 PIC ZZZ,ZZZ,ZZ9.99-. DTSBX330
|
|
00168 05 DISPLAY-AMT1-X PIC X(15). CL**8
|
|
00169 05 DISPLAY-AMT1 REDEFINES DISPLAY-AMT1-X CL**8
|
|
00170 PIC ZZZ,ZZZ,ZZ9.99-. CL**8
|
|
00171 EJECT DTSBX330
|
|
00172 01 L001-LINK-AREA. DTSBX330
|
|
00173 ++INCLUDE DTSIL001 DTSBX330
|
|
00174 CL*19
|
|
00175 01 L004-LINK-AREA. DTSBX330
|
|
00176 ++INCLUDE DTSIL004 DTSBX330
|
|
00177 CL*19
|
|
00178 01 R330-REC. CL*19
|
|
00179 ++INCLUDE DTSIR330 CL*19
|
|
00180 CL*19
|
|
00181 SKIP3 DTSBX330
|
|
00182 PROCEDURE DIVISION. CL**2
|
|
00183 DTSBX330
|
|
00184 PERFORM I0000-INITIALIZE THRU I0000-EXIT. CL**2
|
|
00185 CL**2
|
|
00186 PERFORM P0000-PROCESS THRU P0000-EXIT CL**3
|
|
00187 UNTIL X330-STATUS-EOF-88. CL*18
|
|
00188 CL**2
|
|
00189 PERFORM T0000-TERMINATE THRU T0000-EXIT. CL**2
|
|
00190 SKIP2 DTSBX330
|
|
00191 GOBACK. DTSBX330
|
|
00192 EJECT DTSBX330
|
|
00193 I0000-INITIALIZE. DTSBX330
|
|
00194 MOVE +0 TO QTR-SUB. CL**2
|
|
00195 DTSBX330
|
|
00196 MOVE LENGTH OF R330-REC TO R330-LENGTH. CL*19
|
|
00197 MOVE '330' TO R330-REC-TYPE. CL*19
|
|
00198 CL*19
|
|
00199 OPEN INPUT X330-FILE CL*18
|
|
00200 IF NOT X330-STATUS-OK-88 CL*18
|
|
00201 DISPLAY 'X330 FILE STATUS IS : ' X330-STATUS CL*18
|
|
00202 MOVE 'CANNOT OPEN OUTPUT FILE ' TO ABEND-MSG DTSBX330
|
|
00203 PERFORM S999-ABEND THRU S999-EXIT CL*16
|
|
00204 END-IF. CL*16
|
|
00205 DTSBX330
|
|
00206 OPEN INPUT BE330-PARM-FILE CL*18
|
|
00207 IF NOT PARM-STATUS-OK-88 CL*16
|
|
00208 DISPLAY 'PARM FILE STATUS IS : ' PARM-STATUS CL*16
|
|
00209 MOVE 'CANNOT OPEN PARM FILE ' TO ABEND-MSG CL*16
|
|
00210 PERFORM S999-ABEND THRU S999-EXIT CL*16
|
|
00211 END-IF. CL*16
|
|
00212 CL*16
|
|
00213 READ BE330-PARM-FILE CL*18
|
|
00214 IF PARM-STATUS-OK-88 CL*16
|
|
00215 MOVE BE330-PARM-REC TO WRK-SUBJECT-DATE CL*18
|
|
00216 DISPLAY 'SUBJECT DATE ' WRK-SUBJECT-DATE CL*16
|
|
00217 ELSE CL*16
|
|
00218 DISPLAY 'PARM FILE STATUS IS : ' PARM-STATUS CL*16
|
|
00219 MOVE 'CANNOT READ PARM FILE ' TO ABEND-MSG CL*16
|
|
00220 PERFORM S999-ABEND THRU S999-EXIT CL*16
|
|
00221 END-IF. CL*16
|
|
00222 CL*16
|
|
00223 CLOSE BE330-PARM-FILE. CL*18
|
|
00224 CL*16
|
|
00225 I0000-EXIT. DTSBX330
|
|
00226 EXIT. DTSBX330
|
|
00227 DTSBX330
|
|
00228 P0000-PROCESS. DTSBX330
|
|
00229 READ X330-FILE. CL*18
|
|
00230 IF X330-STATUS-EOF-88 CL*18
|
|
00231 GO TO P0000-EXIT CL**9
|
|
00232 ELSE CL**9
|
|
00233 IF NOT X330-STATUS-OK-88 CL*18
|
|
00234 DISPLAY 'BAD READ: ' X330-STATUS CL*18
|
|
00235 SET X330-STATUS-EOF-88 TO TRUE CL*18
|
|
00236 GO TO P0000-EXIT CL**9
|
|
00237 END-IF CL**9
|
|
00238 END-IF. CL**3
|
|
00239 CL**2
|
|
00240 IF WRK-EMP-NO = ZERO DTSBX330
|
|
00241 PERFORM P1300-INIT-TABLES THRU P1300-EXIT DTSBX330
|
|
00242 PERFORM P1000-BUILD-QTR-TABLE THRU P1000-EXIT CL**4
|
|
00243 ELSE DTSBX330
|
|
00244 IF X330-EMP-NO = WRK-EMP-NO CL*18
|
|
00245 AND X330-YRQ = WRK-YRQ CL*18
|
|
00246 PERFORM P1000-BUILD-QTR-TABLE THRU P1000-EXIT CL**5
|
|
00247 ELSE DTSBX330
|
|
00248 PERFORM P5000-WRITE-OUTPUT THRU P5000-EXIT DTSBX330
|
|
00249 PERFORM P1300-INIT-TABLES THRU P1300-EXIT DTSBX330
|
|
00250 PERFORM P1000-BUILD-QTR-TABLE THRU P1000-EXIT CL**4
|
|
00251 END-IF CL**3
|
|
00252 END-IF. CL**3
|
|
00253 DTSBX330
|
|
00254 P0000-EXIT. DTSBX330
|
|
00255 EXIT. DTSBX330
|
|
00256 DTSBX330
|
|
00257 DTSBX330
|
|
00258 P1000-BUILD-QTR-TABLE. CL**4
|
|
00259 IF QTR-SUB < QTR-MAX CL**2
|
|
00260 ADD +1 TO QTR-SUB CL**2
|
|
00261 QTR-LAST CL**2
|
|
00262 ELSE DTSBX330
|
|
00263 MOVE 'RECEIVABLE TABLE LENGTH EXCEEDED' DTSBX330
|
|
00264 TO ABEND-MSG DTSBX330
|
|
00265 PERFORM S999-ABEND THRU S999-EXIT. DTSBX330
|
|
00266 DTSBX330
|
|
00267 MOVE X330-BATCH-NO TO QTR-BATCH-NO (QTR-SUB). CL*18
|
|
00268 MOVE X330-ITEM-NO TO QTR-ITEM-NO (QTR-SUB). CL*18
|
|
00269 MOVE X330-TRAN-TYPE TO QTR-TRAN-TYPE (QTR-SUB). CL*18
|
|
00270 ADD X330-AMT TO QTR-AMT (QTR-SUB). CL*18
|
|
00271 CL**3
|
|
00272 P1000-EXIT. CL**4
|
|
00273 EXIT. DTSBX330
|
|
00274 DTSBX330
|
|
00275 P1300-INIT-TABLES. DTSBX330
|
|
00276 MOVE X330-EMP-NO TO WRK-EMP-NO. CL*18
|
|
00277 MOVE X330-YRQ TO WRK-YRQ. CL*18
|
|
00278 DTSBX330
|
|
00279 PERFORM DTSBX330
|
|
00280 VARYING QTR-SUB FROM +1 BY +1 CL**2
|
|
00281 UNTIL QTR-SUB > QTR-MAX CL**2
|
|
00282 MOVE +0 TO QTR-BATCH-NO (QTR-SUB) CL**3
|
|
00283 QTR-ITEM-NO (QTR-SUB) CL**3
|
|
00284 QTR-AMT (QTR-SUB) CL**3
|
|
00285 MOVE SPACES TO QTR-TRAN-TYPE (QTR-SUB) CL*16
|
|
00286 END-PERFORM. DTSBX330
|
|
00287 DTSBX330
|
|
00288 MOVE +0 TO QTR-SUB CL**2
|
|
00289 QTR-LAST. CL**3
|
|
00290 DTSBX330
|
|
00291 P1300-EXIT. DTSBX330
|
|
00292 EXIT. DTSBX330
|
|
00293 DTSBX330
|
|
00294 DTSBX330
|
|
00295 P5000-WRITE-OUTPUT. DTSBX330
|
|
00296 MOVE ZERO TO WRK-QTR-BAL CL*12
|
|
00297 WRK-BATCH-NO CL*12
|
|
00298 WRK-ITEM-NO. CL*12
|
|
00299 MOVE SPACES TO WRK-TRAN-TYPE. CL*16
|
|
00300 CL**6
|
|
00301 PERFORM DTSBX330
|
|
00302 VARYING QTR-SUB FROM +1 BY +1 CL**2
|
|
00303 UNTIL QTR-SUB > QTR-LAST CL**2
|
|
00304 ADD QTR-AMT (QTR-SUB) TO WRK-QTR-BAL CL**6
|
|
00305 END-PERFORM. CL**3
|
|
00306 DTSBX330
|
|
00307 IF WRK-QTR-BAL > ZERO CL*23
|
|
00308 PERFORM CL**6
|
|
00309 VARYING QTR-SUB FROM +1 BY +1 CL**6
|
|
00310 UNTIL QTR-SUB > QTR-LAST CL**6
|
|
00311 PERFORM P5100-WRITE-R330 THRU P5100-EXIT CL*19
|
|
00312 END-PERFORM CL**6
|
|
00313 END-IF. CL**6
|
|
00314 DTSBX330
|
|
00315 P5000-EXIT. DTSBX330
|
|
00316 EXIT. DTSBX330
|
|
00317 DTSBX330
|
|
00318 P5100-WRITE-R330. CL*19
|
|
00319 MOVE WRK-EMP-NO TO R330-EMP-NO. CL*19
|
|
00320 MOVE WRK-SUBJECT-DATE TO R330-SUBJECT-DATE. CL*19
|
|
00321 SET R330-RPT-TYPE-DAILY-88 TO TRUE. CL*19
|
|
00322 IF WRK-YRQ < +99999 CL*22
|
|
00323 SET R330-DEBIT-88 TO TRUE CL*19
|
|
00324 ELSE CL*19
|
|
00325 SET R330-CREDIT-88 TO TRUE CL*19
|
|
00326 END-IF. CL*19
|
|
00327 MOVE QTR-BATCH-NO (QTR-SUB) TO R330-BATCH-NO. CL*19
|
|
00328 MOVE QTR-ITEM-NO (QTR-SUB) TO R330-ITEM-NO. CL*19
|
|
00329 MOVE QTR-TRAN-TYPE (QTR-SUB) TO R330-TRAN-TYPE. CL*19
|
|
00330 MOVE QTR-AMT(QTR-SUB) TO R330-AMT. CL*19
|
|
00331 CL*19
|
|
00332 PERFORM S946-WRITE-R330 THRU S946-EXIT. CL*19
|
|
00333 CL*19
|
|
00334 ADD +1 TO WRK-R330-CNT. CL*19
|
|
00335 CL*19
|
|
00336 MOVE WRK-QTR-BAL TO DISPLAY-AMT. CL*19
|
|
00337 MOVE QTR-AMT(QTR-SUB) TO DISPLAY-AMT1. CL*19
|
|
00338 DISPLAY WRK-EMP-NO ' ' WRK-YRQ CL*19
|
|
00339 ' ' DISPLAY-AMT1 CL*19
|
|
00340 ' ' QTR-BATCH-NO (QTR-SUB) CL*19
|
|
00341 ' ' QTR-ITEM-NO (QTR-SUB) CL*19
|
|
00342 ' ' QTR-TRAN-TYPE (QTR-SUB) CL*19
|
|
00343 ' ' DISPLAY-AMT. CL*19
|
|
00344 CL*19
|
|
00345 P5100-EXIT. CL*19
|
|
00346 EXIT. CL*19
|
|
00347 CL*19
|
|
00348 T0000-TERMINATE. DTSBX330
|
|
00349 DTSBX330
|
|
00350 CLOSE X330-FILE. CL*18
|
|
00351 CL*15
|
|
00352 DISPLAY ' '. DTSBX330
|
|
00353 DTSBX330
|
|
00354 DISPLAY '*** DTSBX330 TERMINATION STATISTICS ***'. CL*19
|
|
00355 DTSBX330
|
|
00356 DISPLAY ' '. DTSBX330
|
|
00357 MOVE WRK-R330-CNT TO DISPLAY-CNT. CL*19
|
|
00358 DISPLAY 'R330 RECORDS WRITTEN : ' CL*19
|
|
00359 DISPLAY-CNT. DTSBX330
|
|
00360 DTSBX330
|
|
00361 MOVE LOW-VALUES TO R330-REC. CL*21
|
|
00362 MOVE -1 TO R330-LENGTH. CL*20
|
|
00363 CL*19
|
|
00364 PERFORM S946-WRITE-R330 THRU S946-EXIT. CL*19
|
|
00365 CL*19
|
|
00366 T0000-EXIT. DTSBX330
|
|
00367 EXIT. DTSBX330
|
|
00368 DTSBX330
|
|
00369 S001-FROM-FED-8. DTSBX330
|
|
00370 SET L001-FROM-FED-8 TO TRUE. DTSBX330
|
|
00371 GO TO S001-DATE. DTSBX330
|
|
00372 DTSBX330
|
|
00373 S001-FROM-ABS-DAY. DTSBX330
|
|
00374 SET L001-FROM-ABS-DAY TO TRUE. DTSBX330
|
|
00375 GO TO S001-DATE. DTSBX330
|
|
00376 DTSBX330
|
|
00377 S001-FROM-CAL-6. DTSBX330
|
|
00378 SET L001-FROM-CAL-6 TO TRUE. DTSBX330
|
|
00379 GO TO S001-DATE. DTSBX330
|
|
00380 DTSBX330
|
|
00381 S001-DATE. DTSBX330
|
|
00382 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX330
|
|
00383 S001-EXIT. DTSBX330
|
|
00384 EXIT. DTSBX330
|
|
00385 SKIP3 DTSBX330
|
|
00386 S004-FROM-5. DTSBX330
|
|
00387 SET L004-FROM-5 TO TRUE. DTSBX330
|
|
00388 GO TO S004-QTR. DTSBX330
|
|
00389 DTSBX330
|
|
00390 S004-FROM-ABS. DTSBX330
|
|
00391 SET L004-FROM-ABS TO TRUE. DTSBX330
|
|
00392 GO TO S004-QTR. DTSBX330
|
|
00393 DTSBX330
|
|
00394 S004-FROM-3. DTSBX330
|
|
00395 SET L004-FROM-3 TO TRUE. DTSBX330
|
|
00396 GO TO S004-QTR. DTSBX330
|
|
00397 DTSBX330
|
|
00398 S004-FROM-DATE. DTSBX330
|
|
00399 SET L004-FROM-DATE TO TRUE. DTSBX330
|
|
00400 GO TO S004-QTR. DTSBX330
|
|
00401 DTSBX330
|
|
00402 S004-QTR. DTSBX330
|
|
00403 DTSBX330
|
|
00404 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX330
|
|
00405 DTSBX330
|
|
00406 S004-EXIT. DTSBX330
|
|
00407 EXIT. DTSBX330
|
|
00408 SKIP3 DTSBX330
|
|
00409 DTSBX330
|
|
00410 S946-WRITE-R330. CL*19
|
|
00411 CALL 'DTSBU946' USING R330-REC. CL*19
|
|
00412 CL*19
|
|
00413 S946-EXIT. CL*19
|
|
00414 EXIT. CL*19
|
|
00415 SKIP3 CL*19
|
|
00416 S999-ABEND. DTSBX330
|
|
00417 DISPLAY '*** DTSBE774 ABENDING. ' DTSBX330
|
|
00418 ABEND-MSG. DTSBX330
|
|
00419 DTSBX330
|
|
00420 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX330
|
|
00421 S999-EXIT. DTSBX330
|
|
00422 EXIT. DTSBX330
|