Example COBOL User-Written Function

The following illustrates a COBOL user-written function.

/* ---------------------------------------------------------------- */
/* Rule File that calls COBOL user-written function                 */
/* ---------------------------------------------------------------- */
/* Cobol Function to reverse Characters                             */
/* ---------------------------------------------------------------- */
UserFunction REV_COB NORMCOB
/* Invoke User Functions */
%%Rev_Name_Cob_Normal = REV_COB(%%Whole_Name)

The name REV_COB refers to the COBOL function NORMCOB as defined in the USERFUNCTION command. NORMCOB (shown below) is a user-written function that reverses an input string. It is a compiled function that is linked into Enrichment and called within the rule file. If NORMCOB required two variables from the print stream instead of one as in the example, an extra step would be necessary to concatenate the two variables together and pass them as one variable to the function. The separation of the values occurs within the user function. If NORMCOB returned two or more variables, all values would have to be concatenated before the return. The built-in functions SUBSTR or RGET can separate the return values into variables.

*****************************************************************
* File: NORMCOB                                                 *
* System: Enrichment                             *
* Version: 6.6.2                                                *
* Language: COBOL (mainframe only)                              *
* Copyright (c)1993-2013 Precisely               *
*---------------------------------------------------------------*
* Purpose: Sample COBOL User-Written Function for "Normal"      *
*          type Enrichment User-Written Function interface.   *
*          This example reverses the input string.              *
*****************************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. NORMCOB.
*
*****************************************************************
 ENVIRONMENT DIVISION.                                          *
*****************************************************************
DATA DIVISION.
*----------------------------------------------------------------
WORKING-STORAGE SECTION.
01     IDX        PIC 999 COMP.
01     IDX2       PIC 999 COMP.
*
*****************************************************************
*                    LINKAGE SECTION                            *
*---------------------------------------------------------------*
*         Declarations for Input/Output call areas to pass data *
*         between the Rule file and this function.              *
*****************************************************************
LINKAGE SECTION.
*--- Input Call Area --------------------------------------------
01 INPUT-CALL-AREA.
*    --- Required fields:
      05 IN-SIGNATURE PIC X(4).
      05 CALL-TYPE PIC X(1).
      05 CALL-FROM PIC X(1).
      05 FILLER PIC X(2).
      05 IN-RC PIC S9(9) COMP.
      05 IN-RV PIC S9(9) COMP.
      05 FILLER PIC X(20).
      05 IN-SIZE PIC S9(9) COMP.
*    --- User defined PIC X fields from Rule file arguments:
      05 IN-DATA PIC X(40).*
*--- Output Call Area -------------------------------------------
01 OUTPUT-CALL-AREA.
*    --- Required fields:
      05 OUT-SIGNATURE PIC X(4).
      05 OUT-RC PIC S9(9) COMP.
      05 OUT-RV PIC S9(9) COMP.
      05 FILLER PIC X(24).
      05 OUT-SIZE PIC S9(9) COMP.
*    --- User defined PIC X fields for combined results:
      05 OUT-DATA PIC X(40).
*
*****************************************************************
PROCEDURE DIVISION USING INPUT-CALL-AREA OUTPUT-CALL-AREA.
*
FUNCTION-START.
*
*   --- Check Input and Output signatures ---------------------
      IF IN-SIGNATURE NOT EQUAL 'PDRI' THEN
         MOVE -3 TO OUT-RC
         GO TO FUNCTION-END
      END-IF.
      IF OUT-SIGNATURE NOT EQUAL 'PDRO' THEN
         MOVE -3 TO OUT-RC
         GO TO FUNCTION-END
      END-IF.
*
*   --- Perform User function HERE: ---------------------------
*       -- Print some stuff
*       -- Reverse string
      INITIALIZE OUT-DATA, IDX2.
      PERFORM VARYING IDX FROM IN-SIZE BY -1
         UNTIL IDX EQUAL 0
         ADD 1 TO IDX2
         MOVE IN-DATA (IDX:1) TO OUT-DATA (IDX2:1)
      END-PERFORM.
*
*   --- Store return value, size and set return code & value --
   MOVE IN-SIZE TO OUT-SIZE.
   MOVE 0 TO OUT-RC.
   MOVE 0 TO OUT-RV.
*
 FUNCTION-END.
 EXIT.
*** End of NORMCOB COBOL II File ***************************