00001 IDENTIFICATION DIVISION. 08/31/05 00002 PROGRAM-ID. DTSBX331. DTSBX331 00003 AUTHOR. TRW. LV001 00004 DATE-WRITTEN. NOVEMBER 2002. DTSBX331 00005 DATE-COMPILED. DTSBX331 00006 SKIP3 DTSBX331 00007 ***** DTSBX331 00008 * DTSBX331 00009 * FUNCTION: BUILD COMMA-DELIMITED FILE FOR DOWNLOAD TO DTSBX331 00010 * SQL SERVER DATABASE FOR CREDIT/DEBIT WEB DTSBX331 00011 * APPLICATION. DTSBX331 00012 * READS DATA FILE OUTPUT BY DTSBE331. DTSBX331 00013 * DTSBX331 00014 * MODIFICATION LOG: DTSBX331 00015 * DTSBX331 00016 * 11/28/2002 INITIAL DEVELOPMENT. DTSBX331 00017 * REFERENCE: PROGRAMMER: GD DTSBX331 00018 * DTSBX331 00019 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX331 00020 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX331 00021 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBX331 00022 * DTSBX331 00023 * DTSBX331 00024 * DESCRIPTION: DTSBX331 00025 * DTSBX331 00026 * DTSBX331 00027 * INITIATION: DTSBX331 00028 * DTSBX331 00029 * OPEN DTSX774 DTSBX331 00030 * DTSBX331 00031 * DTSBX331 00032 * DTSBX331 00033 * PROCESSING: DTSBX331 00034 * DTSBX331 00035 * BUILD X774 OUTPUT RECORDS FROM DTSIY774 INPUT. DTSBX331 00036 * DTSBX331 00037 * DTSBX331 00038 * TERMINATION: DTSBX331 00039 * DTSBX331 00040 * CLOSE DTSX774 DTSBX331 00041 * DTSBX331 00042 * RECORDS READ: DTSBX331 00043 * DTSBX331 00044 * MASTER: DTSBX331 00045 * DTSBX331 00046 * NONE DTSBX331 00047 * DTSBX331 00048 * ALTERNATE INDEX: DTSBX331 00049 * DTSBX331 00050 * NONE. DTSBX331 00051 * DTSBX331 00052 * DTSBX331 00053 * REFERENCE: DTSBX331 00054 * DTSBX331 00055 * DTSBX331 00056 * DTSBX331 00057 * RECORDS UPDATED: DTSBX331 00058 * DTSBX331 00059 * NONE DTSBX331 00060 * DTSBX331 00061 * DTSBX331 00062 * OUTPUT RECORDS WRITTEN: DTSBX331 00063 * DTSBX331 00064 * DTSBX331 00065 * DTSBX331 00066 * DTSBX331 00067 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBX331 00068 * DTSBX331 00069 * NONE. DTSBX331 00070 * DTSBX331 00071 * DTSBX331 00072 * MODULES CALLED: DTSBX331 00073 * DTSBX331 00074 * DTSBU001 DATE EDIT/CONVERSION. DTSBX331 00075 * DTSBU004 QUARTER EDIT/CONVERSION. DTSBX331 00076 * DTSBX331 00077 * DTSBX331 00078 * DTSBX331 00079 ***** DTSBX331 00080 SKIP3 DTSBX331 00081 ENVIRONMENT DIVISION. DTSBX331 00082 INPUT-OUTPUT SECTION. DTSBX331 00083 FILE-CONTROL. DTSBX331 00084 SELECT X331-FILE ASSIGN TO DTSX331 DTSBX331 00085 FILE STATUS IS X331-STATUS. DTSBX331 00086 DTSBX331 00087 SELECT X331A-SUMMARY ASSIGN TO DTSX331A DTSBX331 00088 FILE STATUS IS X331A-STATUS. DTSBX331 00089 DTSBX331 00090 SELECT X331B-DETAIL ASSIGN TO DTSX331B DTSBX331 00091 FILE STATUS IS X331B-STATUS. DTSBX331 00092 DTSBX331 00093 SELECT X331C-TRAN ASSIGN TO DTSX331C DTSBX331 00094 FILE STATUS IS X331C-STATUS. DTSBX331 00095 DTSBX331 00096 SELECT BE330-PARM-FILE ASSIGN TO BE330PRM DTSBX331 00097 FILE STATUS IS PARM-STATUS. DTSBX331 00098 EJECT DTSBX331 00099 DATA DIVISION. DTSBX331 00100 FILE SECTION. DTSBX331 00101 FD X331-FILE DTSBX331 00102 RECORDING MODE IS F DTSBX331 00103 LABEL RECORDS ARE STANDARD DTSBX331 00104 BLOCK CONTAINS 0 RECORDS. DTSBX331 00105 01 X331-REC. DTSBX331 00106 ++INCLUDE DTSIX331 DTSBX331 00107 DTSBX331 00108 FD X331A-SUMMARY DTSBX331 00109 RECORDING MODE IS F DTSBX331 00110 LABEL RECORDS ARE STANDARD DTSBX331 00111 BLOCK CONTAINS 0 RECORDS. DTSBX331 00112 01 X331A-REC PIC X(68). DTSBX331 00113 DTSBX331 00114 FD X331B-DETAIL DTSBX331 00115 RECORDING MODE IS F DTSBX331 00116 LABEL RECORDS ARE STANDARD DTSBX331 00117 BLOCK CONTAINS 0 RECORDS. DTSBX331 00118 01 X331B-REC PIC X(56). DTSBX331 00119 DTSBX331 00120 FD X331C-TRAN DTSBX331 00121 RECORDING MODE IS F DTSBX331 00122 LABEL RECORDS ARE STANDARD DTSBX331 00123 BLOCK CONTAINS 0 RECORDS. DTSBX331 00124 01 X331C-REC PIC X(71). DTSBX331 00125 DTSBX331 00126 FD BE330-PARM-FILE DTSBX331 00127 RECORDING MODE IS F DTSBX331 00128 LABEL RECORDS ARE STANDARD DTSBX331 00129 BLOCK CONTAINS 0 CHARACTERS. DTSBX331 00130 DTSBX331 00131 01 BE330-PARM-REC PIC S9(09) COMP-3. DTSBX331 00132 DTSBX331 00133 WORKING-STORAGE SECTION. DTSBX331 001335 77 PAN-VALET PICTURE X(24) VALUE '001DTSBX331 08/31/05'. DTSBX331 00134 SKIP3 DTSBX331 00135 01 WRK-AREA. DTSBX331 00136 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +330.DTSBX331 00137 DTSBX331 00138 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBX331'.DTSBX331 00139 DTSBX331 00140 05 ABEND-MSG PIC X(60). DTSBX331 00141 DTSBX331 00142 05 X331-STATUS PIC X(02) VALUE SPACES. DTSBX331 00143 88 X331-STATUS-OK-88 VALUE ZEROS. DTSBX331 00144 88 X331-STATUS-EOF-88 VALUE '10'. DTSBX331 00145 DTSBX331 00146 05 X331A-STATUS PIC X(02) VALUE SPACES. DTSBX331 00147 88 X331A-STATUS-OK-88 VALUE ZEROS. DTSBX331 00148 88 X331A-STATUS-EOF-88 VALUE '10'. DTSBX331 00149 DTSBX331 00150 05 X331B-STATUS PIC X(02) VALUE SPACES. DTSBX331 00151 88 X331B-STATUS-OK-88 VALUE ZEROS. DTSBX331 00152 88 X331B-STATUS-EOF-88 VALUE '10'. DTSBX331 00153 DTSBX331 00154 05 X331C-STATUS PIC X(02) VALUE SPACES. DTSBX331 00155 88 X331C-STATUS-OK-88 VALUE ZEROS. DTSBX331 00156 88 X331C-STATUS-EOF-88 VALUE '10'. DTSBX331 00157 DTSBX331 00158 05 PARM-STATUS PIC X(02) VALUE SPACES. DTSBX331 00159 88 PARM-STATUS-OK-88 VALUE ZEROS. DTSBX331 00160 88 PARM-STATUS-EOF-88 VALUE '10'. DTSBX331 00161 DTSBX331 00162 05 WRK-RPT-FOUND-IND PIC X(01). DTSBX331 00163 88 WRK-RPT-FOUND-YES-88 VALUE 'Y'. DTSBX331 00164 88 WRK-RPT-FOUND-NO-88 VALUE 'N'. DTSBX331 00165 DTSBX331 00166 05 WRK-SUBJECT-DATE PIC S9(09) COMP-3 DTSBX331 00167 VALUE +0. DTSBX331 00168 05 WRK-EMP-NO PIC S9(07) COMP-3 DTSBX331 00169 VALUE +0. DTSBX331 00170 05 WRK-YRQ PIC S9(05) COMP-3 DTSBX331 00171 VALUE +0. DTSBX331 00172 05 WRK-EMP-CLASS PIC X(01). DTSBX331 00173 05 WRK-TRAN-CAT PIC X(01). DTSBX331 00174 05 WRK-RATE PIC S99V9 COMP-3. DTSBX331 00175 05 WRK-TRAN-TYPE PIC X(02). DTSBX331 00176 DTSBX331 00177 05 WRK-QTR-BAL PIC S9(11)V99 COMP-3 DTSBX331 00178 VALUE +0. DTSBX331 00179 DTSBX331 00180 ******************************************************************DTSBX331 00181 * THE RECEIVABLE TABLE CONTAINS ONE ENTRY FOR EACH RECEIVABLE DTSBX331 00182 * FOR A GIVEN EMPLOYER/QUARTER. THE PROCESSED DATE, RECEIVED DTSBX331 00183 * DATE AND AMOUNT COME FROM THE DTSIY774 RECORD. THE OTHER DTSBX331 00184 * FIELDS ARE CALCULATED. THE START BALANCE IS THE RECEIVABLE DTSBX331 00185 * BALANCE DUE BEFORE APPLYING ANY REPORT QUARTER LIQUIDATIONS. DTSBX331 00186 * THE END BALANCE IS THE RECEIVABLE BALANCE DUE AFTER APPLYING DTSBX331 00187 * ANY REPORT QUARTER LIQUIDATIONS. DTSBX331 00188 ******************************************************************DTSBX331 00189 05 QTR-SUB PIC S9(04) COMP VALUE +0. DTSBX331 00190 05 QTR-LAST PIC S9(04) COMP VALUE +0. DTSBX331 00191 05 QTR-MAX PIC S9(04) COMP VALUE +200. DTSBX331 00192 05 QTR-TABLE OCCURS 200 TIMES. DTSBX331 00193 10 QTR-BATCH-NO PIC S9(05) COMP-3. DTSBX331 00194 10 QTR-ITEM-NO PIC S9(03) COMP-3. DTSBX331 00195 10 QTR-TRAN-TYPE PIC X(02). DTSBX331 00196 10 QTR-AMT PIC S9(09)V99 COMP-3. DTSBX331 00197 10 QTR-ESTB-DATE PIC S9(09) COMP-3. DTSBX331 00198 DTSBX331 00199 05 WRK-SEQ-A PIC S9(05) COMP-3 VALUE +0. DTSBX331 00200 05 WRK-SEQ-B PIC S9(05) COMP-3 VALUE +0. DTSBX331 00201 05 WRK-SEQ-C PIC S9(05) COMP-3 VALUE +0. DTSBX331 00202 05 WRK-BATCH-NO PIC S9(05) COMP-3. DTSBX331 00203 05 WRK-ITEM-NO PIC S9(03) COMP-3. DTSBX331 00204 DTSBX331 00205 05 WRK-X331A-CNT PIC S9(07) COMP-3 DTSBX331 00206 VALUE +0. DTSBX331 00207 05 WRK-X331B-CNT PIC S9(07) COMP-3 DTSBX331 00208 VALUE +0. DTSBX331 00209 05 WRK-X331C-CNT PIC S9(07) COMP-3 DTSBX331 00210 VALUE +0. DTSBX331 00211 DTSBX331 00212 05 WRK-X331A-REC. DTSBX331 00213 10 X331A-SEQ PIC 9(06). DTSBX331 00214 10 FILLER PIC X(01) VALUE ','. DTSBX331 00215 10 X331A-ESTB-DATE PIC X(10). DTSBX331 00216 10 FILLER PIC X(01) VALUE ','. DTSBX331 00217 10 X331A-CREDIT-DEBIT PIC X(06). DTSBX331 00218 10 FILLER PIC X(01) VALUE ','. DTSBX331 00219 10 X331A-EMP-NO PIC 9(06). DTSBX331 00220 10 FILLER PIC X(01) VALUE ','. DTSBX331 00221 10 X331A-BATCH PIC 9(05). DTSBX331 00222 10 FILLER PIC X(01) VALUE ','. DTSBX331 00223 10 X331A-ITEM PIC 9(03). DTSBX331 00224 10 FILLER PIC X(01) VALUE ','. DTSBX331 00225 10 X331A-TRAN PIC X(02). DTSBX331 00226 10 FILLER PIC X(01) VALUE ','. DTSBX331 00227 10 X331A-AMT PIC --------9.99. DTSBX331 00228 10 FILLER PIC X(01) VALUE ','. DTSBX331 00229 10 X331A-YRQ PIC X(06). DTSBX331 00230 10 FILLER PIC X(01) VALUE ','. DTSBX331 00231 10 X331A-CAT PIC X(01). DTSBX331 00232 10 FILLER PIC X(01) VALUE ','. DTSBX331 00233 10 X331A-EMP-CLASS PIC X(01). DTSBX331 00234 DTSBX331 00235 05 WRK-X331B-REC. DTSBX331 00236 10 X331B-SEQ PIC 9(06). DTSBX331 00237 10 FILLER PIC X(01) VALUE ','. DTSBX331 00238 10 X331B-YRQ PIC X(06). DTSBX331 00239 10 FILLER PIC X(01) VALUE ','. DTSBX331 00240 10 X331B-BATCH PIC 9(05). DTSBX331 00241 10 FILLER PIC X(01) VALUE ','. DTSBX331 00242 10 X331B-ITEM PIC 9(03). DTSBX331 00243 10 FILLER PIC X(01) VALUE ','. DTSBX331 00244 10 X331B-EMP-NO PIC 9(06). DTSBX331 00245 10 FILLER PIC X(01) VALUE ','. DTSBX331 00246 10 X331B-EMP-CLASS PIC X(01). DTSBX331 00247 10 FILLER PIC X(01) VALUE ','. DTSBX331 00248 10 X331B-TRAN PIC X(02). DTSBX331 00249 10 FILLER PIC X(01) VALUE ','. DTSBX331 00250 10 X331B-ROW PIC X(02). DTSBX331 00251 10 FILLER PIC X(01) VALUE ','. DTSBX331 00252 10 X331B-COL PIC X(02). DTSBX331 00253 10 FILLER PIC X(01) VALUE ','. DTSBX331 00254 10 X331B-AMT PIC --------9.99. DTSBX331 00255 10 FILLER PIC X(01) VALUE ','. DTSBX331 00256 10 X331B-CAT PIC X(01). DTSBX331 00257 DTSBX331 00258 05 WRK-X331C-REC. DTSBX331 00259 10 X331C-SEQ PIC 9(06). DTSBX331 00260 10 FILLER PIC X(01) VALUE ','. DTSBX331 00261 10 X331C-BATCH PIC 9(05). DTSBX331 00262 10 FILLER PIC X(01) VALUE ','. DTSBX331 00263 10 X331C-ITEM PIC 9(03). DTSBX331 00264 10 FILLER PIC X(01) VALUE ','. DTSBX331 00265 10 X331C-TRANS PIC X(02). DTSBX331 00266 10 FILLER PIC X(01) VALUE ','. DTSBX331 00267 10 X331C-EMP-NO PIC 9(06). DTSBX331 00268 10 FILLER PIC X(01) VALUE ','. DTSBX331 00269 10 X331C-YRQ PIC X(06). DTSBX331 00270 10 FILLER PIC X(01) VALUE ','. DTSBX331 00271 10 X331C-AMT PIC --------9.99. DTSBX331 00272 10 FILLER PIC X(01) VALUE ','. DTSBX331 00273 10 X331C-TAX-WAGE PIC --------9.99. DTSBX331 00274 10 X331C-TAX-WAGE-X REDEFINES X331C-TAX-WAGE DTSBX331 00275 PIC X(12). DTSBX331 00276 10 FILLER PIC X(01) VALUE ','. DTSBX331 00277 10 X331C-RATE PIC Z9.9. DTSBX331 00278 10 X331C-RATE-X REDEFINES X331C-RATE DTSBX331 00279 PIC X(04). DTSBX331 00280 10 FILLER PIC X(01) VALUE ','. DTSBX331 00281 10 X331C-ACCT PIC X(02). DTSBX331 00282 10 FILLER PIC X(01) VALUE ','. DTSBX331 00283 10 X331C-EMP-CLASS PIC X(01). DTSBX331 00284 10 FILLER PIC X(01) VALUE ','. DTSBX331 00285 10 X331C-CAT PIC X(01). DTSBX331 00286 DTSBX331 00287 05 WRK-DISP-EMP PIC S9(07) COMP-3 DTSBX331 00288 VALUE +010169. DTSBX331 00289 DTSBX331 00290 05 DISPLAY-CNT PIC Z(06)9. DTSBX331 00291 05 DISPLAY-AMT-X PIC X(15). DTSBX331 00292 05 DISPLAY-AMT REDEFINES DISPLAY-AMT-X DTSBX331 00293 PIC ZZZ,ZZZ,ZZ9.99-. DTSBX331 00294 05 DISPLAY-AMT1-X PIC X(15). DTSBX331 00295 05 DISPLAY-AMT1 REDEFINES DISPLAY-AMT1-X DTSBX331 00296 PIC ZZZ,ZZZ,ZZ9.99-. DTSBX331 00297 EJECT DTSBX331 00298 01 L001-LINK-AREA. DTSBX331 00299 ++INCLUDE DTSIL001 DTSBX331 00300 DTSBX331 00301 01 L004-LINK-AREA. DTSBX331 00302 ++INCLUDE DTSIL004 DTSBX331 00303 DTSBX331 00304 01 L910-LINK-AREA. DTSBX331 00305 ++INCLUDE DTSIL910 DTSBX331 00306 SKIP3 DTSBX331 00307 01 MSKL-REC. DTSBX331 00308 ++INCLUDE DTSIMSKL DTSBX331 00309 SKIP3 DTSBX331 00310 01 MJRN-REC. DTSBX331 00311 ++INCLUDE DTSIMJRN DTSBX331 00312 DTSBX331 00313 01 MRPT-REC. DTSBX331 00314 ++INCLUDE DTSIMRPT DTSBX331 00315 DTSBX331 00316 01 MPAY-REC. DTSBX331 00317 ++INCLUDE DTSIMPAY DTSBX331 00318 DTSBX331 00319 01 MADJ-REC. DTSBX331 00320 ++INCLUDE DTSIMADJ DTSBX331 00321 DTSBX331 00322 PROCEDURE DIVISION. DTSBX331 00323 DTSBX331 00324 PERFORM I0000-INITIALIZE THRU I0000-EXIT. DTSBX331 00325 DTSBX331 00326 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBX331 00327 UNTIL X331-STATUS-EOF-88. DTSBX331 00328 DTSBX331 00329 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBX331 00330 SKIP2 DTSBX331 00331 GOBACK. DTSBX331 00332 EJECT DTSBX331 00333 I0000-INITIALIZE. DTSBX331 00334 MOVE +0 TO QTR-SUB. DTSBX331 00335 DTSBX331 00336 OPEN INPUT X331-FILE DTSBX331 00337 IF NOT X331-STATUS-OK-88 DTSBX331 00338 DISPLAY 'X331 FILE STATUS IS : ' X331-STATUS DTSBX331 00339 MOVE 'CANNOT OPEN INPUT FILE ' TO ABEND-MSG DTSBX331 00340 PERFORM S999-ABEND THRU S999-EXIT DTSBX331 00341 END-IF. DTSBX331 00342 DTSBX331 00343 OPEN OUTPUT X331A-SUMMARY DTSBX331 00344 IF NOT X331A-STATUS-OK-88 DTSBX331 00345 DISPLAY 'X331A FILE STATUS IS : ' X331A-STATUS DTSBX331 00346 MOVE 'CANNOT OPEN X331A SUMMARY FILE ' TO ABEND-MSG DTSBX331 00347 PERFORM S999-ABEND THRU S999-EXIT DTSBX331 00348 END-IF. DTSBX331 00349 DTSBX331 00350 OPEN OUTPUT X331B-DETAIL DTSBX331 00351 IF NOT X331B-STATUS-OK-88 DTSBX331 00352 DISPLAY 'X331B FILE STATUS IS : ' X331B-STATUS DTSBX331 00353 MOVE 'CANNOT OPEN X331B DETAIL FILE ' TO ABEND-MSG DTSBX331 00354 PERFORM S999-ABEND THRU S999-EXIT DTSBX331 00355 END-IF. DTSBX331 00356 DTSBX331 00357 OPEN OUTPUT X331C-TRAN DTSBX331 00358 IF NOT X331C-STATUS-OK-88 DTSBX331 00359 DISPLAY 'X331C FILE STATUS IS : ' X331C-STATUS DTSBX331 00360 MOVE 'CANNOT OPEN X331C TRAN FILE ' TO ABEND-MSG DTSBX331 00361 PERFORM S999-ABEND THRU S999-EXIT DTSBX331 00362 END-IF. DTSBX331 00363 DTSBX331 00364 OPEN INPUT BE330-PARM-FILE DTSBX331 00365 IF NOT PARM-STATUS-OK-88 DTSBX331 00366 DISPLAY 'PARM FILE STATUS IS : ' PARM-STATUS DTSBX331 00367 MOVE 'CANNOT OPEN PARM FILE ' TO ABEND-MSG DTSBX331 00368 PERFORM S999-ABEND THRU S999-EXIT DTSBX331 00369 END-IF. DTSBX331 00370 DTSBX331 00371 READ BE330-PARM-FILE DTSBX331 00372 IF PARM-STATUS-OK-88 DTSBX331 00373 MOVE BE330-PARM-REC TO WRK-SUBJECT-DATE DTSBX331 00374 DISPLAY 'SUBJECT DATE ' WRK-SUBJECT-DATE DTSBX331 00375 ELSE DTSBX331 00376 DISPLAY 'PARM FILE STATUS IS : ' PARM-STATUS DTSBX331 00377 MOVE 'CANNOT READ PARM FILE ' TO ABEND-MSG DTSBX331 00378 PERFORM S999-ABEND THRU S999-EXIT DTSBX331 00379 END-IF. DTSBX331 00380 DTSBX331 00381 CLOSE BE330-PARM-FILE. DTSBX331 00382 DTSBX331 00383 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBX331 00384 DTSBX331 00385 I0000-EXIT. DTSBX331 00386 EXIT. DTSBX331 00387 DTSBX331 00388 P0000-PROCESS. DTSBX331 00389 READ X331-FILE. DTSBX331 00390 IF X331-STATUS-EOF-88 DTSBX331 00391 GO TO P0000-EXIT DTSBX331 00392 ELSE DTSBX331 00393 IF NOT X331-STATUS-OK-88 DTSBX331 00394 DISPLAY 'BAD READ: ' X331-STATUS DTSBX331 00395 SET X331-STATUS-EOF-88 TO TRUE DTSBX331 00396 GO TO P0000-EXIT DTSBX331 00397 END-IF DTSBX331 00398 END-IF. DTSBX331 00399 DTSBX331 00400 IF WRK-EMP-NO = ZERO DTSBX331 00401 PERFORM P1300-INIT-TABLES THRU P1300-EXIT DTSBX331 00402 PERFORM P1000-BUILD-QTR-TABLE THRU P1000-EXIT DTSBX331 00403 ELSE DTSBX331 00404 IF X331-EMP-NO = WRK-EMP-NO DTSBX331 00405 AND X331-YRQ = WRK-YRQ DTSBX331 00406 PERFORM P1000-BUILD-QTR-TABLE THRU P1000-EXIT DTSBX331 00407 ELSE DTSBX331 00408 PERFORM P5000-WRITE-OUTPUT THRU P5000-EXIT DTSBX331 00409 PERFORM P1300-INIT-TABLES THRU P1300-EXIT DTSBX331 00410 PERFORM P1000-BUILD-QTR-TABLE THRU P1000-EXIT DTSBX331 00411 END-IF DTSBX331 00412 END-IF. DTSBX331 00413 DTSBX331 00414 P0000-EXIT. DTSBX331 00415 EXIT. DTSBX331 00416 DTSBX331 00417 DTSBX331 00418 P1000-BUILD-QTR-TABLE. DTSBX331 00419 IF QTR-SUB < QTR-MAX DTSBX331 00420 ADD +1 TO QTR-SUB DTSBX331 00421 QTR-LAST DTSBX331 00422 ELSE DTSBX331 00423 MOVE 'RECEIVABLE TABLE LENGTH EXCEEDED' DTSBX331 00424 TO ABEND-MSG DTSBX331 00425 PERFORM S999-ABEND THRU S999-EXIT. DTSBX331 00426 DTSBX331 00427 MOVE X331-BATCH-NO TO QTR-BATCH-NO (QTR-SUB). DTSBX331 00428 MOVE X331-ITEM-NO TO QTR-ITEM-NO (QTR-SUB). DTSBX331 00429 MOVE X331-TRAN-TYPE TO QTR-TRAN-TYPE (QTR-SUB). DTSBX331 00430 ADD X331-AMT TO QTR-AMT (QTR-SUB). DTSBX331 00431 ADD X331-ESTB-DATE TO QTR-ESTB-DATE (QTR-SUB). DTSBX331 00432 DTSBX331 00433 P1000-EXIT. DTSBX331 00434 EXIT. DTSBX331 00435 DTSBX331 00436 P1300-INIT-TABLES. DTSBX331 00437 MOVE X331-EMP-NO TO WRK-EMP-NO. DTSBX331 00438 MOVE X331-YRQ TO WRK-YRQ. DTSBX331 00439 MOVE X331-EMP-CLASS TO WRK-EMP-CLASS. DTSBX331 00440 MOVE X331-TRAN-CATEGORY TO WRK-TRAN-CAT. DTSBX331 00441 DTSBX331 00442 PERFORM DTSBX331 00443 VARYING QTR-SUB FROM +1 BY +1 DTSBX331 00444 UNTIL QTR-SUB > QTR-MAX DTSBX331 00445 MOVE +0 TO QTR-BATCH-NO (QTR-SUB) DTSBX331 00446 QTR-ITEM-NO (QTR-SUB) DTSBX331 00447 QTR-AMT (QTR-SUB) DTSBX331 00448 QTR-ESTB-DATE (QTR-SUB) DTSBX331 00449 MOVE SPACES TO QTR-TRAN-TYPE (QTR-SUB) DTSBX331 00450 END-PERFORM. DTSBX331 00451 DTSBX331 00452 MOVE +0 TO QTR-SUB DTSBX331 00453 QTR-LAST. DTSBX331 00454 DTSBX331 00455 P1300-EXIT. DTSBX331 00456 EXIT. DTSBX331 00457 DTSBX331 00458 DTSBX331 00459 P5000-WRITE-OUTPUT. DTSBX331 00460 MOVE ZERO TO WRK-QTR-BAL DTSBX331 00461 WRK-BATCH-NO DTSBX331 00462 WRK-ITEM-NO. DTSBX331 00463 MOVE SPACES TO WRK-TRAN-TYPE. DTSBX331 00464 DTSBX331 00465 PERFORM DTSBX331 00466 VARYING QTR-SUB FROM +1 BY +1 DTSBX331 00467 UNTIL QTR-SUB > QTR-LAST DTSBX331 00468 ADD QTR-AMT (QTR-SUB) TO WRK-QTR-BAL DTSBX331 00469 END-PERFORM. DTSBX331 00470 DTSBX331 00471 IF WRK-QTR-BAL > ZERO DTSBX331 00472 PERFORM DTSBX331 00473 VARYING QTR-SUB FROM +1 BY +1 DTSBX331 00474 UNTIL QTR-SUB > QTR-LAST DTSBX331 00475 PERFORM P5100-WRITE-X331 THRU P5100-EXIT DTSBX331 00476 END-PERFORM DTSBX331 00477 END-IF. DTSBX331 00478 DTSBX331 00479 P5000-EXIT. DTSBX331 00480 EXIT. DTSBX331 00481 DTSBX331 00482 P5100-WRITE-X331. DTSBX331 00483 PERFORM P5110-WRITE-SUMMARY THRU P5110-EXIT. DTSBX331 00484 PERFORM P5120-WRITE-DETAIL THRU P5120-EXIT. DTSBX331 00485 PERFORM P5130-WRITE-TRAN THRU P5130-EXIT. DTSBX331 00486 DTSBX331 00487 P5100-EXIT. DTSBX331 00488 EXIT. DTSBX331 00489 DTSBX331 00490 P5110-WRITE-SUMMARY. DTSBX331 00491 ADD +1 TO WRK-SEQ-A. DTSBX331 00492 MOVE WRK-SEQ-A TO X331A-SEQ. DTSBX331 00493 MOVE QTR-ESTB-DATE (QTR-SUB) TO L001-FED-8-DATE-9. DTSBX331 00494 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX331 00495 MOVE L001-SLASH-8-DATE TO X331A-ESTB-DATE. DTSBX331 00496 MOVE WRK-EMP-NO TO X331A-EMP-NO. DTSBX331 00497 IF WRK-YRQ < +99999 DTSBX331 00498 MOVE 'DEBIT ' TO X331A-CREDIT-DEBIT DTSBX331 00499 ELSE DTSBX331 00500 MOVE 'CREDIT' TO X331A-CREDIT-DEBIT DTSBX331 00501 END-IF. DTSBX331 00502 MOVE QTR-BATCH-NO (QTR-SUB) TO X331A-BATCH. DTSBX331 00503 MOVE QTR-ITEM-NO (QTR-SUB) TO X331A-ITEM. DTSBX331 00504 MOVE QTR-TRAN-TYPE (QTR-SUB) TO X331A-TRAN. DTSBX331 00505 MOVE QTR-AMT(QTR-SUB) TO X331A-AMT. DTSBX331 00506 IF WRK-YRQ < +99999 DTSBX331 00507 MOVE WRK-YRQ TO L004-QTR-5-9 DTSBX331 00508 PERFORM S004-FROM-5 THRU S004-EXIT DTSBX331 00509 MOVE L004-SLASH-5-QTR TO X331A-YRQ DTSBX331 00510 ELSE DTSBX331 00511 MOVE SPACES TO X331A-YRQ. DTSBX331 00512 MOVE WRK-EMP-CLASS TO X331A-EMP-CLASS. DTSBX331 00513 MOVE WRK-TRAN-CAT TO X331A-CAT. DTSBX331 00514 DTSBX331 00515 WRITE X331A-REC FROM WRK-X331A-REC. DTSBX331 00516 IF NOT X331A-STATUS-OK-88 DTSBX331 00517 DISPLAY 'CANNOT WRITE TO OUTPUT FILE ' X331A-STATUS DTSBX331 00518 ' ' X331A-EMP-NO DTSBX331 00519 ELSE DTSBX331 00520 ADD +1 TO WRK-X331A-CNT DTSBX331 00521 END-IF. DTSBX331 00522 DTSBX331 00523 IF WRK-EMP-NO = 010021 DTSBX331 00524 DISPLAY X331A-EMP-NO DTSBX331 00525 * ' ' X331A-AMT DTSBX331 00526 ' ' X331A-BATCH DTSBX331 00527 ' ' X331A-ITEM DTSBX331 00528 ' ' X331A-TRAN. DTSBX331 00529 DTSBX331 00530 P5110-EXIT. DTSBX331 00531 EXIT. DTSBX331 00532 DTSBX331 00533 P5120-WRITE-DETAIL. DTSBX331 00534 MOVE LOW-VALUES TO MJRN-KEY-AREA. DTSBX331 00535 MOVE WRK-EMP-NO TO MJRN-EMP-NO. DTSBX331 00536 SET MJRN-JRN-88 TO TRUE. DTSBX331 00537 MOVE MJRN-KEY-AREA TO MSKL-KEY-AREA. DTSBX331 00538 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX331 00539 PERFORM UNTIL L910-NO-REC-88 DTSBX331 00540 MOVE MSKL-REC TO MJRN-REC DTSBX331 00541 IF (MJRN-BATCH-NO = QTR-BATCH-NO (QTR-SUB) DTSBX331 00542 AND MJRN-ITEM-NO = QTR-ITEM-NO (QTR-SUB)) DTSBX331 00543 PERFORM P5121-WRITE THRU P5121-EXIT DTSBX331 00544 SET L910-NO-REC-88 TO TRUE DTSBX331 00545 END-IF DTSBX331 00546 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX331 00547 END-PERFORM. DTSBX331 00548 DTSBX331 00549 P5120-EXIT. DTSBX331 00550 EXIT. DTSBX331 00551 DTSBX331 00552 P5121-WRITE. DTSBX331 00553 PERFORM DTSBX331 00554 VARYING MJRN-OCC-IDX FROM +1 BY +1 DTSBX331 00555 UNTIL MJRN-OCC-IDX > MJRN-OCC-CNT DTSBX331 00556 ADD +1 TO WRK-SEQ-B DTSBX331 00557 MOVE WRK-SEQ-B TO X331B-SEQ DTSBX331 00558 MOVE MJRN-YRQ (MJRN-OCC-IDX) TO L004-QTR-5-9 DTSBX331 00559 PERFORM S004-FROM-5 THRU S004-EXIT DTSBX331 00560 MOVE L004-SLASH-5-QTR TO X331B-YRQ DTSBX331 00561 MOVE MJRN-EMP-NO TO X331B-EMP-NO DTSBX331 00562 MOVE MJRN-EMP-CLASS TO X331B-EMP-CLASS DTSBX331 00563 MOVE MJRN-BATCH-NO TO X331B-BATCH DTSBX331 00564 MOVE MJRN-ITEM-NO TO X331B-ITEM DTSBX331 00565 MOVE MJRN-TRAN-TYPE TO X331B-TRAN DTSBX331 00566 MOVE MJRN-ACCT-ROW (MJRN-OCC-IDX) DTSBX331 00567 TO X331B-ROW DTSBX331 00568 MOVE MJRN-ACCT-COL (MJRN-OCC-IDX) DTSBX331 00569 TO X331B-COL DTSBX331 00570 MOVE MJRN-AMT (MJRN-OCC-IDX) TO X331B-AMT DTSBX331 00571 MOVE WRK-TRAN-CAT TO X331B-CAT DTSBX331 00572 DTSBX331 00573 WRITE X331B-REC FROM WRK-X331B-REC DTSBX331 00574 IF NOT X331B-STATUS-OK-88 DTSBX331 00575 DISPLAY 'CANNOT WRITE TO OUTPUT FILE ' DTSBX331 00576 ' ' X331B-STATUS ' ' X331B-EMP-NO DTSBX331 00577 ELSE DTSBX331 00578 ADD +1 TO WRK-X331B-CNT DTSBX331 00579 END-IF DTSBX331 00580 END-PERFORM. DTSBX331 00581 DTSBX331 00582 P5121-EXIT. DTSBX331 00583 EXIT. DTSBX331 00584 DTSBX331 00585 P5130-WRITE-TRAN. DTSBX331 00586 IF WRK-TRAN-CAT = 'R' DTSBX331 00587 ** IF X331A-TRAN = 'OR' OR 'AU' OR 'EA' OR 'AC' OR 'FS' DTSBX331 00588 ** OR 'ES' OR 'WD' DTSBX331 00589 PERFORM P5131-REPORT THRU P5131-EXIT DTSBX331 00590 ELSE DTSBX331 00591 IF WRK-TRAN-CAT = 'P' DTSBX331 00592 ** IF X331A-TRAN = 'PA' OR 'PR' OR 'RF' OR 'RR' OR 'NG' DTSBX331 00593 PERFORM P5132-PAYMENT THRU P5132-EXIT DTSBX331 00594 ELSE DTSBX331 00595 IF WRK-TRAN-CAT = 'A' DTSBX331 00596 ** IF X331A-TRAN = 'CH' OR 'WV' OR 'TL' OR 'WO' OR 'WR' DTSBX331 00597 PERFORM P5133-ADJUSTMENT THRU P5133-EXIT DTSBX331 00598 END-IF DTSBX331 00599 END-IF DTSBX331 00600 END-IF. DTSBX331 00601 DTSBX331 00602 P5130-EXIT. DTSBX331 00603 EXIT. DTSBX331 00604 DTSBX331 00605 P5131-REPORT. DTSBX331 00606 SET WRK-RPT-FOUND-NO-88 TO TRUE. DTSBX331 00607 DTSBX331 00608 MOVE LOW-VALUES TO MRPT-KEY-AREA. DTSBX331 00609 MOVE WRK-EMP-NO TO MRPT-EMP-NO. DTSBX331 00610 IF WRK-YRQ < +99999 DTSBX331 00611 MOVE WRK-YRQ TO MRPT-YRQ DTSBX331 00612 MOVE X331A-BATCH TO MRPT-BATCH-NO DTSBX331 00613 MOVE X331A-ITEM TO MRPT-ITEM-NO DTSBX331 00614 END-IF. DTSBX331 00615 SET MRPT-RPT-88 TO TRUE. DTSBX331 00616 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. DTSBX331 00617 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX331 00618 IF L910-NO-REC-88 DTSBX331 00619 GO TO P5131-EXIT DTSBX331 00620 ELSE DTSBX331 00621 PERFORM DTSBX331 00622 UNTIL L910-NO-REC-88 OR WRK-RPT-FOUND-YES-88 DTSBX331 00623 MOVE MSKL-REC TO MRPT-REC DTSBX331 00624 IF (MRPT-BATCH-NO = X331A-BATCH DTSBX331 00625 AND MRPT-ITEM-NO = X331A-ITEM) DTSBX331 00626 SET WRK-RPT-FOUND-YES-88 TO TRUE DTSBX331 00627 ELSE DTSBX331 00628 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX331 00629 END-IF DTSBX331 00630 END-PERFORM DTSBX331 00631 END-IF. DTSBX331 00632 DTSBX331 00633 IF WRK-RPT-FOUND-NO-88 DTSBX331 00634 GO TO P5131-EXIT DTSBX331 00635 END-IF. DTSBX331 00636 DTSBX331 00637 ADD +1 TO WRK-SEQ-C. DTSBX331 00638 MOVE WRK-SEQ-C TO X331C-SEQ. DTSBX331 00639 MOVE MRPT-RPT-TYPE TO X331C-TRANS. DTSBX331 00640 MOVE X331A-BATCH TO X331C-BATCH. DTSBX331 00641 MOVE X331A-ITEM TO X331C-ITEM. DTSBX331 00642 MOVE WRK-EMP-NO TO X331C-EMP-NO. DTSBX331 00643 MOVE MRPT-YRQ TO L004-QTR-5-9 DTSBX331 00644 PERFORM S004-FROM-5 THRU S004-EXIT DTSBX331 00645 MOVE L004-SLASH-5-QTR TO X331C-YRQ DTSBX331 00646 MOVE MRPT-REMIT-AMT TO X331C-AMT. DTSBX331 00647 MOVE MRPT-TAX-WAGE TO X331C-TAX-WAGE. DTSBX331 00648 COMPUTE WRK-RATE = (MRPT-UI-RATE * 100). DTSBX331 00649 MOVE WRK-RATE TO X331C-RATE. DTSBX331 00650 MOVE SPACES TO X331C-ACCT. DTSBX331 00651 MOVE WRK-EMP-CLASS TO X331C-EMP-CLASS. DTSBX331 00652 MOVE WRK-TRAN-CAT TO X331C-CAT. DTSBX331 00653 DTSBX331 00654 WRITE X331C-REC FROM WRK-X331C-REC DTSBX331 00655 IF NOT X331C-STATUS-OK-88 DTSBX331 00656 DISPLAY 'CANNOT WRITE TO X331C FILE ' DTSBX331 00657 ' ' X331C-STATUS ' ' X331C-EMP-NO DTSBX331 00658 ELSE DTSBX331 00659 ADD +1 TO WRK-X331C-CNT DTSBX331 00660 END-IF. DTSBX331 00661 DTSBX331 00662 P5131-EXIT. DTSBX331 00663 EXIT. DTSBX331 00664 DTSBX331 00665 P5132-PAYMENT. DTSBX331 00666 MOVE LOW-VALUES TO MPAY-KEY-AREA. DTSBX331 00667 MOVE WRK-EMP-NO TO MPAY-EMP-NO. DTSBX331 00668 MOVE QTR-BATCH-NO (QTR-SUB) TO MPAY-BATCH-NO. DTSBX331 00669 MOVE QTR-ITEM-NO (QTR-SUB) TO MPAY-ITEM-NO. DTSBX331 00670 SET MPAY-PAY-88 TO TRUE. DTSBX331 00671 MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA. DTSBX331 00672 PERFORM S910-READ THRU S910-EXIT. DTSBX331 00673 IF L910-NO-REC-88 DTSBX331 00674 GO TO P5132-EXIT DTSBX331 00675 ELSE DTSBX331 00676 MOVE MSKL-REC TO MPAY-REC DTSBX331 00677 END-IF. DTSBX331 00678 DTSBX331 00679 ADD +1 TO WRK-SEQ-C. DTSBX331 00680 MOVE WRK-SEQ-C TO X331C-SEQ. DTSBX331 00681 MOVE MPAY-PAY-TYPE TO X331C-TRANS. DTSBX331 00682 MOVE SPACES TO X331C-YRQ. DTSBX331 00683 MOVE WRK-EMP-NO TO X331C-EMP-NO. DTSBX331 00684 MOVE X331A-BATCH TO X331C-BATCH. DTSBX331 00685 MOVE X331A-ITEM TO X331C-ITEM. DTSBX331 00686 MOVE MPAY-REMIT-AMT TO X331C-AMT. DTSBX331 00687 MOVE SPACES TO X331C-TAX-WAGE-X. DTSBX331 00688 MOVE SPACES TO X331C-RATE-X. DTSBX331 00689 MOVE SPACES TO X331C-ACCT. DTSBX331 00690 MOVE WRK-EMP-CLASS TO X331C-EMP-CLASS. DTSBX331 00691 MOVE WRK-TRAN-CAT TO X331C-CAT. DTSBX331 00692 DTSBX331 00693 WRITE X331C-REC FROM WRK-X331C-REC DTSBX331 00694 IF NOT X331C-STATUS-OK-88 DTSBX331 00695 DISPLAY 'CANNOT WRITE TO X331C FILE ' DTSBX331 00696 ' ' X331C-STATUS ' ' X331C-EMP-NO DTSBX331 00697 ELSE DTSBX331 00698 ADD +1 TO WRK-X331C-CNT DTSBX331 00699 END-IF. DTSBX331 00700 DTSBX331 00701 P5132-EXIT. DTSBX331 00702 EXIT. DTSBX331 00703 DTSBX331 00704 P5133-ADJUSTMENT. DTSBX331 00705 MOVE LOW-VALUES TO MADJ-KEY-AREA. DTSBX331 00706 MOVE WRK-EMP-NO TO MADJ-EMP-NO. DTSBX331 00707 MOVE QTR-BATCH-NO (QTR-SUB) TO MADJ-BATCH-NO. DTSBX331 00708 MOVE QTR-ITEM-NO (QTR-SUB) TO MADJ-ITEM-NO. DTSBX331 00709 SET MADJ-ADJ-88 TO TRUE. DTSBX331 00710 MOVE MADJ-KEY-AREA TO MSKL-KEY-AREA. DTSBX331 00711 PERFORM S910-READ THRU S910-EXIT. DTSBX331 00712 IF L910-NO-REC-88 DTSBX331 00713 GO TO P5133-EXIT DTSBX331 00714 ELSE DTSBX331 00715 MOVE MSKL-REC TO MADJ-REC DTSBX331 00716 END-IF. DTSBX331 00717 DTSBX331 00718 ADD +1 TO WRK-SEQ-C. DTSBX331 00719 MOVE WRK-SEQ-C TO X331C-SEQ. DTSBX331 00720 MOVE MADJ-ADJ-TYPE TO X331C-TRANS. DTSBX331 00721 MOVE X331A-BATCH TO X331C-BATCH. DTSBX331 00722 MOVE X331A-ITEM TO X331C-ITEM. DTSBX331 00723 MOVE SPACES TO X331C-YRQ. DTSBX331 00724 MOVE WRK-EMP-NO TO X331C-EMP-NO. DTSBX331 00725 MOVE MADJ-AMT TO X331C-AMT. DTSBX331 00726 MOVE SPACES TO X331C-TAX-WAGE-X. DTSBX331 00727 MOVE SPACES TO X331C-RATE-X. DTSBX331 00728 MOVE MADJ-APPLIC-IND TO X331C-ACCT. DTSBX331 00729 MOVE WRK-EMP-CLASS TO X331C-EMP-CLASS. DTSBX331 00730 MOVE WRK-TRAN-CAT TO X331C-CAT. DTSBX331 00731 DTSBX331 00732 WRITE X331C-REC FROM WRK-X331C-REC DTSBX331 00733 IF NOT X331C-STATUS-OK-88 DTSBX331 00734 DISPLAY 'CANNOT WRITE TO X331C FILE ' DTSBX331 00735 ' ' X331C-STATUS ' ' X331C-EMP-NO DTSBX331 00736 ELSE DTSBX331 00737 ADD +1 TO WRK-X331C-CNT DTSBX331 00738 END-IF. DTSBX331 00739 DTSBX331 00740 P5133-EXIT. DTSBX331 00741 EXIT. DTSBX331 00742 DTSBX331 00743 T0000-TERMINATE. DTSBX331 00744 DTSBX331 00745 CLOSE X331-FILE DTSBX331 00746 X331A-SUMMARY DTSBX331 00747 X331B-DETAIL DTSBX331 00748 X331C-TRAN. DTSBX331 00749 DTSBX331 00750 DISPLAY ' '. DTSBX331 00751 DTSBX331 00752 DISPLAY '*** DTSBX331 TERMINATION STATISTICS ***'. DTSBX331 00753 DTSBX331 00754 DISPLAY ' '. DTSBX331 00755 MOVE WRK-X331A-CNT TO DISPLAY-CNT. DTSBX331 00756 DISPLAY 'X331A RECORDS WRITTEN : ' DTSBX331 00757 DISPLAY-CNT. DTSBX331 00758 MOVE WRK-X331B-CNT TO DISPLAY-CNT. DTSBX331 00759 DISPLAY 'X331B RECORDS WRITTEN : ' DTSBX331 00760 DISPLAY-CNT. DTSBX331 00761 MOVE WRK-X331C-CNT TO DISPLAY-CNT. DTSBX331 00762 DISPLAY 'X331C RECORDS WRITTEN : ' DTSBX331 00763 DISPLAY-CNT. DTSBX331 00764 DTSBX331 00765 T0000-EXIT. DTSBX331 00766 EXIT. DTSBX331 00767 DTSBX331 00768 S001-FROM-FED-8. DTSBX331 00769 SET L001-FROM-FED-8 TO TRUE. DTSBX331 00770 GO TO S001-DATE. DTSBX331 00771 DTSBX331 00772 S001-FROM-ABS-DAY. DTSBX331 00773 SET L001-FROM-ABS-DAY TO TRUE. DTSBX331 00774 GO TO S001-DATE. DTSBX331 00775 DTSBX331 00776 S001-FROM-CAL-6. DTSBX331 00777 SET L001-FROM-CAL-6 TO TRUE. DTSBX331 00778 GO TO S001-DATE. DTSBX331 00779 DTSBX331 00780 S001-DATE. DTSBX331 00781 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX331 00782 S001-EXIT. DTSBX331 00783 EXIT. DTSBX331 00784 SKIP3 DTSBX331 00785 S004-FROM-5. DTSBX331 00786 SET L004-FROM-5 TO TRUE. DTSBX331 00787 GO TO S004-QTR. DTSBX331 00788 DTSBX331 00789 S004-FROM-ABS. DTSBX331 00790 SET L004-FROM-ABS TO TRUE. DTSBX331 00791 GO TO S004-QTR. DTSBX331 00792 DTSBX331 00793 S004-FROM-3. DTSBX331 00794 SET L004-FROM-3 TO TRUE. DTSBX331 00795 GO TO S004-QTR. DTSBX331 00796 DTSBX331 00797 S004-FROM-DATE. DTSBX331 00798 SET L004-FROM-DATE TO TRUE. DTSBX331 00799 GO TO S004-QTR. DTSBX331 00800 DTSBX331 00801 S004-QTR. DTSBX331 00802 DTSBX331 00803 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX331 00804 DTSBX331 00805 S004-EXIT. DTSBX331 00806 EXIT. DTSBX331 00807 SKIP3 DTSBX331 00808 DTSBX331 00809 S910-OPEN-READ. DTSBX331 00810 SET L910-OPEN-READ-88 TO TRUE. DTSBX331 00811 GO TO S910-MSTR-IO. DTSBX331 00812 DTSBX331 00813 S910-READ. DTSBX331 00814 SET L910-READ-88 TO TRUE. DTSBX331 00815 GO TO S910-MSTR-IO. DTSBX331 00816 DTSBX331 00817 S910-START-BROWSE. DTSBX331 00818 SET L910-START-BROWSE-88 TO TRUE. DTSBX331 00819 GO TO S910-MSTR-IO. DTSBX331 00820 DTSBX331 00821 S910-READ-NEXT. DTSBX331 00822 SET L910-READ-NEXT-88 TO TRUE. DTSBX331 00823 GO TO S910-MSTR-IO. DTSBX331 00824 DTSBX331 00825 S910-CLOSE. DTSBX331 00826 SET L910-CLOSE-88 TO TRUE. DTSBX331 00827 GO TO S910-MSTR-IO. DTSBX331 00828 DTSBX331 00829 S910-MSTR-IO. DTSBX331 00830 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX331 00831 MSKL-REC. DTSBX331 00832 S910-EXIT. DTSBX331 00833 EXIT. DTSBX331 00834 DTSBX331 00835 S999-ABEND. DTSBX331 00836 DISPLAY '*** DTSBX331 ABENDING. ' DTSBX331 00837 ABEND-MSG. DTSBX331 00838 DTSBX331 00839 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX331 00840 S999-EXIT. DTSBX331 00841 EXIT. DTSBX331