00001 IDENTIFICATION DIVISION. 08/31/05 00002 PROGRAM-ID. DTSBX332. DTSBX332 00003 AUTHOR. TRW. LV001 00004 DATE-WRITTEN. NOVEMBER 2002. DTSBX332 00005 DATE-COMPILED. DTSBX332 00006 SKIP3 DTSBX332 00007 ***** DTSBX332 00008 * DTSBX332 00009 * DTSBX332 00010 * FUNCTION: BUILD REPORT RECORDS FOR COLLECTIONS REPORT: DTSBX332 00011 * RECEIVABLES OVER 120 DAYS OLD. DTSBX332 00012 * DTSBX332 00013 * DTSBX332 00014 * MODIFICATION LOG: DTSBX332 00015 * DTSBX332 00016 * 11/28/2002 INITIAL DEVELOPMENT. DTSBX332 00017 * REFERENCE: PROGRAMMER: GD DTSBX332 00018 * DTSBX332 00019 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX332 00020 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX332 00021 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBX332 00022 * DTSBX332 00023 * DTSBX332 00024 * DESCRIPTION: DTSBX332 00025 * DTSBX332 00026 * DTSBX332 00027 * INITIATION: DTSBX332 00028 * DTSBX332 00029 * OPEN DTSX774 DTSBX332 00030 * DTSBX332 00031 * DTSBX332 00032 * DTSBX332 00033 * PROCESSING: DTSBX332 00034 * DTSBX332 00035 * BUILD R332 REPORT RECORDS FROM DTSIX332 INPUT. DTSBX332 00036 * DTSBX332 00037 * DTSBX332 00038 * TERMINATION: DTSBX332 00039 * DTSBX332 00040 * DTSBX332 00041 * DTSBX332 00042 * RECORDS READ: DTSBX332 00043 * DTSBX332 00044 * MASTER: DTSBX332 00045 * DTSBX332 00046 * NONE DTSBX332 00047 * DTSBX332 00048 * ALTERNATE INDEX: DTSBX332 00049 * DTSBX332 00050 * NONE. DTSBX332 00051 * DTSBX332 00052 * DTSBX332 00053 * REFERENCE: DTSBX332 00054 * DTSBX332 00055 * DTSBX332 00056 * DTSBX332 00057 * RECORDS UPDATED: DTSBX332 00058 * DTSBX332 00059 * NONE DTSBX332 00060 * DTSBX332 00061 * DTSBX332 00062 * OUTPUT RECORDS WRITTEN: DTSBX332 00063 * DTSBX332 00064 * DTSBX332 00065 * DTSBX332 00066 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBX332 00067 * DTSBX332 00068 * NONE. DTSBX332 00069 * DTSBX332 00070 * DTSBX332 00071 * MODULES CALLED: DTSBX332 00072 * DTSBX332 00073 * DTSBU001 DATE EDIT/CONVERSION. DTSBX332 00074 * DTSBU004 QUARTER EDIT/CONVERSION. DTSBX332 00075 * DTSBX332 00076 * DTSBX332 00077 * DTSBX332 00078 ***** DTSBX332 00079 SKIP3 DTSBX332 00080 ENVIRONMENT DIVISION. DTSBX332 00081 INPUT-OUTPUT SECTION. DTSBX332 00082 FILE-CONTROL. DTSBX332 00083 SELECT X332-FILE ASSIGN TO DTSX332 DTSBX332 00084 FILE STATUS IS X332-STATUS. DTSBX332 00085 DTSBX332 00086 SELECT BE332-PARM-FILE ASSIGN TO BE332PRM DTSBX332 00087 FILE STATUS IS PARM-STATUS. DTSBX332 00088 DTSBX332 00089 *** SELECT X332-OUT-FILE ASSIGN TO X332OUT DTSBX332 00090 *** FILE STATUS IS X332-OUT-STATUS. DTSBX332 00091 EJECT DTSBX332 00092 DATA DIVISION. DTSBX332 00093 FILE SECTION. DTSBX332 00094 FD X332-FILE DTSBX332 00095 RECORDING MODE IS F DTSBX332 00096 LABEL RECORDS ARE STANDARD DTSBX332 00097 BLOCK CONTAINS 0 RECORDS. DTSBX332 00098 01 X332-REC. DTSBX332 00099 ++INCLUDE DTSIX332 DTSBX332 00100 DTSBX332 00101 FD BE332-PARM-FILE DTSBX332 00102 RECORDING MODE IS F DTSBX332 00103 LABEL RECORDS ARE STANDARD DTSBX332 00104 BLOCK CONTAINS 0 CHARACTERS. DTSBX332 00105 DTSBX332 00106 01 BE332-PARM-REC. DTSBX332 00107 05 BE332-PARM-START-DATE PIC S9(09) COMP-3. DTSBX332 00108 05 BE332-PARM-END-DATE PIC S9(09) COMP-3. DTSBX332 00109 05 BE332-PARM-UPDATE-IND PIC X(01). DTSBX332 00110 88 BE332-PARM-UPDATE-YES-88 VALUE 'Y'. DTSBX332 00111 88 BE332-PARM-UPDATE-NO-88 VALUE 'N'. DTSBX332 00112 DTSBX332 00113 *FD X332-OUT-FILE DTSBX332 00114 * RECORDING MODE IS F DTSBX332 00115 * LABEL RECORDS ARE STANDARD DTSBX332 00116 * BLOCK CONTAINS 0 CHARACTERS. DTSBX332 00117 * DTSBX332 00118 *01 X332-OUT-REC PIC X(26). DTSBX332 00119 DTSBX332 00120 WORKING-STORAGE SECTION. DTSBX332 001205 77 PAN-VALET PICTURE X(24) VALUE '001DTSBX332 08/31/05'. DTSBX332 00121 SKIP3 DTSBX332 00122 01 WRK-AREA. DTSBX332 00123 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +332.DTSBX332 00124 DTSBX332 00125 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBX332'.DTSBX332 00126 DTSBX332 00127 05 WRK-TRACE-IND PIC X(01) VALUE SPACE. DTSBX332 00128 DTSBX332 00129 05 ABEND-MSG PIC X(60). DTSBX332 00130 DTSBX332 00131 05 X332-STATUS PIC X(02) VALUE SPACES. DTSBX332 00132 88 X332-STATUS-OK-88 VALUE ZEROS. DTSBX332 00133 88 X332-STATUS-EOF-88 VALUE '10'. DTSBX332 00134 DTSBX332 00135 05 PARM-STATUS PIC X(02) VALUE SPACES. DTSBX332 00136 88 PARM-STATUS-OK-88 VALUE ZEROS. DTSBX332 00137 88 PARM-STATUS-EOF-88 VALUE '10'. DTSBX332 00138 DTSBX332 00139 05 WRK-PARM-UPDATE-IND PIC X(01). DTSBX332 00140 88 WRK-PARM-UPDATE-YES-88 VALUE 'Y'. DTSBX332 00141 88 WRK-PARM-UPDATE-NO-88 VALUE 'N'. DTSBX332 00142 DTSBX332 00143 05 WRK-MFAS-FOUND-IND PIC X(01) VALUE SPACES. DTSBX332 00144 88 WRK-MFAS-FOUND-YES-88 VALUE 'Y'. DTSBX332 00145 88 WRK-MFAS-FOUND-NO-88 VALUE 'N'. DTSBX332 00146 DTSBX332 00147 05 WRK-MFAS-EMP-NO PIC S9(07) COMP-3 DTSBX332 00148 VALUE +0. DTSBX332 00149 DTSBX332 00150 05 WRK-MFAS-ESTB-DATE PIC S9(09) COMP-3 DTSBX332 00151 VALUE +0. DTSBX332 00152 DTSBX332 00153 ** 05 X332-OUT-STATUS PIC X(02) VALUE SPACES. DTSBX332 00154 ** 88 X332-OUT-STATUS-OK-88 VALUE ZEROS. DTSBX332 00155 DTSBX332 00156 05 WRK-X332-REC. DTSBX332 00157 10 WRK-X332-EMP-NO PIC 9(06). DTSBX332 00158 10 FILLER PIC X(01) VALUE ','. DTSBX332 00159 10 WRK-X332-YRQ PIC X(06). DTSBX332 00160 10 FILLER PIC X(01) VALUE ','. DTSBX332 00161 * 10 WRK-X332-BATCH PIC 9(05). DTSBX332 00162 * 10 FILLER PIC X(01) VALUE ','. DTSBX332 00163 * 10 WRK-X332-ITEM PIC 9(03). DTSBX332 00164 * 10 FILLER PIC X(01) VALUE ','. DTSBX332 00165 * 10 WRK-X332-ESTB PIC X(10). DTSBX332 00166 * 10 FILLER PIC X(01) VALUE ','. DTSBX332 00167 * 10 WRK-X332-TRAN PIC X(02). DTSBX332 00168 * 10 FILLER PIC X(01) VALUE ','. DTSBX332 00169 10 WRK-X332-AMT PIC --------9.99. DTSBX332 00170 DTSBX332 00171 05 ALL-NINES-DATE PIC S9(09) COMP-3 DTSBX332 00172 VALUE +99999999. DTSBX332 00173 05 WRK-ALL-NINES-BAL PIC S9(09)V99 COMP-3 DTSBX332 00174 VALUE +99999999.99. DTSBX332 00175 05 WRK-END-DATE PIC S9(09) COMP-3 DTSBX332 00176 VALUE +0. DTSBX332 00177 05 WRK-START-DATE PIC S9(09) COMP-3 DTSBX332 00178 VALUE +0. DTSBX332 00179 05 WRK-ABSTIME PIC S9(15) COMP-3. DTSBX332 00180 05 WRK-EMP-NO PIC S9(07) COMP-3 DTSBX332 00181 VALUE +0. DTSBX332 00182 05 WRK-ASSIGN-NO PIC S9(09) COMP-3 DTSBX332 00183 VALUE +0. DTSBX332 00184 05 WRK-PRIMARY-NAME PIC X(40). DTSBX332 00185 05 WRK-FLD-REP-ID PIC X(02). DTSBX332 00186 DTSBX332 00187 05 WRK-YRQ PIC S9(05) COMP-3 DTSBX332 00188 VALUE +0. DTSBX332 00189 05 WRK-TRAN-TYPE PIC X(02). DTSBX332 00190 DTSBX332 00191 05 WRK-QTR-BAL PIC S9(11)V99 COMP-3 DTSBX332 00192 VALUE +0. DTSBX332 00193 05 PREV-QTR-BAL PIC S9(11)V99 COMP-3 DTSBX332 00194 VALUE +0. DTSBX332 00195 DTSBX332 00196 05 WRK-REC-AREA PIC X(155). DTSBX332 00197 DTSBX332 00198 ******************************************************************DTSBX332 00199 * THE RECEIVABLE TABLE CONTAINS ONE ENTRY FOR EACH RECEIVABLE DTSBX332 00200 * FOR A GIVEN EMPLOYER/QUARTER. THE PROCESSED DATE, RECEIVED DTSBX332 00201 * DATE AND AMOUNT COME FROM THE DTSIY774 RECORD. THE OTHER DTSBX332 00202 * FIELDS ARE CALCULATED. THE START BALANCE IS THE RECEIVABLE DTSBX332 00203 * BALANCE DUE BEFORE APPLYING ANY REPORT QUARTER LIQUIDATIONS. DTSBX332 00204 * THE END BALANCE IS THE RECEIVABLE BALANCE DUE AFTER APPLYING DTSBX332 00205 * ANY REPORT QUARTER LIQUIDATIONS. DTSBX332 00206 ******************************************************************DTSBX332 00207 05 QTR-SUB PIC S9(04) COMP VALUE +0. DTSBX332 00208 05 QTR-LAST PIC S9(04) COMP VALUE +0. DTSBX332 00209 05 QTR-MAX PIC S9(04) COMP VALUE +200. DTSBX332 00210 05 QTR-TABLE OCCURS 200 TIMES. DTSBX332 00211 10 QTR-ESTB-DATE PIC S9(09) COMP-3. DTSBX332 00212 10 QTR-BATCH-NO PIC S9(05) COMP-3. DTSBX332 00213 10 QTR-ITEM-NO PIC S9(03) COMP-3. DTSBX332 00214 10 QTR-TRAN-TYPE PIC X(02). DTSBX332 00215 10 QTR-AMT PIC S9(09)V99 COMP-3. DTSBX332 00216 10 QTR-FIRST-RCVBL PIC X(01). DTSBX332 00217 88 QTR-FIRST-RCVBL-YES-88 VALUE 'Y'. DTSBX332 00218 88 QTR-FIRST-RCVBL-NO-88 VALUE 'N'. DTSBX332 00219 DTSBX332 00220 05 WRK-RCVBL-FOUND-IND PIC X(01) VALUE SPACES. DTSBX332 00221 88 WRK-RCVBL-FOUND-YES-88 VALUE 'Y'. DTSBX332 00222 88 WRK-RCVBL-FOUND-NO-88 VALUE 'N'. DTSBX332 00223 DTSBX332 00224 05 WRK-ESTB-DATE PIC S9(09) COMP-3. DTSBX332 00225 05 WRK-BATCH-NO PIC S9(05) COMP-3. DTSBX332 00226 05 WRK-ITEM-NO PIC S9(03) COMP-3. DTSBX332 00227 DTSBX332 00228 05 WRK-EVENT-TXT PIC X(50) VALUE DTSBX332 00229 'FLD ASSIGN CREATED: RCVBL OVER 120 DAYS OLD'. DTSBX332 00230 DTSBX332 00231 05 WRK-R332-CNT PIC S9(07) COMP-3 DTSBX332 00232 VALUE +0. DTSBX332 00233 05 WRK-X332-CNT PIC S9(07) COMP-3 DTSBX332 00234 VALUE +0. DTSBX332 00235 DTSBX332 00236 05 WRK-DISP-EMP PIC S9(07) COMP-3 DTSBX332 00237 VALUE +010169. DTSBX332 00238 DTSBX332 00239 05 DISPLAY-CNT PIC Z(06)9. DTSBX332 00240 05 DISPLAY-AMT-X PIC X(15). DTSBX332 00241 05 DISPLAY-AMT REDEFINES DISPLAY-AMT-X DTSBX332 00242 PIC ZZZ,ZZZ,ZZ9.99-. DTSBX332 00243 05 DISPLAY-AMT1-X PIC X(15). DTSBX332 00244 05 DISPLAY-AMT1 REDEFINES DISPLAY-AMT1-X DTSBX332 00245 PIC ZZZ,ZZZ,ZZ9.99-. DTSBX332 00246 EJECT DTSBX332 00247 01 L001-LINK-AREA. DTSBX332 00248 ++INCLUDE DTSIL001 DTSBX332 00249 DTSBX332 00250 01 L004-LINK-AREA. DTSBX332 00251 ++INCLUDE DTSIL004 DTSBX332 00252 DTSBX332 00253 01 L005-LINK-AREA. DTSBX332 00254 ++INCLUDE DTSIL005 DTSBX332 00255 DTSBX332 00256 01 L910-LINK-AREA. DTSBX332 00257 ++INCLUDE DTSIL910 DTSBX332 00258 SKIP3 DTSBX332 00259 01 MSKL-REC. DTSBX332 00260 ++INCLUDE DTSIMSKL DTSBX332 00261 DTSBX332 00262 01 MHDR-REC. DTSBX332 00263 ++INCLUDE DTSIMHDR DTSBX332 00264 DTSBX332 00265 01 MPRF-REC. DTSBX332 00266 ++INCLUDE DTSIMPRF DTSBX332 00267 DTSBX332 00268 01 MFAS-REC. DTSBX332 00269 ++INCLUDE DTSIMFAS DTSBX332 00270 DTSBX332 00271 01 MEVL-REC. DTSBX332 00272 ++INCLUDE DTSIMEVL DTSBX332 00273 DTSBX332 00274 01 L921-LINK-AREA. DTSBX332 00275 ++INCLUDE DTSIL921 DTSBX332 00276 DTSBX332 00277 01 ISKL-REC. DTSBX332 00278 ++INCLUDE DTSIISKL DTSBX332 00279 DTSBX332 00280 01 R332-REC. DTSBX332 00281 ++INCLUDE DTSIR332 DTSBX332 00282 DTSBX332 00283 SKIP3 DTSBX332 00284 PROCEDURE DIVISION. DTSBX332 00285 DTSBX332 00286 PERFORM I0000-INITIALIZE THRU I0000-EXIT. DTSBX332 00287 DTSBX332 00288 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBX332 00289 UNTIL X332-STATUS-EOF-88. DTSBX332 00290 DTSBX332 00291 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBX332 00292 SKIP2 DTSBX332 00293 GOBACK. DTSBX332 00294 EJECT DTSBX332 00295 I0000-INITIALIZE. DTSBX332 00296 MOVE +0 TO QTR-SUB DTSBX332 00297 WRK-MFAS-EMP-NO. DTSBX332 00298 DTSBX332 00299 MOVE LENGTH OF R332-REC TO R332-LENGTH. DTSBX332 00300 MOVE '332' TO R332-REC-TYPE. DTSBX332 00301 DTSBX332 00302 SET L005-FROM-SYS TO TRUE. DTSBX332 00303 PERFORM S005-CONVERT-TIME THRU S005-EXIT. DTSBX332 00304 MOVE L005-ABSTIME TO WRK-ABSTIME. DTSBX332 00305 DTSBX332 00306 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBX332 00307 DTSBX332 00308 PERFORM I3000-ASSIGN-NBR THRU I3000-EXIT. DTSBX332 00309 DTSBX332 00310 I0000-EXIT. DTSBX332 00311 EXIT. DTSBX332 00312 DTSBX332 00313 I2000-OPEN-FILES. DTSBX332 00314 MOVE WRK-TRACE-IND TO L910-TRACE-IND DTSBX332 00315 L921-TRACE-IND. DTSBX332 00316 DTSBX332 00317 MOVE WRK-MOD-NAME TO L910-MOD-NAME DTSBX332 00318 L921-MOD-NAME. DTSBX332 00319 DTSBX332 00320 OPEN INPUT X332-FILE DTSBX332 00321 IF NOT X332-STATUS-OK-88 DTSBX332 00322 DISPLAY 'X332 FILE STATUS IS : ' X332-STATUS DTSBX332 00323 MOVE 'CANNOT OPEN OUTPUT FILE ' TO ABEND-MSG DTSBX332 00324 PERFORM S999-ABEND THRU S999-EXIT DTSBX332 00325 END-IF. DTSBX332 00326 DTSBX332 00327 OPEN INPUT BE332-PARM-FILE DTSBX332 00328 IF NOT PARM-STATUS-OK-88 DTSBX332 00329 DISPLAY 'PARM FILE STATUS IS : ' PARM-STATUS DTSBX332 00330 MOVE 'CANNOT OPEN PARM FILE ' TO ABEND-MSG DTSBX332 00331 PERFORM S999-ABEND THRU S999-EXIT DTSBX332 00332 END-IF. DTSBX332 00333 DTSBX332 00334 READ BE332-PARM-FILE DTSBX332 00335 IF PARM-STATUS-OK-88 DTSBX332 00336 MOVE BE332-PARM-START-DATE TO WRK-START-DATE DTSBX332 00337 MOVE BE332-PARM-END-DATE TO WRK-END-DATE DTSBX332 00338 MOVE BE332-PARM-UPDATE-IND TO WRK-PARM-UPDATE-IND DTSBX332 00339 DISPLAY 'START DATE ' WRK-START-DATE DTSBX332 00340 DISPLAY 'END DATE ' WRK-END-DATE DTSBX332 00341 DISPLAY 'UPDATE ' WRK-PARM-UPDATE-IND DTSBX332 00342 ELSE DTSBX332 00343 DISPLAY 'PARM FILE STATUS IS : ' PARM-STATUS DTSBX332 00344 MOVE 'CANNOT READ PARM FILE ' TO ABEND-MSG DTSBX332 00345 PERFORM S999-ABEND THRU S999-EXIT DTSBX332 00346 END-IF. DTSBX332 00347 DTSBX332 00348 CLOSE BE332-PARM-FILE. DTSBX332 00349 DTSBX332 00350 IF WRK-PARM-UPDATE-YES-88 DTSBX332 00351 PERFORM S910-OPEN-UPDATE THRU S910-EXIT DTSBX332 00352 PERFORM S921-OPEN-UPDATE THRU S921-EXIT DTSBX332 00353 ELSE DTSBX332 00354 PERFORM S910-OPEN-READ THRU S910-EXIT DTSBX332 00355 PERFORM S921-OPEN-READ THRU S921-EXIT DTSBX332 00356 END-IF. DTSBX332 00357 DTSBX332 00358 * OPEN OUTPUT X332-OUT-FILE. DTSBX332 00359 * IF NOT X332-OUT-STATUS-OK-88 DTSBX332 00360 * DISPLAY 'X332 OUT FILE STATUS IS : ' X332-OUT-STATUS DTSBX332 00361 * MOVE 'CANNOT OPEN OUTPUT FILE ' TO ABEND-MSG DTSBX332 00362 * PERFORM S999-ABEND THRU S999-EXIT DTSBX332 00363 * END-IF. DTSBX332 00364 DTSBX332 00365 DTSBX332 00366 I2000-EXIT. DTSBX332 00367 EXIT. DTSBX332 00368 DTSBX332 00369 I3000-ASSIGN-NBR. DTSBX332 00370 MOVE LOW-VALUES TO MHDR-KEY-AREA. DTSBX332 00371 MOVE +0 TO MHDR-EMP-NO. DTSBX332 00372 SET MHDR-HDR-88 TO TRUE. DTSBX332 00373 MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA. DTSBX332 00374 DTSBX332 00375 PERFORM S910-READ THRU S910-EXIT. DTSBX332 00376 DTSBX332 00377 IF L910-NO-REC-88 DTSBX332 00378 MOVE 'MHDR RECORD NOT FOUND (I0000)' DTSBX332 00379 TO ABEND-MSG DTSBX332 00380 PERFORM S999-ABEND THRU S999-EXIT. DTSBX332 00381 DTSBX332 00382 MOVE MSKL-REC TO MHDR-REC. DTSBX332 00383 DTSBX332 00384 MOVE MHDR-LAST-USED-ASSIGN-NO TO WRK-ASSIGN-NO. DTSBX332 00385 DTSBX332 00386 I3000-EXIT. DTSBX332 00387 EXIT. DTSBX332 00388 DTSBX332 00389 P0000-PROCESS. DTSBX332 00390 READ X332-FILE. DTSBX332 00391 IF X332-STATUS-EOF-88 DTSBX332 00392 GO TO P0000-EXIT DTSBX332 00393 ELSE DTSBX332 00394 IF NOT X332-STATUS-OK-88 DTSBX332 00395 DISPLAY 'BAD READ: ' X332-STATUS DTSBX332 00396 SET X332-STATUS-EOF-88 TO TRUE DTSBX332 00397 GO TO P0000-EXIT DTSBX332 00398 END-IF DTSBX332 00399 END-IF. DTSBX332 00400 DTSBX332 00401 IF WRK-EMP-NO = ZERO DTSBX332 00402 PERFORM P1300-INIT-TABLES THRU P1300-EXIT DTSBX332 00403 PERFORM P1000-BUILD-QTR-TABLE THRU P1000-EXIT DTSBX332 00404 ELSE DTSBX332 00405 IF X332-EMP-NO = WRK-EMP-NO DTSBX332 00406 AND X332-YRQ = WRK-YRQ DTSBX332 00407 PERFORM P1000-BUILD-QTR-TABLE THRU P1000-EXIT DTSBX332 00408 ELSE DTSBX332 00409 PERFORM P5000-WRITE-OUTPUT THRU P5000-EXIT DTSBX332 00410 PERFORM P1300-INIT-TABLES THRU P1300-EXIT DTSBX332 00411 PERFORM P1000-BUILD-QTR-TABLE THRU P1000-EXIT DTSBX332 00412 END-IF DTSBX332 00413 END-IF. DTSBX332 00414 DTSBX332 00415 P0000-EXIT. DTSBX332 00416 EXIT. DTSBX332 00417 DTSBX332 00418 DTSBX332 00419 P1000-BUILD-QTR-TABLE. DTSBX332 00420 IF QTR-SUB < QTR-MAX DTSBX332 00421 ADD +1 TO QTR-SUB DTSBX332 00422 QTR-LAST DTSBX332 00423 ELSE DTSBX332 00424 MOVE 'RECEIVABLE TABLE LENGTH EXCEEDED' DTSBX332 00425 TO ABEND-MSG DTSBX332 00426 PERFORM S999-ABEND THRU S999-EXIT. DTSBX332 00427 DTSBX332 00428 MOVE X332-ESTB-DATE TO QTR-ESTB-DATE (QTR-SUB). DTSBX332 00429 MOVE X332-BATCH-NO TO QTR-BATCH-NO (QTR-SUB). DTSBX332 00430 MOVE X332-ITEM-NO TO QTR-ITEM-NO (QTR-SUB). DTSBX332 00431 MOVE X332-TRAN-TYPE TO QTR-TRAN-TYPE (QTR-SUB). DTSBX332 00432 MOVE X332-AMT TO QTR-AMT (QTR-SUB). DTSBX332 00433 DTSBX332 00434 P1000-EXIT. DTSBX332 00435 EXIT. DTSBX332 00436 DTSBX332 00437 P1300-INIT-TABLES. DTSBX332 00438 MOVE X332-EMP-NO TO WRK-EMP-NO. DTSBX332 00439 MOVE X332-PRIMARY-NAME TO WRK-PRIMARY-NAME. DTSBX332 00440 MOVE X332-FLD-REP-ID TO WRK-FLD-REP-ID. DTSBX332 00441 MOVE X332-YRQ TO WRK-YRQ. DTSBX332 00442 DTSBX332 00443 PERFORM DTSBX332 00444 VARYING QTR-SUB FROM +1 BY +1 DTSBX332 00445 UNTIL QTR-SUB > QTR-MAX DTSBX332 00446 MOVE +0 TO QTR-BATCH-NO (QTR-SUB) DTSBX332 00447 QTR-ITEM-NO (QTR-SUB) DTSBX332 00448 QTR-ESTB-DATE (QTR-SUB) DTSBX332 00449 QTR-AMT (QTR-SUB) DTSBX332 00450 MOVE SPACES TO QTR-TRAN-TYPE (QTR-SUB) DTSBX332 00451 SET QTR-FIRST-RCVBL-NO-88 (QTR-SUB) TO TRUE DTSBX332 00452 END-PERFORM. DTSBX332 00453 DTSBX332 00454 MOVE +0 TO QTR-SUB DTSBX332 00455 QTR-LAST. DTSBX332 00456 DTSBX332 00457 P1300-EXIT. DTSBX332 00458 EXIT. DTSBX332 00459 DTSBX332 00460 DTSBX332 00461 P5000-WRITE-OUTPUT. DTSBX332 00462 *************************** DTSBX332 00463 * FOR EACH QUARTER, FIND THE EARLIEST TRANSACTION BETWEEN DTSBX332 00464 * THE START AND END DATES THAT ESTABLISHED A RECEIVABLE. DTSBX332 00465 * RECORD THE QUARTER FOR THE REPORT DTSBX332 00466 *************************** DTSBX332 00467 SET WRK-RCVBL-FOUND-NO-88 TO TRUE. DTSBX332 00468 DTSBX332 00469 MOVE ZERO TO WRK-QTR-BAL DTSBX332 00470 PREV-QTR-BAL DTSBX332 00471 WRK-BATCH-NO DTSBX332 00472 WRK-ITEM-NO. DTSBX332 00473 MOVE ALL-NINES-DATE TO WRK-ESTB-DATE. DTSBX332 00474 DTSBX332 00475 PERFORM DTSBX332 00476 VARYING QTR-SUB FROM +1 BY +1 DTSBX332 00477 UNTIL QTR-SUB > QTR-LAST DTSBX332 00478 MOVE WRK-QTR-BAL TO PREV-QTR-BAL DTSBX332 00479 ADD QTR-AMT (QTR-SUB) TO WRK-QTR-BAL DTSBX332 00480 IF WRK-QTR-BAL <= ZERO DTSBX332 00481 SET WRK-RCVBL-FOUND-NO-88 TO TRUE DTSBX332 00482 ELSE DTSBX332 00483 IF QTR-ESTB-DATE (QTR-SUB) >= WRK-START-DATE DTSBX332 00484 AND QTR-ESTB-DATE (QTR-SUB) <= WRK-END-DATE DTSBX332 00485 PERFORM P5010-FIND-FIRST-RCVBL THRU P5010-EXIT DTSBX332 00486 END-IF DTSBX332 00487 END-IF DTSBX332 00488 END-PERFORM. DTSBX332 00489 DTSBX332 00490 IF WRK-RCVBL-FOUND-NO-88 DTSBX332 00491 OR WRK-QTR-BAL < +100 DTSBX332 00492 GO TO P5000-EXIT DTSBX332 00493 END-IF. DTSBX332 00494 DTSBX332 00495 PERFORM P5100-CHK-ASSIGN THRU P5100-EXIT. DTSBX332 00496 IF WRK-MFAS-FOUND-NO-88 DTSBX332 00497 PERFORM P5200-WRITE-R332 THRU P5200-EXIT DTSBX332 00498 PERFORM P5300-ADD-MFAS THRU P5300-EXIT DTSBX332 00499 END-IF. DTSBX332 00500 DTSBX332 00501 P5000-EXIT. DTSBX332 00502 EXIT. DTSBX332 00503 DTSBX332 00504 P5010-FIND-FIRST-RCVBL. DTSBX332 00505 IF PREV-QTR-BAL <= ZERO DTSBX332 00506 IF WRK-QTR-BAL > ZERO DTSBX332 00507 SET WRK-RCVBL-FOUND-YES-88 TO TRUE DTSBX332 00508 END-IF DTSBX332 00509 ELSE DTSBX332 00510 IF WRK-QTR-BAL > PREV-QTR-BAL DTSBX332 00511 SET WRK-RCVBL-FOUND-YES-88 TO TRUE DTSBX332 00512 END-IF DTSBX332 00513 END-IF. DTSBX332 00514 DTSBX332 00515 P5010-EXIT. DTSBX332 00516 EXIT. DTSBX332 00517 DTSBX332 00518 P5100-CHK-ASSIGN. DTSBX332 00519 SET WRK-MFAS-FOUND-NO-88 TO TRUE. DTSBX332 00520 MOVE LOW-VALUE TO MFAS-REC. DTSBX332 00521 MOVE WRK-EMP-NO TO MFAS-EMP-NO. DTSBX332 00522 SET MFAS-FAS-88 TO TRUE. DTSBX332 00523 DTSBX332 00524 MOVE MFAS-REC TO MSKL-REC. DTSBX332 00525 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX332 00526 PERFORM DTSBX332 00527 UNTIL L910-NO-REC-88 DTSBX332 00528 MOVE MSKL-REC TO MFAS-REC DTSBX332 00529 IF MFAS-ASSIGN-TYPE = '13' DTSBX332 00530 IF MFAS-STATUS-ACTIVE-88 DTSBX332 00531 SET WRK-MFAS-FOUND-YES-88 TO TRUE DTSBX332 00532 MOVE MFAS-ESTB-DATE TO WRK-MFAS-ESTB-DATE DTSBX332 00533 END-IF DTSBX332 00534 END-IF DTSBX332 00535 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX332 00536 END-PERFORM. DTSBX332 00537 DTSBX332 00538 P5100-EXIT. DTSBX332 00539 EXIT. DTSBX332 00540 DTSBX332 00541 P5200-WRITE-R332. DTSBX332 00542 MOVE LOW-VALUE TO MSKL-REC. DTSBX332 00543 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSBX332 00544 SET MSKL-PRF-88 TO TRUE. DTSBX332 00545 PERFORM S910-READ THRU S910-EXIT. DTSBX332 00546 IF L910-NO-REC-88 DTSBX332 00547 DISPLAY 'CANNOT FIND PROFILE RECORD ' WRK-EMP-NO DTSBX332 00548 GO TO P5200-EXIT DTSBX332 00549 ELSE DTSBX332 00550 MOVE MSKL-REC TO MPRF-REC DTSBX332 00551 END-IF. DTSBX332 00552 DTSBX332 00553 MOVE WRK-EMP-NO TO R332-EMP-NO. DTSBX332 00554 MOVE WRK-FLD-REP-ID TO R332-FLD-REP-ID. DTSBX332 00555 MOVE WRK-PRIMARY-NAME TO R332-PRIMARY-NAME. DTSBX332 00556 MOVE WRK-YRQ TO R332-YRQ. DTSBX332 00557 MOVE WRK-START-DATE TO R332-START-DATE. DTSBX332 00558 MOVE WRK-END-DATE TO R332-END-DATE. DTSBX332 00559 *** MOVE WRK-ESTB-DATE TO R332-ESTB-DATE. DTSBX332 00560 * MOVE QTR-ESTB-DATE (QTR-SUB) TO R332-ESTB-DATE. DTSBX332 00561 * MOVE QTR-BATCH-NO (QTR-SUB) TO R332-BATCH-NO. DTSBX332 00562 * MOVE QTR-ITEM-NO (QTR-SUB) TO R332-ITEM-NO. DTSBX332 00563 * MOVE QTR-TRAN-TYPE (QTR-SUB) TO R332-TRAN-TYPE. DTSBX332 00564 MOVE WRK-QTR-BAL TO R332-UI-TAX-BAL. DTSBX332 00565 COMPUTE R332-UI-TAX-BAL-XOR = DTSBX332 00566 (WRK-ALL-NINES-BAL - WRK-QTR-BAL). DTSBX332 00567 DTSBX332 00568 PERFORM S946-WRITE-R332 THRU S946-EXIT. DTSBX332 00569 DTSBX332 00570 ADD +1 TO WRK-R332-CNT. DTSBX332 00571 DTSBX332 00572 * MOVE WRK-EMP-NO TO WRK-X332-EMP-NO. DTSBX332 00573 * MOVE WRK-YRQ TO L004-QTR-5-9. DTSBX332 00574 * PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX332 00575 * MOVE L004-SLASH-QTR TO WRK-X332-YRQ. DTSBX332 00576 * MOVE WRK-ESTB-DATE TO L001-FED-8-DATE-9. DTSBX332 00577 * PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX332 00578 * MOVE L001-SLASH-8-DATE TO WRK-X332-ESTB. DTSBX332 00579 * MOVE QTR-BATCH-NO (QTR-SUB) TO WRK-X332-BATCH. DTSBX332 00580 * MOVE QTR-ITEM-NO (QTR-SUB) TO WRK-X332-ITEM. DTSBX332 00581 * MOVE QTR-TRAN-TYPE (QTR-SUB) TO WRK-X332-TRAN. DTSBX332 00582 * MOVE WRK-QTR-BAL TO WRK-X332-AMT. DTSBX332 00583 * DTSBX332 00584 * WRITE X332-OUT-REC FROM WRK-X332-REC. DTSBX332 00585 * IF NOT X332-STATUS-OK-88 DTSBX332 00586 * DISPLAY 'X332 WRITE ERROR : ' X332-STATUS DTSBX332 00587 * ELSE DTSBX332 00588 * ADD +1 TO WRK-X332-CNT DTSBX332 00589 * END-IF. DTSBX332 00590 * DTSBX332 00591 * MOVE WRK-QTR-BAL TO DISPLAY-AMT. DTSBX332 00592 * DISPLAY 'P5200 ' DTSBX332 00593 * WRK-EMP-NO ' ' WRK-YRQ DTSBX332 00594 * ' ' WRK-ESTB-DATE DTSBX332 00595 * ' ' QTR-BATCH-NO (QTR-SUB) DTSBX332 00596 * ' ' QTR-ITEM-NO (QTR-SUB) DTSBX332 00597 * ' ' QTR-TRAN-TYPE (QTR-SUB) DTSBX332 00598 * ' ' DISPLAY-AMT. DTSBX332 00599 DTSBX332 00600 P5200-EXIT. DTSBX332 00601 EXIT. DTSBX332 00602 DTSBX332 00603 P5300-ADD-MFAS. DTSBX332 00604 ***************** DTSBX332 00605 ** ADD ONLY ONE FIELD ASSIGNMENT, EVEN IF THERE ARE DTSBX332 00606 ** MULTIPLE RECEIVABLES DTSBX332 00607 ***************** DTSBX332 00608 DTSBX332 00609 IF WRK-PARM-UPDATE-NO-88 DTSBX332 00610 OR MPRF-EMP-NO = WRK-MFAS-EMP-NO DTSBX332 00611 GO TO P5300-EXIT DTSBX332 00612 ELSE DTSBX332 00613 MOVE MPRF-EMP-NO TO WRK-MFAS-EMP-NO DTSBX332 00614 END-IF. DTSBX332 00615 DTSBX332 00616 MOVE LOW-VALUES TO MFAS-REC. DTSBX332 00617 DTSBX332 00618 MOVE MPRF-EMP-NO TO MFAS-EMP-NO. DTSBX332 00619 DTSBX332 00620 SET MFAS-FAS-88 TO TRUE. DTSBX332 00621 DTSBX332 00622 ADD +1 TO WRK-ASSIGN-NO. DTSBX332 00623 DTSBX332 00624 MOVE WRK-ASSIGN-NO TO MFAS-ASSIGN-NO. DTSBX332 00625 DTSBX332 00626 MOVE +0 TO MFAS-PURGE-DATE. DTSBX332 00627 DTSBX332 00628 SET MFAS-STATUS-ACTIVE-88 TO TRUE. DTSBX332 00629 DTSBX332 00630 MOVE WRK-FLD-REP-ID TO MFAS-FLD-REP-ID. DTSBX332 00631 DTSBX332 00632 MOVE '13' TO MFAS-ASSIGN-TYPE. DTSBX332 00633 DTSBX332 00634 SET MFAS-ATTACHMENTS-NO-88 TO TRUE. DTSBX332 00635 DTSBX332 00636 SET MFAS-NON-AUDIT-88 TO TRUE. DTSBX332 00637 DTSBX332 00638 SET MFAS-ACCOUNTING-DESK-NO-88 TO TRUE. DTSBX332 00639 DTSBX332 00640 MOVE MHDR-CURR-MAIL-DATE TO MFAS-START-DATE. DTSBX332 00641 DTSBX332 00642 MOVE +0 TO MFAS-DUE-DATE DTSBX332 00643 MFAS-COMPLETED-DATE DTSBX332 00644 MFAS-PROCESSED-DATE DTSBX332 00645 MFAS-TAX-DOWNLOAD-DATE DTSBX332 00646 MFAS-WAGE-DOWNLOAD-DATE. DTSBX332 00647 DTSBX332 00648 MOVE 'SYSTEM' TO MFAS-SOURCE-OP-ID. DTSBX332 00649 DTSBX332 00650 MOVE ZERO TO MFAS-CLAIMANT-SSN. DTSBX332 00651 DTSBX332 00652 MOVE SPACES TO MFAS-CLAIMANT-NAME. DTSBX332 00653 DTSBX332 00654 MOVE ZERO TO MFAS-RELATED-EMP-NO. DTSBX332 00655 DTSBX332 00656 MOVE +0 TO MFAS-START-YRQ DTSBX332 00657 MFAS-END-YRQ. DTSBX332 00658 DTSBX332 00659 MOVE MPRF-SIC-CD TO MFAS-SIC-CD. DTSBX332 00660 DTSBX332 00661 MOVE MPRF-NAICS-CD TO MFAS-NAICS-CD. DTSBX332 00662 DTSBX332 00663 MOVE MPRF-OWN-CD TO MFAS-OWN-CD. DTSBX332 00664 DTSBX332 00665 SET MFAS-EMP-NON-AUDIT-88 TO TRUE. DTSBX332 00666 DTSBX332 00667 MOVE +0 TO MFAS-SEL-CNT. DTSBX332 00668 DTSBX332 00669 SET MFAS-NOT-CONVERTED-88 TO TRUE. DTSBX332 00670 DTSBX332 00671 MOVE MHDR-PRIOR-RUN-DATE TO MFAS-ESTB-DATE DTSBX332 00672 MFAS-CHNG-DATE. DTSBX332 00673 DTSBX332 00674 MOVE +1 TO MFAS-TEXT-CNT. DTSBX332 00675 DTSBX332 00676 MOVE DTSBX332 00677 'FIELD ASSIGN CREATED: RECEIVABLE OVER 120 DAYS OLD' DTSBX332 00678 TO MFAS-TEXT (1). DTSBX332 00679 DTSBX332 00680 MOVE MFAS-REC TO MSKL-REC. DTSBX332 00681 DTSBX332 00682 PERFORM S910-WRITE THRU S910-EXIT. DTSBX332 00683 DTSBX332 00684 SET MPRF-MFAS-EXISTS-88 TO TRUE. DTSBX332 00685 DTSBX332 00686 PERFORM P5310-WRITE-MEVL THRU P5310-EXIT. DTSBX332 00687 DTSBX332 00688 PERFORM P5320-UPDATE-MPRF THRU P5320-EXIT. DTSBX332 00689 DTSBX332 00690 P5300-EXIT. DTSBX332 00691 EXIT. DTSBX332 00692 DTSBX332 00693 P5310-WRITE-MEVL. DTSBX332 00694 MOVE LOW-VALUE TO MEVL-REC. DTSBX332 00695 DTSBX332 00696 MOVE MPRF-EMP-NO TO MEVL-EMP-NO. DTSBX332 00697 DTSBX332 00698 SET MEVL-EVL-88 TO TRUE. DTSBX332 00699 DTSBX332 00700 ADD +1000 TO WRK-ABSTIME. DTSBX332 00701 DTSBX332 00702 MOVE WRK-ABSTIME TO L005-ABSTIME. DTSBX332 00703 DTSBX332 00704 SET L005-FROM-ABSTIME TO TRUE. DTSBX332 00705 DTSBX332 00706 PERFORM S005-CONVERT-TIME THRU S005-EXIT. DTSBX332 00707 DTSBX332 00708 MOVE L005-DATE TO MEVL-DATE. DTSBX332 00709 DTSBX332 00710 MOVE L005-TIME TO MEVL-TIME. DTSBX332 00711 DTSBX332 00712 MOVE +0 TO MEVL-PURGE-DATE. DTSBX332 00713 DTSBX332 00714 MOVE WRK-EVENT-TXT TO MEVL-TEXT. DTSBX332 00715 DTSBX332 00716 SET MEVL-SOURCE-SYSTEM-88 TO TRUE. DTSBX332 00717 DTSBX332 00718 SET MEVL-NOT-CONVERTED-88 TO TRUE. DTSBX332 00719 DTSBX332 00720 MOVE MHDR-PRIOR-RUN-DATE TO MEVL-ESTB-DATE DTSBX332 00721 MEVL-CHNG-DATE. DTSBX332 00722 DTSBX332 00723 MOVE MEVL-REC TO MSKL-REC. DTSBX332 00724 DTSBX332 00725 PERFORM S910-WRITE THRU S910-EXIT. DTSBX332 00726 DTSBX332 00727 P5310-EXIT. DTSBX332 00728 EXIT. DTSBX332 00729 DTSBX332 00730 P5320-UPDATE-MPRF. DTSBX332 00731 MOVE MPRF-REC TO MSKL-REC. DTSBX332 00732 DTSBX332 00733 PERFORM S910-REWRITE THRU S910-EXIT. DTSBX332 00734 DTSBX332 00735 P5320-EXIT. DTSBX332 00736 EXIT. DTSBX332 00737 DTSBX332 00738 T0000-TERMINATE. DTSBX332 00739 IF WRK-PARM-UPDATE-YES-88 DTSBX332 00740 PERFORM T1000-UPDATE-HDR THRU T1000-EXIT DTSBX332 00741 END-IF. DTSBX332 00742 DTSBX332 00743 CLOSE X332-FILE. DTSBX332 00744 *** CLOSE X332-OUT-FILE. DTSBX332 00745 PERFORM S910-CLOSE THRU S910-EXIT. DTSBX332 00746 PERFORM S921-CLOSE THRU S921-EXIT. DTSBX332 00747 DTSBX332 00748 DISPLAY ' '. DTSBX332 00749 DTSBX332 00750 DISPLAY '*** DTSBX332 TERMINATION STATISTICS ***'. DTSBX332 00751 DTSBX332 00752 DISPLAY ' '. DTSBX332 00753 MOVE WRK-R332-CNT TO DISPLAY-CNT. DTSBX332 00754 DISPLAY 'R332 RECORDS WRITTEN : ' DTSBX332 00755 DISPLAY-CNT. DTSBX332 00756 * MOVE WRK-X332-CNT TO DISPLAY-CNT. DTSBX332 00757 * DISPLAY 'X332 RECORDS WRITTEN : ' DTSBX332 00758 * DISPLAY-CNT. DTSBX332 00759 DTSBX332 00760 MOVE LOW-VALUES TO R332-REC. DTSBX332 00761 MOVE -1 TO R332-LENGTH. DTSBX332 00762 DTSBX332 00763 PERFORM S946-WRITE-R332 THRU S946-EXIT. DTSBX332 00764 DTSBX332 00765 T0000-EXIT. DTSBX332 00766 EXIT. DTSBX332 00767 DTSBX332 00768 T1000-UPDATE-HDR. DTSBX332 00769 MOVE LOW-VALUES TO MHDR-KEY-AREA. DTSBX332 00770 MOVE +0 TO MHDR-EMP-NO. DTSBX332 00771 SET MHDR-HDR-88 TO TRUE. DTSBX332 00772 MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA. DTSBX332 00773 DTSBX332 00774 PERFORM S910-READ THRU S910-EXIT. DTSBX332 00775 DTSBX332 00776 IF L910-NO-REC-88 DTSBX332 00777 MOVE 'MHDR RECORD NOT FOUND (T0000)' DTSBX332 00778 TO ABEND-MSG DTSBX332 00779 PERFORM S999-ABEND THRU S999-EXIT. DTSBX332 00780 DTSBX332 00781 MOVE MSKL-REC TO MHDR-REC. DTSBX332 00782 DTSBX332 00783 MOVE WRK-ASSIGN-NO TO MHDR-LAST-USED-ASSIGN-NO. DTSBX332 00784 DTSBX332 00785 MOVE MHDR-PRIOR-RUN-DATE TO MHDR-CHNG-DATE. DTSBX332 00786 DTSBX332 00787 MOVE MHDR-REC TO MSKL-REC. DTSBX332 00788 DTSBX332 00789 PERFORM S910-REWRITE THRU S910-EXIT. DTSBX332 00790 DTSBX332 00791 T1000-EXIT. DTSBX332 00792 EXIT. DTSBX332 00793 DTSBX332 00794 S001-FROM-FED-8. DTSBX332 00795 SET L001-FROM-FED-8 TO TRUE. DTSBX332 00796 GO TO S001-DATE. DTSBX332 00797 DTSBX332 00798 S001-FROM-ABS-DAY. DTSBX332 00799 SET L001-FROM-ABS-DAY TO TRUE. DTSBX332 00800 GO TO S001-DATE. DTSBX332 00801 DTSBX332 00802 S001-FROM-CAL-6. DTSBX332 00803 SET L001-FROM-CAL-6 TO TRUE. DTSBX332 00804 GO TO S001-DATE. DTSBX332 00805 DTSBX332 00806 S001-DATE. DTSBX332 00807 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX332 00808 S001-EXIT. DTSBX332 00809 EXIT. DTSBX332 00810 SKIP3 DTSBX332 00811 S004-FROM-5. DTSBX332 00812 SET L004-FROM-5 TO TRUE. DTSBX332 00813 GO TO S004-QTR. DTSBX332 00814 DTSBX332 00815 S004-FROM-ABS. DTSBX332 00816 SET L004-FROM-ABS TO TRUE. DTSBX332 00817 GO TO S004-QTR. DTSBX332 00818 DTSBX332 00819 S004-FROM-3. DTSBX332 00820 SET L004-FROM-3 TO TRUE. DTSBX332 00821 GO TO S004-QTR. DTSBX332 00822 DTSBX332 00823 S004-FROM-DATE. DTSBX332 00824 SET L004-FROM-DATE TO TRUE. DTSBX332 00825 GO TO S004-QTR. DTSBX332 00826 DTSBX332 00827 S004-QTR. DTSBX332 00828 DTSBX332 00829 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX332 00830 DTSBX332 00831 S004-EXIT. DTSBX332 00832 EXIT. DTSBX332 00833 SKIP3 DTSBX332 00834 DTSBX332 00835 S005-CONVERT-TIME. DTSBX332 00836 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBX332 00837 S005-EXIT. EXIT. DTSBX332 00838 DTSBX332 00839 S910-OPEN-UPDATE. DTSBX332 00840 SET L910-OPEN-UPDATE-88 TO TRUE. DTSBX332 00841 GO TO S910-MSTR-IO. DTSBX332 00842 DTSBX332 00843 S910-OPEN-READ. DTSBX332 00844 SET L910-OPEN-READ-88 TO TRUE. DTSBX332 00845 GO TO S910-MSTR-IO. DTSBX332 00846 DTSBX332 00847 S910-READ. DTSBX332 00848 SET L910-READ-88 TO TRUE. DTSBX332 00849 GO TO S910-MSTR-IO. DTSBX332 00850 DTSBX332 00851 S910-START-BROWSE. DTSBX332 00852 SET L910-START-BROWSE-88 TO TRUE. DTSBX332 00853 GO TO S910-MSTR-IO. DTSBX332 00854 DTSBX332 00855 S910-READ-NEXT. DTSBX332 00856 SET L910-READ-NEXT-88 TO TRUE. DTSBX332 00857 GO TO S910-MSTR-IO. DTSBX332 00858 DTSBX332 00859 S910-WRITE. DTSBX332 00860 SET L910-WRITE-88 TO TRUE. DTSBX332 00861 GO TO S910-MSTR-IO. DTSBX332 00862 DTSBX332 00863 S910-REWRITE. DTSBX332 00864 SET L910-REWRITE-88 TO TRUE. DTSBX332 00865 GO TO S910-MSTR-IO. DTSBX332 00866 DTSBX332 00867 S910-CLOSE. DTSBX332 00868 SET L910-CLOSE-88 TO TRUE. DTSBX332 00869 GO TO S910-MSTR-IO. DTSBX332 00870 DTSBX332 00871 S910-MSTR-IO. DTSBX332 00872 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX332 00873 MSKL-REC. DTSBX332 00874 S910-EXIT. DTSBX332 00875 EXIT. DTSBX332 00876 DTSBX332 00877 S921-OPEN-READ. DTSBX332 00878 SET L921-OPEN-READ-88 TO TRUE. DTSBX332 00879 GO TO S921-AIX-IO. DTSBX332 00880 DTSBX332 00881 S921-OPEN-UPDATE. DTSBX332 00882 SET L921-OPEN-UPDATE-88 TO TRUE. DTSBX332 00883 GO TO S921-AIX-IO. DTSBX332 00884 DTSBX332 00885 S921-CLOSE. DTSBX332 00886 SET L921-CLOSE-88 TO TRUE. DTSBX332 00887 GO TO S921-AIX-IO. DTSBX332 00888 DTSBX332 00889 S921-AIX-IO. DTSBX332 00890 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX332 00891 ISKL-REC. DTSBX332 00892 S921-EXIT. DTSBX332 00893 EXIT. DTSBX332 00894 DTSBX332 00895 S946-WRITE-R332. DTSBX332 00896 CALL 'DTSBU946' USING R332-REC. DTSBX332 00897 DTSBX332 00898 S946-EXIT. DTSBX332 00899 EXIT. DTSBX332 00900 SKIP3 DTSBX332 00901 S999-ABEND. DTSBX332 00902 DISPLAY '*** DTSBE774 ABENDING. ' DTSBX332 00903 ABEND-MSG. DTSBX332 00904 DTSBX332 00905 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX332 00906 S999-EXIT. DTSBX332 00907 EXIT. DTSBX332