JustCode : Connect to a Survey and find a record

This code will show you how to connect to a data collection survey and find a specific record. Once found the function will return the ID of the found record.

This is the metadata

Metadata(en-AU, Question, Label)
    ConnectionInfo "{Info}" info;
    Name "Name" text;
End Metadata 

This is the Routing

 
Routing(Web1)

    Dim oInfo

    Set oInfo = CreateObject("Scripting.Dictionary")

    oInfo.Add("Message","")
    oInfo.Add("ID",-1)

    Set oInfo = FindVDataRecord("SERVERNAME","ADO","VDATA","Respondent.Serial","Name = 'Test'","LOGIN","PASSWORD",oInfo)

    ConnectionInfo.Label.Inserts["Info"] = Ctext(oInfo.item["Message"])
    ConnectionInfo.Show()

    If ( oInfo.item["ID"] <> -1  )  Then
        ' Do something
    End If

Name.Ask()

Function FindVDataRecord(sServer,sDatabase,sTable,sKey,sWhere,sUser,sPassword,oReturnObject)

Dim oConnection, oRecordset
Dim sInfo , sConnection, sSQL

On Error Goto ErrorMessage

    Set oConnection = CreateObject("ADODB.Connection")

        sConnection = "Provider=mrOleDB.Provider.2;Data Source=mrRdbDsc2;"
        sConnection = sConnection + "Location='Provider=SQLOLEDB.1;Password=" + sPassword
        sConnection = sConnection + ";Persist Security Info=True;User ID="
        sConnection = sConnection + sUser + ";Initial Catalog=" + sDatabase
        sConnection = sConnection + ";Data Source=" + sServer
        sConnection = sConnection + "';Initial Catalog=\\" + sServer
        sConnection = sConnection + "SPSSMR_FMROOT\Master" + sDatabase + ""
        sConnection = sConnection + sDatabase + ".mdd;MR Init Project=" + sDatabase

    oConnection.Open(sConnection)

    If ( oConnection.State = 1 ) Then
        sInfo = "Connection to the Database worked"
        Set oRecordset = CreateObject("ADODB.Recordset")

        sSQL = "SELECT " + sKey + " FROM " + sTable + " WHERE " + sWhere
        oRecordSet.Open(sSQL,oConnection,3,1)
        If ( oRecordSet.EOF = true and oRecordset.BOF = true ) Then
            sInfo = sInfo + "Name Not Found"
            oReturnObject.Remove("ID")
            ReturnObject.Add("ID", -1)
        Else
            sInfo = sInfo + "Name Found !!!"
            oReturnObject.Remove("ID")
            oReturnObject.Add("ID", oRecordset[sKey].Value)
        End if

        oRecordset.Close()
        oReturnObject.Remove("Message")
        oReturnObject.Add("Message", sInfo)

    Else
        oReturnObject.Remove("Message")
        oReturnObject.Add("Message", "Connection to the Database failed")
    End If

    oConnection.Close()

Goto EndOfFunction

ErrorMessage:

    sInfo = sInfo + "Error : "
    sInfo = sInfo + Err.Description + ""
    sInfo = sInfo + CTEXT(Err.LineNumber)
    oReturnObject.Remove("Message")
    oReturnObject.Add("Message", sInfo)

EndOfFunction:

    Set oConnection = Null
    Set FindVDataRecord = oReturnObject

End Function

End Routing

JustCode : Connect and insert a record into a SQL table

This code will show you how to insert a record into a standard SQL table passing in values collected from a Data Collection Survey.

This is the metadata

Metadata(en-AU, Question, Label)
    ConnectionInfo "{Info}" info;
    Name "Name" text;
End Metadata

This is the routing

Routing(Web3)

    Dim oInfo
    Set oInfo = CreateObject("Scripting.Dictionary")
        oInfo.Add("Message","")
        oInfo.Add("ID",-1)

    Name.Ask()

   ' Lets Insert the Record
   Set oInfo = InsertDataRecord("MyServer","Participants", _
        "Names","ID,UserName", _
        CTEXT(iom.Info.Serial) + ",'" + Name.Response.Value + "'", _
        "MyAdmin","ABC",oInfo)

   ConnectionInfo.Label.Inserts["Info"] = Ctext(oInfo.item["Message"])
   ConnectionInfo.Show()

Function InsertDataRecord(sServer,sDatabase,sTable, _
    sFields,sValues,sUser,sPassword,oReturnObject)

Dim oConnection, oRecordset
Dim sInfo ,sConnection, sSQL

On Error Goto ErrorMessage

    Set oConnection = CreateObject("ADODB.Connection")

        sConnection = "Provider=SQLOLEDB.1;Persist Security Info=-1;"
        sConnection = sConnection + "Password=" + sPassword + ";"
        sConnection = sConnection + "User ID=" + sUser + ";"
        sConnection = sConnection + "Initial Catalog=" + sDatabase + ";"
        sConnection = sConnection + "Data Source=" + sServer

    oConnection.Open(sConnection)

    If ( oConnection.State = 1 ) Then

        sSQL = "INSERT INTO " + sTable + " (" + sFields + ") VALUES " + "(" + sValues + ")"

        oConnection.Execute(sSQL)

        oReturnObject.Remove("Message")
        oReturnObject.Add("Message", "Connection to the Database worked, Insert Complete")

    Else

        oReturnObject.Remove("Message")
        oReturnObject.Add("Message", "Connection to the Database failed")

    End If

    oConnection.Close()

    Goto EndOfFunction

ErrorMessage:

    sInfo = sInfo + "Error : "
    sInfo = sInfo + Err.Description + ""
    sInfo = sInfo + CTEXT(Err.LineNumber)
    oReturnObject.Remove("Message")
    oReturnObject.Add("Message", sInfo)

EndOfFunction:

    Set oConnection = Null
    Set InsertDataRecord = oReturnObject

End Function

End Routing

JustCode : Update a record in a SQL Table

In this example we will show you how to update a record in a VDATA table.

 
This is the routing we used:

Routing(Web2)
    Dim oInfo

    Set oInfo = CreateObject("Scripting.Dictionary")
        oInfo.Add("Message","")
        oInfo.Add("ID",-1)

    Set oInfo = FindVDataRecord("MyServer","ADO","VDATA","Respondent.Serial","Name = 'Test'","MyAdmin","ABCD",oInfo)

    ConnectionInfo.Label.Inserts["Info"] = Ctext(oInfo.item["Message"])
    ConnectionInfo.Show()

    If ( oInfo.item["ID"] <> -1  )  Then

        ' Lets Update the Record
        Set oInfo = UpdateVDataRecord("MyServer","ADO","VDATA","Name = 'DELETE'","Respondent.Serial = " + CTEXT(oInfo.item["ID"]),"MyAdmin","ABCD",oInfo)
        ConnectionInfo.Label.Inserts["Info"] = Ctext(oInfo.item["Message"])
        ConnectionInfo.Show()
    End If

    Name.Ask()


Function InsertVDataRecord(sServer,sDatabase,sTable,sFields,sValues,sUser,sPassword,oReturnObject)
    Dim oConnection, oRecordset
    Dim sInfo ,sConnection, sSQL

On Error Goto ErrorMessage

    Set oConnection = CreateObject("ADODB.Connection")

        sConnection = "Provider=mrOleDB.Provider.2;Data Source=mrRdbDsc2;"
        sConnection = sConnection + "Location='Provider=SQLOLEDB.1;Password=" + sPassword
        sConnection = sConnection + ";Persist Security Info=True;User ID="
        sConnection = sConnection + sUser + ";Initial Catalog=" + sDatabase
        sConnection = sConnection + ";Data Source=" + sServer
        sConnection = sConnection + "';Initial Catalog=\\" + sServer
        sConnection = sConnection + "SPSSMR_FMROOT\Master" + sDatabase + ""
        sConnection = sConnection + sDatabase + ".mdd;MR Init Project=" + sDatabase

        oConnection.Open(sConnection)

        If ( oConnection.State = 1 ) Then

            sSQL = "INSERT INTO " + sTable + " (" + sFields + ") VALUES " + "(" + sValues + ")"

            oConnection.Execute(sSQL)

            oReturnObject.Remove("Message")
            oReturnObject.Add("Message", "Connection to the Database worked, Insert Complete")

        Else

            oReturnObject.Remove("Message")
            oReturnObject.Add("Message", "Connection to the Database failed")

        End If

        oConnection.Close()

    Goto EndOfFunction

ErrorMessage:

    sInfo = sInfo + "Error : "
    sInfo = sInfo + Err.Description + ""
    sInfo = sInfo + CTEXT(Err.LineNumber)
    oReturnObject.Remove("Message")
    oReturnObject.Add("Message", sInfo)

EndOfFunction:

Set oConnection = Null
Set InsertVDataRecord = oReturnObject

End Function

Function UpdateVDataRecord(sServer,sDatabase,sTable,sUpdate,sWhere,sUser,sPassword,oReturnObject)
Dim oConnection, oRecordset
Dim sInfo , sConnection, sSQL

On Error Goto ErrorMessage

Set oConnection = CreateObject("ADODB.Connection")

sConnection = "Provider=mrOleDB.Provider.2;Data Source=mrRdbDsc2;"
sConnection = sConnection + "Location='Provider=SQLOLEDB.1;Password=" + sPassword
sConnection = sConnection + ";Persist Security Info=True;User ID="
sConnection = sConnection + sUser + ";Initial Catalog=" + sDatabase
sConnection = sConnection + ";Data Source=" + sServer
sConnection = sConnection + "';Initial Catalog=\" + sServer
sConnection = sConnection + "SPSSMR_FMROOTMaster" + sDatabase + ""
sConnection = sConnection + sDatabase + ".mdd;MR Init Project=" + sDatabase

oConnection.Open(sConnection)

If ( oConnection.State = 1 ) Then

sSQL = "UPDATE " + sTable + " SET " + sUpdate + " WHERE " + sWhere

oConnection.Execute(sSQL)

oReturnObject.Remove("Message")
oReturnObject.Add("Message", "Connection to the Database worked, Update Complete.")

Else

oReturnObject.Remove("Message")
oReturnObject.Add("Message", "Connection to the Database failed")

End If

oConnection.Close()

Goto EndOfFunction

ErrorMessage:

sInfo = sInfo + "Error : "
sInfo = sInfo + Err.Description + ""
sInfo = sInfo + CTEXT(Err.LineNumber)
oReturnObject.Remove("Message")
oReturnObject.Add("Message", sInfo)

EndOfFunction:

Set oConnection = Null
Set UpdateVDataRecord = oReturnObject

End Function

Function DeleteVDataRecord(sServer,sDatabase,sTable,sWhere,sUser,sPassword,oReturnObject)
Dim oConnection, oRecordset
Dim sInfo , sConnection, sSQL

On Error Goto ErrorMessage

Set oConnection = CreateObject("ADODB.Connection")

sConnection = "Provider=mrOleDB.Provider.2;Data Source=mrRdbDsc2;"
sConnection = sConnection + "Location='Provider=SQLOLEDB.1;Password=" + sPassword
sConnection = sConnection + ";Persist Security Info=True;User ID="
sConnection = sConnection + sUser + ";Initial Catalog=" + sDatabase
sConnection = sConnection + ";Data Source=" + sServer
sConnection = sConnection + "';Initial Catalog=\" + sServer
sConnection = sConnection + "SPSSMR_FMROOT\Master" + sDatabase + ""
sConnection = sConnection + sDatabase + ".mdd;MR Init Project=" + sDatabase

oConnection.Open(sConnection)

If ( oConnection.State = 1 ) Then

sSQL = "DELETE FROM " + sTable + " WHERE " + sWhere

oConnection.Execute(sSQL)

oReturnObject.Remove("Message")
oReturnObject.Add("Message", "Connection to the Database worked, Record deleted.")
Else

oReturnObject.Remove("Message")
oReturnObject.Add("Message", "Connection to the Database failed")

End If

oConnection.Close()

Goto EndOfFunction

ErrorMessage:

sInfo = sInfo + "Error : "
sInfo = sInfo + Err.Description + ""
sInfo = sInfo + CTEXT(Err.LineNumber)
oReturnObject.Remove("Message")
oReturnObject.Add("Message", sInfo)

EndOfFunction:

Set oConnection = Null
Set DeleteVDataRecord = oReturnObject

End Function


Function FindVDataRecord(sServer,sDatabase,sTable,sKey,sWhere,sUser,sPassword,oReturnObject)
Dim oConnection, oRecordset
Dim sInfo , sConnection, sSQL

On Error Goto ErrorMessage

Set oConnection = CreateObject("ADODB.Connection")

sConnection = "Provider=mrOleDB.Provider.2;Data Source=mrRdbDsc2;"
sConnection = sConnection + "Location='Provider=SQLOLEDB.1;Password=" + sPassword
sConnection = sConnection + ";Persist Security Info=True;User ID="
sConnection = sConnection + sUser + ";Initial Catalog=" + sDatabase
sConnection = sConnection + ";Data Source=" + sServer
sConnection = sConnection + "';Initial Catalog=\" + sServer
sConnection = sConnection + "SPSSMR_FMROOTMaster" + sDatabase + ""
sConnection = sConnection + sDatabase + ".mdd;MR Init Project=" + sDatabase

oConnection.Open(sConnection)

If ( oConnection.State = 1 ) Then

sInfo = "Connection to the Database worked"

Set oRecordset = CreateObject("ADODB.Recordset")

sSQL = "SELECT " + sKey + " FROM " + sTable + " WHERE " + sWhere

oRecordSet.Open(sSQL,oConnection,3,1)
If ( oRecordSet.EOF = true and oRecordset.BOF = true ) Then
sInfo = sInfo + "Name Not Found"
oReturnObject.Remove("ID")
oReturnObject.Add("ID", -1)

Else
sInfo = sInfo + "Name Found !!!"
oReturnObject.Remove("ID")
oReturnObject.Add("ID", oRecordset[sKey].Value)

End if

oRecordset.Close()

oReturnObject.Remove("Message")
oReturnObject.Add("Message", sInfo)

Else

oReturnObject.Remove("Message")
oReturnObject.Add("Message", "Connection to the Database failed")

End If

oConnection.Close()

Goto EndOfFunction

ErrorMessage:

sInfo = sInfo + "Error : "
sInfo = sInfo + Err.Description + ""
sInfo = sInfo + CTEXT(Err.LineNumber)
oReturnObject.Remove("Message")
oReturnObject.Add("Message", sInfo)

EndOfFunction:

Set oConnection = Null
Set FindVDataRecord = oReturnObject

End Function




End Routing

JustCode : Ask a read only question

This code will show you how to display a question on the page in Readonly mode.

Metadata(en-AU, Question, label)
    Q1 "This is my text question" text;
End Metadata

and the routing

****************************************
' Designed by : Smarter Dimensions
' Last Updated : 4th August 2009
' ask a read only question
' ****************************************

Routing(Web)

' First way to make a question readonly
Q1.show()

' Second way
QDate.Style.Control.ReadOnly = True
    Q1.ask()

End Routing

JustCode : Adding AutoAnswer Hints to your MDD

This code shows you how to add AutoAnswer Hints to your MDD files.

 
Metadata(en-AU, Question, Label)
    AUTOANSWER lcl(en-AU, AutoAnswer, Label);
    '### END LCL MAP ###

    HDATA -
    [
    Template = "DefaultLayout.htm",
    TemplateLocation = "Hints_files"
    ]
    AUTOANSWER:-;

    Email "Please enter email address"
      AUTOANSWER:-
      AUTOANSWER: [ Value = "smarterDimensions@live.com.au" ]
      text;

    SingleResponseQuestion ""
      AUTOANSWER:-
      AUTOANSWER: [ Value = "D" ]
    categorical [1..1]
    {
      A "A" AUTOANSWER:-,
      B "B" AUTOANSWER:-,
      C "C" AUTOANSWER:-,
      D "D" AUTOANSWER:-,
      E "E" AUTOANSWER:-,
      F "F" AUTOANSWER:-
    };

    MultiResponseQuestion ""
      AUTOANSWER:-
      AUTOANSWER: [ AllowedCategories = "A,B,C" ]
    categorical [1..]
    {
      A "A" AUTOANSWER:-,
      B "B" AUTOANSWER:-,
      C "C" AUTOANSWER:-,
      D "D" AUTOANSWER:-,
      E "E" AUTOANSWER:-,
      F "F" AUTOANSWER:-
    };

    NumericQuestion ""
      AUTOANSWER:-
      AUTOANSWER: [ Max = 10, Min = 20 ]
    long;
End Metadata

JustCode : Delete cases from the input file of a dms script

This script shows you how to delete a record in your input file. The delete is done in the OnNextCase

' ****************************************
' Designed by : Smarter Dimensions
' Last Updated : 4th August 2009
' Delete cases from the input file of a dms script.
' ****************************************

InputDatasource(Input, "")
    ConnectionString = "Provider=mrOleDB.Provider.2; _
        Data Source=mrDataFileDsc; _
        Location=C:\temp\short_drinks.ddf; _
        MR Init MDM Access=1; _
        Initial Catalog=C:\temp\short_drinks.mdd"
    SelectQuery = "SELECT * FROM VDATA"
End InputDatasource

OutputDatasource(Output, "")
    UseInputAsOutput = "True"
End OutputDatasource

Logging(MyLog, "")
    Group = "DMA"
    Alias = "datamgmt"
    FileSize = 500
    Path = "c:\temp"
End Logging

Event(OnNextCase, "")

    If Respondent.Serial > 10 Then
       dmgrJob.DropCurrentCase()
       dmgrLog.LogError_2(Ctext(Respondent.Serial) + " - Case Deleted")
    End If

End Event

JustCode : Update a sample record

This code shows you how to update a sample record from an MRS script.

Dim oConnection

' Start code to check if the field has data in it.
    Set oConnection = CreateObject("ADODB.Connection")

' Standard Connection String You need to change this
    oConnection.ConnectionString = "Provider=SQLOLEDB.1;Password=MyPassword;Persist Security Info=-1;User ID=MyUser;Initial Catalog=Participants;Data Source=MyServer"
    oConnection.Open()

    If ( oConnection.State = 1 ) Then
        oConnection.Execute("UPDATE TABLE1 SET Queue = 'Fresh' WHERE Queue = 'Completed'")
    End If

    oConnection.Close()

Set oConnection = Null

JustCode : Strip out html from metadata context

This code will show you how to strip out html or unwanted characters from a specified context in your mdd file Via a DMS script.

Event(OnBeforeJobStart, "")

    Dim oMDM
    ' Create the MDM object and open the Short Drinks .mdd file in read-write mode
    Set oMDM = CreateObject("MDM.Document")
        oMDM.Open("C:\survey.mdd", ,2)
        oMDM.Contexts.Current = "Question"

    Dim oVar,oElement
    'Using the StripHTML funciton
    
    For Each oVar in oMDM.Variables
        if oVar.IsSystem = False then
            oVar.Label = StripHTML ( oVar.Label )
            For each oElement in oVar.Elements.Elements
                oElement.Label = StripHTML ( oElement.Label )
            Next
        end if
    Next

    'Using the StripOut function
    For Each oVar in oMDM.Variables
        if oVar.IsSystem = False then
            oVar.Label = StripOut ( oVar.Label )
            For each oElement in oVar.Elements.Elements
                oElement.Label = StripOut ( oElement.Label )
            Next
        end if
    Next

    oMDM.Save("C:\survey.mdd")
    Set oMDM = null

    Function StripHTML ( sText )
        Dim objRegExp, strOutput
        Set objRegExp = CreateObject("VBScript.RegExp")
            objRegExp.IgnoreCase = True
            objRegExp.Global = True
            objRegExp.Pattern = "< (.|n)+?>"

            'Replace all HTML tag matches with the empty string
            strOutput = objRegExp.Replace(sText, "")

            'Replace all < and > with < and >
            strOutput = Replace(strOutput, "< ", "<")
            strOutput = Replace(strOutput, ">", ">")

            StripHTML = strOutput    'Return the value of strOutput

        Set objRegExp = null
    End Function

    Function StripOut ( sText )
    ' You can use this function to hard code specific things you want to clean out the text
    Dim sAnswer
        sAnswer = sText
        ' Just repeat this line with the items you want to remove
        sAnswer = Replace(sAnswer,"[WHAT_ARE_YOU_LOOKING FOR]","")
        StripOut = sAnswer

    End Function

End Event

InputDatasource(Input, "")
    ConnectionString = "Provider=mrOleDB.Provider.2;Data Source=mrDataFileDsc;Location="C:\survey.ddf;Initial Catalog="C:\survey.mdd"
    SelectQuery = "SELECT * FROM VDATA"
End InputDatasource

OutputDatasource(Output, "")
    ConnectionString = "Provider=mrOleDB.Provider.2;Data Source=mrSavDsc;Location="C:\survey_out.sav"
    MetaDataOutputName = "C:\survey_OUT.mdd"
End OutputDatasource

JustCode : Strip out new lines from text questions

This code shows us how to strip out new lines from the text questions in our survey via a DMS script.

 
' ****************************************
' Designed by : Smarter Dimensions
' Last Updated : 30th July 2009
' Delete new lines from text questions
' ****************************************

Event(OnNextCase, "Next")
Dim iQuestionCount
    For iQuestionCount = 0 To dmgrJob.Questions.Count - 1
        If dmgrJob.Questions[iQuestionCount].response.DataType = 2 then
            dmgrJob.Questions[iQuestionCount].response.Value = dmgrJob.Questions[iQuestionCount].Replace(mr.Cr," ")
            dmgrJob.Questions[iQuestionCount].response.Value = dmgrJob.Questions[iQuestionCount].Replace(mr.lf," ")
        End If
    Next
End Event

JustCode : Delete cases from the output file of a dms script

This script shows you how to delete a case in the OnNextCase Event in the output data file.

' ****************************************
' Designed by : Smarter Dimensions
' Last Updated : 4th August 2009
' Delete cases from the output file of a dms script.
' ****************************************
InputDatasource(Input, "")
    ConnectionString = "Provider=mrOleDB.Provider.2; _
        Data Source=mrDataFileDsc; _
        Location=C:tempshort_drinks.ddf; _
        Initial Catalog=C:\temp\short_drinks.mdd"
    SelectQuery = "SELECT * FROM VDATA"
End InputDatasource

OutputDatasource(Output, "")
    ConnectionString = "Provider=mrOleDB.Provider.2; _
        Data Source=mrSAVDsc; _
        Location=C:\temp\Output.sav; _
        MR Init MDM DataSource Use=2; _
        MR Init Overwrite=1"
       MetaDataOutputName = "C:\temp\Output.MDD"
End OutputDatasource

Logging(MyLog, "")
    Group = "DMA"
    Alias = "datamgmt"
    FileSize = 500
    Path = "c:\temp"
End Logging

Event(OnNextCase, "")

    If Respondent.Serial > 10 Then
        dmgrJob.DropCurrentCase()
        dmgrLog.LogError_2(Ctext(Respondent.Serial) + " - Case Deleted")
    End If

End Event
%d bloggers like this: