/* Copyright © Oracle Corporation 1995. All Rights Reserved. */ SAMPLE: PROCEDURE OPTIONS (MAIN); /************************************************************************/ /* This is the main program which calls all the sample Callable RDO */ /* procedures together. It allows the user to choose among serveral */ /* actions on the database. */ /* */ /* To create an executable image of all the modules, enter the */ /* following commands: */ /* */ /* $ PLI PLI_sample */ /* $ PLI PLI_call_other */ /* */ /* $ link PLI_sample, PLI_call_other */ /* */ /* $ run PLI_sample */ /************************************************************************/ /* Declare variables to hold field values. */ DECLARE LAST_NAME CHARACTER(14); DECLARE FIRST_NAME CHARACTER(10) ; DECLARE MIDDLE_INITIAL CHARACTER(1); DECLARE ADDRESS_DATA_1 CHARACTER(25) ; DECLARE ADDRESS_DATA_2 CHARACTER(25) ; DECLARE CITY CHARACTER(20) ; DECLARE STATE CHARACTER(2) ; DECLARE POSTAL_CODE CHARACTER(5) ; DECLARE SEX CHARACTER(1) ; DECLARE STATUS_CODE CHARACTER(1) ; DECLARE CANDIDATE_STATUS CHARACTER(255), status_length FIXED BINARY(15); DECLARE COLLEGE_NAME CHARACTER(25) ; DECLARE COLLEGE_CODE CHARACTER(4); DECLARE employee_id CHARACTER(5); DECLARE ascii_bday CHARACTER(23); DECLARE db_key_array (5) CHARACTER(8); /* Declare variables that control program logic. */ DECLARE continue CHARACTER(1); DECLARE correct CHARACTER(1); DECLARE change CHARACTER(1); DECLARE succeed BIT; DECLARE leave BIT; DECLARE status FIXED BINARY(31); DECLARE option FIXED BINARY(31); DECLARE err FIXED BINARY(31) EXTERNAL; DECLARE retry FIXED BINARY(15) EXTERNAL; DECLARE (i,x,new_count) FIXED BINARY(31); DECLARE see_all CHARACTER(1); /* Declare variables to hold RDO statements and return status. */ DECLARE RDB_COMMAND CHARACTER(1024) VARYING, GET_COMMAND CHARACTER(128), FETCH_COMMAND CHARACTER(10); DECLARE RDB_STATUS FIXED BINARY(31), /* status value */ 1 RDB_STATUS_FIELDS BASED (ADDR(RDB_STATUS)), 2 RDB_STATUS_SUCCESS BIT(1), /* low-order bit */ 2 RDB_STATUS_REST BIT(31); /* bits 1 through 32 */ DECLARE NRDB_COMMAND CHARACTER(1024) VARYING, NGET_COMMAND CHARACTER(128), NFETCH_COMMAND CHARACTER(10); DECLARE NRDB_STATUS FIXED BINARY(31), /* status value */ 1 NRDB_STATUS_FIELDS BASED (ADDR(NRDB_STATUS)), 2 NRDB_STATUS_SUCCESS BIT(1), /* low-order bit */ 2 NRDB_STATUS_REST BIT(31); /* bits 1 through 32 */ /* Declare system service and Run-Time Library routines and asssociated */ /* variables. */ DECLARE LIB$MATCH_COND EXTERNAL ENTRY (ANY,ANY,ANY,ANY,ANY,ANY,ANY,ANY,ANY) OPTIONS (VARIABLE) RETURNS (FIXED BINARY(15)); DECLARE SYS$GETMSG ENTRY (ANY VALUE,ANY,ANY,ANY VALUE,ANY VALUE) OPTIONS (VARIABLE) RETURNS (FIXED BINARY(31)); DECLARE RDB$INTERPRET ENTRY (ANY,ANY,ANY,ANY,ANY,ANY,ANY,ANY,ANY,ANY,ANY,ANY,ANY) OPTIONS (VARIABLE) RETURNS (FIXED BINARY(31)); DECLARE RDB$SIGNAL EXTERNAL ENTRY (); DECLARE LIB$WAIT EXTERNAL ENTRY (ANY VALUE) RETURNS (FIXED BINARY(31)); DECLARE LIB$CALLG EXTERNAL ENTRY (ANY,ANY VALUE) RETURNS (FIXED BINARY(31)); DECLARE SYS$PUTMSG EXTERNAL ENTRY (ANY); DECLARE SYS$ASCTIM EXTERNAL ENTRY (ANY VALUE, ANY, ANY, ANY VALUE); DECLARE sstart_date CHARACTER(30), sbinary_time BYTE_FIELD(8); /* Declare symbolic error codes. */ DECLARE (RDB$_STREAM_EOF, RDB$_NO_RECORD, RDB$_DEADLOCK, RDB$_BAD_SEGSTR_HANDLE, RDB$_LOCK_CONFLICT, RDB$_INTEG_FAIL, RDB$_NO_DUP, RDB$_NOT_VALID, RDO$_DATCONERR, RDO$_INDNOTDEF) GLOBALREF FIXED BINARY (31); /* Declare output file for error messages. */ DECLARE err_file FILE PRINT OUTPUT; HANDLE_ERROR: PROCEDURE; /************************************************************/ /* This procedure handles run-time errors trapped by the */ /* ON ERROR clause in the Callable RDO programs. */ /************************************************************/ %REPLACE SECONDS_TO_WAIT BY 5; DECLARE error FIXED BINARY (15); DECLARE string CHARACTER (132); DECLARE msg_string CHARACTER (132); DECLARE error_len FIXED BINARY (15); DECLARE lock_error BIT (1); msg_string = ' '; succeed = '0'B; /* Use LIB$MATCH_COND to determine which of a series of */ /* errors might have occurred. */ error = LIB$MATCH_COND (RDB_STATUS, ADDR (RDB$_DEADLOCK), ADDR (RDB$_LOCK_CONFLICT), ADDR (RDB$_NO_DUP), ADDR (RDB$_NOT_VALID), ADDR (RDB$_INTEG_FAIL), ADDR (RDB$_STREAM_EOF), ADDR (RDO$_DATCONERR), ADDR (RDB$_NO_RECORD)); /* The SELECT statement directs program to appropriate */ /* statements to execute depending on the error */ /* that was trapped. */ SELECT; /* Unexpected error */ WHEN (ERROR = 0) DO; OPEN FILE (err_file) TITLE ('error_file'); PUT SKIP LIST ('Unexpected error - terminating program'); err = SYS$GETMSG(RDB_STATUS, ADDR (error_len), DESCRIPTOR (msg_string), 0, 0); PUT SKIP FILE (err_file) LIST (msg_string); CALL RDB$SIGNAL(); CLOSE FILE (err_file); END; /* Deadlock or lock conflict */ WHEN (ERROR = 1, ERROR = 2) DO; IF (retry <= 4) THEN DO; PUT SKIP LIST ('Deadlock or Lock conflict error'); PUT SKIP LIST ('Others are using the data that'!! 'you want to access'); err = LIB$WAIT(SECONDS_TO_WAIT); END; ELSE DO; PUT SKIP LIST ('Sorry, resources are not available, '); PUT SKIP LIST ('please retry later'); END; END; /* Duplicates not allowed */ WHEN (ERROR = 3) DO; PUT SKIP LIST ('Duplicates are not allowed'); err = SYS$GETMSG(RDB_STATUS, ADDR (error_len), DESCRIPTOR (msg_string), 0, 0); PUT SKIP LIST (msg_string); END; /* Invalid data */ WHEN (ERROR = 4) DO; PUT SKIP LIST ('Invalid Data'); err = SYS$GETMSG(RDB_STATUS, ADDR (error_len), DESCRIPTOR (msg_string), 0, 0); PUT SKIP LIST (msg_string); END; /* Integrity failure */ WHEN (ERROR = 5) DO; PUT SKIP LIST ('Integrity failure'); err = SYS$GETMSG(RDB_STATUS, ADDR (error_len), DESCRIPTOR (msg_string), 0, 0); PUT SKIP LIST (msg_string); END; WHEN (ERROR = 6) DO; END; /* Invalid date */ WHEN (ERROR = 7) DO; PUT SKIP LIST ('Invalid Date'); err = SYS$GETMSG(RDB_STATUS, ADDR (error_len), DESCRIPTOR (msg_string), 0, 0); PUT SKIP LIST (msg_string); END; /* Record deleted */ WHEN (ERROR = 8) DO; PUT SKIP LIST ('A record entered during this session has been'); PUT SKIP LIST ('deleted'); END; OTHERWISE ERROR = ERROR; END; END; ADD_EMPLOYEES: PROCEDURE; /*****************************************************************/ /* This procedure adds a new EMPLOYEES record to the EMPLOYEES */ /* relation. */ /*****************************************************************/ /* Initialize variables. */ employee_id = '00000'; continue = 'N'; succeed = '1'B; ascii_bday = ' '; status = 0; err = 0; x = 0; see_all = 'N'; DO i = 1 TO 5; db_key_array(i) = ' '; END; /* do 1 = 1 to 5 */ i = 0; new_count = 0; /* Prompt user for input, until user enters 'exit' */ DO WHILE ((employee_id ^= 'exit') | (employee_id ^= 'EXIT')); DO WHILE ((continue = 'N') | (continue = 'n')); new_count = new_count + 1; PUT SKIP LIST ('Please enter the ID of the new employee or type exit'); GET LIST (employee_id); TEST: IF employee_id = 'exit' | employee_id = 'EXIT' THEN GOTO ENDER; PUT SKIP LIST ('Please enter the employees last name'); GET LIST (last_name); PUT SKIP LIST ('Please enter the employees first name'); GET LIST (first_name); PUT SKIP LIST ('Please enter the employees middle initial'); GET LIST (middle_initial); /* Prompt user to input date, keep prompting until user */ /* enters the date in the proper format. */ PUT SKIP LIST ('Please enter the employees birthday'); PUT SKIP LIST ('In this format: 14-AUG-1956 0:0:0.0'); GET LIST (ascii_bday); PUT SKIP LIST ('Please enter the employees sex'); GET LIST (sex); PUT SKIP LIST ('Please enter the Employees street address'); GET LIST (address_data_1); PUT SKIP LIST ('Please enter the employees apartment number, if any'); GET LIST (address_data_2); PUT SKIP LIST ('Please enter city'); GET LIST (city); PUT SKIP LIST ('Please enter state'); GET LIST (state); PUT SKIP LIST ('Please enter postal code'); GET LIST (postal_code); PUT SKIP LIST ('Please enter status code'); GET LIST (status_code); PUT SKIP LIST ('Have you entered all data correctly? (Y,N) '); GET LIST (continue); END; /* while continue = n */ /* Pass the START_TRANSACTION statement to RDB$INTERPRET. */ RDB_COMMAND = 'START_TRANSACTION READ_WRITE RESERVING ' !! ' EMPLOYEES FOR SHARED WRITE '; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; PUT SKIP LIST ('Progressing to STORE'); /* Store the values in the EMPLOYEES relation. */ RDB_COMMAND = 'STORE E IN EMPLOYEES USING ' !! ' E.EMPLOYEE_ID = !VAL; ' !! ' E.LAST_NAME = !VAL; ' !! ' E.FIRST_NAME = !VAL; ' !! ' E.MIDDLE_INITIAL = !VAL; ' !! ' E.BIRTHDAY = !VAL; ' !! ' E.SEX = !VAL; ' !! ' E.ADDRESS_DATA_1 = !VAL; ' !! ' E.ADDRESS_DATA_2 = !VAL; ' !! ' E.CITY = !VAL; ' !! ' E.STATE = !VAL; ' !! ' E.POSTAL_CODE = !VAL; ' !! ' E.STATUS_CODE = !VAL END_STORE;'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND), DESCRIPTOR (employee_id), DESCRIPTOR (last_name), DESCRIPTOR (first_name), DESCRIPTOR (middle_initial), /* RDB$INTERPRET does DATE conversion. */ DESCRIPTOR (ascii_bday), DESCRIPTOR (sex), DESCRIPTOR (address_data_1), DESCRIPTOR (address_data_2), DESCRIPTOR (city), DESCRIPTOR (state), DESCRIPTOR (postal_code), DESCRIPTOR (status_code)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; IF succeed THEN DO; RDB_COMMAND = 'START_STREAM ES USING ' !! 'E IN EMPLOYEES WITH E.EMPLOYEE_ID = !VAL'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND), DESCRIPTOR (employee_id)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; RDB_COMMAND = 'FETCH ES'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; /* Get the dbkey associated with the newly stored EMPLOYEES record. */ i = i + 1; RDB_COMMAND = 'GET !VAL = E.RDB$DB_KEY END_GET'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND), DESCRIPTOR (db_key_array(i))); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; RDB_COMMAND = 'END_STREAM ES'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; /* If the user wants to see all of the EMPLOYEES records */ /* added during this session, step through the array of */ /* dbkeys to find and print each new EMPLOYEES record. */ PUT SKIP LIST ('Successfully added employee: ',last_name); PUT SKIP LIST (' with employee id: ',employee_id); PUT SKIP LIST ('Do you want to see the names of all the'); PUT SKIP LIST ('employees entered during this session? (Y,N)'); GET LIST (see_all); IF see_all = 'Y' | see_all = 'y' THEN DO; DO x = 1 TO i; RDB_COMMAND = 'START_STREAM ED USING ' !! ' E IN EMPLOYEES WITH E.RDB$DB_KEY = !VAL'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND), DESCRIPTOR (db_key_array(x))); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; RDB_COMMAND = 'FETCH ED'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; RDB_COMMAND = 'GET !VAL = E.FIRST_NAME; ' !! '!VAL = E.LAST_NAME END_GET'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND), DESCRIPTOR (first_name), DESCRIPTOR (last_name)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; PUT SKIP LIST (first_name, ' ', last_name); RDB_COMMAND = 'END_STREAM ED'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; END; /* for x */ END; /* see_all */ RDB_COMMAND = 'COMMIT'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; END; /* succeed */ ELSE DO; PUT SKIP LIST ('Update operation failed, ',last_name); PUT SKIP LIST (' with employee ID: ',employee_id); PUT SKIP LIST (' has not been stored in the database'); RDB_COMMAND = 'ROLLBACK'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; END; /* else do for not success */ continue = 'n'; END; /* (employee_id ^= 'exit') */ ENDER: PUT SKIP; END ADD_EMPLOYEES; MODIFY_EMPLOYEES: PROCEDURE; /***************************************************************/ /* This procedure modifies the address of an EMPLOYEES record. */ /***************************************************************/ /* Initialize variables. */ employee_id = '00000'; last_name = 'NO'; continue = 'N'; correct = 'N'; succeed = '1'B; ascii_bday = ' '; status = 0; err = 0; x = 0; see_all = 'N'; DO i = 1 TO 5; db_key_array(i) = ' '; END; /* do 1 = 1 to 5 */ i = 0; new_count = 0; /* Prompt user for the ID of the employee whose record he or she */ /* wants to modify. */ DO WHILE ((employee_id ^= 'exit') | (employee_id ^= 'EXIT')); DO WHILE ((continue = 'N') | (continue = 'n')); new_count = new_count + 1; PUT SKIP LIST ('Please enter the ID of the Employee'); PUT SKIP LIST ('whose address you want to change or type exit'); GET LIST (employee_id); TEST: IF employee_id = 'exit' | employee_id = 'EXIT' THEN GOTO ENDER; /* Retrieve and display the record specified by the employee ID and */ /* confirm with the user that he or she wants to modify the record. */ RDB_COMMAND = 'START_TRANSACTION READ_ONLY RESERVING ' !! ' EMPLOYEES FOR SHARED READ '; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; RDB_COMMAND = 'START_STREAM ES USING ' !! 'E IN EMPLOYEES WITH E.EMPLOYEE_ID = !VAL'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND), DESCRIPTOR (employee_id)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; RDB_COMMAND = 'FETCH ES'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; RDB_COMMAND = 'GET !VAL = E.ADDRESS_DATA_1; ' !! '!VAL = E.ADDRESS_DATA_2; ' !! '!VAL = E.CITY; ' !! '!VAL = E.STATE; ' !! '!VAL = E.POSTAL_CODE END_GET;'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND), DESCRIPTOR (address_data_1), DESCRIPTOR (address_data_2), DESCRIPTOR (city), DESCRIPTOR (state), DESCRIPTOR (postal_code)); RDB_COMMAND = 'END_STREAM ES'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; RDB_COMMAND = 'ROLLBACK'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; IF (^succeed) THEN DO; PUT SKIP LIST ('No employees with that id number'); GOTO SKIP_MOD; END; PUT SKIP LIST (address_data_1); PUT SKIP LIST (address_data_2); PUT SKIP LIST (city); PUT SKIP LIST (state); PUT SKIP LIST (postal_code); PUT SKIP; PUT SKIP LIST ('Do you want to change this address? (Y,N) '); GET LIST (continue); change = continue; END; /* while continue = n */ IF change = 'Y' | change = 'y' THEN DO; DO WHILE ((correct = 'N') | (correct = 'n')); PUT SKIP LIST ('Please enter new street address'); GET LIST (address_data_1); PUT SKIP LIST ('Please enter new box number or apt number'); GET LIST (address_data_2); PUT SKIP LIST ('Please enter the city'); GET LIST (city); PUT SKIP LIST ('Please enter the state'); GET LIST (state); PUT SKIP LIST ('Please enter the postal code'); GET LIST (postal_code); PUT SKIP LIST ('Have you entered the address correctly? (Y,N) '); GET LIST (correct); END; /* do while correct */ END; /* do change */ RDB_COMMAND = 'START_TRANSACTION READ_WRITE RESERVING ' !! ' EMPLOYEES FOR SHARED WRITE '; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; /* Modify the address fields for the specified employee. */ RDB_COMMAND = 'START_STREAM ES USING ' !! 'E IN EMPLOYEES WITH E.EMPLOYEE_ID = !VAL'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND), DESCRIPTOR (employee_id)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; RDB_COMMAND = 'FETCH ES'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; RDB_COMMAND = 'MODIFY E USING' !! ' E.ADDRESS_DATA_1 = !VAL;' !! ' E.ADDRESS_DATA_2 = !VAL;' !! ' E.CITY = !VAL;' !! ' E.STATE = !VAL;' !! ' E.POSTAL_CODE = !VAL END_MODIFY;'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND), DESCRIPTOR (address_data_1), DESCRIPTOR (address_data_2), DESCRIPTOR (city), DESCRIPTOR (state), DESCRIPTOR (postal_code)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; RDB_COMMAND = 'END_STREAM ES'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; /* Notify the user of the success or failure of the MODIFY operation. */ IF succeed THEN DO; RDB_COMMAND = 'COMMIT'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; PUT SKIP LIST ('Update operation succeeded'); END; /* succeed */ ELSE DO; RDB_COMMAND = 'ROLLBACK'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; SKIP_MOD: PUT SKIP LIST ('Update operation failed'); END; /* else not succeed */ continue = 'n'; END; /* (employee_id ^= 'exit') */ ENDER: PUT SKIP; END MODIFY_EMPLOYEES; DELETE_RECORD: PROCEDURE; /*****************************************************/ /* This procedure deletes records from the database. */ /*****************************************************/ /* Declare variables. */ DECLARE key CHARACTER(8); DECLARE trans_1 FIXED BINARY(31) EXTERNAL; DECLARE req_1 FIXED BINARY(31) EXTERNAL; DECLARE found_emp BIT; DECLARE call_other EXTERNAL ENTRY (ANY, ANY); /* Initialize variables. */ trans_1 = 0; req_1 = 0; employee_id = '00000'; continue = 'N'; correct = 'N'; succeed = '1'B; ascii_bday = ' '; status = 0; err = 0; x = 0; see_all = 'N'; i = 0; new_count = 0; /* Prompt the user for the ID of the EMPLOYEES record */ /* that he or she wants to delete from the database. */ DO WHILE ((employee_id ^= 'exit') | (employee_id ^= 'EXIT')); DO WHILE ((continue = 'N') | (continue = 'n')); succeed = '1'B; PUT SKIP LIST ('Please enter the ID of the Employee'); PUT SKIP LIST ('you want to delete or type exit'); GET LIST (employee_id); TEST: IF employee_id = 'exit' | employee_id = 'EXIT' THEN GOTO ENDER; /* Find the record of the employee that the user wants to delete */ /* If an error occurs during the FOR operaton call an error handler. */ RDB_COMMAND = 'START_TRANSACTION (TRANSACTION_HANDLE !VAL) READ_ONLY '; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND), DESCRIPTOR (trans_1)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; found_emp = '0'B; /* Get the dbkey of the EMPLOYEES record */ /* that the user wants to delete. */ RDB_COMMAND = 'START_STREAM (TRANSACTION_HANDLE !VAL) ES USING ' !! 'E IN ' !! 'EMPLOYEES WITH E.EMPLOYEE_ID = !VAL'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND), DESCRIPTOR (trans_1), DESCRIPTOR (employee_id)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; RDB_COMMAND = 'FETCH ES'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; IF succeed THEN found_emp = '1'B; RDB_COMMAND = 'GET (TRANSACTION_HANDLE !VAL) !VAL = E.RDB$DB_KEY END_GET; '; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND), DESCRIPTOR (trans_1), DESCRIPTOR (key)); RDB_COMMAND = 'END_STREAM ES'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; /* 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 a Callable RDO program. */ IF found_emp THEN DO; CALL call_other (key, req_1); RDB_COMMAND = 'COMMIT (TRANSACTION_HANDLE !VAL)'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND), DESCRIPTOR (trans_1)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; PUT SKIP LIST ('Have you entered the ID correctly (Y,N)'); GET LIST (continue); END; /* found_emp */ ELSE DO; RDB_COMMAND = 'ROLLBACK (TRANSACTION_HANDLE !VAL)'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND), DESCRIPTOR (trans_1)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; PUT SKIP LIST (' No employee with ', employee_id, ' on file'); END; /* not found_emp */ END; /* while continue = n */ /* If the user wants to delete the EMPLOYEES record, */ /* then start a READ_WRITE transaction and delete */ /* the employee's record from all relations in */ /* which his 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 the many transactions failed, you would */ /* not be certain that the employee's records were */ /* deleted from all of the relations. */ RDB_COMMAND = 'START_TRANSACTION READ_WRITE ' !! ' RESERVING EMPLOYEES, SALARY_HISTORY, JOB_HISTORY, ' !! ' DEGREES, RESUMES FOR SHARED WRITE; '; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; IF succeed THEN DO; RDB_COMMAND = 'START_STREAM JS USING ' !! 'JH IN JOB_HISTORY WITH JH.EMPLOYEE_ID = !VAL'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND), DESCRIPTOR (employee_id)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; DO WHILE (succeed); RDB_COMMAND = 'FETCH JS'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; IF Succeed THEN DO; RDB_COMMAND = 'ERASE JH;'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; END; END; /* end while succeed */ succeed = '1'B; RDB_COMMAND = 'END_STREAM JS'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; RDB_COMMAND = 'START_STREAM SS USING ' !! 'SH IN SALARY_HISTORY WITH SH.EMPLOYEE_ID = !VAL'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND), DESCRIPTOR (employee_id)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; DO WHILE (succeed); RDB_COMMAND = 'FETCH SS'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; IF succeed THEN DO; RDB_COMMAND = 'ERASE SH;'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; END; END; /* end while succeed */ succeed = '1'B; RDB_COMMAND = 'END_STREAM SS'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; RDB_COMMAND = 'START_STREAM DS USING ' !! 'D IN DEGREES WITH D.EMPLOYEE_ID = !VAL'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND), DESCRIPTOR (employee_id)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; DO WHILE (succeed); RDB_COMMAND = 'FETCH DS'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; IF succeed THEN DO; RDB_COMMAND = 'ERASE D;'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; END; END; /* end while succeed */ succeed = '1'B; RDB_COMMAND = 'END_STREAM DS'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; RDB_COMMAND = 'START_STREAM RS USING ' !! 'R IN RESUMES WITH R.EMPLOYEE_ID = !VAL'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND), DESCRIPTOR (employee_id)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; DO WHILE (succeed); RDB_COMMAND = 'FETCH RS'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; IF succeed THEN DO; RDB_COMMAND = 'ERASE R;'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; END; END; /* end while succeed */ succeed = '1'B; RDB_COMMAND = 'END_STREAM RS'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; RDB_COMMAND = 'START_STREAM ES USING ' !! 'E IN EMPLOYEES WITH E.RDB$DB_KEY = !VAL'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND), DESCRIPTOR (key)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; RDB_COMMAND = 'FETCH ES'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; IF succeed THEN DO; RDB_COMMAND = 'ERASE E;'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; END; RDB_COMMAND = 'END_STREAM ES'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; END; /* end IF succeed after start_transaction */ IF succeed THEN DO; RDB_COMMAND = 'COMMIT'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; IF succeed THEN DO; PUT SKIP LIST ('Delete operation succeeded'); END; /* succeed */ ELSE DO; RDB_COMMAND = 'ROLLBACK'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); END; /* else on succeed */ END; /* succeed */ ELSE DO; RDB_COMMAND = 'ROLLBACK'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; PUT SKIP LIST ('Delete operation failed'); END; /* else not succeed */ continue = 'n'; END; /* (employee_id ^= 'exit') */ ENDER: PUT SKIP; req_1 = 0; END DELETE_RECORD; LIST_RECORD: PROCEDURE; /**************************************************************************/ /* This procedure lists all the employees and the colleges they attended. */ /**************************************************************************/ /* Declare variables. */ DECLARE degree CHARACTER(3); DECLARE degree_field CHARACTER(15); DECLARE found BIT; /* Initialize variables. */ err = 0; first_name = ' '; last_name = ' '; degree = ' '; degree_field = ' '; /* Start transaction. */ RDB_COMMAND = 'START_TRANSACTION READ_ONLY '; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; /* For each EMPLOYEES record that has a corresponding record in DEGREES, */ /* print the DEGREES record. */ RDB_COMMAND = 'START_STREAM ES USING E IN ' !! 'EMPLOYEES SORTED BY E.LAST_NAME'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; FETCH_COMMAND = 'FETCH ES'; RDB_COMMAND = 'GET !VAL = E.FIRST_NAME; ' !! '!VAL = E.EMPLOYEE_ID; ' !! '!VAL = E.LAST_NAME END_GET;'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (FETCH_COMMAND)); DO WHILE (RDB_STATUS_SUCCESS); RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND), DESCRIPTOR (first_name), DESCRIPTOR (employee_id), DESCRIPTOR (last_name)); found = '0'B; NRDB_COMMAND = 'START_STREAM DS USING D IN ' !! 'DEGREES WITH D.EMPLOYEE_ID = !VAL'; NRDB_STATUS = RDB$INTERPRET(DESCRIPTOR (NRDB_COMMAND), DESCRIPTOR (employee_id)); NFETCH_COMMAND = 'FETCH DS'; NRDB_COMMAND = 'GET !VAL = D.DEGREE; ' !! '!VAL = D.DEGREE_FIELD END_GET;'; NRDB_STATUS = RDB$INTERPRET(DESCRIPTOR (NFETCH_COMMAND)); DO WHILE (NRDB_STATUS_SUCCESS); NRDB_STATUS = RDB$INTERPRET(DESCRIPTOR (NRDB_COMMAND), DESCRIPTOR (degree), DESCRIPTOR (degree_field)); /* Print the names of the EMPLOYEES who have a record */ /* stored in the DEGREES relation. */ PUT SKIP LIST ('Name is: ', first_name, ' ', last_name); PUT SKIP LIST ('Degree is : ', degree); PUT SKIP LIST ('Degree field is: ',degree_field); found = '1'B; NRDB_STATUS = RDB$INTERPRET(DESCRIPTOR (NFETCH_COMMAND)); END; /* Do NFETCH */ NRDB_COMMAND = 'END_STREAM DS'; NRDB_STATUS = RDB$INTERPRET(DESCRIPTOR (NRDB_COMMAND)); IF (^NRDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; /* Print the records of the employees who do not have a record */ /* stored in the DEGREES relation. */ IF ^(found) THEN DO; PUT SKIP LIST (first_name, ' ', last_name); PUT SKIP LIST ('Does not have this information stored in the database'); END; /* if ^found */ RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (FETCH_COMMAND)); END; /* Do FETCH */ RDB_COMMAND = 'END_STREAM ES'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; RDB_COMMAND = 'ROLLBACK '; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; END LIST_RECORD; SENIORITY: PROCEDURE; /*************************************************************/ /* This procedure lists the employees in order of seniority. */ /*************************************************************/ RDB_COMMAND = 'START_TRANSACTION READ_ONLY '; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; /* The SALHIST stream was declared with a DECLARE_STREAM statement */ /* in the main program section, just after the DATABASE statement. */ /* The record selection expression in the DECLARE_STREAM statement */ /* specifies a stream of records by crossing the EMPLOYEES relation */ /* with a stream of records form the SALARY_HISTORY relation that */ /* have the value for SALARY_END 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_COMMAND = 'START_STREAM SALHIST '; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; FETCH_COMMAND = 'FETCH SALHIST'; RDB_COMMAND = 'GET !VAL = D_E.FIRST_NAME; ' !! '!VAL = D_SH.SALARY_START; ' !! '!VAL = D_E.LAST_NAME END_GET;'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (FETCH_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; DO WHILE (RDB_STATUS_SUCCESS); RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND), DESCRIPTOR (first_name), DESCRIPTOR (sbinary_time), DESCRIPTOR (last_name)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; /* Display the retrieved records; use SYS$ASCTIM to convert */ /* the date, which is stored in binary format. */ CALL SYS$ASCTIM( 0, descriptor(sstart_date), sbinary_time, 0); PUT SKIP LIST ('Name is: ', first_name, ' ', last_name); PUT SKIP LIST ('started work on: ', sstart_date); RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (FETCH_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; END; /* DO FETCH */ RDB_COMMAND = 'END_STREAM SALHIST'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; RDB_COMMAND = 'ROLLBACK '; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; END SENIORITY; PAIR: PROCEDURE; /**************************************************************/ /* This procedure demonstrates how to manipulate two streams. */ /* The output of the procedure is merely a random matching */ /* of each CANDIDATES record with an EMPLOYEES record. */ /**************************************************************/ /* Declare variables. */ DECLARE clast_name (100) CHARACTER(14); DECLARE cfirst_name (100) CHARACTER(10); DECLARE tot_cand FIXED BINARY(31); /* Initialize variables. */ i = 0; /* Start a stream of CANDIDATES records. */ RDB_COMMAND = 'START_STREAM CS USING C IN CANDIDATES '; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; FETCH_COMMAND = 'FETCH CS'; RDB_COMMAND = 'GET !VAL = C.FIRST_NAME; ' !! '!VAL = C.LAST_NAME END_GET;'; /* Fetch a CANDIDATES record. */ RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (FETCH_COMMAND)); /* Get a CANDIDATES record and assign it to an array of records. */ /* Keep fetching records until all the CANDIDATES records */ /* have been fetched. */ DO WHILE (RDB_STATUS_SUCCESS); i = i + 1; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND), DESCRIPTOR (cfirst_name(i)), DESCRIPTOR (clast_name(i))); RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (FETCH_COMMAND)); END; /* DO FETCH */ /* End the CANDIDATES stream. */ RDB_COMMAND = 'END_STREAM CS'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; tot_cand = i; /* Reinitialize the array counter. */ i = 0; /* Start a stream of EMPLOYEES records. Limit the stream */ /* to a number of EMPLOYEES records that is equal to the number */ /* of CANDIDATES records. */ RDB_COMMAND = 'START_STREAM ES USING FIRST !VAL E IN EMPLOYEES '; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND) , DESCRIPTOR (tot_cand)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; FETCH_COMMAND = 'FETCH ES'; RDB_COMMAND = 'GET !VAL = E.FIRST_NAME; ' !! '!VAL = E.LAST_NAME END_GET;'; /* Fetch an EMPLOYEES record. */ RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (FETCH_COMMAND)); /* Get an EMPLOYEES record until the */ /* end-of-stream condition is met. */ DO WHILE (RDB_STATUS_SUCCESS); i = i + 1; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND), DESCRIPTOR (first_name), DESCRIPTOR (last_name)); /* Print an EMPLOYEES name and a CANDIDATES name. */ PUT SKIP LIST (first_name, ' ',last_name, ' interviews ', cfirst_name(i), clast_name(i)); RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (FETCH_COMMAND)); END; /* DO FETCH */ /* End the EMPLOYEES stream. */ RDB_COMMAND = 'END_STREAM ES'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; RDB_COMMAND = 'COMMIT'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; END PAIR; STATS: PROCEDURE; /* This procedure displays the total number of records stored in the */ /* EMPLOYEES relation. */ /* Initialize variables. */ err = 0; RDB_COMMAND = 'START_TRANSACTION READ_ONLY '; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; /* Use the GET statement with a statistical function to calculate */ /* the total number of records in the EMPLOYEES relation. */ RDB_COMMAND = 'GET !VAL = COUNT OF E IN EMPLOYEES END_GET;'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND), DESCRIPTOR (I)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; /* Display the value. */ PUT SKIP LIST ('The number of employees in the Corporation is: ', I); RDB_COMMAND = 'ROLLBACK '; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; END STATS; STORE_CAND: PROCEDURE; /****************************************************************************/ /* This procedure stores a record in the CANDIDATES relation. It shows how */ /* to store a value in a field of data type VARYING STRING. */ /****************************************************************************/ /* Initialize variables.*/ continue = 'N'; succeed = '1'B; status = 0; err = 0; x = 0; i = 0; new_count = 0; candidate_status = ' '; status_length = 1; first_name = '00000'; /* Prompt the user for data to store in the CANDIDATES relation. */ DO WHILE ((first_name ^= 'exit') | (first_name ^= 'EXIT')); DO WHILE ((continue = 'N') | (continue = 'n')); new_count = new_count + 1; PUT SKIP LIST ('Please enter the first name of the candidate'!! ' or type exit'); GET LIST (first_name); TEST: IF first_name = 'exit' | first_name = 'EXIT' THEN GOTO ENDER; PUT SKIP LIST ('Please enter the middle initial of the candidate'); GET LIST (middle_initial); PUT SKIP LIST ('Please enter the last name of the candidate'); GET LIST (last_name); PUT SKIP LIST ('Please enter the candidate status information'); GET LIST (candidate_status); status_length = LENGTH(TRIM(candidate_status)); PUT SKIP LIST ('Have you entered the candidate info correctly? (Y,N) '); GET LIST (continue); END; /* while continue = n */ RDB_COMMAND = 'START_TRANSACTION READ_WRITE RESERVING ' !! ' CANDIDATES FOR SHARED WRITE '; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; /* Store the values specified by the user in the CANDIDATES relation. */ /* Trap for errors and inform the user of the success or failure of */ /* the STORE operation. */ RDB_COMMAND = 'STORE C IN CANDIDATES USING ' !! ' C.FIRST_NAME = !VAL; ' !! ' C.LAST_NAME = !VAL; ' !! ' C.MIDDLE_INITIAL = !VAL; ' !! ' C.CANDIDATE_STATUS = !VAL END_STORE;'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND), DESCRIPTOR (first_name), DESCRIPTOR (last_name), DESCRIPTOR (middle_initial), DESCRIPTOR (candidate_status)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; IF (succeed) THEN DO; RDB_COMMAND = 'COMMIT'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; PUT SKIP LIST ('Update operation succeeded'); END; /* succeed */ ELSE DO; RDB_COMMAND = 'ROLLBACK'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; PUT SKIP LIST ('Update operation failed'); END; /* else do for succees */ continue = 'n'; END; /* (first_name ^= 'exit') */ ENDER: PUT SKIP; END STORE_CAND; DISPLAY_CAND: PROCEDURE; /*************************************************************************/ /* This procedure displays a record from the CANDIDATES relation. */ /* It shows how to display a field stored as data type VARYING STRING. */ /*************************************************************************/ /* Initialize variables. */ continue = 'N'; succeed = '1'B; status = 0; err = 0; x = 0; i = 0; new_count = 0; candidate_status = ' '; status_length = 1; first_name = '00000'; RDB_COMMAND = 'START_TRANSACTION READ_ONLY RESERVING ' !! ' CANDIDATES FOR SHARED READ '; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; /* Prompt user for information needed to identify a record in the */ /* CANDIDATES relation. */ DO WHILE ((first_name ^= 'exit') | (first_name ^= 'EXIT')); DO WHILE ((continue = 'N') | (continue = 'n')); new_count = new_count + 1; PUT SKIP LIST ('Please enter the first name of the'!! 'candidate or type exit'); GET LIST (first_name); TEST: IF first_name = 'exit' | first_name = 'EXIT' THEN GOTO ENDER; PUT SKIP LIST ('Please enter the middle initial of the candidate'); GET LIST (middle_initial); PUT SKIP LIST ('Please enter the last name of the candidate'); GET LIST (last_name); PUT SKIP LIST ('Have you entered the candidate info correctly? (Y,N) '); GET LIST (continue); END; /* while continue = n */ /* 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_COMMAND = 'START_STREAM CS USING C IN ' !! 'CANDIDATES WITH C.FIRST_NAME CONTAINING !VAL AND ' !! 'C.MIDDLE_INITIAL CONTAINING !VAL AND ' !! 'C.LAST_NAME CONTAINING !VAL; '; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND), DESCRIPTOR (first_name), DESCRIPTOR (middle_initial), DESCRIPTOR (last_name)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; FETCH_COMMAND = 'FETCH CS'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (FETCH_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; IF succeed THEN DO; candidate_status = ' '; status_length = 1; RDB_COMMAND = 'GET !VAL = C.FIRST_NAME; ' !! '!VAL = C.MIDDLE_INITIAL; ' !! '!VAL = C.LAST_NAME; ' !! '!VAL = C.CANDIDATE_STATUS END_GET;'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND), DESCRIPTOR (first_name), DESCRIPTOR (middle_initial), DESCRIPTOR (last_name), DESCRIPTOR (candidate_status)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; PUT SKIP LIST (first_name, middle_initial, last_name ); PUT SKIP LIST ('has the following status: ', TRIM(candidate_status)); END; ELSE DO; PUT SKIP LIST (first_name, middle_initial, last_name ); PUT SKIP LIST ('has no status: '); END; RDB_COMMAND = 'END_STREAM CS'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; continue = 'n'; succeed = '1'B; END; /* (first_name ^= 'exit') */ ENDER: PUT SKIP; RDB_COMMAND = 'ROLLBACK '; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; END DISPLAY_CAND; FIND_MISSING: PROCEDURE; /* This procedure prints the employee ID of all employees in the */ /* DEGREES relation who do not have a value stored in the */ /* DEGREES_FIELD field. */ PUT SKIP LIST ('IDs of Employees in relation DEGREES with DEGREE_FIELD'); PUT SKIP LIST ('missing are:'); RDB_COMMAND = 'START_TRANSACTION READ_ONLY '; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; /* 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 field. */ RDB_COMMAND = 'START_STREAM DS USING D IN ' !! 'DEGREES WITH D.DEGREE_FIELD MISSING '; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; FETCH_COMMAND = 'FETCH DS'; RDB_COMMAND = 'GET !VAL = D.EMPLOYEE_ID END_GET;'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (FETCH_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; DO WHILE (RDB_STATUS_SUCCESS); RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND), DESCRIPTOR (employee_id)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; PUT SKIP LIST (employee_id); RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (FETCH_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; END; /* DO FETCH */ RDB_COMMAND = 'END_STREAM DS'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; RDB_COMMAND = 'ROLLBACK '; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; END FIND_MISSING; STORE_DEGREE: PROCEDURE; /****************************************************************/ /* This procedure demonstrates how to use the to mark a */ /* field as missing. */ /****************************************************************/ /* Declare variables. */ DECLARE coll_code CHARACTER(4); DECLARE degree CHARACTER(3); DECLARE field CHARACTER(15); DECLARE year FIXED BINARY(31); /* Initialize variables. */ continue = 'N'; succeed = '1'B; status = 0; err = 0; x = 0; i = 0; new_count = 0; employee_id = '00000'; DO WHILE ((employee_id ^= 'exit') | (employee_id ^= 'EXIT')); DO WHILE ((continue = 'N') | (continue = 'n')); new_count = new_count + 1; /* Prompt the user for values to store in the COLLEGES relation. */ PUT SKIP LIST ('Please enter employee ID number or type exit'); GET LIST (employee_id); TEST: IF employee_id = 'exit' | employee_id = 'EXIT' THEN GOTO ENDER; PUT SKIP LIST ('Please enter College Code'); GET LIST (coll_code); PUT SKIP LIST ('Please enter year degree was granted'); GET LIST (year); PUT SKIP LIST ('Please enter degree'); GET LIST (degree); /* Direct user to enter a question mark if he or she is uncertain of */ /* the DEGREE_FIELD field for the record being stored. */ PUT SKIP LIST ('Please enter field in which'); PUT SKIP LIST ('degree was granted. If unknown enter "?"'); GET LIST (field); PUT SKIP LIST ('Have you entered all data correctly? (Y,N) '); GET LIST (continue); END; /* while continue = n */ RDB_COMMAND = 'START_TRANSACTION READ_WRITE RESERVING ' !! ' DEGREES FOR SHARED WRITE '; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; /* If the user did not enter a question mark for the DEGREE_FIELD field */ /* then store the values given in all the fields. */ IF ^(field = '?') THEN DO; RDB_COMMAND = 'STORE D IN DEGREES USING ' !! ' D.EMPLOYEE_ID = !VAL; ' !! ' D.COLLEGE_CODE = !VAL; ' !! ' D.YEAR_GIVEN = !VAL; ' !! ' D.DEGREE = !VAL; ' !! ' D.DEGREE_FIELD = !VAL END_STORE;'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND), DESCRIPTOR (employee_id), DESCRIPTOR (coll_code), DESCRIPTOR (year), DESCRIPTOR (degree), DESCRIPTOR (field)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; END; /* field "?" */ /* If user entered "?" then do not store the degree field. */ /* The missing value will be returned when this record is */ /* printed. */ ELSE DO; RDB_COMMAND = 'STORE D IN DEGREES USING ' !! ' D.EMPLOYEE_ID = !VAL; ' !! ' D.COLLEGE_CODE = !VAL; ' !! ' D.YEAR_GIVEN = !VAL; ' !! ' D.DEGREE = !VAL END_STORE;'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND), DESCRIPTOR (employee_id), DESCRIPTOR (coll_code), DESCRIPTOR (year), DESCRIPTOR (degree)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; END; /* field = "?" */ IF (succeed) THEN DO; RDB_COMMAND = 'COMMIT'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; /* Inform the user of the success or failure of */ /* the update operation. */ PUT SKIP LIST ('Update operation succeeded'); END; /* succeed */ ELSE DO; RDB_COMMAND = 'ROLLBACK'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; PUT SKIP LIST ('Update operation failed'); END; /* else do for succees */ continue = 'n'; END; /* (employee_id ^= 'exit') */ ENDER: PUT SKIP; END STORE_DEGREE; MOD_RESUME: PROCEDURE; /*************************************************************/ /* This procedure demonstrates how to modify a record that */ /* contains a SEGMENTED STRING field. */ /*************************************************************/ /* Declare variables. */ DECLARE resume_segment1 CHARACTER(80) VARYING; DECLARE mfile_name CHARACTER(10) VARYING; DECLARE my_file FILE; DECLARE end_of_file BIT; /* Initialize variables. */ employee_id = '00000'; continue = 'N'; correct = 'N'; succeed = '1'B; resume_segment1 = ' '; end_of_file = '0'B; status = 0; err = 0; i = 0; /* Prompt the user for the employee ID of the RESUMES record he or */ /* she wants to modify. */ DO WHILE ((employee_id ^= 'exit') | (employee_id ^= 'EXIT')); DO WHILE ((continue = 'N') | (continue = 'n')); new_count = new_count + 1; PUT SKIP LIST ('Please enter the ID of the Employee'); PUT SKIP LIST ('whose resume you want to change or type exit'); GET LIST (employee_id); TEST: IF employee_id = 'exit' | employee_id = 'EXIT' THEN GOTO ENDER; /* Prompt the user for the new file name of the resume */ PUT SKIP LIST ('Please enter file name of new resume'); GET LIST (mfile_name); PUT SKIP; PUT SKIP LIST ('Have you entered all data correctly? (Y,N) '); GET LIST (continue); END; /* while continue = n */ OPEN FILE(my_file) TITLE(mfile_name) SEQUENTIAL; ON ENDFILE(my_file) end_of_file = '1'B; RDB_COMMAND = 'START_TRANSACTION READ_WRITE RESERVING ' !! ' RESUMES FOR SHARED WRITE '; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; RDB_COMMAND = 'CREATE_SEGMENTED_STRING RS_HANDLE;'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; READ FILE(my_file) INTO (resume_segment1); DO WHILE (^end_of_file); RDB_COMMAND = 'STORE L IN RS_HANDLE USING ' !! ' L.RDB$VALUE = !VAL END_STORE;'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND), DESCRIPTOR (TRIM(resume_segment1))); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; READ FILE(my_file) INTO (resume_segment1); END; /* do while not eof */ RDB_COMMAND = 'START_STREAM RE USING ' !! 'R IN RESUMES WITH R.EMPLOYEE_ID = !VAL'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND), DESCRIPTOR (employee_id)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; RDB_COMMAND = 'FETCH RE'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; RDB_COMMAND = 'MODIFY R USING' !! ' R.RESUME = RS_HANDLE END_MODIFY;'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; RDB_COMMAND = 'END_STREAM RE'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; RDB_COMMAND = 'END_SEGMENTED_STRING RS_HANDLE;'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF succeed THEN DO; RDB_COMMAND = 'COMMIT'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; PUT SKIP LIST ('Update operation succeeded'); END; /* succeed */ ELSE DO; RDB_COMMAND = 'ROLLBACK'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; PUT SKIP LIST ('Update operation failed'); END; /* else not succeed */ continue = 'n'; CLOSE FILE(my_file); END; /* (employee_id ^= 'exit') */ ENDER: PUT SKIP; END MOD_RESUME; DISPLAY_RESUME: PROCEDURE; /**********************************************************/ /* This procedure demonstrates how to retrieve a field of */ /* data type SEGMENTED STRING. */ /**********************************************************/ DECLARE resume_segment CHARACTER(80); /* Initialize variables. */ employee_id = '00000'; continue = 'N'; correct = 'N'; succeed = '1'B; status = 0; err = 0; resume_segment = ' '; see_all = 'N'; i = 0; DO WHILE ((employee_id ^= 'exit') | (employee_id ^= 'EXIT')); DO WHILE ((continue = 'N') | (continue = 'n')); new_count = new_count + 1; /* Prompt user to enter the ID of the employee whose */ /* resume that he or she wants to view. If the user */ /* enters 'exit' then exit the procedure. */ PUT SKIP LIST ('Please enter the ID of the Employee'); PUT SKIP LIST ('whose resume you want to display type exit'); GET LIST (employee_id); TEST: IF employee_id = 'exit' | employee_id = 'EXIT' THEN GOTO ENDER; PUT SKIP; PUT SKIP LIST ('Have you entered all data correctly? (Y,N) '); GET LIST (continue); END; /* While continue = n */ RDB_COMMAND = 'START_TRANSACTION READ_ONLY RESERVING ' !! ' RESUMES FOR SHARED READ '; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; /* Start a stream to retrieve the employee record(s) */ /* with the specified ID. */ RDB_COMMAND = 'START_STREAM RS USING ' !! 'RR IN RESUMES WITH RR.EMPLOYEE_ID = !VAL'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND), DESCRIPTOR (employee_id)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; RDB_COMMAND = 'FETCH RS'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; /* Use a START_SEGMENTED_STRING statement to retrieve */ /* the individual segements that comprise the segmented */ /* string. */ NRDB_COMMAND = 'START_SEGMENTED_STRING LS USING L IN RR.RESUME '; NRDB_STATUS = RDB$INTERPRET(DESCRIPTOR (NRDB_COMMAND)); IF (^NRDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; NRDB_COMMAND = 'GET !VAL = L.RDB$VALUE; END_GET; '; NRDB_STATUS = RDB$INTERPRET(DESCRIPTOR (NRDB_COMMAND), DESCRIPTOR (resume_segment)); DO WHILE (NRDB_STATUS = 1); PUT SKIP LIST (TRIM(resume_segment)); resume_segment = ' '; NRDB_COMMAND = 'GET !VAL = L.RDB$VALUE END_GET; '; NRDB_STATUS = RDB$INTERPRET(DESCRIPTOR (NRDB_COMMAND), DESCRIPTOR (resume_segment)); END; /* NRDB_STATUS = 1 */ NRDB_COMMAND = 'END_SEGMENTED_STRING LS'; NRDB_STATUS = RDB$INTERPRET(DESCRIPTOR (NRDB_COMMAND)); IF (^NRDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; RDB_COMMAND = 'END_STREAM RS'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; RDB_COMMAND = 'COMMIT'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; continue = 'n'; END; /* (employee_id ^= 'exit') */ ENDER: PUT SKIP; END DISPLAY_RESUME; DDL_STMNT: PROCEDURE; /*********************************************************************/ /* This procedure demonstrates how to perform data definition tasks. */ /*********************************************************************/ DECLARE literal CHARACTER(100); /* Initialize variables. */ employee_id = '00000'; continue = 'N'; correct = 'N'; succeed = '1'B; status = 0; err = 0; i = 0; DO WHILE ((literal ^= 'exit') | (literal ^= 'EXIT')); DO WHILE ((continue = 'N') | (continue = 'n')); /* 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 within a program environment. */ PUT SKIP; PUT SKIP; PUT SKIP LIST ('Please enter the data definition statement to define'); PUT SKIP LIST (' or delete a temporary index, or type exit'); PUT SKIP LIST ('For example, to define an index for EMPLOYEES based'); PUT SKIP LIST (' on EMPLOYEE_ID, you might enter: '); PUT SKIP LIST ('define index emp_employee_id for employees. employee_id.' ); PUT SKIP LIST (' end index. NOTE: ENCLOSE IN SINGLE QUOTES'); PUT SKIP LIST ('To delete this index, you might enter: '); PUT SKIP LIST (' delete index emp_employee_id.'); PUT SKIP; GET LIST (literal); TEST: IF literal = 'exit' | literal = 'EXIT' THEN GOTO ENDER; PUT SKIP; PUT SKIP LIST ('Did you enter the definition correctly (Y,N)'); GET LIST (continue); PUT SKIP; END; /* while continue = n */ /* Start a READ_WRITE transaction. */ RDB_COMMAND = 'START_TRANSACTION READ_WRITE; '; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; RDB_COMMAND = literal; /* Pass the data definition statement specified by the user to */ /* RDB$INTERPRET. */ RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; /* Inform the user of the success or failure of the data definition */ /* task. */ IF succeed THEN DO; RDB_COMMAND = 'COMMIT'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; PUT SKIP LIST ('Operation succeeded'); END; /* succeed */ ELSE DO; RDB_COMMAND = 'ROLLBACK'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; PUT SKIP LIST ('Operation failed'); END; /* else not succeed */ continue = 'n'; END; /* (literal ^= 'exit') */ ENDER: PUT SKIP; END DDL_STMNT; CALLABLE: PROCEDURE; /***********************************************************/ /* This procedure displays the information from a COLLEGES */ /* record when the user specifies a college code. */ /***********************************************************/ /* Initialize variables. */ err = 0; college_code = ' '; continue = 'N'; DO WHILE ((college_code ^= 'exit') | (college_code ^= 'EXIT')); DO WHILE ((continue = 'N') | (continue = 'n')); /* Prompt user for input. */ PUT SKIP; PUT SKIP LIST ('Please enter the college code of the college'); GET LIST (college_code); TEST: IF college_code = 'exit' | college_code = 'EXIT' THEN GOTO ENDER; PUT SKIP; PUT SKIP LIST ('Did you enter the code correctly (Y,N)'); GET LIST (continue); PUT SKIP; END; /* while continue = n */ /* Start a READ_ONLY transaction. */ RDB_COMMAND = 'START_TRANSACTION READ_ONLY '; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; /* Start a stream of COLLEGES records that contain */ /* the code entered by the user. */ RDB_COMMAND = 'START_STREAM CS USING C IN ' !! 'COLLEGES WITH C.COLLEGE_CODE = !VAL'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND), DESCRIPTOR (COLLEGE_CODE)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; FETCH_COMMAND = 'FETCH CS'; RDB_COMMAND = 'GET !VAL = C.COLLEGE_NAME; ' !! '!VAL = C.CITY; ' !! '!VAL = C.STATE; ' !! '!VAL = C.POSTAL_CODE END_GET;'; /* Fetch the record. */ RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (FETCH_COMMAND)); /* Display the information. */ DO WHILE (RDB_STATUS_SUCCESS); RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND), DESCRIPTOR (college_name), DESCRIPTOR (city), DESCRIPTOR (state), DESCRIPTOR (postal_code)); PUT SKIP LIST ('College is: ', college_name); PUT SKIP LIST ('College city is: ', city); PUT SKIP LIST ('College state is: ', state); PUT SKIP LIST ('Postal code is: ', postal_code); RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (FETCH_COMMAND)); END; /* DO FETCH */ RDB_COMMAND = 'END_STREAM CS'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; RDB_COMMAND = 'ROLLBACK '; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; continue = 'n'; END; /* college_code ^exit */ ENDER: PUT SKIP; END CALLABLE; STORE_RES: PROCEDURE; /**********************************************************/ /* This procedure demonstrates how to store a record with */ /* a field of data type SEGMENTED STRING. */ /**********************************************************/ DECLARE resume_segment1 CHARACTER(80) VARYING; DECLARE mfile_name CHARACTER(10) VARYING; DECLARE my_file FILE; DECLARE end_of_file BIT; /* Initialize variables. */ employee_id = '00000'; continue = 'N'; correct = 'N'; succeed = '1'B; resume_segment1 = ' '; end_of_file = '0'B; status = 0; err = 0; i = 0; /* Prompt the user for the employee ID of the RESUMES record he or */ /* she wants to modify. */ DO WHILE ((employee_id ^= 'exit') | (employee_id ^= 'EXIT')); DO WHILE ((continue = 'N') | (continue = 'n')); new_count = new_count + 1; PUT SKIP LIST ('Please enter the ID of the new Employee'!! 'or type exit'); GET LIST (employee_id); TEST: IF employee_id = 'exit' | employee_id = 'EXIT' THEN GOTO ENDER; PUT SKIP LIST ('Please enter file name of new resume'); GET LIST (mfile_name); PUT SKIP; PUT SKIP LIST ('Have you entered all data correctly? (Y,N) '); GET LIST (continue); END; /* while continue = n */ OPEN FILE(my_file) TITLE(mfile_name) SEQUENTIAL; ON ENDFILE(my_file) end_of_file = '1'B; RDB_COMMAND = 'START_TRANSACTION READ_WRITE RESERVING ' !! ' RESUMES FOR SHARED WRITE '; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; RDB_COMMAND = 'CREATE_SEGMENTED_STRING RS_HANDLE;'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; READ FILE(my_file) INTO (resume_segment1); DO WHILE (^end_of_file); RDB_COMMAND = 'STORE L IN RS_HANDLE USING ' !! ' L.RDB$VALUE = !VAL END_STORE;'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND), DESCRIPTOR (TRIM(resume_segment1))); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; READ FILE(my_file) INTO (resume_segment1); END; /* do while not eof */ RDB_COMMAND = 'STORE RE IN RESUMES USING ' !! ' RE.RESUME = RS_HANDLE;' !! ' RE.EMPLOYEE_ID = !VAL END_STORE;'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND), DESCRIPTOR (employee_id)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; RDB_COMMAND = 'END_SEGMENTED_STRING RS_HANDLE;'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF succeed THEN DO; RDB_COMMAND = 'COMMIT'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; PUT SKIP LIST ('Update operation succeeded'); END; /* succeed */ ELSE DO; RDB_COMMAND = 'ROLLBACK'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; PUT SKIP LIST ('Update operation failed'); END; /* else not succeed */ continue = 'n'; CLOSE FILE(my_file); END; /* (employee_id ^= 'exit') */ ENDER: PUT SKIP; END STORE_RES; /* main */ RDB_COMMAND = 'DATABASE FILENAME "MF_PERSONNEL"'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; /* Declare the stream used in the seniority procedure. */ RDB_COMMAND = 'DECLARE_STREAM SALHIST USING D_SH IN ' !! 'SALARY_HISTORY CROSS D_E IN EMPLOYEES ' !! 'OVER EMPLOYEE_ID SORTED BY ASCENDING D_SH.SALARY_START'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; RDB_COMMAND = 'COMMIT'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; leave = '0'B; DO WHILE (^leave); PUT SKIP LIST (' Main Menu'); PUT SKIP LIST (' Sample Application'); PUT SKIP; PUT SKIP LIST ('1. Add one or more records to EMPLOYEES'); PUT SKIP LIST ('2. Modify the address of one or more records in EMPLOYEES'); PUT SKIP LIST ('3. Delete one or more records from EMPLOYEES'); PUT SKIP LIST ('4. List all the Employee(s) and college(s) attended'); PUT SKIP LIST ('5. List Employees in order of Seniority'); PUT SKIP LIST ('6. Pair an EMPLOYEES record with a CANDIDATES record'); PUT SKIP LIST ('7. Calculate the total number of Employees in the Company'); PUT SKIP LIST ('8. Store one or more records in the CANDIDATES relation'); PUT SKIP LIST ('9. Display one or more records from CANDIDATES'); PUT SKIP LIST ('10. Display Employee IDs of Employees in DEGREES with'); PUT SKIP LIST (' an unknown area of study'); PUT SKIP LIST ('11. Store a record in DEGREES'); PUT SKIP LIST ('12. Modify a resume in RESUMES'); PUT SKIP LIST ('13. Display a resume'); PUT SKIP LIST ('14. Add or delete a temporary index'); PUT SKIP LIST ('15. Display COLLEGES information'); PUT SKIP LIST ('16. Store a RESUME'); PUT SKIP LIST ('99. Exit the Program'); PUT SKIP; PUT SKIP; PUT SKIP; PUT SKIP LIST ('Please enter an option number and press RETURN'); GET LIST (option); SELECT; WHEN (option = 1) CALL add_employees; WHEN (option = 2) CALL modify_employees; WHEN (option = 3) CALL delete_record; WHEN (option = 4) CALL list_record; WHEN (option = 5) CALL seniority; WHEN (option = 6) CALL pair; WHEN (option = 7) CALL stats; WHEN (option = 8) CALL store_cand; WHEN (option = 9) CALL display_cand; WHEN (option = 10) CALL find_missing; WHEN (option = 11) CALL store_degree; WHEN (option = 12) CALL mod_resume; WHEN (option = 13) CALL display_resume; WHEN (option = 14) CALL ddl_stmnt; WHEN (option = 15) CALL callable; WHEN (option = 16) CALL store_res; WHEN (option = 99) leave = '1'B; OTHERWISE option = option; END; /* select */ END; /* do while leave */ RDB_COMMAND = 'FINISH'; RDB_STATUS = RDB$INTERPRET(DESCRIPTOR (RDB_COMMAND)); IF (^RDB_STATUS_SUCCESS) THEN CALL HANDLE_ERROR; END SAMPLE;