frmopgetdrugcondition.frm

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

VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form frmOpGetDrugCondition 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "摆药"
   ClientHeight    =   4185
   ClientLeft      =   3030
   ClientTop       =   1665
   ClientWidth     =   5625
   Icon            =   "frmOpGetDrugCondition.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   4185
   ScaleWidth      =   5625
   Begin VB.CheckBox chkGlass 
      Caption         =   "草药"
      Height          =   225
      Left            =   180
      TabIndex        =   8
      Top             =   3810
      Width           =   1035
   End
   Begin VB.TextBox txtDays 
      Height          =   390
      Left            =   180
      Locked          =   -1  'True
      TabIndex        =   6
      Text            =   "1"
      Top             =   3240
      Width           =   315
   End
   Begin VB.Frame Frame1 
      Caption         =   "选项"
      Height          =   825
      Left            =   2790
      TabIndex        =   3
      Top             =   2835
      Width           =   2640
      Begin VB.OptionButton OptType 
         Caption         =   "全科摆药"
         Height          =   255
         Index           =   1
         Left            =   555
         TabIndex        =   5
         Top             =   480
         Width           =   1455
      End
      Begin VB.OptionButton OptType 
         Caption         =   "按病人摆药"
         Height          =   255
         Index           =   0
         Left            =   555
         TabIndex        =   4
         Top             =   165
         Width           =   1455
      End
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "&C.取  消"
      Height          =   405
      Left            =   4530
      TabIndex        =   2
      Top             =   3735
      Width           =   900
   End
   Begin VB.CommandButton cmdAck 
      Caption         =   "&A.确  定"
      Height          =   405
      Left            =   3600
      TabIndex        =   1
      Top             =   3750
      Width           =   900
   End
   Begin VB.ListBox List1 
      Height          =   2580
      Left            =   165
      TabIndex        =   0
      Top             =   240
      Width           =   5235
   End
   Begin MSComCtl2.UpDown updown1 
      Height          =   420
      Left            =   495
      TabIndex        =   9
      Top             =   3225
      Width           =   270
      _ExtentX        =   476
      _ExtentY        =   741
      _Version        =   393216
      Value           =   1
      BuddyControl    =   "txtDays"
      BuddyDispid     =   196610
      OrigLeft        =   4020
      OrigTop         =   900
      OrigRight       =   4260
      OrigBottom      =   1305
      Min             =   1
      SyncBuddy       =   -1  'True
      BuddyProperty   =   65547
      Enabled         =   -1  'True
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "摆药周期(天)"
      Height          =   180
      Left            =   165
      TabIndex        =   7
      Top             =   2955
      Width           =   1080
   End
End
Attribute VB_Name = "frmOpGetDrugCondition"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private AllGetDrugObj As clsAllGetDrug
Public Sub Init()
    txtDays = gtydSysConfig.DefaultGetDrugDays
    List1.Clear
    If gDbObj.GetRs("SELECT DepCode,DepName FROM m_Depart WHERE DepCode IN (" & gtydSysConfig.OpDepCode & ")") > 0 Then
        Do Until gDbObj.Rs.EOF
            List1.AddItem gDbObj.Rs(0) + Chr(9) + gDbObj.Rs(1)
            gDbObj.Rs.MoveNext
        Loop
    End If
    OptType(1).Value = True
'    List2.Clear
End Sub

Private Sub chkGlass_Click()
    If chkGlass.Value = 1 Then
        Me.Frame1.Enabled = False
        Me.OptType(0).Value = True
    Else
        Me.Frame1.Enabled = True
    End If
End Sub

Private Sub cmdAck_Click()
    If List1.ListIndex = -1 Then Exit Sub
    Me.MousePointer = 11
    frmMain.Note = "正在计算,请稍侯......."
    GetData
    frmMain.Note = ""
    Me.MousePointer = 0
    If AllGetDrugObj Is Nothing Then
        MsgBox "无满足条件的摆药项目", vbInformation
        Exit Sub
    End If
    If AllGetDrugObj.HavingCount = 0 Then
        MsgBox "无满足条件的摆药项目", vbInformation
        Exit Sub
    End If
    If OptType(0) Then
        Set frmGetDrug.AllGetDrugObj = AllGetDrugObj
        frmGetDrug.Show
    Else
        Set frmGetDrugByDepart.AllGetDrugObj = AllGetDrugObj
        frmGetDrugByDepart.DepName = Right(List1.Text, Len(List1.Text) - InStr(List1.Text, " "))
        frmGetDrugByDepart.Show
    End If
    DoEvents
    Unload Me
End Sub


Private Sub cmdCancel_Click()
    Unload Me
End Sub


Private Sub Form_Load()
    hisFormToCenter Me, frmMain
    chkGlass.Visible = False
    Init
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set frmGetDrugCondition = Nothing
End Sub
Private Sub GetData()
    Dim TmpObj As clsSickGetDrug, Index As Integer, GetDrugObj As clsGetDrug
    Dim MdepCode As String
    Dim tmpRS As Recordset
    Dim i As Integer, Baby As Boolean, OutDrug As Boolean
    Dim ADVDetailKind As Long, ADVKind As Long
    Dim SQL As String
    Dim mStr As String
    
    If Me.List1.ListIndex = -1 Then Exit Sub
    i = InStr(Me.List1.Text, Chr(9))
    mStr = Left(List1.Text, i - 1)
    
    SQL = "SELECT Operate_SickInfo.OpSerial,Operate_SickInfo.TableNum AS BedID," _
        & "SickInfo.SkSerial,m_SickRegInfo.Name,SickInfo.Status," _
        & "Operate_ADVDetail.ADVSerial,Operate_ADVDetail.Num,SickInfo.DcCode," _
        & "SickInfo.DepCode,Operate_ADVMain.ADVUsID,(SickInfo.PrePay - SickInfo.Fair) AS 'RemFair'," _
        & "Operate_ADVDetail.ItemCode,Operate_ADVDetail.ModelAmount,Operate_ADVDetail.Amount," _
        & "m_Drug.ItemName,m_Drug.Model,m_Drug.Flag,m_Drug.Gprice," _
        & "m_Drug.Cprice,m_Drug.BaseUnit,Operate_ADVMain.ADVFreqID,Operate_ADVMain.Kind As 'ADVKind'," _
        & "Operate_ADVMain.EndDate,Operate_ADVDetail.PrevEndDate,Operate_ADVDetail.Kind as 'ADVDetailKind',Operate_ADVMain.BeginDate " _
        & "FROM ((((Operate_ADVMain INNER JOIN Operate_ADVDetail ON Operate_ADVMain.ADVSerial = Operate_ADVDetail.ADVSerial) " _
        & "INNER JOIN m_Drug ON Operate_ADVDetail.ItemCode = m_Drug.ItemCode) " _
        & "INNER JOIN Operate_SickInfo ON Operate_ADVMain.OpSerial = Operate_SickInfo.OpSerial)" _
        & "INNER JOIN SickInfo ON Operate_SickInfo.SkSerial = SickInfo.SkSerial) " _
        & "INNER JOIN m_SickRegInfo ON SickInfo.SkID = m_SickRegInfo.SkID " _
        & "WHERE (Operate_ADVDetail.Kind & 1) =0 AND (Operate_ADVMain.Kind & 2) =0 " _
        & gfnMakeLimit(gtydSysConfig.ItemCode, "m_Drug.ItemCode") _
        & " AND Operate_SickInfo.FinishDate IS NULL " _
        & "AND (DateDiff(day,Operate_ADVMain.EndDate,Operate_ADVDetail.PrevEndDate)< 0 OR Operate_ADVMain.EndDate IS NULL ) " _
        & "AND (Operate_ADVMain.Kind & 4) =4 AND Operate_SickInfo.OpDepCode = '" & mStr & "' " _
        & "AND DateDiff(day,getdate(),Operate_ADVDetail.PrevEndDate) <  " & txtDays
'    If chkGlass.Value = 1 Then
'        Sql = Sql & " AND m_Drug.Itemcode Like '" & gtydSysConfig.GlassCode & "%'"
'    Else
'        Sql = Sql & " AND m_Drug.Itemcode NOT Like '" & gtydSysConfig.GlassCode & "%'"
'    End If
    SQL = SQL & " ORDER BY RIGHT(Bedid,DataLength(Bedid)-CHARIndex('#',BedID))," _
            & "SickInfo.SkSerial,(Operate_ADVMain.Kind & 8),(Operate_ADVMain.Kind & 32)"
            ' 未停,审核,未结束,该科或其下级科,非自带药, 结束日期>记帐日期 记帐日期-当前日期 < 天
            '不包括结束的一天
    Set tmpRS = gDbObj.GetNewRs(SQL)
    Set AllGetDrugObj = Nothing
    If Not (tmpRS Is Nothing) Then
        If tmpRS.RecordCount >= 1 Then
        
            Set AllGetDrugObj = New clsAllGetDrug
            AllGetDrugObj.IsOP = True
            Index = 0
            Do Until tmpRS.EOF
                ADVKind = tmpRS("ADVKind").Value
                Baby = IIf((ADVKind And 2 ^ (4 - 1)) <> 0, True, False)
                OutDrug = IIf((ADVKind And 2 ^ (6 - 1)) <> 0, True, False)
                If TmpObj Is Nothing Then
                    Set TmpObj = New clsSickGetDrug
                    TmpObj.OpSerial = tmpRS!OpSerial
                    TmpObj.SkSerial = tmpRS!SkSerial
                    TmpObj.Name = tmpRS!Name
                    TmpObj.BedID = IIf(IsNull(tmpRS!BedID), "", tmpRS!BedID)
                    TmpObj.IsBaby = Baby
                    'TmpObj.OutDrug = OutDrug
                    
                    TmpObj.DcCode = IIf(IsNull(tmpRS!DcCode), "", tmpRS!DcCode)
                    TmpObj.DepCode = tmpRS!DepCode
                    TmpObj.RemFair = tmpRS!RemFair
                    If (tmpRS!Status And 8) Then
                        TmpObj.CanDeb = True
                    End If
                    AllGetDrugObj.Add TmpObj
                Else
                    If TmpObj.SkSerial <> tmpRS!SkSerial _
                        Or TmpObj.IsBaby <> Baby Then
                        Set TmpObj = New clsSickGetDrug
                        TmpObj.OpSerial = tmpRS!OpSerial
                        TmpObj.SkSerial = tmpRS!SkSerial
                        TmpObj.Name = tmpRS!Name
                        TmpObj.BedID = IIf(IsNull(tmpRS!BedID), "", tmpRS!BedID)
                        TmpObj.IsBaby = Baby
                        TmpObj.DcCode = IIf(IsNull(tmpRS!DcCode), "", tmpRS!DcCode)
                        TmpObj.DepCode = tmpRS!DepCode
                        TmpObj.RemFair = tmpRS!RemFair
                        AllGetDrugObj.Add TmpObj
                    End If
                End If
                TmpObj.IsOP = True
                ADVDetailKind = tmpRS("ADVDetailKind").Value
                If (ADVDetailKind And 2 ^ (4 - 1)) <> 0 Then '草药
                    Set GetDrugObj = TmpObj.Add(tmpRS!ADVSerial, tmpRS!Num, tmpRS!EndDate, _
                        tmpRS!CPrice, tmpRS!Gprice, tmpRS!BaseUnit, _
                        tmpRS!ADVFreqID, tmpRS!ADVUsID, tmpRS!PrevEndDate, tmpRS!Amount, _
                        "1", tmpRS!ItemName, tmpRS!ItemCode, _
                        hisDbByteToLng(tmpRS("Kind").Value), _
                        IIf((ADVKind And 1) = 0, True, False), tmpRS!BeginDate)
                Else
                    Set GetDrugObj = TmpObj.Add(tmpRS!ADVSerial, tmpRS!Num, tmpRS!EndDate, _
                        tmpRS!CPrice, tmpRS!Gprice, tmpRS!BaseUnit, _
                        tmpRS!ADVFreqID, tmpRS!ADVUsID, tmpRS!PrevEndDate, tmpRS!ModelAmount.Value, _
                        tmpRS!Model, tmpRS!ItemName, tmpRS!ItemCode, _
                        tmpRS("ADVKind").Value, _
                        IIf((ADVKind And 1) = 0, True, False), tmpRS!BeginDate)
                End If
                Call GetDrugObj.GetMount(txtDays)
                If GetDrugObj.Mount = 0 Then
                    TmpObj.RemoveByKey GetDrugObj.ADVSerial, GetDrugObj.Num '删除此项
                End If
                tmpRS.MoveNext
            Loop
        End If
    End If
    If Not (AllGetDrugObj Is Nothing) Then
        For Each TmpObj In AllGetDrugObj
            If TmpObj.Count = 0 Then
                AllGetDrugObj.Remove TmpObj.SkSerial & IIf(TmpObj.IsBaby, "1", "0")
            End If
        Next
    End If
        
            
End Sub