;==File=================================================================;
; PO6400.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=============================================================;
;	po6400		Supplier performance report
;==Changes==============================================================;
; 03/12/1998 tah - Omit items with qty ordered = zero.
;=======================================================================;
.subroutine po6400

.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 "NAS:nacomm.gbl"
.include "NAS:namast.rec"

record	ordidx
	oxvend		,d8		; vendor id
	oxitem		,a24		; item number
	oxlocn		,a3		; location code
	oxorno		,d6		; order number
	oxline		,d3		; line number

record	scr_rec1		; input set 1
	scr_strvend	,d8		; starting vendor
	scr_endvend	,d8		; ending vendor
	scr_strdate	,d8		; starting date
	scr_enddate	,d8		; ending date

record	head1
		,a*	@2,	'ORDER'
		,a*	@8,	'ITEM-NO'
		,a*	@34,	'DESCRIPTION'
		,a*	@69,	'QTY-ORD'
		,a*	@84,	'QTY-REC'
		,a*	@95,	'LAST-REC'
		,a*	@107,	'DATE-DUE'
		,a*	@116,	'ON-TIME'

record	legnd1
		,a*	@1,	'COMPANY:'
	lcompy	,a2	@11
record	legnd2
			,a*	@1,	'Vendor:'
	prname		,a30	@9
			,a*	@42,	'ID:'
	prvend		,a8	@46

record	pline
			,a132
record	,X
	prorno		,a6	@1
	pritem		,a24	@8
	prdesc		,a30	@34
	proorqty	,a12	@66
	prrcvqty	,a12	@80
	prrcvdate	,a10	@94
	prreqdate	,a10	@106
	prontime	,a1	@119

record	tot_line
	ptot_lines	,a6	@11
			,a*	@18,	'Line Items'
	ptot_ontime	,a6	@31
			,a*	@38,	'On Time'
	ptot_pctontime	,a6	@51
			,a*	@58,	'% Serviceability'

record	totals
	total_items	,d6		; total lines for vendor
	total_ontime	,d6		; total lines on time for vendor

record
	abort		,d1
	cur_vendor	,d8		; current vendor
	mask0		,a12,	' ZZZ,ZZZ,ZZX'
	mask3		,a12,	' ZZZ,ZZZ.XXX'
	otpct		,d10.2		; on time percentage
	pctrec		,d10.2		; percentage received
	received_qty	,d9.3		; quantity received
	recs_read	,d6
	temp_name	,a14		; temp file for sort
	  temp_ext	,a3	@temp_name+11
	title		,a*,	'SUPPLIER PERFORMANCE'
	wdone		,d1
	wind_name	,a*,	'po6400'
	wind_no		,d2		; input window id
	wind_signal	,a31
	work_chan	,d2		; channel for work/sort file
	work_name	,a14,	'WRK:ordidx.ddf'
	  work_ext	,a3	@work_name+11
	wrtcnt		,d6		; count of records written to work file
.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 pull_data
		if (abort.eq.FALSE)
		  begin
		    call sort_data
		    call print_report
		    call print_report_totals
		    xcall clslp ('Supplier Performance')
		  end
	      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 (pohedr_chan,'I:I',pohedr_name)
	xcall open (poline_chan,'I:I',poline_name)
	xcall open (namast_chan,'I:I',namast_name)
	xcall open (smcode_chan,'I:I',smcode_name)
	work_ext = ut_userid
	xcall open (work_chan,'O',work_name)
	return

	;	Close the data files opened for the report
close_files,
	xcall close (work_chan,DTE_PURGE)
	xcall close (pohedr_chan,DTE_CLOSE)
	xcall close (poline_chan,DTE_CLOSE)
	xcall close (namast_chan,DTE_CLOSE)
	xcall close (smcode_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
	if (scr_strdate.gt.scr_enddate) .or.
	&  (scr_strvend.gt.scr_endvend)
	  begin
	    xcall message (DTER_ERR)
	    wdone = FALSE
	  end
	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

	;	Extract data for the report
pull_data,
	abort = FALSE
	xcall status (DTEM_PRC)
	clear recs_read
	xcall statusbar (0,poline_chan)
	call pull_work_data
	xcall close (work_chan,DTE_CLOSE)
	if (wrtcnt.eq.0)
	  begin
	    xcall message (DTEPO_OOF,D_ERROR)
	    abort = TRUE
	  end
	return

	;	Sort the extracted data
sort_data,
	xcall status (DTEM_SRT)
	temp_name = work_name
	temp_ext = ut_cmterm, 'XXX'
	sort (in=work_name,record=ordidx,
	&  key=(oxvend,oxitem,oxorno),tempfile=temp_name)
	return

	;	Print the report
print_report,
	xcall status (DTEM_PRT)
	xcall open (work_chan,'I',work_name)
	xcall status (DTEM_PRT)
	clear totals,cur_vendor
	repeat
	  begin
	    reads (work_chan,ordidx,print_report_eof)
	    if (oxvend.ne.cur_vendor)
	      begin
		call vendor_totals
		nam_comp = na_cmuseco
		nam_id = oxvend
		xcall na_get_name (namast)
		call new_page
		cur_vendor = oxvend
	      end

	    pol_comp = ut_cmcomp
	    pol_order = oxorno
	    pol_lineno = oxline
	    xcall db_read (poline_chan,poline,pol_key,0,'M',,,opcde)
	    if (.not.opcde)
	      begin
		prorno = pol_order, 'XXXXXX'
		pritem = pol_item
		prdesc = pol_descr
		proorqty = pol_ordqty, mask3
		received_qty = pol_recuqty + pol_recpqty
		prrcvqty = received_qty, mask3
		xcall dtdsp (pol_recdate,prrcvdate)
		xcall dtdsp (pol_reqdate,prreqdate)
		if (pol_ordqty.gt.0)
	 	 then pctrec = (received_qty / pol_ordqty)
		 else clear pctrec
		if (pctrec .ge. 0.95) .and.
		&  (pol_recdate.ne.0) .and.
		&  (pol_recdate.le.pol_reqdate) then
		  begin
		    incr total_ontime
		    prontime = 'Y'
		  end
		 else clear prontime
		call print
		incr total_items
	      end
	  end
print_report_eof,
	return

	;	Print the report totals
print_report_totals,
	call vendor_totals
	call print
	return

	;	pull records to work file
pull_work_data,
	clear wrtcnt
	xcall db_find (poline_chan,ut_cmcomp,0,'M',,,opcde)
	repeat
	  begin
	    xcall db_next (poline_chan,poline,'F','M',,,opcde)
	    if (opcde) .or.
	    &  (pol_comp.ne.ut_cmcomp) return
	    incr recs_read
	    if (.not.recs_read(5:2)) xcall statusbar (recs_read)
	    if (pol_status.ne.'D') .and.
	    &  (pol_linetype.eq.'I') .and.
	    &  (pol_reqdate.ge.scr_strdate .and. pol_reqdate.le.scr_enddate)
	      begin
		if (pol_comp.ne.pom_comp) .or.
		&  (pol_order.ne.pom_order)
		  begin
		    pom_comp = pol_comp
		    pom_order = pol_order
		    xcall db_read (pohedr_chan,pohedr,pom_key,0,'M',,,opcde)
		    if (opcde) clear pohedr
		  end
	 	if (pom_vend.ge.scr_strvend) .and.
		&  (pom_vend.le.scr_endvend) .and.
		&  (pol_ordqty.ne.0)
		  begin
		    oxvend = pom_vend
		    oxlocn = pol_locncode
		    oxitem = pol_item
		    oxorno = pol_order
		    oxline = pol_lineno
		    writes (work_chan,ordidx)
		    incr wrtcnt
		  end
	      end
	  end

vendor_totals,
	if (cur_vendor)
	  begin
	    ptot_lines = total_items, mask0
	    ptot_ontime = total_ontime, mask0
	    otpct = ((total_ontime * 100.0) / total_items)
	    ptot_pctontime = otpct, 'ZZZ.XX'
	    pline = tot_line
	    call print
	  end
	clear totals
	return

new_page,
	lp_cnt = 98
	clear pline
	prvend = oxvend, 'XXXXXXXX'
	prname = nam_name
	call print
	return

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

