285 lines
6.7 KiB
Plaintext
285 lines
6.7 KiB
Plaintext
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<I,1>:'\par'
|
|
ErrorTxt := '\b0\par'
|
|
|
|
ErrorTxt := '\tab ':ErrorMsgs<I,2>:'\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<I,1>
|
|
ErrorTxt<-1> = ''
|
|
|
|
ErrorTxt<-1> = ErrorMsgs<I,2>
|
|
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
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|