Attribute VB_Name = "modAdmitPatient" Option Explicit Public Const cvarPediaAge = 14 Public Const cvarBirthPlace = 0 Public Const cvarTelNumber = 2 Public Const cvarHouseStreet = 1 Public Const cvarBarangay = 3 Public Const cvarTown = 4 Public Const cvarOccupation = 5 Public Const cvarNationality = 6 Public Const cvarReligion = 7 Public Const cvarSpouse = 8 Public Const cvarBarangayCaptain = 9 Public Const cvarName = 0 Public Const cvarAddress = 1 Public Const cvarEmployer = 3 Public Const cvarRelationship = 3 Public Const cvarLastName = 0 Public Const cvarFirstName = 1 Public Const cvarMiddleName = 2 Public Const cvarCode = 0 Public Const cvarDesc = 1 Public Const cvarRemarks = 2 'Public Const cvarAttendingDrID = 0 'Public Const cvarAdmittingDrID = 1 'Public Const cvarConsultantDrID = 2 'Public Const cvarReferringDrID = 3 'Public Const cvarAttendingDrName = 4 'Public Const cvarAdmittingDrName = 5 'Public Const cvarConsultantDrName = 6 'Public Const cvarReferringDrName = 7 'VBB 07.02.18 Addition revision Public Const cvarAttendingDrID = 0 Public Const cvarAttendingDrName = 11 Public Const cvarAttendingDrID2 = 1 Public Const cvarAttendingDrName2 = 12 Public Const cvarAttendingDrID3 = 2 Public Const cvarAttendingDrName3 = 13 Public Const cvarAttendingDrID4 = 3 Public Const cvarAttendingDrName4 = 14 Public Const cvarAttendingDrID5 = 4 Public Const cvarAttendingDrName5 = 15 Public Const cvarAdmittingDrID = 5 Public Const cvarAdmittingDrName = 16 Public Const cvarReferringDrID = 6 Public Const cvarReferringDrName = 17 Public Const cvarReferringDrID2 = 7 Public Const cvarReferringDrName2 = 18 Public Const cvarReferringDrID3 = 8 Public Const cvarReferringDrName3 = 19 Public Const cvarReferringDrID4 = 9 Public Const cvarReferringDrName4 = 20 Public Const cvarReferringDrID5 = 10 Public Const cvarReferringDrName5 = 21 Public Const cvarMedicareType = 16 Public Const cvarMale = 0 Public Const cvarFemale = 1 ' Medicare Membership Type Public Const cvarSSSMember = "SM" Public Const cvarSSSDependent = "SD" Public Const cvarGSISMember = "GM" Public Const cvarGSISDependent = "GD" 'Hospitalization Plan Public Const cvarPersonal = "P" Public Const cvarCompany = "C" Public Const cvarInsurance = "I" Public Const cvarOthers = "O" 'How the patient was admitted Public Const cvarAmbulatory = "A" Public Const cvarWheelChair = "W" Public Const cvarStretcher = "S" Public Const cvarByRelatives = "C" 'Patient Location(Incase of patient large count) Public Const cvarRoom = "R" Public Const cvarHallWay = "H" Public Const cvarERLoc = "E" 'Patient Classification Public Const cvarHouseCase = "H" Public Const cvarPrivatePatient = "P" Public Const cvarServicePatient = "S" Public Const cvarAHMO = "A" 'Civil Status Public Const cvarChild = "0" Public Const cvarSingle = "1" Public Const cvarMarried = "2" Public Const cvarWidow = "3" Public Const cvarSeparated = "4" Public Const cvarDivorced = "5" Public Const cvarWidower = "6" 'Type of Package Public Const cvarPlanA = "0" Public Const cvarPlanB = "1" Public Const cvarPlanC = "2" Public Const cvarNormal = "3" Public Const cvarCaesarian = "4" Public Const cvarSP = "5" Public Const cvarGP = "6" 'Type of Admission Public Const cvarIndustrial = "0" Public Const cvarEmployee = "1" Public Const cvarDoctor = "2" Public Const cvarHMO = "3" Public Const cvarPrivate = "4" Public Const cvarWalkIn = "5" Public Const cvarOPDF = "6" 'Public pclsMain As clsPatient 'Public pclsAdmission As clsAdmission Public pclsMain As Object Public pclsAdmission As Object Public pclsBilling As Object 'Public pclsMasterSearch As New clsPatientSearch 'Public pclsCodeSearch As New clsCodeSearch 'Public pclsUser As New clsCurrentUser 'Public pclsMasterSearch As MasterSearch.clsPatientSearch 'Public pclsCodeSearch As CodeSearchForm.clsCodeSearch Public pclsMasterSearch As Object Public pclsCodeSearch As Object Global pclsUser As Object Public CF4 As Object ''Eclaims 11/07/18 Public Eclaims As Object Public ZipCode As Object Public MedicareType As Object Public MemberList As Object Public EmployerList As Object Public Medicare As Object Public ListZipCode As Object Public Icd10 As Object Public DoctorList As Object Public Doctor As Object 'Public MEDSYSClass As Object Public MEDSYSClass As Object 'isallowuservalidation Public pstrConnectionString As String Public pubstrHospNum As String Public pubstrIDNum As String Public pubblnSelected As Boolean Public pubReferredFromCode As String Public pubWatcherID As String 'Room Reservation Patient Name Public pubstrRLastName As String Public pubstrRFirstName As String Public pubstrRMiddleName As String Public pubstrReservNum As String Public pubstrBirthDay As String Public pubstrAge As String Public pubstrAdmDate As String 'Public pubstrNewBornID As String Public pblnNewWatcher As Boolean Public pblnBottonClick As Boolean Public pblnPatient As Boolean Public pstrHospitalName As String Public pstrHospitalAddress As String Public pdCurDate As Date Public pstrServerName As String Public pblnRefresh As Boolean Public pstrCurBookMark As String Public pstrHospitalMTS As String Public pstrAdditionalBed As String Public dblAdditionalRate As Double Public pblnCanLoadWatcher As Boolean Public pstrReservationMode As String Public pblnReserved As Boolean Public Report As CRAXDRT.Report Public Peedy As IAgentCtlCharacter Public pstrWristBType As String Public glngHospitalID As HospitalTypeEnum Public gobjDatasheet As New CrystalReport1 Public strLocalFileNum As String Global strAge As String Global recFile As New ADODB.Connection Public clsUserLog As New clsAccountStatus Public pstrEmployeeID As String Public pstrRemarks As String Public pstrDate As String Public ClientName As String Public pubPediaAgeLimit As Integer Public blnAllowRoomTransferWithPendingRequest Public strFileName As String Public blnExport As Boolean Public gobjCard As New Card Public gobjWristBand As New WristBand Public Enum HospitalTypeEnum cHospTypeCebuDoctors = 0 cHospTypeSeamens = 1 cHospTypeAUF = 2 cHospTypeStaRosa = 3 cHospTypeAllahValley = 4 End Enum Public glngReportType As ReportTypeEnum Public Enum ReportTypeEnum cDatasheet = 0 cSmartCard = 1 'pk cNameTag = 2 cWristBand = 3 End Enum Public gstrIDNumForNameTagReport As String Public gstrCardNumberForSmartCardReport As String Public gbUseIDnumAsBarcode As Boolean Public gstrCardNumberForWristBandReport As String 'Admitting Set Up Public blnAllowEstimateAge As Boolean Public blnAllowSearchBarangay As Boolean Public blnAllowOldHospNumEntry As Boolean Public blnAllowShowNewMainForm As Boolean Public blnAllowBarcode As Boolean Public blnAllowChangeInfo As Boolean Public blnAllowNewBornID As Boolean Public blnAllowPatientCard As Boolean Public blnAllowERNotificationMsg As Boolean Public blnAllowShowNewResult As Boolean Public blnAllowByPeriodReport As Boolean Public blnisAllowDischargewithoutBillingDate As Boolean 'Public blnisAllowDischargeBlockListed As Boolean Public blnisAllowAdmitBlockListed As Boolean Public blnIsAllowEditAdmissionDate As Boolean Public blnIsAllowSupervisorConfirmation As Boolean Public blnAllowCheckOPDConsultation As Boolean Public blnAllowHospitalizationGuide As Boolean Public blnAllowAccountConsolidation As Boolean Public blnAllowAffiliatedDoctorsOnly As Boolean Public blnAllowNewInsuranceHMOcondition As Boolean Public blnAllowCheckAdmdateGreaterThanCharges As Boolean Public blnAllowLoadERDoctorAsAdmDoctor As Boolean Public blnAllowAccountUnConsolidation As Boolean Public blnAllowCF4Entries As Boolean Public blnAllowEclaimsChecking As Boolean Public blnAllowShowBalance As Boolean Public blnAllowDoctorSearchByService As Boolean Public blnAllowCheckPendingRequestOnRoomTransfer As Boolean Public blnAllowCF4OnRegistration As Boolean Public blnAllowAdmitOnOccupiedRoom As Boolean Public blnAllowAutoChargeAdmissionKit As Boolean Public blnAllowAutoChargeRoom As Boolean Public blnLoadPreviousGuarantor As Boolean Public strPHICExpAdjustmentDays As String Public strPRCExpAdjustmentDays As String Public blnAllowPRCExpirationOnDoctor As Boolean Public blnAllowNoBalanceBillingTag As Boolean Public blnAllowSetDefaultValues As Boolean Public blnAllowNewSuffix As Boolean 'Admitting Label Setup Public strLabelLastName As String Public strLabelFirstName As String Public strLabelMiddleName As String Public strLabelTitle As String Public strLabelBirth As String Public strLabelGender As String Public strLabelBirthPlace As String Public strLabelBarangay As String Public strLabelTownProvince As String Public strLabelForeignAddress As String Public strLabelCountry As String Public strLabelOccupation As String Public strLabelGuarantor As String Public strLabelOtherGuarantor As String Public strLabelHospitalizationPlan As String 'SMS vbb Public intRD As Integer Public intPB As Integer Public intXR As Integer Public intLR As Integer 'Build path for excel export Global fs As Object 'Unshow Admit form blnTheresBalance Public blnContinuewithBalance As Boolean 'Prompt at Opening Public blnShowMasterSearch As Boolean 'Password Confirmation Public Const KC_PASSWORD_KEY = "ROBERTFKAISER" 'Continue showing admitform case from MasterSearch to AdmitForm Public ConShowAdmitForm As Boolean 'Admitting Report Setup Public blnmnuDailyLogbook As Boolean Public blnmnuReportAdmissionList As Boolean Public blnmnuReportDischargeList As Boolean Public blnmnuDailySummaryofRoomTransfer As Boolean Public blnmnuNarrativeReport As Boolean Public blnmnuDailyPatientType As Boolean Public blnmnuDailySummary As Boolean Public blnmnuWatchersList As Boolean Public blnmnuReportCensusAllPatient As Boolean Public blnmnuReportCensusByStation As Boolean Public blnmnuReportCensusByDeposits As Boolean Public blnmnuReportGrandCensus As Boolean Public blnmnuFinancialReport As Boolean Public blnmnuPackageCensusReport As Boolean Public blnmnuSummaryHMOLOA As Boolean Public blnmnuReportHMOCompany As Boolean Public blnmnuReportStatisticsDaily As Boolean Public blnmnuStatisticsByStation As Boolean Public blnmnuReportStatisticsMonthly As Boolean Public blnmnuReportStatisticsPeriod As Boolean Public blnmnuAdmissionByCompany As Boolean Public blnmnuMonthlyAdmissionAndReAdmission As Boolean Public blnmnuMonSumHospStat As Boolean Public blnmnuAdmLogbook As Boolean Public blnmnuMonthlyRepPatientType As Boolean Public blnmnuStatisticByShifting As Boolean Public blnmnuDailyCensusByPatientType As Boolean Public blnMnuDailyCensusByService As Boolean Public blnmnuDailyCensusTotalHMO As Boolean Public blnmnuMonthlySummaryOfActivities As Boolean Public blnmnuReportAvailability As Boolean Public blnmnuSummaryOfRoomTransfer As Boolean Public blnmnuReportDoctorPxList As Boolean Public blnmnuCompanyList As Boolean Public blnmnuListOfReservations As Boolean Public blnmnuListOfDischargeOrders As Boolean Public blnmnuTypeOfAdmission As Boolean Public blnmnuWalkIn As Boolean Public blnmnuListOfRevokeDischarges As Boolean Public blnmnuAbsconded As Boolean Public blnmnuMembership As Boolean Public blnmnu_Transferred As Boolean Public blnmnuRoomStatus As Boolean Public blnmnuWellBabyAdmList As Boolean Public blnMnuPatientWithBirthDate As Boolean Public blnmnuYearlyPxByArea As Boolean Public blnmnuPatientByReligion As Boolean Public blnOtherMonthlyDoctorsInvolvement As Boolean Public blnmnuMonthlyOccupancy As Boolean Public blnOtherDefectiveRooms As Boolean Public blnmnuDoctorsPatientLoad As Boolean Public blnNursingDeptStatistics As Boolean Public blnSeaFarer As Boolean 'How the patient Find Us Public Const cvarWellNessWebSite = "W" Public Const cvarHospitalWebSite = "H" Public Const cvarPhoneCall = "P" Public Const cvarOtherWay = "O" 'PatientType Public Const cvarER = 1 Public Const cvarCarriedOrder = 2 Public Const cvarDR = 3 'Web Cam Public ObjWebcam As Object 'Tab Error Win8/Win7 Global WshShell As Object Public blnAdmitFormDisplayed As Boolean 'Private StrStationWithPendingRequest As String Public strUserCode_Transaction As String Public strUserName_Transaction As String Public Sstationname, SstationID As String Public ProgExeName As String 'Required Field 07.06.18 Public blnReqLastName As Boolean Public blnReqFirstName As Boolean Public blnReqMiddleName As Boolean Public blnReqBirthDate As Boolean Public blnReqGender As Boolean Public blnReqCivilStatus As Boolean Public blnReqTownProvince As Boolean Public blnReqNationality As Boolean Public blnReqReligion As Boolean Public blnReqNotifyIncaseOfEmergeny As Boolean Public blnReqInformant As Boolean Public blnReqGuarantor As Boolean Public blnReqHospitalizationPlan As Boolean Public blnReqPatientClass As Boolean Public blnReqAdmissionType As Boolean Public blnReqNoticeOfAdmission As Boolean Public blnReqRoom As Boolean Public blnReqService As Boolean Public blnReqAttendingDr As Boolean Public blnReqAdmissionDiagnosis As Boolean Public blnReqChiefComplaint As Boolean Public blnReqPrecaution As Boolean Public blnReqAdmittingImpression As Boolean Public blnReqTypeOfStay As Boolean Public blnReqCF4RequiredEntry As Boolean Public blnReqHouseStreetBarangay As Boolean Public blnAllowCreditLine As Boolean Public blnReqNoBalanceBilling As Boolean Private RecSetup As New ADODB.Recordset Private CurrTable As String Public recAccomodation As New ADODB.Recordset Public RecRelationship As New ADODB.Recordset Public RecCivilStatus As New ADODB.Recordset Public Sub Main() Dim strPart As String ' On Error GoTo Main_Err ' Dim frmAdmission As New frmAdmitPatient ' On Error GoTo errMain 100 Set pclsUser = CreateObject("Medsys_User.clsCurrentUser", "") pclsUser.SetExePath = App.Path 102 Set pclsCodeSearch = CreateObject("CodeSearchForm.clsCodeSearch") 104 Set pclsMasterSearch = CreateObject("MasterSearch.clsPatientSearch") 106 Set pclsBilling = CreateObject("prjbillingclass.clsBilling") ' Set clsBuild = CreateObject("AdmBuildFile.clsBuildFile", "") 108 Set WshShell = CreateObject("WScript.Shell") ' Set CF4 = CreateObject("CF4.CF4Entry") 'VBB Relocate 11.14.18 110 pclsUser.PasswordDeptCode = "1" pclsUser.medsysclasses.useclasses = True ' pclsUser.hwndParentForm = frmMain.hwnd 112 Sstationname = "Admission" 114 SstationID = "Admission" 116 ProgExeName = "Admission" 118 If App.PrevInstance Then 120 MsgBox "Program is already Loaded!" Exit Sub End If 122 pclsUser.ShowMain ' pstrDate = Now VBB 08.23.17 124 pstrRemarks = "LogIn:" 126 If pclsUser.Connected Then Else 'MsgBox " Cannot InitConnection pclsMasterSearch" Exit Sub End End If pclsUser.medsysclasses.initwithdb 128 Set MEDSYSClass = CreateObject("MEDSYSClasses.clsMEDSYS") 130 MEDSYSClass.MedsysUser = pclsUser 132 MEDSYSClass.exepath = App.Path 134 DoEvents 136 pstrEmployeeID = pclsUser.EmployeeCode 138 Set recFile = pclsUser.sqlconnection 140 frmWelcom.Show 142 frmWelcom.Refresh AddStartLog "Hospital Info" 144 pclsUser.sqlconnection.CommandTimeout = 120 146 pstrServerName = GetServerName(pclsUser.sqlconnection.ConnectionString) Dim recTemp As New ADODB.Recordset 148 Set recTemp = pclsUser.sqlconnection.Execute("Select *, GetDate() as CurDate From Patient_Data..tbHospitalInfo") 150 With recTemp 152 pstrHospitalName = !Company 154 pstrHospitalAddress = !Address1 156 pdCurDate = !CurDate 158 pstrHospitalMTS = !MTSServerName 160 dblAdditionalRate = !AdditionalRate End With 162 Set recTemp = Nothing ' pdCurDate = Format(pdCurDate, "mm/dd/yyyy") 'VBB 08.23.17 164 pstrDate = Format(pdCurDate, "mm/dd/yyyy") 'VBB 08.23.17 AddStartLog "Code Search" 166 pclsCodeSearch.MTS_Server = pstrHospitalMTS ' pclsCodeSearch.MTS_Server = "" 168 pclsCodeSearch.SearchMode = True 170 pclsCodeSearch.Initialize_Classes 172 pclsCodeSearch.Connection = pclsUser.sqlconnection 174 pclsCodeSearch.CompanyName = pstrHospitalName 176 ' recFile.Execute "Patient_Data..SP_Adm_UserLogin '" & Get_Sequence & "','" & pstrEmployeeID & "', '" & pstrRemarks & "', '" & pstrDate & "', ''" AddStartLog "Get_ClientName" 178 Get_ClientName AddStartLog "AdmittingSetup" 180 AdmittingSetup AddStartLog "CF4" 200 If blnAllowCF4Entries Then 202 Set CF4 = CreateObject("CF4.CF4Entry") End If AddStartLog "AdmittingReportSetup" 204 AdmittingReportSetup AddStartLog "Load_SeaFarerSetup" 206 Load_SeaFarerSetup AddStartLog "Load_RegistrationReqEntries" 208 Load_RegistrationReqEntries AddStartLog "Load_RegistrationLabelEntries" 209 Load_RegistrationLabelEntries 210 blnExport = False AddStartLog "MasterSearch.InitConnection" 212 pstrConnectionString = pclsUser.sqlconnection.ConnectionString '214 If pclsMasterSearch.InitConnection(pstrConnectionString, pstrHospitalMTS) Then 214 If pclsMasterSearch.InitConnection(pstrConnectionString, pstrHospitalMTS) Then 216 If blnAllowEclaimsChecking Then 218 If MedicareType.InitConnection(pclsUser.sqlconnection.ConnectionString) Then 220 If ZipCode.InitConnection(pclsUser.sqlconnection.ConnectionString) Then 222 If Medicare.InitConnection(pclsUser.sqlconnection.ConnectionString) Then 224 If MemberList.InitConnection(pclsUser.sqlconnection.ConnectionString) Then 226 If EmployerList.InitConnection(pclsUser.sqlconnection.ConnectionString) Then 228 Set pclsMain = pclsMasterSearch.PatientClass 230 Set pclsAdmission = pclsMasterSearch.Admission 232 pclsBilling.InitConnection (pstrConnectionString) '234 Load frmMainNew '236 'Unload frmWelcom '238 frmMainNew.Show End If End If End If End If End If Else 240 Set pclsMain = pclsMasterSearch.PatientClass 242 Set pclsAdmission = pclsMasterSearch.Admission 244 pclsBilling.InitConnection (pstrConnectionString) 246 ' Load frmMainNew 248 'Unload frmWelcom 250 'frmMainNew.Show End If End If AddStartLog "AllowCF4Entries" 252 If blnAllowCF4Entries Then 254 Set CF4.ActiveConnection = pclsUser.sqlconnection End If ''Eclaims 11/07/18 VBB Khing ' MsgBox " " ' & MedicareType & '"" strPart = "Eclaims" AddStartLog "EclaimsChecking" 182 If blnAllowEclaimsChecking Then 184 Set Eclaims = CreateObject("prjMedsysEClaims.clsEclaims") ' Set user = CreateObject("MEDSYS_User.clsCurrentUser") 186 Set MEDSYSClass = CreateObject("MEDSYSClasses.clsMEDSYS") ' Set clsEClaims = CreateObject("prjMedsysEClaims.clsEClaims") 188 Set EmployerList = CreateObject("prjListEmployers.ListEmployers") 190 Set Medicare = CreateObject("ClassMedicare.clsMedicare") 192 Set ZipCode = CreateObject("ZipCodes.ZipCode") 194 Set ListZipCode = CreateObject("ZipCodeList.clsZipCodeList") 196 Set MedicareType = CreateObject("prjMedicareType.MedType") 198 Set MemberList = CreateObject("prjListMembers.ListMembers") End If AddStartLog "EclaimsChecking" 256 If blnAllowEclaimsChecking Then 258 Set Eclaims.MyMedsysUser = pclsUser 260 Set Eclaims.MyMedicareType = MedicareType 262 Set Eclaims.MyZipCode = ZipCode 264 Set Eclaims.MyMemberList = MemberList 266 Set Eclaims.MyMedicare = Medicare 268 Set Eclaims.MyListZipCode = ListZipCode 270 Set Eclaims.MyMedSysClass = MEDSYSClass 272 Set Eclaims.MyEmployerList = EmployerList 274 Eclaims.MyLinkedMode = True 276 Eclaims.Initialize End If 'Load frmMainNew 'Unload frmWelcom frmMainNew.Show 'errMain: ' MsgBox Err.Description ' End ' Exit Sub Main_Err: MsgBox Err.Description & vbCrLf & _ "in Admission.modAdmitPatient.Main " & _ "at line " & Erl, _ vbExclamation + vbOKOnly, "Application Error" ' Resume Next MsgBox "Check " & strPart Resume Next ' End Sub Public Sub AddStartLog(pLogStr As String) frmWelcom.txtLog.Text = frmWelcom.txtLog.Text & pLogStr & vbCrLf DoEvents End Sub Public Function ChkSurname(strName As String, Optional blnAllowBlank As Boolean = False, Optional blnLastName As Boolean = True) As Boolean If Len(Trim$(strName)) = 0 Then ChkSurname = blnAllowBlank Else strName = " " + strName + " " If InStr(1, strName, " JR ") > 0 Or InStr(1, strName, " SR ") > 0 Or InStr(1, strName, " II") > 0 Or InStr(1, strName, " IV") > 0 Then MsgBox "Please enter labels like Jr, Sr, II, VI or the like in the patient's firstname...", vbCritical ChkSurname = False Else Dim recTemp As New ADODB.Recordset Set recTemp = pclsMain.ExecuteCommand("Patient_Data..sp_Adm_ValidateLastName '" + Trim$(strName) + "'") With recTemp If .EOF And .BOF Then If MsgBox("The " + IIf(blnLastName, "last name", "middle name") + " '" + strName + "' may not be spelled correctly. Select the 'Yes' button if correct or 'No' button if not...", vbCritical + vbYesNo) = vbYes Then ChkSurname = True Else ChkSurname = False End If Else ChkSurname = True End If End With Set recTemp = Nothing End If End If End Function Public Function ValidateDate(ByVal strValue As String, Optional ByVal strStart As String = "", Optional ByVal strEnd As String = "", Optional ByVal blnAllowBlank = True) As Boolean If Len(Trim$(strValue)) = 0 Or strValue = " / / " Then ValidateDate = IIf(blnAllowBlank, True, False) Else ValidateDate = False If IsDate(strValue) Then strValue = Format(strValue, "yyyy/mm/dd") strStart = IIf(Len(Trim$(strStart)) > 0 And strStart <> " / / " And IsDate(strStart), Format(strStart, "yyyy/mm/dd"), strValue) strEnd = IIf(Len(Trim$(strEnd)) > 0 And Trim$(strEnd) <> " / / " And IsDate(strEnd), Format(strEnd, "yyyy/mm/dd"), strValue) If strValue >= strStart And strValue <= strEnd Then ValidateDate = True End If End If End Function Public Function ComputeAge(ByVal strBirth As String, ByVal strNow As String) As Integer Dim intDays As Long Dim intA As Integer ComputeAge = 0 If IsDate(strBirth) And IsDate(strBirth) Then If strBirth <> " / / " Then intA = InStr(1, strNow, ".") intDays = DateDiff("d", strBirth, left(strNow, IIf(intA = 0, Len(strNow), intA - 1))) + 1 ComputeAge = Int(intDays / 365.25) Else ComputeAge = 0 End If End If ''''VBB 12.12.17 Revise to get Actual Date..Returned to original. Age must base on admission date. '' If IsDate(strBirth) And IsDate(strBirth) Then '' '' If strBirth <> " / / " Then '' Call GetCurrentDateTime '' intA = InStr(1, pdCurDate, ".") '' intDays = DateDiff("d", strBirth, pdCurDate) '' ComputeAge = Int(intDays / 365.25) '' Else '' ComputeAge = 0 '' End If '' End If '' End Function Public Function ConvertToDate(strYear As String, strMonth As String, strDay As String) As String Dim intTemp As Integer Dim strDate As String strDate = Trim(strYear) intTemp = Val(strMonth) If intTemp >= 1 And intTemp <= 12 Then strDate = strDate + "." + IIf(intTemp < 10, "0", "") + Trim(strMonth) intTemp = Val(strDay) If intTemp >= 1 And intTemp <= 31 Then strDate = strDate + "." + IIf(intTemp < 10, "0", "") + Trim(strDay) End If End If ConvertToDate = strDate End Function Public Sub ConvertNameKey(ByRef KeyAscii As Integer) Dim strKey As String If KeyAscii >= 32 Then strKey = UCase(Chr(KeyAscii)) If strKey Like "[A-Z,--,Ñ,',.,/,(,), ]" Then _ KeyAscii = Asc(strKey) Else _ KeyAscii = 0 End If 'If KeyAscii <> 0 Then ' KeyAscii = Asc(UCase(Chr$(KeyAscii))) ' 'End If End Sub Public Function StringLen(ByVal strVar As String) As Integer StringLen = Len(Trim$(strVar)) End Function Public Function ValidateRoom() As Boolean Dim RecR As New ADODB.Recordset Dim strSQL As String Dim recX As New ADODB.Recordset Dim strPatientName As String Dim strIDNum As String Dim blnWithRecord As Boolean ValidateRoom = True pstrAdditionalBed = "0" If pstrAdditionalBed <= 0 And pclsAdmission.Room.RoomID <> pclsMasterSearch.Room.RoomID Then pstrAdditionalBed = "0" strSQL = "Patient_Data..sp_Adm_GetRoomStatus '" + pclsMasterSearch.Room.RoomID + "'" If recX.State > 0 Then recX.Close recX.CursorLocation = adUseClient recX.Open strSQL, pclsUser.sqlconnection, adOpenDynamic, adLockReadOnly If recX.RecordCount > 0 Then strPatientName = recX![PatientName] strIDNum = recX![IdNum] blnWithRecord = True End If If blnWithRecord Then If blnAllowAdmitOnOccupiedRoom Then If Not MsgBox("Warning! The room is already occupied by " + strPatientName + " (" + strIDNum + "). Do you want to continue?", vbQuestion + vbYesNo) = vbYes Then ValidateRoom = False Else pstrAdditionalBed = "1" End If Else MsgBox ("Warning! The room is already occupied by " + strPatientName + " (" + strIDNum + "). Room not available") ValidateRoom = False End If Else pstrAdditionalBed = "0" End If End If ' With recR ' If .State > 0 Then .Close ' .Open "Patient_Data..sp_Adm_LoadReservedRoom '" + pclsMasterSearch.Room.RoomID + "'", pclsUser.sqlconnection, adOpenDynamic, adLockOptimistic ' ' If Not .EOF Then ' If MsgBox("This room is reserved by " + !FirstName + " " + !LastName + " . Do you want to continue?", vbQuestion + vbYesNo) = vbNo Then ' ValidateRoom = False ' Else ' pclsUser.sqlconnection.Execute "patient_data..sp_Adm_RevokeReservation '" + !ReservationNum + "'" ' pblnReserved = True ' End If ' End If ' .Close ' ' ' End With ' strSQL = "SELECT top 1 * FROM Patient_Data..tbAdmWaitingList WHERE RoomID = '" & pclsMasterSearch.Room.RoomID & "' AND (ReservationStatus is null or ReservationStatus='') " With RecR If .State > 0 Then .Close .Open strSQL, pclsUser.sqlconnection, adOpenDynamic, adLockOptimistic If Not .EOF Then If MsgBox("This room is reserved by " + !FirstName + " " + !LastName + " . Do you want to continue? (Reservation will now be revoked) ", vbQuestion + vbYesNo) = vbNo Then ValidateRoom = False Else .Fields("ReservationStatus") = "Revoked" .Update pblnReserved = True End If End If .Close End With ' If pclsMasterSearch.Room.BedsLeft <= 0 And _ ' pclsAdmission.Room.RoomID <> pclsMasterSearch.Room.RoomID Then ' pstrAdditionalBed = "0" ' strSQL = "Patient_Data..sp_Adm_GetRoomStatus '" + pclsMasterSearch.Room.RoomID + "'" ' ' If recX.State > 0 Then recX.Close ' recX.CursorLocation = adUseClient ' recX.Open strSQL, pclsUser.sqlconnection, adOpenDynamic, adLockReadOnly ' If recX.RecordCount > 0 Then ' strPatientName = recX![PatientName] & "" ' strIDNum = recX![IdNum] ' blnWithRecord = True ' End If ' ' If blnWithRecord Then ' If Not MsgBox("Warning! The room is already occupied by " + strPatientName + " (" + strIDNum + "). Do you want to continue?", vbQuestion + vbYesNo) = vbYes Then ' ValidateRoom = False ' Else ' pstrAdditionalBed = "1" ' End If ' Else ' pstrAdditionalBed = "0" ' End If ' End If ' If RoomWithPendingRequest Then ' MsgBox "Can not process room change,the patient has pending request.Please contact station " & StrStationWithPendingRequest & " ", vbCritical ' ValidateRoom = False ' Else ' ValidateRoom = True ' End If Set RecR = Nothing End Function Public Function CheckService(ByVal cServCode As String, Optional ByVal cSex As String = "", Optional ByVal cAge As String) As Boolean Dim nServCode As Integer nServCode = Val(cServCode) CheckService = True If cSex = "M" And (nServCode = 9 Or nServCode = 16) Then MsgBox "Cannot use this service for male patient...", vbCritical CheckService = False ElseIf nServCode = 13 And Val(cAge) > 0 Then MsgBox "Patient's age indicates that Newborn is not a valid service...", vbCritical CheckService = False ElseIf nServCode = 14 And Val(cAge) > pubPediaAgeLimit Then MsgBox "Patient's age indicates that Pediatrics is not a valid service...", vbCritical CheckService = False ElseIf nServCode = 16 And Val(cAge) < 15 Then If MsgBox("Patient's age indicates that this is a Pediatric case. Are you sure this is an obsteric case?", vbQuestion + vbYesNo) = vbNo Then _ CheckService = False End If End Function Private Function GetServerName(ByVal strServerName As String) As String Dim strTemp As String strTemp = Mid(strServerName, InStr(1, strServerName, "Server", vbTextCompare) + 7) GetServerName = Mid(strTemp, 1, InStr(1, strTemp, ";") - 1) End Function Public Sub PrintDataSheet(ByVal strAdmNumber As String, ByVal strPxAge As String, Optional ByVal strOutput As String = "S", Optional ByVal strAdmHospNum As String) Dim strFileName As String Screen.MousePointer = 11 'pclsUser.sqlconnection.Execute "Patient_Data..sp_Adm_PatientData '" + Trim$(strAdmNumber) + "', '" + strPxAge + "'" Dim SQLStr As String SQLStr = " DELETE PATIENT_DATA..tbAdmDataSheet " pclsUser.sqlconnection.Execute SQLStr pclsUser.sqlconnection.DefaultDatabase = "Patient_data" Dim AdmDate As String Dim PrevAdmDate As String Dim PrevAdmDiag As String Dim RecP As New ADODB.Recordset Dim RecDS As New ADODB.Recordset SQLStr = " Select top 1 AdmDate " SQLStr = SQLStr & " From Patient_Data..tbpatient a " SQLStr = SQLStr & " Where a.HospNum = '" & strAdmHospNum & "' and a.IdNum = '" & strAdmNumber & "' " RecP.Open SQLStr, pclsUser.sqlconnection, adOpenDynamic, adLockReadOnly If RecP.EOF = False Then AdmDate = RecP.Fields("AdmDate") End If RecP.Close SQLStr = " Select top 1 a.AdmDate, b.FinalDiagnosis " SQLStr = SQLStr & " From Patient_Data..tbpatient a " SQLStr = SQLStr & " Left Join PATIENT_DATA..tbpatientHistory b on a.idnum = b.IDNum " SQLStr = SQLStr & " Where a.HospNum = '" & strAdmHospNum & "' and a.IdNum <> '" & strAdmNumber & "' and admdate < convert(datetime,'" & AdmDate & "') " SQLStr = SQLStr & " Order By a.AdmDate desc" RecP.Open SQLStr, pclsUser.sqlconnection, adOpenDynamic, adLockReadOnly If RecP.EOF = False Then PrevAdmDate = RecP.Fields("AdmDate") PrevAdmDiag = RecP.Fields("FinalDiagnosis") & "" End If RecP.Close 'SQLSTR = " Insert PATIENT_DATA..tbAdmDataSheet " SQLStr = " SELECT " SQLStr = SQLStr & " P.AccountNum," SQLStr = SQLStr & " P.HospNum," SQLStr = SQLStr & " P.IDNum," SQLStr = SQLStr & " P.RoomID," SQLStr = SQLStr & " P.RoomRate," SQLStr = SQLStr & " AT.AdmissionType as AdmType," SQLStr = SQLStr & " P.AdmType as AdmTypeNewOrOld, " '--New OR Old AdmTypeNewOrOld 06.30.16 'SQLSTR = SQLSTR & " '', " ' --OLD_HOSPNUM SQLStr = SQLStr & " M.LastName," SQLStr = SQLStr & " RTrim(LTrim(ISNULL(M.Title,''))) + ' ' + M.FirstName as FirstName," SQLStr = SQLStr & " M.MiddleName," ' SQLStr = SQLStr & " --@PxAge," If strPxAge <> "" Then SQLStr = SQLStr & " '" & strPxAge & "' AS AGE ," Else SQLStr = SQLStr & " M.Age AS AGE ," End If 'SQLSTR = SQLSTR & " Case When ISNULL('" & strPxAge & "', '') = '' THEN M.Age ELSE '" & strPxAge & "' END ," SQLStr = SQLStr & " Case m.Sex" SQLStr = SQLStr & " When 'M' THEN 'M'" SQLStr = SQLStr & " When 'F' THEN 'F'" SQLStr = SQLStr & " ELSE '' END As Sex," SQLStr = SQLStr & " (SELECT TOP 1 CivilStatus FROM BUILD_FILE..tbCoCivilStatus AS CS WITH (NOLOCK) WHERE CS.CivilStatusID = M.CivilStatus) AS CivilStatus," ' SQLStr = SQLStr & " Case m.CivilStatus" ' SQLStr = SQLStr & " When '0' THEN 'Child'" ' SQLStr = SQLStr & " When '1' THEN 'Single'" ' SQLStr = SQLStr & " When '2' THEN 'Married'" ' SQLStr = SQLStr & " When '3' THEN 'Widow'" ' SQLStr = SQLStr & " When '4' THEN 'Separated'" ' SQLStr = SQLStr & " When '5' THEN 'Divorced'" ' SQLStr = SQLStr & " ELSE '' END AS CivilStatus," SQLStr = SQLStr & " RTrim(ISNULL(M.HouseStreet,'')) + ' ' + RTrim(ISNULL(M.Barangay,'')) + ', ' +" SQLStr = SQLStr & " RTrim(ISNULL(Zip.Town,'')) + ', ' + RTrim(ISNULL(Zip.Province,'')) AS Address," SQLStr = SQLStr & " M2.BirthPlace,M.HouseStreet,Zip.Town,M.Barangay,Zip.Province," SQLStr = SQLStr & " Case When M.birthDate IS Null THEN '' ELSE CONVERT(VARCHAR(10),M.BirthDate,101) END as BirthDate," SQLStr = SQLStr & " M.TelNum," SQLStr = SQLStr & " P2.HowAdmitted," SQLStr = SQLStr & " Nat.Nationality," SQLStr = SQLStr & " Rel.Religion," SQLStr = SQLStr & " M.Occupation," SQLStr = SQLStr & " M2.Father," SQLStr = SQLStr & " M2.Mother," SQLStr = SQLStr & " M2.Spouse," SQLStr = SQLStr & " M2.ContactName," SQLStr = SQLStr & " M2.ContactAddress," SQLStr = SQLStr & " M2.ContactTelNum," SQLStr = SQLStr & " M2.ContactRelation," SQLStr = SQLStr & " M2.Employer," SQLStr = SQLStr & " M2.EmployerAddress," SQLStr = SQLStr & " M2.EmployerTelNum," 'SQLStr = SQLStr & " Comp.Company," SQLStr = SQLStr & " ISNULL(Comp.Company,Comp2.Company) As Company," SQLStr = SQLStr & " Case P.HospPlan" SQLStr = SQLStr & " When 'S' THEN 'SSS'" SQLStr = SQLStr & " When 'G' THEN 'GSIS'" SQLStr = SQLStr & " When 'I' THEN 'Insurance/HMO'" SQLStr = SQLStr & " When 'E' THEN 'ECC'" SQLStr = SQLStr & " When 'P' THEN 'Personal'" SQLStr = SQLStr & " When 'C' THEN 'Employer'" SQLStr = SQLStr & " ELSE '' END As [HospPlan]," SQLStr = SQLStr & " P.MEDICARETYPE," SQLStr = SQLStr & " M.SSSGSISNum," SQLStr = SQLStr & " '' as SSSGSISNum2," SQLStr = SQLStr & " Guar.GuarantorName," SQLStr = SQLStr & " Guar.GuarantorAddress," SQLStr = SQLStr & " Guar.GuarantorTelNum," SQLStr = SQLStr & " Guar.GuarantorEmployer," ' SQLStr = SQLStr & " /*" ' SQLStr = SQLStr & " CONVERT(VARCHAR(10),P.AdmDate,101) + ' ' + CONVERT(VARCHAR(10),P.AdmDate,108) AS AdmDateTime," ' SQLStr = SQLStr & " */" ' SQLStr = SQLStr & " " SQLStr = SQLStr & " CONVERT(VARCHAR(25),P.AdmDate,100) AS AdmDateTime," ' SQLStr = SQLStr & " " ' SQLStr = SQLStr & " /*" 'SQLSTR = SQLSTR & " substring(Pass.[Name],1, CharIndex(' ',Pass.[Name]) ) + ', ' +" 'SQLSTR = SQLSTR & " SUBSTRING(LTRIM(substring(Pass.[Name] , CharIndex(' ',Pass.[Name]) , Len(Pass.[Name])-CharIndex(' ',Pass.[Name]) )) , 1 , CharIndex(' ',LTRIM(substring(Pass.[Name] , CharIndex(' ',[Name]) , Len([Name])-CharIndex(' ',[Name]) ))) )*/" SQLStr = SQLStr & " ISNULL(Pass.LastName,'') + ', ' + ISNULL(Pass.Firstname,'') + ' ' + ISNULL(Pass.MiddleName,'') as AdmClerk," SQLStr = SQLStr & " Inf.InformantName," SQLStr = SQLStr & " Inf.InformantAddress," SQLStr = SQLStr & " Inf.InformantTelNum," SQLStr = SQLStr & " Inf.InformantRelation," SQLStr = SQLStr & " rTrim(ISNULL(RefDr.FirstName,'')) + ' ' + rTrim(ISNULL(RefDr.LastName,'')) As RefDoctor," SQLStr = SQLStr & " rTrim(ISNULL(AttDr1.FirstName,'')) + ' ' + rTrim(ISNULL(AttDr1.LastName,'')) As AttDoctor1," SQLStr = SQLStr & " rTrim(ISNULL(AttDr2.FirstName,'')) + ' ' + rTrim(ISNULL(AttDr2.LastName,'')) As AttDoctor2," SQLStr = SQLStr & " rTrim(ISNULL(AttDr3.FirstName,'')) + ' ' + rTrim(ISNULL(AttDr3.LastName,'')) As AttDoctor3," SQLStr = SQLStr & " rTrim(ISNULL(AttDr4.FirstName,'')) + ' ' + rTrim(ISNULL(AttDr3.LastName,'')) As AttDoctor4," SQLStr = SQLStr & " ISNULL(His.AdmDiagnosis,'') As AdmDiagnosis," SQLStr = SQLStr & " ISNULL(His.ChiefComplaint,'') As ChiefComplaint," SQLStr = SQLStr & " ISNULL(His.AdmImpression,'') As AdmImpression," ' SQLStr = SQLStr & " /*M.BirthDate,*/" SQLStr = SQLStr & " M2.FatherAddress," SQLStr = SQLStr & " M2.FatherTelNum," SQLStr = SQLStr & " M2.MotherAddress," SQLStr = SQLStr & " M2.MotherTelNum," SQLStr = SQLStr & " M2.BarangayCaptain," SQLStr = SQLStr & " P2.Remarks," SQLStr = SQLStr & " S.Service," SQLStr = SQLStr & " rTrim(ISNULL(AdmDr.FirstName,'')) + ' ' + rTrim(ISNULL(AdmDr.LastName,'')) As AdmDoctor ," ' AdmDr SQLStr = SQLStr & " rTrim(ISNULL(AdmDr.FirstName,'')) + ' ' + rTrim(ISNULL(AdmDr.LastName,'')) As AdmDr ," ' 'p.AdmittingDr, SQLStr = SQLStr & " rTrim(ISNULL(AdmDr.FirstName,'')) + ' ' + rTrim(ISNULL(AdmDr.LastName,'')) As AdmittingDr ," ' 'p.AdmittingDr, SQLStr = SQLStr & " ISNULL(His.FinalDiagnosis,'') As FinalDiagnosis," SQLStr = SQLStr & " ISNULL(His.Procedures,'') As Procedures," SQLStr = SQLStr & " P.dcrdate, P.dcrdate as DCRDatetime," 'SQLSTR = SQLSTR & " '','','',''," SQLStr = SQLStr & " M2.PatientFindUs HowPatientFindUs," SQLStr = SQLStr & " M2.PatientFindUsOtherRemarks HowPatientFindUsOthers," SQLStr = SQLStr & " P2.PatientType," SQLStr = SQLStr & " M.CellNum," SQLStr = SQLStr & " M.SeniorCitizenID," SQLStr = SQLStr & " M2.SpouseAddress," SQLStr = SQLStr & " M2.SpouseTelNum," SQLStr = SQLStr & " [dbo].fn_GetICDCode(P.IDNum) as ICDCODE," SQLStr = SQLStr & " P.DispositionID," SQLStr = SQLStr & " P.ResultID," SQLStr = SQLStr & " AC.CreditLimitRate," SQLStr = SQLStr & " Case P.HospPlan" SQLStr = SQLStr & " When 'I' THEN comp2.Class" SQLStr = SQLStr & " Else" SQLStr = SQLStr & " comp.Class" SQLStr = SQLStr & " END as AccountBusinessClass," 'SQLSTR = SQLSTR & " [dbo].fn_GetPrevAdmdate('" & strAdmHospNum & "','" & Trim$(strAdmNumber) & "',p.admdate) as PrevAdmdate," 'SQLSTR = SQLSTR & " [dbo].fn_GetPrevFinalDiagnosis('" & strAdmHospNum & "','" & Trim$(strAdmNumber) & "',p.admdate) as PrevFinalDiagnosis," SQLStr = SQLStr & " '" & PrevAdmDate & "' as PrevAdmdate," SQLStr = SQLStr & " '" & Replace(PrevAdmDiag, "'", "`") & "' as PrevFinalDiagnosis," SQLStr = SQLStr & " AC.Accomodation," SQLStr = SQLStr & " Guar.GuarantorRelation," SQLStr = SQLStr & " PR.StationID," SQLStr = SQLStr & " p2.NoticeofAdmID," SQLStr = SQLStr & " m.SpouseEmployer," SQLStr = SQLStr & " m.FileNum," SQLStr = SQLStr & " PatientClass, " SQLStr = SQLStr & " Case When P.MedicareType <> '' THEN 'Yes' ELSE 'No' END isYesPhic," SQLStr = SQLStr & " Case When P.HospPlan = 'C' THEN 'Yes' ELSE 'No' END isYesCompany," SQLStr = SQLStr & " Case When P.HospPlan = 'C' THEN Comp.Company ELSE '' END CompanyAccountName," SQLStr = SQLStr & " Case When P.HospPlan = 'I' THEN 'Yes' ELSE 'No' END isYesHMO," SQLStr = SQLStr & " Case When P.HospPlan = 'I' THEN Comp.Company ELSE '' END HMOAccountName," ' SQLStr = SQLStr & " ----Comp.Company as CompName," ' SQLStr = SQLStr & " --" ' SQLStr = SQLStr & " --Case PMedicareType When '' THEN 'Yes' ELSE '' END isYesPhic," ' SQLStr = SQLStr & " --Case P.HospPlan When 'C' THEN 'Yes' ELSE '' END isYesCompany," ' SQLStr = SQLStr & " --Case P.HospPlan When 'C' THEN Comp.Company ELSE '' END AS CompanyAccountName," ' SQLStr = SQLStr & " --Case P.HospPlan When 'I' THEN 'Yes' ELSE '' END isYesHMO," ' SQLStr = SQLStr & " --Case P.HospPlan When 'I' THEN Comp.Company ELSE '' END AS HMOAccountName," SQLStr = SQLStr & " PHIC.PHICDescription as PDescription," ' SQLStr = SQLStr & " --case when MAX(C.MedicareType) = '' OR MAX(C.MedicareType) = 'NN' then" ' SQLStr = SQLStr & " -- count(A.IDNum) ELSE 0 END NonPHIC," SQLStr = SQLStr & " (SELECT TOP 1 ClientName FROM PATIENT_DATA..tbHospitalInfo ) ClientName, " SQLStr = SQLStr & " P.isNobalanceBilling, '0' CreditLimit, '' as RoomType , '' BusinessClass , '' OLD_HospNum, P.AdmType as NewOLD, NoticeOfAdm," SQLStr = SQLStr & " P.Category AS Category,M.CardNumber AS CardNumber, T.Disposition AS Disposition,P.HMONum,K.Package, " SQLStr = SQLStr & " Case When Ltrim(Rtrim(Isnull(M.EmbarkedDate,''))) = '' THEN '' ELSE Convert(VarChar(10),EmbarkedDate,101) END AS DateOfEmbarkation, " SQLStr = SQLStr & " Case When Ltrim(Rtrim(Isnull(M.DisEmbarkedDate,''))) = '' THEN '' ELSE Convert(VarChar(10), DisEmbarkedDate,101) END AS DateofDisembarked, " SQLStr = SQLStr & " Case When Ltrim(Rtrim(Isnull(M.DisEmbarkedDate,''))) = '' THEN '' ELSE Convert(VarChar(10), DisEmbarkedDate,101) END AS DateofDisembark, " SQLStr = SQLStr & " isnull(DS.Specialization,'') as Specialization, " SQLStr = SQLStr & " isnull(DS1.Specialization,'') as Specialization2, " SQLStr = SQLStr & " AttDr1.PhilHealthNum, Convert(VarChar(20), AttDr1.PHICValidFrom,101) AS PHICValidFrom,Convert(VarChar(20), AttDr1.PHICExpireDate,101) AS PHICExpireDate, " SQLStr = SQLStr & " AttDr2.PhilHealthNum as PhilHealthNum2, Convert(VarChar(20), AttDr2.PHICValidFrom,101) AS PHICValidFrom2, Convert(VarChar(20), AttDr2.PHICExpireDate,101) AS PHICExpireDate2 " SQLStr = SQLStr & " " SQLStr = SQLStr & " " '' as OLD_HOSPNUM SQLStr = SQLStr & " FROM PATIENT_DATA..tbPatient P WITH (NOLOCK) " SQLStr = SQLStr & " LEFT OUTER JOIN PATIENT_DATA..tbPatient2 P2 WITH (NOLOCK) ON P.IDNum = P2.IDNum" SQLStr = SQLStr & " LEFT OUTER JOIN PATIENT_DATA..tbpatient P3 WITH (NOLOCK) ON p3.idnum = p2.idnum" SQLStr = SQLStr & " LEFT OUTER JOIN PATIENT_DATA..tbMaster M WITH (NOLOCK) ON P.HospNum = M.HospNum" SQLStr = SQLStr & " LEFT OUTER JOIN PATIENT_DATA..tbMaster2 M2 WITH (NOLOCK) ON P.HospNum = M2.HospNum" SQLStr = SQLStr & " LEFT OUTER JOIN Build_File..tbCoAddress Zip WITH (NOLOCK) ON M.ZipCode = Zip.ZipCode" SQLStr = SQLStr & " LEFT OUTER JOIN Build_File..tbCoNationality Nat WITH (NOLOCK) ON M2.NationalityID = Nat.NationalityID" SQLStr = SQLStr & " LEFT OUTER JOIN Build_File..tbCoReligion Rel WITH (NOLOCK) ON M2.ReligionID = Rel.ReligionID" SQLStr = SQLStr & " LEFT OUTER JOIN Build_File..tbCoCompany Comp WITH (NOLOCK) ON P.AccountNum = Comp.AccountNum" SQLStr = SQLStr & " LEFT OUTER JOIN Build_File..tbCoCompany Comp2 WITH (NOLOCK) ON P.AccountNumII = Comp2.AccountNum" SQLStr = SQLStr & " LEFT OUTER JOIN PATIENT_DATA..tbPatientGuarantor Guar WITH (NOLOCK) ON P.IDNum = Guar.IDNum" SQLStr = SQLStr & " LEFT OUTER JOIN PATIENT_DATA..tbPatientInformant Inf WITH (NOLOCK) ON P.IDNum = Inf.IDNum" SQLStr = SQLStr & " LEFT OUTER JOIN Password..tbPasswordMaster Pass WITH (NOLOCK) ON P.AdmittingClerk = Pass.EmployeeID" SQLStr = SQLStr & " LEFT OUTER JOIN PATIENT_DATA..tbPatientHistory His WITH (NOLOCK) ON P.IDNum = His.IDNum" SQLStr = SQLStr & " LEFT OUTER JOIN Build_File..tbCoDoctor RefDr WITH (NOLOCK) ON P.ReferringDr = RefDr.DoctorID" SQLStr = SQLStr & " LEFT OUTER JOIN Build_File..tbCoDoctor AttDr1 WITH (NOLOCK) ON P.AttendingDr1 = AttDr1.DoctorID" SQLStr = SQLStr & " LEFT OUTER JOIN Build_File..tbCoDoctor AttDr2 WITH (NOLOCK) ON P.AttendingDr2 = AttDr2.DoctorID" SQLStr = SQLStr & " LEFT OUTER JOIN Build_File..tbCoDoctor AdmDr WITH (NOLOCK) ON P.AdmittingDr = AdmDr.DoctorID" SQLStr = SQLStr & " LEFT OUTER JOIN Build_File..tbCoService S WITH (NOLOCK) ON P.ServiceID = S.ServiceID" SQLStr = SQLStr & " LEFT OUTER JOIN PATIENT_DATA..tbAdmDisposition T WITH (NOLOCK) ON P.DispositionID = T.DispositionID" 'SQLStr = SQLStr & " --LEFT Outer Join Build_File..tbCoPatientCategory tbCoPatientCategory WITH (NOLOCK) ON P.Category = tbCoPatientCategory.PrimaryID" SQLStr = SQLStr & " LEFT OUTER JOIN Build_File..tbCoDoctor AttDr3 WITH (NOLOCK) ON P.AdmittingDr = AttDr3.DoctorID" SQLStr = SQLStr & " LEFT OUTER JOIN Build_File..tbCoDoctor AttDr4 WITH (NOLOCK) ON P.ReferringDr = AttDr4.DoctorID" SQLStr = SQLStr & " LEFT OUTER JOIN Build_File..tbCoAdmissionType AT WITH (NOLOCK) ON p2.AdmissionTypeID = AT.AdmissionTypeID" SQLStr = SQLStr & " LEFT OUTER JOIN Build_file..tbCoAdmPackage K WITH (NOLOCK) ON P2.PackageID = K.PackageID" SQLStr = SQLStr & " LEFT OUTER JOIN Build_File..tbCoNoticeOfAdm N WITH (NOLOCK) ON P2.NoticeOfAdmID= N.NOticeOfAdmID" SQLStr = SQLStr & " LEFT OUTER JOIN Medicare..tbAdmPHICTable PHIC WITH (NOLOCK) ON P.MedicareType = PHIC.PHICCode" SQLStr = SQLStr & " LEFT OUTER JOIN Medicare..tbAdmPHICTable PHIC2 WITH (NOLOCK) ON P3.MedicareType = PHIC2.PHICCode" SQLStr = SQLStr & " Left Join BUILD_FILE..tbcoRoom PR WITH (NOLOCK) ON P.RoomID = PR.RoomID" SQLStr = SQLStr & " Left Join BUILD_FILE..tbCoAccomodation AC WITH (NOLOCK) ON PR.accomodationID = AC.AccomodationID" SQLStr = SQLStr & " Left Outer join BUILD_FILE..tbCoSpecialization DS WITH (NOLOCK) ON AttDr1.SpecializationID = DS.SpecializationID " SQLStr = SQLStr & " Left Outer Join BUILD_FILE..tbcoDocDepartment DD WITH (NOLOCK) ON AttDr1.DeptCode = DD.DeptCode " SQLStr = SQLStr & " Left Outer join BUILD_FILE..tbCoSpecialization DS1 on AttDr1.SpecializationID2 = DS.SpecializationID " SQLStr = SQLStr & " " SQLStr = SQLStr & " WHERE P.IDNum = '" & Trim$(strAdmNumber) & "'" 'pclsUser.addlog SQLStr 'Exit Sub Dim iX As Integer Dim DSValue As String Dim FieldName As String Dim DateVal As Variant Dim FieldType As String 'RecP.Open "SELECT * FROM PATIENT_DATA..tbPatient WHERE IDNum = '" & Trim$(strAdmNumber) & "'", pclsUser.sqlconnection, adOpenDynamic, adLockOptimistic On Error GoTo ErrTrap RecP.CursorLocation = adUseServer RecP.Open SQLStr, pclsUser.sqlconnection, adOpenDynamic, adLockReadOnly With RecP If RecP.EOF = False Then 'For Ix = 0 To RecP.Fields.count - 1 ' FieldName = RecP.Fields(Ix).Name 'DSValue = RecP.Fields(RecDS.Fields(Ix).Name) 'Next RecDS.Open "Patient_Data..tbAdmDataSheet", pclsUser.sqlconnection, adOpenDynamic, adLockOptimistic RecDS.AddNew On Error GoTo errFld For iX = 0 To RecDS.Fields.count - 1 FieldName = RecDS.Fields(iX).Name FieldType = RecDS.Fields(iX).Type 'If InStr(UCase(FieldName), "DATE") > 0 Then If FieldType = 200 Then DSValue = RecP.Fields(FieldName) & "" RecDS.Fields(iX).value = DSValue Else FieldType = FieldType '"DATETIME" If IsNull(RecP.Fields(FieldName)) = False Then DateVal = RecP.Fields(FieldName) & "" RecDS.Fields(iX).value = DateVal End If End If 'DSValue = RecP.Fields(RecDS.Fields(Ix).Name) Next RecDS.Update RecDS.Close End If .Close End With GoTo PrintIT: errFld: 'pclsUser.addlog RecDS.Fields(Ix).Name MsgBox Err.Description & " " & RecDS.Fields(iX).Name Resume Next PrintIT: 'pclsUser.sqlconnection.Execute SQLSTR If blnAllowBarcode Then frmCRViewer.Show Else ' If blnWithBarcode = False Then ' Screen.MousePointer = 1 ' If ClientName = "NDCH" Then ' OpenMainReport App.Path + "\Reports\DataSheet.rpt", pstrHospitalAddress, pclsUser.employeename ' Else '' OpenMainReport App.Path + "\Reports\DataSheet.rpt", pstrHospitalAddress ' strFileName = App.Path + "\CUSTOMIZED\DataSheet.rpt" ' If File_Exists(strFileName) = False Then ' strFileName = App.Path + "\REPORTS\DataSheet.rpt" ' End If ' OpenMainReport strFileName, pstrHospitalAddress ' End If ' ShowReportViewer False, "Data Sheet", IIf(strOutput = "S", False, True) ' ' Else ' ' If ClientName = "NDCH" Then ' OpenMainReport App.Path + "\Reports\DataSheet.rpt", pstrHospitalAddress, pclsUser.employeename ' Else ' strFileName = App.Path + "\CUSTOMIZED\DataSheet.rpt" ' If File_Exists(strFileName) = False Then ' strFileName = App.Path + "\REPORTS\DataSheet.rpt" ' End If ' OpenMainReport strFileName, pstrHospitalAddress ' End If ' ' ShowReportViewer False, "Data Sheet", IIf(strOutput = "S", False, True) ' ' End If With pclsUser.medsysclasses .autoparameter = True .autoparameterver = 1 .ParamClear .paramadd "HOSPADDRESS", pclsUser.companyaddress .paramadd "HospitalAddress", pclsUser.companyaddress .paramadd "@IDNUM", Trim$(strAdmNumber) End With pclsUser.medsysclasses.OpenMainReport "DataSheet.rpt", "", "" End If Dim PrintLogStr As String PrintLogStr = "Print Patient Datasheet with IDnum " + Trim$(strAdmNumber) + " " pclsUser.sqlconnection.Execute "Patient_Data..sp_Adm_UpdateLogfile '" + Trim$(strAdmHospNum) + "','" + Trim$(strAdmNumber) + "','" + pclsUser.EmployeeCode + "','" & PrintLogStr & "','" & "Admission" & "','" & App.Major & "." & App.Minor & "." & App.Revision & "' " PrintLogStr = "" Screen.MousePointer = 0 Exit Sub ErrTrap: Screen.MousePointer = 0 pclsUser.addlog SQLStr MsgBox Err.Description 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [DateOfDisembark] [varchar](10) NULL 'GO 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [AccountNum] [varchar](15) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [HospNum] [varchar](10) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [IDNum] [varchar](10) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [RoomID] [varchar](8) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [RoomRate] [float] NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [AdmType] [varchar](1) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [LastName] [varchar](30) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [FirstName] [varchar](50) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [MiddleName] [varchar](30) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [Age] [varchar](20) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [Sex] [varchar](6) NOT NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [CivilStatus] [varchar](9) NOT NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [Address] [varchar](155) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [BirthPlace] [varchar](50) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [BirthDate] [varchar](10) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [TelNum] [varchar](15) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [HowAdmitted] [varchar](1) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [Nationality] [varchar](15) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [Religion] [varchar](20) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [Occupation] [varchar](30) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [Father] [varchar](50) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [Mother] [varchar](50) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [Spouse] [varchar](50) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [ContactName] [varchar](50) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [ContactAddress] [varchar](50) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [ContactTelNum] [varchar](15) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [ContactRelation] [varchar](50) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [Employer] [varchar](50) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [EmployerAddress] [varchar](50) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [EmployerTelNum] [varchar](15) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [Company] [varchar](200) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [HospPlan] [varchar](13) NOT NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [MedicareType] [varchar](20) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [SSSGSISNum] [varchar](15) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [SSSGSISNUM2] [varchar](15) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [GuarantorName] [varchar](30) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [GuarantorAddress] [varchar](155) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [GuarantorTelNum] [varchar](15) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [GuarantorEmployer] [varchar](30) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [AdmDateTime] [varchar](25) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [AdmClerk] [varchar](102) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [InformantName] [varchar](30) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [InformantAddress] [varchar](155) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [InformantTelNum] [varchar](15) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [InformantRelation] [varchar](30) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [RefDoctor] [varchar](60) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [AttDoctor1] [varchar](60) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [AttDoctor2] [varchar](60) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [AdmDiagnosis] [text] NOT NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [ChiefComplaint] [text] NOT NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [AdmImpression] [text] NOT NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [FatherAddress] [varchar](50) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [FatherTelNum] [varchar](15) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [MotherAddress] [varchar](50) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [MotherTelNum] [varchar](15) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [BarangayCaptain] [varchar](50) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [Remarks] [varchar](255) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [Service] [varchar](30) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [AdmDoctor] [varchar](60) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [FinalDiagnosis] [varchar](100) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [Procedures] [varchar](400) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [DcrDateTime] [varchar](100) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [AttDoctor3] [varchar](60) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [AttDoctor4] [varchar](60) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [PatientClass] [varchar](10) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [BusinessClass] [varchar](10) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [HowPatientFindUs] [varchar](1) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [HowPatientFindUsOthers] [varchar](50) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [PatientType] [varchar](1) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [CellNum] [varchar](15) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [SeniorCitizenID] [varchar](20) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [SpouseAddress] [varchar](70) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [SpouseTelNum] [varchar](15) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [ICDCODE] [varchar](200) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [DispositionID] [varchar](2) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [ResultID] [varchar](2) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [CreditLimit] [money] NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [AccountBusinessClass] [varchar](10) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [PrevAdmdate] [varchar](100) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [PrevFinalDiagnosis] [varchar](1000) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [RoomType] [varchar](20) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [GuarantorRelation] [varchar](50) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [AdmTypeNewOrOld] [varchar](50) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [OLD_HOSPNUM] [varchar](10) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [StationID] [varchar](20) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [NoticeOfAdm] [varchar](100) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [SpouseEmployer] [varchar](100) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [FileNum] [varchar](20) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [AdmittingDr] [varchar](25) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [ClientName] [varchar](20) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [isYesPhic] [varchar](50) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [isYesCompany] [varchar](50) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [isYesHMO] [varchar](50) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [PDescription] [varchar](500) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [CompanyAccountName] [varchar](500) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [HMOAccountName] [varchar](500) NULL 'GO ' 'ALTER TABLE patient_data..[tbAdmDataSheet] ADD [isNoBalanceBilling] [varchar](50) NULL 'GO '' 'USE [Patient_Data] 'GO ' '/****** Object: StoredProcedure [dbo].[sp_Adm_PatientData] Script Date: 12/1/2021 3:09:45 PM ******/ 'SET ANSI_NULLS ON 'GO ' 'SET QUOTED_IDENTIFIER ON 'GO ' 'ALTER PROCEDURE [dbo].[sp_Adm_PatientData] '@IDNum as Varchar(10) , '@PxAge as varchar(20) = '' 'AS ' '--declare @IDNUM as varchar(10), @PxAge as varchar(20) ' '--set @IDNUM='20' '--set @PxAge='' '--DECLARE @Var1 Integer ; '--Declare @Var2 Integer ; '--Declare @Var3 Integer ; '--Declare @PxAge VarChar(20) ; 'Declare @BirthDate VarChar(20) ; 'Declare @AdmDate VarChar(20) ; 'Declare @Hospnum varchar(10); ' '--SET @Var1 = 0 ; '--SET @Var2 = 0 ; '--SET @Var3 = 0 ; ' ' 'Select @BirthDate = Case When Master.BirthDate is Null Then '' Else Convert(VarChar(20),Master.BirthDate,101) End, ' @AdmDate = Convert(VarChar(20),Patient.AdmDate,101) , @PxAge = Patient.Age, ' @Hospnum = Patient.Hospnum 'From tbPatient Patient Inner Join tbMaster Master ON Patient.HospNum = Master.HospNum 'Where Patient.IDNum = @IDNum ; ' ' ' 'DELETE tbAdmDataSheet ; 'Insert tbAdmDataSheet 'Select Top 1 ' P.AccountNum, ' P.HospNum, ' P.IDNum, ' P.RoomID, ' P.RoomRate, ' P.AdmType, ' M.LastName, ' RTrim(LTrim(IsNull(M.Title,''))) + ' ' + M.FirstName, ' M.MiddleName, ' --@PxAge, ' Case When ISNULL( @PxAge, '') = '' then M.Age else @PxAge End , ' Case m.Sex ' When 'M' Then 'M' ' When 'F' Then 'F' ' Else '' End As Sex, ' Case m.CivilStatus ' When '0' Then 'Child' ' When '1' Then 'Single' ' When '2' then 'Married' ' When '3' Then 'Widow' ' When '4' Then 'Separated' ' When '5' Then 'Divorced' ' Else '' End AS CivilStatus, ' RTrim(IsNull(M.HouseStreet,'')) + ' ' + RTrim(IsNull(M.Barangay,'')) + ', ' + ' RTrim(isNull(Zip.Town,'')) + ', ' + RTrim(IsNull(Zip.Province,'')) AS Address, ' M2.BirthPlace, ' Case When M.birthDate IS Null Then '' Else Convert(VarChar(10),M.BirthDate,101) End as BirthDate, ' M.TelNum, ' P2.HowAdmitted, ' Nat.Nationality, ' Rel.Religion, ' M.Occupation, ' M2.Father, ' M2.Mother, ' M2.Spouse, ' M2.ContactName, ' M2.ContactAddress, ' M2.ContactTelNum, ' M2.ContactRelation, ' M2.Employer, ' M2.EmployerAddress, ' M2.EmployerTelNum, ' Comp.Company, ' Case P.HospPlan ' When 'S' Then 'SSS' ' When 'G' Then 'GSIS' ' When 'I' Then 'Insurance/HMO' ' When 'E' Then 'ECC' ' When 'P' Then 'Personal' ' When 'C' Then 'Employer' ' Else '' End As [HospPlan], ' P.MEDICARETYPE, ' M.SSSGSISNum, ' '' SSSGSISNum2, ' Guar.GuarantorName, ' Guar.GuarantorAddress, ' Guar.GuarantorTelNum, ' Guar.GuarantorEmployer, '/* ' Convert(VarChar(10),P.AdmDate,101) + ' ' + Convert(VarChar(10),P.AdmDate,108) AS AdmDateTime, '*/ ' ' Convert(VarChar(25),P.AdmDate,100) AS AdmDateTime, ' '/* ' substring(Pass.[Name],1, CharIndex(' ',Pass.[Name]) ) + ', ' + ' SUBSTRING(LTRIM(substring(Pass.[Name] , CharIndex(' ',Pass.[Name]) , Len(Pass.[Name])-CharIndex(' ',Pass.[Name]) )) , 1 , CharIndex(' ',LTRIM(substring(Pass.[Name] , CharIndex(' ',[Name]) , Len([Name])-CharIndex(' ',[Name]) ))) )*/ ' isnull(Pass.LastName,'') + ', ' + isnull(Pass.Firstname,'') + ' ' + isnull(Pass.MiddleName,'') as AdmClerk, ' Inf.InformantName, ' Inf.InformantAddress, ' Inf.InformantTelNum, ' Inf.InformantRelation, ' rTrim(IsNull(RefDr.FirstName,'')) + ' ' + rTrim(IsNull(RefDr.LastName,'')) As RefDoctor, ' rTrim(IsNull(AttDr1.FirstName,'')) + ' ' + rTrim(IsNull(AttDr1.LastName,'')) As AttDoctor1, ' rTrim(IsNull(AttDr2.FirstName,'')) + ' ' + rTrim(IsNull(AttDr2.LastName,'')) As AttDoctor2, ' IsNull(His.AdmDiagnosis,'') As AdmDiagnosis, ' IsNull(His.ChiefComplaint,'') As ChiefComplaint, ' isNull(His.AdmImpression,'') As AdmImpression, ' /*M.BirthDate,*/ ' M2.FatherAddress, ' M2.FatherTelNum, ' M2.MotherAddress, ' M2.MotherTelNum, ' M2.BarangayCaptain, ' P2.Remarks, ' S.Service, ' rTrim(IsNull(AdmDr.FirstName,'')) + ' ' + rTrim(IsNull(AdmDr.LastName,'')) As AdmDr, ' IsNull(His.FinalDiagnosis,'') As FinalDiagnosis, ' IsNull(His.Procedures,'') As Procedures, ' P.dcrdate, ' '','','','', ' M2.PatientFindUs, ' M2.PatientFindUsOtherRemarks, ' P2.PatientType, ' M.CellNum, ' M.SeniorCitizenID, ' M2.SpouseAddress, ' M2.SpouseTelNum, ' dbo.fn_GetICDCode(@IDNum), ' P.DispositionID, ' P.ResultID, ' AC.CreditLimitRate, ' Case P.HospPlan ' When 'I' then comp2.Class ' Else ' comp.Class ' End as AccountBusinessClass, ' Patient_Data.dbo.fn_GetPrevAdmdate(@Hospnum,@IDNum,@AdmDate) as PrevAdmdate, ' Patient_Data.dbo.fn_GetPrevFinalDiagnosis(@Hospnum,@IDNum,@AdmDate) as PrevFinalDiagnosis, ' AC.Accomodation, ' Guar.GuarantorRelation, ' P.AdmType, --New Or Old AdmTypeNewOrOld 06.30.16 ' '', --OLD_HOSPNUM ' PR.StationID, ' p2.NoticeofAdmID, ' m.SpouseEmployer, ' m.FileNum, ' '' AdmittingDr, ' Case When P.MedicareType <> '' Then 'Yes' Else 'No' END isYesPhic, ' Case When P.HospPlan = 'C' Then 'Yes' Else 'No' END isYesCompany, ' Case When P.HospPlan = 'C' Then Comp.Company Else '' END CompanyAccountName, ' Case When P.HospPlan = 'I' Then 'Yes' Else 'No' END isYesHMO, ' Case When P.HospPlan = 'I' Then Comp.Company Else '' END HMOAccountName, ' ----Comp.Company as CompName, ' -- ' --Case PMedicareType When '' Then 'Yes' Else '' END isYesPhic, ' --Case P.HospPlan When 'C' Then 'Yes' Else '' END isYesCompany, ' --Case P.HospPlan When 'C' Then Comp.Company Else '' END AS CompanyAccountName, ' --Case P.HospPlan When 'I' Then 'Yes' Else '' END isYesHMO, ' --Case P.HospPlan When 'I' Then Comp.Company Else '' END AS HMOAccountName, ' PHIC.PHICDescription as PDescription, ' --case when max(C.MedicareType) = '' or max(C.MedicareType) = 'NN' then ' -- count(A.IDNum) else 0 end NonPHIC, ' (SELECT TOP 1 ClientName FROM PATIENT_DATA..tbHospitalInfo ) ClientName ' ' 'From tbPatient P Left Outer Join tbPatient2 P2 ON P.IDNum = P2.IDNum ' Left Outer Join tbpatient P3 on p3.idnum = p2.idnum ' Left Outer Join tbMaster M ON P.HospNum = M.HospNum ' Left Outer Join tbMaster2 M2 On P.HospNum = M2.HospNum ' Left Outer Join Build_File..tbCoAddress Zip ON M.ZipCode = Zip.ZipCode ' Left Outer Join Build_File..tbCoNationality Nat ON M2.NationalityID = Nat.NationalityID ' Left Outer Join Build_File..tbCoReligion Rel On M2.ReligionID = Rel.ReligionID ' Left Outer Join Build_File..tbCoCompany Comp ON P.AccountNum = Comp.AccountNum ' Left Outer Join Build_File..tbCoCompany Comp2 ON P.AccountNumII = Comp2.AccountNum ' Left Outer Join tbPatientGuarantor Guar ON P.IDNum = Guar.IDNum ' Left Outer Join tbPatientInformant Inf ON P.IDNum = Inf.IDNum ' Left Outer Join Password..tbPasswordMaster Pass ON P.AdmittingClerk = Pass.EmployeeID ' Left Outer Join tbPatientHistory His ON P.IDNum = His.IDNum ' Left Outer Join Build_File..tbCoDoctor RefDr ON P.ReferringDr = RefDr.DoctorID ' Left Outer Join Build_File..tbCoDoctor AttDr1 On P.AttendingDr1 = AttDr1.DoctorID ' Left Outer Join Build_File..tbCoDoctor AttDr2 ON P.AttendingDr2 = AttDr2.DoctorID ' Left Outer Join Build_File..tbCoDoctor AdmDr ON P.AdmittingDr = AdmDr.DoctorID ' Left Outer Join Build_File..tbCoService S ON P.ServiceID = S.ServiceID ' Left Outer Join PATIENT_DATA..tbAdmDisposition T on P.DispositionID = T.DispositionID ' --LEFT Outer Join Build_File..tbCoPatientCategory tbCoPatientCategory ON P.Category = tbCoPatientCategory.PrimaryID ' Left Outer Join Build_File..tbCoDoctor AttDr3 On P.AdmittingDr = AttDr3.DoctorID ' Left Outer Join Build_File..tbCoDoctor AttDr4 ON P.ReferringDr = AttDr4.DoctorID ' Left Outer Join Build_File..tbCoAdmissionType AT on p2.AdmissionTypeID = AT.AdmissionTypeID ' Left Outer Join Build_file..tbCoAdmPackage K on P2.PackageID = K.PackageID ' Left Outer Join Build_File..tbCoNoticeOfAdm N ON P2.NoticeOfAdmID= N.NOticeOfAdmID ' Left outer join Medicare..tbAdmPHICTable PHIC on P.MedicareType = PHIC.PHICCode ' Left outer join Medicare..tbAdmPHICTable PHIC2 on P3.MedicareType = PHIC2.PHICCode ' Left Join BUILD_FILE..tbcoRoom PR on P.RoomID = PR.RoomID ' Left Join BUILD_FILE..tbCoAccomodation AC on PR.accomodationID = AC.AccomodationID 'Where P.IDNum = @IDNum ; ' 'GO ' ' 'USE [PATIENT_DATA] 'GO ' '/****** Object: UserDefinedFunction [dbo].[fn_GetPrevAdmdate] Script Date: 12/1/2021 3:24:24 PM ******/ 'SET ANSI_NULLS OFF 'GO ' 'SET QUOTED_IDENTIFIER OFF 'GO ' ' 'CREATE FUNCTION [dbo].[fn_GetPrevAdmdate] (@HospNum as varchar(10),@IDnum as varchar(15),@Admdate varchar(10)) 'RETURNS DateTime 'AS 'BEGIN ' Declare @PrevAdmdate as datetime ' Set @PrevAdmdate = ' ( Select top 1 a.AdmDate ' --Select top 1 a.HospNum,a.Idnum,a.AdmDate,a.DcrDate ' From Patient_Data..tbpatient a ' Where a.HospNum = @Hospnum and a.IdNum <> @IDnum and admdate < @Admdate ' Order By a.AdmDate desc ' ) ' ' Return(@PrevAdmdate) 'End ' ' 'GO ' ' ' ' 'USE [PATIENT_DATA] 'GO ' '/****** Object: UserDefinedFunction [dbo].[fn_GetPrevFinalDiagnosis] Script Date: 12/1/2021 3:25:17 PM ******/ 'SET ANSI_NULLS OFF 'GO ' 'SET QUOTED_IDENTIFIER OFF 'GO ' ' 'Create FUNCTION [dbo].[fn_GetPrevFinalDiagnosis] (@HospNum as varchar(10),@IDnum as varchar(15),@Admdate varchar(10)) 'RETURNS VarChar(1000) 'AS 'BEGIN ' Declare @PrevFinalDiagnosis as varchar(1000) ' Set @PrevFinalDiagnosis = ' ( Select top 1 b.FinalDiagnosis ' --Select top 1 a.HospNum,a.Idnum,a.AdmDate,a.DcrDate ' From Patient_Data..tbpatient a ' Left Join PATIENT_DATA..tbpatientHistory b on a.idnum = b.IDNum ' Where a.HospNum = @Hospnum and a.IdNum <> @IDnum and admdate < @Admdate ' Order By a.AdmDate desc ' ) ' ' Return(@PrevFinalDiagnosis) 'End ' ' 'GO ' ' ' End Sub Public Sub PrintSmartCard(ByVal pstrHospitalNumber As String, Optional ByVal pstrOutput As String = "S") Dim strCardNumber As String Dim objRec As ADODB.Recordset Screen.MousePointer = 11 Set objRec = New ADODB.Recordset With objRec If .State > 0 Then .Close End If .CursorLocation = adUseClient .Open "Patient_Data..proc_Bar_Search_Patient '" & pstrHospitalNumber & "','7'", pclsUser.sqlconnection, adOpenForwardOnly, adLockReadOnly If .RecordCount > 0 Then strCardNumber = .Fields("CardNumber").value & "" End If .Close End With If Trim(strCardNumber) <> vbNullString Then gstrCardNumberForSmartCardReport = strCardNumber glngReportType = cSmartCard frmCRViewer.Show vbModal Else MsgBox "This patient was not assigned a Smart Card Number.", vbOKOnly, "Notification" End If Screen.MousePointer = 0 ' Dim strCardNumber As String ' Dim objRec As ADODB.Recordset ' Dim objBarcodeLoader As frmBarcodeLoader ' ' Screen.MousePointer = 11 ' ' ' If glngHospitalID = cHospTypeAUF Or _ ' glngHospitalID = cHospTypeCebuDoctors Or _ ' glngHospitalID = cHospTypeStaRosa Then ' Set objRec = New ADODB.Recordset ' With objRec ' If .State > 0 Then ' .Close ' End If ' .CursorLocation = adUseClient ' .Open "Patient_Data..proc_Bar_Search_Patient '" & pstrHospitalNumber & "','7'", pclsUser.SQLCONNECTION, adOpenForwardOnly, adLockReadOnly ' If .RecordCount > 0 Then ' strCardNumber = .Fields("CardNumber").Value & "" ' End If ' .Close ' End With ' ' Set objBarcodeLoader = New frmBarcodeLoader ' ' If Trim(strCardNumber) <> vbNullString Then ' objBarcodeLoader.SaveToBMP strCardNumber, cSmartCard ' 'strCardNumber = pclsAdmission.IDNumber ' ' gstrCardNumberForSmartCardReport = strCardNumber ' glngReportType = cSmartCard ' frmCrViewer.Show vbModal ' Else ' MsgBox "This patient was not assigned a Smart Card Number.", vbOKOnly, "Notification" ' End If ' Else ' MsgBox "Feature not yet available.", vbOKOnly, "Notification" ' End If ' Screen.MousePointer = 0 End Sub Public Sub GetCurrentDateTime() Dim recTemp As New ADODB.Recordset On Error GoTo GetCurrentDateTimeErr Set recTemp = pclsUser.sqlconnection.Execute("Select GetDate() As CurDate from patient_Data..tbHospitalInfo") With recTemp If .EOF And .BOF Then GoTo GetCurrentDateTimeErr Else 'pdCurDate = Format$(!CurDate, "mm/dd/yyyy") pdCurDate = !CurDate End If End With Exit Sub GetCurrentDateTimeErr: pdCurDate = Date End Sub Public Function ToDouble(Argvalue As Variant) As Double 'Converts a variable to double data type If IsNumeric(Trim$(Argvalue)) = True Then ToDouble = Val(Trim$(Str$(Argvalue))) Else ToDouble = 0 End If End Function Public Function GetTitle(ByVal strPNO As String) As String Dim recTemp As New ADODB.Recordset On Error GoTo GetTitleErr recTemp.CursorLocation = adUseClient Set recTemp = pclsUser.sqlconnection.Execute("Select Title from Patient_Data..tbmaster where hospnum = '" + strPNO + "'") With recTemp If .EOF And .BOF Then GetTitle = "" Else GetTitle = !Title & "" End If End With Exit Function GetTitleErr: GetTitle = "" End Function Public Function GetNameSuffix(ByVal strPNO As String) As String Dim recTemp As New ADODB.Recordset On Error GoTo GetNameSuffix recTemp.CursorLocation = adUseClient Set recTemp = pclsUser.sqlconnection.Execute("Select ISNULL(NameSuffix,'') NameSuffix from Patient_Data..tbmaster where hospnum = '" + strPNO + "'") With recTemp If .EOF And .BOF Then GetNameSuffix = "" Else GetNameSuffix = !NameSuffix & "" End If End With Exit Function GetNameSuffix: GetNameSuffix = "" End Function Public Sub OpenMainReport(ByVal strReportFileName As String, ParamArray strParameters()) On Error GoTo ErrTrap Dim crxParameterField As CRAXDRT.ParameterFieldDefinition Dim intCtr As Integer Dim intTotalParam As Integer Dim crxtable As CRAXDRT.DatabaseTable Dim crxApplication As New CRAXDRT.Application intTotalParam = UBound(strParameters) Set Report = crxApplication.OpenReport(strReportFileName, 1) Report.ReportTitle = pstrHospitalName Report.ReportComments = pstrHospitalAddress Report.ReportAuthor = pclsUser.employeename For Each crxtable In Report.Database.Tables crxtable.Location = "Patient_Data" + Mid(crxtable.Location, InStr(1, crxtable.Location, ".")) crxtable.SetLogOnInfo pclsUser.ServerName, "Patient_Data", pclsUser.UserID, pclsUser.serverpassword 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 ' If ClientName = "BOLMSH" And blnExport Then ' If MsgBox("Do you wish to export the report?", vbYesNo, "Export Report to Disk") = vbYes Then ' strFileName = "Logbook " + Format$(Now, "MMddyyyy") + ".xls" ' Report.ExportOptions.DiskFileName = strFileName ' Report.ExportOptions.DestinationType = crEDTDiskFile ' Report.ExportOptions.FormatType = crEFTExcel80 ' Report.Export False ' MsgBox "Report was successfully exported to " + strFileName, vbInformation, "Information" ' End If ' End If blnExport = False Set crxParameterField = Nothing Set crxtable = Nothing Set crxApplication = Nothing Exit Sub ErrTrap: MsgBox "OpenMainReport " & Err.Description & " " & strReportFileName End Sub Public Sub OpenSubReport(ByVal strSubReport 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) For Each crxtable In crxSubreport.Database.Tables crxtable.Location = "Patient_Data" + Mid(crxtable.Location, InStr(1, crxtable.Location, ".")) crxtable.SetLogOnInfo pclsUser.ServerName, "Patient_Data", pclsUser.UserID, pclsUser.serverpassword 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 blnvbModal As Boolean = False) ' Dim frmRView As New frmReportViewer ' With frmRView ' .ShowGroupTree = blnShowGroupTree ' .Caption = strCaption ' .DirectPrint = blnDirectToPrinter ' .Show ' End With 'End Sub Public Sub ShowReportViewer(Optional blnShowGroupTree As Boolean = False, Optional strCaption As String = "", Optional blnDirectToPrinter As Boolean = False, Optional blnvbModal As Boolean = False) If Not blnvbModal Then Dim frmRView As New frmReportViewer With frmRView .ShowGroupTree = blnShowGroupTree .Caption = strCaption .DirectPrint = blnDirectToPrinter .Show vbModal End With Else Dim frmRViewvbmodal As New frmReportViewervbModal With frmRViewvbmodal .ShowGroupTree = blnShowGroupTree .Caption = strCaption .DirectPrint = blnDirectToPrinter .Show vbModal End With End If End Sub Public Function OriginalPrice(strRoomID As String) As Currency Dim recRoom As New ADODB.Recordset With recRoom If .State > 0 Then .Close .Open "Patient_Data..sp_Adm_CheckOriginalPrice '" + strRoomID + "'", pclsUser.sqlconnection, adOpenDynamic, adLockOptimistic If Not (.EOF And .BOF) Then OriginalPrice = IIf(IsNull(!RoomRate), 0, !RoomRate) Else OriginalPrice = 0 End If .Close End With End Function Public Function GetClerkName(ByVal stremployeeid As String) As String Dim recTemp As New ADODB.Recordset On Error GoTo GerClerkNameErr Set recTemp = pclsUser.sqlconnection.Execute("Patient_Data..sp_Adm_GetClerkName '" + stremployeeid + "'") With recTemp If .EOF And .BOF Then GetClerkName = "" Else GetClerkName = !employeename & "" End If End With GoTo ExitSub GerClerkNameErr: GetClerkName = "" ExitSub: Set recTemp = Nothing End Function Public Function Get_Sequence() Dim Rec As New ADODB.Recordset 'Dim riv As StringFormatEnum With Rec If .State > 0 Then .Close .CursorLocation = adUseClient .Open "Select Max(logsequence) + 1 as LogSequence from Patient_Data..tbAdm_UserLogin", pclsUser.sqlconnection, adOpenDynamic, adLockOptimistic If .RecordCount > 0 Then Get_Sequence = !LogSequence End If End With Set Rec = Nothing End Function Public Function Get_ClientName() As String Dim Rec As New ADODB.Recordset Dim SQL As String With Rec SQL = "Select top 1 ClientName, PediaAgeLimit,IsAllowRoomTransferWithPendingRequest from Patient_Data..tbHospitalInfo" If .State > 0 Then .Close .CursorLocation = adUseClient .Open SQL, pclsUser.sqlconnection, adOpenDynamic, adLockReadOnly If .RecordCount = 1 Then Get_ClientName = !ClientName pubPediaAgeLimit = !PediaAgeLimit blnAllowRoomTransferWithPendingRequest = !IsAllowRoomTransferWithPendingRequest End If .Close End With ClientName = Get_ClientName Set Rec = Nothing End Function Public Function GetNewFileNum() As Boolean On Error GoTo GetNewFileNumErr Dim comTemp As New ADODB.Command Dim parTemp As New ADODB.Parameter With comTemp .ActiveConnection = pclsUser.sqlconnection .CommandType = adCmdStoredProc .CommandText = "Patient_Data..sp_Adm_GetNewFileNum" Set parTemp = .CreateParameter("@FileNum", adVarChar, adParamOutput, 8, "") .Parameters.Append parTemp .Execute End With strLocalFileNum = comTemp.Parameters(0).value GetNewFileNum = True Set comTemp = Nothing Set parTemp = Nothing Exit Function GetNewFileNumErr: GetNewFileNum = False MsgBox "Unable to assign a new Control Number", vbOKOnly + vbCritical, "Error" End Function Public Function GetNewIDNum() As Boolean On Error GoTo GetNewAdmNumErr Dim comTemp As New ADODB.Command Dim parTemp As New ADODB.Parameter With comTemp .ActiveConnection = pclsUser.sqlconnection .CommandType = adCmdStoredProc .CommandText = "Patient_Data..sp_adm_GetNewIDNum" Set parTemp = .CreateParameter("@IDNum", adVarChar, adParamOutput, 10, "") .Parameters.Append parTemp .Execute End With pubstrIDNum = comTemp.Parameters(0).value If pubstrIDNum = "" Then GetNewIDNum = False GoTo GetNewAdmNumErr End If GetNewIDNum = True Set comTemp = Nothing Set parTemp = Nothing Exit Function GetNewAdmNumErr: GetNewIDNum = False MsgBox "Unable to assign a new Admission Number", vbOKOnly + vbCritical, "Error" End Function Public Sub AdmittingSetup() ' On Error GoTo AdmittingSetup_Err ' Dim SQL As String 'Dim Rec As New ADODB.Recordset CurrTable = "Patient_Data..tbAdmittingSetup" 100 SQL = "Select * from Patient_Data..tbAdmittingSetup WITH (NOLOCK)" 102 With RecSetup 104 If .State > 0 Then .Close 106 .CursorLocation = adUseServer 108 .CursorType = adOpenDynamic 110 '.LockType = adLockOptimistic 112 .Open SQL, pclsUser.sqlconnection If .EOF = False Then '114 If .RecordCount > 0 Then 116 blnAllowEstimateAge = GetBooleanField("isAllowEstimateAge") 118 blnAllowSearchBarangay = GetBooleanField("isAllowSearchBarangay") 120 blnAllowOldHospNumEntry = GetBooleanField("isAllowOldHospNumEntry") 122 blnAllowShowNewMainForm = GetBooleanField("isAllowShowNewMainForm") 124 blnAllowBarcode = GetBooleanField("isAllowBarcode") 126 blnAllowChangeInfo = GetBooleanField("isAllowChangeInfo") 128 blnAllowNewBornID = GetBooleanField("isAllowNewbornID") 130 blnAllowPatientCard = GetBooleanField("isAllowPatientCard") 132 blnAllowERNotificationMsg = GetBooleanField("isAllowERNotificationMsg") 134 blnAllowShowNewResult = GetBooleanField("IsAllowShowNewResult") 136 blnAllowByPeriodReport = GetBooleanField("IsAllowByPeriodReport") 138 blnisAllowDischargewithoutBillingDate = GetBooleanField("isAllowDischargewithoutBillingDate") 'blnisAllowDischargeBlockListed = GetBooleanField(Rec ,"isAllowDischargeBlockListed","Patient_Data..tbAdmittingSetup") 140 blnisAllowAdmitBlockListed = GetBooleanField("isAllowAdmitBlockListed") 142 blnIsAllowEditAdmissionDate = GetBooleanField("IsAllowEditAdmissionDate") 144 blnIsAllowSupervisorConfirmation = GetBooleanField("IsAllowSupervisorConfirmation") 146 blnAllowCheckOPDConsultation = GetBooleanField("isAllowCheckOPDConsultation") 148 blnAllowHospitalizationGuide = GetBooleanField("IsAllowHospitalizationGuide") 150 blnAllowAccountConsolidation = GetBooleanField("IsAllowAccountConsolidation") 152 blnAllowAffiliatedDoctorsOnly = GetBooleanField("IsAllowAffiliatedDoctorsOnly") 154 blnAllowNewInsuranceHMOcondition = GetBooleanField("isAllowNewInsuranceHMOcondition") 156 blnAllowCheckAdmdateGreaterThanCharges = GetBooleanField("isAllowCheckAdmdateGreaterThanCharges") 158 blnAllowLoadERDoctorAsAdmDoctor = GetBooleanField("isAllowLoadERDoctorAsAdmDoctor") 160 blnAllowAccountUnConsolidation = GetBooleanField("IsAllowAccountUnConsolidation") 162 blnAllowCF4Entries = GetBooleanField("IsAllowCF4Entries") 164 blnAllowEclaimsChecking = GetBooleanField("IsAllowEclaimsChecking") 166 blnAllowShowBalance = GetBooleanField("IsAllowShowBalance") 168 blnAllowDoctorSearchByService = GetBooleanField("IsAllowDoctorSearchByService") 170 blnAllowCheckPendingRequestOnRoomTransfer = GetBooleanField("IsAllowCheckPendingRequestOnRoomTransfer") 172 blnAllowCF4OnRegistration = GetBooleanField("IsAllowCF4OnRegistration") 174 blnAllowAdmitOnOccupiedRoom = GetBooleanField("IsAllowAdmitOnOccupiedRoom") 176 blnAllowAutoChargeAdmissionKit = GetBooleanField("IsAllowAutoChargeAdmissionKit") 177 blnAllowAutoChargeRoom = GetBooleanField("isAllowAutoChargeRoom") 180 blnAllowPRCExpirationOnDoctor = GetBooleanField("isAllowPRCExpirationOnDoctor") 181 blnAllowNoBalanceBillingTag = GetBooleanField("isAllowNoBalanceBillingTag") 182 blnAllowSetDefaultValues = GetBooleanField("isAllowSetDefaultValues") 183 blnAllowNewSuffix = GetBooleanField("isAllowNewSuffix") 184 blnAllowCreditLine = GetBooleanField("IsAllowCreditLine") 178 strPHICExpAdjustmentDays = CheckField("PHICExpAdjustmentDays") 179 strPRCExpAdjustmentDays = CheckField("PRCExpAdjustmentDays") End If 185 .Close End With 186 'Set Rec = Nothing ' Exit Sub AdmittingSetup_Err: MsgBox Err.Description & vbCrLf & _ "in Admission.modAdmitPatient.AdmittingSetup " & _ "at line " & Erl, _ vbExclamation + vbOKOnly, "Application Error" Resume Next ' End Sub Public Function CheckField(pFName As String) As Variant On Error GoTo ErrTrap CheckField = RecSetup.Fields(pFName) Exit Function ErrTrap: pclsUser.addlog "Missing field " & pFName End Function Public Function GetBooleanField(pFName As String) As Boolean On Error GoTo ErrTrap GetBooleanField = RecSetup.Fields(pFName) Exit Function ErrTrap: pclsUser.addlog Err.Description pclsUser.addlog pFName pclsUser.sqlconnection.Execute "ALTER TABLE " & CurrTable & " ADD [" & pFName & "] [bit] NOT NULL DEFAULT ((1))" End Function Public Sub ExtractName(ByVal strName As String, ByRef strLastName As String, ByRef strFirstName As String, ByRef strMiddleName As String) Dim intPos As Integer intPos = InStr(1, strName, ",", vbTextCompare) If intPos > 0 Then strLastName = Trim$(Mid$(strName, 1, intPos - 1)) strName = Trim$(Mid$(strName, intPos + 1)) intPos = InStr(1, strName, ",", vbTextCompare) If intPos > 0 Then strFirstName = Trim$(Mid$(strName, 1, intPos - 1)) strMiddleName = Trim$(Mid$(strName, intPos + 1)) Else strFirstName = strName strMiddleName = "" End If Else strLastName = Trim$(strName) strFirstName = "" strMiddleName = "" End If End Sub Public Function GetNewBornIDNum() As Boolean On Error GoTo GetNewAdmNumErr Dim comTemp As New ADODB.Command Dim parTemp As New ADODB.Parameter With comTemp .ActiveConnection = pclsUser.sqlconnection .CommandType = adCmdStoredProc ' .CommandText = "Patient_Data..sp_Adm_GetNewIDNum" ''VBB 08.04.17 .CommandText = "Patient_Data..sp_Adm_GetNewBornIDNum" Set parTemp = .CreateParameter("@IDNum", adVarChar, adParamOutput, 10, "") .Parameters.Append parTemp .Execute End With pubstrIDNum = comTemp.Parameters(0).value If pubstrIDNum = "" Then GetNewBornIDNum = False GoTo GetNewAdmNumErr End If GetNewBornIDNum = True Set comTemp = Nothing Set parTemp = Nothing Exit Function GetNewAdmNumErr: GetNewBornIDNum = False ' MsgBox "Unable to assign a new Admission Number", vbOKOnly + vbCritical, "Error" MsgBox Err.Description End Function 'Public Sub PrintWristBand(ByVal pstrHospitalNumber As String, Optional ByVal pstrOutput As String = "S") ' Dim strWristBand As String ' Dim objRec As ADODB.Recordset ' ' Screen.MousePointer = 11 ' ' Set objRec = New ADODB.Recordset ' With objRec ' If .State > 0 Then ' .Close ' End If ' .CursorLocation = adUseClient ' .Open "Patient_Data..proc_Bar_Search_Patient '" & pstrHospitalNumber & "','7'", pclsUser.SQLconnection, adOpenForwardOnly, adLockReadOnly ' If .RecordCount > 0 Then ' strWristBand = .Fields("CardNumber").Value & "" ' End If ' .Close ' End With ' If Trim(strWristBand) <> vbNullString Then ' gstrCardNumberForWristBandReport = strWristBand ' glngReportType = cWristBand ' frmCRViewer.Show vbModal ' Else ' MsgBox "This patient was not assigned a Smart Card Number.", vbOKOnly, "Notification" ' End If ' ' Screen.MousePointer = 0 'End Sub Public Sub PrintLabel(ByVal strAdmNumber As String, ByVal strPxAge As String, Optional ByVal strOutput As String = "S") If blnAllowBarcode Then Screen.MousePointer = 1 pclsUser.sqlconnection.Execute "Patient_Data..sp_Adm_PatientData '" + Trim$(strAdmNumber) + "', '" + strPxAge + "'" frmCRViewer.Show Screen.MousePointer = 0 Else If blnWithBarcode = False Then Screen.MousePointer = 1 pclsUser.sqlconnection.Execute "Patient_Data..sp_Adm_PatientData '" + Trim$(strAdmNumber) + "', '" + strPxAge + "'" If ClientName = "NDCH" Then OpenMainReport App.Path + "\rptlabel.rpt", pstrHospitalAddress, pclsUser.employeename Else OpenMainReport App.Path + "\rptlabel.rpt", pstrHospitalAddress End If ShowReportViewer False, "Doctor Label", IIf(strOutput = "S", False, True) Screen.MousePointer = 0 End If End If End Sub Public Sub OpenMainFinancialReport(ByVal strReportFileName 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 intTotalParam = UBound(strParameters) If Not Report Is Nothing Then Set Report = Nothing Set Report = crxApplication.OpenReport(strReportFileName, 1) Report.ReportTitle = UAF(pstrHospitalName) Report.ReportComments = UAF(pstrHospitalAddress) For Each crxtable In Report.Database.Tables crxtable.Location = "Billing" + Mid(crxtable.Location, InStr(1, crxtable.Location, ".")) crxtable.SetLogOnInfo pclsUser.ServerName, "Billing", pclsUser.UserID, pclsUser.serverpassword 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 Function GetPatientName(ByVal Hospnum As String) As String Dim recTemp As New ADODB.Recordset On Error GoTo GetPatientNameErr recTemp.CursorLocation = adUseClient Set recTemp = pclsUser.sqlconnection.Execute("Select LastName +', '+ FirstName +' '+ MiddleName as PatientName from Patient_Data..tbmaster where hospnum = '" + Hospnum + "'") With recTemp If .EOF And .BOF Then GetPatientName = "" Else GetPatientName = !PatientName & "" End If End With Exit Function GetPatientNameErr: GetPatientName = "" End Function Public Function File_Exists(FileName As String) As Boolean Dim fs As Object Dim blnResult As Boolean On Error GoTo errHandle Set fs = CreateObject("Scripting.FileSystemObject") blnResult = fs.FileExists(FileName) Set fs = Nothing File_Exists = blnResult Exit Function errHandle: File_Exists = True End Function Public Sub AdmittingReportSetup() ' On Error GoTo AdmittingReportSetup_Err ' Dim SQL As String 'Dim Rec As New ADODB.Recordset CurrTable = "Patient_Data..tbAdmReportSetup" 100 SQL = "Select * from Patient_Data..tbAdmReportSetup WITH (NOLOCK)" 102 With RecSetup 104 If .State > 0 Then .Close 106 .CursorLocation = adUseServer 108 .CursorType = adOpenDynamic 110 '.LockType = adLockOptimistic 112 .Open SQL, pclsUser.sqlconnection 114 ' If .RecordCount > 0 Then If .EOF = False Then 116 blnmnuDailyLogbook = GetBooleanField("DailyAdmLogBook") 118 blnmnuReportAdmissionList = GetBooleanField("DailyAdmList") 120 blnmnuReportDischargeList = GetBooleanField("DailyDcrList") 122 blnmnuDailySummaryofRoomTransfer = GetBooleanField("DailySummaryOfRoomTransfer") 124 blnmnuNarrativeReport = GetBooleanField("DailynarrativeReport") 126 blnmnuDailyPatientType = GetBooleanField("DailyReportOfPatientType") 128 blnmnuDailySummary = GetBooleanField("DailyAdmSummary") 130 blnmnuWatchersList = GetBooleanField("DailyWatchersList") 132 blnmnuReportCensusAllPatient = GetBooleanField("CensusReportAllpatient") 134 blnmnuReportCensusByStation = GetBooleanField("CenusReportByStation") 136 blnmnuReportCensusByDeposits = GetBooleanField("CensusReportbyDeposit") 138 blnmnuReportGrandCensus = GetBooleanField("CensusGrandCensusReport") 140 blnmnuFinancialReport = GetBooleanField("CensusFinancialStatusReport") 142 blnmnuSummaryHMOLOA = GetBooleanField("CensusSummaryOfHMOLOA") 144 blnmnuReportHMOCompany = GetBooleanField("CensusReportHMOandCompany") 145 blnmnuPackageCensusReport = GetBooleanField("CensusReportPackage") 146 blnmnuReportStatisticsDaily = GetBooleanField("StatDailyHospitalStatistics") 148 blnmnuStatisticsByStation = GetBooleanField("StatMonthlyStatisticsByStation") 150 blnmnuReportStatisticsMonthly = GetBooleanField("StatMonthlyStatisticalReport") 152 blnmnuReportStatisticsPeriod = GetBooleanField("StatReportByPeriod") 154 blnmnuAdmissionByCompany = GetBooleanField("StatMonthlyAdmissionbyCompany") 156 blnmnuMonthlyAdmissionAndReAdmission = GetBooleanField("StatMonthlyAdmissionAndReadmission") 158 blnmnuMonSumHospStat = GetBooleanField("StatMonthlySummaryOfHospital") 160 blnmnuAdmLogbook = GetBooleanField("StatAdmissionLogBook") 162 blnmnuMonthlyRepPatientType = GetBooleanField("StatMonthlyReportOfPatientType") 164 blnmnuStatisticByShifting = GetBooleanField("StatByUser") 166 blnmnuDailyCensusByPatientType = GetBooleanField("StatDailyCensusByPatientType") 168 blnMnuDailyCensusByService = GetBooleanField("StatDailyCensusByService") 170 blnmnuDailyCensusTotalHMO = GetBooleanField("StatDailyCensusTotalHMO") 172 blnmnuMonthlySummaryOfActivities = GetBooleanField("StatMonthlySummaryOfActivities") 174 blnmnuDoctorsPatientLoad = GetBooleanField("DoctorsPatientLoad") 176 blnmnuReportAvailability = GetBooleanField("OtherRoomAvailabilityReport") 178 blnmnuSummaryOfRoomTransfer = GetBooleanField("OtherSummaryOfRoomTransfer") 180 blnmnuReportDoctorPxList = GetBooleanField("OtherDoctorsPatientList") 182 blnmnuCompanyList = GetBooleanField("OtherCompanyList") 184 blnmnuListOfReservations = GetBooleanField("OtherListofReservation") 186 blnmnuListOfDischargeOrders = GetBooleanField("OtherTypeOfAdmissionSummaryReport") 188 blnmnuTypeOfAdmission = GetBooleanField("OtherTypeOfAdmissionSummaryReport") 190 blnmnuWalkIn = GetBooleanField("OtherWalkInOPDFAdmission") 192 blnmnuListOfRevokeDischarges = GetBooleanField("OtherListOfRevokeDischarges") 194 blnmnuAbsconded = GetBooleanField("OtherAbscondedPatients") 196 blnmnuMembership = GetBooleanField("OtherMembership") 198 blnmnu_Transferred = GetBooleanField("OtherTransferedToOtherHospital") 200 blnmnuRoomStatus = GetBooleanField("OtherRoomStatusReport") 202 blnmnuWellBabyAdmList = GetBooleanField("OtherWellBabyAdmissionList") 204 blnMnuPatientWithBirthDate = GetBooleanField("OtherPatientWithBirthdays") 206 blnmnuYearlyPxByArea = GetBooleanField("OtherYearlyPatientByArea") 208 blnmnuPatientByReligion = GetBooleanField("OtherPatientByReligion") 210 blnOtherMonthlyDoctorsInvolvement = GetBooleanField("OtherMonthlyDoctorsInvolvement") 212 blnmnuMonthlyOccupancy = GetBooleanField("OthermnuMonthlyOccupancy") 214 blnOtherDefectiveRooms = GetBooleanField("OtherDefectiveRooms") 216 blnNursingDeptStatistics = GetBooleanField("OtherNursingStatistics") End If 218 .Close End With 220 'Set Rec = Nothing ' Exit Sub AdmittingReportSetup_Err: MsgBox Err.Description & vbCrLf & _ "in Admission.modAdmitPatient.AdmittingReportSetup " & _ "at line " & Erl, _ vbExclamation + vbOKOnly, "Application Error" ' Resume Next ' End Sub Public Sub Load_SeaFarerSetup() Dim SQL As String Dim Rec As New ADODB.Recordset SQL = "Select SeaFarer from Patient_Data..tbhospitalinfo" With Rec If .State > 0 Then .Close .CursorLocation = adUseClient .CursorType = adOpenDynamic .LockType = adLockReadOnly .Open SQL, pclsUser.sqlconnection If .RecordCount > 0 Then blnSeaFarer = !SeaFarer End If .Close End With Set Rec = Nothing End Sub 'Public Function RoomWithPendingRequest() As Boolean 'Dim intReccount As Integer 'Dim Rec As New ADODB.Recordset 'Dim StrQ As String ' '' StrQ = "Select * From Station..tbNurseLogBook where idnum = '" & pubstrIDNum & "' and RecordStatus = ''" ' StrQ = "Select A.Hospnum,A.IDnum,A.RecordStatus,A.RevenueID,D.station From Station..tbNurseLogBook A" _ ' + " Left Outer Join PATIENT_DATA..tbpatient B on A.IDnum = B.IdNum" _ ' + " Left Outer Join BUILD_FILE..tbCoroom C on B.RoomID = C.RoomID" _ ' + " Left Outer Join BUILD_FILE..TbCoStation D on C.StationID = D.StationID " _ ' + " where A.idnum = '" & pubstrIDNum & "' and A.RecordStatus = ''" ' With Rec ' If .State > 0 Then .Close ' .CursorLocation = adUseClient ' .Open StrQ, pclsUser.sqlconnection, adOpenDynamic, adLockOptimistic ' If .RecordCount > 0 Then ' RoomWithPendingRequest = True ' StrStationWithPendingRequest = !Station ' Else ' RoomWithPendingRequest = False ' End If ' End With ' 'End Function Public Sub Load_RegistrationReqEntries() Dim Rec As New ADODB.Recordset Dim SQL As String SQL = "Select * from Patient_Data..tbAdmReqEntrySettings " With Rec If .State > 0 Then .Close .CursorLocation = adUseClient .CursorType = adOpenDynamic .LockType = adLockOptimistic .Open SQL, pclsUser.sqlconnection If .RecordCount > 0 Then Do While Not .EOF If !EntryID = "1" Then blnReqLastName = IIf(!Status = "True", True, False) ElseIf !EntryID = "2" Then blnReqFirstName = IIf(!Status = "True", True, False) ElseIf !EntryID = "3" Then blnReqMiddleName = IIf(!Status = "True", True, False) ElseIf !EntryID = "4" Then blnReqBirthDate = IIf(!Status = "True", True, False) ElseIf !EntryID = "5" Then blnReqGender = IIf(!Status = "True", True, False) ElseIf !EntryID = "6" Then blnReqCivilStatus = IIf(!Status = "True", True, False) ElseIf !EntryID = "7" Then blnReqTownProvince = IIf(!Status = "True", True, False) ElseIf !EntryID = "8" Then blnReqNationality = IIf(!Status = "True", True, False) ElseIf !EntryID = "9" Then blnReqReligion = IIf(!Status = "True", True, False) ElseIf !EntryID = "10" Then blnReqNotifyIncaseOfEmergeny = IIf(!Status = "True", True, False) ElseIf !EntryID = "11" Then blnReqInformant = IIf(!Status = "True", True, False) ElseIf !EntryID = "12" Then blnReqGuarantor = IIf(!Status = "True", True, False) ElseIf !EntryID = "13" Then blnReqHospitalizationPlan = IIf(!Status = "True", True, False) ElseIf !EntryID = "14" Then blnReqPatientClass = IIf(!Status = "True", True, False) ElseIf !EntryID = "15" Then blnReqAdmissionType = IIf(!Status = "True", True, False) ElseIf !EntryID = "16" Then blnReqNoticeOfAdmission = IIf(!Status = "True", True, False) ElseIf !EntryID = "17" Then blnReqRoom = IIf(!Status = "True", True, False) ElseIf !EntryID = "18" Then blnReqService = IIf(!Status = "True", True, False) ElseIf !EntryID = "19" Then blnReqAttendingDr = IIf(!Status = "True", True, False) ElseIf !EntryID = "20" Then blnReqAdmissionDiagnosis = IIf(!Status = "True", True, False) ElseIf !EntryID = "21" Then blnReqChiefComplaint = IIf(!Status = "True", True, False) ElseIf !EntryID = "22" Then blnReqPrecaution = IIf(!Status = "True", True, False) ElseIf !EntryID = "23" Then blnReqAdmittingImpression = IIf(!Status = "True", True, False) ElseIf !EntryID = "24" Then blnReqTypeOfStay = IIf(!Status = "True", True, False) ElseIf !EntryID = "25" Then blnReqCF4RequiredEntry = IIf(!Status = "True", True, False) ElseIf !EntryID = "26" Then blnReqHouseStreetBarangay = IIf(!Status = "True", True, False) ElseIf !EntryID = "27" Then blnReqNoBalanceBilling = IIf(!Status = "True", True, False) End If .MoveNext Loop End If .Close End With Set Rec = Nothing End Sub Public Sub Load_RegistrationLabelEntries() SetupDefaultSetting Dim Rec As New ADODB.Recordset Dim SQL As String SQL = "Select * from Patient_Data..tbAdmLabelEntrySettings where status= 1" With Rec If .State > 0 Then .Close .CursorLocation = adUseClient .CursorType = adOpenDynamic .LockType = adLockOptimistic .Open SQL, pclsUser.sqlconnection If .RecordCount > 0 Then Do While Not .EOF If !EntryID = "1" Then strLabelLastName = !InUseLabel ElseIf !EntryID = "2" Then strLabelFirstName = !InUseLabel ElseIf !EntryID = "3" Then strLabelMiddleName = !InUseLabel ElseIf !EntryID = "4" Then strLabelTitle = !InUseLabel ElseIf !EntryID = "5" Then strLabelBirth = !InUseLabel ElseIf !EntryID = "6" Then strLabelGender = !InUseLabel ElseIf !EntryID = "7" Then strLabelBirthPlace = !InUseLabel ElseIf !EntryID = "8" Then strLabelBarangay = !InUseLabel ElseIf !EntryID = "9" Then strLabelTownProvince = !InUseLabel ElseIf !EntryID = "10" Then strLabelForeignAddress = !InUseLabel ElseIf !EntryID = "11" Then strLabelCountry = !InUseLabel ElseIf !EntryID = "12" Then strLabelOccupation = !InUseLabel ElseIf !EntryID = "13" Then strLabelGuarantor = !InUseLabel ElseIf !EntryID = "14" Then strLabelOtherGuarantor = !InUseLabel ElseIf !EntryID = "15" Then strLabelHospitalizationPlan = !InUseLabel End If .MoveNext Loop End If .Close End With Set Rec = Nothing End Sub Private Sub SetupDefaultSetting() Dim strSQL As String 'TABLE strSQL = "IF NOT EXISTS(SELECT 1 FROM PATIENT_DATA.INFORMATION_SCHEMA.COLUMNS WHERE TABLE_NAME='tbAdmLabelEntrySettings') " strSQL = strSQL + " BEGIN " strSQL = strSQL + " CREATE TABLE PATIENT_DATA..tbAdmLabelEntrySettings ( " strSQL = strSQL + " EntryID varchar(10),Entry varchar(300),InUseLabel varchar(300),Status bit not NULL default(0))" strSQL = strSQL + " END " pclsUser.sqlconnection.Execute strSQL strSQL = "" 'Default items strSQL = "IF NOT EXISTS(SELECT 1 from PATIENT_DATA..tbAdmLabelEntrySettings) " strSQL = strSQL + " BEGIN " strSQL = strSQL + "INSERT INTO PATIENT_DATA..tbAdmLabelEntrySettings (EntryID,Entry,InUseLabel,Status) SELECT '1','Last Name','Last Name',1 " strSQL = strSQL + "INSERT INTO PATIENT_DATA..tbAdmLabelEntrySettings (EntryID,Entry,InUseLabel,Status) SELECT '2','First Name','First Name',1 " strSQL = strSQL + "INSERT INTO PATIENT_DATA..tbAdmLabelEntrySettings (EntryID,Entry,InUseLabel,Status) SELECT '3','Middle Name','Middle Name',1 " strSQL = strSQL + "INSERT INTO PATIENT_DATA..tbAdmLabelEntrySettings (EntryID,Entry,InUseLabel,Status) SELECT '4','Title','Title',1 " strSQL = strSQL + "INSERT INTO PATIENT_DATA..tbAdmLabelEntrySettings (EntryID,Entry,InUseLabel,Status) SELECT '5','Birthdate','Birthdate',1 " strSQL = strSQL + "INSERT INTO PATIENT_DATA..tbAdmLabelEntrySettings (EntryID,Entry,InUseLabel,Status) SELECT '6','Sex ','Sex',1 " strSQL = strSQL + "INSERT INTO PATIENT_DATA..tbAdmLabelEntrySettings (EntryID,Entry,InUseLabel,Status) SELECT '7','Birth Place','Birth Place',1 " strSQL = strSQL + "INSERT INTO PATIENT_DATA..tbAdmLabelEntrySettings (EntryID,Entry,InUseLabel,Status) SELECT '8','Barangay','Barangay',1 " strSQL = strSQL + "INSERT INTO PATIENT_DATA..tbAdmLabelEntrySettings (EntryID,Entry,InUseLabel,Status) SELECT '9','Town/Province','Town/Province',1 " strSQL = strSQL + "INSERT INTO PATIENT_DATA..tbAdmLabelEntrySettings (EntryID,Entry,InUseLabel,Status) SELECT '10','Foreign Address','Foreign Address',1 " strSQL = strSQL + "INSERT INTO PATIENT_DATA..tbAdmLabelEntrySettings (EntryID,Entry,InUseLabel,Status) SELECT '11','Country','Country',1 " strSQL = strSQL + "INSERT INTO PATIENT_DATA..tbAdmLabelEntrySettings (EntryID,Entry,InUseLabel,Status) SELECT '12','Occupation','Occupation',1 " strSQL = strSQL + "INSERT INTO PATIENT_DATA..tbAdmLabelEntrySettings (EntryID,Entry,InUseLabel,Status) SELECT '13','Guarantor','Guarantor',1 " strSQL = strSQL + "INSERT INTO PATIENT_DATA..tbAdmLabelEntrySettings (EntryID,Entry,InUseLabel,Status) SELECT '14','Other Guarantor','Other Guarantor',1 " strSQL = strSQL + "INSERT INTO PATIENT_DATA..tbAdmLabelEntrySettings (EntryID,Entry,InUseLabel,Status) SELECT '15','Hospitalization Plan','Hospitalization Plan',1 " strSQL = strSQL + " END " pclsUser.sqlconnection.Execute strSQL strSQL = "" End Sub Public Sub Proc_AdmitNewRecord(strLastName As String, strFirstName As String, strBirthdate As String, strGender As String) With frmAdmitPatient .strIDNum = "" .NewAdmission = True .IsFromERCommunication = False .NewPatient = True .OPDIDNum = "" .HospNumFromCommunication = "New" '.DirectSearch = True .DirectSearch = False 'pk 2021 .IDNumber = pubstrIDNum .txtPatientName(0) = strLastName If strLastName <> strFirstName Then .txtPatientName(1) = strFirstName End If .txtBirthDate = strBirthdate If strGender = "F" Then .optSex(1).value = True '.txtSSSNum = txtSSSNum '.txtGSISNum = txtGSISNum '.txtPHICNum = txtPHICNum .txtHospNum = "New" .txtAdmStatus = "New Admission" .txtIDNum = "New" .strIDNum = "New" Load frmAdmitPatient Screen.MousePointer = 0 If ConShowAdmitForm Then frmAdmitPatient.Show Else Unload frmAdmitPatient End If End With End Sub Public Sub Proc_ReadmitPatient(pHospNum As String, PatientName As String) If Len(Trim$(pHospNum)) = 0 Then frmAdmitPatient.HospNumFromCommunication = "" Exit Sub End If ' If MsgBox("Are you sure that you want to admit " & PatientName & "", vbQuestion + vbYesNo) <> vbYes Then ' Exit Sub ' End If blnContinuewithBalance = True pubstrHospNum = pHospNum If IsDeceased(pHospNum) Then MsgBox "Patient " & PatientName & " is tagged as deceased, verify this record to Medical Records department.", vbExclamation Exit Sub End If If WithERCommunicationRequest(pHospNum) Then MsgBox "Confinement request for " & PatientName & " is available. Please check ER-Admitting communication.", vbExclamation Exit Sub End If If Proc_OPDConsultation(pHospNum) Then MsgBox "Patient has current OPD Registration. Patient is not allowed to be admitted.", vbInformation Exit Sub End If ' Relocate 11.02.16 VBB ' If blnPrevious_PHICConfinementWithin90days = True Then ' Exit Sub ' End If ' check if confined if If IsAllowSeparateClaim(pHospNum) = True Then ' do not need check if confied Else If blnConfinedPatient(pHospNum) Then Exit Sub End If End If Proc_ComputePatientsOldAccounts pHospNum If blnContinuewithBalance = False Then Exit Sub End If If Proc_BlockListStatus(pHospNum) Then frmBlocklisted.Show vbModal Exit Sub End If ' check absconded? With frmAdmitPatient .NewAdmission = True .IDNumber = "New" .OPDIDNum = "" .HospNumFromCommunication = pHospNum .DirectSearch = True .NewPatient = False Load frmAdmitPatient Screen.MousePointer = 0 If ConShowAdmitForm Then .Show Else Unload frmAdmitPatient End If End With End Sub Public Function Proc_BlockListStatus(PstrHospnum As String) As Boolean If blnisAllowAdmitBlockListed = True Then Proc_BlockListStatus = False Exit Function End If Dim strSQL As String Dim StrPatientStatus As String Dim recPatientStatus As New ADODB.Recordset strSQL = "Select PatientStatus from Patient_Data..tbMaster where hospnum = '" & Trim$(PstrHospnum) & "'" With recPatientStatus .CursorLocation = adUseServer .Open strSQL, pclsUser.sqlconnection, adOpenDynamic, adLockReadOnly If Not .EOF Then If !PatientStatus = "B" Then Proc_BlockListStatus = True Else Proc_BlockListStatus = False End If End If End With End Function Public Sub Proc_ComputePatientsOldAccounts(PstrHospnum As String) Dim recX As New ADODB.Recordset Dim recCheckAccount As New ADODB.Recordset Dim strSQL As String If Len(Trim$(pubstrHospNum)) > 0 Then If recX.State > 0 Then recX.Close recX.CursorLocation = adUseClient recX.Open "Patient_Data..sp_Adm_ComputePatientsOldAccounts '" + Trim$(PstrHospnum) + "'", pclsUser.sqlconnection, adOpenDynamic, adLockReadOnly If recX.RecordCount > 0 Then If recX![Amount] > 0 Then strSQL = "" strSQL = "select top 1 accountnum, admdate from patient_data..tbpatient where hospnum = '" & Trim$(PstrHospnum) & "'" strSQL = strSQL + " union all" strSQL = strSQL + " select top 1 accountnum, admdate from patient_data..tboutpatient where hospnum = '" & Trim$(PstrHospnum) & "' order by admdate desc" If recCheckAccount.State = 1 Then recCheckAccount.Close recCheckAccount.CursorLocation = adUseClient recCheckAccount.Open strSQL, pclsUser.sqlconnection, adOpenDynamic, adLockReadOnly If recCheckAccount.RecordCount > 0 Then If recX![Amount] > 0 Then With frmBalanceCheck If Not blnAllowShowBalance Then .cmdPrintBalance.Enabled = False End If .Show vbModal End With End If End If recCheckAccount.Close End If End If End If End Sub Public Function Proc_OPDConsultation(PstrHospnum As String) As Boolean If blnAllowCheckOPDConsultation = False Then Proc_OPDConsultation = False Exit Function End If Dim strSQL As String 'Dim StrPatientStatus As String Dim recPatientStatus As New ADODB.Recordset 'pubstrHospNum = Trim$(gridPatientList.TextMatrix(gridPatientList.Row, 4)) ' If Len(Trim$(pubstrHospNum)) > 0 Then ' strHospnum = pubstrHospNum ' End If strSQL = "Select DcrDate from Patient_Data..TBOUTPATIENT WITH (NOLOCK) where (DcrDate is null or DcrDate <= '01/01/1900') and HospNum = '" & Trim$(PstrHospnum) & "' and OPDstatus<>'R' " With recPatientStatus .CursorLocation = adUseServer .Open strSQL, pclsUser.sqlconnection, adOpenDynamic, adLockReadOnly If .EOF = False Then Proc_OPDConsultation = True Else Proc_OPDConsultation = False End If End With End Function Public Function WithERCommunicationRequest(PstrHospnum As String) As Boolean ' On Error GoTo CheckERCommunicationRequest_Err ' Dim strSQL As String Dim recPatient As New ADODB.Recordset '100 CheckERCommunicationRequest = False 102 strSQL = "Select 1 From Patient_Data..tbER_Admitting_Communication WITH (NOLOCK) Where Hospnum ='" & Trim$(PstrHospnum) & "' And isnull(Recordstatus,'')=''" 104 With recPatient 108 .CursorLocation = adUseServer 110 .Open strSQL, pclsUser.sqlconnection, adOpenDynamic, adLockReadOnly 112 If .EOF = False Then 114 WithERCommunicationRequest = True Else 116 WithERCommunicationRequest = False End If End With ' Exit Function CheckERCommunicationRequest_Err: MsgBox Err.Description & vbCrLf & _ "in A CheckERCommunicationRequest " & _ "at line " & Erl, _ vbOKOnly, "Application Error" ' Resume Next ' End Function Public Function IsDeceased(PstrHospnum As String) As Boolean ' On Error GoTo IsDeceased_Err ' Dim strSQL As String Dim recPatient As New ADODB.Recordset strSQL = "" strSQL = strSQL + " Select Top 1 resultid From patient_data..tbpatient" strSQL = strSQL + " Where resultid ='4'" strSQL = strSQL + " and hospnum ='" + Trim$(PstrHospnum) + "'" strSQL = strSQL + " Union All" strSQL = strSQL + " Select Top 1 OPDStatus From patient_data..tboutpatient WITH (NOLOCK) " strSQL = strSQL + " Where OPDStatus ='D'" strSQL = strSQL + " and hospnum ='" + Trim$(PstrHospnum) + "'" '100 strSQL = "select top 1 resultid from patient_data..tbpatient where hospnum = '" + Trim$(strHospnum) + "' " 102 With recPatient 106 .CursorLocation = adUseServer 108 .Open strSQL, pclsUser.sqlconnection, adOpenDynamic, adLockReadOnly 110 If .EOF = False Then 112 IsDeceased = True Else 114 IsDeceased = False End If End With ' Exit Function IsDeceased_Err: MsgBox Err.Description & vbCrLf & "in IsDeceased " & "at line " & Erl, vbOKOnly, "Application Error" ' Resume Next ' End Function Public Function IsAllowSeparateClaim(pubstrHospNum As String) As Boolean On Error GoTo ErrTrap Dim strSQL As String Dim recPatient As New ADODB.Recordset ' Search confined patients where exists patient problem of 19 (Covid) strSQL = strSQL & " SELECT 1 FROM PATIENT_DATA..tbpatient AS A WITH (NOLOCK) " strSQL = strSQL & " INNER JOIN STATION..tbPatientProblem AS B WITH (NOLOCK) ON A.IDNUM = B.IDNUM" 'strSQL = strSQL & " WHERE A.hospnum ='" & pubstrHospNum & "' AND B.PPCode='19' " strSQL = strSQL & " WHERE A.hospnum ='" & pubstrHospNum & "' AND B.AllowSeparateClaim='1' " With recPatient .Open strSQL, pclsUser.sqlconnection, adOpenDynamic, adLockReadOnly If .EOF = False Then IsAllowSeparateClaim = True Else IsAllowSeparateClaim = False End If End With Exit Function ErrTrap: MsgBox "IsAllowSeparateClaim " & Err.Description End Function Public Function blnConfinedPatient(PstrHospnum As String) As Boolean Dim strSQL As String Dim RecConfined As New ADODB.Recordset Dim PxName As String strSQL = "" strSQL = " Select a.Hospnum,a.IDNum,a.AdmDate,a.DcrDate" strSQL = strSQL + " From PATIENT_DATA..tbPatient a" strSQL = strSQL + " Where a.HospNum ='" & Trim$(PstrHospnum) & "' And isnull(a.DcrDate,'')=''" With RecConfined .CursorLocation = adUseServer .Open strSQL, pclsUser.sqlconnection, adOpenDynamic, adLockReadOnly If .EOF = False Then blnConfinedPatient = True PxName = GetPatientName(PstrHospnum) MsgBox "Computer record shows that this patient :" & PxName & " is still confined in this hospital.", vbInformation Else blnConfinedPatient = False End If End With End Function