COMPILE SUBROUTINE Print_Dict(TableNames)

/*
	Routine to print dictionary listing
	
	October 12, 1998 - John C. Henry  - J.C. Henry, Inc. - Copyright 1998
	
*/

DECLARE SUBROUTINE Utility
DECLARE FUNCTION Get_Printer, Set_Printer, RGB, Printer_Select

$INSERT DICT_EQUATES
$INSERT OIPRINT_EQUATES
$INSERT FONT_PARM

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


* * *   PRINT SETUP   * * *

Title       = "Dictionary Listing"
Margin		=  0.50:@FM:1.0:@FM:0.50:@FM:0.7:@FM:@FM:@FM:LETTER

SWAP @VM WITH ', ' IN TableNames

PrintPath = Printer_Select()

PrintSetup      = 2		;* Preview Normal
PrintSetup<1,2> = 0		;* Display all buttons
PrintSetup<1,5> = 1		;* Page range dialog box

stat = Set_Printer("INIT",TableNames,Title,Margin,1,PrintSetup,PrintPath)

SWAP ', ' WITH @VM IN TableNames

IF stat < 0 THEN GOTO OIPrint_Err

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 = ''

	Symbolics = ''
	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$>
			Display			= DictRec<DICT_DISPLAY$>
			
			IF Display NE '' THEN
				FieldName := CRLF$:'(':Display:')'
			END
			
			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] = ''
			
			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
			END
			IF Type = 'F' THEN
				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
			END
			IF Type = 'G' THEN
				debug
			END
			
			IF FMC NE '' 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
				PrintLines = INSERT(PrintLines,POS,0,0,PrintLine)
				
			END
			IF Type = 'S' 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)
			END ;* End of sorting routine	

		END ; * 

	NEXT I

	*SWAP @FM WITH @FM:@VM:@VM:@VM:@VM:@FM IN Symbolics	;* Inserts blank lines between items


	***FONTS***

	FONT = 'Arial'
	FONT<F_POINTSIZE$> = '9'
	FONT<F_JUST$>	   = 'L'
	FONT<F_BOLD$>      =  FW_BOLD

	stat = Set_Printer("FONTHEADFOOT", FONT)
	IF stat < 0 THEN GOTO OIPrint_Err

	FONT<F_BOLD$> 	   = FW_NORMAL
	FONT<F_POINTSIZE$> = '8'			
	spacing 	       = '100'
	stat = Set_Printer("FONT", FONT, spacing)
	IF stat < 0 THEN GOTO OIPrint_Err


	footer    = "Page:'P' - 'D' 'T'"
	colfooter = " "

	colHead = ''					;colFmt = ''
	colHead<1,1>	= "FMC"			;colFmt<1,1> = '~>550'
	colHead<1,2>	= "Part"		;colFmt<1,2> = '~<500'
	colHead<1,3>	= "Field Name"	;colFmt<1,3> = '~<2380'
	colHead<1,4>	= "Data Type"	;colFmt<1,4> = '~1600'
	colHead<1,5>	= "S/M"			;colFmt<1,5> = '~^500'
	colHead<1,6>	= "Just"		;colFmt<1,6> = '~^500'
	colHead<1,7>	= "Lgth"		;colFmt<1,7> = '^500'
	colHead<1,8>	= "OConv"		;colFmt<1,8>= '<1440'
	colHead<1,9>	= "Description"	;colFmt<1,9> = '2880'
	colHead<1,10>	= "Indexes"		;colFmt<1,10> = '2880'
	
	

	***HEADER & FOOTER***

	header    = @VM:"Dictionary Listing for ":TableName:" in Application ":@APPID<1>
	header<2> = ""

	stat = Set_Printer("HEADER", header,'','','')
	stat = Set_Printer("FOOTER",footer,colfooter)
	IF stat < 0 THEN GOTO OIPrint_Err
	
	PageBreak = 1
	
	FOR I = 1 TO COUNT(PrintLines,@FM) + (PrintLines NE '')
		stat = Set_Printer('CALCTABLE',colFmt:@FM:PrintLines<I>)
		TableSize = Get_Printer('CALCTABLE')
		TableHeight = TableSize<2>

		Test = Get_Printer('POS')<2>
		IF Get_Printer('POS')<2> + TableHeight > 6.75 THEN
			PageBreak = 1
			stat = Set_Printer('PAGEBREAK')
		END
		
		IF PageBreak THEN
			stat = Set_Printer('ADDTABLE',colFmt,colHead,PrintLines<I>,RGB(192,192,192),'',0,TB_ALL)
			PageBreak = 0
		END ELSE
			stat = Set_Printer('ADDTABLE',colFmt,'',PrintLines<I>,RGB(192,192,192),'',1,TB_ALL)
		END
		
	NEXT I

	IF stat < 0 THEN GOTO OIPrint_Err

	 stat = Set_Printer("PAGEBREAK")	

	colHead		 = "Field Name"	;colFmt  	 = '~<2380'
	colHead<1,2> = "Data Type"	;colFmt<1,2> = '~1600'
	colHead<1,3> = "S/M"		;colFmt<1,3> = '~^500'
	colHead<1,4> = "Just"		;colFmt<1,4> = "~^500"
	colHead<1,5> = "Lgth"		;colFmt<1,5> = '^500'
	colHead<1,6> = "OConv"		;colFmt<1,6> = "<1500"
	colHead<1,7> = "Formula"	;colFmt<1,7> = '<4800'
	colHead<1,8> = "Indexes"	;colFmt<1,8> = '2880'


	header    = @VM:"Symbolic Dictionary Item Listing for ":TableName:" in Application ":@APPID<1>
	header<2> = ""

	stat = Set_Printer("CONTROL", -1:@FM:1)
	stat = Set_Printer("HEADER", header,'','','')
	stat = Set_Printer("FOOTER",footer,colfooter)
	IF stat < 0 THEN GOTO OIPrint_Err
	
	PageBreak = 1
	
	FOR I = 1 TO COUNT(Symbolics,@FM) + (Symbolics NE '')
		stat = Set_Printer('CALCTABLE',colFmt:@FM:Symbolics<I>)
		TableSize = Get_Printer('CALCTABLE')
		TableHeight = TableSize<2>
		IF Get_Printer('POS')<2> + TableHeight > 6.75 THEN
			PageBreak = 1
			stat = Set_Printer('PAGEBREAK')
		END
		
		IF PageBreak THEN
			stat = Set_Printer('ADDTABLE',colFmt,colHead,Symbolics<I>,RGB(192,192,192),'',0,TB_ALL)
			PageBreak = 0
		END ELSE
			stat = Set_Printer('ADDTABLE',colFmt,'',Symbolics<I>,RGB(192,192,192),'',1,TB_ALL)
		END
		
	NEXT I
	
	IF stat < 0 THEN GOTO OIPrint_Err
	
NEXT N


* Terminate this printing session. *

stat = Set_Printer('TERM')

RETURN

OIPrint_Err:

UTILITY("CURSOR","A")

/* Set Error for OIPrint function and return to calling procedure */

stat = Set_Printer('TERM')

RETURN