;==File=================================================================;
; PO4100.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=============================================================;
;	po4100		Select orders for purchase orders.
;==Changes==============================================================;
; 07/19/2006 tfc add selection 9 for custom form
;=======================================================================;
.subroutine po4100

	a_pohedr	,a	; IN  - order header record from PO4000

.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 "INS:incomm.gbl"

record	poprnt
	popono		,d6		; purchase order number

record	scr_rec1
	scr_option	,a1		; selection option
	scr_order	,d6		; order number
	scr_begord	,d6		; beginning order number
	scr_endord	,d6		; ending order number

record
	abort		,d1
	recs_read	,d6
	set_name	,a4		; current input set name
	temp_name	,a14		; temp file for sort
	  temp_ext	,a3	@temp_name+11
	wdone		,d1
	wind_name	,a*,	'po4100'
	wind_no		,d2		; input window id
	wind_signal	,a31
	work_chan	,d2		; work file channel
	work_name	,a*,	'WRK:po4100.ddf'
	  work_ext	,a3	@work_name+11
	wrtcnt		,d6		; number of work records written
.start nopage,list

.proc
	;>>>>>	Main processing  <<<<<;
	call do_setup
	call open_files
	if (%passed(a_pohedr)) then		; Order header passed
	  begin
	    pohedr = a_pohedr
	    call pull_one_order
	  end
	 else
	  begin
	    repeat
	      begin
		call get_parameters
		if (abort.eq.TRUE) exitloop
		call pull_data
		xcall i_init (wind_no)
	      end
	  end
	call sort_data
	if (abort.eq.FALSE) call print_report
	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)
	set_name = 'set1'
	return

	;	Shut down environment
do_shutdown,
	xcall lodtoolbar ('RB',8)
	xcall e_exit
	return

	;	Open the needed data files
open_files,
	work_ext = ut_userid
	xcall open (work_chan,'O',work_name)
	if (.not.%passed(a_pohedr))		; These files are already open
	  begin					;  from PO4000 order entry
	    xcall open (pohedr_chan,'U:I',pohedr_name)
	    xcall open (poline_chan,'U:I',poline_name)
	    xcall open (initem_chan,'I:I',initem_name)
	    xcall open (initvc_chan,'I:I',initvc_name)
	    xcall open (smcode_chan,'I:I',smcode_name)
	  end
	return

	;	Close the data files opened for the report
close_files,
	xcall close (work_chan,DTE_CLOSE)
	if (.not.%passed(a_pohedr))		; Only close files if not
	  begin					;  from PO4000 order entry
	    xcall close (pohedr_chan,DTE_CLOSE)
	    xcall close (poline_chan,DTE_CLOSE)
	    xcall close (initem_chan,DTE_CLOSE)
	    xcall close (initvc_chan,DTE_CLOSE)
	    xcall close (smcode_chan,DTE_CLOSE)
	  end
	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_signal,
	case g_entnam of
	  begincase
	  '@OPTION':case scr_option of
		     begincase
		     'O': begin			; one order
			    xcall i_enable (wind_no,'ORDER')
			    xcall i_disable (wind_no,'BEGORD,ENDORD')
			  end
		     'A': begin			; all orders
			    xcall i_enable (wind_no,'BEGORD,ENDORD')
			    xcall i_disable (wind_no,'ORDER')
			  end
		     endcase
	  '@ORDER':begin
		    pom_comp = ut_cmcomp
		    pom_order = scr_order
		    xcall db_find (pohedr_chan,pom_key,0,'M',,,opcde)
		    if (opcde)
		     then xcall message (DTEPO_ONF)
		     else
		      begin
			xcall db_next (pohedr_chan,pohedr,'F','M',,,opcde)
			case pom_ordtype of
			  begincase
			  'H': begin
				xcall message (DTEPO_OIH)
				xcall i_init (wind_no)
			       end
			  'X': begin
				xcall message (DTEPO_OIX)
				xcall i_init (wind_no)
			       end
			  endcase
			xcall i_dspfld (wind_no,'vendid',pom_vend)
			xcall i_dspfld (wind_no,'vendid_descr',pom_name)
		      end
		   end
	  endcase
	return

verify_input_parameters,
	wdone = TRUE
	return

	;	Extract data for the report
pull_data,
	abort = FALSE
	xcall status (DTEM_PRC)
	case scr_option of
	  begincase
	  'O': call pull_one_order	; one order
	  'A': call pull_all		; all orders
	  endcase
	return

	;	Sort the extracted data
sort_data,
	abort = FALSE
	xcall close (work_chan,DTE_CLOSE)
	if (wrtcnt.eq.0) then
	  begin
	    xcall message (DTEPO_NOI)
	    abort = TRUE
	  end
	 else
	  if (wrtcnt.gt.1)
	    begin
	      xcall status (DTEM_SRT)
	      temp_name = work_name
	      temp_ext = ut_cmterm, 'XXX'
	      sort (in=work_name,record=poprnt,key=(popono),tempfile=temp_name)
	    end
	return

	;	Print the report
print_report,
	xcall status (DTEM_PRT)
	case po_cmform of
	  begincase
	  1: xcall po4101 ('P')		; Nebs form
	  2: xcall po4102 ('P')		; laser form
	  5: xcall po4105 ('N','P')	; no company name or address
	  6: xcall po4105 ('Y','P')	; print company name/address
	  7: xcall po4107 ('N','P')	; no company name or address
	  8: xcall po4107 ('Y','P')	; print company name/address
	  9: xcall po4109 ('P')		; custom form 7/19/06
	  endcase
	 else xcall message (DTEPO_IST,D_ERROR)
	return

	;	all orders
pull_all,
	clear recs_read
	xcall statusbar (0,pohedr_chan)
	xcall db_find (pohedr_chan,ut_cmcomp,0,'M',,,opcde)
	repeat
	  begin
	    xcall db_next (pohedr_chan,pohedr,'F','M',,,opcde)
	    if (opcde) .or.
	    &  (pom_comp.ne.ut_cmcomp) return
	    incr recs_read
	    if (.not.recs_read(5:2)) xcall statusbar (recs_read)
	    if (pom_ordtype.ne.'H') .and.
	    &  (pom_ordtype.ne.'X') .and.
	    &  (pom_status.ne.'D') .and.
	    &  (pom_status.ne.'C') .and.
	    &  (pom_flag1.ne.'Y') .and.
	    &  (pom_order.ge.scr_begord .and. pom_order.le.scr_endord)
		call pull_one_order
	  end

	;	write order record to work file
pull_one_order,
	popono = pom_order
	writes (work_chan,poprnt)
	incr wrtcnt
	return
.end

