frmfigurebus_bak.frm

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

    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 gtydSysConfig.DeFaultPatientID Then
        txtID = gfnGetTime("yymmdd")
    End If
    Set usp.DBInter = gDbObj
    Set usp.CurSpread = spdFigure
    If mItemType = 0 Then
        usp.ID = "A_DrugFigure"
    Else
        usp.ID = "A_ItemFigure"
    End If
    usp.Load
    Me.spdFigure.MaxRows = 0
    Me.spdFigure.MaxRows = 1
    If Not (SickObj Is Nothing) Then
        txtID.Enabled = False
        Me.txtID.TabStop = False
        txtID = SickObj.PatientID
        txtName = SickObj.Name
        txtPtType = SickObj.PtDes
        If Not (RecipesObj Is Nothing) Then
            FillDataByRecipe RecipesObj.Item(1)
            Me.lblRecipeTotal = RecipesObj.Count
        End If
    End If
End Sub
Private Sub Init()
    hisFormClear Me
    txtDoctor.Tag = ""
    txtDepart.Tag = ""
    Me.spdFigure.MaxRows = 0
    Me.spdFigure.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) Then
        Set SickObj = Nothing
    End If
    If gtydSysConfig.DeFaultPatientID Then
        txtID = gfnGetTime("yymmdd")
    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)
    Dim i As Integer
    
    gUnitobj.Add ItemCode

    spdFigure.Redraw = False
    spdFigure.Row = Row
    spdFigure.Col = 1
    spdFigure.Text = ItemName
    spdFigure.Col = 2
    spdFigure.Text = Model & " * " & Int(Factor)
    spdFigure.Col = 3
    If gUnitobj(ItemCode).Count = 1 Then
        spdFigure.CellType = SS_CELL_TYPE_EDIT
        spdFigure.Text = Unit
        spdFigure.Lock = True
    Else
        spdFigure.CellType = SS_CELL_TYPE_COMBOBOX
        spdFigure.Lock = False
        For i = 1 To gUnitobj(ItemCode).Count
            spdFigure.TypeComboBoxIndex = -1
            spdFigure.TypeComboBoxString = gUnitobj(ItemCode).Item(i).Unit
            If gUnitobj(ItemCode).Item(i).Unit = Unit Then
                spdFigure.TypeComboBoxCurSel = i - 1
            End If
        Next i
    End If
    spdFigure.Col = 4
    spdFigure.Text = Amount / Factor
    spdFigure.Col = 5
    If CPrice = 0 Then
        spdFigure.Lock = False
    Else
        spdFigure.Lock = True
    End If
    
    spdFigure.Text = CPrice * Factor
    spdFigure.Col = 6
    spdFigure.Text = CPrice * Amount
    spdFigure.Col = 7
    spdFigure.Text = IIf(RevDepName = "" And gtydSysConfig.AutoRevDepart, txtDepart, RevDepName)
    spdFigure.Col = 8
    spdFigure.Value = IIf(((Flag And 64) = 0) And (mItemType = 0), 1, 0) '?
    spdFigure.Col = 9
    spdFigure.Text = ItemCode
    spdFigure.Col = 10
    spdFigure.Value = IIf(((Flag And 2) <> 0) And (mItemType = 0), 1, 0)
    spdFigure.Col = 11
    
    spdFigure.Text = IIf(RevDepCode = "" And gtydSysConfig.AutoRevDepart, txtDepart.Tag, RevDepCode)
    spdFigure.Col = 8
    spdFigure.Col = 12
    spdFigure.Text = Factor
    spdFigure.Col = 13
    spdFigure.Text = GPrice
    spdFigure.Redraw = True
End Sub


Private Sub cmdNextRecipeNum_Click()
    Dim CurRecipeObj As clsRecipe
    
    
    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
        spdFigure.MaxRows = 0
        spdFigure.MaxRows = 1
    Else
        FillDataByRecipe RecipesObj.Item(Val(lblRecipeNum))
    End If
'    Sum
    hisActiveSpreadCell Me.spdFigure, 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
    lblRecipeNum = lblRecipeNum - 1
    If lblRecipeNum = "1" Then
        cmdPrevRecipeNum.Enabled = False
    End If
    FillDataByRecipe RecipesObj.Item(Val(lblRecipeNum))
'    Sum
    hisActiveSpreadCell Me.spdFigure, 1, 1
End Sub

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

Private Sub ComnHlp1_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

    Me.SetFocus
    Select Case STag
        Case "Item"
            If TypeName(SelData) <> "Nothing" Then
                If spdFigure.MaxRows = spdFigure.ActiveRow Then
                    spdFigure.MaxRows = spdFigure.MaxRows + 1
                End If
                If mItemType = 0 Then
                    PutSpread spdFigure.ActiveRow, SelData(0), SelData(2), SelData(3), _
                        SelData(5), 1, SelData(7), SelData(6), SelData(8), _
                        gtydSysConfig.DepCode, gtydSysConfig.DepName, SelData(9)
                Else
                    PutSpread spdFigure.ActiveRow, SelData(0), SelData(2), "", _
                        SelData(3), 1, IIf(SelData(4) = "", 0, SelData(4)), 1, 0, SelData(5), SelData(6), -0.001
                End If
            Else
                If spdFigure.MaxRows <> spdFigure.ActiveRow Then  '删除旧的一行
                    spdFigure.Row = spdFigure.ActiveRow
                    spdFigure.Action = SS_ACTION_DELETE_ROW
                    spdFigure.MaxRows = spdFigure.MaxRows - 1
                End If
            End If
            Sum
        Case "RevDepart"
            spdFigure.Row = spdFigure.ActiveRow
            If TypeName(SelData) <> "Nothing" Then
                spdFigure.Col = 7
                spdFigure.Text = SelData(1)
                spdFigure.Col = 11
                spdFigure.Text = SelData(0)
                spdFigure.Redraw = True
            Else
                spdFigure.SetFocus
                spdFigure.Redraw = False
                spdFigure.Col = 7
                spdFigure.Text = ""
                spdFigure.Col = 11
                spdFigure.Text = ""
                spdFigure.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)
                txtDepart = SelData(3)
            Else
                txtDoctor.Tag = ""
                txtDoctor = ""
                txtDepart.Tag = ""
                txtDepart = ""
            End If
'            Call RecipesObj.UpDateRecipeInfo(Val(lblDepartNum), txtDepart.Tag, txtDepart, txtDoctor.Tag, txtDoctor)
    End Select
End Sub
Private Sub LoadDataByRecipe(RecipeObj As clsRecipe)  '装入 单张处方
    Dim i As Integer
    Dim RecipeItemObj As clsRecipeItem
    
    RecipeObj.Clear
    RecipeObj.DcCode = txtDoctor.Tag
    RecipeObj.DcName = txtDoctor
    RecipeObj.DepCode = txtDepart.Tag
    RecipeObj.DepName = txtDepart
    For i = 1 To spdFigure.MaxRows - 1
        Set RecipeItemObj = New clsRecipeItem
        spdFigure.Row = i
        spdFigure.Col = 12
        RecipeItemObj.Factor = spdFigure.Text
        spdFigure.Col = 1
        RecipeItemObj.ItemName = spdFigure.Text
        spdFigure.Col = 2
        RecipeItemObj.Model = Left(spdFigure.Text, InStr(spdFigure.Text, " * ") - 1)
        spdFigure.Col = 3
        RecipeItemObj.Unit = spdFigure.Text
        spdFigure.Col = 4
        RecipeItemObj.Amount = spdFigure.Text * RecipeItemObj.Factor
        spdFigure.Col = 5
        RecipeItemObj.CPrice = spdFigure.Text / RecipeItemObj.Factor
        spdFigure.Col = 6
        RecipeItemObj.Fair = spdFigure.Text '这样可以舌入处理
        spdFigure.Col = 7
        RecipeItemObj.RevDepName = spdFigure.Text
        spdFigure.Col = 8
        RecipeItemObj.Pub = IIf(spdFigure.Value = 1, True, False)
        spdFigure.Col = 9
        RecipeItemObj.ItemCode = spdFigure.Text
        spdFigure.Col = 10
        RecipeItemObj.Export = IIf(spdFigure.Value = 1, True, False)
        spdFigure.Col = 11
        RecipeItemObj.RevDepCode = spdFigure.Text
        spdFigure.Col = 13
        RecipeItemObj.GPrice = spdFigure.Text
        RecipeObj.AddObj RecipeItemObj
        Set RecipeItemObj = Nothing
    Next i
End Sub
Private Sub FillDataByRecipe(RecipeObj As clsRecipe)  '装入 单张处方
    Dim i As Integer
    Dim RecipeItemObj As clsRecipeItem
    
    txtDoctor.Tag = RecipeObj.DcCode
    txtDoctor = RecipeObj.DcName
    txtDepart.Tag = RecipeObj.DepCode
    txtDepart = RecipeObj.DepName
    spdFigure.MaxRows = 0
    spdFigure.MaxRows = RecipeObj.Count + 1
    For i = 1 To spdFigure.MaxRows - 1
        Set RecipeItemObj = RecipeObj.Item(i)
        spdFigure.Row = i
        spdFigure.Col = 1
        spdFigure.Text = RecipeItemObj.ItemName
        spdFigure.Col = 2
        spdFigure.Text = RecipeItemObj.Model & " * " & RecipeItemObj.Factor
        spdFigure.Col = 3
        spdFigure.Text = RecipeItemObj.Unit
        spdFigure.Col = 4
        spdFigure.Text = RecipeItemObj.Amount / RecipeItemObj.Factor
        spdFigure.Col = 5
        spdFigure.Text = RecipeItemObj.CPrice * RecipeItemObj.Factor
        spdFigure.Col = 6
        spdFigure.Text = RecipeItemObj.Fair
        spdFigure.Col = 7
        spdFigure.Text = RecipeItemObj.RevDepName
        spdFigure.Col = 8
        spdFigure.Value = IIf(RecipeItemObj.Pub, 1, 0)
        spdFigure.Col = 9
        spdFigure.Text = RecipeItemObj.ItemCode
        spdFigure.Col = 10
        spdFigure.Value = IIf(RecipeItemObj.Export, 1, 0)
        spdFigure.Col = 11
        spdFigure.Text = RecipeItemObj.RevDepCode
        spdFigure.Col = 12
        spdFigure.Text = RecipeItemObj.Factor
        spdFigure.Col = 13
        spdFigure.Text = RecipeItemObj.GPrice
    Next i
End Sub
Private Sub FillData()
    Set SickObj = New clsSickOP
    
    SickObj.SkIDByBaseQuery = QueryRecipeObj.PatientID
    txtID = SickObj.ID
    txtName = SickObj.Name
    txtPtType = SickObj.PtDes
    lblDate = QueryRecipeObj.RecipeDate
    Me.lblHander = QueryRecipeObj.HdName
    lblCancel.Visible = QueryRecipeObj.IsCancel
    If QueryRecipeObj.FetchDate <> "" Then
        lblFetch.Visible = True
    Else
        lblFetch.Visible = False
    End If
    If QueryRecipeObj.ActRevSerial <> "" Then
        lblRev.Visible = True
    Else
        lblRev.Visible = False
    End If
    If Not QueryRecipeObj.IsCancel And QueryRecipeObj.FetchDate = "" And QueryRecipeObj.ActRevSerial = "" Then
        mcr.KeyEnabled(BK_DEL) = True
    Else
        mcr.KeyEnabled(BK_DEL) = False
    End If
    FillDataByRecipe QueryRecipeObj
    Sum
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn And Me.ActiveControl.Name <> "spdFigure" Then
        hisToActiveCtl(Me, True).SetFocus
        KeyAscii = 0
    End If
End Sub

Private Sub Form_Load()
'    Dim CurRecipeObj  As clsRecipe
    
    Call hisFormToCenter(Me, frmMain)
    InitForm
    
    Set ComnHlp1 = New frmInputHelp
    Set ComnHlp1.CN = gDbObj.CN
    Set Me.ListCtl1.CN = gDbObj.CN
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set frmFigureBus = Nothing
'    frmMain.Label1.Visible = False
'    frmMain.LblNote.Visible = False
End Sub



Private Sub ListCtl1_PosChanged(ByVal Pos As Long, ByVal OldPos As Long)
    If Not (QueryRecipeObj Is Nothing) Then
        
        Set QueryRecipeObj = Nothing
    End If
    Set QueryRecipeObj = New clsRecipe
    QueryRecipeObj.RecipeSerialByQuery = ListCtl1.CurColumns(0)
    FillData
End Sub

Private Sub mcr_Click(ByVal WhichB As UseMaintainCtl.BUTTONKEY)
    Dim SheetID As String
    Dim i As Integer
    Dim TmpObj As Object, ErrDes As String
    
    Select Case WhichB
        Case BK_ADD
            LoadData
            Set TmpObj = ValidInput(ErrDes)
            If Not (TmpObj Is Nothing) Then
                MsgBox ErrDes, vbCritical
                TmpObj.SetFocus
                Exit Sub
            End If
            If mItemType = 0 Then
                If Not RecipesObj.Save Then
                    MsgBox gDbObj.ErrDes, vbCritical
                    Exit Sub