modprvpublic.bas

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

Attribute VB_Name = "ModPrvPublic"
Option Explicit

Public Sub gpdAddSheetID()
'模块兼容
End Sub

Public Function gFnGetSerial(ByVal SerialType As ENSerialType, Optional FDate = "") As String
    Dim TmpStr As String
    
    If FDate <> "" Then
        TmpStr = Format(FDate, gstrSERIAL_DATE) & gtydSysConfig.HdCode
    Else
        TmpStr = gfnGetTime(gstrSERIAL_DATE) & gtydSysConfig.HdCode
    End If
    Select Case SerialType
        Case ENSerialType.stRegi
            gDbObj.GetRs ("SELECT Max(RegiSerial)  FROM Open_Regi WHERE RegiSerial LIKE '" & TmpStr & "%'" _
                & " AND HdCode = '" & gtydSysConfig.HdCode & "'")  '注，预防操作员编码有包含情况
            If Not IsNull(gDbObj.Rs(0)) Then
                gFnGetSerial = TmpStr & Format(Right(gDbObj.Rs(0), Len(gDbObj.Rs(0)) - Len(TmpStr)) + 1, _
                    hisStrRepeat("0", gintSERIAL_BITS))
            Else
                gFnGetSerial = TmpStr & Format(1, hisStrRepeat("0", gintSERIAL_BITS))
            End If
        Case ENSerialType.stOpen_HandlerFoot
            If FDate <> "" Then
                TmpStr = Format(FDate, gstrSERIAL_DATE) & gtydSysConfig.HdCode
            Else
                TmpStr = gfnGetTime(gstrSERIAL_DATE) & gtydSysConfig.HdCode
            End If

            gDbObj.GetRs ("SELECT Max(FootID) as Serial" _
                & " FROM Open_HandlerFoot WHERE FootID LIKE '" & TmpStr & "%'" _
                & " AND HdCode = '" & gtydSysConfig.HdCode & "'") '注，预防操作员编码有包含情况
            If Not IsNull(gDbObj.Rs!Serial) Then
                gFnGetSerial = TmpStr & Format(Right(gDbObj.Rs!Serial, Len(gDbObj.Rs!Serial) - Len(TmpStr)) + 1, _
                    hisStrRepeat("0", gintSERIAL_BITS))
            Else
                gFnGetSerial = TmpStr & Format(1, hisStrRepeat("0", gintSERIAL_BITS))
            End If
        Case ENSerialType.stInpati_HandlerFoot '住院统一结算

            gDbObj.GetRs ("SELECT Max(FootID) as Serial" _
                & " FROM HandlerFoot ") '注，预防操作员编码有包含情况
            If Not IsNull(gDbObj.Rs!Serial) Then
                gFnGetSerial = TmpStr & Format(Right(gDbObj.Rs!Serial, Len(gDbObj.Rs!Serial) - Len(TmpStr)) + 1, _
                    hisStrRepeat("0", gintSERIAL_BITS))
            Else
                gFnGetSerial = TmpStr & Format(1, hisStrRepeat("0", gintSERIAL_BITS))
            End If
        Case ENSerialType.stRecipeSerial
            gDbObj.GetRs ("SELECT Max(RecipeSerial) as Serial" _
                & " FROM Open_RecipeMain WHERE RecipeSerial LIKE '" & TmpStr & "%'" _
                & " AND HdCode = '" & gtydSysConfig.HdCode & "'") '注，预防操作员编码有包含情况
            If Not IsNull(gDbObj.Rs!Serial) Then
                gFnGetSerial = TmpStr & Format(Right(gDbObj.Rs!Serial, Len(gDbObj.Rs!Serial) - Len(TmpStr)) + 1, _
                    hisStrRepeat("0", gintSERIAL_BITS))
            Else
                gFnGetSerial = TmpStr & Format(1, hisStrRepeat("0", gintSERIAL_BITS))
            End If
        Case ENSerialType.stFairMark
            gDbObj.GetRs ("SELECT Max(MarkSerial)  FROM FairMarkMain WHERE MarkSerial LIKE '" & TmpStr & "%'" _
                & " AND HdCode = '" & gtydSysConfig.HdCode & "'")  '注，预防操作员编码有包含情况
            If gDbObj.Rs Is Nothing Then
                gFnGetSerial = TmpStr & Format(1, hisStrRepeat("0", gintSERIAL_BITS))
            Else
                If Not IsNull(gDbObj.Rs(0)) Then
                    gFnGetSerial = TmpStr & Format(Right(gDbObj.Rs(0), Len(gDbObj.Rs(0)) - Len(TmpStr)) + 1, _
                        hisStrRepeat("0", gintSERIAL_BITS))
                Else
                    gFnGetSerial = TmpStr & Format(1, hisStrRepeat("0", gintSERIAL_BITS))
                End If
            End If
        Case ENSerialType.stHouseBusSerial
            gDbObj.GetRs ("SELECT Max(BusSerial)  FROM House_BusMain WHERE BusSerial LIKE '" & TmpStr & "%'" _
                & " AND HdCode = '" & gtydSysConfig.HdCode & "'")  '注，预防操作员编码有包含情况
            If Not IsNull(gDbObj.Rs(0)) Then
                gFnGetSerial = TmpStr & Format(Right(gDbObj.Rs(0), Len(gDbObj.Rs(0)) - Len(TmpStr)) + 1, _
                    hisStrRepeat("0", gintSERIAL_BITS))
            Else
                gFnGetSerial = TmpStr & Format(1, hisStrRepeat("0", gintSERIAL_BITS))
            End If
'
    End Select
End Function

Public Function gfnGetFig() As Boolean  '读工作站配置
    gtydSysConfig.FootDay = 28
    If gDbObj.GetRs("SELECT WfID,Value FROM m_WorkStationFig WHERE WsID = '" & gstrWSID & "'") > 0 Then
        Do Until gDbObj.Rs.EOF
            Select Case LCase(gDbObj.Rs!wfID)
                Case "markprint"
                    If Not IsNull(gDbObj.Rs!Value) Then
                        gtydSysConfig.MarkPrint = IIf(gDbObj.Rs!Value = "1", True, False)
                    End If
                Case "enablekeepfs"
                    If Not IsNull(gDbObj.Rs!Value) Then
                        gtydSysConfig.EnableKeepFS = IIf(gDbObj.Rs!Value = "1", True, False)
                    End If
                Case "iffetchlist"
                    If Not IsNull(gDbObj.Rs!Value) Then
                        gtydSysConfig.IfFetchList = IIf(gDbObj.Rs!Value = "1", True, False)
                    End If
                Case "ifmark"
                    If Not IsNull(gDbObj.Rs!Value) Then
                        gtydSysConfig.IfMark = IIf(gDbObj.Rs!Value = "1", True, False)
                    End If
                
                Case "notprintrec"
                    If Not IsNull(gDbObj.Rs!Value) Then
                        gtydSysConfig.NotPrintRec = IIf(gDbObj.Rs!Value = "1", True, False)
                    End If
                Case "printattrcol"
                    If Not IsNull(gDbObj.Rs!Value) Then
                        gtydSysConfig.PrintAttrCol = IIf(gDbObj.Rs!Value = "1", True, False)
                    End If
                Case "depcode"
                    gtydSysConfig.DepCode = IIf(IsNull(gDbObj.Rs!Value), "", gDbObj.Rs!Value)
                    gtydSysConfig.VsADepCode = gtydSysConfig.DepCode
                    gtydSysConfig.VsBDepCode = gtydSysConfig.DepCode
                    gtydSysConfig.VsCDepCode = gtydSysConfig.DepCode
                Case "depname"
                    gtydSysConfig.DepName = IIf(IsNull(gDbObj.Rs!Value), "", gDbObj.Rs!Value)
                Case "itemcode"
                    gtydSysConfig.ItemCode = IIf(IsNull(gDbObj.Rs!Value), "", gDbObj.Rs!Value)
                Case "vsstore"
                    gtydSysConfig.VsStore = IIf(IsNull(gDbObj.Rs!Value), "", gDbObj.Rs!Value)
                Case "vsstorename"
                    gtydSysConfig.VsStoreName = IIf(IsNull(gDbObj.Rs!Value), "", gDbObj.Rs!Value)
                Case "handletype"
                    If Not IsNull(gDbObj.Rs!Value) Then
                        gtydSysConfig.HandleType = IIf(gDbObj.Rs!Value = "", 0, Val(gDbObj.Rs!Value))
                    End If
                Case "defaultgetdrugdays"
                    If Not IsNull(gDbObj.Rs!Value) Then
                        gtydSysConfig.DefaultGetDrugDays = IIf(gDbObj.Rs!Value = "", 1, Val(gDbObj.Rs!Value))
                    Else
                        gtydSysConfig.DefaultGetDrugDays = 1
                    End If
                Case "defaultunit"
                    If Not IsNull(gDbObj.Rs!Value) Then
                        gtydSysConfig.DefaultUnit = IIf(gDbObj.Rs!Value = "", 0, Val(gDbObj.Rs!Value))
                    End If
                
                Case "ifdecstore"
                    If Not IsNull(gDbObj.Rs!Value) Then
                        gtydSysConfig.IfDecStore = IIf(gDbObj.Rs!Value = "1", True, False)
                    Else
                        gtydSysConfig.IfDecStore = False
                    End If
                Case "ifautoid"
                    If Not IsNull(gDbObj.Rs!Value) Then
                        gtydSysConfig.IFAutoID = IIf(gDbObj.Rs!Value = "1", True, False)
                    End If
                Case "ifautoidbyf6"
                    If Not IsNull(gDbObj.Rs!Value) Then
                        gtydSysConfig.IFAutoIDByF6 = IIf(gDbObj.Rs!Value = "1", True, False)
                    End If
                Case "ifmustinputdoctor"
                    If Not IsNull(gDbObj.Rs!Value) Then
                        gtydSysConfig.IfMustInputDoctor = IIf(gDbObj.Rs!Value = "1", True, False)
                    End If
                Case "workstationnum"
                    gtydSysConfig.WorkStationNum = IIf(IsNull(gDbObj.Rs!Value), "", gDbObj.Rs!Value)
                Case "ifmarkfetch"
                    If Not IsNull(gDbObj.Rs!Value) Then
                        gtydSysConfig.IFMarkFetch = IIf(gDbObj.Rs!Value = 1, True, False)
                    End If
                Case "autosheetid"
                    If Not IsNull(gDbObj.Rs!Value) Then
                        gtydSysConfig.AutoSheetID = IIf(gDbObj.Rs!Value = 1, True, False)
                    End If
                Case "footday"
                    If Not IsNull(gDbObj.Rs!Value) Then
                        gtydSysConfig.FootDay = Val(gDbObj.Rs!Value)
                    End If
                    If gtydSysConfig.FootDay = 0 Then
                        gtydSysConfig.FootDay = 28
                    End If
                Case "ifallowneg"
                    If Not IsNull(gDbObj.Rs!Value) Then
                        gtydSysConfig.IFAllowNeg = IIf(gDbObj.Rs!Value = "1", True, False)
                    End If
             End Select
             gDbObj.Rs.MoveNext
        Loop
    End If

End Function

Public Sub mpdGetCurSysConfig()
    Dim values As String
    If gDbObj.GetRs("SELECT ScID,Value FROM f_SysConfig WHERE SmID ='0' OR '" & gstrMODULEID & "' Like SmID +'%'") >= 1 Then
    
        Do Until gDbObj.Rs.EOF
            If Not IsNull(gDbObj.Rs!Value) Then
                values = hisStrRep(gDbObj.Rs!Value, Chr(34), Chr(39))
            Else
                values = ""
            End If
            Select Case LCase(gDbObj.Rs!ScID)
                Case "needregiforfigure"
                    If Not IsNull(gDbObj.Rs!Value) Then
                        gtydSysConfig.NeedRegiForFigure = IIf(gDbObj.Rs!Value = "1", True, False)
                    End If
                Case "legaldaysforregi"