      $SET db2(db=sample)
      ************************************************************************
      * Copyright (C) 1998-1999 Micro Focus International Ltd.
      * All rights reserved.
      *  
      * This demonstration program is provided for use by users of 
      * Micro Focus products (the "Software") and may be used, 
      * modified and distributed as part of your application provided 
      * that you properly acknowledge the copyright of Micro Focus in this
      * material.
      *     
      * All conditions, warranties and undertakings, express or implied, 
      * statutory or otherwise, on the part of Micro Focus are excluded, 
      * including without limitation those of merchantability or fitness  
      * for purpose. This shall not, however, purport to exclude or 
      * restrict the liability of Micro Focus to any extent not 
      * permitted by law.
      *
      * IN NO EVENT WILL MICRO FOCUS BE LIABLE FOR ANY INDIRECT, 
      * INCIDENTAL, SPECIAL, CONSEQUENTIAL OR OTHER DAMAGES ARISING OUT 
      * OF THE USE OF THE DEMONSTRATION PROGRAM DISTRIBUTED WITH THE 
      * SOFTWARE, WHETHER OR NOT INFORMED OF THE POSSIBILITIES OF 
      * DAMAGES IN ADVANCE.  THESE LIMITATIONS APPLY TO ALL CAUSES OF 
      * ACTION, INCLUDING BREACH OF CONTRACT, BREACH OF WARRANTY, STRICT
      * LIABILITY, AND ANY ACTIONS IN TORTS.
      ************************************************************************
       working-storage section.

      *  Include the SQL Communications Area. This includes the
      *  definitions of SQLCODE, etc
       exec sql include sqlca end-exec

       01  in-id                   pic 999.
       01  in-dept                 pic 999.

       01 ws-db                    pic x(08).
       01 ws-usr                   pic x(08).
       01 ws-pass                  pic x(18).

       *>
       *> In this example, the SMALLINT host variables use COMP
       *> variables which is mainframe compatible
       *>
       01  dclstaff.
           10 staff-id                         pic s9(04)  comp.
           10 staff-name.
              49 staff-name-len                pic s9(04)  comp.
              49 staff-name-dat                pic x(9).
           10 staff-dept                       pic s9(04)  comp.
           10 staff-job                        pic x(5).
           10 staff-years                      pic s9(04)  comp.
           10 staff-salary                     pic s9(05)v9(02) comp-3.
           10 staff-comm                       pic s9(05)v9(02) comp-3.
      ******************************************************************
      * COBOL INDICATOR VARIABLES FOR TABLE                            *
      ******************************************************************
       01  dclstaff-null.
           10 staff-name-null                  pic s9(04)  comp.
           10 staff-dept-null                  pic s9(04)  comp.
           10 staff-job-null                   pic s9(04)  comp.
           10 staff-years-null                 pic s9(04)  comp.
           10 staff-salary-null                pic s9(04)  comp.
           10 staff-comm-null                  pic s9(04)  comp.
      *
       procedure division.
       main-para.

           display "Start of static SELECT example "
      *    Connect to an DB2 Sample database
           display "Enter database alias (Eg Sample) "
                   with no advancing
           accept ws-db
           display "Enter username  "
                    with no advancing

           accept ws-usr
           display "Enter password  "
                   with no advancing
           accept ws-pass

      *    Connect to the specified database
           if ws-usr not = spaces
              EXEC SQL
                   CONNECT TO :ws-db USER :ws-usr USING :ws-pass
              END-EXEC
           else
              EXEC SQL
                   CONNECT TO :ws-db
              END-EXEC
           end-if

           if sqlcode not = 0
                display "Error: cannot connect "
                display sqlcode
                display sqlerrmc
                stop run
           end-if.


       loop-point.
	   if sqlcode not = 0
                display "Error: not connected"
		display sqlcode
		display sqlerrmc
		stop run
	   end-if

	   display 'Select ... into test'

	   perform until exit
	       display " "
               display "Enter id (Eg 10, 999 to end): "
		       with no advancing
               accept in-id
               if in-id = 999
                  exit perform
	       end-if
               move in-id          to    staff-id
               move spaces         to    staff-name
               exec sql
                 select
                      a.name
                     ,a.salary
                  into
                     :staff-name:staff-name-null
                 ,   :staff-salary:staff-salary-null
                 from staff a
                 where ( a.id = :staff-id )
               end-exec

	       if sqlcode not = 0
                  if sqlcode = 100
                     display "No employee found"
                  else
                     display sqlcode
                     display sqlerrmc
                  end-if
	       else
                  display "ID for " staff-id " is " staff-name-dat
	       end-if

	   end-perform

	   display 'Cursor fetch test'

	   perform until exit
              display " "
              display "Enter Dept (Eg 84 or 10, 999 to end): "
                  with no advancing
              accept in-dept
              if in-dept = 999
                 exit perform
              end-if
              exec sql
                 declare csr1 cursor for select
                    a.id
                   ,a.name
                 from staff a
                 where ( a.dept = :staff-dept )
                 order by a.name
              end-exec
              move in-dept        to  staff-dept
              exec sql open csr1 end-exec
              if sqlcode not = 0
                 display sqlcode
                 display sqlerrmc
              else
                 display "Employees in Department " in-dept
                 perform until sqlcode < 0 or sqlcode = +100
                    move spaces            to staff-name-dat
                    exec sql
                      fetch csr1 into
                            :staff-id
                           ,:staff-name:staff-name-null
                    end-exec
                    display  " "
                    evaluate sqlcode
                     when +100
                       display "End of results"
                     when < 0
                       display sqlcode
                       display sqlerrmc
                     when other
                       display "ID    " staff-id       with no advancing
                       display " NAME " staff-name-dat
                    end-evaluate
                 end-perform
                 exec sql close csr1 end-exec
              end-if
           end-perform

           exec sql
               connect reset
           end-exec
	   if sqlcode not = 0
              display sqlcode
              display sqlerrmc
	   end-if
           display "static SELECT sample completed"
	   stop run.
