;==File=================================================================;
; PO4710.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=============================================================;
;	po4710		Purchase receivings build work file.
;==Changes==============================================================;
; 08/08/2002 tah - Change for new PORECV file.
; 06/26/1999 tah - Allow receipt of more units than ordered.
; 10/10/1997 tah - Corrected problems with partial receivings.
; 10/07/1996 tah - Fix problem with removing PORECV recs partially accepted.
; 08/28/1996 tah - Fix problem with wrong vendor when posting.
; 01/23/1996 tah - Fix problem reading correct header record.
; 04/01/1995 tah - Added 2-step receivings process.
;=======================================================================;
.subroutine po4710

.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:pohedr.rec"
.include "POS:poline.rec"
.include "POS:porecv.rec"
.include "POS:popost.rec"

record
	abort		,d1
	temp_name	,a14		; temp file for sort
	  temp_ext	,a3	@temp_name+11
	work_chan	,d2		; work file channel
	work_name	,a14,	'WRK:po4710.ddf'
	  work_ext	,a3	@work_name+11
	wrtcnt		,d6		; number of work records written
.start nopage,list

.proc
	;>>>>>	Main processing  <<<<<;
	call do_setup
	call open_files
	call process_data
	call close_files
	if (wrtcnt.eq.0) then
	  begin
	    xcall message (DTEPO_NMR)
	    ut_err = -1
	  end
	 else call sort_data
	xcall status
	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
	return

	;	Shut down environment
do_shutdown,
	xcall e_exit
	return

	;	Open the needed data files
open_files,
	work_ext = ut_userid
	xcall open (work_chan,'O',work_name)
	xcall open (porecv_chan,'U:I',porecv_name)
	return

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

	;	Process the data
process_data,
	abort = FALSE
	xcall status (DTEM_PRC)
	clear wrtcnt

	;	pull posting records for receivings

	xcall db_find (porecv_chan,ut_cmcomp,0,'M',,,opcde)
	repeat
	  begin
	    xcall db_next (porecv_chan,porecv,'F','M',,,opcde)
	    if (opcde) .or.
	    &  (por_comp.ne.ut_cmcomp) return
	    if (por_recdqty.gt.0 .or.		; accepted some
	    &   por_recrqty.gt.0) .and.		; rejected some
	    &  (por_posted.ne.'Y')		; not yet posted
		call process_record
	  end

	;	write out work record and update receivings record
process_record,
	if (por_order.ne.pom_order)
	  begin
	    pom_comp = por_comp
	    pom_order = por_order
	    xcall db_read (pohedr_chan,pohedr,pom_key,0,'M',,,opcde)
	    if (opcde) clear pohedr
	  end

	xcall db_read (poline_chan,poline,por_key,0,'M',,,opcde)
	if (.not.opcde)
	  begin
	    pop_comp = por_comp
	    pop_locncode = por_locncode
	    pop_abin = por_abin
	    pop_catgcode = pol_catgcode
	    pop_item = por_item
	    pop_linetype = por_linetype
	    pop_slst = pol_slst
	    pop_order = por_order
	    pop_lineno = por_lineno
	    pop_recqty = por_recuqty
	    pop_acpqty = por_recdqty
	    pop_rejqty = por_recrqty
	    pop_ucost = por_ucost
	    pop_tcost = (por_recdqty * por_ucost)
	    pop_tcost = pop_tcost - (pop_tcost * (pol_discpct / 100.0))
	    pop_updcost = pol_updcost
	    if (pop_updcost.ne.'Y' .and. pop_updcost.ne.'N') .and.
	    &  (pol_linetype.eq.'I') pop_updcost = 'Y'
	    pop_ordtype = pom_ordtype
	    pop_vend = pom_vend
	    pop_vendpn = pol_vendpn
	    pop_pfactor = pol_pfactor
	    pop_ordqty = pol_ordqty
	    writes (work_chan,popost)
	    incr wrtcnt

	    por_posted = 'Y'
	    por_postqty = por_postqty + por_recdqty	; Add accepted qty
	    por_recuqty = por_recuqty - (por_recdqty + por_recrqty)
	    if (por_recuqty.lt.0) clear por_recuqty
	    if (por_postqty.lt.por_ordqty)	; Not yet all received,
	      begin
		por_posted = 'N'		;  so, set posted to No and
		clear por_recdqty,por_recrqty	;  clear accepted & rejected qty
	      end
	    xcall db_update (porecv_chan,porecv,por_key,0,opcde)
	  end
	return

	;	Sort the extracted data
sort_data,
	xcall status (DTEM_SRT)
	temp_name = work_name
	temp_ext = ut_cmterm, 'XXX'
	sort (in=work_name,record=popost,
	&  key=(pop_comp,pop_locncode,pop_catgcode,pop_item),tempfile=temp_name)
	return
.end

