;==File=================================================================;
; PO4300S.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=============================================================;
;	po4300s		Purchase Order serial number data entry.
;	posl_po4300	Load List with serial/lot information
;==Changes==============================================================;
; 07/25/2007 tah - Insert code for activex list l_select problem.
; 03/15/2007 tah - Modify for activex list display.
; 05/02/2001 tah - New program cloned from OE4000S.dbl
;=======================================================================;
.subroutine po4300s

	a_function	,a	; IN  - Function.
	a_poline	,a	; IN  - Line item record.
	a_load_chan	,n	; IN  - Load items channel.
	a_no_term	,n	; OPT - If passed, do no set processing.

.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:poline.rec"
.include "INS:incomm.gbl"
.include "INS:insnlt.rec"
.include "SMS:smcode.rec"

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

.align
static record
	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
	no_term		,d1		; set termination flag
        cur_item_ptr    ,i4             ; For call to l_status

record
	fldnam		,a30,	"*FRST*"
	hold_key	,a14		; saved line item key
	kit_item	,d1		; true if kit line item
	line_exists	,d1		; line is already on file
	list_compare	,a%size(posnlt)	; Record for comparison
        list_header     ,a*,    'Seq|D|Serial/Lot|Units|'
	set_name	,a4		; Current input set name
        total_display   ,a*,    '|||zzz,zzz-|'
          total_aslqty  ,a8     @total_display+3
	total_slqty	,d6		; Total serial/lot quantity
	wind_name	,a*,	'po4300s'
	wind_noterm	,a*,	'po4300sn'
	wrk_item	,a24		; for history search
.start nopage,list

.proc
	poline = a_poline
	case a_function of
	  begincase
          'D': xcall message (DTER_GEN,,'Delete SN')
	  'I': call init_windows
	  'G': call get_data
	  endcase
	xcall status
	xreturn		; to calling program

	;===================== Initialize windows ===================;
init_windows,
	if %passed(a_no_term) then
	  begin
	    no_term = 1
	    xcall lodwin ('LNL',wind_noterm,wind_no)
	  end
	 else
	  begin
	    clear no_term
	    xcall lodwin ('LNL',wind_name,wind_no)
	  end
	xcall i_ldinp (inp_id, g_utlib, "i_po4300s", D_NOPLC, srch)
        xcall l_create (list_id,inp_id,sel_line,g_utlib,"l_po4300s",,,D_NOPLC,,1,MAX_LINES,opcde)
	xcall l_sect (list_id, list_header, D_HEADER, D_LEFT)
        xcall ut_findc (list_id)
	return

	;================ Delete all lines on an order ================;
delete_all_lines,
	return

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

;-------------------------- subroutines ------------------------------;
	;	Load internal list array with line items
load_list_array,
	for wlist_ptr from 1 thru MAX_LINES
	    clear list_snlot[wlist_ptr],list_qty[wlist_ptr],list_deleted[wlist_ptr]
	clear total_slqty
	xcall db_find (a_load_chan,pol_key,0,'M',,,opcde)
	repeat
	  begin
	    xcall db_next (a_load_chan,posnlt,'F','M',,,opcde)
	    if (opcde) .or.
	    &  (pos_key.ne.pol_key) exitloop
	    wlist_ptr = pos_seqno
	    list_snlot[wlist_ptr] = pos_snlt
	    list_qty[wlist_ptr] = pos_qty
	    if (pos_linestatus.eq.'D')
	     then list_deleted[wlist_ptr] = 'x'
	     else total_slqty = total_slqty + pos_qty
	  end
	call display_totals
	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
		  ' ':		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')

	call compute_totals		; add up serial/lot units
	if (total_slqty.gt.pol_recdqty)
	  begin
	    xcall message (DTEPO_SNE,D_ERROR)
	    clear g_entnam
	  end
	return

	;	Get the selected line and do the input
line_input,
	pos_comp = pol_comp
	pos_order = pol_order
	clear pos_item
	pos_lineno = pol_lineno
	pos_seqno = sel_line_no
	if (sel_snlot.ne.UT_BLANKS) then
	  begin			; change existing line item
	    xcall db_read (posnlt_chan,posnlt,pos_key,0,'M',,,opcde)
	    if (.not.opcde)
	      begin
		list_compare = posnlt
		call sub_from_totals
		line_exists = TRUE
		call full_line_in		
		call add_to_totals
		call display_totals
		if (g_entnam.ne.'ABORT') .and.
		&  (pos_snlt.ne.UT_BLANKS) call update_line
		clear g_entnam
	      end
	  end
	 else
	  begin			; add new line item
	    repeat
	      begin
		pos_comp = pol_comp
		pos_order = pol_order
		pos_lineno = pol_lineno
		clear pos_item
		pos_seqno = sel_line_no
		pos_linestatus = 'x'
		pos_slst = pol_slst
		pos_locncode = pol_locncode
		clear pos_bin
		pos_ucost = pol_ucost
		pos_recdate = ut_datfil
		line_exists = FALSE
		call full_line_in		
		if (g_entnam.eq.' ') .and.
		&  (pos_snlt.ne.UT_BLANKS)
		  begin
		    call write_line
		    call add_to_totals
		    call display_totals
		  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 (posnlt_chan,posnlt,pos_key,posnlt_log,opcde)
	wlist_ptr = pos_seqno
	xcall l_data (list_id,D_LCURRENT,inp_id,sel_line,,opcde)
	list_snlot[wlist_ptr] = pos_snlt
	list_qty[wlist_ptr] = pos_qty
	if (pos_linestatus.eq.'D')
	 then list_deleted[wlist_ptr] = 'x'
	 else clear list_deleted[wlist_ptr]
	sel_snlot = pos_snlt
	sel_qty = pos_qty
	if (pos_linestatus.eq.'D')
	 then sel_deleted = 'x'
	 else clear sel_deleted
	xcall i_display (inp_id,'set1',sel_line)
	return

	;	Write a new line item
write_line,
	clear pos_linestatus
	xcall db_add (posnlt_chan,posnlt,pos_key,posnlt_log,opcde)
	wlist_ptr = pos_seqno
	xcall l_data (list_id,D_LCURRENT,inp_id,sel_line,,opcde)
	list_snlot[wlist_ptr] = pos_snlt
	list_qty[wlist_ptr] = pos_qty
	clear list_deleted[wlist_ptr]
	sel_snlot = pos_snlt
	sel_qty = pos_qty
	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 (pol_slst.eq.'S') then
	  begin
	    set_name = 'set1'
	    pos_qty = 1.0
	  end
	 else set_name = 'set2'
	if (line_exists.eq.TRUE) xcall i_display (wind_no,set_name,posnlt)
	xcall i_next (wind_no,set_name,'*FRST*')
	do begin
	  xcall i_input (wind_no,set_name,posnlt,,ut_col_sel,,no_term,,,pol_item,pol_locncode)
	  if g_select
	    begin
	      case g_entnam of
		begincase
		'END':	   begin
			    if (pos_linestatus.eq.'x') clear pos_linestatus
			    exitloop
			   end
		'ABORT':   exitloop
		'@':	   call process_signal
		endcase
	    end
	  end until (.not.g_setsts) .and. (.not.g_select)
	xcall status
	if (pos_linestatus.eq.'x') clear pos_linestatus
	xcall lodwin ('R',,wind_no)
	return

	;	Process any break signals
process_signal,
	case g_entnam of
	  begincase
	  '@POSSNLOT': call snlot_change
	  endcase
	return

	;	Serial/lot number entered
snlot_change,
	if (pos_snlt.ne.UT_BLANKS)
	  begin
	    ins_comp = pol_comp
	    ins_item = pol_item
	    ins_locncode = pol_locncode
	    ins_snlt = pos_snlt
	    xcall in_get_snlt (insnlt)
	    if (opcde) return
	    xcall message (DTEPO_SNF)
	  end
	xcall i_init (wind_no,,,'POSSNLOT')
	xcall i_next (wind_no,set_name,'POSSNLOT')
	return

	;	Delete function from list process
delete_line,
	pos_comp = pol_comp
	pos_order = pol_order
	pos_lineno = pol_lineno 
	clear pos_item
	pos_seqno = sel_line_no
	if (sel_snlot.ne.UT_BLANKS)
	  begin
	    xcall db_read (posnlt_chan,posnlt,pos_key,0,'M',,,opcde)
	    if (.not.opcde)
	      begin
		case pos_linestatus of
		  begincase
		    'C': xcall message (DTEPO_LCD)
		    'D': begin
			  clear pos_linestatus,sel_deleted
			  call add_to_totals
			  call display_totals
			  call update_line
			 end
		    ' ': begin
			  pos_linestatus = 'D'
			  sel_deleted = 'x'
			  call sub_from_totals
			  call display_totals
			  call update_line
			 end
		  endcase
	      end
	  end
	return

	;	Display the total serial/lot units
display_totals,
	total_aslqty = total_slqty, 'ZZZ,ZZZ-'
	xcall l_sect (list_id,total_display,D_FOOTER,D_CLEAR,D_LEFT)
	return

	;	Add line item to totals
add_to_totals,
	total_slqty = total_slqty + pos_qty
	return

	;	Subtract line item from totals
sub_from_totals,
	total_slqty = total_slqty - pos_qty
	return

	;	add up list total dollars and display
compute_totals,
	clear total_slqty
	for wlist_ptr from 1 thru MAX_LINES
	  begin
	    if (list_deleted[wlist_ptr].ne.'x')
		total_slqty = total_slqty + list_qty[wlist_ptr]
	  end
	call display_totals
	return
.end
;=======================================================================;
.subroutine posl_po4300 ; Load List with serial/lot 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:po4300s.gbl"
.start nopage,list

.proc
	sel_line_no = list_ptr
	sel_snlot = list_snlot[list_ptr]
	sel_qty = list_qty[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
;=======================================================================;

