;==File=================================================================;
; QS4000L.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=============================================================;
;	qs4000l		Quotes line item entry.
;==Changes==============================================================;
; 04/24/2007 lso - Adjust for Syn9 requirements
;=======================================================================;
.subroutine qs4000l

	a_function      ,a      ; IN  - I - initialize
				;       G - get data
				;       D - delete order
	a_qshedr        ,a      ; I/O - Quote header record
	a_arcust        ,a      ; IN  - Customer record
	a_price_qty     ,n      ; IN  - Order quantity for pricing
	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 "QSS:dteqs.def"
.include "INS:dtein.def"

.include "UTS:utcomm.gbl"
.include "QSS:qscomm.gbl"
.include "QSS:qshedr.rec"
.include "QSS:qsline.rec"
.include "INS:incomm.gbl"
.include "INS:initem.rec"
.include "INS:inlocn.rec"
.include "INS:inpric.rec"
.include "INS:inkits.rec"
.include "OES:oecomm.gbl"
.include "ARS:arcust.rec"
.include "SMS:smcode.rec"

external function
	smctrl		,a

;	This global section is necessary for list load method
.define qs4000L_GBL, 1
.include "QSS:qs4000l.gbl"
.undefine qs4000L_GBL

record	list_header
			,a*	@1,	'Seq'
			,a*	@6,	'Item'
			,a*	@30,	'Description'
			,a*	@64,	'Quantity'
.align
static record
	col_id		,i4		; column id for unix
	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
	set_name	,a8		; input set for full window

record
	cp_item		,a24		; for call to customer purchase
	cp_units	,d9.3		; for call to customer purchase
	cp_uprice	,d9.3		; for call to customer purchase
	cur_item	,a24		; current item ID
	cur_linetype	,a1		; current line type
	find_status	,d1		; status of find operation
	fldnam		,a30,	"*FRST*"
	force_next	,d1		; force an i_next after m_signal
	hold_key	,a11		; saved line item key
	insuf_onhand	,d1		; insufficient quantity flag
	item_changed	,d1		; item id on existing line was changed
	item_disc_pct	,d6.4		; item discount pct from ipric
	line_exists	,d1		; line is already on file
	list_compare	,a%size(qsline)	; Record for comparison
	  list_linetype ,a1	@list_compare+13
	oamt_name	,a*,	'qs4000d'
	order_qty	,d9.3
	parse_result	,d1		; Item parser result flag
	pdate		,d8		; date for call to calculate price
	price_name	,a*,	'qs4000p'
	price_qty	,d9.3		; total pricing units on order
	promo_flag	,a1		; promotional price flag
	qsline_lchan	,i4		; local channel for substitutes
	quote_qty	,d9.3
	sunit_price	,d9.3		; standard unit price
        u_costs         ,a27            ; costs for call to calculate price
	  u_cost	,[3]d9.3 @u_costs	; Average,Last,Standard
	unit_price	,d9.3		; unit price for call to calculate price
	valid_item	,d1		; valid item id flag
	wind_name	,a*,	'qs4000m'
	wrk_item	,a24		; for history search
.start nopage,list

.proc
	if %passed(a_qshedr) qshedr = a_qshedr
	if %passed(a_arcust) arcust = a_arcust
	
	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_qs4000l", D_NOPLC, srch)
	xcall l_create (list_id,inp_id,sel_line,g_utlib,"l_qs4000l",,,D_NOPLC,,,,opcde)
	xcall l_sect (list_id, list_header, D_HEADER)
	set_name = 'set_chg'
        if (qs_cmmloc.eq.'N') xcall i_setdel (wind_no,'set_add','QLLOCN')
	xcall qs4000s ('I',qshedr)
	if (ut_windows.eq.FALSE) xcall lodcol ('LNL','inq_qs4000m',col_id)
	return

	;================ Delete all lines on an order ================;
delete_all_lines,
	xcall db_find (qsline_chan,qsh_key,0,'M',,,opcde)
	if (opcde) return
	repeat
	  begin
	    xcall db_next (qsline_chan,qsline,'F','M',,,opcde)
	    if (opcde .or. qsh_key.ne.qsl_key) exitloop
	    if (qsl_linetype.eq.'I')
	      begin
		clear ini_upc
		call get_item
		clear qsl_ordqty
	      end
	    xcall db_delete (qsline_chan,qsline,qsl_key,qsline_log,opcde)
	  end
	clear qsh_ordamt,qsh_ordwgt,qsh_ordcubes,qsh_ordqty
	a_qshedr = qshedr
	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_qshedr = qshedr
		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,qsh_key,0,'M',,,opcde)
	repeat
	  begin
	    xcall db_next (a_load_chan,qsline,'F','M',,,opcde)
	    if (opcde) .or.
	    &  (qsh_key.ne.qsl_key) exitloop
	    if (qsl_subseq.eq.0)
	      begin
		wlist_ptr = qsl_lineno
		list_items[wlist_ptr] = qsl_item
		list_descr[wlist_ptr] = qsl_descr
		list_ordqty[wlist_ptr] = qsl_ordqty
		if (qsl_linestatus.eq.'D') list_deleted[wlist_ptr] = 'x'
	      end
	  end
	clear qsline
	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 (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,
	qsl_comp = qsh_comp
	qsl_quote = qsh_quote
	qsl_revno = qsh_revno
	qsl_lineno = sel_line_no
	clear qsl_subseq
	if (sel_item.ne.UT_BLANKS) then
	  begin			; change existing line item
	    xcall db_read (qsline_chan,qsline,qsl_key,0,'M',,,opcde)
	    if (.not.opcde)
	      begin
		list_compare = qsline
		call sub_from_totals
		line_exists = TRUE
		if (qsl_linetype.eq.'I') call get_item
		cur_item = qsl_item
		call full_line_in		
		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
		qsl_comp = qsh_comp
		qsl_quote = qsh_quote
		qsl_lineno = sel_line_no
		qsl_linestatus = 'x'
		clear cur_linetype,cur_item
		line_exists = FALSE
		call full_line_in		
		if (g_entnam.eq.' ')
		  begin
		    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,
	xcall db_update (qsline_chan,qsline,qsl_key,qsline_log,opcde)
	wlist_ptr = qsl_lineno
	xcall l_data (list_id,D_LCURRENT,inp_id,sel_line,,opcde)
	list_items[wlist_ptr] = qsl_item
	list_descr[wlist_ptr] = qsl_descr
	list_ordqty[wlist_ptr] = qsl_ordqty
	clear list_deleted[wlist_ptr]
	if (qsl_linestatus.eq.'D') list_deleted[wlist_ptr] = 'x'
	if (qsl_linestatus.eq.'C') list_deleted[wlist_ptr] = 'c'
	sel_item = qsl_item
	clear sel_deleted
	if (qsl_linestatus.eq.'D') sel_deleted = 'x'
	if (qsl_linestatus.eq.'C') sel_deleted = 'c'
	sel_descr = qsl_descr
	sel_ordqty = qsl_ordqty
	xcall i_display (inp_id,'set1',sel_line)
	return

	;	Write a new line item
write_line,
	xcall db_add (qsline_chan,qsline,qsl_key,qsline_log,opcde)
	wlist_ptr = qsl_lineno
	xcall l_data (list_id,D_LCURRENT,inp_id,sel_line,,opcde)
	list_items[wlist_ptr] = qsl_item
	list_descr[wlist_ptr] = qsl_descr
	list_ordqty[wlist_ptr] = qsl_ordqty
	clear list_deleted[wlist_ptr]
	sel_item = qsl_item
	sel_descr = qsl_descr
	sel_ordqty = qsl_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)
	item_changed = FALSE
	if (line_exists.eq.FALSE)
	 then xcall i_enable (wind_no,"QLLTYP")
	 else
	  begin
	    call qsl_linetype_break
	    xcall i_disable (wind_no,"QLLTYP")
	    call display_line_item
	    case qsl_linestatus of
	      begincase
	      ' ': xcall status (,"< Open >")
	      'C': xcall status (,"< Complete >")
	      '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_name,'*FRST*')
	do begin
	  if (force_next.eq.TRUE)
	    begin
	      xcall i_next (wind_no,set_name,'*NEXT*')
	      force_next = FALSE
	    end
	  xcall i_input (wind_no,set_name,qsline,,ut_col_sel)
	  if g_select
	    begin
	      case g_entnam of
		begincase
		'END':	   begin
			    if (qsl_linestatus.eq.'x') clear qsl_linestatus
			    exitloop
			   end
		'ABORT':   exitloop
		'QS_EXTD': if (qsl_linestatus.eq.'C')
			    then xcall message (DTEQS_LCD)
			    else call extd_descr_in
		'QS_REPR': call reprice_order
		'QS_PRIC': call price_inquiry
		'OE_HIST': call customer_history
		'OE_CPUR': if (oe_cmpurch.eq.'Y') call customer_purchase
		'QS_SUBS': begin
			    list_compare = qsline	; save current record
			    unlock qsline_chan
			    xcall open (qsline_lchan,'U:I',qsline_name,DTE_LOCAL)
			    xcall qs4000s ('G',qshedr,qsl_lineno,arc_clss,
			    &			arc_terr,qsline_lchan)
			    xcall close (qsline_lchan,DTE_CLOSE)
			    qsline = list_compare	; restore current record
			    if (line_exists.eq.TRUE)
				xcall db_read (qsline_chan,qsline,qsl_key,0,'M',,,opcde)
			    g_select = 1
			   end
		'NOTES':   begin
			    g_entnam = 'U_NOTES'
			    xcall usr_utils (qshedr)
			   end
		'@':	   call process_signal
		endcase
	    end
	  end until (.not.g_setsts) .and. (.not.g_select)
	xcall status
	if (qsl_linestatus.eq.'x') clear qsl_linestatus
	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
	  '@QLLTYP': call qsl_linetype_break
	  '@QLITEM': call qsl_item_break
	  '@QLLOCN': call qsl_locn_break
	  '@QLORQT': call qsl_qty_break
	  '@QLPRCE': call qsl_uprice_break
	  '@QLCATG': call qsl_catg_break
	  '@QLDSTA': call qsl_discst_break
	  endcase
	return

	;-------- reprice key pressed
reprice_order,
	list_compare = qsline           ; save current record
	call compute_totals
	if (oe_cmptot.eq.'Y')		; Order volume pricing is on
	  begin
	    if (a_price_qty)
	     then xcall qs4000p (qshedr,arc_clss,arc_terr,a_price_qty)
	     else xcall qs4000p (qshedr,arc_clss,arc_terr,price_qty)
	  end
	call display_totals
	call sub_from_totals
	qsl_key = hold_key
	xcall db_read (qsline_chan,qsline,qsl_key,0,'M',,,opcde)
	unit_price = qsl_uprice         ; save changed unit price
	qsline = list_compare           ; restore current record
	qsl_uprice = unit_price         ; restore changed price
	xcall i_dspfld (wind_no,'QLPRCE',qsl_uprice)
	return

	;-------- price inquiry key pressed
price_inquiry,
	if (ini_qtyprc.eq.'Y') then
	  begin
	    xcall in2700 (arcust,initem,inlocn)
	    g_select = 1
	  end
	 else
	  begin
	    xcall lodwin ('LNL',price_name,price_id)
	    xcall i_dspfld (price_id,'IMPRIC1',inl_price[1])
	    xcall i_dspfld (price_id,'IMPRIC2',inl_price[2])
	    xcall i_dspfld (price_id,'IMPRIC3',inl_price[3])
	    xcall i_dspfld (price_id,'IMPRIC4',inl_price[4])
	    xcall i_dspfld (price_id,'IMPRIC5',inl_price[5])
	    xcall lodwin ('P',,price_id)
	    xcall confirm (opcde,9)
	    xcall lodwin ('D',,price_id)
	  end
	return

	;-------- extended description key pressed
extd_descr_in,
	xcall qs4000e (qsline,initem)
	g_select = 1
	return

	;-------- Get the item unit price
get_unit_price,
	if (qsl_pricetype.eq.' ') qsl_pricetype = 'S'
	if (qsl_linetype.eq.'N') return		; non-stock item

	;       determine unit price

	clear unit_price,sunit_price,item_disc_pct
	promo_flag = 'N'
	if (qsl_linetype.eq.'I')		; stock item
	  begin
	    if (line_exists.eq.TRUE) then	; this is a change
	      begin
		unit_price = qsl_uprice		; current unit price
		sunit_price = qsl_suprice	; standard unit price
	      end
	     else
	      begin
		if (arc_clss.ge.1 .and. arc_clss.le.5)
		 then unit_price = inl_price[arc_clss]
		 else
		  if (inl_margin)		; calculate desired margin
		   then unit_price = (inl_lcost / inl_margin)
		   else unit_price = inl_price[1]
		sunit_price = unit_price	; standard unit price
	      end
	  end
	qsl_uprice = unit_price
	u_cost[1] = inl_acost
	u_cost[2] = inl_lcost
	u_cost[3] = inl_scost
	pdate = qsh_orddate
	if (in_cmpdat.eq.'S') pdate = qsh_reqdate
	if (line_exists.eq.FALSE) .and.
	&  (qsl_linetype.eq.'I')
	  begin
	    clear opcde
	    xcall ipric (qsh_cust,arc_clss,arc_terr,qsl_item,qsl_catgcode,
	    &            qsl_locncode,pdate,qsl_ordqty,unit_price,inl_price,
	    &            u_costs,promo_flag,item_disc_pct)
	  end
	if (promo_flag.ne.'N') qsl_pricetype = promo_flag
	if (line_exists.eq.FALSE .or. qsl_linetype.ne.'N') .and.
	&  (unit_price)
	  begin
	    if (item_disc_pct.eq.0)
	     then qsl_uprice = unit_price
	     else
	      begin
		qsl_discpct = item_disc_pct
		qsl_discstatus = 'L'
	      end
	    xcall i_dspfld (wind_no,'QLPRCE',qsl_uprice)
	  end
	qsl_suprice = sunit_price

	if (ini_controlled.eq.'N')		; non-controlled item
	  begin
	    xcall i_putfld (wind_no,set_name,qsline,'QLQSTA','N')
;;;         xcall i_next (wind_no,set_name,'QLPRCE')
	  end
	return

	;-------- customer history function key pressed
customer_history,
	wrk_item = qsl_item
	if (wrk_item.eq.UT_BLANKS)
	 then xcall oe_inq_hist (qsh_cust,,,find_status)
	 else xcall oe_inq_hist (qsh_cust,,wrk_item,find_status)
	return

	;-------- customer purchase function key pressed
customer_purchase,
	xcall oe4000c (qsh_cust,cp_item,cp_units,cp_uprice)
	if (line_exists.eq.FALSE) .and.
	&  (cp_item.ne.UT_BLANKS)
	  begin
	    xcall i_putfld (wind_no,set_name,qsline,'QLLTYP','I')
	    xcall i_putfld (wind_no,set_name,qsline,'QLITEM',cp_item)
	    xcall i_putfld (wind_no,set_name,qsline,'QLLOCN',qsl_locncode)
	    xcall i_putfld (wind_no,set_name,qsline,'QLORQT',cp_units)
	    xcall i_putfld (wind_no,set_name,qsline,'QLPRCE',cp_uprice)
	    call qsl_item_break
	  end
	return

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

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

	;-------- line type break
qsl_linetype_break,
	if (qsl_linetype.eq.'N')
	 then xcall i_enable (wind_no,"QLACOST,QLLCOST,QLSCOST")
	 else xcall i_disable (wind_no,"QLACOST,QLLCOST,QLSCOST")
	if (qsl_linetype.eq.'N')
	 then xcall i_fldmod (wind_no,'QLITEM',,,D_OFF,D_FLD_CHANGE)
	 else xcall i_fldmod (wind_no,'QLITEM',,,D_FLD_CHANGE,'INITEM_CHANGE')
	return

	;-------- item id break from short line window
qsl_item_break,
	if (qsl_locncode.eq.UT_BLANKS)
	  begin
	    qsl_locncode = qsh_locncode
	    xcall i_dspfld (wind_no,'QLLOCN',qsl_locncode)
	    smc_type = 'L'
	    smc_code = qsl_locncode
	    xcall sm_get_code (smcode,wind_no,,'QLLOCN_DESCR')
	  end
	if (line_exists.eq.TRUE) .and.
	&  (qsl_item.ne.cur_item)
	 then item_changed = TRUE
	 else item_changed = FALSE
	call item_break
	if (item_changed.eq.TRUE) .and.
	&  (valid_item.eq.TRUE)
	  begin
	    call get_unit_price
	    call display_line_item
	  end
	if (qsl_linetype.ne.'N')
	  begin
	    if (valid_item.eq.TRUE) then
	      begin
		xcall i_next (wind_no,set_name,'QLORQT')
		call display_line_item
		force_next = FALSE
	      end
	     else
	      begin
                if (oe_cmmloc.eq.'N') call reset_field
	      end
	  end
	return

	;-------- location break
qsl_locn_break,
	fldnam = g_fldnam
	call item_break
	if (item_changed.eq.TRUE) .and.
	&  (valid_item.eq.TRUE)
	  begin
	    call get_unit_price
	    call display_line_item
	  end
	if (qsl_linetype.ne.'N')
	  begin
	    if (valid_item.eq.TRUE) then
	      begin
		qsl_locncode = inl_locncode
		call display_line_item
		force_next = FALSE
	      end
	     else call reset_field
	  end
	return

	;-------- quantity break
qsl_qty_break,
	if (qsl_slst.eq.'S' .and. qsl_ordqty.gt.200000)
	 then call reset_field
	 else
	  begin
	    call get_unit_price
	    call qsl_uprice_break
	  end
	return

	;-------- item id break
item_break,		; item id break
	valid_item = TRUE
	if (qsl_linetype.eq.'N') .and.		; Non-stock item
	&  (line_exists.eq.FALSE)		;  and new item
	  begin
	    xcall inifmt (qsl_item)
	    qsl_slst = 'N'
	    qsl_pfactor = 1
	    qsl_catgcode = '???'
	    qsl_uomcode = 'EA '
	    clear qsl_commcode
	    qsl_taxstatus = 'T'
	    qsl_discstatus = 'N'
	    qsl_locncode = qsh_locncode
	    qsl_ucosttype = in_cmalcs
;;;	    qsl_reqdate = qsh_reqdate
	    clear qsl_ucost(1),qsl_ucost(2),qsl_ucost(3)
	  end
;;	if (line_exists.eq.FALSE) .and.		; New line, call item parser
;;	&  (qsl_linetype.eq.'I')
;;	  begin
;;	    xcall qs4000i (qshedr,qsline,parse_result)
;;	    if (parse_result.eq.TRUE) return
;;	  end
	if (qsl_linetype.eq.'I')		; Stock item
	  begin
	    clear ini_upc
	    if (in_cmupc.eq.'Y') ini_upc = qsl_item
	    xcall inifmt (qsl_item)
	    call get_item
	    if (opcde) then
	      begin
		xcall message (DTEQS_INF,D_ERROR)
		opcde = -1
	      end
	     else
	      begin
		qsl_slst = ini_slst
		qsl_pfactor = inl_pfactor
		if (line_exists.eq.FALSE) .or.
		&  (qsl_item.ne.list_compare(13:24))
		  begin				; Find was by upc
		    qsl_item = ini_item
		    if (qs_cmmloc.eq.'N') qsl_locncode = inl_locncode
		    qsl_descr = ini_desc
		    qsl_catgcode = ini_catgcode
		    qsl_uomcode  = ini_suomcode
		    qsl_commcode = ini_commcode
		    qsl_taxstatus = ini_taxable
;;;                 qsl_rltycode = ini_rltycode
		    qsl_discstatus = 'N'
		    qsl_weight = ini_weight
		    qsl_cubes = ini_cubes
;;;		    qsl_reqdate = qsh_reqdate
		    qsl_ucosttype = in_cmalcs
		    if (qsl_ucosttype.eq.'C')
		      begin
			if (smc_type.ne.'C') .or.
			&  (smc_code.ne.ini_catgcode)
			  begin
			    smc_type = 'C'
			    smc_code = ini_catgcode
			    xcall sm_get_code (smcode)
			    if (opcde) smcc_cmalcs = 'A'
			  end
			qsl_ucosttype = smcc_cmalcs
		      end
		    qsl_ucost[1] = inl_acost
		    qsl_ucost[2] = inl_lcost
		    qsl_ucost[3] = inl_scost
		  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
	      end
	  end
	return

	;-------- category code break
qsl_catg_break,
	if (qsl_ucosttype.eq.'C') qsl_ucosttype = smcc_cmalcs
	return

	;-------- discount status break
qsl_discst_break,
	if (qsl_discstatus.ne.'L')
	  begin
	    clear qsl_discpct
	    xcall i_dspfld (wind_no,'QLDISC',qsl_discpct)
	  end
	return

	;-------- unit price break
qsl_uprice_break,
	if (qsl_uprice.ne.unit_price) .and.
	&  (qsl_linetype.ne.'N')
	  begin
	    qsl_pricetype = 'O'
	    if (oe_cmptot.eq.'Y')
	      begin
		qsl_discstatus = 'N'
		xcall i_dspfld (wind_no,'QLDSTA',qsl_discstatus)
	      end
	  end
	if (oe_cmsprc.eq.'Y' .or. qsl_linetype.eq.'N') return
	qsl_ucosttype = in_cmalcs
	if (qsl_ucosttype.eq.'C')
	  begin
	    if (smc_type.ne.'C') .or.
	    &  (smc_code.ne.ini_catgcode)
	      begin
		smc_type = 'C'
		smc_code = ini_catgcode
		xcall sm_get_code (smcode)
		if (opcde) smcc_cmalcs = 'A'
	      end
	    qsl_ucosttype = smcc_cmalcs
	  end
	if (qsl_ucosttype.eq.'L' .and. qsl_uprice.lt.inl_lcost) .or.
	&  (qsl_ucosttype.eq.'A' .and. qsl_uprice.lt.inl_acost) .or.
	&  (qsl_ucosttype.eq.'S' .and. qsl_uprice.lt.inl_scost)
	  begin
	    case qs_cmsprc of
	      begincase
	      'W': xcall message (DTEQS_PLC)
	      'N': xcall message (DTEQS_PCE)
	      endcase
	  end
	return

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

	;       add up line item totals and display
compute_totals,
	clear qsh_ordamt,qsh_ordwgt,qsh_ordcubes,qsh_ordqty,price_qty
	list_compare = qsline	; save current record
	hold_key = qsl_key
	xcall db_find (qsline_chan,qsh_key,0,'M',,,opcde)
	repeat
	  begin
	    xcall db_next (qsline_chan,qsline,'F','M',,,opcde)
	    if (opcde) .or.
	    &  (qsh_key.ne.qsl_key) exitloop
	    if (qsl_item) .and.
	    &  (qsl_linestatus.ne.'D') .and.
	    &  (qsl_subseq.eq.0) call add_to_totals
	  end
	qsl_key = hold_key
	xcall db_read (qsline_chan,qsline,qsl_key,0,'M',,,opcde)
	qsline = list_compare	; restore current record
	call display_totals
	return

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

	;	Delete function from list process
delete_line,
	qsl_comp = qsh_comp
	qsl_quote = qsh_quote
	qsl_lineno = sel_line_no
	if (sel_item.ne.UT_BLANKS)
	  begin
	    xcall db_read (qsline_chan,qsline,qsl_key(1:11),0,'M',,,opcde)
	    if (.not.opcde)
	      begin
		case qsl_linestatus of
		  begincase
		    'C': xcall message (DTEQS_LCD)
		    'D': begin
			  clear qsl_linestatus,sel_deleted
			  call get_item
			  qsl_descr = ini_desc
			  xcall i_dspfld (wind_no,'QLDESC',qsl_descr)
			  call add_to_totals
			  call display_totals
			  call update_line
			 end
		    ' ': begin
			  qsl_linestatus = 'D'
			  sel_deleted = 'x'
			  qsl_descr = '?? Deleted Line Item ??'
			  xcall i_dspfld (wind_no,'QLDESC',qsl_descr)
			  call sub_from_totals
			  call display_totals
			  call update_line
			 end
		  endcase
	      end
	  end
	return

add_to_totals,
	call set_ord_qty
	qsh_ordamt = qsh_ordamt + ((quote_qty * qsl_uprice) / qsl_pfactor)
	qsh_ordwgt = qsh_ordwgt + (quote_qty * qsl_weight)
	qsh_ordcubes = qsh_ordcubes + (quote_qty * qsl_cubes)
	qsh_ordqty = qsh_ordqty + quote_qty
	if (qsl_discstatus.eq.'A') .or.
	&  (qsl_discstatus.eq.'a') price_qty = price_qty + quote_qty
	return

sub_from_totals,
	call set_ord_qty
	qsh_ordamt = qsh_ordamt - ((quote_qty * qsl_uprice) / qsl_pfactor)
	qsh_ordwgt = qsh_ordwgt - (quote_qty * qsl_weight)
	qsh_ordcubes = qsh_ordcubes - (quote_qty * qsl_cubes)
	qsh_ordqty = qsh_ordqty - quote_qty
	if (qsl_discstatus.eq.'A') .or.
	&  (qsl_discstatus.eq.'a') price_qty = price_qty - qsl_ordqty
	if (price_qty.lt.0) clear price_qty
	return

set_ord_qty,
	quote_qty = qsl_ordqty
	if (quote_qty.lt.0) clear quote_qty
	if (qsl_pfactor.le.0) qsl_pfactor = 1
	return

display_line_item,
	xcall i_display (wind_no,'set_show',qsline)
	smc_type = 'L'
	smc_code = qsl_locncode
	xcall sm_get_code (smcode,wind_no,,'QLLOCN_DESCR')
	smc_type = 'C'
	smc_code = qsl_catgcode
	xcall sm_get_code (smcode,wind_no,,'QLCATG_DESCR')
	smc_type = 'U'
	smc_code = qsl_uomcode
	xcall sm_get_code (smcode,wind_no,,'QLUOM_DESCR')
	if (qsl_commcode) then
	  begin
	    smc_type = 'M'
	    smc_code = qsl_commcode
	    xcall sm_get_code (smcode,wind_no,,'QLCOMS_DESCR')
	  end
	 else xcall i_dspfld (wind_no,'QLCOMS_DESCR',' ')
	return

display_totals,
	xcall i_dspfld (a_oamt_id,'ORDTOT',qsh_ordamt)
	xcall i_dspfld (a_oamt_id,'ORDWGT',qsh_ordwgt)
	xcall i_dspfld (a_oamt_id,'ORDCUB',qsh_ordcubes)
	xcall i_dspfld (a_oamt_id,'ORDUNT',qsh_ordqty)
	return

	;	Get inventory item and location records
get_item,
	ini_comp = qsh_comp
	ini_item = qsl_item
	xcall in_get_item (initem)
	inl_comp = qsh_comp
	inl_item = qsl_item
	inl_locncode = qsl_locncode
	xcall in_get_locn (inlocn)
	return

.end
;=======================================================================;
.subroutine qsll_qs4000 ; 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 "QSS:qs4000l.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
;=======================================================================;

