frmgetdrugbydepart.frm

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

                    spd.Col = 8
                    spd.Text = TmpItem.ItemName
                    spd.Col = 9
                    spd.Text = TmpItem.batchid & "\" & TmpItem.model
                    spd.Col = 10
                    If (TmpItem.SFlag And 2) = 0 Then
                        spd.Text = Format(TmpItem.ModelAmount, "#######0.####") & TmpItem.ModelUnit
                    End If
                    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='" & TmpItem.DcCode & "'") > 0 And spd.MaxCols > 15 Then
                        spd.Text = gdbobj.Rs(0)
                    End If
                    spd.Col = 17
                    If spd.MaxCols > 16 Then spd.Text = Format(TmpItem.BeginDate, "yyyy-mm-dd hh:mm:ss")
                    spd.BlockMode = True
                    spd.Row = spd.MaxRows
                    spd.Row2 = spd.MaxRows
                    spd.Col = 1
                    spd.Col2 = spd.MaxCols
                    If TmpItem.NotStoreAmount Then
                        spd.ForeColor = RGB(255, 0, 0)
                    Else
                        spd.ForeColor = RGB(0, 0, 0)
                    End If
                    spd.BlockMode = False
                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
    Dim SFlag 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 = 3 And gtydSysConfig.ifMarkEndPrint) Or (TmpItem.Status And 1 = 1 And Not gtydSysConfig.ifMarkEndPrint) Then
'                If TmpItem.Status = 3 Or TmpItem.Status = 1 Then   '原来是3,按药品汇总不出结果，改为1后，出结果
                    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
                If (tmpObj.Status And 2) = 2 Then
                    tmpObj.Status = 3
                Else
                    tmpObj.Status = 1
                End If
            Else
                If (tmpObj.Status And 2) = 2 Then
                    tmpObj.Status = 2
                Else
                    spd.Col = 4
                    If spd.value = 1 Then
                        tmpObj.Status = 2
                    Else
                        tmpObj.Status = 0
                    End If
                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 = 4
            If spd.value = 1 Then
                spd.Col = 3
                spd.value = 0
            Else
                spd.Col = 3
                If spd.value = 1 Then
                    Having = True
                End If
            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 NoStorefrm_act(Opt As Integer)
    changflag Opt
End Sub

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
    Dim Flag As Boolean
    For i = 1 To spd.MaxRows
        spd.Row = i
        spd.Col = 4
'        If spd.value = 1 Then
            Flag = True
            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

Private Sub changflag(Flag As Integer)
    Dim i As Integer
    Dim TmpItem As clsGetDrug
    Dim tmpObj As clsSickGetDrug
    For i = 1 To AllGetDrugObj.DrugAmountsObj.Count
        If AllGetDrugObj.DrugAmountsObj(i).Storage < AllGetDrugObj.DrugAmountsObj(i).Amount Then
            For Each tmpObj In AllGetDrugObj
                If tmpObj.CanKeep Then
                    For Each TmpItem In tmpObj
                        If TmpItem.ItemCode = AllGetDrugObj.DrugAmountsObj(i).ItemCode Then
'                            if tmpitem.Status= and
                            TmpItem.Status = 0
                        End If
                    Next
                End If
            Next
        End If
    Next i
    FillData
End Sub


Private Sub printspd()
    Dim i As Integer
    Dim TmpStr As String
    Dim prevtmpstr As String
    Dim Flag As Integer
    spd.Redraw = False
    If Me.chkTotal.value = 0 Then
        For i = 1 To spd.MaxRows
            spd.Row = i
            spd.Col = 1
            TmpStr = spd.Text
            spd.Col = 4
            Flag = spd.value
            spd.Col = 3
            If (spd.value = 0 And Flag = 0 And gtydSysConfig.ifMarkEndPrint) Or (spd.value = 0 And Not gtydSysConfig.ifMarkEndPrint) Then
                If (TmpStr = "" And prevtmpstr = "") Or TmpStr <> "" Then
                    spd.RowHidden = True
                End If
                
            End If
            If Not spd.RowHidden Then
                prevtmpstr = TmpStr
            End If
        Next
    End If
    spd.PrintHeader = "                               /fz""12"" /fb1  摆药单                                   /n" _
    & "/fz""10"" /fb0 科别：" & DepName & Space(40) & "日期:" & gfnGetTime(gstrCHINA_DATE) & "/r/n"
    spd.PrintRowHeaders = False
    spd.PrintShadows = False
    spd.PrintMarginLeft = 0
    spd.PrintUseDataMax = False
    spd.Action = SS_ACTION_PRINT
    If Me.chkTotal.value = 0 Then
        For i = 1 To spd.MaxRows
            spd.Row = i
            If spd.RowHidden = True Then
                spd.RowHidden = False
            End If
        Next
    End If
    spd.Redraw = True

End Sub