HP 3000 Manuals

Returning Output Values [ ALLBASE/SQL Release F.0 Application Programming Bulletin for MPE/iX ] MPE/iX 5.0 Documentation


ALLBASE/SQL Release F.0 Application Programming Bulletin for MPE/iX

Returning Output Values 

You can return data values to an application from a procedure (although
not from a procedure invoked by a rule) by using the OUTPUT option in the
parameter list.  To do this you must use the OUTPUT option in both the
CREATE PROCEDURE and EXECUTE PROCEDURE statements.  The following shows
the statement that creates such a procedure:

     CREATE PROCEDURE GetName (PartNumber CHAR(16) NOT NULL,
     PartName CHAR(30) NOT NULL  OUTPUT) as
     BEGIN
        SELECT PartName INTO :PartName
        FROM PurchDB.Parts
        WHERE PartNumber = :PartNumber);
        RETURN ::sqlcode;
     END;

The following shows how the procedure is invoked from an application
program:

     Host variables are declared.  In this example, the host variable names are
     different from the parameter names used in the CREATE PROCEDURE statement. 

          C Declarations:               COBOL Declarations: 

     EXEC SQL BEGIN DECLARE SECTION;    EXEC SQL BEGIN DECLARE SECTION END-EXEC.
        char PartNo[16];                01  PARTNO          PIC X(15).
        char Part[31];                  01  PART            PIC X(30).
        int ReturnStatus;               01  RETCODE         PIC S9(9) COMP.
     EXEC SQL END DECLARE SECTION;      EXEC SQL END DECLARE SECTION END-EXEC.

     The application prompts for a part number, then calls the
     procedure to obtain the part's name from the Parts table, as follows: 

          In C:                         In COBOL: 

     EXEC SQL EXECUTE PROCEDURE         EXEC SQL EXECUTE PROCEDURE
     :ReturnStatus=GetName                :RETCODE = GETNAME (:PARTNO,
     (:PartNo, :Part  OUTPUT);             :PART  OUTPUT) END-EXEC.
     if(sqlca.sqlcode==0)               IF SQLCODE IS ZERO THEN
       if(ReturnStatus==0)                IF RETCODE IS ZERO THEN
         printf("Name is %s\n", Part);       DISPLAY "NAME IS " PART
                                          END-IF.
                                        END-IF.

In the CREATE PROCEDURE statement, two parameters are defined and given
data types and sizes:  PartNumber and PartName, which is declared for
output.  In the EXECUTE PROCEDURE statement, the parameters are passed in
host variables :PartNo and :Part, which is marked for OUTPUT. On a
successful return from the procedure, the part name is printed out.


NOTE Be sure to test SQLCODE first and then (if desired) the return status code before examining the data returned in OUTPUT parameters.


MPE/iX 5.0 Documentation