COMPILE ROUTINE FIND_DB_REFERENCE(SearchString) ROWDEF(CHARSTR) DECLARE FUNCTION UTILITY, Get_Repos_Entities, Printer_Select, Set_Printer, Get_Printer, Obj_Install DECLARE SUBROUTINE Send_Info, Send_Dyn, ErrMsg, $INSERT DICT_EQUATES $INSERT APPCOLORS EQU CRLF$ TO \0D0A\ EQU TAB$ TO \09\ /* References = 'RDS_TEST_READ_THICK$':@VM References := 'RDS_TEST_READ_SHEET_RHO$':@VM References := 'RDS_TEST_READ_RES$' */ References = 'Deprecated' EntityNames = '' EntityReferences = '' RefCnt = COUNT(References,@VM) + (References NE '') PrintData = '' FOR Ref = 1 TO RefCnt SearchString = References<1,Ref> Send_Info(Ref:' ':SearchString) PrintData<-1> = SearchString GOSUB Search PrintData<-1> = Result NEXT Ref *********************** **START PRINTING PROCESS** FileName = 'Print Ready To Ship' Title = 'Printing Ready To Ship':@VM:'Report' TopMargin = 1.0 BottomMargin = 1.0 LeftMargin = 0.5 RightMargin = 0.5 Margins = LeftMargin:@FM:TopMargin:@FM:RightMargin:@FM:BottomMargin PageSetup = '1' ;* Portrait PrintSetup = '2' ;* Preview Normal PrintSetup<1,2> = 5 ;* Print & PDF buttons PrintSetup<1,5> = 1 ;* Page Range Dialog PrintPath = Printer_Select('',1) ;* Get Default printer path stat = Set_Printer("INIT",FileName,Title,Margins,PageSetup,PrintSetup,PrintPath) IF stat < 0 THEN GOTO OIPrint_Err Header = @VM:obj_Install('Get_Prop','CompTitle'):' Active Part Master' Header<2> = @VM Header<3> = '' font = 'Arial' font<2> = '10' font<4> = 1 ;* Bold stat = Set_Printer("FONTHEADFOOT", font) stat = Set_Printer("HEADER",Header) footer = " 'D' 'T'":@VM:@VM:" Page: 'P'" colfooter = " " stat = Set_Printer("FOOTER",footer,colfooter) colHeader = 'Part No' ; colFmt = '^+1080' colHeader<1,2> = 'Description' ; colFmt<1,2> = '<+2160' colHeader<1,3> = 'PSN ID' ; colFmt<1,3> = '^+1080' *colHeader<1,4> = 'Step' ; *colFmt<1,4> = '^+540' *colHeader<1,5> = 'Step PSN' ; *colFmt<1,5> = '^+720' *colHeader<1,6> = 'Step Desc' ; *colFmt<1,6> = '<+1440' colHeader<1,4> = 'Cust No' ; colFmt<1,4> = '^+720' colHeader<1,5> = 'Customer' ; colFmt<1,5> = '<+4600' colHeader<1,6> = 'Cust Part No' ; colFmt<1,6> = '^+1800' colHeader<1,7> = 'Cust Part Desc' ; colFmt<1,7> = '<+1800' colHeader<1,8> = 'Sub Part No' ; colFmt<1,8> = '^+1440' fontSpacing = 100 ****** colData = PartNo colData<1,2> = Desc colData<1,3> = S.PSNId *colData<1,4> = ProcStepNo *colData<1,5> = ProcStepPSN *colData<1,6> = ProcStepDesc colData<1,4> = CustNo colData<1,5> = CustName colData<1,6> = CustPartNo colData<1,7> = CustPartDesc colData<1,8> = SubPartNo ****** * * * * * * PrintTable: * * * * * * stat = Set_Printer('CALCTABLE',colFmt:@FM:colData) TableSize = Get_Printer('CALCTABLE') TableHeight = TableSize<2> Test = Get_Printer('POS')<2> IF Get_Printer('POS')<2> + TableHeight > 6.50 OR FirstLine THEN IF NOT(FirstLine) THEN stat = Set_Printer('PAGEBREAK') END FirstLine = 0 font<2> = 8 font<4> = 1 ;* Bold stat = Set_Printer('FONT',font,'100') stat = Set_Printer('ADDTABLE',colFmt,colHeader,'',LTGREY$,'',0,TB_ALL) font<4> = 0 stat = Set_Printer('FONT',font,fontSpacing) stat = Set_Printer('ADDTABLE',colFmt,'',colData,LTGREY$,'',0,7) END ELSE font<2> = 8 font<4> = 0 stat = Set_Printer('FONT',font,fontSpacing) stat = Set_Printer('ADDTABLE',colFmt,'',colData,LTGREY$,'',1,TB_ALL) END *********************** DEBUG GOTO Bail * * * * * * Search: * * * * * * CONVERT @LOWER_CASE TO @UPPER_CASE IN SearchString Result = '' OPEN 'SYSPROCS' TO ProcsTable THEN SELECT ProcsTable Done = 0 LOOP READNEXT @ID ELSE Done = 1 UNTIL Done READ Record FROM ProcsTable,@ID THEN CONVERT @LOWER_CASE TO @UPPER_CASE IN Record LineCnt = COUNT(Record,@FM) + (Record NE '') FOR Line = 1 TO LineCnt RecLine = Record IF INDEX(RecLine,SearchString,1) THEN CONVERT TAB$ TO ' ' IN RecLine Result<-1> = 'Stored Procedure':@VM:@ID[1,'*']:@VM:Line:@VM:TRIM(RecLine) END NEXT Line END REPEAT END OPEN 'SYSREPOSEVENTS' TO ProcsTable THEN SELECT ProcsTable Done = 0 LOOP READNEXT @ID ELSE Done = 1 UNTIL Done READ Record FROM ProcsTable,@ID THEN CONVERT @LOWER_CASE TO @UPPER_CASE IN Record LineCnt = COUNT(Record,@FM) + (Record NE '') FOR Line = 1 TO LineCnt RecLine = Record IF INDEX(RecLine,SearchString,1) THEN CONVERT TAB$ TO ' ' IN RecLine Result<-1> = 'Event':@VM:@ID[1,'*']:@VM:Line:@VM:TRIM(RecLine) END NEXT Line END REPEAT END DictTables = '' OPEN 'SYSTABLES' TO TableTable THEN SELECT TableTable Done = 0 LOOP READNEXT TableName ELSE Done = 1 UNTIL Done IF TableName[1,5] = 'DICT.' THEN DictTables<1,-1> = TableName END ;* End of check for dictionary filename REPEAT END DictCnt = COUNT(DictTables,@VM) + (DictTables NE '') FOR I = 1 TO DictCnt DictTable = DictTables<1,I> OPEN DictTable TO ActiveDict THEN SELECT ActiveDict Done = 0 LOOP READNEXT DictKey ELSE Done =1 UNTIL Done READ DictRec FROM ActiveDict,DictKey THEN IF DictRec = 'S' THEN Formula = DictRec Desc = DictRec IF INDEX(Desc,SearchString,1) THEN Result<-1> = DictTable:@VM:DictKey:@VM:1:@VM:TRIM(Desc) END CONVERT @LOWER_CASE TO @UPPER_CASE IN Formula LineCnt = COUNT(Formula,@VM) + (Formula NE '') FOR Line = 1 TO LineCnt RecLine = Formula<1,Line> IF INDEX(RecLine,SearchString,1) THEN CONVERT TAB$ TO ' ' IN RecLine Result<-1> = DictTable:@VM:DictKey:@VM:Line:@VM:TRIM(RecLine) END NEXT Line END END ;* End of DictRec Read REPEAT END ;* End of ActiveDict Open NEXT I RETURN * * * * * * * OIPrint_Err: * * * * * * * ErrMsg(ErrorTitle:@SVM:ErrorMsg) ErrMsg(ErrorTitle:@SVM:'Set_Printer returned errorcode ':stat) stat = Set_Printer('TERM',1) * * * * * * * Bail: * * * * * * * END