frmfigurebus_bak.frm

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

                End If
                Init
                Set RecipesObj = Nothing
                txtID.SetFocus
            Else
                RaiseEvent Ack(RecipesObj)
            End If
        Case BK_DEL
            If QueryRecipeObj.Cancel Then
                mcr.KeyEnabled(BK_DEL) = False
                Me.lblCancel.Visible = True
            End If
        Case BK_CLEAR
            Init
            If mItemType = 0 Then
                txtID.SetFocus
            End If
        Case BK_TRANS
            mcr.Status = CL_ADD
            If mItemType = 0 Then
                txtID.SetFocus
            End If
        Case BK_QUERY
            Set QueryObj = New frmFigureQuery
            QueryObj.Show vbModal
        Case BK_EXIT
            RaiseEvent Cancel
            Unload Me
    End Select
End Sub

Private Sub mcr_StatusChanged()
    If mcr.Status = CL_ADD Then
        Init
        hisLockInput Me, False
        ListCtl1.Visible = False
        Me.cmdNextRecipeNum.Enabled = True
        lblDate.Visible = False
        Me.lblHander.Visible = False
    Else
        Init
        hisLockInput Me, True
        ListCtl1.Visible = True
        Me.cmdNextRecipeNum.Enabled = False
        lblDate.Visible = True
        Me.lblHander.Visible = True
        
    End If
End Sub


Private Sub QueryObj_Ack(ByVal Cdt As String)
    Dim SQL As String
    
    If gtydSysConfig.DepCode = "" Then
        SQL = "SELECT RecipeSerial FROM Open_RecipeMain" _
            & " WHERE DsCode IS NULL AND Status & 2 = 0 AND " & Cdt & ""
    Else
        SQL = "SELECT RecipeSerial FROM Open_RecipeMain" _
            & " WHERE Status & 2 = 0 AND DsCode ='" & gtydSysConfig.DepCode & "' AND " & Cdt & ""
    End If
    Set QueryObj = Nothing
    ListCtl1.SQL = SQL
    ListCtl1.Refresh
    If ListCtl1.Count > 0 Then
        mcr.Status = CL_UPDATE
        
        Set QueryRecipeObj = New clsRecipe
        QueryRecipeObj.RecipeSerialByQuery = ListCtl1.CurColumns(0)
        FillData
    Else
        Init
        mcr.Status = CL_ADD
    End If
End Sub

Private Sub spdFigure_EditMode(ByVal Col As Long, ByVal Row As Long, ByVal Mode As Integer, ByVal ChangeMade As Boolean)
    Dim TmpStr As String
    Dim mFactor As Single
    Dim i As Integer, ItemCode As String
    Dim CPrice As Currency, Amount As Single, Factor As Single, Model As String, CurUnit As String
    
    spdFigure.Col = Col
    spdFigure.Row = Row
    If ChangeMade Or gfnGetCell(spdFigure, Row, 1) = "" Then
        Select Case Col
            Case 1: '名称
                TmpStr = spdFigure.Text
                If TmpStr <> "" Then
                    If mItemType = 0 Then
                        Select Case gtydSysConfig.DefaultUnit
                            Case 0
                                ComnHlp1.SQL = "SELECT ItemCode,ItemName,ItemName," _
                                    & "Model,BaseUnit,BaseUnit,1,Cprice,Flag,Gprice  " _
                                    & "FROM m_Drug WHERE Brief Like '##%' AND Flag & 128 = 0 " _
                                    & gfnMakeLimit(gtydSysConfig.ItemCode, "ItemCode") _
                                    & " UNION SELECT m_Drug.ItemCode,m_DrugAlias.AliasName,m_Drug.ItemName," _
                                    & "m_Drug.model,m_Drug.BaseUnit,m_Drug.BaseUnit,1,m_Drug.Cprice,Flag,GPrice " _
                                    & "FROM m_Drug INNER JOIN m_DrugAlias ON " _
                                    & "m_Drug.ItemCode = m_DrugAlias.ItemCode " _
                                    & "WHERE m_DrugAlias.Brief LIKE '##%' AND m_Drug.Flag & 128 = 0 " _
                                    & gfnMakeLimit(gtydSysConfig.ItemCode, "m_Drug.ItemCode")
                            Case 1
                                ComnHlp1.SQL = "SELECT ItemCode,ItemName,ItemName," _
                                    & "Model,BaseUnit,GenalUnit,Factor,Cprice,Flag,GPrice  " _
                                    & "FROM m_Drug WHERE Brief Like '##%' AND Flag & 128 = 0 " _
                                    & gfnMakeLimit(gtydSysConfig.ItemCode, "ItemCode") _
                                    & " UNION SELECT m_Drug.ItemCode,m_DrugAlias.AliasName,m_Drug.ItemName," _
                                    & "m_Drug.model,m_Drug.BaseUnit,m_Drug.GenalUnit,m_Drug.Factor,m_Drug.Cprice,Flag,GPrice " _
                                    & "FROM m_Drug INNER JOIN m_DrugAlias ON " _
                                    & "m_Drug.ItemCode = m_DrugAlias.ItemCode " _
                                    & "WHERE m_DrugAlias.Brief LIKE '##%' AND m_Drug.Flag & 128 = 0 " _
                                    & gfnMakeLimit(gtydSysConfig.ItemCode, "m_Drug.ItemCode")
                        End Select
                        ComnHlp1.FormatHead = _
                           "|名                       称         ||规              格||单    位|| 零售价"
                        'Drug: 名称-别名-正式名-规格-基本单位-当前单位-换算关系-单价-Flag
                    Else
                        ComnHlp1.SQL = "SELECT ItemCode,ItemName,ItemName,Unit,CPrice,m_Item.DepCode,DepName " _
                            & "FROM m_Item LEFT JOIN m_Depart ON m_Item.DepCode= m_Depart.DepCode " _
                            & "WHERE m_Item.Brief Like '##%' AND m_Item.Flag & 2 = 0 " _
                            & "UNION SELECT m_Item.ItemCode,m_ItemAlias.AliasName,m_Item.ItemName,Unit,CPrice," _
                            & "m_Item.DepCode,DepName " _
                            & "FROM (m_Item LEFT JOIN m_ItemAlias  ON m_Item.ItemCode =m_ItemAlias.ItemCode) " _
                            & "LEFT JOIN m_Depart ON m_Item.DepCode= m_Depart.DepCode " _
                            & "WHERE m_ItemAlias.Brief LIKE '##%' AND m_Item.Flag & 2 = 0 "
                        ComnHlp1.FormatHead = _
                           "|名                       称         ||单    位| 零售价  ||收费科别"
                        'item: 名称-别名-正式名-单位-单价-收费科别编码-收费科别名称-Flag
                    End If
                    ComnHlp1.InitPut = TmpStr
                    ComnHlp1.WidthRate = 1.5
                    ComnHlp1.ParmTag = "Item"
                    ComnHlp1.ShowHelp vbModal
                Else
                    If spdFigure.MaxRows <> Row Then
                        spdFigure.Row = Row
                        spdFigure.Action = SS_ACTION_DELETE_ROW
                        spdFigure.MaxRows = spdFigure.MaxRows - 1
                    End If
                    Sum
                End If
            Case 3 '单位 ----> 变  数量不变、批发、实际、零售
                If Row = spdFigure.MaxRows Then Exit Sub
                TmpStr = spdFigure.Text
                CurUnit = TmpStr
                spdFigure.Col = 9
                ItemCode = spdFigure.Text
                spdFigure.Col = 2
                Model = Left(spdFigure.Text, InStr(spdFigure.Text, " * ") - 1)
                spdFigure.Text = Model & " * " & Int(gUnitobj(ItemCode).Item(CurUnit).Factor)

                spdFigure.Col = 4
                Amount = Val(spdFigure.Text)
                spdFigure.Col = 12
                Factor = Val(spdFigure.Text)
                
                spdFigure.Col = 5 '零售价
                spdFigure.Text = Val(spdFigure.Text) * (gUnitobj(ItemCode).Item(CurUnit).Factor / Factor)
                CPrice = Val(spdFigure.Text)
                spdFigure.Col = 6
                spdFigure.Text = CPrice * Amount
                spdFigure.Col = 12
                spdFigure.Text = gUnitobj(ItemCode).Item(CurUnit).Factor
                Sum
            Case 4 '数量
                If Row = spdFigure.MaxRows Then Exit Sub
                TmpStr = spdFigure.Text
                spdFigure.Col = 5
                CPrice = Val(spdFigure.Text)
                spdFigure.Col = 6
                spdFigure.Text = Val(TmpStr) * CPrice
                Sum '            Case 3 '单位
            Case 5 '单价变 -->金额变
                spdFigure.Col = 4
                Amount = Val(spdFigure.Text)
                spdFigure.Col = 5
                CPrice = Val(spdFigure.Text)
                If CPrice <= 0 Then
                    MsgBox "单价必须大于 0.00", vbCritical
                    Exit Sub
                End If
                spdFigure.Col = 6
                
                spdFigure.Text = Amount * CPrice
                Sum '            Case 3 '单位
            Case 7 '收费科别
                If Row = spdFigure.MaxRows Then Exit Sub
                TmpStr = spdFigure.Text
                If TmpStr <> "" Then
                    ComnHlp1.SQL = "SELECT m_Depart.DepCode,m_Depart.DepName FROM m_Depart" _
                            & " WHERE m_Depart.Brief LIKE '##%' AND Leaf =1 AND m_Depart.Flag & 12 <>4 "
                    ComnHlp1.InitPut = TmpStr
                    ComnHlp1.FormatHead = "科  别  编  码|科    别    名    称   "
                    ComnHlp1.WidthRate = 1
                    ComnHlp1.ParmTag = "RevDepart"
                    ComnHlp1.ShowHelp vbModal
                End If

        End Select
    End If
End Sub

Private Sub Sum()
    Dim CurRecipeObj As clsRecipe
'
    If Not (RecipesObj Is Nothing) Then
        Set CurRecipeObj = RecipesObj.Item(Val(Me.lblRecipeNum))
        If CurRecipeObj Is Nothing Then
            Set CurRecipeObj = New clsRecipe
            LoadDataByRecipe CurRecipeObj
            Me.lblFairTotal = Format(RecipesObj.TotalFair + CurRecipeObj.TotalFair, gstrMONEY_FORMAT)
            Me.lblFair = Format(CurRecipeObj.TotalFair, gstrMONEY_FORMAT)
            Me.lblOutFairTotal = Format(RecipesObj.TotalExportFair + CurRecipeObj.TotalExportFair, gstrMONEY_FORMAT)
            Me.lblOutFair = Format(CurRecipeObj.TotalExportFair, gstrMONEY_FORMAT)
            Me.lblSelfFairTotal = Format(RecipesObj.TotalSelfFair + CurRecipeObj.TotalSelfFair, gstrMONEY_FORMAT)
            Me.lblSelfFair = Format(CurRecipeObj.TotalSelfFair, gstrMONEY_FORMAT)
            Me.lblPubFairTotal = Format(RecipesObj.TotalPubFair + CurRecipeObj.TotalPubFair, gstrMONEY_FORMAT)
            Me.lblPubFair = Format(CurRecipeObj.TotalPubFair, gstrMONEY_FORMAT)
        Else
            Me.lblFairTotal = Format(RecipesObj.TotalFair, gstrMONEY_FORMAT)
            Me.lblFair = Format(CurRecipeObj.TotalFair, gstrMONEY_FORMAT)
            Me.lblOutFairTotal = Format(RecipesObj.TotalExportFair, gstrMONEY_FORMAT)
            Me.lblOutFair = Format(CurRecipeObj.TotalExportFair, gstrMONEY_FORMAT)
            Me.lblSelfFairTotal = Format(RecipesObj.TotalSelfFair, gstrMONEY_FORMAT)
            Me.lblSelfFair = Format(CurRecipeObj.TotalSelfFair, gstrMONEY_FORMAT)
            Me.lblPubFairTotal = Format(RecipesObj.TotalPubFair, gstrMONEY_FORMAT)
            Me.lblPubFair = Format(CurRecipeObj.TotalPubFair, gstrMONEY_FORMAT)
    
        End If
    Else
        Set CurRecipeObj = New clsRecipe
        LoadDataByRecipe CurRecipeObj
        Me.lblFairTotal = Format(CurRecipeObj.TotalFair, gstrMONEY_FORMAT)
        Me.lblFair = Format(CurRecipeObj.TotalFair, gstrMONEY_FORMAT)
        Me.lblOutFairTotal = Format(CurRecipeObj.TotalExportFair, gstrMONEY_FORMAT)
        Me.lblOutFair = Format(CurRecipeObj.TotalExportFair, gstrMONEY_FORMAT)
        Me.lblSelfFairTotal = Format(CurRecipeObj.TotalSelfFair, gstrMONEY_FORMAT)
        Me.lblSelfFair = Format(CurRecipeObj.TotalSelfFair, gstrMONEY_FORMAT)
        Me.lblPubFairTotal = Format(CurRecipeObj.TotalPubFair, gstrMONEY_FORMAT)
        Me.lblPubFair = Format(CurRecipeObj.TotalPubFair, gstrMONEY_FORMAT)
    End If
End Sub


Private Sub spdFigure_KeyPress(KeyAscii As Integer)
    If spdFigure.ActiveRow = spdFigure.MaxRows _
        And KeyAscii = vbKeyReturn Then
        
        spdFigure.Col = spdFigure.ActiveCol
        spdFigure.Row = spdFigure.ActiveRow
        If spdFigure.Text = "" Then
            hisToActiveCtl(Me).SetFocus
        End If
        KeyAscii = 0
    End If
End Sub

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

Private Sub txtDepart_GotFocus()
    mDepart = txtDepart
End Sub

Private Sub txtDepart_LostFocus()
    If txtDepart = "" Then
        txtDepart.Tag = ""
        Exit Sub
    End If
    If txtDepart <> mDepart Then
        ComnHlp1.SQL = "SELECT m_Depart.DepCode,m_Depart.DepName FROM m_Depart" _
                & " WHERE m_Depart.Brief LIKE '##%' AND m_Depart.Flag & 3=0 AND Flag & 12 = 0"  '? 临床
        ComnHlp1.InitPut = txtDepart.Text
        ComnHlp1.FormatHead = "科  别  编  码|科    别    名    称"
        ComnHlp1.WidthRate = 1
        ComnHlp1.ParmTag = "Depart"
        ComnHlp1.ShowHelp vbModal
    End If
End Sub

Private Sub txtDoctor_GotFocus()
    mDcCode = txtDoctor
End Sub

Private Sub txtDoctor_LostFocus()
    If txtDoctor = "" Then
        txtDoctor.Tag = ""
        Exit Sub
    End If
    If mDcCode <> txtDoctor Then
        ComnHlp1.SQL = "SELECT m_Doctor.DcCode,m_Doctor.DcName,m_Doctor.DepCode,m_Depart.DepName " _
                & "FROM m_Doctor INNER JOIN m_Depart ON m_Doctor.DepCode = m_Depart.DepCode " _
                & "WHERE m_Doctor.Brief LIKE '##%'"
        ComnHlp1.InitPut = txtDoctor.Text
        ComnHlp1.FormatHead = "医 师 编 码|医 师 名 称||所  属  科  别 "
        ComnHlp1.WidthRate = 1
        ComnHlp1.ParmTag = "Doctor"
        ComnHlp1.ShowHelp vbModal
    End If
End Sub

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

Private Sub txtID_LostFocus()
    Dim mSQL As String
    Dim i As Integer
    
    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
    If SickObj.ID = "" Then
        If gtydSysConfig.NeedRegiForFigure Then
            MsgBox "病人没有登记!", vbCritical
            Init
            txtID.SetFocus
            Exit Sub
        End If
    Else
        If gtydSysConfig.NeedRegiForFigure Then
            If Not SickObj.IfRegi Then
                MsgBox "病人没有挂号", vbCritical, "提示"
                Init
                txtID.SetFocus
                Exit Sub
            End If
        End If
        FillDataForBase
    End If
End Sub
Public Sub FillDataForBase()
    If SickObj Is Nothing Then
        ClearBaseInfo
    Else
        txtID = SickObj.ID
        txtName = SickObj.Name
        Me.txtPtType = SickObj.PtDes
        txtDoctor = SickObj.DcName
        txtDoctor.Tag = SickObj.DcCode
        txtDepart = SickObj.DepName
        txtDepart.Tag = SickObj.DepCode
    End If
End Sub

Public Function ValidInput(ErrDes As String) As Object
    Dim CurRecipeObj As clsRecipe
    Dim i As Integer, j As Integer, HavingInput As Boolean
    
    If SickObj Is Nothing Then
        ErrDes = "必须输入病人信息!"
        Set ValidInput = txtID
        Exit Function
    End If
    For i = 1 To RecipesObj.Count
        For Each CurRecipeObj In RecipesObj
            If CurRecipeObj.Count <> 0 Then
                If CurRecipeObj.DepCode = "" Then
                    ErrDes = "必须输入第" & i & "号处方的就诊科别!"
                    Set ValidInput = txtDepart
                    Exit Function
                End If
                For j = 1 To CurRecipeObj.Count
                    If CurRecipeObj.Item(j).RevDepCode = "" And CurRecipeObj.Item(j).Amount <> 0 And mItemType = 1 Then
                        ErrDes = "必须输入第" & i & "号处方,第" & j & "项的收费科别!"
                        Set ValidInput = spdFigure
                        Exit Function
                    End If
                    If CurRecipeObj.Item(j).CPrice <= 0# And CurRecipeObj.Item(j).Amount <> 0 Then
                        ErrDes = "第" & i & "号处方,第" & j & "项的单价必须大于零!"
                        Set ValidInput = spdFigure
                        Exit Function
                    End If
                    If CurRecipeObj.Item(j).Amount <> 0 Then
                        HavingInput = True
                    End If
                Next j
            End If
        Next
    Next i
    If Not HavingInput Then
        ErrDes = "请输入划价项目!"
        Set ValidInput = spdFigure
    End If
    
End Function

Public Sub LoadData()
    Dim CurRecipeObj As clsRecipe
    Dim i As Integer
    
    If RecipesObj Is Nothing Then
        Set RecipesObj = New clsRecipes
    End If
    Set RecipesObj.SickObj = SickObj
    If RecipesObj.Count < Val(lblRecipeNum) Then
        Set CurRecipeObj = New clsRecipe
        LoadDataByRecipe CurRecipeObj
        RecipesObj.Add CurRecipeObj
    Else
        Set CurRecipeObj = RecipesObj.Item(Val(lblRecipeNum))
        LoadDataByRecipe CurRecipeObj
    End If
    RecipesObj.RecipeDate = gfnGetTime
    RecipesObj.HdCode = gtydSysConfig.HdCode
    RecipesObj.HdName = gtydSysConfig.HdName
    
    RecipesObj.DsCode = gtydSysConfig.DepCode
End Sub