1003 lines
79 KiB
COBOL
1003 lines
79 KiB
COBOL
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
|