;==File=================================================================;
; PO4350.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=============================================================;
;	po4350		Set received quantities from picking list.
;			For 2-step receivings.
;==Changes==============================================================;
; 02/05/2004 kms - Do not allow receivings on a completed or deleted line.
; 08/07/2002 tah - Change for new PORECV record layout.
; 03/28/2002 tah - Fix problem of updating non-controlled items.
; 08/31/2001 tah - Add option for stock date prompting.
; 05/03/2001 tah - Add processing for kit serial numbers.
; 08/01/2000 tah - Add serial number processing.
; 02/11/1998 tah - Fix qty received gt qty ordered in update.
; 01/29/1998 tah - Fix partial receivings problem.
; 01/19/1998 tah - Clear por_postqty on record add.
; 10/13/1997 tah - Add rejection code processing.
;=======================================================================;
.subroutine po4350

	a_function	,a	; IN  - Type of receivings
				;	DOCK - received at dock
				;	STOK - received for stock (accept/reject)

.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: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
	scr_rejcode	,a3		; rejection code
	scr_ucost	,d9.3		; unit cost

record
	abort		,d1
	add_qtys	,a1		; add/replace quantities switch
	data_len	,d2		; scanned data length
	hold_onorder	,d9.3		; saved on order quantity
	hold_recuqty	,d9.3		; saved at dock quantity
	hold_recdqty	,d9.3		; saved accepted quantity
	hold_recrqty	,d9.3		; saved rejected quantity
	hold_ucost	,d9.3		; saved unit cost
	ndx		,d2		; loop control
	order_no	,d6		; current order number
	order_set	,d1		; flag indicates if line was received
	post_date	,d8		; stock posting date
	post_date_type	,a1		; post which date
	post_qty	,d9.3		; quantity to post
	post_qty_over	,d9.3		; excess received quantity to post
	primary_bin	,a8		; primary bin for item
	print_labels	,a1		; print labels flag
	pstdat_name	,a*,	'po4350d'
	pstdat_no	,d2		; date screen id
	rcvgs_on_file	,d1		; receivings record on file switch
	set_name	,a4		; current input set name
	ucost		,d9.3		; stocking unit cost
	ucost_change	,a1		; is unit cost changing allowed
	wdone		,d1
	wind_name	,a*,	'po4350'
	wind_no		,d2		; input window id
	wrk_controlled	,a1
	wrk_item_key	,a26
	  wrk_comp	,a2	@wrk_item_key
	  wrk_item	,a24	@wrk_item_key+2
.start nopage,list

.proc
	;>>>>>	Main processing  <<<<<;
	call do_setup
	call open_files
	if (abort.eq.FALSE)
	  begin
	    if (a_function.eq.'S') .and.
	    &  (%smctrl(ut_cmcomp,'PO','RCVSTOCKDATE').eq.'P')
		call get_post_date
	    xcall i_dspfld (wind_no,'PDATE',post_date)
	    repeat
	      begin
		call get_parameters
		if (abort.eq.TRUE) exitloop
	      end
	  end
	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
	clear abort
	post_date = ut_datfil
	xcall lodwin ('LPL',wind_name,wind_no)
	print_labels = %smctrl(ut_cmcomp,'PO','RECVGSLABELS',1)
	ucost_change = %smctrl (ut_cmcomp,'PO','RCVUNITCOST')
	post_date_type = %smctrl (ut_cmcomp,'PO','POSTDATE',1)
	po_cmfrtadd = %smctrl(ut_cmcomp,'PO','ADDFRGTIN')
	in_cmfrttyp = %smctrl(ut_cmcomp,'IN','FRTADDTYPE')
	if (ucost_change.eq.'N') xcall i_disable (wind_no,'UCOST')
	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,'U: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 (inkits_chan,'I:I',inkits_name)
	xcall open (insnlt_chan,'I:I',insnlt_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 (inkits_chan,DTE_CLOSE)
	xcall close (insnlt_chan,DTE_CLOSE)
	xcall close (smcode_chan,DTE_CLOSE)
	return

	;	Get the report selection parameters
get_parameters,
	abort = FALSE	
	clear pom_order

	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
	  '@RCDE': call reject_break
	  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
	order_set = FALSE
	return

	;	update the order header
update_header,
	xcall db_read (pohedr_chan,pohedr,pom_key,0,'M',,,opcde)
	if (order_set.eq.TRUE)
	  begin
	    set pom_flag2,pom_flag3 = 'Y'
	    xcall db_update (pohedr_chan,pohedr,pom_key,pohedr_log,opcde)
	  end
	if (print_labels.eq.'O') .and.
	&  (a_function.eq.'D') 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

	clear add_qtys
	call get_order_line		; get the line item record
	if (opcde) return

	call find_receivings		; get the receivings record
	if (add_qtys.eq.'C') return	; Cancel button

	call save_before_qtys

	case a_function of		; line item scan type
	  begincase
	  'D': begin			; receive at dock
		case add_qtys of
		  begincase
		  'Y': nop
		  'N': pol_recuqty = pol_ordqty - (pol_recpqty + pol_recrqty)
		  endcase
		pol_recdate = post_date
	       end
	  'S': begin				; stock the item
		pol_recdqty = pol_recuqty
		clear pol_recrqty
		pol_status = 'P'
		if (post_date_type.eq.'S') pol_recdate = post_date
	       end
	  endcase

	if (a_function.eq.'D' .and. pol_recuqty.gt.0) .or.
	&  (a_function.eq.'S' .and. pol_recdqty.gt.0) then
	  begin
	    call manual_qty			; manual quantity entry window
	    if (a_function.eq.'S') .and.
	    &  (scr_ucost.ne.0) .and.
	    &  (scr_ucost.ne.hold_ucost) pol_ucost = scr_ucost
	    xcall db_update (poline_chan,poline,pol_key,poline_log,opcde)
	    call write_receivings		; write receivings record
	    order_set = TRUE
	    wrk_comp = pol_comp
	    wrk_item = pol_item
	    xcall in_get_item_dat (wrk_item_key,'CONTROLLED',wrk_controlled)
	    if (wrk_controlled.eq.'Y') call adjust_inventory	; adjust invent
	    call input_serial_numbers			; input serial numbers
	    if (a_function.eq.'D')
	      begin
		case print_labels of
		  begincase
		  'L': xcall po4320 (pol_order,pol_lineno)
		  'P': begin
			xcall confirm (opcde,53)
			if (opcde.eq.TRUE) xcall po4320 (pol_order,pol_lineno)
		       end
		  endcase
	      end
	  end
	 else xcall message (DTEPO_RRN)
	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
	    case a_function of		; line item scan type
	      begincase
		'D': begin		; receive at dock
		      post_qty = pol_recuqty - hold_recuqty
		      post_qty = post_qty * pol_pfactor
		      clear post_qty_over
		      if (post_qty.lt.0) .and.
		      &  (hold_recuqty.gt.pol_ordqty)
			post_qty_over = pol_recuqty - pol_ordqty
		      if (post_qty.gt.0) .and.
		      &  (pol_recuqty + pol_recpqty.gt.pol_ordqty)
			post_qty_over = post_qty
			&	- (pol_recuqty + pol_recpqty - pol_ordqty)
		      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
		'S': begin			; receive from the dock
		      post_qty = post_qty * pol_pfactor
		      post_qty = (pol_recdqty - hold_recdqty) * pol_pfactor
		      post_qty_over = (pol_recrqty - hold_recrqty) * pol_pfactor
;;;\\\
;;	xcall u_message ("pol_recdqty: " + %string(pol_recdqty))
;;	xcall u_message ("pol_recrqty: " + %string(pol_recrqty))
;;	xcall u_message ("post_qty: " + %string(post_qty))
;;	xcall u_message ("post_qty_over: " + %string(post_qty_over))
;;;\\\
		      if (pol_updcost.eq.'Y') then
			begin
			  if (po_cmfrtadd.eq.'Y')
			   then ucost = (pol_ucost + por_frtadd) / pol_pfactor
			   else ucost = pol_ucost / pol_pfactor
			  xcall instkrec (pol_item,pol_locncode,scr_abin,
				&	post_qty,ucost,'N',opcde)
			end
		       else xcall instkrec (pol_item,pol_locncode,scr_abin,
				&	post_qty,0,'N',opcde)
		      if (post_qty_over)
			xcall instkdok (pol_item,pol_locncode,-post_qty_over,
			&	opcde,0)
		     end
	      endcase
	  end
	return

	;	save quantities prior to changing
save_before_qtys,
	if (pol_linetype.eq.'I') then
	  begin
	    hold_onorder = pol_recuqty
	    if ((hold_onorder + pol_recpqty).gt.pol_ordqty)
		hold_onorder = pol_ordqty - pol_recpqty
	    hold_recuqty = pol_recuqty
	    hold_recdqty = pol_recdqty
	    hold_recrqty = pol_recrqty
	    hold_ucost = pol_ucost
	  end
	 else clear hold_recuqty,hold_recdqty,hold_recrqty,hold_onorder,hold_ucost
	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)
	case a_function of	; line item scan type
	  begincase
	  'D': begin			; receive at dock
		xcall i_next (wind_no,'SET2','RCVD')
		case add_qtys of
		  begincase
		  'Y': clear scr_received
		  'N': scr_received = pol_recuqty
		  endcase
		xcall i_dspfld (wind_no,'RCVD',scr_received)
		call in_quantity
		case add_qtys of
		  begincase
		  'Y': pol_recuqty = pol_recuqty + scr_received
		  'N': pol_recuqty = scr_received
		  endcase
		pol_status = 'P'
		xcall i_init (wind_no,'SET9')
		xcall i_init (wind_no,'SET2',,'RCVD')
		xcall i_init (wind_no,'SET3',,'ACPT,RJCT')
	       end
	  'S': begin				; stock the item
		xcall i_next (wind_no,'SET3','ACPT')
		scr_received = pol_recuqty
		xcall i_dspfld (wind_no,'RCVD',scr_received)
		scr_ucost = hold_ucost
		if (ucost_change.eq.'Y')
		    xcall i_dspfld (wind_no,'UCOST',scr_ucost)
		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,'BIN',primary_bin)
		  end
		 else xcall i_putfld (wind_no,'SET3',scr_rec1,'BIN',por_abin)
		call in_quantity
		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)
		  begin
		    xcall message (DTEPO_QED)
		    xcall i_init (wind_no,set_name,,'ACPT,RJCT')
		    xcall i_next (wind_no,set_name,'ACPT')
		    goto manual_qty
		  end

		pol_status = 'P'
		pol_rejcode = scr_rejcode
		xcall i_init (wind_no,'SET9')
		xcall i_init (wind_no,'SET2',,'RCVD')
		xcall i_init (wind_no,'SET3',,'ACPT,RJCT,RCDE,UCOST')
		xcall i_dspfld (wind_no,'RCDE_DESCR',' ')
	       end
	  endcase
	return

	;	prompt for the quantity received
in_quantity,
	case a_function of		; line item scan type
	  begincase
	  'D': set_name = 'SET2'	; receive at dock
	  'S': begin                    ; stock the item
		set_name = 'SET3'
		xcall i_next (wind_no,set_name,'BIN')
	       end
	  endcase

	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':	nop
		'ABORT':nop
		'@':    call process_signal
		endcase
	    end
	end until (.not.g_setsts) .and. (.not.g_select)

	case a_function of		; line item scan type
	  begincase
	  'S': if (scr_accepted + scr_rejected.gt.scr_received)	; stock item
		begin
		  xcall message (DTEPO_QED)
		  xcall i_init (wind_no,set_name,,'ACPT,RJCT')
		  xcall i_next (wind_no,set_name,'ACPT')
		  goto in_quantity
		end
	  endcase
	return

reject_break,
	pol_rejcode = scr_rejcode
	if (pol_rejcode.ne.UT_BLANKS)
	  begin
	    xcall numrt (pol_rejcode,'0')
	    smc_type = 'K'
	    smc_code = pol_rejcode
	    xcall sm_get_code (smcode,wind_no,'RCDE','RCDE_DESCR')
	    case opcde of
	      begincase
	      1: begin
		  xcall message (DTEPO_IVS,D_ERROR)
		  xcall i_init (wind_no,,,g_fldnam)
		  xcall i_next (wind_no,set_name,g_fldnam)
		 end
	      endcase
	  end
	return

find_receivings,
	rcvgs_on_file = FALSE
	por_comp = pol_comp
	por_order = pol_order
	por_lineno = pol_lineno
	por_recdate = post_date
	xcall db_find (porecv_chan,por_key,0,'M',,,opcde)
	if (.not.opcde) then
	  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
		    case a_function of
		      begincase
		      'D': if (por_recuqty.ne.0)
				xcall confirm (opcde,95) ; already at dock
		      'S': if (por_recdqty.ne.0 .or.
			   &   por_recrqty.ne.0) .and.
			   &  (por_posted.ne.'Y')
				xcall confirm (opcde,94) ; unposted stock
		      endcase
		    if (opcde.eq.TRUE)
		     then add_qtys = 'Y'
		     else add_qtys = 'N'
		    if (opcde.eq.2) add_qtys = 'C'	; Cancel
		    clear opcde
		  end
	      end
	  end
	 else add_qtys = 'N'
	return

write_receivings,
	call get_vend_info
	case in_cmfrttyp of
	  begincase
	  'D': por_frtadd = inv_freightin			; $
	  'P': por_frtadd = (pol_ucost * inv_freightin) / 100.0	; %
	  endcase
	if (rcvgs_on_file.eq.TRUE) then
	  begin
	    por_ordqty = pol_ordqty
	    por_recuqty = pol_recuqty
	    por_recdqty = pol_recdqty
	    por_recrqty = pol_recrqty
	    por_ucost = pol_ucost
	    por_posted = 'N'
	    por_abin = scr_abin
	    por_discpct = pol_discpct
	    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 = post_date
	    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
	    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/lot numbers or kit serial/lot numbers
input_serial_numbers,
	if (a_function.eq.'S')
	  begin
	    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
	  end
	return

get_post_date,
	xcall lodwin ('LPL',pstdat_name,pstdat_no)
	clear post_date
	do begin
	  xcall i_input (pstdat_no,'set1',post_date)
	 end until (.not.g_setsts) .and. (.not.g_select)
	xcall lodwin ('D',,pstdat_no)
	return
.end

