d4_report.4gl

 GLOBALS
    "d4_globals.4gl"
 
 
FUNCTION reports()
    CALL ring_menu()
    MENU "REPORTS"
	COMMAND "Labels" "Print mailing labels from customer list" 
		HELP 501
	    CALL unring_menu()
	    CALL print_labels()
	    CLEAR SCREEN
	    CALL ring_menu()
	COMMAND "Accounts-receivable" "Print current unpaid orders" HELP 502
	    CALL unring_menu()
	    CALL print_ar()
	    CLEAR SCREEN
	    CALL ring_menu()
	COMMAND "Backlog" "Print backlogged orders" HELP 503
	    CALL unring_menu()
	    CALL print_backlog()
	    CALL ring_menu()
	COMMAND "Stock-list" "Print stock available" HELP 504
	    CALL unring_menu()
	    CALL print_stock()
	    CALL ring_menu()
        COMMAND "Options" "Change the report output options" HELP 505
	    CALL unring_menu()
	    CALL update_options()
	    CALL ring_menu()
	COMMAND "Exit" "Return to MAIN Menu" HELP 506
	    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
    IF print_option = "f" THEN
        LET msg = "Labels printed to ", file_name CLIPPED
        CALL mess(msg, 23)
    END IF
    CLOSE FORM customer
    OPTIONS
	FORM LINE 3
END FUNCTION
 
 
REPORT labels_report (rl)
     DEFINE rl RECORD LIKE customer.*
 
OUTPUT
    TOP MARGIN 0         
    BOTTOM MARGIN 0     
    PAGE LENGTH 6
 
FORMAT
    ON EVERY ROW
    SKIP TO TOP OF PAGE
        PRINT rl.fname CLIPPED, 1 SPACE, rl.lname
        PRINT rl.company
        PRINT rl.address1
        IF rl.address2 IS NOT NULL THEN
	    PRINT rl.address2
        END IF
        PRINT rl.city CLIPPED, ", ", rl.state, 2 SPACES, rl.zipcode
    IF print_option = "s" THEN
	PAUSE "Type RETURN to continue"
    END IF
END REPORT
 
 
FUNCTION 
print_ar()
    DEFINE r RECORD
	    customer_num	LIKE customer.customer_num,
	    fname 		LIKE customer.fname,
	    lname 		LIKE customer.lname,
	    company 		LIKE customer.company,
	    order_num 		LIKE orders.order_num,
	    order_date 		LIKE orders.order_date,
	    ship_date 		LIKE orders.ship_date,
	    paid_date 		LIKE orders.paid_date,
	    total_price 	LIKE items.total_price
        END RECORD,
    file_name CHAR(20),
    msg CHAR(50)
 
    DECLARE ar_list CURSOR FOR
	SELECT customer.customer_num,fname,lname,company,
	       orders.order_num,order_date,ship_date,paid_date,
               total_price
	    FROM customer,orders,items
	    WHERE customer.customer_num=orders.customer_num AND
		  paid_date IS NULL AND
		  orders.order_num=items.order_num
            ORDER BY 1,5
 
    CALL clear_menu()
    CASE (print_option)
	WHEN "f"
            PROMPT " Enter file name for AR Report >" FOR file_name
	    IF file_name IS NULL THEN
		LET file_name = "ar.out"
	    END IF
            MESSAGE "Printing AR REPORT to ", file_name CLIPPED,
		    " -- Please wait"
            START REPORT ar_report TO file_name
	WHEN "p"
	    MESSAGE "Printing AR REPORT -- Please wait"
	    START REPORT ar_report TO PRINTER
	WHEN "s"
	    START REPORT ar_report 
            CLEAR SCREEN
	    MESSAGE "Printing AR REPORT -- Please wait"
    END CASE
    FOREACH ar_list INTO r.*
        OUTPUT TO REPORT ar_report (r.*)
	IF int_flag THEN
	    LET int_flag = FALSE
	    EXIT FOREACH
        END IF
    END FOREACH
    FINISH REPORT ar_report
    IF int_flag THEN
	LET int_flag = FALSE
	ERROR "AR REPORT printing aborted" ATTRIBUTE (RED, REVERSE)
	RETURN
    END IF
    IF print_option = "f" THEN
        LET msg = "AR REPORT printed to ", file_name CLIPPED
        CALL mess(msg, 23)
    END IF
END FUNCTION
 
 
REPORT ar_report (r)
    DEFINE r RECORD 
	    customer_num	LIKE customer.customer_num,
	    fname 		LIKE customer.fname,
	    lname 		LIKE customer.lname,
	    company 		LIKE customer.company,
	    order_num 		LIKE orders.order_num,
	    order_date 		LIKE orders.order_date,
	    ship_date 		LIKE orders.ship_date,
	    paid_date 		LIKE orders.paid_date,
	    total_price 	LIKE items.total_price
        END RECORD,
    name_text CHAR(80)
 
OUTPUT 
    PAGE LENGTH 22
    LEFT MARGIN 0
 
ORDER BY r.customer_num, r.order_num
FORMAT
    PAGE HEADER
	PRINT 15 SPACES,"West Coast Wholesalers, Inc."
	PRINT 6 SPACES,
	      "Statement of ACCOUNTS RECEIVABLE"
	SKIP 1 LINES
        LET name_text = r.fname CLIPPED," ",r.lname CLIPPED,"/",
			r.company CLIPPED
        PRINT 29 - length(name_text)/2 SPACES, name_text
	SKIP 1 LINES
	PRINT " Order Date   Order Number    Ship Date            Amount"
	PRINT "----------------------------------------------------------"
 
    BEFORE GROUP OF r.customer_num
	SKIP TO TOP OF PAGE
 
    AFTER GROUP OF r.order_num
	NEED 3 LINES
	PRINT " ",r.order_date,7 SPACES,r.order_num USING "###&",8 SPACES,
	      r.ship_date,"  ", 
	      GROUP SUM(r.total_price) USING "$$$$,$$$,$$$.&&"
 
    AFTER GROUP OF r.customer_num
	PRINT 42 SPACES,"----------------"
	PRINT 42 SPACES,GROUP SUM(r.total_price) USING "$$$$,$$$,$$$.&&"
 
    PAGE TRAILER
        IF print_option = "s" THEN
	    PAUSE "Type RETURN to continue"
        END IF
END REPORT
 
 
FUNCTION update_options()
    DEFINE po CHAR(2)
 
    DISPLAY "Current print option:" AT 8,25
    LET po = " ", print_option
    DISPLAY po AT 8,46 ATTRIBUTE(CYAN)
    MENU "REPORT OPTIONS" 
	COMMAND "File" "Send all reports to a file"
	    LET print_option = "f"
	    EXIT MENU
	COMMAND "Printer" "Send all reports to the printer"
	    LET print_option = "p"
	    EXIT MENU
	COMMAND "Screen" "Send all reports to the terminal screen"
	    LET print_option = "s"
	    EXIT MENU
	COMMAND "Exit" "Return to REPORT Menu" 
	    EXIT MENU
    END MENU
    DISPLAY "" AT 8,1
END FUNCTION
 
 
FUNCTION print_backlog()
    ERROR "This option has not been implemented" ATTRIBUTE (RED)
END FUNCTION
 
 
FUNCTION print_stock()
    ERROR "This option has not been implemented" ATTRIBUTE (RED)
END FUNCTION

	GLOBALS
	"d4_globals.4gl"


	FUNCTION reports()
	CALL ring_menu()
	MENU "REPORTS"
	COMMAND "Labels" "Print mailing labels from customer list"
	HELP 501
	CALL unring_menu()
	CALL print_labels()
	CLEAR SCREEN
	CALL ring_menu()
	COMMAND "Accounts-receivable" "Print current unpaid orders" HELP 502
	CALL unring_menu()
	CALL print_ar()
	CLEAR SCREEN
	CALL ring_menu()
	COMMAND "Backlog" "Print backlogged orders" HELP 503
	CALL unring_menu()
	CALL print_backlog()
	CALL ring_menu()
	COMMAND "Stock-list" "Print stock available" HELP 504
	CALL unring_menu()
	CALL print_stock()
	CALL ring_menu()
	COMMAND "Options" "Change the report output options" HELP 505
	CALL unring_menu()
	CALL update_options()
	CALL ring_menu()
	COMMAND "Exit" "Return to MAIN Menu" HELP 506
	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
	IF print_option = "f" THEN
	LET msg = "Labels printed to ", file_name CLIPPED
	CALL mess(msg, 23)
	END IF
	CLOSE FORM customer
	OPTIONS
	FORM LINE 3
	END FUNCTION


	REPORT labels_report (rl)
	DEFINE rl RECORD LIKE customer.*

	OUTPUT
	TOP MARGIN 0
	BOTTOM MARGIN 0
	PAGE LENGTH 6

	FORMAT
	ON EVERY ROW
	SKIP TO TOP OF PAGE
	PRINT rl.fname CLIPPED, 1 SPACE, rl.lname
	PRINT rl.company
	PRINT rl.address1
	IF rl.address2 IS NOT NULL THEN
	PRINT rl.address2
	END IF
	PRINT rl.city CLIPPED, ", ", rl.state, 2 SPACES, rl.zipcode
	IF print_option = "s" THEN
	PAUSE "Type RETURN to continue"
	END IF
	END REPORT


	FUNCTION
	print_ar()
	DEFINE r RECORD
	customer_num LIKE customer.customer_num,
	fname LIKE customer.fname,
	lname LIKE customer.lname,
	company LIKE customer.company,
	order_num LIKE orders.order_num,
	order_date LIKE orders.order_date,
	ship_date LIKE orders.ship_date,
	paid_date LIKE orders.paid_date,
	total_price LIKE items.total_price
	END RECORD,
	file_name CHAR(20),
	msg CHAR(50)

	DECLARE ar_list CURSOR FOR
	SELECT customer.customer_num,fname,lname,company,
	orders.order_num,order_date,ship_date,paid_date,
	total_price
	FROM customer,orders,items
	WHERE customer.customer_num=orders.customer_num AND
	paid_date IS NULL AND
	orders.order_num=items.order_num
	ORDER BY 1,5

	CALL clear_menu()
	CASE (print_option)
	WHEN "f"
	PROMPT " Enter file name for AR Report >" FOR file_name
	IF file_name IS NULL THEN
	LET file_name = "ar.out"
	END IF
	MESSAGE "Printing AR REPORT to ", file_name CLIPPED,
	" -- Please wait"
	START REPORT ar_report TO file_name
	WHEN "p"
	MESSAGE "Printing AR REPORT -- Please wait"
	START REPORT ar_report TO PRINTER
	WHEN "s"
	START REPORT ar_report
	CLEAR SCREEN
	MESSAGE "Printing AR REPORT -- Please wait"
	END CASE
	FOREACH ar_list INTO r.*
	OUTPUT TO REPORT ar_report (r.*)
	IF int_flag THEN
	LET int_flag = FALSE
	EXIT FOREACH
	END IF
	END FOREACH
	FINISH REPORT ar_report
	IF int_flag THEN
	LET int_flag = FALSE
	ERROR "AR REPORT printing aborted" ATTRIBUTE (RED, REVERSE)
	RETURN
	END IF
	IF print_option = "f" THEN
	LET msg = "AR REPORT printed to ", file_name CLIPPED
	CALL mess(msg, 23)
	END IF
	END FUNCTION


	REPORT ar_report (r)
	DEFINE r RECORD
	customer_num LIKE customer.customer_num,
	fname LIKE customer.fname,
	lname LIKE customer.lname,
	company LIKE customer.company,
	order_num LIKE orders.order_num,
	order_date LIKE orders.order_date,
	ship_date LIKE orders.ship_date,
	paid_date LIKE orders.paid_date,
	total_price LIKE items.total_price
	END RECORD,
	name_text CHAR(80)

	OUTPUT
	PAGE LENGTH 22
	LEFT MARGIN 0

	ORDER BY r.customer_num, r.order_num
	FORMAT
	PAGE HEADER
	PRINT 15 SPACES,"West Coast Wholesalers, Inc."
	PRINT 6 SPACES,
	"Statement of ACCOUNTS RECEIVABLE"
	SKIP 1 LINES
	LET name_text = r.fname CLIPPED," ",r.lname CLIPPED,"/",
	r.company CLIPPED
	PRINT 29 - length(name_text)/2 SPACES, name_text
	SKIP 1 LINES
	PRINT " Order Date Order Number Ship Date Amount"
	PRINT "----------------------------------------------------------"

	BEFORE GROUP OF r.customer_num
	SKIP TO TOP OF PAGE

	AFTER GROUP OF r.order_num
	NEED 3 LINES
	PRINT " ",r.order_date,7 SPACES,r.order_num USING "###&",8 SPACES,
	r.ship_date," ",
	GROUP SUM(r.total_price) USING "$$$$,$$$,$$$.&&"

	AFTER GROUP OF r.customer_num
	PRINT 42 SPACES,"----------------"
	PRINT 42 SPACES,GROUP SUM(r.total_price) USING "$$$$,$$$,$$$.&&"

	PAGE TRAILER
	IF print_option = "s" THEN
	PAUSE "Type RETURN to continue"
	END IF
	END REPORT


	FUNCTION update_options()
	DEFINE po CHAR(2)

	DISPLAY "Current print option:" AT 8,25
	LET po = " ", print_option
	DISPLAY po AT 8,46 ATTRIBUTE(CYAN)
	MENU "REPORT OPTIONS"
	COMMAND "File" "Send all reports to a file"
	LET print_option = "f"
	EXIT MENU
	COMMAND "Printer" "Send all reports to the printer"
	LET print_option = "p"
	EXIT MENU
	COMMAND "Screen" "Send all reports to the terminal screen"
	LET print_option = "s"
	EXIT MENU
	COMMAND "Exit" "Return to REPORT Menu"
	EXIT MENU
	END MENU
	DISPLAY "" AT 8,1
	END FUNCTION


	FUNCTION print_backlog()
	ERROR "This option has not been implemented" ATTRIBUTE (RED)
	END FUNCTION


	FUNCTION print_stock()
	ERROR "This option has not been implemented" ATTRIBUTE (RED)
	END FUNCTION

Source: d4_report.4gl