frmdrugproperty.frm

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

VERSION 5.00
Object = "{AA0D501B-0C16-11D4-8531-00E098160F52}#4.0#0"; "COMNBUTTONS.OCX"
Object = "{B02F3647-766B-11CE-AF28-C3A2FBE76A13}#2.5#0"; "SS32X25.OCX"
Begin VB.Form frmDrugProperty 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "药品限制维护"
   ClientHeight    =   5685
   ClientLeft      =   1350
   ClientTop       =   330
   ClientWidth     =   7110
   Icon            =   "frmDrugProperty.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   5685
   ScaleWidth      =   7110
   Begin FPSpread.vaSpread spd 
      Height          =   5364
      Left            =   -12
      OleObjectBlob   =   "frmDrugProperty.frx":0442
      TabIndex        =   0
      Top             =   -12
      Width           =   7068
   End
   Begin ComnButtons.ButtonGroup btg 
      Height          =   375
      Left            =   3570
      TabIndex        =   1
      Top             =   5355
      Width           =   3495
      _ExtentX        =   6165
      _ExtentY        =   661
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BackColor       =   -2147483638
      ButtonCount     =   3
      ButtonCaption   =   "&Q.查询	&P.打印	&E.关闭"
      KeyEnabled      =   "1#1#1#"
   End
End
Attribute VB_Name = "frmDrugProperty"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'只按包装单位
Private WithEvents CmnHlp As frmInputHelp
Attribute CmnHlp.VB_VarHelpID = -1
Private WithEvents QueryObj As FrmInput
Attribute QueryObj.VB_VarHelpID = -1
Private Sub InitForm()
    Set CmnHlp = New frmInputHelp
    Set CmnHlp.CN = gDbObj.CN
    FillData
End Sub

Private Sub btg_Click(ByVal WhichB As Integer)
    Select Case WhichB
        Case 0
            Set QueryObj = New FrmInput
            QueryObj.MSQL = "SELECT ItemCode,ItemName,Model " _
                & " FROM m_Drug WHERE Brief Like '##%'" _
                & " UNION SELECT m_DrugAlias.ItemCode,m_DrugAlias.AliasName,Model " _
                & " FROM m_Drug INNER JOIN m_DrugAlias " _
                & " ON m_Drug.ItemCode = m_DrugAlias.ItemCode " _
                & " WHERE m_DrugAlias.Brief Like '##%'"

            QueryObj.FormatHead = "编   码         |名    称                  |规格         "
            QueryObj.WidthRate = 1.5
            QueryObj.Title = "请输入查询的药品"
            QueryObj.DisplayItemNum = 2
            QueryObj.NeedItemNum = 1
            QueryObj.Show
        Case 1
        Case 2
            Unload Me
        Case 3
    End Select
End Sub
Private Sub QueryObj_Cancel()
    Me.SetFocus
    Set QueryObj = Nothing
End Sub

Private Sub QueryObj_GetData(ByVal Data As String)
    Dim i As Long
    
    If Data <> "" Then
        For i = 1 To spd.MaxRows - 1
            spd.Row = i
            spd.Col = 3
            If Data = spd.Text Then
                hisActiveSpreadCell spd, i, 5
            End If
        Next i
    End If
    Set QueryObj = Nothing
End Sub

Private Sub CmnHlp_ResSelect(ByVal SelData As Variant, ByVal STag As String)
    Dim i As Integer, OldItemCode As String
    
    Me.SetFocus
    If TypeName(SelData) = "Nothing" Then
        If spd.ActiveRow <> spd.MaxRows Then
            spd.Row = spd.ActiveRow
            spd.Col = 1
            OldItemCode = spd.Text
            If Not Save("", OldItemCode) Then
                FillData
                QueryObj_GetData OldItemCode
            Else
                spd.Action = SS_ACTION_DELETE_ROW
                spd.MaxRows = spd.MaxRows - 1
            
            End If
            
'            LoadData spd.ActiveRow
'            PropertyObj.Delete

        End If
    Else
        spd.Row = spd.ActiveRow
        spd.Col = 3
        spd.Text = SelData(0)
        spd.Col = 4
        spd.Text = SelData(2)
        spd.Col = 5
        spd.Text = SelData(3) & " * " & SelData(6)
        spd.Col = 6
        spd.Text = SelData(5)
        spd.Col = 7
        spd.Text = 0
        spd.Col = 8
        spd.Text = SelData(6)
        If spd.ActiveRow = spd.MaxRows Then
            spd.MaxRows = spd.MaxRows + 1
        End If
    End If
End Sub

Private Sub Form_Load()
    hisFormToCenter Me, frmMain
    InitForm
End Sub
Private Sub FillData()
    Dim i As Integer, J As Integer
    
    Screen.MousePointer = 11
    spd.Redraw = False
    spd.MaxRows = 0
    If gDbObj.GetRs("SELECT m_Drug.ItemCode,House_DrugProperty.LowLimit,m_Drug.ItemCode," _
        & "m_Drug.ItemName,m_Drug.Model+' * ' + CONVERT(varchar(10),m_Drug.Factor)," _
        & "GenalUnit,LowLimit/Factor,Factor FROM House_DrugProperty " _
         & " INNER JOIN m_Drug ON House_DrugProperty.ItemCode = m_Drug.ItemCode " _
         & "WHERE DsCode = '" & gtydSysConfig.DepCode & "'") >= 1 Then
         
        spd.MaxRows = gDbObj.RecordCount + 1
        spd.BlockMode = True
        spd.Row = 1
        spd.Row2 = spd.MaxRows - 1
        spd.Col = 1
        spd.Col2 = spd.MaxCols
        spd.Clip = gDbObj.Rs.GetString
        spd.BlockMode = False
    Else
        spd.MaxRows = 1
    End If
    spd.Redraw = True
    Screen.MousePointer = 0
End Sub


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

Private Sub spd_EditMode(ByVal Col As Long, ByVal Row As Long, ByVal Mode As Integer, ByVal ChangeMade As Boolean)
   Dim ItemCode As String, OldItemCode As String, TmpStr As String
    
    If ChangeMade Then
        spd.Col = Col
        spd.Row = Row
        TmpStr = spd.Text
        Select Case Col
            Case 4 '名称
                If TmpStr <> "" Then
                    CmnHlp.Sql = "SELECT m_Drug.ItemCode,m_Drug.ItemName," _
                        & "m_Drug.ItemName,m_Drug.Model," _
                        & "M_Drug.BaseUnit,m_Drug.GenalUnit,m_Drug.factor," _
                        & "m_Drug.Gprice,m_Drug.CPrice " _
                        & "FROM m_Drug WHERE Brief Like '##%'" & gfnMakeLimit(gtydSysConfig.ItemCode, "m_Drug.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.Gprice,m_Drug.CPrice " _
                        & "FROM m_Drug " _
                        & "INNER JOIN m_DrugAlias ON m_Drug.ItemCode = m_DrugAlias.ItemCode " _
                        & "WHERE m_DrugAlias.Brief Like '##%' " & gfnMakeLimit(gtydSysConfig.ItemCode, "m_Drug.ItemCode")

                        
                    CmnHlp.FormatHead = _
                        "|名              称         ||规              格|基本单位|包装单位|| 批发价| 零售价"
                    CmnHlp.InitPut = TmpStr
                    CmnHlp.WidthRate = 2#
                    CmnHlp.ShowHelp vbModal
                Else
                    If Row <> spd.MaxRows Then
                        spd.Row = Row
                        spd.Col = 1
                        OldItemCode = spd.Text
                        If Not Save("", OldItemCode) Then
                            FillData
                            QueryObj_GetData OldItemCode
                        Else
'                        LoadData Row
'                        PropertyObj.Delete
                            spd.Action = SS_ACTION_DELETE_ROW
                            spd.MaxRows = spd.MaxRows - 1
                        End If
                    End If
                End If
        End Select
    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)
    Dim ItemCode As String, OldItemCode As String, Factor As Integer
    Dim LowLimit As Long, OldLowLimit As Long

    If Row <> NewRow And Row > 0 And NewRow > 0 And Row <> spd.MaxRows Then
        spd.Row = Row
        spd.Col = 1
        OldItemCode = spd.Text
        spd.Col = 2
        OldLowLimit = Val(spd.Text)
        spd.Col = 3
        ItemCode = spd.Text
        spd.Col = 8
        Factor = Val(spd.Text)
        spd.Col = 7
        LowLimit = Val(spd.Text) * Factor
        If Save(ItemCode, OldItemCode, LowLimit, OldLowLimit) Then
            spd.Col = 1
            spd.Text = ItemCode
            spd.Col = 2
            spd.Text = LowLimit
        Else
            FillData
            QueryObj_GetData OldItemCode
        End If
    End If
    gpdSpreadControl spd, Col, Row, NewCol, NewRow
End Sub
Private Function Save(ByVal ItemCode As String, _
        Optional OldItemCode As String = "", _
        Optional LowLimit As Long = 0, _
        Optional OldLowLimit As Long = 0) As Boolean
    
On Error GoTo errlbl
    If ItemCode = "" Then
        If Not Update_House_DrugProperty(HISDBdelete, _
            UpdateCondition:=" DsCode = '" & gtydSysConfig.DepCode _
            & "' AND ItemCode = '" & OldItemCode & "'") Then
            
            GoTo errlbl
        End If
    Else
        If OldItemCode = "" Then
            If Not Update_House_DrugProperty(HISDbInsert, gtydSysConfig.DepCode, _
                ItemCode, LowLimit) Then
                
                GoTo errlbl
            End If
        Else
            If ItemCode <> OldItemCode Or LowLimit <> OldLowLimit Then
                If Not Update_House_DrugProperty(HISDBUpdate, _
                    DsCode:=gtydSysConfig.DepCode, _
                    ItemCode:=ItemCode, _
                    LowLimit:=LowLimit, _
                    UpdateCondition:=" DsCode = '" & gtydSysConfig.DepCode _
                    & "' AND ItemCode = '" & OldItemCode & "'") Then
                    
                    GoTo errlbl
                End If
            End If
        End If
    End If
    Save = True
    
errlbl:
    
End Function