;==File=================================================================;
; AP7040.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=============================================================;
;	ap7040		Print 1099-misc Laser forms.
;==Changes==============================================================;
; 1/19/23 - esc - add year to form print
; 12/30/2015 lso - adj amt down 1 line, box 7
; 02/05/2015 lso - Adj position of amounts to the left by 2, both col
; 01/15/2003 tah - Changed for new 1099 record layout.
; 01/04/2002 tah - Modified for year 2001 forms (2 per page).
; 01/12/1996 tah - Add position prior to page break.
;=======================================================================;
.subroutine ap7040

.start nopage,nolist
.include "UTL:tools.def"
.include "UTS:dteut.def"
.include "APS:dteap.def"

.include "UTS:utcomm.gbl"
.include "NAS:nacomm.gbl"
.include "NAS:namast.rec"
.include "APS:apcomm.gbl"
.include "APS:apvend.rec"
.include "APS:ap1099.rec"

record	pline
	prt_name	,a30	@6
	  prt_payid	,a11	@prt_name
	  prt_recid	,a11	@prt_name+17
	prt_amt1	,a12	@38
	prt_amt2	,a12	@52
record	,X
	prt_city	,a20	@6
	prt_state	,a2	@28
	prt_zip		,a5	@31
record ,X
	prt_phone	,a14	@6

record	scr_rec1		; input set 1
	scr_year	,d4		; year to print
	scr_phone	,a14
	scr_flag	,a1		; update printed flag

record
	abort		,d1
	form_no		,d1		; form number printed
	mask		,a13,	'ZZZZZZZZZZ.XX'
	ndx		,d5		; loop control
	phone_fmt	,a18
	recs_read	,d6
	title		,a*,	'A/P 1099 MISC FORMS'
	wdone		,d1
	wind_name	,a*,	'ap7040'
	wind_no		,d2		; input window id
.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 ('Vendor 1099-misc forms')
	      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 (namast_chan,'I:I',namast_name)
	xcall open (apvend_chan,'I:I',apvend_name)
	xcall open (ap1099_chan,'U:I',ap1099_name)
	return

	;	Close the data files opened for the report
close_files,
	xcall close (namast_chan,DTE_CLOSE)
	xcall close (apvend_chan,DTE_CLOSE)
	xcall close (ap1099_chan,DTE_CLOSE)
	return

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

verify_input_parameters,
	xcall phone (scr_phone,phone_fmt)
	wdone = TRUE
	return

	;	Get the output destination
get_destination,
	abort = FALSE
	clear lp_sel
	xcall askpr (ut_cmname,80,61,-2,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,apvend_chan)
	clear form_no
	xcall db_find (apvend_chan,na_cmuseco,0,'M',,,opcde)
	repeat
	  begin
	    xcall db_next (apvend_chan,apvend,'F','M',,,opcde)
	    if (opcde) .or.
	    &  (apv_comp.ne.na_cmuseco) return
	    incr recs_read
	    if (.not.recs_read(5:2)) xcall statusbar (recs_read)
	    if (apv_1099.eq.'Y') call print_vendor
	  end

	;	Print the report totals
print_report_totals,
	lp_cnt = 98
	xcall print
	return

print_vendor,
	nam_comp = na_cmuseco			; get name
	nam_id = apv_id
	xcall na_get_name (namast)
	if (opcde) clear namast

	ap1_year = scr_year			; get 1099 record
	ap1_comp = ut_cmcomp
	ap1_type = 'M'
	ap1_vend = apv_id
	xcall db_read (ap1099_chan,ap1099,ap1_key,0,'M',,,opcde)
	if (.not.opcde) .and.
	&  (ap1_print.eq.'N')
	  begin
	    case form_no of
	      begincase
	      0: begin			; Top
		  if ((ap1_box1) .or. (ap1_box2) .or. (ap1_box3) .or. (ap1_box4) .or.
		  &  (ap1_box5) .or. (ap1_box6) .or. (ap1_box8) .or.
		  &  (ap1_box9.eq.'Y') .or. (ap1_box10) .or. (ap1_box13) .or. (ap1_box14)) call print_form
		   else return

		  	;call print_form
		  incr form_no
		  for ndx from 1 thru 10 call print
		 end
	      1: begin			; Bottom
		  if ((ap1_box1) .or. (ap1_box2) .or. (ap1_box3) .or. (ap1_box4) .or.
		  &  (ap1_box5) .or. (ap1_box6) .or. (ap1_box8) .or.
		  &  (ap1_box9.eq.'Y') .or. (ap1_box10) .or. (ap1_box13) .or. (ap1_box14)) call print_form
		   else return

		  	;call print_form
		  lp_cnt = 98
		  xcall print
		  clear form_no
		 end
	      endcase
	  end
	return

print_form,

	if ((.not.ap1_box1) .and. (.not.ap1_box2) .and. (.not.ap1_box3) .and. (.not.ap1_box4) .and.
	&  (.not.ap1_box5) .and. (.not.ap1_box6) .and. (.not.ap1_box8) .and.
	&  (.not.ap1_box9) .and. (.not.ap1_box10) .and. (.not.ap1_box13) .and. (.not.ap1_box14)) return


	if ((.not.ap1_box1) .and. (.not.ap1_box2) .and. (.not.ap1_box3) .and. (.not.ap1_box4) .and.
	&  (.not.ap1_box5) .and. (.not.ap1_box6) .and. (.not.ap1_box8) .and.
	&  (ap1_box9.eq.'N') .and. (.not.ap1_box10) .and. (.not.ap1_box13) .and. (.not.ap1_box14)) return	

	call print
	call print

	prt_name = ut_cmname
	if(ap1_box1) prt_amt1 = ap1_box1, mask
	call print

	prt_name = ut_cmadd1
	call print

	prt_name = ut_cmadd2
	call print

	prt_name = ut_cmadd3
	if (ap1_box2) prt_amt1 = ap1_box2, mask
	pline(56:2) = scr_year(3:2)				; 1/19/23
	call print
;	call print
	prt_phone = phone_fmt
	call print

	if (ap1_box3) prt_amt1 = ap1_box3, mask
	if (ap1_box4) prt_amt2 = ap1_box4, mask
	call print
	call print
	call print

	prt_payid = ut_cmfid
	prt_recid = apv_ssn
	if (ap1_box5) prt_amt1 = ap1_box5, mask
	if (ap1_box6) prt_amt2 = ap1_box6, mask
	call print
	call print
	call print

	prt_name = nam_name
	call print
	call print

		;if (ap1_box7) prt_amt1 = ap1_box7, mask
	if (ap1_box9.eq.'Y') pline(51:1) = 'X'
	if (ap1_box8) prt_amt2 = ap1_box8, mask
	call print

	prt_name = nam_addr1
	if (ap1_box10) prt_amt1 = ap1_box10, mask
	if (ap1_box14) prt_amt2 = ap1_box14, mask

	call print

	prt_name = nam_addr2
		;if (ap1_box9.eq.'Y') pline(51:1) = 'X'
		;if (ap1_box10) prt_amt2 = ap1_box10, mask
		;if (ap1_box10) prt_amt12 = ap1_box10, mask
		;if (ap1_box14) prt_amt22 = ap1_box14, mask
	call print
	call print

	prt_city = nam_city
	prt_state = nam_state
	prt_zip = nam_zip
	if (ap1_box11) prt_amt1 = ap1_box11, mask
	if (ap1_box12) prt_amt2 = ap1_box12, mask		; 409A deferrals
	call print
	call print

	if (ap1_box13) prt_amt1 = ap1_box13, mask
		;if (ap1_box14) prt_amt2 = ap1_box14, mask	; 14 now nonqual deferred comp
	call print
	call print

	if (scr_flag.eq.'Y')
	  begin
	    ap1_print = 'Y'
	    xcall db_update (ap1099_chan,ap1099,ap1_key,ap1099_log,opcde)
	  end
	return

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


