Attribute VB_Name = "ModuleBase"
Option Explicit

Public PStrVer          As String           '系統(tǒng)版本 : 0-網(wǎng)絡(luò)版；  1-單機(jī)版

Public PStrFlDLID       As String           '大類(lèi)ID
Public PStrFlYPDW       As String           '藥品單位
Public PStrFlZLDW       As String           '診療單位
Public PStrFlYPJX       As String           '藥品劑型
Public PStrFlMZ         As String           '民族
Public PStrFlJG         As String           '籍貫
Public PStrFlGJ         As String           '國(guó)籍
Public PStrFlZY         As String           '職業(yè)
Public PStrFlHYZK       As String           '婚姻狀況
Public PStrFlQQGX       As String           '親情關(guān)系
Public PStrFlDZ         As String           '地址
Public PStrFlMZFP       As String           '門(mén)診發(fā)票項(xiàng)目
Public PStrFlZYFP       As String           '住院發(fā)票項(xiàng)目
Public PStrFlZYMX       As String           '住院明細(xì)項(xiàng)目
Public PStrFlCWTJ       As String           '財(cái)務(wù)統(tǒng)計(jì)項(xiàng)目
Public PStrFlGHFL       As String           '掛號(hào)分類(lèi)項(xiàng)目

Public PStrUserID       As String           '操作員編號(hào)
Public PStrUserName     As String           '操作員姓名
Public PStrCjyhbh       As String           '超級(jí)用戶

Public PStrSqzID        As String           '社區(qū)站編號(hào)
Public PStrSqzMC        As String           '社區(qū)站名稱

Public PStrSqzxID       As String           '社區(qū)中心編號(hào)
Public PStrSqzxMC       As String           '社區(qū)中心名稱

Public PCnnHisDB        As ADODB.Connection '數(shù)據(jù)庫(kù)連接

Sub Main()
    Dim ClassVerFlag    As cls_base_cnndb.ClassCnnDB
    Set ClassVerFlag = New cls_base_cnndb.ClassCnnDB

    Dim StrUserName     As String
    Dim StrDbName       As String
    Dim StrUserPwd      As String
    Dim StrServerName   As String
    Dim StrConDB        As String

    StrServerName = GetSetting("SqwszYpsfglXt", "ServerName", "ServerName")
    StrDbName = GetSetting("SqwszYpsfglXt", "DbName", "DbName")
    StrUserName = GetSetting("SqwszYpsfglXt", "UserName", "UserName")
    StrUserPwd = GetSetting("SqwszYpsfglXt", "UserPwd", "UserPwd")

    'DataEn.CnnWszDB.Open " User ID=" + StrUserName + ";       " _
                       & " Initial Catalog=" + StrDbName + "; " _
                       & " Pwd=" + StrUserPwd + ";            " _
                       & " Data Source=" + StrServerName + "  "
                       
    Dim AdoRsTmp    As ADODB.Recordset
    Set AdoRsTmp = New ADODB.Recordset
    AdoRsTmp.Open "SELECT sqzxid, sqzxmc, wszid, wszmc FROM base_wsz", PCnnHisDB, adOpenForwardOnly
    If Not (AdoRsTmp.EOF Or AdoRsTmp.BOF) Then
        PStrSqzxID = IIf(IsNull(AdoRsTmp.Fields("sqzxid")), "", AdoRsTmp.Fields("sqzxid"))
        PStrSqzxMC = IIf(IsNull(AdoRsTmp.Fields("sqzxmc")), "", AdoRsTmp.Fields("sqzxmc"))
        PStrSqzID = IIf(IsNull(AdoRsTmp.Fields("wszid")), "", AdoRsTmp.Fields("wszid"))
        PStrSqzMC = IIf(IsNull(AdoRsTmp.Fields("wszmc")), "", AdoRsTmp.Fields("wszmc"))
    End If
    AdoRsTmp.Close: Set AdoRsTmp = Nothing
    
End Sub

Public Sub ProCopyMhflexToMsflex(MhFlexSend As MSHFlexGrid, MsflexSend As MSFlexGrid)
    Dim IntRow  As Integer
    Dim IntCol  As Integer
    
    With MsflexSend
        .Rows = MhFlexSend.Rows
        .Cols = MhFlexSend.Cols
        For IntRow = 0 To .Rows - 1
            For IntCol = 0 To .Cols - 1
                .TextMatrix(IntRow, IntCol) = MhFlexSend.TextMatrix(IntRow, IntCol)
            Next IntCol
        Next IntRow
    End With
End Sub

Public Sub ProcAddCmbItem(CmbSend As ComboBox, AdoRsSend As ADODB.Recordset)
    CmbSend.Clear
    Do While Not AdoRsSend.EOF
        CmbSend.AddItem AdoRsSend.Fields(1)
        CmbSend.ItemData(CmbSend.NewIndex) = AdoRsSend.Fields(0)
        AdoRsSend.MoveNext
    Loop
    If CmbSend.ListCount > 0 Then CmbSend.ListIndex = CmbSend.ListCount - 1
End Sub

Public Function FunGetItemName(CmbTemp As ComboBox, SStrTemp As String) As String
    Dim IntTemp As Integer
    For IntTemp = 0 To CmbTemp.ListCount - 1
        If CStr(CmbTemp.ItemData(IntTemp)) = SStrTemp Then
            FunGetItemName = CmbTemp.List(IntTemp)
            Exit For
        End If
    Next IntTemp
End Function

Public Function FunGetDateTime() As String  '獲取系統(tǒng)時(shí)間
    
    Dim AdoRsDateTime As ADODB.Recordset
    Set AdoRsDateTime = New ADODB.Recordset
    
    If PStrVer = "0" Then
        AdoRsDateTime.Open "SELECT GetDate() ", PCnnHisDB, adOpenDynamic
        FunGetDateTime = Format(CStr(AdoRsDateTime.Fields(0)), "yyyy-mm-dd hh:mm:ss")
        AdoRsDateTime.Close: Set AdoRsDateTime = Nothing
    Else
        FunGetDateTime = Format(CStr(Now), "yyyy-mm-dd hh:mm:ss")
    End If
    
End Function

Public Function FunGetLsh() As String  '獲取流水號(hào)
    
    Dim StrDateTime As String
    Dim AdoRsLsh    As ADODB.Recordset
    Set AdoRsLsh = New ADODB.Recordset
    
    StrDateTime = FunGetDateTime
    
    If PStrVer = "0" Then
        AdoRsLsh.Open " SELECT lsh FROM base_lsh " _
                    & "  WHERE czyid='" + PStrUserID + "' AND CONVERT(Char(10),czsj,21)='" + Format(StrDateTime, "yyyy-mm-dd") + "' ", PCnnHisDB, adOpenDynamic
    End If
    
    If PStrVer = "1" Then
        AdoRsLsh.Open " SELECT lsh FROM base_lsh " _
                    & " WHERE czyid='" + PStrUserID + "' AND Format(czsj,'yyyy-mm-dd')='" + Format(StrDateTime, "yyyy-mm-dd") + "' ", PCnnHisDB, adOpenDynamic

    End If
        
'    '啟動(dòng)事務(wù)
'    PcnnHisDb.BeginTrans
    
    If (AdoRsLsh.EOF Or AdoRsLsh.BOF) Or IsNull(AdoRsLsh.Fields(0)) Then
        FunGetLsh = Format(StrDateTime, "yyyymmdd") & Format(PStrUserID, "000") & "001"
        PCnnHisDB.Execute "INSERT INTO base_lsh(czsj,czyid,lsh) VALUES('" + StrDateTime + "','" + PStrUserID + "',1)"
    Else
        FunGetLsh = Format(StrDateTime, "yyyymmdd") & Format(PStrUserID, "000") & Format(AdoRsLsh.Fields(0), "000")
        If PStrVer = "0" Then
            PCnnHisDB.Execute " Update base_lsh SET lsh = lsh + 1 " _
                            & " WHERE czyid = '" + PStrUserID + "' AND CONVERT(Char(10),czsj,21)='" + Format(StrDateTime, "yyyy-mm-dd") + "' "
        Else
            PCnnHisDB.Execute " Update base_lsh SET lsh = lsh + 1 " _
                            & " WHERE czyid = '" + PStrUserID + "' AND Format(czsj,'yyyy-mm-dd')='" + Format(StrDateTime, "yyyy-mm-dd") + "' "
        End If
        
    End If
    AdoRsLsh.Close: Set AdoRsLsh = Nothing
    
    '判斷事務(wù)狀態(tài)
'    If CBool(PcnnHisDb.State And adStateExecuting) Then
'        PcnnHisDb.Cancel
'        PcnnHisDb.RollbackTrans
'        MsgBox "產(chǎn)生流水號(hào)失敗，請(qǐng)重試。", vbCritical, "提示"
'        FunGetLsh = ""
'    Else
'        PcnnHisDb.CommitTrans
'    End If
End Function

Public Sub ProTxtGetFocus(TxtSend As TextBox)
     TxtSend.BackColor = &HFFC0C0
End Sub
Public Sub ProTxtLostFocus(TxtSend As TextBox)
     TxtSend.BackColor = &HFFFFFF
End Sub

Public Sub ProCmbGetFocus(CmbSend As ComboBox)
     CmbSend.BackColor = &HFFC0C0
End Sub
Public Sub ProCmbLostFocus(CmbSend As ComboBox)
     CmbSend.BackColor = &HFFFFFF
End Sub

Public Sub ProcAdoRsToMsFlex(SAdoRs As ADODB.Recordset, MsFlex As MSFlexGrid)
    
    Dim IntRow  As Integer, IntCol  As Integer
    
    With MsFlex
        .Clear
        If Not (SAdoRs.EOF Or SAdoRs.BOF) Then SAdoRs.MoveLast: SAdoRs.MoveFirst
        
        '字段
        .Rows = SAdoRs.Fields.Count
        .Cols = SAdoRs.RecordCount + 1
        For IntRow = 0 To SAdoRs.Fields.Count - 1
            .TextMatrix(IntRow, 0) = IIf(IsNull(SAdoRs.Fields(IntRow).Name), "", Trim(SAdoRs.Fields(IntRow).Name))
        Next IntRow
        .ColWidth(0) = 1500
        
        '記錄
        IntCol = 1
        Do While Not SAdoRs.EOF
            For IntRow = 0 To SAdoRs.Fields.Count - 1
                .TextMatrix(IntRow, IntCol) = IIf(IsNull(SAdoRs.Fields(IntRow)), "", Trim(SAdoRs.Fields(IntRow)))
            Next IntRow
            IntCol = IntCol + 1
            SAdoRs.MoveNext
        Loop
    
        '行編輯
        For IntRow = 0 To .Rows - 1
            .RowHeight(IntRow) = 300
        Next IntRow
        
        '列編輯
        For IntCol = 0 To .Cols - 1
            .ColWidth(IntCol) = 1200
            .ColAlignment(IntCol) = 4
        Next IntCol
    End With
End Sub