C Copyright © Oracle Corporation 1995.  All Rights Reserved.
C This subroutine is called by the program SQL$DIST_TRANS.FOR.  It 
C calls SQL module procedures to add an employee to the EAST database,
C an Oracle Rdb database.

	SUBROUTINE rdb_add_east ( 
	1		employee_id,
	2		last_name,
	3		first_name,
	4		in_tid)

	IMPLICIT NONE
	INTEGER*4 SYS$BINTIM,STATUS
	EXTERNAL SYS$BINTIM
	CHARACTER employee_id*5,last_name*14,first_name*10,
	1	middle_initial*1,address_data_1*25,address_data_2*20,
	2       city*20,state*2,postal_code*5,ascii_date*23,confirm,
	3       sex*1,status_code*1,birthday*8
       	LOGICAL valid_date

C Declare the distributed TID and SQLCODE.

	INTEGER*4 in_tid(4),sqlcode

C Declare the context structure.

	STRUCTURE /CONTXT_STRUCT/
		INTEGER*4 VERSION
		INTEGER*4 TYPE
		INTEGER*4 LENGTH
		INTEGER*4 tid(4)
		INTEGER*4 END
	END STRUCTURE
	RECORD /CONTXT_STRUCT/ context

C Initialize the context structure.

	context.version = 1
	context.type = 1
	context.length = 16
	context.tid(1) = in_tid(1)
	context.tid(2) = in_tid(2)
	context.tid(3) = in_tid(3)
	context.tid(4) = in_tid(4)
	context.end = 0

	confirm = 'N'
	    DO WHILE ((confirm .NE. 'Y') .AND. (confirm .NE. 'y'))

C Prompt the user for input and accept the input.

		PRINT *, '  '
		TYPE 900
900		FORMAT ('$',' Please enter the ID of the employee: ')
		ACCEPT 910, employee_id
910		FORMAT (A)

		TYPE 1000
1000		FORMAT ('$',' Please enter the employees last name: ')
		ACCEPT 1010, last_name
1010		FORMAT (A)

		TYPE 2000
2000		FORMAT ('$',' Please enter the employees first name: ')
		ACCEPT 2010, first_name
2010		FORMAT (A)

		TYPE 3000
3000		FORMAT ('$',' Please enter the employees middle initial: ')
		ACCEPT 3010, middle_initial
3010		FORMAT (A)

		TYPE 3500
3500		FORMAT ('$',' Please enter the employees sex: ')
		ACCEPT 3510, sex
3510		FORMAT (A)

		valid_date = .FALSE.
		DO WHILE (.NOT.(valid_date))
			TYPE 4000
4000			FORMAT ('$',' Please enter the employees 
	1birthday (dd-MMM-yyyy): ')
			ACCEPT 4010, ascii_date
4010			FORMAT (A23)
			STATUS=SYS$BINTIM(%DESCR(ascii_date),
	1      		%REF(birthday))
			IF (STATUS .NE. 1) THEN 
				WRITE (6,*) 'Invalid date format'
			ELSE
				valid_date = .TRUE.
			END IF
		END DO

		TYPE 5000
5000		FORMAT ('$',' Please enter the employees street address: ')
		ACCEPT 5010, address_data_1
5010		FORMAT (A)

		TYPE 6000
6000		FORMAT ('$',' Please enter the employees apartment number: ')
		ACCEPT 6010, address_data_2
6010		FORMAT (A)

		TYPE 7000
7000		FORMAT ('$',' Please enter the city: ')
		ACCEPT 7010, city
7010		FORMAT (A)

		TYPE 8000
8000		FORMAT ('$',' Please enter the state: ')
		ACCEPT 8010, state 
8010		FORMAT (A)

		TYPE 9000
9000		FORMAT ('$',' Please enter the postal code: ')
		ACCEPT 9010, postal_code
9010		FORMAT (A)

		TYPE 9500
9500		FORMAT ('$',' Please enter the employee status code: ')
		ACCEPT 9510, status_code
9510		FORMAT (A)

		PRINT *, '  '
		TYPE 10000
10000		FORMAT ('$','Have you entered all data correctly? (Y/N): ')
		ACCEPT 10010, confirm
10010		FORMAT (A)
	    END DO
	
C Call the SQL module procedure START_EAST to start the transaction.

	CALL start_east(sqlcode,context)
		IF (SQLCODE .LT. 0) CALL sql$dist_trans_error(in_tid,sqlcode)

C Call the SQL module procedure INSERT_EAST to insert the employee record.

	PRINT *, '  Storing the row in 2pceast database'
	CALL insert_east(sqlcode,employee_id,last_name,first_name,sex,
	1		middle_initial,address_data_1,address_data_2,
	2		city,state,postal_code,birthday,status_code,context)
		IF (SQLCODE .LT. 0) CALL sql$dist_trans_error(in_tid,sqlcode)

	RETURN
	END