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