IWAYEVT0 Sample Program

Topics:

The IWAYEVT0 sample program (iwayevt0.cobol) is a sample program that tests event handling in the iWay Transaction Adapter for IMS. It is identical to the version that is packaged with the iWay Transaction Adapter for CICS, only modified to run on IMS.

Sample Program Location and Directory Structure

Topics:

The IWAYEVT0 sample program and related program files are located in the following directory:

<iway_home>\etc\samples\ims\iwayevt0

where:

<iway_home>

Is the location on your system where iWay Service Manager is installed.

The following subdirectories are included for the IWAYEVT0 sample program:

  • cobolfd
  • src

Cobolfd Subdirectory

Reference:

The cobolfd subdirectory contains the COBOL copybook (IWAYEVT0_IN.CBL) to map the data that is sent from IMS.

Reference: IWAYEVT0_IN.CBL COBOL Copybook

The following is the structure of the IWAYEVT0_IN.CBL COBOL copybook:

05 ALPHA01               PIC X(8).                            
05 INT01                 PIC S9(4) BINARY.
05 PACK01                PIC S9(15) PACKED-DECIMAL.  
05 ZONE01                PIC  9(4).

SRC Subdirectory

Reference:

The src subdirectory contains the COBOL program (IWAYEVT0.COBOL).

Reference: IWAYEVT0.COBOL Program

The following is the structure of the COBOL program (IWAYEVT0.COBOL):

CBL TRUNC(BIN)
       ID DIVISION.
       PROGRAM-ID. IWAYEVT0.
      ***************************************************************
      * IWAYEVT0 - THIS SAMPLE PROGRAM DEMONSTRATES SENDING A       *
      * RECORD TO THE IWAY IMS ADAPTER USING CICS SOCKETS.  NO      *
      * RESPONSE IS RETURNED.  DATA RECORDS MAPPED BY COPYBOOKS     *
      * MUST EACH BE PRECEDED BY A 4 BYTE BINARY LENGTH.            *
      *                                                             *
      * THE IMS ADAPTER MUST BE CONFIGURED WITH AN EVENT TO         *
      * RECEIVE THIS DATA.  SELECT "IS LENGTH PREFIX", SYNCHRON-    *
      * IZATION TYPE "REQUEST", AND USE IWAYEVT0.CBL AS THE         *
      * PREPARSER FD.  HOST AND PORT MUST MATCH THE VALUES SET      *
      * BELOW.                                                      *
      *                                                             *
      * THE EZASOKET INTERFACE IS DOCUMENTED IN THE Z/OS            *
      * COMMUNICATIONS SERVER IP CICS SOCKETS GUIDE.                *
      *                                                             *
      * USES: IWAYEVT0_IN.CBL     (INPUT RECORD)                    *
      *                                                             *
      ***************************************************************
       ENVIRONMENT DIVISION.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       77  GU                         PIC   X(04) VALUE 'GU  '.
       77  CHNG                       PIC   X(04) VALUE 'CHNG'.
       77  ISRT                       PIC   X(04) VALUE 'ISRT'.
       01 SOCKET-GROUP.
          05 SOC-FUNCTION              PIC X(16) VALUE SPACES.
          05 ERRNO                     PIC 9(8) BINARY VALUE ZEROES.
          05 RETCODE                   PIC S9(8) BINARY VALUE ZEROES.
          05 AF                        PIC 9(8) BINARY VALUE 2.
          05 SOCTYPE                   PIC 9(8) BINARY VALUE 1.
          05 PROTO                     PIC 9(8) BINARY VALUE 0.
          05 NAMELEN                   PIC 9(8) BINARY.
          05 HOSTNAME                  PIC X(255).
          05 HOSTENT                   POINTER.
          05 NAME.
             10 FAMILY                 PIC 9(4) BINARY VALUE 2.
             10 PORT                   PIC 9(4) BINARY.
             10 IP-ADDRESS             PIC 9(8) BINARY.
             10 IP-ADDRESS-ALPHA REDEFINES IP-ADDRESS PIC X(4).
             10 RESERVED               PIC X(8) VALUE LOW-VALUES.
          05 FLAGS                     PIC 9(8) BINARY VALUE 0.
          05 SOCKET                    PIC 9(4) BINARY.
          05 NBYTE                     PIC 9(8) BINARY.
          05 CMD                       PIC 9(8) BINARY.
          05 REQARG                    PIC 9(8) BINARY.
       01 WORKAREA.
          05 LLEN                         PIC 9(8) BINARY VALUE 4.
          05 ERRMSG                       PIC X(41)
             VALUE 'ERROR ENCOUNTERED DURING '.
          05 TMSG                         PIC X(44)
             VALUE 'EVENTCBL: RECORD TRANSMISSION WAS SUCCESSFUL'.
      ***************************************************************
      * SAMPLE INBOUND DATA RECORD WITH VARIOUS COBOL TYPES.        *
      ***************************************************************
       01 INBOUND-RECORD.
          05 ALPHA01               PIC X(8)
             VALUE 'ABCDEFGH'.
          05 INT01                 PIC S9(4) BINARY VALUE 25.
          05 PACK01                PIC S9(15) PACKED-DECIMAL VALUE 50.
          05 ZONE01                PIC 9(4) VALUE 75.
       01 MSG-OUT.
          05  IMS-LL               PIC 9(4) BINARY VALUE 70.
          05  IMS-ZZ               PIC 9(4) BINARY.
          05  MSG                  PIC X(70).
       01  PARM-IN.
          05  SLEN                 PIC S9(4) BINARY.
          05  SCRN-IOA             PIC X(255).
          LINKAGE SECTION.
          01  HOSTENT-STRUCT.
              05  HOSTNAME-PTR   POINTER.
              05  HOSTALIASL-PTR POINTER.
              05  HOSTFAMILY     PIC S9(8) BINARY.
              05  HOSTADR-LEN    PIC S9(8) BINARY.
              05  HOSTADRL-PTR   POINTER.
          01  HOST-ENTRY-PTR     POINTER.
          01  HOST-ENTRY         PIC 9(8) BINARY.
      *********************************************************
      *    I/O PCB                                            *
      *********************************************************
          01  IOPCB.
              05  LTERM                  PIC   X(08).
              05  FILLER                 PIC   X(02).
              05  IOPCB-STATUS           PIC   X(02).
              05  FILLER                 PIC   X(28).
       PROCEDURE DIVISION.
       MAINLINE.
           ENTRY 'DLITCBL' USING IOPCB
           PERFORM GETPARM
      ***************************************************************
      * CHANGE HOSTNAME AND PORT TO SITE SPECIFIC LOCATION OF THE   *
      * CICS ADAPTER.                                               *
      ***************************************************************
           MOVE 'YOUR.DNS.NAME' TO HOSTNAME
           MOVE 4772 TO PORT
           PERFORM GETSOCK
           PERFORM GETHOSTBYNAME
           PERFORM SETBLOCK
           PERFORM CONNECTTOHOST
           PERFORM SENDDATA
           PERFORM CLOSESOCK
           MOVE SPACE TO MSG
           MOVE TMSG TO MSG
           CALL 'CBLTDLI' USING ISRT, IOPCB, MSG-OUT
           GOBACK.
       GETPARM.
           CALL 'CBLTDLI' USING GU, IOPCB, SCRN-IOA
           IF IOPCB-STATUS NOT = SPACES
              PERFORM WRITERR-EXIT
           END-IF
      *    DISPLAY 'INPUT PARM: ' SCRN-IOA
           .
       GETSOCK.
           MOVE 'SOCKET          ' TO SOC-FUNCTION
           CALL 'EZASOKET' USING SOC-FUNCTION,
                AF,
                SOCTYPE,
                PROTO,
                ERRNO,
                RETCODE
           MOVE RETCODE TO SOCKET
           IF RETCODE < 0
              PERFORM WRITERR-EXIT
           END-IF.
       GETHOSTBYNAME.
           MOVE 'GETHOSTBYNAME   ' TO SOC-FUNCTION
           MOVE LENGTH OF HOSTNAME TO NAMELEN
           CALL 'EZASOKET' USING SOC-FUNCTION NAMELEN HOSTNAME
                HOSTENT RETCODE
                IF RETCODE EQUAL ZERO
                   SET ADDRESS OF HOSTENT-STRUCT TO HOSTENT
                   SET ADDRESS OF HOST-ENTRY-PTR TO HOSTADRL-PTR
                   SET ADDRESS OF HOST-ENTRY TO HOST-ENTRY-PTR
                ELSE
                   PERFORM WRITERR-EXIT
                END-IF.
       SETBLOCK.
           MOVE 'FCNTL           ' TO SOC-FUNCTION
           MOVE 4 TO CMD
           MOVE 0 TO REQARG
           CALL 'EZASOKET' USING SOC-FUNCTION, SOCKET, CMD, REQARG,
                           ERRNO, RETCODE.
       CONNECTTOHOST.
           MOVE HOST-ENTRY TO IP-ADDRESS
           MOVE 'CONNECT         ' TO SOC-FUNCTION
           CALL 'EZASOKET' USING SOC-FUNCTION,
                SOCKET,
                NAME,
                ERRNO,
                RETCODE
           IF RETCODE = 0
                CONTINUE
           ELSE
              PERFORM WRITERR-EXIT
           END-IF.
       SENDDATA.
      ***************************************************************
      * PRECEDE THE RECORD WITH 4 BYTE BINARY RECORD LENGTH         *
      ***************************************************************
           MOVE 'SEND            ' TO SOC-FUNCTION
           MOVE LENGTH OF INBOUND-RECORD TO NBYTE
           MOVE 4 TO LLEN
           MOVE 0 TO RETCODE
           CALL 'EZASOKET' USING SOC-FUNCTION,
                 SOCKET,
                 FLAGS,
                 LLEN,
                 NBYTE,
                 ERRNO,
                 RETCODE
           IF RETCODE = -1
              PERFORM WRITERR-EXIT
           END-IF
      ***************************************************************
      * SEND THE ACTUAL RECORD                                      *
      ***************************************************************
           CALL 'EZASOKET' USING SOC-FUNCTION,
                SOCKET,
                FLAGS,
                NBYTE,
                INBOUND-RECORD,
                BY REFERENCE ERRNO,
                RETCODE
           IF RETCODE = -1
              PERFORM WRITERR-EXIT
           END-IF
           .
       CLOSESOCK.
           MOVE ZEROES TO RETCODE ERRNO
           MOVE 'CLOSE           ' TO SOC-FUNCTION
           CALL 'EZASOKET' USING SOC-FUNCTION,
              SOCKET,
              ERRNO,
              RETCODE
           IF RETCODE < 0
              PERFORM WRITERR-EXIT
           END-IF.
       WRITERR-EXIT.
           MOVE SOC-FUNCTION TO ERRMSG(26:15)
           DISPLAY 'ERROR IN PROGRAM FUNCTION: ' ERRMSG.