;==File=================================================================;
; PO6300.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=============================================================;
;	po6300		Create drop ship file and print report.
;==Changes==============================================================;
;=======================================================================;
.subroutine po6300

.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:podrop.rec"
.include "OES:oecomm.gbl"
.include "OES:oehedr.rec"
.include "OES:oeline.rec"
.include "NAS:nacomm.gbl"
.include "NAS:namast.rec"
.include "INS:incomm.gbl"
.include "INS:initvc.rec"

record	head1
		,a*	@3,	'VENDOR NAME'
		,a*	@43,	'SHIP TO NAME'
		,a*	@83,	'CUSTOMER NAME'
record	head2
		,a*	@23,	'TYPE'
		,a*	@29,	'ITEM ID'
		,a*	@56,	'DESCRIPTION'
		,a*	@89,	'ORDER'
		,a*	@96,	'LINE'
		,a*	@103,	'LOC'
		,a*	@108,	'CAT'
		,a*	@113,	'REQUIRED'
		,a*	@125,	'QUANTITY'

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

record	pline
		,a132
record	,X
	prvend		,a8	@1
	prvnam		,a30	@10
	prship		,a8	@41
	prshto		,a30	@50
	prcust		,a9	@81
	prcnam		,a30	@90
record	,X
	pritem		,a24	@29
	prdesc		,a30	@56
	prorno		,a6	@89
	prline		,a3	@97
	prlocn		,a3	@103
	prcatg		,a3	@108
	prrqdt		,a8	@113
	prorqt		,a11	@122

record	totals
	lorqt		,d9.3		; location order quantity
	iorqt		,d9.3		; item order quantity
	forqt		,d9.3		; report order quantity

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

record
	abort		,d1
	eof		,d1		; end of file switch
	lines1		,d3		; line item counter - location
	lines2		,d3		; line item counter - items
	lstshp		,d8		; current ship to id
	lstvnd		,d8		; current vendor id
	mask0		,a11,	'   ZZZ,ZZX-'
	mask3		,a11,	'ZZZZZX.XXX-'
	recs_read	,d6
	temp_name	,a14		; temp file for sort
	  temp_ext	,a3	@temp_name+11
	title		,a*,	'DROP SHIP ORDERS'
	vend_id		,d8		; primary vendor id
	vend_part	,a24		; primary vendor part number
	wind_name	,a*,	'po6300'
	wdone		,d1
	wind_no		,d2		; input window id
	wind_signal	,a31
	work_chan	,d2		; channel for work/sort file
	work_name	,a14,	'WRK:podrop.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 ('Drop Ship 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 (oehedr_chan,'I:I',oehedr_name)
	xcall open (oeline_chan,'I:I',oeline_name)
	xcall open (initvc_chan,'I:I',initvc_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_CLOSE)
	xcall close (oehedr_chan,DTE_CLOSE)
	xcall close (oeline_chan,DTE_CLOSE)
	xcall close (namast_chan,DTE_CLOSE)
	xcall close (initvc_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
	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,oehedr_chan)
	call pull_work_data
	xcall close (work_chan,DTE_CLOSE)
	if (wrtcnt.eq.0)
	  begin
	    xcall message (DTEPO_NDI,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=podrop,
	&  key=(pod_comp,pod_vend,pod_shipid,pod_item),tempfile=temp_name)
	return

	;	Print the report
print_report,
	xcall status (DTEM_PRT)

	xcall open (work_chan,'I',work_name)
	xcall open (namast_chan,'I:I',namast_name)
	eof = FALSE
	clear totals, oem_order, lstvnd, lstshp

	repeat
	  begin
	    reads (work_chan,podrop,print_report_eof)
	    if (pod_vend.ne.lstvnd) call new_vendor
	    if (pod_shipid.ne.lstshp) call new_shipto

	    nam_comp = na_cmuseco
	    nam_id = pod_vend
	    xcall na_get_name (namast)
	    prvend = pod_vend, 'XXXXXXXX'
	    prvnam = nam_name

	    nam_comp = na_cmuseco
	    nam_id = pod_shipid
	    xcall na_get_name (namast)
	    prcust = pod_shipid, 'XXXXXXXX'
	    prcnam = nam_name

	    nam_comp = na_cmuseco
	    nam_id = pod_cust
	    xcall na_get_name (namast)
	    prcust = pod_cust, 'XXXXXXXX'
	    prcnam = nam_name
	    call print

	    pritem = pod_item
	    prdesc = pod_desc
	    prorno = pod_order, 'XXXXXX'
	    prline = pod_lineno, 'XXX'
	    prlocn = pod_locncode
	    prcatg = pod_catgcode
	    xcall dtdsp (pod_reqdate,prrqdt)
	    case in_cmqdec of
	      begincase
	      0: prorqt = pod_ordqty, mask0
	      3: prorqt = pod_ordqty, mask3
	      endcase
	    call print
	    incr lines1
	    incr lines2
	    lorqt = lorqt + pod_ordqty
	    iorqt = iorqt + pod_ordqty
	    forqt = forqt + pod_ordqty
	  end
print_report_eof,
	return

	;	Print the report totals
print_report_totals,
	eof = TRUE
	call new_vendor
	pline(7:13) = 'Final Totals:'
	case in_cmqdec of
	  begincase
	  0: prorqt = forqt, mask0
	  3: prorqt = forqt, mask3
	  endcase
	call print
	return

pull_work_data,
	clear wrtcnt
	xcall db_find (oehedr_chan,ut_cmcomp,0,'M',,,opcde)
	repeat
	  begin
	    xcall db_next (oehedr_chan,oehedr,'F','M',,,opcde)
	    if (opcde) .or.
	    &  (oem_comp.ne.ut_cmcomp) return
	    incr recs_read
	    if (.not.recs_read(5:2)) xcall statusbar (recs_read)
	    if (oem_type.ne.'C' .and. oem_flag5.ne.'Y') .and.
	    &  (oem_reqdate.ge.scr_strdate .and. oem_reqdate.le.scr_enddate)
		call pull_lines
	  end

pull_lines,
	xcall db_find (oeline_chan,oem_key,0,'M',,,opcde)
	repeat
	  begin
	    xcall db_next (oeline_chan,oeline,'F','M',,,opcde)
	    if (opcde) .or.
	    &  (oem_key.ne.oel_key) return
	    if (oel_linetype.eq.'I' .or. oel_linetype.eq.'N') .and.
	    &  (oel_linestatus.ne.'D' .and. oel_linestatus.ne.'C')
	      begin
		if (oel_qtystatus.eq.'D')     		; see if drop shipped
		  begin
		    xcall in_get_vend (oel_item,oel_locncode,vend_id,vend_part)
		    pod_comp = oem_comp
		    pod_vend = vend_id
		    pod_shipid = oem_shipid
		    pod_item = oel_item
		    pod_desc = oel_descr
		    pod_order = oem_order
		    pod_lineno = oel_lineno
		    pod_cust = oem_cust
		    pod_ordqty = oel_ordqty
		    pod_reqdate = oel_reqdate
		    pod_locncode = oel_locncode
		    pod_catgcode = oel_catgcode
		    pod_linetype = oel_linetype
		    writes (work_chan,podrop)
		    incr wrtcnt
		  end
	      end
	  end

	;	print vendor totals
new_vendor,
	if (lstvnd.ne.0 .and. lines1.gt.1)
	  begin
	    pline(7:15) = 'Vendor Total:'
	    case in_cmqdec of
	      begincase
	      0: prorqt = lorqt, mask0
	      3: prorqt = lorqt, mask3
	      endcase
	    call print
	    call print
	  end
	clear lorqt, lines1
	lstvnd = pod_vend
	return

	;	print shipto totals
new_shipto,
	call new_vendor
	if (lstshp.ne.0 .and. lines2.gt.1)
	  begin
	    pline(7:11) = 'Ship Total:'
	    case in_cmqdec of
	      begincase
	      0: prorqt = iorqt, mask0
	      3: prorqt = iorqt, mask3
	      endcase
	    call print
	    call print
	  end
	if (eof.eq.TRUE) return
	clear iorqt, lines2
	lstshp = pod_shipid
	return

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

