frmbackdrug.frm

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

            & "           Group By FairMarkBack.markSerial,num ) FairBack on FairBack.MarkSerial=FairMarkSub.MarkSerial " _
            & "           and fairBack.num=FairMarkSub.num " _
            & "INNER JOIN m_Drug ON FairMarkSub.ItemCode =m_Drug.ItemCode " _
            & "WHERE FairMarkSub.MarkSerial ='" & Lct.CurColumns!MarkSerial & "' order by FairMarkSub.MarkSerial,FairMarkSub.num"
    Else
        StrSQL = "SELECT FairMarkSub.ItemCode,FairMarkSub.Unit as baseunit,m_Item.ItemName,'' as model,FairMarkSub.Unit as Unit," _
            & "FairMarkSub.Factor,FairMarkSub.CPrice,FairMarkSub.Gprice,FairMarkSub.Amount,FairBack.BackAmount," _
            & "FairMarkSub.MarkSerial,FairMarksub.depcode,FairMarkSub.num,1 as factor,batchid " _
            & "FROM FairMarkSub " _
            & "Left join (select FairMarkBack.MarkSerial,num,sum(BackAmount) as 'BackAmount' from FairMarkBack " _
            & "           left join fairMarkMain on FairMarkMain.markserial=fairMarkBack.MarkSerial " _
            & "           where FairMarkMain.SkSerial='" & Sickobj.SkSerial & "' " _
            & "           Group By FairMarkBack.markSerial,num ) FairBack " _
            & "           on FairBack.MarkSerial=FairMarkSub.MarkSerial " _
            & "           and fairBack.num=FairMarkSub.num " _
            & "INNER JOIN m_Item ON FairMarkSub.ItemCode =m_Item.ItemCode " _
            & "WHERE FairMarkSub.MarkSerial ='" & Lct.CurColumns!MarkSerial & "' "
        StrSQL = StrSQL & " union SELECT FairMarkSub.ItemCode,FairMarkSub.Unit as baseunit,m_Drug.ItemName,model,FairMarkSub.Unit as Unit," _
            & "FairMarkSub.Factor,FairMarkSub.CPrice,FairMarkSub.Gprice,FairMarkSub.Amount,FairBack.BackAmount," _
            & "FairMarkSub.MarkSerial,FairMarksub.depcode,FairMarkSub.num,fairmarksub.factor,batchid " _
            & "FROM FairMarkSub " _
            & "Left join (select FairMarkBack.MarkSerial,num,sum(BackAmount) as 'BackAmount' from FairMarkBack " _
            & "           left join fairMarkMain on FairMarkMain.markserial=fairMarkBack.MarkSerial " _
            & "           where FairMarkMain.SkSerial='" & Sickobj.SkSerial & "' " _
            & "           Group By FairMarkBack.markSerial,num ) FairBack " _
            & "           on FairBack.MarkSerial=FairMarkSub.MarkSerial " _
            & "           and fairBack.num=FairMarkSub.num " _
            & "INNER JOIN m_Drug ON FairMarkSub.ItemCode =m_Drug.ItemCode " _
            & "WHERE FairMarkSub.MarkSerial ='" & Lct.CurColumns!MarkSerial & "' " _
            & "and fairmarksub.dscode is null order by FairMarkSub.MarkSerial,FairMarkSub.num"
    End If
    Set tmprs = gdbobj.GetNewRs(StrSQL)
    lblDepart = Lct.CurColumns!DepCode
    lblDoctor = IIf(IsNull(Lct.CurColumns!DcCode), "", Lct.CurColumns!DcCode)
    lblDate = Format(CDate(Lct.CurColumns!MarkDate), "yyyy/mm/dd hh:mm:ss")
    lblDate.Tag = Format(CDate(Lct.CurColumns!MarkDate), "yyyy/mm/dd")
    If Sickobj.IFFoot And Sickobj.IFOutHosp Then
        chkFlush.value = 1
    Else
        chkFlush.value = 0
    End If
    If (Lct.CurColumns!Flag And 2) = 2 Then
        chkBaby.value = 1
    Else
        chkBaby.value = 0
    End If
    If (Lct.CurColumns!Flag And 4) = 4 Then
        chkOut.value = 1
    Else
        chkOut.value = 0
    End If
    spd.MaxRows = 0
    Do Until tmprs.EOF
        spd.MaxRows = spd.MaxRows + 1
        spd.Row = spd.MaxRows
        spd.Col = 0
        spd.Text = tmprs!Num
        spd.Col = 1
        spd.Text = tmprs!ItemCode
        spd.Col = 2
        spd.Text = tmprs!ItemName
        spd.Col = 3
        spd.Text = IIf(IsNull(tmprs!batchid), "", tmprs!batchid) & "\" & tmprs!model
        spd.Col = 4
        spd.Text = tmprs!unit
        spd.Col = 5
        
        
        spd.Text = tmprs!Amount - IIf(IsNull(tmprs!BackAmount), 0, tmprs!BackAmount)
        spd.Col = 6
        If tmprs!Amount <= 0 Then
            spd.Lock = True
        Else
            spd.Lock = False
        End If
        spd.Text = 0
            
        spd.Col = 7
        spd.Text = tmprs!Cprice
        spd.Col = 8
        spd.Text = Format(tmprs!Cprice * (tmprs!Amount - IIf(IsNull(tmprs!BackAmount), 0, tmprs!BackAmount)), "0.00")
        spd.Col = 9
        spd.Text = "0.00"
        spd.Col = 10
        spd.Text = IIf(IsNull(tmprs!gprice), "0.00", tmprs!gprice)
        spd.Col = 11
        spd.Text = tmprs!MarkSerial
        spd.Col = 12
        spd.Text = tmprs!DepCode
        spd.Col = 13
        spd.Text = tmprs!Factor
        tmprs.MoveNext
    Loop
End Sub
Private Function ValidInput(ErrDes As String, Row As Long, Col As Long) As Object
    Dim i As Integer, Having As Boolean
    
    For i = 1 To spd.MaxRows
        spd.Row = i
        spd.Col = 6
        If spd.value > 0 Then
            Having = True
        End If
    Next i
    If Not Having Then
        If isHouse Then
            ErrDes = "请输入退药数量!"
        Else
            ErrDes = "请输入退费数量"
        End If
        Set ValidInput = spd
        Row = 1
        Col = 6
        Exit Function
    End If
End Function
Public Function Save()
    Dim i As Integer, j As Integer
    Dim MarkSerial As String, ItemName As String, OldMarkSerial As String, busserial As String
    Dim ItemCode As String, BackAmount As Long, Cprice As Currency, gmoney As Currency
    Dim gprice As Currency, unit As String
    Dim Flag As Integer, BackFair As Currency, TBackFair As Currency, batchid As String
    Dim DrugAmountsObj As clsDrugAmounts
    Dim DepCode As String
    Dim Num As Integer, Factor As Integer
    
On Error GoTo errlbl
    If chkFlush.value = 1 Then
        Flag = 9
    End If
    If chkBaby Then
        Flag = Flag + 2
    End If
    If chkOut Then
        Flag = Flag + 4
    End If
    If gtydSysConfig.EnableModiDate Then
        MarkSerial = gFnGetSerial(stFairMark, lblDate.Tag)
    Else
        MarkSerial = gFnGetSerial(stFairMark)
    End If
    busserial = gFnGetSerial(stHouseBusSerial)

    If gtydSysConfig.IfDecStore And isHouse Then
        Set DrugAmountsObj = New clsDrugAmounts
        DrugAmountsObj.Direct = 1
        DrugAmountsObj.DtType = tsH_SICK_IN
        DrugAmountsObj.DsCode = gtydSysConfig.DepCode
        For i = 1 To spd.MaxRows
            spd.Row = i
            spd.Col = 7
            Cprice = Val(spd.value)
            spd.Col = 10
            gprice = Val(spd.value)
            spd.Col = 3
            If InStr(spd.Text, "\") > 1 Then
                batchid = left(spd.Text, InStr(spd.Text, "\") - 1)
            Else
                batchid = "000001"
            End If
            spd.Col = 6
            spd.Col = 13
            Factor = IIf(Val(spd.Text) = 0, 1, Val(spd.Text))
            spd.Col = 6
            BackAmount = Val(spd.value) * Factor
            If BackAmount > 0 Then
                j = j + 1
                spd.Col = 1
                ItemCode = spd.Text
                spd.Col = 2
                ItemName = spd.Text
                DrugAmountsObj.Add ItemCode, ItemName, BackAmount, batchid, Cprice, gprice
            End If
        Next i
        DrugAmountsObj.GetStorage
    End If
    gdbobj.CNExe.BeginTrans
    If gtydSysConfig.IfDecStore And isHouse Then
        If Not DrugAmountsObj.UpDateStorage Then
            GoTo errlbl
        End If
    End If
    If isHouse And gtydSysConfig.IFFoot Then
        If Not Update_House_BusMain(HISDbInsert, busserial, gtydSysConfig.DepCode, "18", 1, gfnGetTime(), _
                           gtydSysConfig.HdCode, Sickobj.SkSerial, "", 0, "", Sickobj.Name) Then
            GoTo errlbl
        End If
    End If
    If Not Update_FairMarkMain(HISDbInsert, MarkSerial, Sickobj.SkSerial, gfnGetTime(), _
        gtydSysConfig.HdCode, lblDepart, lblDoctor, Flag:=Flag, _
        FetchDate:=gfnGetTime(), FetchHdCode:=gtydSysConfig.HdCode) Then
        
        GoTo errlbl
    End If
    For i = 1 To spd.MaxRows
        spd.Row = i
        spd.Col = 6
        BackAmount = Val(spd.value)
        If BackAmount > 0 Then
            j = j + 1
            spd.Col = 0
            Num = Val(spd.Text)
            spd.Col = 3
            If InStr(spd.Text, "\") > 1 Then
                batchid = left(spd.Text, InStr(spd.Text, "\") - 1)
            Else
                batchid = ""
            End If
            spd.Col = 13
            Factor = IIf(Val(spd.Text) = 0, 1, Val(spd.Text))
            spd.Col = 1
            ItemCode = spd.Text
            spd.Col = 7
            Cprice = Val(spd.value)
            spd.Col = 10
            gprice = Val(spd.value)
            spd.Col = 11
            OldMarkSerial = spd.value
            spd.Col = 12
            DepCode = spd.value
            spd.Col = 9
            BackFair = Val(spd.value)
            spd.Col = 4
            unit = spd.Text
            gmoney = Format(gprice * BackAmount, "0.00")
            TBackFair = TBackFair - BackFair
            If isHouse And gtydSysConfig.IFFoot Then
                If Not Update_House_BusSub(HISDbInsert, busserial, j, ItemCode, BackAmount * Factor, gprice / Factor, gmoney, Cprice / Factor, BackFair, unit, 1) Then
                    GoTo errlbl
                End If
            End If
            If Not Update_FairMarkBack(HISDbInsert, OldMarkSerial, Num, Format(Now, "yyyy/mm/dd hh:mm:ss"), 1 * BackAmount, _
                      left(gtydSysConfig.HdName, 8), 0) Then
                GoTo errlbl
            End If
            
            If Not Update_FairMarkSub(HISDbInsert, MarkSerial, j, ItemCode, DepCode, _
                -1 * BackAmount, Cprice, Factor, unit, -1 * BackFair, -1 * BackFair, gtydSysConfig.DepCode, _
                gprice:=gprice, gmoney:=-1 * gmoney, batchid:=batchid) Then
                GoTo errlbl
            End If
        End If
    Next i
    If Not gdbobj.DBExec("UPDATE SickInfo Set Fair=Fair+  " & TBackFair _
        & " WHERE SkSerial = '" & Sickobj.SkSerial & "'") Then
        GoTo errlbl
    End If
    Save = True
    gdbobj.CNExe.CommitTrans
    Exit Function
errlbl:
    gdbobj.CNExe.RollbackTrans
End Function

Private Sub FillDataM(ItemCode As String)
    Dim tmprs As Recordset
    Dim StrSQL As String
    If isHouse Then
        StrSQL = "SELECT FairMarkSub.ItemCode,m_Drug.BaseUnit,m_Drug.ItemName,m_Drug.Model,FairMarkSub.Unit," _
            & "FairMarkSub.Factor,FairMarkSub.CPrice,FairMarkSub.Gprice,FairMarkSub.Amount,FairBack.BackAmount," _
            & "FairMarkSub.MarkSerial,FairMarksub.depcode,FairMarkSub.num,FairMarkSub.factor,batchid " _
            & "FROM FairMarkSub " _
            & "Left join (select FairMarkBack.MarkSerial,num,sum(BackAmount) as 'BackAmount' from FairMarkBack " _
            & "           left join fairMarkMain on FairMarkMain.markserial=fairMarkBack.MarkSerial " _
            & "           where FairMarkMain.SkSerial='" & Sickobj.SkSerial & "' " _
            & "           Group By FairMarkBack.markSerial,num ) FairBack on FairBack.MarkSerial=FairMarkSub.MarkSerial " _
            & "           and fairBack.num=FairMarkSub.num " _
            & "INNER JOIN m_Drug ON FairMarkSub.ItemCode =m_Drug.ItemCode " _
            & "WHERE FairMarkSub.MarkSerial ='" & Lct.CurColumns!MarkSerial & "' " _
            & "AND fairmarksub.itemcode='" & ItemCode & "'   order by FairMarkSub.MarkSerial,FairMarkSub.num "
    Else
        StrSQL = "SELECT FairMarkSub.ItemCode,FairMarkSub.Unit as baseunit,m_Item.ItemName,'' as model,FairMarkSub.Unit as Unit," _
            & "FairMarkSub.Factor,FairMarkSub.CPrice,FairMarkSub.Gprice,FairMarkSub.Amount,FairBack.BackAmount," _
            & "FairMarkSub.MarkSerial,FairMarksub.depcode,FairMarkSub.num,1 as factor,batchid " _
            & "FROM FairMarkSub " _
            & "Left join (select FairMarkBack.MarkSerial,num,sum(BackAmount) as 'BackAmount' from FairMarkBack " _
            & "           left join fairMarkMain on FairMarkMain.markserial=fairMarkBack.MarkSerial " _
            & "           where FairMarkMain.SkSerial='" & Sickobj.SkSerial & "' " _
            & "           Group By FairMarkBack.markSerial,num ) FairBack " _
            & "           on FairBack.MarkSerial=FairMarkSub.MarkSerial " _
            & "           and fairBack.num=FairMarkSub.num " _
            & "INNER JOIN m_Item ON FairMarkSub.ItemCode =m_Item.ItemCode " _
            & "WHERE FairMarkSub.MarkSerial ='" & Lct.CurColumns!MarkSerial & "' AND fairmarksub.itemcode='" & ItemCode & "' "

        StrSQL = StrSQL & " union SELECT FairMarkSub.ItemCode,FairMarkSub.Unit as baseunit,m_Drug.ItemName,'' as model,FairMarkSub.Unit as Unit," _
            & "FairMarkSub.Factor,FairMarkSub.CPrice,FairMarkSub.Gprice,FairMarkSub.Amount,FairBack.BackAmount," _
            & "FairMarkSub.MarkSerial,FairMarksub.depcode,FairMarkSub.num,fairmarksub.factor,batchid " _
            & "FROM FairMarkSub " _
            & "Left join (select FairMarkBack.MarkSerial,num,sum(BackAmount) as 'BackAmount' from FairMarkBack " _
            & "           left join fairMarkMain on FairMarkMain.markserial=fairMarkBack.MarkSerial " _
            & "           where FairMarkMain.SkSerial='" & Sickobj.SkSerial & "' " _
            & "           Group By FairMarkBack.markSerial,num ) FairBack " _
            & "           on FairBack.MarkSerial=FairMarkSub.MarkSerial " _
            & "           and fairBack.num=FairMarkSub.num " _
            & "INNER JOIN m_Drug ON FairMarkSub.ItemCode =m_Drug.ItemCode " _
            & "WHERE FairMarkSub.MarkSerial ='" & Lct.CurColumns!MarkSerial & "' AND fairmarksub.itemcode='" & ItemCode & "' " _
            & "and fairmarksub.dscode is null order by FairMarkSub.MarkSerial,FairMarkSub.num"
    End If
    Set tmprs = gdbobj.GetNewRs(StrSQL)
    lblDepart = Lct.CurColumns!DepCode
    lblDoctor = IIf(IsNull(Lct.CurColumns!DcCode), "", Lct.CurColumns!DcCode)
    lblDate = Format(Lct.CurColumns!MarkDate, "yyyy-mm-dd hh:mm:ss")
    lblDate.Tag = Format(Lct.CurColumns!MarkDate, "yyyy-mm-dd")
    If Sickobj.IFFoot And Sickobj.IFOutHosp Then
        chkFlush.value = 1
    Else
        chkFlush.value = 0
    End If
    If (Lct.CurColumns!Flag And 2) = 2 Then
        chkBaby.value = 1
    Else
        chkBaby.value = 0
    End If
    If (Lct.CurColumns!Flag And 4) = 4 Then
        chkOut.value = 1
    Else
        chkOut.value = 0
    End If
    spd.MaxRows = 0
    Do Until tmprs.EOF
        spd.MaxRows = spd.MaxRows + 1
        spd.Row = spd.MaxRows
        spd.Col = 0
        spd.Text = tmprs!Num
        spd.Col = 1
        spd.Text = tmprs!ItemCode
        spd.Col = 2
        spd.Text = tmprs!ItemName
        spd.Col = 3
        spd.Text = IIf(IsNull(tmprs!batchid), "", tmprs!batchid) & "\" & tmprs!model
        spd.Col = 4
        spd.Text = tmprs!unit
        spd.Col = 5
        
        
        spd.Text = tmprs!Amount - IIf(IsNull(tmprs!BackAmount), 0, tmprs!BackAmount)
        spd.Col = 6
        If tmprs!Amount <= 0 Then
            spd.Lock = True
        Else
            spd.Lock = False
        End If
        spd.Text = 0
            
        spd.Col = 7
        spd.Text = tmprs!Cprice
        spd.Col = 8
        spd.Text = Format(tmprs!Cprice * (tmprs!Amount - IIf(IsNull(tmprs!BackAmount), 0, tmprs!BackAmount)), "0.00")
        spd.Col = 9
        spd.Text = "0.00"
        spd.Col = 10
        spd.Text = IIf(IsNull(tmprs!gprice), "0.00", tmprs!gprice)
        spd.Col = 11
        spd.Text = tmprs!MarkSerial
        spd.Col = 12
        spd.Text = tmprs!DepCode
        spd.Col = 13
        spd.Text = tmprs!Factor
        tmprs.MoveNext
    Loop
End Sub