************************************************************************* 
      ** 
      ** Source File Name = dbstat.sqb  1.5 
      ** 
      ** Licensed Materials - Property of IBM 
      ** 
      ** (C) COPYRIGHT International Business Machines Corp. 1995, 1999 
      ** All Rights Reserved. 
      ** 
      ** US Government Users Restricted Rights - Use, duplication or 
      ** disclosure restricted by GSA ADP Schedule Contract with IBM Corp. 
      ** 
      **    APIs USED : 
      **       REORGANIZE TABLE           sqlgreot() 
      **       RUN STATISTICS             sqlgstat() 
      ** 
      ** For more information about these samples see the README file. 
      ** 
      ** For more information on programming in COBOL, see the: 
      **    -  "Programming in COBOL" section of the Application Development Guide. 
      ** 
      ** For more information on Building COBOL Applications, see the: 
      **    - "Building COBOL Applications" section of the Application Building Guide. 
      ** 
      ** For more information on the SQL language see the SQL Reference. 
      ** 
      ************************************************************************* 

       Identification Division.
       Program-ID. "dbstat".

       Data Division.
       Working-Storage Section.

           copy "sqlenv.cbl".
           copy "sqlca.cbl".
           copy "sqlutil.cbl".
      * host variables for REORGANIZE TABLE and RUN STATISTICS 
           EXEC SQL BEGIN DECLARE SECTION END-EXEC.
       01 qualifier-table pic x(27).

       77 statement         pic x(254).
       01 instance          pic x(9).

           EXEC SQL END DECLARE SECTION END-EXEC.

       77 errloc              pic x(80).
       77 rc                  pic s9(9) comp-5.

      * variables for REORGANIZE TABLE and RUN STATISTICS 
       77 tablespace-len      pic 9(4) comp-5 value 0.
       77 tablespace          pic x(254).
       77 indexname-len       pic 9(4) comp-5 value 14.
       77 indexname           pic x(14) value "sample.testind".
       77 qualifier-table-len pic 9(4) comp-5 value 0.
       77 num-indexes         pic 9(4) comp-5 value 1.

       01 list-of-lengths.
         05 i-length occurs 1 times pic 9(4) comp-5.
       01 list-of-indexes.
         05 l-index occurs 1 times pointer.

       Procedure Division.
       dbstat Section.
           display "Sample COBOL program: DBSTAT".

           display "Enter your userid: " with no advancing. 
           accept instance.

	   EXEC SQL CONNECT TO sample END-EXEC.

           move "CONNECT TO SAMPLE" to errloc.
           call "checkerr" using SQLCA errloc.

           EXEC SQL DROP INDEX sample.testind END-EXEC.

           display "CREATE INDEX".
           EXEC SQL CREATE INDEX sample.testind ON staff (salary)
                END-EXEC.
           move "CONNECT TO SAMPLE" to errloc.
           call "checkerr" using SQLCA errloc.

      * concatenate 'instance' with ".staff" into 'qualifier-table'. 
           move spaces to qualifier-table.
           string instance delimited by " ", ".staff" delimited by
               size into qualifier-table.

           inspect qualifier-table tallying qualifier-table-len for
               characters before initial " ".

           display "REORGanizing TABLE " qualifier-table.
      ******************************************** 
      * REORGANIZING TABLE STATISTICS API called * 
      ******************************************** 
           call "sqlgreot" using
                                 by value     tablespace-len
                                 by value     indexname-len
                                 by value     qualifier-table-len
                                 by reference sqlca
                                 by reference tablespace
                                 by reference indexname
                                 by reference qualifier-table
                           returning rc.
           move "reorganizing the STAFF table" to errloc.
           call "checkerr" using SQLCA errloc.

           display "RUNning STATISTICS".
      ***************************** 
      * RUN STATISTICS API called * 
      ***************************** 

           set l-index(1) to nulls.

           call "sqlgstat" using
                                 by value qualifier-table-len
                                 by value     num-indexes
                                 by value     SQL-STATS-TABLE
                                 by value     SQL-STATS-CHG
                                 by reference list-of-lengths
                                 by reference sqlca
                                 by reference list-of-indexes
                                 by reference qualifier-table
                             returning rc.
           move "stats" to errloc.
           call "checkerr" using SQLCA errloc.

           EXEC SQL CONNECT RESET END-EXEC.
           move "CONNECT RESET" to errloc.
           call "checkerr" using SQLCA errloc.

       End-dbstat. stop run.