IDENTIFICATION DIVISION.
PROGRAM-ID. CSAINDX.
***************************************************************** * SAMPLE CSA PROGRAM TO ILLUSTRATE: * 1) Connect TO THE DIRECTConnect, 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 DIRECTConnect, DO A TRANSFER TO THAT TABLE * 4) Connect TO SQL SERVER, EXECUTING A STORED PROCEDURE * THAT RE-CREATES AN INDEX ON THAT SQL SERVER TABLE * * TRANSID IN PCT: PIDX PROGRAM NAME IN PPT: CSAINDX *****************************************************************
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 DIRECTConnect 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 SQL SERVER 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 CSA 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 CSA 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 DIRECTConnect CHECKS IF IT'S ALIVE AND WELL. * 2) 2ND ATTACH TO SQL SERVER - RUNS S.P. TO DELETE INDEXES. * 3) 3RD ATTACH TO DIRECTConnect RUNS TRANSFER FROM RSP TO SYBASE SQL SERVER. * 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-DIRECTConnect THRU 5600-EXIT.
PERFORM 5800-CALL-DETACH THRU 5800-EXIT.
PERFORM 5700-ATTACH-TO-SYBASE SQL SERVER 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-DIRECTConnect 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 DIRECTConnect *****************************************************************
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 = '000'
PERFORM 5900-RESCHECK-SEARCH THRU 5900-EXIT
UNTIL RESCHECK-DONE.
5500-EXIT.
EXIT.
***************************************************************** * CALL CSA TO ATTACH TO DIRECTConnect. *****************************************************************
5600-ATTACH-TO-DIRECTConnect.
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 CSA TO ATTACH TO SYBASE SQL SERVER. *****************************************************************
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 SYBASE ICD 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 QUEUE 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 QUEUE *****************************************************************
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. *===============================================================*
