;==File=================================================================;
; PO6700.DBL
;=======================================================================;
; Copyright 1999 by TAH Software Systems (TAH), Oklahoma City, Oklahoma ;
;									;
;	TAH provides this software under a license and may only be	;
;	used in accordance with the terms and conditions of such	;
;	license and with the inclusion of the above Copyright notice.	;
;==Function=============================================================;
;	po6700		Print receivings item cost analysis report.
;==Changes==============================================================;
; 08/07/2002 tah - Change for new PORECV file.
;=======================================================================;
.subroutine po6700

.start nopage,nolist
.include "UTL:tools.def"
.include "UTS:dteut.def"
.include "POS:dtepo.def"

.include "UTS:utcomm.gbl"
.include "POS:pocomm.gbl"
.include "POS:porecv.rec"

record	head1
		,a*	@1,	'ITEM'
		,a*	@26,	'LOC'
		,a*	@30,	'DESCRIPTION'
		,a*	@62,	'ORDER-LIN'
		,a*	@75,	'ORD-QTY'
		,a*	@86,	'REC-QTY'
		,a*	@96,	'REC-COST'
		,a*	@105,	'INVC-NO'
		,a*	@115,	'INVC-QTY'
		,a*	@124,	'INVC-COST'

record	legnd1
		,a*	@1,	'COMPANY:'
	lcompy	,a2	@11
	lbegdte	,a10	@107
		,a*	@118,	'THRU'
	lendte	,a10	@123

record	pline
		,a132
record	,X
	prt_item	,a24	@1
	prt_locn	,a3	@26
	prt_descr	,a30	@30
	prt_orno	,a6	@61
	prt_line	,a3	@68
	prt_ordqty	,a10	@72
	prt_recqty	,a10	@83
	prt_reccost	,a10	@94
	prt_invcno	,a8	@105
	prt_invcqty	,a10	@113
	prt_invccost	,a10	@123

record	scr_rec1		; input set 1
	scr_strdate	,d8		; date to print from
	scr_enddate	,d8		; date to print thru

record	totals
	item_reccost	,d9.3		; total item received cost
	item_invccost	,d9.3		; total item invoiced cost
	tot_reccost	,d9.3		; total received cost
	tot_invccost	,d9.3		; total invoiced cost

record
	abort		,d1
	cur_item	,a24		; current item
	hold_key	,a12		; saved record key
	mask		,a10,	'ZZZ,ZZX.XX'
	mask3		,a10,	'ZZZZZX.XXX'
	ndx		,d2		; loop control
	print_switch	,d1		; flag for printing
	recs_read	,d6
	title		,a*,	'RECEIVINGS ITEM COST ANALYSIS'
	wdone		,d1
	wind_name	,a*,	'po6700'
	wind_no		,d2		; input window id
	wind_signal	,a31
	wrk_amt		,d9.3		; work area for computing values
	wrk_ucost	,d9.3		; discounted unit cost
.start nopage,list

.proc
	;>>>>>	Main processing  <<<<<;
	call do_setup
	call open_files
	call get_parameters
	if (abort.eq.FALSE)
	  begin
	    call get_destination
	    if (abort.eq.FALSE)
	      begin
		call print_report
		call print_report_totals
		xcall clslp ('PO Receivings Cost Analysis')
	      end
	  end
	call close_files
	call do_shutdown
	xreturn		; to calling program

	;>>>>>	End of main processing  <<<<<;

	;	Set up environment
do_setup,
	xcall e_enter
	xcall lodcol ('RL')		; remove local columns
	xcall lodtoolbar ('AB',8)
	return

	;	Shut down environment
do_shutdown,
	xcall lodtoolbar ('RB',8)
	xcall e_exit
	return

	;	Open the needed data files
open_files,
	xcall open (porecv_chan,'I:I',porecv_name)
	return

	;	Close the data files opened for the report
close_files,
	xcall close (porecv_chan,DTE_CLOSE)
	return

	;	Get the report selection parameters
get_parameters,
	repeat
	  begin
	    xcall get_parameters (wind_no,wind_name,'set1',scr_rec1,abort,wind_signal)
	    if (abort.eq.TRUE) exitloop
	    if (wind_signal)
	     then call process_signal
	     else
	      begin
		call verify_input_parameters
		if (wdone.eq.TRUE) exitloop
	      end
	  end
	return

	;	Process any break signals
process_signal,
	case g_entnam of
	  begincase
	  '@': nop
	  endcase
	return

verify_input_parameters,
	wdone = TRUE
	if (scr_strdate.gt.scr_enddate)
	  begin
	    xcall message (DTER_ERR)
	    wdone = FALSE
	  end
	return

	;	Get the output destination
get_destination,
	abort = FALSE
	lcompy = ut_cmcomp
	clear lp_sel
	xcall askpr (ut_cmname,132,61,0,ut_cmdefp)
	if (lp_sel.eq.'E') abort = TRUE
	xcall dtdsp (scr_strdate,lbegdte)
	xcall dtdsp (scr_enddate,lendte)
	return

	;	Print the report
print_report,
	xcall status (DTEM_PRT)
	clear recs_read
	xcall statusbar (0,porecv_chan)
	clear totals,cur_item
	xcall db_find (porecv_chan,' ',1,'M',,,opcde)
	repeat
	  begin
	    xcall db_next (porecv_chan,porecv,'F','M',,,opcde)
	    if (opcde) return
	    incr recs_read
	    if (.not.recs_read(5:2)) xcall statusbar (recs_read)
	    if (por_comp.eq.ut_cmcomp) .and.
	    &  (por_recdate.ge.scr_strdate .and. por_recdate.le.scr_enddate)
	      begin
		if (cur_item.ne.por_item)
		  begin
		    if (cur_item) call item_totals
		    cur_item = por_item
		  end

		prt_item = por_item
		prt_locn = por_locncode
		prt_descr = por_descr
		prt_orno = por_order, 'XXXXXX'
		prt_line = por_lineno, 'ZZX'
		prt_ordqty = por_ordqty, mask3
		prt_recqty = por_postqty, mask3
		wrk_ucost = por_ucost - ((por_ucost * por_discpct) / 100.0)
		wrk_amt = (wrk_ucost * por_postqty)
		prt_reccost = wrk_amt, mask
		item_reccost = item_reccost + wrk_amt
		print_switch = TRUE
		for ndx from 1 thru 10
		  begin
		    if (por_apinvc[ndx])
		      begin
			prt_invcno = por_apinvc[ndx]
			prt_invcqty = por_apqty[ndx], mask3
			prt_invccost = por_apcost[ndx], mask
			call print
			print_switch = FALSE
			item_invccost = item_invccost + por_apcost[ndx]
		      end
		  end
		if (print_switch.eq.TRUE) call print
	      end
	  end

	;	Print the report totals
print_report_totals,
	if (cur_item) call item_totals
	prt_item = '>> REPORT TOTALS >>'
	prt_reccost = tot_reccost, mask
	prt_invccost = tot_invccost, mask
	call print
	return

item_totals,
	prt_descr = '>> ITEM TOTALS >>'
	prt_reccost = item_reccost, mask
	prt_invccost = item_invccost, mask
	clear wrk_amt
	if (item_reccost)
	    wrk_amt = ((item_invccost - item_reccost) / item_reccost) * 100.0
	if (wrk_amt.gt.0) prt_invcqty = wrk_amt, '+ZZZ.XX%'
	if (wrk_amt.lt.0) prt_invcqty = wrk_amt, '-ZZZ.XX%'
	call print
	call print
	tot_reccost = tot_reccost + item_reccost
	tot_invccost = tot_invccost + item_invccost
	clear item_reccost, item_invccost
	return

	;	Print a detail line of the report
print,
	xcall print (pline,title,head1,,,legnd1)
	clear pline
	if (lp_cnt.eq.-1)
	  begin
	    call close_files
	    call do_shutdown
	    xreturn		; to calling program
	  end
	return
.end

