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
