frmbackdrug.frm

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

                hisActiveSpreadCell spd, Row, Col
                Exit Sub
            End If
            If Not Save() Then
                MsgBox gDbObj.ErrDes, vbCritical
                Exit Sub
            End If
            init
            Unload Me
        Case 1
            init
            txtSkID.SetFocus
        Case 2
            Query
        Case 3
            Unload Me
    End Select
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        hisToActiveCtl(Me).SetFocus
    End If
End Sub

Private Sub Form_Load()
    hisFormToCenter Me, frmMain
    InitForm
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set frmBackDrug = Nothing
End Sub

Private Sub Lct_PosChanged(ByVal Pos As Long, ByVal OldPos As Long)
    FillData
End Sub


Private Sub mskDate_LostFocus(Index As Integer)
    If Not IsDate(mskDate(Index)) Then
        MsgBox gstrDATE_ERROR_MSG, vbCritical
        mskDate(Index).SetFocus
    End If
End Sub

Private Sub spd_EditMode(ByVal Col As Long, ByVal Row As Long, ByVal Mode As Integer, ByVal ChangeMade As Boolean)
    Dim Amount As Integer, BackAmount As Integer, cprice As Currency
    
    If ChangeMade Then
        If Col = 6 Then
            spd.Row = Row
            spd.Col = 5
            Amount = Val(spd.Text)
            spd.Col = 6
            BackAmount = Val(spd.Text)
            If BackAmount < 0 Or BackAmount > Amount Then
                spd.Value = 0
                BackAmount = 0
            End If
            spd.Col = 7
            cprice = Val(spd.Text)
            spd.Col = 9
            spd.Text = Format(cprice * BackAmount, "0.00")
        End If
    End If
End Sub

Private Sub spd_LeaveCell(ByVal Col As Long, ByVal Row As Long, ByVal NewCol As Long, ByVal NewRow As Long, Cancel As Boolean)
    gpdSpreadControl spd, Col, Row, NewCol, NewRow
End Sub

Private Sub txtSkID_GotFocus()
    OldSkID = txtSkID
End Sub

Private Sub txtSkID_LostFocus()
    Dim mStr As String
    
    If txtSkID = OldSkID Then Exit Sub
    If txtSkID = "" Then
        init
        Exit Sub
    End If
    If SickObj Is Nothing Then
        Set SickObj = New clsSick
    End If
    SickObj.SkIDByQuery = txtSkID
    If Not SickObj.IfRegInfo Then
        MsgBox "病案号> " & txtSkID & " <不存在", vbCritical
        init
        txtSkID.SetFocus
        Exit Sub
    Else
        If SickObj.Num <= 0 Then
            MsgBox "病人未住过院!", vbCritical
            init
            txtSkID.SetFocus
            Exit Sub
        End If
        If SickObj.IFOutHosp Then
            If chkFlush.Value = 0 Then
                If SickObj.IFFoot Then
                    MsgBox SickObj.Name & " 已出院结算! 不能再退药,如果确需退药。请选择结算后退药", vbCritical
                Else
                    MsgBox SickObj.Name & " 已办出院通知! 不能再退药,如果确需退药,请先取消出院通知后再退药。", vbCritical
                End If
                init
                txtSkID.SetFocus
                Exit Sub
            Else
                If Not SickObj.IFFoot Then
                    MsgBox SickObj.Name & " 已办出院通知! 不能再退药,如果确需退药,请先取消出院通知或结算后再退药。", vbCritical
                    init
                    txtSkID.SetFocus
                    Exit Sub
                End If
            End If
        End If
    End If
    Call gfnFillDataBySickRegInfo(Me, SickObj)
    spd.MaxRows = 0 '避免错退
    Lct.Visible = False
End Sub
Private Sub Query()
    Dim starDate As String
    Dim EndDate As String
    starDate = Format(mskDate(0), "yymmdd")
    EndDate = Format(CDate(mskDate(1)) + 1, "yymmdd")
    If SickObj Is Nothing Then Exit Sub
    If isHouse Then
        Lct.SQL = "SELECT FairMarkMain.DepCode,FairMarkMain.DcCode,FairMarkMain.MarkDate, " _
            & "FairMarkMain.HdCode,FairMarkMain.MarkSerial,FairMarkMain.Flag " _
            & "FROM (FairMarkMain INNER JOIN FairMarkSub ON FairMarkMain.MarkSerial =FairMarkSub.MarkSerial) " _
            & "INNER JOIN m_Drug ON FairMarkSub.ItemCode =m_Drug.ItemCode " _
            & "WHERE FairMarkMain.SkSerial = '" & SickObj.SkSerial & "' and fairMarkSub.Amount>0 " _
            & gfnMakeLimit(gtydSysConfig.ItemCode, "m_Drug.ItemCode") _
            & " AND FairMarkMain.Markserial >='" & starDate & "' AND FairMarkMain.Markserial <='" & EndDate & "' " _
            & "and FairMarkSub.dscode='" & gtydSysConfig.DepCode & "' " _
            & "GROUP BY FairMarkMain.DepCode,FairMarkMain.DcCode,FairMarkMain.MarkDate, " _
            & "FairMarkMain.HdCode,FairMarkMain.MarkSerial,FairMarkMain.Flag "
    Else
        Lct.SQL = "SELECT FairMarkMain.DepCode,FairMarkMain.DcCode,FairMarkMain.MarkDate, " _
            & "FairMarkMain.HdCode,FairMarkMain.MarkSerial,FairMarkMain.Flag " _
            & "FROM (FairMarkMain INNER JOIN FairMarkSub ON FairMarkMain.MarkSerial =FairMarkSub.MarkSerial) " _
            & "INNER JOIN m_Item ON FairMarkSub.ItemCode =m_Item.ItemCode " _
            & "WHERE FairMarkMain.SkSerial = '" & SickObj.SkSerial & "' and fairMarkSub.Amount>0 " _
            & " AND FairMarkMain.Markserial >='" & starDate & "' AND FairMarkMain.Markserial <='" & EndDate & "' " _
            & "GROUP BY FairMarkMain.DepCode,FairMarkMain.DcCode,FairMarkMain.MarkDate, " _
            & "FairMarkMain.HdCode,FairMarkMain.MarkSerial,FairMarkMain.Flag "
    End If
    Lct.Refresh
    If Lct.Count >= 1 Then
        Lct.Visible = True
        FillData
    Else
        Lct.Visible = False
        If isHouse Then
            MsgBox "没有本药房所需要信息！", vbCritical
        Else
            MsgBox "没有需退费的数据！", vbCritical
        End If
        
    End If
End Sub
Private Sub FillData()
    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 " _
            & "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 & "' 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 " _
            & "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 & "' 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 = Lct.CurColumns!MarkDate
    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 = 1
        spd.Text = TmpRs!ItemCode
        spd.Col = 2
        spd.Text = TmpRs!ItemName
        spd.Col = 3
        spd.Text = 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, "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
        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
        ErrDes = "请选择退药数量!"
        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
    Dim DrugAmountsObj As clsDrugAmounts
    Dim DepCode As String
    
    
On Error GoTo Errlbl
    If chkFlush.Value = 1 Then
        Flag = 1
    End If
    If chkBaby Then
        Flag = Flag + 2
    End If
    If chkOut Then
        Flag = Flag + 4
    End If
    MarkSerial = gFnGetSerial(stFairMark)
    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 = 6
            BackAmount = Val(spd.Value)
            If BackAmount > 0 Then
                J = J + 1
                spd.Col = 1
                ItemCode = spd.Text
                spd.Col = 2
                ItemName = spd.Text
                DrugAmountsObj.Add ItemCode, ItemName, BackAmount
            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 = 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, i, ItemCode, BackAmount, 1 * Gprice, GMoney, 1 * cprice, BackFair, Unit, 1) Then
                    GoTo Errlbl
                End If
            End If
            If Not Update_FairMarkBack(HISDbInsert, OldMarkSerial, i, 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, 1, Unit, -1 * BackFair, -1 * BackFair, gtydSysConfig.DepCode, _
                Gprice:=Gprice, GMoney:=-1 * GMoney) 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