Source: d4_demo.4gl

d4-simple/d4_demo.4gl
FUNCTION demo()

    CALL ring_menu()
    MENU "DEMO" 
	COMMAND "Menus" "Source code for MAIN Menu"
	    CALL showhelp(2001)
	COMMAND "Windows" "Source code for STATE CODE Window"
	    CALL showhelp(2007)
        COMMAND "Forms" "Source code for new CUSTOMER data entry"
	    CALL showhelp(2006)
	COMMAND "Detail-Scrolling" "Source code for scrolling of new ORDER line-items"
	    CALL showhelp(2003)
	COMMAND "Scroll-Cursor" "Source code for customer record BROWSE/SCROLL"
	    CALL showhelp(2008)
	COMMAND "Query_language" "Source code for new order insertion using SQL"
	    CALL showhelp(2004)
	COMMAND "Construct_query" 
	  "Source code for QUERY-BY-EXAMPLE selection and reporting"
	    CALL showhelp(2002)
	COMMAND "Reports" "Source code for MAILING LABEL report"
	    CALL showhelp(2005)
	COMMAND "Exit" "Return to MAIN MENU" 
	    CLEAR SCREEN
	    EXIT MENU
    END MENU
END FUNCTION


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


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