open-insight/LSL2/STPROC/DICTTOACAD.txt

COMPILE SUBROUTINE DictToAcad(TableNames)

/*
	Routine to export dictionary information to text file for use in Acad
	
	August 18, 2000 - John C. Henry  - J.C. Henry, Inc. - Copyright 2000
	
*/

DECLARE SUBROUTINE Utility
DECLARE FUNCTION Utility

$INSERT DICT_EQUATES
equ CRLF$       to char(13):char(10)
equ TAB$		TO CHAR(9)

TableCnt = COUNT(TableNames,@VM) + (TableNames NE '')

CurrPath = DRIVE()	;* Returns OI directory so backup one level
CurrPath = FIELD(CurrPath,'\',1,COUNT(CurrPath,'\')):'\ACADTEXT'


DirPath = UTILITY('CHOOSEDIR',@WINDOW,'Directory for Acad Text':@FM:CurrPath)



FOR N = 1 TO TableCnt

	TableName = TableNames<1,N>
	
	FieldData = XLATE('DICT.':TableName,'%FIELDS%','','X')	;* Get the %FIELD% record from the dictionary

	MaxFields = COUNT(FieldData<FIELDS_NAME$>,@VM) + (FieldData<FIELDS_NAME$> NE '')
	PrintLines = ''
	TextLines = ''
	
	Symbolics = ''
	SymTextLines = ''
	SymSort = ''
	FieldSort = ''

	LineCnt = 0
	FOR I = 1 TO MaxFields
		
		FieldName = FieldData<FIELDS_NAME$,I>
		IF FieldName[1,1] NE '%' THEN
			DictRec = XLATE('DICT.':TableName,FieldName,'','X')
			
			FMC				= DictRec<DICT_COLUMN_NO$>
			Part			= DictRec<DICT_PART$>
			Type			= DictRec<DICT_TYPE$>
			Master			= DictRec<DICT_MASTER_FLAG$>
			S_M				= DictRec<DICT_SM$>
			DataType		= DictRec<DICT_GENERIC_TYPE$>
			Desc			= DictRec<DICT_DESC$>
			Conv			= DictRec<DICT_CONV$>
			Length			= DictRec<DICT_LENGTH$>
			Justification	= DictRec<DICT_JUST$>
			
			Formula			= DictRec<DICT_FORMULA$>
			SWAP @VM WITH CRLF$ IN Formula
			
			Btree			= DictRec<DICT_INDEX_FLAG$>
			XrefField		= DictRec<DICT_XREF$>
			RelatedTo		= DictRec<DICT_RELATIONAL$>
			RelatedFrom		= DictRec<DICT_RELATED$>
			Protected		= DictRec<DICT_PROTECT$>
			CaseSensitive	= DictRec<DICT_LOWERCASE$>
			
			IndexData = ''
			
			IF Btree = 1			THEN IndexData := 'Btree':CRLF$
			IF XrefField = 1		THEN IndexData := 'Xref':CRLF$
			IF CaseSensitive = 1	THEN IndexData := 'Case Sensitive':CRLF$
			
			IF RelatedTo NE '' 		THEN IndexData	:= 'Related To: ':RelatedTo:CRLF$
			IF RelatedFrom NE ''	THEN IndexData 	:= 'Related From: ':RelatedFrom:CRLF$
			*IF Protected = 1		THEN IndexData	:= 'Protected'
			
			IF IndexData[-2,2] = CRLF$ THEN IndexData[-2,2] = ''
			
			TextLine = ''
			SymLine = ''
			SymTextLine = ''
			
			IF FieldName[-1,'B4'] NE '_ORG' THEN
			
				IF Type = 'S' THEN
					
					SymLine = ''
					SymLine<1,1> = FieldName
					SymLine<1,2> = DataType
					SymLine<1,3> = S_M
					SymLine<1,4> = Justification
					SymLine<1,5> = Length
					SymLine<1,6> = Conv
					SymLine<1,7> = Formula:CRLF$
					SymLine<1,8> = IndexData
					
					SymTextLine = '   ':@VM:FieldName
					IF S_M[1,1] = 'M' THEN SymTextLine := '(s)'
					
					IF IndexData NE '' THEN SymTextLine := ' --> ':IndexData
					
				END ELSE
					PrintLine = ''
					PrintLine<1,1>	= FMC
					PrintLine<1,2>	= Part
					PrintLine<1,3>	= FieldName
					PrintLine<1,4>	= DataType
					PrintLine<1,5>	= S_M
					PrintLine<1,6>	= Justification
					PrintLine<1,7> 	= Length
					PrintLine<1,8>	= Conv
					PrintLine<1,9>  = Desc:CRLF$
					PrintLine<1,10>  = IndexData
					
					TextLine = '':@VM:FieldName
					IF S_M[1,1] = 'M' THEN TextLine := '(s)'
					IF IndexData NE '' THEN TextLine := ' --> ':IndexData
					
				END
			
					
				IF FMC NE '' THEN
					IF NOT(INDEX(PrintLine,'_ORG',1)) AND NOT(INDEX(PrintLine,'TW_',1)) THEN
						IF FMC = 0 AND Part NE '' THEN FMC := '.':Part
						LOCATE FMC IN FieldSort BY 'AR' USING @FM SETTING POS THEN
							FieldSort = INSERT(FieldSort,POS,0,0,FMC)
						END ELSE
							FieldSort = INSERT(FieldSort,POS,0,0,FMC)
						END
						TextLine<1,1> = FMT(FMC,'R#3')
						TextLines = INSERT(TextLines,POS,0,0,TextLine)
						PrintLines = INSERT(PrintLines,POS,0,0,PrintLine)
					END
					
				END ELSE
					*IF INDEX(SymTextLine,'-->',1) THEN
						LOCATE FieldName IN SymSort USING @FM SETTING POS ELSE
							SymSort = INSERT(SymSort,POS,0,0,FieldName)
						END
						Symbolics = INSERT(Symbolics,POS,0,0,SymLine)
						
						SymTextLines = INSERT(SymTextLines,POS,0,0,SymTextLine)
					*END 
				END ;* End of sorting routine	
			END	;* End of check for "_ORG" 

		END ; * 

	NEXT I
	
	TextLineCnt = COUNT(TextLines,@FM) + (TextLines NE '')
	/*
	IF TextLineCnt > 60 THEN
		TextLines = TableName:@FM:@FM:TextLines
		CONVERT @VM TO ' ' IN TextLines
		SWAP @FM WITH CRLF$ IN TextLines
		FileName = TableName:'.TXT'
		OSWRITE TextLines ON DirPath:'\':FileName
		
		Segment = 1
		LOOP
			TextLines = TableName:@FM:'Symbolics-':Segment:@FM:@FM:FIELD(SymTextLines,@FM,1,TextLineCnt)
			SymTextLines[1,COL2()+1] = ''
			
			CONVERT @VM TO ' ' IN TextLines
			SWAP @FM WITH CRLF$ IN TextLines
			FileName = TableName:Segment:'.TXT'
	
			OSWRITE TextLines ON DirPath:'\':FileName
		UNTIL SymTextLines = ''
			Segment += 1
		REPEAT
	END ELSE
	*/
		TextLines = TableName:@FM:@FM:TextLines:@FM:SymTextLines
		CONVERT @VM TO ',' IN TextLines			;* Excel export
		SWAP @FM WITH CRLF$ IN TextLines
		FileName = TableName:'.TXT'
		OSWRITE TextLines ON DirPath:'\':FileName
	*END
	
NEXT N




RETURN