1753 lines
139 KiB
COBOL
1753 lines
139 KiB
COBOL
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
|