10 OPTION TYPE = EXPLICIT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! This is the main program that calls all the sample BASIC subroutines ! ! together. It allows the user to choose among several actions ! ! on the database. ! ! ! ! To create an executable image of all these modules, ! ! enter the following commands: ! ! ! ! $ rbas :== $rdbpre/basic ! ! $ rbas b_sample ! ! $ rbas b_call_other ! ! $ basic b_error_handler ! ! $ basic b_callable_error_handler ! ! ! ! $ link b_sample, b_call_other, b_error_handler, b_callable_error_handler ! ! ! ! $ run b_sample ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Declare variables. DECLARE LONG confirm , & dbhandle, & eof_flag, & end_of_cands, & end_of_emps, & file_ok , & found_candidate_flag, & found_employee_flag, & i, & lock_error , & loop_cnt , & menu_option , & more_responses , & no_more_ddl_statements, & number_of_employees, & number_employees_added, & resume_id, & retry_count , & return_status , & segment_length , & success_flag, & trans1, & transaction_started, & want_to_exit, & want_to_see_all, & valid_date DECLARE STRING resume_line , & answer, & resume_file, & database_key(20%) , & data_base_key , & db_key , & ddl_statement MAP (RESUMES) STRING resume_segment = 80% MAP (MISC) STRING ascii_date = 23% MAP (DATES) STRING work_date = 8% MAP (DATES) LONG work1,work2 EXTERNAL LONG FUNCTION SYS$ASCTIM,SYS$BINTIM,RDB$INTERPRET EXTERNAL LONG CONSTANT SS$_NORMAL RECORD EMPLOYEE STRING employee_id = 5 STRING last_name = 14 STRING first_name = 10 STRING middle_initial = 1 STRING address_data_1 = 25 STRING address_data_2 = 25 STRING city = 20 STRING state = 2 STRING postal_code = 5 STRING sex = 1 GROUP birthday STRING string_value = 8 END GROUP STRING status_code = 1 END RECORD RECORD CANDIDATE STRING last_name = 14 STRING first_name = 10 STRING middle_initial = 1 GROUP candidate_status WORD word_value STRING string_value = 255 END GROUP END RECORD RECORD DEGREE STRING employee_id = 5 STRING college_code = 4 WORD year_given STRING degree = 3 STRING degree_field = 15 END RECORD RECORD COLLEGE STRING college_code = 4 STRING college_name = 25 STRING city = 20 STRING state = 2 STRING postal_code = 5 END RECORD RECORD SALARY_HISTORY STRING EMPLOYEE_ID = 5 GROUP SALARY_AMOUNT LONG LONG_VALUE END GROUP GROUP SALARY_START STRING STRING_VALUE = 8 END GROUP GROUP SALARY_END STRING STRING_VALUE = 8 END GROUP END RECORD MAP (RECORDS) employee employees, & candidate candidates, & degree degrees, & salary_history salary_hist, & college colleges &RDB& DATABASE GLOBAL pers = FILENAME "MF_PERSONNEL" DBKEY SCOPE IS FINISH ! Declare streams used in the PAIR procedure &RDB& DECLARE_STREAM cands USING CA IN CANDIDATES SORTED BY CA.LAST_NAME &RDB& DECLARE_STREAM emps USING EM IN EMPLOYEES SORTED BY EM.FIRST_NAME Display_menu: more_responses = -1% ! Loop directs the program to call appropriate subroutines ! based on user's response to the following menu. WHILE more_responses PRINT FOR loop_cnt = 1% TO 24% PRINT " Main Menu" PRINT " Sample Application" PRINT PRINT "1. Add one or more records to EMPLOYEES" PRINT "2. Modify the address of one or more records in EMPLOYEES" PRINT "3. Delete one or more records from EMPLOYEES" PRINT "4. List all the EMPLOYEES and the colleges attended" PRINT "5. List EMPLOYEES in order of seniority" PRINT "6. Pair an EMPLOYEES Record with a CANDIDATES record" PRINT "7. Calculate the total number of employees in the Company" PRINT "8. Store one or more records in the CANDIDATES relation" PRINT "9. PRINT one or more records from CANDIDATES" PRINT "10. PRINT employee IDs of employees in DEGREES with"+ & " an unknown area of study" PRINT "11. Store a record in DEGREES" PRINT "12. Modify a resume in RESUMES" PRINT "13. PRINT a RESUME" PRINT "14. Add or delete a temporary index" PRINT "15. Retrieve COLLEGES information using Callable RDO" PRINT "16. Store a resume in RESUMES" PRINT "99. Exit the Program" PRINT "Please enter an OPTION number and press RETURN: "; INPUT menu_option SELECT menu_option CASE 1 GOSUB Add_employees CASE 2 GOSUB Modify_address CASE 3 GOSUB Delete_record CASE 4 GOSUB List_record CASE 5 GOSUB Seniority CASE 6 GOSUB Pair CASE 7 GOSUB Stats CASE 8 GOSUB Store_cand CASE 9 GOSUB Display_cand CASE 10 GOSUB Find_missing CASE 11 GOSUB Rdbdollarmissing CASE 12 GOSUB Mod_resume CASE 13 GOSUB Display_resume CASE 14 GOSUB Ddl_stmnt CASE 15 GOSUB Callable CASE 16 GOSUB Store_res CASE 99 more_responses = 0% CASE ELSE PRINT "Invalid option - "+ & "Press RETURN to continue"; INPUT answer END SELECT NEXT &RDB& FINISH EXIT PROGRAM Add_employees: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! This subroutine adds a new EMPLOYEES record to the EMPLOYEES ! ! relation. ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! PRINT FOR loop_cnt = 1% TO 24% PRINT "Add Employees" want_to_exit = 0% ! Prompt user for input, until user confirms that ! input of valid or enters CTRL/Z. UNTIL want_to_exit WHEN ERROR IN PRINT "Please enter the ID of the new employee or press ^Z:"; INPUT employees::employee_id USE want_to_exit = -1% IF ERR = 11% END WHEN RETURN IF want_to_exit confirm = 0% retry_count = 0% success_flag = 0% UNTIL confirm PRINT "Please enter the employee's last name: "; INPUT employees::last_name PRINT "Please enter the employee's first name: "; INPUT employees::first_name PRINT "Please enter the employee's middle initial: "; INPUT employees::middle_initial valid_date = 0% ! Prompt user to input date, keep prompting until user ! enters date in proper format. UNTIL valid_date PRINT "Enter the employee's birthday (dd-MMM-yyyy):"; INPUT ascii_date ascii_date = EDIT$(ascii_date,32%) ! Use SYS$BINTIM to convert ASCII input ! to binary format. return_status = SYS$BINTIM(ascii_date,work1) IF (return_status AND 1%) <> 1% THEN PRINT "Invalid date format" ELSE valid_date = -1% END IF NEXT employees::birthday::string_value = work_date PRINT "Please enter the employee's street address: "; INPUT employees::address_data_1 PRINT "Please enter apartment number, if any: "; INPUT employees::address_data_2 PRINT "Please enter city: "; INPUT employees::city PRINT "Please enter state: "; INPUT employees::state PRINT "Please enter postal code: "; INPUT employees::postal_code PRINT "Have you entered all data correctly? (Y/N): " INPUT answer confirm = -1% IF EDIT$(answer,32%) = "Y" NEXT retry_count = 0% lock_error = -1% success_flag = 0% transaction_started = 0% ! The following loop will execute at least once, because ! 'success' has just been set to false, and 'retry_count' to ! zero. If an error occurs during the START_TRANSACTION operation, ! the program will retry the START_TRANSACTION operation up to 5 ! times. UNTIL (lock_error AND retry_count = 5) OR & (success_flag) OR (NOT lock_error) success_flag = -1% transaction_started = -1% lock_error = 0% &RDB& START_TRANSACTION READ_WRITE NOWAIT RESERVING &RDB& EMPLOYEES FOR SHARED WRITE &RDB& ON ERROR success_flag = 0% transaction_started = 0% CALL ERROR_HANDLER(RDB$STATUS, & retry_count, & success_flag, & lock_error) &RDB& END_ERROR IF NOT lock_error THEN retry_count = 0% lock_error = -1% success_flag = 0% ! The following loop will execute at least once. ! If an error occurs during the STORE operation, ! the program will retry the STORE operation up to 5 times UNTIL (lock_error AND retry_count = 5) & OR success_flag OR NOT lock_error success_flag = -1% lock_error = 0% ! Store the values that the user entered into an ! EMPLOYEES record. &RDB& STORE E IN EMPLOYEES USING &RDB& ON ERROR success_flag = 0% CALL ERROR_HANDLER(RDB$STATUS, & retry_count, & success_flag, & lock_error) &RDB& END_ERROR &RDB& E.EMPLOYEE_ID = employees::employee_id; &RDB& E.LAST_NAME = employees::last_name; &RDB& E.FIRST_NAME = employees::first_name; &RDB& E.MIDDLE_INITIAL = employees::middle_initial; &RDB& E.ADDRESS_DATA_1 = employees::address_data_1; &RDB& E.ADDRESS_DATA_2 = employees::address_data_2; &RDB& E.CITY = employees::city; &RDB& E.STATE = employees::state; &RDB& E.POSTAL_CODE = employees::postal_code; &RDB& E.BIRTHDAY = employees::birthday::string_value ! Get the dbkey associated with the newly ! stored EMPLOYEES record. &RDB& GET &RDB& ON ERROR success_flag = 0% &RDB& END_ERROR &RDB& data_base_key = E.RDB$DB_KEY &RDB& END_GET &RDB& END_STORE NEXT END IF NEXT ! If the STORE operation succeeded, increment a counter by one ! and add the dbkey to an array of dbkeys IF success_flag THEN number_employees_added = number_employees_added + 1% database_key(number_employees_added) = data_base_key PRINT "successfully added employee: "+employees::last_name PRINT "with employee_id: "+employees::employee_id PRINT PRINT "Do you want to see the names of all the employees "+ & "entered during this session (Y/N): "; INPUT answer want_to_see_all = -1% IF EDIT$(answer,32%) = "Y" ! If the user wants to see all the EMPLOYEES records ! added during this session, step through the array ! of dbkeys to find and print each new employee record. IF want_to_see_all THEN FOR i = 1 TO number_employees_added &RDB& FOR E IN EMPLOYEES WITH E.RDB$DB_KEY = database_key(i) &RDB& ON ERROR success_flag = 0% CALL Error_handler(RDB$STATUS, & retry_count, success_flag, lock_error) &RDB& END_ERROR &RDB& GET &RDB& ON ERROR success_flag = 0% &RDB& END_ERROR &RDB& employees::employee_id = E.EMPLOYEE_ID; &RDB& employees::last_name = E.LAST_NAME; &RDB& employees::first_name = E.FIRST_NAME; &RDB& employees::middle_initial = E.MIDDLE_INITIAL; &RDB& employees::address_data_1 = E.ADDRESS_DATA_1; &RDB& employees::address_data_2 = E.ADDRESS_DATA_2; &RDB& employees::city = E.CITY; &RDB& employees::state = E.STATE; &RDB& employees::postal_code = E.POSTAL_CODE; &RDB& employees::birthday::string_value = E.BIRTHDAY &RDB& END_GET &RDB& END_FOR ! If the field values were successfully retrieved, ! then convert the date field from binary to a ! printable (ASCII) format. The first and last ! arguments to the call SYS$ASCTIM are not ! required arguments. GOSUB Display_employee IF success_flag success_flag = -1% NEXT I END IF &RDB& COMMIT ELSE PRINT "Update operation failed, Employee name ", & employees::employee_id, & " has not been stored in the database" IF transaction_started THEN &RDB& ROLLBACK END IF END IF NEXT RETURN Display_employee: PRINT PRINT "Employee id: "+employees::employee_id PRINT "Last name: "+employees::last_name PRINT "First name: "+employees::first_name PRINT "Middle init: "+employees::middle_initial PRINT "Address: "+employees::address_data_1+" "+ & employees::address_data_2 PRINT "City: "+employees::city PRINT "State: "+employees::state PRINT "Postal code: "+employees::postal_code ! Convert binary date to ASCII format. work_date = employees::birthday::string_value return_status = SYS$ASCTIM(,ascii_date,work1,) PRINT "Birthday: "+ascii_date PRINT RETURN Modify_address: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! This subroutine modifies the address of an EMPLOYEES record. ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! PRINT FOR loop_cnt = 1% to 24% PRINT "Modify Employee Address" PRINT want_to_exit = 0% ! Prompt user for the ID of the employee whose record ! he or she wants to modify. UNTIL want_to_exit WHEN ERROR IN PRINT "Please enter the ID number of the Employee" PRINT "whose address you want to change or press ^Z: "; INPUT employees::employee_id USE want_to_exit = -1% IF err = 11% END WHEN RETURN IF want_to_exit confirm = 0% UNTIL confirm OR want_to_exit ! Retrieve and display the record specified by the employee ! id and confirm with the user that he or she wants to modify ! this record. &RDB& START_TRANSACTION READ_WRITE RESERVING EMPLOYEES FOR SHARED READ found_employee_flag = 0% &RDB& FOR E IN EMPLOYEES WITH E.EMPLOYEE_ID = employees::employee_id &RDB& GET &RDB& employees::employee_id = E.EMPLOYEE_ID; &RDB& employees::last_name = E.LAST_NAME; &RDB& employees::first_name = E.FIRST_NAME; &RDB& employees::middle_initial = E.MIDDLE_INITIAL; &RDB& employees::address_data_1 = E.ADDRESS_DATA_1; &RDB& employees::address_data_2 = E.ADDRESS_DATA_2; &RDB& employees::city = E.CITY; &RDB& employees::state = E.STATE; &RDB& employees::postal_code = E.POSTAL_CODE; &RDB& employees::birthday::string_value = E.BIRTHDAY &RDB& END_GET GOSUB display_employee found_employee_flag = -1% &RDB& END_FOR &RDB& COMMIT IF found_employee_flag THEN PRINT PRINT "Do you want to change this address (Y/N): "; INPUT answer confirm = -1% IF EDIT$(answer,32%) = "Y" ELSE PRINT "Employee id: "+ & employees::employee_id+" not on file" END IF ! Prompt the user for a new address. IF (NOT confirm) OR (NOT found_employee_flag) THEN WHEN ERROR IN PRINT "Please enter the ID number of the employee" PRINT "whose address you want to change or press ^Z: "; INPUT employees::employee_id USE want_to_exit = -1% IF err = 11% END WHEN RETURN IF want_to_exit END IF NEXT confirm = 0% UNTIL confirm PRINT "Please enter the street address: "; INPUT employees::address_data_1 PRINT "Please enter the box number or apartment number: "; INPUT employees::address_data_2 PRINT "Please enter city: "; INPUT employees::city PRINT "Please enter state: "; INPUT employees::state PRINT "Please enter postal code: "; INPUT employees::postal_code PRINT PRINT "Have you entered the address correctly (Y/N): "; INPUT answer confirm = -1% IF EDIT$(answer,32%) = "Y" NEXT success_flag = -1% &RDB& START_TRANSACTION READ_WRITE RESERVING EMPLOYEES FOR SHARED WRITE ! Modify the address fields for the specified EMPLOYEES record. &RDB& FOR E IN EMPLOYEES WITH E.EMPLOYEE_ID = employees::employee_id &RDB& MODIFY E USING &RDB& ON ERROR success_flag = 0% CALL Error_handler (RDB$STATUS, & retry_count, & success_flag, & lock_error) &RDB& END_ERROR &RDB& E.ADDRESS_DATA_1 = employees::address_data_1; &RDB& E.ADDRESS_DATA_2 = employees::address_data_2; &RDB& E.CITY = employees::city; &RDB& E.STATE = employees::state; &RDB& E.POSTAL_CODE = employees::postal_code; &RDB& END_MODIFY &RDB& END_FOR IF success_flag ! Notify the user of the success or failure of the modify operation. THEN PRINT "Update operation succeeded" &RDB& COMMIT ELSE PRINT "Update operation failed" &RDB& ROLLBACK END IF NEXT RETURN Delete_record: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! This subroutine deletes a record from the database. ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! PRINT FOR loop_cnt = 1% to 24% PRINT "Delete Employee" PRINT want_to_exit = 0% ! Prompt user for the ID of the EMPLOYEES record that he or she ! wants to delete from the database. UNTIL want_to_exit WHEN ERROR IN PRINT "Please enter the ID number of the employee" PRINT "you want to delete or PRESS ^Z: "; INPUT employees::employee_id USE want_to_exit = -1% IF ERR = 11% END WHEN RETURN IF want_to_exit confirm = 0% success_flag = -1% until confirm OR want_to_exit trans1 = 0% &RDB& START_TRANSACTION (TRANSACTION_HANDLE trans1) &RDB& READ_WRITE RESERVING EMPLOYEES FOR SHARED READ found_employee_flag = 0% ! Find the record of the employee that the user ! wants to delete. If an error occurs during the ! FOR operation call an error handler. &RDB& FOR (TRANSACTION_HANDLE trans1) &RDB& E IN EMPLOYEES WITH &RDB& E.EMPLOYEE_ID = employees::employee_id &RDB& ON ERROR success_flag = 0% CALL Error_handler(RDB$STATUS, & retry_count, & success_flag, & lock_error) &RDB& END_ERROR ! Get the dbkey of the EMPLOYEES record that the ! user wants to delete. &RDB& GET &RDB& ON ERROR success_flag = 0% &RDB& END_ERROR &RDB& db_key = E.RDB$DB_KEY &RDB& END_GET found_employee_flag = -1% &RDB& END_FOR IF NOT found_employee_flag THEN PRINT "No employee with id: "+ & employees::employee_id+" on file" ELSE ! Pass the dbkey to an external routine "CALL_OTHER" to ! print out the record to which the dbkey points. Note ! that using an external routine is neither necessary ! nor recommended for performing this task. It is done ! in this example only to show how values are passed between ! routines in an RDBPRE BASIC program. IF success_flag THEN CALL Call_other(db_key, trans1) END IF END IF &RDB& COMMIT (TRANSACTION_HANDLE trans1) ! Ask user for confirmation that this is the EMPLOYEES ! record he or she wants to delete. PRINT IF found_employee_flag THEN PRINT "Is this the employee you want to delete (Y/N): "; INPUT answer confirm = -1% IF EDIT$(answer,32%) = "Y" END IF IF NOT confirm THEN PRINT "Employee with employee id: "+ & employees::employee_id+" not deleted" PRINT END IF IF (NOT confirm) OR (NOT found_employee_flag) THEN WHEN ERROR IN PRINT "Please enter the ID number of the employee" PRINT "you want to delete or press ^Z: "; INPUT employees::employee_id USE want_to_exit = -1% IF err = 11% END WHEN RETURN IF want_to_exit END IF NEXT ! If the user wants to delete the EMPLOYEES record, then start ! a READ_WRITE transaction and delete the EMPLOYEES record ! from all relations in which its employee_id appears. Note that ! this is all done in one transaction. You would not want to split ! this task across transactions. If one of many transactions failed, ! you would not be certain that the employee's record ! was deleted from all the relations. &RDB& START_TRANSACTION READ_WRITE RESERVING EMPLOYEES, &RDB& SALARY_HISTORY, JOB_HISTORY, DEPARTMENTS, &RDB& DEGREES, WORK_STATUS, RESUMES FOR SHARED WRITE &RDB& FOR E IN EMPLOYEES WITH E.RDB$DB_KEY = db_key &RDB& FOR JH IN JOB_HISTORY WITH JH.EMPLOYEE_ID = E.EMPLOYEE_ID &RDB& ERASE JH &RDB& END_FOR &RDB& FOR SH IN SALARY_HISTORY WITH SH.EMPLOYEE_ID = E.EMPLOYEE_ID &RDB& ERASE SH &RDB& END_FOR &RDB& FOR D IN DEGREES WITH D.EMPLOYEE_ID = E.EMPLOYEE_ID &RDB& ERASE D &RDB& END_FOR &RDB& FOR R IN RESUMES WITH R.EMPLOYEE_ID = E.EMPLOYEE_ID &RDB& ERASE R &RDB& END_FOR &RDB& ERASE E PRINT "Employee id: "+employees::employee_id+ & " deleted successfully" &RDB& END_FOR &RDB& COMMIT NEXT RETURN List_record: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! This subroutine lists all the employees and the colleges they attended. ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! PRINT FOR loop_cnt = 1% TO 24% PRINT "List of employees and colleges attended" PRINT &RDB& START_TRANSACTION READ_ONLY ! For each EMPLOYEES record that has a corresponding record in ! DEGREES, print the DEGREES record. &RDB& FOR E IN EMPLOYEES SORTED BY E.LAST_NAME &RDB& FOR D IN DEGREES WITH D.EMPLOYEE_ID = E.EMPLOYEE_ID &RDB& GET &RDB& employees::first_name = E.FIRST_NAME; &RDB& employees::last_name = E.LAST_NAME; &RDB& degrees::degree = D.DEGREE; &RDB& degrees::degree_field = D.DEGREE_FIELD &RDB& END_GET PRINT "Name is: "+employees::first_name+" "+ & employees::last_name+" "+ & "Degree is: "+degrees::degree+" "+ & "Degree field is: "+degrees::degree_field &RDB& END_FOR ! Use the NOT ANY clause to create a stream of all the records ! in the EMPLOYEES relation that do not have an associated record ! in the DEGREES relation. ! Then use the FIRST clause to step through this stream. The FOR ! statement previously created for the EMPLOYEES relation ! is still active; this will cause the FIRST clause to step ! through the stream created by the NOT ANY clause. &RDB& FOR FIRST 1 D IN DEGREES WITH NOT ANY D1 IN DEGREES &RDB& WITH D1.EMPLOYEE_ID = E.EMPLOYEE_ID &RDB& GET &RDB& employees::first_name = E.FIRST_NAME; &RDB& employees::last_name = E.LAST_NAME; &RDB& END_GET ! Print the names from the EMPLOYEES records that ! do not have an associated record stored in DEGREES. PRINT employees::first_name+" "+employees::last_name+ & " Does not have this information stored in the database" &RDB& END_FOR &RDB& END_FOR &RDB& COMMIT PRINT "Press RETURN to continue "; INPUT answer RETURN Seniority: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! This subroutine lists employees in order of seniority. ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! PRINT FOR loop_cnt = 1% TO 24% PRINT "List of employees by seniority" PRINT &RDB& START_TRANSACTION READ_ONLY ! Create a stream of records by crossing the EMPLOYEES ! relation with a stream of records from the SALARY_HISTORY relation ! that have the value for the SALARY_END field flagged as missing. ! The assumption is that if the SALARY_END field is missing, ! this record is the current record. Sort the records in ascending ! order of the salary start date. &RDB& FOR SH IN SALARY_HISTORY CROSS E IN EMPLOYEES OVER EMPLOYEE_ID &RDB& WITH SH.SALARY_END MISSING &RDB& SORTED BY SH.SALARY_START &RDB& GET &RDB& employees::first_name = E.FIRST_NAME; &RDB& employees::last_name = E.LAST_NAME; &RDB& salary_hist::salary_start = SH.SALARY_START &RDB& END_GET ! Display the retrieved records; use SYS$ASCTIM to ! convert the date, which is stored in binary format. PRINT employees::first_name+" "+employees::last_name; PRINT " started work on: "; work_date = salary_hist::salary_start::string_value return_status = SYS$ASCTIM(,ascii_date,work1,) PRINT ascii_date &RDB& END_FOR &RDB& COMMIT PRINT "Press RETURN to continue "; INPUT answer RETURN Pair: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! This subroutine demonstrates the use of the declared START_STREAM ! ! statement. The output of this program is merely a random matching ! ! of each CANDIDATES record with an EMPLOYEES record. ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! &RDB& START_TRANSACTION READ_ONLY ! Open both streams and set a flag for the end of stream ! condition to false. GOSUB Open_candidates GOSUB Open_employees end_of_emps = 0% end_of_cands = 0% ! Fetch a record from the CANDIDATES and EMPLOYEES relations. GOSUB Read_a_candidate GOSUB Read_an_employee ! Print the employee and candidate names until the end-of-stream ! condition is met for the stream of CANDIDATES records. UNTIL end_of_cands PRINT employees::last_name+" "+employees::first_name+ & ' '+ & candidates::last_name+" "+ & candidates::first_name GOSUB Read_a_candidate IF NOT end_of_emps THEN GOSUB Read_an_employee END IF NEXT ! Close both streams. GOSUB Close_employees GOSUB Close_candidates &RDB& COMMIT. PRINT "Press RETURN to continue "; INPUT answer RETURN ! These subroutines control a stream. Note that the statements ! do not appear in the order that they will be executed. This ! is a functionality that declared streams have and undeclared streams ! do not have. Close_employees: ! Close the EMPLOYEES stream. &RDB& END_STREAM emps. RETURN Close_candidates: ! Close the CANDIDATES stream. &RDB& END_STREAM cands. RETURN Open_candidates: ! Open the CANDIDATES stream. &RDB& START_STREAM cands. RETURN Open_employees: ! Open the EMPLOYEES stream. &RDB& START_STREAM emps. RETURN Read_a_candidate: ! Fetch a CANDIDATES record. &RDB& FETCH cands &RDB& AT END end_of_cands = -1% &RDB& END_FETCH IF NOT end_of_cands THEN &RDB& GET &RDB& candidates::last_name = CA.LAST_NAME; &RDB& candidates::first_name = CA.FIRST_NAME; &RDB& candidates::candidate_status::string_value &RDB& = CA.CANDIDATE_STATUS &RDB& END_GET END IF RETURN Read_an_employee: ! Fetch an EMPLOYEES record. &RDB& FETCH emps &RDB& AT END end_of_emps = -1% &RDB& END_FETCH IF NOT end_of_emps THEN &RDB& GET &RDB& employees::last_name = EM.LAST_NAME; &RDB& employees::first_name = EM.FIRST_NAME; &RDB& employees::employee_id = EM.EMPLOYEE_ID &RDB& END_GET END IF RETURN Stats: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! This subroutine displays the total number of records stored in the ! ! EMPLOYEES relation. ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! PRINT FOR loop_cnt = 1% TO 24% PRINT "Statistics" PRINT &RDB& START_TRANSACTION READ_ONLY PRINT "The number of employees in the Corporation is: "; ! Use the GET statement with a statistical function to calculate ! the total number of records in the EMPLOYEES relation. &RDB& GET &RDB& number_of_employees = COUNT OF E IN EMPLOYEES &RDB& END_GET ! Display the value. PRINT number_of_employees &RDB& COMMIT PRINT PRINT "Press RETURN to continue "; INPUT answer RETURN Store_cand: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! This subroutine stores a record in the CANDIDATES ! ! relation. It shows how to store a value in a field ! ! of data type VARYING STRING. ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! PRINT FOR loop_cnt = 1% TO 24% PRINT "Store Candidates" PRINT want_to_exit = 0% Store_cand_1: ! Prompt user for data to store in the CANDIDATES relation. UNTIL want_to_exit WHEN ERROR IN PRINT "Please enter the first name "+ & "of the candidate or press ^Z: "; INPUT candidates::first_name USE want_to_exit = -1% IF ERR = 11% END WHEN EXIT STORE_CAND_1 IF want_to_exit confirm = 0% UNTIL confirm PRINT "Please enter the candidates middle initial: "; INPUT candidates::middle_initial PRINT "Please enter the last name of the candidate: "; INPUT candidates::last_name PRINT "Please enter candidate status information: "; INPUT candidates::candidate_status::string_value PRINT "Have you entered the candidate"+ & " information correctly(Y/N): "; INPUT answer confirm = -1% IF EDIT$(answer,32%) = "Y" NEXT &RDB& START_TRANSACTION READ_WRITE RESERVING CANDIDATES FOR SHARED WRITE success_flag = -1% ! Store the values specified by the user in the CANDIDATES ! relation. Trap for errors and inform user of the success or ! failure of the STORE operation. &RDB& STORE C IN CANDIDATES USING &RDB& ON ERROR success_flag = 0% CALL Error_handler(RDB$STATUS, retry_count, & success_flag, lock_error) &RDB& END_ERROR &RDB& C.LAST_NAME = candidates::last_name; &RDB& C.FIRST_NAME = candidates::first_name; &RDB& C.MIDDLE_INITIAL = candidates::middle_initial; &RDB& C.CANDIDATE_STATUS = candidates::candidate_status::string_value &RDB& END_STORE IF success_flag THEN PRINT "Update operation succeeded" &RDB& COMMIT ELSE PRINT "Update operation failed" &RDB& ROLLBACK END IF NEXT RETURN Display_cand: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !This subroutine displays a record from the CANDIDATES relation. ! ! It shows how to display a field stored as data type VARYING STRING. ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! PRINT FOR loop_cnt = 1% TO 24% PRINT "Display Candidates" PRINT want_to_exit = 0% Display_cand_1: ! Prompt user for information needed to identify a ! record in the CANDIDATES relation. UNTIL want_to_exit WHEN ERROR IN PRINT "Please enter the first name "+ & "of the candidate or press ^Z: "; INPUT candidates::first_name USE want_to_exit = -1% IF ERR = 11% END WHEN EXIT DISPLAY_CAND_1 IF want_to_exit confirm = 0% UNTIL confirm OR want_to_exit PRINT "Please enter the candidates middle initial: "; INPUT candidates::middle_initial PRINT "Please enter the last name of the candidate: "; INPUT candidates::last_name PRINT "Have you entered the candidate"+ & " information correctly (Y/N): "; INPUT answer confirm = -1% IF EDIT$(answer,32%) = "Y" IF NOT confirm THEN WHEN ERROR IN PRINT "Please enter the first name "+ & "of the candidate or press ^Z: "; INPUT candidates::first_name USE want_to_exit = -1% IF ERR = 11% END WHEN END IF NEXT IF NOT want_to_exit THEN &RDB& START_TRANSACTION READ_ONLY found_candidate_flag = 0% &RDB& FOR C IN CANDIDATES WITH &RDB& C.FIRST_NAME = candidates::first_name &RDB& AND &RDB& C.MIDDLE_INITIAL = candidates::middle_initial &RDB& AND &RDB& C.LAST_NAME = candidates::last_name ! Retrieve and display the VARYING STRING field ! if a record exists for the specified candidate. ! If no record exists for this person, inform the user. &RDB& GET &RDB& candidates::candidate_status::string_value &RDB& = C.CANDIDATE_STATUS &RDB& END_GET found_candidate_flag = -1% PRINT candidates::first_name+" "+ & candidates::middle_initial+" "+ & candidates::last_name+ & " has the following status:" PRINT PRINT candidates::candidate_status::string_value &RDB& END_FOR &RDB& COMMIT IF NOT found_candidate_flag THEN PRINT "No such candidate on file" END IF ELSE want_to_exit = 0% END IF NEXT RETURN Find_missing: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! This subroutine prints the employee ID of all employees in the ! ! DEGREES relation who do not have a value stored in the ! ! DEGREES_FIELD field. ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! PRINT FOR loop_cnt = 1% to 24% PRINT "Employee IDs of employees in DEGREES with an unknown area of study" PRINT &RDB& START_TRANSACTION READ_ONLY ! Use the MISSING value expression to find all records in the ! DEGREES relation that have the DEGREE_FIELD flagged as missing. ! Print the employee ID of all employees in the DEGREES relation ! who do not have a value stored in the DEGREES field. &RDB& FOR D IN DEGREES WITH D.DEGREE_FIELD MISSING &RDB& GET &RDB& employees::employee_id = D.EMPLOYEE_ID &RDB& END_GET PRINT employees::employee_id &RDB& END_FOR &RDB& COMMIT PRINT PRINT "Press RETURN to continue "; INPUT answer RETURN Rdbdollarmissing: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! This subroutine demonstrates how to use the RDB$MISSING value ! ! clause to mark a field as missing. ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! PRINT FOR loop_cnt = 1% TO 24% PRINT "Store a record in degrees" PRINT want_to_exit = 0% Rdbdollarmissing_1: UNTIL want_to_exit WHEN ERROR IN PRINT "Please enter the EMPLOYEE ID number or press ^Z: "; INPUT degrees::employee_id USE want_to_exit = -1% END WHEN EXIT rdbdollarmissing_1 IF want_to_exit confirm = 0% ! Prompt the user for values to store in the COLLEGES relation. UNTIL confirm PRINT "Please enter the college code: "; INPUT degrees::college_code PRINT "Please enter the year the degree was granted: " INPUT degrees::year_given PRINT "Please enter the degree: "; INPUT degrees::degree ! Direct user to enter a question mark if he or ! she is uncertain of the DEGREE_FIELD for the ! record being stored. PRINT "Please enter the field in which the degree was granted" PRINT "If unknown, enter '?': "; INPUT degrees::degree_field PRINT "Have you entered the degree "+ & "information correctly? (Y/N): "; INPUT answer confirm = -1% IF EDIT$(answer,32%) = "Y" NEXT &RDB& START_TRANSACTION READ_WRITE RESERVING DEGREES FOR SHARED WRITE IF degrees::degree_field = '?' THEN ! If the user entered a question mark for the DEGREE_FIELD, then ! retrieve the missing value that is defined for the DEGREE_FIELD. &RDB& GET &RDB& degrees::degree_field = &RDB& RDB$MISSING(DEGREES.DEGREE_FIELD) &RDB& END_GET END IF ! Store the user-specified values in the DEGREES relation. If he ! or she entered a question mark for DEGREE_FIELD, the missing value ! defined for DEGREE_FIELD will be stored, otherwise the value ! specified by the user will be stored. &RDB& STORE D IN DEGREES USING &RDB& D.EMPLOYEE_ID = degrees::employee_id; &RDB& D.COLLEGE_CODE = degrees::college_code; &RDB& D.YEAR_GIVEN = degrees::year_given; &RDB& D.DEGREE = degrees::degree; &RDB& D.DEGREE_FIELD = degrees::degree_field &RDB& END_STORE &RDB& COMMIT NEXT RETURN Mod_resume: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! This subroutine demonstrates how to modify a ! ! field of data type SEGMENTED STRING. ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! PRINT FOR loop_cnt = 1% TO 24% PRINT "Modify a resume" PRINT want_to_exit = 0% Mod_resume_1: ! Prompt user for the employee ID of the RESUMES record ! he or she wants to modify. UNTIL want_to_exit WHEN ERROR IN PRINT "Please enter the ID of the employee or press ^Z: "; INPUT employees::employee_id USE want_to_exit = -1% END WHEN EXIT Mod_resume_1 IF want_to_exit ! Prompt user for the file name of the resume that will replace ! the old resume. PRINT "To modify a resume, you must supply a new resume" PRINT " to replace the old resume" PRINT file_ok = 0% UNTIL file_ok file_ok = -1% PRINT "Please enter file name of new resume: "; INPUT resume_file WHEN ERROR IN OPEN resume_file FOR INPUT AS FILE 1% USE PRINT "File - ";resume_file;" - not found" file_ok = 0% END WHEN NEXT &RDB& START_TRANSACTION READ_WRITE RESERVING RESUMES FOR SHARED WRITE ! Create a new segmented string that will hold the value ! of the new resume. &RDB& CREATE_SEGMENTED_STRING resume_id eof_flag = 0% Resume_read: UNTIL eof_flag resume_line = "" WHEN ERROR IN INPUT LINE #1%, resume_line USE eof_flag = -1% END WHEN EXIT Resume_read IF eof_flag resume_line = EDIT$(resume_line,4%) &RDB& STORE R IN resume_id USING R.RDB$VALUE = &RDB& resume_line END_STORE NEXT CLOSE #1% &RDB& END_SEGMENTED_STRING resume_id ! Modify the old resume by supplying the segmented ! string handle from the CREATE_SEGMENTED_STRING ! statement as the object of the segmented string ! assignment statement. &RDB& FOR R IN RESUMES WITH R.EMPLOYEE_ID = employees::employee_id &RDB& MODIFY R USING &RDB& R.RESUME = resume_id &RDB& END_MODIFY &RDB& END_FOR &RDB& COMMIT NEXT RETURN Display_resume: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! This subroutine demonstrates how to retrieve a ! ! field of data type SEGMENTED STRING. ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! PRINT FOR loop_cnt = 1% TO 24% PRINT "Display a resume" PRINT want_to_exit = 0% ! Prompt user to enter the ID of the employee ! resume that he or she wants to view. If user ! enters CTRL/Z then exit subroutine. UNTIL want_to_exit WHEN ERROR IN PRINT "Please enter the ID of the employee whose resume " PRINT "you want to PRINT or press ^Z: "; INPUT employees::employee_id USE want_to_exit = -1% END WHEN RETURN IF want_to_exit &RDB& START_TRANSACTION READ_ONLY found_employee_flag = 0% ! Start an outer FOR loop to retrieve the employee record(s) ! with the specified ID. &RDB& FOR R IN RESUMES WITH R.EMPLOYEE_ID = employees::employee_id found_employee_flag = -1% ! Start an inner FOR loop to retrieve the segments ! of the segmented string that comprise the employee's ! resume. &RDB& FOR RR IN R.RESUME &RDB& GET &RDB& resume_segment = RR.RDB$VALUE; &RDB& segment_length = RR.RDB$LENGTH &RDB& END_GET ! Display each segment as it is retrieved from the database. PRINT LEFT(resume_segment,segment_length) &RDB& END_FOR &RDB& END_FOR &RDB& COMMIT ! If a record with the specified ID was not found then inform ! the user. IF NOT found_employee_flag THEN PRINT 'Employee: ', employees::employee_id, & ' has no resume on file' END IF PRINT NEXT RETURN Ddl_stmnt: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! This subroutine demonstrates how to perform data definition tasks ! ! from an RDBPRE BASIC program. You must use the Callable RDO ! ! interface, RDB$INTERPRET, to perform data definition tasks in ! ! preprocessed programs. ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! PRINT FOR loop_cnt = 1% TO 24% PRINT "Execute a DDL statement " PRINT ! Invoke the database to make it known to Callable RDO. return_status = RDB$INTERPRET( & 'DATABASE !VAL = FILENAME "MF_PERSONNEL" ' BY DESC,& dbhandle BY DESC) IF (return_status AND 1%) <> 1% THEN CALL Callable_error_handler(return_status, retry_count,lock_error) success_flag = 0% END IF no_more_ddl_statements = 0% Ddl_stmnt_1: ! Prompt user for input. Ordinarily, it would not be likely that ! you would ask a user to define an index for the database. ! This example serves only to show you how this type of task can be ! done from within a BASIC environment. UNTIL no_more_ddl_statements GOSUB Enter_ddl_statement EXIT ddl_stmnt_1 IF no_more_ddl_statements confirm = 0% UNTIL confirm OR no_more_ddl_statements PRINT "Did you enter the definition correctly (Y/N): "; INPUT answer confirm = -1% IF EDIT$(answer,32%) = "Y" IF NOT confirm THEN GOSUB Enter_ddl_statement END IF IF no_more_ddl_statements THEN return_status = RDB$INTERPRET("FINISH" BY DESC) RETURN END IF NEXT transaction_started = 0% retry_count = 0% ! Start a READ_WRITE transaction. UNTIL transaction_started OR retry_count > 5 transaction_started = -1% return_status = RDB$INTERPRET( & "START_TRANSACTION READ_WRITE" BY DESC) IF (return_status AND 1%) <> 1% THEN CALL Callable_error_handler(return_status, & retry_count,& lock_error) success_flag = 0% transaction_started = 0% END IF NEXT IF transaction_started THEN success_flag = 0% retry_count = 0% lock_error = -1% UNTIL success_flag OR & (lock_error AND retry_count > 5) & OR (NOT lock_error) lock_error = 0% success_flag = -1% ! Pass the data definition statement specified ! by the user to RDB$INTERPRET. return_status = RDB$INTERPRET(ddl_statement BY DESC) IF (return_status AND 1%) <> 1% THEN CALL Callable_error_handler(return_status,& retry_count, & lock_error) success_flag = 0% END IF NEXT ! Inform the user of the success or failure of the ! data definition task. IF success_flag THEN PRINT "Transaction successful" return_status = RDB$INTERPRET("COMMIT" BY DESC) ELSE PRINT "Trasaction failed" return_status = RDB$INTERPRET("ROLLBACK" BY DESC) END IF END IF NEXT return_status = RDB$INTERPRET("FINISH" BY DESC) RETURN Enter_ddl_statement: ! This subroutine is used to prompt user for data definition statement. PRINT 'Please enter the data definition statement to define' PRINT 'or delete a temporary index, or press ^Z"' 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 ARE ALLOWED.' PRINT 'EMPLOYEE_ID. END EMP_EMPLOYEE_ID INDEX.' PRINT PRINT 'To delete this index, you might enter: ' PRINT PRINT 'DELETE INDEX EMP_EMPLOYEE_ID.' PRINT WHEN ERROR IN INPUT ddl_statement USE no_more_ddl_statements = -1% END WHEN RETURN Callable: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! This subroutine demonstrates how to embed Callable RDO ! ! statements that perform data manipulation tasks in ! ! an RDBPRE BASIC program. Note that you should always ! ! use RDBPRE BASIC DML to perform data manipulation tasks, ! ! unless special circumstances require that you use Callable ! ! RDO. Callable RDO uses more resources, and is slower than ! ! using RDBPRE. ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! PRINT FOR loop_cnt = 1% TO 24% PRINT "Retrieve college information using callable RDO" PRINT success_flag = 0% ! Invoke the database in Callable RDO. The DATABASE ! statement issued at the beginning of the program (using RDBPRE) ! is unknown to Callable RDO. If an error occurs during the invoke, ! call an error handler. return_status = RDB$INTERPRET( & 'DATABASE !VAL = FILENAME "MF_PERSONNEL" ' BY DESC,& dbhandle BY DESC) IF (return_status AND 1%) <> 1% THEN CALL Callable_error_handler(return_status, retry_count,lock_error) success_flag = 0% END IF want_to_exit = 0% Callable_1: ! Prompt user for the college code of the COLLEGES record he or she ! wants to view. UNTIL want_to_exit WHEN ERROR IN PRINT "Please enter college code of the college or press ^Z"; INPUT colleges::college_code USE want_to_exit = -1% END WHEN EXIT Callable_1 IF want_to_exit transaction_started = 0% retry_count = 0% UNTIL transaction_started OR retry_count > 5 transaction_started = -1% ! Place the RDO START_TRANSACTION statement in a BASIC variable. ! Pass this variable to RDB$INTERPRET. return_status = RDB$INTERPRET( & "START_TRANSACTION READ_WRITE RESERVING"+ & " COLLEGES FOR EXCLUSIVE WRITE NOWAIT" BY DESC) IF (return_status AND 1%) <> 1% THEN CALL Callable_error_handler(return_status, & retry_count, & lock_error) success_flag = 0% transaction_started = 0% END IF NEXT IF transaction_started THEN success_flag = -1% ! Start a stream of COLLEGES records. return_status = RDB$INTERPRET( & "START_STREAM COLL_INFO"+ & " USING C IN COLLEGES WITH"+ & " C.COLLEGE_CODE = !VAL" BY DESC,& colleges::college_code BY DESC) IF (return_status AND 1%) <> 1% THEN CALL Callable_error_handler(return_status, & retry_count, & lock_error) success_flag = 0% END IF IF success_flag THEN return_status = RDB$INTERPRET("FETCH coll_info" BY DESC) IF (return_status AND 1%) <> 1% THEN CALL Callable_error_handler( & return_status, & retry_count, & lock_error) success_flag = 0% END IF IF success_flag THEN ! Retrieve the value of a COLLEGES record. return_status = RDB$INTERPRET( & "GET !VAL = C.COLLEGE_NAME;"+ & " !VAL = C.CITY "+ & "END_GET" BY DESC, & colleges::college_name BY DESC, & colleges::city BY DESC) IF (return_status AND 1%) <> 1% THEN CALL Callable_error_handler(return_status, & retry_count, & lock_error) success_flag = 0% END IF ! Display the record. PRINT colleges::college_name PRINT colleges::city END IF return_status = RDB$INTERPRET("END_STREAM coll_info" BY DESC) END IF END IF ! Commit the transaction if 'success' equals true ! otherwise, roll back the transaction. IF success_flag AND transaction_started THEN return_status = RDB$INTERPRET("COMMIT" BY DESC) ELSE return_status = RDB$INTERPRET("ROLLBACK" BY DESC) END IF NEXT return_status = RDB$INTERPRET("FINISH" BY DESC) RETURN Store_res: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! This subroutine demonstrates how to store a record with a field ! ! of data type SEGMENTED STRING. ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! PRINT FOR loop_cnt = 1% TO 24% PRINT "Store a resume" PRINT want_to_exit = 0% store_res_1: UNTIL want_to_exit ! Prompt user for the employee ID of the EMPLOYEES record that ! he or she wants to store. WHEN ERROR IN PRINT "Please enter the ID of the employee or press ^Z: "; INPUT employees::employee_id USE want_to_exit = -1% END WHEN EXIT store_res_1 IF want_to_exit file_ok = 0% UNTIL file_ok file_ok = -1% ! Prompt user for the file name of the resume to be stored. PRINT "Please enter file name of resume: "; INPUT resume_file WHEN ERROR IN OPEN resume_file FOR INPUT AS FILE 1% USE PRINT "File - ";resume_file;" - not found" file_ok = 0% END WHEN NEXT &RDB& START_TRANSACTION READ_WRITE RESERVING RESUMES FOR SHARED WRITE ! Create a segmented string to hold the values from the specified file. &RDB& CREATE_SEGMENTED_STRING resume_id eof_flag = 0% Res_read: UNTIL eof_flag resume_line = "" WHEN ERROR IN INPUT LINE #1%, resume_line USE eof_flag = -1% END WHEN EXIT Res_read IF eof_flag resume_line = EDIT$(resume_line,4%) &RDB& STORE R IN resume_id USING R.RDB$VALUE = &RDB& resume_line END_STORE NEXT CLOSE #1% &RDB& END_SEGMENTED_STRING resume_id ! Store the new record by supplying the segmented string handle from ! the CREATE_SEGMENTED_STRING statement as the object of the segmented ! string assignment statement. &RDB& STORE R IN RESUMES USING &RDB& R.EMPLOYEE_ID = employees::employee_id; &RDB& R.RESUME = resume_id &RDB& END_STORE &RDB& COMMIT NEXT RETURN