;==File=================================================================;
; PO4500.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=============================================================;
;	po4500		Print daily receivings report.
;==Changes==============================================================;
; 08/07/2002 tah - Change for new PORECV file.
; 05/02/2001 tah - Change for new POSNLT file format (kits)
; 03/27/2001 tah - Add serial/lot number printing.
;=======================================================================;
.subroutine po4500

.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:porecv.rec"
.include "POS:poline.rec"
.include "POS:posnlt.rec"
.include "INS:incomm.gbl"
.include "INS:initem.rec"
.include "INS:inkits.rec"

record	head1
		,a*	@73,	'+-----RECEIVED-----+'
		,a*	@93,	'+-----ACCEPTED-----+'
		,a*	@113,	'+-----REJECTED-----+'

record	head2
		,a*	@2,	'ORDER'
		,a*	@8,	'LIN'
		,a*	@12,	'LOC'
		,a*	@16,	'ITEM'
		,a*	@41,	'DESCRIPTION'
		,a*	@75,	'QUANTITY'
		,a*	@89,	'COST'
		,a*	@95,	'QUANTITY'
		,a*	@109,	'COST'
		,a*	@115,	'QUANTITY'
		,a*	@129,	'COST'

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

record	pline
		,a132
record	,X
	prt_orno	,a6	@1
	prt_line	,a3	@8
	prt_locn	,a3	@12
	prt_item	,a24	@16
	prt_descr	,a30	@41
	prt_atdqty	,a10	@73
	prt_atdcost	,a10	@83
	prt_acpqty	,a10	@93
	prt_acpcost	,a10	@103
	prt_rejqty	,a10	@113
	prt_rejcost	,a10	@123

record	serial
	prt_slds	,a4	@6
	prt_snlt1	,a20	@10
	prt_snlt2	,a20	@34
	prt_snlt3	,a20	@58
	prt_snlt4	,a20	@82
	prt_snlt5	,a20	@106

record	lot
	prt_lds1	,a4	@6,	'Lot:'
	prt_lot1	,a20	@10
	prt_rcqt1	,a10	@32
	prt_lds2	,a4	@44,	'Lot:'
	prt_lot2	,a20	@48
	prt_rcqt2	,a10	@70

record	scr_rec1		; input set 1
	scr_curdate	,d8		; date to print

record	totals
	ord_recqty	,d9.3		; total received quantity
	ord_acpqty	,d9.3		; total accepted quantity
	ord_rejqty	,d9.3		; total rejected quantity
	ord_reccost	,d9.3		; total received cost
	ord_acpcost	,d9.3		; total accepted cost
	ord_rejcost	,d9.3		; total rejected cost
	tot_recqty	,d9.3		; total received quantity
	tot_acpqty	,d9.3		; total accepted quantity
	tot_rejqty	,d9.3		; total rejected quantity
	tot_reccost	,d9.3		; total received cost
	tot_acpcost	,d9.3		; total accepted cost
	tot_rejcost	,d9.3		; total rejected cost

record
	abort		,d1
	cur_order	,d6		; current order number
	kit_slqty	,d6		; Total units needed for kit component
	line_prt	,d1		; line printed switch
	mask		,a10,	'ZZZ,ZZX.XX'
	mask0		,a10,	'  ZZZ,ZZX-'
	mask3		,a10,	'ZZZZZX.XXX'
	recs_read	,d6
	title		,a*,	'RECEIVINGS REPORT'
	wdone		,d1
	wind_name	,a*,	'po4500'
	wind_no		,d2		; input window id
	wind_signal	,a31
	wrk_amt		,d10.3		; work area for computing values
.start nopage,list

.proc
	;>>>>>	Main processing  <<<<<;
	call do_setup
	call open_files
	call get_parameters
	if (abort.eq.FALSE)
	  begin
	    call get_destination
	    if (abort.eq.FALSE)
	      begin
		call print_report
		call print_report_totals
		xcall clslp ('PO Receivings 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)
	return

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

	;	Open the needed data files
open_files,
	xcall open (porecv_chan,'I:I',porecv_name)
	xcall open (poline_chan,'I:I',poline_name)
	xcall open (posnlt_chan,'I:I',posnlt_name)
	xcall open (initem_chan,'I:I',initem_name)
	xcall open (inkits_chan,'I:I',inkits_name)
	return

	;	Close the data files opened for the report
close_files,
	xcall close (porecv_chan,DTE_CLOSE)
	xcall close (poline_chan,DTE_CLOSE)
	xcall close (posnlt_chan,DTE_CLOSE)
	xcall close (initem_chan,DTE_CLOSE)
	xcall close (inkits_chan,DTE_CLOSE)
	return

	;	Get the report selection parameters
get_parameters,
	repeat
	  begin
	    xcall get_parameters (wind_no,wind_name,'set1',scr_rec1,abort,wind_signal)
	    if (abort.eq.TRUE) exitloop
	    if (wind_signal)
	     then call process_signal
	     else
	      begin
		call verify_input_parameters
		if (wdone.eq.TRUE) exitloop
	      end
	  end
	return

	;	Process any break signals
process_signal,
	case g_entnam of
	  begincase
	  '@': nop
	  endcase
	return

verify_input_parameters,
	wdone = TRUE
	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,porecv_chan)
	clear totals,cur_order
	xcall db_find (porecv_chan,ut_cmcomp,0,'M',,,opcde)

	;	Main processing loop
	repeat
	  begin
	    xcall db_next (porecv_chan,porecv,'F','M',,,opcde)
	    if (opcde) .or.
	    &  (por_comp.ne.ut_cmcomp) return
	    incr recs_read
	    if (.not.recs_read(5:2)) xcall statusbar (recs_read)
	    if (por_recdate.eq.scr_curdate) call print_line
	  end

	;	Print the report totals
print_report_totals,
	if (cur_order) call order_totals
	prt_item = '>> REPORT TOTALS >>'
	prt_atdqty = tot_recqty, mask3
	prt_atdcost = tot_reccost, mask
	prt_acpqty = tot_acpqty, mask3
	prt_acpcost = tot_acpcost, mask
	prt_rejqty = tot_rejqty, mask3
	prt_rejcost = tot_rejcost, mask
	call print
	return

	;	Print the line item
print_line,
	if (cur_order.ne.por_order)
	  begin
	    if (cur_order) call order_totals
	    cur_order = por_order
	  end

	prt_orno = por_order, 'XXXXXX'
	prt_line = por_lineno, 'ZZX'
	prt_locn = por_locncode
	prt_item = por_item
	prt_descr = por_descr
	prt_atdqty = por_recuqty, mask3
	wrk_amt = (por_ucost * por_recuqty)
	prt_atdcost = wrk_amt, mask
	ord_reccost = ord_reccost + wrk_amt
	ord_recqty = ord_recqty + por_recuqty

	prt_acpqty = por_recdqty, mask3
	wrk_amt = (por_ucost * por_recdqty)
	prt_acpcost = wrk_amt, mask
	ord_acpcost = ord_acpcost + wrk_amt
	ord_acpqty = ord_acpqty + por_recdqty

	prt_rejqty = por_recrqty, mask3
	wrk_amt = (por_ucost * por_recrqty)
	prt_rejcost = wrk_amt, mask
	ord_rejcost = ord_rejcost + wrk_amt
	ord_rejqty = ord_rejqty + por_recrqty

	call print

	pol_comp = por_comp
	pol_order = por_order
	pol_lineno = por_lineno
	xcall db_read (poline_chan,poline,pol_key,0,'M',,,opcde)
	if (.not.opcde)
	  begin
	    if (pol_slst.eq.'S' .or. pol_slst.eq.'L') call print_serial
	    if (pol_slst.eq.'K') call print_kit
	  end
	return

	;	print serial/lot numbers
print_serial,
	clear line_prt
	pos_comp = por_comp
	pos_order = por_order
	pos_lineno = por_lineno
	clear pos_item
	pos_seqno = 1
	xcall db_find (posnlt_chan,pos_key,0,'M',,,opcde)
	repeat
	  begin
	    xcall db_next (posnlt_chan,posnlt,'F','M',,,opcde)
	    if (opcde) .or.
	    &  (pos_comp.ne.por_comp) .or.
	    &  (pos_order.ne.por_order) .or.
	    &  (pos_lineno.ne.por_lineno) .or.
	    &  (pos_item.ne.UT_BLANKS) exitloop
	    if (pos_linestatus.ne.'D')
	      begin
		case pol_slst of
		  begincase
		  'L': call print_lots
		  'S': call print_serials
		  endcase
	      end
	  end
	if (line_prt)
	  begin
	    case pol_slst of
	      begincase
	      'L': begin
		    pline = lot
		    call print
		    clear line_prt,lot
		   end
	      'S': begin
		    pline = serial
		    call print
		    clear line_prt,serial
		   end
	      endcase
	  end
	return

	;	print kit components
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
	    ini_comp = inkcmp.comp
	    ini_item = inkcmp.citem
	    xcall in_get_item (initem)
	    prt_locn = 'Kit'
	    prt_item = inkcmp.citem
	    prt_descr = ini_desc
	    if (inkcmp.qty.lt.0)
	     then kit_slqty = -inkcmp.qty
	     else kit_slqty = pol_recdqty * inkcmp.qty
	    prt_acpqty = kit_slqty * 1000, mask3
	    call print
	    if (ini_slst.eq.'L' .or. ini_slst.eq.'S') call print_kit_slnos
	  end
	return

	;	print serial/lot numbers
print_kit_slnos,
	clear line_prt
	pos_comp = por_comp
	pos_order = por_order
	pos_lineno = por_lineno
	pos_item = inkcmp.citem
	pos_seqno = 1
	xcall db_find (posnlt_chan,pos_key,0,'M',,,opcde)
	repeat
	  begin
	    xcall db_next (posnlt_chan,posnlt,'F','M',,,opcde)
	    if (opcde) .or.
	    &  (pos_comp.ne.por_comp) .or.
	    &  (pos_order.ne.por_order) .or.
	    &  (pos_lineno.ne.por_lineno) .or.
	    &  (pos_item.ne.inkcmp.citem) exitloop
	    if (pos_linestatus.ne.'D')
	      begin
		case ini_slst of
		  begincase
		  'L': call print_lots
		  'S': call print_serials
		  endcase
	      end
	  end
	if (line_prt)
	  begin
	    case ini_slst of
	      begincase
	      'L': begin
		    pline = lot
		    call print
		    clear line_prt,lot
		   end
	      'S': begin
		    pline = serial
		    call print
		    clear line_prt,serial
		   end
	      endcase
	  end
	return

print_lots,
	incr line_prt
	if (line_prt.eq.1)
	  begin
	    prt_lds1 = 'Lot:'
	     prt_lot1 = pos_snlt
	     prt_rcqt1 = pos_qty, mask0
	  end
	if (line_prt.eq.2)
	  begin
	    prt_lds2 = 'Lot:'
	    prt_lot2 = pos_snlt
	    prt_rcqt2 = pos_qty, mask0
	    pline = lot
	    call print
	    clear line_prt,lot
	  end
	return

print_serials,
	incr line_prt
	if (line_prt.eq.1)
	  begin
	    prt_slds = 'S/N:'
	    prt_snlt1 = pos_snlt
	  end
	if (line_prt.eq.2) prt_snlt2 = pos_snlt
	if (line_prt.eq.3) prt_snlt3 = pos_snlt
	if (line_prt.eq.4) prt_snlt4 = pos_snlt
	if (line_prt.eq.5)
	  begin
	    prt_snlt5 = pos_snlt
	    pline = serial
	    call print
	    clear line_prt,serial
	  end
	return

order_totals,
	call print
	prt_item = '>> ORDER TOTALS >>'
	prt_atdqty = ord_recqty, mask3
	prt_atdcost = ord_reccost, mask
	prt_acpqty = ord_acpqty, mask3
	prt_acpcost = ord_acpcost, mask
	prt_rejqty = ord_rejqty, mask3
	prt_rejcost = ord_rejcost, mask
	call print
	call print
	tot_reccost = tot_reccost + ord_reccost
	tot_recqty = tot_recqty + ord_recqty
	tot_acpcost = tot_acpcost + ord_acpcost
	tot_acpqty = tot_acpqty + ord_acpqty
	tot_rejcost = tot_rejcost + ord_rejcost
	tot_rejqty = tot_rejqty + ord_rejqty
	clear ord_reccost,ord_recqty,ord_acpcost,ord_acpqty,ord_rejcost,ord_rejqty
	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


