frmhousebus.frm

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

        & " 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)
    Dim Obj As Object, ErrDes As String, Row As Long, Col As Long
    
    Select Case WhichB
        Case BK_ADD
            Set Obj = ValidInput(ErrDes, Row, Col)
            If Not (Obj Is Nothing) Then
                MsgBox ErrDes, vbCritical
                If Obj.Name = "spd" Then
                    hisActiveSpreadCell spd, Row, Col
                Else
                    Obj.SetFocus
                End If
                Exit Sub
            End If
            Set ItemsObj = New clsDrugItems
            LoadData
            If Not ItemsObj.Save Then
                MsgBox gDbObj.ErrDes, vbCritical
            Else
                ItemsObj.PrintSheet
                Init
                txtSheetID.SetFocus
            End If
        Case BK_QUERY
            Set QueryObj = New frmHouseBusQuery
            QueryObj.MDtType = MDtType
            QueryObj.Show vbModal
        Case BK_PRINT
            If mcr.Status = CL_ADD Then
                Set Obj = ValidInput(ErrDes, Row, Col)
                If Not (Obj Is Nothing) Then
                    MsgBox ErrDes, vbCritical
                    If Obj.Name = "spd" Then
                        hisActiveSpreadCell spd, Row, Col
                    Else
                        Obj.SetFocus
                    End If
                    Exit Sub
                End If
                Set ItemsObj = New clsDrugItems
                LoadData
            End If
            ItemsObj.PrintSheet
        Case BK_TRANS
            mcr.Status = CL_ADD
            Init
            txtSheetID.SetFocus
        Case BK_CLEAR
            Init
            txtSheetID.SetFocus
        
        Case BK_EXIT
            Unload Me
    End Select
End Sub

Private Sub spd_EditMode(ByVal Col As Long, ByVal Row As Long, ByVal Mode As Integer, ByVal ChangeMade As Boolean)
    Dim TmpStr As String, Factor As Integer
    Dim Gprice As Single, CPrice As Single
    Dim Amount As Long, CurUnit As String, ItemCode As String, Model As String
    
    If ChangeMade Then
        spd.Col = Col
        spd.Row = Row
        TmpStr = spd.Text
        Select Case Col
            Case 2 '名称
                If TmpStr <> "" Then
                    CmnHlp.SQL = "SELECT m_Drug.ItemCode,m_Drug.ItemName,m_Drug.ItemName," _
                        & "m_Drug.Model," _
                        & "M_Drug.GenalUnit,m_Drug.factor,m_Drug.GPrice,m_Drug.Cprice " _
                        & "FROM m_Drug WHERE Brief Like '##%' and m_drug.flag & 32=0 " _
                        & gfnMakeLimit(gtydSysConfig.ItemCode, "ItemCode") _
                        & "UNION SELECT m_Drug.ItemCode,m_DrugAlias.AliasName," _
                        & "m_Drug.ItemName,m_Drug.Model,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 '##%' and m_drug.flag & 32=0 " _
                        & gfnMakeLimit(gtydSysConfig.ItemCode, "m_Drug.ItemCode")

                    CmnHlp.FormatHead = _
                        "|名              称||规          格|包装单位|| 批发价| 零售价"
                    CmnHlp.InitPut = TmpStr
                    CmnHlp.WidthRate = 1.5
                    CmnHlp.ParmTag = "Item"
                    CmnHlp.ShowHelp vbModal
                Else
                    If Row <> spd.MaxRows Then
                        spd.Row = Row
                        spd.Action = SS_ACTION_DELETE_ROW
                        spd.MaxRows = spd.MaxRows - 1
                        Sum
                    End If
                    
                End If
            Case 4 '单位 ----> 变  数量不变、批发、实际、零售
                If Row = spd.MaxRows Then Exit Sub
                CurUnit = TmpStr
                spd.Col = 1
                ItemCode = spd.Text
                spd.Col = 3
                Model = Left(spd.Text, InStr(spd.Text, " * ") - 1)
                spd.Text = Model & " * " & Int(CurUnitObj(ItemCode).Item(CurUnit).Factor)

                spd.Col = 5
                Amount = Val(spd.Text)
                spd.Col = 11
                Factor = Val(spd.Text)
                
                spd.Col = 6 '批发价
                spd.Text = Val(spd.Text) * (CurUnitObj(ItemCode).Item(CurUnit).Factor / Factor)
                Gprice = Val(spd.Text)
                spd.Col = 7
                spd.Text = Val(spd.Text) * (CurUnitObj(ItemCode).Item(CurUnit).Factor / Factor)
                spd.Col = 8 '零售价
                spd.Text = Val(spd.Text) * (CurUnitObj(ItemCode).Item(CurUnit).Factor / Factor)
                CPrice = Val(spd.Text)
                spd.Col = 9
                spd.Text = Val(spd.Text) * (CurUnitObj(ItemCode).Item(CurUnit).Factor / Factor)
                spd.Col = 10
                spd.Text = CPrice - Gprice
                spd.Col = 11
                spd.Text = CurUnitObj(ItemCode).Item(CurUnit).Factor
                Sum
            Case 5 '数量
                spd.Col = 6
                Gprice = Val(spd.Text)
                spd.Col = 7
                spd.Text = Val(TmpStr) * Gprice
                spd.Col = 8
                CPrice = Val(spd.Text)
                spd.Col = 9
                spd.Text = Val(TmpStr) * CPrice
                spd.Col = 10
                spd.Text = CPrice * Val(TmpStr) - Gprice * Val(TmpStr)
                Sum

                
        End Select
    End If
End Sub
Private Sub Sum()
    Dim i As Integer
    Dim Total As Currency
    Dim Count As Long
    
    If mcr.Status = CL_ADD Then
        Count = spd.MaxRows - 1
    Else
        Count = spd.MaxRows
    End If
    
    spd.Col = 7
    For i = 1 To Count
        spd.Row = i
        Total = Total + Val(spd.Text)
    Next i
    lblGMoney = Format(Total, gstrMONEY_FORMAT)
    spd.Col = 9
    Total = 0
    For i = 1 To Count
        spd.Row = i
        Total = Total + Val(spd.Text)
    Next i
    lblCMoney = Format(Total, gstrMONEY_FORMAT)
    spd.Col = 10
    Total = 0
    For i = 1 To Count
        spd.Row = i
        Total = Total + Val(spd.Text)
    Next i
    lblCGMoney = Format(Total, gstrMONEY_FORMAT)
End Sub

Private Sub spd_KeyPress(KeyAscii As Integer)
    If spd.ActiveCol = 2 And spd.ActiveRow = spd.MaxRows _
        And KeyAscii = vbKeyReturn Then
        
        spd.Col = spd.ActiveCol
        spd.Row = spd.ActiveRow
        If spd.Text = "" Then
            hisToActiveCtl(Me).SetFocus
        End If
        
    End If
End Sub


Private Sub LoadData()
    Dim tmpObj As clsDrugItem
    Dim i As Integer
    
    ItemsObj.BusDate = gfnGetTime
    ItemsObj.Comment = txtComment
    ItemsObj.DtType = MDtType
    ItemsObj.VsDepCode = txtDepart.Tag
    ItemsObj.SheetID = txtSheetID
    ItemsObj.HdCode = gtydSysConfig.HdCode
    ItemsObj.HdName = gtydSysConfig.HdName
    ItemsObj.DsCode = gtydSysConfig.DepCode
    ItemsObj.DsName = gtydSysConfig.DepName
    ItemsObj.marker = txtMarker
    ItemsObj.VsDepName = txtDepart
    
    If MDtType = tsH_ASK_IN Then
        ItemsObj.flag = 1   '请领
    End If
    For i = 1 To spd.MaxRows - 1
        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 spd_LeaveCell(ByVal Col As Long, ByVal Row As Long, ByVal NewCol As Long, ByVal NewRow As Long, Cancel As Boolean)
    gpdSpreadControl spd, Col, Row, NewCol, NewRow
End Sub

Private Sub txtDepart_GotFocus()
    mDepart = txtDepart
End Sub

Private Sub txtDepart_LostFocus()
    Dim SQL As String
    
   If mDepart <> txtDepart Then
        If txtDepart = "" Then
            txtDepart.Tag = ""
        Else
            CmnHlp.SQL = "SELECT DepCode,DepName " _
                & "FROM m_Depart WHERE Brief Like '##%' AND Leaf = 1 "

            CmnHlp.InitPut = txtDepart
            CmnHlp.FormatHead = "|名              称"
            CmnHlp.WidthRate = 1#
            CmnHlp.ParmTag = "Depart"
            CmnHlp.ShowHelp vbModal
        End If
    End If
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
    txtDepart = ItemsObj.VsDepName
    txtComment = ItemsObj.Comment
    txtMarker = ItemsObj.marker
    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
    Me.lblHander = ItemsObj.HdCode
    lblDate = Format(ItemsObj.BusDate, gstrCHINA_DATE)

    Sum
End Sub

Private Function ValidInput(ErrDes As String, Row As Long, Col As Long) As Object
    Dim i As Integer, Amount As Long
    
    
    If Not (MDtType = tsA_DRUMP_OUT) Then
        
        If txtDepart.Tag = "" Then
            ErrDes = "必须输入" & lblDepart.Caption
            Set ValidInput = txtDepart
            Exit Function
        End If
    End If
    For i = 1 To spd.MaxRows - 1
        spd.Row = i
        spd.Col = 5
        Amount = Val(spd.Text)
        If Amount <= 0 Then
            ErrDes = "数量必须大于零!"
            Set ValidInput = spd
            Row = i
            Col = 5
            Exit Function
        End If
    Next i
    If spd.MaxRows = 1 Then
        ErrDes = "请输入药品项!"
        Set ValidInput = spd
        Row = 1
        Col = 2
        Exit Function
    End If
End Function