395 lines
31 KiB
COBOL
395 lines
31 KiB
COBOL
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
|