frmgetdrugbydepart.frm

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

End Sub
Public Sub FillData()
    Dim TmpItem As clsGetDrug
    Dim TmpObj As clsSickGetDrug
    Dim flag As Integer
    spd.Redraw = False
    spd.MaxRows = 0
    For Each TmpObj In AllGetDrugObj
        If TmpObj.CanKeep Then
            flag = 1
            If Not optsex(0).Value Then
                If optsex(1).Value Then
                    If TmpObj.Sex = "女" Then flag = 0
                Else
                    If TmpObj.Sex = "男" Then flag = 0
                End If
            End If
            If flag = 1 Then
                For Each TmpItem In TmpObj
                    spd.MaxRows = spd.MaxRows + 1
                    spd.Row = spd.MaxRows
                    spd.Col = 1
                    spd.Text = TmpItem.ADVSerial
                    spd.Col = 2
                    spd.Text = TmpItem.Num
                    Select Case TmpItem.Status
                        Case 0
                            spd.Col = 3
                            spd.Value = 0
                            spd.Lock = False
                            spd.Col = 4
                            spd.Value = 0
                        Case 1
                            spd.Col = 3
                            spd.Value = 1
                            spd.Lock = False
                            spd.Col = 4
                            spd.Value = 0
                        
                        Case 2
                            spd.Col = 3
                            spd.Value = 0
                            spd.Lock = True
                            spd.Col = 4
                            spd.Value = 1
                    End Select
                    spd.Col = 5
                    spd.Text = TmpObj.SkID & "/" & TmpObj.Name & "/" & TmpObj.Sex
                    spd.Col = 6
                    spd.Text = IIf(TmpObj.IsBaby, "是", " ")
                    spd.Col = 7
                    spd.Text = TmpObj.BedNum
                    spd.Col = 8
                    spd.Text = TmpItem.itemname
                    spd.Col = 9
                    spd.Text = TmpItem.Model
                    spd.Col = 10
                    spd.Text = Format(TmpItem.ModelAmount, "#######0.####") & TmpItem.ModelUnit
                    spd.Col = 11
                    spd.Text = TmpItem.FreqDes
                    spd.Col = 12
                    spd.Text = TmpItem.Mount
                    spd.Col = 13
                    spd.Text = TmpItem.Unit
                    spd.Col = 14
                    spd.Text = TmpItem.CPrice
                    spd.Col = 15
                    spd.Text = TmpItem.Mount * TmpItem.CPrice
                    spd.Col = 16
                    If gDbObj.GetRs("select DcName From m_Doctor where dcCode='" & TmpObj.DcCode & "'") > 0 Then
                        spd.Text = gDbObj.Rs(0)
                    End If
                    spd.Col = 17
                    spd.Text = Format(TmpItem.BeginDate, "yyyy-mm-dd hh:mm:ss")
                Next
                'spd.MaxRows = spd.MaxRows + 1
            End If
        End If
    Next
    spd.Redraw = True

End Sub

Private Sub Total()
    Dim TmpItem As clsGetDrug
    Dim TmpObj As clsSickGetDrug
    Dim VsRow As Long
    Dim flag As Integer
    
    Screen.MousePointer = 11
    spd.Redraw = False
    spd.MaxRows = 0
    For Each TmpObj In AllGetDrugObj
        flag = 1
        If Not optsex(0).Value Then
            If optsex(1).Value Then
                If TmpObj.Sex = "女" Then flag = 0
            Else
                If TmpObj.Sex = "男" Then flag = 0
            End If
        End If
        If flag = 1 Then
            For Each TmpItem In TmpObj
                If TmpItem.Status = 1 Then
                    VsRow = FindVsRow(TmpItem)
                    If VsRow = 0 Then
                        spd.MaxRows = spd.MaxRows + 1
                        spd.Row = spd.MaxRows
                        spd.Col = 1
                        spd.Text = TmpItem.ItemCode
    '                    spd.Col = 2
    '                    spd.Text = TmpItem.Num
                        spd.Col = 8
                        spd.Text = TmpItem.itemname
                        spd.Col = 9
                        spd.Text = TmpItem.Model
                        spd.Col = 12
                        spd.Text = TmpItem.Mount
                        spd.Col = 13
                        spd.Text = TmpItem.Unit
                        spd.Col = 14
                        spd.Text = TmpItem.CPrice
                        spd.Col = 15
                        spd.Text = TmpItem.Mount * TmpItem.CPrice
    
                    Else
                        spd.Row = VsRow
                        spd.Col = 12
                        spd.Text = TmpItem.Mount + Val(spd.Text)
                        spd.Col = 15
                        spd.Text = TmpItem.Mount * TmpItem.CPrice + Val(spd.Text)
                    End If
                End If
            Next
        End If
    Next
    spd.Redraw = True
    Screen.MousePointer = 0
End Sub
Private Function FindVsRow(CurItem As clsGetDrug) As Integer
    Dim ItemCode As String
    Dim TmpItem As clsGetDrug, i As Integer
    
    For i = 1 To spd.MaxRows
        spd.Row = i
        spd.Col = 1
        ItemCode = spd.Text
        If CurItem.ItemCode = ItemCode Then
            FindVsRow = i
            Exit Function
        End If
    Next i
End Function
Private Sub LoadData()
    Dim TmpObj As clsGetDrug
    Dim ADVSerial As String
    Dim Num As Integer, i As Integer
    
    For i = 1 To spd.MaxRows
        spd.Row = i
        spd.Col = 1
        ADVSerial = spd.Text
        spd.Col = 2
        Num = Val(spd.Text)
        Set TmpObj = AllGetDrugObj.ADVItem(ADVSerial, Num)
        If Not (TmpObj Is Nothing) Then
            spd.Col = 3
            If spd.Value = 1 Then
                TmpObj.Status = 1
            Else
                spd.Col = 4
                If spd.Value = 1 Then
                    TmpObj.Status = 2
                Else
                    TmpObj.Status = 0
                End If
            End If
        End If
    Next i
End Sub
Private Function ValidInput(ErrDes As String, Row As Long, Col As Long) As Object
    Dim i As Integer, Having As Boolean
    
    If chkTotal.Value = 0 Then
        For i = 1 To spd.MaxRows
            spd.Row = i
            spd.Col = 3
            If spd.Value = 1 Then
                Having = True
            End If
        Next i
        If Not Having Then
            ErrDes = "请选择记帐项目!"
            Set ValidInput = spd
            Row = 1
            Col = 3
            Exit Function
        End If
    Else
        If spd.MaxRows = 0 Then
            ErrDes = "请选择记帐项目!"
            Set ValidInput = spd
            Exit Function
        End If
    End If
End Function

Private Sub optsex_Click(Index As Integer)
    If chkTotal.Value = 0 Then
        FillData
    Else
        Total
    End If
End Sub

Private Sub QueryObj_AckSelect(ByVal ItemType As String, ByVal ADvType As Integer)
    Dim ADVSerial As String, Num As Integer
    Dim TmpItem As clsGetDrug, i As Integer
    
    For i = 1 To spd.MaxRows
        spd.Row = i
        spd.Col = 4
        If spd.Value = 0 Then
            spd.Col = 1
            ADVSerial = spd.Text
            spd.Col = 2
            Num = Val(spd.Text)
            Set TmpItem = AllGetDrugObj.ADVItem(ADVSerial, Num)
            If Not (TmpItem Is Nothing) Then
            
                If Left(TmpItem.ItemCode, Len(ItemType)) = ItemType And Not (TmpItem.IsTemp And ADvType = 2) _
                    And Not (Not TmpItem.IsTemp And ADvType = 1) Then
                    spd.Col = 3
                    spd.Value = 1
                Else
                    spd.Col = 3
                    spd.Value = 0
                End If
            End If
        End If
    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 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