Sample embedded SQL COBOL fragment

This code fragment sets the current connection, and inserts data into an Adaptive Server database:

*REMARKS. TRANSACTION-ID IS 'POPS'. 
*THIS TRANSACTION POPULATES A DATABASE'S DATA TABLE *WITH STOCK DATA ENTRIES. 


ENVIRONMENT DIVISION. 
DATA DIVISION. 
WORKING-STORAGE SECTION. 
COPY DFHBMSCA. 
COPY DFHAID. 
COPY AIXCSET. 
EXEC SQL INCLUDE SQLCA END-EXEC. 
77  RESPONSE            PIC 9(8) COMP. 
01  MSG-LIST. 
02  MSG-1           PIC X(70) VALUE 
'Transaction Failed: Unable To Prime Stock' 
-'Table.'. 
02  MSG-2           PIC X(70) VALUE
'Stock Records Added Successfully.'.
01  TRANSFAIL           PIC X(70).

EXEC SQL BEGIN DECLARE SECTION END-EXEC.
01  STOCK-RECORD.
02  STOCK-NUM       PIC X(5).
02  ITEM-DESC       PIC X(30).
02  STOCK-QTY       PIC X(7).
02  UNIT-PRICE PIC S9(4)V99 VALUE ZEROES.
EXEC SQL END DECLARE SECTION END-EXEC. 

PROCEDURE DIVISION. 
* CHECK BASIC REQUEST TYPE 
* 
IF EIBAID = DFHCLEAR 
EXEC CICS SEND CONTROL FREEKB 
END-EXEC 
EXEC CICS RETURN 
END-EXEC 
END-IF. 


* MAIN PROCESSING 
*SET UP STOCK RECORD DETAILS AND THEN WRITE OUT 
*STOCK RECORD. 
* 
MOVE '31421'TO STOCK-NUM. 
MOVE 'Widget (No.7)'TO ITEM-DESC. 
MOVE '0050035'TO STOCK-QTY. 
MOVE 25.55 TO UNIT-PRICE. 
PERFORM WRITE-STOCKREC. 

MOVE '43567'TO STOCK-NUM.
MOVE 'Splunkett ZR-1'TO ITEM-DESC.
MOVE '0005782'TO STOCK-QTY.
MOVE 143.79 TO UNIT-PRICE.
PERFORM WRITE-STOCKREC.

EXEC CICS SYNCPOINT
RESP(RESPONSE)
END-EXEC.

IF RESPONSE NOT = DFHRESP(NORMAL) 
MOVE MSG-1 TO TRANSFAIL 
PERFORM FAIL-TRANS 
END-IF. 

MOVE MSG-2 TO MSGOUTO. 
EXEC CICS SEND MAP('MSGLINE') 
MAPSET('AIXCSET') 
FREEKB 
END-EXEC. 
EXEC CICS RETURN 
END-EXEC. 
GOBACK. 


* ATTEMPT TO WRITE OUT NEW STOCK RECORD. 
* 
WRITE-STOCKREC. 
EXEC SQL SET CONNECTION connection_2 
END-EXEC 

IF SQLCODE NOT = 0 
MOVE MSG-1 TO TRANSFAIL 
PERFORM FAIL-TRANS 
END-IF. 

EXEC SQL INSERT INTO STOCK VALUES (:STOCK-RECORD) 
END-EXEC 

IF SQLCODE NOT = 0 
MOVE MSG-1 TO TRANSFAIL 
PERFORM FAIL-TRANS 
END-IF. 


* IF UNABLE TO APPLY CREATE, END TRANSACTION 
* AND DISPLAY REASON FOR FAILURE. 
* 
FAIL-TRANS. 
MOVE TRANSFAIL TO MSGOUTO 
EXEC CICS SEND MAP('MSGLINE') 
MAPSET('AIXCSET') 
FREEKB 
END-EXEC 
EXEC CICS RETURN 
END-EXEC.