COMPILE SUBROUTINE Print_RootCause_Analysis(ReactORLogNo,ReactNo,InitProbCat) /* Print Root Cause analysis for Reactor and Problem Category 07/08/2015 - 6 month history of REACTOR_LOG records for specified Reactor and Problem Category */ DECLARE SUBROUTINE Reduce,MSG,Utility,ErrMsg, Set_Status, Btree.Extract, RList, Make.List DECLARE FUNCTION Set_Printer,Get_Printer,Msg, Get_Status, Dialog_Box, obj_Install DECLARE FUNCTION FieldCount,Get_Status,Set_Status,Set_FSError,Printer_Select $INSERT OIPRINT_EQUATES $INSERT REACTOR_LOG_EQUATES $INSERT APPCOLORS EQU CRLF TO \0D0A\ ;* CHAR(13):CHAR(10) for multiline messages EQU TAB TO CHAR(9) ;* TAB character ErrorTitle = 'Error in Store Procedure Print_RootCause_Analysis' IF ReactorLogNo = '' THEN RETURN IF ReactNo = '' OR InitProbCat = '' THEN CurrReactLogRec = XLATE('REACTOR_LOG',ReactorLogNo,'','X') ReactNo = CurrReactLogRec InitProbCat = CurrReactLogRec END OPEN 'REACTOR_LOG' TO ReactorLogTable ELSE ErrorMsg = 'Unable to Open "REACTOR_LOG" table!' Set_Status(1,ErrorTitle:@SVM:ErrorMsg) RETURN END OPEN 'DICT.REACTOR_LOG' TO @DICT ELSE ErrorMsg = 'Unable to Open "DICT.REACTOR_LOG" table!' Set_Status(1,ErrorTitle:@SVM:ErrorMsg) RETURN END StartDt = OCONV(Date() - 182,'D4\') SelectSent = 'SELECT REACTOR_LOG WITH REACTOR = ':QUOTE(ReactNo):' AND WITH ENTRY_DATE > ':QUOTE(StartDt):' AND WITH REACT_PROB_CAT_ID CONTAINS ':QUOTE(InitProbCat) HeaderDateLine = 'Entry Dates since ':StartDt Set_Status(0) EQU TARGET_ACTIVELIST$ TO 5 RList(SelectSent, TARGET_ACTIVELIST$, "", "", "") IF Get_Status(errCode) THEN ErrMsg(errCode) RETURN END **START PRINTING PROCESS** FileName = 'Print Root Cause Analysis' Title = 'Printing Root Cause Analysis':@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 = '' PrintSetup<1,1> = '2' ;* Preview Normal PrintSetup<1,2> = '5' ;* Display all buttons except Printer Setup PrintSetup<1,3> = '0' ;* Display Printing Window PrintSetup<1,6> = '7' ;* Preview window - keyboard and mouse support PrintPath = Printer_Select('',1) ;* Get Default printer path PDFParms = FileName:@FM: '' :@FM:'':@FM: '' stat = Set_Printer("INIT",FileName,Title,Margins,PageSetup,PrintSetup,PrintPath) IF stat < 0 THEN GOTO OIPrint_Err Header = @VM:obj_Install('Get_Prop','CompTitle'):' Root Cause Analysis Report' Header<2> = @VM:HeaderDateLine 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) @RECCOUNT = 0 FirstPass = 1 LastRecord = 0 ReadErr = 0 FirstLine = 1 * * * * * * * READRECORD: * * * * * * * READNEXT @ID ELSE LastRecord = 1 END IF FirstPass AND LastRecord THEN GOTO Bail END READO @RECORD FROM ReactorLogTable,@ID ELSE stat = Set_Printer('TEXT', 'Unable to read record ':QUOTE(@ID):' from REACTOR_LOG table.') GOTO READRECORD END @RECCOUNT += 1 ReactLogNo = @ID ReactNo = @RECORD StartDt = OCONV(@RECORD,'D4/') ProbCatDesc = {REACT_PROB_CAT_DESC}<1,1> Service = {REACT_SERV_DESC}<1,1> TechSig = {TECH_SIG_NAME} Notes = @RECORD colHeader = 'RL No' ; colFmt = '<+900' colHeader<1,2> = 'React No' ; colFmt<1,2> = '^+900' colHeader<1,3> = 'Start Date' ; colFmt<1,3> = '^+1260' colHeader<1,4> = 'Problem Category' ; colFmt<1,4> = '<+2160' colHeader<1,5> = 'Service' ; colFmt<1,5> = '^+2160' colHeader<1,6> = 'Technician' ; colFmt<1,6> = '^+1260' colHeader<1,7> = 'Notes' ; colFmt<1,7> = '^+4320' colData = ReactLogNo colData<1,2> = ReactNo colData<1,3> = StartDt colData<1,4> = ProbCatDesc colData<1,5> = Service colData<1,6> = TechSig colData<1,7> = Notes fontSpacing = 120 GOSUB PrintTable IF LastRecord THEN GOTO Bail END * * * * * * * DETAIL: * * * * * * * GOTO READRECORD * * * * * * Bail: * * * * * * stat = Set_Printer("TERM",1) ;* Terminiate this printing session IF stat < 0 THEN GOTO OIPrint_Err Utility('CURSOR','A') RETURN * * * * * * * OIPrint_Err: * * * * * * * *Set Error for OIPrint function and return to calling procedure Msg('',stat) Error_Msg = 'Set_Printer Returned Error Status: ':QUOTE(stat) IF Get_Status(errCode) THEN Stat = Set_Status(-1,'STPROC',ErrorTitle:@SVM:Error_Msg) END ELSE Stat = Set_Status(1,'STPROC',ErrorTitle:@SVM:Error_Msg) END stat = Set_Printer('TERM',1) RETURN * * * * * * 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> = 10 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> = 10 font<4> = 0 stat = Set_Printer('FONT',font,fontSpacing) stat = Set_Printer('ADDTABLE',colFmt,'',colData,LTGREY$,'',1,TB_ALL) END RETURN