1070 lines
85 KiB
COBOL
1070 lines
85 KiB
COBOL
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
|