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

C--------------------------------------------------------------
C This subroutine modifies the address of an EMPLOYEES record.
C--------------------------------------------------------------

	IMPLICIT NONE
	LOGICAL found_employee,success
	INTEGER retry_count
	INTEGER*4 birthday(2),SYS$ASCTIM
	CHARACTER employee_id*5,last_name*14,first_name*10,middle_initial
	CHARACTER city*20,state*2,postal_code*5,ascii_date*23,confirm
	CHARACTER*25 address_data_1,address_data_2


&RDB&	DATABASE EXTERNAL pers = FILENAME 'MF_PERSONNEL' 
&RDB&	DBKEY SCOPE IS FINISH

	WRITE (6,90)
90	FORMAT ('1',T25,'**** MODIFY ADDRESS ****'///)

C----------------------------------------------------------
C Prompt user for the ID of the employee whose record
C he or she wants to modify.
C----------------------------------------------------------

	TYPE 100
100	FORMAT ('  Please enter the ID of the Employee whose')
	TYPE 110
110	FORMAT ('$','  address you want to change or type exit: ')	
	ACCEPT 120, employee_id
120	FORMAT (A)
	
	DO WHILE ((employee_id.NE.'EXIT ').AND.(employee_id.NE.'exit '))
	    confirm = 'N'
	    DO WHILE (confirm .EQ. 'N')

C------------------------------------------------------
C Retrieve and display the record specified by the 
C employee id and confirm with the user that he or she
C wants to modify this record.
C------------------------------------------------------

&RDB& 		START_TRANSACTION READ_WRITE RESERVING
&RDB&			EMPLOYEES FOR SHARED READ 

			found_employee = .FALSE.
&RDB&			FOR E IN EMPLOYEES WITH 
&RDB&				E.EMPLOYEE_ID = employee_id
&RDB&			GET
&RDB&				employee_id = E.EMPLOYEE_ID;
&RDB&				last_name = E.LAST_NAME;
&RDB&				first_name = E.FIRST_NAME;
&RDB&				middle_initial = E.MIDDLE_INITIAL;
&RDB&				address_data_1 = E.ADDRESS_DATA_1;
&RDB&				address_data_2 = E.ADDRESS_DATA_2;
&RDB&				city = E.CITY;
&RDB&				state = E.STATE;
&RDB&				postal_code = E.POSTAL_CODE;
&RDB&				birthday = E.BIRTHDAY;
&RDB&			END_GET
			CALL SYS$ASCTIM (, ascii_date, birthday, )
			TYPE 1000, employee_id, last_name, first_name,
	1			middle_initial, address_data_1, 
	1			address_data_2, city, state, 
	1			postal_code, ascii_date
1000			FORMAT (//   ' Employee_id:    ',A/
	1			' Last name:      ',A/
	1			' First name:     ',A/
	1			' Middle initial: ',A/
	1			' Address:        ',A,' ',A/
	1			' City:	        ',A/
	1		   	' State:          ',A/
	1			' Postal code:    ',A/
	1			' Birthday:       ',A//)
			found_employee = .TRUE.
&RDB&			END_FOR
&RDB&			COMMIT

			IF (found_employee) THEN
				PRINT *, '  '
				TYPE 2000
2000				FORMAT ('$',' Do you want to change this
	1 address (Y/N): ')
				ACCEPT 2010, confirm
2010				FORMAT (A)
			ELSE
				TYPE 2020, employee_id
2020				FORMAT (' Employee id: ',A,'is
	1 not on file',/)
			END IF

			IF ((confirm.EQ.'N').OR.(.NOT.found_employee)) THEN
				PRINT *, '  '
				TYPE 100
				TYPE 110
				ACCEPT 120, employee_id
				IF ((employee_id.EQ.'EXIT ').OR.
	1			    (employee_id.EQ.'exit ')) THEN
					confirm = 'Y'
				END IF
			END IF
	    END DO

		confirm = 'N'
		IF ((employee_id.NE.'EXIT ').AND.
	1	    (employee_id.NE.'exit ')) THEN

C---------------------------------------------------
C Prompt the user for a new address.
C---------------------------------------------------

			DO WHILE (confirm .EQ. 'N')
				TYPE 5000
5000				FORMAT ('$',' Please enter the Employees 
	1street address: ')
				ACCEPT 5010, address_data_1
5010				FORMAT (A)
				TYPE 6000
6000				FORMAT ('$',' Please enter the Employees 
	1apartment number: ')
				ACCEPT 6010, address_data_2
6010				FORMAT (A)
				TYPE 7000
7000				FORMAT ('$',' Please enter city: ')
				ACCEPT 7010, city
7010				FORMAT (A)
				TYPE 8000
8000				FORMAT ('$',' Please enter state: ')
				ACCEPT 8010, state 
8010				FORMAT (A)
				TYPE 9000
9000				FORMAT ('$',' Please enter postal code: ')
				ACCEPT 9010, postal_code
9010				FORMAT (A)
				PRINT *, '  '
				TYPE 10000
10000				FORMAT ('$',' Have you entered all data 
	1correctly? (Y/N): ')
				ACCEPT 10010, confirm
10010				FORMAT (A)
	 		END DO

			success = .TRUE.
&RDB& 			START_TRANSACTION READ_WRITE RESERVING
&RDB&				EMPLOYEES FOR SHARED WRITE

C--------------------------------------------------------
C Modify the address fields for the specified EMPLOYEES
C record.
C--------------------------------------------------------

&RDB&			FOR E IN EMPLOYEES WITH 
&RDB&				E.EMPLOYEE_ID = employee_id
&RDB&		    	    MODIFY E USING
&RDB&		    	    ON ERROR
				success = .FALSE.
                                CALL error_handler(RDB$STATUS,success)
                                IF (success) THEN
                                        retry_count = 5
                                END IF
&RDB&			    END_ERROR
&RDB&				E.ADDRESS_DATA_1 = address_data_1;
&RDB&				E.ADDRESS_DATA_2 = address_data_2;
&RDB&				E.CITY = city;
&RDB&				E.STATE = state;
&RDB&				E.POSTAL_CODE = postal_code;
&RDB&		    	    END_MODIFY
&RDB&		    	END_FOR

C-----------------------------------------------------
C Notify the user of the success or failure of the
C modify operation.
C-----------------------------------------------------

			IF (success) THEN
				PRINT *, ' Update operation successful'
&RDB&				COMMIT
			ELSE
				PRINT *, ' Update operation failed'
&RDB&				ROLLBACK
			END IF
	
			PRINT *, '  '
			TYPE 11000
11000			FORMAT ('  Please enter the ID of the 
	1Employee whose')
			TYPE 11010
11010			FORMAT ('$',' address you want to change 
	1or type exit: ')	
			ACCEPT 11020, employee_id
11020			FORMAT (A)
			confirm = 'Y'
		END IF
	END DO

	RETURN
	END