clssickop.cls

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

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsSickOP"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Option Explicit

Dim mStrID As String

Public Id As String
Public Name As String
Public BirthDate As String
Public PtID As String
Public PtDes As String
Public fbPtID As String
Public fbPtDes As String
Public Sex As String
Public PatientID As String
Public Nation As String
Public IDCardNO As String
Public Worker As String
Public Tel As String
Public Post As String
Public Address As String

'Public RegiDep As clsDeparts
Public RegiDate As String
Public DepCode As String
Public DepName As String
Public dccode As String
Public DcName As String
Private Flag As Integer
Public INSID As String
Public Property Get IsInpati() As Boolean
    IsInpati = IIf((Flag And 2) = 2, True, False)
End Property
Public Property Get AgeDes() As String
    If BirthDate <> "" Then
        AgeDes = DateDiff("y", BirthDate, gfnGetTime())
    End If
    
    
End Property



Public Property Let SkIDByBaseQuery(ByVal vdata As String)
    Dim Rs As Recordset
    Dim RsApd As Recordset
    PatientID = vdata
    Set Rs = gdbobj.GetNewRs("SELECT Name,Open_m_PatientBaseInfo.PtID,PtDes,sex,BirthDate, " _
          & "Open_m_PatientBaseInfo.Flag FROM Open_m_PatientBaseInfo LEFT JOIN Open_m_PatientType " _
          & " ON Open_m_PatientBaseInfo.PtID= Open_m_PatientType.PtID " _
          & " WHERE Open_m_PatientBaseInfo.PatientID = '" & vdata & "'")
    If Rs.RecordCount = 1 Then
        Me.Id = vdata
        Sex = IIf(IsNull(Rs!Sex), "", Rs!Sex)
        BirthDate = IIf(IsNull(Rs!BirthDate), "", Rs!BirthDate)
        Name = IIf(IsNull(Rs!Name), "", Rs!Name)
        PtID = IIf(IsNull(Rs!PtID), "", Rs!PtID)
        PtDes = IIf(IsNull(Rs!PtDes), "", Rs!PtDes)
        Flag = Rs!Flag
    Else
        Me.Id = ""
        Name = ""
        PtID = gPatientTypesObj.DeFaultID
        PtDes = gPatientTypesObj.DeFaultDes
    End If
    
    Set RsApd = gdbobj.GetNewRs("SELECT iccard,nation,idcardno,worker,tel,post,address,open_m_PatientBaseInfoApd.ptid,ptdes " _
          & " FROM open_m_PatientBaseInfoApd LEFT JOIN open_m_PatientType " _
          & " ON open_m_PatientBaseInfoapd.PtID= open_m_PatientType.PtID " _
          & " WHERE open_m_PatientBaseInfoapd.PatientID = '" & vdata & "'")
    If Not RsApd Is Nothing Then
        If RsApd.RecordCount = 1 Then
            Nation = IIf(IsNull(RsApd!Nation), "", RsApd!Nation)
            IDCardNO = IIf(IsNull(RsApd!IDCardNO), "", RsApd!IDCardNO)
            Worker = IIf(IsNull(RsApd!Worker), "", RsApd!Worker)
            Tel = IIf(IsNull(RsApd!Tel), "", RsApd!Tel)
            Post = IIf(IsNull(RsApd!Post), "", RsApd!Post)
            Address = IIf(IsNull(RsApd!Address), "", RsApd!Address)
            fbPtID = IIf(IsNull(Rs!PtID), "", Rs!PtID)
            fbPtDes = IIf(IsNull(Rs!PtDes), "", Rs!PtDes)
            Me.INSID = IIf(IsNull(RsApd!IcCard), "", RsApd!IcCard)
        Else
            Nation = ""
            IDCardNO = ""
            Worker = ""
            Tel = ""
            Post = ""
            Address = ""
            fbPtID = ""
            fbPtDes = ""
            INSID = ""
        End If
    End If
          
End Property


Public Property Get IfRegi() As Boolean

    
    If IsInpati Then
        IfRegi = True
        Exit Property
    End If
    If gdbobj.GetRs("SELECT RegiDate,Open_Regi.DepCode,Open_Regi.DcCode,m_Depart.DepName,m_Doctor.DcName " _
        & "FROM (Open_Regi INNER JOIN m_Depart ON Open_regi.DepCode = m_Depart.DepCode) " _
        & "LEFT JOIN m_Doctor ON Open_regi.DcCode = m_Doctor.DcCode WHERE PatientId = '" & Id & "'" _
        & " AND RegiDate = (SELECT Max(RegiDate) FROM Open_Regi WHERE PatientId = '" & Id & "' AND CancelDate IS NULL)") >= 1 Then
        
        If DateDiff("d", gdbobj.Rs!RegiDate, gfnGetTime) <= gtydSysConfig.LegalDaysForRegi + 1 _
            Or gtydSysConfig.LegalDaysForRegi = -1 Then
            dccode = IIf(IsNull(gdbobj.Rs!dccode), "", gdbobj.Rs!dccode)
            DcName = IIf(IsNull(gdbobj.Rs!DcName), "", gdbobj.Rs!DcName)
            DepName = gdbobj.Rs!DepName
            DepCode = gdbobj.Rs!DepCode
            IfRegi = True
            Exit Property
        End If
    End If
End Property

Public Function MPrint(ByVal SheetID As String, ByVal ActRevSerial As String) As Boolean
    Dim mPg As clsPage
    Dim FairObj As clsItemFairs
    Dim I As Integer, j As Integer
    Dim sql As String
    Dim capstr As String
    Dim tmprs As Recordset
'On Error GoTo errlbl
    Set mPg = New clsPage
    Set mPg.gdbobj = gdbobj
    If mPg.ReadFromDB("Open_RevSheet") Then
        Set FairObj = New clsItemFairs
        FairObj.Make "Open_GetRevCatiFair '" & ActRevSerial & "'"
        Set tmprs = gdbobj.GetNewRs("select depname,dcname from open_actreceivesub " _
                                & " inner join m_depart on m_depart.depcode=open_actreceivesub.DEPCODE " _
                                & " inner join m_doctor on m_doctor.dcCode=open_actreceivesub.DcCODE " _
                                & "where actrevserial='" & ActRevSerial & "' ")
        If tmprs.RecordCount > 0 Then
            FairObj.DepName = IIf(IsNull(tmprs(0)), "", tmprs(0))
            FairObj.DcName = IIf(IsNull(tmprs(1)), "", tmprs(1))
            
        End If
        mPg.IDValue("INSID") = Me.INSID
        mPg.IDValue("SheetID") = SheetID
        mPg.IDValue("PatientID") = PatientID
        mPg.IDValue("Name") = Name
        mPg.IDValue("RevDate") = gfnGetTime("yyyy-mm-dd")
        mPg.IDValue("RevYear") = Format(gfnGetTime("yyyy-mm-dd"), "yyyy")
        mPg.IDValue("RevMonth") = Format(gfnGetTime("yyyy-mm-dd"), "mm")
        mPg.IDValue("RevDay") = Format(gfnGetTime("yyyy-mm-dd"), "dd")
        mPg.IDValue("HdName") = gtydSysConfig.HdName
        mPg.IDValue("HdCode") = gtydSysConfig.hdCode
        mPg.IDValue("PtType") = gPatientTypesObj(PtID).Des
        mPg.IDValue("DepName") = FairObj.DepName
        mPg.IDValue("DcName") = FairObj.DcName
        mPg.IDValue("HospName") = gtydSysConfig.HospName
        
        If gPatientTypesObj(PtID).Label Then
            If Not mPg.IDObject("IfLabel") Is Nothing Then mPg.IDValue("IfLabel") = mPg.IDObject("IfLabel").Str
        Else
            mPg.IDValue("IfLabel") = ""
        End If
        capstr = Format(FairObj.InFair * 100, "##################")
        For I = 0 To Len(capstr) - 1
            mPg.IDValue("FairCap" & Format(I, "0")) = GetCap(mID(capstr, Len(capstr) - I, 1))
        Next I
        capstr = Format(FairObj.fair * 100, "##################")
        For I = 0 To Len(capstr) - 1
            mPg.IDValue("TFairCap" & Format(I, "0")) = GetCap(mID(capstr, Len(capstr) - I, 1))
        Next I
            
        capstr = Format((FairObj.fair - FairObj.InFair) * 100, "##################")
        For I = 0 To Len(capstr) - 1
            mPg.IDValue("RateFairCap" & Format(I, "0")) = GetCap(mID(capstr, Len(capstr) - I, 1))
        Next I
            
        mPg.IDValue("TotalFairCap") = hisGetMoneyCap(FairObj.InFair)
        mPg.IDValue("TotalFair") = Format(FairObj.InFair, gstrMONEY_FORMAT)
        mPg.IDValue("TTairCap") = hisGetMoneyCap(FairObj.fair)
        mPg.IDValue("TFair") = Format(FairObj.fair, gstrMONEY_FORMAT)
        mPg.IDValue("RateFairCap") = hisGetMoneyCap(FairObj.fair - FairObj.InFair)
        mPg.IDValue("RateFair") = Format(FairObj.fair - FairObj.InFair, gstrMONEY_FORMAT)
        I = 1
        Do
            If mPg.IDObject("Cancel" & I) Is Nothing Then Exit Do
            mPg.IDValue("Cancel" & I) = "作废"
            I = I + 1
        Loop
        j = 1
        
        For I = 1 To FairObj.Count
            If mPg.IDObject(FairObj.Item(I).Id) Is Nothing Then
                mPg.IDValue("AddItemDes" & j) = FairObj.Item(I).Des
                mPg.IDValue("AddItemFair" & j) = FairObj.Item(I).InFair
                j = j + 1
            Else
                mPg.IDValue(FairObj.Item(I).Id) = Format(FairObj.Item(I).InFair, gstrMONEY_FORMAT)
            End If
            mPg.IDValue("ItemDes" & I) = FairObj.Item(I).Des
            mPg.IDValue("ItemFair" & I) = Format(FairObj.Item(I).InFair, gstrMONEY_FORMAT)
            mPg.IDValue("Cancel" & I) = ""
        Next I
'隆化新增2002-07-07
        
        FairObj.Make "Open_GetRevCatiFairM '" & ActRevSerial & "'"
        If FairObj.Count > 0 Then
            j = 1
            Do
                If mPg.IDObject("Cancel" & j) Is Nothing Then Exit Do
                mPg.IDValue("Cancel" & j) = "作废"
                j = j + 1
            Loop
            j = 1
            Do
                If mPg.IDObject("Itemdes" & j) Is Nothing Then Exit Do
                mPg.IDValue("itemdes" & j) = ""
                mPg.IDValue("ItemFair" & j) = ""
                j = j + 1
            Loop
        End If
        j = 1
        For I = 1 To FairObj.Count
            mPg.IDValue("ItemDes" & I) = FairObj.Item(I).Des
            mPg.IDValue("ItemFair" & I) = Format(FairObj.Item(I).InFair, gstrMONEY_FORMAT)
            mPg.IDValue("Cancel" & I) = ""
        Next I
        
        If gtydSysConfig.Status <> 0 Then
            mPg.RPrint
        Else
           mPg.PreView vbModal
        End If
        MPrint = True
    End If
errlbl:
End Function

Public Function MPrint1(ByVal SheetID As String, ByVal ActRevSerial As String, recnum As Integer, Optional oldsheetid As String = "") As Boolean
    Dim mPg As clsPage
    Dim FairObj As clsItemFairs
    Dim I As Integer, j As Integer, recCount As Integer, Num As Integer, Capnum As Integer
    Dim capstr As String
    Dim tmprs As Recordset
    Dim sql As String
    
'On Error GoTo errlbl
    If gdbobj.GetRs("select count(*) from open_actReceiveSub where actrevserial='" & ActRevSerial & "'") > 0 Then
        recCount = gdbobj.Rs(0)
    End If