; cporecv.dbl	Convert PORECV files to single record format.
;=======================================================================;
; Copyright 2002 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.	;
;=======================================================================;
;	From	version: 7.0 (Windows)
;	To	version: 7.0 (Windows)
;		PORECV: from 156 bytes to 646 bytes
;=======================================================================;
.start nopage,nolist
.include "UTL:tools.def"
.include "UTS:dteut.def"

.define DTECTL_INIT, 1
.include "UTS:utcomm.gbl"
.include "POS:pocomm.gbl"
.include "POS:porecv.rec"
.include "SMS:smcomm.gbl"

record	mesage
	m_records	,a6	@1
			,a*	@8,	'records loaded to'
	m_filename	,a14	@26

record
	chan		,d2		; saved channel number
	cmd_line	,a100		; input command line
	cmd_length	,d3		; length of command line
	cur_porecv_key	,a11		; current order
	file_spec	,a14		; FIL:xxxxxx.ism
	  file_dev	,a3	@file_spec
	  file_name	,a6	@file_spec+4
	  file_extn	,a3	@file_spec+11
	file_no		,d2
	in_buffer	,a2000		; work file input buffer
	  in_dbuffer	,d2000	@in_buffer
	len		,d2
	no_records	,d5		; number of records loaded
	ndx		,d2
	pos		,d4		; buffer starting position
	recs_read	,d6		; number of records read
	  recs_cnt	,d1	@recs_read+5
	sys_code	,d2		; system environment
	work_chan	,i4		; input channel
.start nopage,list

.proc
	xcall lodwin ('I')

	;	create and load main menu

	xcall e_sect (DTEM_DTE,D_HEADER,D_LEFT)
	xcall e_sect ('P/O Conversion',D_HEADER,D_NOCLEAR,D_CENTER)
	xcall e_sect ('Down To Earth V7.0',D_HEADER,D_NOCLEAR,D_RIGHT)
	ut_cmtype = 'SM'
	ut_cmcomp = '01'
	ut_cmdtfm = 1
	sec_option = 'YYYYY'
	xcall dte

	file_spec = 'FIL:porecv.ism'
	call convert_file
stop,
	xcall u_finish
	stop

;;;;;;;;;;;;;;;;;; convert the files  ;;;;;;;;;;;;;;;;;;;;;
convert_file,
	xcall open (work_chan,'U:I',file_spec)
	xcall statusbar (0,work_chan)
	xcall close (work_chan,DTE_CLOSE)

	xcall sm8100 ('FIL',file_spec(5:6),'**')	; unload file
	if (sys_code.ne.6)
	  begin						; delete existing files
	    xcall u_getchn (chan)
	    file_spec = file_spec
	    xcall delet (chan,file_spec)
	    file_extn = 'is1'
	    xcall delet (chan,file_spec)
	  end

	;	create new file
	file_extn = 'ism'
	xcall creidx ('PO',file_spec(5:10),'FIL')

	xcall status (,'Reformatting ' + file_name + ' records.')

	ut_file = file_spec
	ut_filedev = 'WRK'
	ut_fileext = 'ddf'
	xcall open (ut_chan,'I',ut_file)
	xcall open (work_chan,'U:I',file_spec)
	clear no_records, recs_read, cur_porecv_key
	repeat
	  begin
	    reads (ut_chan,in_buffer,convert_end)
	    incr recs_read
	    if (recs_cnt.eq.0) xcall statusbar (recs_read)
	    call format_porecv
	  end
convert_end,
	xcall close (ut_chan,DTE_CLOSE)
	xcall close (work_chan,DTE_CLOSE)
	m_records = no_records, 'ZZZ,ZZX'
	m_filename = file_spec
	xcall u_message (mesage,D_ERROR)
	return

;;;;;;;;;;;;;;;;;; format porecv ;;;;;;;;;;;;;;;;;;;;;
format_porecv,
	if (in_dbuffer(15:2).eq.0)
	 then call set_item_record
	 else call set_invoice_record
	return

set_item_record,
	por_comp = in_buffer(1:2)
	por_order = in_dbuffer(3:6)
	por_lineno = in_dbuffer(9:3)
	por_recdate = in_dbuffer(74:8)
	por_linetype = in_buffer(12:1)
	por_item = in_buffer(17:24)
	por_locncode = in_buffer(41:3)
	por_descr = in_buffer(44:30)
	por_ordqty = ^d(in_dbuffer(82:9),3)
	por_recuqty = ^d(in_dbuffer(91:9),3)
	por_recdqty = ^d(in_dbuffer(100:9),3)
	por_recrqty = ^d(in_dbuffer(109:9),3)
	por_ucost = ^d(in_dbuffer(118:9),3)
	por_pfactor = in_dbuffer(127:6)
	por_posted = in_buffer(133:1)
	por_frtadd = in_dbuffer(134:6)
	por_postqty = ^d(in_dbuffer(140:9),3)
	por_abin = in_buffer(149:8)
	clear por_weight,por_discpct,por_apvend
	for ndx from 1 thru 10
	  clear por_apvch[ndx],por_apinvc[ndx],por_apdate[ndx],
	  &	por_apqty[ndx],por_apcost[ndx]
	xcall db_add (work_chan,porecv,por_key,,opcde)
	incr no_records
	return

set_invoice_record,
	por_comp = in_buffer(1:2)
	por_order = in_dbuffer(3:6)
	por_lineno = in_dbuffer(9:3)
	xcall db_read (work_chan,porecv,por_key(1:11),0,'M',,,opcde)
	if (.not.opcde)
	  begin
	    for ndx from 1 thru 10
		if (.not.por_apinvc[ndx]) exitloop
	    if (ndx.le.10)
	      begin
		clear por_apvch[ndx]
		por_apinvc[ndx] = in_buffer(17:8)
		por_apdate[ndx] = in_dbuffer(25:8)
		por_apqty[ndx] = ^d(in_dbuffer(44:9),3)
		por_apcost[ndx] = ^d(in_dbuffer(53:10),2)
		xcall db_update (work_chan,porecv,por_key,,opcde)
	      end
	  end
	return
.end

