frmhousecheck.frm

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

    End If
    Set frmHouseCheck = Nothing
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 AppearGprice As Single, AppearCPrice As Single
    Dim AppearAmount As Long, CurUnit As String, ItemCode As String, Model As String
    Dim AppearFatualAmount As Long
    
    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," _
                        & "(CASE WHEN House_Drug.Amount IS NULL THEN 0 ELSE House_Drug.Amount END) " _
                        & "FROM m_Drug LEFT JOIN House_Drug " _
                        & "ON m_Drug.ItemCode = House_Drug.ItemCode " _
                        & "AND DsCode ='" & gtydSysConfig.DepCode & "'" _
                        & "WHERE Brief Like '##%' and m_drug.flag & 32=0 " _
                        & 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, " _
                        & "(CASE WHEN House_Drug.Amount IS NULL THEN 0 ELSE House_Drug.Amount END) " _
                        & "FROM (m_Drug INNER JOIN M_DrugAlias " _
                        & "ON m_Drug.ItemCode = m_DrugAlias.ItemCode) " _
                        & "LEFT JOIN House_Drug " _
                        & "ON m_Drug.ItemCode = House_Drug.ItemCode " _
                        & "AND DsCode ='" & gtydSysConfig.DepCode & "'" _
                        & "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.8
                    CmnHlp.ShowHelp vbModal
                Else
                    If Row <> spd.MaxRows Then
                        spd.Row = Row
                        spd.Action = SS_ACTION_DELETE_ROW
                        spd.MaxRows = spd.MaxRows - 1
                    End If
                    
                End If
            Case 6 '单位--->规格变、批发价变、零售价变、库存数量变、数量变、
                  '差数变、批发金额差变、零售金额差变
                If Row = spd.MaxRows Then Exit Sub
                CurUnit = TmpStr
                spd.Col = 1
                ItemCode = spd.Text
                spd.Col = 9
                AppearAmount = Val(spd.Text)
                spd.Col = 10
                AppearFatualAmount = Val(spd.Text)
                spd.Col = 14
                Factor = Val(spd.Text)
                If Not gfnIsInt(AppearAmount * Factor / CurUnitObj(ItemCode).Item(CurUnit).Factor) _
                    Or Not gfnIsInt(AppearAmount * Factor / CurUnitObj(ItemCode).Item(CurUnit).Factor) Then
                    MsgBox gstrERROR_UNIT, vbInformation
                    spd.Col = 6
                    spd.Text = CurUnitObj(ItemCode).GetUnitByFactor(Factor)
                    spd.SetFocus
                    Exit Sub
                End If
                spd.Col = 5
                Model = Left(spd.Text, InStr(spd.Text, "^") - 1)
                spd.Text = Model & "^" & CurUnitObj(ItemCode).Item(CurUnit).Factor
                spd.Col = 7 '批发价
                AppearGprice = Val(spd.Text) * (CurUnitObj(ItemCode).Item(CurUnit).Factor / Factor)
                spd.Text = AppearGprice
                spd.Col = 8
                AppearCPrice = Val(spd.Text) * (CurUnitObj(ItemCode).Item(CurUnit).Factor / Factor)
                spd.Text = AppearCPrice
                spd.Col = 9
                AppearAmount = Val(spd.Text) * Factor / CurUnitObj(ItemCode).Item(CurUnit).Factor
                spd.Text = AppearAmount
                spd.Col = 10
                AppearFatualAmount = Val(spd.Text) * Factor / CurUnitObj(ItemCode).Item(CurUnit).Factor
                spd.Col = 11
                spd.Text = AppearFatualAmount - AppearAmount
                spd.Col = 12
                spd.Text = (AppearFatualAmount - AppearAmount) * AppearGprice
                spd.Col = 13
                spd.Text = (AppearFatualAmount - AppearAmount) * AppearCPrice
                spd.Col = 14
                spd.Text = CurUnitObj(ItemCode).Item(CurUnit).Factor
            
            Case 10 '实际数量
                If Row = spd.MaxRows Then Exit Sub
                spd.Col = 2
                spd.Lock = True
                spd.Col = 7 '批发价
                AppearGprice = Val(spd.Text)
                spd.Col = 8
                AppearCPrice = Val(spd.Text)
                spd.Col = 9
                AppearAmount = Val(spd.Text)
                spd.Col = 11
                spd.Text = Val(TmpStr) - AppearAmount
                If Val(spd.Text) > 0 Then
                    spd.ForeColor = vbBlue
                    spd.Col = 2
                    spd.Lock = False
                End If
                If Val(spd.Text) < 0 Then
                    spd.ForeColor = vbRed
                    spd.Col = 2
                    spd.Lock = False
                End If
                
                spd.Col = 12
                spd.Text = (Val(TmpStr) - AppearAmount) * AppearGprice
                spd.Col = 13
                spd.Text = (Val(TmpStr) - AppearAmount) * AppearCPrice
        End Select
    End If
End Sub


Private Sub PutSpread(ByVal Row As Long, ByVal ItemCode As String, ByVal ItemName As String, _
    ByVal Model As String, ByVal Amount As Long, ByVal BaseUnit As String, _
    ByVal Unit As String, ByVal Factor As Integer, ByVal Gprice As Currency, _
    ByVal CPrice As String)
    
    Dim I As Integer
    
    If CurUnitObj Is Nothing Then
        Set CurUnitObj = New clsDrugUnit
    End If
    CurUnitObj.Add ItemCode
    spd.Row = Row
    spd.Col = 1
    spd.Text = ItemCode
    spd.Col = 2
    spd.Value = 0
    spd.Lock = True
    spd.Col = 3
    spd.Text = 0
    spd.Col = 4
    spd.Text = ItemName
    If Not gfnIsInt(Amount / Factor) Then
        Unit = BaseUnit
        Factor = 1
    End If
    spd.Col = 5
    spd.Text = Model & "^" & Factor
    
'单位处理模式1,数量确切-->
    spd.Col = 6
    spd.CellType = SS_CELL_TYPE_COMBOBOX
    For I = 1 To CurUnitObj(ItemCode).Count
'        If gfnIsInt(Amount / CurUnitObj(ItemCode).Item(I).Factor) Then '不允许界面小数
            spd.TypeComboBoxIndex = -1
            spd.TypeComboBoxString = CurUnitObj(ItemCode).Item(I).Unit
'        End If
    Next I
    If Not gfnIsInt(Amount / Factor) Then
        spd.Text = CurUnitObj(ItemCode).BaseUnit
        Factor = 1
    Else
        spd.Text = Unit
    End If
    If spd.TypeComboBoxCount = 1 Then
        spd.Lock = True
    Else
        spd.Lock = False
    End If
'<---
    spd.Col = 7
    spd.Text = Gprice * Factor
    spd.Col = 8
    spd.Text = CPrice * Factor
    spd.Col = 9
    spd.Text = Amount / Factor
    spd.Col = 10
    spd.Text = 0
    spd.Col = 11
    spd.Text = 0 - Amount / Factor
    If Val(spd.Text) > 0 Then
        spd.ForeColor = vbBlue
        spd.Col = 2
        spd.Lock = False
    End If
    If Val(spd.Text) < 0 Then
        spd.ForeColor = vbRed
        spd.Col = 2
        spd.Lock = False
    End If
    spd.Col = 12
    spd.Text = (0 - Amount) * Gprice
    spd.Col = 13
    spd.Text = (0 - Amount) * CPrice
    spd.Col = 14
    spd.Text = Factor
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 Function FindDrug(ByVal ItemCode As String) As Boolean
    Dim I As Integer
    
    For I = 1 To spd.MaxRows - 1
        spd.Row = I
        spd.Col = 1
        If ItemCode = spd.Text Then
            FindDrug = True
            Exit Function
        End If
    Next I
End Function
Private Sub LoadData(CurDrugsObj As clsDrugItems, Optional DtType As TSDtType = tsA_CHECK_IN)
    Dim I As Long
    Dim Sel As Boolean
    Dim Amount As Long, ItemCode As String, ItemName As String, Gprice As Currency
    Dim CPrice As Currency, Unit As String, Factor As Integer, Model As String
    
    
    For I = 1 To spd.MaxRows - 1
        spd.Row = I
        spd.Col = 2
        Sel = IIf(spd.Value = 1, True, False)
        If Sel Then
            spd.Col = 1
            ItemCode = spd.Text
            spd.Col = 4
            ItemName = spd.Text
            spd.Col = 5
            Model = Left(spd.Text, InStr(spd.Text, "^") - 1)
            spd.Col = 14
            Factor = Val(spd.Text)
            spd.Col = 11
            Amount = Val(spd.Text) * Factor
            spd.Col = 6
            Unit = spd.Text
            spd.Col = 7
            Gprice = Val(spd.Text) / Factor
            spd.Col = 8
            CPrice = Val(spd.Text) / Factor
            If Amount > 0 And DtType = tsA_CHECK_IN Then
                CurDrugsObj.Add ItemCode, ItemName, Model, Amount, Gprice, _
                    CPrice, Unit, Factor
            End If
            If Amount < 0 And DtType = tsA_CHECK_OUT Then
                CurDrugsObj.Add ItemCode, ItemName, Model, -Amount, Gprice, _
                    CPrice, Unit, Factor
            End If
        End If
    Next I
End Sub

Private Sub spd_RightClick(ByVal ClickType As Integer, ByVal Col As Long, ByVal Row As Long, ByVal MouseX As Long, ByVal MouseY As Long)
    Call usp.RightClick
End Sub