frmfigurebus.frm

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

    Select Case mintCurType
        Case 0
            lblType = "西药"
            usp.Id = "A_DrugFigure"
            fraPkCount.Visible = False
        Case 1
            lblType = "中成药"
            usp.Id = "A_DrugFigure"
            fraPkCount.Visible = False
        Case 2
            lblType = "中草药"
            usp.Id = "A_DrugFigure"
            fraPkCount.Visible = True
        Case 3
            lblType = "检查、治疗"
            usp.Id = "A_ItemFigure"
            fraPkCount.Visible = False
    End Select
    usp.Load
    spd.MaxRows = 0
    spd.MaxRows = 1
End Property
Private Property Get CurType() As Integer
    CurType = mintCurType
End Property

Private Sub init()
    Dim tmprs As Recordset
    CboPtType.Visible = False
    CboPtType.TabStop = False
    Dim TmpStr As String
    If Not gtydSysConfig.NeedRegiForFigure And gstrMODULEID = "C" Then
        CboPtType.Visible = True
        CboPtType.TabStop = True
        If CboPtType.ListCount > 0 Then CboPtType.ListIndex = 0
    End If
    mskPkCount = "1  "
    hisFormClear Me
    txtDoctor.Tag = ""
    txtDepart.Tag = ""
    txtName.Enabled = False
    Me.spd.MaxRows = 0
    Me.spd.MaxRows = 1
    Me.lblRecipeTotal = "1"
    Me.lblRecipeNum = "1"
    Me.lblFair = "0.00"
    Me.lblFairTotal = "0.00"
    Me.lblPubFair = "0.00"
    Me.lblSelfFair = "0.00"
    Me.lblOutFair = "0.00"
    Me.lblPubFairTotal = "0.00"
    Me.lblSelfFairTotal = "0.00"
    Me.lblOutFairTotal = "0.00"
    Me.lblDate.Visible = False
    Me.lblHander.Visible = False
    Me.lblCancel.Visible = False
    Me.lblFetch.Visible = False
    Me.lblRev.Visible = False
    Me.cmdPrevRecipeNum.Enabled = False
    If Not (RecipesObj Is Nothing) Then
        Set RecipesObj = Nothing
    End If
    If Not (Sickobj Is Nothing) And gstrMODULEID = "C" Then
        Set Sickobj = Nothing
    Else
        If gstrMODULEID <> "C" Then
            txtID = Sickobj.PatientID
            txtName = Sickobj.Name
            Me.txtPtType = Sickobj.PtDes
            Exit Sub
        End If
    End If
    If gtydSysConfig.IFAutoID And gtydSysConfig.WorkStationNum <> "" Then
        
        TmpStr = gfnGetTime("yymmdd") & gtydSysConfig.WorkStationNum
        Set tmprs = gdbobj.GetNewRs("SELECT MAX(PatientID) FROM Open_m_PatientBaseInfo " _
            & " WHERE PatientID Like '" & TmpStr & "%'")
        If Not IsNull(tmprs(0)) Then
            txtID = TmpStr & Format(Right(tmprs(0), Len(tmprs(0)) - Len(TmpStr)) + 1, _
                    hisStrRepeat("0", 3))
        Else
            txtID = TmpStr & Format(1, hisStrRepeat("0", 3))
        End If
    Else
        If gtydSysConfig.DeFaultPatientID Then
            txtID = gfnGetTime("yymmdd")
        Else
            txtID = ""
        End If
    End If
End Sub

Private Sub ClearBaseInfo()
    hisFormClear Me
    txtDoctor.Tag = ""
    txtDepart.Tag = ""

End Sub
Private Sub PutSpread(ByVal Row As Integer, ByVal ItemCode, ByVal ItemName, ByVal model, _
        ByVal unit, ByVal Amount, ByVal Cprice, ByVal Factor, ByVal Flag As Long, _
        ByVal RevDepCode, ByVal RevDepName, ByVal gprice, batchid)
    Dim i As Integer
    Dim tmprs As Recordset
    If IsNull(RevDepCode) Then
        RevDepCode = ""
    End If
    If IsNull(RevDepName) Then
        RevDepName = ""
    End If
    gUnitobj.Add ItemCode
    cmdNextRecipeNum.Enabled = True
    spd.Redraw = False
    spd.Row = Row
    If ItemCode < "D" And gtydSysConfig.IfDecStore Then
        If batchid = "" Then
            Set tmprs = gdbobj.GetNewRs("select BatchID,amount from House_Drugbus " _
                & "where (dscode='" & gtydSysConfig.VsADepCode & "' or dscode='" & gtydSysConfig.VsBDepCode & "' " _
                & " or dscode='" & gtydSysConfig.VsCDepCode & "') and " _
                & "itemcode='" & ItemCode & "' and amount>=" & Amount * Factor)
        Else
            Set tmprs = gdbobj.GetNewRs("select BatchID,amount from House_Drugbus " _
                & "where (dscode='" & gtydSysConfig.VsADepCode & "' or dscode='" & gtydSysConfig.VsBDepCode & "' " _
                & " or dscode='" & gtydSysConfig.VsCDepCode & "') and " _
                & "itemcode='" & ItemCode & "' and batchid='" & batchid & "' and amount>=" & Amount * Factor)
        End If
        If tmprs.RecordCount > 0 Then
            batchid = tmprs(0)
            spd.Col = -1
            spd.Row = Row
            spd.ForeColor = RGB(0, 0, 0)
        Else
            spd.Col = -1
            spd.Row = Row
            spd.ForeColor = RGB(255, 0, 0)
        End If
    End If
    spd.Col = 1
    spd.Text = ItemName
    spd.Col = 2
    If model <> "" Then model = model & " * " & Int(Factor)
    spd.Text = batchid & "\" & model
    spd.Col = 3
    If left(ItemCode, 1) < "D" Then
        If gUnitobj(ItemCode).Count = 1 Or CurType = 3 Then
            spd.CellType = SS_CELL_TYPE_EDIT
            spd.Text = unit
            spd.Lock = True
        Else
            spd.CellType = SS_CELL_TYPE_COMBOBOX
            spd.Lock = False
            For i = 1 To gUnitobj(ItemCode).Count
                spd.TypeComboBoxIndex = -1
                spd.TypeComboBoxString = gUnitobj(ItemCode).Item(i).unit
                If gUnitobj(ItemCode).Item(i).unit = unit Then
                    spd.TypeComboBoxCurSel = i - 1
                End If
            Next i
        End If
    Else
        spd.CellType = SS_CELL_TYPE_EDIT
        spd.Text = unit
        spd.Lock = True
    End If
    spd.Col = 4
    spd.Text = Amount / Factor
    spd.Col = 5
    If Cprice = 0 Then
        spd.Lock = False
    Else
        spd.Lock = True
    End If
    
    spd.Text = Cprice * Factor
    spd.Col = 6
    spd.Text = Cprice * Amount
    spd.Col = 7
    spd.Lock = True
    spd.Text = IIf(RevDepName = "" And gtydSysConfig.AutoRevDepart, txtDepart, RevDepName)
    spd.Col = 8
    spd.value = IIf(((Flag And 8) = 8) And (mItemType = 0), 1, 0) '?
    spd.Col = 9
    spd.Text = ItemCode
    spd.Col = 10
    spd.value = IIf(((Flag And 2) <> 0) And (mItemType = 0), 1, 0)
    spd.Col = 11
    
    spd.Text = IIf(RevDepCode = "" And gtydSysConfig.AutoRevDepart, txtDepart.Tag, RevDepCode)
    spd.Col = 8
    spd.Col = 12
    spd.Text = Factor
    spd.Col = 13
    spd.Text = gprice
    spd.Redraw = True
End Sub


Private Sub cmdNextRecipeNum_Click()
    Dim CurRecipeObj As clsRecipe
    If spd.MaxRows = 1 Then Exit Sub
    
    If RecipesObj Is Nothing Then
        Set RecipesObj = New clsRecipes
    End If
    If RecipesObj.Count < Val(lblRecipeNum) Then
        Set CurRecipeObj = New clsRecipe
        LoadDataByRecipe CurRecipeObj
        RecipesObj.Add CurRecipeObj
    Else
        LoadDataByRecipe RecipesObj.Item(Val(lblRecipeNum))
    End If
    lblRecipeNum = lblRecipeNum + 1
    If lblRecipeTotal < Val(lblRecipeNum) Then
        lblRecipeTotal = lblRecipeNum
    End If
    cmdPrevRecipeNum.Enabled = True
    If RecipesObj.Count < Val(lblRecipeNum) Then
        Me.mskPkCount = "001"
        spd.MaxRows = 0
        spd.MaxRows = 1
    Else
        FillDataByRecipe RecipesObj.Item(Val(lblRecipeNum))
    End If
'    If spd.MaxRows = 1 Then
'        spd.Row = 1
'        spd.Col = 1
'        If spd.Text = "" Then
'            cmdNextRecipeNum.Enabled = False
'        End If
'    End If
'    Sum
    hisActiveSpreadCell Me.spd, 1, 1
End Sub

Private Sub cmdPrevRecipeNum_Click()
    Dim CurRecipeObj As clsRecipe

    If RecipesObj.Count < Val(lblRecipeNum) Then
        
        Set CurRecipeObj = New clsRecipe
        LoadDataByRecipe CurRecipeObj
        RecipesObj.Add CurRecipeObj
    Else
        LoadDataByRecipe RecipesObj.Item(Val(lblRecipeNum))
    End If
    If Val(lblRecipeNum) > 1 Then
        lblRecipeNum = lblRecipeNum - 1
        If lblRecipeNum = "1" Then
            cmdPrevRecipeNum.Enabled = False
        End If
    End If
    FillDataByRecipe RecipesObj.Item(Val(lblRecipeNum))
    cmdNextRecipeNum.Enabled = True
'    Sum
    hisActiveSpreadCell Me.spd, 1, 1
End Sub

Private Sub CmnHlp_Escape(ByVal STag As String)
    Me.SetFocus
'    spd.Text = mStr
End Sub

Private Sub CmnHlp_ResSelect(ByVal SelData As Variant, ByVal STag As String)
    'Drug: 0名称-1别名-2正式名-3规格-4基本单位-5当前单位-6换算关系-7单价-8Flag
    'item: 0名称-1别名-2正式名-3单位-4单价-5收费科别编码-6收费科别名称-7Flag
    Dim i As Integer

    Me.SetFocus
    Select Case STag
        Case "Item"
            If TypeName(SelData) <> "Nothing" Then
                If UCase(SelData(0)) = "ZZZZ" Then Exit Sub
                If spd.MaxRows = spd.ActiveRow Then
                    spd.MaxRows = spd.MaxRows + 1
                End If
                
                If CurType <> 3 Then
                    If SelData(7) <> "" Then
                        PutSpread spd.ActiveRow, SelData(0), SelData(2), SelData(3), _
                            SelData(5), 1 * SelData(6), SelData(7), SelData(6), SelData(8), _
                            gtydSysConfig.DepCode, gtydSysConfig.DepName, SelData(9), SelData(12)
                    Else
                        If gdbobj.GetRs("SELECT open_m_GroupItem.ItemCode,m_Drug.ItemName," _
                                & "m_Drug.Model,m_Drug.Cprice,open_m_GroupItem.Amount," _
                                & "open_m_GroupItem.Unit,m_Drug.Gprice,m_drug.flag,open_m_GroupItem.factor  " _
                                & " FROM open_m_GroupItem INNER JOIN m_Drug " _
                                & " ON open_m_GroupItem.ItemCode = m_Drug.ItemCode " _
                                & " WHERE GroupID = '" & SelData(0) & "'") >= 0 Then
                            i = 0
                            Do Until gdbobj.Rs.EOF
                                If i > 0 Then
                                    spd.Row = spd.ActiveRow + i
                                    spd.MaxRows = spd.MaxRows + 1
                                    spd.Action = SS_ACTION_INSERT_ROW
                                End If
                                PutSpread spd.ActiveRow + i, gdbobj.Rs!ItemCode, _
                                     gdbobj.Rs!ItemName, gdbobj.Rs!model, gdbobj.Rs!unit, _
                                     gdbobj.Rs!Amount * gdbobj.Rs!Factor, gdbobj.Rs!Cprice, _
                                     gdbobj.Rs!Factor, gdbobj.Rs!Flag, gtydSysConfig.DepCode, _
                                     gtydSysConfig.DepName, gdbobj.Rs!gprice, ""
                                gdbobj.Rs.MoveNext
                                i = i + 1
                            Loop
                        End If

                    End If
                Else
                    If SelData(4) <> "" Then
                        PutSpread spd.ActiveRow, SelData(0), SelData(2), "", _
                            SelData(3), 1, IIf(SelData(4) = "", 0, SelData(4)), 1, 0, SelData(5), SelData(6), -0.001, ""
                    Else
                        If gdbobj.GetRs("SELECT open_m_GroupItem.ItemCode,m_Item.itemName," _
                                & "m_Item.Cprice,open_m_GroupItem.Amount," _
                                & "open_m_GroupItem.Unit,open_m_GroupItem.DepCode,m_depart.depName" _
                                & " FROM (open_m_GroupItem INNER JOIN m_Item " _
                                & "ON open_m_GroupItem.ItemCode = m_Item.ItemCode) " _
                                & " LEFT JOIN m_Depart " _
                                & "ON open_m_GroupItem.depcode = m_Depart.DepCode " _
                                & " WHERE GroupID = '" & SelData(0) & "'") >= 0 Then
                            i = 0
                            Do Until gdbobj.Rs.EOF
                                If i > 0 Then
                                    spd.Row = spd.ActiveRow + i
                                    spd.MaxRows = spd.MaxRows + 1
                                    spd.Action = SS_ACTION_INSERT_ROW
                                End If
                                PutSpread spd.ActiveRow + i, gdbobj.Rs!ItemCode, _
                                    gdbobj.Rs!ItemName, "", gdbobj.Rs!unit, _
                                    gdbobj.Rs!Amount, gdbobj.Rs!Cprice, 1, 0, gdbobj.Rs!DepCode, _
                                    gdbobj.Rs!DepName, 0, ""
                                gdbobj.Rs.MoveNext
                                i = i + 1
                            Loop
                        End If

                    End If
                End If
            Else
                If spd.MaxRows <> spd.ActiveRow Then  '删除旧的一行
                    spd.Row = spd.ActiveRow
                    spd.Action = SS_ACTION_DELETE_ROW
                    spd.MaxRows = spd.MaxRows - 1
                End If
            End If
            Sum
            If gtydSysConfig.Jmp2Amount Then
                spd.Col = 3
            Else
                spd.Col = 2
            End If
            spd.Action = 0
        Case "RevDepart"
            spd.Row = spd.ActiveRow
            If TypeName(SelData) <> "Nothing" Then
                spd.Col = 7
                spd.Text = SelData(1)
                spd.Col = 11
                spd.Text = SelData(0)
                spd.Redraw = True
            Else
                spd.SetFocus
                spd.Redraw = False
                spd.Col = 7
                spd.Text = ""
                spd.Col = 11
                spd.Text = ""
                spd.Redraw = True
            End If
        Case "Depart"
            If TypeName(SelData) <> "Nothing" Then
                txtDepart.Tag = SelData(0)
                txtDepart = SelData(1)
            Else
                txtDepart.Tag = ""
                txtDepart = ""
            End If
'            Call RecipesObj.UpDateRecipeInfo(Val(lblDepartNum), txtDepart.Tag, txtDepart, txtDoctor.Tag, txtDoctor)
        Case "Doctor"
            If TypeName(SelData) <> "Nothing" Then
                txtDoctor.Tag = SelData(0)
                txtDoctor = SelData(1)
                txtDepart.Tag = SelData(2)