COBOL II and LE COBOL user exits: sample 1


This topic provides a sample user exit that is written in COBOL.


      *------------------------
       IDENTIFICATION DIVISION.
      *------------------------
      *
      * THIS IS A SAMPLE OF A COBOL EXIT FOR UNLOAD+ FOR DB2.
      *

       PROGRAM-ID.    ADUEXITC.
       DATE-COMPILED.

      *---------------------
       ENVIRONMENT DIVISION.
      *---------------------

       CONFIGURATION SECTION.

       INPUT-OUTPUT SECTION.

       FILE-Control.

      *--------------
       DATA DIVISION.
      *--------------

       FILE SECTION.

       WORKING-STORAGE SECTION.

      *-------------------------
      * WORKAREAS AND VARIABLES
      *-------------------------
       01 INIT-MSG.
          10 FILLER           PIC X(13) VALUE 'UNLOAD INFO: '.
          10 FILLER           PIC X(03) VALUE 'TB='.
          10 IM-CREATOR       PIC X(08).
          10 FILLER           PIC X(01) VALUE '.'.
          10 IM-NAME          PIC X(18).
          10 FILLER           PIC X(06) VALUE ',SSID='.
          10 IM-SSID          PIC X(04).
          10 FILLER           PIC X(08) VALUE ',USERID='.
          10 IM-USERID        PIC X(08).
          10 FILLER           PIC X(08) VALUE ',UTILID='.
          10 IM-UTID          PIC X(16).

       01 TERM-MSG.
          10 FILLER           PIC X(16) VALUE 'CLEANUP DONE.   '.
          10 FILLER           PIC X(21) VALUE 'PROCESSED ROW COUNT: '.
          10 TERM-ROW-COUNT   PIC ZZ,ZZZ,ZZ9.

      *01 WORK-STUFF.
      *   10 ROW-COUNT        PIC S9(9) VALUE 0.

       LINKAGE SECTION.

       01  EXITPARMS.
            02  EXIT-FUNCTION-CODE   PIC S9(9) BINARY.
                88 PROCESS-CALL      VALUE 0.
                88 INITIALIZE-CALL   VALUE 1.
                88 CLEANUP-CALL      VALUE 2.
            02  EXIT-SQLDA-POINTER   POINTER.
            02  EXIT-TB-NAME-POINTER POINTER.
            02  FILLER               PIC XX.
            02  EXIT-REFERENCE-NUM   PIC S9(4) BINARY.
            02  EXIT-SSID-POINTER    POINTER.
            02  EXIT-USERID-POINTER  POINTER.
            02  EXIT-UTILID-POINTER  POINTER.
            02  FILLER               PIC X(24).
            02  EXIT-USER-POINTER    POINTER.
            02  EXIT-USERF1          PIC S9(9) BINARY.
            02  EXIT-USERF2          PIC S9(9) BINARY.
            02  EXIT-USERF3          PIC S9(9) BINARY.
            02  EXIT-USERF4          PIC S9(9) BINARY.
            02  EXIT-USERMSG-POINTER POINTER.
            02  EXIT-USERMSG-SIZE    PIC S9(9) BINARY.
            02  EXIT-USER-MESSAGE    PIC X(100).
            02  EXIT-FLAGS           PIC X.
            02  FILLER               PIC X.
            02  FILLER               PIC X(214).
            02  FILLER               PIC X(100).
          02 ROW-COUNT        PIC S9(9) VALUE 0.

       01 TABLE-INFO.
          13 TABLE-CREATOR  PIC X(128).
          13 TABLE-NAME     PIC X(128).
       01 SSID              PIC X(04).
       01 USERID            PIC X(08).
       01 UTILITY-ID        PIC X(16).

       01   SQLDA.
            02  SQLDAX   PIC X(8).
            02  SQLDABC  PIC S9(8) COMPUTATIONAL.
            02  SQLN     PIC S9(4) COMPUTATIONAL.
            02  SQLD     PIC S9(4) COMPUTATIONAL.
            02  SQLVAR   OCCURS 1 TO 300 TIMES DEPENDING ON SQLN.
                03  SQLTYPE      PIC S9(4) COMP.
                03  SQLLEN       PIC S9(4) COMP.
                03  SQLDATA      POINTER.
                03  SQLIND       POINTER.
                03  SQLNAME.
                    04  SQLNAMEL     PIC S9(4) COMP.
                    04  SQLNAMEC     PIC X(30).

       01   RECORD-DATA-WORK.
            10 DATA-FIELD       PIC X(20).

      /-------------------
       PROCEDURE DIVISION USING EXITPARMS.

           EVALUATE TRUE

             WHEN PROCESS-CALL PERFORM PROCESS-RECORD
                               THRU PROCESS-RECORD-EXIT

             WHEN INITIALIZE-CALL PERFORM INITIALIZE-THE-EXIT
                                  THRU INITIALIZE-THE-EXIT-EXIT

             WHEN CLEANUP-CALL PERFORM CLEANUP-THE-EXIT
                               THRU CLEANUP-THE-EXIT-EXIT
           END-EVALUATE.

           GOBACK.

      *---------------------
       PROCESS-RECORD.
      *---------------------

           MOVE ZERO TO RETURN-CODE.

           SET ADDRESS OF SQLDA TO EXIT-SQLDA-POINTER.

           MOVE 'PROCESS' TO EXIT-USER-MESSAGE.
           ADD 1 TO ROW-COUNT.

       PROCESS-RECORD-EXIT.
           EXIT.


      *---------------------
       INITIALIZE-THE-EXIT.
      *---------------------

           MOVE ZERO TO RETURN-CODE.

           SET ADDRESS OF TABLE-INFO TO EXIT-TB-NAME-POINTER.
           SET ADDRESS OF SSID       TO EXIT-SSID-POINTER.
           SET ADDRESS OF USERID     TO EXIT-USERID-POINTER.
           SET ADDRESS OF UTILITY-ID TO EXIT-UTILID-POINTER.

           MOVE TABLE-CREATOR TO IM-CREATOR.
           MOVE TABLE-NAME    TO IM-NAME.
           MOVE SSID          TO IM-SSID.
           MOVE USERID        TO IM-USERID.
           MOVE UTILITY-ID    TO IM-UTID.
           MOVE INIT-MSG      TO EXIT-USER-MESSAGE.

           MOVE ZERO TO ROW-COUNT.

      * TO NOT USE THIS PROGRAM, MOVE 4 TO RETURN-CODE.

       INITIALIZE-THE-EXIT-EXIT.
           EXIT.


      *---------------------
       CLEANUP-THE-EXIT.
      *---------------------

           MOVE ZERO TO RETURN-CODE.

           MOVE ROW-COUNT TO TERM-ROW-COUNT.
           MOVE TERM-MSG TO EXIT-USER-MESSAGE.

       CLEANUP-THE-EXIT-EXIT.
           EXIT.


 

Tip: For faster searching, add an asterisk to the end of your partial query. Example: cert*