⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 clsfetch.cls

📁 医院门诊医生工作站,vb6 SqlServer
💻 CLS
📖 第 1 页 / 共 2 页
字号:
    
    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 + -