*DMLIST IDENTIFICATION DIVISION. CHANGE PROGRAM-ID. IDMSSP2. *--------------------------------------------------------------- * VEGA JDBC/ODBC STORED PROCEDURE SAMPLE FOR CA-IDMS/SQL * *--------------------------------------------------------------- * * FUNCTION = THIS MODULE JOINS ALL EMPLOYEE AND POSITION ROWS * WHERE SALARY_AMOUNT > W-INP-SALARY * * ONLY SQL ACCESS IS SUPPORTED IN THIS SAMPLE * * REVIEW AND MODIFY THE LINES MARKED WITH 'CHANGE' IN COLUMNS * 1 - 6 * * MAPPING STATEMENTS ARE NOT ALLOWED * - THIS PROGRAM RUNS AS A NON-TERMINAL TASK * * FINISH/COMMIT/ROLLBACK ARE NOT ALLOWED * - APPLICATION SERVER HANDLES THESE. FINISH WILL BE ISSUED * WHEN JDBC/ODBC DRIVER ISSUES ENDSERVER. * COMMIT/ROLLBACK WILL BE ISSUED BY THE APPLICATION SERVER * WHEN ODBC DRIVER EXECUTES SQLTRANSACT (ODBC 2.X) OR * SQLENDTRAN (ODBC 3.X) OR WHEN THE JDBC DRIVER EXECUTES * COMMIT OR ROLLBACK. * * NOTE THAT JDBC/ODBC AUTOCOMMIT ON IS * DEFAULT. THIS MEANS THAT ALL STATEMENTS ARE IMMEDIATELY * COMMITTED. * *--------------------------------------------------------------- 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. 02 FILLER PIC X(10) VALUE 'IDMSSP2'. 02 SNAP-TITLE-TEXT PIC X(122) VALUE SPACES. 01 SNAP-LENGTH PIC S9(4) COMP. 01 WORK-FIELDS. 02 W-SQLCODE PIC -(8)9. 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 W-ERRFOUND PIC X VALUE 'N'. 02 W-DISPERG. 03 FILLER PIC XX VALUE 'DB'. 03 W-DISPERC PIC 9(6) USAGE DISPLAY. 02 I PIC 9(4) COMP. 02 E-IND PIC 9(4) COMP VALUE 0. 02 FILLER REDEFINES E-IND. 03 FILLER PIC X. 03 E-IND2 PIC X. 02 W-SQLERRML PIC S9(4) COMP. 02 W-SQLERRMC. 04 W-SQLERRM PIC X OCCURS 82 TIMES. 02 FILLER REDEFINES W-SQLERRMC. 03 FILLER PIC X. 03 W-SQLERRM2 PIC X(70). 03 FILLER PIC X(11). ****************************************************************** * THIS IS THE SQL CONTROL AREA (SQLCA) USED BY THE JDBC/ODBC * DRIVER. * VG-SQLCA IS COMPATIBLE WITH DB2 SQLCA. JDBC/ODBC DRIVER USES * THE FOLLOWING VALUES: * - VG-SQLCODE * - VG-SQLERRML (IF VG-SQL-ERROR) * - VG-SQLERRMT (IF VG-SQL-ERROR) * - VG-SQLSTATE (IF VG-SQL-ERROR) * * THIS PROGRAM SHOULD SET PROPER VALUES OF THESE FIELDS. ****************************************************************** 01 VG-SQLCA. * EYE CATCHER 03 VG-SQLCAID PIC X(8) VALUE 'SQLCA'. * SQLCA LENGTH 03 VG-SQLCABC PIC S9(8) COMP VALUE +136. * SQL CODE CHECKED BY THE JDBC/ODBC DRIVER 03 VG-SQLCODE PIC S9(8) COMP. 88 VG-SQL-CODE-OK VALUE +0. 88 VG-SQL-NOT-FOUND VALUE +100. 88 VG-SQL-WARNING VALUE +1 THRU +99 +101 THRU +999999. 88 VG-SQL-ERROR VALUE -999999 THRU -1. 88 VG-SQL-NO-ERROR VALUE +0 THRU +99 +101 THRU +999999. 03 VG-SQLERRM. 04 VG-SQLERRML PIC S9(4) COMP. 04 VG-SQLERRMT PIC X(70). 03 VG-SQLERRP PIC X(8). 03 VG-SQLERRD PIC S9(8) OCCURS 6 COMP. 03 VG-SQLWARN. 04 VG-SQLWARN0 PIC X. 04 VG-SQLWARN1 PIC X. 04 VG-SQLWARN2 PIC X. 04 VG-SQLWARN3 PIC X. 04 VG-SQLWARN4 PIC X. 04 VG-SQLWARN5 PIC X. 04 VG-SQLWARN6 PIC X. 04 VG-SQLWARN7 PIC X. 03 VG-SQLEXT. 04 VG-SQLWARN8 PIC X. 04 VG-SQLWARN9 PIC X. 04 VG-SQLWARNA PIC X. * JDBC/ODBC APPLICATION CAN USE THE SQLSTATE VALUE TO FIND * OUT THE SPECIFIC ERROR CODE 03 VG-SQLSTATE PIC X(5) VALUE SPACE. ****************************************************************** * INCLUDE CA-IDMS/SQL SQLCA ****************************************************************** EXEC SQL INCLUDE SQLCA END-EXEC. 02 SQLCA-END PIC X. ****************************************************************** * 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 +17. ****************************************************************** * SQLDA CONTAINS FIELD DEFINITIONS. THESE ARE SET IN THE * FILL-SQLDA SECTION. SQLDA IS COMPATIBLE WITH DB2. ****************************************************************** 01 VG-SQLDA. * EYECATCH 05 VG-SQLDAID PIC X(8). * 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 18. 06 VG-SQLTYPE PIC S9(4) COMP. 88 SQL-DATE VALUE +384 +385. 88 SQL-DATE-NULL VALUE +385. 88 SQL-TIME VALUE +388 +389. 88 SQL-TIME-NULL VALUE +389. 88 SQL-TIMESTAMP VALUE +392 +393. 88 SQL-TIMESTAMP-NULL VALUE +393. 88 SQL-VARCHAR VALUE +448 +449. 88 SQL-VARCHAR-NULL VALUE +449. 88 SQL-CHAR VALUE +452 +453. 88 SQL-CHAR-NULL VALUE +453. 88 SQL-LONGVARCHAR VALUE +456 +457. 88 SQL-LONGVARCHAR-NULL VALUE +457. 88 SQL-VARGRAPHIC VALUE +464 +465. 88 SQL-VARGRAPHIC-NULL VALUE +465. 88 SQL-GRAPHIC VALUE +468 +469. 88 SQL-GRAPHIC-NULL VALUE +469. 88 SQL-LONGVARGRAPHIC VALUE +472 +473. 88 SQL-LONGVARGRAPHIC-NULL VALUE +473. 88 SQL-FLOAT VALUE +480 +481. 88 SQL-FLOAT-NULL VALUE +481. 88 SQL-PACKED VALUE +484 +485. 88 SQL-PACKED-NULL VALUE +485. 88 SQL-INTEGER VALUE +496 +497. 88 SQL-INTEGER-NULL VALUE +497. 88 SQL-SMALL VALUE +500 +501. 88 SQL-SMALL-NULL VALUE +502. 06 VG-SQLLEN PIC S9(4) COMP. 06 FILLER 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). EXEC SQL BEGIN DECLARE SECTION END-EXEC ****************************************************************** * 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 DATABASE ACCESS. * 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(8)V9(2) USAGE COMP-3. CHANGE 04 W-INP-SALARY-IND PIC S9(4) COMP. CHANGE 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. 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 EMP-ID-IND PIC S9(4) COMP. CHANGE 05 MANAGER-ID-IND PIC S9(4) COMP. CHANGE 05 EMP-FNAME-IND PIC S9(4) COMP. CHANGE 05 EMP-LNAME-IND PIC S9(4) COMP. CHANGE 05 DEPT-ID-IND PIC S9(4) COMP. CHANGE 05 STREET-IND PIC S9(4) COMP. CHANGE 05 CITY-IND PIC S9(4) COMP. CHANGE 05 STATE-IND PIC S9(4) COMP. CHANGE 05 ZIP-CODE-IND PIC S9(4) COMP. CHANGE 05 PHONE-IND PIC S9(4) COMP. CHANGE 05 EMP-STATUS-IND PIC S9(4) COMP. CHANGE 05 SS-NUMBER-IND PIC S9(4) COMP. CHANGE 05 START-DATE-IND PIC S9(4) COMP. CHANGE 05 TERMINATION-DATE-IND PIC S9(4) COMP. CHANGE 05 BIRTH-DATE-IND PIC S9(4) COMP. CHANGE 05 SALARY-AMOUNT-IND PIC S9(4) COMP. 04 W-OUT-VARIABLES. * ROW WILL BE INCREMENTED BY ONE FOR EACH ROW CHANGE 05 ROW PIC S9(4) COMP. CHANGE 05 EMP-ID PIC 9(4) COMP. CHANGE 05 MANAGER-ID PIC 9(4) COMP. CHANGE 05 EMP-FNAME PIC X(20). CHANGE 05 EMP-LNAME PIC X(20). CHANGE 05 DEPT-ID PIC 9(4) COMP. CHANGE 05 STREET PIC X(40). CHANGE 05 CITY PIC X(20). CHANGE 05 STATE PIC X(2). CHANGE 05 ZIP-CODE PIC X(9). CHANGE 05 PHONE PIC X(10). CHANGE 05 EMP-STATUS PIC X(1). CHANGE 05 SS-NUMBER PIC 9(9) COMP. CHANGE 05 START-DATE PIC X(10). CHANGE 05 TERMINATION-DATE PIC X(10). CHANGE 05 BIRTH-DATE PIC X(10). CHANGE 05 SALARY-AMOUNT PIC S9(8)V9(2) USAGE COMP-3. EXEC SQL END DECLARE SECTION END-EXEC ****************************************************************** * DECLARE THE CURSOR * ************************************************************* EXEC SQL CHANGE DECLARE CEMP CURSOR FOR CHANGE SELECT CHANGE E.EMP_ID, CHANGE MANAGER_ID, CHANGE EMP_FNAME, CHANGE EMP_LNAME, CHANGE DEPT_ID, CHANGE STREET, CHANGE CITY, CHANGE STATE, CHANGE ZIP_CODE, CHANGE PHONE, CHANGE STATUS, CHANGE SS_NUMBER, CHANGE E.START_DATE, CHANGE TERMINATION_DATE, CHANGE BIRTH_DATE, CHANGE SALARY_AMOUNT CHANGE FROM DEMOEMPL.EMPLOYEE E, DEMOEMPL.POSITION P CHANGE WHERE SALARY_AMOUNT > :W-INP-SALARY:W-INP-SALARY-IND CHANGE AND CHANGE E.EMP_ID = P.EMP_ID CHANGE ORDER BY E.EMP_ID END-EXEC *********************************************************************** LINKAGE SECTION. 01 WCONTROL. * ************************************************************* * THIS IS THE OUTPUT SCRATCH NAME SET BY THE APPLICATION SERVER * ************************************************************* 02 WGSVOUT PIC X(8). * ************************************************************* * THIS IS THE SERVER NAME FROM THE VEGA SERVER CONTROL TABLE * ************************************************************* 02 WSQLNAME PIC X(8). 01 WORK-AREA PIC X(1024). 01 FILLER REDEFINES WORK-AREA. 02 COPY IDMS SUBSCHEMA-CTRL. COPY WSQLINP. *********************************************************************** PROCEDURE DIVISION USING WCONTROL, 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. MOVE 0 TO VG-SQLCODE MOVE VG-SQLCA TO WSQLSQCA * ************************************************************* * 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 MAXIMUM 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 CHANGE MOVE 'INPUT TOO LONG' TO VG-SQLERRMT PERFORM SEND-ERROR GOBACK END-IF. * ************************************************************* * INPUT FROM THE DRIVER CONSISTS OF * * EITHER * * (1) SQLDA (DESCRIPTION OF INPUT PARAMETER(S)) * (2) PARAMETERS AND INDICATOR VARIABLE(S) * * 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 LOW-VALUES TO WSQLINPUT MOVE 50000 TO W-INP-SALARY MOVE 0 TO W-INP-SALARY-IND 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 IF (VG-SQLD < W-NUMBER-OF-INPUT-PARMS) THEN * ISSUE ERROR MESSAGE MOVE 'INPUT PARAMETER(S) MISSING' TO VG-SQLERRMT PERFORM SEND-ERROR GOBACK END-IF IF (VG-SQLD > W-NUMBER-OF-INPUT-PARMS) THEN * ISSUE ERROR MESSAGE MOVE 'TOO MANY INPUT PARAMETERS' TO VG-SQLERRMT PERFORM SEND-ERROR GOBACK END-IF * ********************************************************** * THE NUMBER OF PARAMETERS IS CORRECT. * CHECK THE DATA TYPE(S). * ********************************************************** IF (NOT (SQL-PACKED(1))) THEN * ISSUE ERROR MESSAGE MOVE 'FIRST INPUT PARAMETER NOT PACKED DECIMAL' TO VG-SQLERRMT PERFORM SEND-ERROR GOBACK END-IF * ********************************************************** * PARAMETER DEFINITIONS ARE CORRECT. * COPY THE INPUT DATA. * ********************************************************** MOVE WSQLIVAR (VG-SQLDABC + 1: ) TO WSQLINPUT * ********************************************************** * YOU CAN CHECK NULL VALUES, IF NEEDED * ********************************************************** IF (W-INP-SALARY-NULL) THEN * ISSUE ERROR MESSAGE BECAUSE SALARY CANNOT BE NULL MOVE 'INPUT PARAMETER SALARY CANNOT BE NULL' TO VG-SQLERRMT PERFORM SEND-ERROR GOBACK END-IF END-IF. * ************************************************************* * NOW WE CAN ACCESS CA-IDMS * ************************************************************* 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. * ************************************************************* * OPEN THE CURSOR. * ************************************************************* EXEC SQL OPEN CEMP END-EXEC. * ************************************************************* * COPY THE SQLCA AND SEND IT TO THE JDBC/ODBC DRIVER. * ************************************************************* MOVE VG-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 THROUGH ALL ROWS * ************************************************************* PERFORM UNTIL (SQLCODE NOT = 0) TEST MOVE '*** WSQLOLEN ***' TO SNAP-TITLE-TEXT TEST MOVE 2 TO SNAP-LENGTH TEST SNAP TITLE SNAP-TITLE FROM WSQLOLEN LENGTH SNAP-LENGTH TEST MOVE '*** WSQLOUT ***' TO SNAP-TITLE-TEXT TEST MOVE W-LENGTH TO SNAP-LENGTH TEST SNAP TITLE SNAP-TITLE FROM WSQLOUT LENGTH SNAP-LENGTH * ********************************************************** * 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 SQLCODE TO VG-SQLCODE. MOVE VG-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 APPLICATION SERVER * ************************************************************* ENDPROGRAM. GOBACK. ****************************************************************** FETCH-CEMP SECTION. TEST MOVE '*** ENTERING FETCH CEMP ***' TO SNAP-TITLE-TEXT. TEST SNAP TITLE SNAP-TITLE. EXEC SQL FETCH CEMP INTO :EMP-ID :EMP-ID-IND, :MANAGER-ID :MANAGER-ID-IND, :EMP-FNAME :EMP-FNAME-IND, :EMP-LNAME :EMP-LNAME-IND, :DEPT-ID :DEPT-ID-IND, :STREET :STREET-IND, :CITY :CITY-IND, :STATE :STATE-IND, :ZIP-CODE :ZIP-CODE-IND, :PHONE :PHONE-IND, :EMP-STATUS :EMP-STATUS-IND, :SS-NUMBER :SS-NUMBER-IND, :START-DATE :START-DATE-IND, :TERMINATION-DATE :TERMINATION-DATE-IND, :BIRTH-DATE :BIRTH-DATE-IND, :SALARY-AMOUNT :SALARY-AMOUNT-IND END-EXEC. * ************************************************************* * AS AN EXAMPLE, WE COUNT EACH ROW. THE ROW FIELD IS AN OUTPUT * PARAMETER. IT IS NOT DIRECTLY 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-SMALL TO VG-SQLTYPE (2). MOVE W-SQL-SMALL TO VG-SQLTYPE (3). MOVE W-SQL-CHAR TO VG-SQLTYPE (4). MOVE W-SQL-CHAR TO VG-SQLTYPE (5). MOVE W-SQL-SMALL 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-CHAR TO VG-SQLTYPE (10). MOVE W-SQL-CHAR TO VG-SQLTYPE (11). MOVE W-SQL-CHAR TO VG-SQLTYPE (12). MOVE W-SQL-INTEGER TO VG-SQLTYPE (13). MOVE W-SQL-CHAR TO VG-SQLTYPE (14). MOVE W-SQL-CHAR TO VG-SQLTYPE (15). MOVE W-SQL-CHAR TO VG-SQLTYPE (16). MOVE W-SQL-PACKED TO VG-SQLTYPE (17). * ************************************************************* * SET DATA LENGTHS * NOTE: LENGTH OF A VARCHAR FIELD IS THE LENGTH OF THE ACTUAL * DATA FIELD * ************************************************************* MOVE LENGTH OF ROW TO VG-SQLLEN (1). MOVE LENGTH OF EMP-ID TO VG-SQLLEN (2). MOVE LENGTH OF MANAGER-ID TO VG-SQLLEN (3). MOVE LENGTH OF EMP-FNAME TO VG-SQLLEN (4). MOVE LENGTH OF EMP-LNAME TO VG-SQLLEN (5). MOVE LENGTH OF DEPT-ID TO VG-SQLLEN (6). MOVE LENGTH OF STREET TO VG-SQLLEN (7). MOVE LENGTH OF CITY TO VG-SQLLEN (8). MOVE LENGTH OF STATE TO VG-SQLLEN (9). MOVE LENGTH OF ZIP-CODE TO VG-SQLLEN (10). MOVE LENGTH OF PHONE TO VG-SQLLEN (11). MOVE LENGTH OF EMP-STATUS TO VG-SQLLEN (12). MOVE LENGTH OF SS-NUMBER TO VG-SQLLEN (13). MOVE LENGTH OF START-DATE TO VG-SQLLEN (14). MOVE LENGTH OF TERMINATION-DATE TO VG-SQLLEN (15). MOVE LENGTH OF BIRTH-DATE TO VG-SQLLEN (16). * ************************************************************* * 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'10' TO VG-PRECISION (17). MOVE X'02' TO VG-DECIMALS (17). * ************************************************************* * * OR COMPUTE THE VALUE OF VG-SQLLEN * ************************************************************* COMPUTE VG-SQLLEN (17) ROUNDED = 10 * 256 + 2 * ************************************************************* * SET COLUMN NAMES * ************************************************************* MOVE 3 TO VG-SQLNAMEL (1). MOVE 'ROW' TO VG-SQLNAMET (1). MOVE 6 TO VG-SQLNAMEL (2). MOVE 'EMP_ID' TO VG-SQLNAMET (2). MOVE 10 TO VG-SQLNAMEL (3). MOVE 'MANAGER_ID' TO VG-SQLNAMET (3). MOVE 9 TO VG-SQLNAMEL (4). MOVE 'EMP_FNAME' TO VG-SQLNAMET (4). MOVE 9 TO VG-SQLNAMEL (5). MOVE 'EMP_LNAME' TO VG-SQLNAMET (5). MOVE 7 TO VG-SQLNAMEL (6). MOVE 'DEPT_ID' TO VG-SQLNAMET (6). MOVE 6 TO VG-SQLNAMEL (7). MOVE 'STREET' TO VG-SQLNAMET (7). MOVE 4 TO VG-SQLNAMEL (8). MOVE 'CITY' TO VG-SQLNAMET (8). MOVE 5 TO VG-SQLNAMEL (9). MOVE 'STATE' TO VG-SQLNAMET (9). MOVE 8 TO VG-SQLNAMEL (10). MOVE 'ZIP_CODE' TO VG-SQLNAMET (10). MOVE 5 TO VG-SQLNAMEL (11). MOVE 'PHONE' TO VG-SQLNAMET (11). MOVE 6 TO VG-SQLNAMEL (12). MOVE 'STATUS' TO VG-SQLNAMET (12). MOVE 9 TO VG-SQLNAMEL (13). MOVE 'SS_NUMBER' TO VG-SQLNAMET (13). MOVE 10 TO VG-SQLNAMEL (14). MOVE 'START_DATE' TO VG-SQLNAMET (14). MOVE 16 TO VG-SQLNAMEL (15). MOVE 'TERMINATION_DATE' TO VG-SQLNAMET (15). MOVE 10 TO VG-SQLNAMEL (16). MOVE 'BIRTH_DATE' TO VG-SQLNAMET (16). MOVE 13 TO VG-SQLNAMEL (17). MOVE 'SALARY_AMOUNT' TO VG-SQLNAMET (17). ****************************************************************** * 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 (18) * ********************************************************** * SET PARAMETER LENGTHS * ********************************************************** COMPUTE VG-SQLLEN (18) ROUNDED = 10 * 256 + 2 * ********************************************************** * SET PARAMETER NAMES. * THE NAME OF EACH INPUT VARIABLE IS ALWAYS '*INPUT*' * ********************************************************** MOVE 7 TO VG-SQLNAMEL (18) MOVE '*INPUT*' TO VG-SQLNAMET (18) 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. ****************************************************************** * THIS SECTION SHOULD WORK WITHOUT CHANGES * ************************************************************* TEST MOVE '*** ENTERING PROCINFO ***' TO SNAP-TITLE-TEXT. TEST SNAP TITLE SNAP-TITLE. MOVE 0 TO VG-SQLCODE. ' MOVE VG-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 VG-SQLERRML. MOVE W-IFIXLEN TO SNAP-LENGTH. MOVE VG-SQLERRMT TO SNAP-TITLE-TEXT. SNAP TITLE SNAP-TITLE FROM WSQLINP LENGTH SNAP-LENGTH. MOVE -1 TO VG-SQLCODE. MOVE VG-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. PERFORM CONVERT-SQLCA. MOVE VG-SQLCABC TO SNAP-LENGTH. SNAP TITLE SNAP-TITLE FROM VG-SQLCA LENGTH SNAP-LENGTH ON ANY-STATUS NEXT SENTENCE. MOVE VG-SQLCA TO WSQLSQCA. * ************************************************************* * SEND ERROR MESSAGE TO THE JDBC/ODBC DRIVER * ************************************************************* PUT SCRATCH AREA ID WGSVOUT FROM WSQLOUT LENGTH W-OFIXLEN ON ANY-STATUS NEXT SENTENCE. GOBACK. ***************************************************************** CONVERT-SQLCA SECTION. ************************************************************* * CONVERT IDMS SQLCA TO DB2 FORMAT * ************************************************************* MOVE 'IDMCA' TO VG-SQLCAID. MOVE 136 TO VG-SQLCABC. MOVE SQLCODE TO VG-SQLCODE. IF SQLCERL NOT > 82 THEN MOVE SQLCERRML TO W-SQLERRML ELSE MOVE 82 TO W-SQLERRML END-IF. ************************************************************* * FIND DB###### = SQLERC * ************************************************************* MOVE SQLCERC TO W-DISPERC. MOVE 1 TO I, E-IND. PERFORM UNTIL (I > SQLCERRML OR E-IND = 0 OR W-DISPERG = SQLERRMC((I + 1):8)) MOVE SQLERRMC(I:1) TO E-IND2 COMPUTE I = I + E-IND + 1 END-PERFORM. IF (I > SQLCERRML OR E-IND = 0) THEN MOVE 1 TO I MOVE 'N' TO W-ERRFOUND ELSE MOVE 'Y' TO W-ERRFOUND END-IF. MOVE SQLERRMC(I:82) TO W-SQLERRMC. PERFORM UNTIL (I > W-SQLERRML + 1 OR W-SQLERRM (I) = LOW-VALUE) MOVE W-SQLERRM (I) TO E-IND2 MOVE LOW-VALUE TO W-SQLERRM (I) COMPUTE I = I + E-IND + 1 END-PERFORM. IF W-ERRFOUND = 'Y' AND W-SQLERRM (10) = SPACE AND W-SQLERRM (11) = 'T' AND W-SQLERRM (12) NUMERIC THEN MOVE 13 TO I PERFORM UNTIL (W-SQLERRM (I) NOT NUMERIC OR I > 20) ADD 1 TO I END-PERFORM MOVE W-SQLERRMC(2:8) TO VG-SQLERRMT(1:8) MOVE W-SQLERRMC(I:62) TO VG-SQLERRMT(9:62) ELSE MOVE W-SQLERRM2 TO VG-SQLERRMT END-IF. MOVE 70 TO VG-SQLERRML. MOVE SQLCERC TO VG-SQLERRD (1). MOVE SQLCLNO TO VG-SQLERRD (2). MOVE SQLCNRP TO VG-SQLERRD (3). MOVE SQLCSER TO VG-SQLERRD (5). MOVE SQLCMCT TO VG-SQLERRD (6). MOVE SQLCA (327:5) TO VG-SQLSTATE. ************************************************************************ *DO NOT COPY IDMS-STATUS!!! ****************************************************************** IDMS-STATUS SECTION. IF DB-STATUS-OK GO TO ISABEX END-IF. * ************************************************************* * 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 ERROR MESSAGE * ************************************************************* MOVE 70 TO VG-SQLERRML. MOVE IDMS-ERROR-MSG TO SNAP-TITLE-TEXT VG-SQLERRMT. MOVE -1 TO VG-SQLCODE. MOVE VG-SQLCABC TO SNAP-LENGTH. * ************************************************************* * SNAP VG-SQLCA * ************************************************************* SNAP TITLE SNAP-TITLE FROM VG-SQLCA LENGTH SNAP-LENGTH ON ANY-STATUS NEXT SENTENCE. MOVE VG-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.