C Copyright © Oracle Corporation 1995.  All Rights Reserved.
	SUBROUTINE ddl_stmnt

C------------------------------------------------------------
C This subroutine demonstrates how to perform 
C data definition tasks from an RDBPRE FORTRAN program.  
C You must use the Callable RDO interface, RDB$INTERPRET,
C to perform data definition tasks in preprocessed programs.
C-------------------------------------------------------------

	IMPLICIT NONE
	LOGICAL success
	INTEGER retry_count
	INTEGER*4 STATUS,RDB$INTERPRET,db_handle
	CHARACTER confirm,rdb_invoke*50,rdb_start*50,ddl_statement*132
C 
C--------------------------------------------------------
C Invoke the database to make it known to Callable RDO.
C--------------------------------------------------------

	rdb_invoke = 'DATABASE !VAL = FILENAME MF_PERSONNEL'
	STATUS = RDB$INTERPRET (rdb_invoke, %DESCR(db_handle))
	IF (.NOT. STATUS ) THEN     
		success = .FALSE.
		CALL callable_error_handler(STATUS)
	END IF

	WRITE (6,90)
90	FORMAT ('1',T25,'**** EXECUTE DDL ****'///)

C--------------------------------------------------------------------
C Prompt user for input.  Ordinarily, it would not be likely
C that you would ask a user to define an index for the database.
C This example serves only to show you how this type of task could be
C done within a FORTRAN environment.
C--------------------------------------------------------------------

	PRINT *,' Please enter the data definition statement to define'
	PRINT *,' or delete a temporary index, or type exit: '
	PRINT *,'  '
	PRINT *,' For example, to define an index for EMPLOYEES based'
	PRINT *,' on EMPLOYEE_ID, you might enter: '
	PRINT *,'  '
	PRINT *,'  define index emp_employee_id for employees duplicates
	1 are allowed.'
	PRINT *,'    employee_id.'
	PRINT *,'  end emp_employee_id index.'
	PRINT *,'  '
	PRINT *,' To delete this index, you might enter: '
	PRINT *,'  '
	PRINT *,'  delete index emp_employee_id.'
	PRINT *,'  '
	ACCEPT 130, ddl_statement
130	FORMAT (A132)
	
	DO WHILE ((ddl_statement.NE.'EXIT ').AND.(ddl_statement.NE.'exit '))
	    confirm = 'N'

	    DO WHILE (confirm .EQ. 'N')
		PRINT *, '  '
		TYPE 1000
1000		FORMAT ('$',' Have you entered all data correctly? (Y/N): ')
		ACCEPT 1010, confirm
1010		FORMAT (A)
	    END DO
	
		success = .FALSE.
		retry_count = 0



C-------------------------------------------------------
C Start a READ_WRITE transaction.
C-------------------------------------------------------

	    DO WHILE ((retry_count .LT. 5) .AND. (.NOT. (success)))
		success = .TRUE.
		rdb_start = 'START_TRANSACTION READ_WRITE'
		STATUS = RDB$INTERPRET(%DESCR(RDB_START))
		IF ((STATUS .AND. 1) .NE. 0) THEN     
			success = .FALSE.
			retry_count = retry_count + 1
			CALL callable_error_handler(STATUS)
		END IF
	    END DO

		success = .FALSE.
		retry_count = 0

C---------------------------------------------------
C Pass the data definition statement specified by the
C user to RDB$INTERPRET.
C----------------------------------------------------

	    DO WHILE ((retry_count .LT. 5) .AND. (.NOT. (success)))
		success = .TRUE.
		STATUS = RDB$INTERPRET(%DESCR(ddl_statement))
		IF ((STATUS .AND. 1) .NE. 0) THEN     
			success = .FALSE.
			retry_count = retry_count + 1
			CALL callable_error_handler(STATUS)
		END IF
	    END DO

C--------------------------------------------------------------
C Inform user of success or failure of data defintion task.
C--------------------------------------------------------------

	    IF (success) THEN
			PRINT *,' Transaction Successful'
			CALL RDB$INTERPRET(%DESCR('COMMIT'))
	    ELSE
			PRINT *,' Transaction failed'
			CALL RDB$INTERPRET(%DESCR('ROLLBACK'))
	    END IF

C--------------------------------------------------------------------
C Ask user if he or she wants to define or delete another index.
C--------------------------------------------------------------------

	    PRINT *,'   '
	    PRINT *,' Please enter the data definition statement to define'
	    PRINT *,' or delete a temporary index, or type exit: '
	    PRINT *,'  '
	    PRINT *,' For example, to define an index for EMPLOYEES based'
	    PRINT *,' on EMPLOYEE_ID, you might enter: '
	    PRINT *,'  '
	    PRINT *,'  define index emp_employee_id for employees duplicates
	1 are allowed.'
	    PRINT *,'    employee_id.'
	    PRINT *,'  end emp_employee_id index.'
	    PRINT *,'  '
	    PRINT *,' To delete this index, you might enter: '
	    PRINT *,'  '
	    PRINT *,'  delete index emp_employee_id.'
	    PRINT *,'  '
	    ACCEPT 130, ddl_statement

	END DO

	RETURN
	END