;==File=================================================================;
; PO4000L.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=============================================================;
;	po4000l		Purchase Order line item entry.
;==Changes==============================================================;
; 04/21/2011 lso - Add item Picture button to line item entry
; 01/08/2007 ESC - Add new Reference to function the same as Remarks
; 03/06/2002 tah - Correct deleting of lines already flagged as deleted.
; 09/17/2001 tah - Change to update inventory kits.
;=======================================================================;
.subroutine po4000l

	a_function	,a	; IN  - I - initialize
				;	G - get data
				;	D - delete order
	a_pohedr	,a	; I/O - Order header record
	a_apvend	,a	; IN  - Vendor record
	a_load_chan	,n	; IN  - Channel from which to load records
	a_oamt_id	,n	; IN  - Totals display window ID

.define MAX_LINES, 500

.start nopage,nolist
.include "WND:tools.def"
.include "WND:system.def"
.include "UTS:dteut.def"
.include "POS:dtepo.def"
.include "INS:dtein.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"
.include "INS:inlocn.rec"
.include "INS:initvc.rec"
.include "INS:inkits.rec"
.include "APS:apvend.rec"
.include "SMS:smcode.rec"

;	This global section is necessary for list load method
.define PO4000L_GBL, 1
.include "POS:po4000l.gbl"
.undefine PO4000L_GBL

record	list_header
			,a*	@1,	'Seq'
			,a*	@7,	'Item'
			,a*	@31,	'Description'
			,a*	@65,	'Quantity'
.align
static record
	col_id		,i4
	list_id		,i4		; find id
	inp_id		,i4		; input column id
	price_id	,i4		; price window id
	qty_id		,i4		;  id
	req		,i4
	srch		,i4		; search parameter
	wind_no		,i4		; input window id
	wlist_ptr	,i4		; work pointer to list position

record
	cur_linetype	,a1		; current line type
	find_status	,d1		; for call to history
	force_next	,d1		; force an i_next after m_signal
	hold_key	,a12		; saved line item key
	kit_units	,d9.3		; kit units to update
	line_exists	,d1		; line is already on file
	list_compare	,a%size(poline)	; Record for comparison
	  list_linetype ,a1	@list_compare+11
	order_qty	,d9.3
	post_flag	,a1		; P:post, U:unpost
	post_qty	,d9.3
	wind_name	,a*,	'po4000m'
	wrk_item	,a24		; for call to vendor history
.start nopage,list

.proc
	if %passed(a_pohedr) pohedr = a_pohedr
	if %passed(a_apvend) apvend = a_apvend
	
	case a_function of
	  begincase
	  'I': call init_windows
	  'D': call delete_all_lines
	  'G': call get_data
	  endcase
	xcall status
	xreturn		; to calling program

	;===================== Initialize windows ===================;
init_windows,
	xcall lodwin ('LNL',wind_name,wind_no)
	xcall i_ldinp (inp_id, g_utlib, "i_po4000l", D_NOPLC, srch)
	xcall l_create (list_id,inp_id,sel_line,g_utlib,"l_po4000l",,,D_NOPLC,,,,opcde)
	xcall l_sect (list_id, list_header, D_HEADER)
	if (ut_windows.eq.FALSE) xcall lodcol ('LNL','inq_po4000m',col_id)
	return

	;================ Delete all lines on an order ================;
delete_all_lines,
	xcall db_find (poline_chan,pom_key,0,'M',,,opcde)
	if (opcde) return
	repeat
	  begin
	    xcall db_next (poline_chan,poline,'F','M',,,opcde)
	    if (opcde .or. pom_key.ne.pol_key) exitloop
	    if (pol_linetype.eq.'I') .and.
	    &  (pol_status.ne.'D')
	      begin
		clear ini_upc
		call get_item
		call unpost_line_item
		clear pol_ordqty
	      end
	    xcall db_delete (poline_chan,poline,pol_key,poline_log,opcde)
	  end
	clear pom_totamt,pom_ordwgt,pom_ordcubes,pom_ordqty
	a_pohedr = pohedr
	return

	;===================== Main processing loop ===================;
get_data,
	xcall l_place (list_id)
	xcall l_restart (list_id)
	call load_list_array
	call display_totals
	list_ptr = 1
	repeat
	  begin
	    call process_list
	    if (g_entnam.eq.'END') .or.
	    &  (g_entnam.eq.'ABORT')
	      begin
		xcall l_remove (list_id)
		a_pohedr = pohedr
		return
	      end
	  end

;-------------------------- subroutines ------------------------------;
	;	Load internal list array with line items
load_list_array,
	for wlist_ptr from 1 thru MAX_LINES
	    clear list_items[wlist_ptr], list_descr[wlist_ptr],
	    &	  list_ordqty[wlist_ptr],list_deleted[wlist_ptr]
	xcall db_find (a_load_chan,pom_key,0,'M',,,opcde)
	repeat
	  begin
	    xcall db_next (a_load_chan,poline,'F','M',,,opcde)
	    if (opcde) .or.
	    &  (pom_key.ne.pol_key) exitloop
	    wlist_ptr = pol_lineno
	    list_items[wlist_ptr] = pol_item
	    list_descr[wlist_ptr] = pol_descr
	    list_ordqty[wlist_ptr] = pol_ordqty
	    if (pol_status.eq.'D') list_deleted[wlist_ptr] = 'x'
	    if (pol_status.eq.'C') list_deleted[wlist_ptr] = 'c'
	    if (pol_status.eq.'P') list_deleted[wlist_ptr] = 'p'
	  end
	clear poline
	return

	;	Select an item from the list of lines
process_list,
	if (ut_windows.eq.TRUE) xcall m_enable (ut_col_gen,'DELETE')
	req = D_LNOP
	do
	  begin
	    xcall l_select (list_id,req,sel_line,,,,,,ut_col_slw)
	    if (req) then
	      begin
		case req of
		  begincase
		  D_LLOADTOP: req = D_LEOF
		  D_LABORT: g_select = TRUE
		  endcase
		end
	     else
	      begin
		case g_entnam of
		  begincase
		  ' ':		if (sel_deleted.ne.'x') .and.
				&  (sel_deleted.ne.'c') call line_input
		  'END':	exitloop
		  'ABORT':	exitloop
		  'DELETE':	begin
				  opcde = TRUE
				  if (sel_deleted.ne.'c') .and.
				  &  (ut_delete.eq.'Y') xcall confirm (opcde,2)
				  if (opcde.eq.TRUE) call delete_line
				end
		  endcase
	      end
	  end
	 until (g_select)
	if (ut_windows.eq.TRUE) xcall m_disable (ut_col_gen,'DELETE')
	return

	;	Get the selected line and do the input
line_input,
	pol_comp = pom_comp
	pol_order = pom_order
	pol_lineno = sel_line_no
	if (sel_item.ne.UT_BLANKS) then
	  begin			; change existing line item
	    xcall db_read (poline_chan,poline,pol_key,0,'M',,,opcde)
	    if (.not.opcde)
	      begin
		list_compare = poline
		call sub_from_totals
		line_exists = TRUE
		if (pol_linetype.eq.'I') call get_item
		cur_linetype = pol_linetype
		call unpost_line_item
		call full_line_in		
		call post_line_item
		call add_to_totals
		call display_totals
		if (g_entnam.ne.'ABORT') call update_line
		clear g_entnam
	      end
	  end
	 else
	  begin			; add new line item
	    repeat
	      begin
		pol_comp = pom_comp
		pol_order = pom_order
		pol_lineno = sel_line_no
		clear cur_linetype
		pol_status = 'x'
		pol_updcost = 'N'
		clear pol_recuqty,pol_recdqty,pol_recrqty,pol_recpqty,
		&     pol_recdate,pol_rem1prt,pol_remark1,pol_rem2prt,
		&     pol_remark2,pol_extdescr[1],pol_extdescr[2],
		&     pol_extdescr[3],pol_extdescr[4],pol_refrnce1,
		&     pol_ref1prt,pol_refrnce2,pol_ref2prt
		line_exists = FALSE
		call full_line_in		
		if (g_entnam.eq.' ')
		  begin
		    call post_line_item
		    call add_to_totals
		    call display_totals
		    call write_line
		  end
		if (g_entnam.eq.'END')
		  begin
		    clear g_entnam
		    exitloop
		  end
	      end
	  end
	return

	;	Update the existing line item
update_line,
	call calc_total
	xcall db_update (poline_chan,poline,pol_key,poline_log,opcde)
	wlist_ptr = pol_lineno
	xcall l_data (list_id,D_LCURRENT,inp_id,sel_line,,opcde)
	list_items[wlist_ptr] = pol_item
	list_descr[wlist_ptr] = pol_descr
	list_ordqty[wlist_ptr] = pol_ordqty
	clear list_deleted[wlist_ptr]
	if (pol_status.eq.'D') list_deleted[wlist_ptr] = 'x'
	if (pol_status.eq.'C') list_deleted[wlist_ptr] = 'c'
	sel_item = pol_item
	clear sel_deleted
	if (pol_status.eq.'D') sel_deleted = 'x'
	if (pol_status.eq.'C') sel_deleted = 'c'
	sel_descr = pol_descr
	sel_ordqty = pol_ordqty
	xcall i_display (inp_id,'set1',sel_line)
	return

	;	Write a new line item
write_line,
	call calc_total
	xcall db_add (poline_chan,poline,pol_key,poline_log,opcde)
	wlist_ptr = pol_lineno
	xcall l_data (list_id,D_LCURRENT,inp_id,sel_line,,opcde)
	list_items[wlist_ptr] = pol_item
	list_descr[wlist_ptr] = pol_descr
	list_ordqty[wlist_ptr] = pol_ordqty
	clear list_deleted[wlist_ptr]
	sel_item = pol_item
	sel_descr = pol_descr
	sel_ordqty = pol_ordqty
	clear sel_deleted
	xcall l_data (list_id,D_LWRITE,inp_id,sel_line,,opcde)
	xcall i_display (inp_id,'set1',sel_line)
	req = D_LDOWN		; position list to next entry
	xcall l_process (list_id,req,sel_line)
	return

	;-------- full line input key pressed
full_line_in,
	xcall lodwin ('P',,wind_no)
	xcall i_init (wind_no)
	if (line_exists.eq.FALSE) then
	  begin
	    xcall i_enable (wind_no,"PLLTYP")
	    clear pol_item,pol_locncode
	  end
	 else
	  begin
	    call pol_linetype_break
	    xcall i_disable (wind_no,"PLLTYP")
	    xcall i_display (wind_no,'set_show',poline)
	    smc_type = 'L'
	    smc_code = pol_locncode
	    xcall sm_get_code (smcode,wind_no,,'PLLOCN_DESCR')
	    smc_type = 'C'
	    smc_code = pol_catgcode
	    xcall sm_get_code (smcode,wind_no,,'PLCATG_DESCR')
	    smc_type = 'U'
	    smc_code = pol_buomcode
	    xcall sm_get_code (smcode,wind_no,,'PLBUOM_DESCR')
	    case pol_status of
	      begincase
	      ' ': xcall status (,"< Open >")
	      'C': xcall status (,"< Received Complete >")
	      'P': xcall status (,"< Partial Received >")
	      'D': xcall status (,"< Deleted >")
	      'x': xcall status (,"< Incomplete entry >")
	      endcase
	  end

	if (ut_windows.eq.FALSE) xcall lodcol ('P',,col_id)
	xcall i_next (wind_no,'set_ordr','*FRST*')
	do begin
	  if (force_next.eq.TRUE)
	    begin
	      xcall i_next (wind_no,'set_ordr','*NEXT*')
	      force_next = FALSE
	    end
	  xcall i_input (wind_no,'set_ordr',poline,,ut_col_sel)
	  if g_select
	    begin
	      case g_entnam of
		begincase
		'END':	   begin
			    if (pol_status.eq.'x') clear pol_status
			    exitloop
			   end
		'ABORT':   exitloop
		'PO_EXTD': if (pol_status.eq.'C')
			    then xcall message (DTEPO_LCD)
			    else call extd_descr_in
		'PO_HIST': call vendor_history
;;		'PO_OORD': if (po_cmtype.ne.'??')
;;				xcall po_inq_item (ini_item,1,ut_err)
		'PO_REMK': if (pol_status.eq.'C')
			    then xcall message (DTEPO_LCD)
			    else call remarks_in
		'PO_REFR': if (pol_status.eq.'C')
			    then xcall message (DTEPO_LCD)
			    else call refer_in	
		'PO_RTOT': call reprice_order
		'NOTES':   begin
			    g_entnam = 'U_NOTES'
			    xcall usr_utils (pohedr)
			   end
		'PIC':  xcall dte_picture (ini_picname)		;lso
		'@':	   call process_signal
		endcase
	    end
	  end until (.not.g_setsts) .and. (.not.g_select)
	xcall status
	if (pol_status.eq.'x') clear pol_status
	xcall lodwin ('R',,wind_no)
	if (ut_windows.eq.FALSE) xcall lodcol ('RC',,col_id)
	return

	;	Process any break signals
process_signal,
	force_next = (.not.ut_windows)
	case g_entnam of
	  begincase
	  '@PLLTYP': call pol_linetype_break
	  '@PLITEM': call pol_item_break
	  '@PLLOCN': call pol_locn_break
	  '@PLORQT': call pol_qty_break
	  endcase
	return

	;-------- extended description key pressed
extd_descr_in,
	xcall po4000e (poline)
	g_select = 1
	return

	;-------- input line item remarks screen
remarks_in,
	xcall po4000r (poline,initem)
	g_select = 1
	return

	;-------- input line item reference screen
refer_in,
	xcall po4000f (poline,initem)
	g_select = 1
	return

	;-------- reprice complete order
reprice_order,
	hold_key = pol_key
	call compute_totals
	call display_totals
	pol_key = hold_key
	xcall db_read (poline_chan,poline,pol_key,0,'M',,,opcde)
	call sub_from_totals
	return

	;-------- reset fields within input window
reset_mfield,
	xcall i_init (wind_no,,,g_fldnam)
	xcall i_next (wind_no,'set_ordr',g_fldnam)
	return

;-------------------------- break processing -------------------------;

	;-------- line type break
pol_linetype_break,
	if (pol_linetype.eq.'N') then
	  begin
	    xcall i_disable (wind_no,'PLUPDT')
	    xcall i_fldmod (wind_no,'PLITEM',,,D_OFF,D_FLD_CHANGE)
	  end
	 else
	  begin
	    xcall i_enable (wind_no,'PLUPDT')
	    xcall i_fldmod (wind_no,'PLITEM',,,D_FLD_CHANGE,'INITEM_CHANGE')
	  end
	return

	;-------- item id break
pol_item_break,
	if (pol_locncode.eq.UT_BLANKS)
	  begin
	    pol_locncode = pom_locncode
	    xcall i_dspfld (wind_no,'PLLOCN',pol_locncode)
	    smc_type = 'L'
	    smc_code = pol_locncode
	    xcall sm_get_code (smcode,wind_no,,'PLLOCN_DESCR')
	  end
	call item_break
	if (pol_linetype.ne.'N')
	  begin
	    if (.not.opcde) then
	      begin
		xcall i_dspfld (wind_no,'PLLOCN',inl_locncode)
		xcall i_dspfld (wind_no,'PLDESC',pol_descr)
		xcall i_next (wind_no,'set_ordr','PLORQT')
		force_next = FALSE
	      end
	     else
	      begin
                if (po_cmmloc.eq.'N') call reset_field
	      end
	  end
	return

	;-------- location break
pol_locn_break,
	call item_break
	if (pol_linetype.ne.'N')
	  begin
	    if (.not.opcde) then
	      begin
		pol_locncode = inl_locncode
		xcall i_dspfld (wind_no,'PLDESC',pol_descr)
		xcall i_next (wind_no,'set_ordr','PLORQT')
		force_next = FALSE
	      end
	     else call reset_field
	  end
	return

	;-------- quantity break from short line window
pol_qty_break,
	return

	;-------- item id break
item_break,		; item id break
	if (pol_linetype.eq.'N') .and.		; Non-stock item
	&  (line_exists.eq.FALSE)		;  and new item
	  begin
	    xcall inifmt (pol_item)
	    pol_slst = 'N'
	    pol_pfactor = 1
	    pol_catgcode = '???'
	    pol_buomcode = 'EA '
	    pol_reqdate = pom_reqdate
	    pol_locncode = pom_locncode
	    clear pol_weight,pol_cubes,pol_vendpn,pol_ucost,pol_updcost,
	    &	  pol_rejcode,pol_rem1prt,pol_remark1,pol_rem2prt,pol_remark2,
	    &     pol_extdescr[1],pol_extdescr[2],pol_extdescr[3],pol_extdescr[4],
	    &     pol_refrnce1,pol_ref1prt,pol_refrnce2,pol_ref2prt
	  end
	if (pol_linetype.eq.'I') 		; Stock item
	  begin
	    clear ini_upc
	    if (in_cmupc.eq.'Y') ini_upc = pol_item
	    xcall inifmt (pol_item)
	    call get_item
	    if (opcde) then
	      begin
		xcall message (DTEPO_INF,D_ERROR)
		opcde = -1
	      end
	     else
	      begin
		pol_slst = ini_slst
		pol_pfactor = ini_uomfactor
		if (line_exists.eq.FALSE) .or.
		&  (pol_item.ne.list_compare(13:24))
		  begin				; Find was by upc
		    pol_item = ini_item
		    if (po_cmmloc.eq.'N') pol_locncode = inl_locncode
		    pol_descr = ini_desc
		    pol_catgcode = ini_catgcode
		    pol_buomcode  = ini_buomcode
		    pol_weight = ini_weight
		    pol_cubes = ini_cubes
		    pol_reqdate = pom_reqdate
		    pol_ucost = inl_lcost
		    pol_updcost = 'Y'
		    clear pol_vendpn

		    inv_comp = pom_comp		; get item vendor information
		    inv_item = pol_item
		    inv_locncode = pol_locncode
		    inv_type = 'V'
		    inv_vend_cust = pom_vend
		    xcall db_find (initvc_chan,inv_key,0,'M',,,opcde)
		    if (.not.opcde) then
		      begin
			xcall db_next (initvc_chan,initvc,'F','M',,,opcde)
			pol_vendpn = inv_partno
			if (inv_fdate.ne.0) .and.
			&  (inv_fdate.le.pom_orddate)
			 then pol_ucost = inv_fcost	; future is now
			 else pol_ucost = inv_cost	; now
		      end
		     else clear opcde
		    xcall i_dspfld (wind_no,'PLCOST',pol_ucost)
		  end
		xcall status

		case ini_status of
		  begincase
		  'I': begin			; item is inactive
			xcall message (DTEIN_INA,D_ERROR)
			opcde = -1
		       end
		  'N': begin			; item is not saleable
			xcall message (DTEIN_NSI,D_ERROR)
			opcde = -1
		       end
		  endcase

		if (ini_mnfctrd.ne.'N') .and.	; Yes or Document only
		&  (.not.opcde)
		  begin
		    xcall po4000e (poline)
		    g_select = TRUE
		    clear opcde
		  end
	      end
	  end
	return

	;       reset an input field
reset_field,
	xcall i_init (wind_no,,,g_fldnam)
	xcall i_next (wind_no,'set_ordr',g_fldnam)
	force_next = FALSE
	return

	;       add up line item totals and display
compute_totals,
	clear pom_totamt,pom_ordwgt,pom_ordcubes,pom_ordqty
	list_compare = poline	; save current record
	hold_key = pol_key
	xcall db_find (poline_chan,pom_key,0,'M',,,opcde)
	repeat
	  begin
	    xcall db_next (poline_chan,poline,'F','M',,,opcde)
	    if (opcde) .or.
	    &  (pom_key.ne.pol_key) exitloop
	    if (pol_item) .and.
	    &  (pol_status.ne.'D') call add_to_totals
	  end
	pol_key = hold_key
	xcall db_read (poline_chan,poline,pol_key,0,'M',,,opcde)
	poline = list_compare	; restore current record
	call display_totals
	return

	;	post line item quantities to inventory record
post_line_item,
	if (pol_linetype.eq.'I')
	  begin
	    post_flag = 'P'
	    post_qty = pol_ordqty - pol_recuqty - pol_recpqty
	    if (ini_controlled.eq.'Y')
		xcall instkord (pol_item,pol_locncode,post_qty,opcde)
	    if (ini_slst.eq.'K') call update_kit
	  end
	return

	;	back out inventory posting of line item
unpost_line_item,
	if (pol_linetype.eq.'I')
	  begin
	    post_flag = 'U'
	    post_qty = pol_ordqty - pol_recuqty - pol_recpqty
	    if (ini_controlled.eq.'Y')
		xcall instkdor (pol_item,pol_locncode,post_qty,opcde)
	    if (ini_slst.eq.'K') call update_kit
	  end
	return

	;	Update for received kit
update_kit,
	inkitm.comp = pol_comp
	inkitm.item = pol_item
	clear inkitm.seqn
	xcall db_read (inkits_chan,inkitm,inkitm.key,0,'M',,,opcde)
	if (opcde) return		; not found
	repeat
	  begin
	    xcall db_next (inkits_chan,inkcmp,'F','M',,,opcde)
	    if (opcde) .or.
	    &  (inkcmp.comp.ne.pol_comp) .or.
	    &  (inkcmp.item.ne.pol_item) return
	    ini_comp = inkcmp.comp
	    ini_item = inkcmp.citem
	    xcall in_get_item (initem)
	    if (.not.opcde) .and.
	    &  (ini_controlled.eq.'Y')
	      begin
		if (inkcmp.qty.lt.0) then
		  begin
		    if (post_flag.eq.'P')
		     then kit_units = -inkcmp.qty
		     else kit_units = inkcmp.qty
		  end
		 else kit_units = (post_qty * inkcmp.qty)
		if (post_flag.eq.'P')
		 then xcall instkord (inkcmp.citem,pol_locncode,kit_units,opcde)
		 else xcall instkdor (inkcmp.citem,pol_locncode,kit_units,opcde)
	      end
	  end
	return

	;-------- Vendor history function key pressed
vendor_history,
	wrk_item = pol_item
	if (wrk_item.eq.ut_blanks)
	 then xcall po_inq_hist (pom_vend,,,find_status)
	 else xcall po_inq_hist (pom_vend,,wrk_item,find_status)
	return

	;       notes option chosen from line item input
notes_process,
	if (a_function.eq.'G')
	  begin
	    g_entnam = 'U_NOTE'
	    xcall usr_utils (a_pohedr)
	  end
	return

	;	Delete function from list process
delete_line,
	pol_comp = pom_comp
	pol_order = pom_order
	pol_lineno = sel_line_no
	if (sel_item.ne.UT_BLANKS)
	  begin
	    xcall db_read (poline_chan,poline,pol_key,0,'M',,,opcde)
	    if (.not.opcde)
	      begin
		case pol_status of
		  begincase
		    'C': begin
			  xcall confirm (opcde,89)
			  if (opcde.eq.TRUE)
			    begin
			      clear pol_status,sel_deleted
			      call update_line
			    end
			 end
		    'D': begin
			  clear pol_status,sel_deleted
			  call get_item
			  pol_descr = ini_desc
			  xcall i_dspfld (wind_no,'PLDESC',pol_descr)
			  call add_to_totals
			  call display_totals
			  call update_line
			 end
		    ' ': begin
			  pol_status = 'D'
			  sel_deleted = 'x'
			  pol_descr = '?? Deleted Line Item ??'
			  xcall i_dspfld (wind_no,'PLDESC',pol_descr)
			  call sub_from_totals
			  call display_totals
			  call update_line
			 end
		  endcase
	      end
	  end
	return

add_to_totals,
	call set_ord_qty
	pom_totamt = pom_totamt + (order_qty * pol_ucost)
	pom_ordwgt = pom_ordwgt + (order_qty * pol_weight)
	pom_ordcubes = pom_ordcubes + (order_qty * pol_cubes)
	pom_ordqty = pom_ordqty + order_qty
	return

sub_from_totals,
	call set_ord_qty
	pom_totamt = pom_totamt - (order_qty * pol_ucost)
	pom_ordwgt = pom_ordwgt - (order_qty * pol_weight)
	pom_ordcubes = pom_ordcubes - (order_qty * pol_cubes)
	pom_ordqty = pom_ordqty - order_qty
	return

set_ord_qty,
	order_qty = pol_ordqty - pol_recdqty
	if (order_qty.lt.0) clear order_qty
	if (pol_pfactor.le.0) pol_pfactor = 1
	return

display_totals,
	xcall i_dspfld (a_oamt_id,'ORDTOT',pom_totamt)
	xcall i_dspfld (a_oamt_id,'ORDWGT',pom_ordwgt)
	xcall i_dspfld (a_oamt_id,'ORDCUB',pom_ordcubes)
	xcall i_dspfld (a_oamt_id,'ORDUNT',pom_ordqty)
	return

calc_total,
	pol_ordcost = (pol_ucost * pol_ordqty)
	pol_ordcost = pol_ordcost - ((pol_ordcost * pol_discpct) / 100.0)
	return

	;	Get inventory item and location records
get_item,
	ini_comp = pom_comp
	ini_item = pol_item
	xcall in_get_item (initem)
	inl_comp = pom_comp
	inl_item = pol_item
	inl_locncode = pol_locncode
	xcall in_get_locn (inlocn)
	return

.end
;=======================================================================;
.subroutine poll_po4000	; Load List with order line information

	a_listid        ,n	; IN  - ID for list
	a_request       ,n	; IN  - List request code
	a_data          ,a	; I/O - Data record area
	a_inpid         ,n	; IN  - Input window ID
	a_disabled      ,n	; IN  - True/False to disable list item
	a_index         ,n	; IN  - List item index

.start nopage,nolist
.include "POS:po4000l.gbl"
.start nopage,list

.proc
	sel_line_no = list_ptr
	sel_item = list_items[list_ptr]
	sel_descr = list_descr[list_ptr]
	sel_ordqty = list_ordqty[list_ptr]
	sel_deleted = list_deleted[list_ptr]
	xcall i_display (a_inpid,'set1',sel_line)
	if %passed(a_data) a_data = sel_line
	incr list_ptr
	if (list_ptr.gt.MAX_LINES) a_request = D_LEOF
	xreturn
.end
;=======================================================================;

