modprvpublic.bas

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

                    If Not IsNull(gDbObj.Rs!Value) Then
                        gtydSysConfig.LegalDaysForRegi = IIf(gDbObj.Rs!Value = "", 0, Val(gDbObj.Rs!Value))
                    End If
                Case "defaultpatientid"
                    If Not IsNull(gDbObj.Rs!Value) Then
                        gtydSysConfig.DeFaultPatientID = IIf(gDbObj.Rs!Value = "1", True, False)
                    End If
                    
                Case "cankeepbeyondfair"
                    If Not IsNull(gDbObj.Rs!Value) Then
                        gtydSysConfig.CanKeepBeyondFair = IIf(gDbObj.Rs!Value = "1", True, False)
                    Else
                        gtydSysConfig.CanKeepBeyondFair = False
                    End If
                Case "deblimit"
                    If Not IsNull(gDbObj.Rs!Value) Then
                        gtydSysConfig.DebLimit = Val(gDbObj.Rs!Value)
                    End If
                Case "configurerev"
                    If Not IsNull(gDbObj.Rs!Value) Then
                        gtydSysConfig.ConFigureRev = IIf(gDbObj.Rs!Value = "1", True, False)
                    End If
                Case "hospname"
                    If Not IsNull(gDbObj.Rs!Value) Then
                        gtydSysConfig.HospName = gDbObj.Rs!Value
                    End If
                Case "opdepcode"
                    If Not IsNull(gDbObj.Rs!Value) Then
                        gtydSysConfig.OpDepCode = values
                    End If
                Case "status"
                    If Not IsNull(gDbObj.Rs!Value) Then
                        gtydSysConfig.Status = gDbObj.Rs!Value
                    End If
            End Select
            gDbObj.Rs.MoveNext
        Loop
    End If
'    gtydSysConfig.HdCode = "1111"
'    gtydSysConfig.DrugDepCode = "3"
End Sub





Public Function gfnGetMount(PrevMarkDate As String, ByVal Days As Integer, _
                            ByVal EndDate As String, ByVal TFreqID As String, _
                            ByVal ModelAmount As Single, _
                            ByVal UnitModelAmount As Single, _
                            ByVal UpMode As Integer, _
                            ByVal IsTemp As Boolean) As Integer   '每次规格计值量,包装单位规格数  '进位方式  0 ---次

    Dim ADVExp As String, Cnt As Integer
    Dim TotalModelAmount As Single
    Dim M As Integer, N As Integer, i As Integer
    Dim VH As Integer, VM As Integer, TmpInt As Integer
    Dim TimeType As Integer '0-- d 1 ---h
    Dim Pos1 As Long, Pos2 As Long, TmpStr As String, TmpTime As String
    Dim TimeWidth As Long  '以天为单位
    Dim OLDPrevMarkDate As String
    Dim TEndDate As String
    
    'd[h]#m/n#hh:mm,hh:mm,...
    
    OLDPrevMarkDate = PrevMarkDate
    ADVExp = gADVFreqsObj(TFreqID).Exp
    If UnitModelAmount = 0 Then UnitModelAmount = 1
    
    If IsTemp Then  '临时医嘱
        Cnt = 1
        PrevMarkDate = "3000-01-01 00:00:00"
    Else
        ADVExp = gADVFreqsObj(TFreqID).Exp
        If EndDate = "" Then
            TimeWidth = DateDiff("d", PrevMarkDate, gfnGetTime) + Days
        Else
            If DateDiff("d", gfnGetTime, EndDate) < Days Then
                TimeWidth = DateDiff("d", PrevMarkDate, gfnGetTime) + _
                    DateDiff("d", gfnGetTime, EndDate)
            Else
                TimeWidth = DateDiff("d", PrevMarkDate, gfnGetTime) + Days
            End If
        End If
        '拆分串
        TimeType = IIf(StrComp(Left(ADVExp, 1), "d", vbTextCompare) = 0, 0, 1)
        Pos1 = InStr(ADVExp, "#")
        Pos2 = InStr(Pos1 + 1, ADVExp, "/")
        N = Val(mID(ADVExp, Pos1 + 1, Pos2 - Pos1 - 1))
        Pos1 = InStr(Pos2 + 1, ADVExp, "#")
        If Pos1 <> 0 Then
            M = Val(mID(ADVExp, Pos2 + 1, Pos1 - Pos2 - 1))
        Else
            M = Val(mID(ADVExp, Pos2 + 1, Len(ADVExp)))
        End If
        '拆分串结束
        
        If TimeType = 0 Then  'd天
            If M = 1 Then  '1天 N 次
                Cnt = N * TimeWidth
                PrevMarkDate = DateAdd("d", TimeWidth, PrevMarkDate)
            Else  'M天N次 m<>1
                If M > TimeWidth Then
                    Cnt = N
                    PrevMarkDate = DateAdd("d", M, PrevMarkDate)
                Else
                    Cnt = gfnUpINT(TimeWidth / M) * N
                    PrevMarkDate = DateAdd("d", M * gfnUpINT(TimeWidth / M), PrevMarkDate)
                End If
            End If
        Else '小时
            If M = 1 Then
                Cnt = TimeWidth * N * 24
                PrevMarkDate = DateAdd("d", TimeWidth, PrevMarkDate)
            Else
                Cnt = gfnUpINT(TimeWidth * 24 / M) * N
                PrevMarkDate = DateAdd("d", TimeWidth, PrevMarkDate)
            End If
        End If
    End If
    If IsTemp Then
        gfnGetMount = gfnUpINT(ModelAmount / UnitModelAmount) * Cnt
    Else
        Select Case UpMode
            Case 0 '次
                gfnGetMount = gfnUpINT(ModelAmount / UnitModelAmount) * Cnt
            Case 1 '天   -- d N Mod M =0 才允许 -- h (N/M) *24
                '这里的N 已为　1 天N 次
                If (N Mod M) <> 0 Then '这种情况无法按天进位,于是按总数进位
                    TotalModelAmount = ModelAmount * Cnt
                    gfnGetMount = gfnUpINT(TotalModelAmount / UnitModelAmount)
                Else
                    
                    If TimeType = 0 Then
                        N = N / M
                    Else
                        N = (N / M) * 24
                    End If
                        
                    VH = Cnt / N
                    VM = Cnt - VH * N
                    For i = 1 To VH
                        TotalModelAmount = ModelAmount * N
                        gfnGetMount = gfnGetMount + gfnUpINT(TotalModelAmount / UnitModelAmount)
                    Next i
                    TotalModelAmount = ModelAmount * (VM)
                    gfnGetMount = gfnGetMount + gfnUpINT(TotalModelAmount / UnitModelAmount)
                End If
            
            Case 2 '医嘱周期
                VH = Cnt / N
                VM = Cnt - VH * N
                For i = 1 To VH
                    TotalModelAmount = ModelAmount * N
                    gfnGetMount = gfnGetMount + gfnUpINT(TotalModelAmount / UnitModelAmount)
                Next i
                TotalModelAmount = ModelAmount * (VM)
                gfnGetMount = gfnGetMount + gfnUpINT(TotalModelAmount / UnitModelAmount)
                
                
            Case 3 ' 摆药周期
                TotalModelAmount = ModelAmount * Cnt
                gfnGetMount = gfnUpINT(TotalModelAmount / UnitModelAmount)
        End Select
    End If
    If gfnGetMount = 0 Then
        PrevMarkDate = OLDPrevMarkDate
        Exit Function
    End If
End Function

Public Function gfnUpINT(ByVal Value As Single) As Integer  '上进位
    Dim TmpValue As Integer
    
    TmpValue = Int(Value)
    If TmpValue = Value Then
        gfnUpINT = TmpValue
    Else
        gfnUpINT = TmpValue + 1
    End If
    
End Function

Public Function gfnFindParent(CurNode As Node, ByVal Code As String) As Node
    If Left("S" & Code, Len(CurNode.key)) = CurNode.key Or CurNode.key = "S0" Or CurNode.key = "Root" Then
        Set gfnFindParent = CurNode
    Else
        Set gfnFindParent = gfnFindParent(CurNode.Parent, Code)
    End If
End Function

Public Sub gfnFillDataBySickRegInfo(FrmObj As Form, SickObj As clsSick)   '通用
    FrmObj.lblName = SickObj.Name
    FrmObj.lblSex = SickObj.SexDes
    FrmObj.lblAge = SickObj.Age
    FrmObj.lblAddr = SickObj.Addr
    FrmObj.lblPtType = SickObj.PtDes
    FrmObj.lblContactor = SickObj.Contactor
    FrmObj.lblContactorAddr = SickObj.ContactorAddr
    FrmObj.lblDepCode = SickObj.DepName
    FrmObj.lblBedNum = SickObj.BedNum
    FrmObj.lblInDate = Format(SickObj.InDate, gstrCHINA_DATE)
    FrmObj.lblFair = Format(SickObj.Fair, gstrMONEY_FORMAT)
    FrmObj.lblRemFair = Format(SickObj.RemFair, gstrMONEY_FORMAT)
End Sub