frmchangepasswd.frm

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

         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   2910
      TabIndex        =   13
      Top             =   690
      Width           =   840
   End
   Begin VB.Line Line1 
      BorderColor     =   &H80000010&
      Index           =   1
      X1              =   -60
      X2              =   6240
      Y1              =   3150
      Y2              =   3150
   End
   Begin VB.Label Label8 
      AutoSize        =   -1  'True
      Caption         =   "姓    名"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   2895
      TabIndex        =   10
      Top             =   150
      Width           =   840
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "就诊科别"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   45
      TabIndex        =   9
      Top             =   675
      Width           =   840
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "划价日期"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   0
      TabIndex        =   8
      Top             =   1320
      Width           =   840
   End
   Begin VB.Label Label6 
      AutoSize        =   -1  'True
      Caption         =   "--"
      Height          =   180
      Left            =   3195
      TabIndex        =   7
      Top             =   1320
      Width           =   180
   End
   Begin VB.Label Label7 
      AutoSize        =   -1  'True
      Caption         =   "病人ID"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   45
      TabIndex        =   6
      Top             =   135
      Width           =   630
   End
End
Attribute VB_Name = "frmFigureQuery"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Public Event Ack(ByVal Cdt As String)

Private OldName As String
Private OldDepart As String
Private WithEvents ComnHlp1 As frmInputHelp
Attribute ComnHlp1.VB_VarHelpID = -1

Private Sub cmdAck_Click()
    RaiseEvent Ack(MakeCdt())
    Unload Me
End Sub

Private Function MakeCdt() As String
    Dim HdCode As String
    Dim TmpStr As String
    
    Set gDBFldsObj = New clsDBFields
    
    gDBFldsObj.Add "HdCode", txtHandler, "", lmEquel
    gDBFldsObj.Add "PatientID", txtID, ""
    gDBFldsObj.Add "DepCode", txtDepart.Tag, "", lmlike
    gDBFldsObj.Add "RecipeDate", mskDate(0).Text, gstrMASK_INIT, lmGreatAndEquel
    gDBFldsObj.Add "RecipeDate", mskDate(1).Text & " 23:59:59", gstrMASK_INIT & " 23:59:59", lmLessAndEquel
    
    TmpStr = gDBFldsObj.MakeSelectSQL("")
    If Me.OptKind(1) Then
        TmpStr = IIf(TmpStr = "", "", TmpStr & " AND ") & " CancelHdCode IS NULL "
    End If
    If Me.OptKind(2) Then
        TmpStr = IIf(TmpStr = "", "", TmpStr & " AND ") & " CancelHdCode IS NOT NULL "
    End If
    If chkRev.Value = 1 Then
        TmpStr = IIf(TmpStr = "", "", TmpStr & " AND ") & " ActRevSerial IS NOT NULL "
    End If
    If chkDrug.Value = 1 Then
        TmpStr = IIf(TmpStr = "", "", TmpStr & " AND ") & " FetchDate IS NOT NULL "
    End If
'    Me.chkDrug
'    Me.chkAll
' 暂不管 收费、取药

'    '如果是取退操作，则限定为已取
'    If Not chkDrug.Enabled And chkDrug.Value = 1 Then
'        TmpStr = IIf(TmpStr = "", "", TmpStr & " AND ") & " (Status & 4) = 4 "
'    End If
'    '如果选中了全部复选框，则不限状态
'    If Me.chkAll <> 1 Then
'        If Me.chkDrug = 1 Then
'            TmpStr = IIf(TmpStr = "", "", TmpStr & " AND ") & " (Status & 4) = 4 "
'        Else
'            TmpStr = IIf(TmpStr = "", "", TmpStr & " AND ") & " (status & 4) = 0 "
'        End If
'        If Me.chkRev = 1 Then
'            TmpStr = IIf(TmpStr = "", "", TmpStr & " AND ") & " (status & 2) = 2 "
'        Else
'            TmpStr = IIf(TmpStr = "", "", TmpStr & " AND ") & " (status & 2) = 0 "
'        End If
'    End If
    MakeCdt = TmpStr
End Function

Private Sub cmdClose_Click()
    Unload Me
End Sub

Private Sub ComnHlp1_ResSelect(ByVal SelData As Variant, ByVal STag As String)
    Me.SetFocus
    Select Case STag
        Case "Depart"
            If TypeName(SelData) <> "Nothing" Then
                txtDepart.Tag = SelData(0)
                txtDepart = SelData(1)
            Else
                txtDepart.Tag = ""
                txtDepart = ""
            End If
        Case "Name"
            If TypeName(SelData) <> "Nothing" Then
                txtID = SelData(0)
                txtName = SelData(1)
            Else
                txtName = ""
            End If
    End Select
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        hisToCtl(Me).SetFocus
        KeyAscii = 0
    End If
End Sub

Private Sub Form_Load()
    Dim tmpRS As rdoResultset
    
    Call hisFormToCenter(Me, frmMain)
    hisFormClear Me
    txtHandler.Text = gtydSysConfig.HdCode
    mskDate(0).Text = gfnGetTime("yyyy-mm-dd")
    mskDate(1).Text = gfnGetTime("yyyy-mm-dd")
    Set ComnHlp1 = New frmInputHelp
    Set ComnHlp1.CN = gDbObj.CN
'
End Sub

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

Private Sub mskDate_LostFocus(Index As Integer)
    If mskDate(Index).ClipText = "" Then Exit Sub
    CheckDate mskDate(Index).Text
End Sub


Private Sub txtDepart_LostFocus()
    If txtDepart = "" Then
        txtDepart = ""
        Exit Sub
    End If
    If txtDepart <> OldDepart Or txtDepart = "" Then
        ComnHlp1.Sql = "SELECT m_Depart.DepCode,m_Depart.DepName FROM m_Depart" _
                & " WHERE m_Depart.Brief LIKE '##%' AND m_Depart.Kind & 4 = 0"
        ComnHlp1.InitPut = txtDepart.Text
        ComnHlp1.FormatHead = "科  别  编  码|科    别    名    称   "
        ComnHlp1.WidthRate = 1
        ComnHlp1.ParmTag = "Depart"
        ComnHlp1.ShowHelp vbModal
    End If

End Sub


Private Sub txtName_GotFocus()
    OldName = txtName
End Sub

Private Sub txtName_LostFocus()
    If txtName = "" Then
        Exit Sub
    End If
    If txtName <> OldName Then
        ComnHlp1.Sql = "SELECT PatientID,Name FROM Open_m_patientbaseinfo WHERE brief LIKE '##%'"
        ComnHlp1.InitPut = txtName.Text
        ComnHlp1.FormatHead = "病 人 编 码|病 人 姓 名"
        ComnHlp1.WidthRate = 1
        ComnHlp1.ParmTag = "Name"
        ComnHlp1.ShowHelp vbModal
    End If
End Sub