00001  IDENTIFICATION DIVISION.                                         06/29/02
00002  PROGRAM-ID.             DTSBD370.                                DTSBD370
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV007
00004  DATE-WRITTEN.           JANUARY 1991.                            DTSBD370
00005  DATE-COMPILED.                                                   DTSBD370
00006      SKIP3                                                        DTSBD370
00007 *****                                                             DTSBD370
00008 *                                                                 DTSBD370
00009 *    FUNCTION:  ACCOUNTING TRANSACTION PROCESSING DRIVER.         DTSBD370
00010 *                                                                 DTSBD370
00011 *                                                                 DTSBD370
00012 *    MODIFICATION LOG:                                            DTSBD370
00013 *                                                                 DTSBD370
00014 *    01/25/92  INITIAL DEVELOPMENT.                               DTSBD370
00015 *              WORK ORDER:                      PROGRAMMER: TCL   DTSBD370
00016 *                                                                 DTSBD370
00017 *    12/13/1998  REVIEWED AND MODIFIED FOR DC.                    DTSBD370
00018 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH   DTSBD370
00019 *                                                                 DTSBD370
00020 *    01/28/2002  MODIFIED FOR ANNUAL REPORT (AATX) TRANSACTION    DTSBD370
00021 *                REFERENCE: HOUSEHOLD           PROGRAMMER: GD    DTSBD370
00022 *                                                                 DTSBD370
00023 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBD370
00024 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBD370
00025 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSBD370
00026 *                                                                 DTSBD370
00027 *                                                                 DTSBD370
00028 *  DESCRIPTION:                                                   DTSBD370
00029 *                                                                 DTSBD370
00030 *      DRIVES THE PROCESSING OF ACCOUNTING TRANSACTIONS.          DTSBD370
00031 *                                                                 DTSBD370
00032 *                                                                 DTSBD370
00033 *      MASTER FILE RECORDS READ:                                  DTSBD370
00034 *                                                                 DTSBD370
00035 *        NONE.                                                    DTSBD370
00036 *                                                                 DTSBD370
00037 *                                                                 DTSBD370
00038 *      MASTER FILE RECORDS UPDATED:                               DTSBD370
00039 *                                                                 DTSBD370
00040 *        NONE.                                                    DTSBD370
00041 *                                                                 DTSBD370
00042 *                                                                 DTSBD370
00043 *      REPORT RECORDS WRITTEN:                                    DTSBD370
00044 *                                                                 DTSBD370
00045 *        NONE.                                                    DTSBD370
00046 *                                                                 DTSBD370
00047 *                                                                 DTSBD370
00048 *      MODULES CALLED:                                            DTSBD370
00049 *                                                                 DTSBD370
00050 *        DTSBD371 REPORT TRANSACTION PROCESSING.                  DTSBD370
00051 *        DTSBD372 PAYMENT TRANSACTION PROCESSING.                 DTSBD370
00052 *        DTSBD373 ADJUSTMENT TRANSACTION PROCESSING.              DTSBD370
00053 *        DTSBU549 JOURNALING/BATCH DETAIL LISTING.                DTSBD370
00054 *                                                                 DTSBD370
00055 *****                                                             DTSBD370
00056      SKIP3                                                        DTSBD370
00057  ENVIRONMENT DIVISION.                                            DTSBD370
00058      EJECT                                                        DTSBD370
00059  DATA DIVISION.                                                   DTSBD370
00060      SKIP3                                                        DTSBD370
00061  WORKING-STORAGE SECTION.                                         DTSBD370
000615 77  PAN-VALET PICTURE X(24) VALUE '007DTSBD370  06/29/02'.       DTSBD370
00062      SKIP3                                                        DTSBD370
00063  01  WRK-AREA.                                                    DTSBD370
00064      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +370.DTSBD370
00065      EJECT                                                        DTSBD370
00066  01  L549-LINK-AREA.                                              DTSBD370
00067  ++INCLUDE DTSIL549                                               DTSBD370
00068      EJECT                                                        DTSBD370
00069  01  MSG-TABLE.                                                   DTSBD370
00070      05  MSG1-INVALID-TRN-CD.                                     DTSBD370
00071          10  MSG1-ID         PIC  X(11)  VALUE 'DTSBD370905'.     DTSBD370
00072          10  MSG1-SHORT-TEXT PIC  X(20)  VALUE 'INVALID TRN CD'.  DTSBD370
00073          10  MSG1-LONG-TEXT.                                      DTSBD370
00074              15  FILLER      PIC  X(30)                           DTSBD370
00075                    VALUE 'TRANSACTION FAILED - TRANSACTI'.        DTSBD370
00076              15  FILLER      PIC  X(30)                           DTSBD370
00077                    VALUE 'ON CODE NOT VALID             '.        DTSBD370
00078                                                                   DTSBD370
00079      05  MSG2-CHARGING-ONLY.                                      DTSBD370
00080          10  MSG2-ID         PIC  X(11)  VALUE 'DTSBD370301'.     DTSBD370
00081          10  MSG2-SHORT-TEXT PIC  X(20)  VALUE 'CHARGING ONLY '.  DTSBD370
00082          10  MSG2-LONG-TEXT.                                      DTSBD370
00083              15  FILLER      PIC  X(30)                           DTSBD370
00084                    VALUE 'TRANSACTION FAILED - ACCOUNTIN'.        DTSBD370
00085              15  FILLER      PIC  X(30)                           DTSBD370
00086                    VALUE 'G TRAN FOR CHRG ONLY EMPLOYER '.        DTSBD370
00087                                                                   DTSBD370
00088      05  MSG3-WRITTEN-OFF.                                        DTSBD370
00089          10  MSG3-ID         PIC  X(11)  VALUE 'DTSBD370302'.     DTSBD370
00090          10  MSG3-SHORT-TEXT PIC  X(20)  VALUE 'WRITTEN OFF EMP'. DTSBD370
00091          10  MSG3-LONG-TEXT.                                      DTSBD370
00092              15  FILLER      PIC  X(30)                           DTSBD370
00093                    VALUE 'TRANSACTION FAILED - NOT A VAL'.        DTSBD370
00094              15  FILLER      PIC  X(30)                           DTSBD370
00095                    VALUE 'ID TRAN FOR A WRITTEN OFF EMPL'.        DTSBD370
00096                                                                   DTSBD370
00097      05  MSG4-NEVER-SUBJECT.                                      DTSBD370
00098          10  MSG4-ID         PIC  X(11)  VALUE 'DTSBD370303'.     DTSBD370
00099          10  MSG4-SHORT-TEXT PIC  X(20)  VALUE 'NEVER SUBJ EMP'.  DTSBD370
00100          10  MSG4-LONG-TEXT.                                      DTSBD370
00101              15  FILLER      PIC  X(30)                           DTSBD370
00102                    VALUE 'TRANSACTION FAILED - NOT A VAL'.        DTSBD370
00103              15  FILLER      PIC  X(30)                           DTSBD370
00104                    VALUE 'ID TRAN FOR NEVER SUBJECT EMPL'.        DTSBD370
00105      EJECT                                                        DTSBD370
00106  LINKAGE SECTION.                                                 DTSBD370
00107      SKIP3                                                        DTSBD370
00108  01  LBCM-LINK-AREA.                                              DTSBD370
00109  ++INCLUDE DTSILBCM                                               DTSBD370
00110      EJECT                                                        DTSBD370
00111  01  MPRF-REC.                                                    DTSBD370
00112  ++INCLUDE DTSIMPRF                                               DTSBD370
00113      EJECT                                                        DTSBD370
00114  01  T051-REC.                                                    DTSBD370
00115  ++INCLUDE DTSIT051                                               DTSBD370
00116      SKIP3                                                        DTSBD370
00117      05  ASKL-REC REDEFINES T051-DATA-AREA.                       DTSBD370
00118  ++INCLUDE DTSIASKL                                               DTSBD370
00119      SKIP3                                                        DTSBD370
00120      05  ARPT-REC REDEFINES T051-DATA-AREA.                       DTSBD370
00121  ++INCLUDE DTSIARPT                                               DTSBD370
00122      SKIP3                                                        DTSBD370
00123      05  APAY-REC REDEFINES T051-DATA-AREA.                       DTSBD370
00124  ++INCLUDE DTSIAPAY                                               DTSBD370
00125      SKIP3                                                        DTSBD370
00126      05  AADJ-REC REDEFINES T051-DATA-AREA.                       DTSBD370
00127  ++INCLUDE DTSIAADJ                                               DTSBD370
00128      SKIP3                                                        DTSBD370
00129      05  AATX-REC REDEFINES T051-DATA-AREA.                       DTSBD370
00130  ++INCLUDE DTSIAATX                                               DTSBD370
00131      EJECT                                                        DTSBD370
00132  PROCEDURE DIVISION USING LBCM-LINK-AREA                          DTSBD370
00133                           MPRF-REC                                DTSBD370
00134                           T051-REC.                               DTSBD370
00135                                                                   DTSBD370
00136                                                                   DTSBD370
00137      PERFORM P0000-PROCESS THRU P0000-EXIT.                       DTSBD370
00138                                                                   DTSBD370
00139                                                                   DTSBD370
00140      GOBACK.                                                      DTSBD370
00141      EJECT                                                        DTSBD370
00142  P0000-PROCESS.                                                   DTSBD370
00143      IF ASKL-RPT-88                                               DTSBD370
00144          IF ARPT-NAME-CHECK = LOW-VALUES OR SPACES                DTSBD370
00145              MOVE MPRF-PRIMARY-NAME TO ARPT-NAME-CHECK            DTSBD370
00146          ELSE                                                     DTSBD370
00147              NEXT SENTENCE                                        DTSBD370
00148      ELSE                                                         DTSBD370
00149      IF ASKL-PAY-88                                               DTSBD370
00150          IF APAY-NAME-CHECK = LOW-VALUES OR SPACES                DTSBD370
00151              MOVE MPRF-PRIMARY-NAME TO APAY-NAME-CHECK            DTSBD370
00152          ELSE                                                     DTSBD370
00153              NEXT SENTENCE                                        DTSBD370
00154      ELSE                                                         DTSBD370
00155      IF ASKL-ADJ-88                                               DTSBD370
00156          IF AADJ-NAME-CHECK = LOW-VALUES OR SPACES                DTSBD370
00157              MOVE MPRF-PRIMARY-NAME TO AADJ-NAME-CHECK            DTSBD370
00158          ELSE                                                     DTSBD370
00159              NEXT SENTENCE                                        DTSBD370
00160      ELSE                                                         DTSBD370
00161      IF ASKL-ATX-88                                               DTSBD370
00162          IF AATX-NAME-CHECK = LOW-VALUES OR SPACES                DTSBD370
00163              MOVE MPRF-PRIMARY-NAME TO AATX-NAME-CHECK            DTSBD370
00164          ELSE                                                     DTSBD370
00165              NEXT SENTENCE                                        DTSBD370
00166      ELSE                                                         DTSBD370
00167          NEXT SENTENCE.                                           DTSBD370
00168                                                                   DTSBD370
00169      PERFORM P1000-MJRN-TABLE-INIT THRU P1000-EXIT.               DTSBD370
00170                                                                   DTSBD370
00171      IF MPRF-CLASS-CHG-ONLY-88                                    DTSBD370
00172          SET LBCM-TRN-NOT-OK-88 TO TRUE                           DTSBD370
00173          MOVE MSG2-CHARGING-ONLY TO LBCM-TRN-MSG-AREA             DTSBD370
00174          PERFORM S549-CANCEL-TRAN THRU S549-EXIT                  DTSBD370
00175          GO TO P0000-EXIT.                                        DTSBD370
00176                                                                   DTSBD370
00177      IF MPRF-NOT-WRITTEN-OFF-88                                   DTSBD370
00178          NEXT SENTENCE                                            DTSBD370
00179      ELSE                                                         DTSBD370
00180          IF (ASKL-PAY-88) AND (APAY-PAYMENT-88)                   DTSBD370
00181              NEXT SENTENCE                                        DTSBD370
00182          ELSE                                                     DTSBD370
00183          IF (ASKL-ADJ-88) AND (AADJ-WRITE-OFF-REV-88)             DTSBD370
00184              NEXT SENTENCE                                        DTSBD370
00185          ELSE                                                     DTSBD370
00186              SET LBCM-TRN-NOT-OK-88 TO TRUE                       DTSBD370
00187              MOVE MSG3-WRITTEN-OFF TO LBCM-TRN-MSG-AREA           DTSBD370
00188              PERFORM S549-CANCEL-TRAN THRU S549-EXIT              DTSBD370
00189              GO TO P0000-EXIT.                                    DTSBD370
00190                                                                   DTSBD370
00191      IF MPRF-CLASS-UNK-88                                         DTSBD370
00192          IF ASKL-PAY-88                                           DTSBD370
00193              NEXT SENTENCE                                        DTSBD370
00194          ELSE                                                     DTSBD370
00195              SET LBCM-TRN-NOT-OK-88 TO TRUE                       DTSBD370
00196              MOVE MSG4-NEVER-SUBJECT TO LBCM-TRN-MSG-AREA         DTSBD370
00197              PERFORM S549-CANCEL-TRAN THRU S549-EXIT              DTSBD370
00198              GO TO P0000-EXIT.                                    DTSBD370
00199                                                                   DTSBD370
00200      IF ASKL-RPT-88                                               DTSBD370
00201          CALL 'DTSBD371' USING LBCM-LINK-AREA                     DTSBD370
00202                                MPRF-REC                           DTSBD370
00203                                ARPT-REC                           DTSBD370
00204      ELSE                                                         DTSBD370
00205      IF ASKL-PAY-88                                               DTSBD370
00206          CALL 'DTSBD372' USING LBCM-LINK-AREA                     DTSBD370
00207                                MPRF-REC                           DTSBD370
00208                                APAY-REC                           DTSBD370
00209      ELSE                                                         DTSBD370
00210      IF ASKL-ADJ-88                                               DTSBD370
00211          CALL 'DTSBD373' USING LBCM-LINK-AREA                     DTSBD370
00212                                MPRF-REC                           DTSBD370
00213                                AADJ-REC                           DTSBD370
00214      ELSE                                                         DTSBD370
00215      IF ASKL-ATX-88                                               DTSBD370
00216          CALL 'DTSBD374' USING LBCM-LINK-AREA                     DTSBD370
00217                                MPRF-REC                           DTSBD370
00218                                AATX-REC                           DTSBD370
00219          GO TO P0000-EXIT                                         DTSBD370
00220      ELSE                                                         DTSBD370
00221          SET LBCM-TRN-NOT-OK-88 TO TRUE                           DTSBD370
00222          MOVE MSG1-INVALID-TRN-CD TO LBCM-TRN-MSG-AREA            DTSBD370
00223          PERFORM S549-CANCEL-TRAN THRU S549-EXIT                  DTSBD370
00224          GO TO P0000-EXIT.                                        DTSBD370
00225                                                                   DTSBD370
00226 *&   IF ASKL-ATX-88                                               DTSBD370
00227 *       NEXT SENTENCE                                             DTSBD370
00228 *    ELSE                                                         DTSBD370
00229      IF LBCM-TRN-OK-88                                            DTSBD370
00230          PERFORM S549-TERM-TRAN-PRIM THRU S549-EXIT               DTSBD370
00231      ELSE                                                         DTSBD370
00232          PERFORM S549-CANCEL-TRAN THRU S549-EXIT.                 DTSBD370
00233  P0000-EXIT.                                                      DTSBD370
00234      EXIT.                                                        DTSBD370
00235      EJECT                                                        DTSBD370
00236 ***************************************************************** DTSBD370
00237 *    NOTE: FOR ANNUAL REPORT TRANSACTIONS (DTSIAATX), THE         DTSBD370
00238 *          INITIALIZATION OF THE JOURNAL RECORD UTILITY           DTSBD370
00239 *          (DTSBU549) TAKES PLACE IN DTSBD374 RATHER THAN HERE.   DTSBD370
00240 *          DTSBD374 PROCESSES EACH QUARTER COVERED BY THE         DTSBD370
00241 *          ANNUAL REPORT SEPARATELY, AND HANDLES ALL CALLS TO     DTSBD370
00242 *          DTSBU549.                                              DTSBD370
00243 ***************************************************************** DTSBD370
00244  P1000-MJRN-TABLE-INIT.                                           DTSBD370
00245      MOVE ASKL-DOC-NO TO L549-TRN-DOC-NO.                         DTSBD370
00246                                                                   DTSBD370
00247      MOVE LBCM-TRACE-IND TO L549-INIT-TRACE-IND.                  DTSBD370
00248                                                                   DTSBD370
00249      MOVE LBCM-CURR-RUN-DATE TO L549-INIT-CURR-RUN-DATE.          DTSBD370
00250                                                                   DTSBD370
00251      MOVE LBCM-EMP-ABSTIME TO L549-INIT-ABSTIME.                  DTSBD370
00252                                                                   DTSBD370
00253      MOVE MPRF-EMP-NO TO L549-INIT-EMP-NO.                        DTSBD370
00254                                                                   DTSBD370
00255      MOVE MPRF-EMP-CLASS TO L549-INIT-EMP-CLASS.                  DTSBD370
00256                                                                   DTSBD370
00257      MOVE MPRF-ELIGIBLE-CD TO L549-INIT-ELIGIBLE-CD.              DTSBD370
00258                                                                   DTSBD370
00259      IF ASKL-RPT-88                                               DTSBD370
00260          MOVE ARPT-REC-TYPE TO L549-INIT-REC-TYPE                 DTSBD370
00261          MOVE ARPT-RPT-TYPE TO L549-INIT-TRANS-TYPE               DTSBD370
00262          MOVE ARPT-RECEIVED-DATE TO L549-INIT-RECEIVED-DATE       DTSBD370
00263          MOVE ARPT-DEPOSIT-DATE TO L549-INIT-DEPOSIT-DATE         DTSBD370
00264          MOVE ARPT-REMIT-AMT TO L549-INIT-REMIT-AMT               DTSBD370
00265          IF ARPT-WAIVE-BOTH-YES-88                                DTSBD370
00266              MOVE ARPT-WAIVE-BOTH-IND TO ARPT-WAIVE-INT-IND       DTSBD370
00267                                          ARPT-WAIVE-LATE-PEN-IND  DTSBD370
00268              SET ARPT-WAIVE-BOTH-NO-88 TO TRUE                    DTSBD370
00269          END-IF                                                   DTSBD370
00270          MOVE ARPT-WAIVE-INT-IND                                  DTSBD370
00271            TO L549-INIT-WAIVE-INT-IND                             DTSBD370
00272          MOVE ARPT-WAIVE-LATE-PEN-IND                             DTSBD370
00273            TO L549-INIT-WAIVE-LATE-PEN-IND                        DTSBD370
00274          MOVE ARPT-YRQ TO L549-INIT-APPLIC-YRQ                    DTSBD370
00275          MOVE SPACE TO L549-INIT-APPLIC-ACCT-IND                  DTSBD370
00276          MOVE +0 TO L549-INIT-APPLIC-BATCH-NO                     DTSBD370
00277                     L549-INIT-APPLIC-ITEM-NO                      DTSBD370
00278          MOVE ARPT-RESPONSIBLE-ACTIVITY                           DTSBD370
00279            TO L549-INIT-RESP-ACTIVITY                             DTSBD370
00280          MOVE ARPT-RESPONSIBLE-OP-ID                              DTSBD370
00281            TO L549-INIT-RESP-OP-ID                                DTSBD370
00282      ELSE                                                         DTSBD370
00283      IF ASKL-ATX-88                                               DTSBD370
00284          GO TO P1000-EXIT                                         DTSBD370
00285      ELSE                                                         DTSBD370
00286      IF ASKL-PAY-88                                               DTSBD370
00287          MOVE APAY-REC-TYPE TO L549-INIT-REC-TYPE                 DTSBD370
00288          MOVE APAY-PAY-TYPE TO L549-INIT-TRANS-TYPE               DTSBD370
00289          MOVE APAY-RECEIVED-DATE TO L549-INIT-RECEIVED-DATE       DTSBD370
00290          MOVE APAY-DEPOSIT-DATE TO L549-INIT-DEPOSIT-DATE         DTSBD370
00291          MOVE APAY-REMIT-AMT TO L549-INIT-REMIT-AMT               DTSBD370
00292 *********IF APAY-WAIVE-BOTH-88                                    DTSBD370
00293 *************MOVE APAY-WAIVE-BOTH-IND TO APAY-WAIVE-INT-IND       DTSBD370
00294 *****************************************APAY-WAIVE-LATE-PEN-IND  DTSBD370
00295 *************SET APAY-NOT-WAIVE-BOTH-88 TO TRUE                   DTSBD370
00296 *********END-IF                                                   DTSBD370
00297          MOVE APAY-WAIVE-INT-IND                                  DTSBD370
00298            TO L549-INIT-WAIVE-INT-IND                             DTSBD370
00299          MOVE APAY-WAIVE-LATE-PEN-IND                             DTSBD370
00300            TO L549-INIT-WAIVE-LATE-PEN-IND                        DTSBD370
00301          MOVE APAY-APPLIC-YRQ TO L549-INIT-APPLIC-YRQ             DTSBD370
00302          MOVE APAY-APPLIC-IND TO L549-INIT-APPLIC-ACCT-IND        DTSBD370
00303          MOVE APAY-APPLIC-DOC-NO TO L549-INIT-APPLIC-DOC-NO       DTSBD370
00304          MOVE APAY-RESPONSIBLE-ACTIVITY                           DTSBD370
00305            TO L549-INIT-RESP-ACTIVITY                             DTSBD370
00306          MOVE APAY-RESPONSIBLE-OP-ID                              DTSBD370
00307            TO L549-INIT-RESP-OP-ID                                DTSBD370
00308      ELSE                                                         DTSBD370
00309      IF ASKL-ADJ-88                                               DTSBD370
00310          MOVE AADJ-REC-TYPE TO L549-INIT-REC-TYPE                 DTSBD370
00311          MOVE AADJ-ADJ-TYPE TO L549-INIT-TRANS-TYPE               DTSBD370
00312          MOVE AADJ-RECEIVED-DATE TO L549-INIT-RECEIVED-DATE       DTSBD370
00313          MOVE AADJ-DEPOSIT-DATE TO L549-INIT-DEPOSIT-DATE         DTSBD370
00314          MOVE +0 TO L549-INIT-REMIT-AMT                           DTSBD370
00315          MOVE SPACE TO L549-INIT-WAIVE-INT-IND                    DTSBD370
00316                        L549-INIT-WAIVE-LATE-PEN-IND               DTSBD370
00317          MOVE AADJ-APPLIC-YRQ TO L549-INIT-APPLIC-YRQ             DTSBD370
00318          MOVE AADJ-APPLIC-IND TO L549-INIT-APPLIC-ACCT-IND        DTSBD370
00319          MOVE AADJ-APPLIC-DOC-NO TO L549-INIT-APPLIC-DOC-NO       DTSBD370
00320          MOVE AADJ-RESPONSIBLE-ACTIVITY                           DTSBD370
00321            TO L549-INIT-RESP-ACTIVITY                             DTSBD370
00322          MOVE AADJ-RESPONSIBLE-OP-ID                              DTSBD370
00323            TO L549-INIT-RESP-OP-ID                                DTSBD370
00324      ELSE                                                         DTSBD370
00325          MOVE SPACE TO L549-INIT-REC-TYPE                         DTSBD370
00326          MOVE SPACE TO L549-INIT-TRANS-TYPE                       DTSBD370
00327          MOVE +0 TO L549-INIT-RECEIVED-DATE                       DTSBD370
00328          MOVE +0 TO L549-INIT-DEPOSIT-DATE                        DTSBD370
00329          MOVE +0 TO L549-INIT-REMIT-AMT                           DTSBD370
00330          MOVE SPACE TO L549-INIT-WAIVE-INT-IND                    DTSBD370
00331                        L549-INIT-WAIVE-LATE-PEN-IND               DTSBD370
00332          MOVE +0 TO L549-INIT-APPLIC-YRQ                          DTSBD370
00333          MOVE SPACE TO L549-INIT-APPLIC-ACCT-IND                  DTSBD370
00334          MOVE +0 TO L549-INIT-APPLIC-DOC-NO                       DTSBD370
00335                     L549-INIT-APPLIC-ITEM-NO                      DTSBD370
00336          MOVE SPACE TO L549-INIT-RESP-ACTIVITY                    DTSBD370
00337                        L549-INIT-RESP-OP-ID.                      DTSBD370
00338                                                                   DTSBD370
00339      PERFORM S549-INIT-TRAN THRU S549-EXIT.                       DTSBD370
00340  P1000-EXIT.                                                      DTSBD370
00341      EXIT.                                                        DTSBD370
00342      EJECT                                                        DTSBD370
00343  S549-INIT-TRAN.                                                  DTSBD370
00344      SET L549-INIT-TRAN-88 TO TRUE.                               DTSBD370
00345      GO TO S549-MJRN-TABLE.                                       DTSBD370
00346                                                                   DTSBD370
00347  S549-CANCEL-TRAN.                                                DTSBD370
00348      SET L549-CANCEL-TRAN-88 TO TRUE.                             DTSBD370
00349      GO TO S549-MJRN-TABLE.                                       DTSBD370
00350                                                                   DTSBD370
00351  S549-TERM-TRAN-PRIM.                                             DTSBD370
00352      SET L549-TERM-TRAN-PRIM-88 TO TRUE.                          DTSBD370
00353      GO TO S549-MJRN-TABLE.                                       DTSBD370
00354                                                                   DTSBD370
00355  S549-MJRN-TABLE.                                                 DTSBD370
00356      CALL 'DTSBU549' USING L549-LINK-AREA.                        DTSBD370
00357  S549-EXIT.                                                       DTSBD370
00358      EXIT.                                                        DTSBD370
00359      SKIP3                                                        DTSBD370
00360  S999-ABEND.                                                      DTSBD370
00361      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBD370
00362  S999-EXIT.                                                       DTSBD370
00363      EXIT.                                                        DTSBD370
