00001 IDENTIFICATION DIVISION. 12/17/04 00002 PROGRAM-ID. DTSBU501. DTSBU501 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV011 00004 DATE-WRITTEN. JANUARY 1991. DTSBU501 00005 DATE-COMPILED. DTSBU501 00006 DTSBU501 00007 DTSBU501 00008 ***** DTSBU501 00009 * DTSBU501 00010 * FUNCTION: INTERNALLY GENERATED ACCOUNTING TRANSACTION DTSBU501 00011 * DRIVER. DTSBU501 00012 * DTSBU501 00013 * DTSBU501 00014 * MODIFICATION LOG: DTSBU501 00015 * DTSBU501 00016 * 01/25/92 INITIAL DEVELOPMENT. DTSBU501 00017 * WORK ORDER: PROGRAMMER: TCL DTSBU501 00018 * DTSBU501 00019 * 06/22/95 PROCESS CREDIT TOLERANCE ON THE EMPLOYER LEVEL. DTSBU501 00020 * WORK ORDER: CR076 PROGRAMMER: EHH DTSBU501 00021 * DTSBU501 00022 * 12/10/1998 REVIEWED AND MODIFIED FOR DC. DTSBU501 00023 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBU501 00024 * DTSBU501 00025 * 09/26/2002 MODIFIED TO RECOGNIZE ANNUAL REPORT TRANSACTIONS DTSBU501 00026 * (AATX) DTSBU501 00027 * REFERENCE: HOUSEHOLD PROGRAMMER: GD DTSBU501 00028 * DTSBU501 00029 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU501 00030 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU501 00031 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBU501 00032 * DTSBU501 00033 * DTSBU501 00034 * DESCRIPTION: DTSBU501 00035 * DTSBU501 00036 * SERVES AS A TRANSFER POINT IN THE PROCESSING OF INTERNALLY DTSBU501 00037 * GENERATED ACCOUNTING TRANSACTIONS. DTSBU501 00038 * DTSBU501 00039 * THIS MODULE ASSIGNS A "BATCH" NUMBER TO THE INTERNALLY DTSBU501 00040 * GENERATED ACCOUNTING TRANSACTION. IF THIS PROCESS FAILS DTSBU501 00041 * (BECAUSE LBCM-LAST-USED-ITEM-NO = 999), THEN ABEND DTSBU501 00042 * PROCESSING. DTSBU501 00043 * DTSBU501 00044 * DTSBU501 00045 * MASTER FILE RECORDS READ: DTSBU501 00046 * DTSBU501 00047 * NONE. DTSBU501 00048 * DTSBU501 00049 * DTSBU501 00050 * MASTER FILE RECORDS UPDATED: DTSBU501 00051 * DTSBU501 00052 * NONE. DTSBU501 00053 * DTSBU501 00054 * DTSBU501 00055 * ACCOUNTING TRANSACTION FILE RECORDS UPDATED: DTSBU501 00056 * DTSBU501 00057 * ARPT (WRITE) DTSBU501 00058 * APAY (WRITE) DTSBU501 00059 * AADJ (WRITE) DTSBU501 00060 * AATX (WRITE) DTSBU501 00061 * DTSBU501 00062 * DTSBU501 00063 * REPORT RECORDS WRITTEN: DTSBU501 00064 * DTSBU501 00065 * R302 ACCOUNTING DETAIL. DTSBU501 00066 * DTSBU501 00067 * DTSBU501 00068 * MODULES CALLED: DTSBU501 00069 * DTSBU501 00070 * DTSBD370 ACCOUNTING TRANSACTION DRIVER. DTSBU501 00071 * DTSBU923 ACCOUNTING TRANSACTION FILE I/O. DTSBU501 00072 * DTSBU946 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 1. DTSBU501 00073 * DTSBU501 00074 * DTSBU501 00075 ***** DTSBU501 00076 SKIP3 DTSBU501 00077 ENVIRONMENT DIVISION. DTSBU501 00078 EJECT DTSBU501 00079 DATA DIVISION. DTSBU501 00080 SKIP3 DTSBU501 00081 WORKING-STORAGE SECTION. DTSBU501 000815 77 PAN-VALET PICTURE X(24) VALUE '011DTSBU501 12/17/04'. DTSBU501 00082 SKIP3 DTSBU501 00083 01 WRK-AREA. DTSBU501 00084 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +501.DTSBU501 00085 DTSBU501 00086 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBU501'.DTSBU501 00087 DTSBU501 00088 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBU501 00089 DTSBU501 00090 05 WRK-NULL-DOC-NO. DTSBU501 00091 10 FILLER PIC S9(05) COMP-3 VALUE +0. DTSBU501 00092 10 FILLER PIC S9(03) COMP-3 VALUE +0. DTSBU501 00093 DTSBU501 00094 05 HOLD-LBCM-TRN-AREA PIC X(256). DTSBU501 00095 EJECT DTSBU501 00096 01 MSG-TABLE. DTSBU501 00097 05 MSG1-INTERNAL-TRAN-FAILED. DTSBU501 00098 10 MSG1-MOD-ID PIC X(11) VALUE 'DTSBD501306'. DTSBU501 00099 10 FILLER REDEFINES MSG1-MOD-ID. DTSBU501 00100 15 MSG1-MOD-NAME PIC X(08). DTSBU501 00101 15 MSG1-ID PIC X(03). DTSBU501 00102 10 MSG1-SHORT-TEXT PIC X(20) VALUE 'INT TRAN FAILE'. DTSBU501 00103 10 MSG1-LONG-TEXT. DTSBU501 00104 15 FILLER PIC X(30) DTSBU501 00105 VALUE 'TRANSACTION FAILED - INTERNALL'. DTSBU501 00106 15 FILLER PIC X(30) DTSBU501 00107 VALUE 'Y GENERATED ACCT TRAN FAILED: '. DTSBU501 00108 15 MSG1-BATCH-NO PIC 9(05). DTSBU501 00109 15 FILLER PIC X(01) VALUE SPACES.DTSBU501 00110 15 MSG1-ITEM-NO PIC 9(03). DTSBU501 00111 EJECT DTSBU501 00112 01 T051-REC. DTSBU501 00113 ++INCLUDE DTSIT051 DTSBU501 00114 EJECT DTSBU501 00115 01 RSKL-REC. DTSBU501 00116 ++INCLUDE DTSIRSK1 DTSBU501 00117 SKIP3 DTSBU501 00118 01 R302-REC. DTSBU501 00119 ++INCLUDE DTSIR302 DTSBU501 00120 SKIP3 DTSBU501 00121 01 R907-REC. DTSBU501 00122 ++INCLUDE DTSIR907 DTSBU501 00123 EJECT DTSBU501 00124 01 L923-LINK-AREA. DTSBU501 00125 ++INCLUDE DTSIL923 DTSBU501 00126 EJECT DTSBU501 00127 LINKAGE SECTION. DTSBU501 00128 SKIP3 DTSBU501 00129 01 L501-LINK-AREA. DTSBU501 00130 ++INCLUDE DTSIL501 DTSBU501 00131 EJECT DTSBU501 00132 01 LBCM-LINK-AREA. DTSBU501 00133 ++INCLUDE DTSILBCM DTSBU501 00134 EJECT DTSBU501 00135 01 MPRF-REC. DTSBU501 00136 ++INCLUDE DTSIMPRF DTSBU501 00137 EJECT DTSBU501 00138 01 ASKL-REC. DTSBU501 00139 ++INCLUDE DTSIASKL DTSBU501 00140 SKIP3 DTSBU501 00141 01 ARPT-REC REDEFINES ASKL-REC. DTSBU501 00142 ++INCLUDE DTSIARPT DTSBU501 00143 SKIP3 DTSBU501 00144 01 APAY-REC REDEFINES ASKL-REC. DTSBU501 00145 ++INCLUDE DTSIAPAY DTSBU501 00146 SKIP3 DTSBU501 00147 01 AADJ-REC REDEFINES ASKL-REC. DTSBU501 00148 ++INCLUDE DTSIAADJ DTSBU501 00149 DTSBU501 00150 01 AATX-REC REDEFINES ASKL-REC. DTSBU501 00151 ++INCLUDE DTSIAATX DTSBU501 00152 EJECT DTSBU501 00153 PROCEDURE DIVISION USING L501-LINK-AREA DTSBU501 00154 LBCM-LINK-AREA DTSBU501 00155 MPRF-REC DTSBU501 00156 ASKL-REC. DTSBU501 00157 DTSBU501 00158 DTSBU501 00159 IF FIRST-TIME-IND = 'Y' DTSBU501 00160 PERFORM I0000-INITIATE THRU I0000-EXIT DTSBU501 00161 MOVE 'N' TO FIRST-TIME-IND. DTSBU501 00162 DTSBU501 00163 DTSBU501 00164 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBU501 00165 DTSBU501 00166 DTSBU501 00167 GOBACK. DTSBU501 00168 EJECT DTSBU501 00169 I0000-INITIATE. DTSBU501 00170 MOVE LBCM-TRACE-IND TO L923-TRACE-IND. DTSBU501 00171 DTSBU501 00172 MOVE WRK-MOD-NAME TO L923-MOD-NAME. DTSBU501 00173 DTSBU501 00174 MOVE LENGTH OF R302-REC TO R302-LENGTH. DTSBU501 00175 DTSBU501 00176 MOVE LENGTH OF R907-REC TO R907-LENGTH. DTSBU501 00177 I0000-EXIT. DTSBU501 00178 EXIT. DTSBU501 00179 EJECT DTSBU501 00180 P0000-PROCESS. DTSBU501 00181 PERFORM P1000-CONSTRUCT-T051 THRU P1000-EXIT. DTSBU501 00182 DTSBU501 00183 CALL 'DTSBD370' USING LBCM-LINK-AREA DTSBU501 00184 MPRF-REC DTSBU501 00185 T051-REC. DTSBU501 00186 DTSBU501 00187 IF LBCM-TRN-NOT-OK-88 DTSBU501 00188 PERFORM P2000-INT-TRAN-ERR THRU P2000-EXIT DTSBU501 00189 ELSE DTSBU501 00190 PERFORM P3000-INT-TRAN-OK THRU P3000-EXIT. DTSBU501 00191 DTSBU501 00192 PERFORM P4000-RESTORE-LBCM-TRN-AREA THRU P4000-EXIT. DTSBU501 00193 P0000-EXIT. DTSBU501 00194 EXIT. DTSBU501 00195 EJECT DTSBU501 00196 P1000-CONSTRUCT-T051. DTSBU501 00197 IF NOT L501-EXT-TO-ACCT-88 DTSBU501 00198 PERFORM S999-ABEND THRU S999-EXIT. DTSBU501 00199 DTSBU501 00200 DTSBU501 00201 MOVE MPRF-EMP-NO TO T051-EMP-NO. DTSBU501 00202 DTSBU501 00203 MOVE L501-ORIGIN TO T051-ORIGIN. DTSBU501 00204 DTSBU501 00205 MOVE LBCM-SYS-DATE TO T051-SYS-DATE. DTSBU501 00206 DTSBU501 00207 MOVE LBCM-SYS-TIME TO T051-SYS-TIME. DTSBU501 00208 DTSBU501 00209 MOVE LBCM-LAST-BATCH-NO TO ASKL-BATCH-NO. DTSBU501 00210 DTSBU501 00211 IF LBCM-LAST-USED-ITEM-NO NOT < 999 DTSBU501 00212 PERFORM S999-ABEND THRU S999-EXIT. DTSBU501 00213 DTSBU501 00214 ADD +1 TO LBCM-LAST-USED-ITEM-NO. DTSBU501 00215 DTSBU501 00216 MOVE LBCM-LAST-USED-ITEM-NO TO ASKL-ITEM-NO. DTSBU501 00217 DTSBU501 00218 MOVE ASKL-REC TO T051-DATA-AREA. DTSBU501 00219 DTSBU501 00220 DTSBU501 00221 MOVE LBCM-TRN-AREA TO HOLD-LBCM-TRN-AREA. DTSBU501 00222 DTSBU501 00223 DTSBU501 00224 MOVE L501-OPTION TO LBCM-TRN-ORIGIN-IND. DTSBU501 00225 DTSBU501 00226 MOVE ASKL-DOC-NO TO LBCM-TRN-DOC-NO. DTSBU501 00227 DTSBU501 00228 SET LBCM-TRN-OK-88 TO TRUE. DTSBU501 00229 DTSBU501 00230 MOVE SPACE TO LBCM-TRN-MSG-AREA. DTSBU501 00231 DTSBU501 00232 MOVE +0 TO LBCM-TRN-INTERNAL-OK-CNT DTSBU501 00233 LBCM-TRN-INTERNAL-FAILED-CNT. DTSBU501 00234 P1000-EXIT. DTSBU501 00235 EXIT. DTSBU501 00236 EJECT DTSBU501 00237 P2000-INT-TRAN-ERR. DTSBU501 00238 MOVE MSG1-ID TO R907-MSG-ID. DTSBU501 00239 DTSBU501 00240 MOVE MPRF-EMP-NO TO R907-EMP-NO. DTSBU501 00241 DTSBU501 00242 MOVE ASKL-BATCH-NO TO MSG1-BATCH-NO. DTSBU501 00243 DTSBU501 00244 MOVE ASKL-ITEM-NO TO MSG1-ITEM-NO. DTSBU501 00245 DTSBU501 00246 MOVE MSG1-LONG-TEXT TO R907-MSG-TEXT. DTSBU501 00247 DTSBU501 00248 MOVE MSG1-MOD-NAME TO R907-MODULE-NAME. DTSBU501 00249 DTSBU501 00250 MOVE R907-REC TO RSKL-REC. DTSBU501 00251 DTSBU501 00252 PERFORM S946-RPT-O THRU S946-EXIT. DTSBU501 00253 DTSBU501 00254 DTSBU501 00255 IF ASKL-RPT-88 DTSBU501 00256 SET ARPT-PASSED-FULL-EDITS-NO-88 TO TRUE DTSBU501 00257 ELSE DTSBU501 00258 IF ASKL-ATX-88 DTSBU501 00259 SET AATX-PASSED-FULL-EDITS-NO-88 TO TRUE. DTSBU501 00260 DTSBU501 00261 PERFORM S923-WRITE THRU S923-EXIT. DTSBU501 00262 DTSBU501 00263 DTSBU501 00264 MOVE ASKL-BATCH-NO TO R302-BATCH-NO. DTSBU501 00265 DTSBU501 00266 MOVE ASKL-ITEM-NO TO R302-ITEM-NO. DTSBU501 00267 DTSBU501 00268 MOVE MPRF-EMP-NO TO R302-EMP-NO. DTSBU501 00269 DTSBU501 00270 SET R302-TRAN-DATA-88 TO TRUE. DTSBU501 00271 DTSBU501 00272 MOVE +0 TO R302-SORT-YRQ DTSBU501 00273 R302-SORT-ACCT-SEQ. DTSBU501 00274 DTSBU501 00275 MOVE SPACE TO R302-SORT-ACCT-IND. DTSBU501 00276 DTSBU501 00277 MOVE LBCM-CURR-RUN-DATE TO R302-CURR-RUN-DATE. DTSBU501 00278 DTSBU501 00279 MOVE ASKL-REC-TYPE TO R302-ACCT-REC-TYPE. DTSBU501 00280 DTSBU501 00281 IF ASKL-RPT-88 DTSBU501 00282 MOVE ARPT-DEPOSIT-DATE TO R302-DEPOSIT-DATE DTSBU501 00283 MOVE ARPT-RECEIVED-DATE TO R302-RECEIVED-DATE DTSBU501 00284 MOVE ARPT-RPT-TYPE TO R302-TRANS-TYPE DTSBU501 00285 MOVE ARPT-REMIT-AMT TO R302-REMIT-AMT DTSBU501 00286 ELSE DTSBU501 00287 IF ASKL-PAY-88 DTSBU501 00288 MOVE APAY-DEPOSIT-DATE TO R302-DEPOSIT-DATE DTSBU501 00289 MOVE APAY-RECEIVED-DATE TO R302-RECEIVED-DATE DTSBU501 00290 MOVE APAY-PAY-TYPE TO R302-TRANS-TYPE DTSBU501 00291 MOVE APAY-REMIT-AMT TO R302-REMIT-AMT DTSBU501 00292 ELSE DTSBU501 00293 IF ASKL-ADJ-88 DTSBU501 00294 MOVE AADJ-DEPOSIT-DATE TO R302-DEPOSIT-DATE DTSBU501 00295 MOVE AADJ-RECEIVED-DATE TO R302-RECEIVED-DATE DTSBU501 00296 MOVE AADJ-ADJ-TYPE TO R302-TRANS-TYPE DTSBU501 00297 MOVE +0 TO R302-REMIT-AMT DTSBU501 00298 ELSE DTSBU501 00299 IF ASKL-ATX-88 DTSBU501 00300 MOVE AATX-DEPOSIT-DATE TO R302-DEPOSIT-DATE DTSBU501 00301 MOVE AATX-RECEIVED-DATE TO R302-RECEIVED-DATE DTSBU501 00302 MOVE AATX-RPT-TYPE TO R302-TRANS-TYPE DTSBU501 00303 MOVE AATX-REMIT-AMT TO R302-REMIT-AMT DTSBU501 00304 ELSE DTSBU501 00305 MOVE LBCM-DEPOSIT-DATE TO R302-DEPOSIT-DATE DTSBU501 00306 MOVE LBCM-RECEIVED-DATE TO R302-RECEIVED-DATE DTSBU501 00307 MOVE SPACES TO R302-TRANS-TYPE DTSBU501 00308 MOVE +0 TO R302-REMIT-AMT. DTSBU501 00309 DTSBU501 00310 MOVE +0 TO R302-APPLIC-YRQ. DTSBU501 00311 DTSBU501 00312 MOVE SPACE TO R302-APPLIC-ACCT-IND. DTSBU501 00313 DTSBU501 00314 MOVE +0 TO R302-APPLIC-BATCH-NO DTSBU501 00315 R302-APPLIC-ITEM-NO. DTSBU501 00316 DTSBU501 00317 MOVE SPACE TO R302-WAIVE-INT-IND DTSBU501 00318 R302-WAIVE-LATE-PEN-IND. DTSBU501 00319 DTSBU501 00320 MOVE +0 TO R302-TOT-WAGE-CHNG DTSBU501 00321 R302-TAX-WAGE-CHNG. DTSBU501 00322 DTSBU501 00323 SET R302-NOT-OK-88 TO TRUE. DTSBU501 00324 DTSBU501 00325 MOVE LBCM-TRN-MSG-ID TO R302-ERROR-MSG-ID. DTSBU501 00326 DTSBU501 00327 MOVE LBCM-TRN-MSG-LONG TO R302-ERROR-MSG-TEXT. DTSBU501 00328 DTSBU501 00329 MOVE LBCM-TRN-MSG-MOD-NAME TO R302-ERROR-MOD-NAME. DTSBU501 00330 DTSBU501 00331 MOVE R302-REC TO RSKL-REC. DTSBU501 00332 DTSBU501 00333 PERFORM S946-RPT-O THRU S946-EXIT. DTSBU501 00334 P2000-EXIT. DTSBU501 00335 EXIT. DTSBU501 00336 EJECT DTSBU501 00337 P3000-INT-TRAN-OK. DTSBU501 00338 IF (MPRF-TOT-CREDIT-AMT > +0) DTSBU501 00339 AND DTSBU501 00340 (MPRF-TOT-CREDIT-AMT <= LBCM-CR-TOL-MAX) DTSBU501 00341 AND DTSBU501 00342 (LBCM-EMP-CR-TOL-DOC-NO = WRK-NULL-DOC-NO) DTSBU501 00343 MOVE LBCM-TRN-DOC-NO TO LBCM-EMP-CR-TOL-DOC-NO. DTSBU501 00344 DTSBU501 00345 IF ASKL-RPT-88 DTSBU501 00346 MOVE LBCM-CURR-RUN-DATE TO ARPT-PROCESSED-DATE DTSBU501 00347 ELSE DTSBU501 00348 IF ASKL-PAY-88 DTSBU501 00349 MOVE LBCM-CURR-RUN-DATE TO APAY-PROCESSED-DATE DTSBU501 00350 ELSE DTSBU501 00351 IF ASKL-ADJ-88 DTSBU501 00352 MOVE LBCM-CURR-RUN-DATE TO AADJ-PROCESSED-DATE DTSBU501 00353 ELSE DTSBU501 00354 IF ASKL-ATX-88 DTSBU501 00355 MOVE LBCM-CURR-RUN-DATE TO AATX-PROCESSED-DATE DTSBU501 00356 ELSE DTSBU501 00357 PERFORM S999-ABEND THRU S999-EXIT. DTSBU501 00358 DTSBU501 00359 PERFORM S923-WRITE THRU S923-EXIT. DTSBU501 00360 P3000-EXIT. DTSBU501 00361 EXIT. DTSBU501 00362 EJECT DTSBU501 00363 P4000-RESTORE-LBCM-TRN-AREA. DTSBU501 00364 MOVE LBCM-TRN-RESULT-IND TO L501-TRN-RESULT-IND. DTSBU501 00365 DTSBU501 00366 MOVE HOLD-LBCM-TRN-AREA TO LBCM-TRN-AREA. DTSBU501 00367 DTSBU501 00368 IF L501-TRN-OK-88 DTSBU501 00369 ADD +1 TO LBCM-TRN-INTERNAL-OK-CNT DTSBU501 00370 ELSE DTSBU501 00371 ADD +1 TO LBCM-TRN-INTERNAL-FAILED-CNT. DTSBU501 00372 P4000-EXIT. DTSBU501 00373 EXIT. DTSBU501 00374 EJECT DTSBU501 00375 S923-WRITE. DTSBU501 00376 SET L923-WRITE-88 TO TRUE. DTSBU501 00377 GO TO S923-ATC-IO. DTSBU501 00378 DTSBU501 00379 S923-ATC-IO. DTSBU501 00380 CALL 'DTSBU923' USING L923-LINK-AREA DTSBU501 00381 ASKL-REC. DTSBU501 00382 S923-EXIT. DTSBU501 00383 EXIT. DTSBU501 00384 SKIP3 DTSBU501 00385 S946-RPT-O. DTSBU501 00386 CALL 'DTSBU946' USING RSKL-REC. DTSBU501 00387 S946-EXIT. DTSBU501 00388 EXIT. DTSBU501 00389 SKIP3 DTSBU501 00390 S999-ABEND. DTSBU501 00391 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBU501 00392 S999-EXIT. DTSBU501 00393 EXIT. DTSBU501