clsallfairmarkdrug.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 = "clsAllFairMarkDrug"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private mCol As Collection
Public allFlag As Boolean
Public DrugAmountsObj As clsDrugAmounts

Public Sub Add(SickGetDrugObj As clsFairMarkDrug)
    '创建新对象
    mCol.Add SickGetDrugObj


End Sub

Public Property Get Item(vntIndexKey As Variant) As clsFairMarkDrug
    '引用集合中的一个元素时使用。
    'vntIndexKey 包含集合的索引或关键字，
    '这是为什么要声明为 Variant 的原因
    '语法：Set foo = x.Item(xyz) or Set foo = x.Item(5)
  Set Item = mCol(vntIndexKey)
End Property
Public Property Get ItemBySick(ByVal SkSerial As String, ByVal IsBaby As Boolean) As clsFairMarkDrug
    Dim tmpObj As clsFairMarkDrug
    
    For Each tmpObj In mCol
        If tmpObj.SkSerial = SkSerial And tmpObj.IsBaby = IsBaby Then
            Set ItemBySick = tmpObj
        End If
    Next
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 Property Get NewEnum() As IUnknown
    '本属性允许用 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
'计算摆药 药品 数量不为 0 的项数
Public Property Get HavingCount() As Integer
    Dim tmpObj As clsFairMarkDrug
    Dim SubObj As clsFairMarkDrugSub
    
    For Each tmpObj In mCol
        For Each SubObj In tmpObj
            If SubObj.Amount <> 0 Then
                HavingCount = HavingCount + 1
            End If
        Next
    Next

End Property

Public Function checkstore() As Integer
    Dim tmpObj As clsFairMarkDrug
    Dim Flag As Boolean
    Dim i As Integer
    checkstore = 0
    If gtydSysConfig.IfDecStore Then
        Set DrugAmountsObj = New clsDrugAmounts
        DrugAmountsObj.Direct = -1
        DrugAmountsObj.DsCode = gtydSysConfig.DepCode
        DrugAmountsObj.DtType = tsH_SICK_OUT
        For Each tmpObj In mCol
            For i = 1 To tmpObj.Count
                If tmpObj.Item(i).Status = 1 Then
                    DrugAmountsObj.Add tmpObj.Item(i).ItemCode, tmpObj.Item(i).ItemName, tmpObj.Item(i).Amount, tmpObj.Item(i).batchid, tmpObj.Item(i).Cprice, tmpObj.Item(i).gprice
                    Flag = True
                End If
            Next i
        Next
        DrugAmountsObj.GetStorage
        If Not DrugAmountsObj.JugeStorageForOut Then
            gdbobj.ErrDes = DrugAmountsObj.Info
            checkstore = -1
            Exit Function
        End If
    Else
        checkstore = 1
    End If
    If Flag = True Then
        checkstore = 1
    End If
End Function

Public Function Save() As Boolean
    Dim tmpObj As clsFairMarkDrug
    Dim MarkSerial As String
    Dim TmpStr As String, i As Integer
    Dim busserial As String
On Error GoTo errlbl
    allFlag = False
    MarkSerial = gFnGetSerial(stFairMark)
    TmpStr = gfnGetTime(gstrSERIAL_DATE) & gtydSysConfig.HdCode
    If gtydSysConfig.IfDecStore Then
        Set DrugAmountsObj = New clsDrugAmounts
        DrugAmountsObj.Direct = -1
        DrugAmountsObj.DsCode = gtydSysConfig.DepCode
        DrugAmountsObj.DtType = tsH_SICK_OUT
        For Each tmpObj In mCol
            For i = 1 To tmpObj.Count
                If tmpObj.Item(i).Status = 1 Then
                    DrugAmountsObj.Add tmpObj.Item(i).ItemCode, tmpObj.Item(i).ItemName, tmpObj.Item(i).Amount, tmpObj.Item(i).batchid, tmpObj.Item(i).Cprice, tmpObj.Item(i).gprice
                End If
            Next i
        Next
        DrugAmountsObj.GetStorage
        If Not DrugAmountsObj.JugeStorageForOut Then
            gdbobj.ErrDes = DrugAmountsObj.Info
            allFlag = True
            Exit Function
        End If
        
    End If
'    busserial = gFnGetSerial(stHouseBusSerial)
    gdbobj.CNExe.BeginTrans
    If gtydSysConfig.IfDecStore Then
        If Not DrugAmountsObj.UpDateStorage Then
            GoTo errlbl
        End If
    End If
    For Each tmpObj In mCol
        If tmpObj.Having Then
            If Not tmpObj.Save(False, MarkSerial, busserial) Then
                GoTo errlbl
            End If
'            MarkSerial = TmpStr & Format(Right(MarkSerial, Len(MarkSerial) - Len(TmpStr)) + 1, _
'                    hisStrRepeat("0", gintSERIAL_BITS))
'            busserial = TmpStr & Format(Right(busserial, Len(busserial) - Len(TmpStr)) + 1, _
'                    hisStrRepeat("0", gintSERIAL_BITS))
        End If
    Next
    gdbobj.CNExe.CommitTrans
    SetStatus
    Save = True
    Exit Function
errlbl:
    gdbobj.CNExe.RollbackTrans
End Function

Public Sub ClearStatus()
    Dim tmpObj As clsFairMarkDrug
    
    For Each tmpObj In mCol
        tmpObj.ClearStatus
    Next
End Sub
Public Sub SetStatus()
    Dim tmpObj As clsFairMarkDrug
    
    For Each tmpObj In mCol
        tmpObj.SetStatus
    Next
End Sub


Public Property Get MarkItem(ByVal MarkSerial As String, ByVal Num As Integer) As clsFairMarkDrugSub
    Dim tmpObj As clsFairMarkDrug
    Dim i As Integer
    
    
    For Each tmpObj In mCol
        For i = 1 To tmpObj.Count
            If tmpObj.Item(i).MarkSerial = MarkSerial And tmpObj.Item(i).Num = Num Then
                Set MarkItem = tmpObj.Item(i)
            End If
        Next i
    Next
End Property

Public Property Get SkIDIndex(ByVal SkID As String) As Integer
    Dim i As Integer
    
    For i = 1 To mCol.Count
        If Item(i).SkID = SkID Then
            SkIDIndex = i
            Exit Function
        End If
    Next i
End Property