JustCode : Delete a vdata record

This sub shows us how to delete a vdata record from a survey. It has 3 parms that you need to pass in. You will also need to enter a valid SQL user login & password.

 
' sSurvey: The name of the survey that is to be used.
' sID: The Respondent.serial that is to be deleted.
' sServer: The name or the IP of the SQL server
' ****************************************
' Designed by : Smarter Dimensions
' Last Updated : 8th July 2009
' Sub to delete a vdata record
' ****************************************

Sub DeleteVDataRecord(sSurvey,sID,sServer)

    Set oConnection = CreateObject("ADODB.Connection")

    oConnection.ConnectionString = "Provider=mrOleDB.Provider.2;Data Source=mrRdbDsc2;Location='Provider=SQLOLEDB.1;Password=XXXXXX;Persist Security Info=True;User ID=XX;Initial Catalog=" + sSurvey + ";Data Source=" + sServer + "';Initial Catalog=\" + sServer + "SPSSMR_FMROOTMaster" + sSurvey + "" + sSurvey + ".mdd;MR Init Project=" + sSurvey

    oConnection.Open()

    If ( oConnection.State = 1 ) Then

        Set oRecordset = CreateObject("ADODB.Recordset")
        oRecordset.Open("DELETE FROM VDATA WHERE Respondent.serial = '" + sID + "'" ,oConnection,3,1)
        Set oRecordset = Null

    End If

    oConnection.Close()
    Set oConnection = Null

End Sub

JustCode : Randomize Cats V1

This function will randomize categories and make sure that some do not sit next to each other.

 Metadata(en-US, Question, Label)
q1loop "blah" loop
{
_1 "_1",
_2 "_2",
_3 "_3",
_4 "_4",
_5 "_5",
_6 "_6",
_7 "_7",
_8 "_8",
_9 "_9"
} fields -
(
q1 ""
categorical [1..1]
{
_1 "_1",
_2 "_2",
_3 "_3",
_4 "_4",
_5 "_5"
};

) expand;
End Metadata

And in the routing

Routing(Web)

Dim i

    q1loop.Categories.Order = OrderConstants.oCustom
    For i = 1 to 20   ' test 20 times
        q1loop.Categories.Filter = RanNotTogether(q1loop,{_3,_4,_5},Null)
        q1loop[..].q1.Response.Initial = {_1}
        q1loop.Ask()
    Next

'! Returns a category list of all categories in question.categories
where none of the categories in notTogether are next to one another
Caution should be taken to ensure that there is enough room to allow for
the notTogether codes to be separated by at least one other code
For example, a question with 9 items having 5 items that can't be together
is not possible.
ARGS:  question - question whose categories are used
notTogether - category list of categories that cannot appear together
seed - if not Null, then used as the random seed
RETURNS:  category list randomized so that none of the notTogether categories are next to each other
EXAMPLE:
q10loop.Categories.Order = OrderConstants.oCustom
q10loop.Categories.Filter = RanNotTogether,q10loop,{coke,pepsi,rccola},Null)
!'

Function RanNotTogether(question,notTogether,seed)
    Dim randomCodes,notTogetherCodes
    Dim randomCodeList,randomCode,codeCount
    Dim FinalArray[],strFilter

    ' Make array large enough for all categories
    ReDim(FinalArray,question.Categories.Count)

    ' Initialize array to blanks
    For codeCount = LBound(FinalArray) to UBound(FinalArray)
        FinalArray[codeCount] = ""
    Next

    ' Codes allowed to be together
    randomCodes = SelectRange(question.Categories - notTogether)

    ' Codes not allowed to be together
    notTogetherCodes = SelectRange(notTogether)

    codeCount = 0
    ' Place codes not allowed to be next to each other
    If ( seed is not null ) Then SetRandomSeed(seed)
    randomCodeList = ransequence(0,UBound(FinalArray),1)

    For Each randomCode in randomCodeList
        Select Case ( randomCode )
            Case 0 ' Can't have any to right
                If FinalArray[randomCode + 1] = "" Then
                    FinalArray[randomCode] = notTogetherCodes[codeCount]
                    codeCount = codeCount + 1
                End If
            Case UBound(FinalArray) ' Can't have any to left
                If FinalArray[randomCode - 1] = "" Then
                    FinalArray[randomCode] = notTogetherCodes[codeCount]
                    codeCount = codeCount + 1
                End If
            Case Else ' Can't have any to right or left
                If FinalArray[randomCode + 1] = "" And FinalArray[randomCode - 1] = "" Then
                    FinalArray[randomCode] = notTogetherCodes[codeCount]
                    codeCount = codeCount + 1
                End If
        End Select

        ' If placed all those that can't be together, then get out of loop
        if ( codeCount > UBound(notTogetherCodes) ) Then Exit For
    Next

    ' Add the remaining codes
    codeCount = 0
    For Each randomCode in randomCodeList
        ' If haven't used this position, then put in the next remaining code
        If FinalArray[randomCode] = "" Then
            FinalArray[randomCode] = randomCodes[codeCount]
            codeCount = codeCount + 1
        End If
    Next

    ' convert to a categorical list and return
    strFilter = ""
    For codeCount = LBound(FinalArray) to UBound(FinalArray)
        strFilter = strFilter + question.Categories[CCategorical(FinalArray[codeCount])].Name + ","
    Next
    RanNotTogether = CCategorical("{" + Left(strFilter,Len(strFilter)-1) + "}")
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 : 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 Empty columns of data

This mrs script shows you how you can use mrs files to make and run a dms file that will strip out any columns that do not have any data in.

Step 1: Open the VQ file and make an MDD FILE.

Dim mrDSCs, mrMdsc, oDoc,sVQ

sVQ = "C:\temp\FILE"
    Set mrMdsc = createobject("mrdscreg.components")
    Set mrMDSC = mrMdsc["mrScDsc"]

    Set oDoc = mrMdsc.Metadata.Open(sVQ + ".vq")
        oDoc.Save(sVQ + ".mdd")
        oDoc.Close()

Set oDoc = Null

Step 2: Take the MDD file and loop the variable instances


Dim oMDM, oVar
Dim sSQL,oConnection,oRecordset

' Create the MDM object
Set oMDM = CreateObject("MDM.Document")
    oMDM.Open("C:\temp\FILE.mdd", , 1)

    For Each oVar in oMDM.Variables
        'if oVar.IsSystem = False then
            debug.Log("Question Name : " + oVar.FullName)

            ' Start code to check if the field has data in it.
            Set oConnection = CreateObject("ADODB.Connection")
                oConnection.ConnectionString = "Provider=mrOleDB.Provider.2;Data Source=mrScDSC;Location=C:\temp\FILE.VQ;Initial Catalog=C:\temp\FILE.mdd"
                oConnection.Open()

            If ( oConnection.State = 1 ) Then
                Set oRecordset = CreateObject("ADODB.Recordset")
                    oRecordset.Open("SELECT count(respondent.serial) FROM VDATA WHERE " + oVar.FullName + " is not null" ,oConnection,3,1)
                    If ( oRecordset.EOF = true and oRecordset.BOF = true ) Then
                        sSQL = sSQL
                    ELSE
                        sSQL = sSQL + oVar.FullName + ","
                    End if
                Set oRecordset = Null

            End If

            oConnection.Close()
            Set oConnection = Null
    ' end if
Next

oMDM.Close()
sSQL = Left(sSQL,len(sSQL)-1)
debug.Log(sSQL)

Step 3: Create the dms file with the select statement in it.


Dim oFSO, oFile

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set oFile = oFSO.CreateTextFile("C:\temp\FILE.dms", True)


oFile.WriteLine("InputDatasource(Input, """")")
oFile.WriteLine("    ConnectionString = ""Provider=mrOleDB.Provider.2;Data Source=mrScDSC;Location=C:\temp\FILE.vq;Initial Catalog=C:\temp\FILE.mdd"" ")
oFile.WriteLine("    SelectQuery = ""SELECT " + sSQL + " FROM VDATA""")
oFile.WriteLine("End InputDatasource")
oFile.WriteLine("")
oFile.WriteLine("OutputDatasource(Output, """")")
oFile.WriteLine("    ConnectionString = ""Provider=mrOleDB.Provider.2;Data Source=mrSavDsc;Location=C:\temp\Final.sav""")
oFile.WriteLine("    MetaDataOutputName = ""C:\temp\Final.mdd""")
oFile.WriteLine("End OutputDatasource")

oFile.Close()

Set oFSO = Null

Step 4: Run the file


Dim oDMOMJob

Set oDMOMJob = CreateObject("DMOM.Job")

oDMOMJob.Load("C:\temp\FILE.dms", null)

oDMOMJob.Run()

Just Code : Run MRS from an MRS

This shows us how we can run an MRS from within an MRS file.

Dim oScriptEngine, sScript, oProgram, sResult

' Define the test script
sScript = "Dim x, y, result" + mr.CrLf + _
"x = ""Hello """ + mr.CrLf + _
"y = ""World""" + mr.CrLf + _
"result = x + y"

' Create the script engine and parse
Set oScriptEngine = CreateObject("mrScript.ScriptEngine")

Set oProgram = oScriptEngine.Parsers[0].Parse(sScript, oScriptEngine, 0)

' Execute the script
oScriptEngine.Execute(oProgram, 0)

' Get the result variable value
sResult = oProgram.Variables["result"]  
%d bloggers like this: