clsrecipe_bak.cls

医院门诊医生工作站,vb6 SqlServer

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsRecipe"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
Attribute VB_Ext_KEY = "Collection" ,"clsRecipeItem"
Attribute VB_Ext_KEY = "Member0" ,"clsRecipeItem"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Option Explicit

'局部变量，保存集合
Public IsNew As Boolean
Public RecipeSerial As String
Public PatientID As String
Public Name As String
Public PtID As String
Public PtDes As String
Public DepCode As String
Public DepName As String
Public DsCode As String
Public DsName As String
Public DcCode As String
Public DcName As String
Public RecipeDate As String
Public HdCode As String
Public HdName As String
Public FetchHdCode As String
Public FetchHdName As String
Public Status As Integer
Public FetchDate As String
Public ActRevSerial As String
Public Act_RecipeNum As Integer

Public NoSelect As Boolean
Private mCol As Collection
Public Function Add(ItemCode As String, ItemName As String, Model As String, CPrice As Currency, Amount As Integer, Unit As String, Factor As Single, RevDepCode As String, RevDepName As String, Flag As Long, Optional sKey As String) As clsRecipeItem
    '创建新对象
    Dim objNewMember As clsRecipeItem
    Set objNewMember = New clsRecipeItem


    '设置传入方法的属性
    objNewMember.ItemCode = ItemCode
    objNewMember.ItemName = ItemName
    objNewMember.Model = Model
    objNewMember.CPrice = CPrice
    objNewMember.Amount = Amount
    objNewMember.Unit = Unit
    objNewMember.Factor = Factor
    objNewMember.RevDepCode = RevDepCode
    objNewMember.RevDepName = RevDepName
    objNewMember.Flag = Flag




    If Len(sKey) = 0 Then
        mCol.Add objNewMember
    Else
        mCol.Add objNewMember, sKey
    End If


    '返回已创建的对象
    Set Add = objNewMember
    Set objNewMember = Nothing


End Function
Public Function AddObj(RecipeObj As clsRecipeItem)

    mCol.Add RecipeObj

End Function

Public Property Get Item(vntIndexKey As Variant) As clsRecipeItem
Attribute Item.VB_UserMemId = 0
    '引用集合中的一个元素时使用。
    'vntIndexKey 包含集合的索引或关键字，
    '这是为什么要声明为 Variant 的原因
    '语法：Set foo = x.Item(xyz) or Set foo = x.Item(5)
  Set Item = mCol(vntIndexKey)
End Property



Public Property Get Count() As Long
    '检索集合中的元素数时使用。语法：Debug.Print x.Count
    Count = mCol.Count
End Property


Public Sub Remove(vntIndexKey As Variant)
    '删除集合中的元素时使用。
    'vntIndexKey 包含索引或关键字，这是为什么要声明为 Variant 的原因
    '语法：x.Remove(xyz)


    mCol.Remove vntIndexKey
End Sub
Public Sub Clear()
    '删除集合中的元素时使用。
    'vntIndexKey 包含索引或关键字，这是为什么要声明为 Variant 的原因
    '语法：x.Remove(xyz)
    Dim I As Integer
    
    For I = 1 To mCol.Count

        mCol.Remove 1
    Next I
End Sub


Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = "40"
    '本属性允许用 For...Each 语法枚举该集合。
    Set NewEnum = mCol.[_NewEnum]
End Property


Private Sub Class_Initialize()
    '创建类后创建集合
    Set mCol = New Collection
    IsNew = True
End Sub


Private Sub Class_Terminate()
    '类终止后破坏集合
    Set mCol = Nothing
End Sub
Public Property Get TotalFair() As Currency
    Dim I As Integer
    
    For I = 1 To mCol.Count
        TotalFair = TotalFair + Item(I).Fair
    Next I
End Property
Public Property Get TotalPubFair() As Single
    Dim I As Integer
    
    For I = 1 To mCol.Count
        If Item(I).Pub Then
            TotalPubFair = TotalPubFair + Item(I).Fair
        End If
    Next I
End Property
Public Property Get TotalSelfFair() As Single
    Dim I As Integer
    
    For I = 1 To mCol.Count
        If Not Item(I).Pub Then
            TotalSelfFair = TotalSelfFair + Item(I).Fair
        End If
    Next I
End Property
Public Property Get TotalExportFair() As Single
    Dim I As Integer
    
    For I = 1 To mCol.Count
        If Item(I).Export Then
            TotalExportFair = TotalExportFair + Item(I).Fair
        End If
    Next I
End Property
Public Property Let RecipeSerialByQuery(ByVal vData As String)
    Dim Rs As Recordset
    Dim tmpobj As clsRecipeItem
    Dim SQL As String
    
    If gtydSysConfig.DepCode <> "" Then
        SQL = "SELECT Open_RecipeMain.*,Open_RecipeSub.*,m_Handler.HdName,m_Drug.ItemName,m_Drug.Model,m_Depart.DepName,m_Doctor.DcName, " _
            & "Dep1.depName as 'RevDepName',H1.HdName as 'FetchHdName' " _
            & "FROM ((((((Open_RecipeMain INNER JOIN Open_RecipeSub " _
            & "ON Open_RecipeMain.RecipeSerial = Open_RecipeSub.RecipeSerial) " _
            & "INNER JOIN m_Handler ON Open_RecipeMain.HdCode = m_Handler.HdCode) " _
            & "INNER JOIN m_Depart ON Open_RecipeMain.DepCode=m_Depart.DepCode ) " _
            & "LEFT JOIN m_Doctor ON Open_RecipeMain.DcCode=m_Doctor.DcCode) " _
            & "LEFT JOIN m_Drug ON Open_RecipeSub.ItemCode = m_Drug.ItemCode) " _
            & "LEFT JOIN m_Depart Dep1 ON Open_RecipeSub.RevDepCode=Dep1.DepCode ) " _
            & "LEFT JOIN m_Handler H1 ON Open_RecipeMain.FetchHdCode=H1.HdCode " _
            & "WHERE Open_RecipeMain.RecipeSerial = '" & vData & "'"
    Else
        SQL = "SELECT *,m_Handler.HdName,m_Item.ItemName,m_Item.Model,m_Depart.DepName,m_Doctor.DcName, " _
            & "Dep1.depName as 'RevDepName',H1.HdName as 'FetchHdName' " _
            & "FROM ((((((Open_RecipeMain INNER JOIN Open_RecipeSub " _
            & "ON Open_RecipeMain.RecipeSerial = Open_RecipeSub.RecipeSerial) " _
            & "INNER JOIN m_Handler ON Open_RecipeMain.HdCode = m_Handler.HdCode) " _
            & "INNER JOIN m_Depart ON Open_RecipeMain.DepCode=m_Depart.DepCode ) " _
            & "LEFT JOIN m_Doctor ON Open_RecipeMain.DcCode=m_Doctor.DcCode) " _
            & "LEFT JOIN m_Item ON Open_RecipeSub.ItemCode = m_Item.ItemCode) " _
            & "LEFT JOIN m_Depart Dep1 ON Open_RecipeSub.RevDepCode=Dep1.DepCode ) " _
            & "LEFT JOIN m_Handler H1 ON Open_RecipeMain.FetchHdCode=H1.HdCode " _
            & "WHERE Open_RecipeMain.RecipeSerial = '" & vData & "'"
    End If
    Set Rs = gDbObj.GetNewRs(SQL)
    If Rs.RecordCount >= 1 Then
        RecipeSerial = Rs!RecipeSerial
        PatientID = Rs!PatientID
        HdCode = Rs!HdCode
        HdName = Rs!HdName
        DepCode = Rs!DepCode
        DepName = Rs!DepName
        DcCode = IIf(IsNull(Rs!DcCode), "", Rs!DcCode)
        DcName = IIf(IsNull(Rs!DcName), "", Rs!DcName)
        RecipeDate = Rs!RecipeDate
        FetchDate = IIf(IsNull(Rs!FetchDate), "", Rs!FetchDate)
        FetchHdCode = IIf(IsNull(Rs!FetchHdCode), "", Rs!FetchHdCode)
        FetchHdName = IIf(IsNull(Rs!FetchHdName), "", Rs!FetchHdName)
        ActRevSerial = IIf(IsNull(Rs!ActRevSerial), "", Rs!ActRevSerial)
        Status = Rs!Status
        Me.Clear
        Do Until Rs.EOF
            Set tmpobj = New clsRecipeItem
            tmpobj.ItemCode = Rs!ItemCode
            tmpobj.ItemName = Rs!ItemName
            tmpobj.CPrice = Rs!CPrice
            tmpobj.Amount = Rs!Amount
            tmpobj.Model = IIf(IsNull(Rs!Model), "", Rs!Model)
            tmpobj.Flag = Rs!Flag
            tmpobj.Unit = IIf(IsNull(Rs!Unit), "", Rs!Unit)
            tmpobj.Factor = Rs!Factor
            tmpobj.GPrice = Rs!GPrice
            tmpobj.Fair = Rs!Fair
            tmpobj.RevDepCode = Rs!RevDepCode
            tmpobj.RevDepName = Rs!RevDepName
            
            Me.AddObj tmpobj
            Rs.MoveNext
        Loop
    End If
End Property
Public Property Get IsCancel()
    IsCancel = IIf((Status And 1) = 1, True, False)
End Property
Public Function Cancel()
    Dim TmpStatus As Integer
    
    TmpStatus = (Status And &HFFFFFFFE) Or 1
    If Update_Open_RecipeMain(HISDBUpdate, Status:=TmpStatus, _
        UpdateCondition:=" RecipeSerial = '" & RecipeSerial & "'") Then
        Cancel = True
        Status = TmpStatus
    End If
End Function
'用于检查、治疗的处方生成
Public Function Save(ByVal SickObj As clsSickOP, Optional Trans As Boolean = True, Optional Staus As Long = 0) As Boolean
    Dim I As Integer
    
On Error GoTo ErrlBl
    
    If Trans Then
        gDbObj.CNExe.BeginTrans
    End If
    If Not Update_Open_RecipeMain(HISDbInsert, RecipeSerial, SickObj.PatientID, _
        DepCode, DcCode, DsCode, HdCode, RecipeDate, _
        TotalFair, , , ActRevSerial, Act_RecipeNum, Status) Then
        GoTo ErrlBl
    End If
    For I = 1 To Count
        If Not Update_Open_RecipeSub(HISDbInsert, RecipeSerial, I, Item(I).ItemCode, _
            Item(I).CPrice, Item(I).Amount, Item(I).Fair, Item(I).Unit, Item(I).Factor, _
            Item(I).RevDepCode, Item(I).Flag) Then
            
            GoTo ErrlBl
        End If
    Next I
    If Trans Then
        gDbObj.CNExe.CommitTrans
    End If
    Save = True
    Exit Function
ErrlBl:
    If Trans Then
        gDbObj.CNExe.RollbackTrans
    End If
End Function