clsdrugamounts.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 = "clsDrugAmounts"
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" ,"clsDrugAmount"
Attribute VB_Ext_KEY = "Member0" ,"clsDrugAmount"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit

'局部变量，保存集合

Private mCol As Collection
Public Direct As Integer  '-1  出库\  1 入库
Public DsCode As String '当前药房编码
Public DtType As TSDtType
Public Info As String
Public Function Add(ItemCode As String, ItemName As String, Amount As Long) As clsDrugAmount
    Dim tmpObj As clsDrugAmount
    
    '创建新对象
    Dim objNewMember As clsDrugAmount
    Set objNewMember = New clsDrugAmount


    '设置传入方法的属性
    objNewMember.ItemCode = ItemCode
    objNewMember.ItemName = ItemName
    objNewMember.Amount = Amount

    Set tmpObj = Item(ItemCode)
    If tmpObj Is Nothing Then
        mCol.Add objNewMember, ItemCode
    Else
        tmpObj.Amount = tmpObj.Amount + Amount
    End If

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


End Function

Public Property Get Item(vntIndexKey As Variant) As clsDrugAmount
Attribute Item.VB_UserMemId = 0
    '引用集合中的一个元素时使用。
    '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 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
End Sub


Private Sub Class_Terminate()
    '类终止后破坏集合
    Set mCol = Nothing
End Sub
Public Function JugeStorageForOut() As Boolean  '对于出库判断库存,调此函数前应调用 GetStorage
    Dim tmpObj As clsDrugAmount
    
    
    JugeStorageForOut = True
    If Direct = 1 Or gtydSysConfig.IFAllowNeg Then Exit Function
    Info = "以下数量为基本单位数量" & Chr(10) & Chr(10)
    For Each tmpObj In mCol
        If tmpObj.Storage < tmpObj.Amount Then
            Info = Info & "< " & tmpObj.ItemName & " >当前数量为 " _
            & tmpObj.StorageDes & ",需出库 " & tmpObj.Amount & ",不能出库!" & Chr(10)
            JugeStorageForOut = False
        End If
    Next
End Function

Public Sub GetStorage()   '得到当前库存数量
    Dim tmpObj As clsDrugAmount
    
    For Each tmpObj In mCol
        If gdbobj.GetRs("SELECT BusAmount,InpatiAmount,OpenAmount " _
            & "FROM House_Drug WHERE DsCode ='" & DsCode _
            & "' AND ItemCode = '" & tmpObj.ItemCode & "'") = 1 Then
            
            tmpObj.BusStorage = gdbobj.Rs!busAmount
            tmpObj.InpatiStorage = gdbobj.Rs!inpatiAmount
            tmpObj.OpenStorage = gdbobj.Rs!openAmount
        End If
    Next

End Sub

Public Function UpDateStorage() As Boolean  '更新库存表
    Dim tmpObj As clsDrugAmount
    
    For Each tmpObj In mCol
        Select Case DtType
            Case tsH_PATIENT_OUT, tsH_PATIENT_IN
                If IsNull(tmpObj.OpenStorage) Then
                    If Not Update_House_DrugOpen(HISDbInsert, DsCode, tmpObj.ItemCode, _
                        tmpObj.Amount * Direct) Then
                        GoTo Errlbl
                    End If
                Else
                    If Not Update_House_DrugOpen(HISDBUpdate, _
                            Amount:=tmpObj.OpenStorage + tmpObj.Amount * Direct, _
                          UpdateCondition:="DsCode ='" & DsCode & "' AND ItemCode = '" & tmpObj.ItemCode & "'") Then
                        GoTo Errlbl
                    End If
                End If
            Case tsH_SICK_OUT, tsH_SICK_IN
                If IsNull(tmpObj.InpatiStorage) Then
                    If Not Update_House_DrugInpati(HISDbInsert, DsCode, tmpObj.ItemCode, _
                        tmpObj.Amount * Direct) Then
                        GoTo Errlbl
                    End If
                Else
                    If Not Update_House_DrugInpati(HISDBUpdate, _
                          Amount:=tmpObj.InpatiStorage + tmpObj.Amount * Direct, _
                          UpdateCondition:="DsCode ='" & DsCode & "' AND ItemCode = '" & tmpObj.ItemCode & "'") Then
                        GoTo Errlbl
                    End If
                End If
            Case Else
                If IsNull(tmpObj.BusStorage) Then
                    If Not Update_House_DrugBus(HISDbInsert, DsCode, tmpObj.ItemCode, _
                        tmpObj.Amount * Direct) Then
                        GoTo Errlbl
                    End If
                Else
                    If Not Update_House_DrugBus(HISDBUpdate, _
                            Amount:=tmpObj.BusStorage + tmpObj.Amount * Direct, _
                          UpdateCondition:="DsCode ='" & DsCode & "' AND ItemCode = '" & tmpObj.ItemCode & "'") Then
                        GoTo Errlbl
                    End If
                End If
        End Select
    Next
    UpDateStorage = True
    Exit Function
Errlbl:
End Function