;==File=================================================================;
; PO6600.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=============================================================;
;	po6600		Purchased inventory variance.
;==Changes==============================================================;
; 02/21/2002 tah - Add option to export report data.
; 05/20/1997 tah - Add dates to legend.
;=======================================================================;
.subroutine po6600

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

record	head1
		,a*	@1,	'ITEM ID'
		,a*	@26,	'DESCRIPTION'
		,a*	@65,	'RECEIVED'
		,a*	@81,	'QUANTITY'
		,a*	@107,	'STANDARD'
record	head2
		,a*	@57,	'ORDER'
		,a*	@67,	'DATE'
		,a*	@75,	'LOC'
		,a*	@81,	'RECEIVED'
		,a*	@93,	'P.O. COST'
		,a*	@109,	'COST'
		,a*	@118,	'DIFFERENCE'

record	legnd1
		,a*	@1,	'COMPANY:'
	lcompy	,a2	@11
		,a*	@108,	'FROM'
	lfrdate	,a8	@113
		,a*	@122,	'TO'
	ltodate	,a8	@125

record	pline
		,a132
record	,X
	pritem		,a24	@1
	prdesc		,a30	@26
	prorno		,a6	@57
	prrcdt		,a10	@64
	prlocn		,a3	@75
	prrcqt		,a10	@79
	prcost		,a12	@90
	prscost		,a12	@103
	prdiff		,a12	@116

record	totals
	frcqt		,d9.3		; report quantity received
	fcost		,d9.3		; report cost
	fscost		,d9.3		; report standard cost
	ircqt		,d9.3		; item quantity received
	icost		,d9.3		; item cost
	iscost		,d9.3		; item standard cost

record	scr_rec1		; input set 1
	scr_strdate	,d8		; starting date
	scr_enddate	,d8		; ending date
	scr_stritem	,a24		; starting item
	scr_enditem	,a24		; ending item
	scr_outtype	,a1		; Print or Export

record	export_data
	exp_item	,a24
	exp_descr	,a30
	exp_orno	,a6
	exp_rcdt	,d8
	exp_locn	,a3
	exp_rcqt	,d10.3
	exp_cost	,d10.2
	exp_scost	,d10.2
	exp_diff	,d10.2

record
	abort		,d1
	cost		,d9.3		; cost amount
	head_fmt	,a*,	'"ITEM","DESCR","ORDER","RCD-DATE","LOCN",'
			&	'"RCD-QTY","PO-COST","STD-COST","DIFF"'
	hlditm		,a24		; current item id
	lstitem		,a24		; current item
	mask		,a12,	'ZZZZ,ZZZ.XX-'
	mask0		,a10,	'  ZZZ,ZZX-'
	mask3		,a10,	'ZZZZZZ.XXX'
	out_format	,a*,	'A1:24|A25:30|A55:6|D61:8|A69:3|'
	&			'N72:10.3|N82:10.2|N92:10.2|N102:10.2|'
	scost		,d9.3		; standard cost amount
	title		,a*,	'PURCHASED INVENTORY VARIANCE REPORT'
	wdone		,d1
	wind_name	,a*,	'po6600'
	wind_no		,d2		; input window id
	wind_signal	,a31
.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
		if (scr_outtype.eq.'R') then
		  begin
		    call print
		    xcall clslp ('Purchase Inventory Variance')
		  end
		 else xcall ascfil ('F',,,,,,,,,opcde)
	      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 (pohist_chan,'I:I',pohist_name)
	xcall open (initem_chan,'I:I',initem_name)
	xcall open (inlocn_chan,'I:I',inlocn_name)
	return

	;	Close the data files opened for the report
close_files,
	xcall close (pohist_chan,DTE_CLOSE)
	xcall close (initem_chan,DTE_CLOSE)
	xcall close (inlocn_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_enditem.ne.UT_ALL .and. scr_stritem.gt.scr_enditem) .or.
	&   (scr_strdate.gt.scr_enddate))
	  begin
	    xcall message (DTER_ERR)
	    wdone = FALSE
	  end
	return

	;	Get the output destination
get_destination,
	abort = FALSE
	if (scr_outtype.eq.'E') then
	  begin
	    xcall ascfil ('I','WRK:po6600.txt','OUTPUT',head_fmt,,,,,,opcde)
	  end
	 else
	  begin
	    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,lfrdate)
	    xcall dtdsp (scr_enddate,ltodate)
	  end
	return

	;	Print the report
print_report,
	xcall status (DTEM_PRT)
	clear totals, poh_key
	lstitem = UT_ALL
	xcall db_find (pohist_chan,scr_stritem,1,'M',,,opcde)
	repeat
	  begin
	    xcall db_next (pohist_chan,pohist,'F','M',,,opcde)
	    if (opcde) .or.
	    &  (scr_enditem.ne.UT_ALL .and. poh_item.gt.scr_enditem) return
	    if (poh_comp.eq.ut_cmcomp) .and.
	    &  (scr_stritem.eq.UT_ALL .or. poh_item.ge.scr_stritem) .and.
	    &  (poh_recdate.ge.scr_strdate .and. poh_recdate.le.scr_enddate) .and.
	    &  (poh_linetype.eq.'I') call print_record
	  end

	;	Print the report totals
print_report_totals,
	call item_total
	prdesc = 'FINAL TOTALS:'
	case in_cmqdec of
	  begincase
	  0: prrcqt = frcqt, mask0
	  3: prrcqt = frcqt, mask3
	  endcase
	prcost = fcost, mask
	prscost = fscost, mask
	prdiff = (fscost - fcost), mask
	call print
	return

print_record,
	if (poh_item.ne.lstitem)
	  begin
	    call item_total
	    pritem = poh_item
	    prdesc = poh_descr
	    call print
	  end
	case poh_linetype of
	  begincase
	  'I': begin
		if (inl_item.ne.poh_item) .or.
		&  (inl_locncode.ne.poh_locncode)
		  begin
		    inl_comp = poh_comp
		    inl_item = poh_item
		    inl_locncode = poh_locncode
		    xcall in_get_locn (inlocn)
		    if (opcde) clear inl_scost
		  end
		call print_item
	       end
	  endcase
	return

	;	print the item
print_item,
	case scr_outtype of
	  begincase
	  'E': begin
		exp_item = poh_item
		exp_descr = poh_descr
		exp_orno = poh_order, 'XXXXXX'
		exp_rcdt = poh_recdate
		exp_locn = poh_locncode
		exp_rcqt = poh_recqty
		cost = (poh_recqty * poh_ucost) / poh_pfactor
		cost = cost - ((cost * poh_discpct) / 100.0)
		exp_cost = cost
		scost = (poh_recqty * inl_scost)
		exp_scost = scost
		exp_diff = (scost - cost)
		xcall ascfil ('D',,export_data,out_format,'"','"',',','Y','Y',opcde)
	       end
	  'R': begin
		prorno = poh_order, 'XXXXXX'
		xcall dtdsp (poh_recdate,prrcdt)
		prlocn = poh_locncode
		case in_cmqdec of
		  begincase
		  0: prrcqt = poh_recqty, mask0
		  3: prrcqt = poh_recqty, mask3
		  endcase
		cost = (poh_recqty * poh_ucost)
		cost = cost - ((cost * poh_discpct) / 100.0)
		prcost = cost, mask
		scost = (poh_recqty * inl_scost)
		prscost = scost, mask
		prdiff = (scost - cost), mask
		call print
		frcqt = frcqt + poh_recqty
		fcost = fcost + cost
		fscost = fscost + scost
		ircqt = ircqt + poh_recqty
		icost = icost + cost
		iscost = iscost + scost
	       end
	  endcase
	return

	;	print item totals
item_total,
	if (lstitem.ne.UT_ALL)
	  begin
	    prdesc = 'ITEM TOTALS:'
	    case in_cmqdec of
	      begincase
	      0: prrcqt = ircqt, mask0
	      3: prrcqt = ircqt, mask3
	      endcase
	    prcost = icost, mask
	    prscost = iscost, mask
	    prdiff = (iscost - icost), mask
	    call print
	  end
	lstitem = poh_item
	clear ircqt,icost,iscost
	call print
	return

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

