" & VBCrLf
rsDynamicForms.Close
Set rsDynamicForms = Nothing
End If
ManageDynamicFormAdministration = strHTML
If err.number <> 0 Then
Call ReportError("ManageDynamicFormAdministration", err.number, err.description)
End If
On Error Goto 0
End Function
Function GetJavascriptFormNameArray()
On Error Resume Next
Dim strHTML
Dim rsDynamicForms
Dim intDynamicFormId
Dim strDynamicFormName_en
Set rsDynamicForms = GetAllDynamicForms()
If rsDynamicForms.EOF = False Then
strHTML = ""
Do Until rsDynamicForms.EOF
strDynamicFormName_en = EncodeNonNull(rsDynamicForms("DYNAMIC_FORM_NAME_EN"))
If strHTML = "" Then
strHTML = "var formNames = new Array(""" & Trim(strDynamicFormName_en) & """"
Else
strHTML = strHTML & ", """ & Trim(strDynamicFormName_en) & """"
End If
rsDynamicForms.MoveNext
Loop
strHTML = strHTML & ");" & VBCrLf
rsDynamicForms.Close
Set rsDynamicForms = Nothing
Else
strHTML = "var formNames = new Array();"
End If
GetJavascriptFormNameArray = strHTML
If err.number <> 0 Then
Call ReportError("GetJavascriptFormNameArray", err.number, err.description)
End If
On Error Goto 0
End Function
Function GetJavascriptElementNameArray(intDynamicFormId, strLang)
On Error Resume Next
Dim strHTML
Dim rsFormElements
Dim intFormElementId
Dim strFormElementName
Set rsFormElements = GetFormElements(intDynamicFormId)
If rsFormElements.EOF = False Then
strHTML = ""
Do Until rsFormElements.EOF
If strLang = "en" Then
strFormElementName = rsFormElements("FORM_ELEMENT_NAME_EN")
Else
strFormElementName = rsFormElements("FORM_ELEMENT_NAME_FR")
End If
If strHTML = "" Then
strHTML = """" & Trim(strFormElementName) & """"
Else
strHTML = strHTML & ", """ & Trim(strFormElementName) & """"
End If
rsFormElements.MoveNext
Loop
rsFormElements.Close
Set rsFormElements = Nothing
End If
GetJavascriptElementNameArray = strHTML
If err.number <> 0 Then
Call ReportError("GetJavascriptElementNameArray", err.number, err.description)
End If
On Error Goto 0
End Function
Function GetDynamicFormName(intDynamicFormId)
On Error Resume Next
Dim cmd
Set cmd = Server.CreateObject("ADODB.Command")
Set cmd.ActiveConnection = conn
cmd.CommandText = "SP_GET_DYNAMIC_FORM_NAME"
cmd.CommandType = adCmdStoredProc
cmd.Parameters.Append cmd.CreateParameter("DYNAMIC_FORM_ID", adInteger, adParamInput,,intDynamicFormId)
cmd.Parameters.Append cmd.CreateParameter("DYNAMIC_FORM_NAME_EN", adVarchar, adParamOutput, 250)
cmd.execute
GetDynamicFormName = cmd.Parameters("DYNAMIC_FORM_NAME_EN")
Set cmd = Nothing
If err.number <> 0 Then
Call ReportError("GetDynamicFormName", err.number, err.description)
End If
On Error Goto 0
End Function
Function GetDynamicFormsHighestElementSortOrder(intDynamicFormId)
On Error Resume Next
Dim cmd
Set cmd = Server.CreateObject("ADODB.Command")
Set cmd.ActiveConnection = conn
cmd.CommandText = "SP_GET_DYNAMIC_FORM_HIGHEST_SORT_ORDER"
cmd.CommandType = adCmdStoredProc
cmd.Parameters.Append cmd.CreateParameter("DYNAMIC_FORM_ID", adInteger, adParamInput,,intDynamicFormId)
cmd.Parameters.Append cmd.CreateParameter("DYNAMIC_FORM_HIGHEST_SORT_ORDER", adInteger, adParamOutput)
cmd.execute
GetDynamicFormsHighestElementSortOrder = cmd.Parameters("DYNAMIC_FORM_HIGHEST_SORT_ORDER")
Set cmd = Nothing
If err.number <> 0 Then
Call ReportError("GetDynamicFormsHighestElementSortOrder", err.number, err.description)
End If
On Error Goto 0
End Function
Function GetMaxPossibleAnswerCount(intDynamicFormId)
On Error Resume Next
Dim cmd
Set cmd = Server.CreateObject("ADODB.Command")
Set cmd.ActiveConnection = conn
cmd.CommandText = "SP_GET_DYNAMIC_FORM_MAX_POSSIBLE_ANSWERS"
cmd.CommandType = adCmdStoredProc
cmd.Parameters.Append cmd.CreateParameter("DYNAMIC_FORM_ID", adInteger, adParamInput,,intDynamicFormId)
cmd.Parameters.Append cmd.CreateParameter("DYNAMIC_FORM_MAX_POSSIBLE_ANSWERS", adInteger, adParamOutput)
cmd.execute
GetMaxPossibleAnswerCount = cmd.Parameters("DYNAMIC_FORM_MAX_POSSIBLE_ANSWERS")
Set cmd = Nothing
If err.number <> 0 Then
Call ReportError("GetMaxPossibleAnswerCount", err.number, err.description)
End If
On Error Goto 0
End Function
Function ManagePossibleAnswers(intMaxPossibleAnswerCount, intFieldId, bolSubmitToExternalForm, intDateType)
On Error Resume Next
Dim strHTML
Dim intAnswerCounter
Dim rsPossibleAnswers
Dim bolDisplayRecordset
strHTML = ""
bolDisplayRecordset = False
If intFieldId > 0 Then
Set rsPossibleAnswers = GetPossibleAnswers(intFieldId)
If rsPossibleAnswers.Eof = False Then
bolDisplayRecordset = True
End If
End If
If bolDisplayRecordset Then
intAnswerCounter = 0
Do Until rsPossibleAnswers.Eof
intAnswerCounter = intAnswerCounter + 1
strHTML = strHTML & "
" & VBCrLf
If intDataType = 2 Then
Dim strDateString
strDateString = rsPossibleAnswers("POSSIBLE_ANSWER_VALUE_EN")
If strDateString <> "" And Not IsNull(strDateString) Then
strDateString = SimpleDate(rsPossibleAnswers("POSSIBLE_ANSWER_VALUE_EN"))
End If
strHTML = strHTML & "" & VBCrLf
Else
strHTML = strHTML & "" & VBCrLf
End If
strHTML = strHTML & "
" & VBCrLf
strHTML = strHTML & "
" & VBCrLf
rsPossibleAnswers.MoveNext
Loop
rsPossibleAnswers.Close
If (intMaxPossibleAnswerCount > intAnswerCounter) Then
Dim intEmptyPossibleAnswerFieldCounter
For intEmptyPossibleAnswerFieldCounter = (intAnswerCounter + 1) To intMaxPossibleAnswerCount
strHTML = strHTML & "
" & VBCrLf
Next
End If
Else'at this point the recordset was either empty or the user did not select to edit an element of type 'field'
For intAnswerCounter = 1 To intMaxPossibleAnswerCount
strHTML = strHTML & "
" & _
"" & _
"" & _
"" & _
""
If bolThisPageIsBeingDisplayedOnAdminSide Then
strHTML_EN = strHTML_EN & ""
End If
strHTML_EN = strHTML_EN & "" & _
"" & _
"" & _
"
" & VBCrLf
strHTML_FR = strHTML_FR & "
" & VBCrLf
strHTML_FR = strHTML_FR & "
" & VBCrLf
strHTML_FR = strHTML_FR & "
" & _
"" & _
"" & _
"" & _
""
If bolThisPageIsBeingDisplayedOnAdminSide Then
strHTML_FR = strHTML_FR & ""
End If
strHTML_FR = strHTML_FR & "" & _
"" & _
"" & _
"
" & VBCrLf
If err.number <> 0 Then
Call ReportError("GetDynamicFormValidationAndHTMLString", err.number, err.description)
End If
On Error Goto 0
End Function
Function CreateAndUpdateDynamicFormPageContent(intDynamicFormId)
On Error Resume Next
Dim strJavaScript_EN, strHTML_EN
Dim strJavaScript_FR, strHTML_FR
Dim strAdminJavaScript_EN, strAdminHTML_EN
Dim strAdminJavaScript_FR, strAdminHTML_FR
Dim strEnglishPage
Dim strFrenchPage
Dim strEnglishAdminPage
Dim strFrenchAdminPage
Dim strJSWrapper_en, strJSWrapper_fr
Dim strWrapper
Call GetDynamicFormValidationAndHTMLString(intDynamicFormId, 0, False, strJavaScript_EN, strHTML_EN, strJavaScript_FR, strHTML_FR)
Call GetDynamicFormValidationAndHTMLString(intDynamicFormId, 0, True, strAdminJavaScript_EN, strAdminHTML_EN, strAdminJavaScript_FR, strAdminHTML_FR)
strJSWrapper_en = GetJSWrapper("en")
strJSWrapper_fr = GetJSWrapper("fr")
strJavaScript_EN = Replace(strJSWrapper_en, "[js]", strJavaScript_EN)
strJavaScript_FR = Replace(strJSWrapper_fr, "[js]", strJavaScript_FR)
strAdminJavaScript_EN = Replace(strJSWrapper_en, "[js]", strAdminJavaScript_EN)
strAdminJavaScript_FR = Replace(strJSWrapper_fr, "[js]", strAdminJavaScript_FR)
strWrapper = GetDynamicFormWrapper(intDynamicFormId)
strEnglishPage = Replace(strWrapper,"[GB_HTML]", strHTML_EN)
strFrenchPage = Replace(strWrapper,"[GB_HTML]", strHTML_FR)
strEnglishPage = Replace(strEnglishPage,"[GB_JAVASCRIPT]", strJavaScript_EN)
strFrenchPage = Replace(strFrenchPage,"[GB_JAVASCRIPT]", strJavaScript_FR)
strEnglishAdminPage = Replace(strWrapper,"[GB_HTML]", strAdminHTML_EN)
strFrenchAdminPage = Replace(strWrapper,"[GB_HTML]", strAdminHTML_FR)
strEnglishAdminPage = Replace(strEnglishAdminPage,"[GB_JAVASCRIPT]", strAdminJavaScript_EN)
strFrenchAdminPage = Replace(strFrenchAdminPage,"[GB_JAVASCRIPT]", strAdminJavaScript_FR)
Call UpdateDynamicFormPageContent(intDynamicFormId, strEnglishPage, strFrenchPage, strEnglishAdminPage, strFrenchAdminPage)
If err.number <> 0 Then
Call ReportError("CreateAndUpdateDynamicFormPageContent", err.number, err.description)
End If
On Error Goto 0
End Function
Sub UpdateDynamicFormPageContent(intDynamicFormId, strEnglishPage, strFrenchPage, strEnglishAdminPage, strFrenchAdminPage)
On Error Resume Next
Dim cmd
set cmd = Server.CreateObject("ADODB.Command")
set cmd.ActiveConnection = conn
cmd.CommandText = "SP_SET_DYNAMIC_FORM_HTML"
cmd.CommandType = adCmdStoredProc
cmd.Parameters.Append cmd.CreateParameter("DYNAMIC_FORM_ID", adInteger, adParamInput, , intDynamicFormId)
cmd.Parameters.Append cmd.CreateParameter("DYNAMIC_FORM_HTML_EN", adLongVarChar, adParamInput, Len(strEnglishPage), strEnglishPage)
cmd.Parameters.Append cmd.CreateParameter("DYNAMIC_FORM_HTML_FR", adLongVarChar, adParamInput, Len(strFrenchPage), strFrenchPage)
cmd.Parameters.Append cmd.CreateParameter("DYNAMIC_ADMIN_FORM_HTML_EN", adLongVarChar, adParamInput, Len(strEnglishAdminPage), strEnglishAdminPage)
cmd.Parameters.Append cmd.CreateParameter("DYNAMIC_ADMIN_FORM_HTML_FR", adLongVarChar, adParamInput, Len(strFrenchAdminPage), strFrenchAdminPage)
cmd.execute
If err.number <> 0 Then
Call ReportError("UpdateDynamicFormPageContent", err.number, err.description)
End If
set cmd = nothing
On Error Goto 0
End Sub
Function GetFiller()
GetFiller = "
" & VBCrLf
End Function
Function GetCaptionElementHTML(strCaptionQuestion, bolNeedsAnotherTD)
On Error Resume Next
Dim strHTML
strHTML = ""
If bolNeedsAnotherTD Then
strHTML = strHTML & GetFiller()
End If
strHTML = strHTML & "" & VBCrLf
strHTML = strHTML & "
" & VBCrLf
strHTML = strHTML & "
" & VBCrLf
strHTML = strHTML & "
" & strCaptionQuestion & "
" & VBCrLf
strHTML = strHTML & "
" & VBCrLf
strHTML = strHTML & "
" & VBCrLf
strHTML = strHTML & "" & VBCrLf
GetCaptionElementHTML = strHTML
If err.number <> 0 Then
Call ReportError("GetCaptionElementHTML", err.number, err.description)
End If
On Error Goto 0
End Function
Function GetRadioElementHTML(intElementId ,strName, strCaptionQuestion, bolDisplayHorizontally, intNumberOfColumns, bolNeedsAnotherTD, bolIsManditory, strTempJavaScript, intQuestionNumber, intDataType, strLang, bolThisPageIsBeingDisplayedOnAdminSide, intSubmissionId)
On Error Resume Next
Dim strCheckedStatus
strCheckedStatus = ""
Dim strHTML, strJavaScript
strHTML = ""
strJavaScript = ""
If bolNeedsAnotherTD Then
strHTML = strHTML & GetFiller()
End If
Dim rsPossibleAnswers, strPossibleAnswerValue
Set rsPossibleAnswers = GetPossibleAnswers(intElementId)
strHTML = strHTML & "" & VBCrLf
strHTML = strHTML & "
" & VBCrLf
strHTML = strHTML & "
" & VBCrLf
Dim strQuestionAndNumber
Dim strTag
strTag = "
"
If LCase(Left(strCaptionQuestion, 3)) = strTag Then
strQuestionAndNumber = Left(strCaptionQuestion, 3) & "#" & intQuestionNumber & " " & Mid(strCaptionQuestion, 4, (Len(strCaptionQuestion)-3))
Else
strQuestionAndNumber = "#" & intQuestionNumber & " " & strCaptionQuestion
End If
If bolDisplayHorizontally Then
strHTML = strHTML & "
" & strQuestionAndNumber & "
" & VBCrLf
Else
strHTML = strHTML & "
" & strQuestionAndNumber & "
" & VBCrLf
strHTML = strHTML & "
" & VBCrLf
End If
If rsPossibleAnswers.EOF = False Then
If bolIsManditory Then
strJavaScript = "var atLeastOneRadioButtonIsSelected" & intElementId & " = false;" & VBCrLf
strJavaScript = strJavaScript & "if (document.layers){" & VBCrLf
strJavaScript = strJavaScript & " if (formObject[""" & strName & """].length){" & VBCrLf
strJavaScript = strJavaScript & " for(var x=0;x++;x 0 Then
If IsCheckBoxChecked(intSubmissionId, intElementId, strPossibleAnswerValue) Then
strCheckedStatus = " checked=""checked"""
End If
End If
If intDataType = 2 Then
If bolDisplayHorizontally Then
strHTML = strHTML & "
" & SimpleDate(strPossibleAnswerValue) & "
" & VBCrLf
Else
If intPossibleAnswerCounter > 1 Then
strHTML = strHTML & "" & VBCrLf
End If
strHTML = strHTML & "
" & VBCrLf
strHTML = strHTML & "
" & SimpleDate(strPossibleAnswerValue) & "
" & VBCrLf
End If
Else
If bolDisplayHorizontally Then
strHTML = strHTML & "
" & strPossibleAnswerValue & "
" & VBCrLf
Else
If intPossibleAnswerCounter > 1 Then
strHTML = strHTML & "
" & VBCrLf
End If
strHTML = strHTML & "
" & VBCrLf
strHTML = strHTML & "
" & strPossibleAnswerValue & "
" & VBCrLf
End If
End If
strCheckedStatus = ""
rsPossibleAnswers.MoveNext
Loop
rsPossibleAnswers.Close
End If
Set rsPossibleAnswers = Nothing
strHTML = strHTML & "
" & VBCrLf
strHTML = strHTML & "
" & VBCrLf
strHTML = strHTML & "" & VBCrLf
strTempJavaScript = strJavaScript
GetRadioElementHTML = strHTML
If err.number <> 0 Then
Call ReportError("GetRadioElementHTML", err.number, err.description)
End If
On Error Goto 0
End Function
Function GetCheckBoxElementHTML(intElementId, strName, strCaptionQuestion, bolDisplayHorizontally, intNumberOfColumns, bolNeedsAnotherTD, bolIsManditory, strTempJavaScript, intQuestionNumber, intDataType, strLang, bolThisPageIsBeingDisplayedOnAdminSide, intSubmissionId)
On Error Resume Next
Dim strHTML, strJavaScript
Dim strCheckedStatus
strCheckedStatus = ""
strHTML = ""
If bolNeedsAnotherTD Then
strHTML = strHTML & GetFiller()
End If
Dim rsPossibleAnswers
Dim strPossibleAnswerValue
Set rsPossibleAnswers = GetPossibleAnswers(intElementId)
strHTML = strHTML & "" & VBCrLf
strHTML = strHTML & "
" & VBCrLf
strHTML = strHTML & "
" & VBCrLf
Dim strQuestionAndNumber
Dim strTag
strTag = "
"
If LCase(Left(strCaptionQuestion, 3)) = strTag Then
strQuestionAndNumber = Left(strCaptionQuestion, 3) & "#" & intQuestionNumber & " " & Mid(strCaptionQuestion, 4, (Len(strCaptionQuestion)-3))
Else
strQuestionAndNumber = "#" & intQuestionNumber & " " & strCaptionQuestion
End If
If bolDisplayHorizontally Then
strHTML = strHTML & "
" & strQuestionAndNumber & "
" & VBCrLf
Else
strHTML = strHTML & "
" & strQuestionAndNumber & "
" & VBCrLf
strHTML = strHTML & "
" & VBCrLf
End If
If rsPossibleAnswers.EOF = False Then
If bolIsManditory Then
strJavaScript = "var atLeastOneCheckBoxIsChecked" & intElementId & " = false;" & VBCrLf
strJavaScript = strJavaScript & "if (document.layers){" & VBCrLf
strJavaScript = strJavaScript & " if (formObject[""" & strName & """].length){" & VBCrLf
strJavaScript = strJavaScript & " for(var x=0;x++;x " & SimpleDate(strPossibleAnswerValue) & "" & VBCrLf
Else
If intPossibleAnswerCounter > 1 Then
strHTML = strHTML & "" & VBCrLf
End If
strHTML = strHTML & "
" & VBCrLf
strHTML = strHTML & "
" & SimpleDate(strPossibleAnswerValue) & "
" & VBCrLf
End If
Else
If bolDisplayHorizontally Then
strHTML = strHTML & "
" & strPossibleAnswerValue & "
" & VBCrLf
Else
If intPossibleAnswerCounter > 1 Then
strHTML = strHTML & "
" & VBCrLf
End If
strHTML = strHTML & "
" & VBCrLf
strHTML = strHTML & "
" & strPossibleAnswerValue & "
" & VBCrLf
End If
End If
strCheckedStatus = ""
rsPossibleAnswers.MoveNext
Loop
rsPossibleAnswers.Close
End If
Set rsPossibleAnswers = Nothing
strHTML = strHTML & "
" & VBCrLf
strHTML = strHTML & "
" & VBCrLf
strHTML = strHTML & "" & VBCrLf
strTempJavaScript = strJavaScript
GetCheckBoxElementHTML = strHTML
If err.number <> 0 Then
Call ReportError("GetCheckBoxElementHTML", err.number, err.description)
End If
On Error Goto 0
End Function
Function GetDropDownElementHTML(intElementId, strName, strCaptionQuestion, bolDisplayHorizontally, intNumberOfColumns, bolNeedsAnotherTD, bolIsManditory, strTempJavaScript, intQuestionNumber, intDataType, strLang, strAnswerValue, intSubmissionId)
On Error Resume Next
Dim strHTML, strJavaScript
Dim strCheckedStatus
strCheckedStatus = ""
strJavaScript = ""
strHTML = ""
If bolNeedsAnotherTD Then
strHTML = strHTML & GetFiller()
End If
Dim rsPossibleAnswers
Dim strPossibleAnswerValue
Set rsPossibleAnswers = GetPossibleAnswers(intElementId)
strHTML = strHTML & "" & VBCrLf
strHTML = strHTML & "
" & VBCrLf
strHTML = strHTML & "
" & VBCrLf
Dim strQuestionAndNumber
Dim strTag
strTag = "
"
If LCase(Left(strCaptionQuestion, 3)) = strTag Then
strQuestionAndNumber = Left(strCaptionQuestion, 3) & "#" & intQuestionNumber & " " & Mid(strCaptionQuestion, 4, (Len(strCaptionQuestion)-3))
Else
strQuestionAndNumber = "#" & intQuestionNumber & " " & strCaptionQuestion
End If
If bolDisplayHorizontally Then
strHTML = strHTML & "
" & strQuestionAndNumber & "
" & VBCrLf
strHTML = strHTML & "
" & VBCrLf
strHTML = strHTML & "
" & VBCrLf
strHTML = strHTML & "
" & VBCrLf
rsPossibleAnswers.Close
End If
Set rsPossibleAnswers = Nothing
strHTML = strHTML & "
" & VBCrLf
strHTML = strHTML & "
" & VBCrLf
strHTML = strHTML & "" & VBCrLf
strTempJavaScript = strJavaScript
GetDropDownElementHTML = strHTML
If err.number <> 0 Then
Call ReportError("GetDropDownElementHTML", err.number, err.description)
End If
On Error Goto 0
End Function
Function GetFreeTextElementHTML(intElementId, strName, strCaptionQuestion, bolDisplayHorizontally, intNumberOfColumns, bolNeedsAnotherTD, bolIsManditory, strTempJavaScript, intQuestionNumber, intDataType, intLength, strLang, strEmailFieldNameArray, strAnswerValue)
On Error Resume Next
Dim strHTML, strJavaScript
strHTML = ""
If bolNeedsAnotherTD Then
strHTML = strHTML & GetFiller()
End If
strHTML = strHTML & "" & VBCrLf
If intNumberOfColumns = 1 Then
strHTML = strHTML & "
" & VBCrLf
Else
strHTML = strHTML & "
" & VBCrLf
End If
strHTML = strHTML & "
" & VBCrLf
Dim strQuestionAndNumber
Dim strTag
strTag = "
"
If LCase(Left(strCaptionQuestion, 3)) = strTag Then
strQuestionAndNumber = Left(strCaptionQuestion, 3) & "#" & intQuestionNumber & " " & Mid(strCaptionQuestion, 4, (Len(strCaptionQuestion)-3))
Else
strQuestionAndNumber = "#" & intQuestionNumber & " " & strCaptionQuestion
End If
If bolDisplayHorizontally Then
strHTML = strHTML & "
" & strQuestionAndNumber & "
" & VBCrLf
strHTML = strHTML & "
" & VBCrLf
Else
strHTML = strHTML & "
" & strQuestionAndNumber & "
" & VBCrLf
strHTML = strHTML & "
" & VBCrLf
strHTML = strHTML & "
" & VBCrLf
strHTML = strHTML & "
" & VBCrLf
End If
If intDataType = 3 Then
If strEmailFieldNameArray = "" Then
strEmailFieldNameArray = strEmailFieldNameArray & "txt" & strName
Else
strEmailFieldNameArray = strEmailFieldNameArray & "," & "txt" & strName
End If
End If
strHTML = strHTML & " "" Then
strHTML = strHTML & "value=""" & SimpleDate(strAnswerValue) & """>
" & VBCrLf
strHTML = strHTML & "" & VBCrLf
If bolIsManditory Then
strJavaScript = strJavaScript & "if (document.layers){" & VBCrLf
strJavaScript = strJavaScript & " if (trim(formObject[""" & strName & """].value).length < 1){" & VBCrLf
If strLang = "en" Then
strJavaScript = strJavaScript & " errMess = errMess + ""Please answer question #" & intQuestionNumber & ".\n"";" & VBCrLf
Else
strJavaScript = strJavaScript & " errMess = errMess + ""Veuillez répondre la question #" & intQuestionNumber & ".\n"";" & VBCrLf
End If
strJavaScript = strJavaScript & " isFalse = 1;" & VBCrLf
strJavaScript = strJavaScript & " }" & VBCrLf
strJavaScript = strJavaScript & "}else{" & VBCrLf
strJavaScript = strJavaScript & " if (trim(formObject." & strName & ".value).length < 1){" & VBCrLf
If strLang = "en" Then
strJavaScript = strJavaScript & " errMess = errMess + ""Please answer question #" & intQuestionNumber & ".\n"";" & VBCrLf
Else
strJavaScript = strJavaScript & " errMess = errMess + ""Veuillez répondre la question #" & intQuestionNumber & ".\n"";" & VBCrLf
End If
strJavaScript = strJavaScript & " isFalse = 1;" & VBCrLf
strJavaScript = strJavaScript & " }" & VBCrLf
strJavaScript = strJavaScript & "}" & VBCrLf
End If
Select Case intDataType
Case 1 'Alphanumeric
Case 2 'Date
strJavaScript = strJavaScript & "if (document.layers){" & VBCrLf
strJavaScript = strJavaScript & " if (trim(formObject[""" & strName & """].value).length > 0){" & VBCrLf
strJavaScript = strJavaScript & " var dateStatus" & intQuestionNumber & "=isDate(trim(formObject[""" & strName & """].value));" & VBCrLf
strJavaScript = strJavaScript & " }" & VBCrLf
strJavaScript = strJavaScript & "}else{" & VBCrLf
strJavaScript = strJavaScript & " if (trim(formObject." & strName & ".value).length >0){" & VBCrLf
strJavaScript = strJavaScript & " var dateStatus" & intQuestionNumber & "=isDate(trim(formObject." & strName & ".value));" & VBCrLf
strJavaScript = strJavaScript & " }" & VBCrLf
strJavaScript = strJavaScript & "}" & VBCrLf
strJavaScript = strJavaScript & "if (dateStatus" & intQuestionNumber & "!=0){" & VBCrLf
If strLang = "en" Then
strJavaScript = strJavaScript & " switch(dateStatus" & intQuestionNumber & "){" & VBCrLf
strJavaScript = strJavaScript & " case 1:" & VBCrLf
strJavaScript = strJavaScript & " // then alert the user and set isFalse to 1" & VBCrLf
strJavaScript = strJavaScript & " errMess = errMess + 'Please enter a valid date for question #" & intQuestionNumber & ", the date format should be: dd/mm/yyyy.\n';" & VBCrLf
strJavaScript = strJavaScript & " isFalse = 1;" & VBCrLf
strJavaScript = strJavaScript & " break;" & VBCrLf
strJavaScript = strJavaScript & " case 2:" & VBCrLf
strJavaScript = strJavaScript & " // then alert the user and set isFalse to 1" & VBCrLf
strJavaScript = strJavaScript & " errMess = errMess + 'Please enter a valid month for question #" & intQuestionNumber & ", the date format should be: dd/mm/yyyy.\n';" & VBCrLf
strJavaScript = strJavaScript & " isFalse = 1;" & VBCrLf
strJavaScript = strJavaScript & " break;" & VBCrLf
strJavaScript = strJavaScript & " case 3:" & VBCrLf
strJavaScript = strJavaScript & " // then alert the user and set isFalse to 1" & VBCrLf
strJavaScript = strJavaScript & " errMess = errMess + 'Please enter a valid day for question #" & intQuestionNumber & ", the date format should be: dd/mm/yyyy.\n';" & VBCrLf
strJavaScript = strJavaScript & " isFalse = 1;" & VBCrLf
strJavaScript = strJavaScript & " break;" & VBCrLf
strJavaScript = strJavaScript & " case 4:" & VBCrLf
strJavaScript = strJavaScript & " // then alert the user and set isFalse to 1" & VBCrLf
strJavaScript = strJavaScript & " errMess = errMess + 'Please enter a valid 4 digit year between '+minYear+' and '+maxYear+' for question #" & intQuestionNumber & ", the date format should be: dd/mm/yyyy.\n';" & VBCrLf
strJavaScript = strJavaScript & " isFalse = 1;" & VBCrLf
strJavaScript = strJavaScript & " break;" & VBCrLf
strJavaScript = strJavaScript & " case 5:" & VBCrLf
strJavaScript = strJavaScript & " // then alert the user and set isFalse to 1" & VBCrLf
strJavaScript = strJavaScript & " errMess = errMess + 'Please enter a valid date for question #" & intQuestionNumber & ", the date format should be: dd/mm/yyyy.\n';" & VBCrLf
strJavaScript = strJavaScript & " isFalse = 1;" & VBCrLf
strJavaScript = strJavaScript & " break;" & VBCrLf
strJavaScript = strJavaScript & " }" & VBCrLf
Else
strJavaScript = strJavaScript & " switch(dateStatus" & intQuestionNumber & "){" & VBCrLf
strJavaScript = strJavaScript & " case 1:" & VBCrLf
strJavaScript = strJavaScript & " // then alert the user and set isFalse to 1" & VBCrLf
strJavaScript = strJavaScript & " errMess = errMess + 'Veuillez fournir une date valide pour la question #" & intQuestionNumber & ", la date doit avoir le format suivant: dd/mm/yyyy.\n';" & VBCrLf
strJavaScript = strJavaScript & " isFalse = 1;" & VBCrLf
strJavaScript = strJavaScript & " break;" & VBCrLf
strJavaScript = strJavaScript & " case 2:" & VBCrLf
strJavaScript = strJavaScript & " // then alert the user and set isFalse to 1" & VBCrLf
strJavaScript = strJavaScript & " errMess = errMess + 'Veuillez fournir un mois valide pour la question #" & intQuestionNumber & ", la date doit avoir le format suivant: dd/mm/yyyy.\n';" & VBCrLf
strJavaScript = strJavaScript & " isFalse = 1;" & VBCrLf
strJavaScript = strJavaScript & " break;" & VBCrLf
strJavaScript = strJavaScript & " case 3:" & VBCrLf
strJavaScript = strJavaScript & " // then alert the user and set isFalse to 1" & VBCrLf
strJavaScript = strJavaScript & " errMess = errMess + 'Veuillez fournir un jour valide pour la question #" & intQuestionNumber & ", la date doit avoir le format suivant: dd/mm/yyyy.\n';" & VBCrLf
strJavaScript = strJavaScript & " isFalse = 1;" & VBCrLf
strJavaScript = strJavaScript & " break;" & VBCrLf
strJavaScript = strJavaScript & " case 4:" & VBCrLf
strJavaScript = strJavaScript & " // then alert the user and set isFalse to 1" & VBCrLf
strJavaScript = strJavaScript & " errMess = errMess + 'Veuillez fournir une année valide de ayant 4 chiffre se situant entre '+minYear+' and '+maxYear+' pour la question #" & intQuestionNumber & ", la date doit avoir le format suivant: dd/mm/yyyy.\n';" & VBCrLf
strJavaScript = strJavaScript & " isFalse = 1;" & VBCrLf
strJavaScript = strJavaScript & " break;" & VBCrLf
strJavaScript = strJavaScript & " case 5:" & VBCrLf
strJavaScript = strJavaScript & " // then alert the user and set isFalse to 1" & VBCrLf
strJavaScript = strJavaScript & " errMess = errMess + 'Veuillez fournir une date valide pour la question #" & intQuestionNumber & ", la date doit avoir le format suivant: dd/mm/yyyy.\n';" & VBCrLf
strJavaScript = strJavaScript & " isFalse = 1;" & VBCrLf
strJavaScript = strJavaScript & " break;" & VBCrLf
strJavaScript = strJavaScript & " }" & VBCrLf
End If
strJavaScript = strJavaScript & "}" & VBCrLf
Case 3 'Email Address
strJavaScript = strJavaScript & "if (document.layers){" & VBCrLf
strJavaScript = strJavaScript & " if(trim(formObject[""" & strName & """].value).length > 1){ if (checkEmail(trim(formObject[""" & strName & """].value))==false) {" & VBCrLf
If strLang = "en" Then
strJavaScript = strJavaScript & " errMess = errMess + ""Question #" & intQuestionNumber & " must be of a valid format.\n"";" & VBCrLf
Else
strJavaScript = strJavaScript & " errMess = errMess + ""Veuillez assurer que le format de la question #" & intQuestionNumber & " valide.\n"";" & VBCrLf
End If
strJavaScript = strJavaScript & " isFalse = 1;" & VBCrLf
strJavaScript = strJavaScript & " }}" & VBCrLf
strJavaScript = strJavaScript & "}else{" & VBCrLf
strJavaScript = strJavaScript & " if(trim(formObject." & strName & ".value).length > 1){ if (checkEmail(trim(formObject." & strName & ".value))==false) {" & VBCrLf
If strLang = "en" Then
strJavaScript = strJavaScript & " errMess = errMess + ""Question #" & intQuestionNumber & " must be of a valid format.\n"";" & VBCrLf
Else
strJavaScript = strJavaScript & " errMess = errMess + ""Veuillez assurer que le format de la question #" & intQuestionNumber & " valide.\n"";" & VBCrLf
End If
strJavaScript = strJavaScript & " isFalse = 1;" & VBCrLf
strJavaScript = strJavaScript & " }}" & VBCrLf
strJavaScript = strJavaScript & "}" & VBCrLf
Case 4 'Numeric
Case 5 'Website Address
strJavaScript = strJavaScript & "if (document.layers){" & VBCrLf
strJavaScript = strJavaScript & " if(trim(formObject[""" & strName & """].value).length > 1){ if (isValidUrl(trim(formObject[""" & strName & """].value))==false) {" & VBCrLf
If strLang = "en" Then
strJavaScript = strJavaScript & " errMess = errMess + ""Question #" & intQuestionNumber & " must be of a valid format.\n"";" & VBCrLf
Else
strJavaScript = strJavaScript & " errMess = errMess + ""Veuillez assurer que le format de la question #" & intQuestionNumber & " valide.\n"";" & VBCrLf
End If
strJavaScript = strJavaScript & " isFalse = 1;" & VBCrLf
strJavaScript = strJavaScript & " }}" & VBCrLf
strJavaScript = strJavaScript & "}else{" & VBCrLf
strJavaScript = strJavaScript & " if(trim(formObject." & strName & ".value).length > 1){ if (isValidUrl(trim(formObject." & strName & ".value))==false) {" & VBCrLf
If strLang = "en" Then
strJavaScript = strJavaScript & " errMess = errMess + ""Question #" & intQuestionNumber & " must be of a valid format.\n"";" & VBCrLf
Else
strJavaScript = strJavaScript & " errMess = errMess + ""Veuillez assurer que le format de la question #" & intQuestionNumber & " valide.\n"";" & VBCrLf
End If
strJavaScript = strJavaScript & " isFalse = 1;" & VBCrLf
strJavaScript = strJavaScript & " }}" & VBCrLf
strJavaScript = strJavaScript & "}" & VBCrLf
End Select
strTempJavaScript = strJavaScript
GetFreeTextElementHTML = strHTML
If err.number <> 0 Then
Call ReportError("GetFreeTextElementHTML", err.number, err.description)
End If
On Error Goto 0
End Function
Function GetFreeTextMultiLinedElementHTML(intElementId, strName, strCaptionQuestion, bolDisplayHorizontally, intNumberOfColumns, bolNeedsAnotherTD, bolIsManditory, strTempJavaScript, intQuestionNumber, intDataType, intLength, strLang, strEmailFieldNameArray, strAnswerValue)
On Error Resume Next
Dim strHTML, strJavaScript
strJavaScript = ""
strHTML = ""
If bolNeedsAnotherTD Then
strHTML = strHTML & GetFiller()
End If
strHTML = strHTML & "" & VBCrLf
If intNumberOfColumns = 1 Then
strHTML = strHTML & "
" & VBCrLf
Else
strHTML = strHTML & "
" & VBCrLf
End If
strHTML = strHTML & "
" & VBCrLf
Dim strQuestionAndNumber
Dim strTag
strTag = "
"
If LCase(Left(strCaptionQuestion, 3)) = strTag Then
strQuestionAndNumber = Left(strCaptionQuestion, 3) & "#" & intQuestionNumber & " " & Mid(strCaptionQuestion, 4, (Len(strCaptionQuestion)-3))
Else
strQuestionAndNumber = "#" & intQuestionNumber & " " & strCaptionQuestion
End If
If bolDisplayHorizontally Then
strHTML = strHTML & "
" & strQuestionAndNumber & "
" & VBCrLf
strHTML = strHTML & "
" & VBCrLf
Else
strHTML = strHTML & "
" & strQuestionAndNumber & "
" & VBCrLf
strHTML = strHTML & "
" & VBCrLf
strHTML = strHTML & "
" & VBCrLf
strHTML = strHTML & "
" & VBCrLf
End If
If intDataType = 3 Then
If strEmailFieldNameArray = "" Then
strEmailFieldNameArray = strEmailFieldNameArray & "txt" & strName
Else
strEmailFieldNameArray = strEmailFieldNameArray & "," & "txt" & strName
End If
End If
strHTML = strHTML & "
"
If UBound(arSelectedCheckbox) > 0 Then
bolIsChecked = False
For intCheckboxArrayItemCounter = 0 To UBound(arSelectedCheckbox)-1
If arSelectedCheckbox(intCheckboxArrayItemCounter) <> "" And CInt(arSelectedCheckbox(intCheckboxArrayItemCounter)) = intSubmissionId Then
bolIsChecked = True
Exit For
End If
Next
If bolIsChecked Then
strFormEntries = strFormEntries & ""
Else
strFormEntries = strFormEntries & ""
End If
Else
strFormEntries = strFormEntries & ""
End If
strFormEntries = strFormEntries & "
" & vbCRLF
If bolFormEntriesAreEditable Then
strFormEntries = strFormEntries & "
" & vbCRLF
End If
For intArrayElementCounter = 0 To UBound(arTempSortingCriteria)-1 Step 5
strFormFieldName = arTempSortingCriteria(intArrayElementCounter)
intFormFieldDataTypeId = CInt(arTempSortingCriteria(intArrayElementCounter+1))
strSortArrowUp = "/images/sort_arrow_up.gif"
strSortArrowDown = "/images/sort_arrow_down.gif"
If CInt(arTempSortingCriteria(intArrayElementCounter+2)) = 1 Then
If arTempSortingCriteria(intArrayElementCounter+3) = "asc" Then
strSortArrowUp = "/images/sort_arrow_up_lit.gif"
Else
strSortArrowDown = "/images/sort_arrow_down_lit.gif"
End If
End If
intFormElementId = CInt(arTempSortingCriteria(intArrayElementCounter+4))
strFormEntries = strFormEntries & "
"
If Not IsNull(rsFormEntries(strFormFieldName)) Then
If intFormFieldDataTypeId = 2 Then
strFormEntries = strFormEntries & SimpleDate(rsFormEntries(strFormFieldName))
Else
strFormEntries = strFormEntries & rsFormEntries(strFormFieldName)
End If
Else
strFormEntries = strFormEntries & " "
End If
strFormEntries = strFormEntries & "
" & vbCRLF
If Not bolHeadersAreWritten Then
If intArrayElementCounter = 0 Then
strFormEntryHeaders = strFormEntryHeaders & "
"
Else
If LCase(strUserLanguage) <> "en" Then
If strMainFilterCriteria = "" Then
strFormEntries = "Il n'y a eu aucune soumission pour ce questionnaire."
Else
strFormEntries = "La recherche a retouné auncun résultat."
End If
Else
If strMainFilterCriteria = "" Then
strFormEntries = "No Form Entries were submitted for this form."
Else
strFormEntries = "This search result did not return any matches."
End If
End If
End If
rsFormEntries.Close
Set rsFormEntries = Nothing
ManageFormEntries = strFormEntries
If err.number <> 0 Then
Call ReportError("ManageFormEntries", err.number, err.description)
End If
On Error Goto 0
End Function
Sub GetDynamicFormEntryQuery(byRef strMainDisplayCriteria, byRef strMainSortingCriteria, byRef strMainDateCriteria, byRef strMainFilterCriteria, byVal intDynamicFormId, byVal strDelimiter, byVal strCriteriaArray, byVal strSortingFieldArray, byVal strUserLanguage)
On Error Resume Next
Dim strTableAliasPrefix
Dim strFormFieldName
Dim bolMainSortingField
Dim strSortingDirection
Dim strSortingCriteria
Dim arTempSortingCriteria
Dim strDateCriteria
Dim strTempDateCriteria
Dim strFilterCriteria
Dim strTempFilterCriteria
Dim strSQLInList
Dim arTempFilterCriteria
Dim intArrayElementCounter
Dim intArrayElementCounter2
Dim intFormFieldId
Dim intFormFieldDataTypeId
Dim intFormFieldOperatorId
Dim strFormFieldCriteriaValue
Dim bolConcatenateTemp
Dim strOperator
Dim strAllowNull
If strCriteriaArray <> "" Then
arTempFilterCriteria = Split(strCriteriaArray, strDelimiter)
strMainDateCriteria = ""
strMainFilterCriteria = ""
For intArrayElementCounter = 0 To UBound(arTempFilterCriteria)-1 Step 5
intFormFieldId = CInt(arTempFilterCriteria(intArrayElementCounter))
intFormFieldDataTypeId = CInt(arTempFilterCriteria(intArrayElementCounter+1))
intFormFieldOperatorId = CInt(arTempFilterCriteria(intArrayElementCounter+2))
strFormFieldCriteriaValue = ReplaceQuotes(arTempFilterCriteria(intArrayElementCounter+3))
If intFormFieldDataTypeId = 2 And Len(strFormFieldCriteriaValue) < 10 Then
strFormFieldCriteriaValue = TenCharDate(strFormFieldCriteriaValue)
End If
If intFormFieldId = 0 Then
strDateCriteria = "AND "
bolConcatenateTemp = True
strTempDateCriteria = ""
If intFormFieldOperatorId = 1 Or intFormFieldOperatorId = 2 Then
If intFormFieldOperatorId = 1 Then
strTempDateCriteria = strTempDateCriteria & "(FORM_ANSWER_DATE_TIME IN ([SQL_IN_LIST]))" & vbCRLF
Else
strTempDateCriteria = strTempDateCriteria & "(FORM_ANSWER_DATE_TIME NOT IN ([SQL_IN_LIST]))" & vbCRLF
End If
strSQLInList = "'" & ConvertDateCdnToUS(strFormFieldCriteriaValue) & "'"
For intArrayElementCounter2 = 0 To UBound(arTempFilterCriteria)-1 Step 5
If CInt(arTempFilterCriteria(intArrayElementCounter2)) = intFormFieldId And CInt(arTempFilterCriteria(intArrayElementCounter2+2)) = intFormFieldOperatorId And intArrayElementCounter2 <> intArrayElementCounter Then
If intArrayElementCounter2 > intArrayElementCounter Then
bolConcatenateTemp = False
Exit For
Else
strSQLInList = strSQLInList & ",'" & ConvertDateCdnToUS(arTempFilterCriteria(intArrayElementCounter2+3)) & "'"
End If
End If
Next
strTempDateCriteria = Replace(strTempDateCriteria, "[SQL_IN_LIST]", strSQLInList)
If bolConcatenateTemp Then
strDateCriteria = strDateCriteria & strTempDateCriteria & vbCRLF
End If
Else
strDateCriteria = strDateCriteria & "(DATEDIFF(day, '" & ConvertDateCdnToUS(strFormFieldCriteriaValue) & "', FORM_ANSWER_DATE_TIME) [OPERAND] 0)" & vbCRLF
Select Case intFormFieldOperatorId
Case 3:
strOperator = "<"
Case 4:
strOperator = "<="
Case 5:
strOperator = ">"
Case 6:
strOperator = ">="
End Select
strDateCriteria = Replace(strDateCriteria, "[OPERAND]", strOperator)
End If
If bolConcatenateTemp Then
strMainDateCriteria = strMainDateCriteria & strDateCriteria & vbCRLF
End If
Else
strFilterCriteria = ""
strAllowNull = ""
strFilterCriteria = strFilterCriteria & "SELECT FORM_SUBMISSION_ID" & vbCRLF
strFilterCriteria = strFilterCriteria & " FROM FORM_ANSWER INNER JOIN" & vbCRLF
strFilterCriteria = strFilterCriteria & " FORM_ELEMENT ON FORM_ANSWER.FORM_ELEMENT_ID = FORM_ELEMENT.FORM_ELEMENT_ID" & vbCRLF
strFilterCriteria = strFilterCriteria & " WHERE (FORM_ELEMENT.FORM_ELEMENT_TYPE_ID = 2)" & vbCRLF
strFilterCriteria = strFilterCriteria & " AND" & vbCRLF
strFilterCriteria = strFilterCriteria & " ( (FORM_ELEMENT.FORM_ELEMENT_ID = " & intFormFieldId
strFilterCriteria = strFilterCriteria & ") AND ( "
bolConcatenateTemp = True
strTempFilterCriteria = ""
If intFormFieldOperatorId = 1 Or intFormFieldOperatorId = 2 Then
Select Case True
Case intFormFieldDataTypeId = 2:
If intFormFieldOperatorId = 1 Then
strTempFilterCriteria = strTempFilterCriteria & "(CAST(FORM_ANSWER_VALUE AS datetime(10)) IN ([SQL_IN_LIST]))) [IS_NULL]))" & vbCRLF
Else
strTempFilterCriteria = strTempFilterCriteria & "(CAST(FORM_ANSWER_VALUE AS datetime(10)) NOT IN ([SQL_IN_LIST]))) [IS_NULL]))" & vbCRLF
strAllowNull = "OR (SELECT CAST(B.FORM_ANSWER_VALUE AS datetime) FROM V_DYNAMIC_FORM_ENTRIES B WHERE B.FORM_ELEMENT_ID = " & intFormFieldId & " AND B.FORM_SUBMISSION_ID = A.FORM_SUBMISSION_ID) IS NULL"
End If
strSQLInList = "'" & ConvertDateCdnToUS(strFormFieldCriteriaValue) & "'"
Case intFormFieldDataTypeId = 4:
If intFormFieldOperatorId = 1 Then
strTempFilterCriteria = strTempFilterCriteria & "(FORM_ANSWER_VALUE IN ([SQL_IN_LIST]))) [IS_NULL]))" & vbCRLF
Else
strTempFilterCriteria = strTempFilterCriteria & "(FORM_ANSWER_VALUE NOT IN ([SQL_IN_LIST]))) [IS_NULL]))" & vbCRLF
strAllowNull = "OR (SELECT CAST(B.FORM_ANSWER_VALUE AS float) FROM V_DYNAMIC_FORM_ENTRIES B WHERE B.FORM_ELEMENT_ID = " & intFormFieldId & " AND B.FORM_SUBMISSION_ID = A.FORM_SUBMISSION_ID) IS NULL"
End If
strSQLInList = strFormFieldCriteriaValue
Case intFormFieldDataTypeId = 1 Or intFormFieldDataTypeId = 3 Or intFormFieldDataTypeId = 5:
If intFormFieldOperatorId = 1 Then
strTempFilterCriteria = strTempFilterCriteria & "(LOWER(FORM_ANSWER_VALUE) IN ([SQL_IN_LIST]))) [IS_NULL]))" & vbCRLF
Else
strTempFilterCriteria = strTempFilterCriteria & "(LOWER(FORM_ANSWER_VALUE) NOT IN ([SQL_IN_LIST]))) [IS_NULL]))" & vbCRLF
strAllowNull = "OR (SELECT B.FORM_ANSWER_VALUE FROM V_DYNAMIC_FORM_ENTRIES B WHERE B.FORM_ELEMENT_ID = " & intFormFieldId & " AND B.FORM_SUBMISSION_ID = A.FORM_SUBMISSION_ID) IS NULL"
End If
strSQLInList = "'" & strFormFieldCriteriaValue & "'"
End Select
strTempFilterCriteria = Replace(strTempFilterCriteria, "[IS_NULL]", strAllowNull)
For intArrayElementCounter2 = 0 To UBound(arTempFilterCriteria)-1 Step 5
If CInt(arTempFilterCriteria(intArrayElementCounter2)) = intFormFieldId And CInt(arTempFilterCriteria(intArrayElementCounter2+2)) = intFormFieldOperatorId And intArrayElementCounter2 <> intArrayElementCounter Then
If intArrayElementCounter2 < intArrayElementCounter Then
bolConcatenateTemp = False
Exit For
Else
Select Case True
Case intFormFieldDataTypeId = 2:
strSQLInList = strSQLInList & ",'" & ConvertDateCdnToUS(arTempFilterCriteria(intArrayElementCounter2+3)) & "'"
Case intFormFieldDataTypeId = 4:
strSQLInList = strSQLInList & "," & arTempFilterCriteria(intArrayElementCounter2+3)
Case intFormFieldDataTypeId = 1 Or intFormFieldDataTypeId = 3 Or intFormFieldDataTypeId = 5:
strSQLInList = strSQLInList & ",'" & ReplaceQuotes(arTempFilterCriteria(intArrayElementCounter2+3)) & "'"
End Select
End If
End If
Next
strTempFilterCriteria = Replace(strTempFilterCriteria, "[SQL_IN_LIST]", strSQLInList)
If bolConcatenateTemp Then
strFilterCriteria = strFilterCriteria & strTempFilterCriteria & vbCRLF
End If
Else
Select Case True
Case intFormFieldDataTypeId = 2:
strFilterCriteria = strFilterCriteria & "(CAST(FORM_ANSWER_VALUE AS datetime(10)) [OPERAND] '" & ConvertDateCdnToUS(strFormFieldCriteriaValue) & "'))))" & vbCRLF
Case intFormFieldDataTypeId = 4:
strFilterCriteria = strFilterCriteria & "(ISNUMERIC(FORM_ANSWER_VALUE)=1 AND CAST(FORM_ANSWER_VALUE AS float) [OPERAND] " & strFormFieldCriteriaValue & "))))" & vbCRLF
Case intFormFieldDataTypeId = 1 Or intFormFieldDataTypeId = 3 Or intFormFieldDataTypeId = 5:
strFilterCriteria = strFilterCriteria & "(LOWER(FORM_ANSWER_VALUE) [OPERAND] '" & strFormFieldCriteriaValue & "'))))" & vbCRLF
End Select
Select Case intFormFieldOperatorId
Case 3:
strOperator = "<"
Case 4:
strOperator = "<="
Case 5:
strOperator = ">"
Case 6:
strOperator = ">="
End Select
strFilterCriteria = Replace(strFilterCriteria, "[OPERAND]", strOperator)
End If
If strMainFilterCriteria = "" Then
strMainFilterCriteria = strMainFilterCriteria & vbCRLF & "AND (FORM_SUBMISSION_ID IN (" & vbCRLF & "[SUBQUERY]" & vbCRLF & ")"
Else
If bolConcatenateTemp Then
strMainFilterCriteria = Replace(strMainFilterCriteria, "[NEXT_SUBQUERY]", (vbCRLF & "AND (FORM_SUBMISSION_ID IN (" & vbCRLF & "[SUBQUERY]" & vbCRLF & ")")) & vbCRLF
End If
End If
If bolConcatenateTemp Then
strMainFilterCriteria = Replace(strMainFilterCriteria, "[SUBQUERY]", strFilterCriteria & "[NEXT_SUBQUERY]") & vbCRLF & vbCRLF
End If
End If
Next
strMainFilterCriteria = Replace(strMainFilterCriteria, "[NEXT_SUBQUERY]", "")
Else
strMainDateCriteria = ""
strMainFilterCriteria = ""
End If
arTempSortingCriteria = Split(strSortingFieldArray, strDelimiter)
strMainSortingCriteria = "ORDER BY"
strSortingCriteria = ""
strMainDisplayCriteria = ""
strTableAliasPrefix = "A."
For intArrayElementCounter = 0 To UBound(arTempSortingCriteria)-1 Step 5
strFormFieldName = arTempSortingCriteria(intArrayElementCounter)
intFormFieldDataTypeId = CInt(arTempSortingCriteria(intArrayElementCounter+1))
bolMainSortingField = (arTempSortingCriteria(intArrayElementCounter+2)="1")
strSortingDirection = arTempSortingCriteria(intArrayElementCounter+3)
intFormFieldId = CInt(arTempSortingCriteria(intArrayElementCounter+4))
If bolMainSortingField Then
strMainSortingCriteria = strMainSortingCriteria & " " & strTableAliasPrefix & strFormFieldName & " " & strSortingDirection
Else
If strSortingCriteria <> "" Then
strSortingCriteria = strSortingCriteria & ", " & strTableAliasPrefix & strFormFieldName & " " & strSortingDirection
Else
strSortingCriteria = strSortingCriteria & strTableAliasPrefix & strFormFieldName & " " & strSortingDirection
End If
End If
If strMainDisplayCriteria <> "" Then
strMainDisplayCriteria = strMainDisplayCriteria & "," &vbCRLF
End If
Select Case intFormFieldDataTypeId
Case 2:'if the field is of date data type then...
If intFormFieldId = 0 Then
strMainDisplayCriteria = strMainDisplayCriteria & "(SELECT TOP 1 B.FORM_ANSWER_DATE_TIME FROM V_DYNAMIC_FORM_ENTRIES B WHERE B.FORM_SUBMISSION_ID = A.FORM_SUBMISSION_ID) AS " & strFormFieldName
Else
strMainDisplayCriteria = strMainDisplayCriteria & "(SELECT CAST(B.FORM_ANSWER_VALUE AS datetime) FROM V_DYNAMIC_FORM_ENTRIES B WHERE B.FORM_ELEMENT_ID = " & intFormFieldId & " AND B.FORM_SUBMISSION_ID = A.FORM_SUBMISSION_ID) AS " & strFormFieldName
End If
Case 4:'if the field is of numeric data type then...
strMainDisplayCriteria = strMainDisplayCriteria & "(SELECT CAST(B.FORM_ANSWER_VALUE AS float) FROM V_DYNAMIC_FORM_ENTRIES B WHERE B.FORM_ELEMENT_ID = " & intFormFieldId & " AND B.FORM_SUBMISSION_ID = A.FORM_SUBMISSION_ID) AS " & strFormFieldName
Case Else:'if the field is of string data type then...
strMainDisplayCriteria = strMainDisplayCriteria & "(SELECT B.FORM_ANSWER_VALUE FROM V_DYNAMIC_FORM_ENTRIES B WHERE B.FORM_ELEMENT_ID = " & intFormFieldId & " AND B.FORM_SUBMISSION_ID = A.FORM_SUBMISSION_ID) AS " & strFormFieldName
End Select
Next
If strSortingCriteria <> "" Then
strMainSortingCriteria = strMainSortingCriteria & ", " & strSortingCriteria
End If
If err.number <> 0 Then
Call ReportError("GetDynamicFormEntryQuery", err.number, err.description)
End If
On Error Goto 0
End Sub
Sub GetDynamicFormEntries(byRef intFormEntryCount, byRef rsDynamicFormEntries, byRef intPageTotal, byVal intFormEntryIncrement, byVal intPageNumber, byVal intDynamicFormId, byVal strMainDisplayCriteria, byVal strMainSortingCriteria, byVal strMainDateCriteria, byVal strMainFilterCriteria)
On Error Resume Next
Dim strDynamicFormEntries
Dim strRecordCountQuery
Dim rsRecordCount
Dim strMainDateExclusionCriteria
Dim strMainFilterExclusionCriteria
Dim strMainSortingExclusionCriteria
Dim strMainDisplayExclusionCriteria
strRecordCountQuery = "SELECT COUNT(DISTINCT A.FORM_SUBMISSION_ID) AS FORM_ENTRY_COUNT" & vbCRLF & _
"FROM V_DYNAMIC_FORM_ENTRIES A" & vbCRLF & _
"WHERE A.DYNAMIC_FORM_ID = " & intDynamicFormId & vbCRLF & _
strMainDateCriteria & vbCRLF & _
strMainFilterCriteria
Set rsRecordCount = Server.CreateObject("ADODB.recordset")
rsRecordCount.Open strRecordCountQuery, conn
intFormEntryCount = rsRecordCount("FORM_ENTRY_COUNT")
If intFormEntryCount > intFormEntryIncrement Then
If intFormEntryCount mod intFormEntryIncrement Then
intPageTotal = Fix(intFormEntryCount / intFormEntryIncrement) + 1
Else
intPageTotal = (intFormEntryCount / intFormEntryIncrement)
End If
Else
intPageTotal = 1
End If
rsRecordCount.Close
Set rsRecordCount = Nothing
strDynamicFormEntries = "SELECT DISTINCT TOP " & intFormEntryIncrement & " A.FORM_SUBMISSION_ID," & vbCRLF & _
strMainDisplayCriteria & vbCRLF & _
"FROM V_DYNAMIC_FORM_ENTRIES A" & vbCRLF & _
"WHERE A.DYNAMIC_FORM_ID = " & intDynamicFormId & vbCRLF & _
strMainDateCriteria & vbCRLF & _
strMainFilterCriteria & vbCRLF
If intPageNumber > 1 Then
strMainDisplayExclusionCriteria = Replace(strMainDisplayCriteria, "A.", "C.")
strMainDisplayExclusionCriteria = Replace(strMainDisplayExclusionCriteria, "B.", "D.")
strMainDisplayExclusionCriteria = Replace(strMainDisplayExclusionCriteria, "B WHERE", "D WHERE")
strMainDateExclusionCriteria = Replace(strMainDateCriteria, "A.", "C.")
strMainDateExclusionCriteria = Replace(strMainDateExclusionCriteria, "B.", "D.")
strMainDateExclusionCriteria = Replace(strMainDateExclusionCriteria, "B WHERE", "D WHERE")
strMainFilterExclusionCriteria = Replace(strMainFilterCriteria, "A.", "C.")
strMainFilterExclusionCriteria = Replace(strMainFilterExclusionCriteria, "B.", "D.")
strMainFilterExclusionCriteria = Replace(strMainFilterExclusionCriteria, "B WHERE", "D WHERE")
strMainSortingExclusionCriteria = Replace(strMainSortingCriteria, "A.", "C.")
strDynamicFormEntries = strDynamicFormEntries & "AND A.FORM_SUBMISSION_ID NOT IN (" & vbCRLF & _
"SELECT E.EXCLUDE_FORM_SUBMISSION_ID FROM(" & vbCRLF & _
"SELECT DISTINCT TOP " & (intFormEntryIncrement*(intPageNumber-1)) & " C.FORM_SUBMISSION_ID AS EXCLUDE_FORM_SUBMISSION_ID," & vbCRLF & _
strMainDisplayExclusionCriteria & vbCRLF & _
"FROM V_DYNAMIC_FORM_ENTRIES C" & vbCRLF & _
"WHERE C.DYNAMIC_FORM_ID = " & intDynamicFormId & vbCRLF & _
strMainDateExclusionCriteria & vbCRLF & _
strMainFilterExclusionCriteria & vbCRLF & _
strMainSortingExclusionCriteria & vbCRLF & _
") E" & vbCRLF & _
")" & vbCRLF
End If
strDynamicFormEntries = strDynamicFormEntries & strMainSortingCriteria
Set rsDynamicFormEntries = Server.CreateObject("ADODB.recordset")
rsDynamicFormEntries.Open strDynamicFormEntries, conn
If err.number <> 0 Then
Call ReportError("GetDynamicFormEntries", err.number, err.description)
End If
On Error Goto 0
End Sub
Function GetSortCriteriaArray(intDynamicFormid, strDelimiter, strUserLanguage)
On Error Resume Next
Dim rsFormElements
Dim strSortCriteriaArray
Set rsFormElements = GetFormElements(intDynamicFormid)
If Not rsFormElements.Eof Then
strSortCriteriaArray = "submission_date||2||1||asc||0||"
Do While Not rsFormElements.Eof
If rsFormElements("FORM_ELEMENT_TYPE_ID") = 2 And rsFormElements("FORM_ELEMENT_IS_USED_FOR_SORTING_IN_FORM_ENTRY_INDEX") = True Then
strSortCriteriaArray = strSortCriteriaArray & rsFormElements("FORM_ELEMENT_NAME_" & strUserLanguage) & strDelimiter
strSortCriteriaArray = strSortCriteriaArray & rsFormElements("FORM_ELEMENT_DATA_TYPE_ID") & strDelimiter
strSortCriteriaArray = strSortCriteriaArray & "0||asc||" & rsFormElements("FORM_ELEMENT_ID") & "||"
End If
rsFormElements.MoveNext
Loop
End If
rsFormElements.Close
Set rsFormElements = Nothing
GetSortCriteriaArray = strSortCriteriaArray
If err.number <> 0 Then
Call ReportError("GetSortCriteriaArray", err.number, err.description)
End If
On Error Goto 0
End Function
Sub DeleteFormEntries(strFormEntryList)
On Error Resume Next
Dim cmd
set cmd = Server.CreateObject("ADODB.Command")
set cmd.ActiveConnection = conn
cmd.CommandText = "SP_DELETE_DYNAMIC_FORM_ENTRIES"
cmd.CommandType = adCmdStoredProc
cmd.Parameters.Append cmd.CreateParameter("DYNAMIC_FORM_ID_LIST", adVarchar, adParamInput, 8000, strFormEntryList)
cmd.execute
If err.number <> 0 Then
Call ReportError("DeleteFormEntries", err.number, err.description)
End If
set cmd = nothing
On Error Goto 0
End Sub
Function GetQueryCriteria(byVal strCriteriaArray, strDelimiter)
On Error Resume Next
Dim arTempFilterCriteria
Dim strMainFilterCriteria
Dim strOperator
Dim strSQLInList
Dim bolConcatenateTemp
Dim intArrayElementCounter
Dim intArrayElementCounter2
Dim strTempFilterCriteria
Dim strFilterCriteria
Dim strFormFieldName
Dim strFormFieldCriteriaValue
Dim intFormFieldOperatorId
Dim intFormFieldDataTypeId
Dim intFormFieldId
If strCriteriaArray <> "" Then
arTempFilterCriteria = Split(strCriteriaArray, strDelimiter)
strMainFilterCriteria = ""
For intArrayElementCounter = 0 To UBound(arTempFilterCriteria)-1 Step 5
intFormFieldId = CInt(arTempFilterCriteria(intArrayElementCounter))
intFormFieldDataTypeId = CInt(arTempFilterCriteria(intArrayElementCounter+1))
intFormFieldOperatorId = CInt(arTempFilterCriteria(intArrayElementCounter+2))
strFormFieldCriteriaValue = arTempFilterCriteria(intArrayElementCounter+3)
If intFormFieldDataTypeId = 2 And Len(strFormFieldCriteriaValue) < 10 Then
strFormFieldCriteriaValue = TenCharDate(strFormFieldCriteriaValue)
End If
strFormFieldName = arTempFilterCriteria(intArrayElementCounter+4)
strFilterCriteria = ""
strFilterCriteria = " " & strFilterCriteria & " - " & strFormFieldName & vbCRLF
bolConcatenateTemp = True
strTempFilterCriteria = ""
If intFormFieldOperatorId = 1 Or intFormFieldOperatorId = 2 Then
If intFormFieldOperatorId = 1 Then
strTempFilterCriteria = strTempFilterCriteria & " = ([SQL_IN_LIST])"
Else
strTempFilterCriteria = strTempFilterCriteria & " <> ([SQL_IN_LIST])"
End If
If intFormFieldDataTypeId = 2 Then
strSQLInList = "'" & strFormFieldCriteriaValue & "'"
Else
strSQLInList = "'" & strFormFieldCriteriaValue & "'"
End If
For intArrayElementCounter2 = 0 To UBound(arTempFilterCriteria)-1 Step 5
If CInt(arTempFilterCriteria(intArrayElementCounter2)) = intFormFieldId And CInt(arTempFilterCriteria(intArrayElementCounter2+2)) = intFormFieldOperatorId And intArrayElementCounter2 <> intArrayElementCounter Then
If intArrayElementCounter2 < intArrayElementCounter Then
bolConcatenateTemp = False
Exit For
Else
Select Case True
Case intFormFieldDataTypeId = 2:
If intFormFieldOperatorId = 1 Then
strSQLInList = strSQLInList & " OR " & arTempFilterCriteria(intArrayElementCounter2+3) & vbCRLF
Else
strSQLInList = strSQLInList & " AND " & arTempFilterCriteria(intArrayElementCounter2+3) & vbCRLF
End If
Case Else:
If intFormFieldOperatorId = 1 Then
strSQLInList = strSQLInList & " OR " & "'" & arTempFilterCriteria(intArrayElementCounter2+3) & "'" & vbCRLF
Else
strSQLInList = strSQLInList & " AND " & "'" & arTempFilterCriteria(intArrayElementCounter2+3) & "'" & vbCRLF
End If
End Select
End If
End If
Next
strTempFilterCriteria = Replace(strTempFilterCriteria, "[SQL_IN_LIST]", strSQLInList)
If bolConcatenateTemp Then
strFilterCriteria = strFilterCriteria & strTempFilterCriteria & vbCRLF
End If
Else
Select Case True
Case intFormFieldDataTypeId = 2:
strFilterCriteria = strFilterCriteria & " [OPERAND] '" & strFormFieldCriteriaValue & "'" & vbCRLF
Case Else:
strFilterCriteria = strFilterCriteria & " [OPERAND] '" & strFormFieldCriteriaValue & "'" & vbCRLF
End Select
Select Case intFormFieldOperatorId
Case 3:
strOperator = "<"
Case 4:
strOperator = "<="
Case 5:
strOperator = ">"
Case 6:
strOperator = ">="
End Select
strFilterCriteria = Replace(strFilterCriteria, "[OPERAND]", strOperator)
End If
If bolConcatenateTemp Then
strMainFilterCriteria = strMainFilterCriteria & strFilterCriteria
End If
Next
End If
GetQueryCriteria = strMainFilterCriteria
If err.number <> 0 Then
Call ReportError("GetQueryCriteria", err.number, err.description)
End If
On Error Goto 0
End Function
Function GetSubmissionDate(intSubmissionId)
On Error Resume Next
dim cmd
set cmd = Server.CreateObject("ADODB.Command")
set cmd.ActiveConnection = conn
cmd.CommandText = "SP_GET_SUBMISSION_DATE"
cmd.CommandType = adCmdStoredProc
cmd.Parameters.Append cmd.CreateParameter("FORM_SUBMISSION_DATE", adDBTimeStamp, adParamOutput)
cmd.Parameters.Append cmd.CreateParameter("FORM_SUBMISSION_ID", adInteger, adParamInput, , intSubmissionId)
cmd.execute
GetSubmissionDate = cmd.Parameters("FORM_SUBMISSION_DATE")
If err.number <> 0 Then
Call ReportError("GetSubmissionDate", err.number, err.description)
End If
set cmd = nothing
On Error Goto 0
End Function
Function TenCharDate(strSubmittedValue)
Dim intForeSlashPos1
Dim intForeSlashPos2
Dim strDay
Dim strMonth
Dim strYear
intForeSlashPos1 = InStr(strSubmittedValue,"/")
intForeSlashPos2 = InStrRev(strSubmittedValue,"/")
strDay = Mid(strSubmittedValue, 1, intForeSlashPos1-1)
If Len(strDay) < 2 Then
strDay = "0" & strDay
End If
strMonth = Mid(strSubmittedValue, intForeSlashPos1+1, intForeSlashPos2-(intForeSlashPos1+1))
If Len(strMonth) < 2 Then
strMonth = "0" & strMonth
End If
strYear = Right(strSubmittedValue, 4)
TenCharDate = strDay & "/" & strMonth & "/" & strYear
If err.number <> 0 Then
Call ReportError("TenCharDate", err.number, err.description)
End If
End Function
Function GetSubmitButtonCaption(intDynamicFormId, strLang)
On Error Resume Next
Dim rdDynamicForm
Set rdDynamicForm = GetDynamicForm(intDynamicFormId)
GetSubmitButtonCaption = rdDynamicForm("DYNAMIC_FORM_SUBMIT_BUTTON_" & strLang)
rdDynamicForm.Close
Set rdDynamicForm = Nothing
If err.number <> 0 Then
Call ReportError("GetSubmitButtonCaption", err.number, err.description)
End If
set cmd = nothing
On Error Goto 0
End Function
Function GetDetailsReportHTML(strUserLanguage, intDynamicFormId, strMainFilterCriteria, strMainDateCriteria)
On Error Resume Next
Dim strHTML
Dim strSQL
Dim rsDetails
Dim intCurrentSubmissionId
Dim intFormCounter
Dim strPreviousQuestion
Dim intQuestionCounter
intQuestionCounter = 0
strPreviousQuestion = ""
strHTML = ""
intCurrentSubmissionId = 0
strSQL = "SELECT * " & vbCRLF & _
"FROM V_DYNAMIC_FORM_ENTRIES A" & vbCRLF & _
"WHERE A.DYNAMIC_FORM_ID = " & intDynamicFormId & vbCRLF & _
strMainDateCriteria & vbCRLF & _
strMainFilterCriteria & vbCRLF & _
"AND A.FORM_SUBMISSION_ID IN (" & vbCRLF & _
"SELECT DISTINCT TOP " & intFormEntryIncrement & " B.FORM_SUBMISSION_ID " & vbCRLF & _
"FROM V_DYNAMIC_FORM_ENTRIES B" & vbCRLF & _
"WHERE B.DYNAMIC_FORM_ID = " & intDynamicFormId & vbCRLF
If intPageNumber > 1 Then
intFormCounter = 0
Dim strMainDateExclusionCriteria
strMainDateExclusionCriteria = Replace(strMainDateCriteria, "A.", "C.")
strMainDateExclusionCriteria = Replace(strMainDateExclusionCriteria, "B.", "D.")
strMainDateExclusionCriteria = Replace(strMainDateExclusionCriteria, "B WHERE", "D WHERE")
Dim strMainFilterExclusionCriteria
strMainFilterExclusionCriteria = Replace(strMainFilterCriteria, "A.", "C.")
strMainFilterExclusionCriteria = Replace(strMainFilterExclusionCriteria, "B.", "D.")
strMainFilterExclusionCriteria = Replace(strMainFilterExclusionCriteria, "B WHERE", "D WHERE")
strSQL = strSQL & "AND B.FORM_SUBMISSION_ID NOT IN (" & vbCRLF & _
"SELECT DISTINCT TOP " & (intFormEntryIncrement*(intPageNumber-1)) & " C.FORM_SUBMISSION_ID AS EXCLUDE_FORM_SUBMISSION_ID" & vbCRLF & _
"FROM V_DYNAMIC_FORM_ENTRIES C" & vbCRLF & _
"WHERE C.DYNAMIC_FORM_ID = " & intDynamicFormId & vbCRLF & _
strMainDateExclusionCriteria & vbCRLF & _
strMainFilterExclusionCriteria & vbCRLF & _
")" & vbCRLF
intFormCounter = intFormEntryIncrement*(intPageNumber-1)
End If
strSQL = strSQL & ")" & vbCRLF
Set rsDetails = Server.CreateObject("ADODB.recordset")
rsDetails.Open strSQL, conn
If rsDetails.EOF = False Then
strHTML = strHTML & "
" & VBCrLf
Do Until rsDetails.EOF
If rsDetails("FORM_ELEMENT_TYPE_ID") <> 1 Then
If intCurrentSubmissionId <> rsDetails("FORM_SUBMISSION_ID") Then
intQuestionCounter = 0
strHTML = strHTML & "
" & VBCrLf
Else
If strPreviousQuestion <> rsDetails("FORM_ELEMENT_NAME_EN") Then
strHTML = strHTML & "
" & VBCrLf
strHTML = strHTML & "
" & VBCrLf
strHTML = strHTML & "
" & VBCrLf
End If
End If
If strPreviousQuestion <> rsDetails("FORM_ELEMENT_NAME_EN") Then
intQuestionCounter = intQuestionCounter + 1
strHTML = strHTML & "
" & VBCrLf
strPreviousQuestion = rsDetails("FORM_ELEMENT_NAME_EN")
intCurrentSubmissionId = rsDetails("FORM_SUBMISSION_ID")
End If
rsDetails.MoveNext
Loop
rsDetails.Close
End If
Set rsDetails = Nothing
GetDetailsReportHTML = strHTML & "
" & VBCrLf
If err.number <> 0 Then
Call ReportError("GetDetailsReportHTML", err.number, err.description)
End If
On Error Goto 0
End Function
Function GetSummaryReportHTML(intFormEntryCount, strUserLanguage, intDynamicFormId, strMainFilterCriteria, strMainDateCriteria)
On Error Resume Next
Dim strImageId
Dim strHTML
Dim strSQL
strSQL = ""
strHTML = ""
Dim rsElements, rsSummary
Dim intElementCounter
intElementCounter = 0
Set rsElements = GetFormElements(intDynamicFormid)
If rsElements.Eof = False Then
strHTML = strHTML & "
" & VBCrLf
Do Until rsElements.Eof
If rsElements("FORM_ELEMENT_TYPE_ID") <> 1 Then
intElementCounter = intElementCounter + 1
If intElementCounter <> 1 Then
strHTML = strHTML & "
" & VBCrLf
strHTML = strHTML & "
" & VBCrLf
strHTML = strHTML & "
" & VBCrLf
End If
If rsElements("FORM_ELEMENT_FORMAT_ID") < 4 Then
strHTML = strHTML & "
" & VBCrLf
End If
strSQL = GetSummarySQL(intDynamicFormId, rsElements("FORM_ELEMENT_ID"), strMainDateCriteria, strMainFilterCriteria)
Set rsSummary = Server.CreateObject("ADODB.recordset")
rsSummary.Open strSQL, conn
If rsSummary.EOF = False Then
Do Until rsSummary.EOF
strHTML = strHTML & "
" & VBCrLf
strHTML = strHTML & "
" & VBCrLf
strHTML = strHTML & "
" & VBCrLf
If rsElements("FORM_ELEMENT_FORMAT_ID") < 4 Then
If rsElements("FORM_ELEMENT_FORMAT_ID") <> 2 Then
strImageId = strImageId + 1
If strImageId > 4 Then
strImageId = 1
End If
strHTML = strHTML & "
" & VBCrLf
End If
rsSummary.MoveNext
Loop
rsSummary.Close
Else
strHTML = strHTML & "
" & VBCrLf
strHTML = strHTML & "
" & VBCrLf
If strUserLanguage = "fr" Then
strHTML = strHTML & "Aucune réponse on été fournis encore." & VBCrLf
Else
strHTML = strHTML & "No answers have yet been submitted." & VBCrLf
End If
strHTML = strHTML & "
" & VBCrLf
strHTML = strHTML & "
" & VBCrLf
End If
End If
rsElements.MoveNext
Loop
Set rsSummary = Nothing
rsElements.Close
End If
Set rsElements = Nothing
GetSummaryReportHTML = strHTML & "
" & VBCrLf
If err.number <> 0 Then
Call ReportError("GetSummaryReportHTML", err.number, err.description)
End If
On Error Goto 0
End Function
Function GetSummarySQL(intDynamicFormId, intElementId, strMainDateCriteria, strMainFilterCriteria)
On Error Resume Next
Dim strSQL
strSQL = ""
strSQL = "SELECT DISTINCT GB.FORM_ANSWER_VALUE, " & vbCRLF & _
"GB.FORM_VALUE_COUNT, " & vbCRLF & _
"GB.RADIO_SUM," & vbCRLF & _
"GB.FORM_ELEMENT_NAME_EN," & vbCRLF & _
"GB.FORM_ELEMENT_NAME_FR" & vbCRLF & _
"FROM ( " & vbCRLF & _
"SELECT DISTINCT TOP 100 PERCENT FORM_ANSWER_VALUE, FORM_ELEMENT_ID," & vbCRLF & _
"(SELECT DISTINCT COUNT(B.FORM_ANSWER_VALUE)" & vbCRLF & _
"FROM V_DYNAMIC_FORM_ENTRIES B" & vbCRLF & _
"WHERE B.FORM_ANSWER_VALUE = A.FORM_ANSWER_VALUE AND B.FORM_ELEMENT_ID = A.FORM_ELEMENT_ID" & vbCRLF & _
"AND A.DYNAMIC_FORM_ID = " & intDynamicFormId & vbCRLF & _
strMainDateCriteria & vbCRLF & _
strMainFilterCriteria & vbCRLF & _
") AS FORM_VALUE_COUNT," & vbCRLF & _
"(SELECT DISTINCT COUNT(B.FORM_ANSWER_VALUE)" & vbCRLF & _
"FROM V_DYNAMIC_FORM_ENTRIES B" & vbCRLF & _
"WHERE B.FORM_ELEMENT_ID = A.FORM_ELEMENT_ID" & vbCRLF & _
"AND B.DYNAMIC_FORM_ID = " & intDynamicFormId & vbCRLF & _
Replace(strMainDateCriteria, "A.DYNAMIC_", "B.DYNAMIC_") & vbCRLF & _
Replace(strMainFilterCriteria, "A.DYNAMIC_", "B.DYNAMIC_") & vbCRLF & _
") AS RADIO_SUM, DYNAMIC_FORM_ID, FORM_ELEMENT_DATA_TYPE_ID, " & vbCRLF & _
"FORM_ELEMENT_NAME_EN, FORM_ELEMENT_NAME_FR, FORM_ANSWER_DATE_TIME" & vbCRLF & _
"FROM V_DYNAMIC_FORM_ENTRIES A" & vbCRLF & _
"WHERE A.DYNAMIC_FORM_ID = " & intDynamicFormId & vbCRLF & _
"AND A.FORM_ELEMENT_ID = " & intElementId & vbCRLF & _
strMainDateCriteria & vbCRLF & _
strMainFilterCriteria & vbCRLF &_
"ORDER BY FORM_ANSWER_VALUE) GB" & vbCRLF
GetSummarySQL = strSQL
If err.number <> 0 Then
Call ReportError("GetSummarySQL", err.number, err.description)
End If
On Error Goto 0
End Function
Function GetSubmissionLanguage(intSubmissionId)
On Error Resume Next
dim cmd
set cmd = Server.CreateObject("ADODB.Command")
set cmd.ActiveConnection = conn
cmd.CommandText = "SP_GET_SUBMISSION_LANGUAGE"
cmd.CommandType = adCmdStoredProc
cmd.Parameters.Append cmd.CreateParameter("SUBMISSION_ID", adInteger, adParamInput, , intSubmissionId)
cmd.Parameters.Append cmd.CreateParameter("SUBMISSION_LANGUAGE", adVarchar, adParamOutput, 5)
cmd.execute
GetSubmissionLanguage = cmd.Parameters("SUBMISSION_LANGUAGE")
If err.number <> 0 Then
Call ReportError("GetSubmissionLanguage", err.number, err.description)
End If
set cmd = nothing
On Error Goto 0
End Function
Function IsBeingReferredByAURL(intDynamicFormId)
On Error Resume Next
dim cmd
set cmd = Server.CreateObject("ADODB.Command")
set cmd.ActiveConnection = conn
cmd.CommandText = "SP_CONFIRM_DYNAMIC_FORM_IS_BEING_REFERRED"
cmd.CommandType = adCmdStoredProc
cmd.Parameters.Append cmd.CreateParameter("DYNAMIC_FORM_ID", adInteger, adParamInput, , intDynamicFormId)
cmd.Parameters.Append cmd.CreateParameter("IS_REFERRED", adInteger, adParamOutput)
cmd.execute
IsBeingReferredByAURL = CBool(cmd.Parameters("IS_REFERRED"))
If err.number <> 0 Then
Call ReportError("IsBeingReferredByAURL", err.number, err.description)
End If
set cmd = nothing
On Error Goto 0
End Function
Function GetFormElementLayoutArray(byRef rsElements, byVal bolDisplayedOnAdminSide)
On Error Resume Next
Dim strElementArrayString
Dim intElementCounter
Dim intPreviousRecordNumberOfColumns
Dim intCurrentRecordsNumberOfColumns
Dim bolPreviousRowIsFull
Dim bolCurrenRowIsFull
Dim bolForInternalUse
Dim intType
intElementCounter = 0
If rsElements.EOF = False Then
Do Until rsElements.EOF
intType = rsElements("FORM_ELEMENT_TYPE_ID")
intCurrentRecordsNumberOfColumns = rsElements("FORM_ELEMENT_NUMBER_OF_COLUMNS")
bolForInternalUse = rsElements("FORM_ELEMENT_IS_FOR_INTERNAL_USE")
If (bolForInternalUse And bolDisplayedOnAdminSide) Or Not(bolForInternalUse) Then
intElementCounter = intElementCounter + 1
If intElementCounter > 1 Then
If intCurrentRecordsNumberOfColumns = 1 Or intType = 1 Then 'this new record should be on its own row
If bolPreviousRowIsFull Then
strElementArrayString = strElementArrayString & 1 & ","
bolCurrenRowIsFull = True
Else
strElementArrayString = strElementArrayString & "spacer" & "," & 1 & ","
bolCurrenRowIsFull = True
End If
Else'else the current record wants to be double columned
If bolPreviousRowIsFull Then
strElementArrayString = strElementArrayString & 2 & ","
bolCurrenRowIsFull = False
Else
strElementArrayString = strElementArrayString & 2 & ","
bolCurrenRowIsFull = True
End If
End If
Else 'this is the first record
If intCurrentRecordsNumberOfColumns = 1 Or intType = 1 Then
bolCurrenRowIsFull = True
strElementArrayString = 1 & ","
Else
bolCurrenRowIsFull = False
strElementArrayString = 2 & ","
End If
End If
bolPreviousRowIsFull = bolCurrenRowIsFull
intPreviousRecordNumberOfColumns = intCurrentRecordsNumberOfColumns
End If
rsElements.MoveNext
Loop
rsElements.Close
If bolPreviousRowIsFull = False Then
strElementArrayString = strElementArrayString & ",spacer"
End If
End If
GetFormElementLayoutArray = strElementArrayString
If err.number <> 0 Then
Call ReportError("GetFormElementLayoutArray", err.number, err.description)
End If
On Error Goto 0
End Function
Function GetFormElementLayoutTable(strElementArrayString)
On Error Resume Next
Dim strLayoutTable
Dim intElementCounter
Dim intFormElementCounter
Dim arElementArrayString
Dim strLayoutArrayItem
arElementArrayString = Split(strElementArrayString, ",")
If UBound(arElementArrayString) > 0 Then
intFormElementCounter = 0
strLayoutTable = "
" & vbCRLF
For intElementCounter = 0 To UBound(arElementArrayString) - 1
strLayoutArrayItem = Trim(arElementArrayString(intElementCounter))
If strLayoutArrayItem <> "" Then
strLayoutTable = strLayoutTable & "
" & vbCRLF
Select Case strLayoutArrayItem
Case "1":'if the item should be displayed in its own tr then...
intFormElementCounter = intFormElementCounter + 1
strLayoutTable = strLayoutTable & "
[FORM_ELEMENT_" & (intFormElementCounter) & "]
" & vbCRLF
Case "2":'if the item should be displayed in half of a tr then...
intFormElementCounter = intFormElementCounter + 1
strLayoutTable = strLayoutTable & "
" & VBCrLf
For Each objField In rsDetails.Fields
If objField.Name <> "FORM_SUBMISSION_ID" Then
intColumnCounter = intColumnCounter + 1
strHeader = strHeader & "
" & objField.Name & "
" & VBCrLf
End If
Next
Do Until rsDetails.EOF
intSubmissionCounter = intSubmissionCounter + 1
strHTML = strHTML & "
" & VBCrLf
strHTML = strHTML & "
" & intSubmissionCounter & ".
" & VBCrLf
For Each objField In rsDetails.Fields
If objField.Name <> "FORM_SUBMISSION_ID" Then
strFieldValue = rsDetails(objField.Name)
If IsNull(strFieldValue) Or Trim(strFieldValue) = "" Then
strFieldValue = " "
End If
strHTML = strHTML & "
" & strFieldValue & "
" & VBCrLf
End If
Next
strHTML = strHTML & "
" & VBCrLf
rsDetails.MoveNext
Loop
rsDetails.Close
End If
Set rsDetails = Nothing
strHTML = strHTML & "
" & VBCrLf
strHTML = Replace(strHTML, "[COLUMN_COUNT]", intColumnCounter+1)
strHTML = Replace(strHTML, "[HEADER]", strHeader)
GetHorizontalDetailsReportHTML = strHTML & VBCrLf
If err.number <> 0 Then
Call ReportError("GetHorizontalDetailsReportHTML", err.number, err.description)
End If
On Error Goto 0
End Function
Function GetAllDisplayCriteria(intDynamicFormId)
On Error Resume Next
Dim strDelimiter
Dim strUserLanguage
Dim arTempSortingCriteria
Dim strDisplayCriteria
Dim intArrayElementCounter
Dim strFormFieldName
Dim intFormFieldDataTypeId
Dim intFormFieldId
Dim intFormFieldFormatId
Dim rsFormElements
Dim strSortCriteriaArray
strDelimiter = "||"
strUserLanguage = "en"
strUserLanguage = "en"
Set rsFormElements = GetFormElements(intDynamicFormid)
If Not rsFormElements.Eof Then
strSortCriteriaArray = "submission_date||2||1||asc||0||0||"
Do While Not rsFormElements.Eof
If rsFormElements("FORM_ELEMENT_TYPE_ID") = 2 Then
strSortCriteriaArray = strSortCriteriaArray & rsFormElements("FORM_ELEMENT_NAME_" & strUserLanguage) & strDelimiter
strSortCriteriaArray = strSortCriteriaArray & rsFormElements("FORM_ELEMENT_DATA_TYPE_ID") & strDelimiter
strSortCriteriaArray = strSortCriteriaArray & "0||asc||" & rsFormElements("FORM_ELEMENT_ID") & "||"
strSortCriteriaArray = strSortCriteriaArray & rsFormElements("FORM_ELEMENT_FORMAT_ID") & "||"
End If
rsFormElements.MoveNext
Loop
End If
rsFormElements.Close
Set rsFormElements = Nothing
arTempSortingCriteria = Split(strSortCriteriaArray, strDelimiter)
strDisplayCriteria = ""
For intArrayElementCounter = 0 To UBound(arTempSortingCriteria)-1 Step 6
strFormFieldName = arTempSortingCriteria(intArrayElementCounter)
intFormFieldDataTypeId = CInt(arTempSortingCriteria(intArrayElementCounter+1))
intFormFieldId = CInt(arTempSortingCriteria(intArrayElementCounter+4))
intFormFieldFormatId = CInt(arTempSortingCriteria(intArrayElementCounter+5))
If strDisplayCriteria <> "" Then
strDisplayCriteria = strDisplayCriteria & "," &vbCRLF
End If
Select Case intFormFieldDataTypeId
Case 2:'if the field is of date data type then...
If intFormFieldId = 0 Then
strDisplayCriteria = strDisplayCriteria & "(SELECT TOP 1 B.FORM_ANSWER_DATE_TIME FROM V_DYNAMIC_FORM_ENTRIES B WHERE B.FORM_SUBMISSION_ID = A.FORM_SUBMISSION_ID) AS " & strFormFieldName
Else
If intFormFieldFormatId = 2 Then
strDisplayCriteria = strDisplayCriteria & "(SELECT dbo.MakeList(" & intFormFieldId & ", A.FORM_SUBMISSION_ID)) AS " & strFormFieldName
Else
strDisplayCriteria = strDisplayCriteria & "(SELECT CAST(B.FORM_ANSWER_VALUE AS datetime) FROM V_DYNAMIC_FORM_ENTRIES B WHERE B.FORM_ELEMENT_ID = " & intFormFieldId & " AND B.FORM_SUBMISSION_ID = A.FORM_SUBMISSION_ID) AS " & strFormFieldName
End If
End If
Case 4:'if the field is of numeric data type then...
If intFormFieldFormatId = 2 Then
strDisplayCriteria = strDisplayCriteria & "(SELECT dbo.MakeList(" & intFormFieldId & ", A.FORM_SUBMISSION_ID)) AS " & strFormFieldName
Else
strDisplayCriteria = strDisplayCriteria & "(SELECT CAST(B.FORM_ANSWER_VALUE AS float) FROM V_DYNAMIC_FORM_ENTRIES B WHERE B.FORM_ELEMENT_ID = " & intFormFieldId & " AND B.FORM_SUBMISSION_ID = A.FORM_SUBMISSION_ID) AS " & strFormFieldName
End If
Case Else:'if the field is of string data type then...
If intFormFieldFormatId = 2 Then
strDisplayCriteria = strDisplayCriteria & "(SELECT dbo.MakeList(" & intFormFieldId & ", A.FORM_SUBMISSION_ID)) AS " & strFormFieldName
Else
strDisplayCriteria = strDisplayCriteria & "(SELECT B.FORM_ANSWER_VALUE FROM V_DYNAMIC_FORM_ENTRIES B WHERE B.FORM_ELEMENT_ID = " & intFormFieldId & " AND B.FORM_SUBMISSION_ID = A.FORM_SUBMISSION_ID) AS " & strFormFieldName
End If
End Select
Next
GetAllDisplayCriteria = strDisplayCriteria
If err.number <> 0 Then
Call ReportError("GetAllDisplayCriteria", err.number, err.description)
End If
On Error Goto 0
End Function
%>