;==File=================================================================;
; PO4740.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=============================================================;
;	po4740		Post to purchase order history file.
;==Changes==============================================================;
; 02/06/2004 kms - Do not set deleted lines to 'P'.
; 03/06/2002 tah - Correct posting of deleted line items.
; 05/02/2001 tah - Change for new POSNLT file format (kits)
; 05/20/1997 tah - Post linetype to history file.
;=======================================================================;
.subroutine po4740

.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:posnlt.rec"
.include "POS:pohist.rec"
.include "POS:pohsln.rec"
.include "POS:popost.rec"

record
	abort		,d1
	eof		,d1		; end of file switch
	ord_closed	,d1		; order completed/close switch
	temp_name	,a14		; temp file for sort
	  temp_ext	,a3	@temp_name+11
	tot_cost	,d9.2		; total line cost work field
	work_chan	,d3		; work file channel
	work_name	,a14,	'WRK:po4710.ddf'
	  work_ext	,a3	@work_name+11
.start nopage,list

.proc
	;>>>>>	Main processing  <<<<<;
	call do_setup
	call sort_data			; Sort work file before
	call open_files			;  opening to process.
	if (abort.eq.FALSE)
	  begin
	    call process_data
	    eof = TRUE
	    call new_order
	  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
	clear ut_err, ut_ert, pohedr
	return

	;	Shut down environment
do_shutdown,
	xcall e_exit
	return

	;	Open the needed data files
open_files,
	xcall open (work_chan,'I',work_name)
	xcall open (pohist_chan,'U:I',pohist_name)
	xcall open (posnlt_chan,'U:I',posnlt_name)
	xcall open (pohsln_chan,'U:I',pohsln_name)
	return

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

	;	Sort the extracted data
sort_data,
	xcall status (DTEM_SRT)
	work_ext = ut_userid
	temp_name = work_name
	temp_ext = ut_cmterm, 'XXX'
	sort (in=work_name,record=popost,
	&  key=(pop_comp,pop_order,pop_lineno),tempfile=temp_name)
	return

	;	Process the data
process_data,
	abort = FALSE
	xcall status (DTEPO_UHF)
	clear pom_comp
	eof = FALSE
	repeat
	  begin
	    reads (work_chan,popost,process_data_eof)
	    if (pom_comp.ne.pop_comp) .or.
	    &  (pom_order.ne.pop_order) call new_order

	    pol_comp = pop_comp
	    pol_order = pop_order
	    pol_lineno = pop_lineno
	    pol_linetype = pop_linetype
	    xcall db_read (poline_chan,poline,pol_key,0,'M',,,opcde)
	    if (.not.opcde)
	      begin
		if (po_cmkphs.eq.'Y')
		  begin
		    call post_pohist
		    if (pol_slst.eq.'S' .or. pol_slst.eq.'L') call post_serial
		  end
		tot_cost = (pol_recdqty * pol_ucost)
		tot_cost = tot_cost - ((tot_cost * pol_discpct) / 100.0)
		pol_recpqty = pol_recpqty + pol_recdqty
		pol_recuqty = pol_recuqty - (pol_recdqty + pol_recrqty)
		if (pol_recuqty.lt.0) clear pol_recuqty
		clear pol_recdqty,pol_recrqty
		if (pol_pfactor.eq.0) pol_pfactor = 1
		pom_totrcvd = pom_totrcvd + tot_cost
		if (po_cmacls.eq.'N')
		 then pol_status = 'P'		; auto close flag off
		 else pol_status = 'C'		; auto close flag on
		if (pol_status.ne.'D'.and.pol_recpqty.lt.pol_ordqty) pol_status = 'P'
		xcall db_update (poline_chan,poline,pol_key,poline_log,opcde)
	      end
	  end
process_data_eof,
	return

	;	Change in order number, update header
new_order,
	if (pom_order.ne.0)
	  begin
	    call check_lines
	    pom_status = 'C'
	    if (po_cmacls.eq.'N') ord_closed = FALSE	; auto close flag off
	    if (ord_closed.eq.FALSE)
	      begin
		pom_status = 'P'
		clear pom_flag2, pom_flag3, pom_flag4
	      end
	    xcall db_update (pohedr_chan,pohedr,pom_key,pohedr_log,opcde)
	  end
	if (eof.eq.TRUE) return
	pom_comp = pop_comp
	pom_order = pop_order
	xcall db_read (pohedr_chan,pohedr,pom_key,0,'M',,,opcde)
	if (opcde) clear pohedr
	ord_closed = TRUE
	return

	;	check all order lines to see if completed
check_lines,
	ord_closed = TRUE
	xcall db_find (poline_chan,pom_key,0,'M',,,opcde)
	repeat
	  begin
	    xcall db_next (poline_chan,poline,'F','M',,,opcde)
	    if (opcde) .or.
	    &  (pol_comp.ne.pom_comp) .or.
	    &  (pol_order.ne.pom_order)
	      begin
		unlock poline_chan
		return
	      end
	    if (pol_status.ne.'C') .and.
	    &  (pol_status.ne.'D')
	      begin
		ord_closed = FALSE
		unlock poline_chan
		return
	      end
	  end
	return

	;	post to history file
post_pohist,
	poh_comp = pop_comp
	poh_vend = pom_vend
	poh_item = pop_item
	poh_order = pop_order
	poh_lineno = pop_lineno
	poh_linetype = pop_linetype
	poh_orddate = pom_orddate
	poh_recdate = pol_recdate
	poh_locncode = pop_locncode
	poh_descr = pol_descr
	poh_ordqty = pol_ordqty
	poh_recqty = pop_acpqty + pop_rejqty
	poh_buomcode = pol_buomcode
	poh_ucost = pop_ucost
	poh_discpct = pol_discpct
	poh_vendpn = pol_vendpn
	poh_cust = pom_cust
	poh_custord = pom_custord
	poh_pfactor = pol_pfactor
	xcall db_add (pohist_chan,pohist,poh_key,pohist_log,opcde)
	if (pop_rejqty.gt.0)
	  begin
	    poh_recqty = -pop_rejqty
	    xcall db_add (pohist_chan,pohist,poh_key,pohist_log,opcde)
	  end
	return

	;	get serial/lot numbers and post to history
post_serial,
	pos_comp = pol_comp
	pos_order = pol_order
	pos_lineno = pol_lineno
	xcall db_find (posnlt_chan,pos_key(1:11),0,'M',,,opcde)
	if (opcde) return
	repeat
	  begin
	    xcall db_next (posnlt_chan,posnlt,'F','M',,,opcde)
	    if (opcde) .or.
	    &  (pos_comp.ne.pol_comp) .or.
	    &  (pos_order.ne.pol_order) .or.
	    &  (pos_lineno.ne.pol_lineno) return

	    if (pos_linestatus.ne.'D')
	     begin
		pohs_comp = pos_comp
		if (pos_item)			; Is this a kit component
		 then pohs_item = pos_item
		 else pohs_item = pol_item
		pohs_snlt = pos_snlt
		pohs_order = pos_order
		pohs_lineno = pos_lineno
		pohs_recvdate = pos_recdate
		pohs_recqty = pos_qty
		xcall db_add (pohsln_chan,pohsln,pohs_key,pohsln_log,opcde)
	      end
	    xcall db_delete (posnlt_chan,posnlt,pos_key,posnlt_log,opcde)
	  end
.end

