00001 IDENTIFICATION DIVISION. 09/14/05 00002 PROGRAM-ID. DTSBD120. DTSBD120 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV011 00004 DATE-WRITTEN. JULY 1994. DTSBD120 00005 DATE-COMPILED. DTSBD120 00006 SKIP3 DTSBD120 00007 ***** DTSBD120 00008 * DTSBD120 00009 * FUNCTION: TICKLER RECORDS SCAN. DTSBD120 00010 * DTSBD120 00011 * DTSBD120 00012 * MODIFICATION LOG: DTSBD120 00013 * DTSBD120 00014 * 07/15/94 INITIAL DEVELOPMENT. DTSBD120 00015 * WORK ORDER: PROGRAMMER: RHC DTSBD120 00016 * DTSBD120 00017 * 10/01/1998 REVIEWED AND MODIFIED FOR DC. DTSBD120 00018 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBD120 00019 * DTSBD120 00020 * 05/10/2004 MODIFIED TO HANDLE TICKLERS FOR COMPROMISE DTSBD120 00021 * SETTLEMENTS DTSBD120 00022 * REFERENCE: COMPROMISE PROGRAMMER: GD DTSBD120 00023 * DTSBD120 00024 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD120 00025 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD120 00026 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBD120 00027 * DTSBD120 00028 * DTSBD120 00029 * DESCRIPTION: DTSBD120 00030 * DTSBD120 00031 * BROWSE THE ALTERNATE INDEX FILE ITDS RECORDS. FOR SELECTED DTSBD120 00032 * ITDS RECORDS, WRITE T001, T011, T031, OR R724 RECORDS. R907 DTSBD120 00033 * RECORDS INDICATING PROBLEMS ENCOUNTERED DURING PROCESSING DTSBD120 00034 * ARE WRITTEN. DTSBD120 00035 * DTSBD120 00036 * DTSBD120 00037 * INITIATION: DTSBD120 00038 * DTSBD120 00039 * OPEN MASTER FILE (L910-OPEN-READ-88). DTSBD120 00040 * OPEN ALTERNATE INDEX FILE (L921-OPEN-READ-88). DTSBD120 00041 * DTSBD120 00042 * READ THE MHDR RECORD. DTSBD120 00043 * IF L910-NO-REC-88 DTSBD120 00044 * ABEND THE MODULE. DTSBD120 00045 * DTSBD120 00046 * IF PARM-LENGTH = +2 DTSBD120 00047 * IF PARM-DAYS-OVERDUE NUMERIC DTSBD120 00048 * DETERMINE WRK-CUTOFF-DATE TO BE EQUAL TO DTSBD120 00049 * MHDR-CURR-RUN-DATE MINUS PARM-DAYS-OVERDUE DTSBD120 00050 * MOVE PARM-DAYS-OVERDUE TO R724-DAYS-OVERDUE DTSBD120 00051 * ELSE DTSBD120 00052 * ABEND THE MODULE DTSBD120 00053 * ELSE DTSBD120 00054 * ABEND THE MODULE. DTSBD120 00055 * DTSBD120 00056 * DTSBD120 00057 * INITIALIZE T***-SYS-DATE AND T***-SYS-TIME. DTSBD120 00058 * DTSBD120 00059 * MOVE +0 TO WRK-ITDS-CNT. DTSBD120 00060 * DTSBD120 00061 * DTSBD120 00062 * PROCESSING: DTSBD120 00063 * DTSBD120 00064 * BROWSE ALL ITDS RECORDS. FOR EACH ITDS RECORD ENCOUNTERED:DTSBD120 00065 * DTSBD120 00066 * ADD +1 TO WRK-ITDS-CNT. DTSBD120 00067 * IF ITDS-ACKNOWLEDGED-DATE > 0 DTSBD120 00068 * NEXT SENTENCE DTSBD120 00069 * ELSE DTSBD120 00070 * IF ITDS-TRIGGER-DATE > MHDR-CURR-RUN-DATE DTSBD120 00071 * NEXT SENTENCE DTSBD120 00072 * ELSE DTSBD120 00073 * IF ITDS-DEST-SYSTEM-88 DTSBD120 00074 * PERFORM PROCESS-DEST-SYSTEM DTSBD120 00075 * ELSE DTSBD120 00076 * PERFORM PROCESS-DEST-NOT-SYSTEM. DTSBD120 00077 * DTSBD120 00078 * PROCESSING-EXIT. DTSBD120 00079 * DTSBD120 00080 * DTSBD120 00081 * PROCESS-DEST-SYSTEM. DTSBD120 00082 * DTSBD120 00083 * READ THE MPRF RECORD. DTSBD120 00084 * IF L910-NO-REC-88 DTSBD120 00085 * WRITE A R907-RECORD DTSBD120 00086 * GO TO EXIT. DTSBD120 00087 * DTSBD120 00088 * READ THE MTCK RECORD. DTSBD120 00089 * IF L910-NO-REC-88 DTSBD120 00090 * WRITE A R907-RECORD DTSBD120 00091 * GO TO EXIT. DTSBD120 00092 * DTSBD120 00093 * IF MTCK-TYPE-CYCLE-A-88 DTSBD120 00094 * WRITE A T001-RECORD (WITH T001-ERA-CYCLE) DTSBD120 00095 * ELSE DTSBD120 00096 * IF MTCK-TYPE-CYCLE-B-88 DTSBD120 00097 * WRITE A T001 RECORD (WITH T001-ERB-CYCLE) DTSBD120 00098 * ELSE DTSBD120 00099 * IF MTCK-TYPE-LIEN-88 DTSBD120 00100 * WRITE A T011 RECORD (WITH T011-LIN-TCK-L01 DTSBD120 00101 * AND T011-ESTB-ABSTIME = MTCK-L01-ESTB-ABSTIME) DTSBD120 00102 * ELSE DTSBD120 00103 * IF MTCK-TYPE-PRF-CLM-88 DTSBD120 00104 * WRITE A T011 RECORD (WITH T011-BNK-TCK-POC DTSBD120 00105 * AND T011-ESTB-ABSTIME = MTCK-L01-ESTB-ABSTIME) DTSBD120 00106 * ELSE DTSBD120 00107 * IF MTCK-TYPE-CHK-LATE-88 DTSBD120 00108 * WRITE A T031 RECORD (WITH T031-AUTO-PROCESS, DTSBD120 00109 * T031-START-YRQ = MTCK-LTE-YRQ, AND DTSBD120 00110 * T031-END-YRQ = MTCK-LTE-YRQ) DTSBD120 00111 * ELSE DTSBD120 00112 * WRITE A R907-RECORD. DTSBD120 00113 * DTSBD120 00114 * PROCESS-DEST-SYSTEM-EXIT. DTSBD120 00115 * DTSBD120 00116 * DTSBD120 00117 * PROCESS-DEST-NOT-SYSTEM. DTSBD120 00118 * DTSBD120 00119 * IF ITDS-TRIGGER-DATE > WRK-CUTOFF-DATE DTSBD120 00120 * GO TO EXIT. DTSBD120 00121 * DTSBD120 00122 * READ THE MPRF RECORD. DTSBD120 00123 * IF L910-NO-REC-88 DTSBD120 00124 * WRITE A R907 RECORD DTSBD120 00125 * GO TO EXIT. DTSBD120 00126 * DTSBD120 00127 * WRITE A R724 RECORD. DTSBD120 00128 * DTSBD120 00129 * PROCESS-DEST-NOT-SYSTEM-EXIT. DTSBD120 00130 * DTSBD120 00131 * DTSBD120 00132 * TERMINATION: DTSBD120 00133 * DTSBD120 00134 * DISPLAY TERMINATION STATISTICS (MHDR-CURR-RUN-DATE, DTSBD120 00135 * WRK-CUTOFF-DATE, WRK-ITDS-CNT). DTSBD120 00136 * DTSBD120 00137 * CLOSE THE MASTER FILE, ALTERNATE INDEX FILE, REPORT RECORD DTSBD120 00138 * FILE, AND TRANSACTION RECORD FILE. DTSBD120 00139 * DTSBD120 00140 ***** DTSBD120 00141 SKIP3 DTSBD120 00142 ENVIRONMENT DIVISION. DTSBD120 00143 SKIP3 DTSBD120 00144 DATA DIVISION. DTSBD120 00145 SKIP3 DTSBD120 00146 FILE SECTION. DTSBD120 00147 SKIP3 DTSBD120 00148 WORKING-STORAGE SECTION. DTSBD120 001485 77 PAN-VALET PICTURE X(24) VALUE '011DTSBD120 09/14/05'. DTSBD120 00149 SKIP3 DTSBD120 00150 01 WRK-AREA. DTSBD120 00151 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +120. DTSBD120 00152 DTSBD120 00153 05 WRK-MODULE-ID PIC X(08) VALUE 'DTSBD120'.DTSBD120 00154 DTSBD120 00155 05 WRK-CUTOFF-DATE PIC S9(09) COMP-3. DTSBD120 00156 DTSBD120 00157 05 WRK-ITDS-CNT PIC S9(07) COMP-3. DTSBD120 00158 EJECT DTSBD120 00159 01 MSG-TABLE. DTSBD120 00160 05 MSG1-NO-MPRF. DTSBD120 00161 10 MSG1-ID. DTSBD120 00162 15 MSG1-ID-A PIC X(08) VALUE 'DTSBD120'. DTSBD120 00163 15 MSG1-ID-B PIC X(03) VALUE '911'. DTSBD120 00164 10 MSG1-SHORT-TEXT PIC X(20) VALUE 'ITDS WITH NO MPRF'.DTSBD120 00165 10 MSG1-LONG-TEXT. DTSBD120 00166 15 FILLER PIC X(30) DTSBD120 00167 VALUE 'ITDS RECORD ENCOUNTERED WITH N'. DTSBD120 00168 15 FILLER PIC X(30) DTSBD120 00169 VALUE 'O CORRESPONDING MPRF RECORD '. DTSBD120 00170 DTSBD120 00171 05 MSG2-NO-MPRF. DTSBD120 00172 10 MSG2-ID. DTSBD120 00173 15 MSG2-ID-A PIC X(08) VALUE 'DTSBD120'. DTSBD120 00174 15 MSG2-ID-B PIC X(03) VALUE '912'. DTSBD120 00175 10 MSG2-SHORT-TEXT PIC X(20) VALUE 'ITDS WITH NO MTCK'.DTSBD120 00176 10 MSG2-LONG-TEXT. DTSBD120 00177 15 FILLER PIC X(30) DTSBD120 00178 VALUE 'ITDS RECORD ENCOUNTERED WITH N'. DTSBD120 00179 15 FILLER PIC X(30) DTSBD120 00180 VALUE 'O CORRESPONDING MTCK RECORD '. DTSBD120 00181 DTSBD120 00182 05 MSG3-NO-MPRF. DTSBD120 00183 10 MSG3-ID. DTSBD120 00184 15 MSG3-ID-A PIC X(08) VALUE 'DTSBD120'. DTSBD120 00185 15 MSG3-ID-B PIC X(03) VALUE '913'. DTSBD120 00186 10 MSG3-SHORT-TEXT PIC X(20) VALUE 'UNKNOWN ITDS-TYPE'.DTSBD120 00187 10 MSG3-LONG-TEXT. DTSBD120 00188 15 FILLER PIC X(30) DTSBD120 00189 VALUE 'ITDS-DEST-SYSTEM RECORD ENCOUN'. DTSBD120 00190 15 FILLER PIC X(30) DTSBD120 00191 VALUE 'TERED WITH UNKNOWN ITDS-TYPE '. DTSBD120 00192 EJECT DTSBD120 00193 01 L001-LINK-AREA. DTSBD120 00194 ++INCLUDE DTSIL001 DTSBD120 00195 EJECT DTSBD120 00196 01 L005-LINK-AREA. DTSBD120 00197 ++INCLUDE DTSIL005 DTSBD120 00198 EJECT DTSBD120 00199 01 L910-LINK-AREA. DTSBD120 00200 ++INCLUDE DTSIL910 DTSBD120 00201 SKIP3 DTSBD120 00202 01 MSKL-REC. DTSBD120 00203 ++INCLUDE DTSIMSKL DTSBD120 00204 SKIP3 DTSBD120 00205 01 MHDR-REC. DTSBD120 00206 ++INCLUDE DTSIMHDR DTSBD120 00207 SKIP3 DTSBD120 00208 01 MPRF-REC. DTSBD120 00209 ++INCLUDE DTSIMPRF DTSBD120 00210 SKIP3 DTSBD120 00211 01 MTCK-REC. DTSBD120 00212 ++INCLUDE DTSIMTCK DTSBD120 00213 EJECT DTSBD120 00214 01 L921-LINK-AREA. DTSBD120 00215 ++INCLUDE DTSIL921 DTSBD120 00216 SKIP3 DTSBD120 00217 01 ISKL-REC. DTSBD120 00218 ++INCLUDE DTSIISKL DTSBD120 00219 SKIP3 DTSBD120 00220 01 ITDS-REC REDEFINES ISKL-REC. DTSBD120 00221 ++INCLUDE DTSIITDS DTSBD120 00222 EJECT DTSBD120 00223 01 RSK1-REC. DTSBD120 00224 ++INCLUDE DTSIRSK1 DTSBD120 00225 SKIP3 DTSBD120 00226 01 R907-REC. DTSBD120 00227 ++INCLUDE DTSIR907 DTSBD120 00228 SKIP3 DTSBD120 00229 01 R724-REC. DTSBD120 00230 ++INCLUDE DTSIR724 DTSBD120 00231 EJECT DTSBD120 00232 01 T001-REC. DTSBD120 00233 ++INCLUDE DTSIT001 DTSBD120 00234 SKIP3 DTSBD120 00235 01 T011-REC. DTSBD120 00236 ++INCLUDE DTSIT011 DTSBD120 00237 SKIP3 DTSBD120 00238 01 T031-REC. DTSBD120 00239 ++INCLUDE DTSIT031 DTSBD120 00240 EJECT DTSBD120 00241 LINKAGE SECTION. DTSBD120 00242 DTSBD120 00243 01 PARM-AREA. DTSBD120 00244 05 PARM-LENGTH PIC S9(04) COMP. DTSBD120 00245 05 PARM-DAYS-OVERDUE PIC 9(02). DTSBD120 00246 SKIP3 DTSBD120 00247 PROCEDURE DIVISION USING PARM-AREA. DTSBD120 00248 DTSBD120 00249 PERFORM I1000-INITIATE THRU I1000-EXIT. DTSBD120 00250 DTSBD120 00251 PERFORM P1000-PROCESS THRU P1000-EXIT DTSBD120 00252 UNTIL L921-NO-REC-88. DTSBD120 00253 DTSBD120 00254 PERFORM T1000-TERMINATE THRU T1000-EXIT. DTSBD120 00255 DTSBD120 00256 GOBACK. DTSBD120 00257 EJECT DTSBD120 00258 I1000-INITIATE. DTSBD120 00259 MOVE SPACE TO T001-DATA-AREA DTSBD120 00260 T011-DATA-AREA DTSBD120 00261 T031-DATA-AREA. DTSBD120 00262 DTSBD120 00263 INITIALIZE T001-DATA-AREA DTSBD120 00264 T011-DATA-AREA DTSBD120 00265 T031-DATA-AREA. DTSBD120 00266 DTSBD120 00267 DTSBD120 00268 MOVE '907' TO R907-REC-TYPE. DTSBD120 00269 DTSBD120 00270 MOVE LENGTH OF R907-REC TO R907-LENGTH. DTSBD120 00271 DTSBD120 00272 DTSBD120 00273 MOVE '724' TO R724-REC-TYPE. DTSBD120 00274 DTSBD120 00275 MOVE LENGTH OF R724-REC TO R724-LENGTH. DTSBD120 00276 DTSBD120 00277 DTSBD120 00278 MOVE LENGTH OF T001-REC TO T001-LENGTH. DTSBD120 00279 DTSBD120 00280 DTSBD120 00281 MOVE LENGTH OF T011-REC TO T011-LENGTH. DTSBD120 00282 DTSBD120 00283 DTSBD120 00284 MOVE LENGTH OF T031-REC TO T031-LENGTH. DTSBD120 00285 DTSBD120 00286 DTSBD120 00287 SET L005-FROM-SYS TO TRUE. DTSBD120 00288 DTSBD120 00289 PERFORM S005-LINK-TIME THRU S005-EXIT. DTSBD120 00290 DTSBD120 00291 MOVE L005-DATE TO T001-SYS-DATE DTSBD120 00292 T011-SYS-DATE DTSBD120 00293 T031-SYS-DATE. DTSBD120 00294 DTSBD120 00295 MOVE L005-TIME TO T001-SYS-TIME DTSBD120 00296 T011-SYS-TIME DTSBD120 00297 T031-SYS-TIME. DTSBD120 00298 DTSBD120 00299 MOVE WRK-MODULE-ID TO T001-ORIGIN DTSBD120 00300 T011-ORIGIN DTSBD120 00301 T031-ORIGIN DTSBD120 00302 R907-MODULE-NAME DTSBD120 00303 L910-MOD-NAME DTSBD120 00304 L921-MOD-NAME. DTSBD120 00305 DTSBD120 00306 MOVE SPACE TO L910-TRACE-IND DTSBD120 00307 L921-TRACE-IND. DTSBD120 00308 DTSBD120 00309 DTSBD120 00310 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBD120 00311 DTSBD120 00312 MOVE LOW-VALUE TO MHDR-KEY-AREA. DTSBD120 00313 DTSBD120 00314 MOVE +0 TO MHDR-EMP-NO. DTSBD120 00315 DTSBD120 00316 SET MHDR-HDR-88 TO TRUE. DTSBD120 00317 DTSBD120 00318 MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA. DTSBD120 00319 DTSBD120 00320 PERFORM S910-READ THRU S910-EXIT. DTSBD120 00321 DTSBD120 00322 IF L910-OK-88 DTSBD120 00323 MOVE MSKL-REC TO MHDR-REC DTSBD120 00324 ELSE DTSBD120 00325 PERFORM S999-ABEND THRU S999-EXIT. DTSBD120 00326 DTSBD120 00327 DTSBD120 00328 PERFORM S921-OPEN-READ THRU S921-EXIT. DTSBD120 00329 DTSBD120 00330 MOVE LOW-VALUE TO ITDS-KEY-AREA. DTSBD120 00331 DTSBD120 00332 SET ITDS-TDS-88 TO TRUE. DTSBD120 00333 DTSBD120 00334 PERFORM S921-START-BROWSE THRU S921-EXIT. DTSBD120 00335 DTSBD120 00336 MOVE +0 TO WRK-ITDS-CNT. DTSBD120 00337 DTSBD120 00338 DTSBD120 00339 IF PARM-LENGTH = +2 DTSBD120 00340 AND PARM-DAYS-OVERDUE NUMERIC DTSBD120 00341 PERFORM I1100-PROCESS-PARM THRU I1100-EXIT DTSBD120 00342 ELSE DTSBD120 00343 PERFORM S999-ABEND THRU S999-EXIT. DTSBD120 00344 I1000-EXIT. EXIT. DTSBD120 00345 SKIP3 DTSBD120 00346 I1100-PROCESS-PARM. DTSBD120 00347 MOVE PARM-DAYS-OVERDUE TO R724-DAYS-OVERDUE. DTSBD120 00348 DTSBD120 00349 DTSBD120 00350 SET L001-FROM-FED-8 TO TRUE. DTSBD120 00351 DTSBD120 00352 MOVE MHDR-CURR-RUN-DATE TO L001-FED-8-DATE-9. DTSBD120 00353 DTSBD120 00354 PERFORM S001-CONVERT-DATE THRU S001-EXIT. DTSBD120 00355 DTSBD120 00356 DTSBD120 00357 SET L001-FROM-ABS-DAY TO TRUE. DTSBD120 00358 DTSBD120 00359 SUBTRACT PARM-DAYS-OVERDUE FROM L001-JUL-ABS-DAY. DTSBD120 00360 DTSBD120 00361 PERFORM S001-CONVERT-DATE THRU S001-EXIT. DTSBD120 00362 DTSBD120 00363 MOVE L001-FED-8-DATE-9 TO WRK-CUTOFF-DATE. DTSBD120 00364 DTSBD120 00365 I1100-EXIT. EXIT. DTSBD120 00366 EJECT DTSBD120 00367 P1000-PROCESS. DTSBD120 00368 ADD +1 TO WRK-ITDS-CNT. DTSBD120 00369 DTSBD120 00370 IF ITDS-ACKNOWLEDGED-DATE > 0 DTSBD120 00371 NEXT SENTENCE DTSBD120 00372 ELSE DTSBD120 00373 IF ITDS-TRIGGER-DATE > MHDR-CURR-RUN-DATE DTSBD120 00374 NEXT SENTENCE DTSBD120 00375 ELSE DTSBD120 00376 IF ITDS-DEST-SYSTEM-88 DTSBD120 00377 PERFORM P1100-DEST-SYSTEM THRU P1100-EXIT DTSBD120 00378 ELSE DTSBD120 00379 IF ITDS-TRIGGER-DATE > WRK-CUTOFF-DATE DTSBD120 00380 NEXT SENTENCE DTSBD120 00381 ELSE DTSBD120 00382 PERFORM P1200-DEST-NOT-SYSTEM THRU P1200-EXIT. DTSBD120 00383 DTSBD120 00384 PERFORM S921-READ-NEXT THRU S921-EXIT. DTSBD120 00385 P1000-EXIT. EXIT. DTSBD120 00386 EJECT DTSBD120 00387 P1100-DEST-SYSTEM. DTSBD120 00388 *& DTSBD120 00389 IF ITDS-EMP-NO = 042459 DTSBD120 00390 DISPLAY 'BD120 ITDS EMP ' ITDS-EMP-NO DTSBD120 00391 ' TYPE ' ITDS-TYPE DTSBD120 00392 ' ESTB ' ITDS-ESTB-ABSTIME DTSBD120 00393 END-IF. DTSBD120 00394 *& DTSBD120 00395 MOVE LOW-VALUE TO MPRF-KEY-AREA. DTSBD120 00396 DTSBD120 00397 MOVE ITDS-EMP-NO TO MPRF-EMP-NO. DTSBD120 00398 DTSBD120 00399 SET MPRF-PRF-88 TO TRUE. DTSBD120 00400 DTSBD120 00401 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSBD120 00402 DTSBD120 00403 PERFORM S910-READ THRU S910-EXIT. DTSBD120 00404 DTSBD120 00405 IF L910-OK-88 DTSBD120 00406 MOVE MSKL-REC TO MPRF-REC DTSBD120 00407 ELSE DTSBD120 00408 MOVE MSG1-ID-B TO R907-MSG-ID DTSBD120 00409 MOVE MSG1-LONG-TEXT TO R907-MSG-TEXT DTSBD120 00410 PERFORM S947-ERROR-O THRU S947-EXIT DTSBD120 00411 GO TO P1100-EXIT. DTSBD120 00412 DTSBD120 00413 DTSBD120 00414 MOVE LOW-VALUE TO MTCK-KEY-AREA. DTSBD120 00415 DTSBD120 00416 MOVE ITDS-EMP-NO TO MTCK-EMP-NO. DTSBD120 00417 DTSBD120 00418 SET MTCK-TCK-88 TO TRUE. DTSBD120 00419 DTSBD120 00420 MOVE ITDS-ESTB-ABSTIME TO MTCK-ESTB-ABSTIME. DTSBD120 00421 DTSBD120 00422 MOVE MTCK-KEY-AREA TO MSKL-KEY-AREA. DTSBD120 00423 DTSBD120 00424 PERFORM S910-READ THRU S910-EXIT. DTSBD120 00425 DTSBD120 00426 IF L910-OK-88 DTSBD120 00427 MOVE MSKL-REC TO MTCK-REC DTSBD120 00428 ELSE DTSBD120 00429 MOVE MSG2-ID-B TO R907-MSG-ID DTSBD120 00430 MOVE MSG2-LONG-TEXT TO R907-MSG-TEXT DTSBD120 00431 PERFORM S947-ERROR-O THRU S947-EXIT DTSBD120 00432 GO TO P1100-EXIT. DTSBD120 00433 DTSBD120 00434 *& DTSBD120 00435 IF MTCK-EMP-NO = 042459 DTSBD120 00436 DISPLAY 'BD120 MTCK EMP ' MTCK-EMP-NO DTSBD120 00437 ' TYPE ' MTCK-TYPE DTSBD120 00438 END-IF. DTSBD120 00439 *& DTSBD120 00440 DTSBD120 00441 IF MTCK-TYPE-CYCLE-A-88 DTSBD120 00442 SET T001-ERA-CYCLE TO TRUE DTSBD120 00443 PERFORM P1110-T001-REC THRU P1110-EXIT DTSBD120 00444 ELSE DTSBD120 00445 IF MTCK-TYPE-LIEN-88 DTSBD120 00446 SET T011-LIN-TCK TO TRUE DTSBD120 00447 MOVE MTCK-L01-ESTB-ABSTIME TO T011-ESTB-ABSTIME DTSBD120 00448 PERFORM P1120-T011-REC THRU P1120-EXIT DTSBD120 00449 ELSE DTSBD120 00450 IF MTCK-TYPE-DPC-PEND-88 DTSBD120 00451 SET T011-DPC-TCK TO TRUE DTSBD120 00452 MOVE MTCK-DPC-ESTB-ABSTIME TO T011-ESTB-ABSTIME DTSBD120 00453 PERFORM P1120-T011-REC THRU P1120-EXIT DTSBD120 00454 ELSE DTSBD120 00455 IF MTCK-TYPE-CMP-PEND-88 DTSBD120 00456 SET T011-CMP-TCK TO TRUE DTSBD120 00457 MOVE MTCK-CMP-ESTB-ABSTIME TO T011-ESTB-ABSTIME DTSBD120 00458 PERFORM P1120-T011-REC THRU P1120-EXIT DTSBD120 00459 ELSE DTSBD120 00460 IF MTCK-TYPE-CHK-LATE-88 DTSBD120 00461 SET T031-AUTO-PROCESS TO TRUE DTSBD120 00462 PERFORM P1130-T031-REC THRU P1130-EXIT DTSBD120 00463 ELSE DTSBD120 00464 MOVE MSG3-ID-B TO R907-MSG-ID DTSBD120 00465 MOVE MSG3-LONG-TEXT TO R907-MSG-TEXT DTSBD120 00466 PERFORM S947-ERROR-O THRU S947-EXIT. DTSBD120 00467 P1100-EXIT. EXIT. DTSBD120 00468 SKIP3 DTSBD120 00469 P1110-T001-REC. DTSBD120 00470 MOVE ITDS-EMP-NO TO T001-EMP-NO. DTSBD120 00471 DTSBD120 00472 MOVE T001-REC TO RSK1-REC. DTSBD120 00473 DTSBD120 00474 PERFORM S946-TRN-REC-O THRU S946-EXIT. DTSBD120 00475 P1110-EXIT. EXIT. DTSBD120 00476 SKIP3 DTSBD120 00477 P1120-T011-REC. DTSBD120 00478 MOVE ITDS-EMP-NO TO T011-EMP-NO. DTSBD120 00479 DTSBD120 00480 MOVE T011-REC TO RSK1-REC. DTSBD120 00481 DTSBD120 00482 PERFORM S946-TRN-REC-O THRU S946-EXIT. DTSBD120 00483 P1120-EXIT. EXIT. DTSBD120 00484 SKIP3 DTSBD120 00485 P1130-T031-REC. DTSBD120 00486 MOVE ITDS-EMP-NO TO T031-EMP-NO. DTSBD120 00487 DTSBD120 00488 MOVE MTCK-LTE-YRQ TO T031-START-YRQ. DTSBD120 00489 DTSBD120 00490 MOVE MTCK-LTE-YRQ TO T031-END-YRQ. DTSBD120 00491 DTSBD120 00492 SET T031-TRANSFER-NO-88 TO TRUE. DTSBD120 00493 DTSBD120 00494 MOVE +0 TO T031-TRANSFER-TO-EMP-NO. DTSBD120 00495 DTSBD120 00496 MOVE T031-REC TO RSK1-REC. DTSBD120 00497 DTSBD120 00498 PERFORM S946-TRN-REC-O THRU S946-EXIT. DTSBD120 00499 P1130-EXIT. EXIT. DTSBD120 00500 EJECT DTSBD120 00501 P1200-DEST-NOT-SYSTEM. DTSBD120 00502 MOVE LOW-VALUE TO MPRF-KEY-AREA. DTSBD120 00503 DTSBD120 00504 MOVE ITDS-EMP-NO TO MPRF-EMP-NO. DTSBD120 00505 DTSBD120 00506 SET MPRF-PRF-88 TO TRUE. DTSBD120 00507 DTSBD120 00508 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSBD120 00509 DTSBD120 00510 PERFORM S910-READ THRU S910-EXIT. DTSBD120 00511 DTSBD120 00512 IF L910-OK-88 DTSBD120 00513 MOVE MSKL-REC TO MPRF-REC DTSBD120 00514 ELSE DTSBD120 00515 MOVE MSG1-ID-B TO R907-MSG-ID DTSBD120 00516 MOVE MSG1-LONG-TEXT TO R907-MSG-TEXT DTSBD120 00517 PERFORM S947-ERROR-O THRU S947-EXIT DTSBD120 00518 GO TO P1200-EXIT. DTSBD120 00519 DTSBD120 00520 DTSBD120 00521 MOVE ITDS-DEST-OP-ID TO R724-DEST-OP-ID. DTSBD120 00522 DTSBD120 00523 MOVE ITDS-TRIGGER-DATE TO R724-TRIGGER-DATE. DTSBD120 00524 DTSBD120 00525 MOVE ITDS-EMP-NO TO R724-EMP-NO. DTSBD120 00526 DTSBD120 00527 MOVE ITDS-TYPE TO R724-TYPE. DTSBD120 00528 DTSBD120 00529 MOVE MPRF-PRIMARY-NAME TO R724-PRIMARY-NAME. DTSBD120 00530 DTSBD120 00531 MOVE LOW-VALUES TO R724-PADDING-FOR-SYNCSORT. DTSBD120 00532 DTSBD120 00533 MOVE R724-REC TO RSK1-REC. DTSBD120 00534 DTSBD120 00535 PERFORM S947-RPT-REC-O THRU S947-EXIT. DTSBD120 00536 P1200-EXIT. EXIT. DTSBD120 00537 EJECT DTSBD120 00538 T1000-TERMINATE. DTSBD120 00539 DISPLAY ' '. DTSBD120 00540 DTSBD120 00541 DISPLAY '*** ' WRK-MODULE-ID DTSBD120 00542 ' TERMINATION STATISTICS'. DTSBD120 00543 DTSBD120 00544 DISPLAY '*** ' MHDR-CURR-RUN-DATE DTSBD120 00545 ' = MHDR-CURR-RUN-DATE'. DTSBD120 00546 DTSBD120 00547 DISPLAY '*** ' WRK-CUTOFF-DATE DTSBD120 00548 ' = WRK-CUTOFF-DATE'. DTSBD120 00549 DTSBD120 00550 DISPLAY '*** ' WRK-ITDS-CNT DTSBD120 00551 ' = WRK-ITDS-CNT'. DTSBD120 00552 DTSBD120 00553 PERFORM S910-CLOSE THRU S910-EXIT. DTSBD120 00554 DTSBD120 00555 PERFORM S921-CLOSE THRU S921-EXIT. DTSBD120 00556 DTSBD120 00557 MOVE -1 TO RSK1-LENGTH. DTSBD120 00558 DTSBD120 00559 PERFORM S946-TRN-REC-O THRU S946-EXIT. DTSBD120 00560 DTSBD120 00561 PERFORM S947-RPT-REC-O THRU S947-EXIT. DTSBD120 00562 T1000-EXIT. EXIT. DTSBD120 00563 EJECT DTSBD120 00564 S001-CONVERT-DATE. DTSBD120 00565 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBD120 00566 S001-EXIT. EXIT. DTSBD120 00567 SKIP3 DTSBD120 00568 S005-LINK-TIME. DTSBD120 00569 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBD120 00570 S005-EXIT. EXIT. DTSBD120 00571 EJECT DTSBD120 00572 S910-OPEN-READ. DTSBD120 00573 SET L910-OPEN-READ-88 TO TRUE. DTSBD120 00574 GO TO S910-MSTR-IO. DTSBD120 00575 DTSBD120 00576 S910-READ. DTSBD120 00577 SET L910-READ-88 TO TRUE. DTSBD120 00578 GO TO S910-MSTR-IO. DTSBD120 00579 DTSBD120 00580 S910-CLOSE. DTSBD120 00581 SET L910-CLOSE-88 TO TRUE. DTSBD120 00582 GO TO S910-MSTR-IO. DTSBD120 00583 DTSBD120 00584 S910-MSTR-IO. DTSBD120 00585 CALL 'DTSBU910' USING L910-LINK-AREA DTSBD120 00586 MSKL-REC. DTSBD120 00587 S910-EXIT. EXIT. DTSBD120 00588 SKIP3 DTSBD120 00589 S921-OPEN-READ. DTSBD120 00590 SET L921-OPEN-READ-88 TO TRUE. DTSBD120 00591 GO TO S921-AIX-IO. DTSBD120 00592 DTSBD120 00593 S921-START-BROWSE. DTSBD120 00594 SET L921-START-BROWSE-88 TO TRUE. DTSBD120 00595 GO TO S921-AIX-IO. DTSBD120 00596 DTSBD120 00597 S921-READ-NEXT. DTSBD120 00598 SET L921-READ-NEXT-88 TO TRUE. DTSBD120 00599 GO TO S921-AIX-IO. DTSBD120 00600 DTSBD120 00601 S921-CLOSE. DTSBD120 00602 SET L921-CLOSE-88 TO TRUE. DTSBD120 00603 GO TO S921-AIX-IO. DTSBD120 00604 DTSBD120 00605 S921-AIX-IO. DTSBD120 00606 CALL 'DTSBU921' USING L921-LINK-AREA DTSBD120 00607 ISKL-REC. DTSBD120 00608 S921-EXIT. EXIT. DTSBD120 00609 EJECT DTSBD120 00610 S946-TRN-REC-O. DTSBD120 00611 CALL 'DTSBU946' USING RSK1-REC. DTSBD120 00612 S946-EXIT. EXIT. DTSBD120 00613 SKIP3 DTSBD120 00614 S947-ERROR-O. DTSBD120 00615 MOVE ITDS-EMP-NO TO R907-EMP-NO. DTSBD120 00616 MOVE R907-REC TO RSK1-REC. DTSBD120 00617 GO TO S947-RPT-REC-O. DTSBD120 00618 DTSBD120 00619 S947-RPT-REC-O. DTSBD120 00620 CALL 'DTSBU947' USING RSK1-REC. DTSBD120 00621 S947-EXIT. EXIT. DTSBD120 00622 SKIP3 DTSBD120 00623 S999-ABEND. DTSBD120 00624 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBD120 00625 S999-EXIT. EXIT. DTSBD120