frmfecthlist.frm

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

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmFecthList 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "取药病人列表"
   ClientHeight    =   5355
   ClientLeft      =   120
   ClientTop       =   1890
   ClientWidth     =   2835
   Icon            =   "frmFecthList.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   Picture         =   "frmFecthList.frx":030A
   ScaleHeight     =   5355
   ScaleWidth      =   2835
   Begin VB.Timer Timer1 
      Interval        =   30000
      Left            =   1140
      Top             =   60
   End
   Begin VB.PictureBox Picture1 
      BackColor       =   &H00000000&
      Height          =   5085
      Left            =   150
      ScaleHeight     =   5025
      ScaleWidth      =   2475
      TabIndex        =   0
      Top             =   150
      Width           =   2535
      Begin MSComctlLib.ImageList ImageList1 
         Left            =   2070
         Top             =   2430
         _ExtentX        =   1005
         _ExtentY        =   1005
         BackColor       =   -2147483643
         ImageWidth      =   16
         ImageHeight     =   16
         MaskColor       =   12632256
         _Version        =   393216
         BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
            NumListImages   =   2
            BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "frmFecthList.frx":1276
               Key             =   ""
            EndProperty
            BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "frmFecthList.frx":1592
               Key             =   ""
            EndProperty
         EndProperty
      End
      Begin MSComctlLib.TreeView tvfecth 
         Height          =   5025
         Left            =   0
         TabIndex        =   1
         Top             =   0
         Width           =   2475
         _ExtentX        =   4366
         _ExtentY        =   8864
         _Version        =   393217
         LabelEdit       =   1
         Style           =   7
         Appearance      =   1
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
      End
   End
End
Attribute VB_Name = "frmFecthList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public closeflag As Boolean
Public Sub getList()
   Dim SQL As String
   Dim jzrq As String
   jzrq = Format(Date - 5, "yymmdd")
   SQL = "SELECT open_m_PatientBaseInfo.PatientID,open_m_PatientBaseInfo.Name " _
        & "FROM ((Open_ActReceiveMain INNER JOIN Open_ActReceiveSub on " _
        & "Open_ActReceiveMain.ActRevSerial =Open_ActReceiveSub.ActRevSerial) " _
        & "INNER JOIN Open_ActReceiveSubItem ON Open_ActReceiveSub.ActRevSerial =Open_ActReceiveSubItem.ActRevSerial " _
        & "AND  Open_ActReceiveSub.recipeNum =Open_ActReceiveSubItem.RecipeNum) " _
        & "LEFT JOIN Open_m_PatientBaseInfo ON open_m_PatientBaseInfo.PatientID=Open_ActReceiveMain.PatientID " _
        & " WHERE Open_ActReceiveSub.Status & 3 =0 and Open_ActReceiveSub.fair>0 and  RecentFetchDate is null " _
        & "and DateDiff(Day,recentDate,GetDate())<=1 "
    If gtydSysConfig.ConFigureRev = False Then
        SQL = SQL & " AND Open_ActReceiveSub.DsCode ='" & gtydSysConfig.DepCode & "'"
'    Else
'        GType = gfnGetHouseType
'        SQL = SQL & " AND ((Open_ActReceiveSub.Status & 12 =0 AND " & (GType And 1) & " = 1)" _
'            & " OR (Open_ActReceiveSub.Status & 12 =4 AND " & (GType And 2) & " = 2)" _
'            & " OR (Open_ActReceiveSub.Status & 12 =8 AND " & (GType And 4) & " = 4))"
    End If
    SQL = SQL & gfnMakeLimit(gtydSysConfig.ItemCode, "Open_ActReceiveSubItem.ItemCode") _
        & " and Open_ActReceiveMain.ActRevSerial>'" & jzrq & "' "
    SQL = SQL & "group By open_m_PatientBaseInfo.PatientID,open_m_PatientBaseInfo.Name "
    tvfecth.Nodes.Clear
    If gDbObj.GetRs(SQL) > 0 Then
    
        Do While Not gDbObj.Rs.EOF
            tvfecth.Nodes.Add , , "D" & gDbObj.Rs(0), gDbObj.Rs(0) & " " & gDbObj.Rs(1)
            gDbObj.Rs.MoveNext
        Loop
    End If
End Sub
Private Sub Form_Load()
    getList
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If Not closeflag Then
        Cancel = 1
        Exit Sub
    End If
    Set frmFecthList = Nothing
    
End Sub

Private Sub Timer1_Timer()
    getList

End Sub

Private Sub tvfecth_DblClick()
    If tvfecth.Nodes.Count = 0 Then Exit Sub
    On Error GoTo tvErr
    frmFetchBus.txtID = Right(tvfecth.SelectedItem.key, Len(tvfecth.SelectedItem.key) - 1)
    frmFetchBus.txtID_LostFocus
    frmFetchBus.spd.SetFocus
tvErr:
End Sub

Private Sub tvfecth_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        tvfecth_DblClick
    End If
End Sub

Private Sub tvfecth_NodeClick(ByVal Node As msComctlLib.Node)
    frmFetchBus.mID = ""
'    frmFetchBus.txtID_LostFocus
End Sub