clssick.cls

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

                UpdateCondition:="SkID = '" & SkID & "'") Then
                GoTo errlbl
            End If
            If Not Update_m_SickRegInfoApd(HISDBdelete, _
                UpdateCondition:="SkID = '" & SkID & "'") Then
                GoTo errlbl
            End If
    End Select
    gdbobj.CNExe.CommitTrans
    Save = True
    Exit Function
errlbl:
    gdbobj.CNExe.RollbackTrans
End Function
Public Sub GetMedicine()
    If gdbobj.GetRs("SELECT * FROM SickMedicine WHERE SkSerial = '" & SkSerial & "'") = 1 Then
        Temperature = IIf(IsNull(gdbobj.Rs!Temperature), -0.001, gdbobj.Rs!Temperature)
        TendLevelID = IIf(IsNull(gdbobj.Rs!TendLevelID), "", gdbobj.Rs!TendLevelID)
        IllnessID = IIf(IsNull(gdbobj.Rs!IllnessID), "", gdbobj.Rs!IllnessID)
        DisID = IIf(IsNull(gdbobj.Rs!DisID), "", gdbobj.Rs!DisID)
        DisDes = IIf(IsNull(gdbobj.Rs!DisDes), "", gdbobj.Rs!DisDes)
    Else
        Temperature = -0.001
        TendLevelID = ""
        IllnessID = ""
        DisID = ""
        DisDes = ""
    End If
    
End Sub
Public Function InHosp() As Boolean
    Dim TmpStatus As Integer
    
    On Error GoTo errlbl
    
    gdbobj.CNExe.BeginTrans
    '已住院的更新前一次的最新标志
    If Num <> 0 Then
        If Not Update_SickInfo(HISDBUpdate, Status:=(mlngStatus And &HFFFFFFFD) Or 2, _
            UpdateCondition:=" SkSerial= '" & SkSerial & "'") Then
            
            GoTo errlbl
        End If
    End If
    TmpStatus = IIf(gSickPatientTypesObj.Item(PtID).CanDeb, 8, 0)
    TmpStatus = TmpStatus + IIf(gSickPatientTypesObj.Item(PtID).IsPub, 16, 0)
    TmpStatus = TmpStatus + IIf(gSickPatientTypesObj.Item(PtID).IsInSu, 32, 0)
    
    If Not Update_SickInfo(HISDbInsert, NewSkSerial, SkID, NewNum, DepCode, DcCode, BedID, InDate, _
        HdCode:=HdCode, Status:=TmpStatus) Then '住院信息
        GoTo errlbl
    End If
    'Wxa add 2000-09-08
    If Not Update_SickMedInfo(HISDbInsert, NewSkSerial, InCase, InWay, DisID, DisDes) Then
        GoTo errlbl
    End If

    '在转科表中插一条记录
    If Not Update_ChangePos(HISDbInsert, NewSkSerial, 1, InDate, TargetDepCode:=DepCode, TargetBedID:=BedID, _
        HdCode:=HdCode) Then
        GoTo errlbl
    End If
    If BedID <> "" Then
        If Not gdbobj.DBExec("UPDATE m_Bed Set Flag =flag |16,comment=null WHERE BedID = '" & BedID & "'") Then
            GoTo errlbl
        End If
    End If
    gdbobj.CNExe.CommitTrans
    Status = TmpStatus
    Num = Num + 1
    InHosp = True
    Exit Function
errlbl:
    gdbobj.CNExe.RollbackTrans
End Function

Public Function OutHosp() As Boolean
    Dim mInt As Integer
    Dim CurDate As String
    Dim TmpStatus As Integer

On Error GoTo errlbl
    CurDate = OutDate
    mInt = mfnGetNewMaxChangePos(SkSerial)
    gdbobj.CNExe.BeginTrans
    TmpStatus = (Status And &HFFFFFFFA) Or 1
    '在转科表中插一条记录，目标科和床位都为-2，以记录这笔业务
    If Not Update_ChangePos(HISDbInsert, SkSerial, mInt, CurDate, DepCode, BedID, _
        HdCode:=gtydSysConfig.HdCode) Then
        
        GoTo errlbl
    End If

    If Not Update_SickInfo(HISDBUpdate, OutDate:=CurDate, Status:=TmpStatus, _
        UpdateCondition:=" SkSerial = '" & SkSerial & "'") Then

        GoTo errlbl
    End If
    If BedID <> "" Then '释放床位
        If Not gdbobj.DBExec("UPDATE m_Bed Set Flag = flag & 239,comment=null " _
            & "WHERE BedID = '" & BedID & "'") Then
            GoTo errlbl
        End If
    End If
    'Wxa 2000-09-08
    If Not Update_SickMedInfo(HISDBUpdate, OutWay:=IIf(OutWay = "", Null, OutWay), _
        UpdateCondition:=" skserial = '" & SkSerial & "'") Then
        
        GoTo errlbl
    End If
    
    gdbobj.CNExe.CommitTrans
    Status = TmpStatus
    OutDate = CurDate
    OutHosp = True
    Exit Function
errlbl:
    gdbobj.CNExe.RollbackTrans

End Function
Public Function IsStopForADV() As Boolean
'长期医嘱停止
    Dim SQL As String
    
    If Me.OpSerial = "" Then
        SQL = "SELECT Count(*) AS NUM FROM ADVMain " _
                & "WHERE SkSerial = '" & SkSerial & "' AND (Flag & 1 )=1 AND (Flag & 4) = 4 " _
                & "AND (DateDiff(day,GetDate(),EndDate)>0 OR EndDate IS NULL)"
        If gdbobj.GetRs(SQL) = 1 Then
            If gdbobj.Rs!Num = 0 Then
                IsStopForADV = True
            End If
        End If
    Else
        SQL = "SELECT Count(*) AS NUM FROM Operate_ADVMain " _
                & "WHERE OpSerial = '" & OpSerial & "' AND (Kind & 1 )=1 AND (Kind & 4) = 4 " _
                & "AND (DateDiff(day,GetDate(),EndDate)>0 OR EndDate IS NULL)"
        If gdbobj.GetRs(SQL) = 1 Then
            If gdbobj.Rs!Num = 0 Then
                IsStopForADV = True
            End If
        End If
    End If
End Function
Public Function IsMarkForTempADV() As Boolean
'长期医嘱停止
    Dim SQL As String
    
    If Me.OpSerial = "" Then
        SQL = "SELECT Count(*) AS NUM FROM advMain INNER JOIN advDetail " _
            & "ON advMain.advserial=advDetail.advserial AND ADVMain.DepCode = '" & DepCode & "' " _
            & "where AdvMain.Flag & 1 =0 AND (AdvMain.Flag & 4) = 4 " _
            & "and PrevEndDate <> '3000-01-01 00:00:00' " _
            & "and advMain.SkSerial ='" & SkSerial & "'  AND AdvMain.Flag & 2 =0 " _
            & "AND (ADVDetail.SFlag & 1) =0"
    Else
        SQL = "SELECT Count(*) AS NUM FROM Operate_ADVMain INNER JOIN Operate_advDetail " _
            & "ON Operate_advMain.advserial=Operate_advDetail.advserial " _
            & "WHERE Operate_advMain.OpSerial = '" & OpSerial & "' " _
            & "AND (Operate_advMain.Kind & 1 )= 0 AND (Operate_advMain.Kind & 4) = 4 " _
            & "and PrevEndDate <> '3000-01-01 00:00:00' " _
            & "AND Operate_ADVMain.Kind & 2 =0 AND Operate_advDetail.Kind & 1 = 0"
    End If
'审核,临时，未删,未记帐.非自带药
    If gdbobj.GetRs(SQL) = 1 Then
        If gdbobj.Rs!Num = 0 Then
            IsMarkForTempADV = True
        End If
    End If
End Function
Public Function IsTranAsk() As Boolean
'长期医嘱停止
    Dim SQL As String
    
    SQL = "select Count(*) AS NUM FROM ChangePos " _
        & "WHERE SkSerial ='" & SkSerial & "'  AND Status & 1 =1"
'审核,临时，未删,未记帐.非自带药
    If gdbobj.GetRs(SQL) = 1 Then
        If gdbobj.Rs!Num = 0 Then
            IsTranAsk = True
        End If
    End If
End Function

Private Sub Class_Initialize()
    Marry = -32767
    mlngStatus = -1
    Temperature = -0.001
End Sub
Public Function CancelOutHosp() As Boolean
    Dim mInt As Integer
    Dim TmpStatus As Integer
    Dim tmprs As Recordset
    
On Error GoTo errlbl
    
    Set tmprs = gdbobj.GetNewRs("Select Max(ChangeNum) as Num FROM ChangePos where SkSerial ='" & SkSerial & "'")
    If Not IsNull(tmprs!Num) Then
        mInt = Val(tmprs!Num)
    End If
    gdbobj.CNExe.BeginTrans
    TmpStatus = (Status And &HFFFFFFFA)
    '作废转科表的最后一条记录
    If Not Update_ChangePos(HISDBUpdate, Status:=1, _
        UpdateCondition:="SkSerial ='" & SkSerial & "' AND ChangeNum = " & mInt) Then
        
        GoTo errlbl
    End If

    If Not Update_SickInfo(HISDBUpdate, OutDate:=Null, Status:=TmpStatus, _
        UpdateCondition:=" SkSerial = '" & SkSerial & "'") Then

        GoTo errlbl
    End If
    gdbobj.CNExe.CommitTrans
    Status = TmpStatus
    OutDate = ""
    CancelOutHosp = True

    Exit Function
errlbl:
    gdbobj.CNExe.RollbackTrans
End Function


Public Property Let SkSerialByQuery(ByVal vdata As String)
    Dim tmprs As Recordset
    
    If vdata = mstrSkSerial Then Exit Property
    mstrSkSerial = vdata
    If gdbobj.GetRs("SELECT m_SickRegInfo.*,m_SickRegInfoApd.*,m_Local.Des as LcDes " _
        & "FROM ((SickInfo INNER JOIN m_SickRegInfo ON SickInfo.SkID = m_SickRegInfo.SkID) " _
        & "INNER JOIN m_SickRegInfoApd ON m_SickRegInfo.SkID=m_SickRegInfoApd.SkID) " _
        & "LEFT JOIN m_Local ON m_SickRegInfoApd.lcID = m_Local.LcID " _
        & "WHERE SickInfo.SkSerial = '" & vdata & "'") = 1 Then
        
        mstrSkID = gdbobj.Rs!SkID
        Name = gdbobj.Rs!Name
        Brief = gdbobj.Rs!Brief
        Sex = IIf(IsNull(gdbobj.Rs!Sex), "", gdbobj.Rs!Sex)
        BirthDate = IIf(IsNull(gdbobj.Rs!BirthDate), "", gdbobj.Rs!BirthDate)
        IDCard = IIf(IsNull(gdbobj.Rs!IDCard), "", gdbobj.Rs!IDCard)
        Marry = IIf(IsNull(gdbobj.Rs!Marry), "", gdbobj.Rs!Marry)
        Country = gdbobj.Rs!Country
        Native = gdbobj.Rs!Native
        Contactor = IIf(IsNull(gdbobj.Rs!Contactor), "", gdbobj.Rs!Contactor)
        relation = IIf(IsNull(gdbobj.Rs!relation), "", gdbobj.Rs!relation)
        ContactorAddr = IIf(IsNull(gdbobj.Rs!ContactorAddr), "", gdbobj.Rs!ContactorAddr)
        unit = IIf(IsNull(gdbobj.Rs!unit), "", gdbobj.Rs!unit)
        LcID = IIf(IsNull(gdbobj.Rs!LcID), "", gdbobj.Rs!LcID)
        LcDes = IIf(IsNull(gdbobj.Rs!LcDes), "", gdbobj.Rs!LcDes)
        Profession = IIf(IsNull(gdbobj.Rs!Profession), "", gdbobj.Rs!Profession)
        Addr = IIf(IsNull(gdbobj.Rs!Addr), "", gdbobj.Rs!Addr)
        BirthAddr = IIf(IsNull(gdbobj.Rs!BirthAddr), "", gdbobj.Rs!BirthAddr)
        Tel = IIf(IsNull(gdbobj.Rs!Tel), "", gdbobj.Rs!Tel)
        Zip = IIf(IsNull(gdbobj.Rs!Zip), "", gdbobj.Rs!Zip)
        PtID = IIf(IsNull(gdbobj.Rs!PtID), "", gdbobj.Rs!PtID)
        IfRegInfo = True
        If gdbobj.GetRs("SELECT SickInfo.*,m_Bed.BedNum,m_Depart.DepName,m_Doctor.DcName" _
            & " FROM ((SickInfo INNER JOIN m_Depart ON SickInfo.DepCode = m_Depart.DepCode)" _
            & " LEFT JOIN m_Bed ON SickInfo.BedID = m_Bed.BedID) " _
            & " LEFT JOIN m_Doctor ON SickInfo.dcCode = m_Doctor.DcCode " _
            & " WHERE  SkSerial='" & vdata & "'") = 1 Then
            
            Num = gdbobj.Rs!Num
            DepCode = gdbobj.Rs!DepCode
            DepName = gdbobj.Rs!DepName
            DcCode = IIf(IsNull(gdbobj.Rs!DcCode), "", gdbobj.Rs!DcCode)
            DcName = IIf(IsNull(gdbobj.Rs!DcName), "", gdbobj.Rs!DcName)
            BedID = IIf(IsNull(gdbobj.Rs!BedID), "", gdbobj.Rs!BedID)
            BedNum = IIf(IsNull(gdbobj.Rs!BedNum), "", gdbobj.Rs!BedNum)
            InDate = gdbobj.Rs!InDate
            OutDate = IIf(IsNull(gdbobj.Rs!OutDate), "", gdbobj.Rs!OutDate)
            HdCode = IIf(IsNull(gdbobj.Rs!HdCode), "", gdbobj.Rs!HdCode)
            Fair = gdbobj.Rs!Fair
            PrePay = gdbobj.Rs!PrePay
            mlngStatus = gdbobj.Rs!Status