COBOL Code Sample:

      IDENTIFICATION DIVISION.

      PROGRAM-ID.  CSAINDXT.

     *****************************************************************
     * SAMPLE CLIENT SERVICES PROGRAM TO ILLUSTRATE:
     * 1) CONNECT TO THE GATEWAY, JUST TO VERIFY IT'S UP
     * 2) CONNECT TO SQL SERVER, EXECUTING A STORED PROCEDURE
     *      THAT DELETES AN INDEX ON A SQL SERVER TABLE
     * 3) CONNECT TO THE GATEWAY, DO A TRANSFER TO THAT TABLE
     * 4) CONNECT TO SQL SERVER, EXECUTING A STORED PROCEDURE
     *      THAT RE-CREATES AN INDEX ON A THAT SQL SERVER TABLE
     *
     * TRANSID IN PCT: PIDX         PROGRAM NAME IN PPT: CSAINDXT
     *****************************************************************

      ENVIRONMENT DIVISION.

      DATA DIVISION.

      WORKING-STORAGE SECTION.

     *****************************************************************
     * POINTERS.
     *****************************************************************
      01  WS-POINTERS.
          05  SPAREA-PTR               POINTER.
          05  SQLDA-PTR                POINTER.
          05  SQL-REQ-PTR              POINTER.

     *****************************************************************
     * COUNTERS AND VARIOUS INTEGERS.
     *****************************************************************
      01  WS-VARIABLES.
          05  CICSRC                   PIC S9(8) COMP VALUE +0.
          05  RESCHECK-CNT             PIC 9(3) VALUE ZEROES.
          05  SPSTATUS-CNT             PIC 9(3) VALUE ZEROES.

     *****************************************************************
     * ATTACHMENT DEFINITION NAME.
     *****************************************************************
      01  WS-ATTACH-NAMES.
     * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *
     * ATTNAME-1 - AN ATTACHMENT RECORD WITH THE GATEWAY SERVICENAME *
     * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *
          05  ATTNAME-1               PIC X(08) VALUE 'GWSERVNM'.
     * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *
     * ATTNAME-2 - ATTACHMENT RECORD WITH THE SQL SERVER SERVICENAME *
     * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *
          05  ATTNAME-2               PIC X(08) VALUE 'SQLSERVE'.

     *****************************************************************
     * SWITCH FOR RESCHECK READS -
     *   THE IDEA IS TO KEEP CALLING RESCHECK UNTIL YOU'VE RECEIVED
     *   SPACES IN SPSTATUS TWICE IN A ROW - THEN YOU'RE DONE.
     *
     *   IMPORTANT FOR "BATCH" COMMANDS SENT THRU THE SQL BUFFER.
     *****************************************************************
      01  WS-SWITCHES.
          03  WS-RESCHECK-DONE-SW      PIC X VALUE 'N'.
              88  RESCHECK-DONE              VALUE 'Y'.
              88  RESCHECK-NOT-DONE          VALUE 'N'.
              88  LAST-SPSTATUS-SPACES       VALUE ' '.

          03  WS-INIT-OKAY-SW              PIC X(01) VALUE 'Y'.
              88  SPAREA-INIT-OK           VALUE 'Y'.
              88  SPAREA-INIT-BAD          VALUE 'N'.

          03  WS-ATTACH-OK-SW              PIC X(01) VALUE 'Y'.
              88  ATTACH-OKAY              VALUE 'Y'.
              88  ATTACH-FAILED            VALUE 'N'.

     *****************************************************************
     * SQL STATEMENT TO EXECUTE. - ALL STATEMENTS ARE 90 BYTES.
     * BEAR IN MIND COMMANDS SENT TO SYBASE MAY BE CASE SENSITIVE.
     *****************************************************************
      01  SQL-BUFFER-CMDS.
          03  DELETE-IDX-SP-STMT.
              05  FILLER               PIC X(16) VALUE
              'execute rickdinx'.
              05  FILLER               PIC X(74) VALUE SPACES.
          03  CREATE-IDX-SP-STMT.
              05  FILLER               PIC X(16) VALUE
              'execute rickcinx'.
              05  FILLER               PIC X(74) VALUE SPACES.
          03  TRANSFER-STMT.
              05  FILLER               PIC X(12) VALUE
              'TRANSFER TO '.
              05  FILLER               PIC X(01) VALUE QUOTE.
              05  FILLER               PIC X(15) VALUE
              'trex ssuid sspw'.
              05  FILLER               PIC X(01) VALUE QUOTE.
              05  FILLER               PIC X(02) VALUE '; '.
              05  FILLER               PIC X(26) VALUE
              'WITH REPLACE INTO samp04in'.
              05  FILLER               PIC X(02) VALUE '; '.
              05  FILLER               PIC X(30) VALUE
              'USE PROCEDURE SAMP04C 00200   '.
              05  FILLER               PIC X(01) VALUE SPACES.

     *****************************************************************
     * ERROR MESSAGES.
     *****************************************************************
      01  WS-ATTACH-ERR-MSG.
          03  FILLER                   PIC X(15)
              VALUE 'ATTACHMENT TO: '.
          03  WS-ATTACH-ERR-NAME       PIC X(08) VALUE SPACES.
          03  FILLER                   PIC X(20)
              VALUE ' - WITH ERROR CODE: '.
          03  WS-ATTACH-ERR-MSGCODE    PIC X(03) VALUE '000'.

      01  WS-RUN-COUNT-MSG.
          03  FILLER                   PIC X(30)
              VALUE '* STARTING TRANSFER LOOP NUM: '.
          03  WS-RUN-COUNT             PIC 9(03) VALUE ZEROES.

      01  WS-CSSETUP-ERROR-MSG.
          03  FILLER                   PIC X(30)
              VALUE '! CSSETUP HAD A PROBLEM SPRC: '.
          03  WS-CSSETUP-SPRC          PIC X(03) VALUE SPACES.

      01  WS-RESCHECK-LAST-MSG.
          03  FILLER                   PIC X(30)
              VALUE '- FINAL RESCHECK READ COUNT : '.
          03  WS-RESCHECK-COUNT        PIC 9(03) VALUE ZEROES.

      01  WS-DID-SYBASE-DELETE.
          03  FILLER                   PIC X(30)
              VALUE '> DID SYBASE DELETE INDEXES SP'.

      01  WS-DID-GW-TRANSFER.
          03  FILLER                   PIC X(30)
              VALUE '> DID GW TRANSFER RSP TO SYBAS'.

      01  WS-DID-SYBASE-CREATE.
          03  FILLER                   PIC X(30)
              VALUE '> DID SYBASE CREATE INDEXES SP'.

      01  WS-RESCHECK-MSG.
          03  FILLER                   PIC X(33)
              VALUE 'RESCHECK NON-BLANK STATUS - REC: '.
          03  WS-RESCHECK-NUMBER       PIC 9(03) VALUE ZEROES.
          03  FILLER                   PIC X(16)
              VALUE ' - SPSTATUS IS: '.
          03  WS-SPSTATUS-OUT          PIC X(02) VALUE SPACES.
          03  FILLER                   PIC X(11)
              VALUE ' - SPCODE: '.
          03  WS-SPCODE-OUT            PIC X(03) VALUE SPACES.
          03  FILLER                   PIC X(10)
              VALUE ' - SPIND: '.
          03  WS-SPIND-OUT             PIC X(01) VALUE SPACE.


      LINKAGE SECTION.

      01  STORED-PROC-AREA.
          COPY SPAREAC.

     *****************************************************************
     * SQL REQUEST BUFFER THAT WILL BE PASSED TO THE REMOTE SERVER VIA
     * REQEXEC CALL.  IT CONSISTS OF A HALFWORD LENGTH FIELD, AND THE
     * ACTUAL REQUEST STATEMENT.
     *****************************************************************
      01  SQL-BUFFER.
          03  SQL-LENGTH               PIC S9(4) COMP.
          03  SQL-REQUEST              PIC X(100).

     *==============================================================*
      PROCEDURE DIVISION.
     *==============================================================*
      0000-MAIN-PROCESSING.

          PERFORM 1000-SPAREA-INIT.

          IF ATTACH-OKAY
              PERFORM 5000-TRANSFER-PROCESS THRU 5000-EXIT
              PERFORM 9900-FINALCOUNT       THRU 9900-EXIT
          END-IF.

      0000-GET-OUT-NOW.

          EXEC CICS
              RETURN
          END-EXEC.

      0000-EXIT.
          EXIT.

     *****************************************************************
     * GET AN SPAREA, AND CALL CLIENT SERVICES TO INITIALIZE IT.
     *****************************************************************
      1000-SPAREA-INIT.

          EXEC CICS
               DELETEQ TS QUEUE('CSEXQUE') RESP(CICSRC)
          END-EXEC.

          EXEC CICS
               GETMAIN SET(SPAREA-PTR)
               LENGTH(LENGTH OF SPAREA)
               NOSUSPEND
               RESP(CICSRC)
          END-EXEC.

          IF CICSRC = DFHRESP(NORMAL)
              SET ADDRESS OF STORED-PROC-AREA TO SPAREA-PTR
              PERFORM 1100-CALL-CSSETUP             THRU 1100-EXIT
          END-IF.

          EXEC CICS
              GETMAIN SET(SQL-REQ-PTR)
              LENGTH(LENGTH OF SQL-BUFFER)
              NOSUSPEND RESP(CICSRC)
          END-EXEC.

          IF CICSRC = DFHRESP(NORMAL)
              SET ADDRESS OF SQL-BUFFER TO SQL-REQ-PTR
              SET SPSQL TO SQL-REQ-PTR
          ELSE
              MOVE 'N'           TO WS-INIT-OKAY-SW
          END-IF.

      1000-EXIT.
          EXIT.

     *****************************************************************
     * CALL CLIENT SERVICES TO INITIALIZE SPAREA
     *****************************************************************
      1100-CALL-CSSETUP.

          CALL 'CSSETUP' USING SPAREA.

          IF SPRC = '000'
              MOVE 'Y'           TO WS-INIT-OKAY-SW
          ELSE
              MOVE SPRC          TO WS-CSSETUP-SPRC
              EXEC CICS
                  WRITEQ TS QUEUE('CSEXQUE')
                         FROM(WS-CSSETUP-ERROR-MSG) NOSUSPEND
                         RESP(CICSRC)
              END-EXEC
              GO TO 0000-GET-OUT-NOW
          END-IF.

      1100-EXIT.
          EXIT.


     *****************************************************************
     * CONTROL THE PROCESS OF ATTACH, EXEC, DETATCH FOR TRANSFER.
     * 1) 1ST ATTACH TO GATEWAY CHECKS IF IT'S ALIVE AND WELL.
     * 2) 2ND ATTACH TO SQL SERVER - RUNS S.P. TO DELETE INDEXES.
     * 3) 3RD ATTACH TO GATEWAY RUNS TRANSFER FROM RSP TO SYBASE.
     * 4) 4TH ATTACH TO SQL SERVER - RUNS S.P. TO RE-CREATE INDEXES.
     *****************************************************************
      5000-TRANSFER-PROCESS.

          PERFORM 5100-WRITE-RUN-COUNT           THRU 5100-EXIT.

          PERFORM 5600-ATTACH-TO-GATEWAY         THRU 5600-EXIT.
          PERFORM 5800-CALL-DETACH               THRU 5800-EXIT.

          PERFORM 5700-ATTACH-TO-SYBASE          THRU 5700-EXIT.
          PERFORM 5200-LOAD-DEL-INDEX-STMT       THRU 5200-EXIT.
          PERFORM 5500-CALL-REQEXEC              THRU 5500-EXIT.
          PERFORM 5800-CALL-DETACH               THRU 5800-EXIT.

          PERFORM 5600-ATTACH-TO-GATEWAY         THRU 5600-EXIT.
          PERFORM 5300-LOAD-TRANSFER-STMT        THRU 5300-EXIT.
          PERFORM 5500-CALL-REQEXEC              THRU 5500-EXIT.
          PERFORM 5800-CALL-DETACH               THRU 5800-EXIT.

          PERFORM 5700-ATTACH-TO-SYBASE          THRU 5700-EXIT.
          PERFORM 5400-LOAD-CRE-INDEX-STMT       THRU 5400-EXIT.
          PERFORM 5500-CALL-REQEXEC              THRU 5500-EXIT.
          PERFORM 5800-CALL-DETACH               THRU 5800-EXIT.

      5000-EXIT.
          EXIT.


     *****************************************************************
     * SEND THE TRANSFER LOOP RUN COUNT TO TEMP STORAGE QUE
     *****************************************************************
      5100-WRITE-RUN-COUNT.

          ADD 1                           TO WS-RUN-COUNT.

          EXEC CICS
              WRITEQ TS QUEUE('CSEXQUE')
                     FROM(WS-RUN-COUNT-MSG) NOSUSPEND
                     RESP(CICSRC)
          END-EXEC.

      5100-EXIT.
          EXIT.


     *****************************************************************
     * LOAD THE DELETE INDEX STATEMENT INTO THE SQL BUFFER
     *****************************************************************
      5200-LOAD-DEL-INDEX-STMT.

          MOVE DELETE-IDX-SP-STMT             TO SQL-REQUEST.
          MOVE LENGTH OF DELETE-IDX-SP-STMT   TO SQL-LENGTH.
          PERFORM 5500-CALL-REQEXEC           THRU 5500-EXIT.

      5200-EXIT.
          EXIT.


     *****************************************************************
     * LOAD THE TRANSFER STATEMENT INTO THE SQL BUFFER FOR THE GATEWAY
     *****************************************************************
      5300-LOAD-TRANSFER-STMT.

          MOVE TRANSFER-STMT                  TO SQL-REQUEST.
          MOVE LENGTH OF TRANSFER-STMT        TO SQL-LENGTH.
          PERFORM 5500-CALL-REQEXEC           THRU 5500-EXIT.

      5300-EXIT.
          EXIT.


     *****************************************************************
     * LOAD THE CREATE INDEX STATEMENT INTO THE SQL BUFFER
     *****************************************************************
      5400-LOAD-CRE-INDEX-STMT.

          MOVE CREATE-IDX-SP-STMT             TO SQL-REQUEST.
          MOVE LENGTH OF CREATE-IDX-SP-STMT   TO SQL-LENGTH.
          PERFORM 5500-CALL-REQEXEC           THRU 5500-EXIT.

      5400-EXIT.
          EXIT.


     *****************************************************************
     * EXECUTE THE SQL REQUEST AGAINST THE REMOTE SERVER.
     *****************************************************************
      5500-CALL-REQEXEC.

          CALL 'REQEXEC' USING SPAREA.

          IF SPRC NOT = '000'
              PERFORM 5900-RESCHECK-SEARCH         THRU 5900-EXIT
                      UNTIL RESCHECK-DONE.

      5500-EXIT.
          EXIT.


     *****************************************************************
     * CALL CLIENT SERVICES TO ATTACH TO THE GATEWAY.
     *****************************************************************
      5600-ATTACH-TO-GATEWAY.

          MOVE ATTNAME-1               TO SPATTACH.

          CALL 'ATTACH' USING SPAREA.

          IF SPRC = '000'
              MOVE 'Y'                 TO WS-ATTACH-OK-SW
          ELSE
              MOVE ATTNAME-1           TO WS-ATTACH-ERR-NAME
              MOVE SPRC                TO WS-ATTACH-ERR-MSGCODE
              EXEC CICS
                  SEND FROM(WS-ATTACH-ERR-MSG) ERASE RESP(CICSRC)
              END-EXEC
              IF SPIND = 'M'
                  PERFORM 9700-GET-MESSAGES
                     UNTIL SPIND NOT = 'M'
              END-IF
              GO TO 0000-GET-OUT-NOW
          END-IF.

      5600-EXIT.
          EXIT.


     *****************************************************************
     * CALL CLIENT SERVICES TO ATTACH TO SYBASE.
     *****************************************************************
      5700-ATTACH-TO-SYBASE.

          MOVE ATTNAME-2               TO SPATTACH.

          CALL 'ATTACH' USING SPAREA.

          IF SPRC = '000'
              MOVE 'Y'                 TO WS-ATTACH-OK-SW
          ELSE
              MOVE ATTNAME-2           TO WS-ATTACH-ERR-NAME
              MOVE SPRC                TO WS-ATTACH-ERR-MSGCODE
              EXEC CICS
                  SEND FROM(WS-ATTACH-ERR-MSG) ERASE RESP(CICSRC)
              END-EXEC
              IF SPIND = 'M'
                  PERFORM 9700-GET-MESSAGES
                     UNTIL SPIND NOT = 'M'
              END-IF
              GO TO 0000-GET-OUT-NOW
          END-IF.

      5700-EXIT.
          EXIT.


     *****************************************************************
     * CALL THE DETACH STUB TO DETACH FROM A REMOTE SERVER.
     *****************************************************************
      5800-CALL-DETACH.

          CALL 'DETACH' USING SPAREA.

          IF SPRC NOT = '000'
              PERFORM 5900-RESCHECK-SEARCH         THRU 5900-EXIT
                      UNTIL RESCHECK-DONE.

      5800-EXIT.
          EXIT.


     *****************************************************************
     * CHECK RESCHECK TO LOCATE SQL STATEMENT IN ERROR.
     * ALWAYS LOG ANY NON-ZERO STATUS AFTER ANY CALL TO MDI STUBS.
     *****************************************************************
      5900-RESCHECK-SEARCH.

          ADD 1                          TO RESCHECK-CNT.

          IF SPSTATUS NOT = '  '
              MOVE 'N'                   TO WS-RESCHECK-DONE-SW
              ADD 1                      TO SPSTATUS-CNT
              MOVE SPSTATUS-CNT          TO WS-RESCHECK-NUMBER
              MOVE SPSTATUS              TO WS-SPSTATUS-OUT
              MOVE SPCODE                TO WS-SPCODE-OUT
              MOVE SPIND                 TO WS-SPIND-OUT
              EXEC CICS
                  WRITEQ TS QUEUE('CSEXQUE')
                            FROM(WS-RESCHECK-MSG) NOSUSPEND
                            RESP(CICSRC)
              END-EXEC
              IF SPIND NOT = SPACES
                  PERFORM 9700-GET-MESSAGES UNTIL SPIND NOT = 'M'
              END-IF
          ELSE
              IF LAST-SPSTATUS-SPACES
                  MOVE 'Y'               TO WS-RESCHECK-DONE-SW
              ELSE
                  MOVE ' '               TO WS-RESCHECK-DONE-SW
              END-IF
          END-IF.

          IF NOT RESCHECK-DONE
              CALL 'RESCHECK' USING SPAREA.

      5900-EXIT.
          EXIT.


     *****************************************************************
     * RETRIEVE ANY OUTSTANDING MESSAGES FOR A REQUEST.
     * LOG ALL MESSAGES TO TEMP STORAGE FOR LATER EXAM - ALWAYS!
     *****************************************************************
      9700-GET-MESSAGES.

          CALL 'GETMSG' USING SPAREA
          IF SPMSG NOT = SPACES
              EXEC CICS
                  WRITEQ TS QUEUE('CSEXQUE')
                         FROM(SPMSG) NOSUSPEND
                  RESP(CICSRC)
              END-EXEC
          END-IF.

      9700-EXIT.
          EXIT.


     *****************************************************************
     * SEND THE FINAL RESCHECK READ NUMBER TO TEMP STORAGE QUE
     *****************************************************************
      9900-FINALCOUNT.

          MOVE RESCHECK-CNT               TO WS-RESCHECK-COUNT.

          EXEC CICS
              WRITEQ TS QUEUE('CSEXQUE')
                     FROM(WS-RESCHECK-LAST-MSG) NOSUSPEND
                     RESP(CICSRC)
          END-EXEC.

      9900-EXIT.
          EXIT.


     *===============================================================*
     *    END OF PROGRAM.
     *===============================================================*