;==File=================================================================;
; PO6740.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=============================================================;
;	po6740		Print receivings freight cost analysis report.
;==Changes==============================================================;
; 11/25/2002 tah - Changed for new PORECV file format.
;=======================================================================;
.subroutine po6740

.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_item	,a24
	tmp_orno	,d6
	tmp_line	,d3
	tmp_invcno	,a12
	tmp_invcdate	,d8
	tmp_descr	,a30
	tmp_recqty	,d9.3
	tmp_ucost	,d9.3
	tmp_uwght	,d6.2
	tmp_ufrtadd	,d6.3
	tmp_ufrtamt	,d6.3
	tmp_tcost	,d9.3
	tmp_twght	,d8.2
	tmp_tfrtadd	,d8.3
	tmp_tfrtaloc	,d6.2
	tmp_ufrtaloc	,d8.4
	tmp_diffamt	,d8.3
	tmp_diffpct	,d8.3

record	head1
		,a*	@1,	'ITEM-ID'
		,a*	@28,	'DESCRIPTION'
record	head2
		,a*	@37,	'--------------UNIT---------------'
		,a*	@71,	'-----------TOTAL----------'
		,a*	@99,	'ALLOCATE-FREIGHT'
		,a*	@116,	'---DIFFERENCE----'
record	head3
		,a*	@1,	'INVC-NO'
		,a*	@15,	'INVC-DATE'
		,a*	@26,	'ORDER-LIN'
		,a*	@42,	'COST'
		,a*	@48,	'WEIGHT'
		,a*	@55,	'FRT-ADD'
		,a*	@63,	'FRT-AMT'
		,a*	@77,	'COST'
		,a*	@83,	'WEIGHT'
		,a*	@90,	'FREIGHT'
		,a*	@102,	'UNIT'
		,a*	@110,	'TOTAL'
		,a*	@118,	'DOLLAR'
		,a*	@126,	'PERCENT'

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_descr	,a30	@28
record	,X
	prt_invcno	,a12	@1
	prt_invcdate	,a10	@14
	prt_orno	,a6	@25
	prt_line	,a3	@32
	prt_ucost	,a10	@36
	prt_uwght	,a7	@47
	prt_ufrtadd	,a7	@55
	prt_ufrtamt	,a7	@63
	prt_tcost	,a10	@71
	prt_twght	,a7	@82
	prt_tfrtadd	,a7	@90
	prt_ufrtaloc	,a8	@98
	prt_tfrtaloc	,a8	@107
	prt_diffamt	,a8	@116
	prt_diffpct	,a8	@125

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.2		; total invoice frt added
	invc_weight	,d8.2		; total invoice weight
	invc_costs	,d8.3		; total invoice other costs
	wrtcnt		,d6		; records written

record
	abort		,d1
	hold_item	,a24		; saved item id
	mask2		,a10,	'ZZZZZZZ.XX'
	mask3		,a10,	'ZZZZZZ.XXX'
	mask2n		,a10,	'ZZZZZZ.XX-'
	mask3n		,a10,	'ZZZZZ.XXX-'
	ndx		,d2		; loop control
	porecv_lchan	,d3		; local channel
	print_switch	,d1		; print line flag
	recs_read	,d6
	temp_name	,a14		; temp file for sort
	  temp_ext	,a3	@temp_name+11
	temp_file	,a*,	'WRK:po6740.ddf'
	  temp_extn	,a3	@temp_file+11
	title		,a*,	'RECEIVINGS FREIGHT ANALYSIS'
	wdone		,d1
	wind_name	,a*,	'po6740'
	wind_no		,d2		; input window id
	wind_signal	,a31
	work_chan	,d3
	wrk_amt		,d10.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 Freight 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

	;	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_item,tmp_orno),
	&		tempfile=temp_name)
	return

	;	Print the report
print_report,
	xcall status (DTEM_PRT)
	clear totals
	xcall open (work_chan,'I',temp_file)
	clear hold_item
	repeat
	  begin
	    reads (work_chan,temp_record,print_report_eof)
	    if (tmp_item.ne.hold_item)
	      begin
		call print
		prt_item = tmp_item
		prt_descr = tmp_descr
		call print
		hold_item = tmp_item
	      end
	    prt_invcno = tmp_invcno
	    xcall dtdsp (tmp_invcdate,prt_invcdate)
	    prt_orno = tmp_orno, 'XXXXXX'
	    prt_line = tmp_line, 'ZZX'
	    prt_ucost = tmp_ucost, mask3
	    prt_uwght = tmp_uwght, mask2
	    prt_ufrtadd = tmp_ufrtadd, mask3
	    prt_ufrtamt = tmp_ufrtamt, mask3
	    prt_tcost = tmp_tcost, mask2
	    prt_twght = tmp_twght, mask2
	    prt_tfrtadd = tmp_tfrtadd, mask2
	    prt_ufrtaloc = tmp_ufrtaloc, mask3
	    prt_tfrtaloc = tmp_tfrtaloc, mask2
	    prt_diffamt = tmp_diffamt, mask3n
	    prt_diffpct = tmp_diffpct, mask3n
	    call print
	  end
print_report_eof,
	return

	;	Print the report totals
print_report_totals,
	return

	;	pull records to work file
pull_work_data,
	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
		tmp_item = por_item
		tmp_orno = por_order
		tmp_line = por_lineno
		tmp_invcno = por_apinvc[1]
		tmp_invcdate = por_apdate[1]
		tmp_descr = por_descr
		tmp_recqty = por_postqty
		tmp_ucost = por_ucost - ((por_ucost * por_discpct) / 100.0)
		tmp_uwght = por_weight
		if (por_ucost)
		 then tmp_ufrtadd = (por_frtadd / por_ucost)
		 else clear tmp_ufrtadd
		tmp_ufrtamt = por_frtadd
		tmp_tcost = (tmp_ucost * por_postqty)
		tmp_twght = (por_weight * por_postqty)
		tmp_tfrtadd = (por_frtadd * por_postqty)
		clear tmp_tfrtaloc
		for ndx from 1 thru 10
		    tmp_tfrtaloc = tmp_tfrtaloc + por_apfrgt[ndx]
		if (por_postqty) tmp_ufrtaloc = (tmp_tfrtaloc / por_postqty)
		tmp_diffamt = tmp_ufrtaloc - tmp_ufrtamt
		if (tmp_ufrtamt) tmp_diffpct = (tmp_diffamt / tmp_ufrtamt)
		writes (work_chan,temp_record)
		incr wrtcnt
		clear temp_record
;;		for ndx from 2 thru 10
;;		  if (por_apinvc[ndx])
;;		    begin
;;		      tmp_item = por_item
;;		      tmp_orno = por_order
;;		      tmp_invcno = por_apinvc[ndx]
;;		      tmp_invcdate = por_apdate[ndx]
;;		      writes (work_chan,temp_record)
;;		      incr wrtcnt
;;		    end
	      end
	  end

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

