;==File=================================================================;
; OE4309.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=============================================================;
;	oe4309   Customer invoices / form 2 (Laser) TechForce Custom.
;==Changes==============================================================;
; 03/29/2010 lso - Custom changes per Cindy/Chris
; 08/08/2002 tah - Add checking for prepaid terms code.
; 07/01/2002 tah - Check history for duplicate invoice/date.
; 04/05/2001 tah - Changed for printing kit components/serial numbers.
; 11/22/2000 tah - Changed for new invoice number option.
; 06/20/2000 tah - Changed for new oeline and oesnlt file formats.
;=======================================================================;
.subroutine oe4309

	a_type		,a	; IN  - C: confirmation
				;	I: invoice

.start nopage,nolist
.include "UTL:tools.def"
.include "UTS:dteut.def"
.include "OES:dteoe.def"

.include "UTS:utcomm.gbl"
.include "OES:oecomm.gbl"
.include "OES:oebsel.rec"
.include "OES:oehedr.rec"
.include "OES:oeline.rec"
.include "OES:oesnlt.rec"
.include "OES:oeihdr.rec"
.include "NAS:nacomm.gbl"
.include "NAS:namast.rec"
.include "INS:incomm.gbl"
.include "INS:initem.rec"
.include "INS:inkits.rec"
.include "SMS:smcode.rec"

external function
	smctrl		,a
	smctrl_put	,a

record	pline
		,a132
record	,X
	prcnam		,a30	@12
	prref		,a17	@110
record	,X
	prname		,a35	@12
	prshto		,a35	@66
record	,X
	prslmn		,a25	@10
        prcref          ,a20    @37
        prsvia          ,a25    @59
        prfob           ,a11    @86
        prterm          ,a25    @100
record	,X
	pritem		,a24	@10
	prorqt		,a10	@38
	prshqt		,a10	@50
	prpric		,a11	@61
	  prpric_q	,a7	@61
	  prpric_s	,a1	@68
	  prpric_u	,a3	@69
	pramnt		,a11	@114
record	,X
	prdesc		,a30	@10
	prbkqt		,a10	@82
	prbkds		,a11	@93
record	,X
	prkitd		,a4	@10
	prkiti		,a24	@14
	prkitsnld	,a4	@40
	prkitsnlt	,a20	@44

record	serial
		,a*	@10,	'S/N:'
	prsn1	,a20	@14
		,a*	@36,	'S/N:'
	prsn2	,a20	@40
record	lot
		,a*	@10,	'Lot:'
	prlot1	,a20	@14
		,a*	@36,	'Lot:'
	prlot2	,a20	@40

record
	abort		,d1
	amount		,d9.2		; line item extended amount
	boqt		,d9.3		; back order quantity
	dup_message	,a*,	'Invoice No %a on %a already used.  '
	&			'Invoice for order number %a will not be printed.'
	invno		,d6		; current invoice number
	invtot		,d9.3		; invoice total
	line		,d2		; item line number (not used this form)
	line_prt	,d1		; serial/lot line print switch
	lines		,d2		; line counter for forms
	line_max	,d2,	32	; number of detail lines on form
	loop		,d2		; loop control
	mask0		,a6,	'ZZZZZZ'
	mask		,a11,	'ZZZZZZZ.XX-'
	mask2		,a9,	'ZZZZZZ.XX'
	mask3		,a11,	'ZZZZZZZ.XXX'
	ndx		,d2		; loop control
	page		,d2		; page counter
	prepay_terms	,a3
	print_kits	,a1		; print kits flag
	print_serial	,a1		; print serial numbers flag
	salamt		,d9.2		; invoice sale amount
	shname		,a35		; work area for formatting address
	shadd1		,a35		; work area for formatting address
	shadd2		,a35		; work area for formatting address
	shadd3		,a35		; work area for formatting address
	slname		,a35		; work area for formatting address
	sladd1		,a35		; work area for formatting address
	sladd2		,a35		; work area for formatting address
	sladd3		,a35		; work area for formatting address
	slmn		,a25		; salesman name
	slst		,a1		; component serial/lot flag
	svia		,a25		; ship via description
	terms		,a25		; terms description
	work_chan	,d2		; work file channel
	work_date	,a10		; for error message
	work_name	,a*,	'WRK:oe4300.ddf'
	  work_ext	,a3	@work_name+11
.start nopage,list

.proc
	;>>>>>	Main processing  <<<<<;
	call do_setup
	call open_files

	call get_destination
	if (abort.eq.FALSE)
	  begin
	    call print_report
	    call print_report_totals
	    clear shname
	    case a_type of
	      begincase
	      'C': begin
		    shname(1:13) = 'Confirmations'
		    shname(15:10) = ut_datdsp, 'XX/XX/XXXX'
		   end
	      'I': begin
		    shname(1:8) = 'Invoices'
		    shname(10:10) = ut_datdsp, 'XX/XX/XXXX'
		   end
	      endcase
	    xcall clslp (shname,nam_fax,'Y',nam_name,oem_confirm)
	  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
	print_kits = %smctrl(ut_cmcomp,'OE','PRINTKITS')
	print_serial = %smctrl(ut_cmcomp,'OE','PRINTSERIAL')
	oe_cmedin = %smctrl(ut_cmcomp,'OE','EXTDONINVC')
	clear prepay_terms
	prepay_terms = %smctrl(ut_cmcomp,'OE','PREPAYTERMS',1)
	return

	;	Shut down environment
do_shutdown,
	xcall e_exit
	return

	;	Open the needed data files
open_files,
	work_ext = ut_userid
	xcall open (work_chan,'I',work_name)
	return

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

	;	Get the output destination
get_destination,
	abort = FALSE
	clear lp_sel
	case a_type of
	  begincase
	  'I': if (oe_cminlp)	; if invoice, default to invoice printer
		then xcall askpr (ut_cmname,132,60,-2,oe_cminlp)
		else xcall askpr (ut_cmname,132,60,-2,ut_cmdefp)
	  'C': if (oe_cmcflp)	; if confirmation, default to confirm printer
		then xcall askpr (ut_cmname,132,60,-2,oe_cmcflp)
		else xcall askpr (ut_cmname,132,60,-2,ut_cmdefp)
	  endcase
	if (lp_sel.eq.'E') abort = TRUE
	return

	;	Print the report
print_report,
	xcall status (DTEM_PRT)
	repeat
	  begin
	    reads (work_chan,oebsel,print_report_eof)
	    oem_comp = ut_cmcomp
	    oem_order = oeb_order
	    xcall db_read (oehedr_chan,oehedr,oem_key,0,'M',,,opcde)
	    if (.not.opcde) call print_invoice
	  end
print_report_eof,
	return

	;	Print the report totals
print_report_totals,
	return

print_invoice,
	case a_type of
	  begincase
	  'I': begin
		oem_invcdate = oeb_invcdate	; set invoice date and number
		if (oem_type.ne.'C' .and. oe_cmoati.eq.'Y')
		  begin
		    if (oe_cminvc.eq.'O') oem_invcno = oem_order
		    if (oem_invcno.eq.0) .or.
		    &  (oem_invcno.ne.0 .and. oe_cminvc.eq.'N')
		      oem_invcno = %smctrl_put(ut_cmcomp,'OE','NEXTINVCNO',,,1,'+')
		  end
		oeih_comp = oem_comp
		oeih_invcno = oem_invcno
		oeih_invcdate = oem_invcdate
		xcall db_find (oeihdr_chan,oeih_key,0,'M',1,,opcde)
		if (.not.opcde)
		  begin
		    xcall dtdsp (oem_invcdate,work_date)
		    xcall s_bld (ut_msgtext,,dup_message,oem_invcno,work_date,oem_order)
		    xcall u_message (ut_msgtext,D_ERROR)
		    return
		  end
	       end
	  endcase

	smc_type = 'S'
	smc_code = oem_slmncode
	xcall db_read (smcode_chan,smcode,smc_key,0,'M',,,opcde)
	if (opcde) clear smcode
	slmn = smc_descr

	smc_type = 'T'
	smc_code = oem_termcode
	xcall db_read (smcode_chan,smcode,smc_key,0,'M',,,opcde)
	if (opcde) clear smcode
	terms = smc_descr

	smc_type = 'V'
	smc_code = oem_viacode
	xcall db_read (smcode_chan,smcode,smc_key,0,'M',,,opcde)
	if (opcde) clear smcode
	svia = smc_descr

	nam_comp = na_cmuseco
	nam_id = oem_cust
	xcall na_get_name (namast)
	if (opcde) clear namast
	slname = nam_name
	sladd1 = nam_addr1
	clear sladd2, sladd3
	if (nam_addr2) then
	  begin
	    sladd2 = nam_addr2
	    sladd3(1:20) = nam_city
	    sladd3(22:2) = nam_state
	    sladd3(25:10) = nam_zip
	  end
	 else
	  begin
	    sladd2(1:20) = nam_city
	    sladd2(22:2) = nam_state
	    sladd2(25:10) = nam_zip
	  end
	shname = oem_shipname
	shadd1 = oem_shipaddr1
	if (oem_shipaddr2) then
	  begin
	    shadd2 = oem_shipaddr2
	    shadd3 = oem_shipcity
	    shadd3(22:2) = oem_shipstate
	    shadd3(25:10) = oem_shipzip
	  end
	 else
	  begin
	    shadd2 = oem_shipcity
	    shadd2(22:2) = oem_shipstate
	    shadd2(25:10) = oem_shipzip
	    clear shadd3
	  end
	clear page, salamt
	call print_header
	call print_detail
	case a_type of
	  begincase
	  'C': oem_flag1 = 'Y'
	  'I': oem_flag4 = 'Y'
	  endcase
	xcall db_update (oehedr_chan,oehedr,oem_key,oehedr_log,opcde)
	return

print_header,
	incr page
	for loop from 1 thru 5 by 1 call print
	case a_type of
	  begincase
	  'C': prref = '* CONFIRM *'
	  'I': prref = oem_invcno, 'XXXXXX'
	  endcase
	call print 
	call print
	xcall dtdsp (oem_reqdate,prref(8:10))
	call print
	case a_type of
	  begincase
	  'C': xcall dtdsp (oem_reqdate,prref(8:10))
	  'I': xcall dtdsp (oeb_invcdate,prref(8:10))
	  endcase
	call print
	call print
	prref(10:8) = oem_cust, 'XXXXXXXX'
;	prref(9:1) = '/'
;	prref(10:8) = oem_shipid, 'XXXXXXXX'
;	call print
;	call print
	call print
	call print
	prname = slname
	prshto = shname
	call print
	prname = sladd1
	prshto = shadd1
	call print
	prname = sladd2
	prshto = shadd2
	call print
	prname = sladd3
	prshto = shadd3
	call print
	call print
;	call print
	prslmn = slmn
	prcref = oem_custref
;       xcall dtdsp (oem_shipdate,prshdt)
	prsvia = svia
	prterm = terms
	case oem_fobc of
	  begincase
	  'O': prfob = 'Origin'
	  'D': prfob = 'Destination'
	  endcase
;	prordr = oem_order, 'XXXXXX'
;	xcall dtdsp (oem_orddate,prdate)
;	call print
;	call print
	call print
	call print
	return

	;	print invoice detail lines
print_detail,
	lines = 1
	clear line
	if (oem_type.eq.'C')
	  begin
	    pline(14,36) = '***** CREDIT MEMO *****'
	    call print
	    incr lines
	  end
	xcall db_read (oeline_chan,oeline,oem_key,0,'M',,,opcde)
	if (.not.opcde)
	  repeat
	    begin
	      if (oel_linestatus.ne.'C') .and.		; not completed
	      &  (oel_linestatus.ne.'D') .and.		; not deleted
	      &  (oel_linestatus.ne.'W')		; not warehouse
		begin
		  case oel_linetype of
		    begincase
		    'I': begin		; stock item
			  call print_item
			  call print_remarks
			  if (oe_cmedin.eq.'I') call print_edsc_item
			 end
		    'J': begin		; stock item no qty updt
			  call print_item
			  call print_remarks
			  if (oe_cmedin.eq.'I') call print_edsc_item
			 end
		    'N': begin		; non stock item
			  call print_item
			  call print_remarks
			 end
		    endcase
		  if (oe_cmedin.eq.'O') call print_edsc_order
		  if ((oel_slst.eq.'L') .or.
		  &   (oel_slst.eq.'S')) .and. 
		  &  (print_serial.eq.'Y') call print_sl_nos
		  if (oel_slst.eq.'K') .and.
		  &  (print_kits.eq.'Y' .or. print_kits.eq.'S') call print_kit
		end
	      xcall db_next (oeline_chan,oeline,'F','M',,,opcde)
	      if (opcde) .or.
	      &  (oel_key.ne.oem_key) exitloop
	    end

	;	end of invoice
	for loop from 1 thru (line_max + 2 - lines) by 1 call print
	pramnt = salamt, mask
	call print

	pline(4:40) = oem_comment1
	pramnt = oem_discamt, mask
	call print

	pramnt = oem_salestax, mask
	call print

	case oem_fobc of
	  begincase
	  'O': begin			; freight charged to customer
		pramnt = oem_freight, mask
		invtot = salamt + oem_salestax + oem_freight - oem_discamt
	       end
	  'D': begin			; freight NOT charged to customer
		clear pramnt
		invtot = salamt + oem_salestax - oem_discamt
	       end
	  endcase
	pline(4:40) = oem_comment2
	call print

	if (oem_type.eq.'C') prname = '** TOTAL CREDIT **'
	pramnt = invtot, mask
	if (a_type.eq.'C') .and.
	&  (oem_type.ne.'C')
	    prname = '* ORDER CONFIRMATION - DO NOT PAY *'
	if (oem_termcode.eq.prepay_terms)
	    prname = '*** PREPAID - DO NOT MAIL ***'
	call print
	if (lp_sel.eq.'S')
	 then call print
	 else
	  begin
	    if (a_type.eq.'I') xcall ds_store ('SOI',oem_invcno,page)
	    lp_cnt = 98				; skip to top of page
	    xcall print
	  end
	return

	;	print a line item
print_item,
	if (lines.gt.line_max) call continued
	boqt = oel_ordqty - oel_pckqty - oel_shpqty
	if (boqt.lt.0) clear boqt
	case a_type of
	  begincase
	  'C': amount = (oel_ordqty * oel_uprice) / oel_pfactor
	  'I': amount = (oel_pckqty * oel_uprice) / oel_pfactor
	  endcase
	incr line

	pritem = oel_item		; Print first line for item
	case in_cmqdec of
	  begincase
	  0: begin
	      prorqt = oel_ordqty, mask0
	      prshqt = oel_pckqty, mask0
	     end
	  3: begin
	      prorqt = oel_ordqty, mask3
	      prshqt = oel_pckqty, mask3
	     end
	  endcase
	if (in_cmqtyprice.eq.'Y') then
	  begin
	    prpric_q = oel_uprice, mask2
	    prpric_s = '/'
	    prpric_u = oel_uomcode
	  end
	 else prpric = oel_uprice, mask3
	pramnt = amount, mask
	call print
	incr lines

	prdesc = oel_descr		; Print second line for item
	if (oel_boqty)
	  begin
	    case in_cmqdec of
	      begincase
	      0: prbkqt = oel_boqty, mask0
	      3: prbkqt = oel_boqty, mask3
	      endcase
	    prbkds = 'Backordered'
	  end
	call print
	incr lines
	salamt = salamt + amount
	return

	;       print remarks lines
print_remarks,
	if (oel_remark1) .and.
	&  (oel_rem1prt.eq.'I' .or. oel_rem1prt.eq.'B')
	  begin
	    if (lines.gt.line_max) call continued
	    pline(9:60) = oel_remark1
;	    pline(11:60) = oel_remark1
	    call print
	    incr lines
	  end
	if (oel_remark2) .and.
	&  (oel_rem2prt.eq.'I' .or. oel_rem2prt.eq.'B')
	  begin
	    if (lines.gt.line_max) call continued
	    pline(11:60) = oel_remark2
	    call print
	    incr lines
	  end
	return

	;       print extended description from item
print_edsc_item,
	ini_comp = oel_comp
	ini_item = oel_item
	xcall in_get_item (initem)
	if (.not.opcde)
	  begin
	    for ndx from 1 thru 4
	      if (ini_edesc[ndx].ne.ut_blanks)
		begin
		  if (lines.gt.line_max) call continued
		  pline(20:60) = ini_edesc[ndx]
		  call print
		  incr lines
		end
	  end
	return

	;       print extended description from order
print_edsc_order,
	for ndx from 1 thru 4
	  if (oel_extdescr[ndx].ne.ut_blanks)
	    begin
	      if (lines.gt.line_max) call continued
	      pline(20:60) = oel_extdescr[ndx]
	      call print
	      incr lines
	    end
	return

	;       Print serial/lot numbers
print_sl_nos,
	clear line_prt
	xcall db_find (oesnlt_chan,oel_key,0,'M',,,opcde)
	repeat
	  begin
	    xcall db_next (oesnlt_chan,oesnlt,'F','M',,,opcde)
	    if (opcde) .or.
	    &  (oes_key.ne.oel_key) exitloop
	    if (oes_linestatus.ne.'D')
	      begin
		case oel_slst of
		  begincase
		  'L': begin
			incr line_prt
			if (line_prt.eq.1) prlot1 = oes_snlt
			if (line_prt.eq.2) prlot2 = oes_snlt
			pline = lot
		       end
		  'S': begin
			incr line_prt
			if (line_prt.eq.1) prsn1 = oes_snlt
			if (line_prt.eq.2) prsn2 = oes_snlt
			pline = serial
		       end
		  endcase
		if (line_prt.eq.2)
		  begin
		    if (lines.gt.line_max) call continued
		    call print
		    incr lines
		    clear prlot1,prlot2,prsn1,prsn2,line_prt
		  end
	      end
	  end
	if (line_prt)
	  begin
	    if (lines.gt.line_max) call continued
	    call print
	    incr lines
	  end
	return

print_kit,
	inkitm.comp = oel_comp
	inkitm.item = oel_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.oel_comp) .or.
	    &  (inkcmp.item.ne.oel_item) return
	    prkitd = 'Kit:'
	    prkiti = inkcmp.citem
	    if (print_kits.eq.'S') .and.
	    &  (a_type.eq.'I') then
	      begin
		xcall in_get_item_dat (inkcmp.comp+inkcmp.citem,'SLST',slst)
		if (slst.eq.'L' .or. slst.eq.'S')
		 then call print_kit_serial
		 else
		  begin
		    call print
		    incr lines
		    if (lines.gt.line_max) call continued
		  end
	      end
	     else
	      begin
		call print
		incr lines
		if (lines.gt.line_max) call continued
	      end
	  end
	return

	;       Print kit component serial/lot numbers
print_kit_serial,
	oes_comp = oel_comp
	oes_order = oel_order
	oes_lineno = oel_lineno
	oes_item = inkcmp.citem
	xcall db_find (oesnlt_chan,oes_key(1:35),0,'M',,,opcde)
	repeat
	  begin
	    xcall db_next (oesnlt_chan,oesnlt,'F','M',,,opcde)
	    if (opcde) .or.
	    &  (oes_comp.ne.oel_comp) .or.
	    &  (oes_order.ne.oel_order) .or.
	    &  (oes_lineno.ne.oel_lineno) .or.
	    &  (oes_item.ne.inkcmp.citem) exitloop
	    if (oes_linestatus.ne.'D')
	      begin
		if (lines.gt.line_max) call continued
		case slst of
		  begincase
		  'L': begin
			prkitsnld = 'Lot:'
			prkitsnlt = oes_snlt
		       end
		  'S': begin
			prkitsnld = 'S/N:'
			prkitsnlt = oes_snlt
		       end
		  endcase
		call print
		incr lines
	      end
	    end
	return

	;	print continued and start a new page
continued,
	for loop from 1 thru 3 by 1 call print
	prdesc = '***** CONTINUED *****'
	call print
	if (lp_sel.eq.'S')
	 then call print			; screen display
	 else
	  begin
	    if (a_type.eq.'I') xcall ds_store ('SOI',oem_invcno,page)
	    lp_cnt = 98				; skip to top of page
	    xcall print
	  end
	call print_header
	lines = 1
	clear line
	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


