IDENTIFICATION DIVISION.
PROGRAM-ID. ISQLTEST.
* Sample program that provides a screen interface to the
* new ISQL statements available in 3.40
* Compile with the -G q switch to enable SQL support
* Revision History
* 06/30/2004 3.44 First release
* 04/01/2005 3.50 Updates v4
* 03/16/2011 4.50 Update for GET COLUMNS and GET TABLES v5
* GET DIAGNOSTICS COLUMN COUNT
* Allow CONNECT DEFAULT and USER v6
* Allow several optiosn for
* GET TABLES/COLUMNS v7
*
*
* Documentation:
*
* All the ISQL functions are driven via a Function Key interface.
*
* First a database must be available via ODBC. Under Windows use
* the ODBC Administrator to add an ODBC UserDSN or SystemDSN.
* That allows the appropriate driver (ACCESS, ICISAM, ORACLE,
* MySQL, etc.) and the corresponding database to be setup.
* Under UNIX usually you edit an odbcini file.
*
* Second, use Connect (F1/sF1/cF1) to connect to a dataset.
* F1 connect using the name only, sF1 connect using a Username/password
* cF1 connect using DEFAULT and environment variables.
* This will connect thru ODBC to the appropriate driver and database.
* csF1 will DisConnect.
*
* If at this point an SQL error of SQLSTATE = "28001" is received then
* that is an "Authorization Failure: an ICSQL license cannot be found."
* Make sure that you have an ICSQL license in your .lic file that
* ICPERMIT is using.
*
* If any other error is received, then hitting F12 will provide more
* information about that error. F12 can be done at any time to get
* additional information about the SQLSTATE.
* For example if a connect error=IM002 is received, then
* doing F12 will show something like:
* [Microsoft][ODBC Driver Manager] Data souce name not found
* in the Msg part of the display.
*
* Using Get Tables and Get Columns (sF12 or cF12) can provide
* information on the dataset, tables available and the columns in
* the tables. csF12 will show TABLE/COLUMN help.
*
* Statements (1-3) and Parameters (a-d) can be entered at any time
* they will be used as indicated by Prepare and Execute.
*
* After a Connect SQL statements can be entered. For example under 1)
* enter "select * from
" where is replaced with a valid
* tablename from the database specified.
*
* Use F2 to Prepare a statement, sF2 changes the id used
* F3 to Execute that statement, sF3 changes the id used, cF3 set # of parms
* If there were NO errors then use
* F4 to Fetch values from the result set, sF5 sets the number of columns
* to retrieve.
*
* csF1 will Disconnect from a DSN, and cF2 will DeAllocate a statement.
*
* Remember this is just a very simple generic program that allows you
* to get a taste for using ISQL. There is much more capability here that
* is not shown!
*
* Again F12 Get Diagnostics provides information on the most recent
* operation.
*
* After a GET TABLES, GET COLUMNS, or EXECUTE statement the new
* GET DIAGNOSTICS x = COLUMN COUNT call is made to initialize the
* number of FETCH arguments to show.
*
* Note: For GET TABLES and GET COLUMNS the per-cent "%" is the template
* character for CATALOG, SCHEMA, TABLES and COLUMNS. TYPE is a list
* of table types (like TABLE, SYSTEM TABLE, VIEW, ...
*
*
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 DATASOURCENAME PIC X(60).
01 DATASOURCE-USER PIC X(20).
01 DATASOURCE-PWD PIC X(20).
01 CAT-NAME CHAR VARYING (20) VALUE "%".
01 SCH-NAME CHAR VARYING (20) VALUE "%".
01 TAB-NAME CHAR VARYING (20) VALUE "%".
01 TYP-NAME CHAR VARYING (30) VALUE "TABLE".
01 COL-NAME CHAR VARYING (20) VALUE "".
01 FKEY PIC 99.
01 pFKEY PIC 99.
01 FKEY2 PIC 99.
01 PREPARE-ID PIC X VALUE "1".
01 PREPARE-STATEMENT PIC X(200).
01 SQL-STUFF.
02 SQL-STATEMENT OCCURS 10 TIMES PIC x(100).
01 PARM-A1 PIC X(30) VALUE SPACES.
01 PARM-A2 PIC X(30) VALUE SPACES.
01 PARM-A3 PIC X(30) VALUE SPACES.
01 PARM-A4 PIC X(30) VALUE SPACES.
01 EXECUTE-ID PIC X VALUE "1".
01 EXECUTE-PARMS PIC 9 VALUE 0.
01 EXECUTE-IMM-STATEMENT PIC X(200).
01 FETCH-ARGS PIC 99 VALUE 18.
01 FETCH-ARGUMENTS.
02 VSTR OCCURS 100 TIMES CHAR VARYING (100).
01 FETCH-INDICATORS.
02 IND OCCURS 100 TIMES USAGE IS INDICATOR.
*01 SQLSTATExx PIC x(5).
77 i pic 99.
77 i-col pic 99.
77 i-line pic 99.
* Get Diagnostics
01 GD-COL-COUNT PIC 9(10).
01 hold-GD-COL-COUNT PIC 9(10).
01 GD-ROW-COUNT PIC 9(10).
01 GD-NUMBER PIC 9(10).
01 GD-COMMAND-FUNC PIC X(50).
01 GD-DYNAMIC-FUNC PIC X(50).
01 GD-NATIVE-ERROR PIC 9(10).
01 GD-MESSAGE-LEN PIC 9(5).
01 GD-SQLSTATE PIC X(5).
01 GD-MESSAGE-TEXT PIC X(240).
SCREEN SECTION.
01 BLANK-SCREEN.
02 BLANK SCREEN.
01 MAIN-SCREEN.
02 LINE 1 COL 10 BOLD "ISQLTest v7".
02 LINE 1 COL 60 "SQLSTATE: ".
02 BOLD PIC X(5) FROM SQLSTATE.
02 GET-DSN.
03 LINE 2 COL 1 "DataSource Name: ".
03 PIC X(60) USING DataSourceName.
02 LINE 3 COL 1 "Statements(below)".
02 GET-IDS.
03 GET-ID-PREPARE.
04 COL 41 "ID to prepare: ".
04 PIC 9 USING PREPARE-ID.
03 GET-ID-EXECUTE.
04 " to execute: ".
04 PIC 9 USING EXECUTE-ID.
02 GET-STATEMENTS.
03 LINE 4 COL 1 "1: ".
03 PIC X(77) USING SQL-STATEMENT (1).
03 LINE 5 COL 1 "2: ".
03 PIC X(77) USING SQL-STATEMENT (2).
03 LINE 6 COL 1 "3: ".
03 PIC X(77) USING SQL-STATEMENT (3).
03 GET-PARMS.
04 LINE 7 COL 1 "Parms: a=".
04 PIC X(30) USING PARM-A1.
04 " b=".
04 PIC X(30) USING PARM-A2.
04 LINE 8 COL 1 "Parms: c=".
04 PIC X(30) USING PARM-A3.
04 " d=".
04 PIC X(30) USING PARM-A4.
02 GET-IMM.
03 LINE 9 COL 1 "ExeIMM: ".
03 PIC X(70) USING EXECUTE-IMM-STATEMENT.
* 00000000011111111112222222222333333333344444444445555555555666666666677777777778
01 MAIN-FUNCTIONS.
02 LINE 10 COL 1 BOLD "Functions:".
02 " F12 GET DIAGNOSTICS, sF12 GET TABLES, cF12 GET COLUMNS, csF12 HELP".
02 LINE 11 COL 1 "F1/sF1/cF1/csF1 Connect DSN/+UID/DEFAULT/DisConn, F2/sF2/cF2 Prepare/ID/Dealloc".
02 LINE 12 COL 1 "F3 Execute with: ".
02 GET-EXECUTE-PARMS.
03 PIC 9 USING EXECUTE-PARMS.
02 " params, sF3 ID, cF3 # of parms, csF3 Execute-Imm".
02 LINE 13 COL 1 "F4 Fetch with: ".
02 GET-FETCH-ARGS.
03 PIC 99 USING FETCH-ARGS.
02 " args, sF4 # of args, F10/sF10 Commit/Rollback".
01 MAIN-SCREEN2.
02 GET-DSN-UID.
03 LINE 2 COL 1 "DataSource Name: ".
03 PIC X(60) USING DataSourceName.
03 LINE 16 COL 1 "User: ".
03 PIC X(20) USING DATASOURCE-USER.
03 " Pwd: ".
03 PIC X(20) USING DATASOURCE-PWD.
01 MAIN-SCREEN-TAB.
02 GET-TABLE.
03 LINE 16 COL 1 "Catalog: ".
03 PIC X(20) USING CAT-NAME.
03 " Schema: ".
03 PIC X(20) USING SCH-NAME.
03 LINE 17 COL 1 "Table: ".
03 PIC X(20) USING TAB-NAME.
03 " Type: ".
03 PIC X(30) USING TYP-NAME.
03 LINE 18 "F1 None of the above, F2 Use ONLY TABLE, F3 Use Only TABLE and TYPE".
01 CL-LINE16.
02 LINE 16 BLANK LINE.
01 CL-LINE17-30.
02 LINE 17 COL 30 BLANK LINE.
01 MAIN-SCREEN-COL.
02 GET-COLUMN.
03 LINE 16 COL 1 "Catalog: ".
03 PIC X(20) USING CAT-NAME.
03 " Schema: ".
03 PIC X(20) USING SCH-NAME.
03 LINE 17 COL 1 "Table: ".
03 PIC X(20) USING TAB-NAME.
03 " Column: ".
03 PIC X(20) USING COL-NAME.
03 LINE 18 "F1 Do not use Catalog/Schema/Table/Column".
01 OUTPUT-LOC.
02 LINE 14 COL 1.
01 OUTPUT-LOC-ERASE.
02 LINE 14 COL 1 ERASE EOS.
01 GD-SCREEN-START.
02 LINE 15 COL 1 "ColCount: ".
02 BOLD PIC Z(3)9 FROM GD-COL-COUNT.
02 " RowCount: ".
02 BOLD PIC Z(5)9 FROM GD-ROW-COUNT.
02 " Number: ".
02 BOLD PIC Z(5)9 FROM GD-NUMBER.
02 " Cmd: ".
02 BOLD PIC X(30) FROM GD-COMMAND-FUNC.
02 LINE 16 "Dyn: ".
02 BOLD PIC X(35) FROM GD-DYNAMIC-FUNC.
01 GD-SCREEN-LOOP.
02 "SQLSTATE: ".
02 BOLD PIC X(5) FROM GD-SQLSTATE.
02 " Native Err: ".
02 BOLD PIC Z(7)9 FROM GD-NATIVE-ERROR.
02 " MsLen: ".
02 BOLD PIC Z(4)9 FROM GD-MESSAGE-LEN.
02 LINE PLUS 1.
02 COL 1 "Msg: ".
02 BOLD PIC X(75) FROM GD-MESSAGE-TEXT (1:75).
02 LINE PLUS 1.
02 BOLD PIC X(80) FROM GD-MESSAGE-TEXT (76:80).
01 HELP-TABLE.
02 LINE 15 "Get Tables columns: TABLE_CAT, TABLE_SCHEM, TABLE_NAME, TABLE_TYPE, REMARKS".
02 LINE 16 "Get Columns columns: TABLE_CAT, TABLE_SCHEM, TABLE_NAME, COLUMN_NAME, DATA_TYPE,".
02 LINE 17 "TYPE_NAME, COLUMN_SIZE, BUFFER_LENGTH, DECINAL_DIGITS, NUM_PREC_RADIX, NULLABLE,".
02 LINE 18 "REMARKS, COLUMN_DEF, SQL_DATA_TYPE, DATETIME_SUB, CHAR_OCTET_LENGTH,".
02 LINE 19 "ORDINAL_POSITION, IS_NULLABLE".
PROCEDURE DIVISION.
MAIN-LOGIC SECTION.
ML-BEGIN.
* set fma-ndx to 1.
DISPLAY BLANK-SCREEN.
RECYCLE.
* MOVE SQLSTATE TO SQLSTATExx.
DISPLAY MAIN-SCREEN.
DISPLAY MAIN-FUNCTIONS.
MOVE FKEY TO PFKEY.
ACCEPT GET-STATEMENTS.
ACCEPT FKEY FROM ESCAPE.
* 2-Escapes
IF FKEY = 1 AND PFKEY = 1
GO TO ML-END-PROGRAM.
* 1-Escape, clear screen, recycle
IF FKEY = 1
DISPLAY BLANK-SCREEN
GO TO RECYCLE.
* Clear output area
DISPLAY OUTPUT-LOC-ERASE.
* F1(2), sF1(10), cF1(18), csF1(26) Open/Close DSN (database)
IF FKEY = 2 OR FKEY = 10 OR FKEY = 18
IF FKEY = 2
ACCEPT GET-DSN
END-IF
IF FKEY = 10
DISPLAY GET-DSN-UID
ACCEPT GET-DSN-UID
END-IF
DISPLAY OUTPUT-LOC
PERFORM CONNECT-IT
END-IF.
IF FKEY = 26
PERFORM DISCONNECT-IT.
* F2(3) sF2(11) cF2(19)Prepare or Deallocate ids
IF FKEY = 3
PERFORM PREPARE-IT.
If FKEY = 11
ACCEPT GET-ID-PREPARE
GO TO RECYCLE.
IF FKEY = 19
PERFORM DEALLOCATE-IT.
* F3(6) sF3(14) id cF3(22) EXECUTE, csF3(28) Exec Imm
IF FKEY = 4
PERFORM EXECUTE-IT.
IF FKEY = 12
ACCEPT GET-ID-EXECUTE
GO TO RECYCLE.
IF FKEY = 20
ACCEPT GET-EXECUTE-PARMS
GO TO RECYCLE.
IF FKEY = 28
ACCEPT GET-IMM
DISPLAY OUTPUT-LOC
PERFORM EXECUTE-IMM-IT.
*F4(5), sF6(13), Fetch, set fetch count
IF FKEY = 5
PERFORM FETCH-IT.
IF FKEY = 13
ACCEPT GET-FETCH-ARGS
GO TO RECYCLE.
* F10/sF10
IF FKEY = 35
PERFORM COMMIT-IT.
IF FKEY = 42
PERFORM ROLLBACK-IT.
* F12 - Diagnostics
IF FKEY = 37
PERFORM GD-STUFF.
* sF12(44)/cF12(51) GET TABLES/GET COLUMNS
IF FKEY = 44
PERFORM GETTAB.
IF FKEY = 51
PERFORM GETCOL.
*csF12 - Help
IF FKEY = 58
DISPLAY HELP-TABLE.
GO TO RECYCLE.
COMMIT-IT.
COMMIT
on sqlerror
display "commit error=" sqlstate
not on sqlerror
display "commit OK " sqlstate
end-commit.
COMMIT-IT-ALL.
COMMIT ALL
on sqlerror
display "commit all error=" sqlstate
not on sqlerror
display "commit all OK " sqlstate
end-commit.
ROLLBACK-IT.
ROLLBACK
on sqlerror
display "rollback error=" sqlstate
not on sqlerror
display "rollback OK " sqlstate
end-rollback.
ROLLBACK-IT-ALL.
ROLLBACK ALL
on sqlerror
display "rollback all error=" sqlstate
not on sqlerror
display "rollback all OK " sqlstate
end-rollback.
CONNECT-IT.
IF FKEY = 2
connect DataSourceName
on sqlerror
display "connect error=" sqlstate
IF SQLSTATE = "28001"
DISPLAY "Authorization Failure: probably no ICSQL license is available"
END-IF
not on sqlerror
display "connect OK " sqlstate
end-connect
END-IF.
IF FKEY = 10
connect DataSourceName USER DATASOURCE-USER DATASOURCE-PWD
on sqlerror
display "connect UID error=" sqlstate
IF SQLSTATE = "28001"
DISPLAY "Authorization Failure: probably no ICSQL license is available"
END-IF
not on sqlerror
display "connect UID OK " sqlstate
end-connect
END-IF.
IF FKEY = 18
* Uses ICSQLDSN, ICSQLUSER, ICSQLPWD environment variables
connect DEFAULT
on sqlerror
display "connect DEFAULT error=" sqlstate
IF SQLSTATE = "28001"
DISPLAY "Authorization Failure: probably no ICSQL license is available"
END-IF
not on sqlerror
display "connect DEFAULT OK " sqlstate
end-connect
END-IF.
DISCONNECT-IT.
* disconnect current
disconnect DataSourceName
on sqlerror
display "disconnect error=" sqlstate
not on sqlerror
display "disconnect OK " sqlstate
end-disconnect.
GETCOL.
DISPLAY GET-COLUMN.
ACCEPT GET-COLUMN.
ACCEPT FKEY2 FROM ESCAPE.
DISPLAY OUTPUT-LOC.
IF FKEY2 = 2
DISPLAY OUTPUT-LOC-ERASE
GET COLUMNS Prepare-id
on sqlerror
display "get columns error=" sqlstate
not on sqlerror
display "get columns OK " sqlstate
END-GET
ELSE
DISPLAY OUTPUT-LOC
GET COLUMNS Prepare-id
CATALOG CAT-NAME
SCHEMA SCH-NAME
TABLE TAB-NAME
COLUMN COL-NAME
on sqlerror
display "get columns error=" sqlstate
not on sqlerror
display "get columns OK " sqlstate
END-GET
END-IF.
GET DIAGNOSTICS
hold-GD-COL-COUNT = COLUMN COUNT
NOT ON EXCEPTION
IF hold-GD-COL-COUNT > 0
MOVE hold-GD-COL-COUNT TO FETCH-ARGS;
END-IF
END-GET.
GETTAB.
DISPLAY GET-TABLE.
ACCEPT GET-TABLE.
ACCEPT FKEY2 FROM ESCAPE.
DISPLAY OUTPUT-LOC.
IF FKEY2 = 2 OR FKEY2 = 3 OR FKEY2 = 4
* second F1
DISPLAY CL-LINE16
DISPLAY OUTPUT-LOC
* Some drivers do not support CATALOG or SCHEMA
IF FKEY2 = 2
DISPLAY OUTPUT-LOC-ERASE
GET TABLES Prepare-id
on sqlerror
display "get tables error=" sqlstate
not on sqlerror
display "get tables OK " sqlstate
END-GET
END-IF
IF FKEY2 = 3
* second F2, use TABLE
DISPLAY CL-LINE17-30
DISPLAY OUTPUT-LOC
GET TABLES Prepare-id
TABLE TAB-NAME
on sqlerror
display "get tables error=" sqlstate
not on sqlerror
display "get tables OK " sqlstate
END-GET
END-IF
IF FKEY2 = 4
* second F4, use TABLE and TYPE
GET TABLES Prepare-id
TABLE TAB-NAME
TYPE TYP-NAME
* type does not support % must use list of tables, TABLE, SYSTEM TABLE, VIEW. ,,,
on sqlerror
display "get tables error=" sqlstate
not on sqlerror
display "get tables OK " sqlstate
END-GET
END-IF
ELSE
DISPLAY OUTPUT-LOC
GET TABLES Prepare-id
CATALOG CAT-NAME
SCHEMA SCH-NAME
TABLE TAB-NAME
TYPE TYP-NAME
on sqlerror
display "get tables error=" sqlstate
not on sqlerror
display "get tables OK " sqlstate
END-GET
END-IF.
GET DIAGNOSTICS
hold-GD-COL-COUNT = COLUMN COUNT
NOT ON EXCEPTION
IF hold-GD-COL-COUNT > 0
MOVE hold-GD-COL-COUNT TO FETCH-ARGS;
END-IF
END-GET.
PREPARE-IT.
move prepare-id to i.
if i = 0
move 1 to i.
if i > 9
move 1 to i.
prepare PREPARE-ID from SQL-STATEMENT (i)
on sqlerror
display "prepare error=" sqlstate
not on sqlerror
display "prepare OK " sqlstate
end-prepare.
DEALLOCATE-IT.
deallocate prepare PREPARE-ID
on sqlerror
display "deallocate error=" sqlstate
not on sqlerror
display "deallocate OK " sqlstate
end-deallocate.
EXECUTE-IT.
IF EXECUTE-PARMS = 0
execute EXECUTE-ID
on sqlerror
display "execute0 error=" sqlstate
not on sqlerror
display "execute0 OK " sqlstate
end-execute
END-IF.
IF EXECUTE-PARMS = 1
execute EXECUTE-ID using Parm-A1
on sqlerror
display "execute1 error=" sqlstate
not on sqlerror
display "execute1 OK " sqlstate
end-execute
END-IF.
IF EXECUTE-PARMS = 2
execute EXECUTE-ID using Parm-A1
Parm-A2
on sqlerror
display "execute2 error=" sqlstate
not on sqlerror
display "execute2 OK " sqlstate
end-execute
END-IF.
IF EXECUTE-PARMS = 3
execute EXECUTE-ID using Parm-A1
Parm-A2
Parm-A3
on sqlerror
display "execute3 error=" sqlstate
not on sqlerror
display "execute3 OK " sqlstate
end-execute
END-IF.
IF EXECUTE-PARMS >= 4
execute EXECUTE-ID using Parm-A1
Parm-A2
Parm-A3
Parm-A4
on sqlerror
display "execute4 error=" sqlstate
not on sqlerror
display "execute4 OK " sqlstate
end-execute
END-IF.
GET DIAGNOSTICS
hold-GD-COL-COUNT = COLUMN COUNT
NOT ON EXCEPTION
IF hold-GD-COL-COUNT > 0
MOVE hold-GD-COL-COUNT TO FETCH-ARGS;
END-IF
END-GET.
EXECUTE-IMM-IT.
execute immediate EXECUTE-IMM-STATEMENT
on sqlerror
display "execute imm error=" sqlstate
not on sqlerror
display "execute imm OK " sqlstate
end-execute.
FETCH-IT.
INITIALIZE FETCH-ARGUMENTS.
INITIALIZE FETCH-INDICATORS.
fetch for EXECUTE-ID into
vstr(1) INDICATOR ind(1),
vstr(2) INDICATOR ind(2),
vstr(3) INDICATOR ind(3),
vstr(4) INDICATOR ind(4),
vstr(5) INDICATOR ind(5),
vstr(6) INDICATOR ind(6),
vstr(7) INDICATOR ind(7),
vstr(8) INDICATOR ind(8),
vstr(9) INDICATOR ind(9),
vstr(10) INDICATOR ind(10),
vstr(11) INDICATOR ind(11)
vstr(12) INDICATOR ind(12),
vstr(13) INDICATOR ind(13),
vstr(14) INDICATOR ind(14),
vstr(15) INDICATOR ind(15),
vstr(16) INDICATOR ind(16),
vstr(17) INDICATOR ind(17),
vstr(18) INDICATOR ind(18),
vstr(19) INDICATOR ind(19),
vstr(20) INDICATOR ind(20),
vstr(21) INDICATOR ind(21)
on sqlerror
display "fetch error=" sqlstate
not on sqlerror
display "fetch OK " sqlstate
end-fetch.
MOVE 1 TO I, I-COL
MOVE 15 to i-line
PERFORM FETCH-ARGS TIMES
evaluate TRUE
when ind(I) is null display i line i-line col i-col " ind is null"
when ind(I) is overflow display i line i-line col i-col "*" QUOTE vstr(I) QUOTE
when ind(I) is valid display i line i-line col i-col " " QUOTE vstr(I) QUOTE
end-evaluate
ADD 1 TO I
IF I-COL = 1 THEN
MOVE 41 TO I-COL
ELSE
MOVE 1 TO I-COL
ADD 1 TO I-LINE
END-IF
END-PERFORM.
GD-STUFF.
GET DIAGNOSTICS
GD-COL-COUNT = COLUMN COUNT
GD-ROW-COUNT = ROW COUNT
GD-NUMBER = NUMBER
GD-COMMAND-FUNC = COMMAND FUNCTION
GD-DYNAMIC-FUNC = DYNAMIC FUNCTION
ON EXCEPTION
DISPLAY "GD Diagnostics error, sqlstate=", SQLSTATE
IF SQLSTATE = "28001"
DISPLAY "Authorization Failure: probably no ICSQL license is available"
END-IF
NOT ON EXCEPTION
DISPLAY GD-SCREEN-START;
* Use below for non-screen case
* DISPLAY "Rowcount: ", GD-ROW-COUNT, " Number: ", GD-NUMBER;
* DISPLAY "Cmd: ", GD-COMMAND-LINE;
* DISPLAY "Dyn: ", GD-DYNAMIC-FUNC;
END-GET.
MOVE SPACES TO GD-SQLSTATE, GD-MESSAGE-TEXT.
MOVE 0 TO GD-MESSAGE-LEN, GD-NATIVE-ERROR.
IF GD-NUMBER > 0
MOVE 1 TO I;
* Loop and get all the exceptions
PERFORM UNTIL I > GD-NUMBER
GET DIAGNOSTICS EXCEPTION I
GD-SQLSTATE = SQLSTATE
GD-MESSAGE-TEXT = MESSAGE TEXT
GD-MESSAGE-LEN = MESSAGE LENGTH
GD-NATIVE-ERROR = NATIVE ERROR
ON EXCEPTION
DISPLAY "GD Exception error, number =", I, " sqlstate=", SQLSTATE;
NOT ON EXCEPTION
DISPLAY "SQLSTATE: ", GD-SQLSTATE, " Native Err: ", GD-NATIVE-ERROR;
DISPLAY "Msg: ", GD-MESSAGE-TEXT (1:GD-MESSAGE-LEN), ".";
END-GET
ADD 1 TO I
END-PERFORM.
ML-END-PROGRAM.
EXIT PROGRAM.
STOP RUN.