1067 lines
84 KiB
COBOL
1067 lines
84 KiB
COBOL
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
|