;==File=================================================================;
; PO6250.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=============================================================;
;	po6250		Aged open orders report by item.
;==Changes==============================================================;
;=======================================================================;
.subroutine po6250

.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"

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

record	scr_rec1		; input set 1
	scr_stritem	,a24		; starting item no
	scr_enditem	,a24		; ending item no
	scr_agedate	,d8		; aging date

record	head1
		,a*	@1,	'ITEM-NO'
		,a*	@26,	'DESCRIPTION'
	h_dfr2	,a8	@101
	h_dfr3	,a8	@113
record	head2
		,a*	@46,	'ORDER'
		,a*	@55,	'DATE'
		,a*	@63,	'DATE'
		,a*	@91,	'THRU'
		,a*	@103,	'THRU'
		,a*	@115,	'THRU'
		,a*	@124,	'BEYOND'
record	head3
		,a*	@6,	'LOC'
		,a*	@12,	'VENDOR NAME'
		,a*	@48,	'NO'
		,a*	@53,	'ORDERED'
		,a*	@61,	'REQUIRED'
		,a*	@70,	'UOM'
		,a*	@78,	'QTY-OUT'
	h_dto1	,a8	@89
	h_dto2	,a8	@101
	h_dto3	,a8	@113
	h_dto4	,a8	@123

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

record	pline
		,a132
record	,X
	pritem		,a24	@1
	prdesc		,a30	@26
record	,X
	prlocn		,a3	@6
	prvend		,a8	@10
	prname		,a25	@19
	prorno		,a6	@45
	prdate		,a8	@52
	prrqdt		,a8	@61
	prbuom		,a3	@70
	proqty		,a12	@73
	pramt1		,a12	@85
	pramt2		,a12	@97
	pramt3		,a12	@109
	pramt4		,a12	@121
record	,X
	prtamt		,a12	@52
	prtamt1		,a12	@85
	prtamt2		,a12	@97
	prtamt3		,a12	@109
	prtamt4		,a12	@121

record	totals
	iamt		,[4]d9.2	; item total dollars
	ramt		,[4]d9.2	; report total dollars

record
	abort		,d1
	cost		,d9.3		; cost amount
	days		,d3		; work area for age date computations
	eof		,d1		; end of file switch
	lines2		,d3		; line item counter 2
	lstitm		,a24		; current item id
	mask		,a12,	'Z,ZZZ,ZZZ.XX'
	mask0		,a12,	' ZZZ,ZZZ,ZZX'
	mask3		,a12,	' ZZZ,ZZZ.XXX'
	ndx		,d3		; loop control
	nocust		,d6		; number of customers printed
	qty_out		,d9.3		; work area for computing quantity
	recs_read	,d6
	temp_name	,a14		; temp file for sort
	  temp_ext	,a3	@temp_name+11
	trxs		,d6		; transaction count
	title		,a*,	'AGED OPEN PURCHASE ORDER ITEMS'
	wdone		,d1
	wind_name	,a*,	'po6250'
	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
	wrk_date	,d8		; work area for date compute
	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 ('Aged Open Purchase Orders')
		  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 (initem_chan,'I:I',initem_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 (initem_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_enditem.ne.UT_ALL .and. scr_stritem.gt.scr_enditem)
	  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=(oxitem,oxlocn,oxorno,oxline,oxvend),tempfile=temp_name)
	return

	;	Print the report
print_report,
	xcall status (DTEM_PRT)
	xcall open (work_chan,'I',work_name)
	days = 29
	xcall dyadd (scr_agedate,days,wrk_date)
	xcall dtdsp (wrk_date,h_dto1)
	days = 30
	xcall dyadd (scr_agedate,days,wrk_date)
	xcall dtdsp (wrk_date,h_dfr2)
	days = 59
	xcall dyadd (scr_agedate,days,wrk_date)
	xcall dtdsp (wrk_date,h_dto2)
	days = 60
	xcall dyadd (scr_agedate,days,wrk_date)
	xcall dtdsp (wrk_date,h_dfr3)
	days = 90
	xcall dyadd (scr_agedate,days,wrk_date)
	xcall dtdsp (wrk_date,h_dto3)
	xcall dtdsp (wrk_date,h_dto4)

	eof = FALSE
	clear totals
	lstitm = ']]]]]]'
	repeat
	  begin
	    reads (work_chan,ordidx,print_report_eof)
	    if (oxorno.ne.pom_order)
	      begin
		pom_comp = ut_cmcomp
		pom_order = oxorno
		xcall db_read (pohedr_chan,pohedr,pom_key,0,'M',,,opcde)
		if (opcde) clear pohedr
	      end
	    pol_comp = pom_comp
	    pol_order = pom_order
	    pol_lineno = oxline
	    xcall db_read (poline_chan,poline,pol_key,0,'M',,,opcde)
	    if (opcde.eq.0)
	      begin
		if (oxitem.ne.lstitm)
		  begin
		    call new_item
		    pritem = pol_item
		    prdesc = pol_descr
		    call print
		  end
		prlocn = pol_locncode
		prvend = pom_vend, 'XXXXXXXX'
		prname = pom_name
		prorno = pom_order, 'XXXXXX'
		xcall dtdsp (pom_orddate,prdate)
		xcall dtdsp (pol_reqdate,prrqdt)
		prbuom = pol_buomcode
		qty_out = pol_ordqty - (pol_recpqty + pol_recuqty)
		case in_cmqdec of
		  begincase
		  0: proqty = qty_out, mask0
		  3: proqty = qty_out, mask3
		  endcase
		cost = (qty_out * pol_ucost)
		cost = cost - ((cost * pol_discpct) / 100.0)

		clear days
		xcall dyadd (scr_agedate,days,pol_reqdate)
		if (pol_reqdate.lt.scr_agedate) clear days
		if (days.le.30) then
		  begin
		    pramt1 = cost, mask
		    iamt[1] = iamt[1] + cost
		  end
		 else
		  if (days.le.60) then
		    begin
		      pramt2 = cost, mask
		      iamt[2] = iamt[2] + cost
		    end
		   else
		    if (days.le.90) then
		      begin
			pramt3 = cost, mask
			iamt[3] = iamt[3] + cost
		      end
		     else
		      begin
			pramt4 = cost, mask
			iamt[4] = iamt[4] + cost
		      end
		call print
		incr lines2
	      end
	  end
print_report_eof,
	return

	;	Print the report totals
print_report_totals,
	call new_item
	prname = 'FINAL TOTALS:'
	prtamt  = (ramt[1] + ramt[2] + ramt[3] + ramt[4]), mask
	prtamt1 = ramt[1], mask
	prtamt2 = ramt[2], mask
	prtamt3 = ramt[3], mask
	prtamt4 = ramt[4], mask
	call print
	return

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.'C') .and.
	    &  (pol_status.ne.'D') .and.
	    &  (pol_linetype.ne.'R') .and.
	    &  (scr_stritem.eq.UT_ALL .or. pol_item.ge.scr_stritem) .and.
	    &  (scr_enditem.eq.UT_ALL .or. pol_item.le.scr_enditem) .and.
	    &  (pol_ordqty - pol_recpqty - pol_recuqty.gt.0)
	      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
		oxvend = pom_vend
		oxlocn = pol_locncode
		oxitem = pol_item
		oxorno = pol_order
		oxline = pol_lineno
		incr wrtcnt
		writes (work_chan,ordidx)
	      end
	  end

	;	new item number
new_item,
	if (lstitm.ne.oxitem) .and.
	&  (lines2.gt.1)
	  begin
	    prname = 'ITEM TOTAL:'
	    prtamt  = (iamt[1] + iamt[2] + iamt[3] + iamt[4]), mask
	    prtamt1 = iamt[1], mask
	    prtamt2 = iamt[2], mask
	    prtamt3 = iamt[3], mask
	    prtamt4 = iamt[4], mask
	    call print
	  end
	for ndx from 1 thru 4
	  begin
	    ramt[ndx] = ramt[ndx] + iamt[ndx]
	    clear iamt[ndx]
	  end
	clear lines2
	lstitm = oxitem
	call print
	return

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

