;==File=================================================================;
; PO4360.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=============================================================;
;	po4360		Print receivings stock labels.
;==Changes==============================================================;
; 07/11/2001 tah - Change print method for Bartender
; 05/02/2001 tah - Change for new POSNLT file format (kits)
;=======================================================================;
.subroutine po4360

.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:porecv.rec"
.include "POS:posnlt.rec"
.include "INS:incomm.gbl"
.include "INS:initem.rec"
.include "SMS:smcode.rec"

record	export
	exp_item	,a24		; Item ID
	exp_descr	,a30		; Item description
	exp_locncode	,a3		; Location code
	exp_locndescr	,a25		; Location name
	exp_slst	,a4		; Serial/Lot type
	exp_snlt	,a20		; Serial/Lot number
	exp_bin		,a8		; Bin
	exp_order	,a6		; PO number
	exp_line	,a3		; PO line number
	
record	scr_rec1
	scr_scan	,a10		; scanned information
	  scr_order	,d6	@scr_scan
	  scr_line	,d3	@scr_scan+6
	scr_count	,d3		; number of labels to print

record
	abort		,d1
	cformat		,a*,	'A1:24|A25:30|A55:3|A58:25|A83:4|A87:20|A107:8|'
	&			'A115:6|A121:3|'
	data_len	,d2		; scanned data length
	label_chan	,d3		; label records channel
	label_name	,a*,	'WRK:po4360.ddf'
	  label_extn	,a3	@label_name+11
	ndx		,d5		; loop control
	recs_read	,d6
	wdone		,d1
	wind_name	,a*,	'po4360'
	wind_no		,d2		; input window id
.start nopage,list

.proc
	;>>>>>	Main processing  <<<<<;
	call do_setup
	call open_files
	if (abort.eq.FALSE) call get_parameters
	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)
	abort = FALSE
	return

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

	;	Open the needed data files
open_files,
	xcall open (porecv_chan,'I:I',porecv_name)
	xcall open (posnlt_chan,'I:I',posnlt_name)
	xcall open (initem_chan,'I:I',initem_name)
	xcall open (smcode_chan,'I:I',smcode_name)
	label_extn = ut_userid
	xcall ascfil ('I',label_name,'OUTPUT',,,,,,,opcde)
	exp_item = 'Item ID'
	exp_descr = 'Description'
	exp_locncode = 'Loc'
	exp_locndescr = 'Loc Description'
	exp_slst = 'S/L'
	exp_snlt = 'Serial/Lot'
	exp_bin = 'Bin'
	exp_order = 'Order'
	exp_line = 'Lin'
	xcall ascfil ('D',,export,cformat,'"','"',',','Y','Y',opcde)
	return

	;	Close the data files opened for the report
close_files,
	xcall close (porecv_chan,DTE_CLOSE)
	xcall close (posnlt_chan,DTE_CLOSE)
	xcall close (initem_chan,DTE_CLOSE)
	xcall close (smcode_chan,DTE_CLOSE)
	xcall ascfil ('F',,,,,,,,,opcde)
	xcall copy (label_name,'LBL:po4360.txt')
	return

	;	Get the report selection parameters
get_parameters,
	abort = FALSE	
	xcall lodwin ('LPL',wind_name,wind_no)
	repeat
	  begin
	    wdone = FALSE
	    xcall i_next (wind_no,'set1','*FRST*')
	    do begin
	      xcall i_input (wind_no,'set1',scr_rec1,,ut_col_sel,,1)
	      if g_select
		begin
		  case g_entnam of
		    begincase
		    'END':  begin
			      abort = TRUE
			      return
			    end
		    'GO':   begin
			      xcall i_next (wind_no,'set1','*DONE*')
			      wdone = TRUE
			      clear g_setsts,g_select
			    end
		    '@':    call process_signal
		    endcase
		end
	    end until (.not.g_setsts) .and. (.not.g_select)
	    if (wdone.eq.TRUE) exitloop
	    xcall i_init (wind_no,'SET1',,'SCAN')
	  end
	return

	;	Process any break signals
process_signal,
	case g_entnam of
	  begincase
	  '@SCAN':begin
		    data_len = %trim(scr_scan)
		    case data_len of
		      begincase
		      9: begin
			  abort = FALSE
			  call order_line
			  if (abort.eq.TRUE) return
			 end
		      endcase
		     else xcall u_message ('Invalid scan data')
		  end
	  endcase
	return

	;	order line bar code scanned
order_line,
	por_comp = ut_cmcomp
	por_order = scr_order
	por_lineno = scr_line
	xcall db_read (porecv_chan,porecv,por_key(1:11),0,'M',,,opcde)
	if (opcde)
	 then xcall u_message ("Order line item not found.")
	 else
	  begin
	    xcall i_dspfld (wind_no,'ITEM',por_item)
	    xcall i_dspfld (wind_no,'DESC',por_descr)
	    scr_count = por_recdqty
	    call in_labels
	    if (scr_count) call print_label
	  end
	return

	;	prompt for the number of labels wanted
in_labels,
	do begin
	  xcall i_init (wind_no,'SET2')
	  xcall i_input (wind_no,'SET2',scr_rec1,,ut_col_sel)
	  if g_select
	    begin
	      case g_entnam of
		begincase
		'END':	return
		'ABORT':return
		endcase
	    end
	end until (.not.g_setsts) .and. (.not.g_select)
	return

print_label,
	ini_comp = ut_cmcomp
	if (pos_item)			; Is this a kit component
	 then ini_item = pos_item
	 else ini_item = por_item
	xcall in_get_item (initem)
	if (scr_count.eq.por_recdqty) .and.
	&  (ini_slst.eq.'S' .or. ini_slst.eq.'L')
	 then call print_sn_labels
	 else call print_non_sn_labels
	return

	;	Print number of labels without serial numbers
print_non_sn_labels,
	for ndx from 1 thru scr_count by 1
	  begin
	    smc_type = 'L'
	    smc_code = por_locncode
	    xcall sm_get_code (smcode)
	    exp_locncode = por_locncode
	    exp_locndescr = smc_descr
	    clear exp_slst,exp_snlt,exp_bin
	    if (pos_item) then		; Is this a kit component
	      begin
		exp_item = pos_item
		exp_descr = ini_desc
	      end
	     else
	      begin
		exp_item = por_item
		exp_descr = por_descr
	      end
	    exp_order = por_order, 'XXXXXX'
	    exp_line = por_lineno, 'XXX'
	    xcall ascfil ('D',,export,cformat,'"','"',',','Y','Y',opcde)
	  end
	return

	;	Print 1 label for each serial number on file
print_sn_labels,
	pos_comp = por_comp
	pos_order = por_order
	pos_lineno = por_lineno
	xcall db_find (posnlt_chan,pos_key(1:11),0,'M',1,,opcde)
	if (.not.opcde)
	  repeat
	    begin
	      xcall db_next (posnlt_chan,posnlt,'F','M',1,,opcde)
	      if (opcde) .or.
	      &  (pos_comp.ne.por_comp) .or.
	      &  (pos_order.ne.por_order) .or.
	      &  (pos_lineno.ne.por_lineno) exitloop

	      smc_type = 'L'
	      smc_code = por_locncode
	      xcall sm_get_code (smcode)
	      exp_locncode = por_locncode
	      exp_locndescr = smc_descr
	      case ini_slst of
		begincase
		'S': exp_slst = 'S/N:'
		'L': exp_slst = 'Lot:'
		endcase
	      exp_snlt = pos_snlt
	      clear exp_bin
	      if (pos_item) then		; Is this a kit component
		begin
		  exp_item = pos_item
		  exp_descr = ini_desc
		end
	       else
		begin
		  exp_item = por_item
		  exp_descr = por_descr
		end
	      exp_order = por_order, 'XXXXXX'
	      exp_line = por_lineno, 'XXX'
	      xcall ascfil ('D',,export,cformat,'"','"',',','Y','Y',opcde)
	    end
	return
.end

