;==File=================================================================;
; PO6760.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=============================================================;
;	po6760		Print receivings items not invoiced.
;==Changes==============================================================;
; 08/07/2002 tah - Change for new PORECV file.
; 09/19/1997 tah - Add non-stock items prompt.
;=======================================================================;
.subroutine po6760

.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"
.include "INS:initem.rec"
.include "INS:inlocn.rec"
.include "SMS:smcode.rec"

record	temp_record
	tmp_catgcode	,a3
	tmp_item	,a24
	tmp_locncode	,a3
	tmp_descr	,a30
	tmp_orno	,d6
	tmp_line	,d3
	tmp_recdqty	,d9.3
	tmp_dockqty	,d9.3
	tmp_ucost	,d9.3
	tmp_tcost	,d9.3
	tmp_tfrtadd	,d6.2
	tmp_invcqty	,d9.3
	tmp_ninvqty	,d9.3

record	head1
		,a*	@10,	'CATEOGRY'
record	head2
		,a*	@1,	'ITEM'
		,a*	@26,	'LOC'
		,a*	@30,	'DESCRIPTION'
		,a*	@60,	'ORDER-LIN'
		,a*	@72,	'RECD-QTY'
		,a*	@83,	'DOCK-QTY'
		,a*	@93,	'UNINV-QTY'
		,a*	@104,	'UNIT-COST'
		,a*	@116,	'TOT-COST'
		,a*	@126,	'FRT-ADD'
record	legnd1
		,a*	@1,	'COMPANY:'
	lcompy	,a2	@11
	lbegdte	,a10	@107
		,a*	@118,	'THRU'
	lendte	,a10	@123

record	pline
		,a132
record	,X
	prt_catgcode	,a3	@10
	prt_catgdescr	,a25	@15
record	,X
	prt_item	,a24	@1
	prt_locn	,a3	@26
	prt_descr	,a28	@30
	prt_orno	,a6	@59
	prt_line	,a3	@66
	prt_recqty	,a10	@70
	prt_atdqty	,a10	@81
	prt_ninqty	,a10	@92
	prt_ucost	,a10	@103
	prt_tcost	,a10	@114
	prt_tfrtadd	,a8	@125

record	scr_rec1		; input set 1
	scr_strdate	,d8		; date to print from
	scr_enddate	,d8		; date to print thru
	scr_locncode	,a3		; location to print
	scr_nonstock	,a1		; include non-stock items

record	totals
	catg_reccost	,d9.3		; total category received cost
	catg_tfrtadd	,d8.2		; total category freight cost
	tot_reccost	,d9.2		; total received cost
	tot_tfrtadd	,d8.2		; total freight cost
	wrtcnt		,d6		; work records written

record
	abort		,d1
	cur_catgcode	,a3		; current category code
	hold_key	,a12		; saved record key
	invc_qty	,d9.3		; invoiced quantity
	mask2		,a10,	'ZZZ,ZZX.XX'
	mask3		,a10,	'ZZZZZX.XXX'
	ndx		,d2		; loop control
	print_switch	,d1		; flag for printing
	recs_read	,d6
	sav_frtadd	,d6.2		; saved freight added
	temp_name	,a14		; temp file for sort
	  temp_ext	,a3	@temp_name+11
	temp_file	,a*,	'WRK:po6760.ddf'
	  temp_extn	,a3	@temp_file+11
	title		,a*,	'RECEIVINGS NOT INVOICED'
	wdone		,d1
	wind_name	,a*,	'po6760'
	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 Received/Not Invoiced')
		  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)
	xcall open (initem_chan,'I:I',initem_name)
	xcall open (inlocn_chan,'I:I',inlocn_name)
	xcall open (smcode_chan,'I:I',smcode_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 (initem_chan,DTE_CLOSE)
	xcall close (inlocn_chan,DTE_CLOSE)
	xcall close (smcode_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_catgcode,tmp_item),
	&		tempfile=temp_name)
	return

	;	Print the report
print_report,
	xcall status (DTEM_PRT)
	clear totals,cur_catgcode
	xcall open (work_chan,'I',temp_file)
	clear cur_catgcode
	repeat
	  begin
	    reads (work_chan,temp_record,print_report_eof)
	    if (tmp_catgcode.ne.cur_catgcode) call new_catgcode
	    prt_item = tmp_item
	    prt_locn = tmp_locncode
	    prt_descr = tmp_descr
	    prt_orno = tmp_orno, 'XXXXXX'
	    prt_line = tmp_line, 'ZZX'
	    prt_recqty = tmp_recdqty, mask3
	    prt_atdqty = tmp_dockqty, mask3
	    prt_ninqty = tmp_ninvqty, mask3
	    prt_ucost = tmp_ucost, mask3
	    prt_tcost = tmp_tcost, mask2
	    prt_tfrtadd = tmp_tfrtadd, mask2
	    call print
	    catg_reccost = catg_reccost + tmp_tcost
	    catg_tfrtadd = catg_tfrtadd + tmp_tfrtadd
	  end
print_report_eof,
	return

	;	Print the report totals
print_report_totals,
	if (cur_catgcode) call catg_totals
	prt_descr = '>> REPORT TOTALS >>'
	prt_tcost = tot_reccost, mask2
	prt_tfrtadd = tot_tfrtadd, mask2
	call print
	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 (scr_locncode.eq.UT_ALL .or. por_locncode.eq.scr_locncode) .and.
	    &  (por_recdate.ge.scr_strdate .and. por_recdate.le.scr_enddate) .and.
	    &  ((scr_nonstock.eq.'B') .or.
	    &   (scr_nonstock.eq.'S' .and. por_linetype.eq.'I') .or.
	    &   (scr_nonstock.eq.'N' .and. por_linetype.eq.'N'))
	      begin
		if (ini_item.ne.por_item)
		  begin
		    ini_comp = por_comp
		    ini_item = por_item
		    xcall in_get_item (initem)
		    if (opcde) ini_catgcode = '???'
		  end
		tmp_catgcode = ini_catgcode
		tmp_item = por_item
		tmp_locncode = por_locncode
		tmp_descr = por_descr
		tmp_orno = por_order
		tmp_line = por_lineno
		tmp_recdqty = por_postqty
		tmp_dockqty = por_recuqty - por_recdqty - por_recrqty
		if (tmp_dockqty.lt.0) clear tmp_dockqty
		tmp_ucost = por_ucost
		sav_frtadd = por_frtadd

		print_switch = FALSE
		clear invc_qty
		for ndx from 1 thru 10
		  begin
		    if (por_apinvc[ndx])
		      begin
			invc_qty = invc_qty + por_apqty[ndx]
			print_switch = FALSE
		      end
		  end

		if (print_switch.eq.TRUE) .or.
		&  (print_switch.eq.FALSE .and. invc_qty.lt.tmp_recdqty)
		  begin
		    tmp_invcqty = invc_qty
;;;		    tmp_ninvqty = tmp_recdqty - tmp_invcqty
		    tmp_ninvqty = tmp_recdqty + tmp_dockqty - tmp_invcqty
		    tmp_tcost = (tmp_ucost * tmp_ninvqty)
		    tmp_tfrtadd = (sav_frtadd * tmp_ninvqty)
		    writes (work_chan,temp_record)
		    incr wrtcnt
		  end
	      end
	  end

new_catgcode,
	if (cur_catgcode.ne.UT_BLANKS) call catg_totals
	smc_type = 'C'
	smc_code = tmp_catgcode
	xcall sm_get_code (smcode)
	prt_catgcode = tmp_catgcode
	prt_catgdescr = smc_descr
	call print
	cur_catgcode = tmp_catgcode
	return

catg_totals,
	prt_descr = '<< CATEGORY TOTALS >>'
	prt_tcost = catg_reccost, mask2
	prt_tfrtadd = catg_tfrtadd, mask2
	call print
	call print
	tot_reccost = tot_reccost + catg_reccost
	tot_tfrtadd = tot_tfrtadd + catg_tfrtadd
	clear catg_reccost,catg_tfrtadd
	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

