IDENTIFICATION DIVISION.

PROGRAM-ID. EXTXN01.

*

* InstantSQL Transaction Example 01.

*

*This example connects to the data source named

*Bank. It then executes a transfer transaction

*from a checking account to a savings account.

*The transaction is committed only if it is

*successful, otherwise it is rolled back.

*

DATA DIVISION.

WORKING-STORAGE SECTION.

COPY "lisqlall.cpy".

01 WS-Handles.

05 WS-QryHandleReadCkg USAGE ISqlHandle.

05 WS-QryHandleUpdtCkg USAGE ISqlHandle.

05 WS-QryHandleUpdtSvg USAGE ISqlHandle.

01 WS-Account-Data.

05 WS-CkgAccountNo PIC 9(09). *> checking acct number

05 WS-SvgAccountNo PIC 9(09). *> savings acct number

05 WS-CkgBalance PIC S9(16)V9(2). *> checking balance

05 WS-SvgBalance PIC S9(16)V9(2). *> savings balance

05 WS-TrfAmount PIC S9(16)V9(2). *> transfer amount

05 WS-TxnFlag PIC X.

88 WS-TxnIsActive VALUE "Y" FALSE "N".

05 WS-Timeout PIC S9(5) BINARY VALUE 20.

01 PBuf PIC X(80) VALUE SPACES.

01 P1 PIC S9(5) BINARY VALUE 0.

01 I PIC S9(5) BINARY VALUE 0.

78 ErrMsgContSize VALUE 50.

PROCEDURE DIVISION.

A.

*Initialize.

SET WS-TxnIsActive TO FALSE.

*Connect to data source named Bank.

SQL CONNECT DATASOURCE sql-ConnectionHandle

"Bank"

"MyName"

"MyPassword".

IF NOT sql-OK

DISPLAY "<Error connecting to Bank data source.>"

PERFORM DescAndDisplaySqlError

STOP RUN

END-IF.

*Prepare query for verifying Checking balance larger than

*transfer amount.

SQL PREPARE QUERY WS-QryHandleReadCkg

sql-ConnectionHandle

"SELECT Balance FROM Checking WHERE AccountNo = ?"

sql-Concur-Lock.

IF NOT sql-OK PERFORM DescAndDisplaySqlError END-IF.

SQL BIND COLUMN WS-QryHandleReadCkg

1 WS-CkgBalance OMITTED.

IF NOT sql-OK PERFORM DescAndDisplaySqlError END-IF.

SQL BIND PARAMETER WS-QryHandleReadCkg

1 sql-Integer sql-Param-Input

WS-CkgAccountNo OMITTED.

IF NOT sql-OK PERFORM DescAndDisplaySqlError END-IF.

*Prepare queries for updating Checking and Savings balances.

SQL PREPARE QUERY WS-QryHandleUpdtCkg

sql-ConnectionHandle

"UPDATE Checking SET Balance = ? WHERE AccountNo = ?".

IF NOT sql-OK PERFORM DescAndDisplaySqlError END-IF.

SQL BIND PARAMETER WS-QryHandleUpdtCkg

1 sql-Decimal sql-Param-Input WS-CkgBalance OMITTED

2 sql-Integer sql-Param-Input WS-CkgAccountNo OMITTED.

IF NOT sql-OK PERFORM DescAndDisplaySqlError END-IF.

SQL PREPARE QUERY WS-QryHandleUpdtSvg

sql-ConnectionHandle

"UPDATE Savings SET Balance = Balance + ?

- "WHERE AccountNo = ?".

IF NOT sql-OK PERFORM DescAndDisplaySqlError END-IF.

SQL BIND PARAMETER WS-QryHandleUpdtSvg

1 sql-Decimal sql-Param-Input WS-TrfAmount OMITTED

2 sql-Integer sql-Param-Input WS-SvgAccountNo OMITTED.

IF NOT sql-OK PERFORM DescAndDisplaySqlError END-IF.

*Get account numbers and transfer amount.

MOVE 001346759 TO WS-CkgAccountNo.

MOVE 002478291 TO WS-SvgAccountNo.

MOVE 1000.00 TO WS-TrfAmount.

*Start transaction for transfer from checking to savings.

SQL START TRANSACTION sql-ConnectionHandle

sql-TXN-Repeatable-Read.

IF NOT sql-OK PERFORM DescAndDisplaySqlError END-IF.

SET WS-TxnIsActive TO TRUE.

*Read checking account balance.

SQL START QUERY WS-QryHandleReadCkg WS-Timeout.

IF NOT sql-OK PERFORM TxnSqlError END-IF.

SQL FETCH ROW WS-QryHandleReadCkg.

IF NOT sql-OK PERFORM TxnSqlError END-IF.

*Verify transfer does not exceed checking balance.

IF WS-TrfAmount > WS-CkgBalance

DISPLAY "Transaction failed: insufficient funds."

PERFORM TxnCobolError

ELSE

*> Do transfer.

SUBTRACT WS-TrfAmount FROM WS-CkgBalance

SQL START QUERY WS-QryHandleUpdtCkg WS-Timeout

IF NOT sql-OK PERFORM TxnSqlError END-IF

SQL START QUERY WS-QryHandleUpdtSvg WS-Timeout

IF NOT sql-OK PERFORM TxnSqlError END-IF

IF WS-TxnIsActive

SQL COMMIT TRANSACTION sql-ConnectionHandle

SET WS-TxnIsActive TO FALSE

IF NOT sql-OK PERFORM DescAndDisplaySqlError END-IF

DISPLAY "Transfer completed."

END-IF

END-IF.

*End queries

SQL END QUERY WS-QryHandleUpdtSvg.

IF NOT sql-OK PERFORM DescAndDisplaySqlError END-IF.

SQL END QUERY WS-QryHandleUpdtCkg.

IF NOT sql-OK PERFORM DescAndDisplaySqlError END-IF.

SQL END QUERY WS-QryHandleReadCkg.

IF NOT sql-OK PERFORM DescAndDisplaySqlError END-IF.

*Disconnect from Bank data source.

SQL DISCONNECT DATASOURCE sql-ConnectionHandle.

IF NOT sql-OK PERFORM DescAndDisplaySqlError END-IF.

*Terminate InstantSQL and application

SQL SHUTDOWN.

STOP RUN.

TxnSqlError.

DISPLAY "Transaction failed: SQL error or account busy."

PERFORM DescAndDisplaySqlError.

PERFORM TxnCobolError.

TxnCobolError.

IF WS-TxnIsActive PERFORM RollBackTxn END-IF.

RollBackTxn.

DISPLAY "Rolling back transaction.".

SQL ROLLBACK TRANSACTION sql-ConnectionHandle.

SET WS-TxnIsActive TO FALSE.

IF NOT sql-OK PERFORM DescAndDisplaySqlError END-IF.

DescAndDisplaySqlError.

PERFORM WITH TEST AFTER UNTIL sql-EndOfData

SQL DESCRIBE ERROR sql-Error-Description

IF NOT sql-OK

IF sql-EndOfData

DISPLAY "--->End of error list."

ELSE

DISPLAY "Error describing error: " sql-Return CONVERT

ELSE

PERFORM DisplayErrorDesc

END-IF

END-PERFORM.

STOP "*** Transfer error occurred. ***".

DisplayErrorDesc.

STRING " Error type = " sql-ErrType

DELIMITED SIZE INTO PBuf POINTER P1.

EVALUATE TRUE

WHEN sql-IsOdbcError

STRING " (ODBC error)"

DELIMITED SIZE INTO PBuf POINTER P1

WHEN sql-IsInternalError

STRING " (internal error)"

DELIMITED SIZE INTO PBuf POINTER P1

WHEN OTHER

STRING " (unknown error type)"

DELIMITED SIZE INTO PBuf POINTER P1

END-EVALUATE.

PERFORM OutputPBuf.

STRING " Error statement = " sql-ErrStatement

DELIMITED SIZE INTO PBuf POINTER P1.

PERFORM OutputPBuf.

STRING " Error SQL state = " sql-ErrSqlState

DELIMITED SIZE INTO PBuf POINTER P1.

PERFORM OutputPBuf.

STRING " Error number = " sql-ErrNo(3:)

DELIMITED SIZE INTO PBuf POINTER P1.

PERFORM OutputPBuf.

STRING " Error msg len = " sql-ErrMsgLength(2:)

DELIMITED SIZE INTO PBuf POINTER P1.

PERFORM OutputPBuf.

STRING " Error message = """

DELIMITED SIZE INTO PBuf POINTER P1.

IF sql-ErrMsgLength > 0

IF sql-ErrMsgLength <= ErrMsgContSize

STRING sql-ErrMsg(1: sql-ErrMsgLength)

DELIMITED SIZE INTO PBuf POINTER P1

ELSE

STRING sql-ErrMsg(1: ErrMsgContSize)

DELIMITED SIZE INTO PBuf POINTER P1

END-IF

SUBTRACT ErrMsgContSize FROM sql-ErrMsgLength

ADD ErrMsgContSize 1 GIVING I

PERFORM VARYING I FROM I BY ErrMsgContSize

UNTIL sql-ErrMsgLength <= 0

PERFORM OutputPBuf

STRING " "

DELIMITED SIZE INTO PBuf POINTER P1

IF sql-ErrMsgLength <= ErrMsgContSize

STRING sql-ErrMsg(I: sql-ErrMsgLength)

DELIMITED SIZE INTO PBuf POINTER P1

ELSE

STRING sql-ErrMsg(I: ErrMsgContSize)

DELIMITED SIZE INTO PBuf POINTER P1

END-IF

SUBTRACT ErrMsgContSize FROM sql-ErrMsgLength

END-PERFORM

END-IF.

STRING """" DELIMITED SIZE INTO PBuf POINTER P1

PERFORM OutputPBuf.

OutputPBuf.

DISPLAY PBuf.

MOVE SPACES TO PBuf.

MOVE 1 TO P1.

END PROGRAM EXTXN01.