;==File=================================================================;
; PO4600.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=============================================================;
;	po4600		Print PO receivings/OE unshipped report.
;==Changes==============================================================;
; 06/04/2003 tah - Patch for 1 step receivings.
;=======================================================================;
.subroutine po4600

.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 "OES:oecomm.gbl"
.include "OES:oehedr.rec"
.include "OES:oeline.rec"
.include "INS:incomm.gbl"
.include "SMS:smcode.rec"

external function
	smctrl		,a

record	head1
		,a*	@1,	'-------------------ITEM--------------------'
		,a*	@45,	'P/O-NO'
		,a*	@52,	'LIN'
		,a*	@56,	'----------------VENDOR----------------'
		,a*	@96,	'LOC'
		,a*	@102,	'QUANTITY'
record	head2
		,a*	@51,	'S/O-NO'
		,a*	@58,	'LIN'
		,a*	@62,	'------------CUSTOMER------------'
		,a*	@95,	'LOC'
		,a*	@100,	'SLMN'
		,a*	@106,	'ORDERED'
		,a*	@114,	'REQUIRED'
		,a*	@125,	'B/O QTY'

record	legnd1
		,a*	@1,	'COMPANY:'
	lcompy	,a2	@10

record	pline
		,a132
record	,X
	pritem		,a12	@1
	prdesc		,a30	@14
	prpord		,a6	@45
	prline		,a3	@52
	prvend		,a8	@56
	prname		,a30	@65
	prlocn		,a3	@96
	prrcqt		,a10	@100
record	,X
	prorno		,a6	@51
	prolin		,a3	@58
	procst		,a6	@62
	pronam		,a25	@69
	proloc		,a3	@95
	proslm		,a3	@101
	prodat		,a8	@105
	prorqd		,a8	@114
	probqt		,a10	@123

record
	abort		,d1
	boqt		,d9.3		; computed back order quantity
	mask0		,a10,	'   ZZZ,ZZX'
	mask3		,a10,	'ZZZZZZ.XXX'
	recs_read	,d6
	title		,a*,	'ITEMS RECEIVED/BACK-ORDERED REPORT'
	unshipped	,a1		; unshipped or back ordered only
.start nopage,list

.proc
	;>>>>>	Main processing  <<<<<;
	call do_setup
	call open_files
	if (abort.eq.FALSE)
	  begin
	    call get_destination
	    if (abort.eq.FALSE)
	      begin
		call print_report
		call print_report_totals
		xcall clslp ('Received/Back order Report')
	      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
	xcall lodtoolbar ('AB',8)
	unshipped = %smctrl(ut_cmcomp,'PO','PO4600UQTY')
	return

	;	Shut down environment
do_shutdown,
	xcall lodtoolbar ('RB',8)
	xcall e_exit
	return

	;	Open the needed data files
open_files,
	abort = FALSE
	xcall open (pohedr_chan,'I:I',pohedr_name)
	xcall open (poline_chan,'I:I',poline_name)
	if (%smctrl(ut_cmcomp,'OE','OEHEDR'))
	  begin
	    xcall open (oehedr_chan,'I:I',oehedr_name)
	    xcall open (oeline_chan,'I:I',oeline_name)
	  end
	return

	;	Close the data files opened for the report
close_files,
	xcall close (pohedr_chan,DTE_CLOSE)
	xcall close (poline_chan,DTE_CLOSE)
	if (oehedr_chan) xcall close (oehedr_chan,DTE_CLOSE)
	if (oeline_chan) xcall close (oeline_chan,DTE_CLOSE)
	return

	;	Get the output destination
get_destination,
	abort = FALSE
	clear lp_sel
	xcall askpr (ut_cmname,132,61,0,ut_cmdefp)
	if (lp_sel.eq.'E') abort = TRUE
	return

	;	Print the report
print_report,
	xcall status (DTEM_PRT)
	clear recs_read
	xcall statusbar (0,poline_chan)
	clear pol_item
	xcall db_read (poline_chan,poline,pol_item,1,'M',,,opcde)
	repeat
	  begin
	    if (pol_comp.eq.ut_cmcomp) .and.
	    &  (pol_status.ne.'D') .and.
	    &  ((po_cmrectyp.eq.1 .and. pol_recdqty.gt.0) .or.
	    &   (po_cmrectyp.eq.2 .and. pol_recuqty.gt.0)) call process_line_item
	    xcall db_next (poline_chan,poline,'F','M',,,opcde)
	    if (opcde) return
	    incr recs_read
	    if (.not.recs_read(5:2)) xcall statusbar (recs_read)
	  end

	;	Print the report totals
print_report_totals,
	return

process_line_item,
	pom_comp = pol_comp
	pom_order = pol_order
	xcall db_read (pohedr_chan,pohedr,pom_key,0,'M',,,opcde)
	if (opcde) .or.
	&  (pom_flag3.ne.'Y') return

	call print
	pritem = pol_item
	prdesc = pol_descr
	prPORD = pol_order, 'XXXXXX'
	prline = pol_lineno, 'ZZX'
	prvend = pom_vend, 'XXXXXXXX'
	prname = pom_name
	prlocn = pol_locncode
	case in_cmqdec of
	  begincase
	  0: prrcqt = pol_recuqty, mask0
	  3: prrcqt = pol_recuqty, mask3
	  endcase
	call print
	if (oehedr_chan) call get_sales_orders
	return

	;	Get outstanding sales order information
get_sales_orders,
	oel_item = pol_item
	xcall db_read (oeline_chan,oeline,oel_item,1,'M',,,opcde)
	if (opcde) return
	repeat
	  begin
	    if (oel_comp.eq.pol_comp) .and.
	    &  (oel_linestatus.ne.'D' .and. 		; Line deleted
	    &   oel_linestatus.ne.'C') .and.		; Line completed
	    &  ((unshipped.eq.'N' .and. oel_qtystatus.ne.'N') .or.
	    &   (unshipped.eq.'Y')) .and.
	    &  (oel_qtystatus.ne.'D' .and.		; Drop ship
	    &   oel_qtystatus.ne.'O')			; Override
	      begin
		boqt = oel_boqty			; Set back ord qty
		if ((oel_shpqty + oel_pckqty).le.oel_ordqty) ; Compute unshipped
		    boqt = oel_ordqty - (oel_shpqty + oel_pckqty)
		if (boqt.gt.0)				; If unshipped gt zero
		  begin
		    oem_comp = oel_comp
		    oem_order = oel_order
		    xcall db_read (oehedr_chan,oehedr,oem_key,0,'M',,,opcde)
		    if (opcde) clear oehedr

		    prorno = oel_order, 'XXXXXX'
		    prolin = oel_lineno, 'ZZX'
		    procst = oem_cust
		    pronam = oem_shipname
		    proloc = oel_locncode
		    proslm = oem_slmncode
		    xcall dtdsp (oem_orddate,prodat)
		    xcall dtdsp (oem_reqdate,prorqd)
		    case in_cmqdec of
		      begincase
		      0: probqt = boqt, mask0
		      3: probqt = boqt, mask3
		      endcase
		    call print
		  end
	      end
	    xcall db_next (oeline_chan,oeline,'F','M',,,opcde)
	    if (opcde) .or.
	    &  (oel_item.ne.pol_item) exitloop
	  end
	return

	;	Print a detail line of the report
print,
	xcall print (pline,title,head1,head2,,legnd1)
	clear pline
	if (lp_cnt.eq.-1)
	  begin
	    call close_files
	    call do_shutdown
	    xreturn		; to calling program
	  end
	return
.end

