Skip Headers

Pro*FORTRAN Supplement to the Oracle Precompilers Guide
Release 1.8

Part Number A42523-1
Go to Documentation Home
Home
Go to Book List
Book List
Go to Table of Contents
Contents
Go to Index
Index
Go to Master Index
Master Index
Go to Feedback page
Feedback

Go to previous page
Previous
Go to next page
Next
View PDF

Sample Programs

This chapter provides several embedded SQL programs to guide you in writing your own. These programs illustrate the key concepts and features of Pro*FORTRAN programming and demonstrate techniques that let you take full advantage of SQL's power and flexibility.

Each sample program in this chapter is available online. Table 3 - 1 shows the usual filenames of the sample programs. However, the exact filenames are system-dependent. For specific filenames, see your Oracle system-specific documentation.

Filename Demonstrates...
SAMPLE1.PFO a simple query
SAMPLE2.PFO cursor operations
SAMPLE3.PFO array fetches
SAMPLE4.PFO datatype equivalencing
SAMPLE5.PFO an Oracle Forms user exit
SAMPLE6.PFO dynamic SQL Method 1
SAMPLE7.PFO dynamic SQL Method 2
SAMPLE8.PFO dynamic SQL Method 3
SAMPLE9.PFO calling a stored procedure
Table 3 - 1. Pro*FORTRAN 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 below. 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