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