added LSL2 stored procedures
This commit is contained in:
Infineon\StieberD
281
LSL2/STPROC/PRINT_DICT.txt
Normal file
281
LSL2/STPROC/PRINT_DICT.txt
Normal file
@ -0,0 +1,281 @@
|
||||
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
|
||||
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user