;==File=================================================================;
; PO8200.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=============================================================;
;	po8200		Purge order history.
;==Changes==============================================================;
; 03/13/2015 lso - added check for scr_confirm.ne.'YES'
;=======================================================================;
.subroutine po8200

.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:pohist.rec"

record	scr_rec1		; input set 1
	scr_purdate	,d8		; date to purge through
	scr_write	,a1		; write purged records to file
	scr_confirm	,a3		; confirmation (YES/NO)

record
	abort		,d1
	recs_read	,d6
	wdone		,d1
	wind_name	,a*,	'po8200'
	wind_no		,d2		; input window id
	wind_signal	,a31
.start nopage,list

.proc
	;>>>>>	Main processing  <<<<<;
	call do_setup
	if (po_cmkphs.eq.'Y')	; nothing if history switch is not on
	  begin
	    call open_files
	    call get_parameters
	    if (abort.eq.FALSE) call process_data
	    call close_files
	  end
	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 (pohist_chan,'U:I',pohist_name)
	return

	;	Close the data files opened for the report
close_files,
	xcall close (pohist_chan,DTE_CLOSE)
	if (ut_chan) xcall close (ut_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
	if (scr_confirm.ne.'YES') abort = TRUE			;03/13/2015
	return

	;	Process the data
process_data,
	abort = FALSE
	xcall status (DTEM_PRC)
	clear recs_read
	xcall statusbar (0,pohist_chan)
	clear ut_chan
	if (scr_write.eq.'Y')
	  begin
	    ut_filename = pohist_name
	    ut_filedev = 'WRK'
	    ut_fileext = 'pur'
	    xcall open (ut_chan,'O',ut_file)
	  end
	xcall db_find (pohist_chan,ut_cmcomp,0,'M',,,opcde)
	repeat
	  begin
	    xcall db_next (pohist_chan,pohist,'F','M',,,opcde)
	    if (opcde) .or.
	    &  (poh_comp.ne.ut_cmcomp) return
	    incr recs_read
	    if (.not.recs_read(5:2)) xcall statusbar (recs_read)
	    if (poh_recdate.le.scr_purdate)
	      begin
		xcall db_delete (pohist_chan,pohist,poh_key,pohist_log,opcde)
		if (scr_write.eq.'Y') writes (ut_chan,pohist)
	      end
	  end
.end

