3 Sample Programs

Sample Program 1: Simple Query

This program connects to Oracle, prompts the user for an employee number, queries the database for the employee's name, salary, and commission, then displays the result. The program ends when the user enters a zero employee number.

PROGRAM QUERY

 EXEC SQL BEGIN DECLARE SECTION
 CHARACTER*10 UID
 CHARACTER*10 PWD
 INTEGER EMPNO
 CHARACTER*10 ENAME
 REAL SAL
 REAL COMM
 INTEGER*2 ICOMM
 EXEC SQL END DECLARE SECTION

 INTEGER TOTAL

 EXEC SQL INCLUDE SQLCA
 EXEC SQL WHENEVER SQLERROR DO CALL SQLERR

* LOG ON TO ORACLE.
 UID = 'SCOTT'
 PWD = 'TIGER'
 EXEC SQL CONNECT :UID IDENTIFIED BY :PWD
 PRINT *, 'CONNECTED TO ORACLE AS USER: ', UID

* QUERY LOOP REPEATS UNTIL THE USER ENTERS A 0
 TOTAL = 0
2000 CONTINUE

 PRINT *, '\NENTER EMPLOYEE NUMBER (0 TO QUIT): '
 READ '(I10)', EMPNO
 IF (EMPNO .EQ. 0) CALL SIGNOFF (TOTAL)

 EXEC SQL WHENEVER NOT FOUND GOTO 7000
 EXEC SQL SELECT ENAME, SAL, COMM
 1 INTO :ENAME, :SAL, :COMM:ICOMM
 2 FROM EMP
 3 WHERE EMPNO = :EMPNO

 PRINT *, 'EMPLOYEE SALARY COMMISSION\N',
 +'---------- ------- ----------'

 
IF (ICOMM .EQ. -1) THEN
 PRINT '(A10, 2X, F7.2, A12)', ENAME, SAL, ' NULL'
 ELSE
 PRINT '(A10, 2X, F7.2, 5X, F7.2)', ENAME, SAL, COMM
 END IF

 TOTAL = TOTAL + 1
 GOTO 2000

7000 CONTINUE

 PRINT *, 'NOT A VALID EMPLOYEE NUMBER - TRY AGAIN.'
 GOTO 2000
 END

 SUBROUTINE SIGNOFF (NUMQ)
 INTEGER NUMQ
 EXEC SQL INCLUDE SQLCA
 PRINT *, 'TOTAL NUMBER QUERIED WAS: ', NUMQ
 PRINT *, 'HAVE A GOOD DAY.'
 EXEC SQL COMMIT WORK RELEASE 
 STOP
 END

 SUBROUTINE SQLERR
 EXEC SQL INCLUDE SQLCA
 EXEC SQL WHENEVER SQLERROR CONTINUE
 PRINT *, 'ORACLE ERROR DETECTED:'
 PRINT '(70A1)', SQLEMC
 EXEC SQL ROLLBACK WORK RELEASE
 STOP
 END

Sample Program 2: Cursor Operations

This program connects to Oracle, declares and opens a cursor, fetches the names, salaries, and commissions of all salespeople, displays the results, then closes the cursor.

PROGRAM CURSOR

 EXEC SQL BEGIN DECLARE SECTION
 CHARACTER*10 UID
 CHARACTER*10 PWD
 CHARACTER*10 ENAME
 REAL SAL
 REAL COMM
 EXEC SQL END DECLARE SECTION

 EXEC SQL INCLUDE SQLCA
 EXEC SQL WHENEVER SQLERROR DO CALL SQLERR

* LOG ON TO ORACLE.
 UID = 'SCOTT'
 PWD = 'TIGER'
 EXEC SQL CONNECT :UID IDENTIFIED BY :PWD
 PRINT *, 'CONNECTED TO ORACLE AS USER:', UID

* DECLARE THE CURSOR.
 EXEC SQL DECLARE SALESPEOPLE CURSOR FOR
 1 SELECT ENAME, SAL, COMM
 2 FROM EMP
 3 WHERE JOB LIKE 'SALES%'
 EXEC SQL OPEN SALESPEOPLE

 PRINT *, 'SALESPERSON SALARY COMMISSION\N',
 +'----------- ------- ----------'

* LOOP, FETCHING ALL SALESPERSON'S STATISTICS
 EXEC SQL WHENEVER NOT FOUND DO CALL SIGNOFF
3000 EXEC SQL FETCH SALESPEOPLE INTO :ENAME, :SAL, :COMM
 PRINT '(1X, A10, 3X, F7.2, 5X, F7.2)', ENAME, SAL, COMM
 GOTO 3000
 END

 SUBROUTINE SIGNOFF
 EXEC SQL INCLUDE SQLCA
 EXEC SQL CLOSE SALESPEOPLE
 PRINT *, 'HAVE A GOOD DAY.'
 EXEC SQL COMMIT WORK RELEASE 
 STOP
 END

 SUBROUTINE SQLERR
 EXEC SQL INCLUDE SQLCA
 EXEC SQL WHENEVER SQLERROR CONTINUE
 PRINT *, 'ORACLE ERROR DETECTED:'
 PRINT '(70A1)', SQLEMC
 EXEC SQL ROLLBACK WORK RELEASE
 STOP
 END

Sample Program 3: Fetching in Batches

This program logs on to Oracle, declares and opens a cursor, fetches in batches using arrays, and prints the results using the subroutine PRTRES.

PROGRAM ARRAYS

 EXEC SQL BEGIN DECLARE SECTION
 CHARACTER*10 UID
 CHARACTER*10 PWD
 CHARACTER*10 ENAME(5)
 INTEGER EMPNO(5)
 REAL SAL(5)
 EXEC SQL END DECLARE SECTION

* NUMBER OF ROWS RETURNED, AND NUMBER TO PRINT
 INTEGER NUMRET
 INTEGER NUMP
 EXEC SQL INCLUDE SQLCA
 EXEC SQL WHENEVER SQLERROR DO CALL SQLERR

* LOG ON TO ORACLE.
 UID = 'SCOTT'
 PWD = 'TIGER'
 EXEC SQL CONNECT :UID IDENTIFIED BY :PWD
 PRINT *, 'CONNECTED TO ORACLE AS USER: ', UID

* DECLARE THE CURSOR, THEN OPEN IT.
 EXEC SQL DECLARE C1 CURSOR FOR
 1 SELECT EMPNO, ENAME, SAL
 2 FROM EMP
 EXEC SQL OPEN C1
 NUMRET = 0

* LOOP, FETCHING AND PRINTING BATCHES,
* UNTIL NOT FOUND BECOMES TRUE.
 EXEC SQL WHENEVER NOT FOUND GOTO 3000
2000 EXEC SQL FETCH C1 INTO :EMPNO, :ENAME, :SAL
 NUMP = SQLERD(3) - NUMRET
 CALL PRTRES (NUMP, EMPNO, ENAME, SAL)
 NUMRET = SQLERD(3)
 GOTO 2000

* PRINT FINAL SET OF ROWS, IF ANY.
3000 NUMP = SQLERD(3) - NUMRET
 IF (NUMP .GT. 0) CALL PRTRES (NUMP, EMPNO, ENAME, SAL)
 CALL SIGNOFF
 END
 SUBROUTINE PRTRES (NUMP, EMPNO, ENAME, SAL)
 INTEGER NUMP
 INTEGER EMPNO(NUMP)
 CHARACTER*10 ENAME(NUMP)
 REAL SAL(NUMP)

* PRINT HEADER.
 PRINT *, 'EMPLOYEE NUMBER EMPLOYEE NAME SALARY\N',
 +'--------------- ------------- -------'

* PRINT BATCH OF ROWS.
 DO 7000 I = 1, NUMP
 PRINT '(1X, I4, 13X, A10, 5X, F7.2)',
 + EMPNO(I), ENAME(I), SAL(I)
7000 CONTINUE
 RETURN
 END

 SUBROUTINE SIGNOFF
 EXEC SQL INCLUDE SQLCA
 EXEC SQL CLOSE C1
 PRINT *, 'HAVE A GOOD DAY.'
 EXEC SQL COMMIT WORK RELEASE 
 STOP
 END

 SUBROUTINE SQLERR
 EXEC SQL INCLUDE SQLCA
 EXEC SQL WHENEVER SQLERROR CONTINUE
 PRINT *, 'ORACLE ERROR DETECTED:'
 PRINT '(70A1)', SQLEMC
 EXEC SQL ROLLBACK WORK RELEASE
 STOP
 END

Sample Program 4: Datatype Equivalencing

After connecting to Oracle, this program creates a database table named IMAGE in the SCOTT account, then simulates the insertion of bitmap images of employee numbers into the table. Datatype equivalencing lets the program use the Oracle external datatype LONG RAW to represent the images. Later, when the user enters an employee number, the number's "bitmap" is selected from the IMAGE table and pseudo-displayed on the terminal screen.

PROGRAM DTYEQV
 EXEC SQL BEGIN DECLARE SECTION
 CHARACTER*10 UID
 CHARACTER*10 PWD
 INTEGER EMPNO
 CHARACTER*10 ENAME
 REAL SAL
 REAL COMM
 CHARACTER*8192 BUFFER
 EXEC SQL VAR BUFFER IS LONG RAW
 INTEGER SELECTION
 EXEC SQL END DECLARE SECTION

 CHARACTER*10 REPLY

 EXEC SQL INCLUDE SQLCA
 EXEC SQL WHENEVER SQLERROR DO CALL SQLERR

* LOG ON TO ORACLE.
 UID = 'SCOTT'
 PWD = 'TIGER'
 EXEC SQL CONNECT :UID IDENTIFIED BY :PWD
 PRINT *, 'CONNECTED TO ORACLE AS USER: ', UID

 PRINT *, 'PROGRAM IS ABOUT TO DROP THE IMAGE ',
 +'TABLE - OK [Y/N]? '
 READ '(A10)', REPLY
 IF ((REPLY(1:1) .NE. 'Y') .AND. (REPLY(1:1) .NE. 'Y'))
 1 CALL SIGNOFF

 EXEC SQL WHENEVER SQLERROR CONTINUE
 EXEC SQL DROP TABLE IMAGE
 IF (SQLCDE .EQ. 0) THEN
 PRINT *, 'TABLE IMAGE HAS BEEN DROPPED - ',
 + 'CREATING NEW TABLE.'
 ELSE IF (SQLCDE .EQ. -942) THEN
 PRINT *, 'TABLE IMAGE DOES NOT EXIST - ',
 + 'CREATING NEW TABLE.'
 
ELSE
 CALL SQLERR
 END IF

 EXEC SQL WHENEVER SQLERROR DO CALL SQLERR
 EXEC SQL CREATE TABLE IMAGE
 1 (EMPNO NUMBER(4) NOT NULL, BITMAP LONG RAW)
 EXEC SQL DECLARE EMPCUR CURSOR FOR
 1 SELECT EMPNO, ENAME FROM EMP
 EXEC SQL OPEN EMPCUR
 PRINT *, 'INSERTING BITMAPS INTO IMAGE FOR ALL EMPLOYEES...'

7000 CONTINUE
 EXEC SQL WHENEVER NOT FOUND GOTO 10000
 EXEC SQL FETCH EMPCUR INTO :EMPNO, :ENAME
 CALL GETIMG (EMPNO, BUFFER)
 EXEC SQL INSERT INTO IMAGE VALUES (:EMPNO, :BUFFER)
 PRINT *, 'EMPLOYEE ', ENAME, '.......... IS DONE!'
 GOTO 7000

10000 EXEC SQL CLOSE EMPCUR
 EXEC SQL COMMIT WORK
 PRINT *, 'DONE INSERTING BITMAPS. NEXT, LETS DISPLAY SOME.'

* BEGINNING OF DISPLAY LOOP
12000 SELECTION = 0
 PRINT *, '\NENTER EMPLOYEE NUMBER (0 TO QUIT):'
 READ '(I10)', SELECTION
 IF (SELECTION .EQ. 0) CALL SIGNOFF
 EXEC SQL WHENEVER NOT FOUND GOTO 16000

 EXEC SQL SELECT EMP.EMPNO, ENAME, SAL, NVL(COMM,0), BITMAP
 1 INTO :EMPNO, :ENAME, :SAL, :COMM, :BUFFER
 2 FROM EMP, IMAGE
 3 WHERE EMP.EMPNO = :SELECTION
 4 AND EMP.EMPNO = IMAGE.EMPNO
 CALL SHWIMG (BUFFER)

 PRINT *, '\NEMPLOYEE ', ENAME, ' HAS SALARY ', SAL,
 + ' AND COMMISSION ', COMM
 GOTO 12000

16000 PRINT *, 'NOT A VALID EMPLOYEE NUMBER - TRY AGAIN.'
 GOTO 12000
 END

 
 SUBROUTINE GETIMG (ENUM, BUF)
 INTEGER ENUM
 CHARACTER*8192 BUF
 INTEGER I

 DO 18000 I = 1, 8192
 BUF(I:I) = '*'
18000 CONTINUE
 END

 SUBROUTINE SHWIMG (BUF)
 CHARACTER*8192 BUF
 INTEGER I

 PRINT *, ' ***************************'
 DO 22000 I = 1, 9
 PRINT *, ' ***************************'
22000 CONTINUE
 END

 SUBROUTINE SIGNOFF
 EXEC SQL INCLUDE SQLCA
 PRINT *, 'HAVE A GOOD DAY.'
 EXEC SQL COMMIT WORK RELEASE 
 STOP
 END

 SUBROUTINE SQLERR
 EXEC SQL INCLUDE SQLCA
 EXEC SQL WHENEVER SQLERROR CONTINUE
 PRINT *, 'ORACLE ERROR DETECTED:'
 PRINT '(70A1)', SQLEMC
 EXEC SQL ROLLBACK WORK RELEASE
 STOP
 END

Sample Program 5: Oracle Forms User Exit

This user exit concatenates form fields. To call the user exit from a Oracle Forms trigger, use the syntax

<user_exit>('CONCAT <field1>, <field2>, ..., <result_field>');

where user_exit is a packaged procedure supplied with Oracle Forms and CONCAT is the name of the user exit. A sample CONCAT form invokes the user exit. For more information about Oracle Forms user exits, see Chapter 11 of the Programmer's Guide to the Oracle Precompilers.

Note: The sample code listed is for a Oracle*Forms user exit and is not intended to be compiled in the same manner as the other sample programs listed in this chapter.

INTEGER FUNCTION CONCAT (CMD,CMDL,ERR,ERRL,INQRY)

 EXEC SQL BEGIN DECLARE SECTION
 LOGICAL*1 VALUE(81)
 LOGICAL*1 FINAL(241)
 LOGICAL*1 FIELD(81)
 EXEC SQL END DECLARE SECTION

 EXEC SQL INCLUDE SQLCA
 EXEC SQL WHENEVER SQLERROR GO TO 999

 LOGICAL*1 CMD(80)
 LOGICAL*1 ERR(80)
 INTEGER*2 CMDL, ERRL, INQRY

* CERR IS A DYNAMICALLY BUILT ERROR MESSAGE RETURNED
* TO SQL*FORMS.

 LOGICAL*1 CERR(80)

* TEMPORARY VARIABLES TO DO STRING MANIPULATIONS.

 INTEGER*2 CMDCNT
 INTEGER*2 FLDCNT
 INTEGER*2 FNLCNT

* INITIALIZE VARIABLES.

 DO 1 I = 1, 81
 FIELD(I) = ' '
1 VALUE(I) = ' '
 DO 2 I = 1, 241
2 FINAL(I) = ' '
 FNLCNT = 0
* STRIP CONCAT FROM COMMAND LINE.

 CMDCNT = 7
 I = 1

* LOOP UNTIL END OF COMMAND LINE.

 DO WHILE (CMDCNT .LE. CMDL)

* PARSE EACH FIELD DELIMITED BY A COMMA.

 FLDCNT = 0
 DO WHILE ((CMD(CMDCNT) .NE. ',').AND.(CMDCNT .LE. CMDL))
 FLDCNT = FLDCNT + 1
 FIELD(FLDCNT) = CMD(CMDCNT)
 CMDCNT = CMDCNT + 1
 END DO
 IF (CMDCNT .LT. CMDL) THEN

* WE HAVE FIELD1...FIELDN. THESE ARE NAMES OF
* SQL*FORMS FIELDS; GET THE VALUE.

 EXEC IAF GET :FIELD INTO :VALUE

* REINITIALIZE FIELD NAME.

 DO 20 K = 1, FLDCNT
20 FIELD(K) = ' '

* MOVE VALUE RETRIEVED FROM FIELD TO A CHARACTER
* TO FIND LENGTH.

 DO WHILE (VALUE(I) .NE. ' ')
 FNLCNT = FNLCNT + 1
 FINAL(FNLCNT) = VALUE(I)
 I = I + 1
 END DO
 I = 1
 CMDCNT = CMDCNT + 1
 ELSE

* WE HAVE RESULT_FIELD; STORE IN SQL*FORMS FIELD.

 EXEC IAF PUT :FIELD VALUES (:FINAL)
 END IF
 END DO

* ALL OK. RETURN SUCCESS CODE.

 CONCAT = IAPSUC
 RETURN

* ERROR OCCURRED. PREFIX NAME OF USER EXIT TO ORACLE
* ERROR MESSAGE, SET FAILURE RETURN CODE, AND EXIT.

999 CERR(1) = 'C'
 CERR(2) = 'O'
 CERR(3) = 'N'
 CERR(4) = 'C'
 CERR(5) = 'A'
 CERR(6) = 'T'
 CERR(7) = ':'
 CERR(8) = ' '
 DO 1000 J = 1, 70
 CERR(J + 8) = SQLEMC(J)
1000 CONTINUE
 ERRL = 78
 CALL SQLIEM (CERR, ERRL)
 CONCAT = IAPFAI
 RETURN
 END

Sample Program 6: Dynamic SQL Method 1

This program uses dynamic SQL Method 1 to create a table, insert a row, commit the insert, then drop the table.

PROGRAM DYN1

 EXEC SQL INCLUDE SQLCA
 EXEC SQL INCLUDE ORACA
 EXEC ORACLE OPTION (ORACA=YES)
 EXEC ORACLE OPTION (RELEASE_CURSOR=YES)

 EXEC SQL BEGIN DECLARE SECTION
 CHARACTER*10 USERNAME
 CHARACTER*10 PASSWORD
 CHARACTER*80 DYNSTM
 EXEC SQL END DECLARE SECTION

 EXEC SQL WHENEVER SQLERROR GOTO 9000

 ORATXF = 1

 USERNAME = 'SCOTT'
 PASSWORD = 'TIGER'
 EXEC SQL CONNECT :USERNAME IDENTIFIED BY :PASSWORD
 PRINT *, 'CONNECTED TO ORACLE.'

 PRINT *, 'CREATE TABLE DYN1 (COL1 CHAR(4))'
 EXEC SQL EXECUTE IMMEDIATE
 1 'CREATE TABLE DYN1 (COL1 CHAR(4))'

 DYNSTM = 'INSERT INTO DYN1 VALUES (''TEST'')'
 PRINT *, DYNSTM
 EXEC SQL EXECUTE IMMEDIATE :DYNSTM
 EXEC SQL COMMIT WORK

 DYNSTM = 'DROP TABLE DYN1'
 PRINT *, DYNSTM
 EXEC SQL EXECUTE IMMEDIATE :DYNSTM
 EXEC SQL COMMIT RELEASE

 PRINT *, 'HAVE A GOOD DAY!'
 GOTO 9999

9000 PRINT *, '\N-- ORACLE ERROR:'
 PRINT '(70A)', SQLEMC
 PRINT '(3A, 70A)', 'IN ', ORATXC
 PRINT *, 'ON LINE', ORASLN
 PRINT '(3A, 70A)', 'OF ', ORAFNC
 EXEC SQL WHENEVER SQLERROR CONTINUE
 EXEC SQL ROLLBACK RELEASE

9999 CONTINUE
 END

Sample Program 7: Dynamic SQL Method 2

This program uses dynamic SQL Method 2 to insert two rows into the EMP table, then delete them.

PROGRAM DYN2

 EXEC SQL INCLUDE SQLCA

 EXEC SQL BEGIN DECLARE SECTION
 CHARACTER*10 USERNAME
 CHARACTER*10 PASSWORD
 CHARACTER*80 DYNSTM
 INTEGER*2 EMPNO
 INTEGER*2 DEPTNO1
 INTEGER*2 DEPTNO2
 EXEC SQL END DECLARE SECTION

 EXEC SQL WHENEVER SQLERROR GOTO 9000

 USERNAME = 'SCOTT'
 PASSWORD = 'TIGER'
 EXEC SQL CONNECT :USERNAME IDENTIFIED BY :PASSWORD
 PRINT *, 'CONNECTED TO ORACLE.'

 DYNSTM = 'INSERT INTO EMP (EMPNO,DEPTNO) VALUES(:V1, :V2)'
 PRINT *, DYNSTM
 EMPNO = 1234
 DEPTNO1 = 97
 PRINT *, 'V1 = ', EMPNO
 PRINT *, 'V2 = ', DEPTNO1
 EXEC SQL PREPARE S FROM :DYNSTM
 EXEC SQL EXECUTE S USING :EMPNO, :DEPTNO1
 PRINT *, 'INSERT STATEMENT EXECUTED.\N'

 EMPNO = EMPNO + 1
 DEPTNO2 = 99
 PRINT *, 'CHANGED BIND VARIABLES V1 AND V2\NV1 = ', EMPNO
 PRINT *, 'V2 = ', DEPTNO2
 PRINT *, 'EXECUTING STATEMENT AGAIN WITH NEW BIND ',
 + 'VARIABLES.'
 EXEC SQL EXECUTE S USING :EMPNO, :DEPTNO2
 PRINT *, 'DONE, NOW DELETING...\N'

 DYNSTM = 
 + 'DELETE FROM EMP WHERE DEPTNO = :V1 OR DEPTNO = :V2'

 
 PRINT *, DYNSTM
 PRINT *, 'V1 = ', DEPTNO1
 PRINT *, 'V2 = ', DEPTNO2
 EXEC SQL PREPARE S FROM :DYNSTM
 EXEC SQL EXECUTE S USING :DEPTNO1, :DEPTNO2

 EXEC SQL COMMIT RELEASE
 PRINT *, 'HAVE A GOOD DAY!'
 GOTO 9999

9000 PRINT '(70A1)', SQLEMC
 EXEC SQL WHENEVER SQLERROR CONTINUE
 EXEC SQL ROLLBACK RELEASE

9999 CONTINUE
 END

Sample Program 8: Dynamic SQL Method 3

This program uses dynamic SQL Method 3 to retrieve the names of all employees in a given department from the EMP table.

PROGRAM DYN3

 EXEC SQL INCLUDE SQLCA
 EXEC SQL BEGIN DECLARE SECTION
 CHARACTER*10 USERNAME
 CHARACTER*10 PASSWORD
 CHARACTER*80 DYNSTM
 CHARACTER*10 ENAME
 INTEGER*2 DEPTNO
 EXEC SQL END DECLARE SECTION
 EXEC SQL WHENEVER SQLERROR GOTO 9000

 USERNAME = 'SCOTT'
 PASSWORD = 'TIGER'
 EXEC SQL CONNECT :USERNAME IDENTIFIED BY :PASSWORD
 PRINT *, 'CONNECTED TO ORACLE.\N'

 DYNSTM = 'SELECT ENAME FROM EMP WHERE DEPTNO = :V1'
 PRINT *, DYNSTM
 DEPTNO = 10
 PRINT *, 'V1 = ', DEPTNO
 EXEC SQL PREPARE S FROM :DYNSTM
 EXEC SQL DECLARE C CURSOR FOR S
 EXEC SQL OPEN C USING :DEPTNO
 EXEC SQL WHENEVER NOT FOUND GOTO 110

 PRINT *, '\NEMPLOYEE NAME\N-------------'
100 EXEC SQL FETCH C INTO :ENAME
 PRINT *, ENAME
 GOTO 100

110 PRINT *, '\NQUERY RETURNED', SQLERD(3), ' ROWS.'
 EXEC SQL CLOSE C
 EXEC SQL COMMIT RELEASE
 PRINT *, '\NHAVE A GOOD DAY.'
 GOTO 9999

9000 PRINT '(70A1)', SQLEMC
 EXEC SQL WHENEVER SQLERROR CONTINUE
 EXEC SQL CLOSE C
 EXEC SQL ROLLBACK RELEASE

9999 CONTINUE
 END

Sample Program 9: Calling a Stored Procedure

Before trying the sample program, you must create a PL/SQL package named calldemo, by running a script named CALLDEMO.SQL, which is supplied with Pro*FORTRAN and shown in the following example. The script can be found in the Pro*FORTRAN demo library. Check your Oracle system-specific documentation for exact spelling of the script.

CREATE OR REPLACE PACKAGE calldemo AS

 TYPE name_array IS TABLE OF emp.ename%type
 INDEX BY BINARY_INTEGER;
 TYPE job_array IS TABLE OF emp.job%type
 INDEX BY BINARY_INTEGER;
 TYPE sal_array IS TABLE OF emp.sal%type
 INDEX BY BINARY_INTEGER;

 PROCEDURE get_employees(
 dept_number IN number, -- department to query
 batch_size IN INTEGER, -- rows at a time
 found IN OUT INTEGER, -- rows actually returned
 done_fetch OUT INTEGER, -- all done flag
 emp_name OUT name_array,
 job OUT job_array,
 sal OUT sal_array);

END calldemo;
/

CREATE OR REPLACE PACKAGE BODY calldemo AS

 CURSOR get_emp (dept_number IN number) IS
 SELECT ename, job, sal FROM emp
 WHERE deptno = dept_number;

 -- Procedure "get_employees" fetches a batch of employee
 -- rows (batch size is determined by the client/caller
 -- of the procedure). It can be called from other
 -- stored procedures or client application programs.
 -- The procedure opens the cursor if it is not
 -- already open, fetches a batch of rows, and
 -- returns the number of rows actually retrieved. At
 -- end of fetch, the procedure closes the cursor.

 PROCEDURE get_employees(
 dept_number IN number,
 batch_size IN INTEGER,
 found IN OUT INTEGER,
 done_fetch OUT INTEGER,
 emp_name OUT name_array,
 job OUT job_array,
 sal OUT sal_array) IS

 BEGIN
 IF NOT get_emp%ISOPEN THEN -- open the cursor if
 OPEN get_emp(dept_number); -- not already open
 END IF;

 -- Fetch up to "batch_size" rows into PL/SQL table,
 -- tallying rows found as they are retrieved. When all
 -- rows have been fetched, close the cursor and exit
 -- the loop, returning only the last set of rows found.

 done_fetch := 0; -- set the done flag FALSE
 found := 0;

 FOR i IN 1..batch_size LOOP
 FETCH get_emp INTO emp_name(i), job(i), sal(i);
 IF get_emp%NOTFOUND THEN -- if no row was found
 CLOSE get_emp;
 done_fetch := 1; -- indicate all done
 EXIT;
 ELSE
 found := found + 1; -- count row
 END IF;
 END LOOP;
 END;
END;
/

The following sample program connects to Oracle, prompts the user for a department number, then calls a PL/SQL procedure named get_employees, which is stored in package calldemo. The procedure declares three PL/SQL tables as OUT formal parameters, then fetches a batch of employee data into the PL/SQL tables. The matching actual parameters are host tables. When the procedure finishes, row values in the PL/SQL tables are automatically assigned to the corresponding elements in the host tables. The program calls the procedure repeatedly, displaying each batch of employee data, until no more data is found.

PROGRAM CALLSP

 EXEC SQL BEGIN DECLARE SECTION
 CHARACTER*10 UID
 CHARACTER*10 PWD
 INTEGER DEPTNO
 CHARACTER*10 ENAME(10)
 CHARACTER*10 JOB(10)
 REAL SAL(10)
 INTEGER ENDFLG
 INTEGER ARYSIZ
 INTEGER NUMRET
 INTEGER*4 SQLCOD
 EXEC SQL END DECLARE SECTION

 EXEC SQL INCLUDE SQLCA
 EXEC SQL WHENEVER SQLERROR DO CALL SQLERR

 UID = 'SCOTT'
 PWD = 'TIGER'
 EXEC SQL CONNECT :UID IDENTIFIED BY :PWD
 PRINT *, 'CONNECTED TO ORACLE AS USER ', UID

 PRINT *, 'ENTER DEPARTMENT NUMBER: '
 READ '(I10)', DEPTNO

* INITIALIZE VARIABLES AND ARRAYS.
 ENDFLG = 0
 ARYSIZ = 10
 NUMRET = 0
 DO 4000 I = 1, ARYSIZ
 ENAME(I) = ' '
 JOB(I) = ' '
 SAL(I) = 0
4000 CONTINUE

* DISPLAY HEADER.
 PRINT *, 'EMPLOYEE NAME JOB TITLE SALARY\N',
 +'------------- --------- ------'

* LOOP, FETCHING AND PRINTING BATCHES UNTIL END-FLAG IS SET.
6000 EXEC SQL EXECUTE
 1 BEGIN
 2 CALLDEMO.GET_EMPLOYEES (:DEPTNO, :ARYSIZ,
 3 :NUMRET, :ENDFLG, :ENAME, :JOB, :SAL);
 4 END;
 5 END-EXEC

 CALL PBATCH (NUMRET, ENAME, JOB, SAL)
 IF (ENDFLG .EQ. 0) GOTO 6000
 CALL SIGNOFF
 END

*********************** SUBROUTINES *********************
* DISPLAY A BATCH OF ROWS.

 SUBROUTINE PBATCH (ROWS, ENAME, JOB, SAL)
 INTEGER ROWS
 CHARACTER*10 ENAME(ROWS)
 CHARACTER*10 JOB(ROWS)
 REAL SAL(ROWS)

 DO 8000 I = 1, ROWS
 PRINT '(1X, A10, 5X, A10, 1X, F7.2)', ENAME(I), JOB(I), SAL(I)
8000 CONTINUE
 RETURN
 END

* LOG OFF ORACLE.

 SUBROUTINE SIGNOFF
 EXEC SQL INCLUDE SQLCA
 PRINT *, 'HAVE A GOOD DAY.'
 EXEC SQL COMMIT WORK RELEASE 
 STOP
 END

* HANDLE SQL ERRORS.

 SUBROUTINE SQLERR
 EXEC SQL INCLUDE SQLCA
 EXEC SQL WHENEVER SQLERROR CONTINUE
 PRINT *, 'ORACLE ERROR DETECTED:'
 PRINT '(70A1)', SQLEMC
 EXEC SQL ROLLBACK WORK RELEASE
 STOP
 END