Sample COBOL Function › Sample Function Program

Sample Function Program

The following example shows a sample SQL function program written in COBOL. This program requires the SQL employee demo database.

*COBOL PGM SOURCE FOR FUNBONUS
*RETRIEVAL
*DMLIST
 IDENTIFICATION DIVISION.
 PROGRAM-ID.                     FUNBONUS.
 AUTHOR.                         DEFJE01.
 INSTALLATION.                   SYSTEM71.
 DATE-WRITTEN.                   mm/dd/yyyy.

*----------------------------------------------------------------*
*                                                                *
* CA IDMS SQL                    nn.n                            *
*                                                                *
* FUNBONUS implements the SQL function FUNBONUS                  *
*                                                                *
*----------------------------------------------------------------*
 ENVIRONMENT DIVISION.
*
 CONFIGURATION SECTION.
*SOURCE-COMPUTER.                IBM WITH DEBUGGING MODE.
*
 DATA DIVISION.
*
 WORKING-STORAGE SECTION.
*----------------------------------------------------------------*
*                                                                *
*----------------------------------------------------------------*
LINKAGE SECTION.
 EXEC SQL BEGIN DECLARE SECTION END-EXEC.

 EXEC SQL
   INCLUDE TABLE FIN.UDF_FUNBONUS NO STRUCTURE
 END-EXEC.

 EXEC SQL END DECLARE SECTION END-EXEC.
 77 RESULT-IND                             PIC S9(04) COMP SYNC.
 01 FUN-SQLSTATE.
    02 FUN-SQLSTATE-CLASS                  PIC X(02).
    02 FUN-SQLSTATE-SUBCLASS               PIC X(03).
*----------------------------------------------------------------*
PROCEDURE DIVISION USING F-EMP-ID
                   , USER-FUNC
                   , F-EMP-ID-I
                   , USER-FUNC-I
                   , RESULT-IND
                   , FUN-SQLSTATE.
0000-MAINLINE.

IF F-EMP-ID-I NOT < 0
  THEN
    EXEC SQL
      SELECT SUM(BONUS_AMOUNT) INTO :USER-FUNC
        FROM DEMOEMPL.BENEFITS
       WHERE EMP_ID = :F-EMP-ID
    END-EXEC

    IF SQLSTATE NOT = '00000'
       MOVE -1 TO USER-FUNC-I
       MOVE '38901' TO FUN-SQLSTATE
    ELSE
       MOVE 0 TO USER-FUNC-I
 ELSE
   MOVE -1 TO USER-FUNC-I
   MOVE '38902' TO FUN-SQLSTATE.
EXIT PROGRAM.
STOP RUN.