00001 IDENTIFICATION DIVISION. 02/26/10 00002 PROGRAM-ID. DTSBX431. DTSBX431 00003 AUTHOR. NORTHROP GRUMMAN. LV001 00004 DATE-WRITTEN. SEPTEMBER 2007. DTSBX431 00005 DATE-COMPILED. DTSBX431 00006 SKIP3 DTSBX431 00007 ***** DTSBX431 00008 * DTSBX431 00009 * FUNCTION: UPDATED EVENT LOG (MEVL) AND NOTEPAD (MNTE) DTSBX431 00010 * RECORDS ON THE MAINFRAME BASED ON AN UPLOADED DTSBX431 00011 * DATA SET FROM THE REPORT DELINQUENCY TRACKING DTSBX431 00012 * APPLICATION FROM THE SERVER. DTSBX431 00013 * DTSBX431 00014 * MODIFICATION LOG: DTSBX431 00015 * DTSBX431 00016 * 02/21/2007 INITIAL DEVELOPMENT. DTSBX431 00017 * WORK ORDER: PROGRAMMER: RW1 DTSBX431 00018 * DTSBX431 00019 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX431 00020 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX431 00021 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBX431 00022 * DTSBX431 00023 * DESCRIPTION: DTSBX431 00024 * DTSBX431 00025 * UPDATE THE MAINFRAME CICS MEVL AND MNTE RECORDS. DTSBX431 00026 * DTSBX431 00027 * DTSBX431 READ THE UPLOADED DATASET FROM THE REPORT DTSBX431 00028 * DELINQUENCY TRACKING APPLICATION FROM THE DTSBX431 00029 * SERVER TO PERFORM THE UPDATE FUNCTIONS. DTSBX431 00030 * DTSBX431 00031 * REPORT RECORDS INPUT: DTSBX431 00032 * NONE. DTSBX431 00033 * DTSBX431 00034 * TAPES INPUT: DTSBX431 00035 * NONE. DTSBX431 00036 * DTSBX431 00037 * MASTER FILE RECORDS READ: DTSBX431 00038 * NONE DTSBX431 00039 * DTSBX431 00040 * MASTER FILE RECORDS UPDATED: DTSBX431 00041 * MEVL (WRITTEN). DTSBX431 00042 * MNTE (WRITTEN). DTSBX431 00043 * DTSBX431 00044 * RECORDS READ: DTSBX431 00045 * DELINQUENT DATA SET FROM THE SERVER. DTSBX431 00046 * DTSBX431 00047 * MODULES CALLED: DTSBX431 00048 * DTSBU910 MASTER FILE I/O. DTSBX431 00049 * DTSBX431 00050 ***** DTSBX431 00051 SKIP3 DTSBX431 00052 ENVIRONMENT DIVISION. DTSBX431 00053 DTSBX431 00054 INPUT-OUTPUT SECTION. DTSBX431 00055 DTSBX431 00056 FILE-CONTROL. DTSBX431 00057 SELECT WEB-DLQ-FILE ASSIGN TO WEBDLQSI DTSBX431 00058 FILE STATUS IS WEB-DLQ-STATUS. DTSBX431 00059 DTSBX431 00060 DATA DIVISION. DTSBX431 00061 DTSBX431 00062 FILE SECTION. DTSBX431 00063 DTSBX431 00064 FD WEB-DLQ-FILE DTSBX431 00065 LABEL RECORDS ARE STANDARD DTSBX431 00066 RECORDING MODE IS F DTSBX431 00067 BLOCK CONTAINS 0 RECORDS. DTSBX431 00068 DTSBX431 00069 01 WEB-DLQ-REC PIC X(1246). DTSBX431 00070 ** 05 REC-LEN PIC S9(04) COMP. DTSBX431 00071 * 05 REC-DATA OCCURS 1 TO 4087 TIMES DTSBX431 00072 ** DEPENDING ON VAR-REC-CNT PIC X(01). DTSBX431 00073 DTSBX431 00074 WORKING-STORAGE SECTION. DTSBX431 000745 77 PAN-VALET PICTURE X(24) VALUE '001DTSBX431 02/26/10'. DTSBX431 00075 SKIP3 DTSBX431 00076 01 WRK-AREA. DTSBX431 00077 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +431. DTSBX431 00078 05 ABEND-MSG PIC X(60). DTSBX431 00079 05 W-MOD-NAME PIC X(08) VALUE 'DTSBX431'.DTSBX431 00080 05 WRK-SYS-ABSTIME PIC S9(15) COMP-3 VALUE +0. DTSBX431 00081 05 WRK-SYS-DATE PIC S9(09) COMP-3 VALUE +0. DTSBX431 00082 05 WRK-SYS-TIME PIC S9(07) COMP-3 VALUE +0. DTSBX431 00083 DTSBX431 00084 05 VAR-REC-CNT PIC S9(04) COMP. DTSBX431 00085 05 WEB-DLQ-STATUS PIC X(02). DTSBX431 00086 88 WEB-DLQ-STATUS-OK-88 VALUE '00'. DTSBX431 00087 88 WEB-DLQ-STATUS-EOF-88 VALUE '10'. DTSBX431 00088 DTSBX431 00089 05 WRK-MPRF-FOUND-IND PIC X(01). DTSBX431 00090 88 WRK-MPRF-FOUND-YES-88 VALUE 'Y'. DTSBX431 00091 88 WRK-MPRF-FOUND-NO-88 VALUE 'N'. DTSBX431 00092 DTSBX431 00093 05 WRK-EMP-NO PIC S9(07) COMP-3 VALUE +0. DTSBX431 00094 05 WRK-WEB-REC-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX431 00095 05 WRK-WRITE-MEVL-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX431 00096 05 WRK-WRITE-MNTE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX431 00097 05 WRK-YES-MNTE-REC-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX431 00098 05 WRK-NO-MNTE-REC-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX431 00099 05 WRK-YES-MEVL-REC-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX431 00100 05 WRK-NO-MEVL-REC-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX431 00101 DTSBX431 00102 05 WRK-ID-NO-9 PIC 9(03). DTSBX431 00103 05 WRK-ID-NO-X REDEFINES WRK-ID-NO-9 DTSBX431 00104 PIC X(03). DTSBX431 00105 DTSBX431 00106 05 W-SLASH-QTR PIC X(06). DTSBX431 00107 05 FILLER REDEFINES W-SLASH-QTR. DTSBX431 00108 10 W-SLASH-QTR-CCYY PIC X(04). DTSBX431 00109 10 FILLER PIC X(01). DTSBX431 00110 10 W-SLASH-QTR-Q PIC X(01). DTSBX431 00111 DTSBX431 00112 05 WRK-ESTB-DATE-TIME. DTSBX431 00113 10 WRK-ESTB-CCYY PIC X(04) VALUE SPACES. DTSBX431 00114 10 FILLER PIC X(01) VALUE SPACE. DTSBX431 00115 10 WRK-ESTB-MO PIC X(02) VALUE SPACES. DTSBX431 00116 10 FILLER PIC X(01) VALUE SPACE. DTSBX431 00117 10 WRK-ESTB-DD PIC X(02) VALUE SPACES. DTSBX431 00118 10 FILLER PIC X(01) VALUE SPACE. DTSBX431 00119 10 WRK-ESTB-HH PIC X(02) VALUE SPACES. DTSBX431 00120 10 FILLER PIC X(01) VALUE SPACE. DTSBX431 00121 10 WRK-ESTB-MM PIC X(02) VALUE SPACES. DTSBX431 00122 10 FILLER PIC X(01) VALUE SPACE. DTSBX431 00123 10 WRK-ESTB-SS PIC X(02) VALUE SPACES. DTSBX431 00124 DTSBX431 00125 05 WRK-DATE-X. DTSBX431 00126 10 WRK-CCYY PIC X(04) VALUE SPACES. DTSBX431 00127 10 WRK-MO PIC X(02) VALUE SPACES. DTSBX431 00128 10 WRK-DD PIC X(02) VALUE SPACES. DTSBX431 00129 05 WRK-DATE-9 REDEFINES WRK-DATE-X DTSBX431 00130 PIC 9(08). DTSBX431 00131 05 WRK-TIME-X. DTSBX431 00132 10 WRK-HH PIC X(02) VALUE SPACES. DTSBX431 00133 10 WRK-MM PIC X(02) VALUE SPACES. DTSBX431 00134 10 WRK-SS PIC X(02) VALUE SPACES. DTSBX431 00135 05 WRK-TIME-9 REDEFINES WRK-TIME-X DTSBX431 00136 PIC 9(06). DTSBX431 00137 DTSBX431 00138 05 WRK-DIFFERENCE PIC S9(08) COMP VALUE +0. DTSBX431 00139 DTSBX431 00140 05 W-MNTE-COMPLETE-IND PIC X(01) VALUE 'N'. DTSBX431 00141 88 W-MNTE-COMPLETE-YES-88 VALUE 'Y'. DTSBX431 00142 88 W-MNTE-COMPLETE-NO-88 VALUE 'N'. DTSBX431 00143 DTSBX431 00144 05 W-MNTE-TEXT-CNT PIC S9(04) COMP VALUE +0. DTSBX431 00145 05 W-MNTE-TEXT-MAX PIC S9(04) COMP VALUE +16. DTSBX431 00146 05 W-MNTE-TEXT-AREA. DTSBX431 00147 10 W-MNTE-TEXT OCCURS 16 TIMES DTSBX431 00148 PIC X(72). DTSBX431 00149 DTSBX431 00150 05 TSUB1 PIC S9(04) COMP. DTSBX431 00151 05 TSUB2 PIC S9(04) COMP. DTSBX431 00152 05 W-LAST-SPACE PIC S9(04) COMP. DTSBX431 00153 05 W-TEXT-CNT PIC S9(04) COMP. DTSBX431 00154 DTSBX431 00155 05 W-MNTE-LINE PIC X(72). DTSBX431 00156 DTSBX431 00157 05 W-CASE-TYPE PIC X(09). DTSBX431 00158 88 W-CASE-TYPE-COLL-88 DTSBX431 00159 VALUE 'COLLECT: '. DTSBX431 00160 88 W-CASE-TYPE-RPT-88 DTSBX431 00161 VALUE 'RPT DEL: '. DTSBX431 00162 DTSBX431 00163 05 W-CASE-NO PIC S9(09) COMP-3. DTSBX431 00164 05 W-CASE-NO-X PIC X(09). DTSBX431 00165 05 W-CASE-NO-9 REDEFINES W-CASE-NO-X DTSBX431 00166 PIC 9(09). DTSBX431 00167 05 W-LEN-X PIC X(04). DTSBX431 00168 05 W-LEN-9 REDEFINES W-LEN-X DTSBX431 00169 PIC 9(04). DTSBX431 00170 DTSBX431 00171 05 W-MULTIPLIER PIC S9(11)V99 COMP-3 DTSBX431 00172 VALUE +0. DTSBX431 00173 05 W-DIGIT PIC 9. DTSBX431 00174 05 W-AMT PIC S9(09)V99 COMP-3 DTSBX431 00175 VALUE +0. DTSBX431 00176 05 SUB PIC S9(04) COMP. DTSBX431 00177 DTSBX431 00178 05 W-DECIMAL-FOUND-IND PIC X(01) VALUE 'N'. DTSBX431 00179 88 W-DECIMAL-FOUND-YES-88 VALUE 'Y'. DTSBX431 00180 88 W-DECIMAL-FOUND-NO-88 VALUE 'N'. DTSBX431 00181 DTSBX431 00182 05 W-SLASH-DATE PIC X(10). DTSBX431 00183 05 FILLER REDEFINES W-SLASH-DATE. DTSBX431 00184 10 W-SLASH-DT-MM PIC X(02). DTSBX431 00185 10 FILLER PIC X(01). DTSBX431 00186 10 W-SLASH-DT-DD PIC X(02). DTSBX431 00187 10 FILLER PIC X(01). DTSBX431 00188 10 W-SLASH-DT-CCYY PIC X(04). DTSBX431 00189 DTSBX431 00190 05 W-SLASH-QTR PIC X(06). DTSBX431 00191 05 FILLER REDEFINES W-SLASH-QTR. DTSBX431 00192 10 W-SLASH-QTR-CCYY PIC X(04). DTSBX431 00193 10 FILLER PIC X(01). DTSBX431 00194 10 W-SLASH-QTR-Q PIC X(01). DTSBX431 00195 DTSBX431 00196 05 ISUB1 PIC S9(04) COMP. DTSBX431 00197 05 ISUB2 PIC S9(04) COMP. DTSBX431 00198 05 ISUB3 PIC S9(04) COMP. DTSBX431 00199 05 ISUB4 PIC S9(04) COMP. DTSBX431 00200 05 ISUB5 PIC S9(04) COMP. DTSBX431 00201 05 ISUB6 PIC S9(04) COMP. DTSBX431 00202 05 W-SLASH1 PIC S9(04) COMP. DTSBX431 00203 05 W-SLASH2 PIC S9(04) COMP. DTSBX431 00204 05 W-CURR-FIELD PIC S9(04) COMP. DTSBX431 00205 05 W-LAST-FIELD PIC S9(04) COMP. DTSBX431 00206 05 W-LAST-FIELD-LEN PIC S9(04) COMP-3. DTSBX431 00207 05 W-INPUT-LENGTH PIC S9(04) COMP DTSBX431 00208 VALUE +1154. DTSBX431 00209 05 W-INPUT-LINE PIC X(1152). DTSBX431 00210 05 W-PARSE-COMPLETE-IND PIC X(01). DTSBX431 00211 88 W-PARSE-COMPLETE-YES-88 VALUE 'Y'. DTSBX431 00212 88 W-PARSE-COMPLETE-NO-88 VALUE 'N'. DTSBX431 00213 05 W-FIELD-LENGTH PIC S9(04) COMP. DTSBX431 00214 05 W-CONV-LINE PIC X(32). DTSBX431 00215 DTSBX431 00216 05 W-MDY PIC X(04). DTSBX431 00217 05 FILLER REDEFINES W-MDY. DTSBX431 00218 10 FILLER PIC X(02). DTSBX431 00219 10 W-MDY-X-2 PIC X(02). DTSBX431 00220 10 FILLER REDEFINES W-MDY-X-2. DTSBX431 00221 15 FILLER PIC X(01). DTSBX431 00222 15 W-MDY-X-1 PIC X(01). DTSBX431 00223 DTSBX431 00224 05 AMT-DISP1 PIC 9(09). DTSBX431 00225 DTSBX431 00226 01 L001-LINK-AREA. DTSBX431 00227 ++INCLUDE DTSIL001 DTSBX431 00228 DTSBX431 00229 01 WRK-WEB-DLQ-REC. DTSBX431 00230 ++INCLUDE DTSIX431 DTSBX431 00231 SKIP3 DTSBX431 00232 01 T003-REC. DTSBX431 00233 ++INCLUDE DTSIT003 DTSBX431 00234 EJECT DTSBX431 00235 01 L005-LINK-AREA. DTSBX431 00236 ++INCLUDE DTSIL005 DTSBX431 00237 EJECT DTSBX431 00238 01 L910-LINK-AREA. DTSBX431 00239 ++INCLUDE DTSIL910 DTSBX431 00240 EJECT DTSBX431 00241 01 MSKL-REC. DTSBX431 00242 ++INCLUDE DTSIMSKL DTSBX431 00243 EJECT DTSBX431 00244 01 MPRF-REC. DTSBX431 00245 ++INCLUDE DTSIMPRF DTSBX431 00246 EJECT DTSBX431 00247 01 MNTE-REC. DTSBX431 00248 ++INCLUDE DTSIMNTE DTSBX431 00249 EJECT DTSBX431 00250 01 MEVL-REC. DTSBX431 00251 ++INCLUDE DTSIMEVL DTSBX431 00252 EJECT DTSBX431 00253 01 L921-LINK-AREA. DTSBX431 00254 ++INCLUDE DTSIL921 DTSBX431 00255 EJECT DTSBX431 00256 01 ISKL-REC. DTSBX431 00257 ++INCLUDE DTSIISKL DTSBX431 00258 EJECT DTSBX431 00259 01 L927-LINK-AREA. DTSBX431 00260 ++INCLUDE DTSIL927 DTSBX431 00261 EJECT DTSBX431 00262 01 TSKL-REC. DTSBX431 00263 ++INCLUDE DTSITSKL DTSBX431 00264 EJECT DTSBX431 00265 PROCEDURE DIVISION. DTSBX431 00266 DTSBX431 00267 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBX431 00268 DTSBX431 00269 DTSBX431 00270 MOVE +0 TO WRK-EMP-NO. DTSBX431 00271 DTSBX431 00272 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBX431 00273 UNTIL WEB-DLQ-STATUS-EOF-88. DTSBX431 00274 DTSBX431 00275 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBX431 00276 DTSBX431 00277 GOBACK. DTSBX431 00278 EJECT DTSBX431 00279 DTSBX431 00280 I0000-INITIATE. DTSBX431 00281 DTSBX431 00282 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBX431 00283 ** PERFORM S910-OPEN-UPDATE THRU S910-EXIT. DTSBX431 00284 * DTSBX431 00285 ** PERFORM S921-OPEN-UPDATE THRU S921-EXIT. DTSBX431 00286 DTSBX431 00287 OPEN INPUT WEB-DLQ-FILE. DTSBX431 00288 DTSBX431 00289 IF NOT WEB-DLQ-STATUS-OK-88 DTSBX431 00290 MOVE 'CANNOT OPEN WEB-DLQ-FILE ' TO ABEND-MSG DTSBX431 00291 PERFORM S999-ABEND THRU S999-EXIT DTSBX431 00292 GO TO I0000-EXIT DTSBX431 00293 END-IF. DTSBX431 00294 DTSBX431 00295 MOVE 'N' TO L927-TRACE-IND. DTSBX431 00296 MOVE W-MOD-NAME TO L927-MOD-NAME. DTSBX431 00297 PERFORM S927A-OPEN THRU S927A-EXIT. DTSBX431 00298 DTSBX431 00299 PERFORM S005-FROM-SYS THRU S005-EXIT. DTSBX431 00300 MOVE L005-DATE TO WRK-SYS-DATE. DTSBX431 00301 MOVE L005-TIME TO WRK-SYS-TIME. DTSBX431 00302 DTSBX431 00303 MOVE +0 TO WRK-WRITE-MEVL-CNT DTSBX431 00304 WRK-WRITE-MNTE-CNT DTSBX431 00305 WRK-WEB-REC-CNT. DTSBX431 00306 DTSBX431 00307 MOVE +9 TO W-LAST-FIELD. DTSBX431 00308 ** MOVE +1152 TO W-LAST-FIELD-LEN. DTSBX431 00309 DTSBX431 00310 I0000-EXIT. DTSBX431 00311 EXIT. DTSBX431 00312 DTSBX431 00313 P0000-PROCESS. DTSBX431 00314 READ WEB-DLQ-FILE. DTSBX431 00315 IF NOT WEB-DLQ-STATUS-OK-88 DTSBX431 00316 DISPLAY 'NO RECORDS IN INPUT FILE ' WEB-DLQ-STATUS DTSBX431 00317 GO TO P0000-EXIT DTSBX431 00318 ELSE DTSBX431 00319 ADD +1 TO WRK-WEB-REC-CNT DTSBX431 00320 PERFORM UNTIL WEB-DLQ-STATUS-EOF-88 DTSBX431 00321 INITIALIZE WRK-WEB-DLQ-REC DTSBX431 00322 PERFORM S2000-PARSE THRU S2000-EXIT DTSBX431 00323 SET WRK-MPRF-FOUND-NO-88 TO TRUE DTSBX431 00324 PERFORM P0100-FIND-MPRF THRU P0100-EXIT DTSBX431 00325 IF WRK-MPRF-FOUND-YES-88 DTSBX431 00326 PERFORM P1000-WRITE-MNTE-RECORD THRU P1000-EXIT DTSBX431 00327 PERFORM P2000-WRITE-MEVL-RECORD THRU P2000-EXIT DTSBX431 00328 END-IF DTSBX431 00329 READ WEB-DLQ-FILE DTSBX431 00330 END-PERFORM DTSBX431 00331 END-IF. DTSBX431 00332 DTSBX431 00333 P0000-EXIT. DTSBX431 00334 EXIT. DTSBX431 00335 DTSBX431 00336 P0100-FIND-MPRF. DTSBX431 00337 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBX431 00338 MOVE X431-EMP-NO TO MSKL-EMP-NO. DTSBX431 00339 SET MSKL-PRF-88 TO TRUE. DTSBX431 00340 DTSBX431 00341 PERFORM S910-READ THRU S910-EXIT. DTSBX431 00342 IF L910-NO-REC-88 DTSBX431 00343 DISPLAY 'EMPLOYER NOT ON FILE: ' X431-EMP-NO DTSBX431 00344 ELSE DTSBX431 00345 MOVE MSKL-REC TO MPRF-REC DTSBX431 00346 SET WRK-MPRF-FOUND-YES-88 TO TRUE DTSBX431 00347 END-IF. DTSBX431 00348 DTSBX431 00349 P0100-EXIT. DTSBX431 00350 EXIT. DTSBX431 00351 DTSBX431 00352 P1000-WRITE-MNTE-RECORD. DTSBX431 00353 MOVE X431-ESTB-DATE TO L001-SLASH-8-DATE. DTSBX431 00354 MOVE L001-SLASH-8-MO TO L001-FED-8-MO. DTSBX431 00355 MOVE L001-SLASH-8-DA TO L001-FED-8-DA. DTSBX431 00356 MOVE L001-SLASH-8-YR TO L001-FED-8-YR. DTSBX431 00357 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX431 00358 DTSBX431 00359 MOVE LOW-VALUES TO MNTE-REC. DTSBX431 00360 MOVE X431-EMP-NO TO MNTE-EMP-NO. DTSBX431 00361 SET MNTE-NTE-88 TO TRUE. DTSBX431 00362 DTSBX431 00363 MOVE ZERO TO MNTE-DATA-ESTB-ABSTIME DTSBX431 00364 MNTE-CHNG-ABSTIME. DTSBX431 00365 MOVE L001-FED-8-DATE-9 TO MNTE-ESTB-DATE DTSBX431 00366 MNTE-CHNG-DATE. DTSBX431 00367 DTSBX431 00368 DISPLAY 'MNTE ' MNTE-EMP-NO. DTSBX431 00369 MOVE X431-OPID TO MNTE-ESTB-OP-ID DTSBX431 00370 MNTE-CHNG-OP-ID. DTSBX431 00371 DTSBX431 00372 MOVE +0 TO MNTE-PURGE-DATE. DTSBX431 00373 DTSBX431 00374 SET MNTE-NOT-CONVERTED-88 TO TRUE. DTSBX431 00375 DTSBX431 00376 EVALUATE TRUE DTSBX431 00377 WHEN X431-RPT-DELINQ-88 DTSBX431 00378 SET W-CASE-TYPE-RPT-88 TO TRUE DTSBX431 00379 WHEN X431-COLLECTIONS-88 DTSBX431 00380 SET W-CASE-TYPE-COLL-88 TO TRUE DTSBX431 00381 END-EVALUATE. DTSBX431 00382 DTSBX431 00383 STRING DTSBX431 00384 W-CASE-TYPE DTSBX431 00385 X431-CASE-NO DTSBX431 00386 DELIMITED BY SIZE DTSBX431 00387 INTO MNTE-SUBJECT DTSBX431 00388 END-STRING. DTSBX431 00389 DTSBX431 00390 MOVE X431-ACTION TO MNTE-TEXT (1). DTSBX431 00391 INSPECT X431-RESULT REPLACING ALL ';' BY ','. DTSBX431 00392 DTSBX431 00393 MOVE +1 TO MNTE-TEXT-CNT. DTSBX431 00394 PERFORM P1001-MOVE-TEXT THRU P1001-EXIT. DTSBX431 00395 DTSBX431 00396 MOVE LENGTH OF T003-REC TO T003-LENGTH. DTSBX431 00397 MOVE '003' TO T003-REC-TYPE. DTSBX431 00398 MOVE MPRF-EMP-NO TO T003-EMP-NO. DTSBX431 00399 MOVE 'CASE TRACK' TO T003-ORIGIN. DTSBX431 00400 MOVE L005-DATE TO T003-SYS-DATE. DTSBX431 00401 MOVE L005-TIME TO T003-SYS-TIME. DTSBX431 00402 SET T003-ADD-MNTE-88 TO TRUE. DTSBX431 00403 MOVE MNTE-REC TO T003-MNTE-REC. DTSBX431 00404 DTSBX431 00405 ** DISPLAY 'MNTE ' MNTE-EMP-NO ' ' MNTE-SUBJECT. DTSBX431 00406 MOVE T003-REC TO TSKL-REC. DTSBX431 00407 PERFORM S927B-WRITE THRU S927B-EXIT. DTSBX431 00408 DTSBX431 00409 ADD +1 TO WRK-WRITE-MNTE-CNT. DTSBX431 00410 DTSBX431 00411 P1000-EXIT. DTSBX431 00412 EXIT. DTSBX431 00413 DTSBX431 00414 P1001-MOVE-TEXT. DTSBX431 00415 SET W-MNTE-COMPLETE-NO-88 TO TRUE. DTSBX431 00416 MOVE SPACES TO W-MNTE-LINE. DTSBX431 00417 MOVE +0 TO W-LAST-SPACE DTSBX431 00418 TSUB1 DTSBX431 00419 TSUB2. DTSBX431 00420 ** MNTE-TEXT-CNT. DTSBX431 00421 PERFORM DTSBX431 00422 UNTIL W-MNTE-COMPLETE-YES-88 DTSBX431 00423 ADD +1 TO TSUB1 DTSBX431 00424 IF TSUB1 <= +1152 DTSBX431 00425 PERFORM P1001A-MOVE-DATA THRU P1001A-EXIT DTSBX431 00426 ELSE DTSBX431 00427 SET W-MNTE-COMPLETE-YES-88 TO TRUE DTSBX431 00428 END-IF DTSBX431 00429 END-PERFORM. DTSBX431 00430 DTSBX431 00431 P1001-EXIT. DTSBX431 00432 EXIT. DTSBX431 00433 DTSBX431 00434 P1001A-MOVE-DATA. DTSBX431 00435 IF TSUB2 < +72 DTSBX431 00436 ADD +1 TO TSUB2 DTSBX431 00437 MOVE X431-RESULT (TSUB1:1) DTSBX431 00438 TO W-MNTE-LINE (TSUB2:1) DTSBX431 00439 IF X431-RESULT (TSUB1:1) = SPACE DTSBX431 00440 MOVE TSUB2 TO W-LAST-SPACE DTSBX431 00441 END-IF DTSBX431 00442 ELSE DTSBX431 00443 PERFORM P1001B-RESET THRU P1001B-EXIT DTSBX431 00444 IF W-MNTE-LINE NOT = SPACES DTSBX431 00445 ADD +1 TO MNTE-TEXT-CNT DTSBX431 00446 MOVE W-MNTE-LINE TO MNTE-TEXT (MNTE-TEXT-CNT) DTSBX431 00447 MOVE SPACES TO W-MNTE-LINE DTSBX431 00448 MOVE +0 TO W-LAST-SPACE DTSBX431 00449 TSUB2 DTSBX431 00450 DISPLAY 'MSG = ' MNTE-TEXT (MNTE-TEXT-CNT) DTSBX431 00451 ELSE DTSBX431 00452 MOVE +0 TO W-LAST-SPACE DTSBX431 00453 TSUB2 DTSBX431 00454 END-IF DTSBX431 00455 END-IF. DTSBX431 00456 DTSBX431 00457 ** DISPLAY 'A ' TSUB1 ' ' TSUB2 ' ' W-MNTE-LINE. DTSBX431 00458 DTSBX431 00459 P1001A-EXIT. DTSBX431 00460 EXIT. DTSBX431 00461 DTSBX431 00462 P1001B-RESET. DTSBX431 00463 * DISPLAY 'B1 ' W-LAST-SPACE ' ' TSUB1 ' ' TSUB2. DTSBX431 00464 ************* DTSBX431 00465 * EXIT IF THE LAST LETTER MOVED IS A SPACE, OR IF THE CURRENT DTSBX431 00466 * LINE DOES NOT CONTAIN ANY SPACES. DTSBX431 00467 ************* DTSBX431 00468 IF W-MNTE-LINE (72:1) = SPACE DTSBX431 00469 SUBTRACT +1 FROM TSUB1 DTSBX431 00470 GO TO P1001B-EXIT DTSBX431 00471 END-IF. DTSBX431 00472 DTSBX431 00473 IF W-LAST-SPACE = ZERO DTSBX431 00474 GO TO P1001B-EXIT DTSBX431 00475 END-IF. DTSBX431 00476 DTSBX431 00477 ************* DTSBX431 00478 * REPLACE THE LAST LETTERS WRITTEN (OCCURRING IN THE MIDDLE OF DTSBX431 00479 * A WORD) WITH SPACES. DTSBX431 00480 ************* DTSBX431 00481 PERFORM DTSBX431 00482 VARYING TSUB2 FROM W-LAST-SPACE BY +1 DTSBX431 00483 UNTIL TSUB2 > +72 DTSBX431 00484 MOVE SPACE TO W-MNTE-LINE (TSUB2:1) DTSBX431 00485 END-PERFORM. DTSBX431 00486 DTSBX431 00487 ************* DTSBX431 00488 * RESET TSUB1 TO POINT TO THE FIRST LETTER OF THE INCOMPLETED DTSBX431 00489 * WORD. DTSBX431 00490 ************* DTSBX431 00491 COMPUTE TSUB1 = TSUB1 - (73 - W-LAST-SPACE). DTSBX431 00492 DTSBX431 00493 ** DISPLAY 'B2 ' TSUB1 ' ' TSUB2 ' ' W-MNTE-LINE. DTSBX431 00494 DTSBX431 00495 P1001B-EXIT. DTSBX431 00496 EXIT. DTSBX431 00497 DTSBX431 00498 P2000-WRITE-MEVL-RECORD. DTSBX431 00499 MOVE X431-ESTB-DATE TO L001-SLASH-8-DATE. DTSBX431 00500 MOVE L001-SLASH-8-MO TO L001-FED-8-MO. DTSBX431 00501 MOVE L001-SLASH-8-DA TO L001-FED-8-DA. DTSBX431 00502 MOVE L001-SLASH-8-YR TO L001-FED-8-YR. DTSBX431 00503 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX431 00504 DTSBX431 00505 MOVE LOW-VALUES TO MEVL-REC. DTSBX431 00506 MOVE X431-EMP-NO TO MEVL-EMP-NO. DTSBX431 00507 SET MEVL-EVL-88 TO TRUE. DTSBX431 00508 DTSBX431 00509 EVALUATE TRUE DTSBX431 00510 WHEN X431-RPT-DELINQ-88 DTSBX431 00511 SET W-CASE-TYPE-RPT-88 TO TRUE DTSBX431 00512 SET MEVL-BA-ACCOUNTING-88 TO TRUE DTSBX431 00513 SET MEVL-ACT-CT-RPT-DEL-88 TO TRUE DTSBX431 00514 WHEN X431-COLLECTIONS-88 DTSBX431 00515 SET W-CASE-TYPE-COLL-88 TO TRUE DTSBX431 00516 SET MEVL-BA-COLLECTIONS-88 TO TRUE DTSBX431 00517 SET MEVL-ACT-CT-COLLECT-88 TO TRUE DTSBX431 00518 END-EVALUATE. DTSBX431 00519 DTSBX431 00520 STRING DTSBX431 00521 W-CASE-TYPE DTSBX431 00522 X431-ACTION DTSBX431 00523 DELIMITED BY SIZE DTSBX431 00524 INTO MEVL-TEXT DTSBX431 00525 END-STRING. DTSBX431 00526 DTSBX431 00527 MOVE ZEROS TO MEVL-PURGE-DATE. DTSBX431 00528 DTSBX431 00529 MOVE X431-OPID TO MEVL-SOURCE. DTSBX431 00530 DTSBX431 00531 SET MEVL-NOT-CONVERTED-88 TO TRUE. DTSBX431 00532 DTSBX431 00533 MOVE ZERO TO MEVL-DATE DTSBX431 00534 MEVL-TIME. DTSBX431 00535 MOVE L001-FED-8-DATE-9 TO MEVL-ESTB-DATE DTSBX431 00536 MEVL-CHNG-DATE. DTSBX431 00537 DTSBX431 00538 MOVE LENGTH OF T003-REC TO T003-LENGTH. DTSBX431 00539 MOVE '003' TO T003-REC-TYPE. DTSBX431 00540 MOVE MPRF-EMP-NO TO T003-EMP-NO. DTSBX431 00541 MOVE 'CASE TRACK' TO T003-ORIGIN. DTSBX431 00542 MOVE L005-DATE TO T003-SYS-DATE. DTSBX431 00543 MOVE L005-TIME TO T003-SYS-TIME. DTSBX431 00544 SET T003-ADD-MEVL-88 TO TRUE. DTSBX431 00545 MOVE MEVL-REC TO T003-MEVL-REC. DTSBX431 00546 DTSBX431 00547 MOVE T003-REC TO TSKL-REC. DTSBX431 00548 PERFORM S927B-WRITE THRU S927B-EXIT. DTSBX431 00549 DTSBX431 00550 ADD +1 TO WRK-WRITE-MEVL-CNT. DTSBX431 00551 DTSBX431 00552 P2000-EXIT. DTSBX431 00553 EXIT. DTSBX431 00554 DTSBX431 00555 T0000-TERMINATE. DTSBX431 00556 DISPLAY DTSBX431 00557 '*** DTSBX431 TERMINATION STATISTICS'. DTSBX431 00558 DTSBX431 00559 DISPLAY ' '. DTSBX431 00560 DTSBX431 00561 DISPLAY DTSBX431 00562 '*** NO OF WEB DELINQUENT INPUT RECORDS READ : ' DTSBX431 00563 WRK-WEB-REC-CNT. DTSBX431 00564 DTSBX431 00565 DISPLAY ' '. DTSBX431 00566 DTSBX431 00567 DISPLAY DTSBX431 00568 '*** NUMBER OF MNTE NOTE PAD RECORDS WRITTEN : ' DTSBX431 00569 WRK-WRITE-MNTE-CNT. DTSBX431 00570 DTSBX431 00571 DISPLAY DTSBX431 00572 '*** NUMBER OF MNTE RECS ALREADY EXISTED CNT : ' DTSBX431 00573 WRK-YES-MNTE-REC-CNT. DTSBX431 00574 DTSBX431 00575 DISPLAY ' '. DTSBX431 00576 DTSBX431 00577 DISPLAY DTSBX431 00578 '*** NUMBER OF MEVL EVENT LOG RECORDS WRITTEN: ' DTSBX431 00579 WRK-WRITE-MEVL-CNT. DTSBX431 00580 DTSBX431 00581 DISPLAY DTSBX431 00582 '*** NUMBER OF MEVL RECS ALREADY EXISTED CNT : ' DTSBX431 00583 WRK-YES-MEVL-REC-CNT. DTSBX431 00584 DTSBX431 00585 PERFORM S910-CLOSE THRU S910-EXIT. DTSBX431 00586 PERFORM S927C-CLOSE THRU S927C-EXIT. DTSBX431 00587 CLOSE WEB-DLQ-FILE. DTSBX431 00588 DTSBX431 00589 T0000-EXIT. DTSBX431 00590 EXIT. DTSBX431 00591 EJECT DTSBX431 00592 DTSBX431 00593 S001-FROM-FED-8. DTSBX431 00594 SET L001-FROM-FED-8 TO TRUE. DTSBX431 00595 GO TO S001-DATE. DTSBX431 00596 DTSBX431 00597 S001-DATE. DTSBX431 00598 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX431 00599 S001-EXIT. DTSBX431 00600 EXIT. DTSBX431 00601 DTSBX431 00602 S005-FROM-SYS. DTSBX431 00603 SET L005-FROM-SYS TO TRUE. DTSBX431 00604 GO TO S005-ABSTIME. DTSBX431 00605 DTSBX431 00606 S005-FROM-ABSTIME. DTSBX431 00607 SET L005-FROM-ABSTIME TO TRUE. DTSBX431 00608 GO TO S005-ABSTIME. DTSBX431 00609 DTSBX431 00610 S005-FROM-DATE-TIME. DTSBX431 00611 SET L005-FROM-DATE-TIME TO TRUE. DTSBX431 00612 GO TO S005-ABSTIME. DTSBX431 00613 DTSBX431 00614 S005-ABSTIME. DTSBX431 00615 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBX431 00616 DTSBX431 00617 S005-EXIT. DTSBX431 00618 EXIT. DTSBX431 00619 DTSBX431 00620 S910-OPEN-READ. DTSBX431 00621 SET L910-OPEN-READ-88 TO TRUE. DTSBX431 00622 GO TO S910-MSTR-CALL. DTSBX431 00623 DTSBX431 00624 S910-OPEN-UPDATE. DTSBX431 00625 SET L910-OPEN-UPDATE-88 TO TRUE. DTSBX431 00626 GO TO S910-MSTR-CALL. DTSBX431 00627 DTSBX431 00628 S910-READ. DTSBX431 00629 SET L910-READ-88 TO TRUE. DTSBX431 00630 GO TO S910-MSTR-CALL. DTSBX431 00631 DTSBX431 00632 S910-START-BROWSE. DTSBX431 00633 SET L910-START-BROWSE-88 TO TRUE. DTSBX431 00634 GO TO S910-MSTR-CALL. DTSBX431 00635 DTSBX431 00636 S910-READ-NEXT. DTSBX431 00637 SET L910-READ-NEXT-88 TO TRUE. DTSBX431 00638 GO TO S910-MSTR-CALL. DTSBX431 00639 DTSBX431 00640 S910-REWRITE. DTSBX431 00641 SET L910-REWRITE-88 TO TRUE. DTSBX431 00642 GO TO S910-MSTR-CALL. DTSBX431 00643 DTSBX431 00644 S910-WRITE. DTSBX431 00645 SET L910-WRITE-88 TO TRUE. DTSBX431 00646 GO TO S910-MSTR-CALL. DTSBX431 00647 DTSBX431 00648 S910-CLOSE. DTSBX431 00649 SET L910-CLOSE-88 TO TRUE. DTSBX431 00650 GO TO S910-MSTR-CALL. DTSBX431 00651 DTSBX431 00652 S910-MSTR-CALL. DTSBX431 00653 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX431 00654 MSKL-REC. DTSBX431 00655 S910-EXIT. DTSBX431 00656 EXIT. DTSBX431 00657 DTSBX431 00658 S921-OPEN-UPDATE. DTSBX431 00659 SET L921-OPEN-UPDATE-88 TO TRUE. DTSBX431 00660 GO TO S921-AIX-IO. DTSBX431 00661 DTSBX431 00662 S921-CLOSE. DTSBX431 00663 SET L921-CLOSE-88 TO TRUE. DTSBX431 00664 GO TO S921-AIX-IO. DTSBX431 00665 DTSBX431 00666 S921-AIX-IO. DTSBX431 00667 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX431 00668 ISKL-REC. DTSBX431 00669 S921-EXIT. DTSBX431 00670 EXIT. DTSBX431 00671 DTSBX431 00672 S927A-OPEN. DTSBX431 00673 SET L927-OPEN-UPDATE-88 TO TRUE. DTSBX431 00674 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX431 00675 DTSBX431 00676 S927A-EXIT. DTSBX431 00677 EXIT. DTSBX431 00678 DTSBX431 00679 S927B-WRITE. DTSBX431 00680 SET L927-WRITE-88 TO TRUE. DTSBX431 00681 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX431 00682 DTSBX431 00683 S927B-EXIT. DTSBX431 00684 EXIT. DTSBX431 00685 DTSBX431 00686 S927C-CLOSE. DTSBX431 00687 SET L927-CLOSE-88 TO TRUE. DTSBX431 00688 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX431 00689 DTSBX431 00690 S927C-EXIT. DTSBX431 00691 EXIT. DTSBX431 00692 DTSBX431 00693 S927Z-IO. DTSBX431 00694 CALL 'DTSBU927' USING L927-LINK-AREA DTSBX431 00695 TSKL-REC. DTSBX431 00696 S927Z-EXIT. DTSBX431 00697 EXIT. DTSBX431 00698 DTSBX431 00699 S2000-PARSE. DTSBX431 00700 SET W-PARSE-COMPLETE-NO-88 TO TRUE. DTSBX431 00701 MOVE +1 TO ISUB1. DTSBX431 00702 MOVE +0 TO ISUB2. DTSBX431 00703 MOVE +1 TO W-CURR-FIELD. DTSBX431 00704 MOVE +0 TO W-LAST-FIELD-LEN. DTSBX431 00705 DTSBX431 00706 MOVE SPACES TO W-INPUT-LINE. DTSBX431 00707 DTSBX431 00708 PERFORM DTSBX431 00709 UNTIL W-PARSE-COMPLETE-YES-88 DTSBX431 00710 IF WEB-DLQ-REC (ISUB1:1) NOT = ',' DTSBX431 00711 IF W-CURR-FIELD = W-LAST-FIELD DTSBX431 00712 PERFORM S2010-LAST-FIELD THRU S2010-EXIT DTSBX431 00713 ELSE DTSBX431 00714 PERFORM S2020-MOVE-CHAR THRU S2020-EXIT DTSBX431 00715 END-IF DTSBX431 00716 ELSE DTSBX431 00717 PERFORM S2100-MOVE-TO-REC THRU S2100-EXIT DTSBX431 00718 ADD +1 TO W-CURR-FIELD DTSBX431 00719 MOVE +0 TO ISUB2 DTSBX431 00720 MOVE SPACES TO W-INPUT-LINE DTSBX431 00721 IF WEB-DLQ-REC ((ISUB1 + 1):1) = ',' DTSBX431 00722 ADD +1 TO ISUB1 DTSBX431 00723 PERFORM S2100-MOVE-TO-REC THRU S2100-EXIT DTSBX431 00724 ADD +1 TO W-CURR-FIELD DTSBX431 00725 END-IF DTSBX431 00726 END-IF DTSBX431 00727 ADD +1 TO ISUB1 DTSBX431 00728 IF ISUB1 > W-INPUT-LENGTH DTSBX431 00729 SET W-PARSE-COMPLETE-YES-88 TO TRUE DTSBX431 00730 END-IF DTSBX431 00731 DTSBX431 00732 END-PERFORM. DTSBX431 00733 DTSBX431 00734 PERFORM S2100-MOVE-TO-REC THRU S2100-EXIT. DTSBX431 00735 MOVE SPACES TO W-INPUT-LINE. DTSBX431 00736 ** DISPLAY X431-RESULT (1:80). DTSBX431 00737 DTSBX431 00738 S2000-EXIT. DTSBX431 00739 EXIT. DTSBX431 00740 DTSBX431 00741 S2010-LAST-FIELD. DTSBX431 00742 IF W-LAST-FIELD-LEN NOT NUMERIC DTSBX431 00743 DISPLAY 'LEN NOT NUMERIC ' X431-EMP-NO DTSBX431 00744 END-IF. DTSBX431 00745 ADD +1 TO ISUB2 DTSBX431 00746 IF ISUB2 > W-LAST-FIELD-LEN DTSBX431 00747 OR WEB-DLQ-REC (ISUB1:1) = ',' DTSBX431 00748 SET W-PARSE-COMPLETE-YES-88 TO TRUE DTSBX431 00749 ELSE DTSBX431 00750 MOVE WEB-DLQ-REC (ISUB1:1) DTSBX431 00751 TO W-INPUT-LINE (ISUB2:1) DTSBX431 00752 END-IF. DTSBX431 00753 DTSBX431 00754 S2010-EXIT. DTSBX431 00755 EXIT. DTSBX431 00756 DTSBX431 00757 S2020-MOVE-CHAR. DTSBX431 00758 ADD +1 TO ISUB2. DTSBX431 00759 MOVE WEB-DLQ-REC (ISUB1:1) DTSBX431 00760 TO W-INPUT-LINE (ISUB2:1). DTSBX431 00761 DTSBX431 00762 S2020-EXIT. DTSBX431 00763 EXIT. DTSBX431 00764 DTSBX431 00765 S2100-MOVE-TO-REC. DTSBX431 00766 EVALUATE TRUE DTSBX431 00767 WHEN W-CURR-FIELD = 1 DTSBX431 00768 MOVE W-INPUT-LINE (1:03) TO X431-REC-TYPE DTSBX431 00769 DTSBX431 00770 WHEN W-CURR-FIELD = 2 DTSBX431 00771 MOVE W-INPUT-LINE (1:06) TO X431-EMP-NO DTSBX431 00772 DTSBX431 00773 WHEN W-CURR-FIELD = 3 DTSBX431 00774 MOVE W-INPUT-LINE (1:02) TO X431-CASE-TYPE DTSBX431 00775 DTSBX431 00776 WHEN W-CURR-FIELD = 4 DTSBX431 00777 MOVE +0 TO W-CASE-NO DTSBX431 00778 MOVE +9 TO W-FIELD-LENGTH DTSBX431 00779 PERFORM S2200-CONV-AMT THRU S2200-EXIT DTSBX431 00780 MOVE W-CASE-NO TO X431-CASE-NO DTSBX431 00781 DTSBX431 00782 WHEN W-CURR-FIELD = 5 DTSBX431 00783 MOVE W-INPUT-LINE (1:07) TO X431-OPID DTSBX431 00784 DTSBX431 00785 WHEN W-CURR-FIELD = 6 DTSBX431 00786 MOVE +10 TO W-FIELD-LENGTH DTSBX431 00787 PERFORM S2300-CONV-DATE THRU S2300-EXIT DTSBX431 00788 MOVE W-INPUT-LINE (1:10) TO X431-ESTB-DATE DTSBX431 00789 DTSBX431 00790 WHEN W-CURR-FIELD = 7 DTSBX431 00791 MOVE W-INPUT-LINE (1:50) TO X431-ACTION DTSBX431 00792 DTSBX431 00793 WHEN W-CURR-FIELD = 8 DTSBX431 00794 ** DISPLAY 'FIELD 8 ' W-INPUT-LINE (1:10) DTSBX431 00795 MOVE +0 TO W-CASE-NO DTSBX431 00796 MOVE +4 TO W-FIELD-LENGTH DTSBX431 00797 PERFORM S2200-CONV-AMT THRU S2200-EXIT DTSBX431 00798 MOVE W-CASE-NO TO W-CASE-NO-9 DTSBX431 00799 MOVE W-CASE-NO-X (1:4) TO W-LEN-X DTSBX431 00800 MOVE W-LEN-9 TO W-LAST-FIELD-LEN DTSBX431 00801 ** DISPLAY 'FIELD 8 - 2 ' W-LEN-X DTSBX431 00802 ** DISPLAY 'S21 LEN ' W-LAST-FIELD-LEN DTSBX431 00803 DTSBX431 00804 WHEN W-CURR-FIELD = 9 DTSBX431 00805 MOVE W-INPUT-LINE (1:W-LAST-FIELD-LEN) TO X431-RESULT DTSBX431 00806 DTSBX431 00807 END-EVALUATE. DTSBX431 00808 DTSBX431 00809 DTSBX431 00810 S2100-EXIT. DTSBX431 00811 EXIT. DTSBX431 00812 DTSBX431 00813 S2200-CONV-AMT. DTSBX431 00814 MOVE W-INPUT-LINE (1:ISUB2) TO W-CONV-LINE. DTSBX431 00815 MOVE ZEROS TO W-INPUT-LINE. DTSBX431 00816 MOVE W-FIELD-LENGTH TO ISUB4. DTSBX431 00817 DTSBX431 00818 ** DISPLAY 'S2200 W-CONV-LINE ' W-CONV-LINE. DTSBX431 00819 PERFORM DTSBX431 00820 VARYING ISUB3 FROM ISUB2 BY -1 DTSBX431 00821 UNTIL ISUB3 < +1 DTSBX431 00822 IF ((W-CONV-LINE (ISUB3:1) >= '0' AND <= '9') DTSBX431 00823 OR W-CONV-LINE (ISUB3:1) = '.') DTSBX431 00824 MOVE W-CONV-LINE (ISUB3:1) DTSBX431 00825 TO W-INPUT-LINE (ISUB4:1) DTSBX431 00826 SUBTRACT +1 FROM ISUB4 DTSBX431 00827 END-IF DTSBX431 00828 END-PERFORM. DTSBX431 00829 DTSBX431 00830 MOVE W-INPUT-LINE (1:09) TO W-CASE-NO-X DTSBX431 00831 PERFORM S2210-INTEGER THRU S2210-EXIT. DTSBX431 00832 PERFORM S2220-FRACTION THRU S2220-EXIT. DTSBX431 00833 DTSBX431 00834 S2200-EXIT. DTSBX431 00835 EXIT. DTSBX431 00836 DTSBX431 00837 S2210-INTEGER. DTSBX431 00838 SET W-DECIMAL-FOUND-NO-88 TO TRUE. DTSBX431 00839 MOVE +1 TO W-MULTIPLIER. DTSBX431 00840 DTSBX431 00841 PERFORM DTSBX431 00842 VARYING SUB FROM +9 BY -1 DTSBX431 00843 UNTIL SUB < +1 DTSBX431 00844 IF W-CASE-NO-X (SUB:1) = '.' DTSBX431 00845 SET W-DECIMAL-FOUND-YES-88 TO TRUE DTSBX431 00846 ELSE DTSBX431 00847 IF W-DECIMAL-FOUND-YES-88 DTSBX431 00848 MOVE W-CASE-NO-X (SUB:1) TO W-DIGIT DTSBX431 00849 COMPUTE W-AMT = (W-DIGIT * W-MULTIPLIER) DTSBX431 00850 COMPUTE W-CASE-NO = (W-CASE-NO + W-AMT) DTSBX431 00851 COMPUTE W-MULTIPLIER = (W-MULTIPLIER * 10) DTSBX431 00852 END-IF DTSBX431 00853 END-IF DTSBX431 00854 END-PERFORM. DTSBX431 00855 DTSBX431 00856 IF W-DECIMAL-FOUND-NO-88 DTSBX431 00857 PERFORM DTSBX431 00858 VARYING SUB FROM +9 BY -1 DTSBX431 00859 UNTIL SUB < +1 DTSBX431 00860 MOVE W-CASE-NO-X (SUB:1) TO W-DIGIT DTSBX431 00861 COMPUTE W-AMT = (W-DIGIT * W-MULTIPLIER) DTSBX431 00862 COMPUTE W-CASE-NO = (W-CASE-NO + W-AMT) DTSBX431 00863 COMPUTE W-MULTIPLIER = (W-MULTIPLIER * 10) DTSBX431 00864 MOVE W-CASE-NO TO AMT-DISP1 DTSBX431 00865 END-PERFORM DTSBX431 00866 END-IF. DTSBX431 00867 DTSBX431 00868 S2210-EXIT. DTSBX431 00869 EXIT. DTSBX431 00870 DTSBX431 00871 S2220-FRACTION. DTSBX431 00872 SET W-DECIMAL-FOUND-NO-88 TO TRUE. DTSBX431 00873 MOVE +0.1 TO W-MULTIPLIER. DTSBX431 00874 DTSBX431 00875 PERFORM DTSBX431 00876 VARYING SUB FROM +1 BY +1 DTSBX431 00877 UNTIL SUB > +9 DTSBX431 00878 IF W-CASE-NO-X (SUB:1) = '.' DTSBX431 00879 SET W-DECIMAL-FOUND-YES-88 TO TRUE DTSBX431 00880 ELSE DTSBX431 00881 IF W-DECIMAL-FOUND-YES-88 DTSBX431 00882 MOVE W-CASE-NO-X (SUB:1) TO W-DIGIT DTSBX431 00883 COMPUTE W-AMT = (W-DIGIT * W-MULTIPLIER) DTSBX431 00884 COMPUTE W-CASE-NO = (W-CASE-NO + W-AMT) DTSBX431 00885 COMPUTE W-MULTIPLIER = (W-MULTIPLIER / 10) DTSBX431 00886 END-IF DTSBX431 00887 END-IF DTSBX431 00888 END-PERFORM. DTSBX431 00889 DTSBX431 00890 S2220-EXIT. DTSBX431 00891 EXIT. DTSBX431 00892 DTSBX431 00893 S2300-CONV-DATE. DTSBX431 00894 IF W-INPUT-LINE = SPACES DTSBX431 00895 GO TO S2300-EXIT DTSBX431 00896 END-IF. DTSBX431 00897 DTSBX431 00898 MOVE W-INPUT-LINE (1:ISUB2) TO W-CONV-LINE. DTSBX431 00899 MOVE ZEROS TO L001-SLASH-8-MO DTSBX431 00900 L001-SLASH-8-DA DTSBX431 00901 L001-SLASH-8-YR. DTSBX431 00902 DTSBX431 00903 MOVE ZEROS TO W-MDY. DTSBX431 00904 DTSBX431 00905 **************************************************** DTSBX431 00906 * GET LOCATION OF SLASHES IN DATE DTSBX431 00907 **************************************************** DTSBX431 00908 MOVE +0 TO W-SLASH1 DTSBX431 00909 W-SLASH2. DTSBX431 00910 DTSBX431 00911 PERFORM DTSBX431 00912 VARYING ISUB3 FROM +1 BY +1 DTSBX431 00913 UNTIL ISUB3 > ISUB2 DTSBX431 00914 OR W-SLASH2 > ZERO DTSBX431 00915 IF W-CONV-LINE (ISUB3:1) = '/' DTSBX431 00916 IF W-SLASH1 = ZERO DTSBX431 00917 MOVE ISUB3 TO W-SLASH1 DTSBX431 00918 ELSE DTSBX431 00919 MOVE ISUB3 TO W-SLASH2 DTSBX431 00920 END-IF DTSBX431 00921 END-IF DTSBX431 00922 END-PERFORM. DTSBX431 00923 DTSBX431 00924 **************************************************** DTSBX431 00925 * GET MONTH DTSBX431 00926 **************************************************** DTSBX431 00927 IF W-SLASH1 = 3 DTSBX431 00928 MOVE W-CONV-LINE (1:2) TO W-MDY-X-2 DTSBX431 00929 ELSE DTSBX431 00930 IF W-SLASH1 = 2 DTSBX431 00931 MOVE W-CONV-LINE (1:1) TO W-MDY-X-1 DTSBX431 00932 END-IF DTSBX431 00933 END-IF. DTSBX431 00934 DTSBX431 00935 IF (W-MDY-X-2 (1:1) >= '0' AND <= '9') DTSBX431 00936 AND (W-MDY-X-2 (2:1) >= '0' AND <= '9') DTSBX431 00937 MOVE W-MDY-X-2 TO L001-SLASH-8-MO DTSBX431 00938 ELSE DTSBX431 00939 MOVE ZEROS TO L001-SLASH-8-MO DTSBX431 00940 END-IF. DTSBX431 00941 DTSBX431 00942 **************************************************** DTSBX431 00943 * GET DAY DTSBX431 00944 **************************************************** DTSBX431 00945 MOVE ZEROS TO W-MDY. DTSBX431 00946 IF W-SLASH1 = 3 DTSBX431 00947 IF W-SLASH2 = 6 DTSBX431 00948 MOVE W-CONV-LINE (4:2) TO W-MDY-X-2 DTSBX431 00949 ELSE DTSBX431 00950 IF W-SLASH2 = 5 DTSBX431 00951 MOVE W-CONV-LINE (4:1) TO W-MDY-X-1 DTSBX431 00952 END-IF DTSBX431 00953 END-IF DTSBX431 00954 ELSE DTSBX431 00955 IF W-SLASH1 = 2 DTSBX431 00956 IF W-SLASH2 = 5 DTSBX431 00957 MOVE W-CONV-LINE (3:2) TO W-MDY-X-2 DTSBX431 00958 ELSE DTSBX431 00959 IF W-SLASH2 = 4 DTSBX431 00960 MOVE W-CONV-LINE (3:1) TO W-MDY-X-1 DTSBX431 00961 END-IF DTSBX431 00962 END-IF DTSBX431 00963 END-IF DTSBX431 00964 END-IF. DTSBX431 00965 DTSBX431 00966 IF (W-MDY-X-2 (1:1) >= '0' AND <= '9') DTSBX431 00967 AND (W-MDY-X-2 (2:1) >= '0' AND <= '9') DTSBX431 00968 MOVE W-MDY-X-2 TO L001-SLASH-8-DA DTSBX431 00969 ELSE DTSBX431 00970 MOVE ZEROS TO L001-SLASH-8-DA DTSBX431 00971 END-IF. DTSBX431 00972 DTSBX431 00973 **************************************************** DTSBX431 00974 * GET YEAR DTSBX431 00975 **************************************************** DTSBX431 00976 MOVE ZEROS TO W-MDY. DTSBX431 00977 MOVE +1 TO ISUB4. DTSBX431 00978 COMPUTE ISUB5 = (W-SLASH2 + 1). DTSBX431 00979 COMPUTE ISUB6 = (ISUB5 + 4). DTSBX431 00980 PERFORM DTSBX431 00981 VARYING ISUB3 FROM ISUB5 BY +1 DTSBX431 00982 UNTIL ISUB3 > ISUB6 DTSBX431 00983 IF (W-CONV-LINE (ISUB3:1) >= '0' AND <= '9') DTSBX431 00984 MOVE W-CONV-LINE (ISUB3:1) TO W-MDY (ISUB4:1) DTSBX431 00985 ADD +1 TO ISUB4 DTSBX431 00986 END-IF DTSBX431 00987 END-PERFORM. DTSBX431 00988 DTSBX431 00989 MOVE W-MDY TO L001-SLASH-8-YR. DTSBX431 00990 DTSBX431 00991 MOVE L001-SLASH-8-DATE TO W-INPUT-LINE (1:10). DTSBX431 00992 DTSBX431 00993 S2300-EXIT. DTSBX431 00994 EXIT. DTSBX431 00995 DTSBX431 00996 S999-ABEND. DTSBX431 00997 DISPLAY '*** DTSBX431 ABENDING. ' DTSBX431 00998 ABEND-MSG WEB-DLQ-STATUS. DTSBX431 00999 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX431 01000 S999-EXIT. DTSBX431 01001 EXIT. DTSBX431