;==File=================================================================;
; AR6900.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=============================================================;
;	ar6900		Sales tax report.
;==Changes==============================================================;
; 07/14/2003 tah - Added tax pct and name to report.
; 02/25/1999 tah - Change for new tax code parameters.
;=======================================================================;
.subroutine ar6900

.start nopage,nolist
.include "UTL:tools.def"
.include "UTS:dteut.def"
.include "ARS:dtear.def"

.include "UTS:utcomm.gbl"
.include "NAS:nacomm.gbl"
.include "NAS:namast.rec"
.include "ARS:arcomm.gbl"
.include "ARS:arhist.rec"
.include "SMS:smcode.rec"

record	work_record
	wrk_dist	,a10		; tax district
	wrk_txcd	,a3		; tax code
	wrk_name	,a25		; tax code name
	wrk_cust	,d6		; customer id
	wrk_aply	,a8		; invoice number
	wrk_amnt	,d9.2		; invoice amount
	wrk_amtx	,d9.2		; taxable amount
	wrk_taxa	,d8.2		; tax amount
	wrk_frta	,d8.2		; freight amount
	wrk_idat	,d8		; invoice date
	wrk_paid	,d9.2		; paid amount
	wrk_pdat	,d8		; paid date
	wrk_ptax	,d8.2		; pro-rated tax amount
	wrk_taxpct	,d6.4		; tax percent

record	head1
		,a*	@5,	'------------CUSTOMER------------'
		,a*	@101,	'NON-TAX'
		,a*	@114,	'TAXABLE'
		,a*	@125,	'PRORATED'
record	head2
		,a*	@1,	'CDE'
		,a*	@7,	'NO'
		,a*	@13,	'NAME'
		,a*	@44,	'INVOICE'
		,a*	@59,	'AMOUNT'
		,a*	@74,	'TAX'
		,a*	@81,	'INV DATE'
		,a*	@102,	'AMOUNT'
		,a*	@115,	'AMOUNT'
		,a*	@128,	'TAX'
record	head3
		,a*	@1,	'CDE'
		,a*	@7,	'NO'
		,a*	@13,	'NAME'
		,a*	@44,	'INVOICE'
		,a*	@57,	'PAID AMT'
		,a*	@69,	'PAID TAX'
		,a*	@80,	'PAID DATE'
		,a*	@92,	'%-PD'
		,a*	@102,	'AMOUNT'
		,a*	@115,	'AMOUNT'
		,a*	@128,	'TAX'

record	legnd1
		,a*	@1,	'FOR PERIOD:'
	ldate1	,a10	@13
		,a*	@24,	'TO'
	ldate2	,a10	@27
record	legnd2
		,a*	@1,	'COMPANY:'
	lcompy	,a2	@10

record	taxdist
		,a*	@1,	'DISTRICT:'
	ltxdist	,a10	@11
	ltxdesc	,a25	@25
		,a*	@52,	'RATE:'
	ltxrate	,a7	@57

record	pline
		,a132
record	,X				; Both reports
	prtxcod		,a3	@1
	prcust		,a8	@5
	prname		,a29	@14
	praply		,a8	@44
	pranon		,a12	@97
	praamt		,a12	@110
	pratax		,a10	@123
record	,X				; Billed report
	pramnt		,a12	@54
	prtaxa		,a10	@68
	pridat		,a10	@80
record	,X				; Paid report
	prpaid		,a12	@54
	prtxpd		,a10	@68
	prpdat		,a10	@79
	prppct		,a6	@90
record	,X
	pr_tax		,a8	@40
	pr_amttax	,a12	@50
	pr_nontax	,a10	@75
	pr_amtnontax	,a12	@87

record	scr_rec1		; input set 1
	scr_strdat	,d8		; starting date
	scr_enddat	,d8		; ending date
	scr_taxcod	,a3		; tax code
	scr_rpttyp	,a1		; Paid or Billed

record	totals
	tdbamt		,d10.2		; total dist invoice amount
	tdbtam		,d10.2		; total dist taxable amount
	tdbnam		,d10.2		; total dist non-taxable amount
	tdbtax		,d10.2		; total dist tax
	tdpamt		,d10.2		; total dist paid amount
	tdptax		,d10.2		; total dist tax paid
	trptax		,d10.2		; total report tax paid

record
	abort		,d1
	amt_tax 	,d9.2		; calculated tax amount
	amt_taxable	,d16.2		; taxable amount of invoice
	amt_nontaxable	,d19.2		; non taxable amount of invoice
	cur_district	,a10		; current printing tax district
	decml		,d9.2		; work area for amounts
	eof		,d1		; end of file switch
	file_type	,a1		; file type returned from find
	find_status	,d1		; status of find operation
	hcustid		,d6		; saved customer id
	hinvno		,a8		; saved invoice number
	hinvdt		,d8		; saved invoice date
	htxcod		,a3		; saved tax code
	htxname		,a25		; saved tax description
	hintax		,d9.2		; invoice tax amount
	hinfrt		,d9.2		; invoice freight amount
	hinamt		,d10.2		; invoice billed amount
	hpyamt		,d10.2		; invoice payment amount
	hpymdt		,d8		; saved payment date
	mask		,a14,	'ZZZZZZZZZZ.XX-'
	pcttot		,d6.4		; total of 4 tax rates
	pct1		,d6.4		; percent for tax rate 1
	pct2		,d6.4		; percent for tax rate 2
	pct3		,d6.4		; percent for tax rate 3
	pct4		,d6.4		; percent for tax rate 4
	reccnt		,d6		; work file records written
	temp_name	,a14		; temp file for sort
	  temp_ext	,a3	@temp_name+11
	title		,a*,	'SALES TAX REPORT'
	wdone		,d1
	wind_name	,a*,	'ar6900'
	wind_no		,d2		; input window id
	wind_signal	,a31
	work_chan	,d2		; work file channel
	work_name	,a*,	'WRK:artaxs.ddf'
	wpct		,d16.2		; work area for percentage calculations
	wtax		,d8.2		; work area for tax paid calculation
.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
		call sort_data
		call print_report
		call print_report_totals
		xcall clslp ('Sales Tax Report')
	      end
	  end
	call close_files
	call do_shutdown
	xreturn		; to calling program

	;	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 (arhist_chan,'I:I',arhist_name)
	xcall open (namast_chan,'I:I',namast_name)
	xcall open (smcode_chan,'I:I',smcode_name)
	xcall open (work_chan,'O',work_name)
	return

	;	Close the data files opened for the report
close_files,
	xcall close (work_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
	xcall numrt (scr_taxcod,'0',wind_no,'TAXCOD')
	if (scr_taxcod.ne.UT_ALL)
	  begin
	    wrk_txcd = scr_taxcod
	    call get_tax_code
	  end
	if (scr_strdat.gt.scr_enddat)
	  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
	xcall dtdsp (scr_strdat,ldate1)
	xcall dtdsp (scr_enddat,ldate2)
	return

	;	Sort the extracted data
sort_data,
	xcall status (DTEM_SRT)
	xcall close (arhist_chan,DTE_CLOSE)
	xcall close (work_chan,DTE_CLOSE)
	temp_name = work_name
	temp_ext = ut_cmterm, 'XXX'
	sort (in=work_name,record=work_record,
	&  key=(wrk_dist,wrk_txcd,wrk_aply),tempfile=temp_name)
	return

	;	Print the report
print_report,
	xcall status (DTEM_PRT)
	xcall open (work_chan,'I',work_name)
	eof = FALSE
	clear nam_id, smc_code, totals, pcttot
	cur_district = '~@#FIRST'
	repeat
	  begin
	    reads (work_chan,work_record,print_eof)
	    if (wrk_dist.ne.cur_district) call new_tax_district
	    call print_invoice
	  end
print_eof,
	eof = TRUE
	call new_tax_district
	return

	;	Print the report totals
print_report_totals,
	prname = '*** TOTAL TAX:'
	pratax = trptax, mask
	call print
	return

	;	Pull data for report
pull_data,
	clear hcustid,hinvno,hinamt,hintax,hinfrt,hpyamt,hpymdt,htxcod,htxname
	eof = FALSE
	xcall db_find (arhist_chan,ut_cmcomp,0,'M',,,opcde)
	repeat
	  begin
	    xcall db_next (arhist_chan,arhist,'F','M',,,opcde)
	    if (opcde) .or.
	    &  (arh_comp.ne.ut_cmcomp)
	      begin
		eof = TRUE
		clear arhist
	      end
	    if (hcustid.ne.arh_cust) .or.
	    &  (hinvno.ne.arh_aply)
	      begin
		case scr_rpttyp of
		  begincase
		  'B': if (hinvdt.lt.scr_strdat) .or.
		       &  (hinvdt.gt.scr_enddat) goto end_of_invoice
		  'P': if (hpymdt.lt.scr_strdat) .or.
		       &  (hpymdt.gt.scr_enddat) goto end_of_invoice
		  endcase
		if (scr_taxcod.eq.UT_ALL .and. htxcod.ne.UT_BLANKS) .or.
		&  (htxcod.eq.scr_taxcod)
		  begin
		    if (htxcod.ne.smc_code)
		      begin
			smc_type = 'X'
			smc_code = htxcod
			xcall db_read (smcode_chan,smcode,smc_key,0,'M',,,opcde)
			if (opcde) clear smcode
		      end
		    htxname = smc_descr
		    pcttot = smcx_pct1 + smcx_pct2 + smcx_pct3 + smcx_pct4
		    clear pct1,pct2,pct3,pct4
		    if (pcttot.gt.0)
		      begin
			pct1 = smcx_pct1 / pcttot
			pct2 = smcx_pct2 / pcttot
			pct3 = smcx_pct3 / pcttot
			pct4 = smcx_pct4 / pcttot
		      end
		    wrk_txcd = htxcod
		    wrk_name = htxname
		    wrk_cust = hcustid
		    wrk_aply = hinvno
		    wrk_amnt = hinamt
		    wrk_amtx = hinamt
		    if (smcx_freight.eq.'Y') wrk_amtx = wrk_amtx + hinfrt
		    wrk_taxa = hintax
		    wrk_frta = hinfrt
		    wrk_idat = hinvdt
		    wrk_paid = hpyamt
		    wrk_pdat = hpymdt
		    call write_district1
		    if (smcx_taxdist2.ne.UT_BLANKS) .or.
		    &  (pct2.ne.0) call write_district2
		    if (smcx_taxdist3.ne.UT_BLANKS) .or.
		    &  (pct3.ne.0) call write_district3
		    if (smcx_taxdist4.ne.UT_BLANKS) .or.
		    &  (pct4.ne.0) call write_district4
		  end
end_of_invoice,
		hcustid = arh_cust
		hinvno = arh_aply
		clear hinamt,hintax,hinfrt,hpyamt,hpymdt,hinvdt,htxcod,htxname
	      end
	    if (eof.eq.TRUE) return

	    if (scr_rpttyp.eq.'P') .or.
	    &  (arh_date.ge.scr_strdat .and. arh_date.le.scr_enddat)
		call add_amounts
	  end

add_amounts,
	case arh_type of
	  begincase
	  1: begin				; Invoice
	      hinamt = hinamt + (arh_amnt - arh_frta - arh_othr)
	      hintax = hintax + arh_othr
	      hinfrt = hinfrt + arh_frta
	      htxcod = arh_txcd
	      hinvdt = arh_date
	     end
	  2: begin				; Payment
	      hpyamt = hpyamt -(arh_amnt + arh_othr)
	      hpymdt = arh_date
	     end
	  3: begin				; Credit memo
	      hinamt = hinamt + (arh_amnt - arh_frta - arh_othr)
	      hintax = hintax + arh_othr
	      hinfrt = hinfrt + arh_frta
	      if (htxcod.eq.UT_BLANKS) htxcod = arh_txcd
	      hinvdt = arh_date
	     end
	  4: begin				; Debit memo
	      hinamt = hinamt + (arh_amnt - arh_frta - arh_othr)
	      hintax = hintax + arh_othr
	      hinfrt = hinfrt + arh_frta
	      if (htxcod.eq.UT_BLANKS) htxcod = arh_txcd
	      hinvdt = arh_date
	     end
	  5: hinamt = hinamt + arh_amnt		; Finance charge
	  6: begin				; Write-off
	      hinamt = hinamt + (arh_amnt - arh_frta - arh_othr)
	      hintax = hintax + arh_othr
	      hinfrt = hinfrt + arh_frta
	     end
	  endcase
	return

	;	Write records for tax districts
write_district1,
	wrk_dist = smcx_taxdist1
	wrk_ptax = (hintax * pct1)
	wrk_taxpct = smcx_pct1
	writes (work_chan,work_record)
	return
write_district2,
	wrk_dist = smcx_taxdist2
	wrk_ptax = (hintax * pct2)
	wrk_taxpct = smcx_pct2
	writes (work_chan,work_record)
	return
write_district3,
	wrk_dist = smcx_taxdist3
	wrk_ptax = (hintax * pct3)
	wrk_taxpct = smcx_pct3
	writes (work_chan,work_record)
	return
write_district4,
	wrk_dist = smcx_taxdist4
	wrk_ptax = (hintax * pct4)
	wrk_taxpct = smcx_pct4
	writes (work_chan,work_record)
	return

	;	Break on tax district
new_tax_district,
	if (cur_district.ne.'~@#FIRST') .or.
	&  (eof.eq.TRUE)
	  begin
	    clear pline
	    prname = 'TOTALS: DISTRICT ' + cur_district
	    case scr_rpttyp of
	      begincase
	      'B': begin
		    pramnt = tdbamt, mask
		    prtaxa = tdbtax, mask
		    pranon = tdbnam, mask
		    praamt = tdbtam, mask
		    pratax = tdptax, mask
		   end
	      'P': begin
		    prpaid = tdpamt, mask
		    prtaxa = tdbtax, mask
		    pranon = tdbnam, mask
		    praamt = tdbtam, mask
		    pratax = tdptax, mask
		   end
	      endcase
	    call print
	    trptax = trptax + tdptax
	    clear tdbamt,tdbtam,tdbnam,tdbtax,tdpamt,tdptax
	  end
	cur_district = wrk_dist
	if (eof.eq.FALSE)
	  begin
	    clear pline
	    call print
	    ltxdist = cur_district
	    if (%instr(1,cur_district,'/').gt.1)
	     then clear ltxdesc
	     else ltxdesc = wrk_name
	    ltxrate = wrk_taxpct, 'ZZ.XXXX'
	    pline = taxdist
	    call print
	  end
	return

	;	get tax code master information
get_tax_code,
	smc_type = 'X'
	smc_code = wrk_txcd
	xcall db_read (smcode_chan,smcode,smc_key,0,'M',,,opcde)
	if (opcde) clear smcode
	return

print_invoice,
	prtxcod = wrk_txcd
	prcust = wrk_cust, 'XXXXXXXX'
	if (nam_id.ne.wrk_cust)
	  begin
	    nam_comp = na_cmuseco
	    nam_id = wrk_cust
	    xcall na_get_name (namast)
	  end
	prname = nam_name
	praply = wrk_aply
	call calc_taxable
	case scr_rpttyp of
	  begincase
	  'B': begin
		pramnt = wrk_amtx, mask
		prtaxa = wrk_taxa, mask
		xcall dtdsp (wrk_idat,pridat)
		pranon = amt_nontaxable, mask
		praamt = amt_taxable, mask
		pratax = wrk_ptax, mask
	       end
	  'P': begin
		prpaid = wrk_paid, mask
		if (wrk_pdat.gt.0) xcall dtdsp (wrk_pdat,prpdat)
		clear wpct
		if ((wrk_amnt + wrk_taxa + wrk_frta).gt.0)
			wpct = (wrk_paid * 100.0) / (wrk_amnt + wrk_taxa + wrk_frta)
		prppct = wpct, 'ZZZ.XX'
		wtax = (wpct * wrk_taxa) / 100.0
		prtxpd = wtax, mask
		pranon = amt_nontaxable, mask
		praamt = amt_taxable, mask
		pratax = wrk_ptax, mask
	       end
	  endcase
	call print
	tdbamt = tdbamt + wrk_amtx		; add to district totals
	tdbtax = tdbtax + wrk_taxa
	tdpamt = tdpamt + wrk_paid
	tdbtam = tdbtam + amt_taxable
	tdptax = tdptax + wrk_ptax
	tdbnam = tdbnam + amt_nontaxable
	return

	;	figure taxable and non-taxable amounts
calc_taxable,
	clear amt_taxable
	amt_nontaxable = wrk_amtx
	if (wrk_taxa.ne.0)
	  begin
	    if (wrk_txcd.ne.smc_code)
	      begin
		smc_type = 'X'
		smc_code = wrk_txcd
		xcall db_read (smcode_chan,smcode,smc_key,0,'M',,,opcde)
		if (opcde) clear smcode
	      end
	    pcttot = smcx_pct1 + smcx_pct2 + smcx_pct3 + smcx_pct4
	    amt_tax = (wrk_amtx * pcttot) / 100.0
	    if (amt_tax.le.wrk_taxa) then
	      begin
		amt_taxable = wrk_amtx
		clear amt_nontaxable
	      end
	     else
	      begin
		if (pcttot.gt.0) amt_taxable = (wrk_taxa * 100.0) / pcttot
		amt_nontaxable = wrk_amtx - amt_taxable
	      end
	  end
	return

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

