;==File=================================================================;
; PO8100.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=============================================================;
;	po8100		Resets on order quantities.
;==Changes==============================================================;
; 07/12/2004 tah - Add BMTRAN file for work order quantities.
; 12/20/2002 tah - Add INTRAN file for on order quantities.
; 12/26/1996 tah - Do not reset manufactured items quantities.
;=======================================================================;
.subroutine po8100

.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 "INS:incomm.gbl"
.include "INS:initem.rec"
.include "INS:inlocn.rec"
.include "INS:intran.rec"
.include "INS:inkits.rec"
.include "BMS:bmcomm.gbl"
.include "BMS:bmtran.rec"

record
	abort		,d1
	intran_lchan	,i4		; local channel for transaction file
	onorder_qty	,d9.3
	recs_read	,d6		; records read
	wrk_controlled	,a1
.start nopage,list

.proc
	;>>>>>	Main processing  <<<<<;
	call do_setup
	call open_files
	xcall confirm (ut_err)
	if (ut_err.ne.FALSE) call process_data
	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
	xcall status (,'Clears the Quantity On Order for all items.')
	return

	;	Shut down environment
do_shutdown,
	xcall e_exit
	return

	;	Open the needed data files
open_files,
	xcall open (pohedr_chan,'I:I',pohedr_name)
	xcall open (poline_chan,'I:I',poline_name)
	xcall open (initem_chan,'I:I',initem_name)
	xcall open (inkits_chan,'I:I',inkits_name)
	xcall open (inlocn_chan,'U:I',inlocn_name)
	xcall open (intran_chan,'I:I',intran_name)
	xcall open (intran_lchan,'I:I',intran_name,DTE_LOCAL)
	xcall open (bmtran_chan,'I:I',bmtran_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 (initem_chan,DTE_CLOSE)
	xcall close (inkits_chan,DTE_CLOSE)
	xcall close (inlocn_chan,DTE_CLOSE)
	xcall close (intran_chan,DTE_CLOSE)
	xcall close (intran_lchan,DTE_CLOSE)
	xcall close (bmtran_chan,DTE_CLOSE)
	return

	;	Process the data
process_data,
	abort = FALSE
	xcall status (DTEM_PRC)
	clear recs_read
	xcall statusbar (0,inlocn_chan)
	xcall db_find (inlocn_chan,ut_cmcomp,0,'M',,,opcde)
	repeat
	  begin
	    xcall db_next (inlocn_chan,inlocn,'F','M',,,opcde)
	    if (opcde) .or.
	    &  (inl_comp.ne.ut_cmcomp) exitloop
	    incr recs_read
	    if (.not.recs_read(5:2)) xcall statusbar (recs_read)
	    ini_key = inl_key
	    xcall in_get_item (initem)
;;	    if (ini_mnfctrd.ne.'Y')
;;	      begin
		clear inl_onorder,inl_atdock
		xcall db_update (inlocn_chan,inlocn,inl_key,inlocn_log,opcde)
;;	      end
	  end

	clear recs_read
	xcall statusbar (0,pohedr_chan)
	xcall status (,'Reading PO lines...')
	xcall db_find (pohedr_chan,ut_cmcomp,0,'M',,,opcde)
	repeat
	  begin
	    xcall db_next (pohedr_chan,pohedr,'F','M',,,opcde)
	    if (opcde) .or.
	    &  (pom_comp.ne.ut_cmcomp) exitloop
	    incr recs_read
	    if (.not.recs_read(5:2)) xcall statusbar (recs_read)
	    if (pom_status.ne.'C') .and.
	    &  (pom_status.ne.'D') call set_po_lines
	  end

	clear recs_read
	xcall statusbar (0,intran_chan)
	xcall status (,'Reading IN transactions...')
	xcall db_find (intran_chan,ut_cmcomp,0,'M',,,opcde)
	repeat
	  begin
	    xcall db_next (intran_chan,inthdr,'F','M',,,opcde)
	    if (opcde) .or.
	    &  (inthdr.comp.ne.ut_cmcomp) exitloop
	    incr recs_read
	    if (.not.recs_read(5:2)) xcall statusbar (recs_read)
	    if (inthdr.code .eq. 'T') .and.
	    &  (inthdr.status .ne. 'C') .and.
	    &  (inthdr.status .ne. 'X') call set_in_lines
	  end

	clear recs_read
	xcall statusbar (0,bmtran_chan)
	xcall status (,'Reading BM transactions...')
	xcall db_find (bmtran_chan,ut_cmcomp,0,'M',,,opcde)
	repeat
	  begin
	    xcall db_next (bmtran_chan,bmtran,'F','M',,,opcde)
	    if (opcde) .or.
	    &  (bmt_comp.ne.ut_cmcomp) exitloop
	    incr recs_read
	    if (.not.recs_read(5:2)) xcall statusbar (recs_read)
	    if (bmt_ordtype.eq.'B') .and.
	    &  (bmt_aloc.eq.'C') .and.
	    &  (bmt_updt.ne.'C') call set_bm_lines
	  end
	return

	;	Read and post matching purchase order lines
set_po_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) return	
	    if (pol_linetype.eq.'I') .and.
	    &  (pol_status.ne.'C' .and. pol_status.ne.'D')
	      begin
		if (pol_ordqty - pol_recpqty - pol_recuqty.gt.0) .or.
		&  (pol_recuqty.gt.0)
	 	  begin
		    ini_comp = pol_comp
		    ini_item = pol_item
		    xcall in_get_item (initem)
		    if (ini_mnfctrd.ne.'Y')
		      begin
			if (pol_slst.eq.'K')
			 then call po_update_kit
			 else call po_update_item
		      end
		  end
	      end
	  end

	;	Update inventory for PO line item
po_update_item,
	if (ini_controlled.eq.'Y')
	  begin
	    inl_comp = pol_comp
	    inl_item = pol_item
	    inl_locncode = pol_locncode
	    xcall in_get_locn (inlocn,1)
	    if (.not.opcde)
	      begin
		onorder_qty = (pol_ordqty - pol_recpqty - pol_recuqty)
		inl_onorder = inl_onorder + onorder_qty
		if (inl_onorder.lt.0) clear inl_onorder
		inl_atdock = inl_atdock + pol_recuqty
		xcall db_update (inlocn_chan,inlocn,inl_key,inlocn_log,opcde)
	      end
	  end
	return

	;	Update inventory kit components for PO line item
po_update_kit,
	inkitm.comp = pol_comp
	inkitm.item = pol_item
	clear inkitm.seqn
	xcall db_find (inkits_chan,inkitm.key,0,'M',,,opcde)
	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_dat (ini_key,'CONTROLLED',wrk_controlled)
	    if (wrk_controlled.eq.'Y')
	      begin
		inl_comp = inkcmp.comp
		inl_item = inkcmp.citem
		inl_locncode = pol_locncode
		xcall db_read (inlocn_chan,inlocn,inl_key,0,'M',,,opcde)
		if (.not.opcde)
		  begin
		    if (inkcmp.qty .gt. 0)
		     then onorder_qty = ((pol_ordqty - pol_recpqty - pol_recuqty)
				&	* inkcmp.qty)
		     else onorder_qty = -inkcmp.qty
		    inl_onorder = inl_onorder + onorder_qty
		    if (inl_onorder.lt.0) clear inl_onorder
		    xcall db_update (inlocn_chan,inlocn,inl_key,inlocn_log,opcde)
		  end
	      end
	  end

	;	Read and post matching inventory transaction lines
set_in_lines,
	xcall db_read (intran_lchan,inthdr,inthdr.key,0,'M',,,opcde)
	repeat
	  begin
	    xcall db_next (intran_lchan,intdtl,'F','M',,,opcde)
	    if (opcde) .or.
	    &  (intdtl.comp .ne. inthdr.comp) .or.
	    &  (intdtl.order .ne. inthdr.order) exitloop
	    if (intdtl.seqno .eq. 0) .and.
	    &  (intdtl.status .ne. 'D') .and.
	    &  (intdtl.qtyreq - intdtl.qtyprc .gt. 0)
	      begin
		ini_comp = intdtl.comp
		ini_item = intdtl.item
		xcall in_get_item (initem)
		if (ini_mnfctrd.ne.'Y')
		  begin
		    if (ini_slst.eq.'K')
		     then call in_update_kit
		     else call in_update_item
		  end
	      end
	  end
	return

	;	Update inventory for IN transaction line item
in_update_item,
	if (ini_controlled.eq.'Y')
	  begin
	    inl_comp = intdtl.comp
	    inl_item = intdtl.item
	    inl_locncode = inthdr.locnto
	    xcall in_get_locn (inlocn,1)
	    if (.not.opcde)
	      begin
		onorder_qty = intdtl.qtyreq - intdtl.qtyprc
		inl_onorder = inl_onorder + onorder_qty
		if (inl_onorder.lt.0) clear inl_onorder
		xcall db_update (inlocn_chan,inlocn,inl_key,inlocn_log,opcde)
	      end
	  end
	return

	;	Update inventory kit components for IN transaction line item
in_update_kit,
	inkitm.comp = intdtl.comp
	inkitm.item = intdtl.item
	clear inkitm.seqn
	xcall db_find (inkits_chan,inkitm.key,0,'M',,,opcde)
	repeat
	  begin
	    xcall db_next (inkits_chan,inkcmp,'F','M',,,opcde)
	    if (opcde) .or.
	    &  (inkcmp.comp .ne. intdtl.comp) .or.
	    &  (inkcmp.item .ne. intdtl.item) return

	    ini_comp = inkcmp.comp
	    ini_item = inkcmp.citem
	    xcall in_get_item_dat (ini_key,'CONTROLLED',wrk_controlled)
	    if (wrk_controlled.eq.'Y')
	      begin
		inl_comp = inkcmp.comp
		inl_item = inkcmp.citem
		inl_locncode = inthdr.locnfrom
		xcall db_read (inlocn_chan,inlocn,inl_key,0,'M',,,opcde)
		if (.not.opcde)
		  begin
		    if (inkcmp.qty .gt. 0)
		     then onorder_qty = ((intdtl.qtyreq - intdtl.qtyprc)
				&	* inkcmp.qty)
		     else onorder_qty = -inkcmp.qty
		    inl_onorder = inl_onorder + onorder_qty
		    if (inl_onorder.lt.0) clear inl_onorder
		    xcall db_update (inlocn_chan,inlocn,inl_key,inlocn_log,opcde)
		  end
	      end
	  end

	;	Post BM item to inventory
set_bm_lines,
	inl_comp = bmt_comp
	inl_item = bmt_item
	inl_locncode = bmt_locn
	xcall in_get_locn (inlocn,1)		; Get and lock
	if (opcde)
	 then xcall message (DTEPO_INL,D_ERROR,bmt_item,bmt_locn)
	 else
	  begin
	    inl_onorder = inl_onorder + (bmt_rqty - bmt_cqty)
	    xcall db_update (inlocn_chan,inlocn,inl_key,inlocn_log,opcde)
	  end
	return
.end

