frmhousebus.frm

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

      Width           =   570
   End
   Begin VB.Label lblTitle 
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "药房业务"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Index           =   0
      Left            =   3690
      TabIndex        =   13
      Top             =   60
      Width           =   1320
   End
   Begin VB.Label lblTitle 
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      Caption         =   "药房业务"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000005&
      Height          =   315
      Index           =   1
      Left            =   3660
      TabIndex        =   12
      Top             =   60
      Width           =   1320
   End
   Begin VB.Line Line2 
      BorderColor     =   &H80000003&
      X1              =   48
      X2              =   9468
      Y1              =   588
      Y2              =   588
   End
   Begin VB.Line Line1 
      BorderColor     =   &H80000005&
      X1              =   48
      X2              =   9468
      Y1              =   576
      Y2              =   576
   End
   Begin VB.Label lblCMoney 
      AutoSize        =   -1  'True
      Caption         =   "lblCMoney"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H8000000D&
      Height          =   210
      Left            =   3600
      TabIndex        =   10
      Tag             =   "Dyn"
      Top             =   3975
      Width           =   945
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "零售金额:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   2535
      TabIndex        =   9
      Top             =   3975
      Width           =   945
   End
   Begin VB.Label lblGMoney 
      AutoSize        =   -1  'True
      Caption         =   "lblGMoney"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H8000000D&
      Height          =   210
      Left            =   1200
      TabIndex        =   8
      Tag             =   "Dyn"
      Top             =   3975
      Width           =   945
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "批发金额:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   120
      TabIndex        =   7
      Top             =   3975
      Width           =   945
   End
   Begin VB.Label lblDepart 
      AutoSize        =   -1  'True
      Caption         =   "对    方:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   192
      Left            =   3036
      TabIndex        =   6
      Top             =   696
      Width           =   948
   End
End
Attribute VB_Name = "frmHouseBus"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'spd  Col 1 ---> Hide  - 药品编码
'                2 --->         药品名称
'                3 --->         规格      - Lock
'                4 --->         单位（基本）- Lock
'                5 --->         数量
'                6 --->         批发价    - - Float.4
'                7 --->         批发金额    - - Float.2
'                8 --->        零售价    - - Float.4
'                9 --->        零售金额    - - Float.2
'                10 --->        批零差价   - - Float.4
Private mDepart As String

Public MDtType As TSDtType

Private WithEvents CmnHlp As frmInputHelp
Attribute CmnHlp.VB_VarHelpID = -1
Private WithEvents QueryObj As frmHouseBusQuery
Attribute QueryObj.VB_VarHelpID = -1
Public ItemsObj As clsDrugItems
Private CurUnitObj As clsDrugUnit
Private FormatStr As String
Private Sub InitForm()
    FormatStr = Text1
    Set CmnHlp = New frmInputHelp
    Set CmnHlp.CN = gDbObj.CN
    Set lct.CN = gDbObj.CN
    lct.Visible = False
    lblTitle(0) = gTsObj.Name(MDtType)
    lblTitle(1) = gTsObj.Name(MDtType)
    Init

    Select Case MDtType
        Case tsH_DEPART_IN
            lblDepart = "退药科室"
        Case tsH_DEPART_OUT
            lblDepart = "领药科室"
        Case tsH_TRAN_OUT
            lblDepart = "拨出药房"
        Case tsA_DRUMP_OUT
            lblDepart.Visible = False
            txtDepart.Visible = False
    End Select
    fra.Visible = False

End Sub
Private Sub Init()
    hisFormClear Me
    spd.MaxRows = 0
    spd.MaxRows = 1
    txtDepart.Tag = ""
    If gtydSysConfig.AutoSheetID Then
        txtSheetID = gFnGetSerial(stHouseBusSerial)
        txtSheetID.Locked = True
    End If

End Sub
Private Sub PutSpread(ByVal Row As Integer, ByVal ItemCode, ByVal itemname, ByVal Model, _
        ByVal Unit, ByVal Amount, ByVal Gprice, ByVal CPrice, ByVal Factor)
    Dim i As Integer
    
    If CurUnitObj Is Nothing Then
        Set CurUnitObj = New clsDrugUnit
    End If
    CurUnitObj.Add ItemCode

    spd.Redraw = False
    spd.Row = Row
    spd.Col = 1
    spd.Text = ItemCode
    spd.Col = 2
    spd.Text = itemname
    spd.Col = 3
    spd.Text = Model & " * " & Int(Factor)
    spd.Col = 4
    If CurUnitObj(ItemCode).Count = 1 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 CurUnitObj(ItemCode).Count
            spd.TypeComboBoxIndex = -1
            spd.TypeComboBoxString = CurUnitObj(ItemCode).Item(i).Unit
            If CurUnitObj(ItemCode).Item(i).Unit = Unit Then
                spd.TypeComboBoxCurSel = i - 1
            End If
        Next i
    End If
    spd.Col = 5
    spd.Text = Amount / Factor
    spd.Col = 6
    spd.Text = Gprice * Factor
    spd.Col = 7
    spd.Text = Gprice * Amount
    spd.Col = 8
    spd.Text = CPrice * Factor
    spd.Col = 9
    spd.Text = CPrice * Amount
    spd.Col = 10
    spd.Text = CPrice * Amount - Gprice * Amount
    spd.Col = 11
    spd.Text = Factor
    spd.Redraw = True
End Sub

Private Sub CmnHlp_ResSelect(ByVal SelData As Variant, ByVal STag As String)
    Me.SetFocus
    Select Case STag
        Case "Item"
            If TypeName(SelData) = "Nothing" Then
                If spd.ActiveRow <> spd.MaxRows Then
                    spd.Row = spd.ActiveRow
                    spd.Action = SS_ACTION_DELETE_ROW
                    spd.MaxRows = spd.MaxRows - 1
                End If
            Else
                PutSpread spd.ActiveRow, SelData(0), SelData(2), SelData(3), _
                    SelData(4), 1 * SelData(5), SelData(6), SelData(7), SelData(5)
                If spd.ActiveRow = spd.MaxRows Then
                    spd.MaxRows = spd.MaxRows + 1
                End If
            End If
            Sum
        Case "Depart"
            If TypeName(SelData) = "Nothing" Then
                txtDepart = ""
                txtDepart.Tag = ""
            Else
                txtDepart = SelData(1)
                txtDepart.Tag = SelData(0)
            End If
            mDepart = txtDepart
    End Select
End Sub



Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        If Me.ActiveControl.Name = "spd" Then Exit Sub
        hisToActiveCtl(Me).SetFocus
        KeyAscii = 0
    End If
End Sub

Private Sub Form_Load()
    hisFormToCenter Me, frmMain
    InitForm
End Sub

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

Private Sub Lct_PosChanged(ByVal Pos As Long, ByVal OldPos As Long)
  
    FillData
End Sub
Private Sub mcr_StatusChanged()
    If mcr.Status = CL_ADD Then
        hisLockInput Me, False
        lct.Visible = False
        fra.Visible = False
        
    Else
        hisLockInput Me, True
        lct.Visible = True
        fra.Visible = True
    End If
End Sub

Private Sub QueryObj_Ack(ByVal Cdt As String)
    Dim SQL As String
    
    SQL = "SELECT House_BusMain.BusSerial FROM House_BusMain" _
        & " INNER JOIN House_BusSub ON House_BusMain.BusSerial = House_BusSub.BusSerial " _