;==File=================================================================;
; PO6720.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=============================================================;
;	po6720		Print receivings invoice cost analysis report.
;==Changes==============================================================;
; 08/07/2002 tah - Change for new PORECV file.
;=======================================================================;
.subroutine po6720

.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"
.include "INS:incomm.gbl"

record	temp_record
	tmp_invcno	,a12
	tmp_invcdate	,d8
	tmp_orno	,d6
	tmp_line	,d3
	tmp_item	,a24
	tmp_locn	,a3
	tmp_descr	,a30
	tmp_recqty	,d9.3
	tmp_ucost	,d9.3
	tmp_tcost	,d9.3
	tmp_frtadd	,d9.3
	tmp_tfrtadd	,d9.3
	tmp_apqty	,d9.3
	tmp_apcost	,d9.3

record	head1
		,a*	@1,	'INVC-NO'
		,a*	@11,	'INVC-DATE'
record	head2
		,a*	@9,	'ORDER-LIN'
		,a*	@19,	'ITEM'
		,a*	@44,	'LOC'
		,a*	@48,	'DESCRIPTION'
		,a*	@81,	'REC-QTY'
		,a*	@91,	'REC-COST'
		,a*	@101,	'FRT-ADD'
		,a*	@111,	'INVC-QTY'
		,a*	@121,	'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_invcno	,a8	@1
	prt_invcdate	,a10	@10
record	,X
	prt_orno	,a6	@8
	prt_line	,a3	@15
	prt_item	,a24	@19
	prt_locn	,a3	@44
	prt_descr	,a30	@48
	prt_recqty	,a10	@79
	prt_reccost	,a10	@90
	prt_frtadd	,a7	@101
	prt_apqty	,a10	@109
	prt_apcost	,a10	@120
	prt_flag	,a1	@132

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

record	totals
	invcreccost	,d9.3		; total received cost
	invccost	,d9.3		; total invoice cost
	invcfrtadd	,d9.3		; total invoice frt added
	tot_reccost	,d9.3		; total received cost
	tot_invccost	,d9.3		; total invoiced cost
	tot_frtadd	,d9.3		; total invoice frt added
	wrtcnt		,d6		; records written

record
	abort		,d1
	cur_invcno	,a12		; current invoice
	mask		,a10,	'ZZZ,ZZZ.XX'
	mask3		,a10,	'ZZZZZZ.XXX'
	ndx		,d2		; loop control
	recs_read	,d6
	temp_name	,a14		; temp file for sort
	  temp_ext	,a3	@temp_name+11
	temp_file	,a*,	'WRK:po6720.ddf'
	  temp_extn	,a3	@temp_file+11
	title		,a*,	'RECEIVINGS INVOICE COST ANALYSIS'
	wdone		,d1
	wind_name	,a*,	'po6720'
	wind_no		,d2		; input window id
	wind_signal	,a31
	work_chan	,d3		; work channel
	wrk_amt		,d9.3		; work area for computing values
.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 pull_data
		if (abort.eq.FALSE)
		  begin
		    call sort_data
		    call print_report
		    call print_report_totals
		    xcall clslp ('PO Receivings Cost Analysis')
		  end
	      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)
	temp_extn = ut_userid
	xcall open (work_chan,'O',temp_file)
	return

	;	Close the data files opened for the report
close_files,
	xcall close (porecv_chan,DTE_CLOSE)
	xcall close (work_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

	;	Extract data for the report
pull_data,
	abort = FALSE
	xcall status (DTEM_PRC)
	clear recs_read
	xcall statusbar (0,porecv_chan)
	call pull_work_data
	xcall close (work_chan,DTE_CLOSE)
	if (wrtcnt.eq.0)
	  begin
	    xcall message (DTEPO_NMR,D_ERROR)
	    abort = TRUE
	  end
	return

	;	pull records to work file
pull_work_data,
	xcall status (DTEM_PRT)
	xcall statusbar (0,porecv_chan)
	xcall db_find (porecv_chan,ut_cmcomp,0,'M',,,opcde)
	repeat
	  begin
	    xcall db_next (porecv_chan,porecv,'F','M',,,opcde)
	    incr recs_read
	    if (.not.recs_read(5:2)) xcall statusbar (recs_read)
	    if (opcde) .or.
	    &  (por_comp.ne.ut_cmcomp) return

	    if (por_apdate.ge.scr_strdate) .and.
	    &  (por_apdate.le.scr_enddate)
	      begin
		for ndx from 1 thru 10
		  begin
		    if (por_apinvc[ndx])
		      begin
			tmp_invcno = por_apinvc[ndx]
			tmp_invcdate = por_apdate[ndx]
			tmp_orno = por_order
			tmp_line = por_lineno
			tmp_item = por_item
			tmp_locn = por_locncode
			tmp_descr = por_descr
			tmp_recqty = por_postqty
			tmp_ucost = por_ucost - ((por_ucost * por_discpct) / 100.0)
			tmp_tcost = (tmp_ucost * por_postqty)
			tmp_frtadd = por_frtadd
			tmp_tfrtadd = (por_frtadd * por_postqty)
			tmp_apqty = por_apqty[ndx]
			tmp_apcost = por_apcost[ndx]
			writes (work_chan,temp_record)
			incr wrtcnt
		      end
		  end
	      end
	  end

	;	Sort the extracted data
sort_data,
	xcall status (DTEM_SRT)
	temp_name = temp_file
	temp_ext = ut_cmterm, 'XXX'
	sort (in=temp_file,record=temp_record,
	&	key=(tmp_invcno,tmp_invcdate,tmp_orno,tmp_line),
	&	tempfile=temp_name)
	return

	;	Print the report
print_report,
	xcall status (DTEM_PRT)
	clear totals,cur_invcno
	xcall open (work_chan,'I',temp_file)
	repeat
	  begin
	    reads (work_chan,temp_record,print_report_eof)
	    if (tmp_invcno.ne.cur_invcno)
	      begin
		if (cur_invcno) call invc_totals
		call print
		prt_invcno = tmp_invcno
		xcall dtdsp (tmp_invcdate,prt_invcdate)
		call print
		cur_invcno = tmp_invcno
	      end
	    prt_orno = tmp_orno, 'XXXXXX'
	    prt_line = tmp_line, 'ZZX'
	    prt_item = tmp_item
	    prt_locn = tmp_locn
	    prt_descr = tmp_descr
	    prt_recqty = tmp_recqty, mask3
	    prt_reccost = tmp_tcost, mask
	    prt_frtadd = tmp_tfrtadd, mask
	    prt_apqty = tmp_apqty, mask3
	    prt_apcost = tmp_apcost, mask
	    if (tmp_apcost.ne.tmp_tcost) prt_flag = '*'
	    invcreccost = invcreccost + tmp_tcost
	    invcfrtadd = invcfrtadd + tmp_tfrtadd
	    invccost = invccost + tmp_apcost
	    call print
	  end
print_report_eof,
	return

	;	Print the report totals
print_report_totals,
	if (cur_invcno) call invc_totals
	prt_item = '>> REPORT TOTALS >>'
	prt_reccost = tot_reccost, mask
	prt_frtadd = tot_frtadd, mask
	wrk_amt = tot_reccost + tot_frtadd
	if (wrk_amt) wrk_amt = (tot_invccost - wrk_amt) / wrk_amt
	if (wrk_amt.gt.0) prt_apqty = wrk_amt, '+ZZZ.XX%'
	if (wrk_amt.lt.0) prt_apqty = wrk_amt, '-ZZZ.XX%'
	prt_apcost = tot_invccost, mask
	call print
	return

invc_totals,
	prt_item = '>> INVOICE TOTALS >>'
	prt_reccost = invcreccost, mask
	prt_frtadd = invcfrtadd, mask
	clear wrk_amt
	wrk_amt = invcreccost + invcfrtadd
	if (wrk_amt) wrk_amt = (invccost - wrk_amt) / wrk_amt
	if (wrk_amt.gt.0) prt_apqty = wrk_amt, '+ZZZ.XX%'
	if (wrk_amt.lt.0) prt_apqty = wrk_amt, '-ZZZ.XX%'
	prt_apcost = invccost, mask
	call print
	call print
	tot_reccost = tot_reccost + invcreccost
	tot_frtadd = tot_frtadd + invcfrtadd
	tot_invccost = tot_invccost + invccost
	clear invcreccost, invcfrtadd, invccost
	return

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

