DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
423
Batch/DTSBX330.cob
Normal file
423
Batch/DTSBX330.cob
Normal file
@ -0,0 +1,423 @@
|
||||
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
|
||||
Reference in New Issue
Block a user