clsfetchs.cls

医院门诊医生工作站,vb6 SqlServer

'                        If Not gDbObj.DBExec(SQL) Then
'                            GoTo errlbl
'                        End If
'                    End If
                   If Not Update_Open_RecipeSub(HISDbInsert, recipeSerial, i, tmpObj.Item(i).ItemCode, _
                       tmpObj.Item(i).Cprice, tmpObj.Item(i).BackAmount * (-1), _
                       tmpObj.Item(i).BackFair * (-1), tmpObj.Item(i).BaseUnit, 1, _
                       tmpObj.Item(i).RevDepCode, tmpObj.Item(i).Flag, tmpObj.Item(i).gprice, _
                       tmpObj.Item(i).gprice * tmpObj.Item(i).BackAmount * -1, tmpObj.Item(i).batchid) Then  ''

                       GoTo errlbl
                   End If
                    If Not Update_Open_ActReceiveSubItem(HISDBUpdate, Amount:= _
                        tmpObj.Item(i).TotalAmount - tmpObj.Item(i).BackAmount, _
                        Fair:=tmpObj.Item(i).TotalFair - tmpObj.Item(i).BackFair, _
                        UpdateCondition:=" actRevSerial= '" & tmpObj.ActRevSerial _
                        & "' AND recipeNum = " & tmpObj.Num & " AND Num =" & tmpObj.Item(i).ItemNum) Then
                        GoTo errlbl
                    End If
                End If
            Next i
            Status = 0
            If tmpObj.BackOut Then
                Status = 1
            End If
            If tmpObj.FetchedFair <> 0 Then
                Status = Status + 2
            End If

            If Status <> 0 Then
                If Not Update_Open_ActReceiveSub(HISDBUpdate, Status:=Status, _
                    Fair:=tmpObj.TotalFair - tmpObj.BackFair, _
                    UpdateCondition:=" ActRevSerial= '" & tmpObj.ActRevSerial _
                    & "' AND recipeNum = " & tmpObj.Num) Then
                    GoTo errlbl
                End If
            End If
            If Not Update_Open_ReceiveSub(HISDbInsert, RevSerial, recipeSerial, (-1) * tmpObj.BackFair, _
                tmpObj.Rate, 1) Then
                GoTo errlbl
            End If
            recipeSerial = left(recipeSerial, Len(recipeSerial) - 4) _
                    & Format(Val(Right(recipeSerial, 4)) + 1, "0000")
        End If
    Next
    gdbobj.CNExe.CommitTrans
    Back = True
    Exit Function
errlbl:
    gdbobj.CNExe.RollbackTrans
End Function

Public Function BackRec(Num As Integer) As Boolean
    Dim RevSerial As String
    Dim recipeSerial As String
    Dim tmpObj As clsFetch, i As Integer
    Dim Status As Integer
    Dim TotalAmount As Integer, Cprice As Currency
    Dim SQL As String
    Dim tmprs As Recordset
    Dim oldRevSerial As String, oldRecipeSerial As String
On Error GoTo errlbl
    SQL = "select Revserial,Open_RecipeMain.recipeserial From Open_RecipeMain " _
        & "inner join Open_ReceiveSub on Open_ReceiveSub.recipeserial=Open_RecipeMain.recipeserial " _
        & "where actrevserial='" & Item(1).ActRevSerial & "' and recipenum=" & Num
    Set tmprs = gdbobj.GetNewRs(SQL)
    If Not tmprs.EOF Then
        oldRevSerial = tmprs(0)
        oldRecipeSerial = tmprs(1)
    End If
    RevSerial = gFnGetSerial(stRECEIVE)
    recipeSerial = gFnGetSerial(stRecipeSerial)
    
    gdbobj.CNExe.BeginTrans
    If BackFair = 0 Then
        gdbobj.ErrDes = "无退费！"
        GoTo errlbl
    End If
    If Not Update_Open_ReceiveSubSheet(HISDbInsert, oldRevSerial, oldRecipeSerial, "", gfnGetTime(), gtydSysConfig.HdCode) Then
        If Not Update_Open_ReceiveSubSheet(HISDBUpdate, CancelHdCode:=gtydSysConfig.HdCode, _
            CancelDate:=gfnGetTime(), UpdateCondition:="RevSerial ='" & oldRevSerial _
            & "' AND recipeserial='" & oldRecipeSerial & "' ") Then
                
                GoTo errlbl
        End If
    End If
    Set tmpObj = Item(Num)
    If Not Update_Open_ReceiveMain(HISDbInsert, RevSerial, gfnGetTime(), _
         gtydSysConfig.HdCode, Sickobj.Id, tmpObj.TotalFair - tmpObj.BackFair, (tmpObj.TotalFair - tmpObj.BackFair) * tmpObj.Rate, _
         , tmpObj.ActRevSerial, SheetID:=IIf(BackClear, Null, SheetID), ChequeNo:=ChequeNo) Then '退费只对某一次收费
        GoTo errlbl
    End If
    If Not Update_Open_ActReceiveMain(HISDBUpdate, RecentDate:=gfnGetTime(), _
        HdCode:=gtydSysConfig.HdCode, SheetID:=IIf(BackClear, Null, SheetID), _
        UpdateCondition:=" ActRevSerial= '" & tmpObj.ActRevSerial & "'") Then

        GoTo errlbl
    End If
    If tmpObj.BackFair > 0 Then
        '生成负处方，此处方既不算划价，也不算取药,但统计
        If Not Update_Open_RecipeMain(HISDbInsert, recipeSerial, Sickobj.Id, _
            tmpObj.DepCode, tmpObj.DcCode, _
            "", tmpObj.HdCode, tmpObj.FetchDate, tmpObj.BackFair * (-1), ActRevSerial:=tmpObj.ActRevSerial, _
            RecipeNum:=tmpObj.Num, Status:=2) Then
            
            GoTo errlbl
        End If
        For i = 1 To tmpObj.Count
            If tmpObj.Item(i).BackAmount <> 0 Then
                If Not Update_Open_RecipeSub(HISDbInsert, recipeSerial, i, tmpObj.Item(i).ItemCode, _
                    tmpObj.Item(i).Cprice, tmpObj.Item(i).BackAmount * (-1), _
                    tmpObj.Item(i).BackFair * (-1), tmpObj.Item(i).BaseUnit, 1, _
                    tmpObj.Item(i).RevDepCode, tmpObj.Item(i).Flag, tmpObj.Item(i).gprice, _
                    tmpObj.Item(i).BackAmount * (-1) * tmpObj.Item(i).gprice, tmpObj.Item(i).batchid) Then
                    
                    GoTo errlbl
                End If

                If Not Update_Open_ActReceiveSubItem(HISDBUpdate, Amount:= _
                    tmpObj.Item(i).TotalAmount - tmpObj.Item(i).BackAmount, _
                    Fair:=tmpObj.Item(i).TotalFair - tmpObj.Item(i).BackFair, _
                    UpdateCondition:=" actRevSerial= '" & tmpObj.ActRevSerial _
                    & "' AND recipeNum = " & tmpObj.Num & " AND Num =" & tmpObj.Item(i).ItemNum) Then
                    GoTo errlbl
                End If
            End If
        Next i
        Status = 0
        If tmpObj.BackOut Then
            Status = 1
        End If
        If tmpObj.FetchedFair <> 0 Then
            Status = Status + 2
        End If

        If Status <> 0 Then
            If Not Update_Open_ActReceiveSub(HISDBUpdate, Status:=Status, _
                Fair:=tmpObj.TotalFair - tmpObj.BackFair, _
                UpdateCondition:=" ActRevSerial= '" & tmpObj.ActRevSerial _
                & "' AND recipeNum = " & tmpObj.Num) Then
                GoTo errlbl
            End If
        End If
        If Not Update_Open_ReceiveSub(HISDbInsert, RevSerial, recipeSerial, (-1) * tmpObj.BackFair, _
            tmpObj.Rate, 1) Then
            GoTo errlbl
        End If
        If Not Update_Open_ReceiveSubSheet(HISDbInsert, RevSerial, recipeSerial, "", "", "") Then
            GoTo errlbl
        End If
    End If
    gdbobj.CNExe.CommitTrans
    BackRec = True
    Exit Function
errlbl:
    gdbobj.CNExe.RollbackTrans
End Function

Public Property Get BackFair() As Currency
    Dim i As Integer
    
    For i = 1 To Count
        BackFair = BackFair + Item(i).BackFair
    Next i
End Property
Public Property Get BackInFair() As Currency
    Dim i As Integer
    
    For i = 1 To Count
        BackInFair = BackInFair + Item(i).BackInFair
    Next i
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 TotalInFair() As Currency
    Dim i As Integer
    
    For i = 1 To Count
        TotalInFair = TotalInFair + Item(i).TotalFair * Item(i).Rate
    Next i
    
End Property

Public Property Get AllAck() As Boolean
    Dim i As Integer
    
    For i = 1 To Count
        If Not Item(i).Ack Then
            Exit Property
        End If
    Next i
    AllAck = True
End Property
Public Property Get BackClear() As Boolean
    Dim i As Integer
    
    For i = 1 To Count
        If Not Item(i).BackClear Then Exit Property
    Next i
    BackClear = True
End Property
Public Property Get CanBackClear() As Boolean
    Dim i As Integer
    
    For i = 1 To Count
        If Item(i).ActFair <> Item(i).TotalFair Then Exit Property
    Next i
    CanBackClear = True

End Property