Case Study 2: Stored Procedure for Account Transfer
Background
Pacific Coast Federal Credit Union processes over 200,000 member-to-member fund transfers daily. These transfers move money between checking accounts, savings accounts, money market accounts, and loan payment accounts -- all within the credit union's DB2 database on z/OS.
Historically, the transfer logic was embedded in a CICS COBOL application program. The CICS program performed five separate SQL operations -- balance check, debit, credit, fee assessment, and audit logging -- as individual statements within a single CICS task. This design had three problems:
- Network overhead: Each SQL statement traveled from the CICS address space to the DB2 address space and back, resulting in five cross-address-space calls per transfer.
- Inconsistent business logic: A second transfer channel (the mobile banking middleware) duplicated the same five SQL operations in Java. When the fee calculation rules changed, the COBOL and Java implementations diverged, causing audit discrepancies.
- Concurrency issues: Under heavy load, the five individual SQL operations sometimes interleaved with other transactions, causing balance inconsistencies despite cursor stability isolation.
The solution: encapsulate the entire transfer operation in a DB2 stored procedure written in COBOL. Both the CICS application and the Java middleware call the same stored procedure, ensuring consistent business logic and atomic execution.
Project Requirements
Functional Requirements
The stored procedure XFER_FUNDS must:
- Validate that the source account exists, is active, and belongs to the requesting member
- Validate that the destination account exists and is eligible to receive transfers
- Check that the source account has sufficient funds (balance minus any hold amount)
- Apply a transfer fee if the transfer crosses account types (e.g., savings to checking incurs a $1.50 fee)
- Debit the source account
- Credit the destination account
- Record the fee (if any) as a separate transaction
- Insert audit trail records for both the debit and credit
- Return a transfer confirmation number, the new balances, and a status code
Non-Functional Requirements
- The procedure must complete within 200 milliseconds for 99th percentile response time
- Isolation level must prevent dirty reads and lost updates
- The procedure must not commit -- the caller controls the commit scope
- All monetary calculations must use COMP-3 (packed decimal) to avoid floating-point rounding
- The procedure must handle deadlocks internally with retry logic
Stored Procedure Design
Procedure Definition
The CREATE PROCEDURE statement registers the procedure in the DB2 catalog:
CREATE PROCEDURE PCFCU.XFER_FUNDS
(IN P_MEMBER_ID CHAR(10),
IN P_SOURCE_ACCT CHAR(12),
IN P_DEST_ACCT CHAR(12),
IN P_AMOUNT DECIMAL(13,2),
IN P_MEMO VARCHAR(50),
OUT P_CONFIRM_NUM CHAR(16),
OUT P_SOURCE_BAL DECIMAL(13,2),
OUT P_DEST_BAL DECIMAL(13,2),
OUT P_FEE_AMOUNT DECIMAL(13,2),
OUT P_STATUS_CODE CHAR(4),
OUT P_STATUS_MSG VARCHAR(100))
LANGUAGE COBOL
EXTERNAL NAME XFERFUND
PARAMETER STYLE GENERAL WITH NULLS
NOT DETERMINISTIC
MODIFIES SQL DATA
COMMIT ON RETURN NO
WLM ENVIRONMENT WLMBANK1
COLLID PCFCU_COLL
ASUTIME LIMIT 5
STAY RESIDENT YES;
Key design decisions in this definition:
- COMMIT ON RETURN NO: The caller (CICS or middleware) decides when to commit. This allows the caller to perform additional operations (like sending a confirmation message) within the same unit of work.
- PARAMETER STYLE GENERAL WITH NULLS: Allows the caller to pass NULL indicators, which the procedure uses to detect optional parameters (e.g., memo text).
- STAY RESIDENT YES: Keeps the COBOL load module in memory between calls, avoiding repeated load overhead for a high-volume procedure.
- ASUTIME LIMIT 5: Prevents runaway execution by limiting CPU time to 5 service units.
COBOL Procedure Implementation
Data Division
The LINKAGE SECTION maps directly to the CREATE PROCEDURE parameters:
IDENTIFICATION DIVISION.
PROGRAM-ID. XFERFUND.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
EXEC SQL INCLUDE SQLCA END-EXEC
*---------------------------------------------------------
* Account validation work areas
*---------------------------------------------------------
01 WS-SOURCE-ACCT-REC.
05 WS-SRC-ACCT-ID PIC X(12).
05 WS-SRC-MEMBER-ID PIC X(10).
05 WS-SRC-ACCT-TYPE PIC X(02).
05 WS-SRC-STATUS PIC X(01).
05 WS-SRC-BALANCE PIC S9(11)V99 COMP-3.
05 WS-SRC-HOLD-AMT PIC S9(11)V99 COMP-3.
05 WS-SRC-AVAIL-BAL PIC S9(11)V99 COMP-3.
01 WS-DEST-ACCT-REC.
05 WS-DST-ACCT-ID PIC X(12).
05 WS-DST-ACCT-TYPE PIC X(02).
05 WS-DST-STATUS PIC X(01).
05 WS-DST-BALANCE PIC S9(11)V99 COMP-3.
*---------------------------------------------------------
* Transfer processing work areas
*---------------------------------------------------------
01 WS-TRANSFER-FEE PIC S9(11)V99 COMP-3
VALUE +0.00.
01 WS-DEBIT-AMOUNT PIC S9(11)V99 COMP-3.
01 WS-CREDIT-AMOUNT PIC S9(11)V99 COMP-3.
01 WS-CONFIRM-NUMBER PIC X(16).
01 WS-TRANS-TIMESTAMP PIC X(26).
*---------------------------------------------------------
* Fee schedule (cross-account-type transfer fees)
*---------------------------------------------------------
01 WS-FEE-TABLE.
05 WS-FEE-ENTRY OCCURS 5 TIMES.
10 WS-FEE-FROM-TYPE PIC X(02).
10 WS-FEE-TO-TYPE PIC X(02).
10 WS-FEE-AMT PIC S9(05)V99 COMP-3.
01 WS-FEE-COUNT PIC 9(02) VALUE 0.
*---------------------------------------------------------
* Deadlock retry control
*---------------------------------------------------------
01 WS-RETRY-COUNT PIC 9(02) VALUE 0.
01 WS-MAX-RETRIES PIC 9(02) VALUE 3.
01 WS-RETRY-NEEDED PIC X(01) VALUE 'N'.
88 RETRY-YES VALUE 'Y'.
88 RETRY-NO VALUE 'N'.
*---------------------------------------------------------
* Sequence number for confirmation
*---------------------------------------------------------
01 WS-SEQ-NUM PIC S9(09) COMP.
01 WS-SEQ-CHAR PIC 9(09).
*---------------------------------------------------------
* Date/time work areas
*---------------------------------------------------------
01 WS-CURRENT-TS.
05 WS-TS-DATE PIC X(10).
05 WS-TS-TIME PIC X(16).
*---------------------------------------------------------
* Processing status
*---------------------------------------------------------
01 WS-PROC-STATUS PIC X(04) VALUE '0000'.
88 PROC-SUCCESS VALUE '0000'.
88 PROC-SRC-NOT-FOUND VALUE '1001'.
88 PROC-SRC-INACTIVE VALUE '1002'.
88 PROC-SRC-NOT-OWNER VALUE '1003'.
88 PROC-DST-NOT-FOUND VALUE '2001'.
88 PROC-DST-INACTIVE VALUE '2002'.
88 PROC-INSUFF-FUNDS VALUE '3001'.
88 PROC-DEADLOCK VALUE '4001'.
88 PROC-SQL-ERROR VALUE '9999'.
LINKAGE SECTION.
01 LS-MEMBER-ID PIC X(10).
01 LS-SOURCE-ACCT PIC X(12).
01 LS-DEST-ACCT PIC X(12).
01 LS-AMOUNT PIC S9(11)V99 COMP-3.
01 LS-MEMO PIC X(50).
01 LS-CONFIRM-NUM PIC X(16).
01 LS-SOURCE-BAL PIC S9(11)V99 COMP-3.
01 LS-DEST-BAL PIC S9(11)V99 COMP-3.
01 LS-FEE-AMOUNT PIC S9(11)V99 COMP-3.
01 LS-STATUS-CODE PIC X(04).
01 LS-STATUS-MSG PIC X(100).
* Null indicators for GENERAL WITH NULLS
01 LS-IND-MEMBER-ID PIC S9(04) COMP.
01 LS-IND-SOURCE-ACCT PIC S9(04) COMP.
01 LS-IND-DEST-ACCT PIC S9(04) COMP.
01 LS-IND-AMOUNT PIC S9(04) COMP.
01 LS-IND-MEMO PIC S9(04) COMP.
01 LS-IND-CONFIRM-NUM PIC S9(04) COMP.
01 LS-IND-SOURCE-BAL PIC S9(04) COMP.
01 LS-IND-DEST-BAL PIC S9(04) COMP.
01 LS-IND-FEE-AMOUNT PIC S9(04) COMP.
01 LS-IND-STATUS-CODE PIC S9(04) COMP.
01 LS-IND-STATUS-MSG PIC S9(04) COMP.
Procedure Division: Main Flow
The main processing flow validates inputs, executes the transfer, and handles deadlock retries:
PROCEDURE DIVISION USING
LS-MEMBER-ID LS-SOURCE-ACCT
LS-DEST-ACCT LS-AMOUNT
LS-MEMO LS-CONFIRM-NUM
LS-SOURCE-BAL LS-DEST-BAL
LS-FEE-AMOUNT LS-STATUS-CODE
LS-STATUS-MSG
LS-IND-MEMBER-ID LS-IND-SOURCE-ACCT
LS-IND-DEST-ACCT LS-IND-AMOUNT
LS-IND-MEMO LS-IND-CONFIRM-NUM
LS-IND-SOURCE-BAL LS-IND-DEST-BAL
LS-IND-FEE-AMOUNT LS-IND-STATUS-CODE
LS-IND-STATUS-MSG.
0000-MAIN-PROCESS.
* Initialize output parameters
INITIALIZE LS-CONFIRM-NUM
MOVE 0 TO LS-SOURCE-BAL
MOVE 0 TO LS-DEST-BAL
MOVE 0 TO LS-FEE-AMOUNT
MOVE '0000' TO LS-STATUS-CODE
MOVE SPACES TO LS-STATUS-MSG
* Set null indicators for output to non-null
MOVE 0 TO LS-IND-CONFIRM-NUM
MOVE 0 TO LS-IND-SOURCE-BAL
MOVE 0 TO LS-IND-DEST-BAL
MOVE 0 TO LS-IND-FEE-AMOUNT
MOVE 0 TO LS-IND-STATUS-CODE
MOVE 0 TO LS-IND-STATUS-MSG
* Validate input parameters are not null
IF LS-IND-MEMBER-ID < 0
OR LS-IND-SOURCE-ACCT < 0
OR LS-IND-DEST-ACCT < 0
OR LS-IND-AMOUNT < 0
MOVE '1000' TO LS-STATUS-CODE
MOVE 'Required parameter is null'
TO LS-STATUS-MSG
GOBACK
END-IF
* Validate amount is positive
IF LS-AMOUNT <= 0
MOVE '3002' TO LS-STATUS-CODE
MOVE 'Transfer amount must be positive'
TO LS-STATUS-MSG
GOBACK
END-IF
* Load fee schedule from DB2 table
PERFORM 1000-LOAD-FEE-SCHEDULE
* Execute transfer with deadlock retry
SET RETRY-NO TO TRUE
MOVE 0 TO WS-RETRY-COUNT
PERFORM 2000-EXECUTE-TRANSFER
PERFORM UNTIL RETRY-NO
ADD 1 TO WS-RETRY-COUNT
IF WS-RETRY-COUNT > WS-MAX-RETRIES
SET PROC-DEADLOCK TO TRUE
MOVE WS-PROC-STATUS TO LS-STATUS-CODE
MOVE 'Deadlock retry limit exceeded'
TO LS-STATUS-MSG
GOBACK
END-IF
PERFORM 2000-EXECUTE-TRANSFER
END-PERFORM
* Set output parameters
MOVE WS-PROC-STATUS TO LS-STATUS-CODE
IF PROC-SUCCESS
MOVE WS-CONFIRM-NUMBER TO LS-CONFIRM-NUM
MOVE WS-SRC-BALANCE TO LS-SOURCE-BAL
MOVE WS-DST-BALANCE TO LS-DEST-BAL
MOVE WS-TRANSFER-FEE TO LS-FEE-AMOUNT
MOVE 'Transfer completed successfully'
TO LS-STATUS-MSG
END-IF
GOBACK
.
Account Validation with Locking
The validation phase reads both accounts with FOR UPDATE to acquire exclusive locks, preventing concurrent modifications:
2000-EXECUTE-TRANSFER.
SET RETRY-NO TO TRUE
* Step 1: Validate and lock source account
PERFORM 2100-VALIDATE-SOURCE
IF NOT PROC-SUCCESS
MOVE WS-PROC-STATUS TO LS-STATUS-CODE
GOBACK
END-IF
* Step 2: Validate and lock destination account
PERFORM 2200-VALIDATE-DEST
IF NOT PROC-SUCCESS
EXEC SQL ROLLBACK END-EXEC
MOVE WS-PROC-STATUS TO LS-STATUS-CODE
GOBACK
END-IF
* Step 3: Check sufficient funds
PERFORM 2300-CHECK-FUNDS
IF NOT PROC-SUCCESS
EXEC SQL ROLLBACK END-EXEC
MOVE WS-PROC-STATUS TO LS-STATUS-CODE
GOBACK
END-IF
* Step 4: Calculate fee
PERFORM 2400-CALCULATE-FEE
* Step 5: Execute debit and credit
PERFORM 2500-EXECUTE-DEBIT
IF NOT PROC-SUCCESS
EXEC SQL ROLLBACK END-EXEC
GOBACK
END-IF
PERFORM 2600-EXECUTE-CREDIT
IF NOT PROC-SUCCESS
EXEC SQL ROLLBACK END-EXEC
GOBACK
END-IF
* Step 6: Record fee transaction if applicable
IF WS-TRANSFER-FEE > 0
PERFORM 2700-RECORD-FEE
IF NOT PROC-SUCCESS
EXEC SQL ROLLBACK END-EXEC
GOBACK
END-IF
END-IF
* Step 7: Insert audit records
PERFORM 2800-INSERT-AUDIT
* Step 8: Generate confirmation number
PERFORM 2900-GENERATE-CONFIRM
.
2100-VALIDATE-SOURCE.
SET PROC-SUCCESS TO TRUE
EXEC SQL
SELECT ACCT_ID, MEMBER_ID, ACCT_TYPE,
ACCT_STATUS, BALANCE, HOLD_AMOUNT
INTO :WS-SRC-ACCT-ID,
:WS-SRC-MEMBER-ID,
:WS-SRC-ACCT-TYPE,
:WS-SRC-STATUS,
:WS-SRC-BALANCE,
:WS-SRC-HOLD-AMT
FROM PCFCU.ACCOUNTS
WHERE ACCT_ID = :LS-SOURCE-ACCT
FOR UPDATE OF BALANCE, LAST_ACTIVITY
END-EXEC
EVALUATE SQLCODE
WHEN 0
CONTINUE
WHEN +100
SET PROC-SRC-NOT-FOUND TO TRUE
MOVE 'Source account not found'
TO LS-STATUS-MSG
GOBACK
WHEN -911
SET RETRY-YES TO TRUE
EXEC SQL ROLLBACK END-EXEC
GOBACK
WHEN -913
SET RETRY-YES TO TRUE
EXEC SQL ROLLBACK END-EXEC
GOBACK
WHEN OTHER
SET PROC-SQL-ERROR TO TRUE
STRING 'SQL error on source read: '
DELIMITED BY SIZE
SQLCODE
DELIMITED BY SIZE
INTO LS-STATUS-MSG
END-STRING
GOBACK
END-EVALUATE
* Validate account is active
IF WS-SRC-STATUS NOT = 'A'
SET PROC-SRC-INACTIVE TO TRUE
MOVE 'Source account is not active'
TO LS-STATUS-MSG
END-IF
* Validate ownership
IF WS-SRC-MEMBER-ID NOT = LS-MEMBER-ID
SET PROC-SRC-NOT-OWNER TO TRUE
MOVE 'Member does not own source account'
TO LS-STATUS-MSG
END-IF
.
2200-VALIDATE-DEST.
SET PROC-SUCCESS TO TRUE
EXEC SQL
SELECT ACCT_ID, ACCT_TYPE,
ACCT_STATUS, BALANCE
INTO :WS-DST-ACCT-ID,
:WS-DST-ACCT-TYPE,
:WS-DST-STATUS,
:WS-DST-BALANCE
FROM PCFCU.ACCOUNTS
WHERE ACCT_ID = :LS-DEST-ACCT
FOR UPDATE OF BALANCE, LAST_ACTIVITY
END-EXEC
EVALUATE SQLCODE
WHEN 0
CONTINUE
WHEN +100
SET PROC-DST-NOT-FOUND TO TRUE
MOVE 'Destination account not found'
TO LS-STATUS-MSG
WHEN -911
SET RETRY-YES TO TRUE
EXEC SQL ROLLBACK END-EXEC
WHEN -913
SET RETRY-YES TO TRUE
EXEC SQL ROLLBACK END-EXEC
WHEN OTHER
SET PROC-SQL-ERROR TO TRUE
STRING 'SQL error on dest read: '
DELIMITED BY SIZE
SQLCODE DELIMITED BY SIZE
INTO LS-STATUS-MSG
END-STRING
END-EVALUATE
IF SQLCODE = 0 AND WS-DST-STATUS NOT = 'A'
SET PROC-DST-INACTIVE TO TRUE
MOVE 'Destination account is not active'
TO LS-STATUS-MSG
END-IF
.
Fund Sufficiency Check and Fee Calculation
2300-CHECK-FUNDS.
SET PROC-SUCCESS TO TRUE
* Available balance = current balance minus holds
COMPUTE WS-SRC-AVAIL-BAL =
WS-SRC-BALANCE - WS-SRC-HOLD-AMT
* Anticipate the fee for the sufficiency check
PERFORM 2400-CALCULATE-FEE
* Total debit = transfer amount + fee
COMPUTE WS-DEBIT-AMOUNT =
LS-AMOUNT + WS-TRANSFER-FEE
IF WS-DEBIT-AMOUNT > WS-SRC-AVAIL-BAL
SET PROC-INSUFF-FUNDS TO TRUE
STRING 'Insufficient funds. Available: $'
DELIMITED BY SIZE
INTO LS-STATUS-MSG
END-STRING
END-IF
.
2400-CALCULATE-FEE.
MOVE 0 TO WS-TRANSFER-FEE
* Load fee schedule if not already loaded
IF WS-FEE-COUNT = 0
PERFORM 1000-LOAD-FEE-SCHEDULE
END-IF
* Look up fee for this account type combination
PERFORM VARYING WS-IDX FROM 1 BY 1
UNTIL WS-IDX > WS-FEE-COUNT
IF WS-FEE-FROM-TYPE(WS-IDX) =
WS-SRC-ACCT-TYPE
AND WS-FEE-TO-TYPE(WS-IDX) =
WS-DST-ACCT-TYPE
MOVE WS-FEE-AMT(WS-IDX)
TO WS-TRANSFER-FEE
END-IF
END-PERFORM
.
1000-LOAD-FEE-SCHEDULE.
MOVE 0 TO WS-FEE-COUNT
EXEC SQL
DECLARE CSR-FEES CURSOR FOR
SELECT FROM_ACCT_TYPE, TO_ACCT_TYPE,
FEE_AMOUNT
FROM PCFCU.TRANSFER_FEE_SCHEDULE
WHERE EFFECTIVE_DATE <= CURRENT DATE
AND (EXPIRY_DATE IS NULL
OR EXPIRY_DATE > CURRENT DATE)
END-EXEC
EXEC SQL OPEN CSR-FEES END-EXEC
PERFORM UNTIL SQLCODE = +100
OR WS-FEE-COUNT >= 5
EXEC SQL
FETCH CSR-FEES
INTO :WS-FEE-FROM-TYPE(WS-FEE-COUNT
+ 1),
:WS-FEE-TO-TYPE(WS-FEE-COUNT
+ 1),
:WS-FEE-AMT(WS-FEE-COUNT + 1)
END-EXEC
IF SQLCODE = 0
ADD 1 TO WS-FEE-COUNT
END-IF
END-PERFORM
EXEC SQL CLOSE CSR-FEES END-EXEC
.
Executing the Debit and Credit
The debit and credit operations update account balances and the last activity timestamp:
2500-EXECUTE-DEBIT.
SET PROC-SUCCESS TO TRUE
EXEC SQL
UPDATE PCFCU.ACCOUNTS
SET BALANCE = BALANCE - :LS-AMOUNT,
LAST_ACTIVITY = CURRENT TIMESTAMP
WHERE ACCT_ID = :LS-SOURCE-ACCT
END-EXEC
EVALUATE SQLCODE
WHEN 0
COMPUTE WS-SRC-BALANCE =
WS-SRC-BALANCE - LS-AMOUNT
WHEN -911
SET RETRY-YES TO TRUE
WHEN -913
SET RETRY-YES TO TRUE
WHEN OTHER
SET PROC-SQL-ERROR TO TRUE
STRING 'Debit failed. SQLCODE='
DELIMITED BY SIZE
SQLCODE DELIMITED BY SIZE
INTO LS-STATUS-MSG
END-STRING
END-EVALUATE
.
2600-EXECUTE-CREDIT.
SET PROC-SUCCESS TO TRUE
EXEC SQL
UPDATE PCFCU.ACCOUNTS
SET BALANCE = BALANCE + :LS-AMOUNT,
LAST_ACTIVITY = CURRENT TIMESTAMP
WHERE ACCT_ID = :LS-DEST-ACCT
END-EXEC
EVALUATE SQLCODE
WHEN 0
COMPUTE WS-DST-BALANCE =
WS-DST-BALANCE + LS-AMOUNT
WHEN -911
SET RETRY-YES TO TRUE
WHEN -913
SET RETRY-YES TO TRUE
WHEN OTHER
SET PROC-SQL-ERROR TO TRUE
STRING 'Credit failed. SQLCODE='
DELIMITED BY SIZE
SQLCODE DELIMITED BY SIZE
INTO LS-STATUS-MSG
END-STRING
END-EVALUATE
.
2700-RECORD-FEE.
SET PROC-SUCCESS TO TRUE
* Debit the fee from the source account
EXEC SQL
UPDATE PCFCU.ACCOUNTS
SET BALANCE = BALANCE - :WS-TRANSFER-FEE
WHERE ACCT_ID = :LS-SOURCE-ACCT
END-EXEC
IF SQLCODE = 0
COMPUTE WS-SRC-BALANCE =
WS-SRC-BALANCE - WS-TRANSFER-FEE
* Record fee as a transaction
EXEC SQL
INSERT INTO PCFCU.TRANSACTIONS
(ACCT_ID, TRANS_TYPE, TRANS_AMOUNT,
TRANS_DATE, DESCRIPTION)
VALUES
(:LS-SOURCE-ACCT, 'FE',
:WS-TRANSFER-FEE,
CURRENT TIMESTAMP,
'Transfer fee')
END-EXEC
IF SQLCODE NOT = 0
SET PROC-SQL-ERROR TO TRUE
STRING 'Fee insert failed. SQLCODE='
DELIMITED BY SIZE
SQLCODE DELIMITED BY SIZE
INTO LS-STATUS-MSG
END-STRING
END-IF
ELSE
SET PROC-SQL-ERROR TO TRUE
MOVE 'Fee debit update failed'
TO LS-STATUS-MSG
END-IF
.
Audit Trail and Confirmation
2800-INSERT-AUDIT.
* Get current timestamp for audit records
EXEC SQL
SET :WS-TRANS-TIMESTAMP = CURRENT TIMESTAMP
END-EXEC
* Debit-side audit record
EXEC SQL
INSERT INTO PCFCU.TRANSACTIONS
(ACCT_ID, TRANS_TYPE, TRANS_AMOUNT,
TRANS_DATE, DESCRIPTION,
RELATED_ACCT, MEMBER_ID)
VALUES
(:LS-SOURCE-ACCT, 'XD',
:LS-AMOUNT,
:WS-TRANS-TIMESTAMP,
:LS-MEMO :LS-IND-MEMO,
:LS-DEST-ACCT,
:LS-MEMBER-ID)
END-EXEC
IF SQLCODE NOT = 0
SET PROC-SQL-ERROR TO TRUE
MOVE 'Debit audit insert failed'
TO LS-STATUS-MSG
GOBACK
END-IF
* Credit-side audit record
EXEC SQL
INSERT INTO PCFCU.TRANSACTIONS
(ACCT_ID, TRANS_TYPE, TRANS_AMOUNT,
TRANS_DATE, DESCRIPTION,
RELATED_ACCT, MEMBER_ID)
VALUES
(:LS-DEST-ACCT, 'XC',
:LS-AMOUNT,
:WS-TRANS-TIMESTAMP,
:LS-MEMO :LS-IND-MEMO,
:LS-SOURCE-ACCT,
:LS-MEMBER-ID)
END-EXEC
IF SQLCODE NOT = 0
SET PROC-SQL-ERROR TO TRUE
MOVE 'Credit audit insert failed'
TO LS-STATUS-MSG
END-IF
.
2900-GENERATE-CONFIRM.
* Generate confirmation number from DB2 sequence
EXEC SQL
SELECT NEXT VALUE FOR PCFCU.XFER_SEQ
INTO :WS-SEQ-NUM
FROM SYSIBM.SYSDUMMY1
END-EXEC
IF SQLCODE = 0
MOVE WS-SEQ-NUM TO WS-SEQ-CHAR
STRING 'XFR'
DELIMITED BY SIZE
WS-TS-DATE(1:4)
DELIMITED BY SIZE
WS-SEQ-CHAR
DELIMITED BY SIZE
INTO WS-CONFIRM-NUMBER
END-STRING
ELSE
MOVE 'XFRTMP0000000000' TO WS-CONFIRM-NUMBER
END-IF
.
Client-Side COBOL (CICS Caller)
The CICS application program calls the stored procedure through EXEC SQL CALL:
*---------------------------------------------------------
* In the CICS COBOL program that calls the procedure
*---------------------------------------------------------
5000-CALL-TRANSFER-PROC.
EXEC SQL
CALL PCFCU.XFER_FUNDS
(:WS-MEMBER-ID,
:WS-FROM-ACCT,
:WS-TO-ACCT,
:WS-XFER-AMOUNT,
:WS-MEMO-TEXT,
:WS-CONFIRM-NUM,
:WS-NEW-FROM-BAL,
:WS-NEW-TO-BAL,
:WS-FEE-CHARGED,
:WS-RETURN-CODE,
:WS-RETURN-MSG)
END-EXEC
EVALUATE WS-RETURN-CODE
WHEN '0000'
MOVE 'Transfer successful' TO WS-MSG
MOVE WS-CONFIRM-NUM TO WS-DISPLAY-CONFIRM
EXEC SQL COMMIT END-EXEC
WHEN '1001'
MOVE 'Source account not found' TO WS-MSG
WHEN '1002'
MOVE 'Source account inactive' TO WS-MSG
WHEN '1003'
MOVE 'Account ownership error' TO WS-MSG
WHEN '2001'
MOVE 'Destination not found' TO WS-MSG
WHEN '3001'
MOVE 'Insufficient funds' TO WS-MSG
WHEN '4001'
MOVE 'System busy - retry' TO WS-MSG
WHEN OTHER
MOVE WS-RETURN-MSG TO WS-MSG
EXEC SQL ROLLBACK END-EXEC
END-EVALUATE
.
BIND JCL
The stored procedure's DBRM is bound into a package within the collection referenced by the CREATE PROCEDURE:
//BINDXFER JOB (ACCT),'BIND XFER PROC',CLASS=A,
// MSGCLASS=X,NOTIFY=&SYSUID
//*
//* BIND THE STORED PROCEDURE PACKAGE
//*
//BIND EXEC PGM=IKJEFT01
//DBRMLIB DD DSN=PCFCU.DB2.DBRMLIB,DISP=SHR
//SYSTSPRT DD SYSOUT=*
//SYSPRINT DD SYSOUT=*
//SYSTSIN DD *
DSN SYSTEM(DB2P)
BIND PACKAGE(PCFCU_COLL) -
MEMBER(XFERFUND) -
ACTION(REPLACE) -
ISOLATION(CS) -
VALIDATE(BIND) -
ACQUIRE(USE) -
RELEASE(COMMIT) -
QUALIFIER(PCFCU) -
EXPLAIN(YES) -
ENCODING(EBCDIC)
END
/*
//*
//* COMPILE AND LINK THE COBOL STORED PROCEDURE
//*
//COMPILE EXEC PGM=IGYCRCTL,
// PARM='RENT,APOST,DATA(31),DYNAM'
//SYSIN DD DSN=PCFCU.COBOL.SOURCE(XFERFUND),DISP=SHR
//SYSLIB DD DSN=PCFCU.COBOL.COPYLIB,DISP=SHR
// DD DSN=DSNV13R1.SRCLIB,DISP=SHR
//SYSLIN DD DSN=&&OBJ,DISP=(NEW,PASS),
// SPACE=(TRK,(5,5))
//SYSPRINT DD SYSOUT=*
//SYSUT1 DD SPACE=(CYL,(1,1))
//SYSUT2 DD SPACE=(CYL,(1,1))
//SYSUT3 DD SPACE=(CYL,(1,1))
//SYSUT4 DD SPACE=(CYL,(1,1))
//SYSUT5 DD SPACE=(CYL,(1,1))
//SYSUT6 DD SPACE=(CYL,(1,1))
//SYSUT7 DD SPACE=(CYL,(1,1))
//*
//LKED EXEC PGM=IEWL,PARM='RENT,LIST,MAP,XREF'
//SYSLIN DD DSN=&&OBJ,DISP=(OLD,DELETE)
//SYSLIB DD DSN=CEE.SCEELKED,DISP=SHR
// DD DSN=DSNV13R1.SDSNLOAD,DISP=SHR
//SYSLMOD DD DSN=PCFCU.PROCLIB(XFERFUND),DISP=SHR
//SYSPRINT DD SYSOUT=*
Isolation Level Analysis
The stored procedure uses Cursor Stability (CS) isolation, specified in the BIND. Here is why each alternative was considered and rejected:
Uncommitted Read (UR): Rejected because reading uncommitted balance changes could cause the procedure to transfer funds based on a balance that gets rolled back, resulting in an overdraft.
Cursor Stability (CS): Selected because it provides page-level locking during the read and hold-duration locking for updated rows. The FOR UPDATE clause on the SELECT escalates to exclusive locks on the specific rows being modified, preventing lost updates.
Read Stability (RS): Considered but not needed because the procedure reads exactly two rows (source and destination) and immediately updates them. RS would add overhead by keeping read locks on rows that CS would release, with no benefit for a two-row operation.
Repeatable Read (RR): Rejected because it would lock the entire range of qualifying rows in the ACCOUNTS table, not just the two rows being transferred. This would cause unnecessary contention in a high-volume environment.
Results and Lessons Learned
After deploying XFER_FUNDS as a stored procedure, Pacific Coast FCU observed:
-
Response time improved 35%: The five cross-address-space SQL calls were reduced to one stored procedure call. Average transfer time dropped from 85 milliseconds to 55 milliseconds.
-
Business logic consistency: Both the CICS and mobile banking channels now call the same procedure. Fee calculation discrepancies were eliminated. Monthly audit exceptions related to transfer fees dropped from 150 to zero.
-
Deadlock rate decreased: By acquiring both account locks in a deterministic order within the procedure (source first, destination second), deadlocks between concurrent transfers were reduced by 80%. The remaining deadlocks are handled by the retry logic and are invisible to users.
-
Deployment agility: When regulatory requirements changed the maximum transfer amount and added a new fee tier, only the stored procedure was modified. The CICS program and Java middleware required no changes.
-
Monitoring improvement: Because all transfers flow through one DB2 package, performance monitoring with DB2 accounting trace data became straightforward. The DBA can see exactly how many transfers occurred, the average elapsed time, and the CPU consumption per call.
The key architectural lesson: stored procedures are most valuable when multiple channels perform the same multi-statement database operation. The encapsulation benefit (consistent logic) is often more important than the performance benefit (reduced network calls).