      $SET DB2
       *>
       *> Micro Focus one-phase commit DB2 switch module.
       *>
       *> (C) Copyright 2007 Micro Focus (IP) Limited
       *> All Rights Reserved.
       *> 

       *> As indicated below -- search for CUSTOMIZE -- it is possible to
       *> only pass the DSN parameter in from Enterprise Server, and
       *> define the USRPASS parameters programmatically from this
       *> program.

       IDENTIFICATION DIVISION.
       PROGRAM-ID. ESDB2OPC.
       ENVIRONMENT DIVISION.

       DATA DIVISION.

       WORKING-STORAGE SECTION.

       *> Return codes for XA calls

       01 ws-return-flags.
          03 ws-open-rc                    PIC S9(9) COMP-5 VALUE 0.
          03 ws-close-rc                   PIC S9(9) COMP-5 VALUE 0.
          03 ws-start-rc                   PIC S9(9) COMP-5 VALUE 0.
          03 ws-end-rc                     PIC S9(9) COMP-5 VALUE 0.
          03 ws-rollback-rc                PIC S9(9) COMP-5 VALUE 0.
          03 ws-prepare-rc                 PIC S9(9) COMP-5 VALUE 0.
          03 ws-commit-rc                  PIC S9(9) COMP-5 VALUE 0.
          03 ws-recover-rc                 PIC S9(9) COMP-5 VALUE 0.
          03 ws-forget-rc                  PIC S9(9) COMP-5 VALUE 0.
          03 ws-complete-rc                PIC S9(9) COMP-5 VALUE 0.

       *> Variables for extracting the DSN, UserID and Password from
       *> the Open String passed from the Enterprise Server
       *> Configuration page.

       01 TmpWorkString                    PIC X(256) VALUE SPACES.
       01 ParamString                      PIC X(256) VALUE SPACES.
       01 ValueString                      PIC X(256) VALUE SPACES.

       01 OuterPosn                        PIC 9(3) VALUE 0.
       01 InnerPosn                        PIC 9(3) VALUE 0.

       EXEC SQL INCLUDE SQLCA END-EXEC

       EXEC SQL BEGIN DECLARE SECTION END-EXEC

       *> SQL Connect information, derived from the Open string
       *> as defined within the Enterprise Server configuration.

       01 DbString                     PIC X(32) VALUE LOW-VALUES.
       01 UidString                    PIC X(32) VALUE LOW-VALUES.
       01 PwdString                    PIC X(32) VALUE LOW-VALUES.

       EXEC SQL END   DECLARE SECTION END-EXEC

       *> Support for tracing

       COPY "cbltypes.cpy".

      *>***************************************************************
      *>
      *> Consolidated Tracing Facility (CTF)
      *>
      *>***************************************************************

      *>---------------------------------------------------------------
      *> CBL_CTF_ API return codes
      *>---------------------------------------------------------------
       78  78-CTF-RET-SUCCESS                   value 0.
       78  78-CTF-RET-FAILURE                   value -1.
       78  78-CTF-RET-INVALID-TRACE-HANDLE      value 1.
       78  78-CTF-RET-INVALID-TRACE-LEVEL       value 2.
       78  78-CTF-RET-NOT-TRACE-ENABLED         value 3.
       78  78-CTF-RET-NOT-TRACING-LEVEL         value 4.
       78  78-CTF-RET-NOT-ENOUGH-MEMORY         value 5.
       78  78-CTF-RET-OUTPUT-ERROR              value 6.
       78  78-CTF-RET-PROPERTY-NOT-FOUND        value 7.
       78  78-CTF-RET-BUFFER-TOO-SMALL          value 8.
       78  78-CTF-RET-VALUE-NOT-INTEGER         value 9.
       78  78-CTF-RET-EMITTER-NOT-FOUND         value 10.
       78  78-CTF-RET-INVALID-EVENT-HANDLE      value 11.
       78  78-CTF-RET-ZERO-LENGTH-DATA          value 12.
       78  78-CTF-RET-INVALID-PROP-NAME         value 13.
       78  78-CTF-RET-INVALID-COMP-NAME         value 14.
       78  78-CTF-RET-INVALID-EMITTER-NAME      value 15.
       78  78-CTF-RET-INVALID-PROG-NAME         value 16.
       78  78-CTF-RET-CALLBACK-NOT-FOUND        value 17.
       78  78-CTF-RET-CALLBACK-EXISTS           value 18.

      *>---------------------------------------------------------------
      *> CBL_CTF_ API control flags
      *>---------------------------------------------------------------
       78  78-DESTFLGS-COMPID-STRING            value h'80000000'.

      *>
      *>  Used by:
      *>
      *>        CBL_CTF_EMITTER
      *>
       78  78-CTF-FLAG-PROG-NAME-NULL-TERM      value h'00000001'.

      *>
      *>  Used by:
      *>
      *>        CBL_CTF_ENABLE
      *>
       78  78-CTF-FLAG-COMP-ENABLE              value h'00000000'.
       78  78-CTF-FLAG-COMP-DISABLE             value h'00000001'.

      *>
      *>  Used by:
      *>
      *>        CBL_CTF_DEST
      *>
       78  78-CTF-FLAG-DEST-ADD                 value h'00000000'.
       78  78-CTF-FLAG-DEST-REMOVE              value h'00000001'.
       78  78-CTF-FLAG-DEST-NOINHERIT           value h'00000002'.

      *>
      *>  Used by:
      *>
      *>        CBL_CTF_COMP_PROPERTY_GET
      *>        CBL_CTF_COMP_PROPERTY_SET
      *>        CBL_CTF_EMITTER_PROPERTY_GET
      *>        CBL_CTF_EMITTER_PROPERTY_SET
      *>
       78  78-CTF-FLAG-PROP-STRING-VALUE        value h'00000000'.
       78  78-CTF-FLAG-PROP-INT-VALUE           value h'00000001'.
       78  78-CTF-FLAG-PROP-NULL-TERM           value h'00000002'.

      *>
      *>  Used by:
      *>
      *>        CBL_CTF_TRACE
      *>
       78  78-CTF-FLAG-TRACE-OUTPUT-FORCE       value h'00001000'.
       78  78-CTF-FLAG-TRACE-ARRAY-DATA         value h'00002000'.

      *>
      *>  Used by:
      *>
      *>        CBL_CTF_DEST
      *>        CBL_CTF_EMITTER
      *>        CBL_CTF_EMITTER_PROPERTY_GET
      *>        CBL_CTF_EMITTER_PROPERTY_SET
      *>
       78  78-CTF-FLAG-EMIT-NAME-NULL-TERM      value h'10000000'.

      *>
      *>  Used by:
      *>
      *>        CBL_CTF_COMP_PROPERTY_GET
      *>        CBL_CTF_COMP_PROPERTY_SET
      *>        CBL_CTF_EMITTER_PROPERTY_GET
      *>        CBL_CTF_EMITTER_PROPERTY_SET
      *>
       78  78-CTF-FLAG-PROP-NAME-NULL-TERM      value h'20000000'.

      *>
      *>  Used by:
      *>
      *>        CBL_CTF_COMP_PROPERTY_GET
      *>        CBL_CTF_COMP_PROPERTY_SET
      *>        CBL_CTF_DEST
      *>        CBL_CTF_ENABLE
      *>        CBL_CTF_LEVEL
      *>        CBL_CTF_TRACE
      *>        CBL_CTF_TRACER_GET
      *>        CBL_CTF_TRACER_LEVEL_GET
      *>
       78  78-CTF-FLAG-COMP-NAME-NULL-TERM      value h'40000000'.
      *>
      *>  Used by:
      *>
      *>        CBL_CTF_COMP_PROPERTY_GET
      *>        CBL_CTF_COMP_PROPERTY_SET
      *>        CBL_CTF_DEST
      *>        CBL_CTF_ENABLE
      *>        CBL_CTF_LEVEL
      *>        CBL_CTF_TRACE
      *>        CBL_CTF_TRACER_LEVEL_GET
      *>
       78  78-CTF-FLAG-COMPID-STRING            value h'80000000'.

      *>---------------------------------------------------------------
      *> Trace levels
      *>---------------------------------------------------------------
       78  78-CTF-FLAG-LEVEL-DEBUG              value 0.
       78  78-CTF-FLAG-LEVEL-INFO               value 1.
       78  78-CTF-FLAG-LEVEL-WARN               value 2.
       78  78-CTF-FLAG-LEVEL-ERROR              value 3.
       78  78-CTF-FLAG-LEVEL-FATAL              value 4.

       78  78-CTF-FLAG-LEVEL-NONE               value h'FFFFFFFF'.

      *>---------------------------------------------------------------
      *> Trace event
      *>---------------------------------------------------------------
       01       cblt-trc-event                  typedef.
         03     cblte-trcevt-version            cblt-x4-comp5.
         03     cblte-trcevt-flags              cblt-x4-comp5.
         03     cblte-trcevt-event-id           cblt-x4-comp5.
         03     cblte-trcevt-level              cblt-x4-comp5.
         03     cblte-trcevt-data-count         cblt-x4-comp5.
         03     cblte-trcevt-event-len          cblt-pointer.
         03     cblte-trcevt-event-type         cblt-pointer.
         03     cblte-trcevt-event-data         cblt-pointer.

      *>
      *> Version types (cblte-trcevt-version)
      *>
       78  78-TRACE-EVENT-VERSION               value 0.

      *>
      *> Control flags (cblte-trcevt-flags)
      *>
       78  78-TRACE-EVENT-FLAGS-NONE            value h'00000000'.

      *>
      *> Trace event types (cblte-trcevt-event-type)
      *>
       78  78-TRACE-EVENT-TYPE-BINARY           value 0.
       78  78-TRACE-EVENT-TYPE-TEXT             value 1.
       78  78-TRACE-EVENT-TYPE-ADDRESS          value 2.
       78  78-TRACE-EVENT-TYPE-COMP5            value 3.
       78  78-TRACE-EVENT-TYPE-COMPX            value 4.
       78  78-TRACE-EVENT-TYPE-UTF8             value 5.
       78  78-TRACE-EVENT-TYPE-COMP5S           value 6.
       78  78-TRACE-EVENT-TYPE-COMPXS           value 7.

      *>---------------------------------------------------------------
      *> Tracer notification callback installation
      *>---------------------------------------------------------------
       01       cblt-trc-notif-install          typedef.
         03     cblte-tni-version               cblt-x4-comp5.
         03     cblte-tni-handle                cblt-x4-comp5.
         03     cblte-tni-callback              cblt-ppointer.

       78  78-TRC-NOTIF-TYPE-PROP-CHANGE        value 0.
       78  78-TRC-NOTIF-TYPE-LEVEL-CHANGE       value 1.

      *>---------------------------------------------------------------
      *> Tracer notification: property change
      *>---------------------------------------------------------------
       01       cblt-trc-notif-prop-change      typedef.
         03     cblte-tnpc-version              cblt-x4-comp5.
         03     cblte-tnpc-flags                cblt-x4-comp5.
         03     cblte-tnpc-namelen              cblt-x4-comp5.
         03     cblte-tnpc-vallen               cblt-x4-comp5.
         03     cblte-tnpc-valint               cblt-x4-comp5.
         03     cblte-tnpc-name                 cblt-pointer.
         03     cblte-tnpc-value                cblt-pointer.

      *>
      *> Version types (cblte-tnpc-version)
      *>
       78  78-PROP-CHANGE-VERSION               value 0.

      *>
      *> Control flags (cblte-tnpc-flags)
      *>
       78  78-PROP-CHANGE-FLAGS-NONE            value h'00000000'.
       78  78-PROP-CHANGE-FLAGS-VAL-INT         value h'00000001'.

       01  TmpString                   PIC X(200).

       78  MAX-TRACE-DATA              VALUE 7.
       78  THIS-COMPONENT              VALUE "MF.ESDB2OPC".

      *----------------------------------------------------------------
      *    THIS_COMPONENT's tracer properties
      *----------------------------------------------------------------
       78  PROPID-ALL                  VALUE 1.

       78  PROPNAME-ALL                VALUE "all".
       78  PROPNAME-OPEN               VALUE "connect".
       78  PROPNAME-COMMIT             VALUE "commit".
       78  PROPNAME-ROLLBACK           VALUE "rollback".
       78  PROPNAME-CLOSE              VALUE "disconnect".

       01  ws-prop-names.
           03                         PIC X(10) VALUE PROPNAME-ALL.
           03                         PIC X(10) VALUE PROPNAME-OPEN.
           03                         PIC X(10) VALUE PROPNAME-COMMIT.
           03                         PIC X(10) VALUE PROPNAME-ROLLBACK.
           03                         PIC X(10) VALUE PROPNAME-CLOSE.
           03                         PIC X(10) VALUE spaces.
       01  ws-prop-name               REDEFINES ws-prop-names
                                      PIC X(10) OCCURS 6.
      *----------------------------------------------------------------
      *    THIS_COMPONENT events
      *----------------------------------------------------------------
       78  EVENT-OPEN-BADOPENSTRING    VALUE 0.
       78  EVENT-OPEN-CONNECT          VALUE 1.
       78  EVENT-COMMIT                VALUE 2.
       78  EVENT-ROLLBACK              VALUE 3.
       78  EVENT-CLOSE                 VALUE 4.

      *----------------------------------------------------------------
      *    Trace flags for THIS-COMPONENT. Each bit of these flags
      *    corresponds to a property being set (non-zero value) for 
      *    THIS-COMPONENT. The actual bit set for a given property
      *    corresponds to the position-1 of the property's name in the
      *    'ws-prop-name' table above. For example, if bit 0 is set,
      *    it indicates that the 'APPLES' property was set. If the 'ALL'
      *    property is set, then all bits of 'trace_flags' will be set.
      *
      *    N.B. This is just an example of how properties and their
      *    values may be processed by a component.How properties are
      *    processed is completely transparent to CTF.
      *----------------------------------------------------------------
       78  TRACE-FLAGS-OPEN            VALUE h'00000002'.
       78  TRACE-FLAGS-COMMIT          VALUE h'00000004'.
       78  TRACE-FLAGS-ROLLBACK        VALUE h'00000008'.
       78  TRACE-FLAGS-CLOSE           VALUE h'00000010'.

       01  ctf-config-data.
           03  ctf-trace-level         PIC X(4) COMP-5.
           03  ctf-trace-flags         PIC X(4) COMP-5.

      *----------------------------------------------------------------
      *    Variables required for CTF event generation
      *----------------------------------------------------------------
       01  ctf-event-data.
           03  ctf-tracer-handle       PIC X(4) COMP-5.
           03  ctf-trace-event         cblt-trc-event.
           03  ctf-trace-event-lens    PIC X(4) comp-5
                                       OCCURS MAX-TRACE-DATA.
           03  ctf-trace-event-types   PIC X(4) comp-5
                                       OCCURS MAX-TRACE-DATA.
           03  ctf-trace-event-ptrs    pointer
                                       OCCURS MAX-TRACE-DATA.

       01  tracingInitialised          PIC 9 VALUE 0.

      *****************************************************************
       local-storage section.
       01  ls-data.
           03  ls-api-flags            PIC X(4) COMP-5.
           03  ls-bunch-size           PIC X(4) COMP-5.
           03  ls-comp-name            PIC X(16).
           03  ls-install-param        cblt-trc-notif-install.
           03  ls-net-size             PIC X(4) COMP-5.
           03  ls-prop-id              PIC X(4) COMP-5.
           03  ls-prop-value           PIC X(4) COMP-5.
           03  ls-trace-data-count     PIC X(4) COMP-5.
           03  ls-trace-data-desc      PIC X(80).
           03  ls-trace-start-desc     PIC X(14).
           03  ls-trace-event          PIC X(4) COMP-5.
           03  ls-trace-level          PIC X(4) COMP-5.
           03  ls-work-var             PIC X(4) COMP-5.

       LINKAGE SECTION.

       01 lk-xid.
          03 lk-xid-formatid               PIC S9(9) COMP-5.
             88 lk-xid-nullxid-88          VALUE -1.
          03 lk-xid-gtrid-length           PIC S9(9) COMP-5.
          03 lk-xid-bqual-length           PIC S9(9) COMP-5.
          03 lk-xid-value.
             05 lk-xid-global.
                07 lk-xid-id               PIC X(6).
                07 lk-xid-sysid            PIC X(4).
                07 lk-xid-tran-no          PIC 9(6).
             05 lk-xid-branch-no           PIC 9(6).
             05                            PIC X(105).

       01 lk-rmid                          PIC S9(9) COMP-5.
       01 lk-flags                         PIC S9(9) COMP-5.
       01 lk-open-string                   PIC X(256).
       01 lk-close-string                  PIC X(256).
       01 lk-rc                            PIC S9(9) COMP-5.

       *> Tracing support

       01  lk-ctf-tracer-handle        PIC X(4) COMP-5.
       01  lk-ctf-notif-type           PIC X(4) COMP-5.

       01  lk-ctf-notif-param          PIC X.
       01  lk-ctf-notif-param-level    REDEFINES lk-ctf-notif-param
                                       PIC X(4) COMP-5.
       01  lk-ctf-notif-param-property REDEFINES lk-ctf-notif-param
                                       cblt-trc-notif-prop-change.
       01  lk-ctf-property-name        PIC X.
       01  lk-ctf-property-value       PIC X.

       PROCEDURE DIVISION.

           GOBACK
           .
      *--------------------------------------------------------------*
       xa-open SECTION.
       ENTRY "esdb2opc_1pc_connect" USING BY REFERENCE lk-open-string
                                 BY VALUE     lk-rmid
                                 BY VALUE     lk-flags.


           IF tracingInitialised = 0
              PERFORM initialise-esdb2opc-tracing
              MOVE 1 TO tracingInitialised
           END-IF

        *> Parse and validate the Open String passed in from ES.

           MOVE 1 TO OuterPosn

           PERFORM UNTIL OuterPosn > 256

             *> From the start point, loop until the end of param
             *> or end of string

                PERFORM VARYING InnerPosn 
                    FROM OuterPosn BY 1 UNTIL
                       lk-open-string(InnerPosn : 1) = ","
                    OR lk-open-string(InnerPosn : 1) = LOW-VALUES

                END-PERFORM

             *> Remove any leading spaces

                PERFORM WITH TEST BEFORE UNTIL
                    lk-open-string(OuterPosn:1) NOT = SPACE

                    ADD 1 TO OuterPosn

                END-PERFORM

                MOVE lk-open-string(OuterPosn : InnerPosn - OuterPosn)
                     TO TmpWorkString

             *> Separate the Parameter and Value

                UNSTRING TmpWorkString DELIMITED BY "="
                         INTO ParamString, ValueString
                END-UNSTRING

                CALL "CBL_TOUPPER" USING ParamString
                                   BY VALUE 256
                END-CALL

                EVALUATE ParamString
                WHEN "DB"
                     MOVE ValueString TO DbString
                WHEN "UID"
                     MOVE ValueString TO UidString
                WHEN "PWD"
                     MOVE ValueString TO PwdString
                END-EVALUATE

             *> If we've reached the end of the string, drop out
             *> of the perform loop.

                IF     lk-open-string(InnerPosn : 2) = LOW-VALUES
                   EXIT PERFORM
                END-IF

                MOVE InnerPosn TO OuterPosn
                ADD 1 TO OuterPosn

           END-PERFORM

        *> CUSTOMIZE
        *> If you don't want to make the userID and password visible
        *> within the ES configuration pages, then code them directly
        *> here. Likewise for the ConnectionName to be used.

        *> MOVE "mydsn"      TO DbString
        *> MOVE "myuserid"   TO UidString
        *> MOVE "mypassword" TO PwdString

        *> Ensure that at minimum, a DSN has been passed via the
        *> Open String.

           IF DbString = LOW-VALUES
              OR (UidString = LOW-VALUES AND PwdString NOT = LOW-VALUES)
              OR (UidString NOT = LOW-VALUES AND PwdString = LOW-VALUES)
              MOVE -2 TO ws-open-rc

              IF (TRACE-FLAGS-OPEN b-and ctf-trace-flags) not = 0
              and 78-CTF-FLAG-LEVEL-ERROR >= ctf-trace-level
                  MOVE EVENT-OPEN-BADOPENSTRING TO ls-trace-event
                  MOVE 78-CTF-FLAG-LEVEL-ERROR TO ls-trace-level
                  perform trc-esdb2opc-event
              end-if

           ELSE

           *> Connect to the database

              IF UidString = LOW-VALUES
                    EXEC SQL
                         CONNECT TO :DbString
                    END-EXEC
              ELSE
                    EXEC SQL
                         CONNECT TO :DbString USER :UidString
                                 USING :PwdString
                    END-EXEC
              END-IF
   
              IF SQLCODE NOT = ZERO

                 MOVE -3 TO ws-open-rc

                 IF (TRACE-FLAGS-OPEN b-and ctf-trace-flags) not = 0
                 and 78-CTF-FLAG-LEVEL-INFO >= ctf-trace-level
                     MOVE EVENT-OPEN-CONNECT TO ls-trace-event
                     MOVE 78-CTF-FLAG-LEVEL-INFO TO ls-trace-level
                     perform trc-esdb2opc-event
                 end-if

              ELSE
                 MOVE 0 TO ws-open-rc

                 IF (TRACE-FLAGS-OPEN b-and ctf-trace-flags) not = 0
                 and 78-CTF-FLAG-LEVEL-INFO >= ctf-trace-level
                     MOVE EVENT-OPEN-CONNECT TO ls-trace-event
                     MOVE 78-CTF-FLAG-LEVEL-INFO TO ls-trace-level
                     perform trc-esdb2opc-event
                 end-if

              END-IF

           END-IF

           GOBACK RETURNING ws-open-rc
           .

       xa-close SECTION.
       ENTRY "esdb2opc_1pc_disconnect" USING
                                  BY REFERENCE lk-close-string
                                  BY VALUE     lk-rmid
                                  BY VALUE     lk-flags.

              EXEC SQL
                   DISCONNECT CURRENT
              END-EXEC

           IF SQLCODE NOT = ZERO
              MOVE -3 TO ws-close-rc

              IF (TRACE-FLAGS-CLOSE b-and ctf-trace-flags) not = 0
              and 78-CTF-FLAG-LEVEL-INFO >= ctf-trace-level
                  MOVE EVENT-CLOSE TO ls-trace-event
                  MOVE 78-CTF-FLAG-LEVEL-INFO TO ls-trace-level
                  perform trc-esdb2opc-event
              end-if
           ELSE
              MOVE 0 TO ws-close-rc

              IF (TRACE-FLAGS-CLOSE b-and ctf-trace-flags) not = 0
              and 78-CTF-FLAG-LEVEL-INFO >= ctf-trace-level
                  MOVE EVENT-CLOSE TO ls-trace-event
                  MOVE 78-CTF-FLAG-LEVEL-INFO TO ls-trace-level
                  perform trc-esdb2opc-event
              end-if
           END-IF


           GOBACK RETURNING ws-close-rc
           .

       xa-rollback SECTION.
       ENTRY "esdb2opc_1pc_rollback" USING
                                      BY REFERENCE lk-xid
                                      BY VALUE     lk-rmid
                                      BY VALUE     lk-flags.

           EXEC SQL
                ROLLBACK
           END-EXEC

           IF SQLCODE NOT = ZERO
              MOVE -3 TO ws-rollback-rc

              IF (TRACE-FLAGS-ROLLBACK b-and ctf-trace-flags) not = 0
              and 78-CTF-FLAG-LEVEL-INFO >= ctf-trace-level
                  MOVE EVENT-ROLLBACK TO ls-trace-event
                  MOVE 78-CTF-FLAG-LEVEL-INFO TO ls-trace-level
                  perform trc-esdb2opc-event
              end-if

           ELSE
              MOVE 0 TO ws-rollback-rc

              IF (TRACE-FLAGS-ROLLBACK b-and ctf-trace-flags) not = 0
              and 78-CTF-FLAG-LEVEL-INFO >= ctf-trace-level
                  MOVE EVENT-ROLLBACK TO ls-trace-event
                  MOVE 78-CTF-FLAG-LEVEL-INFO TO ls-trace-level
                  perform trc-esdb2opc-event
              end-if

           END-IF

           GOBACK RETURNING ws-rollback-rc
           .

       xa-commit SECTION.
       ENTRY "esdb2opc_1pc_commit" USING
                                    BY REFERENCE lk-xid
                                    BY VALUE     lk-rmid
                                    BY VALUE     lk-flags.

           EXEC SQL
                COMMIT
           END-EXEC

           IF SQLCODE NOT = ZERO
              MOVE -3 TO ws-commit-rc

              IF (TRACE-FLAGS-COMMIT b-and ctf-trace-flags) not = 0
              and 78-CTF-FLAG-LEVEL-INFO >= ctf-trace-level
                  MOVE EVENT-COMMIT TO ls-trace-event
                  MOVE 78-CTF-FLAG-LEVEL-INFO TO ls-trace-level
               perform trc-esdb2opc-event
              end-if

           ELSE
              MOVE 0 TO ws-commit-rc

              IF (TRACE-FLAGS-COMMIT b-and ctf-trace-flags) not = 0
              and 78-CTF-FLAG-LEVEL-INFO >= ctf-trace-level
                  MOVE EVENT-COMMIT TO ls-trace-event
                  MOVE 78-CTF-FLAG-LEVEL-INFO TO ls-trace-level
                  perform trc-esdb2opc-event
              end-if

           END-IF

           GOBACK RETURNING ws-commit-rc
           .

      *****************************************************************
      *  Initialise tracing for THIS-COMPONENT.
      *
      *  On exit from this section 'ctf-tracer-handle',
      *  'ctf-trace-flags' and 'ctf-trace-level' will be set for
      *  THIS-COMPONENT
      *****************************************************************
       initialise-esdb2opc-tracing section.

           MOVE 0 TO ctf-trace-flags

           *>
           *>  Pick up THIS-COMPONENT's tracer handle
           *>
           MOVE 78-CTF-FLAG-COMP-NAME-NULL-TERM TO ls-api-flags
           MOVE THIS-COMPONENT & x"00" TO ls-comp-name

           CALL "CBL_CTF_TRACER_GET" USING
                                     BY VALUE     ls-api-flags
                                     BY REFERENCE ls-comp-name
                                     BY REFERENCE ctf-tracer-handle
           END-CALL

           IF RETURN-CODE NOT = 0
               DISPLAY "CBL_CTF_TRACER_GET (rc = "
                       RETURN-CODE
                       ")"
               EXIT SECTION
           END-IF

           *>
           *>  Get THIS-COMPONENT's tracer properties.
           *>
           *>  For the purpose of this demo, all properties are
           *>  expected to have integer values, so if the property
           *>  exists, but has a non-integer value it will be ignored.
           *>
           MOVE 78-CTF-FLAG-PROP-INT-VALUE TO ls-api-flags

           PERFORM VARYING ls-prop-id FROM 1 BY 1
                     UNTIL ws-prop-name(ls-prop-id) = SPACES

               CALL "CBL_CTF_COMP_PROPERTY_GET" USING
                              BY VALUE     ls-api-flags
                              BY REFERENCE ctf-tracer-handle
                              BY REFERENCE ws-prop-name(ls-prop-id)
                              BY VALUE     0
                              BY REFERENCE ls-prop-value
               END-CALL

               IF RETURN-CODE = 0
                   PERFORM apply-esdb2opc-property-value
               END-IF
           END-PERFORM

           *>
           *>  Get THIS-COMPONENT's tracer trace level
           *>
           MOVE 0 TO ls-api-flags

           CALL "CBL_CTF_TRACER_LEVEL_GET" USING
                                       BY VALUE     ls-api-flags
                                       BY REFERENCE ctf-tracer-handle
                                       BY REFERENCE ctf-trace-level
           END-CALL

           IF RETURN-CODE NOT = 0
               DISPLAY "CBL_TRACER_LEVEL_GET (rc = "
                       return-code
                       ")"
               EXIT SECTION
           END-IF

           *>
           *> Install tracer notification callback
           *>
           MOVE LOW-VALUES TO ls-install-param
           MOVE ctf-tracer-handle TO
                cblte-tni-handle OF ls-install-param
           SET cblte-tni-callback OF ls-install-param TO
               ENTRY "ctf-tracer-esdb2opcsub-ntfy-callbk"

           CALL "CBL_CTF_TRACER_NOTIFY" USING
                                        BY VALUE 0
                                        BY REFERENCE ls-install-param
           END-CALL

           IF RETURN-CODE NOT = 0
               DISPLAY "CBL_CTF_TRACER_NOTIFY (rc = "
                       return-code
                       ")"
               EXIT SECTION
           END-IF

           *>
           *> Initialise fixed fields in trace event structure
           *>
           MOVE LOW-VALUES TO ctf-trace-event

           SET cblte-trcevt-event-len OF ctf-trace-event TO
               ADDRESS OF ctf-trace-event-lens(1)
           SET cblte-trcevt-event-type OF ctf-trace-event TO
               ADDRESS OF ctf-trace-event-types(1)
           SET cblte-trcevt-event-data OF ctf-trace-event TO
               ADDRESS OF ctf-trace-event-ptrs(1)
           .

      *****************************************************************
      *    Set appropriate trace flags bit
      *****************************************************************
       apply-esdb2opc-property-value section.
           IF ls-prop-id = PROPID-ALL
               IF ls-prop-value NOT = 0
                  COMPUTE ctf-trace-flags = ctf-trace-flags b-or
                                            h'FFFFFFFF'
               ELSE
                  MOVE 0 TO ctf-trace-flags
               END-IF
           ELSE
               COMPUTE ls-work-var = 2 ** (ls-prop-id - 2)

               IF ls-prop-value NOT = 0
                   COMPUTE ctf-trace-flags = ctf-trace-flags b-or
                                             ls-work-var
               ELSE
                   COMPUTE ctf-trace-flags = ctf-trace-flags b-and b-not
                                             ls-work-var
               END-IF
           END-IF
           .

      *****************************************************************
      *  THIS-COMPONENT tracer callback. Processes THIS-COMPONENT's
      *  property and trace level changes.
      *
      *  lk-ctf-tracer-handle  =  tracer handle
      *
      *  lk-ctf-notif-type     =  notification type
      *
      *                           0 = property change
      *                           1 = trace level change
      *
      *  lk-ctf-notif-info     =  address of item whose type is
      *                           dependent upon notification type
      *
      *                           type 0 = cblt-trc-notif-prop-change
      *                           type 1 = pic x(4) comp-5
      *****************************************************************
       ctf-tracer-esdb2opc-ntfy-callbk section.
           ENTRY "ctf-tracer-esdb2opcsub-ntfy-callbk" USING
                                      BY VALUE     lk-ctf-tracer-handle
                                      BY VALUE     lk-ctf-notif-type
                                      BY REFERENCE lk-ctf-notif-param.
           EVALUATE lk-ctf-notif-type
               WHEN 78-TRC-NOTIF-TYPE-PROP-CHANGE
                   PERFORM ctf-tracer-esdb2opc-ntfy-prop

               WHEN 78-TRC-NOTIF-TYPE-LEVEL-CHANGE
                   MOVE lk-ctf-notif-param-level TO ctf-trace-level

               WHEN OTHER
                    CONTINUE
           END-EVALUATE

           GOBACK
           .

      *-----------------------------------------------------------------
      *    Tracer property changed
      *-----------------------------------------------------------------
       ctf-tracer-esdb2opc-ntfy-prop section.
           SET ADDRESS OF lk-ctf-property-name TO
               cblte-tnpc-name OF lk-ctf-notif-param-property

           PERFORM VARYING ls-prop-id FROM 1 BY 1
                     UNTIL ws-prop-name(ls-prop-id) = SPACES

               IF ws-prop-name(ls-prop-id) =
                  lk-ctf-property-name
                   (1:cblte-tnpc-namelen OF lk-ctf-notif-param-property)

                   MOVE cblte-tnpc-valint OF lk-ctf-notif-param-property
                        TO ls-prop-value

                   PERFORM apply-esdb2opc-property-value
                   EXIT PERFORM
               END-IF
           END-PERFORM
           .

      *****************************************************************
      *    Output trace event
      *****************************************************************
       trc-esdb2opc-event section.
           MOVE 78-TRACE-EVENT-FLAGS-NONE TO
                cblte-trcevt-flags OF ctf-trace-event
           MOVE ls-trace-event TO
                cblte-trcevt-event-id OF ctf-trace-event
           MOVE ls-trace-level TO
                cblte-trcevt-level OF ctf-trace-event

           MOVE 0 TO ls-trace-data-count

           EVALUATE ls-trace-event
               WHEN EVENT-OPEN-CONNECT
               WHEN EVENT-COMMIT
               WHEN EVENT-ROLLBACK
               WHEN EVENT-CLOSE
                   PERFORM trc-esdb2opc-event-rtn-sqlerr

               WHEN EVENT-OPEN-BADOPENSTRING
                   PERFORM trc-esdb2opc-event-openstr-err

           END-EVALUATE

           MOVE ls-trace-data-count TO
                cblte-trcevt-data-count OF ctf-trace-event

           CALL "CBL_CTF_TRACE" USING BY VALUE     0
                                      BY REFERENCE ctf-tracer-handle
                                      BY REFERENCE ctf-trace-event
           END-CALL

           IF RETURN-CODE NOT = 0
               DISPLAY "CBL_CTF_TRACE (rc = "
                       RETURN-CODE
                       ")"
           END-IF
           .

      *-----------------------------------------------------------------
      *    Set up trace data for handling sql errors
      *-----------------------------------------------------------------
       trc-esdb2opc-event-rtn-sqlerr section.

           *>
           *>  SQL Error message
           *>

           UNSTRING SQLERRMC DELIMITED BY "   " INTO TmpString
                COUNT ctf-trace-event-lens(1)

           SET ctf-trace-event-ptrs(1) TO 
               ADDRESS OF SQLERRMC

           MOVE 78-TRACE-EVENT-TYPE-TEXT TO
                ctf-trace-event-types(1)

           ADD 1 TO ls-trace-data-count

           *>
           *>  SQLCODE
           *>

           SET ctf-trace-event-ptrs(2) TO 
               ADDRESS OF SQLCODE

           MOVE length of SQLCODE TO
                ctf-trace-event-lens(2)

           MOVE 78-TRACE-EVENT-TYPE-COMP5S TO
                ctf-trace-event-types(2)

           ADD 1 TO ls-trace-data-count

           *>
           *>  SQLSTATE
           *>

           SET ctf-trace-event-ptrs(3) TO 
               ADDRESS OF SQLSTATE

           MOVE length of SQLSTATE TO
                ctf-trace-event-lens(3)

           MOVE 78-TRACE-EVENT-TYPE-TEXT TO
                ctf-trace-event-types(3)

           ADD 1 TO ls-trace-data-count
           .

       trc-esdb2opc-event-openstr-err section.

           *>
           *>  info text
           *>

           MOVE "Error: Open String format is DSN=odbc_dsn"
                & "[,USRPASS=userid.passwd]."
                TO ls-trace-data-desc

           SET ctf-trace-event-ptrs(1) TO 
               ADDRESS OF ls-trace-data-desc

           UNSTRING ls-trace-data-desc DELIMITED BY "  " INTO TmpString
                COUNT ctf-trace-event-lens(1)

           MOVE 78-TRACE-EVENT-TYPE-TEXT TO
                ctf-trace-event-types(1)

           ADD 1 TO ls-trace-data-count

           .

