frmfetch.frm

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

    Me.lblFairTotal = Format(CurFetchObj.ActFair, gstrMONEY_FORMAT)
    Me.lblFair = Format(CurFetchObj.FetchFair, gstrMONEY_FORMAT)
    Me.lblOutFairTotal = Format(CurFetchObj.ActExportFair, gstrMONEY_FORMAT)
    Me.lblOutFair = Format(CurFetchObj.FetchExportFair, gstrMONEY_FORMAT)
    Me.lblSelfFairTotal = Format(CurFetchObj.ActSelfFair, gstrMONEY_FORMAT)
    Me.lblSelfFair = Format(CurFetchObj.FetchSelfFair, gstrMONEY_FORMAT)
    Me.lblPubFairTotal = Format(CurFetchObj.ActPubFair, gstrMONEY_FORMAT)
    Me.lblPubFair = Format(CurFetchObj.FetchPubFair, gstrMONEY_FORMAT)
End Sub



Private Sub Frame1_DragDrop(Source As Control, X As Single, Y As Single)

End Sub

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

Private Sub mcr_Click(ByVal WhichB As UseMaintainCtl.BUTTONKEY)
    Dim tmpObj As Object
    
    Select Case WhichB
        Case BK_ADD
            Set tmpObj = ValidCheck
            If Not (tmpObj Is Nothing) Then
                tmpObj.SetFocus
                Exit Sub
            End If
            If Not chkAmount Then Exit Sub
            LoadData
            CurFetchObj.PName = SickObj.Name
            If Not CurFetchObj.Save(SickObj) Then
                MsgBox gDbObj.ErrDes, vbCritical
            Else
                If Fetchsobj.AllAck Then
                    init
                    txtID.SetFocus
                    Set SickObj = Nothing
                    Set Fetchsobj = Nothing
                    Set CurFetchObj = Nothing
                    If gtydSysConfig.IfFetchList Then frmFecthList.tvfecth.SetFocus
                    If gtydSysConfig.IfFetchList Then frmFecthList.getList
                        
                Else
                    mcr.KeyEnabled(BK_ADD) = False
                End If
            End If
        Case BK_QUERY
            Set QueryObj = New frmFetchQuery
            QueryObj.Show
        Case BK_CLEAR
            init
            txtID.SetFocus
            Set SickObj = Nothing
            Set Fetchsobj = Nothing
            Set CurFetchObj = Nothing
        Case BK_TRANS
            mcr.Status = CL_ADD
            init
            txtID.SetFocus
        Case BK_EXIT
            Unload Me
    End Select
End Sub

Private Sub mcr_StatusChanged()
    If mcr.Status = CL_ADD Then
        LockInput False
        lct.Visible = False
        lblDate.Visible = False
        lblHander.Visible = False
        fraRecipe.Visible = True
    Else
        LockInput False
        lct.Visible = True
        lblDate.Visible = True
        lblHander.Visible = True
        fraRecipe.Visible = False
    End If
End Sub

Private Sub mskPkCount_GotFocus()
    mskPkCount.SelStart = 0
    mskPkCount.SelLength = Len(mskPkCount)
End Sub

Private Sub mskPkCount_LostFocus()
    LoadData
    Sum
End Sub

Private Sub QueryObj_Ack(ByVal Cdt As String)
    If Cdt <> "" Then
        lct.SQL = "SELECT Open_RecipeMain.RecipeSerial " _
            & "FROM Open_RecipeMain WHERE Open_RecipeMain.FetchDate IS NOT NULL " _
            & " AND Open_RecipeMain.DsCode = '" & gtydSysConfig.DepCode & "' AND " & Cdt
        lct.Refresh
        If lct.Count >= 1 Then
            mcr.Status = CL_UPDATE
            FillQuery
        End If
    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 RemainAmount As Single, FetchAmount As Single
    Dim CPrice As Currency
    
    If ChangeMade Then
        If Col = 5 Then
           spd.Row = Row
           spd.Col = 4
           RemainAmount = Val(spd.Text)
           spd.Col = 5
           FetchAmount = spd.Text
           If FetchAmount < 0 Or FetchAmount > RemainAmount Then
                MsgBox "取药数量不能小于 0 或着 大于 收费数量!", vbCritical
                spd.Text = RemainAmount
                hisActiveSpreadCell spd, Row, Col - 1
            Else
                spd.Col = 6
                CPrice = spd.Text
                spd.Col = 7
                If FetchAmount = RemainAmount Then
                    spd.Text = CurFetchObj.Item(Row).ActFair
                Else
                    spd.Text = CPrice * FetchAmount
                End If
                
           End If
           LoadData
           Sum

        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 spd_RightClick(ByVal ClickType As Integer, ByVal Col As Long, ByVal Row As Long, ByVal MouseX As Long, ByVal MouseY As Long)
    Call usp.RightClick
End Sub

Private Sub txtID_GotFocus()
    mID = txtID
    txtID.SelStart = 0
    txtID.SelLength = Len(txtID)
End Sub

Public Sub txtID_LostFocus()
    Dim SQL As String
    Dim i As Integer
    Dim GType As Integer
    Dim fetch As Boolean
    If mID = txtID Then Exit Sub
    If txtID = "" Then
        init
        Exit Sub
    End If
    If SickObj Is Nothing Then
        Set SickObj = New clsSickOP
    End If
    SickObj.SkIDByBaseQuery = txtID
    txtName = SickObj.Name
    txtPtType = SickObj.PtDes
    If SickObj.ID = "" Then
        init
        txtID.SetFocus
        Exit Sub
    End If
    SQL = "SELECT Open_ActReceiveSub.ActRevSerial,Open_ActReceiveSub.RecipeNum," _
        & "Open_ActReceiveSubItem.Num,Open_ActReceiveSub.DcCode,m_Doctor.DcName," _
        & "Open_ActReceiveSub.DepCode,m_Depart.DepName,Open_ActReceiveSubItem.Flag," _
        & "m_Drug.ItemCode,m_Drug.ItemName,m_Drug.Model,Open_ActReceiveSubItem.Cprice,m_Drug.BaseUnit," _
        & "Open_ActReceiveSubItem.Unit,Open_ActReceiveSubItem.Factor,m_Drug.Gprice," _
        & "Open_ActReceiveSubItem.Amount,Open_ActReceiveSubItem.Fair,Open_ActReceiveSubItem.FetchAmount,Open_ActReceiveSubItem.FetchFair, " _
        & "Open_ActReceiveSubItem.revDepcode,Open_ActReceiveSub.recentFetchDate, " _
        & "Open_ActReceiveMain.RecentDate,Open_ActReceiveMain.SheetID, " _
        & "Open_ActReceiveSub.DsCode,m_Drug.Cprice as 'T_Price',Open_ActReceiveSub.rate,Open_ActReceiveSub.PKCount " _
        & "FROM ((((Open_ActReceiveMain INNER JOIN Open_ActReceiveSub " _
        & "ON Open_ActReceiveMain.ActRevSerial =Open_ActReceiveSub.ActRevSerial) " _
        & " INNER JOIN Open_ActReceiveSubItem " _
        & " ON Open_ActReceiveSub.ActRevSerial =Open_ActReceiveSubItem.ActRevSerial" _
        & " AND Open_ActReceiveSub.recipeNum =Open_ActReceiveSubItem.RecipeNum) " _
        & " INNER JOIN m_Drug ON m_Drug.ItemCode = Open_ActReceiveSubItem.ItemCode) " _
        & " INNER JOIN m_Depart ON Open_ActReceiveSub.DepCode =m_Depart.DepCode) " _
        & " LEFT JOIN m_Doctor ON Open_ActReceiveSub.DcCode =m_Doctor.DcCode " _
        & " WHERE Open_ActReceiveSub.Status & 1 =0 " _
        & " AND Open_ActReceiveMain.PatientID = '" & SickObj.ID & "'  and  RecentFetchDate is null"
    If gtydSysConfig.ConFigureRev = False Then
        SQL = SQL & " AND Open_ActReceiveSub.DsCode ='" & gtydSysConfig.DepCode & "'"
    End If
    SQL = SQL & gfnMakeLimit(gtydSysConfig.ItemCode, "m_Drug.ItemCode")
    SQL = SQL & " ORDER BY Open_ActReceiveSub.ActRevSerial,Open_ActReceiveSub.RecipeNum,Open_ActReceiveSubItem.Num"
    Set Fetchsobj = New clsFetchs
    Fetchsobj.Make SQL
    If Fetchsobj.Count = 0 Then
        MsgBox "病人无收费记录!", vbCritical
        init
        txtID.SetFocus
        Exit Sub
    End If
    
    For i = 1 To Fetchsobj.Count
        If Fetchsobj.Item(i).RecentFetchDate <> "" Then
            fetch = True
        Else
            fetch = False
        
        End If
    Next i
    If fetch Then
        MsgBox "此病人已经退过药了不能再取药!或退费后重新开处方.", vbCritical
        init
        txtID.SetFocus
        Exit Sub
    End If
    FillData
End Sub

Private Sub LoadData()
    Dim i As Integer
    If Val(mskPkCount) = 0 Then mskPkCount.Text = "1  "
    For i = 1 To spd.MaxRows
        spd.Row = i
        spd.Col = 5
'        spd.Col = CurFetchObj.Count
        CurFetchObj.Item(i).FetchAmount = spd.Text * CurFetchObj.Item(i).Factor * Val(mskPkCount)
        spd.Col = 7
        CurFetchObj.Item(i).FetchFair = spd.Text * Val(mskPkCount)
    Next i
    CurFetchObj.FetchDate = gfnGetTime
    CurFetchObj.HdCode = gtydSysConfig.HdCode
    CurFetchObj.PKCount = Val(mskPkCount)
End Sub
Private Function ValidCheck() As Object
    Dim i As Integer
    Dim Having As Boolean
    
    If SickObj Is Nothing Then
        MsgBox "请输入病人ID!", vbCritical
        Set ValidCheck = txtID
        Exit Function
    End If
    For i = 1 To spd.MaxRows
        spd.Row = i
        spd.Col = 5
        If Val(spd.Text) <> 0 Then
            Having = True
        End If
    Next i
    If Not Having Then
        MsgBox "此病人无取药项目!", vbCritical
        Set ValidCheck = spd
        Exit Function
    End If
    
End Function
Private Sub FillQuery()
    Dim QueryRecipeObj As clsRecipe
    Dim i As Integer
        
    Set QueryRecipeObj = New clsRecipe
    Set SickObj = New clsSickOP
    QueryRecipeObj.RecipeSerialByQuery = lct.CurColumns(0)

    SickObj.SkIDByBaseQuery = QueryRecipeObj.PatientID
    txtID = SickObj.ID
    txtName = SickObj.Name
    txtPtType = SickObj.PtDes
    txtDoctor = QueryRecipeObj.DcName
    txtDepart = QueryRecipeObj.DepName
    lblDate = QueryRecipeObj.FetchDate
    Me.lblHander = QueryRecipeObj.FetchHdName
    spd.MaxRows = QueryRecipeObj.Count
    If QueryRecipeObj.PKCount > 1 Then
        fraPK.Visible = True
    Else
        fraPK.Visible = False
    End If
    For i = 1 To spd.MaxRows
        spd.Row = i
        spd.Col = 1
        spd.Text = QueryRecipeObj.Item(i).itemname
        spd.Col = 2
        spd.Text = QueryRecipeObj.Item(i).Model
        spd.Col = 3
        spd.Text = QueryRecipeObj.Item(i).Unit
        spd.Col = 4
        spd.Text = QueryRecipeObj.Item(i).Amount / QueryRecipeObj.Item(i).Factor / QueryRecipeObj.PKCount
        spd.Col = 5
        spd.Text = QueryRecipeObj.Item(i).Amount / QueryRecipeObj.Item(i).Factor / QueryRecipeObj.PKCount
        spd.Col = 6
        spd.Text = QueryRecipeObj.Item(i).CPrice * QueryRecipeObj.Item(i).Factor
        spd.Col = 7
        spd.Text = QueryRecipeObj.Item(i).Fair / QueryRecipeObj.PKCount
        spd.Col = 8
        spd.Value = IIf(QueryRecipeObj.Item(i).Pub, 1, 0)
        spd.Col = 9
        spd.Value = IIf(QueryRecipeObj.Item(i).Export, 1, 0)
    Next i
    lblFair = Format(QueryRecipeObj.TotalFair, gstrMONEY_FORMAT)
    lblPubFair = Format(QueryRecipeObj.TotalPubFair, gstrMONEY_FORMAT)
    lblSelfFair = Format(QueryRecipeObj.TotalSelfFair, gstrMONEY_FORMAT)
    lblOutFair = Format(QueryRecipeObj.TotalExportFair, gstrMONEY_FORMAT)
    lblFairTotal = Format(QueryRecipeObj.TotalFair, gstrMONEY_FORMAT)
    lblPubFairTotal = Format(QueryRecipeObj.TotalPubFair, gstrMONEY_FORMAT)
    lblSelfFairTotal = Format(QueryRecipeObj.TotalSelfFair, gstrMONEY_FORMAT)
    lblOutFairTotal = Format(QueryRecipeObj.TotalExportFair, gstrMONEY_FORMAT)
    
'    Sum
End Sub

Private Sub LockInput(Optional Locked As Boolean = True)
    Dim tmpObj As Object
    
    For Each tmpObj In Me.Controls
        If TypeName(tmpObj) = "TextBox" Or TypeName(tmpObj) = "ComboBox" _
            Or TypeName(tmpObj) = "CheckBox" Then
                tmpObj.Enabled = Not Locked
        End If
        If TypeName(tmpObj) = "vaSpread" Then
            gpdLockSpread tmpObj, Locked
        End If
    Next
End Sub

Private Function chkAmount() As Boolean
    Dim i As Integer
    Dim ActAmount As Double, FetchAmount As Double
    
    For i = 1 To spd.MaxRows
        spd.Row = i
        spd.Col = 4
        ActAmount = Val(spd.Text)
        spd.Col = 5
        FetchAmount = Val(spd.Text)
        If ActAmount <> FetchAmount Then
            If MsgBox("第 " & i & " 条药品没取完！是否继续?", vbYesNo + 32) = vbYes Then
                chkAmount = True
            End If
            Exit Function
        Else
            chkAmount = True
        End If
    Next i
                
End Function