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