Attribute VB_Name = "modBarcode"
'[BC08162006 /NGP]===================================
Option Explicit

Global gblBarcode As String
Global gblBarcodeUserID As String
Global arPrefSectionID As Variant
Global arPrefSection As Variant
Global gblPrefSectionID As String
Global gblPrefSection As String
Global gblDefaultPrinter As String
Global blnPrintBarcodeLabel As Boolean
Global blnAutoPrintBarcode As Boolean
Global blnPrintBarcodeCS As Boolean
Global blnPrintBarcodeRF As Boolean
Global blnIsSectionBarcoded As Boolean
Global blnSpecRecActivated As Boolean
Global blnSpecStatActivated As Boolean
Global blnResValActivated As Boolean

Global arRequestNum As Variant
Global arItemID As Variant
Global arLabSectionID As Variant
Global gblItemCount As Integer

Global arBarcode As Variant
Global arBarcodeText As Variant
Global arSampleType As Variant
Global arPatientName As Variant
Global arSectionID As Variant
Global arRefNum As Variant
Global arSpecimenID As Variant

Global strBCParameter As String
Global gblCurrentDate As String
Global gblSpecFloatingTime As Integer
Global gblTransportTime As Long
Global gblOverdueTime As Long
Global intActivateCtr As Integer

Public Const mdGetDefaultPrinter As Integer = 0
Public Const mdSetBarcodePrinter As Integer = 1
Public Const mdSetDefaultPrinter As Integer = 2

Public Type LabelPage
    LabelWidth As Single
    LabelHeight As Single
    LabelsAcross As Integer
    LabelsDown As Integer
    
    VerticalSpacing As Single
    HorizontalSpacing As Single
    
    TopMargin As Single
    SideMargin As Single
    
    PageWidth As Single
    PageHeight As Single
End Type

'============================================================
' Verify if label is valid
'============================================================
Public Function VerifyLabel(Label As LabelPage) As Boolean
    Dim w As Single ' Total width
    
    w = Label.SideMargin * 2 + Label.LabelsAcross * Label.LabelWidth + _
            (Label.LabelsAcross - 1) * Label.HorizontalSpacing
    If w > Label.PageWidth Then
        If w - Label.PageWidth > 0.1 Then
            GoTo Err ' Wider than the page
        End If
    End If
    
    Dim t As Single
    t = Label.TopMargin * 2 + Label.LabelsDown * Label.LabelHeight + _
            (Label.LabelsDown - 1) * Label.VerticalSpacing
            
    If t > Label.PageHeight Then
        If t - Label.PageHeight > 0.1 Then
            GoTo Err ' Taller than the page
        End If
    End If
    
    VerifyLabel = True
    Exit Function
Err:
    VerifyLabel = False
End Function

'============================================================
' Sets the printer to be used
'============================================================
Public Sub SetPrinter(mode As Integer)
    Dim MyPrinter As Printer
    
    If mode = mdGetDefaultPrinter Then
        If gblDefaultPrinter = "" Then gblDefaultPrinter = Printer.DeviceName
    ElseIf mode = mdSetBarcodePrinter Then
        For Each MyPrinter In Printers
            If InStr(1, MyPrinter.DeviceName, "Godex") > 0 Then Set Printer = MyPrinter
        Next
    ElseIf mode = mdSetDefaultPrinter Then
        For Each MyPrinter In Printers
            If MyPrinter.DeviceName = gblDefaultPrinter Then Set Printer = MyPrinter
        Next
    End If
End Sub

'============================================================
' Check if Sample Exists in Database
'============================================================
Public Function SampleExists(Barcode As String, Optional SectionID As String, Optional mode As Integer) As Boolean
    Dim recBarcode As New ADODB.Recordset
    Dim intCtr As Integer
    
    With recBarcode
        If .State > 0 Then .Close
        
        .Open "Lab_Barcode_Search '" & Trim(Barcode) & "','" & SectionID & "','" & mode & "'", conLaboratory, adOpenDynamic, adLockReadOnly
        If .RecordCount > 0 Then
            ReDim arRequestNum(.RecordCount)
            ReDim arItemID(.RecordCount)
            ReDim arLabSectionID(.RecordCount)
            
            gblItemCount = .RecordCount
            For intCtr = 0 To gblItemCount - 1 Step 1
                arRequestNum(intCtr) = !RequestNum
                arItemID(intCtr) = !ItemID
                arLabSectionID(intCtr) = !SectionID
                .MoveNext
            Next
            
            SampleExists = True
        Else
            SampleExists = False
        End If
        
        If .State > 0 Then .Close
        Set recBarcode = Nothing
    End With
End Function

'============================================================
' Check if Label Exists in Database
'============================================================
Public Function LabelExists(Barcode As String, Optional SectionID As String) As Boolean
    Dim recBarcode As New ADODB.Recordset
    Dim intCtr As Integer

    With recBarcode
        If .State > 0 Then .Close
        .Open "Lab_Barcode_GetLabelData '" & Trim(Barcode) & "','" & SectionID & "'", conLaboratory, adOpenDynamic, adLockReadOnly
        If .RecordCount > 0 Then
            ReDim arBarcode(.RecordCount)
            ReDim arBarcodeText(.RecordCount)
            ReDim arSampleType(.RecordCount)
            ReDim arPatientName(.RecordCount)
            ReDim arSectionID(.RecordCount)
            ReDim arRefNum(.RecordCount)
            ReDim arSpecimenID(.RecordCount)
            
            gblItemCount = .RecordCount
            For intCtr = 0 To gblItemCount - 1 Step 1
                If !Barcode & "" <> "" Then
                    arBarcode(intCtr) = !Barcode
                Else
                    arBarcode(intCtr) = GetBarcodePrefix(!SectionID) & !RefNum _
                        & GetBarcodeSuffix(!SpecimenID)
                    conLaboratory.Execute "Lab_Barcode_Save '" & arBarcode(intCtr) _
                        & "','" & !SectionID & "','" & !RefNum & "','" & !SpecimenID & "'"
                End If
                arBarcodeText(intCtr) = arBarcode(intCtr)
                arSampleType(intCtr) = !SampleType
                arPatientName(intCtr) = !PatientName
                arSectionID(intCtr) = !SectionID
                arRefNum(intCtr) = !RefNum
                arSpecimenID(intCtr) = !SpecimenID
                .MoveNext
            Next
            LabelExists = True
        Else
            LabelExists = False
        End If
        If .State > 0 Then .Close
        Set recBarcode = Nothing
    End With
End Function

'============================================================
' Gets the current date from the database (format = mm/dd/yy)
'============================================================
Public Function GetBarcodePrintDate() As String
    Dim recGetDate As New ADODB.Recordset
            
    If recGetDate.State > 0 Then recGetDate.Close
        recGetDate.Open "Select getdate() as DateToday", CurrentUser.SQLConnection, adOpenDynamic, adLockReadOnly
        GetBarcodePrintDate = Format(recGetDate!DateToday, "mm/dd/yy")
    If recGetDate.State > 0 Then recGetDate.Close
End Function

'============================================================
' Gets Specimen Floating Time
'============================================================
Public Function GetSpecimenFloatingTime() As Integer
    Dim recGetSpecFT As New ADODB.Recordset
    
    With recGetSpecFT
        If .State > 0 Then .Close
        .Open "Lab_SpecimenFloatingTime", _
            CurrentUser.SQLConnection, adOpenDynamic, adLockReadOnly
        If !SpecFloatingTime & "" = "" Then GetSpecimenFloatingTime = 0 Else GetSpecimenFloatingTime = !SpecFloatingTime
        If .State > 0 Then .Close
    End With
    Set recGetSpecFT = Nothing
End Function

'============================================================
' Print Barcode Labels
'============================================================
Public Sub PrintSticker(BarcodeValue As String, TopText As String, BottomText As String)
    Dim Barcode As String
    
    Barcode = Chr(154) & BarcodeValue & getCheckDigit(BarcodeValue) & Chr(156)
    OpenMainReport App.Path & "\LabBarcodeLabel.rpt", "Laboratory", _
        Barcode, BarcodeValue, TopText, BottomText
    ShowReportViewer False, "Print Barcode Sticker", True
End Sub

Public Function GetBarcodePrefix(SectionID As String) As String
    Dim rsPrefix As New ADODB.Recordset
    
    With rsPrefix
        If .State > 0 Then .Close
        .Open "Laboratory..Lab_Barcode_GetPrefix '" & SectionID & "'", _
            CurrentUser.SQLConnection, adOpenDynamic, adLockReadOnly
        If .RecordCount > 0 Then
            GetBarcodePrefix = !BarcodeID & ""
        Else
            GetBarcodePrefix = ""
        End If
        .Close
        Set rsPrefix = Nothing
    End With
End Function

Public Function GetBarcodeSuffix(SpecimenID As String) As String
    Dim rsSuffix As New ADODB.Recordset
    
    With rsSuffix
        If .State > 0 Then .Close
        .Open "Lab_Barcode_GetAffix 1,'','" & SpecimenID & "'", _
            CurrentUser.SQLConnection, adOpenDynamic, adLockReadOnly
        If .RecordCount > 0 Then
            GetBarcodeSuffix = !BarcodeID
        Else
            GetBarcodeSuffix = ""
        End If
        .Close
        Set rsSuffix = Nothing
    End With
End Function

'============================================================
' Start: functions to calculate the ascii value for Barcode
' NP-09132006
'============================================================
Public Function getCheckDigit(strBCVal As String) As String
    Dim intLength As Integer
    Dim intCtr As Integer
    Dim intAscii As Integer
    Dim intCheckSum As Integer
    
    intCheckSum = 104
    intLength = Len(strBCVal)
    For intCtr = 1 To intLength Step 1
        intAscii = Asc(Right(Left(strBCVal, intCtr), 1))
        intCheckSum = intCheckSum + (getAsciiLoc(intAscii) * intCtr)
    Next
    
    getCheckDigit = Chr(GetCode128(intCheckSum Mod 103))
End Function

Public Function getAsciiLoc(intAscii As Integer) As Integer
    If intAscii = 128 Then
        getAsciiLoc = 0
    ElseIf intAscii > 32 And intAscii < 127 Then
        getAsciiLoc = intAscii - 32
    ElseIf intAscii > 126 And intAscii <> 128 Then
        getAsciiLoc = intAscii - 50
    End If
End Function

Public Function GetCode128(intAscii As Integer) As Integer
    If intAscii = 0 Then
        GetCode128 = 128
    ElseIf intAscii > 0 And intAscii < 95 Then
        GetCode128 = intAscii + 32
    ElseIf intAscii > 94 Then
        GetCode128 = intAscii + 50
    End If
End Function

Public Function GetExams(SampleID As String, SectionID As String) As String
    Dim recGetExams As New ADODB.Recordset
    Dim strExams As String
    Dim intCtr As Integer
    
    strExams = ""
    With recGetExams
        If .State > 0 Then .Close
        .Open "Lab_GetSpecimenExams '" & SampleID & "','" & SectionID & "'", conLaboratory, adOpenDynamic, adLockReadOnly
        If .RecordCount > 0 Then
            For intCtr = 0 To .RecordCount - 1 Step 1
                If intCtr = 0 Then
                    strExams = " (" & !ItemID & ") " & !LabResultName & ""
                Else
                    strExams = strExams & ", (" & !ItemID & ") " & !LabResultName
                End If
                .MoveNext
            Next
        End If
        If .State > 0 Then .Close
        Set recGetExams = Nothing
    End With
    GetExams = strExams
End Function
'============================================================
' End: functions declaration
'============================================================

Public Function ValidateEmailAddChar(intAscii As Integer) As Integer
    ValidateEmailAddChar = 0
    If intAscii = 8 Or intAscii = 13 Then ValidateEmailAddChar = intAscii
    If intAscii > 42 And intAscii < 58 Then ValidateEmailAddChar = intAscii
    If intAscii = 61 Then ValidateEmailAddChar = intAscii
    If intAscii >= 64 And intAscii <= 90 Then ValidateEmailAddChar = intAscii
    If intAscii = 94 Or intAscii = 95 Then ValidateEmailAddChar = intAscii
    If intAscii >= 97 And intAscii <= 123 Then ValidateEmailAddChar = intAscii
    If intAscii = 125 Or intAscii = 126 Then ValidateEmailAddChar = intAscii
End Function

Public Function GetPatientOtherData(intMode As Integer, strHospNum As String) As String
    Dim recGetPOD As New ADODB.Recordset
    
    With recGetPOD
        If .State > 0 Then .Close
        .Open "Lab_Barcode_GetCellNumEmail '" & strHospNum & "'", _
            conLaboratory, adOpenDynamic, adLockReadOnly
        If .RecordCount > 0 Then
            If intMode = 0 Then GetPatientOtherData = !CellNum & ""
            If intMode = 1 Then GetPatientOtherData = !Email & ""
        Else
            GetPatientOtherData = ""
        End If
        If .State > 0 Then .Close
        Set recGetPOD = Nothing
    End With
End Function