; PO2600.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=============================================================;
;	po2600		Purchase order inquiry program.
;	po2600tb	Toolbar routine.
;==Changes==============================================================;
; 10/02/2000 tah - Changes for i_disable xcall.
; 07/17/2000 tah - Add toolbar processing
;=======================================================================;
.subroutine po2600

	a_order		,n	; IN  - optional, order number to display.

.start nopage,nolist
.include "WND:toolbar.def"
.include "WND:tools.def"
.include "WND:fldinf.def"
.include "UTS:dtb.gbl"

.include "UTS:dteut.def"
.include "POS:dtepo.def"

.include "UTS:utcomm.gbl"
.include "INS:incomm.gbl"
.include "POS:pocomm.gbl"
.include "POS:poline.rec"
.include "APS:apcomm.gbl"
.include "APS:aphist.rec"
.include "NAS:nacomm.gbl"
.include "SMS:smcode.rec"

external function
	inp_done	,^val

global data section po2600, INIT
record	field_info
	inp_wind_no	,i4		; Input window number
	field_enabled	,d1		; Enabled or disabled fields
.include "POS:pohedr.rec"
record	,X
	dtb_table	,a%size(pohedr)
	dtb_key		,a%size(pom_key) @dtb_table
endglobal

record
	abort		,d1
	ap_lookup_key	,a8
	  ap_comp	,a2	@ap_lookup_key
	  ap_pono	,d6	@ap_lookup_key+2
	beg_key		,a8
	  beg_comp	,a2	@beg_key
	  beg_order	,a6	@beg_key+2
	col_id		,i4
	aphist_open	,d1
	initem_open	,d1
	namast_open	,d1
	pohedr_open	,d1
	poline_open	,d1
	smcode_open	,d1
	wind_name	,a*,	'po2600'	; Header window
	wind_line	,a*,	'po2600l'	; Line detail window
	wind_line_no	,i4			; Line detail window ID
	wrk_amt		,d9.2
.start nopage,list

.proc
	;>>>>>	Main processing  <<<<<;
	call do_setup			; Set up environment and security
	call open_files			; Open needed data file tables
	call init_windows		; Init windows routines
	call init_data_toolbar		; Init the data toolbar
	repeat				; Loop to process the input window
	  begin
	    call process_input
	    if (g_entnam.eq.'END') exitloop
	  end
	call close_files		; Close all data files
	call do_shutdown		; Clean up
	xreturn				; Return to calling program

	;>>>>>	End of main processing  <<<<<;

do_setup,
	xcall e_enter			; Enter a new environment
	xcall lodcol ('RL')		; remove local columns
	if (ut_windows.eq.FALSE) xcall lodcol ('LPL','inq_po2600',col_id)
	ut_calprg = 'po2600'
	beg_comp = ut_cmcomp
	if %passed(a_order) beg_order = a_order, 'XXXXXX'
	return

do_shutdown,
	clear g_entnam
	xcall dtb_close 		; Close data toolbar
	xcall e_exit			; Exit the current environment
	return

open_files,
	abort = FALSE
	if (pohedr_chan)
	 then pohedr_open = FALSE
	 else
	  begin
	    xcall open (pohedr_chan,'I:I',pohedr_name)
	    pohedr_open = TRUE
	  end
	if (poline_chan)
	 then poline_open = FALSE
	 else
	  begin
	    xcall open (poline_chan,'I:I',poline_name)
	    poline_open = TRUE
	  end
	if (aphist_chan)
	 then aphist_open = FALSE
	 else
	  begin
	    xcall open (aphist_chan,'I:I',aphist_name)
	    aphist_open = TRUE
	  end
	if (namast_chan)
	 then namast_open = FALSE
	 else
	  begin
	    xcall open (namast_chan,'I:I',namast_name)
	    namast_open = TRUE
	  end
	if (initem_chan)
	 then initem_open = FALSE
	 else
	  begin
	    xcall open (initem_chan,'I:I',initem_name)
	    initem_open = TRUE
	  end
	if (smcode_chan)
	 then smcode_open = FALSE
	 else
	  begin
	    xcall open (smcode_chan,'I:I',smcode_name)
	    smcode_open = TRUE
	  end
	return

	;	Close the data files opened for the report
close_files,
	if (pohedr_open.eq.TRUE) xcall close (pohedr_chan,DTE_CLOSE)
	if (poline_open.eq.TRUE) xcall close (poline_chan,DTE_CLOSE)
	if (aphist_open.eq.TRUE) xcall close (aphist_chan,DTE_CLOSE)
	if (namast_open.eq.TRUE) xcall close (namast_chan,DTE_CLOSE)
	if (initem_open.eq.TRUE) xcall close (initem_chan,DTE_CLOSE)
	if (smcode_open.eq.TRUE) xcall close (smcode_chan,DTE_CLOSE)
	return

	;	Initialize the window information
init_windows,
	clear field_info
	xcall lodwin ('LPL',wind_name,inp_wind_no)
	xcall lodwin ('LNL',wind_line,wind_line_no)
	xcall lodinp ('PD')		; Place input column (for find function)
	field_enabled = TRUE
	return

	;	Initialize the data toolbar functions
init_data_toolbar,
	dtb_add = 'N'			; Do not allow Add
	dtb_chg = 'N'			; Do not allow Change
	dtb_del = 'N'			; Do not allow Delete
	dtb_mov = 'Y'			; Allow movement
	xcall dtb_init (pohedr_chan,inp_wind_no,beg_comp,,'po2600tb')
	xcall po2600tb ('FRST')		; Position and display first
	if %passed(a_order)
	  begin
	    xcall db_read (pohedr_chan,pohedr,beg_key,0,'M',1,,opcde)
	    if (.not.opcde) xcall i_display (inp_wind_no,'set_show',pohedr)
	  end
	call display_linked_fields	;  record on file
	return

	;	Do input for the window
process_input,
	repeat
	 begin
	  dtb_setname = 'set_chg'
	  xcall i_next (inp_wind_no,dtb_setname,"*NONE*")
	  do begin
	    xcall i_input (inp_wind_no,dtb_setname,pohedr,,ut_col_sel,,ut_windows)
	    if g_select
	      begin
		if (g_entnam(1:1).ne.'^') xcall po2600tb (g_entnam)
		case g_entnam of
		  begincase
		  'END':   return
		  '^DISP': call display_linked_fields
		  '^FIND': call find_record
	          'LIN':   call disp_order_lines
	          'API':   call disp_ap_invoice
		  endcase
	      end
	  end until (.not.g_setsts) .and. (.not.g_select)
	 end

	;--------------------	display order lines
disp_order_lines,
	xcall dtb_toolbar ('DI')
	repeat
	  begin
	    xcall po_inq_line (poline,pom_key)
	    if (.not.pol_key) exitloop
	    xcall lodwin ('P',,wind_line_no)
	    xcall i_display (wind_line_no,'set_show',poline)
	    smc_type = 'U'
	    smc_code = pol_buomcode
	    xcall sm_get_code (smcode,wind_line_no,,'BUOMD')
	    xcall i_dspfld (wind_line_no,'PLTAMT',pol_ordcost)
	    wrk_amt = (pol_ucost * pol_recuqty)
	    wrk_amt = wrk_amt - ((wrk_amt * pol_discpct) / 100.0)
	    xcall i_dspfld (wind_line_no,'PLDAMT',wrk_amt)
	    wrk_amt = (pol_ucost * pol_recdqty)
	    wrk_amt = wrk_amt - ((wrk_amt * pol_discpct) / 100.0)
	    xcall i_dspfld (wind_line_no,'PLAAMT',wrk_amt)
	    wrk_amt = (pol_ucost * pol_recrqty)
	    wrk_amt = wrk_amt - ((wrk_amt * pol_discpct) / 100.0)
	    xcall i_dspfld (wind_line_no,'PLRAMT',wrk_amt)
	    wrk_amt = (pol_ucost * pol_recpqty)
	    wrk_amt = wrk_amt - ((wrk_amt * pol_discpct) / 100.0)
	    xcall i_dspfld (wind_line_no,'PLPAMT',wrk_amt)
	    xcall dte_wait
	    xcall lodwin ('R',,wind_line_no)
	  end
	xcall dtb_toolbar ('EN')
	return

	;--------------------	display A/P invoices
disp_ap_invoice,
	xcall dtb_toolbar ('DI')
	xcall e_enter
	ap_comp = pom_comp
	ap_pono = pom_order
	xcall ut_find ('aphist',aphist_chan,aphist,ap_lookup_key,4)
	xcall e_exit
	xcall dtb_toolbar ('EN')
	return

	;	Find a record by key or as a lookup list window
	;		(this is coded however needed)
find_record,
	xcall pohedr_lookup (inp_wind_no,pohedr_chan,pohedr,pom_key)
	if (pohedr)
	  begin
	    xcall i_display (inp_wind_no,'SET_SHOW',pohedr)
	    call display_linked_fields
	  end
	g_select = TRUE
	return

	;	Display all linked fields
display_linked_fields,
	xcall i_display (inp_wind_no,'set_show',pohedr)
	smc_type = 'L'
	smc_code = pom_locncode
	xcall sm_get_code (smcode,inp_wind_no,,'phlocn_descr')
	smc_type = 'V'
	smc_code = pom_viacode
	xcall sm_get_code (smcode,inp_wind_no,,'phsvia_descr')
	smc_type = 'B'
	smc_code = pom_buyrcode
	xcall sm_get_code (smcode,inp_wind_no,,'phbuyr_descr')
	return
.end
;=======================================================================;
.subroutine po2600tb

	a_param		,a

.start nopage,nolist
.include "UTL:tools.def"
.include "UTS:dtb.gbl"
.include "UTS:utcomm.gbl"

global data section po2600
record	field_info
	inp_wind_no	,i4		; Input window number
	field_enabled	,d1		; Enabled or disabled fields
.include "POS:pohedr.rec"
record	,X
	dtb_table	,a%size(pohedr)
	dtb_key		,a%size(pom_key) @dtb_table
endglobal
.start nopage,list

.proc

.include "UTS:dtbfunct.inc"

.end
;=======================================================================;

