AnsweredAssumed Answered

XML

Question asked by B_1 on Jan 9, 2014
Latest reply on Jan 10, 2014 by B_1

Title

XML

Post

     So I have this XML ( I will post below) and I was wondering if it would be able to get it to work in FM. What the XML does is read a date that I would have entered into a field and it would convert it to MMWR week and enter it into the appropriate field. 

     Any help or ideas on how to get this converted to work on FM Pro would be amazing. 

      

      

<?xml version="1.0"?>
<component>

<?component error="true" debug="true"?>

<registration
    description="EpiWeek"
    progid="EpiWeek.WSC"
    version="1.00"
    classid="{0c470e66-a6f7-4b60-a2f2-b0bce44d5a7a}"
>
</registration>

<public>
    <method name="GetEpiWeek">
        <parameter name="InputDate" />
    </method>

    <method name="GetEpiYearWeek">
        <parameter name="InputDate" />
    </method>
</public>

<script language="VBScript">
<![CDATA[

' Program code and logic by David Nitschke

Private Function GetMMWRStart( dteDateIn ) 

    ' GetMMWRStart returns the date of the start of the MMWR year closest to Jan 01
    ' of the year passed in. It finds 01/01/yyyy first then moves forward or back
    ' the correct number of days to be the start of the MMWR year. MMWR Week #1 is 
    ' always the first week of the year that has a minimum of 4 days in the new year.
    ' If Jan. first falls on a Thurs, Fri, or Sat, the MMWRStart date returned could be
    ' greater than the date passed in so this must be checked for by the calling Sub.

    ' If Jan. first is a Mon, Tues, or Wed, the MMWRStart goes back to the last
    ' Sunday in Dec of the previous year which is the start of MMWR Week 1 for the
    ' current year.

    ' If the first of January is a Thurs, Fri, or Sat, the MMWRStart goes forward to 
    ' the first Sunday in Jan of the current year which is the start of
    ' MMWR Week 1 for the current year. For example, if the year passed
    ' in was 01/02/1998, a Friday, the MMWRStart that is returned is 01/04/1998, a Sunday
    ' Since 01/04/1998 > 01/02/1998, we must subract a year and pass Jan 1 of the new
    ' year into this function as in GetMMWRStart("01/01/1997").
    ' The MMWRStart date would then be returned as the date of the first
    ' MMWR Week of the previous year. 

    Dim dteYrBegin
    Dim dblDayOfWeek
    dteYrBegin = CDate("01/01/" & CStr(Year(dteDateIn)))
    dblDayOfWeek = Weekday(dteYrBegin)
    If dblDayOfWeek <= vbWednesday Then
        GetMMWRStart = DateAdd("d", -(dblDayOfWeek - 1), dteYrBegin)
    Else
        GetMMWRStart = DateAdd("d", ((7 - dblDayOfWeek) + 1), dteYrBegin)
    End If
End Function


Function GetEpiWeek( InputDate )
    Dim strAnswer
    Dim dteStart 
    Dim lngYear 
    Dim strYear 
    Dim dteQDate
    Dim dteQAccept
    Dim dteWkStart
    Dim dteWkEnd
    Dim intMmwrWk
    Dim intMmwrNow
    Dim intMmwrMax

    dteQDate = InputDate

    ' The following lines of code make sure that if a NULL (blank) date is passed into
    ' this function from Epi Info, that we don't cause an error to appear in Epi Info.
    ' Instead, we return a null value and exit the function.
    If IsNull(InputDate) = true Then
        GetEpiWeek = Null
        Exit Function
    End If

    dteQAccept = dteQDate 

    ' get the year
    lngYear = Year(dteQAccept)

    ' convert the year to a string
    strYear = CStr(lngYear)

    dteEndOfQYr = CDate("12/31/" & strYear)
    intEndOfYrDay = Weekday(dteEndOfQYr)

    If intEndOfYrDay < vbWednesday Then
        If (DateDiff("d", dteQAccept, dteEndOfQYr) < intEndOfYrDay) Then
            dteQAccept = CDate("01/01/" & CStr(lngYear + 1))
    End If
    End If

    dteStart = GetMMWRStart(dteQAccept)
    If dteStart > dteQAccept Then
        dteStart = GetMMWRStart(CDate("01/01/" & CStr(lngYear - 1)))
    End If
    intMmwrWk = 1 + DateDiff("w", dteStart, dteQAccept)
    strAnswer = CStr(intMmwrWk)
    if Len(strAnswer)< 2 then strAnswer = "0" & strAnswer

    GetEpiWeek = CInt(strAnswer)
End Function



Function GetEpiYearWeek( InputDate )
    Dim strAnswer
    Dim dteStart 
    Dim lngYear 
    Dim strYear 
    Dim dteQDate
    Dim dteQAccept
    Dim dteWkStart
    Dim dteWkEnd
    Dim intMmwrWk
    Dim intMmwrNow
    Dim intMmwrMax

    ' The following lines of code make sure that if a NULL (blank) date is passed into
    ' this function from Epi Info, that we don't cause an error to appear in Epi Info.
    ' Instead, we return a null value and exit the function.
    If IsNull(InputDate) = true Then
        GetEpiYearWeek = Null
        Exit Function
    End If

    dteQDate = InputDate

    strAnswer = GetEpiWeek( dteQDate ) 

    lngYear = Year(dteQDate)
    strYear = CStr(lngYear) 
    if Len(strAnswer)< 2 then strAnswer = "0" & strAnswer

    ' the following two IF statements check to see if the year doesn't logically match
    ' the week number, and if so, does the appropriate modifications.
    If CInt(strAnswer) >= 52 and Month(dteQDate) = 1 Then
        strYear = CStr(lngYear - 1)
    End If

    If CInt(strAnswer) = 01 and Month(dteQDate) = 12 Then
        strYear = CStr(lngYear + 1)
    End If

    ' format the answer to match the EpiYearWeek function from the EIEpiWk.DLL file
    strAnswer = strYear & ":" & strAnswer

    GetEpiYearWeek = strAnswer

End Function


]]>
</script>
</component>

      

      

      

Outcomes