Attribute VB_Name = "ModuleBase"
Option Explicit

Public PStrVer          As String           '系統版本 : 0-網絡版；  1-單機版

Public PStrFlDLID       As String           '大類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           '國籍
Public PStrFlZY         As String           '職業
Public PStrFlHYZK       As String           '婚姻狀況
Public PStrFlQQGX       As String           '親情關系
Public PStrFlDZ         As String           '地址
Public PStrFlMZFP       As String           '門診發票項目
Public PStrFlZYFP       As String           '住院發票項目
Public PStrFlZYMX       As String           '住院明細項目
Public PStrFlCWTJ       As String           '財務統計項目
Public PStrFlGHFL       As String           '掛號分類項目

Public PStrUserID       As String           '操作員編號
Public PStrUserName     As String           '操作員姓名
Public PStrCjyhbh       As String           '超級用戶

Public PStrSqzID        As String           '社區站編號
Public PStrSqzMC        As String           '社區站名稱

Public PStrSqzxID       As String           '社區中心編號
Public PStrSqzxMC       As String           '社區中心名稱
Public PcnnHisDb        As ADODB.Connection '數據庫連接

Sub Main()
    Dim ClassVerFlag    As cls_base_cnndb.ClassCnnDB
    Set ClassVerFlag = New cls_base_cnndb.ClassCnnDB
    PStrVer = ClassVerFlag.PropVerFlag
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
    CmbSend.AddItem ""
    CmbSend.ItemData(CmbSend.ListCount - 1) = 0
    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

Function Get_Chinese(ByVal Money As Currency) As String
    Dim Pre    As Integer, Had_Frist_Num     As Boolean
    Dim Temp   As String, Num_To_Chinese(10) As String
    Dim First As Currency:   First = Money: Pre = 0
    Num_To_Chinese(0) = "零": Num_To_Chinese(1) = "壹"
    Num_To_Chinese(2) = "貳": Num_To_Chinese(3) = "叁"
    Num_To_Chinese(4) = "肆": Num_To_Chinese(5) = "伍"
    Num_To_Chinese(6) = "陸": Num_To_Chinese(7) = "柒"
    Num_To_Chinese(8) = "捌": Num_To_Chinese(9) = "玖"
Re:
    Select Case Money
        Case Is >= 10000000 And Money < 100000000
            Had_Frist_Num = True
            Temp = Num_To_Chinese(Int(Money / 10000000)) & "仟"
            Pre = 1: Money = Money - Int(Money / 10000000) * 10000000
            GoTo Re
        Case Is >= 1000000 And Money < 10000000
            Had_Frist_Num = True
            Temp = Temp & Num_To_Chinese(Int(Money / 1000000)) & "佰"
            Pre = 2: Money = Money - Int(Money / 1000000) * 1000000
            GoTo Re
        Case Is >= 100000 And Money < 1000000
            If Not Had_Frist_Num Then
                Temp = Num_To_Chinese(Int(Money / 100000)) & "拾"
            ElseIf Pre <> 2 Then
                Temp = Temp & "零" & Num_To_Chinese(Int(Money / 100000)) & "拾"
            Else
                Temp = Temp & Num_To_Chinese(Int(Money / 100000)) & "拾"
            End If
            Had_Frist_Num = True: Pre = 3
            Money = Money - Int(Money / 100000) * 100000
            GoTo Re
        Case Is >= 10000 And Money < 100000
            If Not Had_Frist_Num Then
                Temp = Num_To_Chinese(Int(Money / 10000)) & "萬"
            ElseIf Pre <> 3 Then
                Temp = Temp & "零" & Num_To_Chinese(Int(Money / 10000)) & "萬"
            Else
                Temp = Temp & Num_To_Chinese(Int(Money / 10000)) & "萬"
            End If
            Had_Frist_Num = True: Pre = 4
            Money = Money - Int(Money / 10000) * 10000
            GoTo Re
        Case Is >= 1000 And Money < 10000
            If Not Had_Frist_Num Then
                Temp = Temp & Num_To_Chinese(Int(Money / 1000)) & "仟"
            ElseIf Pre <> 4 Then
                Temp = Temp & "萬零" & Num_To_Chinese(Int(Money / 1000)) & "仟"
            Else
                Temp = Temp & Num_To_Chinese(Int(Money / 1000)) & "仟"
            End If
            
            Had_Frist_Num = True: Pre = 5
            Money = Money - Int(Money / 1000) * 1000
            GoTo Re
        Case Is >= 100 And Money < 1000
            If Not Had_Frist_Num Then
                Temp = Temp & Num_To_Chinese(Int(Money / 100)) & "佰"
            ElseIf Pre <> 4 And Pre < 4 Then
                Temp = Temp & "萬零" & Num_To_Chinese(Int(Money / 100)) & "佰"
            ElseIf Pre <> 5 Then
                Temp = Temp & "零" & Num_To_Chinese(Int(Money / 100)) & "佰"
            Else
                Temp = Temp & Num_To_Chinese(Int(Money / 100)) & "佰"
            End If
            Had_Frist_Num = True: Pre = 6
            Money = Money - Int(Money / 100) * 100
            GoTo Re
        Case Is >= 10 And Money < 100
            If Not Had_Frist_Num Then
                Temp = Temp & Num_To_Chinese(Int(Money / 10)) & "拾"
            ElseIf Pre <> 4 And Pre < 4 Then
                Temp = Temp & "萬零" & Num_To_Chinese(Int(Money / 10)) & "拾"
            ElseIf Pre <> 6 Then
                Temp = Temp & "零" & Num_To_Chinese(Int(Money / 10)) & "拾"
            Else
                Temp = Temp & Num_To_Chinese(Int(Money / 10)) & "拾"
            End If
            Had_Frist_Num = True: Pre = 7
            Money = Money - Int(Money / 10) * 10
            GoTo Re
        Case Is >= 1 And Money < 10
            If Not Had_Frist_Num Then
                Temp = Temp & Num_To_Chinese(Int(Money)) & "元"
            ElseIf Pre <> 4 And Pre < 4 Then
                Temp = Temp & "萬零" & Num_To_Chinese(Int(Money)) & "元"
            ElseIf Pre <> 7 Then
                Temp = Temp & "零" & Num_To_Chinese(Int(Money)) & "元"
            Else
                Temp = Temp & Num_To_Chinese(Int(Money)) & "元"
            End If
            Had_Frist_Num = True: Pre = 8
            Money = Money - Int(Money)
            GoTo Re
        Case Is >= 0.1
            If Not Had_Frist_Num Then
                Temp = Temp & Num_To_Chinese(Int(Money * 10)) & "角"
            ElseIf Pre <> 4 And Pre < 4 Then
                Temp = Temp & "萬零" & Num_To_Chinese(Int(Money * 10)) & "角"
            ElseIf Pre <> 8 Then
                Temp = Temp & "元零" & Num_To_Chinese(Int(Money * 10)) & "角"
            Else
                Temp = Temp & Num_To_Chinese(Int(Money * 10)) & "角"
            End If
            Pre = 9
            Money = Money - Int(Money * 10) / 10
            GoTo Re:
        Case Is >= 0.01
            If Money <> 0 Then
                If Not Had_Frist_Num Then
                    Temp = Temp & Num_To_Chinese(Int(Money * 100)) & "分"
                ElseIf Pre <> 4 And Pre < 4 Then
                    Temp = Temp & "萬零" & Num_To_Chinese(Int(Money * 100)) & "分"
                ElseIf Pre <> 8 And Pre <> 9 Then
                    Temp = Temp & "元零" & Num_To_Chinese(Int(Money * 100)) & "分"
                Else
                    Temp = Temp & Num_To_Chinese(Int(Money * 100)) & "分"
                End If
            End If
            Pre = 10
    End Select
    If Val(First) = Int(First) Then Get_Chinese = Temp & "整" Else Get_Chinese = Temp
End Function

Public Function FunGetDateTime() As String  '獲取系統時間
    
    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  '獲取流水號
    
    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
        
    '啟動事務
    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
    
    '判斷事務狀態
    If CBool(PcnnHisDb.State And adStateExecuting) Then
        PcnnHisDb.Cancel
        PcnnHisDb.RollbackTrans
        MsgBox "產生流水號失敗，請重試。", vbCritical, "提示"
        FunGetLsh = ""
    Else
        PcnnHisDb.CommitTrans
    End If
End Function

Public Sub ProcPrtFp(SendMhFlexFp As MSHFlexGrid, _
                     SendStrBrXm As String, SendStrBrBh As String, _
                     SendStrFyHj As String, SendStrDySj As String, SendStrBs As String)
                      
    Const X0 = 1: Const Y0 = 3
    Const Xc = 4: Const Yc = 0.75
    
    Dim HI      As Integer
    Dim IntRow  As Integer
    
    With Printer
    
    '-------------------------------<正聯>------------------------------
        '100001 西藥        '100002 中成藥   '100003 中草藥
        '100004 常規檢查    '100005 CT       '100006 核磁
        '100007 Ｂ超        '100008 輸氧費   '100009 手術費
        '100010 治療費      '100011 放射     '100012 化驗
        '100013 輸血費      '100014 其它一   '100015 其它二
        '100016 其它三

        Printer.ScaleMode = 7: Printer.FontSize = 12
            
        '姓名
        .CurrentX = X0 - 0.8: .CurrentY = Y0 - 1.9
        If SendStrBrXm <> "" Then Printer.Print Trim(SendStrBrXm)
        
        For IntRow = 1 To SendMhFlexFp.Rows - 1
            
            '西藥
            If SendMhFlexFp.TextMatrix(IntRow, 0) = "100001" Then
                
                If Val(SendMhFlexFp.TextMatrix(IntRow, 2)) <> 0 Then
                    .CurrentX = X0:     .CurrentY = Y0
                    Printer.Print Format(SendMhFlexFp.TextMatrix(IntRow, 2), "0.00")
                End If
            End If
            
            '中成藥
            If SendMhFlexFp.TextMatrix(IntRow, 0) = "100002" Then
                
                If Val(SendMhFlexFp.TextMatrix(IntRow, 2)) <> 0 Then
                    .CurrentX = X0:     .CurrentY = Y0 + Yc
                    Printer.Print Format(SendMhFlexFp.TextMatrix(IntRow, 2), "0.00")
                End If
            End If
        
            '中草藥
            If SendMhFlexFp.TextMatrix(IntRow, 0) = "100003" Then
                
                If Val(SendMhFlexFp.TextMatrix(IntRow, 2)) <> 0 Then
                    .CurrentX = X0:     .CurrentY = Y0 + 2 * Yc
                    Printer.Print Format(SendMhFlexFp.TextMatrix(IntRow, 2), "0.00")
                End If
            End If
        
            '常規檢查
            If SendMhFlexFp.TextMatrix(IntRow, 0) = "100004" Then
                
                If Val(SendMhFlexFp.TextMatrix(IntRow, 2)) <> 0 Then
                    .CurrentX = X0:     .CurrentY = Y0 + 3 * Yc
                    Printer.Print Format(SendMhFlexFp.TextMatrix(IntRow, 2), "0.00")
                End If
            End If
        
            'C T
            If SendMhFlexFp.TextMatrix(IntRow, 0) = "100005" Then
                
                If Val(SendMhFlexFp.TextMatrix(IntRow, 2)) <> 0 Then
                    .CurrentX = X0:     .CurrentY = Y0 + 4 * Yc
                    Printer.Print Format(SendMhFlexFp.TextMatrix(IntRow, 2), "0.00")
                End If
            End If
        
            '核磁
            If SendMhFlexFp.TextMatrix(IntRow, 0) = "100006" Then
                
                If Val(SendMhFlexFp.TextMatrix(IntRow, 2)) <> 0 Then
                    .CurrentX = X0:     .CurrentY = Y0 + 5 * Yc
                    Printer.Print Format(SendMhFlexFp.TextMatrix(IntRow, 2), "0.00")
                End If
            End If
        
            'B 超
            If SendMhFlexFp.TextMatrix(IntRow, 0) = "100007" Then
                
                If Val(SendMhFlexFp.TextMatrix(IntRow, 2)) <> 0 Then
                    .CurrentX = X0:     .CurrentY = Y0 + 6 * Yc
                    Printer.Print Format(SendMhFlexFp.TextMatrix(IntRow, 2), "0.00")
                End If