clsrecipes_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 = "clsRecipes"
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 = "Top_Level" ,"Yes"
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Option Explicit


Public SickObj As clsSickOP
Public DsCode As String
Private mCol As Collection

Public Sub Add(RecipeObj As clsRecipe)
    '创建新对象
    mCol.Add RecipeObj


End Sub

Public Property Get Item(vntIndexKey As Variant) As clsRecipe
    '引用集合中的一个元素时使用。
    'vntIndexKey 包含集合的索引或关键字，
    '这是为什么要声明为 Variant 的原因
    '语法：Set foo = x.Item(xyz) or Set foo = x.Item(5)
On Error GoTo errlbl
  Set Item = mCol(vntIndexKey)
errlbl:
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
        Remove 1
    Next I
End Sub


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


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


Private Sub Class_Terminate()
    '类终止后破坏集合
    Set mCol = Nothing
End Sub
Public Property Let RecipeDate(ByVal vData As String)
    Dim I As Integer
    
    For I = 1 To mCol.Count
        Item(I).RecipeDate = vData
    Next I
End Property
Public Property Let hdCode(ByVal vData As String)
    Dim I As Integer
    
    For I = 1 To mCol.Count
        Item(I).hdCode = vData
    Next I
End Property
Public Property Let HdName(ByVal vData As String)
    Dim I As Integer
    
    For I = 1 To mCol.Count
        Item(I).HdName = vData
    Next I
End Property

Public Property Get TotalFair() As Single
    Dim I As Integer
    
    For I = 1 To mCol.Count
        TotalFair = TotalFair + Item(I).TotalFair
    Next I
End Property
Public Property Get TotalPubFair() As Single
    Dim I As Integer
    
    For I = 1 To mCol.Count
        TotalPubFair = TotalPubFair + Item(I).TotalPubFair
    Next I
End Property
Public Property Get TotalSelfFair() As Single
    Dim I As Integer
    
    For I = 1 To mCol.Count
        TotalSelfFair = TotalSelfFair + Item(I).TotalSelfFair
    Next I
End Property
Public Property Get TotalExportFair() As Single
    Dim I As Integer
    
    For I = 1 To mCol.Count
        TotalExportFair = TotalExportFair + Item(I).TotalExportFair
    Next I
End Property

Public Function Save() As Boolean
    Dim Serial As String
    Dim TmpStr As String
    Dim Tmpobj As clsRecipe
    Dim TmpItem As clsRecipeItem, I As Integer
    
    Serial = gFnGetSerial(stRecipeSerial)
On Error GoTo errlbl
    gDbObj.CNExe.BeginTrans
    If SickObj.ID = "" Then
        If Not SickObj.Save(HISDbInsert) Then
            GoTo errlbl
        End If
    End If
    For Each Tmpobj In mCol
        If Tmpobj.Count <> 0 Then
            If Not Update_Open_RecipeMain(HISDbInsert, Serial, SickObj.PatientID, _
                 Tmpobj.DepCode, Tmpobj.DcCode, DsCode, Tmpobj.hdCode, Tmpobj.RecipeDate, Tmpobj.TotalFair) Then
                        
                GoTo errlbl
            End If
            I = 1
            For Each TmpItem In Tmpobj
                If Not Update_Open_RecipeSub(HISDbInsert, Serial, I, TmpItem.ItemCode, TmpItem.CPrice, _
                    TmpItem.Amount, TmpItem.Fair, TmpItem.Unit, TmpItem.Factor, TmpItem.RevDepCode, _
                    TmpItem.Flag, TmpItem.GPrice, TmpItem.GMoney) Then
                    
                    GoTo errlbl
                End If
                I = I + 1
            Next
            Serial = Left(Serial, Len(Serial) - 4) & Format(Right(Serial, 4) + 1, "0000")
        End If
    Next
            
    gDbObj.CNExe.CommitTrans
    Save = True
    Exit Function
errlbl:
    gDbObj.CNExe.RollbackTrans
End Function
Public Sub Make(ByVal SQL As String)
    Dim Rs As Recordset
    Dim Tmpobj As clsRecipe
    Dim TmpItem As clsRecipeItem
    Dim RecipeSerial As String
    
    Set Rs = gDbObj.GetNewRs(SQL)
    
    Me.Clear
    Do Until Rs.EOF
        If RecipeSerial <> Rs!RecipeSerial Then
            Set Tmpobj = New clsRecipe
            Tmpobj.IsNew = False '为了收费检查治疗的判断
            Tmpobj.RecipeSerial = Rs!RecipeSerial
            RecipeSerial = Rs!RecipeSerial
            Tmpobj.RecipeDate = Rs!RecipeDate
            Tmpobj.hdCode = Rs!hdCode
            Tmpobj.HdName = Rs!HdName
            Tmpobj.DcCode = IIf(IsNull(Rs!DcCode), "", Rs!DcCode)
            Tmpobj.DcName = IIf(IsNull(Rs!DcCode), "", Rs!DcName)
            Tmpobj.DepCode = Rs!DepCode
            Tmpobj.DepName = Rs!DepName
            Tmpobj.DsCode = IIf(IsNull(Rs!DsCode), "", Rs!DsCode)
            Tmpobj.DsName = IIf(IsNull(Rs!DsName), "", Rs!DsName)
            Me.Add Tmpobj
        End If
        Set TmpItem = New clsRecipeItem
        TmpItem.ItemCode = Rs!ItemCode
        TmpItem.ItemName = Rs!ItemName
        TmpItem.Model = IIf(IsNull(Rs!Model), "", Rs!Model)
        TmpItem.CPrice = Rs!CPrice
        TmpItem.Unit = IIf(IsNull(Rs!Unit), "", Rs!Unit)
        TmpItem.Factor = Rs!Factor
        TmpItem.Amount = Rs!Amount
        TmpItem.RevDepCode = IIf(IsNull(Rs!RevDepCode), "", Rs!RevDepCode)
        TmpItem.RevDepName = IIf(IsNull(Rs!RevDepName), "", Rs!RevDepName)
        TmpItem.Flag = Rs!Flag
        TmpItem.Fair = Rs!sFair
        Tmpobj.AddObj TmpItem
        Rs.MoveNext
    Loop
End Sub