;==File=================================================================;
; PO8300.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=============================================================;
;	po8300		Close purchase orders.
;==Changes==============================================================;
; 03/06/2002 tah - Correct close of deleted line items.
;=======================================================================;
.subroutine po8300

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

record	scr_rec1		; input set 1
	scr_order	,d6		; order number
	scr_vendid	,d8		; vendor id
	scr_vendname	,a30		; vendor name
	scr_status	,a45		; order status line
	scr_confirm	,a3		; confirmation (YES/NO)

record
	abort		,d1
	hlditm		,a24		; saved item id
	hldsnl		,a20		; saved serial/lot number
	recs_read	,d6
	set_name	,a4		; current input set name
	wdone		,d1
	wind_name	,a*,	'po8300'
	wind_no		,d2		; input window id
	wind_signal	,a31
	wrk_qty		,d9.3		; work for quantity
.start nopage,list

.proc
	;>>>>>	Main processing  <<<<<;
	call do_setup
	call open_files
	repeat
	  begin
	    call get_parameters
	    if (abort.eq.TRUE) exitloop
	    call process_data
	    xcall i_init (wind_no)
	    set_name = 'set1'
	  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 (pohedr_chan,'U:I',pohedr_name)
	xcall open (poline_chan,'U:I',poline_name)
	xcall open (initem_chan,'I:I',initem_name)
	xcall open (inlocn_chan,'U:I',inlocn_name)
	return

	;	Close the data files opened for the report
close_files,
	xcall close (pohedr_chan,DTE_CLOSE)
	xcall close (poline_chan,DTE_CLOSE)
	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,
	set_name = 'set1'
	repeat
	  begin
	    xcall get_parameters (wind_no,wind_name,set_name,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
	  '@ORDER': begin
		      xcall status
		      call break_on_order
		    end
	  endcase
	return

verify_input_parameters,
	wdone = TRUE
	if (scr_confirm.ne.'YES')
	  begin
	    xcall i_init (wind_no,,,'ORDER,CONFIRM')
	    xcall i_init (wind_no,'set2')
	    set_name = 'set1'
	    wdone = FALSE
	  end
	return

	;	Process the data
process_data,
	abort = FALSE
	call close_order
	pom_status = 'C'
	xcall db_update (pohedr_chan,pohedr,pom_key,pohedr_log,opcde)
	xcall status (DTEPO_OIC)
	return

close_order,
	pol_comp = ut_cmcomp
	pol_order = scr_order
	xcall db_read (pohedr_chan,pohedr,pom_key,0,'M',,,opcde)
	if (opcde) return

	xcall db_find (poline_chan,pom_key,0,'M',,,opcde)
	if (opcde) return

	repeat
	  begin
	    opcde= DTE_RETRY
	    xcall db_next (poline_chan,poline,'F','M',,,opcde)
	    if (opcde) .or.
	    &  (pom_key.ne.pol_key) return
	    if (pol_linetype.eq.'I') .and.
	    &  (pol_status.ne.'D')
	      begin
		ini_comp = pol_comp
		ini_item = pol_item
		xcall in_get_item (initem)
		if (.not.opcde) .and.
		&  (ini_controlled.eq.'Y')
		  begin
		    wrk_qty = ((pol_ordqty - pol_recpqty) * ini_uomfactor)
		    xcall instkdor (pol_item,pol_locncode,wrk_qty,opcde)
		  end
	      end
	    if (pol_status.eq.'D')
	     then xcall db_delete (poline_chan,poline,pol_key,poline_log,opcde)
	     else
	      begin
		pol_status = 'C'
		xcall db_update (poline_chan,poline,pol_key,poline_log,opcde)
	      end
	  end

break_on_order,
	pom_comp = ut_cmcomp
	pom_order = scr_order
	xcall db_find (pohedr_chan,pom_key,0,'M',,,opcde)
	if (opcde)
	  begin
	    xcall message (DTEPO_ONF)
	    return
	  end
	xcall db_next (pohedr_chan,pohedr,'F','M',,,opcde)
	scr_vendid = pom_vend
	scr_vendname = pom_name
	case pom_status of
	  begincase
	  'O': xcall gettxt (DTEPO_ONC,scr_status)
	  'C': xcall gettxt (DTEPO_OIC,scr_status)
	  'D': xcall gettxt (DTEPO_OID,scr_status)
	  'R': xcall gettxt (DTEPO_PCN,scr_status)
	  'P': xcall gettxt (DTEPO_PRC,scr_status)
	  endcase
	xcall i_display (wind_no,'set2',scr_rec1)
	if (pom_status.ne.'C') .and.
	&  (pom_status.ne.'D') .and.
	&  (pom_status.ne.'R') set_name = 'set3'
	return
.end

