When writing COBOL programs for Teradata mode, define one SQLCA per program. For example, if an application consists of one main program and two subprograms, the main program and each of the subprograms must contain an SQLCA.
Declare the SQLCA in the WORKING STORAGE SECTION of the program, in one of two ways:
- Code an EXEC SQL INCLUDE SQLCA statement, which causes PP2 to generate the structure.
- Code the SQLCA directly into the application. The structure must be named SQLCA and must be unique.
Declare an SQLCA structure in COBOL as:
01 SQLCA. 05 SQLCAID PIC X(8) VALUE ’SQLCA ’. 05 SQLCABC PIC S9(9) <comp> VALUE +136. 05 SQLCODE PIC S9(9) <comp>. 05 SQLERRM. 49 SQLERRML PIC S9(4) <comp>. 49 SQLERRMC PIC X(70). 05 SQLERRP PIC X(8). 05 SQLERRD OCCURS 6 TIMES PIC S9(9) <comp>. 05 SQLWARN. 10 SQLWARN0 PIC X(1). 10 SQLWARN1 PIC X(1). 10 SQLWARN2 PIC X(1). 10 SQLWARN3 PIC X(1). 10 SQLWARN4 PIC X(1). 10 SQLWARN5 PIC X(1). 10 SQLWARN6 PIC X(1). 10 SQLWARN7 PIC X(1). 10 SQLWARN8 PIC X(1). 10 SQLWARN9 PIC X(1). 10 SQLWARNA PIC X(1). 05 SQLEXT PIC X(5).
where <comp> is COMP-5 for MF COBOL and COMP for all other COBOL compilers.
SQLCA is documented in Teradata Vantage™ - SQL Stored Procedures and Embedded SQL, B035-1148.