Source: d4_cust.4gl

d4-simple/d4_cust.4gl
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