frmhousecheckbus.frm

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

         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H8000000D&
      Height          =   210
      Left            =   3600
      TabIndex        =   7
      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        =   6
      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        =   5
      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        =   4
      Top             =   3975
      Width           =   945
   End
End
Attribute VB_Name = "frmHouseCheckBus"
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

Public MDtType As TSDtType
Public Event Ack(TDrugsObj As clsDrugItems)
Public Event Cancel()
Public ItemsObj As clsDrugItems

Private Sub InitForm()
    Set lct.CN = gDbObj.CN
    lct.Visible = False
    lblTitle(0) = gTsObj.Name(MDtType)
    lblTitle(1) = gTsObj.Name(MDtType)
    fra.Visible = False
    Init
    FillDataByDrugsObj
    hisLockSpread spd, True
    
End Sub
Private Sub Init()
    hisFormClear Me
    spd.MaxRows = 0
    spd.MaxRows = 1
    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
    

    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
    spd.Text = Unit
    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 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)
    If MDtType = tsA_CHECK_IN Or MDtType = tsA_CHECK_OUT Then
        RaiseEvent Cancel
    End If
    Set frmHouseCheckBus = 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
        lblHander.Visible = False
        lct.Visible = False
        lblDate.Visible = False
    Else
        hisLockInput Me, False
        lblHander.Visible = True
        lct.Visible = True
        lblDate.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 " & Cdt & " GROUP BY House_BusMain.BusSerial"
    lct.SQL = SQL
    lct.Refresh
    If lct.Count > 0 Then
        mcr.Status = CL_UPDATE
        FillData
    Else
        mcr.Status = CL_ADD
        Init
    End If
        
    
End Sub

Private Sub mcr_Click(ByVal WhichB As UseMaintainCtl.BUTTONKEY)
    
    Select Case WhichB
        Case BK_ADD
            Set ItemsObj = New clsDrugItems
            LoadData
            If Not ItemsObj.Save Then
                MsgBox gDbObj.ErrDes, vbCritical
            Else
                RaiseEvent Ack(ItemsObj)
                Unload Me
            End If
        Case BK_PRINT
            If mcr.Status = CL_ADD Then
                Set ItemsObj = New clsDrugItems
                LoadData
            End If
            ItemsObj.PrintSheet
        Case BK_EXIT
            Unload Me
    End Select
End Sub

Private Sub Sum()
    Dim i As Integer
    Dim Total As Currency
    
    spd.Col = 7
    For i = 1 To spd.MaxRows
        spd.Row = i
        Total = Total + Val(spd.Text)
    Next i
    lblGMoney = Format(Total, gstrMONEY_FORMAT)
    spd.Col = 9
    Total = 0
    For i = 1 To spd.MaxRows
        spd.Row = i
        Total = Total + Val(spd.Text)
    Next i
    lblCMoney = Format(Total, gstrMONEY_FORMAT)
    spd.Col = 10
    Total = 0
    For i = 1 To spd.MaxRows
        spd.Row = i
        Total = Total + Val(spd.Text)
    Next i
    lblCGMoney = Format(Total, gstrMONEY_FORMAT)
End Sub



Private Sub LoadData()
    Dim tmpObj As clsDrugItem
    Dim i As Integer
    
    ItemsObj.BusDate = gfnGetTime
    ItemsObj.Comment = txtComment
    ItemsObj.DtType = MDtType
    ItemsObj.VsDepCode = ""
    ItemsObj.SheetID = txtSheetID
    ItemsObj.HdCode = gtydSysConfig.HdCode
    ItemsObj.HdName = gtydSysConfig.HdName
    ItemsObj.DsCode = gtydSysConfig.DepCode
    ItemsObj.DsName = gtydSysConfig.DepName
    

    For i = 1 To spd.MaxRows
        spd.Row = i
        Set tmpObj = New clsDrugItem
        spd.Col = 1
        tmpObj.ItemCode = spd.Text
        spd.Col = 11
        tmpObj.Factor = Val(spd.Text)
        spd.Col = 2
        tmpObj.itemname = spd.Text
        spd.Col = 3
        tmpObj.Model = Left(spd.Text, InStr(spd.Text, " * ") - 1)
        spd.Col = 4
        tmpObj.Unit = spd.Text
        spd.Col = 5
        tmpObj.Amount = Val(spd.Text) * tmpObj.Factor
        spd.Col = 6
        tmpObj.Gprice = Val(spd.Text) / tmpObj.Factor
        spd.Col = 8
        tmpObj.CPrice = Val(spd.Text) / tmpObj.Factor
        ItemsObj.AddObj tmpObj
    Next i
End Sub

Private Sub FillData()
    Dim tmpObj As clsDrugItem
    Dim i As Integer
    
    If ItemsObj Is Nothing Then
        Set ItemsObj = New clsDrugItems
    End If
    ItemsObj.BusSerialByQuery = lct.CurColumns!BusSerial
    txtSheetID = ItemsObj.SheetID
    txtComment = ItemsObj.Comment
    spd.Redraw = False
    spd.MaxRows = 0
    spd.MaxRows = ItemsObj.Count + 1
    i = 1
    For Each tmpObj In ItemsObj
        PutSpread i, tmpObj.ItemCode, tmpObj.itemname, tmpObj.Model, _
            tmpObj.Unit, tmpObj.Amount, tmpObj.Gprice, tmpObj.CPrice, tmpObj.Factor
        i = i + 1
    Next
    spd.Redraw = True
    Me.lblHander = ItemsObj.HdName
    lblDate = Format(ItemsObj.BusDate, gstrCHINA_DATE)

    Sum
End Sub
Private Sub FillDataByDrugsObj()
    Dim tmpObj As clsDrugItem
    Dim i As Integer
    
    spd.Redraw = False
    spd.MaxRows = 0
    spd.MaxRows = ItemsObj.Count
    i = 1
    For Each tmpObj In ItemsObj
        PutSpread i, tmpObj.ItemCode, tmpObj.itemname, tmpObj.Model, _
            tmpObj.Unit, tmpObj.Amount, tmpObj.Gprice, tmpObj.CPrice, tmpObj.Factor
        i = i + 1
    Next
    spd.Redraw = True
    Sum
End Sub