;==File=================================================================;
; PO4300.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=============================================================;
;	po4300		Set received quantities from picking list.
;			For 1-step receivings only.
;==Changes==============================================================;
; 06/26/2006 tfc - if printing label from line, send receivings bin
; 02/05/2004 kms - Do not allow receivings on a completed or deleted line.
; 08/07/2002 tah - Change for new PORECV file.
; 08/01/2000 tah - Add serial number processing.
; 06/26/1999 tah - Allow receipt of more units than ordered.
; 05/20/1997 tah - Non-controlled posting to at dock quantity.
; 11/26/1996 tah - Clear por_postqty on receivings.
; 11/07/1996 tah - Add user post/recv date.
; 01/17/1996 tah - Check cost change limits.
;=======================================================================;
.subroutine po4300

.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 "POS:porecv.rec"
.include "INS:incomm.gbl"
.include "INS:initem.rec"
.include "INS:initvc.rec"
.include "SMS:smcode.rec"

external function
	smctrl		,a
	inabin_primary	,a

record	scr_rec1
	scr_scan	,a10		; scanned information
	  scr_order	,d6	@scr_scan
	  scr_line	,d3	@scr_scan+6
	scr_abin	,a8		; aisle/bin where stocked
	scr_received	,d9.3		; quantity received
	scr_accepted	,d9.3		; quantity accepted
	scr_rejected	,d9.3		; quantity rejected
record	scr_rec2
	scr_recdate	,d8		; receivings date

record
	abort		,d1
	add_qtys	,a1		; add/replace quantities switch
	data_len	,d2		; scanned data length
	hold_recuqty	,d9.3		; saved at dock quantity
	hold_recdqty	,d9.3		; saved accepted quantity
	hold_recrqty	,d9.3		; saved rejected quantity
	ndx		,d2		; loop control
	order_no	,d6		; current order number
	post_qty	,d9.3		; quantity to be posted
	post_qty_over	,d9.3		; quantity over received to be posted
	primary_bin	,a8		; primary bin for item
	print_labels	,a1		; print labels flag
	rcvgs_on_file	,d1		; receivings record on file switch
	set_name	,a4		; current input set name
	wdone		,d1
	wind_name	,a*,	'po4300'
	wind_no		,d2		; input window id
.start nopage,list

.proc
	;>>>>>	Main processing  <<<<<;
	call do_setup
	call open_files
	if (abort.eq.FALSE) call get_parameters
	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
	print_labels = %smctrl(ut_cmcomp,'PO','RECVGSLABELS',1)
	in_cmfrttyp = %smctrl(ut_cmcomp,'IN','FRTADDTYPE')
	clear abort
	xcall po4300s ('I',poline,posnlt_chan)
	xcall po4300k ('I',poline,posnlt_chan)
	return

	;	Shut down environment
do_shutdown,
	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 (porecv_chan,'U:I',porecv_name)
	xcall open (posnlt_chan,'U:I',posnlt_name)
	xcall open (initem_chan,'I:I',initem_name)
	xcall open (inlocn_chan,'U:I',inlocn_name)
	xcall open (inabin_chan,'U:I',inabin_name)
	xcall open (initvc_chan,'I:I',initvc_name)
	xcall open (insnlt_chan,'I:I',insnlt_name)
	xcall open (inkits_chan,'I:I',inkits_name)
	xcall open (smcode_chan,'I:I',smcode_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 (porecv_chan,DTE_CLOSE)
	xcall close (posnlt_chan,DTE_CLOSE)
	xcall close (initem_chan,DTE_CLOSE)
	xcall close (inlocn_chan,DTE_CLOSE)
	xcall close (inabin_chan,DTE_CLOSE)
	xcall close (initvc_chan,DTE_CLOSE)
	xcall close (insnlt_chan,DTE_CLOSE)
	xcall close (inkits_chan,DTE_CLOSE)
	xcall close (smcode_chan,DTE_CLOSE)
	return

	;	Get the report selection parameters
get_parameters,
	abort = FALSE	
	xcall lodwin ('LPL',wind_name,wind_no)
	clear pom_order
	scr_recdate = ut_datfil

	xcall i_input (wind_no,'SET99',scr_rec2)

	repeat
	  begin
	    wdone = FALSE
	    xcall i_next (wind_no,'set1','*FRST*')
	    do begin
	      xcall i_input (wind_no,'set1',scr_rec1,,ut_col_sel,,1)
	      if g_select
		begin
		  case g_entnam of
		    begincase
		    'END':  begin
			      if (pom_order) call update_header
			      abort = TRUE
			      return
			    end
		    'GO':   begin
			      xcall i_next (wind_no,'set1','*DONE*')
			      wdone = TRUE
			    end
		    '@':    call process_signal
		    endcase
		end
	    end until (.not.g_setsts) .and. (.not.g_select)
	    if (wdone.eq.TRUE) exitloop
	    xcall i_init (wind_no,'SET1',,'SCAN')
	  end
	return

	;	Process any break signals
process_signal,
	case g_entnam of
	  begincase
	  '@SCAN':begin
		    data_len = %trim(scr_scan)
		    case data_len of
		      begincase
		      6: begin
			  xcall i_init (wind_no,'SET8')
			  if (pom_order) call update_header
			  call order_header
			  xcall i_init (wind_no,'SET2')
		         end
		      9: call order_line
		      endcase
		     else xcall message (DTEPO_IVD)
		  end
	  endcase
	return

	;	order header bar code scanned
order_header,
	pom_comp = ut_cmcomp
	pom_order = scr_order
	xcall db_read (pohedr_chan,pohedr,pom_key,0,'M',,,opcde)
	if (opcde)
	 then xcall message (DTEPO_ONF)
	 else
	  begin
	    xcall i_dspfld (wind_no,'PHVEND',pom_vend)
	    xcall i_dspfld (wind_no,'PHNAME',pom_name)
	    xcall i_dspfld (wind_no,'PHADR1',pom_addr1)
	    xcall i_dspfld (wind_no,'PHADR2',pom_addr2)
	    xcall i_dspfld (wind_no,'PHCITY',pom_city)
	    xcall i_dspfld (wind_no,'PHSTAT',pom_state)
	    xcall i_dspfld (wind_no,'PHZIPC',pom_zip)
	  end
	return

	;	update the order header
update_header,
	xcall db_read (pohedr_chan,pohedr,pom_key,0,'M',,,opcde)
	set pom_flag2,pom_flag3 = 'Y'
	xcall db_update (pohedr_chan,pohedr,pom_key,pohedr_log,opcde)
	if (print_labels.eq.'O') xcall po4320 (pom_order)
	return

	;	order line bar code scanned
order_line,
	if (pom_order.ne.scr_order)
	  begin
	    xcall message (DTEPO_SOF)
	    return
	  end

	add_qtys = 'N'
	call get_order_line		; get the line item record
	if (opcde) return
	pol_recuqty = pol_ordqty - (pol_recpqty + pol_recrqty)

	call find_receivings		; get the receivings record

	call save_before_qtys

	pol_recdqty = pol_recuqty
	clear pol_recrqty
	pol_status = 'P'

	call manual_qty			; manual quantity entry window
	if (g_entnam.eq.'END') return
	pol_recdate = scr_recdate
	clear pol_recuqty
	xcall db_update (poline_chan,poline,pol_key,poline_log,opcde)
	if (pol_recdqty.ne.0) .or.
	&  (pol_recrqty.ne.0) .or.
	&  (hold_recdqty.ne.0) .or.
	&  (hold_recrqty.ne.0)
	  begin
	    call write_receivings		; write receivings record
	    call adjust_inventory		; adjust inventory quantities
	    if (pol_recdqty.ne.0)
		call input_serial_numbers	; input serial numbers
	    case print_labels of
	      begincase
	      'L': xcall po4320 (pol_order,pol_lineno,por_abin)	; 6/26
	      'P': begin
		    xcall confirm (opcde,53)
		    if (opcde.eq.TRUE) xcall po4320 (pol_order,pol_lineno,por_abin)
		   end
	      endcase
	  end
	return

	;	get the order line item record
get_order_line,
	pol_comp = ut_cmcomp
	pol_order = scr_order
	pol_lineno = scr_line
	xcall db_read (poline_chan,poline,pol_key,0,'M',,,opcde)
	if (opcde) xcall message (DTEPO_LNF)
	if (pol_status.eq.'C'.or.pol_status.eq.'D')
	   then
	     begin
		xcall message (DTEPO_LCD)
		opcde = TRUE
	     end
	return

	;	update inventory file quantities
adjust_inventory,
	if (pol_linetype.eq.'I')
	  begin
	    post_qty = (pol_recdqty + pol_recrqty)
	    &	     - (hold_recdqty + hold_recrqty)
	    clear post_qty_over
	    if (post_qty.lt.0) .and.
	    &  (hold_recdqty.gt.pol_ordqty)
		post_qty_over = pol_recdqty + pol_recrqty - pol_ordqty
	    if (post_qty.gt.0) .and.
	    &  (pol_recdqty + pol_recpqty + pol_recrqty.gt.pol_ordqty)
		post_qty_over = pol_ordqty - hold_recdqty - hold_recrqty
	    if (post_qty_over)
	     then xcall instkdok (pol_item,pol_locncode,post_qty,opcde,
		&	post_qty_over)
	     else xcall instkdok (pol_item,pol_locncode,post_qty,opcde)
	  end
	return

	;	save quantities prior to changing
save_before_qtys,
	if (pol_linetype.eq.'I') then
	  begin
	    hold_recuqty = pol_recuqty
	    hold_recdqty = pol_recdqty
	    hold_recrqty = pol_recrqty
	  end
	 else clear hold_recuqty, hold_recdqty, hold_recrqty
	return

	;	manual override of quantities received/accepted/rejected
manual_qty,
	xcall i_dspfld (wind_no,'ITEM',pol_item)
	xcall i_dspfld (wind_no,'DESC',pol_descr)
	xcall i_next (wind_no,'SET3','ACPT')
	scr_received = pol_recuqty
	xcall i_dspfld (wind_no,'RCVD',scr_received)
	case add_qtys of
	  begincase
	  'Y': clear scr_accepted, scr_rejected
	  'N': begin
		scr_accepted = pol_recdqty
		scr_rejected = pol_recrqty
	       end
	  endcase
	xcall i_dspfld (wind_no,'ACPT',scr_accepted)
	xcall i_dspfld (wind_no,'RJCT',scr_rejected)
	if (rcvgs_on_file.eq.FALSE) .or.
	&  (por_abin.eq.UT_BLANKS) then
	  begin
	    primary_bin = %inabin_primary (pol_comp,pol_item,pol_locncode)
	    xcall i_putfld (wind_no,'SET3',scr_rec1,'ABIN',primary_bin)
	  end
	 else xcall i_putfld (wind_no,'SET3',scr_rec1,'ABIN',por_abin)
	call in_quantity
	if (g_entnam.ne.'END')
	  begin
	    case add_qtys of
	      begincase
	      'Y': begin
		    pol_recdqty = hold_recdqty + scr_accepted
		    pol_recrqty = hold_recrqty + scr_rejected
		   end
	      'N': begin
		    pol_recdqty = scr_accepted
		    pol_recrqty = scr_rejected
		   end
	      endcase
	    if (pol_recdqty + pol_recrqty.gt.pol_recuqty) xcall message (DTEPO_QED)
	    pol_status = 'P'
	  end
	xcall i_init (wind_no,'SET9')
	xcall i_init (wind_no,'SET2',,'RCVD')
	xcall i_init (wind_no,'SET3',,'ACPT,RJCT,ABIN')
	return

	;	prompt for the quantity received
in_quantity,
	set_name = 'SET3'		; stock the item
	do begin
	  xcall i_input (wind_no,set_name,scr_rec1,ut_col_inp,ut_col_sel)
	  if g_select
	    begin
	      case g_entnam of
		begincase
		'END':	return
	      endcase
	      xcall i_init (wind_no,set_name)
	    end
	end until (.not.g_setsts) .and. (.not.g_select)
	return

find_receivings,
	rcvgs_on_file = FALSE
	por_comp = pol_comp
	por_order = pol_order
	por_lineno = pol_lineno
	por_recdate = scr_recdate
	xcall db_find (porecv_chan,por_key,0,'M',,,opcde)
	if (.not.opcde)
	  begin
	    xcall db_next (porecv_chan,porecv,'F','M',,,opcde)
	    if (.not.opcde)
	      begin
		rcvgs_on_file = TRUE
		if (add_qtys.eq.ut_blanks)
		  begin
		    if (por_recdqty.ne.0) .or.
		    &  (por_recrqty.ne.0)
			xcall confirm (opcde,94) ; unposted stock
		    if (opcde.eq.TRUE)
		     then add_qtys = 'Y'
		     else add_qtys = 'N'
		    clear opcde
		  end
	      end
	  end
	return

write_receivings,
	if (rcvgs_on_file.eq.TRUE) then
	  begin
	    por_recdate = scr_recdate
	    por_recuqty = pol_recuqty
	    por_recdqty = pol_recdqty
	    por_recrqty = pol_recrqty
	    por_abin = scr_abin
	    if (pol_ucost.ne.por_ucost) por_ucost = pol_ucost
	    por_discpct = pol_discpct
	    if (por_posted.eq.'Y') por_posted = 'N'
	    if (por_recuqty.eq.0) .and.
	    &  (por_recdqty.eq.0) .and.
	    &  (por_recrqty.eq.0)
	     then xcall db_delete (porecv_chan,porecv,por_key,0,opcde)
	     else xcall db_update (porecv_chan,porecv,por_key,0,opcde)
	  end
	 else
	  begin
	    por_comp = pol_comp
	    por_order = pol_order
	    por_lineno = pol_lineno
	    por_recdate = scr_recdate
	    por_linetype = pol_linetype
	    por_item = pol_item
	    por_locncode = pol_locncode
	    por_descr = pol_descr
	    por_ordqty = pol_ordqty
	    por_recuqty = pol_recuqty
	    por_recdqty = pol_recdqty
	    por_recrqty = pol_recrqty
	    por_ucost = pol_ucost
	    por_pfactor = pol_pfactor
	    por_abin = scr_abin
	    por_weight = pol_weight
	    por_discpct = pol_discpct
	    call get_vend_info
	    case in_cmfrttyp of
	      begincase
	      'D': por_frtadd = inv_freightin				; $
	      'P': por_frtadd = (pol_ucost * inv_freightin) / 100.0	; %
	      endcase
	    por_posted = 'N'
	    clear por_postqty,por_apvend
	    for ndx from 1 thru 10
		clear por_apvch[ndx],por_apinvc[ndx],por_apdate[ndx],
		&     por_apqty[ndx],por_apcost[ndx]
	    if (por_recuqty.ne.0) .or.
	    &  (por_recdqty.ne.0) .or.
	    &  (por_recrqty.ne.0)
		xcall db_add (porecv_chan,porecv,por_key,0,opcde)
	  end
	return

get_vend_info,
	inv_comp = pol_comp
	inv_item = pol_item
	inv_locncode = pol_locncode
	inv_type = 'V'
	inv_vend_cust = pom_vend
	xcall db_read (initvc_chan,initvc,inv_key,0,'M',,,opcde)
	if (opcde) clear inv_freightin
	return

input_serial_numbers,
	case pol_slst of
	  begincase
	  'S': xcall po4300s ('G',poline,posnlt_chan)
	  'L': xcall po4300s ('G',poline,posnlt_chan)
	  'K': xcall po4300k ('G',poline,posnlt_chan)
	  endcase
	return
.end

