Attribute VB_Name = "modBillingSTD"
Option Explicit

Global blnPatientexist As Boolean

Global strStat As String
Global strAmount As String
Global strRemarks As String
Global blnIsAMPickUp As Boolean

Global strRoom As String
Public strMsg As String, strMsg1 As String
Public strProcedureRemarks As String ''Remarks for procedure together with Exam Remarks
Public strChecker As String

Global intRow As Integer
 
Global strStockOnHand As Double 'String

Global RevenueTableLoaded As Boolean
Global RevenueTable()
Global RevenueFields(21)
Dim RequestTableName As String
Dim ResultTableName As String
Dim HistoryTableName As String
Dim ExamName As String
Dim ItemCodeFieldName As String
Dim RevFORM As String

Global TransactionDate As Date

Global Xray As ADODB.Recordset
Global Lab As ADODB.Recordset
Global Ultra As ADODB.Recordset
Global RecOT As ADODB.Recordset

Global recPT As ADODB.Recordset
Global RecWC As ADODB.Recordset
Global RecCT As ADODB.Recordset
Global RecRT As ADODB.Recordset
Global RecAU As ADODB.Recordset
Global RecHS As ADODB.Recordset
Global RecNE As ADODB.Recordset
Global RecNU As ADODB.Recordset
Global RecEC As ADODB.Recordset

Global ExamListLoaded As Boolean

Public Function Get_TransactionDate() As Date

    TransactionDate = pclsUser.medsysclasses.Get_TransactionDate
     
'    Dim recDate As New ADODB.Recordset
'    'recDate.Open "select GETDATE() AS Tdate from Patient_data..tbHospitalInfo", pclsUser.sqlconnection, adOpenForwardOnly, adLockReadOnly
'    recDate.Open "select GETDATE() AS Tdate ", pclsUser.sqlconnection, adOpenForwardOnly, adLockReadOnly
'    TransactionDate = recDate!Tdate
'    Get_TransactionDate = recDate!Tdate
'    recDate.Close 'convert(varchar(10),getdate(),101)
'    Set recDate = Nothing
End Function

Public Sub Remove_Profile_List(strExamID As String, ProFileList As MSHFlexGrid)
    Dim intProfile As Integer
    Dim intCount As Integer
    intCount = ProFileList.Rows - 1
Routine:
    For intProfile = 1 To intCount
        With ProFileList
            If .Rows = 2 And .TextMatrix(1, 1) = "" Then
            Else
                If Trim$(.TextMatrix(intProfile, 3)) = Trim$(strExamID) Then
                    If .Rows = 2 And .TextMatrix(1, 1) <> "" Then
                        .TextMatrix(1, 1) = ""
                        .TextMatrix(1, 2) = ""
                        .TextMatrix(1, 3) = ""
                        .TextMatrix(1, 4) = ""
                    Else
                        .RemoveItem (intProfile)
                        intCount = .Rows - 1
                        GoTo Routine
                    End If
                End If
            End If
        End With
    Next
End Sub
  
'Public Function Check_ExamRequest(strID As String, strCode As String, strRevenueId As String) As Boolean
''Check supply if requested and status is pending
'Dim recCheckStatus As New ADODB.Recordset
'recCheckStatus.Open "STATION..Nurse_CheckExamStatus '" & Trim$(strID) & "','" & Trim$(strCode) & "','" & Trim$(strRevenueId) & "'", pclsUser.sqlconnection, adopenstatic, adLockReadOnly
'If Not recCheckStatus.EOF Then
'    'If MsgBox(Trim$(recCheckStatus!RequestDate) + vbOKOnly, "Message ") = vbOK Then
'        MsgBox "Item is already requested. Time: " + Trim$(recCheckStatus!Requestdate), vbOKOnly, "Message"
'        recCheckStatus.Close
'        Set recCheckStatus = Nothing
'        Check_ExamRequest = True
'        Exit Function
'    'End If
'Else
' Check_ExamRequest = False
'End If
'recCheckStatus.Close
'Set recCheckStatus = Nothing
'End Function

Public Function Check_ExamRequest(strID As String, strCode As String, strRevenueID As String) As Boolean
    'Check supply if requested and status is pending
    Dim recCheckStatus As New ADODB.Recordset
    recCheckStatus.Open "STATION..Nurse_CheckExamStatus '" & Trim$(strID) & "','" & Trim$(strCode) & "','" & Trim$(strRevenueID) & "'", pclsUser.sqlconnection, adOpenStatic, adLockReadOnly
    '---->>oski<<-----'
    '--allowing multiple request--'
    If isAllowMultipleRequest Then
    Exit Function
    
    Else
    If Not recCheckStatus.EOF Then
        If MsgBox(strMsg + Trim$(recCheckStatus!RequestDate) + strMsg1, vbOKOnly, "Message ") = vbOK Then
            recCheckStatus.Close
            Set recCheckStatus = Nothing
            Check_ExamRequest = True
            Exit Function
        End If
    Else
     Check_ExamRequest = False
    End If
    End If
    
    recCheckStatus.Close
    Set recCheckStatus = Nothing
End Function

Public Function Check_ExamPosted(strID As String, strCode As String, strRevenueID As String) As Boolean
    'Check medicines/supply if requested and status processed
    Dim recCheckStatus As New ADODB.Recordset
    recCheckStatus.Open "STATION..Nurse_CheckExam_Posted '" & Trim$(strID) & "','" & Trim$(strCode) & "','" & Trim$(strRevenueID) & "'", pclsUser.sqlconnection, adOpenStatic, adLockReadOnly
    If Not recCheckStatus.EOF Then
        If MsgBox("This Request has been PROCCESSED TODAY AT " + Trim$(recCheckStatus!ProcessDate) + "! Do you wish to REPEAT it ?", vbCritical + vbYesNo, "Message ") = vbNo Then
            recCheckStatus.Close
            Set recCheckStatus = Nothing
            Check_ExamPosted = True
            Exit Function
        End If
    Else
     Check_ExamPosted = False
    End If
    recCheckStatus.Close
    Set recCheckStatus = Nothing
End Function

Public Function Search_LaboratoryExam_MaxQty(strItemID As String) As Double

    Dim recLab As New ADODB.Recordset
    Dim strQuery As String

    Search_LaboratoryExam_MaxQty = 1
    strQuery = "Select Case " & _
               "           When IsNull(Isprocedure,0) = 1 and IsNull(Openquantity,0) = 1 then MaxQty " & _
               "           Else 1 " & _
               "       End As MaxQty " & _
               "From BUILD_FILE..tbCoLabExam WITH (NOLOCK) Where LabexamID = '" & Trim$(strItemID) & "';"

    If recLab.State > 0 Then recLab.Close

    recLab.Open strQuery, pclsUser.sqlconnection, adOpenForwardOnly, adLockReadOnly

    If Not recLab.EOF Then
        Search_LaboratoryExam_MaxQty = recLab!MaxQty
    End If
    If recLab.State > 0 Then recLab.Close
    Set recLab = Nothing
End Function

Public Function Search_XrayExam_MaxQty(strItemID As String) As Double

    Dim recXray As New ADODB.Recordset
    Dim strQuery As String

    Search_XrayExam_MaxQty = 1
    strQuery = "Select Case " & _
               "           When IsNull(Isprocedure,0) = 1 and IsNull(Openquantity,0) = 1 then MaxQty " & _
               "           Else 1 " & _
               "       End As MaxQty " & _
               "From BUILD_FILE..tbCoXrayExam WITH (NOLOCK)  Where XrayexamID = '" & Trim$(strItemID) & "';"

    If recXray.State > 0 Then recXray.Close

    recXray.Open strQuery, pclsUser.sqlconnection, adOpenForwardOnly, adLockReadOnly

    If Not recXray.EOF Then
        Search_XrayExam_MaxQty = recXray!MaxQty
    End If
    If recXray.State > 0 Then recXray.Close
    Set recXray = Nothing
End Function

Public Function Search_UltraExam_MaxQty(strItemID As String) As Double
    Dim recUltra As New ADODB.Recordset
    Dim strQuery As String

    Search_UltraExam_MaxQty = 1
    strQuery = "Select Case " & _
               "           When IsNull(Isprocedure,0) = 1 and IsNull(Openquantity,0) = 1 then MaxQty " & _
               "           Else 1 " & _
               "       End As MaxQty " & _
               "From BUILD_FILE..tbCoultraExam  WITH (NOLOCK)  Where UltraexamID = '" & Trim$(strItemID) & "';"

    If recUltra.State > 0 Then recUltra.Close
    recUltra.Open strQuery, pclsUser.sqlconnection, adOpenForwardOnly, adLockReadOnly

    If Not recUltra.EOF Then
        Search_UltraExam_MaxQty = recUltra!MaxQty
    End If
    If recUltra.State > 0 Then recUltra.Close
    Set recUltra = Nothing
End Function

Public Function Get_LabExam_StatID(strExamID As String, frmObject As Object)
    Dim recCheckStat As New ADODB.Recordset

    recCheckStat.Open "Select isnull(stat,'') AS Stat, datepart(dw,GETDATE()) as DayofWeek, " & _
                      "case " & _
                      "When convert(varchar(10),getdate(),101) +' 17:00:00' >= GEtDATE() then 'F' " & _
                      "When convert(varchar(10),getdate(),101) +' 17:00:00' < GEtDATE() then 'T' " & _
                      "END AS 'AFter5' from BUILD_FILE..tbcoLabExam Where LabexamID ='" & strExamID & "'", pclsUser.sqlconnection, adOpenForwardOnly, adLockReadOnly
    
    If Not recCheckStat.EOF Then
        If recCheckStat!Stat = "Y" Then
            frmObject.Option1(1).Value = True
            frmObject.Option1(0).Enabled = False
            frmObject.Option1(1).Enabled = True
        Else
            If recCheckStat!Stat = "N" Then
                frmObject.Option1(0).Value = True
                frmObject.Option1(1).Enabled = False
                frmObject.Option1(0).Enabled = True
            Else
                frmObject.Option1(0).Enabled = True
                frmObject.Option1(1).Enabled = True
                If recCheckStat!DayOfWeek = 7 Or recCheckStat!After5 = "T" Then
                    frmObject.Option1(1).Value = True
                Else
                    frmObject.Option1(0).Value = True
                End If
            End If
        End If
    End If
    recCheckStat.Close
    Set recCheckStat = Nothing

End Function

Public Function Get_Lab_Exam_Specimen(strExamID As String) As String
    Dim recSpecimen As New ADODB.Recordset
    recSpecimen.Open "STATION..sp_Nurse_GetLabExam_Specimen '" & Trim$(strExamID) & "'", pclsUser.sqlconnection, adOpenForwardOnly, adLockReadOnly
    'If recSpecimen.RecordCount > 1 Then
    If recSpecimen.EOF = False Then
     blnMoreSpecimen = True
    Else
     blnMoreSpecimen = False
    End If
    If blnMoreSpecimen Then
         strSpecimenID = ""
         Get_Lab_Exam_Specimen = ""
    Else
        If Not recSpecimen.EOF Then
         strSpecimenID = recSpecimen!code & ""
         Get_Lab_Exam_Specimen = recSpecimen![Description] & ""
        Else
         strSpecimenID = "0"
         Get_Lab_Exam_Specimen = "None"
         
        End If
    End If
    recSpecimen.Close
    Set recSpecimen = Nothing
                     
End Function

'Public Function myclsbilling.GetSpecializedRate(strCompanyCode As String, strRevenueId As String, strItemId As String) As Double
'Dim Rec As New ADODB.Recordset
'Dim SQL As String
'
'    SQL = "Build_File..spBuild_GetItemRate '" & strCompanyCode & "', '" & strRevenueId & "', '" & strItemId & "'"
'    With Rec
'        If .State > 0 Then .Close
'           .CursorLocation = adUseClient
'           .Open SQL, pclsUser.sqlconnection, adopenstatic, adLockOptimistic
'           If .RecordCount > 0 Then
'              myclsbilling.GetSpecializedRate = !RateA
'           End If
'    End With
'    Set Rec = Nothing
'
'End Function

Public Function Check_PatientsMed(strIdNum As String) As Boolean

    Dim recCash As New ADODB.Recordset
    
    recCash.Open "Select Isnull(PatientsMed,0) as PatientsMed from Patient_data..tbPatient2 WITH(NOLOCK) where IDNum ='" & Trim$(strIdNum) & "'", pclsUser.sqlconnection, adOpenForwardOnly, adLockReadOnly
    If Not recCash.EOF Then
        Check_PatientsMed = recCash!PatientsMed
    Else
        Check_PatientsMed = False
    End If
    recCash.Close
    Set recCash = Nothing
End Function

Public Sub Remove_Profile_OrderList(ProFileList As MSHFlexGrid, OrderList As MSHFlexGrid, intCol As Integer)
    Dim intOrder As Integer
    Dim intProfile As Integer

Routine:
    For intOrder = 1 To OrderList.Rows - 1
        For intProfile = 1 To ProFileList.Rows - 1
            If OrderList.Rows = 2 And OrderList.TextMatrix(1, 1) = "" Then
            Else
                If Trim$(ProFileList.TextMatrix(intProfile, 1)) = _
                   Trim$(OrderList.TextMatrix(intOrder, intCol)) Then
                    If OrderList.Rows = 2 And OrderList.TextMatrix(1, 1) <> "" Then
                        If intCol = 2 Then
                            If Not OrderList.TextMatrix(intOrder, 11) = "" Then
                                frmFinal.lstListLaboratory.RemoveItem OrderList.TextMatrix(intOrder, 11)
                                frmFinal.lstListLaboratory.AddItem OrderList.TextMatrix(intOrder, 10)
                                frmFinal.lstListLaboratory.Refresh
                            End If
                        End If

                        With OrderList
                            .TextMatrix(1, 1) = ""
                            .TextMatrix(1, 2) = ""
                            .TextMatrix(1, 3) = ""
                            .TextMatrix(1, 4) = ""
                            .TextMatrix(1, 5) = ""
                            .TextMatrix(1, 6) = ""
                            .TextMatrix(1, 7) = ""
                            .TextMatrix(1, 8) = ""
                            .TextMatrix(1, 9) = ""
                            .TextMatrix(1, 10) = ""
                            .TextMatrix(1, 11) = ""
                            If .Cols > 12 Then
                                .TextMatrix(1, 12) = ""
                                .TextMatrix(1, 13) = ""
                                .TextMatrix(1, 14) = ""
                                .TextMatrix(1, 15) = ""
                            End If
                        End With
                    Else
                        If intCol = 2 Then
                            If Not OrderList.TextMatrix(intOrder, 11) = "" Then
                                frmFinal.lstListLaboratory.RemoveItem OrderList.TextMatrix(intOrder, 11)
                                frmFinal.lstListLaboratory.AddItem OrderList.TextMatrix(intOrder, 10)
                                frmFinal.lstListLaboratory.Refresh
                            End If
                        End If
                        OrderList.RemoveItem (intOrder)
                        GoTo Routine
                    End If
                End If
            End If
        Next
    Next

End Sub

Public Function Check_OnHand(strItemID As String, strLocationID As String)
    Dim strA As String
    Dim Rec As New ADODB.Recordset
    strStockOnHand = 0
    
    strA = "select isnull(OnHand,0)Onhand from INVENTORY..tbinvent WITH (NOLOCK) where ItemID = '" & Trim$(strItemID) & "' and LocationID = '" & Trim$(strLocationID) & "'"
    
    With Rec
        .Open strA, pclsUser.sqlconnection, adOpenStatic, adLockReadOnly
        If .EOF = False Then
            strStockOnHand = !Onhand
        End If
        .Close
    End With
    strStockOnHand = strStockOnHand
    Set Rec = Nothing
    
End Function
 
Public Function Get_StockCardRevenueID(strRevenueID As String) As String
    Dim SQL As String
    Dim RecG As New ADODB.Recordset

    Get_StockCardRevenueID = ""

    SQL = "Select LocationID, StockCardRevenueID from Build_File..tbCoRevenueCode WITH(NOLOCK) WHERE RevenueID = '" & Trim$(strRevenueID) & "'"

    With RecG
        .CursorType = adOpenStatic
        .LockType = adLockReadOnly
        .Open SQL, pclsUser.sqlconnection

        If .EOF = False Then
'            If Len(Trim$(!LocationID)) > 0 Then
            If !LocationID <> "" Then
                Get_StockCardRevenueID = !StockCardRevenueID & ""
            End If
        End If
        .Close
    End With

    Set RecG = Nothing
End Function


Public Function Get_LocationID(strRevenueID As String) As String
    Dim SQL As String
    Dim recGet As New ADODB.Recordset

    Get_LocationID = ""

    SQL = "Select LocationID, StockCardRevenueID from Build_File..tbCoRevenueCode where RevenueID = '" & Trim$(strRevenueID) & "'"
    Dim RECL As New ADODB.Recordset
    
    With RECL
        If .State > 0 Then .Close
        '.CursorLocation = adUseClient
        .CursorType = adOpenStatic
        '.LockType = adLockOptimistic
        .LockType = adLockReadOnly
        .Open SQL, pclsUser.sqlconnection

        'If .RecordCount > 0 Then
        If .EOF = False Then
'            If Len(Trim$(!LocationID)) > 0 Then
            If RECL!LocationID <> "" Then
                Get_LocationID = !LocationID & ""
'                Get_StockCardRevenueID = !StockCardRevenueID & ""
            End If
        End If
        .Close
    End With

    Set recGet = Nothing
End Function

Public Function CheckLabSection(ItemID As String) As Boolean
    Dim RECL As New ADODB.Recordset
    Dim SQL As String
    CheckLabSection = False

    SQL = "Select * from Build_file..tbcoLabExam WITH (NOLOCK) where LabExamID = '" & ItemID & "'"

    With RECL
        .Open SQL, pclsUser.sqlconnection, adOpenStatic, adLockReadOnly
        If .EOF = False Then
            If !LabSectionID = "2" Then
                CheckLabSection = True
            End If
        End If
        .Close
    End With
    Set RECL = Nothing
End Function

Public Sub LoadRevenueTable()
    
    If RevenueTableLoaded = True Then
        Exit Sub
    End If
    
    Dim SQLStr As String
    Dim RECL As New ADODB.Recordset
    Dim RowCount As Integer
    Dim IX As Integer
    
    ' FROM RADIO
    '                   0     1              2       3            4          5               6               7            8         9         10            11               12            13               14                  15                  16                  17            18               19               20
    '                  ([ID], [Description], [Form], [RevenueID], [DeptNum], [SectionName], [RefNumSuffix], [SortOrder], [Active], [Common], [LocationID], [ChargeSlipNum], [RequestNum], [DICOMModality], [RequestTableName], [ResultTableName], [HistoryTableName], [IDFieldName], [ExamFieldName], [ExamTableName], [SectionIDFieldName])
    'VALUES (1, NULL, NULL, N' ', NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, N'otherrevenueid', N'otherrevenue', N'tbcootherrevenue', N'othersectionid')

    SQLStr = "select [ID], [Description], [Form], [RevenueID], [DeptNum], [SectionName], [RefNumSuffix], [SortOrder], [Active], [Common], [LocationID], [ChargeSlipNum], [RequestNum], [DICOMModality], [RequestTableName], [ResultTableName], [HistoryTableName], [IDFieldName], [ExamFieldName], [ExamTableName], [SectionIDFieldName] FROM BUILD_FILE..[tbRevenues]"
 

    ReDim Preserve RevenueTable(21, 0)
    With RECL
        'AddLog SQLStr
        .Open SQLStr, pclsUser.sqlconnection, adOpenStatic, adLockReadOnly
        If .EOF = False Then
            For IX = 0 To 20
                RevenueFields(IX) = RECL.Fields(IX).Name
            Next
        End If
        
        Do While Not RECL.EOF
            ReDim Preserve RevenueTable(21, RowCount)
            For IX = 0 To 20
                RevenueTable(IX, RowCount) = RECL.Fields(IX).Value
            Next
            RowCount = RowCount + 1
            .MoveNext
        Loop
        .Close
        
    End With
    RevenueTableLoaded = True
    
End Sub

Public Function GetChargeSlipNum(ByVal RevID As String, CSlipNum As String, LabNum As String) As String
    Dim TableName As String
    
    'If RevID = "MR" Then RevID = "MI"
    
    Dim recC As New ADODB.Recordset
    Dim SQLStr As String
    
    Dim wCS As Integer
    Dim wLabNum As Integer
    Dim wRequestNum As Integer
    
    Select Case UCase(RevID)
    
    Case "ON", "MG", "HC", "EC", "EG", "PH", "CS", "NE"
        TableName = "STATION..tbNurse" & RevID & "Slip"
        wCS = 1
        
    Case "LB", "XR", "AU", "CT", "NU", "PA", "US", "PT"
        TableName = "STATION..tbNurse" & RevID & "Slip"
        wCS = 1
        wLabNum = 1
    
    Case "HS"
        TableName = "STATION..tbNurse" & RevID & "Slip"
        wCS = 1
        wRequestNum = 1

    Case "MR", "MI"
        wCS = 1
        TableName = "STATION..tbNurseMISlip"
   
    Case "WC"
    
        TableName = "RADIOLOGY..tbOBULOPD"
        wRequestNum = 1
        
    End Select
    
    If TableName <> "" Then
        SQLStr = " SELECT * FROM " & TableName
        recC.Open SQLStr, pclsUser.sqlconnection, adOpenDynamic, adLockOptimistic
        If recC.EOF = False Then
        
            If wCS = 1 Then
                CSlipNum = recC.Fields("ChargeSlip") & ""
                recC.Fields("ChargeSlip") = Val(CSlipNum) + 1
            End If
            
            If wLabNum = 1 Then
                LabNum = recC.Fields("LabNum") & "" & ""
                recC.Fields("LabNum") = Val(LabNum) + 1
            End If
            
            If wRequestNum = 1 Then
                recC.Fields("RequestNum") = Val("RequestNum") + 1
            End If
            
            
            recC.Update
            
        End If
        recC.Close
    Else
        'SQLStr = "SELECT TOP 1 ChargeSlip from STATION..tbNurseOtherSlip Where Revenueid = Left(" & RevID & ",2) "
        SQLStr = "SELECT TOP 1 ChargeSlip from STATION..tbNurseOtherSlip Where Revenueid = '" & RevID & "' "
        
        
        If recC.EOF = False Then
        
            CSlipNum = recC.Fields("ChargeSlip") & ""
            recC.Fields("ChargeSlip") = Val(CSlipNum) + 1
            
            recC.Update
            
        End If
        
    End If
    
    CSlipNum = RevID & CSlipNum
    
        

End Function
  


Public Function GetBarcodePrefix(strSectionID As String) As String
    Dim Rec As New ADODB.Recordset
    Dim SQL As String
    Dim strBarcodePrefix As String
    'SQL = "Laboratory..Lab_Barcode_GetPrefix '" & Trim$(strSectionID) & "'"
    SQL = "select BarcodeID from Build_File..tbCoLabSection where LabSectionID =  '" & Trim$(strSectionID) & "'"
    

    With Rec
        If .State > 0 Then .Close
        .CursorType = adOpenStatic
        .LockType = adLockReadOnly
        .Open SQL, pclsUser.sqlconnection

        If .EOF = False Then
            strBarcodePrefix = !BarcodeID & ""
        End If
        .Close
    End With
    Set Rec = Nothing
    GetBarcodePrefix = Trim$(strBarcodePrefix)
End Function