frmfairmarkdrugcondition.frm

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

VERSION 5.00
Object = "{AA0D501B-0C16-11D4-8531-00E098160F52}#4.0#0"; "COMNBUTTONS.OCX"
Begin VB.Form frmFairMarkDrugCondition 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "住院病人取药"
   ClientHeight    =   3810
   ClientLeft      =   3360
   ClientTop       =   2670
   ClientWidth     =   4140
   Icon            =   "frmFairMarkDrugCondition.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   3810
   ScaleWidth      =   4140
   Begin VB.CheckBox chkOut 
      Caption         =   "已出院病人"
      Height          =   705
      Left            =   3030
      TabIndex        =   2
      Top             =   1740
      Width           =   915
   End
   Begin VB.ListBox lst 
      Height          =   3660
      Left            =   60
      TabIndex        =   1
      Top             =   60
      Width           =   2835
   End
   Begin ComnButtons.ButtonGroup btg 
      Height          =   1305
      Left            =   2880
      TabIndex        =   0
      Top             =   60
      Width           =   1305
      _ExtentX        =   2302
      _ExtentY        =   2302
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BackColor       =   -2147483638
      ButtonCount     =   3
      ButtonCaption   =   "&A.确定	&C.取消	&E.关闭"
      KeyEnabled      =   "1#1#1#"
   End
End
Attribute VB_Name = "frmFairMarkDrugCondition"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private AllGetDrugObj As clsAllFairMarkDrug
Private WithEvents DebInfoObj As frmDebInfo
Attribute DebInfoObj.VB_VarHelpID = -1
Private mSex(2) As String
Private Sub InitForm()
    Dim SQL As String
    Dim PNode As Node
    Dim i As Integer
    Dim tmrs As Recordset
    hisFormClear Me
    If gdbobj.GetRs("select Code,value from f_GenlCode where kindID='Sex' order By Code") > 0 Then
        i = 0
        Do While Not gdbobj.Rs.EOF
            Select Case gdbobj.Rs(1)
            Case "男"
                mSex(i) = "男"
                i = i + 1
            Case "女"
                mSex(i) = "女"
                i = i + 1
            End Select
            gdbobj.Rs.MoveNext
        Loop
    End If
    lst.Clear
    SQL = "select DepCode,DepName from m_depart where flag & 4=4"
    Set tmrs = gdbobj.GetNewRs(SQL)
    If Not tmrs Is Nothing Then
        Do While Not tmrs.EOF
            lst.AddItem tmrs!DepCode & " " & tmrs!DepName
            tmrs.MoveNext
        Loop
        init
    End If
End Sub
Public Sub init()
End Sub

Private Sub btg_Click(ByVal WhichB As Integer)
    Select Case WhichB
        Case 0
            If lst.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.Count = 0 Then
                    MsgBox "无满足条件的项目", vbInformation
                    Exit Sub
                End If
                Set frmDrugGetByDepart.AllGetDrugObj = AllGetDrugObj
                frmDrugGetByDepart.DepName = Right(lst.Text, Len(lst.Text) - InStr(lst.Text, " "))
                frmDrugGetByDepart.Show
                Unload Me
        Case 1
            init
        Case 2
            Unload Me
    End Select
End Sub


Private Sub Form_Load()
    hisFormToCenter Me, frmMain
    InitForm
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set frmGetDrugCondition = Nothing
End Sub

Private Sub GetData()
    Dim tmpObj As clsFairMarkDrug, Index As Integer, GetDrugObj As clsFairMarkDrugSub
    Dim DepCode As String
    Dim tmprs As Recordset
    Dim i As Integer, IsBaby As Boolean
    Dim SQL As String
    
    DepCode = left(lst.Text, InStr(lst.Text, " ") - 1)
    
    SQL = "SELECT SickInfo.SkSerial,SickInfo.BedID,m_SickRegInfo.Name," _
            & "FairMarkMain.markSerial,FairMarksub.Num,FairMarkMain.DcCode,FairMarkMain.DepCode," _
            & "Fairmarksub.ItemCode,fairmarksub.Amount-COALESCE(BackAmount,0) as amount," _
            & "(SickInfo.PrePay -SickInfo.Fair) as 'RemFair'," _
            & "m_Drug.ItemName,m_Drug.Model,m_Drug.Flag as 'DFlag',fairmarksub.Gprice," _
            & "fairmarksub.Cprice,fairmarksub.Unit,Fairmarkmain.flag,SickInfo.Status,fairmarksub.factor," _
            & "FairmarkMain.markdate,m_SickRegInfo.sex,fairmarksub.Fair,fairmarksub.InFair,fairmarksub.Gmoney,AFair,batchid " _
            & "FROM (FairmarkMain INNER JOIN FairmarkSub ON Fairmarkmain.markSerial = fairmarksub.markSerial " _
            & " AND fairmarksub.dscode is null) " _
            & "left JOIN (select markserial,num,sum(backAmount) as BackAmount from FairMarkBack " _
            & "   gruop by markserial,num ) Back ON Fairmarksub.Markserial = Back.markserial and " _
            & " fairmarksub.num=back.num " _
            & "INNER JOIN m_Drug ON Fairmarksub.ItemCode = m_Drug.ItemCode " _
            & "INNER JOIN SickInfo ON FairmarkMain.SkSerial = SickInfo.SkSerial and " & IIf(chkOut.value = 0, "SickInfo.Status & 1 =0 ", "SickInfo.Status & 1 =1 ") _
            & "INNER JOIN m_SickRegInfo ON SickInfo.SkID = m_SickRegInfo.SkID " _
            & "left JOIN SickArrear ON Fairmarkmain.Skserial = sickarrear.skserial " _
            & "WHERE  fairmarkmain.depcode like '" & DepCode & "%' and amount>0 and fairmarkmain.flag & 4=0 " _
            & gfnMakeLimit(gtydSysConfig.ItemCode, "m_Drug.ItemCode") _
            & " ORDER BY SickInfo.BedID"
            ' 未停,审核,未结束,该科或其下级科,非自带药, 结束日期>记帐日期 记帐日期-当前日期 < 天
            '不包括结束的一天
    Set tmprs = gdbobj.GetNewRs(SQL)
    If tmprs Is Nothing Then
        SQL = "SELECT SickInfo.SkSerial,SickInfo.BedID,m_SickRegInfo.Name," _
                & "FairMarkMain.markSerial,FairMarksub.Num,FairMarkMain.DcCode,FairMarkMain.DepCode," _
                & "Fairmarksub.ItemCode,fairmarksub.Amount-COALESCE(BackAmount,0) as amount," _
                & "(SickInfo.PrePay -SickInfo.Fair) as 'RemFair'," _
                & "m_Drug.ItemName,m_Drug.Model,m_Drug.Flag as 'DFlag',fairmarksub.Gprice," _
                & "fairmarksub.Cprice,fairmarksub.Unit,Fairmarkmain.flag,SickInfo.Status,fairmarksub.factor," _
                & "FairmarkMain.markdate,m_SickRegInfo.sex,fairmarksub.Fair,fairmarksub.InFair,fairmarksub.Gmoney,0 as AFair,batchid " _
                & "FROM (FairmarkMain INNER JOIN FairmarkSub ON Fairmarkmain.markSerial = fairmarksub.markSerial " _
                & " AND fairmarksub.dscode is null ) " _
                & "left JOIN (select markserial,num,sum(backAmount) as BackAmount from FairMarkBack " _
                & "   group by markserial,num ) Back ON Fairmarksub.Markserial = Back.markserial and " _
                & " fairmarksub.num=back.num " _
                & "INNER JOIN m_Drug ON Fairmarksub.ItemCode = m_Drug.ItemCode " _
                & "INNER JOIN SickInfo ON FairmarkMain.SkSerial = SickInfo.SkSerial and " & IIf(chkOut.value = 0, "SickInfo.Status & 1 =0 ", "SickInfo.Status & 1 =1 ") _
                & "INNER JOIN m_SickRegInfo ON SickInfo.SkID = m_SickRegInfo.SkID " _
                & "WHERE  fairmarkmain.depcode like '" & DepCode & "%' and  amount-COALESCE(BackAmount,0)>0 and fairmarkmain.flag & 4=0 " _
                & gfnMakeLimit(gtydSysConfig.ItemCode, "m_Drug.ItemCode") _
                & " ORDER BY SickInfo.BedID"
        
        Set tmprs = gdbobj.GetNewRs(SQL)
    End If
    Set AllGetDrugObj = New clsAllFairMarkDrug
    If Not (tmprs Is Nothing) Then
        If tmprs.RecordCount >= 1 Then
        
            Index = 0
            Do Until tmprs.EOF
                If tmprs!Amount > 0 Then
                    IsBaby = IIf((tmprs!Flag And 2) = 2, True, False)
                    Set tmpObj = AllGetDrugObj.ItemBySick(tmprs!SkSerial, IsBaby)
                    If tmpObj Is Nothing Then
                        Set tmpObj = New clsFairMarkDrug
                        tmpObj.SkSerial = tmprs!SkSerial
                        tmpObj.Name = tmprs!Name
                        tmpObj.BedID = IIf(IsNull(tmprs!BedID), "", tmprs!BedID)
                        tmpObj.IsBaby = IsBaby
                        tmpObj.DepCode = tmprs!DepCode
                        tmpObj.DcCode = IIf(IsNull(tmprs!DcCode), "", tmprs!DcCode)
                        tmpObj.RemFair = tmprs!RemFair
                        tmpObj.afair = IIf(IsNull(tmprs!afair), 0, tmprs!afair)
                        tmpObj.Sex = IIf(IsNull(tmprs!Sex), "男", mSex(tmprs!Sex))
                        If (tmprs!Status And 8) Then
                            tmpObj.CanDeb = True
                        End If
    
                        AllGetDrugObj.Add tmpObj
                    End If
                    
                    Set GetDrugObj = tmpObj.Add(tmprs!MarkSerial, tmprs!Num, tmprs!MarkDate, _
                            tmprs!Cprice, tmprs!gprice, tmprs!model, tmprs!unit, _
                            tmprs!ItemCode, tmprs!ItemName, tmprs!Amount, tmprs!Fair, tmprs!InFair, _
                            tmprs!gmoney, tmprs!Factor, tmprs!Flag, tmprs!batchid)
                End If
                tmprs.MoveNext
            Loop
        Else
            
        End If
    End If
End Sub