00001 IDENTIFICATION DIVISION. 10/17/13 00002 PROGRAM-ID. DTSBX340. DTSBX340 00003 AUTHOR. NGC. LV015 00004 DATE-WRITTEN. OCTOBER 2007. DTSBX340 00005 DATE-COMPILED. DTSBX340 00006 SKIP3 DTSBX340 00007 ***** DTSBX340 00008 * DTSBX340 00009 * FUNCTION: INTERNAL WEB MAINFRAME EXTRACT DRIVER DTSBX340 00010 * DTSBX340 00011 * DTSBX340 00012 * MODIFICATION LOG: DTSBX340 00013 * DTSBX340 00014 * 10/22/2007 INITIAL DEVELOPMENT. DTSBX340 00015 * REFERENCE: PROGRAMMER: GD DTSBX340 00016 * DTSBX340 00017 * 02/12/2009 ADDED CALL TO DTSBX346 FOR BENEFIT CHARGES. DTSBX340 00018 * REFERENCE: PROGRAMMER: GD DTSBX340 00019 * DTSBX340 00020 * 03/23/2009 MODIFIED I4000 TO INCLUDE ACCOUNTING DTSBX340 00021 * DATA FOR EMPLOYERS INACTIVE MORE THAN 3 YEARS DTSBX340 00022 * IF THERE HAS BEEN ANY ACCOUNTING ACTIVITY. DTSBX340 00023 * DURING THE LAST YEAR. DTSBX340 00024 * THE CHANGE IS TO W-JRN-ABSTIME. DTSBX340 00025 * REFERENCE: PROGRAMMER: GD DTSBX340 00026 * DTSBX340 00027 * 06/05/2009 MODIFIED P1100 TO EXTRACT THE PROFILE RECORD DTSBX340 00028 * FOR ALL CHARGE-ONLY ACCOUNTS. DTSBX340 00029 * THESE ACCOUNTS ARE NEEDED ON THE WEB DATABASE. DTSBX340 00030 * REFERENCE: PROGRAMMER: GD DTSBX340 00031 * DTSBX340 00032 * 12/31/2009 MODIFIED P1100 TO EXTRACT DATA FOR ACCOUNTS DTSBX340 00033 * WITH STATUS = UNKNOWN. DTSBX340 00034 * THESE ACCOUNTS ARE NEEDED ON THE WEB DATABASE DTSBX340 00035 * FOR THE COMPLIANCE PROCESS. DTSBX340 00036 * REFERENCE: PROGRAMMER: GD DTSBX340 00037 * DTSBX340 00038 * DTSBX340 00039 * 02/10/2012 MODIFIED I1100 TO WRITE HOLIDAYS TO A FILE DTSBX340 00040 * REFERENCE: PROGRAMMER: ZL1 DTSBX340 00041 * DTSBX340 00042 * 10/10/2013 REMOVED CALL TO BX346 FOR CHARGES DTSBX340 00043 * REFERENCE: PROGRAMMER: ZL1 DTSBX340 00044 * DTSBX340 00045 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX340 00046 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX340 00047 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBX340 00048 * DTSBX340 00049 * DTSBX340 00050 * DESCRIPTION: DTSBX340 00051 * DTSBX340 00052 * DTSBX340 00053 * INITIATION: DTSBX340 00054 * DTSBX340 00055 * SET LECM-MST-OPEN-READ-88 TO TRUE. DTSBX340 00056 * SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBX340 00057 * DTSBX340 00058 * EDIT AND DEFAULT PARAMETERS. DTSBX340 00059 * DTSBX340 00060 * DTSBX340 00061 * PROCESSING: DTSBX340 00062 * DTSBX340 00063 * DTSBX340 00064 * TERMINATION: DTSBX340 00065 * DTSBX340 00066 * DTSBX340 00067 * DTSBX340 00068 * RECORDS READ: DTSBX340 00069 * DTSBX340 00070 * MASTER: DTSBX340 00071 * DTSBX340 00072 * MSOL DTSBX340 00073 * MQTR DTSBX340 00074 * DTSBX340 00075 * DTSBX340 00076 * ALTERNATE INDEX: DTSBX340 00077 * DTSBX340 00078 * NONE. DTSBX340 00079 * DTSBX340 00080 * DTSBX340 00081 * REFERENCE: DTSBX340 00082 * DTSBX340 00083 * DTSBX340 00084 * DTSBX340 00085 * RECORDS UPDATED: DTSBX340 00086 * DTSBX340 00087 * NONE DTSBX340 00088 * DTSBX340 00089 * DTSBX340 00090 * OUTPUT RECORDS WRITTEN: DTSBX340 00091 * DTSBX340 00092 * DTSBX331 DTSBX340 00093 * DTSBX340 00094 * DTSBX340 00095 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBX340 00096 * DTSBX340 00097 * NONE. DTSBX340 00098 * DTSBX340 00099 * DTSBX340 00100 * MODULES CALLED: DTSBX340 00101 * DTSBX340 00102 * DTSBU001 DATE EDIT/CONVERSION. DTSBX340 00103 * DTSBU004 QUARTER EDIT/CONVERSION. DTSBX340 00104 * DTSBU910 MASTER FILE I/O. DTSBX340 00105 * DTSBX340 00106 * DTSBX340 00107 * DTSBX340 00108 ***** DTSBX340 00109 SKIP3 DTSBX340 00110 ENVIRONMENT DIVISION. DTSBX340 00111 INPUT-OUTPUT SECTION. DTSBX340 00112 FILE-CONTROL. DTSBX340 00113 SELECT SERVER-FILE ASSIGN TO DTSFSERV DTSBX340 00114 FILE STATUS IS SRVR-STATUS. DTSBX340 00115 DTSBX340 00116 DTSBX340 00117 DATA DIVISION. DTSBX340 00118 FILE SECTION. DTSBX340 00119 FD SERVER-FILE DTSBX340 00120 RECORDING MODE IS F DTSBX340 00121 LABEL RECORDS ARE STANDARD DTSBX340 00122 BLOCK CONTAINS 0 CHARACTERS. DTSBX340 00123 DTSBX340 00124 01 SERVER-REC. DTSBX340 00125 05 SRVR-EMP-NO PIC 9(06). DTSBX340 00126 DTSBX340 00127 DTSBX340 00128 WORKING-STORAGE SECTION. DTSBX340 001285 77 PAN-VALET PICTURE X(24) VALUE '015DTSBX340 10/17/13'. DTSBX340 00129 77 PAN-VALET PICTURE X(24) VALUE '002DTSBX340 10/10/13'. DTSBX340 00130 77 PAN-VALET PICTURE X(24) VALUE '013DTSBX340 03/12/12'. DTSBX340 00131 SKIP3 DTSBX340 00132 01 W-AREA. DTSBX340 00133 05 W-ABEND-CD PIC S9(04) COMP VALUE +340.DTSBX340 00134 DTSBX340 00135 05 W-TRACE-IND PIC X(01) VALUE SPACE. DTSBX340 00136 05 W-MOD-NAME PIC X(08) VALUE 'DTSBE340'.DTSBX340 00137 DTSBX340 00138 05 ABEND-MSG PIC X(60). DTSBX340 00139 DTSBX340 00140 05 SRVR-STATUS PIC X(02). DTSBX340 00141 88 SRVR-STATUS-OK-88 VALUE '00'. DTSBX340 00142 88 SRVR-STATUS-EOF-88 VALUE '10'. DTSBX340 00143 DTSBX340 00144 05 W-ERROR-IND PIC X(01) VALUE 'N'. DTSBX340 00145 88 W-ERROR-YES-88 VALUE 'Y'. DTSBX340 00146 88 W-ERROR-NO-88 VALUE 'N'. DTSBX340 00147 DTSBX340 00148 05 W-RUN-TYPE PIC X(01). DTSBX340 00149 88 W-RUN-CONVERT-88 VALUE '0'. DTSBX340 00150 88 W-RUN-INCREMENTAL-88 VALUE '1'. DTSBX340 00151 DTSBX340 00152 05 W-SELECT-IND PIC X(01) VALUE 'N'. DTSBX340 00153 88 W-SELECT-NO-88 VALUE '0'. DTSBX340 00154 88 W-SELECT-ALL-88 VALUE '1'. DTSBX340 00155 88 W-SELECT-UPD-88 VALUE '2'. DTSBX340 00156 88 W-SELECT-PRF-88 VALUE '3'. DTSBX340 00157 DTSBX340 00158 05 W-SELECT-NAME-IND PIC X(01). DTSBX340 00159 88 W-SELECT-NAME-YES-88 VALUE 'Y'. DTSBX340 00160 88 W-SELECT-NAME-NO-88 VALUE 'N'. DTSBX340 00161 05 W-SELECT-ADDR-IND PIC X(01). DTSBX340 00162 88 W-SELECT-ADDR-YES-88 VALUE 'Y'. DTSBX340 00163 88 W-SELECT-ADDR-NO-88 VALUE 'N'. DTSBX340 00164 05 W-SELECT-OPO-IND PIC X(01). DTSBX340 00165 88 W-SELECT-OPO-YES-88 VALUE 'Y'. DTSBX340 00166 88 W-SELECT-OPO-NO-88 VALUE 'N'. DTSBX340 00167 05 W-SELECT-SOL-IND PIC X(01). DTSBX340 00168 88 W-SELECT-SOL-YES-88 VALUE 'Y'. DTSBX340 00169 88 W-SELECT-SOL-NO-88 VALUE 'N'. DTSBX340 00170 05 W-SELECT-FSC-IND PIC X(01). DTSBX340 00171 88 W-SELECT-FSC-YES-88 VALUE 'Y'. DTSBX340 00172 88 W-SELECT-FSC-NO-88 VALUE 'N'. DTSBX340 00173 05 W-SELECT-RATE-IND PIC X(01). DTSBX340 00174 88 W-SELECT-RATE-YES-88 VALUE 'Y'. DTSBX340 00175 88 W-SELECT-RATE-NO-88 VALUE 'N'. DTSBX340 00176 DTSBX340 00177 ** 05 W-SUBJECT-DATE PIC S9(09) COMP-3 VALUE +0. DTSBX340 00178 05 W-CUTOFF-DATE PIC S9(09) COMP-3 DTSBX340 00179 VALUE +20020101. DTSBX340 00180 05 W-LAST-LIAB-YRQ PIC S9(05) COMP-3 VALUE +0. DTSBX340 00181 05 W-INACT-DATE PIC S9(09) COMP-3 VALUE +0. DTSBX340 00182 05 W-INACT-CUTOFF PIC S9(09) COMP-3 VALUE +0. DTSBX340 00183 05 W-JRN-ABSTIME PIC S9(15) COMP-3 VALUE +0. DTSBX340 00184 05 W-HOLD-EMP-NO PIC S9(07) COMP-3 VALUE +0. DTSBX340 00185 05 W-SUBJ-EMP-IND PIC X(01). DTSBX340 00186 88 W-SUBJ-EMP-YES-88 VALUE 'Y'. DTSBX340 00187 88 W-SUBJ-EMP-NO-88 VALUE 'N'. DTSBX340 00188 05 W-ACTIVE-JRN-IND PIC X(01). DTSBX340 00189 88 W-ACTIVE-JRN-YES-88 VALUE 'Y'. DTSBX340 00190 88 W-ACTIVE-JRN-NO-88 VALUE 'N'. DTSBX340 00191 DTSBX340 00192 05 W-MPRF-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX340 00193 05 W-SERVER-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX340 00194 05 W-SELECT-NO-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX340 00195 05 W-SELECT-PRF-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX340 00196 05 W-SELECT-ALL-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX340 00197 05 W-SELECT-UPD-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX340 00198 05 DISPLAY-CNT PIC Z(06)9. DTSBX340 00199 DTSBX340 00200 05 DISPLAY-AMT1-X PIC X(14). DTSBX340 00201 05 DISPLAY-AMT1 REDEFINES DISPLAY-AMT1-X DTSBX340 00202 PIC ---,---,--9.99. DTSBX340 00203 05 DISPLAY-AMT2-X PIC X(14). DTSBX340 00204 05 DISPLAY-AMT2 REDEFINES DISPLAY-AMT2-X DTSBX340 00205 PIC ---,---,--9.99. DTSBX340 00206 05 DISPLAY-AMT3-X PIC X(14). DTSBX340 00207 05 DISPLAY-AMT3 REDEFINES DISPLAY-AMT3-X DTSBX340 00208 PIC ---,---,--9.99. DTSBX340 00209 05 DISPLAY-AMT4-X PIC X(14). DTSBX340 00210 05 DISPLAY-AMT4 REDEFINES DISPLAY-AMT4-X DTSBX340 00211 PIC ---,---,--9.99. DTSBX340 00212 EJECT DTSBX340 00213 01 L001-LINK-AREA. DTSBX340 00214 ++INCLUDE DTSIL001 DTSBX340 00215 EJECT DTSBX340 00216 01 L003-LINK-AREA. DTSBX340 00217 ++INCLUDE DTSIL003 DTSBX340 00218 EJECT DTSBX340 00219 01 L004-LINK-AREA. DTSBX340 00220 ++INCLUDE DTSIL004 DTSBX340 00221 EJECT DTSBX340 00222 01 L005-LINK-AREA. DTSBX340 00223 ++INCLUDE DTSIL005 DTSBX340 00224 DTSBX340 00225 01 LX34-LINK-AREA. DTSBX340 00226 ++INCLUDE DTSILX34 DTSBX340 00227 EJECT DTSBX340 00228 01 L910-LINK-AREA. DTSBX340 00229 ++INCLUDE DTSIL910 DTSBX340 00230 SKIP3 DTSBX340 00231 01 MSKL-REC. DTSBX340 00232 ++INCLUDE DTSIMSKL DTSBX340 00233 SKIP3 DTSBX340 00234 01 MHDR-REC. DTSBX340 00235 ++INCLUDE DTSIMHDR DTSBX340 00236 SKIP3 DTSBX340 00237 01 MPRF-REC. DTSBX340 00238 ++INCLUDE DTSIMPRF DTSBX340 00239 EJECT DTSBX340 00240 01 MQTR-REC. DTSBX340 00241 ++INCLUDE DTSIMQTR DTSBX340 00242 SKIP3 DTSBX340 00243 01 MJRN-REC. DTSBX340 00244 ++INCLUDE DTSIMJRN DTSBX340 00245 SKIP3 DTSBX340 00246 01 MRPT-REC. DTSBX340 00247 ++INCLUDE DTSIMRPT DTSBX340 00248 SKIP3 DTSBX340 00249 01 MADJ-REC. DTSBX340 00250 ++INCLUDE DTSIMADJ DTSBX340 00251 SKIP3 DTSBX340 00252 01 MPAY-REC. DTSBX340 00253 ++INCLUDE DTSIMPAY DTSBX340 00254 SKIP3 DTSBX340 00255 01 MRTE-REC. DTSBX340 00256 ++INCLUDE DTSIMRTE DTSBX340 00257 SKIP3 DTSBX340 00258 01 MEVL-REC. DTSBX340 00259 ++INCLUDE DTSIMEVL DTSBX340 00260 SKIP3 DTSBX340 00261 01 MSOL-REC. DTSBX340 00262 ++INCLUDE DTSIMSOL DTSBX340 00263 SKIP3 DTSBX340 00264 01 MFSC-REC. DTSBX340 00265 ++INCLUDE DTSIMFSC DTSBX340 00266 SKIP3 DTSBX340 00267 01 MTAD-REC. DTSBX340 00268 ++INCLUDE DTSIMTAD DTSBX340 00269 SKIP3 DTSBX340 00270 01 MTAA-REC. DTSBX340 00271 ++INCLUDE DTSIMTAA DTSBX340 00272 SKIP3 DTSBX340 00273 01 MLOG-REC. DTSBX340 00274 ++INCLUDE DTSIMLOG DTSBX340 00275 SKIP3 DTSBX340 00276 01 L921-LINK-AREA. DTSBX340 00277 ++INCLUDE DTSIL921 DTSBX340 00278 SKIP3 DTSBX340 00279 01 ISKL-REC. DTSBX340 00280 ++INCLUDE DTSIISKL DTSBX340 00281 DTSBX340 00282 01 L931-LINK-AREA. DTSBX340 00283 ++INCLUDE DTSIL931 DTSBX340 00284 SKIP3 DTSBX340 00285 01 FSKL-REC. DTSBX340 00286 ++INCLUDE DTSIFSKL DTSBX340 00287 SKIP3 DTSBX340 00288 01 FQTR-REC. DTSBX340 00289 ++INCLUDE DTSIFQTR DTSBX340 00290 DTSBX340 00291 LINKAGE SECTION. DTSBX340 00292 SKIP3 DTSBX340 00293 01 PARM-AREA. DTSBX340 00294 05 PARM-LENGTH PIC S9(04) COMP. DTSBX340 00295 05 PARM-DATA. DTSBX340 00296 10 PARM-RUN-TYPE PIC X(01). DTSBX340 00297 88 PARM-RUN-CONVERT-88 VALUE '0'. DTSBX340 00298 88 PARM-RUN-INCREMENTAL-88 VALUE '1'. DTSBX340 00299 88 PARM-RUN-VALID-88 VALUE '0', '1'. DTSBX340 00300 DTSBX340 00301 PROCEDURE DIVISION USING PARM-AREA. DTSBX340 00302 DTSBX340 00303 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBX340 00304 IF W-ERROR-NO-88 DTSBX340 00305 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBX340 00306 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBX340 00307 END-IF. DTSBX340 00308 DTSBX340 00309 GOBACK. DTSBX340 00310 DTSBX340 00311 I0000-INITIALIZE. DTSBX340 00312 SKIP2 DTSBX340 00313 MOVE W-TRACE-IND TO L910-TRACE-IND. DTSBX340 00314 DTSBX340 00315 MOVE W-MOD-NAME TO L910-MOD-NAME. DTSBX340 00316 DTSBX340 00317 SET L005-FROM-SYS TO TRUE. DTSBX340 00318 PERFORM S005-FROM-SYS THRU S005-EXIT. DTSBX340 00319 DTSBX340 00320 PERFORM I1000-EDIT-PARM THRU I1000-EXIT. DTSBX340 00321 IF W-ERROR-YES-88 DTSBX340 00322 GO TO I0000-EXIT DTSBX340 00323 END-IF. DTSBX340 00324 DTSBX340 00325 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBX340 00326 IF W-ERROR-YES-88 DTSBX340 00327 GO TO I0000-EXIT DTSBX340 00328 END-IF. DTSBX340 00329 DTSBX340 00330 PERFORM I3000-GET-MHDR THRU I3000-EXIT. DTSBX340 00331 DTSBX340 00332 PERFORM I4000-INIT-LINKAGE THRU I4000-EXIT. DTSBX340 00333 DTSBX340 00334 PERFORM I5000-INITIAL-CALLS THRU I5000-EXIT. DTSBX340 00335 DTSBX340 00336 I0000-EXIT. DTSBX340 00337 EXIT. DTSBX340 00338 EJECT DTSBX340 00339 I1000-EDIT-PARM. DTSBX340 00340 IF PARM-RUN-VALID-88 DTSBX340 00341 MOVE PARM-RUN-TYPE TO W-RUN-TYPE DTSBX340 00342 IF W-RUN-CONVERT-88 DTSBX340 00343 DISPLAY 'BX340 RUN TYPE: CONVERT' DTSBX340 00344 ELSE DTSBX340 00345 IF W-RUN-INCREMENTAL-88 DTSBX340 00346 DISPLAY 'BX340 RUN TYPE: INCREMENTAL' DTSBX340 00347 END-IF DTSBX340 00348 END-IF DTSBX340 00349 ELSE DTSBX340 00350 DISPLAY 'INVALID RUN TYPE: ' PARM-RUN-TYPE DTSBX340 00351 DISPLAY 'BX340 TERMINATING' DTSBX340 00352 SET W-ERROR-YES-88 TO TRUE DTSBX340 00353 END-IF. DTSBX340 00354 DTSBX340 00355 I1000-EXIT. DTSBX340 00356 EXIT. DTSBX340 00357 DTSBX340 00358 DTSBX340 00359 I2000-OPEN-FILES. DTSBX340 00360 OPEN INPUT SERVER-FILE. DTSBX340 00361 IF NOT SRVR-STATUS-OK-88 DTSBX340 00362 DISPLAY 'OPEN ERROR ON SERVER FILE ' SRVR-STATUS DTSBX340 00363 SET W-ERROR-YES-88 TO TRUE DTSBX340 00364 GO TO I2000-EXIT DTSBX340 00365 END-IF. DTSBX340 00366 DTSBX340 00367 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBX340 00368 DTSBX340 00369 PERFORM S921-OPEN-READ THRU S921-EXIT. DTSBX340 00370 DTSBX340 00371 PERFORM S931-OPEN-READ THRU S931-EXIT. DTSBX340 00372 DTSBX340 00373 DTSBX340 00374 I2000-EXIT. DTSBX340 00375 EXIT. DTSBX340 00376 DTSBX340 00377 I3000-GET-MHDR. DTSBX340 00378 MOVE LOW-VALUES TO MSKL-REC. DTSBX340 00379 MOVE +0 TO MSKL-EMP-NO. DTSBX340 00380 SET MSKL-HDR-88 TO TRUE. DTSBX340 00381 DTSBX340 00382 PERFORM S910-READ THRU S910-EXIT. DTSBX340 00383 IF L910-NO-REC-88 DTSBX340 00384 DISPLAY 'DTSBX340: MHDR RECORD IS MISSING' DTSBX340 00385 SET W-ERROR-YES-88 TO TRUE DTSBX340 00386 GO TO I3000-EXIT DTSBX340 00387 ELSE DTSBX340 00388 MOVE MSKL-REC TO MHDR-REC DTSBX340 00389 END-IF. DTSBX340 00390 DTSBX340 00391 I3000-EXIT. DTSBX340 00392 EXIT. DTSBX340 00393 DTSBX340 00394 I4000-INIT-LINKAGE. DTSBX340 00395 MOVE MHDR-CURR-RUN-DATE TO LX34-CURR-RUN-DATE. DTSBX340 00396 MOVE MHDR-PRIOR-RUN-DATE TO LX34-PRIOR-RUN-DATE. DTSBX340 00397 MOVE L005-DATE TO LX34-SYS-DATE. DTSBX340 00398 MOVE L005-TIME TO LX34-SYS-TIME. DTSBX340 00399 DTSBX340 00400 MOVE MHDR-PRIOR-RUN-DATE TO L001-FED-8-DATE-9. DTSBX340 00401 SUBTRACT +1 FROM L001-FED-8-YR. DTSBX340 00402 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX340 00403 MOVE L001-JUL-ABS-DAY TO W-JRN-ABSTIME. DTSBX340 00404 SUBTRACT +2 FROM L001-FED-8-YR. DTSBX340 00405 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX340 00406 MOVE L001-FED-8-DATE-9 TO L004-DATE. DTSBX340 00407 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSBX340 00408 MOVE L004-QTR-5-9 TO LX34-3-YRS-AGO-YRQ. DTSBX340 00409 DTSBX340 00410 ** MOVE MHDR-PRIOR-RUN-DATE TO L001-FED-8-DATE-9. DTSBX340 00411 * SUBTRACT +3 FROM L001-FED-8-YR. DTSBX340 00412 * PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX340 00413 * MOVE L001-FED-8-DATE-9 TO L004-DATE. DTSBX340 00414 * PERFORM S004-FROM-DATE THRU S004-EXIT. DTSBX340 00415 * MOVE L004-QTR-5-9 TO LX34-3-YRS-AGO-YRQ. DTSBX340 00416 * DTSBX340 00417 * MOVE MHDR-CURR-RUN-DATE TO L005-DATE. DTSBX340 00418 * MOVE ZERO TO L005-TIME. DTSBX340 00419 * SET L005-FROM-DATE-TIME TO TRUE. DTSBX340 00420 * PERFORM S005-FROM-SYS THRU S005-EXIT. DTSBX340 00421 ** MOVE L005-ABSTIME TO W-JRN-ABSTIME. DTSBX340 00422 DTSBX340 00423 MOVE MHDR-PRIOR-RUN-DATE TO L001-FED-8-DATE-9. DTSBX340 00424 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX340 00425 SUBTRACT +1 FROM L001-JUL-ABS-DAY. DTSBX340 00426 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSBX340 00427 MOVE L001-FED-8-DATE-9 TO L005-DATE. DTSBX340 00428 MOVE ZERO TO L005-TIME. DTSBX340 00429 SET L005-FROM-DATE-TIME TO TRUE. DTSBX340 00430 PERFORM S005-FROM-SYS THRU S005-EXIT. DTSBX340 00431 MOVE L005-ABSTIME TO LX34-ABSTIME. DTSBX340 00432 DTSBX340 00433 MOVE MHDR-PRIOR-RUN-DATE TO L004-DATE. DTSBX340 00434 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSBX340 00435 SUBTRACT +2 FROM L004-ABS-QTR. DTSBX340 00436 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBX340 00437 MOVE L004-QTR-START-DATE TO W-INACT-CUTOFF. DTSBX340 00438 DTSBX340 00439 MOVE W-CUTOFF-DATE TO LX34-CUTOFF-DATE. DTSBX340 00440 DTSBX340 00441 IF W-RUN-INCREMENTAL-88 DTSBX340 00442 SET LX34-RUN-INCREMENTAL-88 TO TRUE DTSBX340 00443 ELSE DTSBX340 00444 IF W-RUN-CONVERT-88 DTSBX340 00445 SET LX34-RUN-CONVERT-88 TO TRUE DTSBX340 00446 END-IF DTSBX340 00447 END-IF. DTSBX340 00448 DTSBX340 00449 DISPLAY '********************************'. DTSBX340 00450 DISPLAY ' DTSBX340'. DTSBX340 00451 DISPLAY ' 3 YEARS AGO ' LX34-3-YRS-AGO-YRQ. DTSBX340 00452 DISPLAY ' INACT CUTOFF ' W-INACT-CUTOFF. DTSBX340 00453 DISPLAY '********************************'. DTSBX340 00454 DISPLAY SPACE. DTSBX340 00455 DTSBX340 00456 I4000-EXIT. DTSBX340 00457 EXIT. DTSBX340 00458 DTSBX340 00459 I5000-INITIAL-CALLS. DTSBX340 00460 SET LX34-INITIALIZE-88 TO TRUE. DTSBX340 00461 DTSBX340 00462 PERFORM S341-STATUS THRU S341-EXIT. DTSBX340 00463 ** PERFORM S342-ACCT-DAILY THRU S342-EXIT. DTSBX340 00464 PERFORM S343-ACCT-CONVERT THRU S343-EXIT. DTSBX340 00465 PERFORM S344-DELINQ-COLL THRU S344-EXIT. DTSBX340 00466 * PERFORM S346-CHARGES THRU S346-EXIT. DTSBX340 00467 DTSBX340 00468 I5000-EXIT. DTSBX340 00469 EXIT. DTSBX340 00470 DTSBX340 00471 P0000-PROCESS. DTSBX340 00472 SET LX34-PROCESS-88 TO TRUE. DTSBX340 00473 DTSBX340 00474 IF LX34-RUN-CONVERT-88 DTSBX340 00475 PERFORM P1000-CONVERT THRU P1000-EXIT DTSBX340 00476 ELSE DTSBX340 00477 PERFORM P2000-INCREMENTAL THRU P2000-EXIT DTSBX340 00478 END-IF. DTSBX340 00479 DTSBX340 00480 * PERFORM S346-CHARGES THRU S346-EXIT. DTSBX340 00481 DTSBX340 00482 PERFORM S348-HOLIDAYS THRU S348-EXIT. DTSBX340 00483 P0000-EXIT. DTSBX340 00484 EXIT. DTSBX340 00485 DTSBX340 00486 P1000-CONVERT. DTSBX340 00487 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBX340 00488 MOVE +0 TO MSKL-EMP-NO. DTSBX340 00489 SET MSKL-PRF-88 TO TRUE. DTSBX340 00490 DTSBX340 00491 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX340 00492 IF NOT L910-OK-88 DTSBX340 00493 DISPLAY 'CANNOT READ MASTER FILE ' DTSBX340 00494 GO TO P1000-EXIT DTSBX340 00495 END-IF. DTSBX340 00496 DTSBX340 00497 PERFORM DTSBX340 00498 UNTIL L910-NO-REC-88 DTSBX340 00499 OR W-ERROR-YES-88 DTSBX340 00500 ADD +1 TO W-MPRF-CNT DTSBX340 00501 MOVE MSKL-REC TO MPRF-REC DTSBX340 00502 PERFORM P1100-SELECT THRU P1100-EXIT DTSBX340 00503 IF W-SELECT-PRF-88 DTSBX340 00504 PERFORM S341-STATUS THRU S341-EXIT DTSBX340 00505 ELSE DTSBX340 00506 IF W-SELECT-ALL-88 DTSBX340 00507 PERFORM S341-STATUS THRU S341-EXIT DTSBX340 00508 PERFORM S343-ACCT-CONVERT THRU S343-EXIT DTSBX340 00509 PERFORM S344-DELINQ-COLL THRU S344-EXIT DTSBX340 00510 END-IF DTSBX340 00511 END-IF DTSBX340 00512 MOVE MPRF-REC TO MSKL-REC DTSBX340 00513 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX340 00514 END-PERFORM. DTSBX340 00515 DTSBX340 00516 P1000-EXIT. DTSBX340 00517 EXIT. DTSBX340 00518 DTSBX340 00519 P1100-SELECT. DTSBX340 00520 PERFORM S3000-INITIALIZE THRU S3000-EXIT. DTSBX340 00521 DTSBX340 00522 IF MPRF-CLASS-CHG-ONLY-88 DTSBX340 00523 SET W-SELECT-PRF-88 TO TRUE DTSBX340 00524 PERFORM S3100-LX34-SELECTIONS THRU S3100-EXIT DTSBX340 00525 GO TO P1100-EXIT DTSBX340 00526 END-IF. DTSBX340 00527 DTSBX340 00528 ** IF MPRF-CLASS-CHG-ONLY-88 DTSBX340 00529 * IF MPRF-ELIGIBLE-DC-GOV-88 DTSBX340 00530 * SET W-SELECT-PRF-88 TO TRUE DTSBX340 00531 * PERFORM S3100-LX34-SELECTIONS THRU S3100-EXIT DTSBX340 00532 * GO TO P1100-EXIT DTSBX340 00533 * END-IF DTSBX340 00534 ** END-IF. DTSBX340 00535 DTSBX340 00536 IF MPRF-STATUS-INACT-88 DTSBX340 00537 PERFORM P1110-INACT-DATES THRU P1110-EXIT DTSBX340 00538 IF W-LAST-LIAB-YRQ < LX34-3-YRS-AGO-YRQ DTSBX340 00539 IF MPRF-TOT-BALANCE-AMT > ZERO DTSBX340 00540 OR MPRF-TOT-CREDIT-AMT > ZERO DTSBX340 00541 OR MPRF-PURSUED-RPT-CNT > ZERO DTSBX340 00542 OR W-INACT-DATE >= W-INACT-CUTOFF DTSBX340 00543 OR W-ACTIVE-JRN-YES-88 DTSBX340 00544 SET W-SELECT-ALL-88 TO TRUE DTSBX340 00545 ELSE DTSBX340 00546 SET W-SELECT-PRF-88 TO TRUE DTSBX340 00547 END-IF DTSBX340 00548 ELSE DTSBX340 00549 SET W-SELECT-ALL-88 TO TRUE DTSBX340 00550 END-IF DTSBX340 00551 ELSE DTSBX340 00552 SET W-SELECT-ALL-88 TO TRUE DTSBX340 00553 END-IF. DTSBX340 00554 DTSBX340 00555 IF (MPRF-STATUS-NEVERSUB-88 DTSBX340 00556 OR MPRF-STATUS-UNK-88) DTSBX340 00557 SET W-SELECT-ALL-88 TO TRUE DTSBX340 00558 **** PERFORM S2000-UNKNOWN THRU S2000-EXIT DTSBX340 00559 END-IF. DTSBX340 00560 DTSBX340 00561 PERFORM S3100-LX34-SELECTIONS THRU S3100-EXIT. DTSBX340 00562 DTSBX340 00563 IF W-SELECT-NO-88 DTSBX340 00564 ADD +1 TO W-SELECT-NO-CNT DTSBX340 00565 END-IF. DTSBX340 00566 DTSBX340 00567 EVALUATE TRUE DTSBX340 00568 WHEN W-SELECT-NO-88 DTSBX340 00569 ADD +1 TO W-SELECT-NO-CNT DTSBX340 00570 DTSBX340 00571 WHEN W-SELECT-PRF-88 DTSBX340 00572 ADD +1 TO W-SELECT-PRF-CNT DTSBX340 00573 DTSBX340 00574 WHEN W-SELECT-ALL-88 DTSBX340 00575 ADD +1 TO W-SELECT-ALL-CNT DTSBX340 00576 DTSBX340 00577 END-EVALUATE. DTSBX340 00578 DTSBX340 00579 P1100-EXIT. DTSBX340 00580 EXIT. DTSBX340 00581 DTSBX340 00582 P1110-INACT-DATES. DTSBX340 00583 MOVE ZERO TO W-LAST-LIAB-YRQ DTSBX340 00584 W-INACT-DATE. DTSBX340 00585 SET W-ACTIVE-JRN-NO-88 TO TRUE. DTSBX340 00586 DTSBX340 00587 MOVE LOW-VALUES TO MSOL-REC DTSBX340 00588 MOVE MPRF-EMP-NO TO MSOL-EMP-NO DTSBX340 00589 SET MSOL-SOL-88 TO TRUE DTSBX340 00590 MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA DTSBX340 00591 PERFORM S910-START-BROWSE THRU S910-EXIT DTSBX340 00592 PERFORM UNTIL L910-NO-REC-88 DTSBX340 00593 MOVE MSKL-REC TO MSOL-REC DTSBX340 00594 IF NOT MSOL-INACT-WITHDRAWN-88 DTSBX340 00595 IF MSOL-INACT-INACTIVE-88 DTSBX340 00596 IF MSOL-LAST-LIAB-YRQ > W-LAST-LIAB-YRQ DTSBX340 00597 MOVE MSOL-LAST-LIAB-YRQ DTSBX340 00598 TO W-LAST-LIAB-YRQ DTSBX340 00599 MOVE MSOL-INACT-ENTER-DATE DTSBX340 00600 TO W-INACT-DATE DTSBX340 00601 END-IF DTSBX340 00602 END-IF DTSBX340 00603 END-IF DTSBX340 00604 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX340 00605 END-PERFORM. DTSBX340 00606 DTSBX340 00607 ** IF W-INACT-DATE >= W-INACT-CUTOFF DTSBX340 00608 * DISPLAY 'INACT WITHIN 2 QTRS ' MPRF-EMP-NO DTSBX340 00609 ** END-IF. DTSBX340 00610 DTSBX340 00611 MOVE LOW-VALUES TO MJRN-KEY-AREA. DTSBX340 00612 MOVE MPRF-EMP-NO TO MJRN-EMP-NO. DTSBX340 00613 SET MJRN-JRN-88 TO TRUE. DTSBX340 00614 MOVE W-JRN-ABSTIME TO MJRN-ESTB-ABSTIME. DTSBX340 00615 MOVE MJRN-KEY-AREA TO MSKL-KEY-AREA. DTSBX340 00616 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX340 00617 IF L910-OK-88 DTSBX340 00618 IF W-LAST-LIAB-YRQ < LX34-3-YRS-AGO-YRQ DTSBX340 00619 SET W-ACTIVE-JRN-YES-88 TO TRUE DTSBX340 00620 ** DISPLAY 'BX340 INACT > 3, ACT JRN ' MPRF-EMP-NO DTSBX340 00621 END-IF DTSBX340 00622 END-IF. DTSBX340 00623 DTSBX340 00624 P1110-EXIT. DTSBX340 00625 EXIT. DTSBX340 00626 DTSBX340 00627 P2000-INCREMENTAL. DTSBX340 00628 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBX340 00629 MOVE +0 TO MSKL-EMP-NO. DTSBX340 00630 SET MSKL-PRF-88 TO TRUE. DTSBX340 00631 DTSBX340 00632 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX340 00633 IF NOT L910-OK-88 DTSBX340 00634 DISPLAY 'CANNOT READ MASTER FILE ' DTSBX340 00635 GO TO P2000-EXIT DTSBX340 00636 ELSE DTSBX340 00637 MOVE MSKL-REC TO MPRF-REC DTSBX340 00638 END-IF. DTSBX340 00639 DTSBX340 00640 PERFORM S1000-READ-SRVR THRU S1000-EXIT. DTSBX340 00641 IF W-ERROR-YES-88 DTSBX340 00642 DISPLAY 'CANNOT READ SERVER FILE ' DTSBX340 00643 GO TO P2000-EXIT DTSBX340 00644 END-IF. DTSBX340 00645 DTSBX340 00646 PERFORM DTSBX340 00647 UNTIL (L910-NO-REC-88 DTSBX340 00648 OR SRVR-STATUS-EOF-88 DTSBX340 00649 OR W-ERROR-YES-88) DTSBX340 00650 SET W-SELECT-NO-88 TO TRUE DTSBX340 00651 IF MPRF-EMP-NO < SRVR-EMP-NO DTSBX340 00652 PERFORM P2100-EXTRACT THRU P2100-EXIT DTSBX340 00653 PERFORM P2010-READ-MPRF THRU P2010-EXIT DTSBX340 00654 ELSE DTSBX340 00655 IF MPRF-EMP-NO = SRVR-EMP-NO DTSBX340 00656 SET W-SELECT-UPD-88 TO TRUE DTSBX340 00657 PERFORM P2100-EXTRACT THRU P2100-EXIT DTSBX340 00658 PERFORM P2010-READ-MPRF THRU P2010-EXIT DTSBX340 00659 PERFORM S1000-READ-SRVR THRU S1000-EXIT DTSBX340 00660 ELSE DTSBX340 00661 DISPLAY 'P2000 ERROR > NO MPRF ' SRVR-EMP-NO DTSBX340 00662 PERFORM S1000-READ-SRVR THRU S1000-EXIT DTSBX340 00663 END-IF DTSBX340 00664 END-IF DTSBX340 00665 END-PERFORM. DTSBX340 00666 DTSBX340 00667 IF SRVR-STATUS-EOF-88 DTSBX340 00668 AND L910-OK-88 DTSBX340 00669 PERFORM UNTIL L910-NO-REC-88 DTSBX340 00670 SET W-SELECT-NO-88 TO TRUE DTSBX340 00671 PERFORM P2100-EXTRACT THRU P2100-EXIT DTSBX340 00672 PERFORM P2010-READ-MPRF THRU P2010-EXIT DTSBX340 00673 END-PERFORM DTSBX340 00674 END-IF. DTSBX340 00675 DTSBX340 00676 IF SRVR-STATUS-OK-88 DTSBX340 00677 AND L910-NO-REC-88 DTSBX340 00678 PERFORM UNTIL SRVR-STATUS-EOF-88 DTSBX340 00679 DISPLAY 'P2000 EOF ERR > NO MPRF ' SRVR-EMP-NO DTSBX340 00680 READ SERVER-FILE DTSBX340 00681 END-PERFORM DTSBX340 00682 END-IF. DTSBX340 00683 DTSBX340 00684 P2000-EXIT. DTSBX340 00685 EXIT. DTSBX340 00686 DTSBX340 00687 P2010-READ-MPRF. DTSBX340 00688 MOVE MPRF-REC TO MSKL-REC. DTSBX340 00689 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBX340 00690 MOVE MSKL-REC TO MPRF-REC. DTSBX340 00691 DTSBX340 00692 P2010-EXIT. DTSBX340 00693 EXIT. DTSBX340 00694 DTSBX340 00695 P2100-EXTRACT. DTSBX340 00696 PERFORM S3000-INITIALIZE THRU S3000-EXIT. DTSBX340 00697 IF MPRF-EMP-NO = SRVR-EMP-NO DTSBX340 00698 SET W-SELECT-UPD-88 TO TRUE DTSBX340 00699 END-IF. DTSBX340 00700 DTSBX340 00701 EVALUATE TRUE DTSBX340 00702 WHEN MPRF-CLASS-CHG-ONLY-88 DTSBX340 00703 IF MPRF-ESTB-DATE = LX34-PRIOR-RUN-DATE DTSBX340 00704 OR MPRF-CHNG-DATE = LX34-PRIOR-RUN-DATE DTSBX340 00705 SET W-SELECT-PRF-88 TO TRUE DTSBX340 00706 ** DISPLAY 'BX340 CHG ONLY ' MPRF-EMP-NO DTSBX340 00707 ** ' ' W-SELECT-IND DTSBX340 00708 END-IF DTSBX340 00709 DTSBX340 00710 WHEN MPRF-CLASS-SUB-88 DTSBX340 00711 IF W-SELECT-UPD-88 DTSBX340 00712 PERFORM P2110-CHK-CHANGES THRU P2110-EXIT DTSBX340 00713 ELSE DTSBX340 00714 IF MPRF-ESTB-DATE = LX34-PRIOR-RUN-DATE DTSBX340 00715 OR MPRF-CHNG-DATE = LX34-PRIOR-RUN-DATE DTSBX340 00716 ** DISPLAY 'BX340 NEWLY SUBJECT ' MPRF-EMP-NO DTSBX340 00717 SET W-SELECT-ALL-88 TO TRUE DTSBX340 00718 END-IF DTSBX340 00719 END-IF DTSBX340 00720 DTSBX340 00721 WHEN MPRF-CLASS-UNK-88 DTSBX340 00722 IF NOT W-SELECT-UPD-88 DTSBX340 00723 PERFORM S2000-UNKNOWN THRU S2000-EXIT DTSBX340 00724 END-IF DTSBX340 00725 END-EVALUATE. DTSBX340 00726 DTSBX340 00727 EVALUATE TRUE DTSBX340 00728 WHEN W-SELECT-NO-88 DTSBX340 00729 ADD +1 TO W-SELECT-NO-CNT DTSBX340 00730 DTSBX340 00731 WHEN W-SELECT-PRF-88 DTSBX340 00732 ADD +1 TO W-SELECT-PRF-CNT DTSBX340 00733 DTSBX340 00734 WHEN W-SELECT-ALL-88 DTSBX340 00735 ADD +1 TO W-SELECT-ALL-CNT DTSBX340 00736 DTSBX340 00737 WHEN W-SELECT-UPD-88 DTSBX340 00738 ADD +1 TO W-SELECT-UPD-CNT DTSBX340 00739 DTSBX340 00740 END-EVALUATE. DTSBX340 00741 DTSBX340 00742 PERFORM S3100-LX34-SELECTIONS THRU S3100-EXIT. DTSBX340 00743 DTSBX340 00744 EVALUATE TRUE DTSBX340 00745 WHEN W-SELECT-PRF-88 DTSBX340 00746 PERFORM S341-STATUS THRU S341-EXIT DTSBX340 00747 DTSBX340 00748 WHEN W-SELECT-UPD-88 DTSBX340 00749 PERFORM S341-STATUS THRU S341-EXIT DTSBX340 00750 ** PERFORM S342-ACCT-DAILY THRU S342-EXIT DTSBX340 00751 *& PERFORM S344-DELINQ-COLL THRU S344-EXIT DTSBX340 00752 DTSBX340 00753 WHEN W-SELECT-ALL-88 DTSBX340 00754 PERFORM S341-STATUS THRU S341-EXIT DTSBX340 00755 PERFORM S343-ACCT-CONVERT THRU S343-EXIT DTSBX340 00756 *& PERFORM S344-DELINQ-COLL THRU S344-EXIT DTSBX340 00757 DTSBX340 00758 END-EVALUATE. DTSBX340 00759 DTSBX340 00760 DTSBX340 00761 P2100-EXIT. DTSBX340 00762 EXIT. DTSBX340 00763 DTSBX340 00764 P2110-CHK-CHANGES. DTSBX340 00765 MOVE LOW-VALUES TO MLOG-REC. DTSBX340 00766 MOVE MPRF-EMP-NO TO MLOG-EMP-NO. DTSBX340 00767 SET MLOG-LOG-88 TO TRUE. DTSBX340 00768 MOVE LX34-ABSTIME TO MLOG-ESTB-ABSTIME. DTSBX340 00769 MOVE MLOG-KEY-AREA TO MSKL-KEY-AREA. DTSBX340 00770 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX340 00771 DTSBX340 00772 PERFORM DTSBX340 00773 UNTIL L910-NO-REC-88 DTSBX340 00774 MOVE MSKL-REC TO MLOG-REC DTSBX340 00775 IF MLOG-ESTB-DATE = LX34-PRIOR-RUN-DATE DTSBX340 00776 EVALUATE TRUE DTSBX340 00777 WHEN MLOG-DATA-ELEMENT-NAME = MPRF-PRIMARY-NAME DTSBX340 00778 SET W-SELECT-NAME-YES-88 TO TRUE DTSBX340 00779 DISPLAY 'NAME ' MPRF-EMP-NO ' ' MLOG-ESTB-DATE DTSBX340 00780 DTSBX340 00781 WHEN MLOG-DE-REC-TYPE = 'MTAD' DTSBX340 00782 SET W-SELECT-ADDR-YES-88 TO TRUE DTSBX340 00783 DISPLAY 'ADDR ' MPRF-EMP-NO ' ' MLOG-ESTB-DATE DTSBX340 00784 DTSBX340 00785 WHEN MLOG-DE-REC-TYPE = 'MOPO' DTSBX340 00786 SET W-SELECT-OPO-YES-88 TO TRUE DTSBX340 00787 DISPLAY 'OPO ' MPRF-EMP-NO ' ' MLOG-ESTB-DATE DTSBX340 00788 DTSBX340 00789 WHEN MLOG-DE-REC-TYPE = 'MSOL' DTSBX340 00790 SET W-SELECT-SOL-YES-88 TO TRUE DTSBX340 00791 DISPLAY 'SOL ' MPRF-EMP-NO ' ' MLOG-ESTB-DATE DTSBX340 00792 DTSBX340 00793 WHEN MLOG-DE-REC-TYPE = 'MFSC' DTSBX340 00794 SET W-SELECT-FSC-YES-88 TO TRUE DTSBX340 00795 DISPLAY 'FSC ' MPRF-EMP-NO ' ' MLOG-ESTB-DATE DTSBX340 00796 DTSBX340 00797 WHEN MLOG-DE-REC-TYPE = 'MRTE' DTSBX340 00798 SET W-SELECT-RATE-YES-88 TO TRUE DTSBX340 00799 DISPLAY 'RATE ' MPRF-EMP-NO ' ' MLOG-ESTB-DATE DTSBX340 00800 DTSBX340 00801 END-EVALUATE DTSBX340 00802 END-IF DTSBX340 00803 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX340 00804 END-PERFORM. DTSBX340 00805 DTSBX340 00806 P2110-EXIT. DTSBX340 00807 EXIT. DTSBX340 00808 DTSBX340 00809 DTSBX340 00810 DTSBX340 00811 DTSBX340 00812 T0000-TERMINATE. DTSBX340 00813 DTSBX340 00814 SET LX34-TERMINATE-88 TO TRUE. DTSBX340 00815 DTSBX340 00816 PERFORM S341-STATUS THRU S341-EXIT. DTSBX340 00817 ** PERFORM S342-ACCT-DAILY THRU S342-EXIT. DTSBX340 00818 PERFORM S343-ACCT-CONVERT THRU S343-EXIT. DTSBX340 00819 PERFORM S344-DELINQ-COLL THRU S344-EXIT. DTSBX340 00820 * PERFORM S346-CHARGES THRU S346-EXIT. DTSBX340 00821 DTSBX340 00822 CLOSE SERVER-FILE. DTSBX340 00823 DTSBX340 00824 PERFORM S910-CLOSE THRU S910-EXIT. DTSBX340 00825 DTSBX340 00826 PERFORM S921-CLOSE THRU S921-EXIT. DTSBX340 00827 DTSBX340 00828 PERFORM S931-CLOSE THRU S931-EXIT. DTSBX340 00829 DTSBX340 00830 DTSBX340 00831 DISPLAY '*********************************************'. DTSBX340 00832 DISPLAY '** DTSBX340 TERMINATION STATISTICS **'. DTSBX340 00833 DISPLAY '** **'. DTSBX340 00834 DISPLAY '** PROFILE RECORDS READ: ' W-MPRF-CNT DTSBX340 00835 ' **'. DTSBX340 00836 DISPLAY '** SERVER RECORDS READ: ' W-SERVER-CNT DTSBX340 00837 ' **'. DTSBX340 00838 DISPLAY '** **'. DTSBX340 00839 DISPLAY '** NOT LIABLE BYPASSED : ' W-SELECT-NO-CNT DTSBX340 00840 ' **'. DTSBX340 00841 DISPLAY '** SELECT ALL : ' W-SELECT-ALL-CNT DTSBX340 00842 ' **'. DTSBX340 00843 DISPLAY '** SELECT PROFILE : ' W-SELECT-PRF-CNT DTSBX340 00844 ' **'. DTSBX340 00845 DISPLAY '** SELECT UPDATE : ' W-SELECT-UPD-CNT DTSBX340 00846 ' **'. DTSBX340 00847 DISPLAY '** **'. DTSBX340 00848 DISPLAY '*********************************************'. DTSBX340 00849 DTSBX340 00850 T0000-EXIT. DTSBX340 00851 EXIT. DTSBX340 00852 DTSBX340 00853 S001-FROM-FED-8. DTSBX340 00854 SET L001-FROM-FED-8 TO TRUE. DTSBX340 00855 GO TO S001-DATE. DTSBX340 00856 DTSBX340 00857 S001-FROM-ABS-DAY. DTSBX340 00858 SET L001-FROM-ABS-DAY TO TRUE. DTSBX340 00859 GO TO S001-DATE. DTSBX340 00860 DTSBX340 00861 S001-FROM-CAL-6. DTSBX340 00862 SET L001-FROM-CAL-6 TO TRUE. DTSBX340 00863 GO TO S001-DATE. DTSBX340 00864 DTSBX340 00865 S001-DATE. DTSBX340 00866 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX340 00867 S001-EXIT. DTSBX340 00868 EXIT. DTSBX340 00869 SKIP3 DTSBX340 00870 S004-FROM-5. DTSBX340 00871 SET L004-FROM-5 TO TRUE. DTSBX340 00872 GO TO S004-QTR. DTSBX340 00873 DTSBX340 00874 S004-FROM-ABS. DTSBX340 00875 SET L004-FROM-ABS TO TRUE. DTSBX340 00876 GO TO S004-QTR. DTSBX340 00877 DTSBX340 00878 S004-FROM-3. DTSBX340 00879 SET L004-FROM-3 TO TRUE. DTSBX340 00880 GO TO S004-QTR. DTSBX340 00881 DTSBX340 00882 S004-FROM-DATE. DTSBX340 00883 SET L004-FROM-DATE TO TRUE. DTSBX340 00884 GO TO S004-QTR. DTSBX340 00885 DTSBX340 00886 S004-QTR. DTSBX340 00887 DTSBX340 00888 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX340 00889 DTSBX340 00890 S004-EXIT. DTSBX340 00891 EXIT. DTSBX340 00892 SKIP3 DTSBX340 00893 S005-FROM-SYS. DTSBX340 00894 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBX340 00895 S005-EXIT. DTSBX340 00896 EXIT. DTSBX340 00897 DTSBX340 00898 S341-STATUS. DTSBX340 00899 CALL 'DTSBX341' USING LX34-LINK-AREA DTSBX340 00900 MPRF-REC. DTSBX340 00901 DTSBX340 00902 S341-EXIT. DTSBX340 00903 EXIT. DTSBX340 00904 DTSBX340 00905 S342-ACCT-DAILY. DTSBX340 00906 CALL 'DTSBX342' USING LX34-LINK-AREA DTSBX340 00907 MPRF-REC. DTSBX340 00908 DTSBX340 00909 S342-EXIT. DTSBX340 00910 EXIT. DTSBX340 00911 DTSBX340 00912 S343-ACCT-CONVERT. DTSBX340 00913 CALL 'DTSBX343' USING LX34-LINK-AREA DTSBX340 00914 MPRF-REC. DTSBX340 00915 DTSBX340 00916 S343-EXIT. DTSBX340 00917 EXIT. DTSBX340 00918 DTSBX340 00919 S344-DELINQ-COLL. DTSBX340 00920 CALL 'DTSBX344' USING LX34-LINK-AREA DTSBX340 00921 MPRF-REC. DTSBX340 00922 DTSBX340 00923 S344-EXIT. DTSBX340 00924 EXIT. DTSBX340 00925 DTSBX340 00926 *S346-CHARGES. DTSBX340 00927 * CALL 'DTSBX346' USING LX34-LINK-AREA DTSBX340 00928 * MPRF-REC. DTSBX340 00929 * DTSBX340 00930 *S346-EXIT. DTSBX340 00931 * EXIT. DTSBX340 00932 DTSBX340 00933 DTSBX340 00934 S348-HOLIDAYS. DTSBX340 00935 ADD +1 TO L001-JUL-ABS-DAY. DTSBX340 00936 DTSBX340 00937 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSBX340 00938 DTSBX340 00939 MOVE L001-FED-8-DATE-9 TO L003-DATE. DTSBX340 00940 DTSBX340 00941 MOVE '2' TO L003-OPTION. DTSBX340 00942 CALL 'DTSBU003' USING L003-LINK-AREA. DTSBX340 00943 DTSBX340 00944 S348-EXIT. DTSBX340 00945 EXIT. DTSBX340 00946 DTSBX340 00947 S910-OPEN-READ. DTSBX340 00948 SET L910-OPEN-READ-88 TO TRUE. DTSBX340 00949 GO TO S910-MSTR-IO. DTSBX340 00950 DTSBX340 00951 S910-READ. DTSBX340 00952 SET L910-READ-88 TO TRUE. DTSBX340 00953 GO TO S910-MSTR-IO. DTSBX340 00954 DTSBX340 00955 S910-START-BROWSE. DTSBX340 00956 SET L910-START-BROWSE-88 TO TRUE. DTSBX340 00957 GO TO S910-MSTR-IO. DTSBX340 00958 DTSBX340 00959 S910-READ-NEXT. DTSBX340 00960 SET L910-READ-NEXT-88 TO TRUE. DTSBX340 00961 GO TO S910-MSTR-IO. DTSBX340 00962 DTSBX340 00963 S910-COUNT. DTSBX340 00964 SET L910-COUNT-88 TO TRUE. DTSBX340 00965 GO TO S910-MSTR-IO. DTSBX340 00966 DTSBX340 00967 S910-REWRITE. DTSBX340 00968 SET L910-REWRITE-88 TO TRUE. DTSBX340 00969 GO TO S910-MSTR-IO. DTSBX340 00970 DTSBX340 00971 S910-CLOSE. DTSBX340 00972 SET L910-CLOSE-88 TO TRUE. DTSBX340 00973 GO TO S910-MSTR-IO. DTSBX340 00974 DTSBX340 00975 S910-MSTR-IO. DTSBX340 00976 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX340 00977 MSKL-REC. DTSBX340 00978 S910-EXIT. DTSBX340 00979 EXIT. DTSBX340 00980 SKIP3 DTSBX340 00981 DTSBX340 00982 S931-OPEN-READ. DTSBX340 00983 SET L931-OPEN-READ-88 TO TRUE. DTSBX340 00984 GO TO S931-REF-IO. DTSBX340 00985 DTSBX340 00986 S931-READ. DTSBX340 00987 SET L931-READ-88 TO TRUE. DTSBX340 00988 GO TO S931-REF-IO. DTSBX340 00989 DTSBX340 00990 S931-CLOSE. DTSBX340 00991 SET L931-CLOSE-88 TO TRUE. DTSBX340 00992 GO TO S931-REF-IO. DTSBX340 00993 DTSBX340 00994 S931-REF-IO. DTSBX340 00995 CALL 'DTSBU931' USING L931-LINK-AREA DTSBX340 00996 FSKL-REC. DTSBX340 00997 S931-EXIT. DTSBX340 00998 EXIT. DTSBX340 00999 DTSBX340 01000 S921-OPEN-READ. DTSBX340 01001 SET L921-OPEN-READ-88 TO TRUE. DTSBX340 01002 GO TO S921-AIX-IO. DTSBX340 01003 DTSBX340 01004 S921-CLOSE. DTSBX340 01005 SET L921-CLOSE-88 TO TRUE. DTSBX340 01006 GO TO S921-AIX-IO. DTSBX340 01007 DTSBX340 01008 S921-AIX-IO. DTSBX340 01009 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX340 01010 ISKL-REC. DTSBX340 01011 S921-EXIT. DTSBX340 01012 EXIT. DTSBX340 01013 DTSBX340 01014 S1000-READ-SRVR. DTSBX340 01015 READ SERVER-FILE. DTSBX340 01016 IF NOT SRVR-STATUS-OK-88 DTSBX340 01017 IF SRVR-STATUS-EOF-88 DTSBX340 01018 NEXT SENTENCE DTSBX340 01019 ELSE DTSBX340 01020 DISPLAY 'SERVER FILE READ ERROR ' SRVR-STATUS DTSBX340 01021 SET W-ERROR-YES-88 TO TRUE DTSBX340 01022 END-IF DTSBX340 01023 ELSE DTSBX340 01024 ADD +1 TO W-SERVER-CNT DTSBX340 01025 END-IF. DTSBX340 01026 DTSBX340 01027 S1000-EXIT. DTSBX340 01028 EXIT. DTSBX340 01029 DTSBX340 01030 S2000-UNKNOWN. DTSBX340 01031 MOVE LOW-VALUES TO MJRN-KEY-AREA. DTSBX340 01032 MOVE MPRF-EMP-NO TO MJRN-EMP-NO. DTSBX340 01033 SET MJRN-JRN-88 TO TRUE. DTSBX340 01034 MOVE MJRN-KEY-AREA TO MSKL-KEY-AREA. DTSBX340 01035 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX340 01036 IF L910-OK-88 DTSBX340 01037 SET W-SELECT-ALL-88 TO TRUE DTSBX340 01038 ELSE DTSBX340 01039 SET W-SELECT-NO-88 TO TRUE DTSBX340 01040 END-IF. DTSBX340 01041 DTSBX340 01042 S2000-EXIT. DTSBX340 01043 EXIT. DTSBX340 01044 DTSBX340 01045 S3000-INITIALIZE. DTSBX340 01046 * SET LX34-SELECT-NO-88 TO TRUE. DTSBX340 01047 SET W-SELECT-NO-88 TO TRUE. DTSBX340 01048 IF W-RUN-INCREMENTAL-88 DTSBX340 01049 SET W-SELECT-NAME-NO-88 TO TRUE DTSBX340 01050 SET W-SELECT-ADDR-NO-88 TO TRUE DTSBX340 01051 SET W-SELECT-OPO-NO-88 TO TRUE DTSBX340 01052 SET W-SELECT-SOL-NO-88 TO TRUE DTSBX340 01053 SET W-SELECT-FSC-NO-88 TO TRUE DTSBX340 01054 SET W-SELECT-RATE-NO-88 TO TRUE DTSBX340 01055 ELSE DTSBX340 01056 SET W-SELECT-NAME-YES-88 TO TRUE DTSBX340 01057 SET W-SELECT-ADDR-YES-88 TO TRUE DTSBX340 01058 SET W-SELECT-OPO-YES-88 TO TRUE DTSBX340 01059 SET W-SELECT-SOL-YES-88 TO TRUE DTSBX340 01060 SET W-SELECT-FSC-YES-88 TO TRUE DTSBX340 01061 SET W-SELECT-RATE-YES-88 TO TRUE DTSBX340 01062 END-IF. DTSBX340 01063 DTSBX340 01064 PERFORM DTSBX340 01065 VARYING LX34-SUB FROM +1 BY +1 DTSBX340 01066 UNTIL LX34-SUB > LX34-MAX DTSBX340 01067 SET LX34-QTR-EXISTS-NO-88 (LX34-SUB) TO TRUE DTSBX340 01068 END-PERFORM. DTSBX340 01069 DTSBX340 01070 S3000-EXIT. DTSBX340 01071 EXIT. DTSBX340 01072 DTSBX340 01073 S3100-LX34-SELECTIONS. DTSBX340 01074 MOVE W-SELECT-IND TO LX34-SELECT-IND. DTSBX340 01075 MOVE W-SELECT-NAME-IND TO LX34-SELECT-NAME-IND. DTSBX340 01076 MOVE W-SELECT-ADDR-IND TO LX34-SELECT-ADDR-IND. DTSBX340 01077 MOVE W-SELECT-OPO-IND TO LX34-SELECT-OPO-IND. DTSBX340 01078 MOVE W-SELECT-SOL-IND TO LX34-SELECT-SOL-IND. DTSBX340 01079 MOVE W-SELECT-FSC-IND TO LX34-SELECT-FSC-IND. DTSBX340 01080 MOVE W-SELECT-RATE-IND TO LX34-SELECT-RATE-IND. DTSBX340 01081 DTSBX340 01082 S3100-EXIT. DTSBX340 01083 EXIT. DTSBX340 01084 DTSBX340 01085 S999-ABEND. DTSBX340 01086 DISPLAY '*** DTSBX340 ABENDING. ' DTSBX340 01087 ABEND-MSG. DTSBX340 01088 DTSBX340 01089 CALL 'DTSBU999' USING W-ABEND-CD. DTSBX340 01090 S999-EXIT. DTSBX340 01091 EXIT. DTSBX340