added LSL2 stored procedures

LSL2/STPROC/EXPORT_TSV.txt

@@ -0,0 +1,145 @@
+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
+
+
+
+
+