;==File=================================================================;
; PO4310.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=============================================================;
;	po4310		Print receivings proof report.
;==Changes==============================================================;
; 11/18/2002 tah - Added control record to print kits, fixed total amt recvd.
; 06/26/1999 tah - Allow receipt of more units than ordered.
;=======================================================================;
.subroutine po4310

.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:posnlt.rec"
.include "INS:incomm.gbl"
.include "INS:inkits.rec"
.include "SMS:smcode.rec"
external function
	smctrl		,a

record	head1
		,a*	@1,	'ORDER'
		,a*	@11,	'VENDOR NAME'
		,a*	@83,	'QUANTITY'
		,a*	@94,	'RECEIVED'
		,a*	@105,	'RECEIVED'
		,a*	@116,	'DATE'
		,a*	@125,	'QUANTITY'
record	head2
		,a*	@3,	'SEQ'
		,a*	@8,	'ITEM NO'
		,a*	@33,	'DESCRIPTION'
		,a*	@64,	'VENDOR ITEM'
		,a*	@77,	'UOM'
		,a*	@84,	'ORDERED'
		,a*	@97,	'PRIOR'
		,a*	@106,	'CURRENT'
		,a*	@114,	'RECEIVED'
		,a*	@124,	'REMAINING'
record	legnd1
		,a*	@1,	'COMPANY:'
	lcompy	,a2	@10

record	pline
		,a132
record	,X
	prorno		,a6	@1
	prvend		,a8	@9
	prname		,a30	@18
record	,X
	prseqn		,a3	@3
	pritem		,a24	@8
	prdesc		,a30	@33
	prvnid		,a12	@64
	pruom		,a3	@77
	prorqt		,a10	@81
	prrcvd		,a10	@92
	prrcqt		,a10	@103
	prrcdt		,a8	@114
	prrem		,a10	@123
record	,X
	prslds		,a4	@60
	prsitm		,a24	@66
	prsnlt		,a20	@92
record	,X
	prkitd		,a4	@60
	prkiti		,a24	@66
	prkqty		,a10	@92
	prksln		,a20	@104

record	total
			,a*	@4,	'* ORDER TOTALS *'
			,a*	@22,	'LINES:'
	tlines		,a3	@28
			,a*	@33,	'COMPLETE:'
	tlinec		,a3	@42
			,a*	@47,	'PARTIAL:'
	tlinep		,a3	@55
			,a*	@62,	'AMOUNT:'
	tdolamt		,a10	@69
			,a*	@80,	'RECEIVED:'
	tdolrec		,a10	@89
	tpctrec		,a6	@100
			,a*	@106,	'%'

record	totals
	ord_lines	,d3		; number of lines on order
	ord_linec	,d3		; number of lines completed
	ord_linep	,d3		; number of lines partial
	ord_amount	,d9.2		; total order dollars
	ord_amtrec	,d9.2		; total order received
	ord_qtyrec	,d9.3		; total quantity received
	ord_tamtrec	,d10.2		; total order received
	ord_pctrec	,d5.2		; percent received

record
	abort		,d1
	mask		,a10,	'ZZZ,ZZZ.XX'
	mask0		,a10,	'  ZZZ,ZZX-'
	mask3		,a10,	'ZZZZZZ.XXX'
	qtyrem		,d9.3		; quantity remaining
	print_kits	,a1		; print kits flag
	recs_read	,d6
	rpt_amtrec	,d10.2		; total report dollars received
	rpt_qtyrec	,d9.3		; total report quantity received
	title		,a*,	'PURCHASE RECEIVINGS PROOF'
	tot_cost	,d9.3		; total line item cost
.start nopage,list

.proc
	;>>>>>	Main processing  <<<<<;
	call do_setup
	call open_files
	call get_destination
	if (abort.eq.FALSE)
	  begin
	    call print_report
	    call print_report_totals
	    clear ut_ert
	    ut_ert(1:16) = 'Receivings proof'
	    ut_ert(18:8) = ut_datdsp
	    xcall clslp (ut_ert)
	    clear ut_ert
	  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)
	print_kits = %smctrl(ut_cmcomp,'PO','PRINTKITS',1)
	return

	;	Shut down environment
do_shutdown,
	xcall lodtoolbar ('RB',8)
	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 (posnlt_chan,'I:I',posnlt_name)
	if (print_kits.eq.'Y') xcall open (inkits_chan,'I:I',inkits_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 (posnlt_chan,DTE_CLOSE)
	if (print_kits.eq.'Y') xcall close (inkits_chan,DTE_CLOSE)
	return

	;	Get the output destination
get_destination,
	abort = FALSE
	lcompy = ut_cmcomp
	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,pohedr_chan)
	clear totals,rpt_amtrec,rpt_qtyrec
	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) return
	    incr recs_read
	    if (.not.recs_read(5:2)) xcall statusbar (recs_read)
	    if (pom_status.ne.'C' .and. pom_flag3.eq.'Y')
	      begin
		prorno = pom_order, 'XXXXXX'
		prvend = pom_vend, 'XXXXXXXX'
		prname = pom_name
		call print			; print order header
		call print_lines		; process line items
		call end_order			; print order totals
	      end
	  end

	;	Print the report totals
print_report_totals,
	call print
	prdesc = '>> REPORT TOTALS >>'
	prrcvd = 'QUANTITY:'
	prrcqt = rpt_qtyrec, mask3
	prrcdt = 'DOLLARS:'
	prrem = rpt_amtrec, mask
	call print
	return

	;	print detail lines
print_lines,
	xcall db_find (poline_chan,pom_key,0,'M',,,opcde)
	repeat
	  begin
	    xcall db_next (poline_chan,poline,'F','M',,,opcde)
	    if (opcde) .or.
	    &  (pol_comp.ne.pom_comp) .or.
	    &  (pol_order.ne.pom_order) return
	    if (pol_status.ne.'D')
	      begin
		incr ord_lines
		ord_amount = ord_amount + pol_ordcost
		call print_one_line
	      end
	  end

print_one_line,
	if (pol_status.eq.'C')
	  begin
	    incr ord_linec
	    return
	  end

	if ((po_cmrectyp.eq.1) .and.
	&   (pol_recdqty.ne.0)) .or.
	&  ((po_cmrectyp.eq.2) .and.
	&   (pol_recuqty.ne.0))
	  begin
	    prseqn = pol_lineno, 'ZZX'		; Set up print line
	    pritem = pol_item
	    prdesc = pol_descr
	    prvnid = pol_vendpn
	    pruom = pol_buomcode
	    xcall dtdsp (pol_recdate,prrcdt)
	    case po_cmrectyp of
	      begincase				; calculate quantity remaining
	      1: qtyrem = pol_ordqty - pol_recpqty - pol_recdqty
	      2: qtyrem = pol_ordqty - pol_recpqty - pol_recuqty
	      endcase
	    if (qtyrem.lt.0) clear qtyrem
	    case in_cmqdec of
	      begincase
	      0: begin
		  prorqt = pol_ordqty, mask0		; total qty ordered
		  prrcvd = pol_recpqty, mask0		; qty recvd prior
		  case po_cmrectyp of
		    begincase
		    1: prrcqt = pol_recdqty, mask0	; qty recvd current
		    2: prrcqt = pol_recuqty, mask0	; qty recvd current
		    endcase
		  prrem = qtyrem, mask0			; qty remaining
		 end
	      3: begin
		  prorqt = pol_ordqty, mask3		; total qty ordered
		  prrcvd = pol_recpqty, mask3		; qty recvd prior
		  case po_cmrectyp of
		    begincase
		    1: prrcqt = pol_recdqty, mask3	; qty recvd current
		    2: prrcqt = pol_recuqty, mask3	; qty recvd current
		    endcase
		  prrem = qtyrem, mask3			; qty remaining
		 end
	      endcase
	    call print
	    if (qtyrem.eq.0)			; Accumulate totals
	     then incr ord_linec
	     else incr ord_linep
	    case po_cmrectyp of
	      begincase
	      1: begin
		  tot_cost = ((pol_recdqty + pol_recpqty) * pol_ucost)
		  ord_qtyrec = ord_qtyrec + pol_recdqty
		  rpt_qtyrec = rpt_qtyrec + pol_recdqty
		 end
	      2: begin
		  tot_cost = ((pol_recuqty + pol_recpqty) * pol_ucost)
		  ord_qtyrec = ord_qtyrec + pol_recuqty
		  rpt_qtyrec = rpt_qtyrec + pol_recuqty
		 end
	      endcase
	    tot_cost = tot_cost - ((tot_cost * pol_discpct) / 100.0)
	    ord_amtrec = ord_amtrec + tot_cost
	    ord_tamtrec = ord_tamtrec + tot_cost
	    rpt_amtrec = rpt_amtrec + tot_cost
	    case pol_slst of
	      begincase
	      'S': call print_serial
	      'L': call print_serial
	      'K': if (print_kits.eq.'Y') call print_kit
	      endcase
	  end
	return

	;	print serial/lot numbers
print_serial,
	xcall db_find (posnlt_chan,pol_key,0,'M',,,opcde)
	repeat
	  begin
	    xcall db_next (posnlt_chan,posnlt,'F','M',,,opcde)
	    if (opcde) .or.
	    &  (pos_comp.ne.pol_comp) .or.
	    &  (pos_order.ne.pol_order) .or.
	    &  (pos_lineno.ne.pol_lineno) return
	    if (pos_linestatus.ne.'D')
	      begin
		case pol_slst of
		  begincase
		  'S': begin
		        prslds = 'S/N:'
		        prsnlt = pos_snlt
		        if (pos_item) prsitm = pos_item	; Kit component
		       end
		  'L': begin
		        prslds = 'Lot:'
		        prsnlt = pos_snlt
		        prrcqt = pos_qty, mask0
		        if (pos_item) prsitm = pos_item	; Kit component
		       end
		  endcase
	      end
	    call print
	  end

print_kit,
	inkitm.comp = pol_comp
	inkitm.item = pol_item
	clear inkitm.seqn
	xcall db_read (inkits_chan,inkitm,inkitm.key,0,'M',,,opcde)
	if (opcde) return		; not found
	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

	    if (inkcmp.status .ne. 'D') .and.
	    &  (inkcmp.status .ne. 'I')
	      begin
		pos_comp = pol_comp
		pos_order = pol_order
		pos_lineno = pol_lineno
		pos_item = inkcmp.citem
		pos_seqno = 1
		xcall db_find (posnlt_chan,pos_key,0,'M',,,opcde)
		if (opcde) then
		  begin		; No serial numbers for component
		    prkitd = 'Kit:'
		    prkiti = inkcmp.citem
		    if (inkcmp.qty .lt. 0)
		     then prkqty = -inkcmp.qty, mask3
		     else prkqty = (inkcmp.qty * pol_ordqty), mask3
		    call print
		  end
		 else
		  begin		; Component has serial numbers
		    repeat
		      begin
			xcall db_next (posnlt_chan,posnlt,'F','M',,,opcde)
			if (opcde) .or.
			&  (pos_comp.ne.pol_comp) .or.
			&  (pos_order.ne.pol_order) .or.
			&  (pos_lineno.ne.pol_lineno) .or.
			&  (pos_item.ne.inkcmp.citem) exitloop
			if (pos_linestatus.ne.'D')
			    begin
			      prkitd = 'Kit:'
			      prkiti = pos_item
			      prkqty = pos_qty, mask3
			      prksln = pos_snlt
			      call print
			    end
			end
		    end
	      end
	  end
	return

	;	Print order totals
end_order,
	tlines = ord_lines, 'ZZX'
	tlinec = ord_linec, 'ZZX'
	tlinep = ord_linep, 'ZZX'
	tdolamt = ord_amount, mask
	tdolrec = ord_amtrec, mask
	clear ord_pctrec
	if (ord_amount) ord_pctrec = (ord_amtrec / ord_amount) * 100.0
	tpctrec = ord_pctrec, 'ZZZ.XX'
	pline = total
	call print
	call print
	clear totals
	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


