📄 clsfetch.cls
字号:
For i = 1 To mCol.Count
If Item(i).BackFair <> Item(i).ActFair Then
Exit Property
End If
Next i
BackOut = True
End Property
Public Property Get BackClear() As Boolean '退完
Dim i As Integer
For i = 1 To mCol.Count
If Item(i).TotalFair <> Item(i).BackFair Then
Exit Property
End If
Next i
BackClear = True
End Property
Public Property Get BackDrugAmountOut() As Boolean '是否全退(数量)
Dim i As Integer
For i = 1 To mCol.Count
If Item(i).FetchedAmount <> Item(i).BackAmount Then
Exit Property
End If
Next i
BackDrugAmountOut = True
End Property
Public Property Get BackInFair() As Currency
BackInFair = BackFair * Rate
End Property
Public Function Back(Sickobj As clsSickOP) As Boolean '退药
Dim recipeSerial As String, i As Integer
Dim oldRecipeSerial As String
Dim FetchFair As Currency
Dim DrugAmountsObj As clsDrugAmounts
Dim busserial As String
Dim SQL As String
On Error GoTo errlbl
busserial = gFnGetSerial(stHouseBusSerial)
If BackFair = 0 Then
gdbobj.ErrDes = "无药可退!"
GoTo errlbl
End If
recipeSerial = gFnGetSerial(stRecipeSerial)
If gtydSysConfig.IfDecStore Then
Set DrugAmountsObj = New clsDrugAmounts
DrugAmountsObj.Direct = 1
DrugAmountsObj.DtType = tsH_PATIENT_IN
DrugAmountsObj.DsCode = gtydSysConfig.DepCode
For i = 1 To mCol.Count
DrugAmountsObj.Add Item(i).ItemCode, Item(i).ItemName, Item(i).BackAmount, Item(i).batchid, Item(i).Cprice, Item(i).gprice
Next i
DrugAmountsObj.GetStorage
End If
gdbobj.CNExe.BeginTrans
'库存事物
If gtydSysConfig.IfDecStore Then
If Not DrugAmountsObj.UpDateStorage Then
GoTo errlbl
End If
End If
'生成负的处方
For i = 1 To mCol.Count
If Item(i).BackAmount <> 0 Then
If Not Update_Open_RecipeSub(HISDbInsert, recipeSerial, i, Item(i).ItemCode, _
Item(i).Cprice, Item(i).BackAmount * (-1), _
Item(i).BackFair * (-1), Item(i).unit, Item(i).Factor, gtydSysConfig.DepCode, _
Item(i).Flag, Item(i).gprice, Item(i).gprice * Item(i).BackAmount * (-1), Item(i).batchid) Then
GoTo errlbl
End If
If Not Update_Open_ActReceiveSubItem(HISDBUpdate, _
FetchAmount:=Item(i).FetchedAmount - Item(i).BackAmount, _
FetchFair:=Item(i).FetchedFair - Item(i).BackFair, _
UpdateCondition:=" ActRevSerial = '" & ActRevSerial _
& "' AND RecipeNum = " & Num & " AND Num = " & Item(i).ItemNum) Then
GoTo errlbl
End If
If gtydSysConfig.IFFoot Then
If Not Update_House_BusSub(HISDbInsert, busserial, i, Item(i).ItemCode, Item(i).BackAmount, _
Item(i).gprice, Item(i).gprice * Item(i).BackAmount, Item(i).Cprice, _
Item(i).BackAmount * Item(i).Cprice, Item(i).unit, Item(i).Factor) Then
GoTo errlbl
End If
End If
End If
Next i
If gtydSysConfig.IFFoot Then
If Not Update_House_BusMain(HISDbInsert, busserial, gtydSysConfig.DepCode, "16", 1, gfnGetTime, _
gtydSysConfig.HdCode, "", Sickobj.PatientID, 0, "", PName) Then
GoTo errlbl
End If
End If
If Not Update_Open_RecipeMain(HISDbInsert, recipeSerial, Sickobj.Id, DepCode, DcCode, _
gtydSysConfig.DepCode, HdCode, FetchDate, (-1) * BackFair, _
FetchDate, HdCode, ActRevSerial, Num, 4) Then
GoTo errlbl
End If
If BackDrugAmountOut Then '处方数所有不记
If Not gdbobj.DBExec("Update Open_RecipeMain Set Status=Status |4 " _
& " WHERE ActRevSerial = '" & ActRevSerial _
& "' AND RecipeNum = " & Num) Then
GoTo errlbl
End If
End If
If Not Update_Open_ActReceiveSub(HISDBUpdate, Status:=IIf(BackDrugAmountOut, 0, 2), _
RecentFetchDate:=Me.FetchDate, RecentFetchHdCode:=Me.HdCode, PKCount:=PKCount, _
UpdateCondition:="ActRevSerial = '" & ActRevSerial _
& "' AND RecipeNum = " & Num) Then
GoTo errlbl
End If
gdbobj.CNExe.CommitTrans
Back = True
Ack = True
Exit Function
errlbl:
gdbobj.CNExe.RollbackTrans
End Function
Public Property Get IsDrug() As Boolean '是否为药品处方
If DsCode <> "" Then
IsDrug = True
End If
End Property
Public Property Get TotalFair() As Currency
Dim i As Integer
For i = 1 To Count
TotalFair = TotalFair + Item(i).TotalFair
Next i
End Property
Public Property Get ActFair() As Single
Dim i As Integer
For i = 1 To mCol.Count
ActFair = ActFair + Item(i).ActFair
Next i
End Property
Public Property Get ActPubFair() As Single
Dim i As Integer
For i = 1 To mCol.Count
If Item(i).Pub Then
ActPubFair = ActPubFair + Item(i).ActFair
End If
Next i
End Property
Public Property Get ActSelfFair() As Single
Dim i As Integer
For i = 1 To mCol.Count
If Not Item(i).Pub Then
ActSelfFair = ActSelfFair + Item(i).ActFair
End If
Next i
End Property
Public Property Get ActExportFair() As Single
Dim i As Integer
For i = 1 To mCol.Count
If Item(i).Export Then
ActExportFair = ActExportFair + Item(i).ActFair
End If
Next i
End Property
Public Property Get FetchFair() As Single
Dim i As Integer
For i = 1 To mCol.Count
FetchFair = FetchFair + Item(i).FetchFair
Next i
End Property
Public Property Get FetchPubFair() As Single
Dim i As Integer
For i = 1 To mCol.Count
If Item(i).Pub Then
FetchPubFair = FetchPubFair + Item(i).FetchFair
End If
Next i
End Property
Public Property Get FetchSelfFair() As Single
Dim i As Integer
For i = 1 To mCol.Count
If Not Item(i).Pub Then
FetchSelfFair = FetchSelfFair + Item(i).FetchFair
End If
Next i
End Property
Public Property Get FetchExportFair() As Single
Dim i As Integer
For i = 1 To mCol.Count
If Item(i).Export Then
FetchExportFair = FetchExportFair + Item(i).FetchFair
End If
Next i
End Property
Public Property Get FetchedFair() As Single
Dim i As Integer
For i = 1 To mCol.Count
FetchedFair = FetchedFair + Item(i).FetchedFair
Next i
End Property
Public Property Get FetchedPubFair() As Single
Dim i As Integer
For i = 1 To mCol.Count
If Item(i).Pub Then
FetchedPubFair = FetchedPubFair + Item(i).FetchedFair
End If
Next i
End Property
Public Property Get FetchedSelfFair() As Single
Dim i As Integer
For i = 1 To mCol.Count
If Not Item(i).Pub Then
FetchedSelfFair = FetchedSelfFair + Item(i).FetchedFair
End If
Next i
End Property
Public Property Get FetchedExportFair() As Single
Dim i As Integer
For i = 1 To mCol.Count
If Item(i).Export Then
FetchedExportFair = FetchedExportFair + Item(i).FetchedFair
End If
Next i
End Property
Public Property Get BackFair() As Single
Dim i As Integer
For i = 1 To mCol.Count
BackFair = BackFair + Item(i).BackFair
Next i
End Property
Public Property Get BackPubFair() As Single
Dim i As Integer
For i = 1 To mCol.Count
If Item(i).Pub Then
BackPubFair = BackPubFair + Item(i).BackFair
End If
Next i
End Property
Public Property Get BackSelfFair() As Single
Dim i As Integer
For i = 1 To mCol.Count
If Not Item(i).Pub Then
BackSelfFair = BackSelfFair + Item(i).BackFair
End If
Next i
End Property
Public Property Get BackExportFair() As Single
Dim i As Integer
For i = 1 To mCol.Count
If Item(i).Export Then
BackExportFair = BackExportFair + Item(i).BackFair
End If
Next i
End Property
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -