00001 IDENTIFICATION DIVISION. 02/02/04 00002 PROGRAM-ID. DTSBX460. DTSBX460 00003 AUTHOR. TRW. LV003 00004 DATE-WRITTEN. NOVEMBER 2001. DTSBX460 00005 DATE-COMPILED. DTSBX460 00006 SKIP3 DTSBX460 00007 ******************************************************************DTSBX460 00008 * *DTSBX460 00009 * FUNCTION: EXTRACT THE VSAM MASTER FILES TO CREATE *DTSBX460 00010 * A RECYCLE FILE AND A TRANSACTIONS FILE *DTSBX460 00011 * FOR THE OFFICE OF TAX AND REVENUE. *DTSBX460 00012 * *DTSBX460 00013 ******************************************************************DTSBX460 00014 * MODIFICATION HISTORY: *DTSBX460 00015 * *DTSBX460 00016 * 11-01-2001 INIT1AL DEVELOPMENT *DTSBX460 00017 * REFERENCE RFP # AUTHOR OF CHANGE - RW1 *DTSBX460 00018 * *DTSBX460 00019 * 02-02-2004 INCREASED SIZE OF MPRF-FEIN-TABLE FROM 50000 TO DTSBX460 00020 * 60000 AND ADDED TEST TO CATCH TABLE SIZE ERROR. *DTSBX460 00021 * CHANGED I4000 TO SELECT ONLY ACTIVE EMPLOYERS. *DTSBX460 00022 * REFERENCE PROD ABEND AUTHOR OF CHANGE - GD *DTSBX460 00023 * *DTSBX460 00024 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *DTSBX460 00025 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *DTSBX460 00026 * REFERENCE RFP #**** AUTHOR OF CHANGE - *** *DTSBX460 00027 ******************************************************************DTSBX460 00028 DTSBX460 00029 ENVIRONMENT DIVISION. DTSBX460 00030 SKIP2 DTSBX460 00031 INPUT-OUTPUT SECTION. DTSBX460 00032 DTSBX460 00033 FILE-CONTROL. DTSBX460 00034 DTSBX460 00035 SELECT OTR-PRIOR-FILE ASSIGN TO IPRIFILE. DTSBX460 00036 SELECT OTR-CURR-FILE ASSIGN TO OCURFILE. DTSBX460 00037 SELECT OTR-TRANS-FILE ASSIGN TO OTRNFILE. DTSBX460 00038 DTSBX460 00039 DATA DIVISION. DTSBX460 00040 DTSBX460 00041 FILE SECTION. DTSBX460 00042 DTSBX460 00043 FD OTR-PRIOR-FILE DTSBX460 00044 RECORDING MODE IS F DTSBX460 00045 BLOCK CONTAINS 0 RECORDS DTSBX460 00046 LABEL RECORDS ARE OMITTED. DTSBX460 00047 DTSBX460 00048 01 OTR-PRIOR-REC PIC X(332). DTSBX460 00049 DTSBX460 00050 FD OTR-CURR-FILE DTSBX460 00051 RECORDING MODE IS F DTSBX460 00052 BLOCK CONTAINS 0 RECORDS DTSBX460 00053 LABEL RECORDS ARE OMITTED. DTSBX460 00054 DTSBX460 00055 01 OTR-CURR-REC PIC X(332). DTSBX460 00056 DTSBX460 00057 FD OTR-TRANS-FILE DTSBX460 00058 RECORDING MODE IS F DTSBX460 00059 BLOCK CONTAINS 0 RECORDS DTSBX460 00060 LABEL RECORDS ARE OMITTED. DTSBX460 00061 DTSBX460 00062 01 OTR-TRANS-REC PIC X(333). DTSBX460 00063 DTSBX460 00064 EJECT DTSBX460 00065 WORKING-STORAGE SECTION. DTSBX460 000655 77 PAN-VALET PICTURE X(24) VALUE '003DTSBX460 02/02/04'. DTSBX460 00066 SKIP3 DTSBX460 00067 01 WRK-AREA. DTSBX460 00068 05 SUB PIC S9(04) COMP VALUE +0. DTSBX460 00069 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +802.DTSBX460 00070 DTSBX460 00071 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBX460'.DTSBX460 00072 DTSBX460 00073 05 WRK-TABLE-LOAD-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX460 00074 05 WRK-OTHER-CLASS-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX460 00075 05 WRK-MPRF-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX460 00076 05 WRK-MPRF-ACT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX460 00077 05 WRK-MPRF-INACT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX460 00078 05 WRK-SUCC-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX460 00079 05 WRK-OTR-CURR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX460 00080 05 WRK-OTR-TRANS-ADD-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX460 00081 05 WRK-OTR-TRANS-DEL-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX460 00082 05 WRK-OTR-TRANS-CHG-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX460 00083 05 WRK-OTR-WRITE-CURR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX460 00084 05 WRK-OTR-READ-PRIOR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX460 00085 05 WRK-LIAB-DATE-9-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX460 00086 05 WRK-INACT-WITHDRAWN-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX460 00087 DTSBX460 00088 05 WRK-LIAB-DATE PIC S9(09) COMP-3 VALUE DTSBX460 00089 +999999999. DTSBX460 00090 05 WRK-SUCCESSOR-FEIN PIC 9(06) VALUE ZEROS. DTSBX460 00091 05 AMT-DISP PIC Z(11)9.99-. DTSBX460 00092 05 AMT-DISP1 PIC Z(11)9.99-. DTSBX460 00093 05 AMT-DISP2 PIC Z(11)9.99-. DTSBX460 00094 05 EMP-ACCT-DISP PIC 9(06). DTSBX460 00095 05 DISP-DATE1 PIC X(10). DTSBX460 00096 05 DISP-DATE2 PIC X(10). DTSBX460 00097 DTSBX460 00098 05 WRK-MPRF-IND PIC X(01). DTSBX460 00099 88 WRK-MPRF-OK VALUE 'Y'. DTSBX460 00100 88 WRK-MPRF-NO-REC VALUE 'N'. DTSBX460 00101 DTSBX460 00102 05 WRK-MQTR-IND PIC X(01). DTSBX460 00103 88 WRK-MQTR-OK VALUE 'Y'. DTSBX460 00104 88 WRK-MQTR-NO-REC VALUE 'N'. DTSBX460 00105 DTSBX460 00106 05 WRK-MSOL-IND PIC X(01). DTSBX460 00107 88 WRK-MSOL-OK VALUE 'Y'. DTSBX460 00108 88 WRK-MSOL-NO-REC VALUE 'N'. DTSBX460 00109 DTSBX460 00110 05 WRK-MRPT-FOUND-IND PIC X(01). DTSBX460 00111 88 WRK-MRPT-FOUND-YES VALUE 'Y'. DTSBX460 00112 88 WRK-MRPT-FOUND-NO VALUE 'N'. DTSBX460 00113 DTSBX460 00114 05 WRK-EMP-SELECTED-IND PIC X(01). DTSBX460 00115 88 WRK-EMP-SELECTED-YES VALUE 'Y'. DTSBX460 00116 88 WRK-EMP-SELECTED-NO VALUE 'N'. DTSBX460 00117 DTSBX460 00118 05 WRK-READ-INPUT-MPRF-SW PIC X(01). DTSBX460 00119 88 WRK-READ-INPUT-MPRF-YES VALUE 'Y'. DTSBX460 00120 88 WRK-READ-INPUT-MPRF-NO VALUE 'N'. DTSBX460 00121 DTSBX460 00122 05 WRK-READ-INPUT-PRIOR-SW PIC X(01). DTSBX460 00123 88 WRK-READ-INPUT-PRIOR-YES VALUE 'Y'. DTSBX460 00124 88 WRK-READ-INPUT-PRIOR-NO VALUE 'N'. DTSBX460 00125 DTSBX460 00126 05 WRK-READ-INPUT-PRIOR-END-SW PIC X(01). DTSBX460 00127 88 WRK-READ-INPUT-PRIOR-END-YES VALUE 'Y'. DTSBX460 00128 88 WRK-READ-INPUT-PRIOR-END-NO VALUE 'N'. DTSBX460 00129 DTSBX460 00130 05 WRK-EMP-NO PIC 9(06). DTSBX460 00131 05 WRK-TRACE-IND PIC X(01). DTSBX460 00132 05 WRK-TOT-EMPS PIC S9(07) COMP-3 VALUE +0. DTSBX460 00133 DTSBX460 00134 05 MPRF-FEIN-AREA. DTSBX460 00135 10 TBL-LEN-MAX PIC S9(07) COMP-3 DTSBX460 00136 VALUE +60000. DTSBX460 00137 10 MPRF-FEIN-TABLE OCCURS 1 TO 60000 TIMES DTSBX460 00138 DEPENDING ON WRK-TABLE-LOAD-CNT DTSBX460 00139 INDEXED BY MPRF-TBL-IDX. DTSBX460 00140 DTSBX460 00141 15 TBL-EMP-NO PIC 9(06). DTSBX460 00142 15 TBL-FEIN PIC 9(09). DTSBX460 00143 DTSBX460 00144 01 WRK-CURR-REC. DTSBX460 00145 05 CURR-EMPL-FEIN PIC 9(09) VALUE ZEROS. DTSBX460 00146 05 CURR-EMPL-ACT-IND PIC X(01) VALUE SPACE. DTSBX460 00147 05 CURR-EMPL-LIAB-DATE PIC 9(08) VALUE ZEROS. DTSBX460 00148 05 CURR-EMPL-BUS-NAME PIC X(40) VALUE SPACES. DTSBX460 00149 05 CURR-EMPL-TRADE-NAME PIC X(40) VALUE SPACES. DTSBX460 00150 05 CURR-EMPL-TELEPHONE. DTSBX460 00151 10 CURR-TEL-AREA-CD PIC X(03) VALUE SPACES. DTSBX460 00152 10 CURR-TEL-PREFIX PIC X(03) VALUE SPACES. DTSBX460 00153 10 CURR-TEL-SUFFIX PIC X(04) VALUE SPACES. DTSBX460 00154 05 CURR-TEL-EXT PIC X(05) VALUE SPACES. DTSBX460 00155 05 CURR-ADDR-ATTN-LINE PIC X(40) VALUE SPACES. DTSBX460 00156 05 CURR-ADDR-LINE1 PIC X(40) VALUE SPACES. DTSBX460 00157 05 CURR-ADDR-LINE2 PIC X(40) VALUE SPACES. DTSBX460 00158 05 CURR-CITY PIC X(25) VALUE SPACES. DTSBX460 00159 05 CURR-STATE PIC X(02) VALUE SPACES. DTSBX460 00160 05 CURR-ZIP-CODE PIC X(10) VALUE SPACES. DTSBX460 00161 05 CURR-OPO-NAME PIC X(32) VALUE SPACES. DTSBX460 00162 05 CURR-OPO-TELEPHONE. DTSBX460 00163 10 CURR-OPO-TEL-AREA-CD PIC X(03) VALUE SPACES. DTSBX460 00164 10 CURR-OPO-TEL-PREFIX PIC X(03) VALUE SPACES. DTSBX460 00165 10 CURR-OPO-TEL-SUFFIX PIC X(04) VALUE SPACES. DTSBX460 00166 05 CURR-OPO-TEL-EXT PIC X(05) VALUE SPACES. DTSBX460 00167 05 CURR-SUCCESSOR-FEIN PIC X(09) VALUE SPACES. DTSBX460 00168 05 CURR-EMP-NO PIC 9(06) VALUE ZEROS. DTSBX460 00169 DTSBX460 00170 01 WRK-PREV-REC. DTSBX460 00171 05 PREV-EMPL-FEIN PIC 9(09) VALUE ZEROS. DTSBX460 00172 05 PREV-EMPL-ACT-IND PIC X(01) VALUE SPACE. DTSBX460 00173 05 PREV-EMPL-LIAB-DATE PIC 9(08) VALUE ZEROS. DTSBX460 00174 05 PREV-EMPL-BUS-NAME PIC X(40) VALUE SPACES. DTSBX460 00175 05 PREV-EMPL-TRADE-NAME PIC X(40) VALUE SPACES. DTSBX460 00176 05 PREV-EMPL-TELEPHONE. DTSBX460 00177 10 PREV-TEL-AREA-CD PIC X(03) VALUE SPACES. DTSBX460 00178 10 PREV-TEL-PREFIX PIC X(03) VALUE SPACES. DTSBX460 00179 10 PREV-TEL-SUFFIX PIC X(04) VALUE SPACES. DTSBX460 00180 05 PREV-TEL-EXT PIC X(05) VALUE SPACES. DTSBX460 00181 05 PREV-ADDR-ATTN-LINE PIC X(40) VALUE SPACES. DTSBX460 00182 05 PREV-ADDR-LINE1 PIC X(40) VALUE SPACES. DTSBX460 00183 05 PREV-ADDR-LINE2 PIC X(40) VALUE SPACES. DTSBX460 00184 05 PREV-CITY PIC X(25) VALUE SPACES. DTSBX460 00185 05 PREV-STATE PIC X(02) VALUE SPACES. DTSBX460 00186 05 PREV-ZIP-CODE PIC X(10) VALUE SPACES. DTSBX460 00187 05 PREV-OPO-NAME PIC X(32) VALUE SPACES. DTSBX460 00188 05 PREV-OPO-TELEPHONE. DTSBX460 00189 10 PREV-OPO-TEL-AREA-CD PIC X(03) VALUE SPACES. DTSBX460 00190 10 PREV-OPO-TEL-PREFIX PIC X(03) VALUE SPACES. DTSBX460 00191 10 PREV-OPO-TEL-SUFFIX PIC X(04) VALUE SPACES. DTSBX460 00192 05 PREV-OPO-TEL-EXT PIC X(05) VALUE SPACES. DTSBX460 00193 05 PREV-SUCCESSOR-FEIN PIC X(09) VALUE SPACES. DTSBX460 00194 05 PREV-EMP-NO PIC 9(06) VALUE 999999. DTSBX460 00195 DTSBX460 00196 01 WRK-TRANS-REC. DTSBX460 00197 05 TRANS-UPDATE-CODE PIC X(01) VALUE SPACE. DTSBX460 00198 05 WRK-OTR-TRANS-REC. DTSBX460 00199 10 TRANS-EMPL-FEIN PIC 9(09) VALUE ZEROS. DTSBX460 00200 10 TRANS-EMPL-ACT-IND PIC X(01) VALUE SPACE. DTSBX460 00201 10 TRANS-EMPL-LIAB-DATE PIC 9(08) VALUE ZEROS. DTSBX460 00202 10 TRANS-EMPL-BUS-NAME PIC X(40) VALUE SPACES. DTSBX460 00203 10 TRANS-EMPL-TRADE-NAME PIC X(40) VALUE SPACES. DTSBX460 00204 10 TRANS-EMPL-TELEPHONE. DTSBX460 00205 15 TRANS-TEL-AREA-CD PIC X(03) VALUE SPACES. DTSBX460 00206 15 TRANS-TEL-PREFIX PIC X(03) VALUE SPACES. DTSBX460 00207 15 TRANS-TEL-SUFFIX PIC X(04) VALUE SPACES. DTSBX460 00208 10 TRANS-TEL-EXT PIC X(05) VALUE SPACES. DTSBX460 00209 10 TRANS-ADDR-ATTN-LINE PIC X(40) VALUE SPACES. DTSBX460 00210 10 TRANS-ADDR-LINE1 PIC X(40) VALUE SPACES. DTSBX460 00211 10 TRANS-ADDR-LINE2 PIC X(40) VALUE SPACES. DTSBX460 00212 10 TRANS-CITY PIC X(25) VALUE SPACES. DTSBX460 00213 10 TRANS-STATE PIC X(02) VALUE SPACES. DTSBX460 00214 10 TRANS-ZIP-CODE PIC X(10) VALUE SPACES. DTSBX460 00215 10 TRANS-OPO-NAME PIC X(32) VALUE SPACES. DTSBX460 00216 10 TRANS-OPO-TELEPHONE. DTSBX460 00217 15 TRANS-OPO-TEL-AREA-CD PIC X(03) VALUE SPACES. DTSBX460 00218 15 TRANS-OPO-TEL-PREFIX PIC X(03) VALUE SPACES. DTSBX460 00219 15 TRANS-OPO-TEL-SUFFIX PIC X(04) VALUE SPACES. DTSBX460 00220 10 TRANS-OPO-TEL-EXT PIC X(05) VALUE SPACES. DTSBX460 00221 10 TRANS-SUCCESSOR-FEIN PIC X(09) VALUE SPACES. DTSBX460 00222 10 TRANS-EMP-NO PIC 9(06) VALUE ZEROS. DTSBX460 00223 DTSBX460 00224 01 L001-LINK-AREA. DTSBX460 00225 ++INCLUDE DTSIL001 DTSBX460 00226 EJECT DTSBX460 00227 01 L102-LINK-AREA. DTSBX460 00228 ++INCLUDE DTSIL102 DTSBX460 00229 EJECT DTSBX460 00230 01 L910-LINK-AREA. DTSBX460 00231 ++INCLUDE DTSIL910 DTSBX460 00232 EJECT DTSBX460 00233 01 MSKL-REC. DTSBX460 00234 ++INCLUDE DTSIMSKL DTSBX460 00235 EJECT DTSBX460 00236 01 MHDR-REC. DTSBX460 00237 ++INCLUDE DTSIMHDR DTSBX460 00238 EJECT DTSBX460 00239 01 MPRF-REC. DTSBX460 00240 ++INCLUDE DTSIMPRF DTSBX460 00241 EJECT DTSBX460 00242 01 MSOL-REC. DTSBX460 00243 ++INCLUDE DTSIMSOL DTSBX460 00244 EJECT DTSBX460 00245 01 MOPO-REC. DTSBX460 00246 ++INCLUDE DTSIMOPO DTSBX460 00247 EJECT DTSBX460 00248 01 MTAD-REC. DTSBX460 00249 ++INCLUDE DTSIMTAD DTSBX460 00250 EJECT DTSBX460 00251 01 L921-LINK-AREA. DTSBX460 00252 ++INCLUDE DTSIL921 DTSBX460 00253 EJECT DTSBX460 00254 01 ISKL-REC. DTSBX460 00255 ++INCLUDE DTSIISKL DTSBX460 00256 EJECT DTSBX460 00257 01 L004-COMM-AREA. DTSBX460 00258 ++INCLUDE DTSIL004 DTSBX460 00259 EJECT DTSBX460 00260 01 L516-LINK-AREA. DTSBX460 00261 ++INCLUDE DTSIL516 DTSBX460 00262 EJECT DTSBX460 00263 01 L600-LINK-AREA. DTSBX460 00264 ++INCLUDE DTSIL600 DTSBX460 00265 EJECT DTSBX460 00266 PROCEDURE DIVISION. DTSBX460 00267 SKIP2 DTSBX460 00268 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBX460 00269 DTSBX460 00270 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBX460 00271 DTSBX460 00272 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBX460 00273 SKIP2 DTSBX460 00274 GOBACK. DTSBX460 00275 EJECT DTSBX460 00276 I0000-INITIATE. DTSBX460 00277 SKIP2 DTSBX460 00278 MOVE 'N' TO WRK-TRACE-IND. DTSBX460 00279 DTSBX460 00280 PERFORM I2000-OPEN-FILES-1 THRU I2000-EXIT. DTSBX460 00281 DTSBX460 00282 PERFORM I3000-LOAD-TABLE THRU I3000-EXIT. DTSBX460 00283 DTSBX460 00284 SKIP2 DTSBX460 00285 I0000-EXIT. DTSBX460 00286 EXIT. DTSBX460 00287 I2000-OPEN-FILES-1. DTSBX460 00288 MOVE WRK-TRACE-IND TO L910-TRACE-IND DTSBX460 00289 L921-TRACE-IND. DTSBX460 00290 DTSBX460 00291 MOVE WRK-MOD-NAME TO L910-MOD-NAME DTSBX460 00292 L921-MOD-NAME. DTSBX460 00293 OPEN INPUT OTR-PRIOR-FILE. DTSBX460 00294 OPEN OUTPUT OTR-CURR-FILE OTR-TRANS-FILE. DTSBX460 00295 DTSBX460 00296 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBX460 00297 PERFORM S921-OPEN-READ THRU S921-EXIT. DTSBX460 00298 DTSBX460 00299 SET WRK-READ-INPUT-PRIOR-YES TO TRUE. DTSBX460 00300 PERFORM P7000-READ-RECYCLE-FILE THRU P7000-EXIT. DTSBX460 00301 DTSBX460 00302 I2000-EXIT. DTSBX460 00303 EXIT. DTSBX460 00304 DTSBX460 00305 I3000-LOAD-TABLE. DTSBX460 00306 DTSBX460 00307 MOVE +0 TO WRK-TABLE-LOAD-CNT. DTSBX460 00308 DTSBX460 00309 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBX460 00310 DTSBX460 00311 MOVE +0 TO MSKL-EMP-NO. DTSBX460 00312 DTSBX460 00313 SET MSKL-PRF-88 TO TRUE. DTSBX460 00314 DTSBX460 00315 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX460 00316 IF L910-OK-88 DTSBX460 00317 MOVE MSKL-REC TO MPRF-REC DTSBX460 00318 SET WRK-MPRF-OK TO TRUE DTSBX460 00319 ELSE DTSBX460 00320 DISPLAY 'BAD INITIAL FIRST READ ' L910-RESULT-IND DTSBX460 00321 SET L910-NO-REC-88 TO TRUE DTSBX460 00322 GO TO I3000-EXIT. DTSBX460 00323 DTSBX460 00324 DISPLAY SPACE. DTSBX460 00325 DISPLAY 'EXTRACT EMPLOYER NO. AND FEIN LOADS INTO THE TABLE'.DTSBX460 00326 DISPLAY SPACE. DTSBX460 00327 DTSBX460 00328 SET MPRF-TBL-IDX TO 1. DTSBX460 00329 PERFORM I4000-READ-NEXT THRU I4000-EXIT DTSBX460 00330 UNTIL WRK-MPRF-NO-REC. DTSBX460 00331 DTSBX460 00332 DISPLAY 'FEIN TABLE LOADED. NUMBER OF ENTRIES = ' DTSBX460 00333 WRK-TABLE-LOAD-CNT. DTSBX460 00334 I3000-EXIT. DTSBX460 00335 EXIT. DTSBX460 00336 DTSBX460 00337 I4000-READ-NEXT. DTSBX460 00338 IF MPRF-CLASS-SUB-88 DTSBX460 00339 AND MPRF-STATUS-ACT-88 DTSBX460 00340 IF MPRF-FEIN > ZEROS DTSBX460 00341 MOVE MPRF-EMP-NO TO TBL-EMP-NO (MPRF-TBL-IDX) DTSBX460 00342 MOVE MPRF-FEIN TO TBL-FEIN (MPRF-TBL-IDX) DTSBX460 00343 DTSBX460 00344 * DISPLAY 'EMP-NO, FEIN & STATUS ' TBL-EMP-NO (MPRF-TBL-IDX) DTSBX460 00345 * ' ' TBL-FEIN (MPRF-TBL-IDX) ' ' MPRF-EMP-STATUS DTSBX460 00346 IF MPRF-STATUS-ACT-88 DTSBX460 00347 ADD +1 TO WRK-MPRF-ACT-CNT DTSBX460 00348 ELSE DTSBX460 00349 ADD +1 TO WRK-MPRF-INACT-CNT DTSBX460 00350 END-IF DTSBX460 00351 DTSBX460 00352 ADD +1 TO WRK-TABLE-LOAD-CNT DTSBX460 00353 IF WRK-TABLE-LOAD-CNT > TBL-LEN-MAX DTSBX460 00354 DISPLAY 'BTSBX460 I4000: TABLE LEN EXCEEDED ' DTSBX460 00355 WRK-TABLE-LOAD-CNT DTSBX460 00356 PERFORM S999-ABEND THRU S999-EXIT DTSBX460 00357 END-IF DTSBX460 00358 SET MPRF-TBL-IDX UP BY 1 DTSBX460 00359 ELSE DTSBX460 00360 NEXT SENTENCE DTSBX460 00361 ELSE DTSBX460 00362 ADD +1 TO WRK-OTHER-CLASS-CNT. DTSBX460 00363 DTSBX460 00364 * IT IS OK TO ASTERICK THE THREE LINES BELOW, BECAUSE THE ONLY DTSBX460 00365 * MPRF REC INVOLVED. DTSBX460 00366 DTSBX460 00367 * MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBX460 00368 * MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBX460 00369 * SET MSKL-PRF-88 TO TRUE. DTSBX460 00370 DTSBX460 00371 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBX460 00372 IF NOT L910-OK-88 DTSBX460 00373 SET WRK-MPRF-NO-REC TO TRUE DTSBX460 00374 ELSE DTSBX460 00375 MOVE MSKL-REC TO MPRF-REC. DTSBX460 00376 DTSBX460 00377 I4000-EXIT. DTSBX460 00378 EXIT. DTSBX460 00379 DTSBX460 00380 P0000-PROCESS. DTSBX460 00381 DTSBX460 00382 MOVE +0 TO WRK-MPRF-CNT. DTSBX460 00383 DTSBX460 00384 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBX460 00385 DTSBX460 00386 MOVE +0 TO MSKL-EMP-NO. DTSBX460 00387 DTSBX460 00388 SET MSKL-PRF-88 TO TRUE. DTSBX460 00389 DTSBX460 00390 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX460 00391 IF L910-OK-88 DTSBX460 00392 MOVE MSKL-REC TO MPRF-REC DTSBX460 00393 SET WRK-MPRF-OK TO TRUE DTSBX460 00394 ELSE DTSBX460 00395 DISPLAY 'BAD FIRST READ ' L910-RESULT-IND DTSBX460 00396 SET L910-NO-REC-88 TO TRUE DTSBX460 00397 GO TO P0000-EXIT. DTSBX460 00398 DTSBX460 00399 DISPLAY 'IDENTIFY CLASS SUBJECT AND PROCESSING BEGIN'. DTSBX460 00400 DISPLAY SPACE. DTSBX460 00401 DTSBX460 00402 PERFORM P1000-READ-NEXT THRU P1000-EXIT DTSBX460 00403 UNTIL WRK-MPRF-NO-REC. DTSBX460 00404 DTSBX460 00405 P0000-EXIT. DTSBX460 00406 EXIT. DTSBX460 00407 EJECT DTSBX460 00408 P1000-READ-NEXT. DTSBX460 00409 DTSBX460 00410 ADD +1 TO WRK-MPRF-CNT DTSBX460 00411 DTSBX460 00412 IF MPRF-CLASS-SUB-88 DTSBX460 00413 IF MPRF-FEIN > ZEROS DTSBX460 00414 SET WRK-EMP-SELECTED-NO TO TRUE DTSBX460 00415 PERFORM P2000-FIND-ADDRESS THRU P2000-EXIT DTSBX460 00416 PERFORM P3000-FIND-OPO THRU P3000-EXIT DTSBX460 00417 PERFORM P4000-FIND-SUCCESSOR THRU P4000-EXIT DTSBX460 00418 PERFORM P5000-FIND-SOL THRU P5000-EXIT DTSBX460 00419 IF WRK-EMP-SELECTED-YES DTSBX460 00420 PERFORM P6000-WRITE-CURR-OTR-REC THRU P6000-EXIT. DTSBX460 00421 DTSBX460 00422 * IT MUST RESET THE KEY AREA, BECAUSE MSKL-REC HAD BEEN USED DTSBX460 00423 * TO FIND ADDRESS, OPO, AND SOL ETC. DTSBX460 00424 DTSBX460 00425 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBX460 00426 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBX460 00427 SET MSKL-PRF-88 TO TRUE. DTSBX460 00428 DTSBX460 00429 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBX460 00430 IF NOT L910-OK-88 DTSBX460 00431 MOVE 999999 TO CURR-EMP-NO DTSBX460 00432 PERFORM P6100-COMPARE-RECYCLE-REC THRU P6100-EXIT DTSBX460 00433 UNTIL WRK-READ-INPUT-PRIOR-END-YES DTSBX460 00434 SET WRK-MPRF-NO-REC TO TRUE DTSBX460 00435 ELSE DTSBX460 00436 MOVE MSKL-REC TO MPRF-REC. DTSBX460 00437 DTSBX460 00438 P1000-EXIT. DTSBX460 00439 EXIT. DTSBX460 00440 DTSBX460 00441 P2000-FIND-ADDRESS. DTSBX460 00442 DTSBX460 00443 MOVE LOW-VALUE TO MTAD-REC. DTSBX460 00444 MOVE MPRF-EMP-NO TO MTAD-EMP-NO. DTSBX460 00445 SET MTAD-TAD-88 TO TRUE. DTSBX460 00446 DTSBX460 00447 IF MPRF-TAX-REC-ADDR-NO-88 DTSBX460 00448 SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE DTSBX460 00449 ELSE DTSBX460 00450 SET MTAD-ID-TAX-RECORDS-ADDR-88 TO TRUE. DTSBX460 00451 DTSBX460 00452 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSBX460 00453 PERFORM S910-READ THRU S910-EXIT. DTSBX460 00454 IF L910-NO-REC-88 DTSBX460 00455 GO TO P2000-EXIT. DTSBX460 00456 DTSBX460 00457 MOVE MSKL-REC TO MTAD-REC. DTSBX460 00458 MOVE MTAD-VOICE-1-AREA-CD TO CURR-TEL-AREA-CD. DTSBX460 00459 MOVE MTAD-VOICE-1-PREFIX TO CURR-TEL-PREFIX. DTSBX460 00460 MOVE MTAD-VOICE-1-SUFFIX TO CURR-TEL-SUFFIX. DTSBX460 00461 MOVE MTAD-VOICE-1-EXT TO CURR-TEL-EXT. DTSBX460 00462 MOVE MTAD-ATTN-LINE TO CURR-ADDR-ATTN-LINE. DTSBX460 00463 MOVE MTAD-DELIV-LINE-1 TO CURR-ADDR-LINE1. DTSBX460 00464 MOVE MTAD-DELIV-LINE-2 TO CURR-ADDR-LINE2. DTSBX460 00465 MOVE MTAD-CITY TO CURR-CITY. DTSBX460 00466 MOVE MTAD-ST TO CURR-STATE. DTSBX460 00467 MOVE MTAD-ZIP TO CURR-ZIP-CODE. DTSBX460 00468 * DISPLAY 'P2000-FIND-ADDR ZIP ' MTAD-ZIP. DTSBX460 00469 DTSBX460 00470 P2000-EXIT. DTSBX460 00471 EXIT. DTSBX460 00472 DTSBX460 00473 P3000-FIND-OPO. DTSBX460 00474 DTSBX460 00475 MOVE LOW-VALUES TO MOPO-KEY-AREA. DTSBX460 00476 MOVE MPRF-EMP-NO TO MOPO-EMP-NO. DTSBX460 00477 SET MOPO-OPO-88 TO TRUE. DTSBX460 00478 MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA. DTSBX460 00479 DTSBX460 00480 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX460 00481 IF L910-NO-REC-88 DTSBX460 00482 GO TO P3000-EXIT. DTSBX460 00483 DTSBX460 00484 MOVE MSKL-REC TO MOPO-REC DTSBX460 00485 DTSBX460 00486 MOVE MOPO-NAME TO CURR-OPO-NAME DTSBX460 00487 MOVE MOPO-VOICE-1-AREA-CD TO CURR-OPO-TEL-AREA-CD DTSBX460 00488 MOVE MOPO-VOICE-1-PREFIX TO CURR-OPO-TEL-PREFIX DTSBX460 00489 MOVE MOPO-VOICE-1-SUFFIX TO CURR-OPO-TEL-SUFFIX DTSBX460 00490 MOVE MOPO-VOICE-1-EXT TO CURR-OPO-TEL-EXT. DTSBX460 00491 DTSBX460 00492 * DISPLAY 'P3000 MPRF-EMP-NO & MOPO-NAME ' MPRF-EMP-NO DTSBX460 00493 * ' ' MOPO-NAME ' ' MOPO-VOICE-1-AREA-CD DTSBX460 00494 * ' ' MOPO-VOICE-1-PREFIX ' ' MOPO-VOICE-1-SUFFIX DTSBX460 00495 * ' ' MOPO-VOICE-1-EXT. DTSBX460 00496 P3000-EXIT. DTSBX460 00497 EXIT. DTSBX460 00498 DTSBX460 00499 P4000-FIND-SUCCESSOR. DTSBX460 00500 DTSBX460 00501 IF MPRF-STATUS-INACT-88 DTSBX460 00502 MOVE MPRF-EMP-NO TO L600-EMP-NO DTSBX460 00503 MOVE +999999999 TO L600-EXP-TRN-EFF-DATE DTSBX460 00504 CALL 'DTSBU600' USING L600-LINK-AREA DTSBX460 00505 ELSE DTSBX460 00506 GO TO P4000-EXIT. DTSBX460 00507 DTSBX460 00508 IF L600-NO-SUCCESSOR-88 DTSBX460 00509 NEXT SENTENCE DTSBX460 00510 ELSE DTSBX460 00511 MOVE L600-ULTIMATE-SUCCESSOR TO WRK-SUCCESSOR-FEIN. DTSBX460 00512 DTSBX460 00513 IF L600-SUCCESSOR-FOUND-88 DTSBX460 00514 PERFORM P4100-SEARCH-TABLE THRU P4100-EXIT DTSBX460 00515 ADD +1 TO WRK-SUCC-CNT DTSBX460 00516 * DISPLAY 'P4000 SUCCESSOR FEIN FIND ' WRK-SUCCESSOR-FEIN DTSBX460 00517 ELSE DTSBX460 00518 MOVE SPACES TO CURR-SUCCESSOR-FEIN DTSBX460 00519 END-IF. DTSBX460 00520 DTSBX460 00521 DTSBX460 00522 P4000-EXIT. DTSBX460 00523 EXIT. DTSBX460 00524 DTSBX460 00525 P4100-SEARCH-TABLE. DTSBX460 00526 DTSBX460 00527 PERFORM DTSBX460 00528 VARYING MPRF-TBL-IDX FROM +1 BY +1 DTSBX460 00529 UNTIL MPRF-TBL-IDX > WRK-TABLE-LOAD-CNT DTSBX460 00530 IF TBL-EMP-NO (MPRF-TBL-IDX) = L600-ULTIMATE-SUCCESSORDTSBX460 00531 MOVE TBL-FEIN (MPRF-TBL-IDX) DTSBX460 00532 TO CURR-SUCCESSOR-FEIN DTSBX460 00533 GO TO P4100-EXIT DTSBX460 00534 END-IF DTSBX460 00535 END-PERFORM. DTSBX460 00536 DTSBX460 00537 P4100-EXIT. DTSBX460 00538 EXIT. DTSBX460 00539 DTSBX460 00540 P5000-FIND-SOL. DTSBX460 00541 DTSBX460 00542 MOVE +999999999 TO WRK-LIAB-DATE. DTSBX460 00543 SET WRK-MSOL-OK TO TRUE. DTSBX460 00544 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBX460 00545 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBX460 00546 SET MSKL-SOL-88 TO TRUE. DTSBX460 00547 DTSBX460 00548 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX460 00549 DTSBX460 00550 IF L910-NO-REC-88 DTSBX460 00551 DISPLAY 'P5000 BAD MSOL FIRST BROWSE ' L910-RESULT-IND DTSBX460 00552 GO TO P5000-EXIT DTSBX460 00553 ELSE DTSBX460 00554 PERFORM P5100-SCAN-MSOL THRU P5100-EXIT DTSBX460 00555 UNTIL WRK-MSOL-NO-REC. DTSBX460 00556 DTSBX460 00557 IF WRK-LIAB-DATE EQUAL +999999999 DTSBX460 00558 * MOVE +0 TO WRK-LIAB-DATE DTSBX460 00559 * DISPLAY 'LIAB-DATE EQUAL ZEROS ' WRK-LIAB-DATE ' ' DTSBX460 00560 * MPRF-FEIN ' ' MPRF-EMP-STATUS DTSBX460 00561 ADD +1 TO WRK-LIAB-DATE-9-CNT DTSBX460 00562 IF PREV-EMP-NO = 999999 DTSBX460 00563 SET WRK-EMP-SELECTED-NO TO TRUE DTSBX460 00564 ELSE DTSBX460 00565 *** PERFORM P9000-WRITE-TRANS-DEL THRU P9000-EXIT DTSBX460 00566 SET WRK-EMP-SELECTED-NO TO TRUE DTSBX460 00567 END-IF DTSBX460 00568 ELSE DTSBX460 00569 SET WRK-EMP-SELECTED-YES TO TRUE. DTSBX460 00570 DTSBX460 00571 P5000-EXIT. DTSBX460 00572 EXIT. DTSBX460 00573 DTSBX460 00574 P5100-SCAN-MSOL. DTSBX460 00575 DTSBX460 00576 MOVE MSKL-REC TO MSOL-REC. DTSBX460 00577 DTSBX460 00578 IF MSOL-INACT-WITHDRAWN-88 DTSBX460 00579 NEXT SENTENCE DTSBX460 00580 * ADD +1 TO WRK-INACT-WITHDRAWN-CNT DTSBX460 00581 ELSE DTSBX460 00582 IF MSOL-LIAB-DATE < WRK-LIAB-DATE DTSBX460 00583 MOVE MSOL-LIAB-DATE TO WRK-LIAB-DATE. DTSBX460 00584 ** DISPLAY 'P5100 MSOL SCAN LIAB-DATE ' MSOL-LIAB-DATE. DTSBX460 00585 DTSBX460 00586 *** MOVE MSOL-REC TO MSKL-REC. DTSBX460 00587 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBX460 00588 IF L910-NO-REC-88 DTSBX460 00589 SET WRK-MSOL-NO-REC TO TRUE. DTSBX460 00590 DTSBX460 00591 P5100-EXIT. DTSBX460 00592 EXIT. DTSBX460 00593 DTSBX460 00594 P6000-WRITE-CURR-OTR-REC. DTSBX460 00595 DTSBX460 00596 MOVE WRK-LIAB-DATE TO CURR-EMPL-LIAB-DATE. DTSBX460 00597 DTSBX460 00598 MOVE MPRF-FEIN TO CURR-EMPL-FEIN. DTSBX460 00599 MOVE MPRF-EMP-STATUS TO CURR-EMPL-ACT-IND. DTSBX460 00600 MOVE MPRF-EMP-NO TO CURR-EMP-NO. DTSBX460 00601 DTSBX460 00602 IF MPRF-PRIMARY-IS-ENTITY-88 DTSBX460 00603 MOVE MPRF-PRIMARY-NAME TO CURR-EMPL-BUS-NAME DTSBX460 00604 MOVE SPACES TO CURR-EMPL-TRADE-NAME DTSBX460 00605 ELSE DTSBX460 00606 IF MPRF-ENTITY-NAME EQUAL LOW-VALUES DTSBX460 00607 MOVE SPACES TO CURR-EMPL-BUS-NAME DTSBX460 00608 ELSE DTSBX460 00609 MOVE MPRF-ENTITY-NAME TO CURR-EMPL-BUS-NAME DTSBX460 00610 END-IF DTSBX460 00611 MOVE MPRF-PRIMARY-NAME TO CURR-EMPL-TRADE-NAME DTSBX460 00612 END-IF. DTSBX460 00613 DTSBX460 00614 ADD +1 TO WRK-OTR-CURR-CNT. DTSBX460 00615 MOVE +999999999 TO WRK-LIAB-DATE. DTSBX460 00616 ** DTSBX460 00617 SET WRK-READ-INPUT-MPRF-NO TO TRUE. DTSBX460 00618 PERFORM P6100-COMPARE-RECYCLE-REC THRU P6100-EXIT DTSBX460 00619 UNTIL WRK-READ-INPUT-MPRF-YES. DTSBX460 00620 ** DTSBX460 00621 P6000-EXIT. DTSBX460 00622 EXIT. DTSBX460 00623 DTSBX460 00624 P6100-COMPARE-RECYCLE-REC. DTSBX460 00625 DTSBX460 00626 IF CURR-EMP-NO < PREV-EMP-NO DTSBX460 00627 * DISPLAY 'P6100 CURR-EMP-NO < PREV-EMP-NO ' DTSBX460 00628 * CURR-EMP-NO ' ' PREV-EMP-NO DTSBX460 00629 MOVE 'A' TO TRANS-UPDATE-CODE DTSBX460 00630 PERFORM P8000-WRITE-TRANS-ADD THRU P8000-EXIT DTSBX460 00631 PERFORM P9500-WRITE-RECYCLE-REC THRU P9500-EXIT DTSBX460 00632 SET WRK-READ-INPUT-MPRF-YES TO TRUE DTSBX460 00633 INITIALIZE WRK-CURR-REC DTSBX460 00634 ELSE DTSBX460 00635 IF PREV-EMP-NO < CURR-EMP-NO DTSBX460 00636 * INITIALIZE WRK-TRANS-REC DTSBX460 00637 * MOVE 'D' TO TRANS-UPDATE-CODE DTSBX460 00638 * MOVE PREV-EMPL-FEIN TO TRANS-EMPL-FEIN DTSBX460 00639 PERFORM P9000-WRITE-TRANS-DEL THRU P9000-EXIT DTSBX460 00640 SET WRK-READ-INPUT-PRIOR-YES TO TRUE DTSBX460 00641 PERFORM P7000-READ-RECYCLE-FILE THRU P7000-EXIT DTSBX460 00642 ELSE DTSBX460 00643 IF WRK-CURR-REC = WRK-PREV-REC DTSBX460 00644 * DISPLAY 'P6100 WRK-CURR-REC = WRK-PREV-REC ' DTSBX460 00645 * CURR-EMP-NO ' ' PREV-EMP-NO DTSBX460 00646 PERFORM P9500-WRITE-RECYCLE-REC THRU P9500-EXIT DTSBX460 00647 INITIALIZE WRK-CURR-REC DTSBX460 00648 SET WRK-READ-INPUT-PRIOR-YES TO TRUE DTSBX460 00649 PERFORM P7000-READ-RECYCLE-FILE THRU P7000-EXIT DTSBX460 00650 SET WRK-READ-INPUT-MPRF-YES TO TRUE DTSBX460 00651 ELSE DTSBX460 00652 MOVE 'C' TO TRANS-UPDATE-CODE DTSBX460 00653 PERFORM P8500-WRITE-TRANS-CHG THRU P8500-EXIT DTSBX460 00654 PERFORM P9500-WRITE-RECYCLE-REC THRU P9500-EXIT DTSBX460 00655 INITIALIZE WRK-CURR-REC DTSBX460 00656 SET WRK-READ-INPUT-PRIOR-YES TO TRUE DTSBX460 00657 PERFORM P7000-READ-RECYCLE-FILE THRU P7000-EXIT DTSBX460 00658 SET WRK-READ-INPUT-MPRF-YES TO TRUE DTSBX460 00659 END-IF DTSBX460 00660 END-IF DTSBX460 00661 END-IF. DTSBX460 00662 DTSBX460 00663 P6100-EXIT. DTSBX460 00664 EXIT. DTSBX460 00665 DTSBX460 00666 P7000-READ-RECYCLE-FILE. DTSBX460 00667 DTSBX460 00668 IF WRK-READ-INPUT-PRIOR-YES DTSBX460 00669 SET WRK-READ-INPUT-PRIOR-NO TO TRUE DTSBX460 00670 READ OTR-PRIOR-FILE INTO WRK-PREV-REC DTSBX460 00671 AT END MOVE 999999 TO PREV-EMP-NO DTSBX460 00672 SET WRK-READ-INPUT-PRIOR-END-YES TO TRUE DTSBX460 00673 GO TO P7000-EXIT. DTSBX460 00674 ADD +1 TO WRK-OTR-READ-PRIOR-CNT. DTSBX460 00675 DTSBX460 00676 P7000-EXIT. DTSBX460 00677 EXIT. DTSBX460 00678 DTSBX460 00679 P8000-WRITE-TRANS-ADD. DTSBX460 00680 DTSBX460 00681 MOVE WRK-CURR-REC TO WRK-OTR-TRANS-REC. DTSBX460 00682 WRITE OTR-TRANS-REC FROM WRK-TRANS-REC. DTSBX460 00683 ADD +1 TO WRK-OTR-TRANS-ADD-CNT. DTSBX460 00684 DTSBX460 00685 P8000-EXIT. DTSBX460 00686 EXIT. DTSBX460 00687 DTSBX460 00688 P8500-WRITE-TRANS-CHG. DTSBX460 00689 DTSBX460 00690 MOVE WRK-CURR-REC TO WRK-OTR-TRANS-REC. DTSBX460 00691 WRITE OTR-TRANS-REC FROM WRK-TRANS-REC. DTSBX460 00692 ADD +1 TO WRK-OTR-TRANS-CHG-CNT. DTSBX460 00693 DTSBX460 00694 P8500-EXIT. DTSBX460 00695 EXIT. DTSBX460 00696 DTSBX460 00697 P9000-WRITE-TRANS-DEL. DTSBX460 00698 DTSBX460 00699 * MOVE WRK-PREV-REC TO WRK-OTR-TRANS-REC. DTSBX460 00700 INITIALIZE WRK-TRANS-REC DTSBX460 00701 MOVE 'D' TO TRANS-UPDATE-CODE DTSBX460 00702 MOVE PREV-EMPL-FEIN TO TRANS-EMPL-FEIN DTSBX460 00703 WRITE OTR-TRANS-REC FROM WRK-TRANS-REC. DTSBX460 00704 ADD +1 TO WRK-OTR-TRANS-DEL-CNT. DTSBX460 00705 DTSBX460 00706 P9000-EXIT. DTSBX460 00707 EXIT. DTSBX460 00708 DTSBX460 00709 P9500-WRITE-RECYCLE-REC. DTSBX460 00710 DTSBX460 00711 WRITE OTR-CURR-REC FROM WRK-CURR-REC. DTSBX460 00712 ADD +1 TO WRK-OTR-WRITE-CURR-CNT. DTSBX460 00713 DTSBX460 00714 P9500-EXIT. DTSBX460 00715 EXIT. DTSBX460 00716 DTSBX460 00717 T0000-TERMINATE. DTSBX460 00718 DTSBX460 00719 DISPLAY ' '. DTSBX460 00720 DTSBX460 00721 DISPLAY '*** DTSBX460 TERMINATION STATISTICS ***'. DTSBX460 00722 DTSBX460 00723 DISPLAY ' '. DTSBX460 00724 DTSBX460 00725 DISPLAY 'MASTER FILE RECORDS READ : ' DTSBX460 00726 WRK-MPRF-CNT. DTSBX460 00727 DTSBX460 00728 DISPLAY ' '. DTSBX460 00729 DTSBX460 00730 DISPLAY 'TABLE LOADING CLASS-SUB & FEIN > ZERO CNT : ' DTSBX460 00731 WRK-TABLE-LOAD-CNT. DTSBX460 00732 DTSBX460 00733 DISPLAY 'MPRF STATUS ACTIVE RECORDS COUNT : ' DTSBX460 00734 WRK-MPRF-ACT-CNT. DTSBX460 00735 DTSBX460 00736 DISPLAY 'MPRF STATUS INACTIVE RECORDS COUNT : ' DTSBX460 00737 WRK-MPRF-INACT-CNT. DTSBX460 00738 DTSBX460 00739 DISPLAY ' '. DTSBX460 00740 DTSBX460 00741 DISPLAY 'RECYCLE INPUT FILE RECORDS READ COUNT : ' DTSBX460 00742 WRK-OTR-READ-PRIOR-CNT. DTSBX460 00743 DTSBX460 00744 DISPLAY ' '. DTSBX460 00745 DTSBX460 00746 DISPLAY 'TRANSACTION FILE OUTPUT REC ADD COUNT : ' DTSBX460 00747 WRK-OTR-TRANS-ADD-CNT. DTSBX460 00748 DTSBX460 00749 DISPLAY 'TRANSACTION FILE OUTPUT REC CHANGE COUNT : ' DTSBX460 00750 WRK-OTR-TRANS-CHG-CNT. DTSBX460 00751 DTSBX460 00752 DISPLAY 'TRANSACTION FILE OUTPUT REC DELETE COUNT : ' DTSBX460 00753 WRK-OTR-TRANS-DEL-CNT. DTSBX460 00754 DTSBX460 00755 DISPLAY ' '. DTSBX460 00756 DTSBX460 00757 DISPLAY 'CURR-RECYCLE OUTPUT FILE RECS WRITTEN CNT : ' DTSBX460 00758 WRK-OTR-WRITE-CURR-CNT. DTSBX460 00759 DTSBX460 00760 DISPLAY 'MSOL-INACT-WITHDRAWN COUNT : ' DTSBX460 00761 WRK-LIAB-DATE-9-CNT. DTSBX460 00762 DTSBX460 00763 CLOSE OTR-PRIOR-FILE OTR-CURR-FILE OTR-TRANS-FILE. DTSBX460 00764 DTSBX460 00765 PERFORM S910-CLOSE THRU S910-EXIT. DTSBX460 00766 PERFORM S921-CLOSE THRU S921-EXIT. DTSBX460 00767 DTSBX460 00768 T0000-EXIT. DTSBX460 00769 EXIT. DTSBX460 00770 EJECT DTSBX460 00771 S001-FROM-FED-8. DTSBX460 00772 SET L001-FROM-FED-8 TO TRUE. DTSBX460 00773 GO TO S001-DATE. DTSBX460 00774 DTSBX460 00775 S001-DATE. DTSBX460 00776 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX460 00777 DTSBX460 00778 S001-EXIT. DTSBX460 00779 EXIT. DTSBX460 00780 SKIP3 DTSBX460 00781 S004-EDIT-QTR. DTSBX460 00782 CALL 'DTSBU004' USING L004-COMM-AREA. DTSBX460 00783 DTSBX460 00784 S004-EXIT. DTSBX460 00785 EXIT. DTSBX460 00786 SKIP3 DTSBX460 00787 S516-LIABILITY. DTSBX460 00788 CALL 'DTSBU516' USING L516-LINK-AREA DTSBX460 00789 MPRF-REC. DTSBX460 00790 DTSBX460 00791 S516-EXIT. DTSBX460 00792 EXIT. DTSBX460 00793 SKIP3 DTSBX460 00794 S910-OPEN-READ. DTSBX460 00795 SET L910-OPEN-READ-88 TO TRUE. DTSBX460 00796 GO TO S910-MSTR-IO. DTSBX460 00797 DTSBX460 00798 S910-OPEN-UPDATE. DTSBX460 00799 SET L910-OPEN-UPDATE-88 TO TRUE. DTSBX460 00800 GO TO S910-MSTR-IO. DTSBX460 00801 DTSBX460 00802 S910-OPEN-UPDATE-NO-AIX. DTSBX460 00803 SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE. DTSBX460 00804 GO TO S910-MSTR-IO. DTSBX460 00805 DTSBX460 00806 S910-READ. DTSBX460 00807 SET L910-READ-88 TO TRUE. DTSBX460 00808 GO TO S910-MSTR-IO. DTSBX460 00809 DTSBX460 00810 S910-START-BROWSE. DTSBX460 00811 SET L910-START-BROWSE-88 TO TRUE. DTSBX460 00812 GO TO S910-MSTR-IO. DTSBX460 00813 DTSBX460 00814 S910-READ-NEXT. DTSBX460 00815 SET L910-READ-NEXT-88 TO TRUE. DTSBX460 00816 GO TO S910-MSTR-IO. DTSBX460 00817 DTSBX460 00818 S910-COUNT. DTSBX460 00819 SET L910-COUNT-88 TO TRUE. DTSBX460 00820 GO TO S910-MSTR-IO. DTSBX460 00821 DTSBX460 00822 S910-REWRITE. DTSBX460 00823 SET L910-REWRITE-88 TO TRUE. DTSBX460 00824 GO TO S910-MSTR-IO. DTSBX460 00825 DTSBX460 00826 S910-DELETE. DTSBX460 00827 SET L910-DELETE-88 TO TRUE. DTSBX460 00828 GO TO S910-MSTR-IO. DTSBX460 00829 DTSBX460 00830 S910-CLOSE. DTSBX460 00831 SET L910-CLOSE-88 TO TRUE. DTSBX460 00832 GO TO S910-MSTR-IO. DTSBX460 00833 DTSBX460 00834 S910-MSTR-IO. DTSBX460 00835 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX460 00836 MSKL-REC. DTSBX460 00837 S910-EXIT. DTSBX460 00838 EXIT. DTSBX460 00839 SKIP3 DTSBX460 00840 S921-OPEN-READ. DTSBX460 00841 SET L921-OPEN-READ-88 TO TRUE. DTSBX460 00842 GO TO S921-AIX-IO. DTSBX460 00843 DTSBX460 00844 S921-OPEN-UPDATE. DTSBX460 00845 SET L921-OPEN-UPDATE-88 TO TRUE. DTSBX460 00846 GO TO S921-AIX-IO. DTSBX460 00847 DTSBX460 00848 S921-CLOSE. DTSBX460 00849 SET L921-CLOSE-88 TO TRUE. DTSBX460 00850 GO TO S921-AIX-IO. DTSBX460 00851 DTSBX460 00852 S921-AIX-IO. DTSBX460 00853 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX460 00854 ISKL-REC. DTSBX460 00855 S921-EXIT. DTSBX460 00856 EXIT. DTSBX460 00857 SKIP3 DTSBX460 00858 S999-ABEND. DTSBX460 00859 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX460 00860 S999-EXIT. DTSBX460 00861 EXIT. DTSBX460