************************************************************************* 
      ** 
      ** Source File Name = dcscat.cbl 
      ** 
      ** Licensed Materials - Property of IBM 
      ** 
      ** (C) COPYRIGHT International Business Machines Corp. 1995, 2000 
      ** All Rights Reserved. 
      ** 
      ** US Government Users Restricted Rights - Use, duplication or 
      ** disclosure restricted by GSA ADP Schedule Contract with 
      ** 
      **    PURPOSE : 
      **      This program is an example of how APIs are implemented in order to 
      **      access DB/2.  The order of the program is as follows: 
      **         - create/catalog a DCS database 
      **         - list a directory of DCS databases (showing what was created) 
      **         - uncatalog the DCS database 
      ** 
      **    APIs USED : 
      **       GET DCS DIRECTORY ENTRY                sqlggdge() 
      **       CATALOG DCS DIRECTORY ENTRY            sqlggdad() 
      **       OPEN DCS DIRECTORY SCAN                sqlggdsc() 
      **       GET DCS DIRECTORY ENTRIES              sqlggdgt() 
      **       CLOSE DCS DIRECTORY SCAN               sqlggdcl() 
      **       UNCATALOG DCS DIRECTORY ENTRY          sqlggdel() 
      ** 
      ** 
      ** 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. "dcscat".

       Data Division.
       Working-Storage Section.

       copy "sqlenv.cbl".
       copy "sqlca.cbl".

      * Local Variables 
       77 rc                  pic s9(9) comp-5.

       77 errloc              pic x(80).
      * Variables for the DCS DIRECTORY SCAN APIs 
       77 dbcount             pic s9(4) comp-5.
       77 cbl-count           pic s9(4) comp-5 value 1.
       77 idx                 pic s9(4) comp-5.

       Procedure Division.
       dcscat-pgm section.

           display "Sample COBOL Program : dcscat.cbl".

           move "this is a dcs database" to COMMENT of SQL-DIR-ENTRY.
           move "dcsnm"                  to LDB     of SQL-DIR-ENTRY.
           move "targetnm"               to TDB     of SQL-DIR-ENTRY.
           move "arName"                 to AR      of SQL-DIR-ENTRY.
           move SQL-DCS-STR-ID           to
                STRUCT-ID of SQL-DIR-ENTRY.
           move " "                      to PARM    of SQL-DIR-ENTRY.

           display "cataloging the DCS database : ",
                TDB of SQL-DIR-ENTRY.
      *********************************** 
      * CATALOG DCS DATABASE API called * 
      *********************************** 
           call "sqlggdad" using
                                 by reference sqlca
                                 by reference SQL-DIR-ENTRY
                           returning rc.

           move "cataloging the database" to errloc.
           call "checkerr" using SQLCA errloc.

           display "database ", TDB of SQL-DIR-ENTRY,
                " has been catalogued".

           display "now listing all databases".
           perform list-dcs thru end-list-dcs.

           display "now uncataloging the database that was created ",
                    TDB of SQL-DIR-ENTRY.

      ************************************* 
      * UNCATALOG DCS DATABASE API called * 
      ************************************* 
           call "sqlggdel" using
                                 by reference sqlca
                                 by reference SQL-DIR-ENTRY
                           returning rc.

           move "uncataloging the database" to errloc.
           call "checkerr" using SQLCA errloc.

           display "now listing all databases [after uncatalog DCS]".
           perform list-dcs thru end-list-dcs.

       end-dcscat. stop run.

       list-dcs Section.
      ************************************** 
      * OPEN DCS DIRECTORY SCAN API called * 
      ************************************** 
           call "sqlggdsc" using
                                 by reference sqlca
                                 by reference dbcount
                           returning rc.

           if sqlcode equal SQLE-RC-NO-ENTRY
              display "--- DCS directory is empty ---"
              go to close-dcs-scan.
           move "opening the database directory scan" to errloc.
           call "checkerr" using SQLCA errloc.

           if dbcount not equal 0 then
           perform display-dcs-info thru end-display-dcs-info
               varying idx from 1 by 1 until idx equal dbcount.

       display-dcs-info Section.
      ************************************* 
      * GET DCS DIRECTORY SCAN API called * 
      ************************************* 
           call "sqlggdgt" using
                                 by reference sqlca
                                 by reference cbl-count
                                 by reference SQL-DIR-ENTRY
                           returning rc.

           display "number of dcs databases : " , cbl-count.

           display "Local Database Name :" , LDB of SQL-DIR-ENTRY.
           display "Target Database Name:" , TDB of SQL-DIR-ENTRY.
           display "App. Requestor Name :" , AR of SQL-DIR-ENTRY.
           display "DCS parameters      :" , PARM of SQL-DIR-ENTRY.
           display "Comment             :" , COMMENT of SQL-DIR-ENTRY.
           display "DCS Release Level   :" ,
                   RELEASE-LVL of SQL-DIR-ENTRY.
           display " ".
       end-display-dcs-info. exit.

           move "getting dcs database entries" to errloc.
           call "checkerr" using SQLCA errloc.
      ********************************************* 
      * GET DCS DIRECTORY FOR DATABASE API called * 
      ********************************************* 
      * use the SQL-DIR-ENTRY from the previous call 
           call "sqlggdge" using
                                 by reference sqlca
                                 by reference SQL-DIR-ENTRY
                           returning rc.

       close-dcs-scan.

      *************************************** 
      * CLOSE DCS DIRECTORY SCAN API called * 
      *************************************** 
           call "sqlggdcl" using
                                 by reference sqlca
                           returning rc.

           move "closing the database directory scan" to errloc.
           call "checkerr" using SQLCA errloc.
       end-list-dcs. exit.