Chip 1998 February/CHIP_2_98.iso/software/pelne/optionp/iis4_07.cab/BenefitList.cls

Text File | 1997-11-01 | 22KB | 712 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "BenefitList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Function SummaryForID(ByVal strFileDSN As String, ByVal lngEmployeeId As Long, _
    ByVal intBenefitYear As Integer)

    ' Define transaction context for Microsoft Transaction Server(MTS)
    Dim objContext As ObjectContext
    Set objContext = GetObjectContext

    On Error GoTo ErrorHandler

    ' Execute SQLServer Stored Procedure to return recordset. All of the methods in
    '   the BenefitList class interact with the database through Stored Procedures.
    '   Methods in the Employee class interact with the database through query strings.
    '   Both ways are demonstrated, but Stored Procedures usually run faster.
    Dim rst As New ADOR.Recordset, strSQL As String

    ' "rst.CursorLocation = adUseClient" would put the cursor work on the client of
    '   the SQLServer (in this case the Web server), which would mean less work for
    '   the database. Not used here because adUseClient requires Remote Data
    '   Service (RDS), which may not be loaded on the Web server.
    rst.CursorLocation = adUseServer
    strSQL = "EXECUTE sp_SummaryForID " & lngEmployeeId & ", " & intBenefitYear
    rst.Open strSQL, "FILEDSN=" & strFileDSN

    ' Return the recordset to the Active Server Page (ASP)
    Set SummaryForID = rst

    ' Tell MTS the work by this method is now commitable
    objContext.SetComplete
    Exit Function

ErrorHandler:
    ' This code is required to get real error messages back
    If Not rst Is Nothing Then Set rst = Nothing

    ' Tell MTS to abort the work done by this method, which will reverse all
    '   the work done by this method, and as far back up the line as defined
    '   by the calling level transaction contexts.
    objContext.SetAbort
    Err.Raise Err.Number, "BenefitList.SummaryForID()", Err.Description

End Function

Function BenefitsForID(ByVal strFileDSN As String, ByVal lngEmployeeId As Long, _
    ByVal intBenefitYear As Integer)

    Dim objContext As ObjectContext
    Set objContext = GetObjectContext

    On Error GoTo ErrorHandler

    Dim rst As New ADOR.Recordset, strSQL As String
    rst.CursorLocation = adUseServer
    strSQL = "EXECUTE sp_BenefitsForID " & lngEmployeeId & ", " & intBenefitYear
    rst.Open strSQL, "FILEDSN=" & strFileDSN

    Set BenefitsForID = rst

    objContext.SetComplete
    Exit Function

ErrorHandler:
    If Not rst Is Nothing Then Set rst = Nothing

    objContext.SetAbort
    Err.Raise Err.Number, "BenefitList.BenefitsForID()", Err.Description

End Function

Function Update(ByVal strFileDSN As String, ByVal lngEmployeeId As Long, _
     ByVal lngBenefitId As Long, ByVal lngPlanId As Long, _
     ByVal lngTaxStatusId As Long)

    Dim objContext As ObjectContext
    Set objContext = GetObjectContext

    On Error GoTo ErrorHandler

    Dim cnn As New ADODB.Connection, strSQL As String
    cnn.Open "FileDSN=" & strFileDSN
    strSQL = "EXECUTE sp_Update " & lngPlanId & ", " & lngTaxStatusId & _
        ", " & lngEmployeeId & ", " & lngBenefitId
    cnn.Execute (strSQL)

    objContext.SetComplete
    Exit Function

ErrorHandler:
    If Not cnn Is Nothing Then Set cnn = Nothing

    objContext.SetAbort
    Err.Raise Err.Number, "BenefitList.Update()", Err.Description

End Function

Function GetTotalCost(ByVal strFileDSN As String, ByVal lngEmployeeId As Long, _
    ByVal intBenefitYear As Integer, ByVal lngTaxStatusId As Long)

    Dim objContext As ObjectContext
    Set objContext = GetObjectContext

    On Error GoTo ErrorHandler

    Dim rst As New ADOR.Recordset, strSQL As String
    rst.CursorLocation = adUseServer
    strSQL = "EXECUTE sp_GetTotalCost " & lngEmployeeId & ", " & intBenefitYear & _
      ", " & lngTaxStatusId
    rst.Open strSQL, "FILEDSN=" & strFileDSN

    objContext.SetComplete
    If Not IsNull(rst("TotalCost")) Then
      GetTotalCost = rst("TotalCost")
    Else
      GetTotalCost = 0
    End If

    Exit Function

ErrorHandler:
    If Not rst Is Nothing Then Set rst = Nothing

    objContext.SetAbort
    Err.Raise Err.Number, "BenefitList.GetTotalCost()", Err.Description

End Function

Function GetTotalCredits(ByVal strFileDSN As String, ByVal lngEmployeeId As Long, _
    ByVal intBenefitYear As Integer)

    Dim objContext As ObjectContext
    Set objContext = GetObjectContext

    On Error GoTo ErrorHandler

    Dim rst As New ADOR.Recordset, strSQL As String
    rst.CursorLocation = adUseServer
    strSQL = "EXECUTE sp_GetTotalCredits " & lngEmployeeId & ", " & intBenefitYear
    rst.Open strSQL, "FILEDSN=" & strFileDSN

    objContext.SetComplete
    If Not IsNull(rst("TotalCredits")) Then
      GetTotalCredits = rst("TotalCredits")
    Else
      GetTotalCredits = 0
    End If

    Exit Function

ErrorHandler:
    If Not rst Is Nothing Then Set rst = Nothing

    objContext.SetAbort
    Err.Raise Err.Number, "BenefitList.GetTotalCredits()", Err.Description

End Function

Function GetTotalPaycheck(ByVal strFileDSN As String, ByVal lngEmployeeId As Long, _
    ByVal intBenefitYear As Integer)

    ' The calculations in this method probably have nothing to do with how taxes are
    '   calculated where you work. They do show the effect of pretax vs after-tax
    '   benefits. Don't use these calculations for anything real!

    Dim objContext As ObjectContext
    Set objContext = GetObjectContext

    On Error GoTo ErrorHandler

    Dim curAfterTaxCost As Currency, curPreTaxCost As Currency, _
      curTotalCredits As Currency, curPeriodEarnings As Currency, _
      intExemptions As Integer, curTotalPaycheck As Currency, _
      curAnnualEarnings As Currency, curTotalExemptions As Currency, _
      curAnnualAfterTaxCost As Currency, curAnnualPreTaxCost As Currency, _
      curTaxableEarnings As Currency, curAnnualTotalCredits

    ' When calling other methods in the same class, you can call them without
    '   "objContext.CreateInstance"
    curAfterTaxCost = GetTotalCost(strFileDSN, lngEmployeeId, intBenefitYear, 1)
    curPreTaxCost = GetTotalCost(strFileDSN, lngEmployeeId, intBenefitYear, 2)
    curTotalCredits = GetTotalCredits(strFileDSN, lngEmployeeId, intBenefitYear)

    Dim rst As New ADOR.Recordset, strSQL As String
    rst.CursorLocation = adUseServer
    strSQL = "EXECUTE sp_GetTotalPaycheck " & lngEmployeeId
    rst.Open strSQL, "FILEDSN=" & strFileDSN

    If Not IsNull(rst("PeriodEarnings")) Then
      curPeriodEarnings = rst("PeriodEarnings")
    Else
      curPeriodEarnings = 0
    End If
    If Not IsNull(rst("Exemptions")) Then
      intExemptions = rst("Exemptions")
    Else
      intExemptions = 0
    End If

    curAnnualEarnings = curPeriodEarnings * 24
    curAnnualAfterTaxCost = curAfterTaxCost * 24
    curAnnualPreTaxCost = curPreTaxCost * 24
    curAnnualTotalCredits = curTotalCredits * 24
    curTotalExemptions = intExemptions * 3000
    curTaxableEarnings = curAnnualEarnings - curTotalExemptions - curAnnualPreTaxCost
    curTotalPaycheck = ((curTaxableEarnings * 0.67) - curAnnualAfterTaxCost + curAnnualTotalCredits) / 24

    objContext.SetComplete
    GetTotalPaycheck = curTotalPaycheck

    Exit Function

ErrorHandler:
    If Not rst Is Nothing Then Set rst = Nothing

    objContext.SetAbort
    Err.Raise Err.Number, "BenefitList.GetTotalPaycheck()", Err.Description

End Function

Function CheckQualifier(ByVal strFileDSN As String, ByVal lngEmployeeId As Long, _
    ByVal lngBenefitId As Long)

    Dim objContext As ObjectContext
    Set objContext = GetObjectContext

    On Error GoTo ErrorHandler

    Dim rst As New ADOR.Recordset, strSQL As String
    rst.CursorLocation = adUseServer
    strSQL = "EXECUTE sp_CheckQualifier " & lngEmployeeId & ", " & lngBenefitId
    rst.Open strSQL, "FILEDSN=" & strFileDSN

    Set CheckQualifier = rst

    objContext.SetComplete
    Exit Function

ErrorHandler:
    If Not rst Is Nothing Then Set rst = Nothing

    objContext.SetAbort
    Err.Raise Err.Number, "BenefitList.CheckQualifier()", Err.Description

End Function

Function CurrentPlan(ByVal strFileDSN As String, ByVal lngEmployeeId As Long, _
    ByVal lngBenefitId As Long)

    Dim objContext As ObjectContext
    Set objContext = GetObjectContext

    On Error GoTo ErrorHandler

    Dim rst As New ADOR.Recordset, strSQL As String
    rst.CursorLocation = adUseServer
    strSQL = "EXECUTE sp_CurrentPlan " & lngEmployeeId & ", " & lngBenefitId
    rst.Open strSQL, "FILEDSN=" & strFileDSN

    Set CurrentPlan = rst

    objContext.SetComplete
    Exit Function

ErrorHandler:
    If Not rst Is Nothing Then Set rst = Nothing

    objContext.SetAbort
    Err.Raise Err.Number, "BenefitList.CurrentPlan()", Err.Description

End Function

Function PlanInfo(ByVal strFileDSN As String, ByVal lngBenefitId As Long, _
    ByVal lngPlanId As Long)

    Dim objContext As ObjectContext
    Set objContext = GetObjectContext

    On Error GoTo ErrorHandler

    Dim rst As New ADOR.Recordset, strSQL As String
    rst.CursorLocation = adUseServer
    strSQL = "EXECUTE sp_PlanInfo " & lngBenefitId & ", " & lngPlanId
    rst.Open strSQL, "FILEDSN=" & strFileDSN

    Set PlanInfo = rst

    objContext.SetComplete
    Exit Function

ErrorHandler:
    If Not rst Is Nothing Then Set rst = Nothing

    objContext.SetAbort
    Err.Raise Err.Number, "BenefitList.PlanInfo()", Err.Description

End Function

Function PlanList(ByVal strFileDSN As String, ByVal lngBenefitId As Long)

    Dim objContext As ObjectContext
    Set objContext = GetObjectContext

    On Error GoTo ErrorHandler

    Dim rst As New ADOR.Recordset, strSQL As String
    rst.CursorLocation = adUseServer
    strSQL = "EXECUTE sp_PlanList " & lngBenefitId
    rst.Open strSQL, "FILEDSN=" & strFileDSN

    Set PlanList = rst

    objContext.SetComplete
    Exit Function

ErrorHandler:
    If Not rst Is Nothing Then Set rst = Nothing

    objContext.SetAbort
    Err.Raise Err.Number, "BenefitList.PlanList()", Err.Description

End Function

Function PlanField(ByVal strFileDSN As String, ByVal lngPlanId As Long)

    Dim objContext As ObjectContext
    Set objContext = GetObjectContext

    On Error GoTo ErrorHandler

    Dim rst As New ADOR.Recordset, strSQL As String
    rst.CursorLocation = adUseServer
    strSQL = "EXECUTE sp_PlanField " & lngPlanId
    rst.Open strSQL, "FILEDSN=" & strFileDSN

    Set PlanField = rst

    objContext.SetComplete
    Exit Function

ErrorHandler:
    If Not rst Is Nothing Then Set rst = Nothing

    objContext.SetAbort
    Err.Raise Err.Number, "BenefitList.PlanField()", Err.Description

End Function

Function ListDependents(ByVal strFileDSN As String, ByVal lngEmployeeId As Long, _
    ByVal lngBenefitId As Long)

    Dim objContext As ObjectContext
    Set objContext = GetObjectContext

    On Error GoTo ErrorHandler

    Dim rst As New ADOR.Recordset, strSQL As String
    rst.CursorLocation = adUseServer
    strSQL = "EXECUTE sp_ListDependents " & lngEmployeeId & ", " & lngBenefitId
    rst.Open strSQL, "FILEDSN=" & strFileDSN

    Set ListDependents = rst

    objContext.SetComplete
    Exit Function

ErrorHandler:
    If Not rst Is Nothing Then Set rst = Nothing

    objContext.SetAbort
    Err.Raise Err.Number, "BenefitList.ListDependents()", Err.Description

End Function

Function PhysicianList(ByVal strFileDSN As String)

    Dim objContext As ObjectContext
    Set objContext = GetObjectContext

    On Error GoTo ErrorHandler

    Dim rst As New ADOR.Recordset
    rst.CursorLocation = adUseServer
    rst.Open "EXECUTE sp_PhysicianList", "FILEDSN=" & strFileDSN

    Set PhysicianList = rst

    objContext.SetComplete
    Exit Function

ErrorHandler:
    If Not rst Is Nothing Then Set rst = Nothing

    objContext.SetAbort
    Err.Raise Err.Number, "BenefitList.PhysicianList()", Err.Description

End Function

Function GenderList(ByVal strFileDSN As String)

    Dim objContext As ObjectContext
    Set objContext = GetObjectContext

    On Error GoTo ErrorHandler

    Dim rst As New ADOR.Recordset
    rst.CursorLocation = adUseServer
    rst.Open "EXECUTE sp_GenderList", "FILEDSN=" & strFileDSN

    Set GenderList = rst

    objContext.SetComplete
    Exit Function

ErrorHandler:
    If Not rst Is Nothing Then Set rst = Nothing

    objContext.SetAbort
    Err.Raise Err.Number, "BenefitList.GenderList()", Err.Description

End Function

Function DependentTypeList(ByVal strFileDSN As String)

    Dim objContext As ObjectContext
    Set objContext = GetObjectContext

    On Error GoTo ErrorHandler

    Dim rst As New ADOR.Recordset
    rst.CursorLocation = adUseServer
    rst.Open "EXECUTE sp_DependentTypeList", "FILEDSN=" & strFileDSN

    Set DependentTypeList = rst

    objContext.SetComplete
    Exit Function

ErrorHandler:
    If Not rst Is Nothing Then Set rst = Nothing

    objContext.SetAbort
    Err.Raise Err.Number, "BenefitList.DependentTypeList()", Err.Description

End Function

Function ListCoveredPersons(ByVal strFileDSN As String, ByVal lngEmployeeId As Long, _
        ByVal lngBenefitId As Long)

    Dim objContext As ObjectContext
    Set objContext = GetObjectContext

    On Error GoTo ErrorHandler

    Dim rst As New ADOR.Recordset, strSQL As String
    rst.CursorLocation = adUseServer
    strSQL = "EXECUTE sp_ListCoveredPersons " & lngEmployeeId & ", " & lngBenefitId
    rst.Open strSQL, "FILEDSN=" & strFileDSN

    Set ListCoveredPersons = rst

    objContext.SetComplete
    Exit Function

ErrorHandler:
    If Not rst Is Nothing Then Set rst = Nothing

    objContext.SetAbort
    Err.Raise Err.Number, "BenefitList.ListCoveredPersons()", Err.Description

End Function

Function TaxStatusList(ByVal strFileDSN As String, ByVal lngBenefitId As Long)

    Dim objContext As ObjectContext
    Set objContext = GetObjectContext

    On Error GoTo ErrorHandler

    Dim rst As New ADOR.Recordset, strSQL As String
    rst.CursorLocation = adUseServer
    strSQL = "EXECUTE sp_TaxStatusList " & lngBenefitId
    rst.Open strSQL, "FILEDSN=" & strFileDSN, adOpenStatic, adLockReadOnly, adCmdText

    Set TaxStatusList = rst

    objContext.SetComplete
    Exit Function

ErrorHandler:
    If Not rst Is Nothing Then Set rst = Nothing

    objContext.SetAbort
    Err.Raise Err.Number, "BenefitList.TaxStatusList()", Err.Description

End Function

Function AddQualifier(ByVal strFileDSN As String, ByVal lngEmployeeId As Long, _
        ByVal lngQualifierId As Long, ByVal datQualifierDate As Date)

    Dim objContext As ObjectContext
    Set objContext = GetObjectContext

    On Error GoTo ErrorHandler

    Dim cnn As New ADODB.Connection, strSQL As String
    cnn.Open "FileDSN=" & strFileDSN
    ' If date beyond permissible range entered, substitute today's date
    If Year(datQualifierDate) < 1753 Or Year(datQualifierDate) > 9999 Then
      datQualifierDate = Date
    End If
    ' Have to put single quotes around the date so it won't look like a math problem
    '   of day divided by month divided by year
    strSQL = "EXECUTE sp_AddQualifier " & lngEmployeeId & ", " & lngQualifierId & _
        ", '" & datQualifierDate & "'"
    cnn.Execute (strSQL)

    objContext.SetComplete
    Exit Function

ErrorHandler:
    If Not cnn Is Nothing Then Set cnn = Nothing

    objContext.SetAbort
    Err.Raise Err.Number, "BenefitList.AddQualifier()", Err.Description

End Function

Function AddBenefit(ByVal strFileDSN As String, ByVal lngEmployeeId As Long, _
        ByVal lngBenefitId As Long)

    Dim objContext As ObjectContext
    Set objContext = GetObjectContext

    On Error GoTo ErrorHandler

    Dim rst As New ADOR.Recordset, strSQL As String
    rst.CursorLocation = adUseServer
    strSQL = "EXECUTE sp_AddBenefitSelect1 " & lngBenefitId
    rst.Open strSQL, "FILEDSN=" & strFileDSN

    If Not rst.EOF Then

        Dim cnn As New ADODB.Connection
        cnn.Open "FileDSN=" & strFileDSN
        strSQL = "EXECUTE sp_AddBenefitInsert " & lngEmployeeId & ", " & lngBenefitId & _
            ", " & rst("PlanId") & ", " & rst("PlanCost") & ", " & rst("TaxStatusId")
        cnn.Execute (strSQL)

            Dim rst2 As New ADOR.Recordset
            rst2.CursorLocation = adUseServer
            strSQL = "EXECUTE sp_AddBenefitSelect2 " & lngEmployeeId
            rst2.Open strSQL, "FILEDSN=" & strFileDSN

            ' We can call a method in the same class without creating an object, or
            '   as shown here, we can create the object. If we want to create an
            '   object, we should use objContext.CreateInstance; because if use
            '   CreateObject, will get a NEW transaction that cannot see the work
            '   done in this (calling) transaction
            If Not rst2.EOF Then
            Dim BenefitList As Object
            Set BenefitList = objContext.CreateInstance("Benefit.BenefitList")
            Do Until rst2.EOF
                BenefitList.AddEBD strFileDSN, lngEmployeeId, lngBenefitId, _
                rst2("DependentId"), rst2("DependentTypeId")
                rst2.MoveNext
            Loop
        End If

    End If

    objContext.SetComplete
    Exit Function

ErrorHandler:
    If Not rst Is Nothing Then Set rst = Nothing
    If Not cnn Is Nothing Then Set cnn = Nothing
    If Not rst2 Is Nothing Then Set rst2 = Nothing

    objContext.SetAbort
    Err.Raise Err.Number, "BenefitList.AddBenefit()", Err.Description

End Function

Function AddEBD(ByVal strFileDSN As String, ByVal lngEmployeeId As Long, _
        ByVal lngBenefitId As Long, ByVal lngDependentId As Long, _
        ByVal lngDependentTypeId As Long)

    Dim objContext As ObjectContext
    Set objContext = GetObjectContext

    On Error GoTo ErrorHandler

    Dim intEBDStatusId As Integer
    ' lngDependentTypeId = 1 indicates the employee's Dependent record
    If lngDependentTypeId = 1 Then
        ' intEBDStatusId = 1 means Active
        intEBDStatusId = 1
    Else
        ' intEBDStatusId = 1 means Inactive
        intEBDStatusId = 2
    End If

    Dim cnn As New ADODB.Connection, strSQL As String
    cnn.Open "FileDSN=" & strFileDSN
    strSQL = "EXECUTE sp_AddEBD " & lngEmployeeId & ", " & lngBenefitId & _
        ", " & lngDependentId & ", " & intEBDStatusId
    cnn.Execute (strSQL)

    objContext.SetComplete
    Exit Function

ErrorHandler:
    If Not cnn Is Nothing Then Set cnn = Nothing

    objContext.SetAbort
    Err.Raise Err.Number, "BenefitList.AddEBD()", Err.Description

End Function

Function InactivateDependents(ByVal strFileDSN As String, ByVal lngEmployeeId As Long, _
     ByVal lngBenefitId As Long)

    Dim objContext As ObjectContext
    Set objContext = GetObjectContext

    On Error GoTo ErrorHandler

    Dim cnn As New ADODB.Connection, strSQL As String
    cnn.Open "FileDSN=" & strFileDSN
    strSQL = "EXECUTE sp_InactivateDependents " & lngEmployeeId & ", " & lngBenefitId
    cnn.Execute (strSQL)

    objContext.SetComplete
    Exit Function

ErrorHandler:
    If Not cnn Is Nothing Then Set cnn = Nothing

    objContext.SetAbort
    Err.Raise Err.Number, "BenefitList.InactivateDependents()", Err.Description

End Function

Function SaveDependents(ByVal strFileDSN As String, ByVal lngEmployeeId As Long, _
     ByVal lngBenefitId As Long, ByVal lngDependentId As Long, _
     ByVal lngPhysicianId As Long)

    Dim objContext As ObjectContext
    Set objContext = GetObjectContext

    On Error GoTo ErrorHandler

    Dim cnn As New ADODB.Connection, strSQL As String
    cnn.Open "FileDSN=" & strFileDSN
    strSQL = "EXECUTE sp_SaveDependents " & lngPhysicianId & ", " & lngEmployeeId & _
        ", " & lngBenefitId & ", " & lngDependentId
    cnn.Execute (strSQL)

    objContext.SetComplete
    Exit Function

ErrorHandler:
    If Not cnn Is Nothing Then Set cnn = Nothing

    objContext.SetAbort
    Err.Raise Err.Number, "BenefitList.SaveDependents()", Err.Description

End Function

Function ChangeQualifierList(ByVal strFileDSN As String, ByVal lngBenefitId As Long, _
        ByVal lngQualifierClassId As Long)

    Dim objContext As ObjectContext
    Set objContext = GetObjectContext

    On Error GoTo ErrorHandler

    Dim rst As New ADOR.Recordset, strSQL As String
    rst.CursorLocation = adUseServer

    ' Which stored procedure we should run depends on whether lngBenefitId is greater
    '   than zero
    If lngBenefitId > 0 Then
        strSQL = "EXECUTE sp_ChangeQualifierList1 " & lngQualifierClassId & ", " & lngBenefitId
    Else
        strSQL = "EXECUTE sp_ChangeQualifierList2 " & lngQualifierClassId
    End If

    rst.Open strSQL, "FILEDSN=" & strFileDSN

    Set ChangeQualifierList = rst

    objContext.SetComplete
    Exit Function

ErrorHandler:
    If Not rst Is Nothing Then Set rst = Nothing

    objContext.SetAbort
    Err.Raise Err.Number, "BenefitList.ChangeQualifierList()", Err.Description

End Function