COMPILE SUBROUTINE Export_TSV(TableName,FieldNames,KeyList,DosTable,AutoFlag)


* 9/22/2006 John C. Henry - J.C. Henry & Co., Inc. - Initial Coding

DECLARE SUBROUTINE RList, Msg, ErrMsg, Yield, Send_Info
DECLARE FUNCTION Msg, obj_Part, Environment_Services

$Insert LOGICAL
$INSERT MSG_EQUATES
$INSERT DICT_EQUATES

EQU CRLF$	TO \0D0A\
EQU CR$		TO \0D\
EQU TAB$	TO \09\

If Assigned(AutoFlag) else AutoFlag = False$
If AutoFlag EQ True$ else AutoFlag = False$

DosTableName = DosTable[1,'.']

DosTable = DosTableName:'.tsv'
IF DosTable[2,1] NE ':' THEN
* 	DosTable = 'C:\OIReports\':DosTable
    DosTable = Environment_Services('GetReportsRootPath') : '\':DosTable
END

OPEN TableName TO TableVar ELSE
	ErrorMsg = 'Unable to open ':TableName:' table in Export_TSV routine'
	If Not(AutoFlag) then ErrMsg(ErrorMsg)
	RETURN
END

OPEN 'DICT.':TableName TO @DICT ELSE
	ErrorMsg = 'Unable to open DICT.':TableName:' table in Export_TSV routine.'
	If Not(AutoFlag) then ErrMsg(ErrorMsg)
	RETURN
END

DataOut = ''

OSOPEN DosTable TO DOSFile THEN
	OSWrite DataOut ON DosTable			;* Clear file it was already there
END ELSE
	OSWrite DataOut ON DosTable			;* Create the file if it wasn't
	OSOPEN DosTable TO DOSFile ELSE
		ErrorMsg = "Unable to open ":QUOTE(DosTable):" in Export_TSV routine."
		RETURN
	END
END  

READ Fields FROM @DICT,'%FIELDS%' ELSE
	ErrorMsg = 'Unable to read %FIELDS% from DICT.':TableName:' in Export_TSV routine.'
	RETURN
END

FilePointer = 0

Def = ''
Def<MTEXT$> = 'Exporting ':TableName:' Data...'
Def<MTYPE$>	= 'U'

If Not(AutoFlag) then MsgUp = Msg(@WINDOW,Def)

HeaderOut = ''

FOR I = 1 TO COUNT(FieldNames,@VM) + (FieldNames NE '')
	FieldName = FieldNames<1,I>
	READV FieldHeader FROM @DICT,FieldName,DICT_DISPLAY$ THEN
		HeaderOut := QUOTE(FieldHeader):TAB$
	END
NEXT I

HeaderOut[-1,1] = ''
HeaderOut := CRLF$

OSBWrite HeaderOut ON DOSFile AT FilePointer
FilePointer += LEN(HeaderOut)

DataOut = ''
FOR I = 1 TO COUNT(KeyList,@VM) + (KeyList NE '')
	@ID = KeyList<1,I>
	READ @RECORD FROM TableVar,@ID THEN
	
		FOR N = 1 TO COUNT(FieldNames,@VM) + (FieldNames NE '')
			FieldName = FieldNames<1,N>
			LOCATE FieldName IN Fields<FIELDS_NAME$> USING @VM SETTING Pos THEN
				FType	= Fields<FIELDS_TYPE$,Pos>
				FNo		= Fields<FIELDS_FIELD_NO$,Pos>
				FMV		= Fields<FIELDS_MVFLAG$,Pos>
				FPart	= Fields<FIELDS_PART$,Pos>
				FJust	= Fields<FIELDS_JUST$,Pos>
				FConv	= Fields<FIELDS_CONV$,Pos>
				
				
				IF FNo[1,1] = 0 THEN
					* @ID field
					DataVal = FIELD(@ID,'*',FPart,1)
				END ELSE
					IF FType = 'F' THEN DataVal = @RECORD<FNo>
					IF FType = 'S' THEN
						DataVal = Calculate(FieldName)
					END
				END
 				IF FConv NE '' THEN DataVal = OCONV(DataVal,FConv)
 				
 				DataOut := QUOTE(DataVal):TAB$
 				
 			END
 				
		
		NEXT N
		
		DataOut[-1,1] = ''
		DataOut := CRLF$
		
		IF LEN(DataOut) > 32000 THEN
			OSBWrite DataOut ON DOSFile AT FilePointer
			FilePointer += LEN(DataOut)
			DataOut = ''
		END		
	END
	YIELD()
	
NEXT I

OSBWrite DataOut ON DOSFile AT FilePointer

If Not(AutoFlag) then Msg(@WINDOW,MsgUp)


Def = ''
Def<MTEXT$> = 'File ':DosTable:' written.'
Def<MTYPE$>	= 'TA3'

If Not(AutoFlag) then MsgUp = Msg(@WINDOW,Def)

OSClose DOSFile

RETURN