00001 IDENTIFICATION DIVISION. 05/07/22 00002 PROGRAM-ID. DTSBD300. DTSBD300 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV032 00004 DATE-WRITTEN. JANUARY 1991. DTSBD300 00005 DATE-COMPILED. DTSBD300 00006 SKIP3 DTSBD300 00007 ***** DTSBD300 00008 * DTSBD300 00009 * FUNCTION: DAILY UPDATE DRIVER. DTSBD300 00010 * DTSBD300 00011 * DTSBD300 00012 * MODIFICATION LOG: DTSBD300 00013 * DTSBD300 00014 * 01/09/92 INITIAL DEVELOPMENT. DTSBD300 00015 * WORK ORDER: PROGRAMMER: TCL DTSBD300 00016 * DTSBD300 00017 * 05/09/95 AHDR-*-ITEM-CNT WERE CHANGED TO AHDR-*-TRAN-CNT. DTSBD300 00018 * THEY NO LONGER INCLUDE THE CHECKS IN THE COUNTS. DTSBD300 00019 * WORK ORDER: CR076 PROGRAMMER: RHC DTSBD300 00020 * DTSBD300 00021 * 05/13/95 PROCESS CREDIT TOLERANCE ON THE EMPLOYER LEVEL. DTSBD300 00022 * WORK ORDER: CR094 PROGRAMMER: RHC DTSBD300 00023 * DTSBD300 00024 * 10/26/95 JOINT REGISTRATION MODIFICATION. ADD T002 RECORD DTSBD300 00025 * PROCESSING. DTSBD300 00026 * WORK ORDER: JR PROGRAMMER: RPA DTSBD300 00027 * DTSBD300 00028 * 12/31/96 ADDED 88 LEVEL TO DTSIAHDR FOR ELECTRONIC FILER DTSBD300 00029 * BATCHES. ONLY USED IN DTSBD140, SO TO SAVE MONEY DTSBD300 00030 * THIS PROGRAM WASN'T RECOMPILED. DTSBD300 00031 * WORK ORDER: PROGRAMMER: MJA DTSBD300 00032 * DTSBD300 00033 * 10/10/1998 REVIEWED AND MODIFIED FOR DC. DTSBD300 00034 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBD300 00035 * DTSBD300 00036 * 05/13/1999 INITIALIZE LBCM-PICKUP-YRQ. DTSBD300 00037 * REFERENCE: PICKUP DIR PROGRAMMER: EHH DTSBD300 00038 * DTSBD300 00039 * 01/31/2002 MODIFIED TO RECOGNIZE AATX TRANSACTIONS. DTSBD300 00040 * REFERENCE: HOUSEHOLD PROGRAMMER: GD DTSBD300 00041 * DTSBD300 00042 * 01/16/2003 MODIFIED P1210-INIT-TRN TO CHECK FOR AATX DTSBD300 00043 * TRANSACTIONS THAT DID NOT PASS FULL EDITS. DTSBD300 00044 * REFERENCE: PROD ABEND PROGRAMMER: GD DTSBD300 00045 * DTSBD300 00046 * 09/23/2003 MODIFIED TO RECOGNIZE T002 TRANSACTIONS. DTSBD300 00047 * REFERENCE: DTSBD380 PROGRAMMER: ZL1 DTSBD300 00048 * DTSBD300 00049 * 09/23/2003 ADDED CODE TO OPEN NAME FILE (CALL TO DTSBU982) DTSBD300 00050 * REFERENCE: WAGE MODIFICATIONS PROGRAMMER: GD DTSBD300 00051 * DTSBD300 00052 * 09/23/2003 ADDED CALL TO DTSBD380 (UPDATES FROM WEB) DTSBD300 00053 * NOTE: CALL DISABLED UNTIL BD380 PROGRAMS ARE DTSBD300 00054 * MIGRATED. DTSBD300 00055 * REFERENCE: EFT PROGRAMMER: GD DTSBD300 00056 * DTSBD300 00057 * 01/18/2005 MODIFIED FOR T003 NOTEPAD TRANSACTION. DTSBD300 00058 * REFERENCE: ICESA PROCESSING PROGRAMMER: GD DTSBD300 00059 * DTSBD300 00060 * 12/19/2005 MODIFIED S1000 - INITIALIZE BANK BATCH DTSBD300 00061 * NUMBER TO ZERO. DTSBD300 00062 * REFERENCE: PROGRAMMER: GD DTSBD300 00063 * DTSBD300 00064 * 04/21/2006 MODIFIED PARM AREA, I3100, P1000 TO ALLOW DTSBD300 00065 * BYPASS OF UP TO 3 EMPLOYERS. DTSBD300 00066 * REFERENCE: PROGRAMMER: GD DTSBD300 00067 * DTSBD300 00068 * 03/14/2011 MODIFIED TO PASS NON-DOES CHECK ACCOUNT DTSBD300 00069 * NUMBER IN LBCM LINKAGE AREA. DTSBD300 00070 * REFERENCE: LOCKBOX PROGRAMMER: GD DTSBD300 00071 * DTSBD300 00072 * 05/02/2012 MODIFIED TO PROCESS T040 WEB AUDIT TRANSACTIONS DTSBD300 00073 * REFERENCE: AUDIT PROGRAMMER: ZL1 DTSBD300 00074 * DTSBD300 00075 * 03/22/2013 MODIFIED TO FIND LAST USED ITEM NUMBER FOR DTSBD300 00076 * PROCESSING ANNUAL REPORTS. THE FIRST QUARTER DTSBD300 00077 * MODIFIED TO FIND LAST USED ITEM NUMBER FOR DTSBD300 00078 * 03/22/2013 MODIFIED TO FIND LAST USED ITEM NUMBER FOR DTSBD300 00079 * REFERENCE: AUDIT PROGRAMMER: ZL1 DTSBD300 00080 * DTSBD300 00081 * 09/22/2015 MODIFIED TO REMOVE ALL TOLERATED AMOUNTS FROM DTSBD300 00082 * DUTAS AS OF 10/01/15. CREDITS,DEBITS AND ADMIN DTSBD300 00083 * REFERENCE: TOLERANCE PROGRAMMER: ZL1 DTSBD300 00084 * DTSBD300 00085 * CL**5 00086 * 02/22/2016 MODIFIED TO READ NEW BATCH NO FILE AND PASS IT CL**5 00087 * IN THE COMM AREA FOR OTHER PROGRAMS TO USE CL**5 00088 * REFERENCE: BATCH NO FILE PROGRAMMER: ZL1 CL**5 00089 * CL**5 00090 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD300 00091 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD300 00092 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBD300 00093 * DTSBD300 00094 * DTSBD300 00095 * DESCRIPTION: DTSBD300 00096 * DTSBD300 00097 * DRIVES THE DAILY MASTER FILE UPDATE. DTSBD300 00098 * DTSBD300 00099 * DTSBD300 00100 ***** DTSBD300 00101 SKIP3 DTSBD300 00102 ENVIRONMENT DIVISION. DTSBD300 00103 SKIP2 CL*20 00104 CONFIGURATION SECTION. CL*20 00105 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. CL*20 00106 CL*20 00107 INPUT-OUTPUT SECTION. CL*20 00108 CL*20 00109 FILE-CONTROL. CL*20 00110 * SELECT EMP-FILE ASSIGN TO DTSIFEMP CL*30 00111 * FILE STATUS IS EXP-STATUS. CL*30 00112 CL*20 00113 DATA DIVISION. CL*20 00114 CL*20 00115 FILE SECTION. CL*20 00116 CL*20 00117 *FD EMP-FILE CL*30 00118 * RECORDING MODE IS F. CL*30 00119 *01 EMP-REC1 PIC X(80). CL*30 00120 WORKING-STORAGE SECTION. DTSBD300 001205 77 PAN-VALET PICTURE X(24) VALUE '032DTSBD300 05/07/22'. DTSBD300 00121 77 PAN-VALET PICTURE X(24) VALUE '051DTSBD300 10/01/15'. DTSBD300 00122 77 PAN-VALET PICTURE X(24) VALUE '003DTSBD300 10/01/15'. DTSBD300 00123 77 PAN-VALET PICTURE X(24) VALUE '049DTSBD300 05/20/13'. DTSBD300 00124 77 PAN-VALET PICTURE X(24) VALUE '005DTSBD300 05/14/13'. DTSBD300 00125 77 PAN-VALET PICTURE X(24) VALUE '047DTSBD300 08/07/12'. DTSBD300 00126 SKIP3 DTSBD300 00127 01 WRK-AREA. DTSBD300 00128 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +300.DTSBD300 00129 DTSBD300 00130 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBD300'.DTSBD300 00131 DTSBD300 00132 05 WRK-NULL-DOC-NO. DTSBD300 00133 10 WRK-NULL-BATCH-NO PIC S9(05) COMP-3 VALUE +0. DTSBD300 00134 10 WRK-NULL-ITEM-NO PIC S9(03) COMP-3 VALUE +0. DTSBD300 00135 DTSBD300 00136 05 VAR-CHAR-CNT PIC S9(04) COMP. DTSBD300 00137 DTSBD300 00138 05 TRN-EOF-IND PIC X(01). DTSBD300 00139 DTSBD300 00140 05 TRN-REC-CNT PIC S9(07) COMP-3. DTSBD300 00141 DTSBD300 00142 05 TRN-REC-OK-CNT PIC S9(07) COMP-3. DTSBD300 00143 DTSBD300 00144 05 TRN-REC-FAILED-CNT PIC S9(07) COMP-3. DTSBD300 00145 DTSBD300 00146 05 TRN-INTERNAL-CNT PIC S9(07) COMP-3. DTSBD300 00147 DTSBD300 00148 05 TRN-INTERNAL-OK-CNT PIC S9(07) COMP-3. DTSBD300 00149 DTSBD300 00150 05 TRN-INTERNAL-FAILED-CNT PIC S9(07) COMP-3. DTSBD300 00151 CL*12 00152 05 WRK-TERMINATE-HDR PIC S9(07) COMP-3 CL*12 00153 VALUE +0. CL*12 00154 DTSBD300 00155 05 BYPASS-EMP1 PIC S9(07) COMP-3 DTSBD300 00156 VALUE +0. DTSBD300 00157 05 BYPASS-EMP2 PIC S9(07) COMP-3 DTSBD300 00158 VALUE +0. DTSBD300 00159 05 BYPASS-EMP3 PIC S9(07) COMP-3 DTSBD300 00160 VALUE +0. DTSBD300 00161 DTSBD300 00162 05 EXP-STATUS PIC X(02). CL*22 00163 88 EXP-STATUS-OK-88 VALUE '00'. CL*22 00164 05 SLASHED-RUN-DATE PIC X(10). DTSBD300 00165 DTSBD300 00166 05 SLASHED-MAIL-DATE PIC X(10). DTSBD300 00167 DTSBD300 00168 05 WRK-RUN-TYPE PIC X(01). DTSBD300 00169 DTSBD300 00170 05 WRK-TRACE-IND PIC X(01). DTSBD300 00171 DTSBD300 00172 05 WRK-CONSOLE-RESPONSE PIC X(01). DTSBD300 00173 DTSBD300 00174 05 WRK-START-ABSTIME PIC S9(15) COMP-3. DTSBD300 00175 DTSBD300 00176 05 WRK-STEP-DURATION-X PIC X(09). DTSBD300 00177 05 WRK-STEP-DURATION REDEFINES WRK-STEP-DURATION-X DTSBD300 00178 PIC ZZ,ZZ9.99. DTSBD300 00179 DTSBD300 00180 05 UNPACKED-TIME PIC 9(06). DTSBD300 00181 05 FILLER REDEFINES UNPACKED-TIME. DTSBD300 00182 10 UNPACKED-H PIC 9(02). DTSBD300 00183 10 UNPACKED-M PIC 9(02). DTSBD300 00184 10 UNPACKED-S PIC 9(02). DTSBD300 00185 DTSBD300 00186 DTSBD300 00187 05 UNPACKED-BATCH-NO PIC 9(05). DTSBD300 00188 DTSBD300 00189 05 UNPACKED-ITEM-NO PIC 9(03). DTSBD300 00190 EJECT DTSBD300 00191 01 MSG-AREA. DTSBD300 00192 05 MSG-MOD-ID. DTSBD300 00193 10 MSG-MOD-NAME PIC X(08). DTSBD300 00194 10 MSG-ID PIC X(03). DTSBD300 00195 DTSBD300 00196 05 MSG-SHORT-TEXT PIC X(20). DTSBD300 00197 DTSBD300 00198 05 MSG-LONG-AREA. DTSBD300 00199 10 MSG-LONG-COMMON. DTSBD300 00200 15 MSG-TRN-TYPE PIC X(03). DTSBD300 00201 15 FILLER PIC X(02). DTSBD300 00202 15 MSG-TRN-CD PIC X(02). DTSBD300 00203 15 FILLER PIC X(02). DTSBD300 00204 15 MSG-TRN-ORIGIN PIC X(10). DTSBD300 00205 15 FILLER PIC X(02). DTSBD300 00206 15 MSG-TRN-SYS-DATE PIC X(10). DTSBD300 00207 15 FILLER PIC X(02). DTSBD300 00208 15 MSG-TRN-SYS-TIME PIC X(08). DTSBD300 00209 15 FILLER PIC X(03). DTSBD300 00210 10 MSG-LONG-TEXT PIC X(60). DTSBD300 00211 SKIP3 DTSBD300 00212 01 MSG-TABLE. DTSBD300 00213 05 MSG1-NO-EMP. DTSBD300 00214 10 MSG1-ID PIC X(11) VALUE 'DTSBD300901'. DTSBD300 00215 10 MSG1-SHORT-TEXT PIC X(20) VALUE 'NO EMPLOYER'. DTSBD300 00216 10 MSG1-LONG-TEXT. DTSBD300 00217 15 FILLER PIC X(30) DTSBD300 00218 VALUE 'TRANSACTION FAILED - EMPLOYER '. DTSBD300 00219 15 FILLER PIC X(30) DTSBD300 00220 VALUE 'DOES NOT EXIST '. DTSBD300 00221 DTSBD300 00222 05 MSG2-UPDATE-LOCKED. DTSBD300 00223 10 MSG2-ID PIC X(11) VALUE 'DTSBD300902'. DTSBD300 00224 10 MSG2-SHORT-TEXT PIC X(20) VALUE 'UPDATE LOCKED'. DTSBD300 00225 10 MSG2-LONG-TEXT. DTSBD300 00226 15 FILLER PIC X(30) DTSBD300 00227 VALUE 'TRANSACTION FAILED - EMPLOYER '. DTSBD300 00228 15 FILLER PIC X(30) DTSBD300 00229 VALUE 'LOCKED AGAINST UPDATE '. DTSBD300 00230 DTSBD300 00231 05 MSG3-INVALID-TRN-TYPE. DTSBD300 00232 10 MSG3-ID PIC X(11) VALUE 'DTSBD300904'. DTSBD300 00233 10 MSG3-SHORT-TEXT PIC X(20) VALUE 'INVALID TRN TYP'. DTSBD300 00234 10 MSG3-LONG-TEXT. DTSBD300 00235 15 FILLER PIC X(30) DTSBD300 00236 VALUE 'TRANSACTION FAILED - INVALID T'. DTSBD300 00237 15 FILLER PIC X(30) DTSBD300 00238 VALUE 'RANSACTION RECORD TYPE '. DTSBD300 00239 DTSBD300 00240 05 MSG4-PURGE-IND-SET. DTSBD300 00241 10 MSG4-ID PIC X(11) VALUE 'DTSBD300903'. DTSBD300 00242 10 MSG4-SHORT-TEXT PIC X(20) VALUE 'PURGE IND ON '. DTSBD300 00243 10 MSG4-LONG-TEXT. DTSBD300 00244 15 FILLER PIC X(30) DTSBD300 00245 VALUE 'TRANSACTION FAILED - EMPLOYER '. DTSBD300 00246 15 FILLER PIC X(30) DTSBD300 00247 VALUE 'AWAITING PURGE '. DTSBD300 00248 DTSBD300 00249 05 MSG5-NOT-PASSED-FULL-EDITS. DTSBD300 00250 10 MSG5-ID PIC X(11) VALUE 'DTSBD300905'. DTSBD300 00251 10 MSG5-SHORT-TEXT PIC X(20) VALUE 'FAILED FULL EDT'. DTSBD300 00252 10 MSG5-LONG-TEXT. DTSBD300 00253 15 FILLER PIC X(30) DTSBD300 00254 VALUE 'TRANSACTION FAILED - DID NOT P'. DTSBD300 00255 15 FILLER PIC X(30) DTSBD300 00256 VALUE 'ASS FULL EDITS ON SCREEN 24 '. DTSBD300 00257 EJECT DTSBD300 00258 01 WRK-TABLES. CL*20 00259 05 WRK-EMP-NO PIC 9(06) VALUE ZEROS. CL*20 00260 05 TF-SUB PIC S9(07) COMP-3. CL*20 00261 05 TF-MAX PIC S9(07) COMP-3 CL*20 00262 VALUE +999999. CL*20 00263 05 TRANS-FILE-RPTS OCCURS 999999 TIMES. CL*20 00264 10 TRANS-FILE-RPT-IND PIC X(01). CL*20 00265 88 TF-RPT-FOUND-YES-88 VALUE 'Y'. CL*20 00266 88 TF-RPT-FOUND-NO-88 VALUE 'N'. CL*20 00267 10 TRANS-BYPASSED-IND PIC X(01). CL*20 00268 88 TF-BYPASSED-YES-88 VALUE 'Y'. CL*20 00269 88 TF-BYPASSED-NO-88 VALUE 'N'. CL*20 00270 EJECT CL*20 00271 01 EMP-CREDIT-REC. CL*25 00272 05 CREEMP PIC 9(06). CL*23 00273 05 FILLER PIC X(74). CL*23 00274 SKIP3 CL*23 00275 SKIP3 CL*20 00276 01 L941-LINK-AREA. CL*20 00277 ++INCLUDE DTSIL941 DTSBD300 00278 SKIP3 DTSBD300 00279 01 TVAR-REC. DTSBD300 00280 ++INCLUDE DTSIRVAR DTSBD300 00281 EJECT DTSBD300 00282 01 LBCM-LINK-AREA. DTSBD300 00283 ++INCLUDE DTSILBCM DTSBD300 00284 EJECT DTSBD300 00285 01 TSKL-REC. DTSBD300 00286 ++INCLUDE DTSITSKL DTSBD300 00287 EJECT DTSBD300 00288 01 RSKL-REC. DTSBD300 00289 ++INCLUDE DTSIRSK1 DTSBD300 00290 SKIP3 DTSBD300 00291 01 R907-REC. DTSBD300 00292 ++INCLUDE DTSIR907 DTSBD300 00293 SKIP3 DTSBD300 00294 01 R905-REC. DTSBD300 00295 ++INCLUDE DTSIR905 DTSBD300 00296 SKIP3 DTSBD300 00297 01 R302-REC. DTSBD300 00298 ++INCLUDE DTSIR302 DTSBD300 00299 EJECT DTSBD300 00300 01 L001-LINK-AREA. DTSBD300 00301 ++INCLUDE DTSIL001 DTSBD300 00302 EJECT DTSBD300 00303 01 L005-LINK-AREA. DTSBD300 00304 ++INCLUDE DTSIL005 DTSBD300 00305 EJECT DTSBD300 00306 01 L420-LINK-AREA. DTSBD300 00307 ++INCLUDE DTSIL420 DTSBD300 00308 EJECT DTSBD300 00309 01 L590-LINK-AREA. DTSBD300 00310 ++INCLUDE DTSIL590 DTSBD300 00311 EJECT DTSBD300 00312 01 L910-LINK-AREA. DTSBD300 00313 ++INCLUDE DTSIL910 DTSBD300 00314 SKIP3 DTSBD300 00315 01 MSKL-REC. DTSBD300 00316 ++INCLUDE DTSIMSKL DTSBD300 00317 SKIP3 DTSBD300 00318 01 MHDR-REC. DTSBD300 00319 ++INCLUDE DTSIMHDR DTSBD300 00320 SKIP3 DTSBD300 00321 01 MPRF-REC. DTSBD300 00322 ++INCLUDE DTSIMPRF DTSBD300 00323 EJECT DTSBD300 00324 01 L921-LINK-AREA. DTSBD300 00325 ++INCLUDE DTSIL921 DTSBD300 00326 SKIP3 DTSBD300 00327 01 ISKL-REC. DTSBD300 00328 ++INCLUDE DTSIISKL DTSBD300 00329 EJECT DTSBD300 00330 01 L923-LINK-AREA. DTSBD300 00331 ++INCLUDE DTSIL923 DTSBD300 00332 SKIP3 DTSBD300 00333 01 ASKL-REC. DTSBD300 00334 ++INCLUDE DTSIASKL DTSBD300 00335 SKIP3 DTSBD300 00336 01 ARPT-REC REDEFINES ASKL-REC. DTSBD300 00337 ++INCLUDE DTSIARPT DTSBD300 00338 SKIP3 DTSBD300 00339 01 APAY-REC REDEFINES ASKL-REC. DTSBD300 00340 ++INCLUDE DTSIAPAY DTSBD300 00341 SKIP3 DTSBD300 00342 01 AADJ-REC REDEFINES ASKL-REC. DTSBD300 00343 ++INCLUDE DTSIAADJ DTSBD300 00344 SKIP3 DTSBD300 00345 01 AATX-REC REDEFINES ASKL-REC. DTSBD300 00346 ++INCLUDE DTSIAATX DTSBD300 00347 SKIP3 DTSBD300 00348 01 AHDR-REC. DTSBD300 00349 ++INCLUDE DTSIAHDR DTSBD300 00350 EJECT DTSBD300 00351 01 L931-LINK-AREA. DTSBD300 00352 ++INCLUDE DTSIL931 DTSBD300 00353 SKIP3 DTSBD300 00354 01 FSKL-REC. DTSBD300 00355 ++INCLUDE DTSIFSKL DTSBD300 00356 EJECT DTSBD300 00357 01 L933-LINK-AREA. DTSBD300 00358 ++INCLUDE DTSIL933 DTSBD300 00359 SKIP3 DTSBD300 00360 01 XSIC-REC. DTSBD300 00361 ++INCLUDE DTSIXSIC DTSBD300 00362 EJECT DTSBD300 00363 01 L934-LINK-AREA. DTSBD300 00364 ++INCLUDE DTSIL934 DTSBD300 00365 SKIP3 DTSBD300 00366 01 XNIC-REC. DTSBD300 00367 ++INCLUDE DTSIXNIC DTSBD300 00368 EJECT DTSBD300 00369 01 L983-LINK-AREA. DTSBD300 00370 ++INCLUDE DTSIL983 DTSBD300 00371 SKIP3 DTSBD300 00372 01 WSKL-REC. DTSBD300 00373 ++INCLUDE DTSIWSKL DTSBD300 00374 EJECT DTSBD300 00375 01 L981-LINK-AREA. DTSBD300 00376 ++INCLUDE DTSIL981 DTSBD300 00377 SKIP3 DTSBD300 00378 01 WWGH-REC. DTSBD300 00379 ++INCLUDE DTSIWWGH DTSBD300 00380 EJECT DTSBD300 00381 01 L982-LINK-AREA. DTSBD300 00382 ++INCLUDE DTSIL982 DTSBD300 00383 SKIP3 DTSBD300 00384 01 WNAM-REC. DTSBD300 00385 ++INCLUDE DTSIWNAM DTSBD300 00386 EJECT DTSBD300 00387 01 L985-LINK-AREA. CL**2 00388 ++INCLUDE DTSIL985 CL**2 00389 01 LINK-REC. CL**2 00390 ++INCLUDE DTSIWBAT CL**2 00391 LINKAGE SECTION. DTSBD300 00392 SKIP3 DTSBD300 00393 01 PARM-AREA. DTSBD300 00394 05 PARM-LENGTH PIC S9(04) COMP. DTSBD300 00395 05 PARM-DATA. DTSBD300 00396 10 PARM-RUN-TYPE PIC X(01). DTSBD300 00397 10 FILLER PIC X(01). DTSBD300 00398 10 PARM-TRACE-IND PIC X(01). DTSBD300 00399 10 FILLER PIC X(01). DTSBD300 00400 10 PARM-BYPASS-EMP1 PIC 9(06). DTSBD300 00401 10 FILLER PIC X(01). DTSBD300 00402 10 PARM-BYPASS-EMP2 PIC 9(06). DTSBD300 00403 10 FILLER PIC X(01). DTSBD300 00404 10 PARM-BYPASS-EMP3 PIC 9(06). DTSBD300 00405 EJECT DTSBD300 00406 PROCEDURE DIVISION USING PARM-AREA. DTSBD300 00407 DTSBD300 00408 DTSBD300 00409 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBD300 00410 DTSBD300 00411 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBD300 00412 DTSBD300 00413 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBD300 00414 DTSBD300 00415 DTSBD300 00416 GOBACK. DTSBD300 00417 EJECT DTSBD300 00418 I0000-INITIATE. DTSBD300 00419 PERFORM I1000-OPEN-FILES THRU I1000-EXIT. DTSBD300 00420 DTSBD300 00421 PERFORM I2000-READ-MHDR THRU I2000-EXIT. DTSBD300 00422 DTSBD300 00423 PERFORM I3000-PARM THRU I3000-EXIT. DTSBD300 00424 DTSBD300 00425 PERFORM I4000-INIT-LBCM THRU I4000-EXIT. DTSBD300 00426 DTSBD300 00427 PERFORM I5000-MISC-INIT THRU I5000-EXIT. DTSBD300 00428 I0000-EXIT. DTSBD300 00429 EXIT. DTSBD300 00430 SKIP3 DTSBD300 00431 I1000-OPEN-FILES. DTSBD300 00432 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSBD300 00433 DTSBD300 00434 PERFORM S910-OPEN-UPDATE THRU S910-EXIT. DTSBD300 00435 DTSBD300 00436 DTSBD300 00437 MOVE WRK-MOD-NAME TO L921-MOD-NAME. DTSBD300 00438 DTSBD300 00439 PERFORM S921-OPEN-UPDATE THRU S921-EXIT. DTSBD300 00440 DTSBD300 00441 DTSBD300 00442 MOVE WRK-MOD-NAME TO L923-MOD-NAME. DTSBD300 00443 DTSBD300 00444 PERFORM S923-OPEN-UPDATE THRU S923-EXIT. DTSBD300 00445 DTSBD300 00446 DTSBD300 00447 MOVE WRK-MOD-NAME TO L931-MOD-NAME. DTSBD300 00448 DTSBD300 00449 PERFORM S931-OPEN-READ THRU S931-EXIT. DTSBD300 00450 DTSBD300 00451 DTSBD300 00452 MOVE WRK-MOD-NAME TO L933-MOD-NAME. DTSBD300 00453 DTSBD300 00454 PERFORM S933-OPEN-READ THRU S933-EXIT. DTSBD300 00455 DTSBD300 00456 DTSBD300 00457 MOVE WRK-MOD-NAME TO L934-MOD-NAME. DTSBD300 00458 DTSBD300 00459 PERFORM S934-OPEN-READ THRU S934-EXIT. DTSBD300 00460 DTSBD300 00461 DTSBD300 00462 MOVE WRK-MOD-NAME TO L941-MOD-NAME. DTSBD300 00463 DTSBD300 00464 PERFORM S941-OPEN-READ THRU S941-EXIT. DTSBD300 00465 DTSBD300 00466 MOVE WRK-MOD-NAME TO L983-MOD-NAME. DTSBD300 00467 DTSBD300 00468 PERFORM S983B-OPEN-UPDATE THRU S983B-EXIT. DTSBD300 00469 DTSBD300 00470 MOVE WRK-MOD-NAME TO L981-MOD-NAME. DTSBD300 00471 DTSBD300 00472 PERFORM S981B-OPEN-UPDATE THRU S981B-EXIT. DTSBD300 00473 DTSBD300 00474 MOVE WRK-MOD-NAME TO L982-MOD-NAME. DTSBD300 00475 DTSBD300 00476 PERFORM S982B-OPEN-UPDATE THRU S982B-EXIT. DTSBD300 00477 CL**3 00478 PERFORM S985-OPEN THRU S985-EXIT. CL**3 00479 DTSBD300 00480 PERFORM S420A-OPEN-W4-FILE THRU S420A-EXIT. DTSBD300 00481 DTSBD300 00482 I1000-EXIT. DTSBD300 00483 EXIT. DTSBD300 00484 SKIP3 DTSBD300 00485 I2000-READ-MHDR. DTSBD300 00486 MOVE LOW-VALUES TO MHDR-KEY-AREA. DTSBD300 00487 DTSBD300 00488 SET MHDR-HDR-88 TO TRUE. DTSBD300 00489 DTSBD300 00490 MOVE +0 TO MHDR-EMP-NO. DTSBD300 00491 DTSBD300 00492 MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA. DTSBD300 00493 DTSBD300 00494 PERFORM S910-READ THRU S910-EXIT. DTSBD300 00495 DTSBD300 00496 IF L910-NO-REC-88 DTSBD300 00497 MOVE 'MASTER HEADER RECORD NOT FOUND' DTSBD300 00498 TO MSG-LONG-TEXT DTSBD300 00499 PERFORM S999-ABEND THRU S999-EXIT. DTSBD300 00500 DTSBD300 00501 DTSBD300 00502 MOVE MSKL-REC TO MHDR-REC. DTSBD300 00503 DTSBD300 00504 DTSBD300 00505 MOVE MHDR-CURR-RUN-DATE TO L001-FED-8-DATE-9. DTSBD300 00506 DTSBD300 00507 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBD300 00508 DTSBD300 00509 MOVE L001-SLASH-8-DATE TO SLASHED-RUN-DATE. DTSBD300 00510 DTSBD300 00511 DTSBD300 00512 MOVE MHDR-CURR-MAIL-DATE TO L001-FED-8-DATE-9. DTSBD300 00513 DTSBD300 00514 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBD300 00515 DTSBD300 00516 MOVE L001-SLASH-8-DATE TO SLASHED-MAIL-DATE. DTSBD300 00517 I2000-EXIT. DTSBD300 00518 EXIT. DTSBD300 00519 SKIP3 DTSBD300 00520 I3000-PARM. DTSBD300 00521 DISPLAY '*** DTSBD300 PARAMETERS'. DTSBD300 00522 DTSBD300 00523 *** IF PARM-LENGTH = +3 DTSBD300 00524 IF PARM-LENGTH = +24 DTSBD300 00525 NEXT SENTENCE DTSBD300 00526 ELSE DTSBD300 00527 DISPLAY '24 BYTES OF PARM INFORMATION ' DTSBD300 00528 'MUST BE INPUT. PARM-LENGTH = ' DTSBD300 00529 PARM-LENGTH DTSBD300 00530 PERFORM S999-ABEND THRU S999-EXIT. DTSBD300 00531 DTSBD300 00532 IF PARM-RUN-TYPE = 'P' OR 'T' DTSBD300 00533 MOVE PARM-RUN-TYPE TO WRK-RUN-TYPE DTSBD300 00534 ELSE DTSBD300 00535 DISPLAY 'PARM SPECIFIED RUN TYPE MUST EQUAL P OR T. ' DTSBD300 00536 'PARM-RUN-TYPE = ' DTSBD300 00537 PARM-RUN-TYPE DTSBD300 00538 PERFORM S999-ABEND THRU S999-EXIT. DTSBD300 00539 DTSBD300 00540 MOVE PARM-TRACE-IND TO WRK-TRACE-IND. DTSBD300 00541 DTSBD300 00542 PERFORM I3100-BYPASS-EMP THRU I3100-EXIT. DTSBD300 00543 DTSBD300 00544 I3000-EXIT. DTSBD300 00545 EXIT. DTSBD300 00546 SKIP3 DTSBD300 00547 I3100-BYPASS-EMP. DTSBD300 00548 IF PARM-BYPASS-EMP1 NUMERIC DTSBD300 00549 MOVE PARM-BYPASS-EMP1 TO BYPASS-EMP1 DTSBD300 00550 END-IF. DTSBD300 00551 DTSBD300 00552 IF PARM-BYPASS-EMP2 NUMERIC DTSBD300 00553 MOVE PARM-BYPASS-EMP2 TO BYPASS-EMP2 DTSBD300 00554 END-IF. DTSBD300 00555 DTSBD300 00556 IF PARM-BYPASS-EMP3 NUMERIC DTSBD300 00557 MOVE PARM-BYPASS-EMP3 TO BYPASS-EMP3 DTSBD300 00558 END-IF. DTSBD300 00559 * OPEN INPUT EMP-FILE. CL*30 00560 * IF NOT EXP-STATUS-OK-88 CL*30 00561 * DISPLAY 'CANNOT OPEN CREDIT FILE ' EXP-STATUS CL*30 00562 * SET WRK-ERROR-YES-88 TO TRUE CL*29 00563 * PERFORM S999-ABEND THRU S999-EXIT. CL*30 00564 CL*27 00565 * PERFORM I3300-CREDIT-TABLE THRU I3300-EXIT. CL*30 00566 * CLOSE EMP-FILE. CL*30 00567 DTSBD300 00568 I3100-EXIT. CL*30 00569 EXIT. CL*30 00570 *I3300-CREDIT-TABLE. CL*30 00571 * READ EMP-FILE INTO EMP-CREDIT-REC AT END CL*30 00572 * GO TO I3300-EXIT. CL*30 00573 * MOVE CREEMP TO TF-SUB CL*30 00574 CL*20 00575 * IF WRK-RPT-YRQ = WRK-PARM-SUBJECT-YRQ CL*28 00576 * SET TF-RPT-FOUND-YES-88 (TF-SUB) TO TRUE. CL*30 00577 * ADD +1 TO WRK-TF-TABLE-CNT CL*29 00578 * DISPLAY 'EMP-LOADED IN TABLE: ' TF-SUB. CL*30 00579 CL*20 00580 * GO TO I3300-CREDIT-TABLE. CL*30 00581 *I3300-EXIT. CL*30 00582 * EXIT. CL*30 00583 SKIP3 DTSBD300 00584 *I3200-OPERATOR-COMM. DTSBD300 00585 * SKIP2 DTSBD300 00586 ***** DTSBD300 00587 * DTSBD300 00588 * IN MONTANA I3200 AND I3210 ARE COMMENTED OUT DTSBD300 00589 * - TO PREVENT MESSAGES TO THE CONSOLE. DTSBD300 00590 * DTSBD300 00591 * IF THE COMPUTER OPERATOR IS TO AUTHORIZE CONTINUATION DTSBD300 00592 * OF THE RUN, THEN REMOVE THE COMMENTS FROM I3200 AND I3210. DTSBD300 00593 * DTSBD300 00594 ***** DTSBD300 00595 * SKIP2 DTSBD300 00596 * MOVE SPACE TO WRK-CONSOLE-RESPONSE. DTSBD300 00597 * PERFORM I3210-OPERATOR-LOOP THRU I3210-EXIT DTSBD300 00598 * UNTIL WRK-CONSOLE-RESPONSE = 'Y' OR 'N'. DTSBD300 00599 * IF WRK-CONSOLE-RESPONSE = 'N' DTSBD300 00600 * MOVE 'THE CONSOLE OPERATOR TERMINATED THE STEP' DTSBD300 00601 * TO MSG-LONG-TEXT DTSBD300 00602 * PERFORM S999-ABEND THRU S999-EXIT. DTSBD300 00603 ***** DTSBD300 00604 *I3200-EXIT. DTSBD300 00605 * EXIT. DTSBD300 00606 * SKIP3 DTSBD300 00607 *I3210-OPERATOR-LOOP. DTSBD300 00608 * DISPLAY 'DTSBD300 +---------------------------------+' DTSBD300 00609 * UPON CONSOLE. DTSBD300 00610 * DISPLAY 'DTSBD300 + ROSES ARE RED +' DTSBD300 00611 * UPON CONSOLE. DTSBD300 00612 * DISPLAY 'DTSBD300 + VIOLETS ARE BLUE +' DTSBD300 00613 * UPON CONSOLE. DTSBD300 00614 * DISPLAY 'DTSBD300 + THIS UI TAX UPDATE +' DTSBD300 00615 * UPON CONSOLE. DTSBD300 00616 * DISPLAY 'DTSBD300 + (RUN DATE ' DTSBD300 00617 * SLASHED-RUN-DATE DTSBD300 00618 * ') +' DTSBD300 00619 * UPON CONSOLE. DTSBD300 00620 * DISPLAY 'DTSBD300 + (MAIL DATE ' DTSBD300 00621 * SLASHED-MAIL-DATE DTSBD300 00622 * ') +' DTSBD300 00623 * UPON CONSOLE. DTSBD300 00624 * DISPLAY 'DTSBD300 + IS JUST FOR YOU +' DTSBD300 00625 * UPON CONSOLE. DTSBD300 00626 * DISPLAY 'DTSBD300 + +' DTSBD300 00627 * UPON CONSOLE. DTSBD300 00628 * DISPLAY 'DTSBD300 + PROCEED (Y/N)? +' DTSBD300 00629 * UPON CONSOLE. DTSBD300 00630 * DISPLAY 'DTSBD300 +---------------------------------+' DTSBD300 00631 * UPON CONSOLE. DTSBD300 00632 * DTSBD300 00633 * ACCEPT WRK-CONSOLE-RESPONSE FROM CONSOLE. DTSBD300 00634 *I3210-EXIT. DTSBD300 00635 * EXIT. DTSBD300 00636 SKIP3 DTSBD300 00637 I4000-INIT-LBCM. DTSBD300 00638 MOVE SPACES TO LBCM-LINK-AREA. DTSBD300 00639 DTSBD300 00640 DTSBD300 00641 MOVE WRK-RUN-TYPE TO LBCM-RUN-TYPE. DTSBD300 00642 DTSBD300 00643 DTSBD300 00644 IF WRK-RUN-TYPE = 'T' DTSBD300 00645 MOVE WRK-TRACE-IND TO LBCM-TRACE-IND DTSBD300 00646 ELSE DTSBD300 00647 MOVE 'N' TO LBCM-TRACE-IND. DTSBD300 00648 DTSBD300 00649 DTSBD300 00650 PERFORM S005-FROM-SYS THRU S005-EXIT. DTSBD300 00651 DTSBD300 00652 MOVE L005-DATE TO LBCM-SYS-DATE. DTSBD300 00653 DTSBD300 00654 MOVE L005-TIME TO LBCM-SYS-TIME. DTSBD300 00655 DTSBD300 00656 MOVE L005-ABSTIME TO LBCM-ABSTIME DTSBD300 00657 WRK-START-ABSTIME. DTSBD300 00658 DTSBD300 00659 * MOVE 15.00 TO LBCM-QTR-TOL-MAX. DTSBD300 00660 MOVE 0.00 TO LBCM-QTR-TOL-MAX. DTSBD300 00661 DTSBD300 00662 MOVE 0.00 TO LBCM-CR-TOL-MAX. CL*26 00663 CL*17 00664 * MOVE 100.00 TO LBCM-CR-TOL-MAX. CL*20 00665 DTSBD300 00666 MOVE 19924 TO LBCM-PICKUP-YRQ. DTSBD300 00667 DTSBD300 00668 MOVE +500 TO LBCM-LAST-USED-ITEM-NO. CL**5 00669 DTSBD300 00670 MOVE MHDR-LAST-USED-ASSIGN-NO DTSBD300 00671 TO LBCM-LAST-USED-ASSIGN-NO. DTSBD300 00672 DTSBD300 00673 MOVE MHDR-LAST-USED-LEVY-NO DTSBD300 00674 TO LBCM-LAST-USED-LEVY-NO. DTSBD300 00675 DTSBD300 00676 MOVE MHDR-LAST-USED-LIEN-NO DTSBD300 00677 TO LBCM-LAST-USED-LIEN-NO. DTSBD300 00678 DTSBD300 00679 MOVE MHDR-LAST-USED-REFUND-NO DTSBD300 00680 TO LBCM-LAST-USED-REFUND-NO. DTSBD300 00681 DTSBD300 00682 MOVE MHDR-CURR-RUN-DATE DTSBD300 00683 TO LBCM-CURR-RUN-DATE. DTSBD300 00684 DTSBD300 00685 MOVE MHDR-CURR-MAIL-DATE DTSBD300 00686 TO LBCM-CURR-MAIL-DATE. DTSBD300 00687 DTSBD300 00688 MOVE MHDR-CURR-RUN-DATE DTSBD300 00689 TO LBCM-RECEIVED-DATE. DTSBD300 00690 DTSBD300 00691 MOVE MHDR-CURR-MAIL-DATE DTSBD300 00692 TO LBCM-DEPOSIT-DATE. DTSBD300 00693 DTSBD300 00694 MOVE MHDR-LAST-USED-BATCH-NO DTSBD300 00695 TO LBCM-LAST-BATCH-NO. DTSBD300 00696 DTSBD300 00697 PERFORM S1100-INCR-BATCH-NO THRU S1100-EXIT. DTSBD300 00698 DTSBD300 00699 MOVE MHDR-LAST-UC30-MASS-MAIL-YRQ DTSBD300 00700 TO LBCM-LAST-UC30-MASS-MAIL-YRQ. DTSBD300 00701 DTSBD300 00702 MOVE MHDR-LAST-UC30-DEL-MAIL-YRQ DTSBD300 00703 TO LBCM-LAST-UC30-DEL-MAIL-YRQ. DTSBD300 00704 DTSBD300 00705 MOVE MHDR-LAST-PEN-ASSESSED-YRQ DTSBD300 00706 TO LBCM-LAST-PEN-ASSESSED-YRQ. DTSBD300 00707 DTSBD300 00708 MOVE MHDR-FIRST-PURSUED-RPT-YRQ DTSBD300 00709 TO LBCM-FIRST-PURSUED-RPT-YRQ. DTSBD300 00710 DTSBD300 00711 MOVE MHDR-LAST-RATE-END-YRQ DTSBD300 00712 TO LBCM-LAST-RATE-END-YRQ. DTSBD300 00713 DTSBD300 00714 MOVE +010010 DTSBD300 00715 TO LBCM-NON-DOES-EMP-NO. DTSBD300 00716 I4000-EXIT. DTSBD300 00717 EXIT. DTSBD300 00718 SKIP3 DTSBD300 00719 I5000-MISC-INIT. DTSBD300 00720 MOVE +0 TO TRN-REC-CNT DTSBD300 00721 TRN-REC-OK-CNT DTSBD300 00722 TRN-REC-FAILED-CNT DTSBD300 00723 TRN-INTERNAL-OK-CNT DTSBD300 00724 TRN-INTERNAL-FAILED-CNT DTSBD300 00725 TRN-INTERNAL-CNT. DTSBD300 00726 DTSBD300 00727 MOVE LBCM-TRACE-IND TO L910-TRACE-IND DTSBD300 00728 L921-TRACE-IND DTSBD300 00729 L923-TRACE-IND DTSBD300 00730 L931-TRACE-IND DTSBD300 00731 L933-TRACE-IND DTSBD300 00732 L934-TRACE-IND DTSBD300 00733 L941-TRACE-IND. DTSBD300 00734 DTSBD300 00735 MOVE LENGTH OF R302-REC TO R302-LENGTH. DTSBD300 00736 DTSBD300 00737 MOVE LENGTH OF R905-REC TO R905-LENGTH. DTSBD300 00738 DTSBD300 00739 MOVE LENGTH OF R907-REC TO R907-LENGTH. DTSBD300 00740 I5000-EXIT. DTSBD300 00741 EXIT. DTSBD300 00742 EJECT DTSBD300 00743 P0000-PROCESS. DTSBD300 00744 MOVE 'N' TO TRN-EOF-IND. DTSBD300 00745 DTSBD300 00746 DISPLAY '>> P0000-BD300 ' CL**9 00747 PERFORM P1100-READ-TRN THRU P1100-EXIT. DTSBD300 00748 DTSBD300 00749 IF TRN-EOF-IND = 'N' DTSBD300 00750 PERFORM P1310-INIT-EMP THRU P1310-EXIT DTSBD300 00751 PERFORM P1000-PROCESS-LOOP THRU P1000-EXIT DTSBD300 00752 UNTIL TRN-EOF-IND = 'Y' DTSBD300 00753 PERFORM P1320-TERMINATE-EMP THRU P1320-EXIT. DTSBD300 00754 P0000-EXIT. DTSBD300 00755 EXIT. DTSBD300 00756 EJECT DTSBD300 00757 P1000-PROCESS-LOOP. DTSBD300 00758 DISPLAY '>> BD300 ' TSKL-EMP-NO. DTSBD300 00759 IF TSKL-EMP-NO NOT = LBCM-EMP-NO DTSBD300 00760 PERFORM P1320-TERMINATE-EMP THRU P1320-EXIT DTSBD300 00761 PERFORM P1310-INIT-EMP THRU P1310-EXIT. DTSBD300 00762 DTSBD300 00763 IF TSKL-EMP-NO = BYPASS-EMP1 DTSBD300 00764 OR TSKL-EMP-NO = BYPASS-EMP2 DTSBD300 00765 OR TSKL-EMP-NO = BYPASS-EMP3 DTSBD300 00766 OR TSKL-EMP-NO = 120502 OR 121420 OR 145516 CL*15 00767 OR 121420 CL*31 00768 IF TSKL-EMP-NO > ZERO DTSBD300 00769 DISPLAY '##### EMPLOYER BYPASSED DAILY UPDATE ' DTSBD300 00770 TSKL-EMP-NO DTSBD300 00771 END-IF DTSBD300 00772 ELSE DTSBD300 00773 PERFORM P1210-INIT-TRN THRU P1210-EXIT DTSBD300 00774 PERFORM P1220-PROCESS-TRN THRU P1220-EXIT DTSBD300 00775 PERFORM P1230-TERMINATE-TRN THRU P1230-EXIT DTSBD300 00776 END-IF. DTSBD300 00777 DTSBD300 00778 PERFORM P1100-READ-TRN THRU P1100-EXIT. DTSBD300 00779 P1000-EXIT. DTSBD300 00780 EXIT. DTSBD300 00781 SKIP3 DTSBD300 00782 P1100-READ-TRN. DTSBD300 00783 DISPLAY '>> P1100-BD300 ' CL**9 00784 PERFORM S941-READ-NEXT THRU S941-EXIT. DTSBD300 00785 DTSBD300 00786 IF L941-NO-REC-88 DTSBD300 00787 MOVE 'Y' TO TRN-EOF-IND DTSBD300 00788 GO TO P1100-EXIT. DTSBD300 00789 DTSBD300 00790 COMPUTE VAR-CHAR-CNT = RVAR-LENGTH - 2. DTSBD300 00791 DTSBD300 00792 MOVE TVAR-REC TO TSKL-REC. DTSBD300 00793 DTSBD300 00794 ADD +1 TO TRN-REC-CNT. DTSBD300 00795 P1100-EXIT. DTSBD300 00796 EXIT. DTSBD300 00797 SKIP3 DTSBD300 00798 P1210-INIT-TRN. DTSBD300 00799 DISPLAY '>> P1210-BD300 ' CL**9 00800 MOVE SPACES TO LBCM-TRN-AREA. DTSBD300 00801 DTSBD300 00802 SET LBCM-EXT-TO-ACCT-88 TO TRUE. DTSBD300 00803 DTSBD300 00804 IF TSKL-ACCOUNTING-88 DTSBD300 00805 MOVE TSKL-DATA-AREA TO ASKL-REC DTSBD300 00806 MOVE ASKL-DOC-NO TO LBCM-TRN-DOC-NO. DTSBD300 00807 DTSBD300 00808 SET LBCM-TRN-OK-88 TO TRUE. DTSBD300 00809 DTSBD300 00810 MOVE +0 TO LBCM-TRN-INTERNAL-OK-CNT DTSBD300 00811 LBCM-TRN-INTERNAL-FAILED-CNT. DTSBD300 00812 DTSBD300 00813 IF (TSKL-ACCOUNTING-88) DTSBD300 00814 AND DTSBD300 00815 ((ASKL-RPT-88) DTSBD300 00816 AND DTSBD300 00817 (ARPT-PASSED-FULL-EDITS-NO-88) DTSBD300 00818 OR DTSBD300 00819 (ASKL-ATX-88 DTSBD300 00820 AND DTSBD300 00821 AATX-PASSED-FULL-EDITS-NO-88)) DTSBD300 00822 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD300 00823 MOVE MSG5-NOT-PASSED-FULL-EDITS TO LBCM-TRN-MSG-AREA DTSBD300 00824 ELSE DTSBD300 00825 IF LBCM-EMP-MPRF-NO-88 DTSBD300 00826 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD300 00827 MOVE MSG1-NO-EMP TO LBCM-TRN-MSG-AREA DTSBD300 00828 ELSE DTSBD300 00829 IF MPRF-UPDATE-ACTIVE-88 DTSBD300 00830 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD300 00831 MOVE MSG2-UPDATE-LOCKED TO LBCM-TRN-MSG-AREA DTSBD300 00832 ELSE DTSBD300 00833 IF MPRF-PURGE-ALL-YES-88 DTSBD300 00834 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD300 00835 MOVE MSG4-PURGE-IND-SET TO LBCM-TRN-MSG-AREA. DTSBD300 00836 DTSBD300 00837 IF LBCM-TRN-OK-88 DTSBD300 00838 IF TSKL-ACCOUNTING-88 DTSBD300 00839 MOVE TSKL-DATA-AREA TO ASKL-REC DTSBD300 00840 IF ASKL-ATX-88 DTSBD300 00841 PERFORM P1215-LAST-ITEM THRU P1215-EXIT DTSBD300 00842 END-IF DTSBD300 00843 END-IF DTSBD300 00844 END-IF. DTSBD300 00845 DTSBD300 00846 P1210-EXIT. DTSBD300 00847 EXIT. DTSBD300 00848 DTSBD300 00849 P1215-LAST-ITEM. DTSBD300 00850 DISPLAY 'BD300 P1215 ' TSKL-EMP-NO. DTSBD300 00851 DISPLAY ' ASKL-DOC ' ASKL-BATCH-NO ' ' ASKL-ITEM-NO. DTSBD300 00852 MOVE +0 TO ASKL-ITEM-NO. CL*10 00853 DTSBD300 00854 PERFORM S923-READ THRU S923-EXIT. DTSBD300 00855 IF L923-OK-88 DTSBD300 00856 MOVE ASKL-REC TO AHDR-REC DTSBD300 00857 MOVE AHDR-LAST-USED-ITEM-NO DTSBD300 00858 TO LBCM-LAST-AATX-ITEM-NO DTSBD300 00859 DISPLAY ' HDR ITEM ' LBCM-LAST-AATX-ITEM-NO DTSBD300 00860 ELSE DTSBD300 00861 DISPLAY 'CANNOT FIND HEADER RECORD: ' DTSBD300 00862 ASKL-BATCH-NO ' ' ASKL-ITEM-NO DTSBD300 00863 END-IF. DTSBD300 00864 DTSBD300 00865 P1215-EXIT. DTSBD300 00866 EXIT. DTSBD300 00867 DTSBD300 00868 P1220-PROCESS-TRN. DTSBD300 00869 IF LBCM-TRN-OK-88 DTSBD300 00870 NEXT SENTENCE DTSBD300 00871 ELSE DTSBD300 00872 GO TO P1220-EXIT. DTSBD300 00873 DTSBD300 00874 IF TSKL-EMP-NO = 998888 CL*32 00875 DISPLAY 'P1220- BD300 TRAN TYPE ' TSKL-REC-TYPE. CL*32 00876 CL*32 00877 IF TSKL-ACCOUNTING-88 CL*32 00878 CALL 'DTSBD370' USING LBCM-LINK-AREA DTSBD300 00879 MPRF-REC DTSBD300 00880 TSKL-REC DTSBD300 00881 ELSE DTSBD300 00882 IF TSKL-REGISTRATION-88 DTSBD300 00883 CALL 'DTSBD310' USING LBCM-LINK-AREA DTSBD300 00884 MPRF-REC DTSBD300 00885 TSKL-REC DTSBD300 00886 ELSE DTSBD300 00887 IF TSKL-RATING-88 DTSBD300 00888 CALL 'DTSBD340' USING LBCM-LINK-AREA DTSBD300 00889 MPRF-REC DTSBD300 00890 TSKL-REC DTSBD300 00891 ELSE DTSBD300 00892 IF TSKL-COLLECTION-88 DTSBD300 00893 CALL 'DTSBD320' USING LBCM-LINK-AREA DTSBD300 00894 MPRF-REC DTSBD300 00895 TSKL-REC DTSBD300 00896 ELSE DTSBD300 00897 IF TSKL-FS-DOWNLOAD-88 DTSBD300 00898 CALL 'DTSBD330' USING LBCM-LINK-AREA DTSBD300 00899 MPRF-REC DTSBD300 00900 TSKL-REC DTSBD300 00901 ELSE DTSBD300 00902 IF TSKL-AUTO-QTR-88 DTSBD300 00903 CALL 'DTSBD350' USING LBCM-LINK-AREA DTSBD300 00904 MPRF-REC DTSBD300 00905 TSKL-REC DTSBD300 00906 ELSE DTSBD300 00907 IF TSKL-RPT-PRINT-88 DTSBD300 00908 CALL 'DTSBD360' USING LBCM-LINK-AREA DTSBD300 00909 MPRF-REC DTSBD300 00910 TSKL-REC DTSBD300 00911 ELSE DTSBD300 00912 IF TSKL-AUTO-EMP-STATUS-88 DTSBD300 00913 OR TSKL-NOTEPAD-88 DTSBD300 00914 OR TSKL-WEB-AUDIT-88 DTSBD300 00915 DISPLAY ' AUDIT TRAN ' DTSBD300 00916 CALL 'DTSBD380' USING LBCM-LINK-AREA DTSBD300 00917 MPRF-REC DTSBD300 00918 TSKL-REC DTSBD300 00919 ELSE DTSBD300 00920 IF TSKL-LMI-EMP-88 DTSBD300 00921 CALL 'DTSBD390' USING LBCM-LINK-AREA DTSBD300 00922 MPRF-REC DTSBD300 00923 TSKL-REC DTSBD300 00924 ELSE DTSBD300 00925 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD300 00926 MOVE MSG3-INVALID-TRN-TYPE TO LBCM-TRN-MSG-AREA. DTSBD300 00927 P1220-EXIT. DTSBD300 00928 EXIT. DTSBD300 00929 SKIP3 DTSBD300 00930 P1230-TERMINATE-TRN. DTSBD300 00931 IF LBCM-TRN-OK-88 DTSBD300 00932 ADD +1 TO TRN-REC-OK-CNT DTSBD300 00933 IF TSKL-ACCOUNTING-88 DTSBD300 00934 PERFORM P1232-UPDATE-ATC THRU P1232-EXIT DTSBD300 00935 ELSE DTSBD300 00936 NEXT SENTENCE DTSBD300 00937 ELSE DTSBD300 00938 ADD +1 TO TRN-REC-FAILED-CNT DTSBD300 00939 IF TSKL-ACCOUNTING-88 DTSBD300 00940 PERFORM P1231-R302-REC THRU P1231-EXIT DTSBD300 00941 ELSE DTSBD300 00942 PERFORM P1233-R907-REC THRU P1233-EXIT. DTSBD300 00943 DTSBD300 00944 ADD LBCM-TRN-INTERNAL-OK-CNT TO TRN-INTERNAL-CNT DTSBD300 00945 TRN-INTERNAL-OK-CNT. DTSBD300 00946 DTSBD300 00947 ADD LBCM-TRN-INTERNAL-FAILED-CNT TO TRN-INTERNAL-CNT DTSBD300 00948 TRN-INTERNAL-FAILED-CNT. DTSBD300 00949 DTSBD300 00950 PERFORM P1234-SET-EMP-CR-TOL-DOC-NO THRU P1234-EXIT. DTSBD300 00951 DTSBD300 00952 IF LBCM-LAST-USED-ITEM-NO >= 600 CL**4 00953 PERFORM S1000-ATC-HDR THRU S1000-EXIT. DTSBD300 00954 P1230-EXIT. DTSBD300 00955 EXIT. DTSBD300 00956 SKIP3 DTSBD300 00957 P1231-R302-REC. DTSBD300 00958 MOVE TSKL-DATA-AREA TO ASKL-REC. DTSBD300 00959 DTSBD300 00960 MOVE ASKL-BATCH-NO TO R302-BATCH-NO. DTSBD300 00961 DTSBD300 00962 MOVE ASKL-ITEM-NO TO R302-ITEM-NO. DTSBD300 00963 DTSBD300 00964 MOVE TSKL-EMP-NO TO R302-EMP-NO. DTSBD300 00965 DTSBD300 00966 SET R302-TRAN-DATA-88 TO TRUE. DTSBD300 00967 DTSBD300 00968 MOVE +0 TO R302-SORT-YRQ DTSBD300 00969 R302-SORT-ACCT-SEQ. DTSBD300 00970 DTSBD300 00971 MOVE SPACE TO R302-SORT-ACCT-IND. DTSBD300 00972 DTSBD300 00973 MOVE LBCM-CURR-RUN-DATE TO R302-CURR-RUN-DATE. DTSBD300 00974 DTSBD300 00975 MOVE ASKL-REC-TYPE TO R302-ACCT-REC-TYPE. DTSBD300 00976 DTSBD300 00977 IF ASKL-RPT-88 DTSBD300 00978 MOVE ARPT-DEPOSIT-DATE TO R302-DEPOSIT-DATE DTSBD300 00979 MOVE ARPT-RECEIVED-DATE TO R302-RECEIVED-DATE DTSBD300 00980 MOVE ARPT-RPT-TYPE TO R302-TRANS-TYPE DTSBD300 00981 MOVE ARPT-REMIT-AMT TO R302-REMIT-AMT DTSBD300 00982 ELSE DTSBD300 00983 IF ASKL-ATX-88 DTSBD300 00984 MOVE AATX-DEPOSIT-DATE TO R302-DEPOSIT-DATE DTSBD300 00985 MOVE AATX-RECEIVED-DATE TO R302-RECEIVED-DATE DTSBD300 00986 MOVE AATX-RPT-TYPE TO R302-TRANS-TYPE DTSBD300 00987 MOVE AATX-REMIT-AMT TO R302-REMIT-AMT DTSBD300 00988 ELSE DTSBD300 00989 IF ASKL-PAY-88 DTSBD300 00990 MOVE APAY-DEPOSIT-DATE TO R302-DEPOSIT-DATE DTSBD300 00991 MOVE APAY-RECEIVED-DATE TO R302-RECEIVED-DATE DTSBD300 00992 MOVE APAY-PAY-TYPE TO R302-TRANS-TYPE DTSBD300 00993 MOVE APAY-REMIT-AMT TO R302-REMIT-AMT DTSBD300 00994 ELSE DTSBD300 00995 IF ASKL-ADJ-88 DTSBD300 00996 MOVE AADJ-DEPOSIT-DATE TO R302-DEPOSIT-DATE DTSBD300 00997 MOVE AADJ-RECEIVED-DATE TO R302-RECEIVED-DATE DTSBD300 00998 MOVE AADJ-ADJ-TYPE TO R302-TRANS-TYPE DTSBD300 00999 MOVE +0 TO R302-REMIT-AMT DTSBD300 01000 ELSE DTSBD300 01001 MOVE LBCM-DEPOSIT-DATE TO R302-DEPOSIT-DATE DTSBD300 01002 MOVE LBCM-RECEIVED-DATE TO R302-RECEIVED-DATE DTSBD300 01003 MOVE SPACES TO R302-TRANS-TYPE DTSBD300 01004 MOVE +0 TO R302-REMIT-AMT. DTSBD300 01005 DTSBD300 01006 MOVE +0 TO R302-APPLIC-YRQ. DTSBD300 01007 DTSBD300 01008 MOVE SPACE TO R302-APPLIC-ACCT-IND. DTSBD300 01009 DTSBD300 01010 MOVE +0 TO R302-APPLIC-BATCH-NO DTSBD300 01011 R302-APPLIC-ITEM-NO. DTSBD300 01012 DTSBD300 01013 MOVE SPACE TO R302-WAIVE-INT-IND DTSBD300 01014 R302-WAIVE-LATE-PEN-IND DTSBD300 01015 DTSBD300 01016 MOVE +0 TO R302-TOT-WAGE-CHNG DTSBD300 01017 R302-TAX-WAGE-CHNG. DTSBD300 01018 DTSBD300 01019 SET R302-NOT-OK-88 TO TRUE. DTSBD300 01020 DTSBD300 01021 MOVE LBCM-TRN-MSG-ID TO R302-ERROR-MSG-ID. DTSBD300 01022 DTSBD300 01023 MOVE LBCM-TRN-MSG-LONG TO R302-ERROR-MSG-TEXT. DTSBD300 01024 DTSBD300 01025 MOVE LBCM-TRN-MSG-MOD-NAME TO R302-ERROR-MOD-NAME. DTSBD300 01026 DTSBD300 01027 MOVE R302-REC TO RSKL-REC. DTSBD300 01028 DTSBD300 01029 PERFORM S946-RPT-O THRU S946-EXIT. DTSBD300 01030 DTSBD300 01031 DTSBD300 01032 IF ASKL-RPT-88 DTSBD300 01033 IF ARPT-PASSED-FULL-EDITS-YES-88 DTSBD300 01034 NEXT SENTENCE DTSBD300 01035 ELSE DTSBD300 01036 GO TO P1231-EXIT DTSBD300 01037 ELSE DTSBD300 01038 IF ASKL-ATX-88 DTSBD300 01039 IF AATX-PASSED-FULL-EDITS-YES-88 DTSBD300 01040 NEXT SENTENCE DTSBD300 01041 ELSE DTSBD300 01042 GO TO P1231-EXIT DTSBD300 01043 ELSE DTSBD300 01044 GO TO P1231-EXIT. DTSBD300 01045 DTSBD300 01046 PERFORM S923-READ THRU S923-EXIT. DTSBD300 01047 DTSBD300 01048 IF L923-NO-REC-88 DTSBD300 01049 MOVE ASKL-BATCH-NO TO UNPACKED-BATCH-NO DTSBD300 01050 MOVE ASKL-ITEM-NO TO UNPACKED-ITEM-NO DTSBD300 01051 MOVE SPACES TO MSG-LONG-TEXT DTSBD300 01052 STRING DTSBD300 01053 'P1231 001 ' DELIMITED BY SIZE DTSBD300 01054 'DOCUMENT: ' DELIMITED BY SIZE DTSBD300 01055 UNPACKED-BATCH-NO DELIMITED BY SIZE DTSBD300 01056 ' ' DELIMITED BY SIZE DTSBD300 01057 UNPACKED-ITEM-NO DELIMITED BY SIZE DTSBD300 01058 ' NOT FOUND ON ATC FILE' DELIMITED BY SIZE DTSBD300 01059 INTO DTSBD300 01060 MSG-LONG-TEXT DTSBD300 01061 PERFORM S999-ABEND THRU S999-EXIT. DTSBD300 01062 DTSBD300 01063 IF ASKL-RPT-88 DTSBD300 01064 SET ARPT-PASSED-FULL-EDITS-NO-88 TO TRUE DTSBD300 01065 ELSE DTSBD300 01066 IF ASKL-ATX-88 DTSBD300 01067 SET AATX-PASSED-FULL-EDITS-NO-88 TO TRUE. DTSBD300 01068 DTSBD300 01069 PERFORM S923-REWRITE THRU S923-EXIT. DTSBD300 01070 P1231-EXIT. DTSBD300 01071 EXIT. DTSBD300 01072 SKIP3 DTSBD300 01073 P1232-UPDATE-ATC. DTSBD300 01074 MOVE TSKL-DATA-AREA TO ASKL-REC. DTSBD300 01075 DTSBD300 01076 PERFORM S923-READ THRU S923-EXIT. DTSBD300 01077 DTSBD300 01078 IF L923-NO-REC-88 DTSBD300 01079 MOVE ASKL-BATCH-NO TO UNPACKED-BATCH-NO DTSBD300 01080 MOVE ASKL-ITEM-NO TO UNPACKED-ITEM-NO DTSBD300 01081 MOVE SPACES TO MSG-LONG-TEXT DTSBD300 01082 STRING DTSBD300 01083 'P1232 001 ' DELIMITED BY SIZE DTSBD300 01084 'DOCUMENT: ' DELIMITED BY SIZE DTSBD300 01085 UNPACKED-BATCH-NO DELIMITED BY SIZE DTSBD300 01086 ' ' DELIMITED BY SIZE DTSBD300 01087 UNPACKED-ITEM-NO DELIMITED BY SIZE DTSBD300 01088 ' NOT FOUND ON ATC FILE' DELIMITED BY SIZE DTSBD300 01089 INTO DTSBD300 01090 MSG-LONG-TEXT DTSBD300 01091 PERFORM S999-ABEND THRU S999-EXIT. DTSBD300 01092 DTSBD300 01093 IF ASKL-ADJ-88 DTSBD300 01094 MOVE LBCM-CURR-RUN-DATE TO AADJ-PROCESSED-DATE DTSBD300 01095 ELSE DTSBD300 01096 IF ASKL-PAY-88 DTSBD300 01097 MOVE LBCM-CURR-RUN-DATE TO APAY-PROCESSED-DATE DTSBD300 01098 ELSE DTSBD300 01099 IF ASKL-RPT-88 DTSBD300 01100 MOVE LBCM-CURR-RUN-DATE TO ARPT-PROCESSED-DATE DTSBD300 01101 ELSE DTSBD300 01102 IF ASKL-ATX-88 DTSBD300 01103 MOVE LBCM-CURR-RUN-DATE TO AATX-PROCESSED-DATE DTSBD300 01104 ELSE DTSBD300 01105 MOVE 'P1232 002 UNEXPECTED ASKL-REC-TYPE ENCOUNTERED' DTSBD300 01106 TO MSG-LONG-TEXT DTSBD300 01107 PERFORM S999-ABEND THRU S999-EXIT. DTSBD300 01108 DTSBD300 01109 PERFORM S923-REWRITE THRU S923-EXIT. DTSBD300 01110 P1232-EXIT. DTSBD300 01111 EXIT. DTSBD300 01112 SKIP3 DTSBD300 01113 P1233-R907-REC. DTSBD300 01114 MOVE TSKL-EMP-NO TO R907-EMP-NO. DTSBD300 01115 DTSBD300 01116 MOVE LBCM-TRN-MSG-ID TO R907-MSG-ID. DTSBD300 01117 DTSBD300 01118 MOVE LBCM-TRN-MSG-LONG TO MSG-LONG-TEXT. DTSBD300 01119 DTSBD300 01120 MOVE SPACES TO MSG-LONG-COMMON. DTSBD300 01121 DTSBD300 01122 MOVE TSKL-REC-TYPE TO MSG-TRN-TYPE. DTSBD300 01123 DTSBD300 01124 MOVE TSKL-TRN-CD TO MSG-TRN-CD. DTSBD300 01125 DTSBD300 01126 MOVE TSKL-ORIGIN TO MSG-TRN-ORIGIN. DTSBD300 01127 DTSBD300 01128 MOVE TSKL-SYS-DATE TO L001-FED-8-DATE-9. DTSBD300 01129 DTSBD300 01130 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBD300 01131 DTSBD300 01132 MOVE TSKL-SYS-TIME TO UNPACKED-TIME. DTSBD300 01133 DTSBD300 01134 MOVE ' : : ' TO L005-DISPLAY-TIME. DTSBD300 01135 DTSBD300 01136 MOVE UNPACKED-H TO L005-DISPLAY-H. DTSBD300 01137 DTSBD300 01138 MOVE UNPACKED-M TO L005-DISPLAY-M. DTSBD300 01139 DTSBD300 01140 MOVE UNPACKED-S TO L005-DISPLAY-S. DTSBD300 01141 DTSBD300 01142 MOVE L001-SLASH-8-DATE TO MSG-TRN-SYS-DATE. DTSBD300 01143 DTSBD300 01144 MOVE L005-DISPLAY-TIME TO MSG-TRN-SYS-TIME. DTSBD300 01145 DTSBD300 01146 MOVE MSG-LONG-AREA TO R907-MSG-TEXT. DTSBD300 01147 DTSBD300 01148 MOVE LBCM-TRN-MSG-MOD-NAME TO R907-MODULE-NAME. DTSBD300 01149 DTSBD300 01150 MOVE R907-REC TO RSKL-REC. DTSBD300 01151 DTSBD300 01152 PERFORM S946-RPT-O THRU S946-EXIT. DTSBD300 01153 P1233-EXIT. DTSBD300 01154 EXIT. DTSBD300 01155 SKIP3 DTSBD300 01156 P1234-SET-EMP-CR-TOL-DOC-NO. DTSBD300 01157 IF LBCM-TRN-OK-88 DTSBD300 01158 AND TSKL-ACCOUNTING-88 DTSBD300 01159 IF MPRF-TOT-CREDIT-AMT > +0 DTSBD300 01160 AND MPRF-TOT-CREDIT-AMT <= LBCM-CR-TOL-MAX DTSBD300 01161 AND LBCM-EMP-CR-TOL-DOC-NO = WRK-NULL-DOC-NO DTSBD300 01162 MOVE ASKL-DOC-NO TO LBCM-EMP-CR-TOL-DOC-NO. DTSBD300 01163 P1234-EXIT. DTSBD300 01164 EXIT. DTSBD300 01165 EJECT DTSBD300 01166 P1310-INIT-EMP. DTSBD300 01167 DISPLAY '>> P1310-BD300 ' CL**9 01168 MOVE SPACES TO LBCM-EMP-AREA. DTSBD300 01169 DTSBD300 01170 MOVE TSKL-EMP-NO TO LBCM-EMP-NO. DTSBD300 01171 DTSBD300 01172 MOVE LBCM-ABSTIME TO LBCM-EMP-ABSTIME. DTSBD300 01173 DTSBD300 01174 SET LBCM-EMP-UPDATE-NO-88 TO TRUE. DTSBD300 01175 DTSBD300 01176 SET LBCM-EMP-ACCOUNTING-NO-88 TO TRUE. DTSBD300 01177 DTSBD300 01178 MOVE WRK-NULL-DOC-NO TO LBCM-EMP-CR-TOL-DOC-NO. DTSBD300 01179 DTSBD300 01180 DTSBD300 01181 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSBD300 01182 DTSBD300 01183 SET MPRF-PRF-88 TO TRUE. DTSBD300 01184 DTSBD300 01185 MOVE LBCM-EMP-NO TO MPRF-EMP-NO. DTSBD300 01186 DTSBD300 01187 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSBD300 01188 DTSBD300 01189 IF MSKL-EMP-NO = +0 DTSBD300 01190 SET L910-NO-REC-88 TO TRUE DTSBD300 01191 ELSE DTSBD300 01192 PERFORM S910-READ THRU S910-EXIT. DTSBD300 01193 DTSBD300 01194 IF L910-NO-REC-88 DTSBD300 01195 SET LBCM-EMP-MPRF-NO-88 TO TRUE DTSBD300 01196 GO TO P1310-EXIT. DTSBD300 01197 DTSBD300 01198 DTSBD300 01199 MOVE MSKL-REC TO MPRF-REC. DTSBD300 01200 CL*17 01201 **** TEST CODE FOR CREDIT TOLERANCE. CL*17 01202 CL*17 01203 * MOVE 0.00 TO LBCM-CR-TOL-MAX. CL*30 01204 * MOVE MPRF-EMP-NO TO TF-SUB CL*30 01205 * DISPLAY 'CREDIT MPRF EMP: ' TF-SUB. CL*30 01206 * IF TF-RPT-FOUND-YES-88 (TF-SUB) CL*30 01207 * SET TF-BYPASSED-YES-88 (WRK-EMP-NO) TO TRUE CL*30 01208 * MOVE 100000.00 TO LBCM-CR-TOL-MAX CL*30 01209 * DISPLAY 'CREDIT EMP FOUND: ' TF-SUB. CL*30 01210 * ADD +1 TO WRK-BYPASS-TBL CL*20 01211 * GO TO P0000-EXIT. CL*20 01212 CL*20 01213 SET LBCM-EMP-MPRF-YES-88 TO TRUE. DTSBD300 01214 DTSBD300 01215 DTSBD300 01216 PERFORM S590-INITIATE THRU S590-EXIT. DTSBD300 01217 DTSBD300 01218 DTSBD300 01219 IF MPRF-UPDATE-ACTIVE-88 DTSBD300 01220 PERFORM P1311-R905 THRU P1311-EXIT. DTSBD300 01221 P1310-EXIT. DTSBD300 01222 EXIT. DTSBD300 01223 SKIP3 DTSBD300 01224 P1311-R905. DTSBD300 01225 MOVE MPRF-EMP-NO TO R905-EMP-NO. DTSBD300 01226 DTSBD300 01227 MOVE LBCM-SYS-DATE TO R905-SYS-DATE. DTSBD300 01228 DTSBD300 01229 MOVE LBCM-SYS-TIME TO R905-SYS-TIME. DTSBD300 01230 DTSBD300 01231 MOVE 'DAILY' TO R905-OP-ID. DTSBD300 01232 DTSBD300 01233 MOVE 'Y' TO R905-UPDATE-IND. DTSBD300 01234 DTSBD300 01235 MOVE MPRF-UPDATE-TASK-ID TO R905-UPDATE-TASK-ID. DTSBD300 01236 DTSBD300 01237 MOVE MPRF-UPDATE-OP-ID TO R905-UPDATE-OP-ID. DTSBD300 01238 DTSBD300 01239 MOVE MPRF-UPDATE-TERMID TO R905-UPDATE-TERMID. DTSBD300 01240 DTSBD300 01241 MOVE MPRF-UPDATE-NETNAME TO R905-UPDATE-NETNAME. DTSBD300 01242 DTSBD300 01243 MOVE MPRF-UPDATE-START-DATE TO R905-UPDATE-START-DATE. DTSBD300 01244 DTSBD300 01245 MOVE MPRF-UPDATE-START-TIME TO R905-UPDATE-START-TIME. DTSBD300 01246 DTSBD300 01247 MOVE MPRF-UPDATE-SCR-ID TO R905-UPDATE-SCR-ID. DTSBD300 01248 DTSBD300 01249 MOVE MPRF-UPDATE-FUNCTION TO R905-UPDATE-FUNCTION. DTSBD300 01250 DTSBD300 01251 MOVE LOW-VALUES TO R905-PADDING-FOR-SYNCSORT. DTSBD300 01252 DTSBD300 01253 MOVE R905-REC TO RSKL-REC. DTSBD300 01254 DTSBD300 01255 PERFORM S946-RPT-O THRU S946-EXIT. DTSBD300 01256 P1311-EXIT. DTSBD300 01257 EXIT. DTSBD300 01258 SKIP3 DTSBD300 01259 P1320-TERMINATE-EMP. DTSBD300 01260 IF LBCM-EMP-MPRF-NO-88 DTSBD300 01261 GO TO P1320-EXIT. DTSBD300 01262 DTSBD300 01263 DTSBD300 01264 PERFORM S590-TERMINATE THRU S590-EXIT. DTSBD300 01265 DTSBD300 01266 DTSBD300 01267 MOVE MPRF-REC TO MSKL-REC. DTSBD300 01268 DTSBD300 01269 PERFORM S910-REWRITE THRU S910-EXIT. DTSBD300 01270 P1320-EXIT. DTSBD300 01271 EXIT. DTSBD300 01272 EJECT DTSBD300 01273 T0000-TERMINATE. DTSBD300 01274 PERFORM T1000-MHDR-REC THRU T1000-EXIT. DTSBD300 01275 DTSBD300 01276 PERFORM T2000-TERM-STATS THRU T2000-EXIT. DTSBD300 01277 DTSBD300 01278 PERFORM T3000-CLOSE-FILES THRU T3000-EXIT. DTSBD300 01279 T0000-EXIT. DTSBD300 01280 EXIT. DTSBD300 01281 SKIP3 DTSBD300 01282 T1000-MHDR-REC. DTSBD300 01283 IF LBCM-LAST-USED-ITEM-NO > 500 CL**5 01284 MOVE +1 TO WRK-TERMINATE-HDR CL*12 01285 PERFORM S1000-ATC-HDR THRU S1000-EXIT. DTSBD300 01286 DTSBD300 01287 * SUBTRACT 1 FROM LBCM-LAST-BATCH-NO. CL**2 01288 DTSBD300 01289 CALL 'DTSBD399' USING LBCM-LINK-AREA DTSBD300 01290 MHDR-REC. DTSBD300 01291 DTSBD300 01292 MOVE MHDR-REC TO MSKL-REC. DTSBD300 01293 DTSBD300 01294 PERFORM S910-REWRITE THRU S910-EXIT. DTSBD300 01295 T1000-EXIT. DTSBD300 01296 EXIT. DTSBD300 01297 SKIP3 DTSBD300 01298 T2000-TERM-STATS. DTSBD300 01299 DISPLAY ' '. DTSBD300 01300 DTSBD300 01301 DISPLAY '*** DTSBD300 TERMINATION STATISTICS'. DTSBD300 01302 DTSBD300 01303 DISPLAY '*** ' DTSBD300 01304 SLASHED-RUN-DATE DTSBD300 01305 ' RUN DATE'. DTSBD300 01306 DTSBD300 01307 DISPLAY '*** ' DTSBD300 01308 SLASHED-MAIL-DATE DTSBD300 01309 ' MAIL-DATE'. DTSBD300 01310 DTSBD300 01311 DISPLAY '*** ' DTSBD300 01312 TRN-REC-CNT DTSBD300 01313 ' TRANSACTION RECORDS READ'. DTSBD300 01314 DTSBD300 01315 DISPLAY '*** ' DTSBD300 01316 TRN-REC-OK-CNT DTSBD300 01317 ' SUCCESSFUL TRANSACTIONS'. DTSBD300 01318 DTSBD300 01319 DISPLAY '*** ' DTSBD300 01320 TRN-REC-FAILED-CNT DTSBD300 01321 ' FAILED TRANSACTIONS'. DTSBD300 01322 DTSBD300 01323 DISPLAY '*** ' DTSBD300 01324 TRN-INTERNAL-CNT DTSBD300 01325 ' INTERNALLY GENERATED TRANSACTIONS'. DTSBD300 01326 DTSBD300 01327 DISPLAY '*** ' DTSBD300 01328 TRN-INTERNAL-OK-CNT DTSBD300 01329 ' SUCCESSFUL INTERNALLY GENERATED TRANSACTIONS'. DTSBD300 01330 DTSBD300 01331 DISPLAY '*** ' DTSBD300 01332 TRN-INTERNAL-FAILED-CNT DTSBD300 01333 ' FAILED INTERNALLY GENERATED TRANSACTIONS'. DTSBD300 01334 DTSBD300 01335 DTSBD300 01336 PERFORM S005-FROM-SYS THRU S005-EXIT. DTSBD300 01337 DTSBD300 01338 COMPUTE WRK-STEP-DURATION ROUNDED DTSBD300 01339 = (L005-ABSTIME - WRK-START-ABSTIME ) / 1000. DTSBD300 01340 DTSBD300 01341 DISPLAY '*** ' DTSBD300 01342 WRK-STEP-DURATION-X DTSBD300 01343 ' STEP DURATION (SECONDS)'. DTSBD300 01344 DTSBD300 01345 DISPLAY '*** '. DTSBD300 01346 DTSBD300 01347 DISPLAY '*** '. DTSBD300 01348 T2000-EXIT. DTSBD300 01349 EXIT. DTSBD300 01350 SKIP3 DTSBD300 01351 T3000-CLOSE-FILES. DTSBD300 01352 PERFORM S910-CLOSE THRU S910-EXIT. DTSBD300 01353 DTSBD300 01354 PERFORM S921-CLOSE THRU S921-EXIT. DTSBD300 01355 DTSBD300 01356 PERFORM S923-CLOSE THRU S923-EXIT. DTSBD300 01357 DTSBD300 01358 PERFORM S931-CLOSE THRU S931-EXIT. DTSBD300 01359 DTSBD300 01360 PERFORM S933-CLOSE THRU S933-EXIT. DTSBD300 01361 DTSBD300 01362 PERFORM S934-CLOSE THRU S934-EXIT. DTSBD300 01363 DTSBD300 01364 PERFORM S941-CLOSE THRU S941-EXIT. DTSBD300 01365 DTSBD300 01366 MOVE -1 TO RSK1-LENGTH. DTSBD300 01367 DTSBD300 01368 PERFORM S946-RPT-O THRU S946-EXIT. DTSBD300 01369 DTSBD300 01370 PERFORM S983C-CLOSE THRU S983C-EXIT. DTSBD300 01371 DTSBD300 01372 PERFORM S981C-CLOSE THRU S981C-EXIT. DTSBD300 01373 DTSBD300 01374 PERFORM S982C-CLOSE THRU S982C-EXIT. DTSBD300 01375 CL**3 01376 PERFORM S985-CLOSE THRU S985-EXIT. CL**3 01377 DTSBD300 01378 PERFORM S420B-CLOSE-W4-FILE THRU S420B-EXIT. DTSBD300 01379 DTSBD300 01380 T3000-EXIT. DTSBD300 01381 EXIT. DTSBD300 01382 EJECT DTSBD300 01383 S1000-ATC-HDR. DTSBD300 01384 MOVE LOW-VALUES TO AHDR-REC. DTSBD300 01385 DTSBD300 01386 DTSBD300 01387 MOVE LBCM-LAST-BATCH-NO TO AHDR-BATCH-NO. DTSBD300 01388 DTSBD300 01389 MOVE +0 TO AHDR-ITEM-NO. CL*11 01390 DTSBD300 01391 SET AHDR-HDR-88 TO TRUE. DTSBD300 01392 DTSBD300 01393 SET AHDR-BATCH-BALANCED-YES-88 TO TRUE. DTSBD300 01394 DTSBD300 01395 SET AHDR-BATCH-HELD-NO-88 TO TRUE. DTSBD300 01396 DTSBD300 01397 SET AHDR-ESTB-SYSTEM-88 TO TRUE. DTSBD300 01398 DTSBD300 01399 MOVE LBCM-CURR-RUN-DATE TO AHDR-ESTB-DATE. DTSBD300 01400 DTSBD300 01401 MOVE SPACES TO AHDR-CHNG-OP-ID. DTSBD300 01402 DTSBD300 01403 MOVE +0 TO AHDR-CHNG-DATE. DTSBD300 01404 DTSBD300 01405 MOVE LBCM-DEPOSIT-DATE TO AHDR-DEPOSIT-DATE. DTSBD300 01406 DTSBD300 01407 MOVE LBCM-RECEIVED-DATE TO AHDR-RECEIVED-DATE. DTSBD300 01408 DTSBD300 01409 MOVE LBCM-LAST-USED-ITEM-NO TO AHDR-LAST-USED-ITEM-NO. CL**5 01410 SUBTRACT +500 FROM LBCM-LAST-USED-ITEM-NO. CL**5 01411 MOVE LBCM-LAST-USED-ITEM-NO TO AHDR-CONTROL-TRAN-CNT CL**5 01412 AHDR-ATC-FILE-TRAN-CNT. DTSBD300 01413 DTSBD300 01414 MOVE +0 TO AHDR-PROC-TRAN-CNT DTSBD300 01415 AHDR-CONTROL-REMIT-AMT DTSBD300 01416 AHDR-ATC-FILE-REMIT-AMT DTSBD300 01417 AHDR-PROC-REMIT-AMT DTSBD300 01418 AHDR-BANK-BATCH-NO. DTSBD300 01419 DTSBD300 01420 DTSBD300 01421 MOVE AHDR-REC TO ASKL-REC. DTSBD300 01422 DTSBD300 01423 PERFORM S923-WRITE THRU S923-EXIT. DTSBD300 01424 DTSBD300 01425 IF WRK-TERMINATE-HDR = +0 CL*12 01426 PERFORM S1100-INCR-BATCH-NO THRU S1100-EXIT. CL*12 01427 DTSBD300 01428 MOVE +500 TO LBCM-LAST-USED-ITEM-NO. CL**5 01429 S1000-EXIT. DTSBD300 01430 EXIT. DTSBD300 01431 SKIP3 DTSBD300 01432 S1100-INCR-BATCH-NO. DTSBD300 01433 IF LBCM-LAST-BATCH-NO = 99999 DTSBD300 01434 MOVE +0 TO LBCM-LAST-BATCH-NO. DTSBD300 01435 CL**2 01436 DISPLAY 'OLD LBCM-LAST BATCH NO: ' LBCM-LAST-BATCH-NO. CL**7 01437 MOVE LBCM-LAST-BATCH-NO TO WBAT-BATCH-NO CL**2 01438 PERFORM S985-START-BROWSE THRU S985-EXIT CL*13 01439 IF L985-OK-88 CL**2 01440 MOVE WBAT-BATCH-NO TO LBCM-LAST-BATCH-NO CL**2 01441 ELSE CL**2 01442 DISPLAY 'BAD BTCH RETURN CODE: ' L985-RESULT-IND CL**8 01443 PERFORM S999-ABEND THRU S999-EXIT CL**2 01444 END-IF. CL**2 01445 CL**2 01446 DISPLAY 'NEW LBCM-LAST BATCH NO: ' LBCM-LAST-BATCH-NO. CL**5 01447 CL**2 01448 DTSBD300 01449 * ADD +1 TO LBCM-LAST-BATCH-NO. CL**2 01450 S1100-EXIT. DTSBD300 01451 EXIT. DTSBD300 01452 EJECT DTSBD300 01453 S001-FROM-FED-8. DTSBD300 01454 SET L001-FROM-FED-8 TO TRUE. DTSBD300 01455 GO TO S001-DATE. DTSBD300 01456 DTSBD300 01457 S001-DATE. DTSBD300 01458 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBD300 01459 S001-EXIT. DTSBD300 01460 EXIT. DTSBD300 01461 SKIP3 DTSBD300 01462 S005-FROM-SYS. DTSBD300 01463 SET L005-FROM-SYS TO TRUE. DTSBD300 01464 GO TO S005-ABSTIME. DTSBD300 01465 DTSBD300 01466 *S005-FROM-DATE-TIME. DTSBD300 01467 *****SET L005-FROM-DATE-TIME TO TRUE. DTSBD300 01468 *****GO TO S005-ABSTIME. DTSBD300 01469 DTSBD300 01470 S005-ABSTIME. DTSBD300 01471 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBD300 01472 S005-EXIT. DTSBD300 01473 EXIT. DTSBD300 01474 SKIP3 DTSBD300 01475 S420A-OPEN-W4-FILE. DTSBD300 01476 SET L420-CMND-OPEN-88 TO TRUE. DTSBD300 01477 CALL 'DTSBU420' USING L420-LINK-AREA. DTSBD300 01478 S420A-EXIT. DTSBD300 01479 EXIT. DTSBD300 01480 SKIP3 DTSBD300 01481 S420B-CLOSE-W4-FILE. DTSBD300 01482 SET L420-CMND-CLOSE-88 TO TRUE. DTSBD300 01483 CALL 'DTSBU420' USING L420-LINK-AREA. DTSBD300 01484 S420B-EXIT. DTSBD300 01485 EXIT. DTSBD300 01486 SKIP3 DTSBD300 01487 S590-INITIATE. DTSBD300 01488 SET L590-INITIATE-88 TO TRUE. DTSBD300 01489 GO TO S590-EMP-CLEANUP. DTSBD300 01490 DTSBD300 01491 S590-TERMINATE. DTSBD300 01492 SET L590-TERMINATE-88 TO TRUE. DTSBD300 01493 GO TO S590-EMP-CLEANUP. DTSBD300 01494 DTSBD300 01495 S590-EMP-CLEANUP. DTSBD300 01496 CALL 'DTSBU590' USING L590-LINK-AREA DTSBD300 01497 LBCM-LINK-AREA DTSBD300 01498 MPRF-REC. DTSBD300 01499 S590-EXIT. DTSBD300 01500 EXIT. DTSBD300 01501 SKIP3 DTSBD300 01502 S910-OPEN-UPDATE. DTSBD300 01503 SET L910-OPEN-UPDATE-88 TO TRUE. DTSBD300 01504 GO TO S910-MSTR-IO. DTSBD300 01505 DTSBD300 01506 S910-READ. DTSBD300 01507 SET L910-READ-88 TO TRUE. DTSBD300 01508 GO TO S910-MSTR-IO. DTSBD300 01509 DTSBD300 01510 S910-REWRITE. DTSBD300 01511 SET L910-REWRITE-88 TO TRUE. DTSBD300 01512 GO TO S910-MSTR-IO. DTSBD300 01513 DTSBD300 01514 S910-CLOSE. DTSBD300 01515 SET L910-CLOSE-88 TO TRUE. DTSBD300 01516 GO TO S910-MSTR-IO. DTSBD300 01517 DTSBD300 01518 S910-MSTR-IO. DTSBD300 01519 CALL 'DTSBU910' USING L910-LINK-AREA DTSBD300 01520 MSKL-REC. DTSBD300 01521 S910-EXIT. DTSBD300 01522 EXIT. DTSBD300 01523 SKIP3 DTSBD300 01524 S921-OPEN-UPDATE. DTSBD300 01525 SET L921-OPEN-UPDATE-88 TO TRUE. DTSBD300 01526 GO TO S921-AIX-IO. DTSBD300 01527 DTSBD300 01528 S921-CLOSE. DTSBD300 01529 SET L921-CLOSE-88 TO TRUE. DTSBD300 01530 GO TO S921-AIX-IO. DTSBD300 01531 DTSBD300 01532 S921-AIX-IO. DTSBD300 01533 CALL 'DTSBU921' USING L921-LINK-AREA DTSBD300 01534 ISKL-REC. DTSBD300 01535 S921-EXIT. DTSBD300 01536 EXIT. DTSBD300 01537 SKIP3 DTSBD300 01538 S923-OPEN-UPDATE. DTSBD300 01539 SET L923-OPEN-UPDATE-88 TO TRUE. DTSBD300 01540 GO TO S923-ATC-IO. DTSBD300 01541 DTSBD300 01542 S923-READ. DTSBD300 01543 SET L923-READ-88 TO TRUE. DTSBD300 01544 GO TO S923-ATC-IO. DTSBD300 01545 DTSBD300 01546 S923-WRITE. DTSBD300 01547 SET L923-WRITE-88 TO TRUE. DTSBD300 01548 GO TO S923-ATC-IO. DTSBD300 01549 DTSBD300 01550 S923-REWRITE. DTSBD300 01551 SET L923-REWRITE-88 TO TRUE. DTSBD300 01552 GO TO S923-ATC-IO. DTSBD300 01553 DTSBD300 01554 *S923-DELETE. DTSBD300 01555 *****SET L923-DELETE-88 TO TRUE. DTSBD300 01556 *****GO TO S923-ATC-IO. DTSBD300 01557 DTSBD300 01558 S923-CLOSE. DTSBD300 01559 SET L923-CLOSE-88 TO TRUE. DTSBD300 01560 GO TO S923-ATC-IO. DTSBD300 01561 DTSBD300 01562 S923-ATC-IO. DTSBD300 01563 CALL 'DTSBU923' USING L923-LINK-AREA DTSBD300 01564 ASKL-REC. DTSBD300 01565 S923-EXIT. DTSBD300 01566 EXIT. DTSBD300 01567 SKIP3 DTSBD300 01568 S931-OPEN-READ. DTSBD300 01569 SET L931-OPEN-READ-88 TO TRUE. DTSBD300 01570 GO TO S931-REF-I. DTSBD300 01571 DTSBD300 01572 S931-CLOSE. DTSBD300 01573 SET L931-CLOSE-88 TO TRUE. DTSBD300 01574 GO TO S931-REF-I. DTSBD300 01575 DTSBD300 01576 S931-REF-I. DTSBD300 01577 CALL 'DTSBU931' USING L931-LINK-AREA DTSBD300 01578 FSKL-REC. DTSBD300 01579 S931-EXIT. DTSBD300 01580 EXIT. DTSBD300 01581 SKIP3 DTSBD300 01582 S933-OPEN-READ. DTSBD300 01583 SET L933-OPEN-READ-88 TO TRUE. DTSBD300 01584 GO TO S933-SIC-I. DTSBD300 01585 DTSBD300 01586 S933-CLOSE. DTSBD300 01587 SET L933-CLOSE-88 TO TRUE. DTSBD300 01588 GO TO S933-SIC-I. DTSBD300 01589 DTSBD300 01590 S933-SIC-I. DTSBD300 01591 CALL 'DTSBU933' USING L933-LINK-AREA DTSBD300 01592 XSIC-REC. DTSBD300 01593 S933-EXIT. DTSBD300 01594 EXIT. DTSBD300 01595 SKIP3 DTSBD300 01596 S934-OPEN-READ. DTSBD300 01597 SET L934-OPEN-READ-88 TO TRUE. DTSBD300 01598 GO TO S934-NAIC-I. DTSBD300 01599 DTSBD300 01600 S934-CLOSE. DTSBD300 01601 SET L934-CLOSE-88 TO TRUE. DTSBD300 01602 GO TO S934-NAIC-I. DTSBD300 01603 DTSBD300 01604 S934-NAIC-I. DTSBD300 01605 CALL 'DTSBU934' USING L934-LINK-AREA DTSBD300 01606 XNIC-REC. DTSBD300 01607 S934-EXIT. DTSBD300 01608 EXIT. DTSBD300 01609 SKIP3 DTSBD300 01610 S941-OPEN-READ. DTSBD300 01611 SET L941-OPEN-READ-88 TO TRUE. DTSBD300 01612 GO TO S941-TRN-I. DTSBD300 01613 DTSBD300 01614 S941-READ-NEXT. DTSBD300 01615 SET L941-READ-NEXT-88 TO TRUE. DTSBD300 01616 GO TO S941-TRN-I. DTSBD300 01617 DTSBD300 01618 S941-CLOSE. DTSBD300 01619 SET L941-CLOSE-88 TO TRUE. DTSBD300 01620 GO TO S941-TRN-I. DTSBD300 01621 DTSBD300 01622 S941-TRN-I. DTSBD300 01623 CALL 'DTSBU941' USING L941-LINK-AREA DTSBD300 01624 TVAR-REC. DTSBD300 01625 S941-EXIT. DTSBD300 01626 EXIT. DTSBD300 01627 SKIP3 DTSBD300 01628 S946-RPT-O. DTSBD300 01629 CALL 'DTSBU946' USING RSKL-REC. DTSBD300 01630 S946-EXIT. DTSBD300 01631 EXIT. DTSBD300 01632 SKIP3 DTSBD300 01633 S983A-OPEN-READ. DTSBD300 01634 SET L983-OPEN-READ-88 TO TRUE. DTSBD300 01635 PERFORM S983Z-WAGE-I THRU S983Z-EXIT. DTSBD300 01636 DTSBD300 01637 S983A-EXIT. DTSBD300 01638 EXIT. DTSBD300 01639 DTSBD300 01640 DTSBD300 01641 S983B-OPEN-UPDATE. DTSBD300 01642 SET L983-OPEN-UPDATE-88 TO TRUE. DTSBD300 01643 PERFORM S983Z-WAGE-I THRU S983Z-EXIT. DTSBD300 01644 DTSBD300 01645 S983B-EXIT. DTSBD300 01646 EXIT. DTSBD300 01647 DTSBD300 01648 S983C-CLOSE. DTSBD300 01649 SET L983-CLOSE-88 TO TRUE. DTSBD300 01650 PERFORM S983Z-WAGE-I THRU S983Z-EXIT. DTSBD300 01651 DTSBD300 01652 S983C-EXIT. DTSBD300 01653 EXIT. DTSBD300 01654 DTSBD300 01655 S983Z-WAGE-I. DTSBD300 01656 CALL 'DTSBU983' USING L983-LINK-AREA DTSBD300 01657 WSKL-REC. DTSBD300 01658 S983Z-EXIT. DTSBD300 01659 EXIT. DTSBD300 01660 DTSBD300 01661 S981A-OPEN-READ. DTSBD300 01662 SET L981-OPEN-READ-88 TO TRUE. DTSBD300 01663 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DTSBD300 01664 DTSBD300 01665 S981A-EXIT. DTSBD300 01666 EXIT. DTSBD300 01667 DTSBD300 01668 DTSBD300 01669 S981B-OPEN-UPDATE. DTSBD300 01670 SET L981-OPEN-UPDATE-88 TO TRUE. DTSBD300 01671 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DTSBD300 01672 DTSBD300 01673 S981B-EXIT. DTSBD300 01674 EXIT. DTSBD300 01675 DTSBD300 01676 S981C-CLOSE. DTSBD300 01677 SET L981-CLOSE-88 TO TRUE. DTSBD300 01678 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DTSBD300 01679 DTSBD300 01680 S981C-EXIT. DTSBD300 01681 EXIT. DTSBD300 01682 DTSBD300 01683 S981Z-WAGE-I. DTSBD300 01684 CALL 'DTSBU981' USING L981-LINK-AREA DTSBD300 01685 WWGH-REC. DTSBD300 01686 S981Z-EXIT. DTSBD300 01687 EXIT. DTSBD300 01688 DTSBD300 01689 S982A-OPEN-READ. DTSBD300 01690 SET L982-OPEN-READ-88 TO TRUE. DTSBD300 01691 PERFORM S982Z-NAME-I THRU S982Z-EXIT. DTSBD300 01692 DTSBD300 01693 S982A-EXIT. DTSBD300 01694 EXIT. DTSBD300 01695 DTSBD300 01696 DTSBD300 01697 S982B-OPEN-UPDATE. DTSBD300 01698 SET L982-OPEN-UPDATE-88 TO TRUE. DTSBD300 01699 PERFORM S982Z-NAME-I THRU S982Z-EXIT. DTSBD300 01700 DTSBD300 01701 S982B-EXIT. DTSBD300 01702 EXIT. DTSBD300 01703 DTSBD300 01704 S982C-CLOSE. DTSBD300 01705 SET L982-CLOSE-88 TO TRUE. DTSBD300 01706 PERFORM S982Z-NAME-I THRU S982Z-EXIT. DTSBD300 01707 DTSBD300 01708 S982C-EXIT. DTSBD300 01709 EXIT. DTSBD300 01710 DTSBD300 01711 S982Z-NAME-I. DTSBD300 01712 CALL 'DTSBU982' USING L982-LINK-AREA DTSBD300 01713 WNAM-REC. DTSBD300 01714 S982Z-EXIT. DTSBD300 01715 EXIT. DTSBD300 01716 S985-OPEN. CL**2 01717 SET L985-OPEN-READ-88 TO TRUE. CL**2 01718 GO TO S985-BAT-IO. CL**2 01719 S985-READ. CL**2 01720 SET L985-READ-88 TO TRUE. CL**2 01721 GO TO S985-BAT-IO. CL**2 01722 CL**2 01723 S985-START-BROWSE. CL**2 01724 SET L985-START-BROWSE-88 TO TRUE. CL**2 01725 GO TO S985-BAT-IO. CL**2 01726 CL**2 01727 S985-READ-NEXT. CL**2 01728 SET L985-READ-NEXT-88 TO TRUE. CL**2 01729 GO TO S985-BAT-IO. CL**2 01730 S985-CLOSE. CL**2 01731 SET L985-CLOSE-88 TO TRUE. CL**2 01732 GO TO S985-BAT-IO. CL**2 01733 CL**2 01734 S985-BAT-IO. CL**2 01735 CALL 'DTSBU985' USING L985-LINK-AREA CL**2 01736 LINK-REC. CL**2 01737 S985-EXIT. CL**2 01738 EXIT. CL**2 01739 CL**2 01740 DTSBD300 01741 S999-ABEND. DTSBD300 01742 DISPLAY ' '. DTSBD300 01743 DTSBD300 01744 DISPLAY '*** DTSBD300 ABENDING'. DTSBD300 01745 DTSBD300 01746 DISPLAY '*** ' DTSBD300 01747 MSG-LONG-TEXT. DTSBD300 01748 DTSBD300 01749 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBD300 01750 S999-EXIT. DTSBD300 01751 EXIT. DTSBD300