IDENTIFICATION DIVISION. CHANGE PROGRAM-ID. DB2SP2. *--------------------------------------------------------------- * VEGA STORED PROCEDURE SAMPLE TO ACCESS DB2 * *--------------------------------------------------------------- * * FUNCTION = THIS MODULE RETURNS EMP TABLE ROWS FROM DB2 * WHERE SALARY > W-INP-SALARY * * COMMENTS * * DB2 WILL BE ACCESSED USING THE VEGA IDMS/DB2 INTERFACE WITH * CALL ATTACHMENT FACILITY (CAF). *--------------------------------------------------------------- ENVIRONMENT DIVISION. IDMS-CONTROL SECTION. PROTOCOL MODE IDMS-DC DEBUG. DATA DIVISION. WORKING-STORAGE SECTION. 01 SNAP-TITLE. 02 FILLER PIC X(2) VALUE SPACES. CHANGE 02 FILLER PIC X(10) VALUE 'DB2SP2'. 02 SNAP-TITLE-TEXT PIC X(122) VALUE SPACES. 01 SNAP-LENGTH PIC S9(4) COMP. 01 WORK-FIELDS. 02 W-IFIXLEN PIC S9(4) VALUE +100. 02 W-OFIXLEN PIC S9(4) VALUE +172. 02 W-LENGTH PIC S9(4) VALUE +0. 02 W-SQLDAFIXLEN PIC S9(4) COMP VALUE +16. 02 W-SQLVARLEN PIC S9(4) COMP VALUE +44. 02 IDMS-ERROR-MSG. 03 FILLER PIC X(12) VALUE 'IDMS ERROR:'. 03 IDMS-ERROR-STATUS PIC X(4). 02 CAF-ERROR-MSG. 03 FILLER PIC X(11) VALUE 'CAF ERROR.'. 03 FILLER PIC X(7) VALUE 'RETURN:'. 03 CAF-RETC PIC -------9. 03 FILLER PIC X(8) VALUE ' REASON:'. 03 CAF-RESC-SUBC PIC 9(4). 03 CAF-RESC-IDNT PIC 9(4). ****************************************************************** * INCLUDE DB2 SQLCA ****************************************************************** EXEC SQL INCLUDE SQLCA END-EXEC. ****************************************************************** * COPY THE VEGA SQLCA EXTENSION ****************************************************************** 05 COPY IDMS SQLCAX. ****************************************************************** * COPY VEGA CAF CLIENT WORK AREA ****************************************************************** COPY IDMS WDB2CAF-WORK. ****************************************************************** * THE JDBC/ODBC DRIVER SUPPORTS THESE SQL DATA TYPES. * USE THESE TYPES IN FILL-SQLDA BELOW TO DEFINE FIELD/PARAMETER * DATA TYPES. ****************************************************************** 01 W-SQL-TYPES. 02 W-SQL-DATE-NOT-NULL PIC S9(4) COMP VALUE +384. 02 W-SQL-DATE PIC S9(4) COMP VALUE +385. 02 W-SQL-TIME-NOT-NULL PIC S9(4) COMP VALUE +388. 02 W-SQL-TIME PIC S9(4) COMP VALUE +389. 02 W-SQL-TIMESTAMP-NOT-NULL PIC S9(4) COMP VALUE +392. 02 W-SQL-TIMESTAMP PIC S9(4) COMP VALUE +393. 02 W-SQL-VARCHAR-NOT-NULL PIC S9(4) COMP VALUE +448. 02 W-SQL-VARCHAR PIC S9(4) COMP VALUE +449. 02 W-SQL-CHAR-NOT-NULL PIC S9(4) COMP VALUE +452. 02 W-SQL-CHAR PIC S9(4) COMP VALUE +453. 02 W-SQL-LONGVARCHAR-NOT-NULL PIC S9(4) COMP VALUE +456. 02 W-SQL-LONGVARCHAR PIC S9(4) COMP VALUE +457. 02 W-SQL-FLOAT-NOT-NULL PIC S9(4) COMP VALUE +480. 02 W-SQL-FLOAT PIC S9(4) COMP VALUE +481. 02 W-SQL-PACKED-NOT-NULL PIC S9(4) COMP VALUE +484. 02 W-SQL-PACKED PIC S9(4) COMP VALUE +485. 02 W-SQL-INTEGER-NOT-NULL PIC S9(4) COMP VALUE +496. 02 W-SQL-INTEGER PIC S9(4) COMP VALUE +497. 02 W-SQL-SMALL-NOT-NULL PIC S9(4) COMP VALUE +500. 02 W-SQL-SMALL PIC S9(4) COMP VALUE +501. ****************************************************************** * SET THE NUMBER OF INPUT PARAMETERS ****************************************************************** CHANGE 01 W-NUMBER-OF-INPUT-PARMS PIC S9(4) COMP VALUE +1. ****************************************************************** * SET THE NUMBER OF OUTPUT FIELDS ****************************************************************** CHANGE 01 W-NUMBER-OF-OUTPUT-FIELDS PIC S9(4) COMP VALUE +15. ****************************************************************** * VG-SQLDA CONTAINS FIELD DEFINITIONS. THESE ARE SET IN THE * FILL-SQLDA SECTION. ****************************************************************** 01 VG-SQLDA. * EYE CATCHER 05 VG-SQLDAID PIC X(8) VALUE 'SQLDA'. * TOTAL LENGTH OF SQLDA 05 VG-SQLDABC PIC S9(8) COMP. * TOTAL NUMBER OF OCCURRENCES IN VG-SQLVAR 05 VG-SQLN PIC S9(4) COMP VALUE +0. * TOTAL NUMBER OF COLUMNS DESCRIBED IN VG-SQLVAR 05 VG-SQLD PIC S9(4) COMP VALUE +0. ****************************************************************** * EACH SQLVAR DESCRIBES A FIELD OR PARAMETER * * NOTE: OCCURS VALUE MUST BE GE W-NUMBER-OF-INPUT-PARMS + * W-NUMBER-OF-OUTPUT-FIELDS ****************************************************************** CHANGE 05 VG-SQLVAR OCCURS 16. 06 VG-SQLTYPE PIC S9(4) COMP. 88 SQL-DATE VALUE +384 +385. 88 SQL-TIME VALUE +388 +389. 88 SQL-TIMESTAMP VALUE +392 +393. 88 SQL-VARCHAR VALUE +448 +449. 88 SQL-CHAR VALUE +452 +453. 88 SQL-LONGVARCHAR VALUE +456 +457. 88 SQL-FLOAT VALUE +480 +481. 88 SQL-PACKED VALUE +484 +485. 88 SQL-INTEGER VALUE +496 +497. 88 SQL-SMALL VALUE +500 +501. 06 VG-SQLLEN PIC S9(4) COMP. 06 VG-SQLLEN-R REDEFINES VG-SQLLEN. 07 VG-PRECISION PIC X. 07 VG-DECIMALS PIC X. 06 VG-SQLDATA PIC S9(9) COMP. 06 VG-SQLIND PIC S9(9) COMP. 06 VG-SQLNAME. 07 VG-SQLNAMEL PIC S9(4) COMP. 07 VG-SQLNAMET PIC X(30). ****************************************************************** * INPUT FROM THE JDBC/ODBC DRIVER WILL BE MOVED HERE. ****************************************************************** 01 WSQLINPUT. ****************************************************************** * NOTE: YOU MUST HAVE ONE INDICATOR VARIABLE FOR EACH * INPUT PARAMETER, EVEN IF YOU DO NOT USE INDICATOR * VARIABLES IN YOUR SQL STATEMENTS. * JDBC/ODBC DRIVER ALWAYS INSERTS AN INDICATOR VARIABLE * (BINARY HALW-WORD) IMMEDIATELY AFTER THE DATA FIELD. * DO NOT USE COMP SYNC! ****************************************************************** CHANGE 04 W-INP-SALARY PIC S9(7)V9(2) USAGE COMP-3. CHANGE 04 W-INP-SALARY-IND PIC S9(4) COMP. 88 W-INP-SALARY-NULL VALUE -1. ****************************************************************** * THIS IS THE OUTPUT DATA AREA. THIS PROGRAM WRITES OUTPUT DATA * TO A PREDEFINED SCRATCH AREA. WHEN CONTROL RETURNS TO THE * APPLICATION SERVER, IT SENDS THE SCRATCH RECORDS TO THE * JDBC/ODBC DRIVER. ****************************************************************** 01 WSQLOUT. ****************************************************************** * THIS IS THE FIXED HEADER OF OUTPUT DATA AREA. ****************************************************************** COPY WSQLOFIX. ****************************************************************** * NOTE: THE MAXIMUM SIZE OF INPUT/OUTPUT IS 8000 BYTES ****************************************************************** 02 WSQLOVAR PIC X(8000). 02 WSQLOUTPUT REDEFINES WSQLOVAR. ****************************************************************** * NOTE: YOU MUST HAVE ONE INDICATOR VARIABLE FOR EACH * OUTPUT FIELD, EVEN IF YOU DO NOT USE INDICATOR * VARIABLES IN YOUR SQL STATEMENTS. * * OUTPUT INDICATOR VARIABLES PRECEDE OUTPUT VARIABLES. ****************************************************************** 03 W-OUT-DATA. 04 W-OUT-INDICATORS. CHANGE 05 ROW-IND PIC S9(4) COMP. CHANGE 05 EMPNO-IND PIC S9(4) COMP. CHANGE 05 FIRSTNME-IND PIC S9(4) COMP. CHANGE 05 MIDINIT-IND PIC S9(4) COMP. CHANGE 05 LASTNAME-IND PIC S9(4) COMP. CHANGE 05 WORKDEPT-IND PIC S9(4) COMP. CHANGE 05 PHONENO-IND PIC S9(4) COMP. CHANGE 05 HIREDATE-IND PIC S9(4) COMP. CHANGE 05 JOB-IND PIC S9(4) COMP. CHANGE 05 EDLEVEL-IND PIC S9(4) COMP. CHANGE 05 SEX-IND PIC S9(4) COMP. CHANGE 05 BIRTHDATE-IND PIC S9(4) COMP. CHANGE 05 SALARY-IND PIC S9(4) COMP. CHANGE 05 BONUS-IND PIC S9(4) COMP. CHANGE 05 COMM-IND PIC S9(4) COMP. 04 W-OUT-VARIABLES. CHANGE* ROW WILL BE INCREMENTED BY ONE FOR EACH OCCURRENCE CHANGE 05 ROW PIC S9(4) COMP. CHANGE 05 EMPNO PIC X(6). CHANGE 05 FIRSTNME. CHANGE 49 FIRSTNMEL PIC S9(4) COMP. CHANGE 49 FIRSTNMET PIC X(12). CHANGE 05 MIDINIT PIC X(1). CHANGE 05 LASTNAME. CHANGE 49 LASTNAMEL PIC S9(4) USAGE COMP. CHANGE 49 LASTNAMET PIC X(15). CHANGE 05 WORKDEPT PIC X(3). CHANGE 05 PHONENO PIC X(4). CHANGE 05 HIREDATE PIC X(10). CHANGE 05 JOB PIC X(8). CHANGE 05 EDLEVEL PIC S9(4) USAGE COMP. CHANGE 05 SEX PIC X(1). CHANGE 05 BIRTHDATE PIC X(10). CHANGE 05 SALARY PIC S9(7)V9(2) USAGE COMP-3. CHANGE 05 BONUS PIC S9(7)V9(2) USAGE COMP-3. CHANGE 05 COMM PIC S9(7)V9(2) USAGE COMP-3. ****************************************************************** *PARMS FOR DSNTIAR ****************************************************************** 01 DB2-MESSAGE. 03 MESSAGE-LEN PIC S9(4) COMP VALUE +395. 03 MESSAGE-TXT. 04 FILLER PIC X(79) OCCURS 5. 01 LRECL PIC S9(8) COMP VALUE +79. ****************************************************************** * SUBSCHEMA-CTRL ****************************************************************** COPY IDMS SUBSCHEMA-CTRL. ****************************************************************** * DECLARE DB2 CURSOR * ************************************************************* CHANGE EXEC SQL CHANGE DECLARE CEMP CURSOR FOR CHANGE SELECT EMPNO, FIRSTNME,MIDINIT, LASTNAME, WORKDEPT, CHANGE PHONENO, HIREDATE, JOB, EDLEVEL, SEX, CHANGE BIRTHDATE, SALARY, BONUS, COMM CHANGE FROM DSN8510.EMP CHANGE WHERE SALARY > :W-INP-SALARY CHANGE ORDER BY EMPNO CHANGE FOR FETCH ONLY CHANGE WITH UR CHANGE END-EXEC ************************************************************************ * THERE ARE ALWAYS THREE PROGRAM ARGUMENTS * ************************************************************* LINKAGE SECTION. * ************************************************************* * THIS IS THE OUTPUT SCRATCH NAME * ************************************************************* 01 WGSVOUT PIC X(8). * ************************************************************* * WORK AREA CAN BE USED TO SAVE DATA BETWEEN SUBSEQUENT * EXECUTIONS OF THE PROGRAM WITHIN THE SAME TASK * ************************************************************* 01 WORK-AREA PIC X(1024). * ************************************************************* * THIS IS THE INPUT FROM THE JDBC/ODBC DRIVER * ************************************************************* COPY WSQLINP. ************************************************************************ PROCEDURE DIVISION USING WGSVOUT, WORK-AREA, WSQLINP. MAIN-LINE. ****************************************************************** * A NON-ZERO VALUE OF WSQLCMSG FORCES JDBC/ODBC DRIVER TO ABEND. ****************************************************************** MOVE 0 TO WSQLCMSG. EXEC SQL WHENEVER SQLERROR GO TO SQLERROR END-EXEC. TEST MOVE '*** WSQLINP (1) ***' TO SNAP-TITLE-TEXT TEST MOVE 200 TO SNAP-LENGTH TEST SNAP TITLE SNAP-TITLE FROM WSQLINP LENGTH SNAP-LENGTH MOVE LOW-VALUES TO WSQLOVAR. * ************************************************************* * THE JDBC/ODBC DRIVER SENDS 'PROCINFO' WHEN PREPARING * THE CALL OR WHEN EXECUTING GETPROCEDURECOLUMNS/ * SQLPROCEDURECOLUMNS * ************************************************************* IF (WSQLCMDC = 'PROCINFO') THEN PERFORM PROCINFO GOBACK END-IF. * ************************************************************* * OTHERWISE, THE COMMAND IS 'EXECUTE' * ************************************************************* * ************************************************************* * THE EXPECTED LENGTH OF THE INPUT IS * (1) THE LENGTH OF THE FIXED PART OF SQLDA + * (2) THE LENGTH OF THE VARIABLE PART OF SQLDA + * (3) THE LENGTH OF INPUT PARAMETERS AND INDICATORS * ************************************************************* COMPUTE W-LENGTH = W-SQLDAFIXLEN + W-NUMBER-OF-INPUT-PARMS * W-SQLVARLEN + LENGTH OF WSQLINPUT. IF (WSQLILEN > W-LENGTH) THEN * ISSUE ERROR MESSAGE MOVE 'INPUT TOO LONG' TO SQLERRMC PERFORM SEND-ERROR GOBACK END-IF. * ************************************************************* * INPUT FROM THE DRIVER CONSISTS OF * * EITHER * * (1) SQLDA (DESCRIPTION OF INPUT PARAMETER(S)) * (2) INDICATOR VARIABLE(S) * (3) PARAMETER DATA * * OR * * OF NO INPUT. IN THIS CASE THE STORED PROCEDURE MAY USE * DFAULT PARAMETER VALUE(S). * * WSQLILEN CONTAINS THE LENGTH OF THE INPUT MESSAGE. * ************************************************************* IF (WSQLILEN NOT > 0) THEN * ********************************************************** * USE DEFAULTS * ********************************************************** MOVE 0 TO W-INP-SALARY-IND MOVE 0 TO W-INP-SALARY ELSE * ********************************************************** * JDBC/ODBC DRIVER HAS SENT INPUT PARAMETER(S). * CHECK IF THE INPUT IS VALID. * ********************************************************** MOVE WSQLIVAR TO VG-SQLDA TEST MOVE '*** SQLDA IN ***' TO SNAP-TITLE-TEXT TEST MOVE VG-SQLDABC TO SNAP-LENGTH TEST SNAP TITLE SNAP-TITLE FROM VG-SQLDA LENGTH SNAP-LENGTH * ********************************************************** * VG-SQLDA NOW CONTAINS DESCRIPTION OF INPUT PARAMETER(S) * ********************************************************** IF (VG-SQLD < W-NUMBER-OF-INPUT-PARMS) THEN * ISSUE ERROR MESSAGE MOVE 'INPUT PARAMETER(S) MISSING' TO SQLERRMC PERFORM SEND-ERROR GOBACK END-IF IF (VG-SQLD > W-NUMBER-OF-INPUT-PARMS) THEN * ISSUE ERROR MESSAGE MOVE 'TOO MANY INPUT PARAMETERS' TO SQLERRMC PERFORM SEND-ERROR GOBACK END-IF * ********************************************************** * THE NUMBER OF PARAMETERS IS CORRECT. * CHECK THE DATA TYPE(S). * ********************************************************** CHANGE IF (NOT (SQL-PACKED(1))) THEN * ISSUE ERROR MESSAGE MOVE 'FIRST INPUT PARAMETER NOT PACKED DECIMAL' TO SQLERRMC PERFORM SEND-ERROR GOBACK END-IF * ********************************************************** * PARAMETER DEFINITIONS ARE CORRECT. * COPY THE INPUT DATA. DATA FOLLOWS DESCRIPTIONS. * ********************************************************** MOVE WSQLIVAR (VG-SQLDABC + 1: ) TO WSQLINPUT * ********************************************************** * YOU CAN CHECK NULL VALUES, IF NEEDED * ********************************************************** IF (W-INP-SALARY-NULL) THEN MOVE 0 TO W-INP-SALARY END-IF END-IF. * ************************************************************* * NOW WE CAN ACCESS DB2. * WE USE THE DB2 THREAD STARTED BY THE APPLICATION SERVER * ************************************************************* TEST MOVE '*** WSQLINPUT (2) ***' TO SNAP-TITLE-TEXT. TEST MOVE LENGTH OF WSQLINPUT TO SNAP-LENGTH. TEST SNAP TITLE SNAP-TITLE FROM WSQLINPUT LENGTH SNAP-LENGTH. PERFORM CAF-CONTINUE-RETURN. IF (WDB2CAF-RETC NOT = 0) THEN MOVE WDB2CAF-RETC TO CAF-RETC MOVE WDB2CAF-RESC-SUBC TO CAF-RESC-SUBC MOVE WDB2CAF-RESC-IDNT TO CAF-RESC-IDNT MOVE CAF-ERROR-MSG TO SQLERRMC MOVE 20 TO SNAP-LENGTH SNAP TITLE SNAP-TITLE FROM WDB2CAF-SSNM LENGTH SNAP-LENGTH PERFORM SEND-ERROR GOBACK END-IF. * ************************************************************* * OPEN THE DB2 CURSOR. * ************************************************************* EXEC SQL OPEN CEMP END-EXEC. * ************************************************************* * COPY THE SQLCA AND SEND IT TO THE JDBC/ODBC DRIVER. * ************************************************************* MOVE SQLCA TO WSQLSQCA. * ************************************************************* * WE SEND ONLY THE FIXED PART OF THE WSQLOUT. THIS CONTAINS * SQLCODE. * ************************************************************* MOVE 0 TO WSQLOLEN. COMPUTE W-LENGTH = WSQLOLEN + W-OFIXLEN TEST MOVE '*** SQLCA OUT ***' TO SNAP-TITLE-TEXT. TEST MOVE W-LENGTH TO SNAP-LENGTH. TEST SNAP TITLE SNAP-TITLE FROM WSQLOUT LENGTH SNAP-LENGTH. PUT SCRATCH AREA ID WGSVOUT FROM WSQLOUT LENGTH W-LENGTH. * ************************************************************* * CLEAN THE OUTPUT DATA AREA, JUST IN CASE... * ************************************************************* MOVE LOW-VALUES TO WSQLOVAR. MOVE 0 TO ROW. * ************************************************************* * SET THE LENGTH OF VARIABLE PART OF THE OUTPUT MESSAGE * ************************************************************* MOVE LENGTH OF W-OUT-DATA TO WSQLOLEN. * ************************************************************* * SET THE TOTAL LENGTH OF THE MESSAGE * ************************************************************* COMPUTE W-LENGTH = WSQLOLEN + W-OFIXLEN. * ************************************************************* * RETRIEVE THE FIRST ROW * ************************************************************* PERFORM FETCH-CEMP. * ************************************************************* * LOOP ALL ROWS * ************************************************************* PERFORM UNTIL (SQLCODE NOT = 0) * ********************************************************** * SEND THE OUTPUT MESSAGE * ********************************************************** PUT SCRATCH AREA ID WGSVOUT FROM WSQLOUT LENGTH W-LENGTH * ********************************************************** * RETRIEVE THE NEXT ROW, IF ANY * ********************************************************** PERFORM FETCH-CEMP END-PERFORM. * ************************************************************* * SEND THE SQLCODE. IT SHOULD ALWAYS BE 100 HERE, * BECAUSE WE USE WHENEVER SQLERROR. * ************************************************************* MOVE SQLCA TO WSQLSQCA. TEST MOVE '*** END OF LOOP ***' TO SNAP-TITLE-TEXT. TEST SNAP TITLE SNAP-TITLE. TEST MOVE '*** WSQLOUT ***' TO SNAP-TITLE-TEXT TEST MOVE W-OFIXLEN TO SNAP-LENGTH. TEST SNAP TITLE SNAP-TITLE FROM WSQLOUT LENGTH SNAP-LENGTH. PUT SCRATCH AREA ID WGSVOUT FROM WSQLOUT LENGTH W-OFIXLEN. * ************************************************************* * CLOSE THE CURSOR * ************************************************************* EXEC SQL CLOSE CEMP END-EXEC. * ************************************************************* * RETURN TO IDMS CLIENT * ************************************************************* ENDPROGRAM. GOBACK. ************************************************************************ FETCH-CEMP SECTION. TEST*** MOVE '*** ENTERING FETCH CEMP ***' TO SNAP-TITLE-TEXT. TEST*** SNAP TITLE SNAP-TITLE. EXEC SQL FETCH CEMP INTO :EMPNO, :FIRSTNME, :MIDINIT, :LASTNAME, :WORKDEPT, :PHONENO, :HIREDATE, :JOB, :EDLEVEL, :SEX, :BIRTHDATE, :SALARY, :BONUS, :COMM END-EXEC. * ************************************************************* * AS AN EXAMPLE, WE COUNT EACH ROW. THE ROW FIELD IS AN OUTPUT * PARAMETER. IT IS NOT RETRIEVED FROM THE DATABASE. * ************************************************************* ADD 1 TO ROW. TEST*** MOVE '*** LEAVING FETCH CEMP***' TO SNAP-TITLE-TEXT. TEST*** SNAP TITLE SNAP-TITLE. ************************************************************************ FILL-SQLDA SECTION. TEST*** MOVE '*** ENTERING FILL-SQLDA ***' TO SNAP-TITLE-TEXT. TEST*** SNAP TITLE SNAP-TITLE. * ************************************************************* * FILL DEFINITIONS OF RESULT SET (OUTPUT) VARIABLES FIRST. * SEPARATE OUTPUT PARAMETERS ARE NOT SUPPORTED. THEY ARE * TREATED LIKE OUTPUT VARIABLES RETRIEVED FROM THE DATABASE. * ************************************************************* MOVE W-NUMBER-OF-OUTPUT-FIELDS TO VG-SQLN, VG-SQLD. * ************************************************************* * SET DATA TYPES * ************************************************************* MOVE W-SQL-SMALL TO VG-SQLTYPE (1). MOVE W-SQL-CHAR TO VG-SQLTYPE (2). MOVE W-SQL-VARCHAR TO VG-SQLTYPE (3). MOVE W-SQL-CHAR TO VG-SQLTYPE (4). MOVE W-SQL-VARCHAR TO VG-SQLTYPE (5). MOVE W-SQL-CHAR TO VG-SQLTYPE (6). MOVE W-SQL-CHAR TO VG-SQLTYPE (7). MOVE W-SQL-CHAR TO VG-SQLTYPE (8). MOVE W-SQL-CHAR TO VG-SQLTYPE (9). MOVE W-SQL-SMALL TO VG-SQLTYPE (10). MOVE W-SQL-CHAR TO VG-SQLTYPE (11). MOVE W-SQL-CHAR TO VG-SQLTYPE (12). MOVE W-SQL-PACKED TO VG-SQLTYPE (13). MOVE W-SQL-PACKED TO VG-SQLTYPE (14). MOVE W-SQL-PACKED TO VG-SQLTYPE (15). * ************************************************************* * SET DATA LENGTHS * ************************************************************* MOVE LENGTH OF ROW TO VG-SQLLEN (1). MOVE LENGTH OF EMPNO TO VG-SQLLEN (2). * ************************************************************* * LENGTH OF A VARCHAR FIELD IS THE LENGTH OF THE ACTUAL DATA * FIELD, I.E. FIRSTNMET ETC. * ************************************************************* MOVE LENGTH OF FIRSTNMET TO VG-SQLLEN (3). MOVE LENGTH OF MIDINIT TO VG-SQLLEN (4). MOVE LENGTH OF LASTNAMET TO VG-SQLLEN (5). MOVE LENGTH OF WORKDEPT TO VG-SQLLEN (6). MOVE LENGTH OF PHONENO TO VG-SQLLEN (7). MOVE LENGTH OF HIREDATE TO VG-SQLLEN (8). MOVE LENGTH OF JOB TO VG-SQLLEN (9). MOVE LENGTH OF EDLEVEL TO VG-SQLLEN (10). MOVE LENGTH OF SEX TO VG-SQLLEN (11). MOVE LENGTH OF BIRTHDATE TO VG-SQLLEN (12). * ************************************************************* * PACKED DECIMAL (COMP-3) FIELDS * * THE FIRST BYTE OF VG-SQLLEN CONTAINS THE PRECISION, I.E. * THE TOTAL NUMBER OF DIGITS IN THE PICTURE. THE SECOND BYTE * CONTAINS THE SCALE, I.E. THE NUMBER OF DECIMAL DIGITS, IF ANY * ************************************************************* * * YOU CAN USE HEX LITERALS * ************************************************************* MOVE X'09' TO VG-PRECISION (13). MOVE X'02' TO VG-DECIMALS (13). * ************************************************************* * * OR COMPUTE THE VALUE OF VG-SQLLEN * ************************************************************* COMPUTE VG-SQLLEN (14) ROUNDED = 9 * 256 + 2 COMPUTE VG-SQLLEN (15) ROUNDED = 9 * 256 + 2 * ************************************************************* * SET COLUMN NAMES * ************************************************************* MOVE 3 TO VG-SQLNAMEL (1). MOVE 'ROW' TO VG-SQLNAMET (1). MOVE 5 TO VG-SQLNAMEL (2). MOVE 'EMPNO' TO VG-SQLNAMET (2). MOVE 8 TO VG-SQLNAMEL (3). MOVE 'FIRSTNME' TO VG-SQLNAMET (3). MOVE 7 TO VG-SQLNAMEL (4). MOVE 'MIDINIT' TO VG-SQLNAMET (4). MOVE 8 TO VG-SQLNAMEL (5). MOVE 'LASTNAME' TO VG-SQLNAMET (5). MOVE 8 TO VG-SQLNAMEL (6). MOVE 'WORKDEPT' TO VG-SQLNAMET (6). MOVE 7 TO VG-SQLNAMEL (7). MOVE 'PHONENO' TO VG-SQLNAMET (7). MOVE 8 TO VG-SQLNAMEL (8). MOVE 'HIREDATE' TO VG-SQLNAMET (8). MOVE 3 TO VG-SQLNAMEL (9). MOVE 'JOB' TO VG-SQLNAMET (9). MOVE 7 TO VG-SQLNAMEL (10). MOVE 'EDLEVEL' TO VG-SQLNAMET (10). MOVE 3 TO VG-SQLNAMEL (11). MOVE 'SEX' TO VG-SQLNAMET (11). MOVE 9 TO VG-SQLNAMEL (12). MOVE 'BIRTHDATE' TO VG-SQLNAMET (12). MOVE 6 TO VG-SQLNAMEL (13). MOVE 'SALARY' TO VG-SQLNAMET (13). MOVE 5 TO VG-SQLNAMEL (14). MOVE 'BONUS' TO VG-SQLNAMET (14). MOVE 4 TO VG-SQLNAMEL (15). MOVE 'COMM' TO VG-SQLNAMET (15). ****************************************************************** * FILL DEFINITIONS OF INPUT PARAMETER(S), IF ANY * ************************************************************* IF (W-NUMBER-OF-INPUT-PARMS > 0) THEN ADD W-NUMBER-OF-INPUT-PARMS TO VG-SQLN, VG-SQLD * ********************************************************** * SET PARAMETER DATA TYPES * ********************************************************** MOVE W-SQL-PACKED TO VG-SQLTYPE (16) * ********************************************************** * SET PARAMETER LENGTHS * ********************************************************** COMPUTE VG-SQLLEN (16) ROUNDED = 9 * 256 + 2 * ********************************************************** * SET PARAMETER NAMES. * THE NAME OF EACH INPUT VARIABLE MUST ALWAYS BE '*INPUT*' * ********************************************************** MOVE 7 TO VG-SQLNAMEL (16) MOVE '*INPUT*' TO VG-SQLNAMET (16) END-IF. * ************************************************************* * COMPUTE THE LENGTH OF SQLDA * ************************************************************* COMPUTE VG-SQLDABC = VG-SQLN * W-SQLVARLEN + W-SQLDAFIXLEN. TEST*** MOVE '*** LEAVING FILL-SQLDA ***' TO SNAP-TITLE-TEXT. TEST*** SNAP TITLE SNAP-TITLE. ************************************************************************ PROCINFO SECTION. TEST*** MOVE '*** ENTERING PROCINFO ***' TO SNAP-TITLE-TEXT. TEST*** SNAP TITLE SNAP-TITLE. ****************************************************************** * THIS SECTION SHOULD WORK WITHOUT CHANGES * ************************************************************* MOVE 0 TO SQLCODE. MOVE SQLCA TO WSQLSQCA. PERFORM FILL-SQLDA. MOVE VG-SQLDA TO WSQLOVAR. MOVE VG-SQLDABC TO WSQLOLEN. COMPUTE W-LENGTH = WSQLOLEN + W-OFIXLEN. TEST*** MOVE '*** SQLDA OUT ***' TO SNAP-TITLE-TEXT. TEST*** MOVE W-LENGTH TO SNAP-LENGTH. TEST*** SNAP TITLE SNAP-TITLE FROM WSQLOUT LENGTH SNAP-LENGTH. PUT SCRATCH AREA ID WGSVOUT FROM WSQLOUT LENGTH W-LENGTH. TEST*** MOVE '*** LEAVING PROCINFO ***' TO SNAP-TITLE-TEXT. TEST*** SNAP TITLE SNAP-TITLE. *********************************************************************** SEND-ERROR SECTION. MOVE 70 TO SQLERRML. MOVE W-IFIXLEN TO SNAP-LENGTH. MOVE SQLERRMC TO SNAP-TITLE-TEXT. SNAP TITLE SNAP-TITLE FROM WSQLINP LENGTH SNAP-LENGTH. MOVE -1 TO SQLCODE. MOVE SQLCA TO WSQLSQCA. MOVE 0 TO WSQLOLEN. PUT SCRATCH AREA ID WGSVOUT FROM WSQLOUT LENGTH W-OFIXLEN. ************************************************************************ SQLERROR SECTION. MOVE '*** SQL ERROR ****' TO SNAP-TITLE-TEXT. MOVE LENGTH OF SQLCA TO SNAP-LENGTH. SNAP TITLE SNAP-TITLE FROM SQLCA LENGTH SNAP-LENGTH ON ANY-STATUS NEXT SENTENCE. * ************************************************************* * THE MODULE BELOW CALLS IBM'S DSNTIAR TO GET MORE ERROR TEXT * ************************************************************* TRANSFER 'MDB2CFH' LINK USING SQLCA DB2-MESSAGE LRECL; ON ANY-STATUS NEXT SENTENCE. MOVE '*** ERROR TEXT ****' TO SNAP-TITLE-TEXT. SNAP TITLE SNAP-TITLE FROM DB2-MESSAGE LENGTH MESSAGE-LEN ON ANY-STATUS NEXT SENTENCE. MOVE SQLCA TO WSQLSQCA. * ************************************************************* * COPY THE TEXT RETRIEVED FROM DSNTIAR TO WSQLOVAR * ************************************************************* MOVE MESSAGE-LEN TO WSQLOLEN. MOVE MESSAGE-TXT TO WSQLOVAR. COMPUTE W-LENGTH = W-OFIXLEN + WSQLOLEN. * ************************************************************* * SEND ERROR MESSAGE TO THE JDBC/ODBC DRIVER * ************************************************************* PUT SCRATCH AREA ID WGSVOUT FROM WSQLOUT LENGTH W-LENGTH ON ANY-STATUS NEXT SENTENCE. GOBACK. ****************************************************************** * CONTROL ROUTINE FOR IDMS CLIENT ****************************************************************** COPY IDMS CDB2CAF-CONTROL-CALL. ************************************************************************ * DO NOT COPY IDMS-STATUS!!! ****************************************************************** IDMS-STATUS SECTION. IF DB-STATUS-OK GO TO ISABEX. * ************************************************************* * SAVE IDMS ERROR-STATUS * ************************************************************* MOVE ERROR-STATUS TO IDMS-ERROR-STATUS. MOVE ERROR-STATUS TO SSC-ERRSTAT-SAVE. MOVE DML-SEQUENCE TO SSC-DMLSEQ-SAVE. * ************************************************************* * SNAP SUBSCHEMA-CTRL * ************************************************************* SNAP TITLE SNAP-TITLE FROM SUBSCHEMA-CTRL TO SUBSCHEMA-CTRL-END ON ANY-STATUS NEXT SENTENCE. * ************************************************************* * SET JDBC/ODBC ERROR MESSAGE * ************************************************************* MOVE 70 TO SQLERRML. MOVE IDMS-ERROR-MSG TO SNAP-TITLE-TEXT SQLERRMC. MOVE -1 TO SQLCODE. MOVE SQLCABC TO SNAP-LENGTH. * ************************************************************* * SNAP SQLCA * ************************************************************* SNAP TITLE SNAP-TITLE FROM SQLCA LENGTH SNAP-LENGTH ON ANY-STATUS NEXT SENTENCE. MOVE SQLCA TO WSQLSQCA. MOVE 0 TO WSQLOLEN. * ************************************************************* * SEND ERROR MESSAGE TO THE JDBC/ODBC DRIVER * ************************************************************* PUT SCRATCH AREA ID WGSVOUT FROM WSQLOUT LENGTH W-OFIXLEN ON ANY-STATUS NEXT SENTENCE. GOBACK. ISABEX. EXIT.