COBOL II and LE COBOL user exits: sample 2

      *------------------------
       IDENTIFICATION DIVISION.
      *------------------------
      *
      * THIS IS A SAMPLE OF A COBOL EXIT FOR UNLOAD+ FOR DB2.
      *
      * THIS IS A SIMPLE COMPARASION OF ROWS PASSED FROM UNLOAD+
      * AND RECORDS READ FROM A SEQUENTIAL DATA SET TO WRITE AN
      * OUTPUT RECORD.  AS EACH ROW IS RECEIVED FROM THE TABLE
      * A SEQUENTIAL FILE IS READ IN PARALLEL.
      * IF THE SEQUENTIAL RECORD INDICATOR
      * 'COMES FROM INPUT TABLE' IS FOUND THE OUTPUT
      * RECORD IS WRITTEN FROM THE SEQUENTIAL DATA SET,
      * OTHERWISE THE OUTPUT RECORD WRITTEN FROM THE TABLE.
      *
       PROGRAM-ID.    ADUEXTC2.
       DATE-COMPILED.

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

       CONFIGURATION SECTION.

       INPUT-OUTPUT SECTION.

       FILE-Control.

           SELECT COBOLOUT ASSIGN TO UT-S-COBOLOUT.
           SELECT COBOLIN ASSIGN TO UT-S-COBOLIN.

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

       FILE SECTION.

       FD  COBOLOUT
           RECORD CONTAINS 80 CHARACTERS
           RECORDING MODE IS F
           LABEL RECORDS ARE OMITTED
           DATA RECORD IS OUTREC.

       01  OUTREC                 PIC X(80).

       FD  COBOLIN
           RECORD CONTAINS 80 CHARACTERS
           RECORDING MODE IS F
           LABEL RECORDS ARE OMITTED
           DATA RECORD IS INREC.

       01  INREC                  PIC X(80).

       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 OUTDATA.
          10 P-ID                 PIC 9(4).
          10 P-NAME.
             49 P-NAME-LEN        PIC 9(4).
             49 P-NAME-TEXT       PIC X(9).
          10 P-DEPT               PIC 9(4).
          10 P-JOB                PIC X(5).
          10 P-YEARS              PIC 9(4).
          10 P-SALARY             PIC 9(5)V9(2).
          10 P-COMM               PIC 9(5)V9(2).
          10 P-FILLER             PIC X(21) VALUE 'DB2 TABLE'.

       01 INDATA.
          10 I-ID                 PIC 9(4).
          10 I-NAME.
             49 I-NAME-LEN        PIC 9(2).
             49 I-NAME-TEXT       PIC X(11).
          10 I-DEPT               PIC 9(4).
          10 I-JOB                PIC X(5).
          10 I-YEARS              PIC 9(4).
          10 I-SALARY             PIC 9(5)V9(2).
          10 I-COMM               PIC 9(5)V9(2).
          10 I-COMES-FROM         PIC X(21).
          10 I-FILLER             PIC X(15).

       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).

       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
                INDEXED BY I.
                03  SQLTYPE      PIC S9(4) COMP.
                03  SQLLEN       PIC S9(4) COMP.
                03  SQLDATA      POINTER.
                03  SQLIND       POINTER.
                03  SQLINDN REDEFINES SQLIND PIC S9(9) COMP.
                03  SQLNAME.
                    04  SQLNAMEL     PIC S9(4) COMP.
                    04  SQLNAMEC     PIC X(30).

       01   NUMID          PIC S9(4) USAGE COMP.
       01   NAME.
            49 NAME-LEN    PIC S9(4) USAGE COMP.
            49 NAME-TEXT   PIC X(9).
       01   DEPT           PIC S9(4) USAGE COMP.
       01   JOB            PIC X(5).
       01   YEARS          PIC S9(4) USAGE COMP.
       01   SALARY         PIC S9(5)V9(2) USAGE COMP-3.
       01   COMM           PIC S9(5)V9(2) USAGE COMP-3.

       01   NULLBYTE       PIC X.

       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.
      *---------------------

           SET ADDRESS OF SQLDA TO EXIT-SQLDA-POINTER.
           PERFORM BUILD-PRINT-LINE THRU BUILD-PRINT-LINE-EXIT
                   VARYING I FROM 1 BY 1
                           UNTIL I GREATER THAN SQLN.

           READ COBOLIN INTO INDATA.
           IF I-COMES-FROM = 'COMES FROM INPUT FILE'
            THEN MOVE INDATA TO OUTDATA.
           WRITE OUTREC FROM OUTDATA.
           MOVE ' ' TO I-COMES-FROM.
           MOVE 'DB2 TABLE' TO P-FILLER.
           MOVE NAME-TEXT TO EXIT-USER-MESSAGE.
           ADD 1 TO ROW-COUNT.

       PROCESS-RECORD-EXIT.
           EXIT.


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

           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.

           OPEN OUTPUT COBOLOUT.
           OPEN INPUT COBOLIN.

       INITIALIZE-THE-EXIT-EXIT.
           EXIT.

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

           MOVE ROW-COUNT TO TERM-ROW-COUNT.

           CLOSE COBOLOUT.
           CLOSE COBOLIN.
           MOVE TERM-MSG TO EXIT-USER-MESSAGE.

       CLEANUP-THE-EXIT-EXIT.
           EXIT.

      *---------------------
       BUILD-PRINT-LINE.
      *---------------------

      * PREPARE TEST FOR THE NULL INDICATOR

           IF SQLINDN(I) EQUAL 0
              THEN
                   SET ADDRESS OF NULLBYTE TO NULL
              ELSE
                   SET ADDRESS OF NULLBYTE TO SQLIND(I).

      * PROCESS EACH COLUMN BY NUMBER AS CALLED BY THE PERFORM/VARYING

           IF I = 1
              THEN
               SET ADDRESS OF NUMID TO SQLDATA(I)
               MOVE NUMID TO P-ID.
           IF I = 2
              THEN
               SET ADDRESS OF NAME TO SQLDATA(I)
               MOVE NAME TO P-NAME.
           IF I = 3
              THEN
               SET ADDRESS OF DEPT TO SQLDATA(I)
               MOVE DEPT TO P-DEPT.
           IF I = 4
              THEN
               SET ADDRESS OF JOB TO SQLDATA(I)
               MOVE JOB TO P-JOB.
           IF I = 5
              THEN
               SET ADDRESS OF YEARS TO SQLDATA(I)
               MOVE YEARS TO P-YEARS.
           IF I = 6
              THEN
               SET ADDRESS OF SALARY TO SQLDATA(I)
               MOVE SALARY TO P-SALARY.
           IF I = 7
              THEN
               SET ADDRESS OF COMM TO SQLDATA(I).

       BUILD-PRINT-LINE-EXIT.
           EXIT.