📄 clsallgetdrug.cls
字号:
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "clsAllGetDrug"
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"
Option Explicit
Private mCol As Collection
Public IsOP As Boolean
Public allFlag As Boolean
Public DrugAmountsObj As clsDrugAmounts
Public Sub Add(SickGetDrugObj As clsSickGetDrug)
'创建新对象
mCol.Add SickGetDrugObj
End Sub
Public Property Get Item(vntIndexKey As Variant) As clsSickGetDrug
'引用集合中的一个元素时使用。
'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 clsSickGetDrug
Dim tmpObj As clsSickGetDrug
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
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
'计算摆药 药品 数量不为 0 的项数
Public Property Get HavingCount() As Integer
Dim tmpObj As clsSickGetDrug
Dim SubObj As clsGetDrug
For Each tmpObj In mCol
For Each SubObj In tmpObj
If SubObj.Mount <> 0 Then
HavingCount = HavingCount + 1
End If
Next
Next
End Property
Public Function checkstore() As Integer
Dim tmpObj As clsSickGetDrug
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).Mount, 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 clsSickGetDrug
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).Mount, 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 clsSickGetDrug
For Each tmpObj In mCol
tmpObj.ClearStatus
Next
End Sub
Public Sub SetStatus()
Dim tmpObj As clsSickGetDrug
For Each tmpObj In mCol
tmpObj.SetStatus
Next
End Sub
Public Property Get ADVItem(ByVal ADVSerial As String, ByVal Num As Integer) As clsGetDrug
Dim tmpObj As clsSickGetDrug
Dim i As Integer
For Each tmpObj In mCol
For i = 1 To tmpObj.Count
If tmpObj.Item(i).ADVSerial = ADVSerial And tmpObj.Item(i).Num = Num Then
Set ADVItem = 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
Public Property Get HavingDebInfo() As Boolean
Dim tmpObj As clsSickGetDrug
For Each tmpObj In mCol
If Not tmpObj.CanKeep Then
HavingDebInfo = True
End If
Next
End Property
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -