*DMLIST IDENTIFICATION DIVISION. CHANGE PROGRAM-ID. IDMSSP1. *--------------------------------------------------------------- * VEGA JDBC/ODBC STORED PROCEDURE SAMPLE FOR CA-IDMS DML * *--------------------------------------------------------------- * * COMMENTS * * ONLY DML 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 IDMS-RECORDS MANUAL. DATA DIVISION. SCHEMA SECTION. CHANGE DB MYSUBSCHEMA WITHIN MYSCHEMA. WORKING-STORAGE SECTION. 01 SNAP-TITLE. 02 FILLER PIC X(2) VALUE SPACES. CHANGE 02 FILLER PIC X(10) VALUE 'IDMSSP1'. 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). ****************************************************************** * 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-SQLERRMN (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 VALUE +0. 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. * ERROR TEXT LENGTH 04 VG-SQLERRMN PIC S9(4) COMP VALUE +0. * ERROR TEXT 04 VG-SQLERRMT PIC X(70) VALUE SPACES. 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. ****************************************************************** * 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 +???. ***************************************************************** * SET THE NUMBER OF OUTPUT FIELDS ***************************************************************** CHANGE 01 W-NUMBER-OF-OUTPUT-FIELDS PIC S9(4) COMP VALUE +???. ****************************************************************** * 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 ???. 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 W-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 DATABASE ACCESS. * JDBC/ODBC DRIVER ALWAYS INSERTS AN INDICATOR VARIABLE * (BINARY HALW-WORD) IMMEDIATELY AFTER THE DATA FIELD. * DO NOT USE COMP SYNC! ****************************************************************** CHANGE 03 W-INP-PARM1. CHANGE* NOTE: THIS IS A VARCHAR FIELD CHANGE 04 W-INP-PARM1L PIC S9(4) COMP. CHANGE 04 W-INP-PARM1T PIC X(18). CHANGE 03 W-INP-PARM1-IND PIC S9(4) COMP. CHANGE 88 W-INP-PARM1-NULL VALUE -1. CHANGE 03 W-INP-PARM2 PIC S9(9)V99 COMP-3. CHANGE 03 W-INP-PARM2-IND PIC S9(4) COMP. CHANGE 88 W-INP-PARM2-NULL VALUE -1. ****************************************************************** * NOTE: ONE OF THE INPUT PARAMETERS CAN BE A TRACE FLAG. * IF TRACE IS ENABLED BY YOUR APPLIATION, YOU CAN SNAP * STORAGE CONTENTS WHEN NECESSARY. ****************************************************************** CHANGE 03 W-INP-PARM3 PIC X. CHANGE 88 W-TRACE-ON VALUE 'Y'. CHANGE 03 W-INP-TRACE-IND PIC S9(4) COMP. CHANGE 88 W-INP-PARM3-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 DATA 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 W-OUT-DATA1-IND PIC S9(4) COMP. CHANGE 88 W-OUT-DATA1-NULL VALUE -1. CHANGE 05 W-OUT-DATA2-IND PIC S9(4) COMP. CHANGE 88 W-OUT-DATA2-NULL VALUE -1. CHANGE ... 04 W-OUT-VARIABLES. CHANGE 05 W-OUT-DATA1 PIC X(30). CHANGE 05 W-OUT-DATA2 PIC S9(4) COMP. CHANGE ... CHANGE ****************************************************************** * COPY IDMS RECORDS AND SUBSCHEMA NAMES ****************************************************************** CHANGE COPY IDMS ... COPY IDMS SUBSCHEMA-NAMES. *********************************************************************** LINKAGE SECTION. * ************************************************************* * THIS IS THE OUTPUT SCRATCH NAME SET BY THE APPLICATION SERVER * ************************************************************* 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). 01 FILLER REDEFINES WORK-AREA. 02 COPY IDMS SUBSCHEMA-CTRL. 02 SW-RUN-UNIT-OPEN PIC X. 88 RUN-UNIT-OPEN VALUE 'Y'. ****************************************************************** * 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. IF (W-TRACE-ON) THEN MOVE '*** WSQLINP ***' TO SNAP-TITLE-TEXT SNAP TITLE SNAP-TITLE FROM WSQLINP LENGTH W-IFIXLEN END-IF. MOVE 0 TO VG-SQLCODE MOVE VG-SQLCA TO WSQLSQCA ****************************************************************** * THE JDBC/ODBC DRIVER SENDS 'PROCINFO' COMMAND 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 ****************************************************************** ****************************************************************** * INPUT FROM THE DRIVER CONSISTS OF * * EITHER * * (1) SQLDA (DESCRIPTION OF INPUT PARAMETER(S)) AND * (2) PARAMETER DATA FOLLOWED BY INDICATOR VARIABLE * * 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 * ISSUE ERROR MESSAGE CHANGE MOVE 'IDMSSP1: INPUT EMPTY' TO VG-SQLERRMT PERFORM SEND-ERROR GOBACK END-IF. ****************************************************************** * LET'S CALCULATE THE EXPTECTED MESSAGE LENGTH ****************************************************************** COMPUTE W-LENGTH = LENGTH OF WSQLINPUT + W-SQLDAFIXLEN + W-NUMBER-OF-INPUT-PARMS * W-SQLVARLEN. IF (WSQLILEN > W-LENGTH) THEN * ISSUE ERROR MESSAGE CHANGE MOVE 'IDMSSP1: INPUT TOO LONG' TO VG-SQLERRMT PERFORM SEND-ERROR GOBACK END-IF. IF (WSQLILEN < W-LENGTH) THEN * ISSUE ERROR MESSAGE CHANGE MOVE 'IDMSSP1: INPUT TOO SHORT' TO VG-SQLERRMT PERFORM SEND-ERROR GOBACK END-IF. ****************************************************************** * THE MESSAGE LENGTH IS CORRECT. LET'S MOVE PARAMETER * DESCRIPTIONS TO VG-SQLDA ****************************************************************** IF (WSQLILEN > 0) THEN MOVE WSQLIVAR TO VG-SQLDA IF (W-TRACE-ON) THEN MOVE '*** SQLDA IN ***' TO SNAP-TITLE-TEXT MOVE VG-SQLDABC TO SNAP-LENGTH SNAP TITLE SNAP-TITLE FROM VG-SQLDA LENGTH SNAP-LENGTH END-IF END-IF. IF (VG-SQLD < W-NUMBER-OF-INPUT-PARMS) THEN * ISSUE ERROR MESSAGE CHANGE MOVE 'IDMSSP1: 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 CHANGE MOVE 'IDMSSP1: TOO MANY INPUT PARAMETERS' TO VG-SQLERRMT PERFORM SEND-ERROR GOBACK END-IF ****************************************************************** * THE NUMBER OF PARAMETERS IS CORRECT. * LET'S CHECK THE PARAMETER DATA TYPE(S). ****************************************************************** CHANGE IF (NOT (SQL-VARCHAR(1))) THEN * ISSUE ERROR MESSAGE CHANGE MOVE 'IDMSSP1: 1. INPUT PARAMETER (PARM1) NOT VARCHAR' TO VG-SQLERRMT PERFORM SEND-ERROR GOBACK END-IF. CHANGE IF (NOT (SQL-PACKED(2))) THEN * ISSUE ERROR MESSAGE CHANGE MOVE 'IDMSSP1: 2. INPUT PARAMETER (PARM2) NOT DECIMAL' TO VG-SQLERRMT PERFORM SEND-ERROR GOBACK END-IF. CHANGE IF (NOT (SQL-CHAR(3))) THEN * ISSUE ERROR MESSAGE CHANGE MOVE 'IDMSSP1: 3. INPUT PARAMETER (TRACE) NOT CHAR' TO VG-SQLERRMT PERFORM SEND-ERROR GOBACK END-IF. CHANGE CHECK ADDITIONAL PARAMETERS, IF ANY ****************************************************************** * PARAMETER DEFINITIONS ARE CORRECT. * COPY THE INPUT DATA THAT STARTS IMMEDIATELY AFTER SQLDA. ****************************************************************** MOVE WSQLIVAR (VG-SQLDABC + 1: ) TO WSQLINPUT. ****************************************************************** * YOU CAN CHECK NULL VALUES, IF NEEDED, AND DO SOMETHING, E.G. ****************************************************************** CHANGE IF (W-INP-PARM1-NULL) THEN CHANGE* ISSUE ERROR MESSAGE CHANGE MOVE 'IDMSSP1: 1. INPUT PARAMETER (PARM1) CANNOT BE NULL' CHANGE TO VG-SQLERRMT CHANGE PERFORM SEND-ERROR CHANGE GOBACK CHANGE END-IF IF (W-TRACE-ON) THEN MOVE '*** WSQLINPUT ***' TO SNAP-TITLE-TEXT MOVE LENGTH OF WSQLINPUT TO SNAP-LENGTH SNAP TITLE SNAP-TITLE FROM WSQLINPUT LENGTH SNAP-LENGTH END-IF. MOVE LOW-VALUES TO WSQLOUTPUT. PERFORM START-RUN-UNIT. PERFORM ACCESS-IDMS. ENDPROGRAM. GOBACK. *********************************************************************** 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. ****************************************************************** * RESULTS SET COLUMN TYPES ****************************************************************** CHANGE MOVE W-SQL-CHAR TO VG-SQLTYPE (1). CHANGE MOVE W-SQL-SMALL TO VG-SQLTYPE (2). CHANGE INSERT ADDITIONAL COLUMNS, IF ANY ****************************************************************** * RESULTS SET COLUMN LENGTHS * * NOTE: LENGTH OF A VARCHAR FIELD IS THE LENGTH OF THE ACTUAL * DATA FIELD ****************************************************************** CHANGE MOVE LENGTH OF W-OUT-DATA1 TO VG-SQLLEN (1). CHANGE MOVE LENGTH OF W-OUT-DATA2 TO VG-SQLLEN (2). CHANGE INSERT ADDITIONAL COLUMNS, IF ANY ****************************************************************** * RESULTS SET COLUMN NAMES ****************************************************************** CHANGE MOVE 5 TO VG-SQLNAMEL (1). CHANGE MOVE 'DATA1' TO VG-SQLNAMET (1). CHANGE MOVE 5 TO VG-SQLNAMEL (2). CHANGE MOVE 'DATA2' TO VG-SQLNAMET (2). CHANGE INSERT ADDITIONAL COLUMNS, IF ANY ****************************************************************** * INPUT PARMS ARE DESCRIBED AFTER THE RESULT SET. * THIS HELPS THE SEND DRIVER TO VERIFY DATA TYPES ****************************************************************** * 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 NAMES. * ********************************************************** * THE NAME OF AN INPUT PARAMETER IS ALWAYS *INPUT* ****************************************************************** CHANGE MOVE 7 TO VG-SQLNAMEL (??) CHANGE VG-SQLNAMEL (??) CHANGE VG-SQLNAMEL (??). CHANGE MOVE '*INPUT*' TO VG-SQLNAMET (??) CHANGE VG-SQLNAMET (??) CHANGE VG-SQLNAMET (??). CHANGE INSERT ADDITIONAL PARMATERS, IF ANY ****************************************************************** * SET PARAMETER LENGTHS ****************************************************************** MOVE LENGTH OF W-INP-PARM1 TO VG-SQLLEN (??). ****************************************************************** * 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 * ********************************************************** CHANGE MOVE X'09' TO VG-PRECISION (??). CHANGE MOVE X'02' TO VG-DECIMALS (??). * ********************************************************** * * OR COMPUTE THE VALUE OF VG-SQLLEN ****************************************************************** CHANGE COMPUTE VG-SQLLEN (??) ROUNDED = 9 * 256 + 2 CHANGE MOVE LENGTH OF W-INP-PARM3 TO VG-SQLLEN (??). CHANGE INSERT ADDITIONAL PARMATERS, IF ANY ****************************************************************** * SET PARAMETER DATA TYPES ****************************************************************** CHANGE MOVE W-SQL-VARCHAR TO VG-SQLTYPE (??). CHANGE MOVE W-SQL-PACKED TO VG-SQLTYPE (??). CHANGE MOVE W-SQL-CHAR TO VG-SQLTYPE (??). CHANGE INSERT ADDITIONAL PARMATERS, IF ANY END-IF. ****************************************************************** * COMPUTE THE LENGTH OF VG-SQLDA ****************************************************************** COMPUTE VG-SQLDABC = VG-SQLN * W-SQLVARLEN + W-SQLDAFIXLEN. TEST*** MOVE '*** LEAVING FILL-SQLDA ***' TO SNAP-TITLE-TEXT. TEST*** SNAP TITLE SNAP-TITLE. *********************************************************************** START-RUN-UNIT SECTION. IF (W-TRACE-ON) THEN MOVE '*** ENTERING START-RUN-UNIT ***' TO SNAP-TITLE-TEXT SNAP TITLE SNAP-TITLE END-IF. MOVE 'IDMSSP1' TO PROGRAM-NAME. MOVE 'MYSUBSCHEMA' TO SUBSCHEMA-SSNAME. ****************************************************************** * RUN UNIT REMAINS OPEN BETWEEN SUBSEQUENT CALLS WITHIN THE * SAME TASK. ****************************************************************** IF (NOT RUN-UNIT-OPEN) THEN TEST*** MOVE '*** IDMSSP1: RUN-UNIT NOT OPEN ***' TO TEST*** SNAP-TITLE-TEXT TEST*** SNAP TITLE SNAP-TITLE BIND RUN-UNIT CHANGE READY USAGE-MODE ???? MOVE 'Y' TO SW-RUN-UNIT-OPEN END-IF. ****************************************************************** * NOTE: YOU MUST ALWAYS BIND RECORD LOCATIONS, BECAUSE * STORAGE ADDRESSES MAY CHANGE BETWEEN SUBSEQUENT CALLS ****************************************************************** CHANGE BIND RECORDS CHANGE ... IF (W-TRACE-ON) THEN MOVE '*** LEAVING START-RUN-UNIT ***' TO SNAP-TITLE-TEXT SNAP TITLE SNAP-TITLE END-IF. *********************************************************************** ACCESS-IDMS SECTION. IF (W-TRACE-ON) THEN MOVE '*** ENTERING ACCESS-IDMS ***' TO SNAP-TITLE-TEXT SNAP TITLE SNAP-TITLE END-IF. CHANGE INSERT YOUR DML HERE ****************************************************************** * YOU SHOULD CONVERT ACCEPTABLE IDMS STATUS CODES TO SQL CODES * E.G. END-OF-SET = +100 * DB-REC-NOT-FOUND = +100 ****************************************************************** ****************************************************************** * BEFORE RETURNING ANY DATA, SET THE LENGTH * OF THE VARIABLE PART OF THE OUTPUT MESSAGE ****************************************************************** MOVE LENGTH OF W-OUT-DATA TO WSQLOLEN. ****************************************************************** * AND THEN CALCULATE THE TOTAL LENGTH OF THE MESSAGE ****************************************************************** COMPUTE W-LENGTH = WSQLOLEN + W-OFIXLEN. *************************************************************** * WRITE THE OUTPUT MESSAGE TO SCRATCH *************************************************************** PUT SCRATCH AREA ID WGSVOUT FROM WSQLOUT LENGTH W-LENGTH. IF (W-TRACE-ON) THEN MOVE '*** LEAVING ACCESS-IDMS ***' TO SNAP-TITLE-TEXT SNAP TITLE SNAP-TITLE END-IF. ************************************************************************ PROCINFO SECTION. ****************************************************************** * 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. *********************************************************************** SEND-ERROR SECTION. MOVE 70 TO VG-SQLERRMN. 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. *********************************************************************** *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-SQLERRMN. 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.