COBOL does not conveniently support dynamic SQL. Writing a PL/I or C subroutine to handle dynamic requests is one option. To use COBOL, follow these guidelines:
- The application must supply the necessary SQLDA structures.
A sample SQLDA takes the following form:
01 SQLDA. 05 SQLDAID PIC X(8) VALUE ’SQLDA ’. 05 SQLDABC PIC S9(9) <comp> VALUE +104. 05 SQLN PIC S9(4) <comp> VALUE +2. 05 SQLD PIC S9(4) <comp> VALUE +2. 05 SQLTYP-001 PIC S9(4) <comp> VALUE +496. 05 SQLLEN-001 PIC S9(4) <comp> VALUE +4. 05 SQLDAT-001 PIC 9(9) <comp>. 05 SQLIND-001 PIC 9(9) <comp>. 05 SQLNAM-001 PIC X(32). 05 SQLTYP-002 PIC S9(4) <comp> VALUE +496. 05 SQLLEN-002 PIC S9(4) <comp> VALUE +4. 05 SQLDAT-002 PIC 9(9) <comp>. 05 SQLIND-002 PIC 9(9) <comp>. 05 SQLNAM-002 PIC X(32).
where <comp> is COMP-5 for MF COBOL and COMP for all other COBOL compilers.
Teradata Vantage™ - SQL Stored Procedures and Embedded SQL, B035-1148 describes the SQLDA and its fields.
- The SQLDAT field of the SQLDA must contain the address of the host variable where data is to be obtained (input) or returned (output).
The SQLIND field of the SQLDA must contain the address of the host variable, if any, where the indicator value is to be placed.
Initialize the SQLIND field to X’00’ (LOW-VALUES) if the field is not used.
The database supplies a routine through CLIv2 for setting the address of a field in COBOL. DBCHSAD places the address of a specified variable into a specified field.
This routine requires three parameters, a 4-byte field to contain the return code of the routine, a 4 byte field to store the address, and the variable whose address is desired.
An example using the mentioned SQLDA takes the following form:
CALL ’DBCHSAD’ return-code, SQLDAT-001, host-var
The precompiler generates the field SQL-RETCODE, which can be used to receive the return code, or the application can define a different field for the return code.
Declare the field as a PIC S9(9) COMP field. This field contains a value of 0 or 2 upon return from DBCHSAD.
A 0 indicates successful completion, while 2 indicates an incorrect number of parameters has been passed.
- The string expression used for the PREPARE or EXECUTE IMMEDIATE statements must be a SQL string (that is a VARCHAR structure).
See Teradata Vantage™ - SQL Fundamentals, B035-1141 for additional information on SQL strings.
For information on declaring VARCHAR fields, see SQL Strings and Host Variable Declaration.