COMPILE FUNCTION DIALOG_ErrMsg(EntID,Event,Parm1,Parm2,Parm3,Parm4,Parm5) /* Commuter module for DIALOG_ERRMSG (Displays error messages) 01/19/2009 - John C. Henry, J.C. Henry & Co., Inc. */ DECLARE SUBROUTINE Set_Property, End_Dialog, Set_Status, Set_Printer, obj_Notes DECLARE SUBROUTINE ErrMsg, Send_Message, Set_Property, Msg DECLARE SUBROUTINE End_Window,Print_Errors, obj_Appwindow DECLARE FUNCTION Get_Property, Get_Status, Dialog_Box, Utility, Popup DECLARE FUNCTION Send_Message, Msg, Printer_Select, Set_Printer, obj_Install, RetStack $INSERT OIPRINT_EQUATES $INSERT APPCOLORS $INSERT MSG_EQUATES $INSERT LOGICAL $INSERT SRPMail_Inserts EQU TAB$ TO \09\ ErrTitle = 'Error in Dialog_ErrMsg commuter module' ErrorMsg = '' Result = '' BEGIN CASE CASE EntID = 'DIALOG_ERRMSG' BEGIN CASE CASE Event = 'CREATE' ; GOSUB Create CASE Event = 'CLOSE' ; GOSUB Close END CASE CASE EntID ='DIALOG_ERRMSG':'.PRINT_BUTTON' AND Event = 'CLICK' ; GOSUB PrintForm CASE EntID ='DIALOG_ERRMSG':'.EMAIL_BUTTON' AND Event = 'CLICK' ; GOSUB EmailForm CASE 1 ErrorMsg = 'Unknown Parameters ':EntID:' - ':Event:' passed to commuter' ErrMsg(ErrorMsg) END CASE IF ErrorMsg NE '' THEN ErrMsg(ErrTitle:@SVM:ErrorMsg) END RETURN Result * * * * * * * Create: * * * * * * * obj_Appwindow('Create',@WINDOW) ErrorMsgs = Parm1 CurrDate = OCONV(Date(),'D4/') CurrTime = OCONV(Time(),'MTH') CurrDTM = CurrDate:' ':CurrTime ErrorTxt = '{\rtf1\ansi\ansicpg1252\deff0\deflang1033{\fonttbl{\f0\fswiss\fcharset0 Arial;}{\f1\fswiss\fprq2\fcharset0 Arial;}}' ErrorTxt := '{\*\generator Msftedit 5.41.15.1515;}\viewkind4\uc1\pard\f0\fs20\par' ErrorTxt := '\pard\qc\b\f1\fs32 Error Report\b0\f0\fs20\par' ErrorTxt := '\pard\par' MsgCnt = COUNT(ErrorMsgs,@FM) + (ErrorMsgs NE '') FOR I = 1 TO MsgCnt ErrorTxt := '\b ':ErrorMsgs:'\par' ErrorTxt := '\b0\par' ErrorTxt := '\tab ':ErrorMsgs:'\par' ErrorTxt := '\par' NEXT I ErrorTxt := '\pard\b ':CurrDTM:'\b0\par' ErrorTxt := '}' Set_Property(@WINDOW:'.ERRORS','RTFTEXT',ErrorTxt) Set_Property(@WINDOW,'@ERROR_MSGS',ErrorMsgs) BriefTxt = '{\rtf1\ansi\ansicpg1252\deff0\deflang1033{\fonttbl{\f0\fswiss\fcharset0 Arial;}}' BriefTxt := '{\*\generator Msftedit 5.41.15.1515;}\viewkind4\uc1\pard\b\f0\fs20\par' BriefTxt := ' Application Error and Reporting\par' BriefTxt := '\b0\pard\par' BriefTxt := ' 1. Please enter a description of what was being done immediately prior' BriefTxt := ' to this error happening.' BriefTxt := '\par 2. The eMail button will send an eMail message to support. You may also print a copy for yourself.\par' BriefTxt := '}' Set_Property(@WINDOW:'.BRIEF_EDITBOX','RTFTEXT',BriefTxt) RETURN * * * * * * * Close: * * * * * * * * End_Dialog(@WINDOW,'') RETURN * * * * * * * PrintForm: * * * * * * * ErrorTitle = 'Error in Stored Procedure "Print_Errors"' AppName = @APPID<1> **START PRINTING PROCESS** *FileName = '' PDFParms = 'Printing PDF Document':@FM: '' :@FM:'':@FM: '' Title = 'Application Error Handler':@VM:'Application Error Listing' PageInfo = 1.0:@FM:1.5:@FM:1.0:@FM:0.6 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('') ;* Select printer without changing default printer stat = Set_Printer("INIT",PDFParms,Title,PageInfo,PageSetup,PrintSetup,PrintPath) font = "Arial" font<2> = "10" font<3> = "L" font<4> = 0 ;* Normal font location = -0.15:@fm:-1.150:@fm:1.57:@fm:1 stat = Set_Printer('BMP',obj_Install('Get_Prop','ColorBMP'),location, 0,1) fontSpacing = 125 stat = Set_Printer("FONT",font,fontspacing) font<4> = 1 ;* Bold font stat = Set_Printer("FONTHEADFOOT",font) header = @VM:'Application Error Message':@VM:"'D' 'T'" header<2> = '' header<3> = '' header<4> = '' stat = Set_Printer("HEADER",header,colLen,colHead,colJust) * Make Column Heading colHead = '' ; colFmt = '' colHead<1,1> = 'Source' ; colFmt<1,1> = '<5000' colHead<1,2> = 'Message' ; colFmt<1,2> = '<7960' colData = Get_Property('DIALOG_ERRMSG','@ERROR_MSGS') font<2> = 10 font<4> = 1 ;* Bold stat = Set_Printer('FONT',font,fontspacing) stat = Set_Printer('ADDTABLE',colFmt,colHead,'',LTGREY$,'',0,TB_ALL) font<4> = 0 stat = Set_Printer('FONT',font,fontSpacing) stat = Set_Printer('ADDTABLE',colFmt,'',colData,LTGREY$,'',0,7) stat = Set_Printer("TEXT") stat = Set_Printer("TEXT") colHead = '' ; colFmt = '' colHead<1,1> = 'Problem Description' ; colFmt<1,1> = '<12960' colData = Get_Property('DIALOG_ERRMSG.PROBLEM_DESC','TEXT') font<2> = 10 font<4> = 1 ;* Bold stat = Set_Printer('FONT',font,fontspacing) stat = Set_Printer('ADDTABLE',colFmt,colHead,'',LTGREY$,'',0,TB_ALL) font<4> = 0 stat = Set_Printer('FONT',font,fontSpacing) stat = Set_Printer('ADDTABLE',colFmt,'',colData,LTGREY$,'',0,7) stat = Set_Printer("TERM",1) RETURN * * * * * * * EmailForm: * * * * * * * ProblemDesc = Get_Property('DIALOG_ERRMSG.PROBLEM_DESC','DEFPROP') IF LEN(ProblemDesc) < 3 THEN Msg(@WINDOW,'','ERROR','','Required Data':@FM:'A problem description is required when reporting via eMail.') RETURN END ErrorMsgs = Get_Property('DIALOG_ERRMSG','@ERROR_MSGS') MsgCnt = COUNT(ErrorMsgs,@FM) + (ErrorMsgs NE '') ErrorTxt = '' FOR I = 1 TO MsgCnt ErrorTxt<-1> = ErrorMsgs ErrorTxt<-1> = '' ErrorTxt<-1> = ErrorMsgs ErrorTxt<-1> = '' NEXT I Text = '' Text<-1> = 'OpenInsight Error Report' Text<-1> = '' Text<-1> = 'Username: ':@USER4 Text<-1> = 'Workstation: ':@STATION Text<-1> = 'Window: ':@WINDOW Text<-1> = 'At ID: ':@ID Text<-1> = 'RetStack: ' Text<-1> = RetStack() Text<-1> = '' Text<-1> = 'Parent Window: ':Get_Property(@WINDOW,'PARENT') Text<-1> = '' Text<-1> = 'Description: ' Text<-1> = ProblemDesc Text<-1> = '' Text<-1> = '' Text<-1> = 'Error Messages:' Text<-1> = '' Text<-1> = ErrorTxt CONVERT \00\ TO ',' IN Text SWAP @VM WITH ':@VM:' IN Text SWAP @FM WITH CHAR(13):CHAR(10) IN Text SWAP @TM WITH CHAR(13):CHAR(10) IN Text Recipients = Xlate('SEC_GROUPS', 'OI_ADMIN', 'USER', 'X') ; SentFrom = 'OI_ERROR' Subject = 'Application Error Reported' Message = Text AttachWindow = '' AttachKey = '' SendToGroup = '' Parms = Recipients:@RM:SentFrom:@RM:Subject:@RM:Message:@RM:AttachWindow:@RM:AttachKey:@RM:SendToGroup obj_Notes('Create',Parms) GOTO Close RETURN