frmhouseask.frm

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

    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
            If Not checkstore() Then Exit Sub
            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
                Init
                txtSheetID.SetFocus
            End If
        Case BK_DEL
            If Not gDbObj.DBExec("UpDate House_BusMain Set Flag = Flag |4 " _
                & " WHERE BusSerial = '" & lct.CurColumns!BusSerial & "'") Then
                MsgBox gDbObj.ErrDes
            Else
                lblCancel.Visible = True
                mcr.KeyEnabled(BK_DEL) = False
            End If
        Case BK_QUERY
            
            Set QueryObj = New frmHouseAskQuery  '?
            QueryObj.Show vbModal
        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,'',sum(Amount) ," _
                        & "M_Drug.baseUnit,m_Drug.factor,m_Drug.GPrice,m_Drug.Cprice " _
                        & "FROM m_Drug " _
                        & "inner join Store_Drug on store_drug.ItemCode=m_Drug.ItemCode and store_drug.dsCode='" & gtydSysConfig.VsStore & "' " _
                        & "WHERE Brief Like '##%' and m_drug.flag & 32=0 and Store_Drug.amount>0 " _
                        & gfnMakeLimit(gtydSysConfig.ItemCode, "m_Drug.ItemCode") _
                        & " Group By m_Drug.ItemCode,m_Drug.ItemName,m_Drug.ItemName,m_Drug.model," _
                        & "M_Drug.baseUnit,m_Drug.factor,m_Drug.GPrice,m_Drug.Cprice " _
                        & "UNION SELECT m_Drug.ItemCode,m_DrugAlias.AliasName," _
                        & "m_Drug.ItemName,m_Drug.model,'',sum(Amount),m_Drug.baseUnit,m_Drug.factor," _
                        & "m_Drug.GPrice,m_Drug.Cprice " _
                        & "FROM m_Drug INNER JOIN M_DrugAlias " _
                        & "ON m_Drug.ItemCode = m_DrugAlias.ItemCode " _
                        & "inner join Store_Drug on store_drug.ItemCode=m_Drug.ItemCode and store_drug.dsCode='" & gtydSysConfig.VsStore & "' " _
                        & "WHERE m_DrugAlias.Brief Like '##%' and m_drug.flag & 32=0  and Store_Drug.amount>0 " _
                        & gfnMakeLimit(gtydSysConfig.ItemCode, "m_Drug.ItemCode") _
                        & " Group By m_Drug.ItemCode,m_Drug.ItemName,m_DrugAlias.AliasName,m_Drug.model," _
                        & "M_Drug.baseUnit,m_Drug.factor,m_Drug.GPrice,m_Drug.Cprice " _

                    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 '数量
                Amount = Val(spd.Text)
                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)
                spd.Col = 11
                Factor = Val(spd.Text)
                spd.Col = 12
                If Amount * Factor > Val(spd.Text) Then
                    MsgBox gtydSysConfig.VsStoreName & " 库存只有 " & spd.Text / Factor & " 不够!", vbCritical
                    spd.Col = 5
                    spd.Action = SS_ACTION_ACTIVE_CELL
                    spd.SetFocus
                    Exit Sub
                End If
                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 = tsH_ASK_IN
    ItemsObj.VsDepCode = txtDepart.Tag
    ItemsObj.SheetID = txtSheetID
    ItemsObj.HdCode = gtydSysConfig.HdCode
    ItemsObj.HdName = gtydSysConfig.HdName
    ItemsObj.DsCode = gtydSysConfig.DepCode
    ItemsObj.DsName = gtydSysConfig.DepName
    
    ItemsObj.flag = 1   '请领
    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 AND Flag & 48 = 16"

            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
    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, 0
        i = i + 1
    Next
    spd.Redraw = True
    Me.lblHander = ItemsObj.HdCode
    lblDate = Format(ItemsObj.BusDate, gstrCHINA_DATE)
    If (ItemsObj.flag And 1) = 1 Then  '不可能有3
        Me.lblAskStatus = "请领未确认"
    Else
        Me.lblAskStatus = "请领确认"
    End If
    lblCancel.Visible = IIf((ItemsObj.flag And 4) = 4, True, False)
    mcr.KeyEnabled(BK_DEL) = IIf(((ItemsObj.flag And 4) = 4) Or ((ItemsObj.flag And 1) = 0), False, True)
    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 txtDepart.Tag = "" Then
        ErrDes = "必须输入请领药库!"
        Set ValidInput = txtDepart
        Exit Function
    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