Attribute VB_Name = "modMain"
Option Explicit
'*** Request Informations
Public Type RequestInfo
    strHospNum As String
    strIDNum As String
    strPatientName As String
    strSex As String
    strAge As String
    strCivilStatus As String
    strRoomID As String
    strRoomClass As String
    strStationID As String
    dtRequestDate As Date
    strPhysician As String
    strStat As String
'    strRefNum As String
    strTransplant As String
    strDialysis As String
    strORNum As String
    strCSNum As String
    strExamName As String
    strLabSection As String
    strLabSectionID As String
    strFormType As String
    strValueType As String
    strExamCode As String
    strPathologist As String
    strSpecimenId As String
    strSpecimen As String
    strPatientType As String
    strReaderId As String
    strReader As String
    strPDPhysician As String
    strPDPhysicianID As String
    strSupExamID As String
    strSupExam As String
    strPDResidentId As String
    strPDResident As String
    blnWithReagent As Boolean
    strMethod As String
    strBloodType As String
    DateFinished As Date
End Type

Public Type ResultInfo
    Remarks As String
    LogbookDate As Date
    SubmittedDate As Date
    ReportDate As Date
    AccessionNum As String
    intEntryMode As Integer
    Method As String
    DateFinished As Date
    InstrumentID As String
End Type




'Created by : Jetty P. OMo
'To get the reagent info

Public Type ReagentInfo
    ReagentID As String
    LocationID As String
    Quantity As Double
    MachineCode As String
    MachineDescription As String
End Type

Global gblRequestInfo As RequestInfo
Global gblResultInfo As ResultInfo
Global gblReagentInfo As ReagentInfo
Global strCode As String

Global LSearch As Object

'***Remarks, LogbookDate/Time, SubmittedDate/Time, ReportDate/TIme
'Global strRemarks As String
'Global LogbookDate As Date
'Global SubmittedDate As Date
'Global ReportDate As Date
'Global AccessionNum As String

Global dbConnection As New ADODB.Connection
Global blnResultVerified As Boolean
Global blnEdit As Boolean
Global blnBack As Boolean
Global blnPrintResult As Boolean
Global strHospName As String
Global strHospAdd As String
Global strHospTitle As String
Global strServerName  As String
Global blnEditMode As Boolean
Global blnVerifyMode  As Boolean
Global blnCancelled As Boolean
Global strMethod As String

Global strEmployeeName As String
Global strEmployeeCode As String
Global strMedTechId As String
Global strRequestNum As String
Global blnClerk As Boolean
Global sServerName As String
Global sServerUser As String
Global sServerPassword As String
'Global Searcher As Object
Global conStr As New ConnSettings
Global intFormCode As Integer
Global strProfileID As String
Global strExamID As String
Global blnCanVerify As Boolean

'Spelling Check
Public oWord As Object
Public strSelection As String

Public Report As CRAXDRT.Report

Sub Main()

End Sub

Public Sub OpenMainReport(ByVal strReportFileName As String, strDatabaseName As String, ParamArray strParameters())
   Dim crxParameterField As CRAXDRT.ParameterFieldDefinition
   Dim intCtr As Integer
   Dim intTotalParam As Integer
   Dim crxTable As CRAXDRT.DatabaseTable
   Dim crxApplication As New CRAXDRT.Application
   blnEdit = False
   intTotalParam = UBound(strParameters)
   If Not Report Is Nothing Then Set Report = Nothing
   Set Report = crxApplication.OpenReport(strReportFileName, 1)
   Report.ReportTitle = strHospName
   For Each crxTable In Report.Database.Tables
      crxTable.Location = strDatabaseName + Mid(crxTable.Location, InStr(1, crxTable.Location, "."))
      crxTable.SetLogOnInfo sServerName, strDatabaseName, sServerUser, sServerPassword
              
   Next
   If intTotalParam >= 0 Then
      For Each crxParameterField In Report.ParameterFields
         If intTotalParam >= intCtr Then
            crxParameterField.AddCurrentValue strParameters(intCtr)
         Else
            Exit For
         End If
         intCtr = intCtr + 1
      Next
   End If
   Set crxParameterField = Nothing
   Set crxTable = Nothing
   Set crxApplication = Nothing
        
End Sub

Public Sub OpenSubReport(ByVal strSubReport As String, strDatabaseName As String, ParamArray strParameters())
   Dim crxParameterField As CRAXDRT.ParameterFieldDefinition
   Dim intCtr As Integer
   Dim intTotalParam As Integer
   Dim crxTable As CRAXDRT.DatabaseTable
   Dim crxSubreport As CRAXDRT.Report
           
   intTotalParam = UBound(strParameters)
   Set crxSubreport = Report.OpenSubReport(strSubReport)
   crxSubreport.ReportTitle = strHospName
   For Each crxTable In crxSubreport.Database.Tables
      crxTable.Location = strDatabaseName + Mid(crxTable.Location, InStr(1, crxTable.Location, "."))
      crxTable.SetLogOnInfo sServerName, strDatabaseName, sServerUser, sServerPassword
   Next

   If intTotalParam >= 0 Then
      For Each crxParameterField In crxSubreport.ParameterFields
         If intTotalParam >= intCtr Then
            crxParameterField.AddCurrentValue strParameters(intCtr)
         Else
            Exit For
         End If
         intCtr = intCtr + 1
      Next
   End If
   Set crxParameterField = Nothing
   Set crxTable = Nothing
   Set crxSubreport = Nothing
        
End Sub

Public Sub ShowReportViewer(Optional blnShowGroupTree As Boolean = False, Optional strCaption As String = "", Optional blnDirectToPrinter As Boolean = False, Optional blnWithVerification As Boolean = False)
'(Optional blnShowGroupTree As Boolean = False, Optional strCaption As String = "", Optional blnDirectToPrinter As Boolean = False)
'Optional blnShowGroupTree As Boolean = False, Optional strCaption As String = "", Optional blnDirectToPrinter As Boolean = False, Optional blnWithVerification As Boolean = False
If blnDirectToPrinter Then
    Report.DisplayProgressDialog = False
    Report.PrintOut False
    Set Report = Nothing
Else

       Dim frmRView As New frmReportViewer
       With frmRView
          .ShowGroupTree = blnShowGroupTree
          .Caption = strCaption
          .DirectPrint = blnDirectToPrinter
          .crViewer1.Zoom 1
          .Show vbModal
       End With

End If
End Sub

Public Function GetPatientRequestInfo(RequestNum As String) As Boolean
    Dim recPatientSearch As New ADODB.Recordset
    
    GetPatientRequestInfo = False
    With recPatientSearch
        If .State > 0 Then .Close
            .CursorLocation = adUseClient
            .Open "Lab_Get_PatientInformation '" & Trim$(strRequestNum) & "'", dbConnection, adOpenDynamic, adLockReadOnly
            If .RecordCount > 0 Then
                    GetPatientRequestInfo = True
                    gblRequestInfo.strHospNum = !HospNum
                    gblRequestInfo.strIDNum = !IdNum
                    gblRequestInfo.strPatientName = !PatientName
                    gblRequestInfo.strSex = !Sex
                    gblRequestInfo.strAge = !Age
                    gblRequestInfo.strCivilStatus = !CivilStatus
                    gblRequestInfo.strRoomID = !RoomID
                    gblRequestInfo.strRoomClass = !Class
                    gblRequestInfo.strStationID = !Ward
                    gblRequestInfo.dtRequestDate = IIf(IsNull(!requestdate), Date, !requestdate)
                    gblRequestInfo.strPhysician = !Doctor
                    gblRequestInfo.strStat = !Rush
                    gblRequestInfo.strCSNum = !RefNum
                    gblRequestInfo.strTransplant = !Transplant
                    gblRequestInfo.strDialysis = !Dialysis
                    gblRequestInfo.strORNum = !ORNum
                    gblRequestInfo.strExamName = !ExamName
                    gblRequestInfo.strLabSection = !LabSection
                    gblRequestInfo.strLabSectionID = !SectionID
                    gblRequestInfo.strExamCode = !Code
                    gblRequestInfo.strFormType = !FormType
                    gblRequestInfo.strValueType = !ValueType
                    gblRequestInfo.strPathologist = !Pathologist
                    gblRequestInfo.strSpecimenId = !SpecimenID
                    gblRequestInfo.strSpecimen = !Specimen
                    gblRequestInfo.strReader = !Reader
                    gblRequestInfo.strReaderId = !ReaderID
                    gblRequestInfo.strPDPhysician = !Physician
                    gblRequestInfo.strPDPhysicianID = !PhysicianID
                    gblRequestInfo.strSupExamID = !SupExamID
                    gblRequestInfo.strSupExam = !SupExam
                    gblRequestInfo.strPDResidentId = !ResidentId
                    gblRequestInfo.strPDResident = !Resident
                    gblRequestInfo.blnWithReagent = IIf(Len(!WithReagent & "") = 0, 0, !WithReagent)
                    gblRequestInfo.strPatientType = !PatientType
                    gblRequestInfo.strMethod = !Method
                    gblRequestInfo.strBloodType = !BloodType
'                    gblRequestInfo.DateFinished = !DateFinished
                    strCode = !Code
            End If
        If .State > 0 Then .Close
        Set recPatientSearch = Nothing
    End With
End Function

Public Sub HighLight()
    With Screen.ActiveForm
        If (TypeOf .ActiveControl Is TextBox) Then
            .ActiveControl.SelStart = 0
            .ActiveControl.SelLength = Len(.ActiveControl)
        End If
    End With
End Sub

Public Function ValiText(KeyIn As Integer, ValidateString As String, _
    Editable As Boolean) As Integer
    Dim ValidateList As String
    Dim KeyOut As Integer

    If Editable = True Then
        ValidateList = UCase(ValidateString) & Chr(8)
    Else
        ValidateList = UCase(ValidateString)
    End If

    If InStr(1, ValidateList, UCase(Chr(KeyIn)), 1) > 0 Then
        KeyOut = KeyIn
    Else
        KeyOut = 0
        Beep
    End If

    ValiText = KeyOut

End Function

Public Sub MT_Rights(myform As Form)
    If blnClerk = False Then
        myform.fraMedTech.Enabled = True
    Else
        myform.fraMedTech.Enabled = False
    End If
End Sub

Public Function Search_Donors(strLastName As String) As Boolean
    
    Dim Com As New ADODB.Command
    Dim rec As New ADODB.Recordset
        
        Search_Donors = False
        With Com
            .ActiveConnection = dbConnection
            .CommandText = "Laboratory.dbo.Search_Donor_Or_Recipient_By_LastName"
            .CommandType = adCmdStoredProc
            .Parameters.Append .CreateParameter("LastName", adVarChar, adParamInput, 20, strLastName)
            Set rec = .Execute()
            If Not rec.EOF Then
                Search_Donors = True
            End If
            rec.Close
            Set rec = Nothing
            Set Com = Nothing
        End With
End Function

Public Sub EmbossText(myform As Form)
    Dim ctr As Integer
    For ctr = 1 To 3
        Load myform.lblHeader(ctr)
        myform.lblHeader(ctr).Visible = True
    Next
    myform.lblHeader(1).Left = myform.lblHeader(0).Left - 10
    myform.lblHeader(1).Top = myform.lblHeader(0).Top - 10
    myform.lblHeader(1).ForeColor = &H80000005
    myform.lblHeader(2).Left = myform.lblHeader(0).Left + 10
    myform.lblHeader(2).Top = myform.lblHeader(0).Top + 10
    myform.lblHeader(2).ForeColor = &HC0C0C0
    myform.lblHeader(3).Left = myform.lblHeader(0).Left + 20
    myform.lblHeader(3).Top = myform.lblHeader(0).Top + 20
    myform.lblHeader(3).ForeColor = &H80000012
End Sub

Public Sub EnableFormButtons(myform As Form, Enable As Boolean)
    myform.cmdPrint.Enabled = Enable
    myform.cmdVerify.Enabled = Enable
    myform.cmdSave.Enabled = Enable
End Sub

Public Sub GetResult()
    Dim recExams As New ADODB.Recordset
    If recExams.State > 0 Then recExams.Close
    recExams.CursorLocation = adUseClient
    recExams.Open "Lab_FormMaker_GetResult '" & strRequestNum & "'", dbConnection, adOpenDynamic, adLockReadOnly
    If recExams.RecordCount > 0 Then
        gblResultInfo.LogbookDate = recExams!lratime
        gblResultInfo.SubmittedDate = recExams!samplesubmitted
        gblResultInfo.ReportDate = recExams!ResultDate
        gblResultInfo.intEntryMode = recExams!EntryMode
        gblResultInfo.Remarks = recExams!Remarks
        gblResultInfo.AccessionNum = recExams!AccessionNum
        gblResultInfo.Method = recExams!Method
        gblResultInfo.DateFinished = recExams!DateFinished
        gblResultInfo.InstrumentID = recExams!InstrumentID & ""
    End If
    If recExams.State > 0 Then recExams.Close
End Sub

Function MsSpellCheck(strText As String) As String

       Set oWord = CreateObject("Word.Basic")
       oWord.AppMinimize
       MsSpellCheck = strText
       oWord.FileNewDefault
       oWord.EditSelectAll
       oWord.EditCut
       oWord.Insert strText
       oWord.StartOfDocument
       On Error Resume Next
       oWord.ToolsSpelling
       On Error GoTo 0
       oWord.EditSelectAll
       strSelection = oWord.Selection$

      If Mid(strSelection, Len(strSelection), 1) = Chr(13) Then
             strSelection = Mid(strSelection, 1, Len(strSelection) - 1)
      End If

      If Len(strSelection) > 1 Then
             MsSpellCheck = strSelection
      End If

      oWord.FileCloseAll 2
      oWord.AppClose
      Set oWord = Nothing
 End Function

Function GetServerDate() As Date
    Dim a As New ADODB.Recordset
    
    a.Open "SELECT getdate() as serverdate", _
                dbConnection, adOpenDynamic, adLockReadOnly
        GetServerDate = a!serverdate
    a.Close
    Set a = Nothing
End Function

Function ComputeConversion(Factor As String, Result As String, Examcode As String, Column As Integer) As String
    Dim dblFactor As Double
    Dim dblResult As Double
    Dim dblComputed As Double
    Dim strOperator As String
    Dim strResult As String
    Dim a As New ADODB.Recordset
    If a.State > 0 Then a.Close
    a.CursorLocation = adUseClient
    a.Open "sp_LabLoadExamEntry '" & Examcode & "'", dbConnection, adOpenDynamic, adLockReadOnly
        If a.RecordCount > 0 Then
            strOperator = a!Operator
        End If
    a.Close
    Set a = Nothing
    
    If gblRequestInfo.strFormType = "7" Then
        ComputeConversion = ""
    Else
        If Factor <> 0 Then
            If (IsNumeric(Factor) And IsNumeric(Result)) Then
                dblFactor = CDbl(Factor)
                dblResult = CDbl(Result)
                If strOperator = "*" Then
                    dblComputed = dblResult * dblFactor
                Else
                    dblComputed = dblResult / dblFactor
                End If
                ComputeConversion = CStr(Format(dblComputed, "0.00"))
            Else
              If Left(Result, 1) = ">" Then
                strResult = Replace(Result, ">", "")
                dblFactor = CDbl(Factor)
                dblResult = CDbl(strResult)
                If strOperator = "*" Then
                    dblComputed = dblResult * dblFactor
                Else
                    dblComputed = dblResult / dblFactor
                End If
                ComputeConversion = CStr(Format(dblComputed, "0.00"))
                
             ElseIf Left(Result, 1) = "<" Then
                strResult = Replace(Result, "<", "")
                dblFactor = CDbl(Factor)
                dblResult = CDbl(strResult)
                If strOperator = "*" Then
                    dblComputed = dblResult * dblFactor
                Else
                    dblComputed = dblResult / dblFactor
                End If
                ComputeConversion = CStr(Format(dblComputed, "0.00"))
                
             Else
                ComputeConversion = ""
             End If
                   
            End If
        ElseIf Factor = 0 And strOperator = "" Then
            ComputeConversion = Result
        Else
            ComputeConversion = ""
        End If
    End If
End Function
'Public Function GetReagentinfo(ItemID As String) As Boolean
'    Dim recReagent As New ADODB.Recordset
'
'    GetReagentinfo = False
'
'    With recReagent
'        If .State > 0 Then .Close
'        .CursorLocation = adUseClient
'        .Open "Select * from BUILD_FILE..tbcoLabExamReagent Where LabExamID = '" & ItemID & "'", dbConnection, adOpenDynamic, adLockReadOnly
'        If Not .EOF Then
'            gblReagentInfo.LocationID = !LocationID & ""
'            gblReagentInfo.Quantity = !ReagentQty
'            gblReagentInfo.ReagentID = !ReagentID
'            GetReagentinfo = True
'        Else
'            gblReagentInfo.LocationID = ""
'            gblReagentInfo.Quantity = 0
'            gblReagentInfo.ReagentID = ""
'            GetReagentinfo = False
'        End If
'        .Close
'        Set recReagent = Nothing
'    End With
'
'
'End Function
Public Sub AppendStockCard(strHospNum As String, _
                           strIDNum As String, _
                           strItemID As String, _
                           strTransDate As String, _
                           strRefNum As String, _
                           dblQuantity As Double, _
                           dblQuantityRec As Double, _
                           dblAmount As Double, _
                           strUserID As String, _
                           strDosageID As String, _
                           strRequestByID As String, _
                           strLocationID As String, _
                           strTargetLocationID As String, _
                           strRoomID As String, intShift As Integer, _
                           Optional strRevenueID As Variant = "PH", _
                           Optional strSummaryCode As String = "PH", _
                           Optional strClinicID As String = "", _
                           Optional strItemType As String = "D", _
                           Optional strRemark As String = "", _
                           Optional strRequestNumber As String = "", _
                           Optional strInOut As String = "I", _
                           Optional intCommunication As Integer = 0, _
                           Optional intPostOrReturn As Integer = 1, _
                           Optional strCreditMemoNum As String = "", _
                           Optional intDispenserCode As Integer = 0, Optional strCashName As String = "", Optional strSequence As String = "", Optional datReportDate As String, Optional intSenior As Integer = 0, Optional strAcctNum As String = "", Optional strCashAddress As String = "", Optional strCashDoctor As String = "")
   Dim recAppendStockCard As New ADODB.Recordset
   
   'On Error GoTo AppendStockCardErr
   
   With recAppendStockCard
      .Open "Inventory.dbo.Drug_AddStockCard '" & strSummaryCode & "','" & _
                                       strHospNum & "','" & _
                                       strIDNum & "','" & _
                                       strItemID & "','" & _
                                       strTransDate & "','" & _
                                       strRevenueID & "','" & _
                                       strRefNum & "','" & _
                                       dblQuantity & "','" & _
                                       dblQuantityRec & "','" & _
                                       dblAmount & "','" & _
                                       strUserID & "','" & _
                                       strDosageID & "','" & _
                                       strClinicID & "','" & _
                                       strItemType & "','" & _
                                       strRequestByID & "','" & _
                                       strLocationID & "','" & _
                                       strTargetLocationID & "','" & strRoomID & "','" & _
                                       strRemark & "','" & _
                                       strRequestNumber & "','" & _
                                       strInOut & "','" & _
                                       intCommunication & "','" & _
                                       intPostOrReturn & "','" & _
                                       strCreditMemoNum & "','" & intDispenserCode & "','" & strCashName & "','" & strSequence & "','" & datReportDate & "','" & intShift & "','" & intSenior & "','" & strAcctNum & "','" & strCashAddress & "','" & strCashDoctor & "'", _
             dbConnection, adOpenDynamic, adLockOptimistic
      If .State > 0 Then .Close
   End With
   
   Set recAppendStockCard = Nothing
   
   Exit Sub

AppendStockCardErr:
'   Call RaiseError(MyUnhandledError, "Drug: AppendStockCard Method")
End Sub




'Created BY jetty P. OMo
' To get the reagent information

Public Function GetReagentinfo(Examcode As String) As Boolean

    Dim recReagent As New ADODB.Recordset
    If recReagent.State > 0 Then recReagent.Close
    recReagent.CursorLocation = adUseClient
    recReagent.Open "lab_getReagentInfo '" & strCode & "'", dbConnection, adOpenDynamic, adLockReadOnly
    If recReagent.RecordCount > 0 Then
        gblReagentInfo.ReagentID = recReagent!ReagentCode
        gblReagentInfo.LocationID = recReagent!LocationID
        gblReagentInfo.Quantity = recReagent!Quantity
        gblReagentInfo.MachineCode = recReagent!ReagentCode
        gblReagentInfo.MachineDescription = recReagent!Reagent & ""
     End If
    If recReagent.State > 0 Then recReagent.Close
End Function

Public Sub LoadResultViewer(IdNum As String, User As String, _
                            HospNum As String, RefNum As String)
On Error GoTo Hell:
Dim ResultViewer As Object

Set ResultViewer = CreateObject("labresultinquiry.labresultviewer")

    With ResultViewer
        .Idnumber = IdNum
        .UserId = User
        .HospitalNumber = HospNum
        .CSNumber = RefNum
        .ViewMode = "0"
        .Show_Results
    End With

Set ResultViewer = Nothing
Exit Sub
Hell:
    MsgBox "Unable to load Result Viewer.", vbExclamation
End Sub


Public Sub ResizeFormToScreen(FrmName)
Dim XRatio As Integer
Dim YRatio As Integer
Dim i As Integer
    'The 'On Error Resume Next' is needed because there might be
    'some controls on the form that may not support some of the
    'properties that will be set
    On Error Resume Next

    'If the form's windows state is minimized or maximized then exit
    If FrmName.WindowState <> 0 Then Exit Sub

    'Calculate the X and Y resizing ratio
    XRatio = Screen.Width / FrmName.Width
    YRatio = Screen.Height / FrmName.Height

    'Set the form's origin to 0,0
    FrmName.Top = 0
    FrmName.Left = 0

    'Resize the form's height, width , and font size
    FrmName.Height = FrmName.Height * YRatio
    FrmName.Width = FrmName.Width * XRatio
    FrmName.Font.Size = FrmName.Font.Size * XRatio

    'Loop through all the controls on the from and repostion every
    'control relative to the form origin, then resize thier width,
    'height, and Font.Size properties
    For i = 0 To FrmName.Controls.Count - 1
       FrmName.Controls(i).Left = FrmName.Controls(i).Left * XRatio
       FrmName.Controls(i).Top = FrmName.Controls(i).Top * YRatio
       FrmName.Controls(i).Height = FrmName.Controls(i).Height * YRatio
       FrmName.Controls(i).Width = FrmName.Controls(i).Width * XRatio

       'Note: The control's font will resize only if it is a truetype font
       FrmName.Controls(i).Font.Size = FrmName.Controls(i).Font.Size * XRatio
    Next i
    End Sub