| GLOBALS |
| "d4_globals.4gl" |
| |
| FUNCTION print_labels() |
| DEFINE where_part CHAR(500), |
| query_text CHAR(500), |
| msg CHAR(50), |
| file_name CHAR(20) |
| |
| OPTIONS |
| FORM LINE 7 |
| OPEN FORM customer FROM "custform" |
| DISPLAY FORM customer |
| ATTRIBUTE(MAGENTA) |
| CALL fgl_drawbox(3,32,3,42) |
| CALL fgl_drawbox(3,61,8,7) |
| CALL fgl_drawbox(11,61,8,7) |
| CALL clear_menu() |
| DISPLAY "CUSTOMER LABELS:" AT 1,1 |
| MESSAGE "Use query-by-example to select customer list" |
| CONSTRUCT BY NAME where_part ON customer.* |
| IF int_flag THEN |
| LET int_flag = FALSE |
| ERROR "Label print request aborted" ATTRIBUTE(RED, REVERSE) |
| RETURN |
| END IF |
| MESSAGE "" |
| LET query_text = "select * from customer where ", where_part CLIPPED, |
| " order by zipcode" |
| PREPARE label_st FROM query_text |
| DECLARE label_list CURSOR FOR label_st |
| CASE (print_option) |
| WHEN "f" |
| PROMPT " Enter file name for labels >" FOR file_name |
| IF file_name IS NULL THEN |
| LET file_name = "labels.out" |
| END IF |
| MESSAGE "Printing mailing labels to ", file_name CLIPPED, |
| " -- Please wait" |
| START REPORT labels_report TO file_name |
| WHEN "p" |
| MESSAGE "Printing mailing labels -- Please wait" |
| START REPORT labels_report TO PRINTER |
| WHEN "s" |
| START REPORT labels_report |
| CLEAR SCREEN |
| END CASE |
| FOREACH label_list INTO p_customer.* |
| OUTPUT TO REPORT labels_report (p_customer.*) |
| IF int_flag THEN |
| LET int_flag = FALSE |
| EXIT FOREACH |
| END IF |
| END FOREACH |
| FINISH REPORT labels_report |
| IF int_flag THEN |
| LET int_flag = FALSE |
| ERROR "Label printing aborted" ATTRIBUTE (RED, REVERSE) |
| RETURN |
| END IF |
| CLOSE FORM customer |
| OPTIONS |
| FORM LINE 3 |
| END FUNCTION |
| |
| FUNCTION customer() |
| |
| OPTIONS |
| FORM LINE 7 |
| OPEN FORM customer FROM "custform" |
| DISPLAY FORM customer |
| ATTRIBUTE(MAGENTA) |
| CALL ring_menu() |
| CALL fgl_drawbox(3,32,3,42) |
| CALL fgl_drawbox(3,61,8,7) |
| CALL fgl_drawbox(11,61,8,7) |
| LET p_customer.customer_num = NULL |
| MENU "CUSTOMER" |
| COMMAND "One-add" "Add a new customer to the database" HELP 201 |
| CALL unring_menu() |
| CALL add_customer(FALSE) |
| call ring_menu () |
| COMMAND "Many-add" "Add several new customers to database" HELP 202 |
| CALL unring_menu() |
| CALL add_customer(TRUE) |
| call ring_menu () |
| COMMAND "Find-cust" "Look up specific customer" HELP 203 |
| call unring_menu () |
| IF query_customer(23) THEN |
| call ring_menu () |
| NEXT OPTION "Update-cust" |
| END IF |
| call ring_menu () |
| COMMAND "Update-cust" "Modify current customer information" HELP 204 |
| CALL unring_menu() |
| CALL update_customer() |
| call ring_menu () |
| NEXT OPTION "Find-cust" |
| COMMAND "Delete-cust" "Remove a customer from database" HELP 205 |
| CALL unring_menu() |
| CALL delete_customer() |
| call ring_menu () |
| NEXT OPTION "Find-cust" |
| COMMAND "Exit" "Return to MAIN Menu" HELP 206 |
| CLEAR SCREEN |
| EXIT MENU |
| END MENU |
| OPTIONS |
| FORM LINE 3 |
| END FUNCTION |
| |
| |
| FUNCTION add_customer(repeat) |
| DEFINE repeat INTEGER |
| |
| CALL clear_menu() |
| MESSAGE "Press F1 or CTRL-F for field help; ", |
| "F2 or CTRL-Y to return to menu" |
| IF repeat THEN |
| WHILE input_cust() |
| ERROR "Customer data entered" ATTRIBUTE (GREEN) |
| END WHILE |
| CALL mess("Multiple insert completed - current screen values ignored", 23) |
| ELSE |
| IF input_cust() THEN |
| ERROR "Customer data entered" ATTRIBUTE (GREEN) |
| ELSE |
| CLEAR FORM |
| LET p_customer.customer_num = NULL |
| ERROR "Customer addition aborted" ATTRIBUTE (RED, REVERSE) |
| END IF |
| END IF |
| END FUNCTION |
| |
| |
| FUNCTION input_cust() |
| |
| DISPLAY "Press ESC to enter new customer data" AT 1,1 |
| INPUT BY NAME p_customer.* |
| AFTER FIELD state |
| CALL statehelp() |
| DISPLAY "Press ESC to enter new customer data", "" AT 1,1 |
| ON KEY (F1, CONTROL-F) |
| CALL customer_help() |
| ON KEY (F2, CONTROL-Y) |
| LET int_flag = TRUE |
| EXIT INPUT |
| END INPUT |
| IF int_flag THEN |
| LET int_flag = FALSE |
| RETURN(FALSE) |
| END IF |
| LET p_customer.customer_num = 0 |
| INSERT INTO customer VALUES (p_customer.*) |
| LET p_customer.customer_num = SQLCA.SQLERRD[2] |
| DISPLAY BY NAME p_customer.customer_num ATTRIBUTE(MAGENTA) |
| RETURN(TRUE) |
| END FUNCTION |
| |
| |
| FUNCTION query_customer(mrow) |
| DEFINE where_part CHAR(500), |
| query_text CHAR(500), |
| answer CHAR(1), |
| mrow, chosen, exist SMALLINT |
| |
| CLEAR FORM |
| CALL clear_menu() |
| |
| MESSAGE "Enter criteria for selection" |
| CONSTRUCT where_part ON customer.* FROM customer.* |
| MESSAGE "" |
| IF int_flag THEN |
| LET int_flag = FALSE |
| CLEAR FORM |
| ERROR "Customer query aborted" ATTRIBUTE(RED, REVERSE) |
| LET p_customer.customer_num = NULL |
| RETURN (p_customer.customer_num) |
| END IF |
| LET query_text = "select * from customer where ", where_part CLIPPED, |
| " order by lname" |
| PREPARE statement_1 FROM query_text |
| DECLARE customer_set SCROLL CURSOR FOR statement_1 |
| |
| OPEN customer_set |
| FETCH FIRST customer_set INTO p_customer.* |
| IF status = NOTFOUND THEN |
| LET exist = FALSE |
| ELSE |
| LET exist = TRUE |
| DISPLAY BY NAME p_customer.* ATTRIBUTE(MAGENTA) |
| MENU "BROWSE" |
| COMMAND "Next" "View the next customer in the list" |
| FETCH NEXT customer_set INTO p_customer.* |
| IF status = NOTFOUND THEN |
| ERROR "No more customers in this direction" ATTRIBUTE(RED, REVERSE) |
| FETCH LAST customer_set INTO p_customer.* |
| END IF |
| DISPLAY BY NAME p_customer.* ATTRIBUTE(MAGENTA) |
| COMMAND "Previous" "View the previous customer in the list" |
| FETCH PREVIOUS customer_set INTO p_customer.* |
| IF status = NOTFOUND THEN |
| ERROR "No more customers in this direction" ATTRIBUTE(RED, REVERSE) |
| FETCH FIRST customer_set INTO p_customer.* |
| END IF |
| DISPLAY BY NAME p_customer.* ATTRIBUTE(MAGENTA) |
| COMMAND "First" "View the first customer in the list" |
| FETCH FIRST customer_set INTO p_customer.* |
| DISPLAY BY NAME p_customer.* ATTRIBUTE(MAGENTA) |
| COMMAND "Last" "View the last customer in the list" |
| FETCH LAST customer_set INTO p_customer.* |
| DISPLAY BY NAME p_customer.* ATTRIBUTE(MAGENTA) |
| COMMAND "Select" "Exit BROWSE selecting the current customer" |
| LET chosen = TRUE |
| EXIT MENU |
| COMMAND "Quit" "Quit BROWSE without selecting a customer" |
| LET chosen = FALSE |
| EXIT MENU |
| END MENU |
| END IF |
| CLOSE customer_set |
| |
| CALL clear_menu() |
| IF NOT exist THEN |
| CLEAR FORM |
| CALL mess("No customer satisfies query", mrow) |
| LET p_customer.customer_num = NULL |
| RETURN (FALSE) |
| END IF |
| IF NOT chosen THEN |
| CLEAR FORM |
| LET p_customer.customer_num = NULL |
| CALL mess("No selection made", mrow) |
| RETURN (FALSE) |
| END IF |
| RETURN (TRUE) |
| END FUNCTION |
| |
| |
| FUNCTION update_customer() |
| |
| CALL clear_menu() |
| IF p_customer.customer_num IS NULL THEN |
| ERROR "No customer has been selected; use the Find-cust option" |
| ATTRIBUTE (RED, REVERSE) |
| RETURN |
| END IF |
| MESSAGE "Press F1 or CTRL-F for field-level help" |
| DISPLAY "Press ESC to update customer data; DEL to abort" AT 1,1 |
| INPUT BY NAME p_customer.* WITHOUT DEFAULTS |
| AFTER FIELD state |
| CALL statehelp() |
| DISPLAY "Press ESC to update customer data; DEL to abort", "" AT 1,1 |
| ON KEY (F1, CONTROL-F) |
| CALL customer_help() |
| END INPUT |
| IF NOT int_flag THEN |
| UPDATE customer SET customer.* = p_customer.* |
| WHERE customer_num = p_customer.customer_num |
| CALL mess("Customer data modified", 23) |
| ELSE |
| LET int_flag = FALSE |
| SELECT * INTO p_customer.* FROM customer |
| WHERE customer_num = p_customer.customer_num |
| DISPLAY BY NAME p_customer.* ATTRIBUTE(MAGENTA) |
| ERROR "Customer update aborted" ATTRIBUTE (RED, REVERSE) |
| END IF |
| END FUNCTION |
| |
| |
| FUNCTION delete_customer() |
| DEFINE answer CHAR(1), |
| num_orders INTEGER |
| |
| CALL clear_menu() |
| IF p_customer.customer_num IS NULL THEN |
| ERROR "No customer has been selected; use the Find-cust option" |
| ATTRIBUTE (RED, REVERSE) |
| RETURN |
| END IF |
| |
| SELECT COUNT(*) INTO num_orders |
| FROM orders |
| WHERE customer_num = p_customer.customer_num |
| IF num_orders THEN |
| ERROR "This customer has active orders and can not be removed" |
| ATTRIBUTE (RED, REVERSE) |
| RETURN |
| END IF |
| |
| PROMPT " Are you sure you want to delete this customer row? " |
| FOR CHAR answer |
| IF answer MATCHES "[yY]" THEN |
| DELETE FROM customer |
| WHERE customer_num = p_customer.customer_num |
| CLEAR FORM |
| CALL mess("Customer entry deleted", 23) |
| LET p_customer.customer_num = NULL |
| ELSE |
| ERROR "Deletion aborted" ATTRIBUTE (RED, REVERSE) |
| END IF |
| END FUNCTION |
| |
| |
| FUNCTION customer_help() |
| CASE |
| WHEN infield(customer_num) CALL showhelp(1001) |
| WHEN infield(fname) CALL showhelp(1002) |
| WHEN infield(lname) CALL showhelp(1003) |
| WHEN infield(company) CALL showhelp(1004) |
| WHEN infield(address1) CALL showhelp(1005) |
| WHEN infield(address2) CALL showhelp(1006) |
| WHEN infield(city) CALL showhelp(1007) |
| WHEN infield(state) CALL showhelp(1008) |
| WHEN infield(zipcode) CALL showhelp(1009) |
| WHEN infield(phone) CALL showhelp(1010) |
| WHEN infield(phone1) CALL customer(2020) |
| END CASE |
| END FUNCTION |
| |
| |
| FUNCTION statehelp() |
| DEFINE idx INTEGER |
| |
| SELECT COUNT(*) INTO idx |
| FROM state |
| WHERE code = p_customer.state |
| IF idx = 1 THEN |
| RETURN |
| END IF |
| |
| DISPLAY "Move cursor using F3, F4, and arrow keys; press ESC to select state" AT 1,1 |
| OPEN WINDOW w_state AT 8,37 |
| WITH FORM "state_list" |
| ATTRIBUTE (BORDER, RED, FORM LINE 2) |
| |
| CALL set_count(state_cnt) |
| DISPLAY ARRAY p_state TO s_state.* |
| LET idx = arr_curr() |
| |
| CLOSE WINDOW w_state |
| LET p_customer.state = p_state[idx].code |
| DISPLAY BY NAME p_customer.state ATTRIBUTE(MAGENTA) |
| RETURN |
| END FUNCTION |
| |
| GLOBALS |
| DEFINE |
| p_customer RECORD LIKE customer.*, |
| p_orders RECORD |
| order_num LIKE orders.order_num, |
| order_date LIKE orders.order_date, |
| po_num LIKE orders.po_num, |
| ship_instruct LIKE orders.ship_instruct |
| END RECORD, |
| p_items ARRAY[11] OF RECORD |
| item_num LIKE items.item_num, |
| stock_num LIKE items.stock_num, |
| manu_code LIKE items.manu_code, |
| description LIKE stock.description, |
| quantity LIKE items.quantity, |
| unit_price LIKE stock.unit_price, |
| total_price LIKE items.total_price |
| END RECORD, |
| p_stock ARRAY[31] OF RECORD |
| stock_num LIKE stock.stock_num, |
| manu_code LIKE manufact.manu_code, |
| manu_name LIKE manufact.manu_name, |
| description LIKE stock.description, |
| unit_price LIKE stock.unit_price, |
| unit_descr LIKE stock.unit_descr |
| END RECORD, |
| p_state ARRAY[51] OF RECORD LIKE state.*, |
| state_cnt, stock_cnt INTEGER, |
| print_option CHAR(1) |
| END GLOBALS |