frmhouseask.frm

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

         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   312
      Index           =   0
      Left            =   2808
      TabIndex        =   12
      Top             =   48
      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       =   &H8000000C&
      Height          =   315
      Index           =   1
      Left            =   2820
      TabIndex        =   11
      Top             =   45
      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        =   9
      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        =   8
      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        =   7
      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        =   6
      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          =   210
      Left            =   3030
      TabIndex        =   5
      Top             =   720
      Width           =   975
   End
End
Attribute VB_Name = "frmHouseAsk"
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

Private WithEvents CmnHlp As frmInputHelp
Attribute CmnHlp.VB_VarHelpID = -1
Private WithEvents QueryObj As frmHouseAskQuery
Attribute QueryObj.VB_VarHelpID = -1
Public ItemsObj As clsDrugItems
Private CurUnitObj As clsDrugUnit

Private Function checkstore() As Boolean
    Dim i As Integer
    Dim Amount As Double
    Dim itemname As String
    Dim Factor As Double
    For i = 1 To spd.MaxRows
        spd.Row = i
        spd.Col = 2
        itemname = spd.Text
        spd.Col = 11
        Factor = Val(spd.Text)
        spd.Col = 5
        Amount = Val(spd.Text) * Factor
        spd.Col = 12
        If Amount > Val(spd.Text) Then
            MsgBox itemname & " 库存不够，只有 " & spd.Text / Factor, vbCritical
            spd.Col = 5
            spd.Action = SS_ACTION_ACTIVE_CELL
            Exit Function
        End If
    Next i
    checkstore = True
End Function
Private Sub InitForm()
    Set CmnHlp = New frmInputHelp
    Set CmnHlp.CN = gDbObj.CN
    Set lct.CN = gDbObj.CN
    lct.Visible = False
    Init

    fra.Visible = False

End Sub
Private Sub Init()
    hisFormClear Me
    spd.MaxRows = 0
    spd.MaxRows = 1
    txtDepart.Tag = gtydSysConfig.VsStore
    txtDepart = gtydSysConfig.VsStoreName
    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, ByVal KCAmount)
    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).Factor = Factor 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.Col = 12
    spd.Text = KCAmount
    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(6), 1 * SelData(7), SelData(8), SelData(9), 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 frmHouseAsk = 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 " _
        & " WHERE DsCode = '" & gtydSysConfig.DepCode _
        & "' AND DtCode = '" & gTsObj.Code(tsH_ASK_IN) & "' AND " & Cdt _
        & " GROUP BY House_BusMain.BusSerial"
    lct.SQL = SQL
    lct.Refresh