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