A Form Script Debugging System in MetaVision

Debugging vbscript that resides in forms in MetaVision is problematic. Runtime exceptions are often thrown without even the right message. I have, therefore, developped a debugging system that can be used in vbscripts in MetaVision to track function calls and provide information of scripting flow and runtime info.

The following script has to be added to a form:

Private Function Debug(strMsg)

If Not Scripts.CurrentUserType = "Beheerders" Then Exit Function

' Set environment variables
strFormName  = "MS Afspraken" ' Aanpassen per formulier
intPatientId = Scripts.CurrentPatientId
' Debug parameters aanpassen per database
intDebugLevelParamId = 12438 'Debug Level Debug parameter Id
intDebugFileParamId  = 12446 'Debug File Location Parameter to give optional file location
intDebugTagParamId   = 12445 'Debug Tag Parameter to add a tag to debug msg
' Debug levels
intLevelDebug   = 0
intLevelOff     = 1
intLevelSilent  = 2
intLevelMessage = 3
' Get Debug level
strSql = strSql & "Select TextId From TextSignals Where ParameterId = "
strSql = strSql & intDebugLevelParamId & " " 
If intPatientId > 0 Then strSql = strSql & "And PatientId = " & intPatientId & " "
strSql = strSql & "Order By ValidationTime Desc"
Set objRecordSet = Scripts.ExecuteStatement(strSql)
If Not objRecordSet.EOF Then intDebugLevel = objRecordSet.Fields("TextId").Value

If intDebugLevel > intLevelOff Then 
 strFileLocation = ""
 strDebugTag     = ""
 ' Get Debug file location
 If intDebugFileParamId > 0 Then
  strSql = "Select Value From FreeTextSignals "
  strSql = strSql & "Where ParameterId = " & intDebugFileParamId & " " 
  If intPatientId > 0 Then strSql = strSql & "And PatientId = " & intPatientId & " "
  strSql = strSql & "Order By ValidationTime Desc"
  Set objRecordSet = Scripts.ExecuteStatement(strSql)
  If Not objRecordSet.EOF Then strFileLocation = objRecordSet.Fields("Value").Value
 End IF
 ' Get Debug tag
 If intDebugTagParamId > 0 Then
  strSql = "Select Value From FreeTextSignals "
  strSql = strSql & "Where ParameterId = " & intDebugTagParamId & " " 
  If intPatientId > 0 Then strSql = strSql & "And PatientId = " & intPatientId & " "
  strSql = strSql & "Order By ValidationTime Desc"
  Set objRecordSet = Scripts.ExecuteStatement(strSql)
  If Not objRecordSet.EOF Then strDebugTag = objRecordSet.Fields("Value").Value
 End IF
  
 If intDebugLevel = intLevelMessage Then Scripts.MsgBox strMsg
 
 intForReading   = 1
 intForWriting   = 2
 intForAppending = 8 
 
 Set objFileSys = CreateObject("Scripting.FileSystemObject")
 If strFileLocation = "" Then strPath = "C:\mvlog.txt" Else strPath = strFileLocation
 
 If objFileSys.FileExists(strPath) Then
  If strDebugTag <> "" Then strLogText = strDebugTag & " "
  strLogText = strLogText & Now & ": " 
  strLogText = strLogText & strFormName & ", " 
  strLogText = strLogText & "Session: " & Scripts.CurrentSessionID & ", "
  strLogText = strLogText & Cstr(strMsg) & vbNewLine 

  Set objLogFile = objFileSys.OpenTextFile(strPath, intForAppending, True) 
  objLogFile.WriteLine(strLogText)
  objLogFile.Close
 End IF
End IF
End Function

First of all I have to apology for the length of the above function. This function is 65 lines! Normally, I try to keep function as simple as possible, let them do just one thing which typically results in function of about 10 lines max. But by putting everything an a single function it is easier to copy and paste (also ugly) this function in forms I need debugging.

The result is that at runtime I can start and/or change debugging for a particular patient in MetaVision. I can even debug the form in the formbuilder! This will look something like:

An Example of Debug level set to Message

In order to set the debug level for a particular patient there needs to be a 'Debug form' like:

The Debug Form

In my next blog entry I will go into more detail of how the debug function works