Attribute VB_Name = "modTemp"
Option Explicit
Public Const YELLOW = &H80000018
Public Const YELLOW_1 = &H80FFFF
Public Const WHITE = &H80000005
Public Const RED = &HC0C0FF
Public Const BLACK = &H80000008
Public Const VIOLET = &HFFC0C0
Public Const CONST_RUV_PSH = True
Public Const KC_PASSWORD_KEY = "ROBERTFKAISER"
'NKTI
Private mvarDocChief As String
Private mvarPayService As String
Private mvarPurchaseDate As String
'Private mvarSession As String
Public user As Object
'Public user As New Medsys_User.clsCurrentUser
Public Medicare As New clsMedicare
Public DoctorList As New clsDoctorList
Public Doctor As New Doctor
Public ZipCode As New ZipCode
Public ListZipCode As New clsZipCodeList
Public MedicareType As New MedType
Public MemberList As New ListMembers
'Public EmployerList As New ListEmployers
Public EmployerList As Object
''
'isPBEF
Public PubisPBEFImplementationDate As Date
Public blnEnablePBEF As Boolean
'Transmittal
Public blnisTransmittalCaseType As Boolean
'Split Caserate
Public blnisallowSplitCaserate As Boolean
'Distribute Whole Caserate
Public blnisDistributeWholeCaserate As Boolean
'Caserate Terms
Public blnisAllowCaseRateTerms As Boolean
Public PubAllowCaseRateTermsImplementationDate As Date
'restrict fields on CF2 Entry
Public blnisAllowFieldsCF2 As Boolean
'allow all doctors on CF1 Entry
Public blnEnablePFPHICValidCF1 As Boolean
'validate 90 days Same caserate
Public blnisValidate90daysCaserate As Boolean
'check PHIC admitted patients
Public blnAllowShowAdmittedPHICPx As Boolean
Public blnAllowShowAdmittedPHICPxImplementationDate As Date
'activate PBEF Transmittal
Public blnPBEFTransmittal As Boolean
Public blnPBEFTransmittalImplementationDate As Date
'activate Automatic PF Sharing
Public blnAutoPFSharing As Boolean
'enable CF2 Pre-print
Public blnCF2Preprint As Boolean
'enable Prompt Px w/ 90 days confinement @CF1
Public bln90daysConfinement As Boolean
'eclaims
Public clsMDR As New classMDR
'eclaims
'Public MedsysClasses As New clsMEDSYS
Public pclsCodeSearch As Object
Public PatientList As New ListPatients
Public clsPatient As Object
'Public clsPatient As New clsPatient
'Public clsPatient As New clsPatient
Public BuildFiles As New MedBuildFiles
Public LateSubmission As New LateSubmission
Public RVS As New RVS
Public clsICD10 As Object
Public MEDSYSClass As Object
Public clsSummary As New clsSummary
Public clsUserSetting As New UserSetting
Public AdditionalClass As New AdditionalClass
Public clsCardiologist As New clsCardiologist
Public clsAnesthesiologist As New clsAnesthesiologist
Public clsPhysician As New clsPhysician
Public recPostedList As New ADODB.Recordset
Public recSubReceivableList As New ADODB.Recordset
Public Recnew As New ADODB.Recordset
Public Form2Report As CRAXDRT.Report
Public Form5Report As CRAXDRT.Report
Public Form2crxApplication As CRAXDRT.Application
Public strpubHospnum As String
Public strpubIDNum As String
Public PublicPCF As Double
Public pstrHospitalName As String
Public pstrHospitalAddress As String
Public pstrHospitalCode As String
Public pstrAdministrator As String
Public pstrAdminTitle As String
Public pstrHospitalTIN As String
Public pstrHospitalTelNo As String
Public pstrPHICAccountNum As String
Public dblPackagePF As Double
Public dblAmountPackage As Double
'Public dblTotalActualCharges As Double
Public PublicORAmount As String
Public PublicPackage As String
Public isPublicPackage As Boolean
Public isPackage As String
Public PublicRB As Double
Public PublicDrugs As Double
Public PublicOthers As Double
Public PublicOR As Double
Public DoctorPF As Double
Public PhysicianPF As Double
Public SurgeonPF As Double
Public AnesPF As Double
Public ServerDate As Date
Public dblCashMed As Double
Public blnCashMeds As Boolean
Public blnWithOperationDate As Boolean
Public blnAllowUpdateSlashingCharges As Boolean
Public blnAllowDistributeSlashing As Boolean
Public blnAllowPrintOutDiagnosis As Boolean
Public intAllowedPrintOutDiagnosis As Integer
Public blnAllowTentativeTransmittal As Boolean
Public blnAllowShowElapsedClaims As Boolean
Public blnAllowShowRTHClaims As Boolean
Public blnAllowMaximize As Boolean
Public blnAllowPrintPartV As Boolean
Public blnAllowUpdateDoctorPF As Boolean
Public blnAllowLateSubmission As Boolean
Public blnAllowTransmittalRefiled As Boolean
Public blnHMOAccount As Boolean
Public PubSlashingForm As String
Public blnAllowSlashing As Boolean
Public blnAllowSignatoryUserAccount As Boolean
Public blnAllowPatientAutomaticCompute As Boolean
Public blnAllowEntryAutomaticCompute As Boolean
Public blnAllowBuildFileNew As Boolean
Public blnAllowIndexNumber As Boolean
Public blnAllowDirectAutomaticCompute As Boolean
Public blnAllowDeleteTransmittal As Boolean
Public blnAllowShowPerformedDate As Boolean
Public blnAllowLockedFormsPrinting As Boolean
Public PubFormsImplementationDate As Date
Public PubACRFormsImplementationDate As Date
Public PubPartIIIandIVACR As Date
Public PubBenefitsImplementationDate As Date
Public blnAllowSeparatePart45 As Boolean
Public blnAllowEditPatientDays As Boolean
Public blnAllowPart23Signatory As Boolean
Public blnPart34onEntry As Boolean
'ECLAIMS
Public blnAllowUserVerification As Boolean
Public ActivatePhase1 As Boolean
Public ActivatePhase1_2 As Boolean
Public ActivatePhase2 As Boolean
Public blnShowReport As Boolean
'ECLAIMS
Public WshShell As Object 'sendKeys
Public pubMemberRelationship As String
Public ClientName As String
Public strOptionType As String
Public strIdNum As String
Public ActualUserID As String
Private strBirthDate As String
Private strAge As String
Public isMaternityPackage As Boolean
Public pubDcrDate As String
Public pubAdmDate As Date
Public pubRequireCF4StartDate As Date
'Grid Table
Global Const coCapitalize = 1
Global Const coNumericOnly = 2
Global strReportPath As String
Global blnProceed As Boolean
Public strDx1 As String
Public strDx2 As String
Public strDx3 As String
Public strDx4 As String
Public strDx5 As String
Public strDx6 As String
Public strDx7 As String
Public strDx8 As String
Public strDx9 As String
Public strDx10 As String
Public strDx11 As String
Public strDx12 As String
Public strDx13 As String
Public strDx14 As String
Public strDx15 As String
Public strDx16 As String
Public strDx17 As String
Public strDx18 As String
Public strDx19 As String
Public strDx20 As String
Public strICD1 As String
Public strICD2 As String
Public strICD3 As String
Public strICD4 As String
Public strICD5 As String
Public strICD6 As String
Public strICD7 As String
Public strICD8 As String
Public strICD9 As String
Public strICD10 As String
Public strICD11 As String
Public strICD12 As String
Public strICD13 As String
Public strICD14 As String
Public strICD15 As String
Public strICD16 As String
Public strICD17 As String
Public strICD18 As String
Public strICD19 As String
Public strICD20 As String
Public strRVSCode1 As String
Public strRVSCode2 As String
Public strRVSCode3 As String
Public strRVSCode4 As String
Public strRVSCode5 As String
Public strRVSCode6 As String
Public strRVSCode7 As String
Public strRVSCode8 As String
Public strRVSCode9 As String
Public strRVSCode10 As String
'added by khing november 29, 2013
Public strLaterality1 As String
Public strLaterality2 As String
Public strLaterality3 As String
Public strLaterality4 As String
Public strLaterality5 As String
Public strLaterality6 As String
Public strLaterality7 As String
Public strLaterality8 As String
Public strLaterality9 As String
Public strLaterality10 As String
Public strRelatedProcedure1 As String
Public strRelatedProcedure2 As String
Public strRelatedProcedure3 As String
Public strRelatedProcedure4 As String
Public strRelatedProcedure5 As String
Public strRelatedProcedure6 As String
Public strRelatedProcedure7 As String
Public strRelatedProcedure8 As String
Public strRelatedProcedure9 As String
Public strRelatedProcedure10 As String
Public strICDRVS1 As String
Public strICDRVS2 As String
Public strICDRVS3 As String
Public strICDRVS4 As String
Public strICDRVS5 As String
Public strICDRVS6 As String
Public strICDRVS7 As String
Public strICDRVS8 As String
Public strICDRVS9 As String
Public strICDRVS10 As String
Public strDateOfOperation1 As String
Public strDateOfOperation2 As String
Public strDateOfOperation3 As String
Public strDateOfOperation4 As String
Public strDateOfOperation5 As String
Public strDateOfOperation6 As String
Public strDateOfOperation7 As String
Public strDateOfOperation8 As String
Public strDateOfOperation9 As String
Public strDateOfOperation10 As String
'added by ange 3.1.2016
Public strRelatedProcedure11 As String
Public strRelatedProcedure12 As String
Public strRelatedProcedure13 As String
Public strRelatedProcedure14 As String
Public strRelatedProcedure15 As String
Public strRelatedProcedure16 As String
Public strRelatedProcedure17 As String
Public strRelatedProcedure18 As String
Public strRelatedProcedure19 As String
Public strRelatedProcedure20 As String
Public strDateOfOperation11 As String
Public strDateOfOperation12 As String
Public strDateOfOperation13 As String
Public strDateOfOperation14 As String
Public strDateOfOperation15 As String
Public strDateOfOperation16 As String
Public strDateOfOperation17 As String
Public strDateOfOperation18 As String
Public strDateOfOperation19 As String
Public strDateOfOperation20 As String
Public strRVSCode11 As String
Public strRVSCode12 As String
Public strRVSCode13 As String
Public strRVSCode14 As String
Public strRVSCode15 As String
Public strRVSCode16 As String
Public strRVSCode17 As String
Public strRVSCode18 As String
Public strRVSCode19 As String
Public strRVSCode20 As String
Public strICDRVS11 As String
Public strICDRVS12 As String
Public strICDRVS13 As String
Public strICDRVS14 As String
Public strICDRVS15 As String
Public strICDRVS16 As String
Public strICDRVS17 As String
Public strICDRVS18 As String
Public strICDRVS19 As String
Public strICDRVS20 As String
Public strLaterality11 As String
Public strLaterality12 As String
Public strLaterality13 As String
Public strLaterality14 As String
Public strLaterality15 As String
Public strLaterality16 As String
Public strLaterality17 As String
Public strLaterality18 As String
Public strLaterality19 As String
Public strLaterality20 As String
Public strFirstICDRVS As String
Public strSecondICDRVS As String
Public intDiagCount As Integer
Public blnPreprinted As Boolean
Private strDocID As String
Public blnServicePerformed As Boolean
Public strForm2RVS As String
Public strForm2IllnessCOde As String
'**** User Setting ****'
Public blnDataEntry As Boolean
Public blnAutoComputation As Boolean
Public blnFeeAdjustment As Boolean
Public blnPaymentEntry As Boolean
Public blnStatementOfAccount As Boolean
Public blnForm3 As Boolean
Public blnMedicareClaim As Boolean
Public blnReason As Boolean
Public blnPHICReceived As Boolean
Public blnForm1 As Boolean
Public blnTransmittalReport As Boolean
'**** END ****'
'*** Declaration of New Rates ***'
Public clsNewRates As New clsNewRates
Public PubMaxDailyPF As Double
Public PubDailyPF As Double
Public PubSurgeonPFBelow500 As Double
Public PubSurgeonPFUp500 As Double
Public PubAnesPFBelow500 As Double
Public PubAnesPFUp500 As Double
'*** END ***'
Public pubAdmDateTime As Date
Public pubPatientDays As Integer
'*** Private Declaration ***'
Dim dblHMORB As Double
Dim dblHMOMeds As Double
Dim dblHMOOthers As Double
Dim dblHMOOR As Double
Dim dblDiscountRB As Double
Dim dblDiscountMeds As Double
Dim dblDiscountOthers As Double
Dim dblDiscountOR As Double
Dim dblHMOPhysician As Double
Dim dblHMOSurgeon As Double
Dim dblHMOAnes As Double
Dim dblDiscountPhysician As Double
Dim dblDiscountSurgeon As Double
Dim dblDiscountAnes As Double
Dim dblTotalHMO As Double
Dim dblTotalDiscount As Double
'*** END ***'
Global blnRecomputed As Boolean
Global strRemarks As String
Public strCase As Integer
Public Report As CRAXDRT.Report
Public Enum DOCTOR_PF
ACTUAL_PF = 1
MEDICARE_PF = 2000
End Enum
Public Sub Main()
'
On Error GoTo Main_Err
'
Dim blnOnLine As Boolean
Dim recX As New ADODB.Recordset
100 Set user = CreateObject("MEDSYS_User.clsCurrentUser")
102 Set clsPatient = CreateObject("Patient.clsPatient")
104 Set clsICD10 = CreateObject("ICD10.ICDCodeSearch")
106 Set pclsCodeSearch = CreateObject("CodeSearchForm.clsCodeSearch")
108 Set MEDSYSClass = CreateObject("MEDSYSClasses.clsMEDSYS")
110 Set EmployerList = CreateObject("prjListEmployers.ListEmployers")
112 Set WshShell = CreateObject("WScript.Shell")
114 user.PasswordDeptCode = "8"
116 user.ShowMain
118 DoEvents
120 blnOnLine = False
122 If user.Connected Then
124 pclsCodeSearch.SearchMode = True
126 pclsCodeSearch.Initialize_Classes
128 pclsCodeSearch.Connection = user.SQLConnection
130 user.MEDSYSClasses.UseClasses = True
132 user.MEDSYSClasses.InitWithDB
134 MEDSYSClass.MedsysUser = user
136 MEDSYSClass.EXEPath = App.Path
138 frmSplash.Show
140 frmSplash.Refresh
142 user.SQLConnection.DefaultDatabase = "Medicare"
144 user.SQLConnection.CommandTimeout = 120
146 If ConnectAll Then
' blnOnLine = True
148 If recX.State > 0 Then recX.Close
150 recX.CursorLocation = adUseClient
152 recX.Open "Select IsNull(PCF,0) [PCF] from Medicare..tbMedHospital", user.SQLConnection, adOpenDynamic, adLockReadOnly
154 If recX.RecordCount > 0 Then
156 PublicPCF = Format(recX![PCF], "#########0.00")
End If
158 GetHospitalCode
160 GetAdministrator
162 GetServerDate
164 HospitalInfo
166 GetUserVerSettings
168 ActivatePhase
' If isActivateLetterLogin = True Then
' CheckCurrUser 'Letter@LogIn
' End If
170 clsUserSetting.Initialize_MenuVisibility
172 clsUserSetting.Load_MenuSetting
174 clsUserSetting.Initialize_Menu
176 clsUserSetting.Load_UserSetting
178 frmMedicare.EnableDisableOptions 0
180 Load frmMedicare
182 Unload frmSplash
184 frmMedicare.Show
Else
186 frmSplash.cmdExit.Visible = True
End If
Else
Exit Sub
End If
' If blnOnLine Then
'
' Else
' End If
188 If recX.State > 0 Then recX.Close
190 Set recX = Nothing
'
Exit Sub
Main_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.Main " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Sub
Public Function ConnectAll()
Dim blnConnected As Boolean
Dim errDLL() As Variant
errDLL = Array("CurrentUser", "ClassMedicare", "PRJDOCTORDLL", "PRJDOCTORLISTDLL", "ZipCodes", "ZipCodeList", "MedicareType", "PatientClass", "PRJLISTMEMBERS", "PRJLISTEMPLOYERS", "PRJMEDBUILDFILES", "RVSMedSys")
On Error GoTo errtrap
blnConnected = False
If user.Connected Then
frmSplash.pb.value = frmSplash.pb.value + 1
If Medicare.InitConnection(user.SQLConnection.ConnectionString) Then
frmSplash.pb.value = frmSplash.pb.value + 1
If Doctor.InitConnection(user.SQLConnection.ConnectionString) Then
frmSplash.pb.value = frmSplash.pb.value + 1
If DoctorList.InitConnection(user.SQLConnection.ConnectionString) Then
frmSplash.pb.value = frmSplash.pb.value + 1
If ZipCode.InitConnection(user.SQLConnection.ConnectionString) Then
frmSplash.pb.value = frmSplash.pb.value + 1
If ListZipCode.InitConnection(user.SQLConnection.ConnectionString) Then
frmSplash.pb.value = frmSplash.pb.value + 1
If MedicareType.InitConnection(user.SQLConnection.ConnectionString) Then
frmSplash.pb.value = frmSplash.pb.value + 1
clsPatient.OpenConnection user.SQLConnection.ConnectionString
If Not clsPatient.ActiveConnection Is Nothing Then
frmSplash.pb.value = frmSplash.pb.value + 1
If MemberList.InitConnection(user.SQLConnection.ConnectionString) Then
frmSplash.pb.value = frmSplash.pb.value + 1
If EmployerList.InitConnection(user.SQLConnection.ConnectionString) Then
frmSplash.pb.value = frmSplash.pb.value + 1
If BuildFiles.InitConnection(user.SQLConnection.ConnectionString) Then
frmSplash.pb.value = frmSplash.pb.value + 1
'user.sqlconnection.ConnectionString
If RVS.InitConnection(user.SQLConnection.ConnectionString) Then
frmSplash.pb.value = frmSplash.pb.value + 1
'If PatientList.InitConnection(user.SQLConnection.ConnectionString) Then
'frmSplash.pb.Value = frmSpldash.pb.Value + 1
blnConnected = True
'End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
ConnectAll = blnConnected
Exit Function
errtrap:
frmSplash.pb.Visible = False
frmSplash.lblLoad.Caption = errDLL(frmSplash.pb.value) & ".dll was not able to connect to server."
End Function
Public Sub Emphasize(msflexVar As MSHFlexGrid, lHigh As Boolean, Optional lngColor As Long = YELLOW)
'
On Error GoTo Emphasize_Err
'
100 If msflexVar.Rows > 0 Then
102 If lHigh Then
' msflexVar.CellBackColor = lngColor
104 msflexVar.CellForeColor = BLACK
Else
' msflexVar.CellBackColor = WHITE
106 msflexVar.CellForeColor = BLACK
End If
End If
'
Exit Sub
Emphasize_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.Emphasize " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Sub
Public Sub PrintGeneralInfo(Optional blnWithICD As Boolean = False, Optional HideDoctor As Boolean)
'
On Error GoTo PrintGeneralInfo_Err
'
Dim intctr As Integer
Dim strDx As String
Dim strDiag As String
Dim strMembership As String
Dim blnIsCashMeds As Boolean
Dim strAdmDate As String
Dim intPatientDays As Integer
'for direct filing NKTI
Dim dblClaimRB As Double
Dim dblClaimDrugs As Double
Dim dblClaimOthers As Double
Dim dblClaimOR As Double
Dim dblClaimOutside As Double
100 With Medicare
102 strMembership = GetMembership(IIf(.Member.MemberType = "", 1, .Member.MemberType))
104 Form2Report.ParameterFields(F_ACCREDITNUM).AddCurrentValue .Hospital.AccrNumber
106 Form2Report.ParameterFields(F_CATEGORY).AddCurrentValue .Hospital.Category
108 Form2Report.ParameterFields(F_HOSPITAL_NAME).AddCurrentValue .Hospital.HospitalName
110 Form2Report.ParameterFields(F_HOSPITAL_STREET).AddCurrentValue .Hospital.Street
112 Form2Report.ParameterFields(F_HOSPITAL_BARANGAY).AddCurrentValue .Hospital.Barangay
114 Form2Report.ParameterFields(F_HOSPITAL_MUNICIPALITY).AddCurrentValue .Hospital.Municipality
116 Form2Report.ParameterFields(F_HOSPITAL_PROVINCE).AddCurrentValue .Hospital.Province
118 Form2Report.ParameterFields(F_HOSPITAL_ZIPCODE).AddCurrentValue .Hospital.ZipCode
120 Form2Report.ParameterFields(F_PATIENT_LASTNAME).AddCurrentValue Trim$(.LastName) ' + " (" + .IDNum + ")"
122 Form2Report.ParameterFields(F_PATIENT_FIRSTNAME).AddCurrentValue .FirstName
124 Form2Report.ParameterFields(F_PATIENT_MIDDLENAME).AddCurrentValue .MiddleName
126 Form2Report.ParameterFields(F_SEX).AddCurrentValue .Sex
128 strIdNum = .IdNum
130 strAdmDate = GetPatientAdmDate(strIdNum)
132 If ClientName = "MJSH" And (ServerDate < PubFormsImplementationDate Or ServerDate < PubACRFormsImplementationDate) Then
134 blnHMOAccount = IsHMOAccount(strIdNum)
End If
136 If ClientName <> "RLMC" Then
138 Form2Report.ParameterFields(F_AGE).AddCurrentValue IIf(IIf(IsNumeric(.Age), .Age, 0) = 0, CalculateBirthday(BirthDate(.HospNum), .AdmissionDate), .Age)
Else
140 BirthDate .HospNum
142 Form2Report.ParameterFields(F_AGE).AddCurrentValue IIf(InStr(1, .Age, "D") > 0 Or InStr(1, .Age, "M") > 0, 0, (IIf(IsNumeric(.Age), .Age, 0)))
End If
144 Form2Report.ParameterFields(F_MEMBER_LASTNAME).AddCurrentValue .Member.LastName '& " (" & strMembership & ")"
146 Form2Report.ParameterFields(F_MEMBER_FIRSTNAME).AddCurrentValue .Member.FirstName
148 Form2Report.ParameterFields(F_MEMBER_MIDDLENAME).AddCurrentValue .Member.MiddleName
150 Form2Report.ParameterFields(F_MEMBER_IDNUM).AddCurrentValue .Member.MemberNumber
152 Form2Report.ParameterFields(F_MEMBER_STREET).AddCurrentValue .Member.HouseStreet
154 Form2Report.ParameterFields(F_MEMBER_BARANGAY).AddCurrentValue .Member.Barangay
156 Form2Report.ParameterFields(F_MEMBER_MUNICIPALITY).AddCurrentValue .Member.Municipality
158 Form2Report.ParameterFields(F_MEMBER_PROVINCE).AddCurrentValue .Member.Province
160 Form2Report.ParameterFields(F_MEMBER_ZIPCODE).AddCurrentValue .Member.ZipCode
162 If Len(.Diagnosis.AdmissionDiagnosis) > 254 Then
164 Form2Report.ParameterFields(F_ADMISSIONDX).AddCurrentValue Left(.Diagnosis.AdmissionDiagnosis, 254)
Else
166 Form2Report.ParameterFields(F_ADMISSIONDX).AddCurrentValue .Diagnosis.AdmissionDiagnosis
End If
168 Form2Report.ParameterFields(F_DATE_ADMITTED).AddCurrentValue Format(.AdmissionDate, "mm/dd/yyyy")
170 Form2Report.ParameterFields(F_DATE_DISCHARGED).AddCurrentValue Format(.DischargedDate, "mm/dd/yyyy")
172 Form2Report.ParameterFields(F_TIME_ADMITTED).AddCurrentValue Format(.AdmissionDate, "hh:mm AMPM") '.AdmissionTime
174 Form2Report.ParameterFields(F_TIME_DISCHARGED).AddCurrentValue Format(.DischargedDate, "hh:mm AMPM") '.DischargeTime
176 If .Condition = "E" Then
178 Form2Report.ParameterFields(F_DATE_OF_DEATH).AddCurrentValue Format(.DischargedDate, "mm/dd/yyyy")
Else
180 Form2Report.ParameterFields(F_DATE_OF_DEATH).AddCurrentValue "n/a"
End If
182 If blnCashMeds Then
184 blnIsCashMeds = IsCashMeds(strIdNum)
End If
186 If ClientName = "LMC" Then
188 If IsNumeric(Right(strIdNum, 1)) Then
190 If blnAllowEditPatientDays Then
192 intPatientDays = GetPatientDays(strIdNum)
194 If intPatientDays > 0 Then
196 Form2Report.ParameterFields(F_CLAIMED_DAYS).AddCurrentValue Trim$(STR(intPatientDays))
Else
198 Form2Report.ParameterFields(F_CLAIMED_DAYS).AddCurrentValue Format(DateDiff("d", .AdmissionDate, .DischargedDate), "#####")
End If
Else
200 Form2Report.ParameterFields(F_CLAIMED_DAYS).AddCurrentValue Format(DateDiff("d", .AdmissionDate, .DischargedDate), "#####")
End If
Else
202 Form2Report.ParameterFields(F_CLAIMED_DAYS).AddCurrentValue "0"
End If
Else
204 If blnAllowEditPatientDays Then
206 intPatientDays = GetPatientDays(strIdNum)
208 If intPatientDays > 0 Then
210 Form2Report.ParameterFields(F_CLAIMED_DAYS).AddCurrentValue Trim$(STR(intPatientDays))
Else
212 Form2Report.ParameterFields(F_CLAIMED_DAYS).AddCurrentValue Format(DateDiff("d", .AdmissionDate, .DischargedDate), "#####")
End If
Else
214 Form2Report.ParameterFields(F_CLAIMED_DAYS).AddCurrentValue Format(DateDiff("d", .AdmissionDate, .DischargedDate), "#####")
End If
End If
216 With Rec
218 If .State > 0 Then .Close
220 .CursorLocation = adUseClient
222 .CursorType = adOpenDynamic
224 .LockType = adLockOptimistic
226 .Open "Select isnull(ActualRoomBoard,0)ActualRoomBoard, isnull(ActualDrug,0) ActualDrug,isnull(ActualOthers,0) ActualOthers,isnull(ActualOR,0) ActualOR, isnull(ActualOutside,0) ActualOutside From medicare..tbmedclaim Where Idnum = '" & Trim$(strIdNum) & "'", user.SQLConnection
228 If .RecordCount > 0 Then
230 dblClaimRB = !ActualRoomBoard
232 dblClaimDrugs = !ActualDrug
234 dblClaimOthers = !ActualOthers
236 dblClaimOR = !ActualOR
238 dblClaimOutside = !ActualOutside
End If
End With
240 Set Rec = Nothing
' If ClientName <> "NKTI" Then
242 Form2Report.ParameterFields(F_ACTUAL_RB).AddCurrentValue Format(.Charges.Claim.ActualRoomAndBoard, "###,###,##0.00")
244 Form2Report.ParameterFields(F_ACTUAL_MEDS).AddCurrentValue Format(.Charges.Claim.ActualDrugs, "###,###,##0.00")
246 Form2Report.ParameterFields(F_ACTUAL_OTHERS).AddCurrentValue Format(.Charges.Claim.ActualOthers, "###,###,##0.00")
248 Form2Report.ParameterFields(F_ACTUAL_OR).AddCurrentValue Format(.Charges.Claim.ActualOR, "###,###,##0.00")
250 Form2Report.ParameterFields(F_ACTUAL_ETC).AddCurrentValue Format(.Charges.Claim.ActualOutsideCharges, "###,###,##0.00")
252 If isMaternityPackage And ClientName = "BOLMSH" Then
254 Form2Report.ParameterFields(F_TOTALACTUAL).AddCurrentValue Format((.Charges.Claim.ActualRoomAndBoard + _
.Charges.Claim.ActualDrugs + _
.Charges.Claim.ActualOthers + _
.Charges.Claim.ActualOR + _
.Charges.Claim.ActualOutsideCharges) - GetActualMeds(strIdNum, "5"), "##,###,##0.00")
Else
256 If blnIsCashMeds And ClientName = "DDH" And strAdmDate >= PubFormsImplementationDate Then
258 Form2Report.ParameterFields(F_TOTALACTUAL).AddCurrentValue Format((.Charges.Claim.ActualRoomAndBoard + _
.Charges.Claim.ActualDrugs + _
.Charges.Claim.ActualOthers + _
.Charges.Claim.ActualOR), "##,###,##0.00")
Else
'jeremy
260 If ClientName = "MJSH" Or ClientName = "BIHMI" Then
262 If GetIsBenefits(strIdNum) = True Then
264 Form2Report.ParameterFields(F_TOTALACTUAL).AddCurrentValue Format((.Charges.Claim.ActualRoomAndBoard + _
.Charges.Claim.ActualDrugs + _
.Charges.Claim.ActualOthers + _
.Charges.Claim.ActualOR + _
.Charges.Claim.ActualOutsideCharges) + _
GetTotalActualPF(strIdNum), "##,###,##0.00")
Else
266 Form2Report.ParameterFields(F_TOTALACTUAL).AddCurrentValue Format((.Charges.Claim.ActualRoomAndBoard + _
.Charges.Claim.ActualDrugs + _
.Charges.Claim.ActualOthers + _
.Charges.Claim.ActualOR + _
.Charges.Claim.ActualOutsideCharges), "##,###,##0.00")
End If
268 ElseIf ClientName = "MGH" Then
270 If GetIsBenefits(strIdNum) = True Then
272 Form2Report.ParameterFields(F_TOTALACTUAL).AddCurrentValue Format((.Charges.Claim.ActualRoomAndBoard + _
.Charges.Claim.ActualDrugs + _
.Charges.Claim.ActualOthers + _
.Charges.Claim.ActualOR + _
.Charges.Claim.ActualOutsideCharges) + _
GetTotalActualPFNew(strIdNum), "##,###,##0.00")
Else
274 Form2Report.ParameterFields(F_TOTALACTUAL).AddCurrentValue Format((.Charges.Claim.ActualRoomAndBoard + _
.Charges.Claim.ActualDrugs + _
.Charges.Claim.ActualOthers + _
.Charges.Claim.ActualOR + _
.Charges.Claim.ActualOutsideCharges), "##,###,##0.00")
End If
Else
276 Form2Report.ParameterFields(F_TOTALACTUAL).AddCurrentValue Format((.Charges.Claim.ActualRoomAndBoard + _
.Charges.Claim.ActualDrugs + _
.Charges.Claim.ActualOthers + _
.Charges.Claim.ActualOR + _
.Charges.Claim.ActualOutsideCharges), "##,###,##0.00")
End If
End If
End If
' End If
'
' If ClientName = "NKTI" And (.Charges.Claim.ActualRoomAndBoard + _
' .Charges.Claim.ActualDrugs + _
' .Charges.Claim.ActualOthers + _
' .Charges.Claim.ActualOR + _
' .Charges.Claim.ActualOutsideCharges) = 0 Then
'
' Form2Report.ParameterFields(F_ACTUAL_RB).AddCurrentValue Format(dblClaimRB, "###,###,##0.00")
' Form2Report.ParameterFields(F_ACTUAL_MEDS).AddCurrentValue Format(dblClaimDrugs, "###,###,##0.00")
' Form2Report.ParameterFields(F_ACTUAL_OTHERS).AddCurrentValue Format(dblClaimOthers, "###,###,##0.00")
' Form2Report.ParameterFields(F_ACTUAL_OR).AddCurrentValue Format(dblClaimOR, "###,###,##0.00")
' Form2Report.ParameterFields(F_ACTUAL_ETC).AddCurrentValue Format(dblClaimOutside, "###,###,##0.00")
' Form2Report.ParameterFields(F_TOTALACTUAL).AddCurrentValue Format((dblClaimRB + dblClaimDrugs + dblClaimOthers + dblClaimOR + dblClaimOutside), "##,###,##0.00")
' Else
' Form2Report.ParameterFields(F_ACTUAL_RB).AddCurrentValue Format(.Charges.Claim.ActualRoomAndBoard, "###,###,##0.00")
' Form2Report.ParameterFields(F_ACTUAL_MEDS).AddCurrentValue Format(.Charges.Claim.ActualDrugs, "###,###,##0.00")
' Form2Report.ParameterFields(F_ACTUAL_OTHERS).AddCurrentValue Format(.Charges.Claim.ActualOthers, "###,###,##0.00")
' Form2Report.ParameterFields(F_ACTUAL_OR).AddCurrentValue Format(.Charges.Claim.ActualOR, "###,###,##0.00")
' Form2Report.ParameterFields(F_ACTUAL_ETC).AddCurrentValue Format(.Charges.Claim.ActualOutsideCharges, "###,###,##0.00")
' Form2Report.ParameterFields(F_TOTALACTUAL).AddCurrentValue Format((.Charges.Claim.ActualRoomAndBoard + _
' .Charges.Claim.ActualDrugs + _
' .Charges.Claim.ActualOthers + _
' .Charges.Claim.ActualOR + _
' .Charges.Claim.ActualOutsideCharges), "##,###,##0.00")
' End If
'
278 Form2Report.ParameterFields(F_MED_RB).AddCurrentValue Format(.Charges.Claim.MedicareRoomAndBoard, "##,###,##0.00")
280 Form2Report.ParameterFields(F_MED_MEDS).AddCurrentValue Format(.Charges.Claim.MedicareDrugs, "##,###,##0.00")
282 Form2Report.ParameterFields(F_MED_OTHERS).AddCurrentValue Format(.Charges.Claim.MedicareOthers, "##,###,##0.00")
284 Form2Report.ParameterFields(F_MED_OR).AddCurrentValue Format(.Charges.Claim.MedicareOR, "##,###,##0.00")
286 Form2Report.ParameterFields(F_MED_ETC).AddCurrentValue Format(.Charges.Claim.MedicareOutsideCharges, "##,###,##0.00")
' If ClientName = "MGH" Or ClientName = "VRPMC" Or ClientName = "LMC" Or ClientName = "BIHMI" Or ClientName = "SHMC" Or _
' ClientName = "WCI" Or ClientName = "NKTI" Then
288 If GetIsBenefits(strIdNum) = True Then
290 SearchPackageID GetPackageType(strIdNum)
292 Form2Report.ParameterFields(F_TOTALMED).AddCurrentValue Format(dblAmountPackage, "##,###,##0.00")
Else
294 Form2Report.ParameterFields(F_TOTALMED).AddCurrentValue Format((.Charges.Claim.MedicareRoomAndBoard + _
.Charges.Claim.MedicareDrugs + _
.Charges.Claim.MedicareOthers + _
.Charges.Claim.MedicareOR + _
.Charges.Claim.MedicareOutsideCharges), "##,###,##0.00")
End If
' Else
' Form2Report.ParameterFields(F_TOTALMED).AddCurrentValue Format((.Charges.Claim.MedicareRoomAndBoard + _
' .Charges.Claim.MedicareDrugs + _
' .Charges.Claim.MedicareOthers + _
' .Charges.Claim.MedicareOR + _
' .Charges.Claim.MedicareOutsideCharges), "##,###,##0.00")
' End If
296 If ClientName <> "MJSH" Then
298 Form2Report.ParameterFields(F_PAT_RB).AddCurrentValue Format(.Charges.Claim.PatientRoomAndBoard, "##,###,##0.00")
300 Form2Report.ParameterFields(F_PAT_MEDS).AddCurrentValue Format(.Charges.Claim.PatientDrugs, "##,###,##0.00")
302 Form2Report.ParameterFields(F_PAT_OTHERS).AddCurrentValue Format(.Charges.Claim.PatientOthers, "##,###,##0.00")
304 Form2Report.ParameterFields(F_PAT_OR).AddCurrentValue Format(.Charges.Claim.PatientOR, "##,###,##0.00")
306 Form2Report.ParameterFields(F_PAT_ETC).AddCurrentValue Format(.Charges.Claim.PatientOutsideCharges, "##,###,##0.00")
308 Form2Report.ParameterFields(F_TOTALPATIENT).AddCurrentValue Format((.Charges.Claim.PatientRoomAndBoard + _
.Charges.Claim.PatientDrugs + _
.Charges.Claim.PatientOthers + _
.Charges.Claim.PatientOR + _
.Charges.Claim.PatientOutsideCharges), "##,###,##0.00")
End If
310 dblCashMed = Format((.Charges.Claim.PatientRoomAndBoard + _
.Charges.Claim.PatientDrugs + _
.Charges.Claim.PatientOthers + _
.Charges.Claim.PatientOR + _
.Charges.Claim.PatientOutsideCharges), "##,###,##0.00")
312 If blnAllowSignatoryUserAccount Then
314 Form2Report.ParameterFields(F_REPRESENTATIVE).AddCurrentValue user.EmployeeName
Else
316 Form2Report.ParameterFields(F_REPRESENTATIVE).AddCurrentValue .Signatory.SignatoryName
End If
318 Form2Report.ParameterFields(F_DATE_SIGNED).AddCurrentValue Format(Date, "mm/dd/yyyy")
320 Form2Report.ParameterFields(F_OFFICIAL_CAPACITY).AddCurrentValue .Signatory.OfficialCapacity
322 intDiagCount = .Diagnosis.FinalDiagnosis.count
324 strDx = ""
326 strDx1 = ""
328 strDx2 = ""
330 strDx3 = ""
332 strDx4 = ""
334 strDx5 = ""
336 strICD1 = ""
338 strICD2 = ""
340 strICD3 = ""
342 strICD4 = ""
344 strICD5 = ""
346 If intDiagCount > 0 Then
348 For intctr = 1 To .Diagnosis.FinalDiagnosis.count
350 strDiag = .Diagnosis.FinalDiagnosis(intctr).DiagText
352 If Len(strDiag) > 0 Then
354 If intctr < .Diagnosis.FinalDiagnosis.count Then
356 strDx = strDx + strDiag
Else
358 strDx = strDx + strDiag
End If
End If
360 Select Case intctr
Case 1
362 strDx1 = .Diagnosis.FinalDiagnosis(intctr).DiagText
364 strICD1 = .Diagnosis.FinalDiagnosis(intctr).ICDCode
366 Case 2
368 strDx2 = .Diagnosis.FinalDiagnosis(intctr).DiagText
370 strICD2 = .Diagnosis.FinalDiagnosis(intctr).ICDCode
372 Case 3
374 strDx3 = .Diagnosis.FinalDiagnosis(intctr).DiagText
376 strICD3 = .Diagnosis.FinalDiagnosis(intctr).ICDCode
378 Case 4
380 strDx4 = .Diagnosis.FinalDiagnosis(intctr).DiagText
382 strICD4 = .Diagnosis.FinalDiagnosis(intctr).ICDCode
384 Case 5
386 strDx5 = .Diagnosis.FinalDiagnosis(intctr).DiagText
388 strICD5 = .Diagnosis.FinalDiagnosis(intctr).ICDCode
390 Case 6
392 strDx6 = .Diagnosis.FinalDiagnosis(intctr).DiagText
394 strICD6 = .Diagnosis.FinalDiagnosis(intctr).ICDCode
396 Case 7
398 strDx7 = .Diagnosis.FinalDiagnosis(intctr).DiagText
400 strICD7 = .Diagnosis.FinalDiagnosis(intctr).ICDCode
402 Case 8
404 strDx8 = .Diagnosis.FinalDiagnosis(intctr).DiagText
406 strICD8 = .Diagnosis.FinalDiagnosis(intctr).ICDCode
408 Case 9
410 strDx9 = .Diagnosis.FinalDiagnosis(intctr).DiagText
412 strICD9 = .Diagnosis.FinalDiagnosis(intctr).ICDCode
414 Case 10
416 strDx10 = .Diagnosis.FinalDiagnosis(intctr).DiagText
418 strICD10 = .Diagnosis.FinalDiagnosis(intctr).ICDCode
'added by ange
420 Case 11
422 strDx11 = .Diagnosis.FinalDiagnosis(intctr).DiagText
424 strICD11 = .Diagnosis.FinalDiagnosis(intctr).ICDCode
426 Case 12
428 strDx12 = .Diagnosis.FinalDiagnosis(intctr).DiagText
430 strICD12 = .Diagnosis.FinalDiagnosis(intctr).ICDCode
End Select
432 If strAdmDate >= PubACRFormsImplementationDate Then
434 GetDiagnosisLaterality strIdNum, .Diagnosis.FinalDiagnosis(intctr).Key, intctr
End If
436 Next intctr
End If
'by khing 1-2-14
438 If strAdmDate >= PubACRFormsImplementationDate Then
440 GetICDRVS strIdNum
End If
442 Form2Report.ParameterFields(F_FINAL_DX).AddCurrentValue Left(strDx, 250)
444 If blnWithICD Then
446 Form2Report.ParameterFields(F_DX1).AddCurrentValue strDx1
448 Form2Report.ParameterFields(F_DX2).AddCurrentValue strDx2
450 Form2Report.ParameterFields(F_DX3).AddCurrentValue strDx3
452 Form2Report.ParameterFields(F_DX4).AddCurrentValue strDx4
454 Form2Report.ParameterFields(F_DX5).AddCurrentValue strDx5
456 Form2Report.ParameterFields(F_DX6).AddCurrentValue strDx6
458 Form2Report.ParameterFields(F_DX7).AddCurrentValue strDx7
460 Form2Report.ParameterFields(F_ICD1).AddCurrentValue strICD1
462 Form2Report.ParameterFields(F_ICD2).AddCurrentValue strICD2
464 Form2Report.ParameterFields(F_ICD3).AddCurrentValue strICD3
466 Form2Report.ParameterFields(F_ICD4).AddCurrentValue strICD4
468 Form2Report.ParameterFields(F_ICD5).AddCurrentValue strICD5
470 Form2Report.ParameterFields(F_ICD6).AddCurrentValue strICD6
472 Form2Report.ParameterFields(F_ICD7).AddCurrentValue strICD7
474 Form2Report.ParameterFields(F_CASETYPE).AddCurrentValue IIf(Len(.CaseType) = 0, "O", .CaseType)
476 If strAdmDate >= PubACRFormsImplementationDate Then
478 Form2Report.ParameterFields(F_DX8).AddCurrentValue strDx8
480 Form2Report.ParameterFields(F_DX9).AddCurrentValue strDx9
482 Form2Report.ParameterFields(F_DX10).AddCurrentValue strDx10
484 Form2Report.ParameterFields(F_DX11).AddCurrentValue strDx11
486 Form2Report.ParameterFields(F_DX12).AddCurrentValue strDx12
488 Form2Report.ParameterFields(F_ICD8).AddCurrentValue strICD8
490 Form2Report.ParameterFields(F_ICD9).AddCurrentValue strICD9
492 Form2Report.ParameterFields(F_ICD10).AddCurrentValue strICD10
494 Form2Report.ParameterFields(F_ICD11).AddCurrentValue strICD11
496 Form2Report.ParameterFields(F_ICD12).AddCurrentValue strICD12
498 Form2Report.ParameterFields(F_Laterality1).AddCurrentValue strLaterality1
500 Form2Report.ParameterFields(F_Laterality2).AddCurrentValue strLaterality2
502 Form2Report.ParameterFields(F_Laterality3).AddCurrentValue strLaterality3
504 Form2Report.ParameterFields(F_Laterality4).AddCurrentValue strLaterality4
506 Form2Report.ParameterFields(F_Laterality5).AddCurrentValue strLaterality5
508 Form2Report.ParameterFields(F_Laterality6).AddCurrentValue strLaterality6
510 Form2Report.ParameterFields(F_Laterality7).AddCurrentValue strLaterality7
512 Form2Report.ParameterFields(F_Laterality8).AddCurrentValue strLaterality8
514 Form2Report.ParameterFields(F_Laterality9).AddCurrentValue strLaterality9
516 Form2Report.ParameterFields(F_Laterality10).AddCurrentValue strLaterality10
' Form2Report.ParameterFields(F_Laterality11).AddCurrentValue strLaterality11
' Form2Report.ParameterFields(F_Laterality12).AddCurrentValue strLaterality12
518 Form2Report.ParameterFields(F_RelatedProcedure1).AddCurrentValue strRelatedProcedure1
520 Form2Report.ParameterFields(F_RelatedProcedure2).AddCurrentValue strRelatedProcedure2
522 Form2Report.ParameterFields(F_RelatedProcedure3).AddCurrentValue strRelatedProcedure3
524 Form2Report.ParameterFields(F_RelatedProcedure4).AddCurrentValue strRelatedProcedure4
526 Form2Report.ParameterFields(F_RelatedProcedure5).AddCurrentValue strRelatedProcedure5
528 Form2Report.ParameterFields(F_RelatedProcedure6).AddCurrentValue strRelatedProcedure6
530 Form2Report.ParameterFields(F_RelatedProcedure7).AddCurrentValue strRelatedProcedure7
532 Form2Report.ParameterFields(F_RelatedProcedure8).AddCurrentValue strRelatedProcedure8
534 Form2Report.ParameterFields(F_RelatedProcedure9).AddCurrentValue strRelatedProcedure9
536 Form2Report.ParameterFields(F_RelatedProcedure10).AddCurrentValue strRelatedProcedure10
' Form2Report.ParameterFields(F_RelatedProcedure11).AddCurrentValue strRelatedProcedure11
' Form2Report.ParameterFields(F_RelatedProcedure12).AddCurrentValue strRelatedProcedure12
538 Form2Report.ParameterFields(F_RVSCode1).AddCurrentValue strICDRVS1
540 Form2Report.ParameterFields(F_RVSCode2).AddCurrentValue strICDRVS2
542 Form2Report.ParameterFields(F_RVSCode3).AddCurrentValue strICDRVS3
544 Form2Report.ParameterFields(F_RVSCode4).AddCurrentValue strICDRVS4
546 Form2Report.ParameterFields(F_RVSCode5).AddCurrentValue strICDRVS5
548 Form2Report.ParameterFields(F_RVSCode6).AddCurrentValue strICDRVS6
550 Form2Report.ParameterFields(F_RVSCode7).AddCurrentValue strICDRVS7
552 Form2Report.ParameterFields(F_RVSCode8).AddCurrentValue strICDRVS8
554 Form2Report.ParameterFields(F_RVSCode9).AddCurrentValue strICDRVS9
556 Form2Report.ParameterFields(F_RVSCode10).AddCurrentValue strICDRVS10
' Form2Report.ParameterFields(F_RVSCode11).AddCurrentValue strICDRVS11
' Form2Report.ParameterFields(F_RVSCode12).AddCurrentValue strICDRVS12
558 Form2Report.ParameterFields(F_DateOfOperation1).AddCurrentValue strDateOfOperation1
560 Form2Report.ParameterFields(F_DateOfOperation2).AddCurrentValue strDateOfOperation2
562 Form2Report.ParameterFields(F_DateOfOperation3).AddCurrentValue strDateOfOperation3
564 Form2Report.ParameterFields(F_DateOfOperation4).AddCurrentValue strDateOfOperation4
566 Form2Report.ParameterFields(F_DateOfOperation5).AddCurrentValue strDateOfOperation5
568 Form2Report.ParameterFields(F_DateOfOperation6).AddCurrentValue strDateOfOperation6
570 Form2Report.ParameterFields(F_DateOfOperation7).AddCurrentValue strDateOfOperation7
572 Form2Report.ParameterFields(F_DateOfOperation8).AddCurrentValue strDateOfOperation8
574 Form2Report.ParameterFields(F_DateOfOperation9).AddCurrentValue strDateOfOperation9
576 Form2Report.ParameterFields(F_DateOfOperation10).AddCurrentValue strDateOfOperation10
' Form2Report.ParameterFields(F_DateOfOperation11).AddCurrentValue strDateOfOperation11
' Form2Report.ParameterFields(F_DateOfOperation12).AddCurrentValue strDateOfOperation12
578 Form2Report.ParameterFields(F_FirstICDRVS).AddCurrentValue strFirstICDRVS
580 Form2Report.ParameterFields(F_SecondICDRVS).AddCurrentValue strSecondICDRVS
End If
'added 10.16.2007 **************
582 Form2Report.ParameterFields(F_AdmNumber).AddCurrentValue strIdNum
584 Form2Report.ParameterFields(F_DxCount).AddCurrentValue .Diagnosis.FinalDiagnosis.count
586 If strAdmDate >= PubFormsImplementationDate Then
588 Form2Report.ParameterFields(F_MedType).AddCurrentValue strMembership
Else
590 If ClientName <> "BIHMI" Then
592 Form2Report.ParameterFields(F_MedType).AddCurrentValue strMembership
End If
End If
'added 03.13.2008
594 If blnCashMeds Then
596 Form2Report.ParameterFields(F_CashMeds).AddCurrentValue blnIsCashMeds
End If
' ******************************
598 GetRVSInfo (strIdNum)
600 If ClientName = "MJSH" And strAdmDate < PubFormsImplementationDate Then
602 Form2Report.ParameterFields(F_DX8).AddCurrentValue strDx8
604 Form2Report.ParameterFields(F_DX9).AddCurrentValue strDx9
606 Form2Report.ParameterFields(F_DX10).AddCurrentValue strDx10
608 Form2Report.ParameterFields(F_DX11).AddCurrentValue strDx11
610 Form2Report.ParameterFields(F_DX12).AddCurrentValue strDx12
612 Form2Report.ParameterFields(F_DX13).AddCurrentValue strDx13
614 Form2Report.ParameterFields(F_DX14).AddCurrentValue strDx14
616 Form2Report.ParameterFields(F_ICD8).AddCurrentValue strICD8
618 Form2Report.ParameterFields(F_ICD9).AddCurrentValue strICD9
620 Form2Report.ParameterFields(F_ICD10).AddCurrentValue strICD10
622 Form2Report.ParameterFields(F_ICD11).AddCurrentValue strICD11
624 Form2Report.ParameterFields(F_ICD12).AddCurrentValue strICD12
626 Form2Report.ParameterFields(F_ICD13).AddCurrentValue strICD13
628 Form2Report.ParameterFields(F_ICD14).AddCurrentValue strICD14
630 dblHMORB = HMOAmount(strIdNum, "1")
632 Form2Report.ParameterFields(F_HMORB).AddCurrentValue Format(dblHMORB, "##,###,##0.00")
634 dblHMOMeds = HMOAmount(strIdNum, "2")
636 Form2Report.ParameterFields(F_HMOMeds).AddCurrentValue Format(dblHMOMeds, "##,###,##0.00")
638 dblHMOOthers = HMOAmount(strIdNum, "3")
640 Form2Report.ParameterFields(F_HMOOthers).AddCurrentValue Format(dblHMOOthers, "##,###,##0.00")
642 dblHMOOR = HMOAmount(strIdNum, "4")
644 Form2Report.ParameterFields(F_HMOOR).AddCurrentValue Format(dblHMOOR, "##,###,##0.00")
646 dblTotalHMO = dblHMORB + dblHMOMeds + dblHMOOthers + dblHMOOR
648 Form2Report.ParameterFields(F_TotalHMO).AddCurrentValue Format(dblTotalHMO, "##,###,##0.00")
650 dblDiscountRB = DiscountAmount(strIdNum, "1")
652 Form2Report.ParameterFields(F_DisRB).AddCurrentValue Format(dblDiscountRB, "##,###,##0.00")
654 dblDiscountMeds = DiscountAmount(strIdNum, "2")
656 Form2Report.ParameterFields(F_DisMeds).AddCurrentValue Format(dblDiscountMeds, "##,###,##0.00")
658 dblDiscountOthers = DiscountAmount(strIdNum, "3")
660 Form2Report.ParameterFields(F_DisOthers).AddCurrentValue Format(dblDiscountOthers, "##,###,##0.00")
662 dblDiscountOR = DiscountAmount(strIdNum, "4")
664 Form2Report.ParameterFields(F_DisOR).AddCurrentValue Format(dblDiscountOR, "##,###,##0.00")
666 dblTotalDiscount = dblDiscountRB + dblDiscountMeds + dblDiscountOthers + dblDiscountOR
668 Form2Report.ParameterFields(F_TotalDiscount).AddCurrentValue Format(dblTotalDiscount, "##,###,##0.00")
670 Form2Report.ParameterFields(F_PAT_RB).AddCurrentValue Format(.Charges.Claim.PatientRoomAndBoard - (dblHMORB + dblDiscountRB), "##,###,##0.00")
672 Form2Report.ParameterFields(F_PAT_MEDS).AddCurrentValue Format(.Charges.Claim.PatientDrugs - (dblHMOMeds + dblDiscountMeds), "##,###,##0.00")
674 Form2Report.ParameterFields(F_PAT_OTHERS).AddCurrentValue Format(.Charges.Claim.PatientOthers - (dblHMOOthers + dblDiscountOthers), "##,###,##0.00")
676 Form2Report.ParameterFields(F_PAT_OR).AddCurrentValue Format(.Charges.Claim.PatientOR - (dblHMOOR + dblDiscountOR), "##,###,##0.00")
678 Form2Report.ParameterFields(F_PAT_ETC).AddCurrentValue Format(.Charges.Claim.PatientOutsideCharges, "##,###,##0.00")
680 Form2Report.ParameterFields(F_TOTALPATIENT).AddCurrentValue Format((.Charges.Claim.PatientRoomAndBoard + _
.Charges.Claim.PatientDrugs + _
.Charges.Claim.PatientOthers + _
.Charges.Claim.PatientOR + _
.Charges.Claim.PatientOutsideCharges) - (dblTotalHMO + dblTotalDiscount), "##,###,##0.00")
Else
682 Form2Report.ParameterFields(F_RVS).AddCurrentValue strForm2RVS
684 Form2Report.ParameterFields(F_IllnessCode).AddCurrentValue strForm2IllnessCOde
686 Form2Report.ParameterFields(F_Initial).AddCurrentValue Trim$(EmployeeInitial)
'F_BirthDate
688 Form2Report.ParameterFields(F_BirthDate).AddCurrentValue Trim$(strBirthDate)
690 If ClientName = "MJSH" Or ClientName = "NDCH" Then
692 If strAdmDate >= PubFormsImplementationDate Then
694 Form2Report.ParameterFields(F_IsBenefits).AddCurrentValue GetIsBenefits(strIdNum)
696 SearchPackageID GetPackageType(strIdNum)
698 If GetIsBenefits(strIdNum) = True Then
700 Form2Report.ParameterFields(F_PF).AddCurrentValue Format(dblPackagePF, "##,###,##0.00")
Else
702 Form2Report.ParameterFields(F_PF).AddCurrentValue Format(0, "##,###,##0.00")
End If
704 Form2Report.ParameterFields(F_Initial).AddCurrentValue Trim$(GetRoomClass(strIdNum))
End If
Else
706 If strAdmDate >= PubFormsImplementationDate Then
708 If ClientName = "NKTI" Then
710 If strAdmDate >= PubACRFormsImplementationDate Then
712 Form2Report.ParameterFields(201).AddCurrentValue PayService
714 Form2Report.ParameterFields(202).AddCurrentValue DocChief
716 Form2Report.ParameterFields(203).AddCurrentValue isHemo(Medicare.IdNum)
718 Form2Report.ParameterFields(204).AddCurrentValue HasBC(Medicare.IdNum)
720 Form2Report.ParameterFields(205).AddCurrentValue isER(Medicare.IdNum)
722 Form2Report.ParameterFields(206).AddCurrentValue GetPackageName(Medicare.IdNum)
724 Form2Report.ParameterFields(207).AddCurrentValue isEndoscopy(Medicare.IdNum)
726 Form2Report.ParameterFields(208).AddCurrentValue PurchaseDate '(Medicare.IdNum)
728 Form2Report.ParameterFields(209).AddCurrentValue HideDoctor '(Medicare.IdNum)
730 Form2Report.ParameterFields(210).AddCurrentValue GetSession(Medicare.IdNum)
732 Form2Report.ParameterFields(211).AddCurrentValue GetBagCount(Medicare.IdNum)
Else
734 Form2Report.ParameterFields(F_PayService).AddCurrentValue PayService
736 Form2Report.ParameterFields(F_DocChief).AddCurrentValue DocChief
738 Form2Report.ParameterFields(F_IsHemoPatient).AddCurrentValue isHemo(Medicare.IdNum)
740 Form2Report.ParameterFields(F_BloodComponent).AddCurrentValue HasBC(Medicare.IdNum)
742 Form2Report.ParameterFields(F_ER).AddCurrentValue isER(Medicare.IdNum)
744 Form2Report.ParameterFields(F_PACKAGENAME).AddCurrentValue GetPackageName(Medicare.IdNum)
746 Form2Report.ParameterFields(F_ENDOSCOPY).AddCurrentValue isEndoscopy(Medicare.IdNum)
748 Form2Report.ParameterFields(F_PURCHASEDATE).AddCurrentValue PurchaseDate '(Medicare.IdNum)
750 Form2Report.ParameterFields(F_HDOCTOR).AddCurrentValue HideDoctor '(Medicare.IdNum)
752 Form2Report.ParameterFields(F_SESSION).AddCurrentValue GetSession(Medicare.IdNum)
754 Form2Report.ParameterFields(F_BAG).AddCurrentValue GetBagCount(Medicare.IdNum)
End If
End If
756 Form2Report.ParameterFields(F_IsBenefits).AddCurrentValue GetIsBenefits(strIdNum)
758 Form2Report.ParameterFields(F_Initial).AddCurrentValue Trim$(GetRoomClass(strIdNum))
End If
End If
End If
End If
End With
'
Exit Sub
PrintGeneralInfo_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.PrintGeneralInfo " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Sub
'added by khing november 28, 2013
Public Function GetDiagnosisLaterality(strIdNum As String, DiagID As String, intctr As Integer) As String
'
On Error GoTo GetDiagnosisLaterality_Err
'
Dim Rec As New ADODB.Recordset
Dim SQL As String
100 SQL = "Select isnull(Laterality,'') Laterality, isnull(RelatedOperation,'') RelatedOperation, " _
& " isnull(DateOfOperation,'') DateOfOperation, isnull(RVSCode,'') RVSCode from Medicare..tbMedDiagnosis " _
& " where IDNum = '" & Trim$(strIdNum) & "' and DiagID = '" & DiagID & "'"
102 With Rec
104 If .State > 0 Then .Close
106 .CursorLocation = adUseClient
108 .Open SQL, user.SQLConnection, adOpenDynamic, adLockReadOnly
110 If Not .EOF Then
112 Select Case intctr
Case 1
114 strLaterality1 = IIf(IsNull(!Laterality), "", !Laterality)
116 strRelatedProcedure1 = IIf(IsNull(!RelatedOperation), "", !RelatedOperation)
118 strICDRVS1 = IIf(IsNull(!RVSCode), "", !RVSCode)
120 strDateOfOperation1 = IIf(IsNull(!DateOfOperation), "", !DateOfOperation)
122 Case 2
124 strLaterality2 = IIf(IsNull(!Laterality), "", !Laterality)
126 strRelatedProcedure2 = IIf(IsNull(!RelatedOperation), "", !RelatedOperation)
128 strICDRVS2 = IIf(IsNull(!RVSCode), "", !RVSCode)
130 strDateOfOperation2 = IIf(IsNull(!DateOfOperation), "", !DateOfOperation)
132 Case 3
134 strLaterality3 = IIf(IsNull(!Laterality), "", !Laterality)
136 strRelatedProcedure3 = IIf(IsNull(!RelatedOperation), "", !RelatedOperation)
138 strICDRVS3 = IIf(IsNull(!RVSCode), "", !RVSCode)
140 strDateOfOperation3 = IIf(IsNull(!DateOfOperation), "", !DateOfOperation)
142 Case 4
144 strLaterality4 = IIf(IsNull(!Laterality), "", !Laterality)
146 strRelatedProcedure4 = IIf(IsNull(!RelatedOperation), "", !RelatedOperation)
148 strICDRVS4 = IIf(IsNull(!RVSCode), "", !RVSCode)
150 strDateOfOperation4 = IIf(IsNull(!DateOfOperation), "", !DateOfOperation)
152 Case 5
154 strLaterality5 = IIf(IsNull(!Laterality), "", !Laterality)
156 strRelatedProcedure5 = IIf(IsNull(!RelatedOperation), "", !RelatedOperation)
158 strICDRVS5 = IIf(IsNull(!RVSCode), "", !RVSCode)
160 strDateOfOperation5 = IIf(IsNull(!DateOfOperation), "", !DateOfOperation)
162 Case 6
164 strLaterality6 = IIf(IsNull(!Laterality), "", !Laterality)
166 strRelatedProcedure6 = IIf(IsNull(!RelatedOperation), "", !RelatedOperation)
168 strICDRVS6 = IIf(IsNull(!RVSCode), "", !RVSCode)
170 strDateOfOperation6 = IIf(IsNull(!DateOfOperation), "", !DateOfOperation)
172 Case 7
174 strLaterality7 = IIf(IsNull(!Laterality), "", !Laterality)
176 strRelatedProcedure7 = IIf(IsNull(!RelatedOperation), "", !RelatedOperation)
178 strICDRVS7 = IIf(IsNull(!RVSCode), "", !RVSCode)
180 strDateOfOperation7 = IIf(IsNull(!DateOfOperation), "", !DateOfOperation)
182 Case 8
184 strLaterality8 = IIf(IsNull(!Laterality), "", !Laterality)
186 strRelatedProcedure8 = IIf(IsNull(!RelatedOperation), "", !RelatedOperation)
188 strICDRVS8 = IIf(IsNull(!RVSCode), "", !RVSCode)
190 strDateOfOperation8 = IIf(IsNull(!DateOfOperation), "", !DateOfOperation)
192 Case 9
194 strLaterality9 = IIf(IsNull(!Laterality), "", !Laterality)
196 strRelatedProcedure9 = IIf(IsNull(!RelatedOperation), "", !RelatedOperation)
198 strICDRVS9 = IIf(IsNull(!RVSCode), "", !RVSCode)
200 strDateOfOperation9 = IIf(IsNull(!DateOfOperation), "", !DateOfOperation)
202 Case 10
204 strLaterality10 = IIf(IsNull(!Laterality), "", !Laterality)
206 strRelatedProcedure10 = IIf(IsNull(!RelatedOperation), "", !RelatedOperation)
208 strICDRVS10 = IIf(IsNull(!RVSCode), "", !RVSCode)
210 strDateOfOperation10 = IIf(IsNull(!DateOfOperation), "", !DateOfOperation)
212 Case 11
214 strLaterality11 = IIf(IsNull(!Laterality), "", !Laterality)
216 strRelatedProcedure11 = IIf(IsNull(!RelatedOperation), "", !RelatedOperation)
218 strICDRVS11 = IIf(IsNull(!RVSCode), "", !RVSCode)
220 strDateOfOperation11 = IIf(IsNull(!DateOfOperation), "", !DateOfOperation)
222 Case 12
224 strLaterality12 = IIf(IsNull(!Laterality), "", !Laterality)
226 strRelatedProcedure12 = IIf(IsNull(!RelatedOperation), "", !RelatedOperation)
228 strICDRVS12 = IIf(IsNull(!RVSCode), "", !RVSCode)
230 strDateOfOperation12 = IIf(IsNull(!DateOfOperation), "", !DateOfOperation)
End Select
End If
232 .Close
End With
234 Set Rec = Nothing
'
Exit Function
GetDiagnosisLaterality_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.GetDiagnosisLaterality " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
'added by khing january 2, 2014
Public Function GetICDRVS(strIdNum As String) As String
'
On Error GoTo GetICDRVS_Err
'
Dim Rec As New ADODB.Recordset
Dim SQL As String
100 SQL = "Select isnull(FirstICDRVS,'') FirstICDRVS, isnull(SecondICDRVS,'') SecondICDRVS " _
& " from Medicare..tbMedPatient where IDNum = '" & Trim$(strIdNum) & "'"
102 With Rec
104 If .State > 0 Then .Close
106 .CursorLocation = adUseClient
108 .Open SQL, user.SQLConnection, adOpenDynamic, adLockReadOnly
110 If Not .EOF Then
112 strFirstICDRVS = IIf(IsNull(!FirstICDRVS), "", !FirstICDRVS)
114 strSecondICDRVS = IIf(IsNull(!SecondICDRVS), "", !SecondICDRVS)
End If
116 .Close
End With
118 Set Rec = Nothing
'
Exit Function
GetICDRVS_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.GetICDRVS " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Private Sub SearchPackageID(strPackageID As String)
'
On Error GoTo SearchPackageID_Err
'
Dim SQL As String
100 SQL = "Select Amount, PF From medicare..tbMedPackage Where Status = 1 And PackageID = '" & Trim$(strPackageID) & "'"
102 With Rec
104 If .State > 0 Then .Close
106 .CursorLocation = adUseClient
108 .CursorType = adOpenDynamic
110 .LockType = adLockOptimistic
112 .Open SQL, user.SQLConnection
114 If .RecordCount > 0 Then
116 dblPackagePF = !PF
118 dblAmountPackage = !Amount & ""
End If
End With
120 Set Rec = Nothing
'
Exit Sub
SearchPackageID_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.SearchPackageID " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Sub
Public Function dblSeniorDiscount(strIdNum As String) As Double
'
On Error GoTo dblSeniorDiscount_Err
'
Dim strQ As String
Dim Rec As New ADODB.Recordset
100 dblSeniorDiscount = 0
102 If IsNumeric(Right(strIdNum, 1)) = True Then
104 strQ = "select abs(isnull(amount,0)) Amount from billing..tbbilldailybill where idnum = '" & strIdNum & "' and revenueid = 'CF'"
Else
106 strQ = "select abs(isnull(amount,0)) Amount from billing..tbbillopdailyout where idnum = '" & strIdNum & "' and revenueid = 'CF'"
End If
108 With Rec
110 If .State > 0 Then .Close
112 .CursorLocation = adUseClient
114 .Open strQ, user.SQLConnection, adOpenDynamic, adLockReadOnly
116 If .RecordCount > 0 Then
118 dblSeniorDiscount = !Amount
End If
End With
120 Set Rec = Nothing
'
Exit Function
dblSeniorDiscount_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.dblSeniorDiscount " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
'
'Public Function GetTotalPaymentPF(strIdNum As String) As Currency
' Dim SQL As String
'
' GetTotalPaymentPF = 0
' SQL = "Select Cast(Sum(IsNull(Payment,0)) as money) [Payment] From tbMedDoctors Where Idnum = '" & Trim$(strIdNum) & "'"
'
' With Rec
' If .State > 0 Then .Close
' .CursorLocation = adUseClient
' .CursorType = adOpenDynamic
' .LockType = adLockOptimistic
' .Open SQL, user.sqlconnection
'
' If .RecordCount > 0 Then
' GetTotalPaymentPF = !Payment
' End If
' End With
' Set Rec = Nothing
'
'End Function
'Public Function GetTotalMedPF(strIdNum As String) As Currency
' Dim SQL As String
'
' GetTotalMedPF = 0
' SQL = "Select Cast(Sum(IsNull(MedicarePF,0)) as money) [PF] From tbMedDoctors Where Idnum = '" & Trim$(strIdNum) & "'"
'
' With Rec
' If .State > 0 Then .Close
' .CursorLocation = adUseClient
' .CursorType = adOpenDynamic
' .LockType = adLockOptimistic
' .Open SQL, user.sqlconnection
'
' If .RecordCount > 0 Then
' GetTotalMedPF = !PF
' End If
' End With
' Set Rec = Nothing
'
'End Function
Public Function GetTotalActualPF(strIdNum As String) As Double
'
On Error GoTo GetTotalActualPF_Err
'
Dim SQL As String
100 GetTotalActualPF = 0
102 SQL = "Select Cast(Sum(IsNull(ActualPF,0)) as money) [PF] From tbMedDoctors Where Idnum = '" & Trim$(strIdNum) & "'"
104 With Rec
106 If .State > 0 Then .Close
108 .CursorLocation = adUseClient
110 .CursorType = adOpenDynamic
112 .LockType = adLockOptimistic
114 .Open SQL, user.SQLConnection
116 If .RecordCount > 0 Then
118 GetTotalActualPF = !PF
End If
End With
120 Set Rec = Nothing
'
Exit Function
GetTotalActualPF_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.GetTotalActualPF " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Private Function GetTotalActualPFNew(strIdNum As String) As Double
'
On Error GoTo GetTotalActualPFNew_Err
'
Dim SQL As String
100 GetTotalActualPFNew = 0
102 If IsNumeric(Right(strIdNum, 1)) Then
104 SQL = "Select (Select Sum(A.ActualPF)[Amount] from Medicare..tbMedDoctors A Where A.idnum = '" & _
Trim$(strIdNum) & "') + (Select Sum(Amount) [Amount] from Billing..tbBillDailyBill Where RevenueID = 'MD' and IdNum = '" & Trim$(strIdNum) & "')as PF"
Else
106 SQL = "Select (Select Sum(A.ActualPF)[Amount] from Medicare..tbMedDoctors A Where A.idnum = '" & _
Trim$(strIdNum) & "') + (Select Sum(Amount) [Amount] from Billing..tbBillOPDailyOut Where RevenueID = 'MD' and IdNum = '" & Trim$(strIdNum) & "')as PF"
End If
108 With Rec
110 If .State > 0 Then .Close
112 .CursorLocation = adUseClient
114 .CursorType = adOpenDynamic
116 .LockType = adLockOptimistic
118 .Open SQL, user.SQLConnection
120 If .RecordCount > 0 Then
122 GetTotalActualPFNew = !PF
End If
End With
124 Set Rec = Nothing
'
Exit Function
GetTotalActualPFNew_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.GetTotalActualPFNew " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
'Private Sub SearchPackagePF(strPackageID As String)
' Dim SQL As String
'
' SQL = "Select Amount, PF From tbMedPackage Where Status = 1 And PackageID = '" & Trim$(strPackageID) & "'"
'
' With Rec
' If .State > 0 Then .Close
' .CursorLocation = adUseClient
' .CursorType = adOpenDynamic
' .LockType = adLockOptimistic
' .Open SQL, user.sqlconnection
'
' If .RecordCount > 0 Then
' dblAmountPackage = !Amount
' dblPackagePF = !PF
' End If
' End With
' Set Rec = Nothing
'End Sub
Public Sub PrintPhysician(intCount As Integer)
'
On Error GoTo PrintPhysician_Err
'
Dim dblPatient As Double
Dim strAdmDate As String
Dim strPerformedDate As String
100 blnServicePerformed = False
102 With Medicare
104 strAdmDate = GetPatientAdmDate(Trim$(.IdNum))
106 If intCount <= .Doctors.Physician.count Then
108 If Len(.Doctors.Physician(intCount).DocCode) > 0 And .Doctors.Physician(intCount).DocCode <> "36M" And .Doctors.Physician(intCount).DocCode <> "37M" Then
110 DoctorPF = 0
112 AnesPF = 0
114 SurgeonPF = 0
116 PhysicianPF = 0
118 GetDoctorPF .Doctors.Physician(intCount).DocCode, "P"
120 Form2Report.ParameterFields(F_PHYS_NAME).AddCurrentValue .Doctors.Physician(intCount).DocName
122 Form2Report.ParameterFields(F_PHYS_PHIC).AddCurrentValue .Doctors.Physician(intCount).PHICNumber
124 Form2Report.ParameterFields(F_PHYS_TIN).AddCurrentValue .Doctors.Physician(intCount).TinNumber
126 If ClientName = "DDH" Then
128 If Len(Trim$(.Doctors.Physician(intCount).ServicePerformed)) > 137 Or _
(Len(Trim$(.Doctors.Physician(intCount).ServicePerformed)) > 110 And strAdmDate >= PubFormsImplementationDate) Then
130 blnServicePerformed = True
132 Form2Report.ParameterFields(F_PHYS_SERVICES).AddCurrentValue "SEE ATTACHED"
Else
134 Form2Report.ParameterFields(F_PHYS_SERVICES).AddCurrentValue .Doctors.Physician(intCount).ServicePerformed
End If
Else
136 Form2Report.ParameterFields(F_PHYS_SERVICES).AddCurrentValue .Doctors.Physician(intCount).ServicePerformed
End If
138 Form2Report.ParameterFields(F_PHYS_ACTUAL).AddCurrentValue Format(.Doctors.Physician(intCount).ActualPF, "##,###,##0.00")
140 Form2Report.ParameterFields(F_PHYS_MED).AddCurrentValue Format(.Doctors.Physician(intCount).MedicarePF, "##,###,##0.00")
142 If (strAdmDate >= PubFormsImplementationDate Or strAdmDate >= PubACRFormsImplementationDate) And ClientName = "DDH" Then
144 clsPhysician.IdNum = strIdNum
146 If clsPhysician.LoadPhysicianInfo Then
148 strPerformedDate = Format(clsPhysician.DatePeformed(intCount), "MM/dd/yyyy")
150 If strPerformedDate <> "01/01/1900" And CDate(strPerformedDate) > CDate("01/01/1900") Then
152 Form2Report.ParameterFields(F_PHYS_PERFORMEDDATE).AddCurrentValue Format(clsPhysician.DatePeformed(intCount), "MM/dd/yyyy")
Else
154 Form2Report.ParameterFields(F_PHYS_PERFORMEDDATE).AddCurrentValue "n/a"
End If
Else
156 Form2Report.ParameterFields(F_PHYS_PERFORMEDDATE).AddCurrentValue "n/a"
End If
End If
158 If ClientName = "MJSH" And (strAdmDate < PubFormsImplementationDate Or strAdmDate < PubACRFormsImplementationDate) Then
160 dblHMOPhysician = HMOPFAmount(strIdNum, .Doctors.Physician(intCount).DocCode)
162 dblDiscountPhysician = DiscountPFAmount(strIdNum, .Doctors.Physician(intCount).DocCode)
164 dblPatient = .Doctors.Physician(intCount).ActualPF - (dblHMOPhysician + dblDiscountPhysician + .Doctors.Physician(intCount).MedicarePF)
166 If dblPatient = 0 Then
168 Form2Report.ParameterFields(F_PHYS_PATIENT).AddCurrentValue Format(dblPatient, "##,###,##0.00")
Else
170 If blnHMOAccount Then
172 Form2Report.ParameterFields(F_PHYS_PATIENT).AddCurrentValue Format(dblPatient, "##,###,##0.00") '& "(HMO)"
Else
174 Form2Report.ParameterFields(F_PHYS_PATIENT).AddCurrentValue Format(dblPatient, "##,###,##0.00") '& "(Promisory Note)"
End If
End If
176 Form2Report.ParameterFields(F_PHYS_HMO).AddCurrentValue Format(dblHMOPhysician, "##,###,##0.00")
178 Form2Report.ParameterFields(F_PHYS_Discount).AddCurrentValue Format(dblDiscountPhysician, "##,###,##0.00")
Else
180 Form2Report.ParameterFields(F_PHYS_PATIENT).AddCurrentValue Format(.Doctors.Physician(intCount).PatientPF, "##,###,##0.00")
End If
182 If ClientName = "LMC" Then
184 If intCount > 2 Then
186 Form2Report.ParameterFields(F_PhysicianService).AddCurrentValue "Referral Date"
Else
188 Form2Report.ParameterFields(F_PhysicianService).AddCurrentValue "Medical Fee"
End If
End If
Else
190 Form2Report.ParameterFields(F_PHYS_NAME).AddCurrentValue "n/a"
192 Form2Report.ParameterFields(F_PHYS_PHIC).AddCurrentValue "n/a"
194 Form2Report.ParameterFields(F_PHYS_TIN).AddCurrentValue "n/a"
196 Form2Report.ParameterFields(F_PHYS_SERVICES).AddCurrentValue "n/a"
198 Form2Report.ParameterFields(F_PHYS_ACTUAL).AddCurrentValue "n/a"
200 Form2Report.ParameterFields(F_PHYS_MED).AddCurrentValue "n/a"
202 Form2Report.ParameterFields(F_PHYS_PATIENT).AddCurrentValue "n/a"
204 If strAdmDate >= PubFormsImplementationDate And ClientName = "DDH" Then
206 Form2Report.ParameterFields(F_PHYS_PERFORMEDDATE).AddCurrentValue "n/a"
End If
208 If ClientName = "MJSH" And strAdmDate < PubFormsImplementationDate Then
210 Form2Report.ParameterFields(F_PHYS_HMO).AddCurrentValue Format(0, "##,###,##0.00")
212 Form2Report.ParameterFields(F_PHYS_Discount).AddCurrentValue Format(0, "##,###,##0.00")
End If
End If
Else
214 DoctorPF = 0
216 AnesPF = IIf(intCount <= .Doctors.Anesthesiologist.count, AnesPF, 0)
218 SurgeonPF = IIf(intCount <= .Doctors.Surgeon.count, SurgeonPF, 0)
220 PhysicianPF = IIf(intCount <= .Doctors.Physician.count, PhysicianPF, 0)
222 Form2Report.ParameterFields(F_PHYS_NAME).AddCurrentValue "n/a"
224 Form2Report.ParameterFields(F_PHYS_PHIC).AddCurrentValue "n/a"
226 Form2Report.ParameterFields(F_PHYS_TIN).AddCurrentValue "n/a"
228 Form2Report.ParameterFields(F_PHYS_SERVICES).AddCurrentValue "n/a"
230 Form2Report.ParameterFields(F_PHYS_ACTUAL).AddCurrentValue "n/a"
232 Form2Report.ParameterFields(F_PHYS_MED).AddCurrentValue "n/a"
234 Form2Report.ParameterFields(F_PHYS_PATIENT).AddCurrentValue "n/a"
236 If strAdmDate >= PubFormsImplementationDate And ClientName = "DDH" Then
238 Form2Report.ParameterFields(F_PHYS_PERFORMEDDATE).AddCurrentValue "n/a"
End If
240 If ClientName = "MJSH" And strAdmDate < PubFormsImplementationDate Then
242 Form2Report.ParameterFields(F_PHYS_HMO).AddCurrentValue Format(0, "##,###,##0.00")
244 Form2Report.ParameterFields(F_PHYS_Discount).AddCurrentValue Format(0, "##,###,##0.00")
End If
End If
End With
'
Exit Sub
PrintPhysician_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.PrintPhysician " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Sub
Public Sub PrintSurgeon(intCount As Integer)
'
On Error GoTo PrintSurgeon_Err
'
Dim dblPatient As Double
Dim strAdmDate As String
Dim strPerformedDate As String
100 With Medicare
102 strAdmDate = GetPatientAdmDate(Trim$(.IdNum))
104 If intCount <= .Doctors.Surgeon.count Then
106 If Len(.Doctors.Surgeon(intCount).DocCode) > 0 And .Doctors.Surgeon(intCount).DocCode <> "36M" And .Doctors.Surgeon(intCount).DocCode <> "37M" Then
108 SurgeonPF = 0
110 GetDoctorPF .Doctors.Surgeon(intCount).DocCode, "S"
112 Form2Report.ParameterFields(F_SURG_NAME).AddCurrentValue .Doctors.Surgeon(intCount).DocName
114 Form2Report.ParameterFields(F_SURG_PHIC).AddCurrentValue .Doctors.Surgeon(intCount).PHICNumber
116 Form2Report.ParameterFields(F_SURG_TIN).AddCurrentValue .Doctors.Surgeon(intCount).TinNumber
118 If ClientName = "DDH" Then
120 If Len(Trim$(.Doctors.Surgeon(intCount).ServicePerformed)) > 137 Or _
(Len(Trim$(.Doctors.Surgeon(intCount).ServicePerformed)) > 110 And strAdmDate >= PubFormsImplementationDate) Then
122 blnServicePerformed = True
124 Form2Report.ParameterFields(F_SURG_SERVICES).AddCurrentValue "SEE ATTACHED"
Else
126 Form2Report.ParameterFields(F_SURG_SERVICES).AddCurrentValue .Doctors.Surgeon(intCount).ServicePerformed
End If
Else
128 Form2Report.ParameterFields(F_SURG_SERVICES).AddCurrentValue .Doctors.Surgeon(intCount).ServicePerformed
End If
130 Form2Report.ParameterFields(F_SURG_ACTUAL).AddCurrentValue Format(.Doctors.Surgeon(intCount).ActualPF, "##,###,##0.00")
132 Form2Report.ParameterFields(F_SURG_MED).AddCurrentValue Format(.Doctors.Surgeon(intCount).MedicarePF, "##,###,##0.00")
'Form2Report.ParameterFields(F_SURG_PATIENT).AddCurrentValue Format(.Doctors.Surgeon(intCount).PatientPF, "##,###,##0.00")
134 strPerformedDate = Format(.Doctors.Surgeon(intCount).DatePeformed, "MM/dd/yyyy")
136 If strPerformedDate <> "01/01/1900" And CDate(strPerformedDate) > CDate("01/01/1900") Then
138 Form2Report.ParameterFields(F_SURG_PERFORMEDDATE).AddCurrentValue Format(.Doctors.Surgeon(intCount).DatePeformed, "MM/dd/yyyy")
Else
140 Form2Report.ParameterFields(F_SURG_PERFORMEDDATE).AddCurrentValue "n/a"
End If
142 If ClientName = "MJSH" And strAdmDate < PubFormsImplementationDate Then
144 dblHMOSurgeon = HMOPFAmount(strIdNum, .Doctors.Surgeon(intCount).DocCode)
146 dblDiscountSurgeon = DiscountPFAmount(strIdNum, .Doctors.Surgeon(intCount).DocCode)
148 dblPatient = .Doctors.Surgeon(intCount).ActualPF - (.Doctors.Surgeon(intCount).MedicarePF + dblHMOSurgeon + dblDiscountSurgeon)
150 If dblPatient = 0 Then
152 Form2Report.ParameterFields(F_SURG_PATIENT).AddCurrentValue Format(dblPatient, "##,###,##0.00")
Else
154 If blnHMOAccount Then
156 Form2Report.ParameterFields(F_SURG_PATIENT).AddCurrentValue Format(dblPatient, "##,###,##0.00") '& "(HMO)"
Else
158 Form2Report.ParameterFields(F_SURG_PATIENT).AddCurrentValue Format(dblPatient, "##,###,##0.00") '& "(Promisory Note)"
End If
End If
160 Form2Report.ParameterFields(F_SURG_HMO).AddCurrentValue Format(dblHMOSurgeon, "##,###,##0.00")
162 Form2Report.ParameterFields(F_SURG_Discount).AddCurrentValue Format(dblDiscountSurgeon, "##,###,##0.00")
Else
164 Form2Report.ParameterFields(F_SURG_PATIENT).AddCurrentValue Format(.Doctors.Surgeon(intCount).PatientPF, "##,###,##0.00")
End If
166 If ClientName <> "DDH" Then
168 Form2Report.ParameterFields(F_ProcedureDate).AddCurrentValue IIf(blnAllowShowPerformedDate, Format(.Doctors.Surgeon(intCount).DatePerformed, "mm/dd/yyyy"), _
GetOperationDate(.IdNum, .Doctors.Surgeon(intCount).DocCode))
End If
Else
170 Form2Report.ParameterFields(F_SURG_NAME).AddCurrentValue "n/a"
172 Form2Report.ParameterFields(F_SURG_PHIC).AddCurrentValue "n/a"
174 Form2Report.ParameterFields(F_SURG_TIN).AddCurrentValue "n/a"
176 Form2Report.ParameterFields(F_SURG_SERVICES).AddCurrentValue "n/a"
178 Form2Report.ParameterFields(F_SURG_ACTUAL).AddCurrentValue "n/a"
180 Form2Report.ParameterFields(F_SURG_MED).AddCurrentValue "n/a"
182 Form2Report.ParameterFields(F_SURG_PATIENT).AddCurrentValue "n/a"
184 Form2Report.ParameterFields(F_SURG_PERFORMEDDATE).AddCurrentValue "n/a"
186 If ClientName = "MJSH" And strAdmDate < PubFormsImplementationDate Then
188 Form2Report.ParameterFields(F_SURG_HMO).AddCurrentValue Format(0, "##,###,##0.00")
190 Form2Report.ParameterFields(F_SURG_Discount).AddCurrentValue Format(0, "##,###,##0.00")
End If
End If
Else
192 AnesPF = IIf(intCount <= .Doctors.Anesthesiologist.count, AnesPF, 0)
194 SurgeonPF = IIf(intCount <= .Doctors.Surgeon.count, SurgeonPF, 0)
196 PhysicianPF = IIf(intCount <= .Doctors.Physician.count, PhysicianPF, 0)
198 Form2Report.ParameterFields(F_SURG_NAME).AddCurrentValue "n/a"
200 Form2Report.ParameterFields(F_SURG_PHIC).AddCurrentValue "n/a"
202 Form2Report.ParameterFields(F_SURG_TIN).AddCurrentValue "n/a"
204 Form2Report.ParameterFields(F_SURG_SERVICES).AddCurrentValue "n/a"
206 Form2Report.ParameterFields(F_SURG_ACTUAL).AddCurrentValue "n/a"
208 Form2Report.ParameterFields(F_SURG_MED).AddCurrentValue "n/a"
210 Form2Report.ParameterFields(F_SURG_PATIENT).AddCurrentValue "n/a"
212 Form2Report.ParameterFields(F_SURG_PERFORMEDDATE).AddCurrentValue "n/a"
214 If blnWithOperationDate Then
216 Form2Report.ParameterFields(F_ProcedureDate).AddCurrentValue ""
End If
218 If ClientName = "MJSH" And strAdmDate < PubFormsImplementationDate Then
220 Form2Report.ParameterFields(F_SURG_HMO).AddCurrentValue Format(0, "##,###,##0.00")
222 Form2Report.ParameterFields(F_SURG_Discount).AddCurrentValue Format(0, "##,###,##0.00")
End If
End If
End With
'
Exit Sub
PrintSurgeon_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.PrintSurgeon " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Sub
Public Sub PrintAnesthesiologist(intCount As Integer)
'
On Error GoTo PrintAnesthesiologist_Err
'
Dim dblPatient As Double
Dim strAdmDate As String
Dim strPerformedDate As String
100 With Medicare
102 strAdmDate = GetPatientAdmDate(Trim$(.IdNum))
104 If intCount <= .Doctors.Anesthesiologist.count Then
106 If Len(.Doctors.Anesthesiologist(intCount).DocCode) > 0 And .Doctors.Anesthesiologist(intCount).DocCode <> "36M" And .Doctors.Anesthesiologist(intCount).DocCode <> "37M" Then
108 AnesPF = 0
110 GetDoctorPF .Doctors.Anesthesiologist(intCount).DocCode, "A"
112 Form2Report.ParameterFields(F_ANES_NAME).AddCurrentValue .Doctors.Anesthesiologist(intCount).DocName
114 Form2Report.ParameterFields(F_ANES_PHIC).AddCurrentValue .Doctors.Anesthesiologist(intCount).PHICNumber
116 Form2Report.ParameterFields(F_ANES_TIN).AddCurrentValue .Doctors.Anesthesiologist(intCount).TinNumber
118 If ClientName = "DDH" Then
120 If Len(Trim$(.Doctors.Anesthesiologist(intCount).ServicePerformed)) > 137 Or _
(Len(Trim$(.Doctors.Anesthesiologist(intCount).ServicePerformed)) > 110 And strAdmDate >= PubFormsImplementationDate) Then
122 blnServicePerformed = True
124 Form2Report.ParameterFields(F_ANES_SERVICES).AddCurrentValue "SEE ATTACHED"
Else
126 Form2Report.ParameterFields(F_ANES_SERVICES).AddCurrentValue .Doctors.Anesthesiologist(intCount).ServicePerformed
End If
Else
128 Form2Report.ParameterFields(F_ANES_SERVICES).AddCurrentValue .Doctors.Anesthesiologist(intCount).ServicePerformed
End If
130 Form2Report.ParameterFields(F_ANES_ACTUAL).AddCurrentValue Format(.Doctors.Anesthesiologist(intCount).ActualPF, "##,###,##0.00")
132 Form2Report.ParameterFields(F_ANES_MED).AddCurrentValue Format(.Doctors.Anesthesiologist(intCount).MedicarePF, "##,###,##0.00")
'Form2Report.ParameterFields(F_ANES_PATIENT).AddCurrentValue Format(.Doctors.Anesthesiologist(intCount).PatientPF, "##,###,##0.00")
134 clsAnesthesiologist.IdNum = strIdNum
136 If clsAnesthesiologist.LoadAnesInfo Then
138 strPerformedDate = Format(clsAnesthesiologist.DatePeformed(intCount), "MM/dd/yyyy")
Else
140 strPerformedDate = Format(.Doctors.Surgeon(intCount).DatePeformed, "MM/dd/yyyy")
End If
142 If strPerformedDate <> "01/01/1900" And CDate(strPerformedDate) > CDate("01/01/1900") Then
144 Form2Report.ParameterFields(F_ANES_PERFORMEDDATE).AddCurrentValue strPerformedDate
Else
146 Form2Report.ParameterFields(F_ANES_PERFORMEDDATE).AddCurrentValue "n/a"
End If
148 If ClientName = "MJSH" And strAdmDate < PubFormsImplementationDate Then
150 dblHMOAnes = HMOPFAmount(strIdNum, .Doctors.Anesthesiologist(intCount).DocCode)
152 dblDiscountAnes = DiscountPFAmount(strIdNum, .Doctors.Anesthesiologist(intCount).DocCode)
154 dblPatient = .Doctors.Anesthesiologist(intCount).ActualPF - (.Doctors.Anesthesiologist(intCount).MedicarePF + dblHMOAnes + dblDiscountAnes)
156 If dblPatient = 0 Then
158 Form2Report.ParameterFields(F_ANES_PATIENT).AddCurrentValue Format(dblPatient, "##,###,##0.00")
Else
160 If blnHMOAccount Then
162 Form2Report.ParameterFields(F_ANES_PATIENT).AddCurrentValue Format(dblPatient, "##,###,##0.00") '& "(HMO)"
Else
164 Form2Report.ParameterFields(F_ANES_PATIENT).AddCurrentValue Format(dblPatient, "##,###,##0.00") '& "(Promisory Note)"
End If
End If
166 Form2Report.ParameterFields(F_ANES_HMO).AddCurrentValue Format(dblHMOAnes, "##,###,##0.00")
168 Form2Report.ParameterFields(F_ANES_Discount).AddCurrentValue Format(dblDiscountAnes, "##,###,##0.00")
Else
170 Form2Report.ParameterFields(F_ANES_PATIENT).AddCurrentValue Format(.Doctors.Anesthesiologist(intCount).PatientPF, "##,###,##0.00")
End If
Else
172 Form2Report.ParameterFields(F_ANES_NAME).AddCurrentValue "n/a"
174 Form2Report.ParameterFields(F_ANES_PHIC).AddCurrentValue "n/a"
176 Form2Report.ParameterFields(F_ANES_TIN).AddCurrentValue "n/a"
178 Form2Report.ParameterFields(F_ANES_SERVICES).AddCurrentValue "n/a"
180 Form2Report.ParameterFields(F_ANES_ACTUAL).AddCurrentValue "n/a"
182 Form2Report.ParameterFields(F_ANES_MED).AddCurrentValue "n/a"
184 Form2Report.ParameterFields(F_ANES_PATIENT).AddCurrentValue "n/a"
186 Form2Report.ParameterFields(F_ANES_PERFORMEDDATE).AddCurrentValue "n/a"
188 If ClientName = "MJSH" And strAdmDate < PubFormsImplementationDate Then
190 Form2Report.ParameterFields(F_ANES_HMO).AddCurrentValue Format(0, "##,###,##0.00")
192 Form2Report.ParameterFields(F_ANES_Discount).AddCurrentValue Format(0, "##,###,##0.00")
End If
End If
Else
194 AnesPF = IIf(intCount <= .Doctors.Anesthesiologist.count, AnesPF, 0)
196 SurgeonPF = IIf(intCount <= .Doctors.Surgeon.count, SurgeonPF, 0)
198 PhysicianPF = IIf(intCount <= .Doctors.Physician.count, PhysicianPF, 0)
200 Form2Report.ParameterFields(F_ANES_NAME).AddCurrentValue "n/a"
202 Form2Report.ParameterFields(F_ANES_PHIC).AddCurrentValue "n/a"
204 Form2Report.ParameterFields(F_ANES_TIN).AddCurrentValue "n/a"
206 Form2Report.ParameterFields(F_ANES_SERVICES).AddCurrentValue "n/a"
208 Form2Report.ParameterFields(F_ANES_ACTUAL).AddCurrentValue "n/a"
210 Form2Report.ParameterFields(F_ANES_MED).AddCurrentValue "n/a"
212 Form2Report.ParameterFields(F_ANES_PATIENT).AddCurrentValue "n/a"
214 Form2Report.ParameterFields(F_ANES_PERFORMEDDATE).AddCurrentValue "n/a"
216 If ClientName = "MJSH" And strAdmDate < PubFormsImplementationDate Then
218 Form2Report.ParameterFields(F_ANES_HMO).AddCurrentValue Format(0, "##,###,##0.00")
220 Form2Report.ParameterFields(F_ANES_Discount).AddCurrentValue Format(0, "##,###,##0.00")
End If
End If
End With
'
Exit Sub
PrintAnesthesiologist_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.PrintAnesthesiologist " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Sub
Public Function Exist(strReportName As String) As Boolean
Set Form2crxApplication = New CRAXDRT.Application
On Error GoTo FileExists_Error
Set Form2Report = Form2crxApplication.OpenReport(App.Path + "\Reports\custom\" + strReportName)
Exist = True
Exit Function
FileExists_Error:
Set Form2Report = Form2crxApplication.OpenReport(App.Path + "\Reports\" + strReportName)
Exist = False
End Function
Public Sub PrintForm2(strIdNum As String, Optional intOption As Integer = 1, Optional HideDoctor As Boolean = False)
'
On Error GoTo PrintForm2_Err
'
Dim intFormCount As Integer
Dim blnWithICD As Boolean
Dim strActualUserID As String
Dim strAdmDate As String
Dim strTrackingNum As String
Dim PrintTracking As Boolean
Dim intCount As Integer
Dim intFormNumber As Integer
100 intFormCount = 0
102 intFormNumber = 1
104 If Medicare.Search(strIdNum) Then
106 strAdmDate = GetPatientAdmDate(strIdNum)
108 If strAdmDate < PubACRFormsImplementationDate Then
110 With Medicare
112 If intFormCount < .Doctors.Physician.count Then
114 intFormCount = .Doctors.Physician.count
116 strDocID = .Doctors.Physician(1).DocCode
End If
118 If intFormCount < .Doctors.Surgeon.count Then
120 intFormCount = .Doctors.Surgeon.count
End If
122 If intFormCount < .Doctors.Anesthesiologist.count Then
124 intFormCount = .Doctors.Anesthesiologist.count
End If
End With
End If
'count for new page
126 If strAdmDate >= PubACRFormsImplementationDate Then
128 intFormNumber = countDiag(strIdNum)
End If
130 If intFormCount <= 1 Then
132 For intCount = 1 To intFormNumber
134 Set Form2crxApplication = New CRAXDRT.Application
136 Select Case intOption
Case 1
138 Set Form2Report = Form2crxApplication.OpenReport(App.Path + "\Reports\NewClaim.rpt")
140 Case 2
142 Set Form2Report = Form2crxApplication.OpenReport(App.Path + "\Reports\NewClaim_Old.rpt")
144 Case 3
146 If ServerDate >= PubFormsImplementationDate Then
148 If strAdmDate >= PubACRFormsImplementationDate Then
150 Set Form2Report = Form2crxApplication.OpenReport(App.Path + "\Reports\NewClaimForm2ACR.rpt")
152 ElseIf strAdmDate >= PubFormsImplementationDate Then
154 Set Form2Report = Form2crxApplication.OpenReport(App.Path + "\Reports\NewClaimForm2.rpt")
Else
156 Set Form2Report = Form2crxApplication.OpenReport(App.Path + "\Reports\NewClaimWithICD.rpt")
End If
Else
158 Set Form2Report = Form2crxApplication.OpenReport(App.Path + "\Reports\NewClaimWithICD.rpt")
End If
160 Case 4
162 If ServerDate >= PubFormsImplementationDate Then
164 If strAdmDate >= PubACRFormsImplementationDate Then
166 Set Form2Report = Form2crxApplication.OpenReport(App.Path + "\Reports\NewClaimForm2ACR_Preprinted.rpt")
168 ElseIf strAdmDate >= PubFormsImplementationDate Then
170 Set Form2Report = Form2crxApplication.OpenReport(App.Path + "\Reports\NewClaimForm2_Preprinted.rpt")
Else
172 Set Form2Report = Form2crxApplication.OpenReport(App.Path + "\Reports\NewClaimWithICD_PrePrinted.rpt")
End If
Else
174 Set Form2Report = Form2crxApplication.OpenReport(App.Path + "\Reports\NewClaimWithICD_PrePrinted.rpt")
End If
176 Case 5
178 If ServerDate >= PubFormsImplementationDate Then
180 If strAdmDate >= PubACRFormsImplementationDate Then
182 Set Form2Report = Form2crxApplication.OpenReport(App.Path + "\Reports\NewClaimForm2ACR.rpt")
184 ElseIf strAdmDate >= PubFormsImplementationDate Then
186 Set Form2Report = Form2crxApplication.OpenReport(App.Path + "\Reports\NewClaimForm2.rpt")
Else
188 Set Form2Report = Form2crxApplication.OpenReport(App.Path + "\Reports\NewClaimMaternity.rpt")
End If
Else
190 Set Form2Report = Form2crxApplication.OpenReport(App.Path + "\Reports\NewClaimMaternity.rpt")
End If
192 Case 6
194 If ServerDate >= PubFormsImplementationDate Then
196 If strAdmDate >= PubFormsImplementationDate Then
198 Set Form2Report = Form2crxApplication.OpenReport(App.Path + "\Reports\NewClaimForm2_Preprinted.rpt")
Else
200 Set Form2Report = Form2crxApplication.OpenReport(App.Path + "\Reports\NewClaimMaternity_Preprinted.rpt")
End If
Else
202 Set Form2Report = Form2crxApplication.OpenReport(App.Path + "\Reports\NewClaimMaternity_Preprinted.rpt")
End If
204 Case 7
206 Set Form2Report = Form2crxApplication.OpenReport(App.Path + "\Reports\NewClaimTBDots.rpt")
208 Case 8
210 Set Form2Report = Form2crxApplication.OpenReport(App.Path + "\Reports\NewClaimTBDotsPreprinted.rpt")
212 Case 9
214 Set Form2Report = Form2crxApplication.OpenReport(App.Path + "\Reports\NewClaimForm2_Preprinted_2.rpt")
216 Case 10
218 Set Form2Report = Form2crxApplication.OpenReport(App.Path + "\Reports\NewClaimForm2_2.rpt")
220 Case 11
222 Set Form2Report = Form2crxApplication.OpenReport(App.Path + "\Reports\NewClaimForm2_Preprinted_3.rpt")
224 Case 12
226 Set Form2Report = Form2crxApplication.OpenReport(App.Path + "\Reports\NewClaimForm2_3.rpt")
228 Case 13
230 Set Form2Report = Form2crxApplication.OpenReport(App.Path + "\Reports\NewClaimForm2ACR_Diagnosis.rpt")
232 Case 14
234 Set Form2Report = Form2crxApplication.OpenReport(App.Path + "\Reports\NewClaimForm2ACR_Diagnosis_Preprinted.rpt")
End Select
236 If intOption = 3 Or intOption = 4 Or intOption = 5 Or intOption = 6 Or intOption = 7 Or intOption = 8 Or intOption = 13 Or intOption = 14 Then
238 blnWithICD = True
Else
240 blnWithICD = False
End If
242 PrintPhysician 1
244 PrintSurgeon 1
246 PrintAnesthesiologist 1
248 If strAdmDate >= PubACRFormsImplementationDate Then 'khing 11.27.13 CF2_ACR Printing
250 PrintConfinementInfo strIdNum
252 ElseIf strAdmDate >= PubFormsImplementationDate Then
254 PrintCardiologist 1, strIdNum
256 If intOption = 5 Or intOption = 6 Then
258 Form2Report.ParameterFields(F_IsBenefits).AddCurrentValue True
End If
' If ClientName = "NKTI" Then
' Form2Report.ParameterFields(F_PayService).AddCurrentValue PayService
' Form2Report.ParameterFields(F_DocChief).AddCurrentValue DocChief
' Form2Report.ParameterFields(F_IsHemoPatient).AddCurrentValue IsHemo(Medicare.IdNum)
' End If
'If ClientName = "LMC" Or ClientName = "NDCH" Or ClientName = "SHMC" Then
' Form2Report.ParameterFields(F_TrackingNumber).AddCurrentValue GetTrackingNumber(strIdNum)
260 strTrackingNum = GetTrackingNumber(strIdNum)
262 Form2Report.ParameterFields(F_TrackingNumber).AddCurrentValue "š" + strTrackingNum & getCheckDigit(strTrackingNum) & "œ"
264 PrintTracking = Val(GetSetting("MEDSYS", "MEDICARE", "printTrackingNumberForm2"))
' If PrintTracking = True Then
' Assign Options
Dim iX As Integer
266 For iX = 1 To Form2Report.FormulaFields.count
268 If Form2Report.FormulaFields.Item(iX).Name = "{@Options}" Then
270 Form2Report.FormulaFields.Item(iX).Text = "BooleanVar ShowTrackingNumber:= " & PrintTracking & " as boolean"
Exit For
End If
Next
' Assign Record Selection Formula
' End If
272 If blnPreprinted = False Then
274 If PrintTracking = True Then
276 Form2Report.FormulaFields.Item(iX).Text = "BooleanVar ShowTrackingNumber:=true"
Else
278 Form2Report.FormulaFields.Item(iX).Text = "BooleanVar ShowTrackingNumber:=false"
End If
End If
'End If
End If
280 PrintGeneralInfo blnWithICD, HideDoctor
282 If intOption = 5 Or intOption = 6 Then
284 Form2Report.ParameterFields(F_IndexNumber).AddCurrentValue ""
End If
286 If intOption = 4 Or intOption = 3 Or intOption = 13 Or intOption = 14 Then
288 If isPaidtoBill(strIdNum) Then
290 If MsgBox("Is it Hospital Claim?", vbYesNo) = vbYes Then
292 Form2Report.ParameterFields(F_ConstHospPatient).AddCurrentValue "Y"
294 strOptionType = "Y"
Else
296 Form2Report.ParameterFields(F_ConstHospPatient).AddCurrentValue "N"
298 strOptionType = "N"
End If
Else
300 If strOptionType = "Y" Then
302 Form2Report.ParameterFields(F_ConstHospPatient).AddCurrentValue "Y"
Else
304 Form2Report.ParameterFields(F_ConstHospPatient).AddCurrentValue "N"
End If
End If
End If
306 If Not ClientName Like "[DDH, MJSH, LMC]" Then
308 Form2Report.ParameterFields(F_DocBatchNew).AddCurrentValue "1"
End If
310 If ClientName = "MJSH" And strAdmDate < PubFormsImplementationDate Then
312 Form2Report.ParameterFields(F_DocBatch).AddCurrentValue "1"
314 Form2Report.ParameterFields(F_DiagBatch).AddCurrentValue "1"
End If
316 If strAdmDate >= PubACRFormsImplementationDate Then
318 Form2Report.ParameterFields(F_PageCount).SetCurrentValue CStr(intCount)
End If
320 frmViewForm2.WhatReport = 1
322 frmViewForm2.IdNum = strIdNum
324 frmViewForm2.Index = intCount
326 frmViewForm2.Show vbModal
328 Next intCount
' If blnPart34onEntry Then
' If strAdmDate >= PubACRFormsImplementationDate Then
' frmEntryACR.cmdCancel_Click
' frmMedicare.mnuACRFormat_Click
' End If
' End If
'Start
330 If strAdmDate < PubACRFormsImplementationDate Then
332 If blnAllowSeparatePart45 Then
334 PrintBlankForm2 5
End If
End If
336 If blnAllowPrintPartV And strAdmDate < PubFormsImplementationDate Then
338 If ClientName <> "BIHMI" Then
340 If blnPreprinted = True Then
342 frmView.MedicType = "1"
Else
344 If IsNumeric(Right(strIdNum, 1)) Then
346 frmView.MedicType = "2"
Else
348 If MsgBox("Do you want Preprinted Part 5?", vbYesNo) = vbYes Then
350 frmView.MedicType = "4"
Else
352 frmView.MedicType = "2"
End If
End If
End If
354 frmView.Title = strOptionType
356 frmView.IdNum = strIdNum
358 frmView.TotalPF = DoctorPF
360 frmView.TotalDeduction = dblCashMed
362 frmView.WhatReport = 37
364 frmView.Show vbModal
End If
End If
366 Screen.MousePointer = vbDefault
368 If strAdmDate < PubACRFormsImplementationDate Then
370 If blnAllowPrintOutDiagnosis Then
372 If intDiagCount > intAllowedPrintOutDiagnosis Then
374 frmView.IdNum = strIdNum
376 frmView.WhatReport = 45
378 frmView.Show vbModal
End If
End If
End If
380 If CheckHemoChemoDischarges(strIdNum) Then
382 frmView.IdNum = strIdNum
384 frmView.StartDate = GetAdmDate(strIdNum)
386 frmView.EndDate = GetDcrdate(strIdNum)
388 frmView.WhatReport = 48
390 frmView.Show vbModal
End If
392 If blnServicePerformed And ClientName = "DDH" Then
394 frmView.IdNum = strIdNum
396 frmView.WhatReport = 56
398 frmView.Show vbModal
End If
400 If ClientName = "MJSH" Then
402 If intDiagCount > intAllowedPrintOutDiagnosis And strAdmDate < PubFormsImplementationDate Then
404 Set Form2Report = Nothing
406 Set Form2crxApplication = Nothing
408 Set Form2crxApplication = New CRAXDRT.Application
410 Set Form2Report = Form2crxApplication.OpenReport(App.Path + "\Reports\NewClaimWithICD.rpt")
412 PrintPhysician 1
414 PrintSurgeon 1
416 PrintAnesthesiologist 1
418 PrintGeneralInfo True, HideDoctor
420 Form2Report.ParameterFields(F_IndexNumber).AddCurrentValue ""
422 If isPaidtoBill(strIdNum) Then
424 If MsgBox("Is it Hospital Claim?", vbYesNo) = vbYes Then
426 Form2Report.ParameterFields(F_ConstHospPatient).AddCurrentValue "Y"
428 strOptionType = "Y"
Else
430 Form2Report.ParameterFields(F_ConstHospPatient).AddCurrentValue "N"
432 strOptionType = "N"
End If
Else
434 If strOptionType = "Y" Then
436 Form2Report.ParameterFields(F_ConstHospPatient).AddCurrentValue "Y"
Else
438 Form2Report.ParameterFields(F_ConstHospPatient).AddCurrentValue "N"
End If
End If
440 Form2Report.ParameterFields(F_DocBatch).AddCurrentValue "1"
442 Form2Report.ParameterFields(F_DiagBatch).AddCurrentValue "2"
444 frmViewForm2.WhatReport = 1
446 frmViewForm2.Show vbModal
End If
448 strActualUserID = GetActualUserID(strIdNum)
450 user.SQLConnection.Execute "Medicare..Medic_CreateTempTable '" & Trim$(strIdNum) & "','" & Trim$(strActualUserID) & "'"
452 If IsNumeric(Right(strIdNum, 1)) Then
454 user.SQLConnection.Execute "Medicare..Medic_AutoComputeCharges '" & Trim$(strIdNum) & "','" & Trim$(strActualUserID) & "'"
Else
456 user.SQLConnection.Execute "Medicare..Medic_AutoComputeChargesOP '" & Trim$(strIdNum) & "','" & Trim$(strActualUserID) & "'"
End If
458 user.SQLConnection.Execute "Update Medicare..tbMedActual set CountPrinting = IsNull(CountPrinting,0) + 1 where IDNum = '" & Trim$(strIdNum) & "'"
460 frmView.PatientName = GetPatientName(strIdNum)
462 frmView.TotalDeduction = ""
464 frmView.TotalPF = ""
466 frmView.UserID = Trim$(strActualUserID)
468 frmView.IdNum = strIdNum
470 If GetPackageType(strIdNum) = "4" Then
472 frmView.WhatReport = 2
474 frmView.ReportType = 1
Else
476 frmView.WhatReport = 61
End If
'jeremy'
'blnPrint = True
478 frmView.Show vbModal
End If
'End
Else
480 Screen.MousePointer = vbDefault
482 If intOption = 6 Then
484 frmForm2.Preprinted = True
Else
486 frmForm2.Preprinted = False
End If
488 If HideDoctor = True Then
490 frmForm2.HideDoctor = True
Else
492 frmForm2.HideDoctor = False
End If
494 frmForm2.FormCount = intFormCount
496 frmForm2.Show vbModal
End If
End If
'
Exit Sub
PrintForm2_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.PrintForm2 " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Sub
Public Sub PrintBlankForm2(Optional intOptiona As Integer = 1)
'
On Error GoTo PrintBlankForm2_Err
'
100 Set Form2crxApplication = New CRAXDRT.Application
102 Select Case intOptiona
Case 1
104 Set Form2Report = Form2crxApplication.OpenReport(App.Path + "\Reports\BlankForm2.rpt")
106 Case 2
108 Set Form2Report = Form2crxApplication.OpenReport(App.Path + "\Reports\NewClaimWithICDBlank.rpt")
110 Case 3
112 Set Form2Report = Form2crxApplication.OpenReport(App.Path + "\Reports\BlankForm4.rpt")
114 Case 4
116 Set Form2Report = Form2crxApplication.OpenReport(App.Path + "\Reports\Part4And5.rpt")
118 Case 5
120 Set Form2Report = Form2crxApplication.OpenReport(App.Path + "\Reports\ClaimNewPart4.rpt")
End Select
122 If intOptiona = 4 Or intOptiona = 5 Then
124 PrintSignatoryForBlank
Else
126 PrintGenInfoForBlank
End If
128 frmViewForm2.WhatReport = 2
130 frmViewForm2.Form2Type = 2
132 frmViewForm2.Show vbModal
'
Exit Sub
PrintBlankForm2_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.PrintBlankForm2 " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Sub
Public Sub PrintGenInfoForBlank()
'
On Error GoTo PrintGenInfoForBlank_Err
'
100 With Medicare
102 Form2Report.ParameterFields(F_ACCREDITNUM).AddCurrentValue .Hospital.AccrNumber
104 Form2Report.ParameterFields(F_CATEGORY).AddCurrentValue .Hospital.Category
106 Form2Report.ParameterFields(F_HOSPITAL_NAME).AddCurrentValue .Hospital.HospitalName
108 Form2Report.ParameterFields(F_HOSPITAL_STREET).AddCurrentValue .Hospital.Street
110 Form2Report.ParameterFields(F_HOSPITAL_BARANGAY).AddCurrentValue .Hospital.Barangay
112 Form2Report.ParameterFields(F_HOSPITAL_MUNICIPALITY).AddCurrentValue .Hospital.Municipality
114 Form2Report.ParameterFields(F_HOSPITAL_PROVINCE).AddCurrentValue .Hospital.Province
116 Form2Report.ParameterFields(F_HOSPITAL_ZIPCODE).AddCurrentValue .Hospital.ZipCode
End With
'
Exit Sub
PrintGenInfoForBlank_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.PrintGenInfoForBlank " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Sub
Public Sub PrintSignatoryForBlank()
'
On Error GoTo PrintSignatoryForBlank_Err
'
100 Form2Report.ParameterFields(1).AddCurrentValue Medicare.Signatory.SignatoryName
102 Form2Report.ParameterFields(2).AddCurrentValue Medicare.Signatory.OfficialCapacity
'
Exit Sub
PrintSignatoryForBlank_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.PrintSignatoryForBlank " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Sub
Public Function BillingMedicareDeduction(strIdNum As String) As Currency
'
On Error GoTo BillingMedicareDeduction_Err
'
Dim recX As New ADODB.Recordset
Dim strSQL As String
100 If IsNumeric(Trim$(strIdNum)) Then
102 strSQL = "Select IsNull( (Select Cast(Sum(IsNull(Amount,0)) as money)" + _
"From Billing..tbBillDailyBill " + _
"Where IdNum = '" + strIdNum + "' and RevenueID = 'SS'),0) [Amount]"
Else
104 If Right(Trim$(strIdNum), 1) = "D" Then
106 strSQL = "Select IsNull( (Select Cast(IsNull(ActualRoomBoard,0) + IsNull(ActualDrug,0) +" + _
"IsNull(ActualOthers,0) + IsNull(ActualOR,0) + isnull(ActualOutside,0) as money)" + _
"From Medicare..tbMedClaim " + _
"Where IdNum = '" + strIdNum + "'),0) [Amount]"
Else
108 strSQL = "Select IsNull( (Select Cast(Sum(IsNull(Amount,0)) as money)" + _
"From Billing..tbBillOPDailyOut " + _
"Where IdNum = '" + strIdNum + "' and RevenueID = 'SS'),0) [Amount]"
End If
End If
110 BillingMedicareDeduction = 0
112 If recX.State > 0 Then recX.Close
114 recX.CursorLocation = adUseClient
116 recX.Open strSQL, user.SQLConnection, adOpenDynamic, adLockReadOnly
118 If recX.RecordCount > 0 Then
120 BillingMedicareDeduction = recX![Amount]
End If
122 If recX.State > 0 Then recX.Close
124 Set recX = Nothing
'
Exit Function
BillingMedicareDeduction_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.BillingMedicareDeduction " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Public Function GetPF(strIdNum As String, strDocID As String, Optional intOption As DOCTOR_PF = ACTUAL_PF) As Currency
'
On Error GoTo GetPF_Err
'
Dim recX As New ADODB.Recordset
100 GetPF = 0
102 If recX.State > 0 Then recX.Close
104 recX.CursorLocation = adUseClient
106 If intOption = ACTUAL_PF Then
108 recX.Open "Medic_GetPF '" + strIdNum + "','" + strDocID + "'", user.SQLConnection, adOpenDynamic, adLockReadOnly
Else
110 recX.Open "Medic_GetMedicarePF '" + strIdNum + "','" + strDocID + "'", user.SQLConnection, adOpenDynamic, adLockReadOnly
End If
112 If recX.RecordCount > 0 Then
114 GetPF = recX![Amount]
End If
116 If recX.State > 0 Then recX.Close
118 Set recX = Nothing
'
Exit Function
GetPF_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.GetPF " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Public Function GetUserName(UserID As String) As String
'
On Error GoTo GetUserName_Err
'
Dim recX As New ADODB.Recordset
100 If recX.State > 0 Then recX.Close
102 recX.CursorLocation = adUseClient
104 recX.Open "Medic_GetUserName '" + UserID + "'", user.SQLConnection, adOpenDynamic, adLockReadOnly
106 If recX.RecordCount > 0 Then
108 GetUserName = recX![UserName]
Else
110 GetUserName = ""
End If
112 If recX.State > 0 Then recX.Close
114 Set recX = Nothing
'
Exit Function
GetUserName_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.GetUserName " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Public Function CountConfinement(strHospNum As String, Optional strStartDate As String, Optional blnOwwa = False) As Integer
'
On Error GoTo CountConfinement_Err
'
Dim strSQL As String
Dim RecSQL As New ADODB.Recordset
100 If blnOwwa = True Then
102 strSQL = "Medicare..Medic_PatientCountConfinementNoticeOWWA '" & strHospNum & "', '" & strStartDate & "'"
Else
104 strSQL = "Medicare..Medic_PatientCountConfinementNotice '" & strHospNum & "', '" & strStartDate & "'"
End If
106 CountConfinement = 0
108 With RecSQL
110 If .State > 0 Then .Close
112 .CursorLocation = adUseClient
114 .Open strSQL, user.SQLConnection, adOpenDynamic, adLockOptimistic
116 If .RecordCount > 0 Then
118 CountConfinement = !CountPeriod
End If
120 If .State > 0 Then .Close
End With
'
Exit Function
CountConfinement_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.CountConfinement " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Public Function CountMemberAvailment(strMemberNumber As String, strStartDate As String) As Integer
'
On Error GoTo CountMemberAvailment_Err
'
Dim strSQL As String
Dim RecSQL As New ADODB.Recordset
100 strSQL = "Medicare..Medic_MemberCountConfinementNotice '" & strMemberNumber & "','" & strStartDate & "'"
102 CountMemberAvailment = 0
104 With RecSQL
106 If .State > 0 Then .Close
108 .CursorLocation = adUseClient
110 .Open strSQL, user.SQLConnection, adOpenDynamic, adLockOptimistic
112 If .RecordCount > 0 Then
114 CountMemberAvailment = !CountPeriod
End If
116 If .State > 0 Then .Close
End With
'
Exit Function
CountMemberAvailment_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.CountMemberAvailment " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Public Function GetMembership(Optional intType As Integer = 1) As String
'
On Error GoTo GetMembership_Err
'
Dim RecSQL As New ADODB.Recordset
Dim strSQL As String
100 With RecSQL
102 GetMembership = ""
104 strSQL = "select [Name] as Membership from tbmedtype where code = " & intType
106 If .State > 0 Then .Close
108 .CursorLocation = adUseClient
110 .Open strSQL, user.SQLConnection, adOpenDynamic, adLockOptimistic
112 If .RecordCount > 0 Then
114 GetMembership = !Membership & ""
End If
116 If .State > 0 Then .Close
End With
'
Exit Function
GetMembership_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.GetMembership " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Public Sub HospitalInfo()
'
On Error GoTo HospitalInfo_Err
'
Dim recX As New ADODB.Recordset
Dim strSQL As String
100 strSQL = "Select Top 1 * From Patient_Data..tbHospitalInfo"
102 If recX.State > 0 Then recX.Close
104 recX.CursorLocation = adUseClient
106 recX.Open strSQL, user.SQLConnection, adOpenDynamic, adLockReadOnly
108 If recX.RecordCount > 0 Then
110 pstrHospitalName = recX!Company & ""
112 pstrHospitalAddress = recX!Address1 & ""
114 ClientName = recX!ClientName & ""
End If
116 If recX.State > 0 Then recX.Close
118 Set recX = Nothing
'
Exit Sub
HospitalInfo_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.HospitalInfo " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Sub
Public Sub GetUserVerSettings()
'
On Error GoTo GetUserVerSettings_Err
'
Dim recX As New ADODB.Recordset
Dim strSQL As String
100 blnProceed = True
102 strSQL = "Select Top 1 * From build_file..tbcoBuildFileSetting"
104 If recX.State > 0 Then recX.Close
106 recX.CursorLocation = adUseClient
108 recX.Open strSQL, user.SQLConnection, adOpenDynamic, adLockReadOnly
110 If recX.RecordCount > 0 Then
112 blnAllowUserVerification = recX!isAllowUserVerification & ""
End If
114 If recX.State > 0 Then recX.Close
116 Set recX = Nothing
'
Exit Sub
GetUserVerSettings_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.GetUserVerSettings " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Sub
Public Sub ActivatePhase()
'
On Error GoTo ActivatePhase_Err
'
Dim recX As New ADODB.Recordset
Dim strSQL As String
100 strSQL = "Select isAllowShowReportDescription,ActivatePhase1, ActivatePhase2,ActivatePhase1_2 From Medicare..tbMedHospital"
102 If recX.State > 0 Then recX.Close
104 recX.CursorLocation = adUseClient
106 recX.Open strSQL, user.SQLConnection, adOpenDynamic, adLockReadOnly
108 If recX.RecordCount > 0 Then
110 ActivatePhase1 = IIf(IsNull(recX!ActivatePhase1), 0, recX!ActivatePhase1)
112 ActivatePhase1_2 = IIf(IsNull(recX!ActivatePhase1_2), 0, recX!ActivatePhase1_2)
114 ActivatePhase2 = IIf(IsNull(recX!ActivatePhase2), 0, recX!ActivatePhase2)
116 blnShowReport = IIf(IsNull(recX!isAllowShowReportDescription), 0, recX!isAllowShowReportDescription)
End If
118 If recX.State > 0 Then recX.Close
120 Set recX = Nothing
'
Exit Sub
ActivatePhase_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.ActivatePhase " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Sub
Public Function isPatientAlreadyFiled(strIDnumber As String) As Boolean
Dim strSQL As String
Dim RecSQL As New ADODB.Recordset
On Error GoTo ErrHandle
strSQL = "Select isnull(isFiled,0) as isFiled From Medicare..tbMedPatient Where IDNum = '" & strIDnumber & "'"
With RecSQL
isPatientAlreadyFiled = False
If .State > 0 Then .Close
.CursorLocation = adUseClient
.Open strSQL, user.SQLConnection, adOpenDynamic, adLockReadOnly
If .RecordCount > 0 Then
If !isFiled = True Then
isPatientAlreadyFiled = True
End If
End If
If .State > 0 Then .Close
End With
Exit Function
ErrHandle:
MsgBox "ERROR : " & Err.Description, vbInformation + vbCritical, "Message"
End Function
Public Function isPatientTaggedForTransmittal(strIdNum As String) As String
'
On Error GoTo isPatientTaggedForTransmittal_Err
'
Dim RecSQL As New ADODB.Recordset
Dim strSQL As String
100 strSQL = "Medic_PatientTagForTransmittal '" & strIdNum & "'"
102 isPatientTaggedForTransmittal = ""
104 With RecSQL
106 If .State > 0 Then .Close
108 .CursorLocation = adUseClient
110 .Open strSQL, user.SQLConnection, adOpenDynamic, adLockReadOnly
112 If .RecordCount > 0 Then
114 isPatientTaggedForTransmittal = IIf(IsNull(!TransDate), "", Format(!TransDate, "MM/dd/yyyy"))
End If
116 If .State > 0 Then .Close
End With
'
Exit Function
isPatientTaggedForTransmittal_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.isPatientTaggedForTransmittal " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Public Function isClaimsReceived(strIdNum As String) As String
'
On Error GoTo isClaimsReceived_Err
'
Dim RecSQL As New ADODB.Recordset
Dim strSQL As String
100 strSQL = "Select * from Medicare..tbMedPatient where IDNum ='" & strIdNum & "'"
102 isClaimsReceived = ""
104 With RecSQL
106 If .State > 0 Then .Close
108 .CursorLocation = adUseClient
110 .Open strSQL, user.SQLConnection, adOpenDynamic, adLockReadOnly
112 If .RecordCount > 0 Then
114 isClaimsReceived = IIf(IsNull(!PHICReceived), "Not Yet", Format(!PHICReceived, "MM/dd/yyyy"))
End If
116 If .State > 0 Then .Close
End With
'
Exit Function
isClaimsReceived_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.isClaimsReceived " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Public Sub GetHBActual(IdNum As String)
'
On Error GoTo GetHBActual_Err
'
Dim recX As New ADODB.Recordset
100 PublicRB = 0
102 PublicDrugs = 0
104 PublicOthers = 0
106 PublicOR = 0
108 If recX.State > 0 Then recX.Close
110 recX.CursorLocation = adUseClient
112 recX.Open "Billing..sp_PARS_RepSOASummarized_New '" + Trim$(IdNum) + "'", user.SQLConnection, adOpenDynamic, adLockReadOnly
114 If recX.RecordCount > 0 Then
116 recX.MoveFirst
118 While Not recX.EOF
120 If recX!ReportOrder = 1 Then PublicRB = recX!Charges - recX!Credit
122 If recX!ReportOrder = 2 Then PublicDrugs = recX!Charges - recX!Credit
124 If recX!ReportOrder = 4 Then PublicOthers = recX!Charges - recX!Credit
126 If recX!ReportOrder = 3 Then PublicOR = recX!Charges - recX!Credit
' If recX!RevenueID = "PC" Or recX!RevenueID = "CC" Then
' PublicDrugs = PublicDrugs - recX!Credit
' End If
128 recX.MoveNext
Wend
End If
130 If recX.State > 0 Then recX.Close
132 Set recX = Nothing
'
Exit Sub
GetHBActual_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.GetHBActual " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Sub
Public Function isAlreadyInvoice(strIdNum As String) As Boolean
'
On Error GoTo isAlreadyInvoice_Err
'
Dim RecSQL As New ADODB.Recordset
Dim strSQL As String
100 strSQL = "Medicare..Medic_CheckIfAlreadyInvoiced '" & strIdNum & "'"
102 isAlreadyInvoice = False
104 With RecSQL
106 If .State > 0 Then .Close
108 .CursorLocation = adUseClient
110 .Open strSQL, user.SQLConnection, adOpenDynamic, adLockOptimistic
112 If .RecordCount > 0 Then
114 If Len(Trim$(!InvoiceNumber)) > 0 Then
116 isAlreadyInvoice = True
End If
End If
118 If .State > 0 Then .Close
End With
'
Exit Function
isAlreadyInvoice_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.isAlreadyInvoice " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Public Function isLateChargesBilling(strIdNum As String) As Boolean
'
On Error GoTo isLateChargesBilling_Err
'
Dim RecSQL As New ADODB.Recordset
Dim strSQL As String
100 strSQL = "Medicare..Medic_CheckIFLateCharges '" & strIdNum & "'"
102 isLateChargesBilling = False
104 With RecSQL
106 If .State > 0 Then .Close
108 .CursorLocation = adUseClient
110 .Open strSQL, user.SQLConnection, adOpenDynamic, adLockOptimistic
112 If .RecordCount > 0 Then
114 If Trim$(!LateCharges) = "0" Then
116 isLateChargesBilling = True
End If
End If
118 If .State > 0 Then .Close
End With
'
Exit Function
isLateChargesBilling_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.isLateChargesBilling " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Public Function UpdateMedicarePayments(strId As String, strORNumber As String, dblRoomBoard As Double, dblDrugs As Double, _
dblOthers As Double, dblOR As Double, dblTax As Double, strDatePaid As String, strUserID As String, strPaymentOrder As String, _
strAPVNum As String) As Boolean
Dim strSQL As String
On Error GoTo ErrHandle
UpdateMedicarePayments = True
strSQL = "Medicare..Medic_UpdatePaymentRoomDrugOthers '" & strId & "', '" & strORNumber & "', " & CStr(dblRoomBoard) & ", " & CStr(dblDrugs) & ", " _
+ " " & CStr(dblOthers) & ", " & CStr(dblOR) & ", " & CStr(dblTax) & ", '" & strDatePaid & "', '" & strUserID & "', '" & strPaymentOrder & "', '" & strAPVNum & "'"
user.SQLConnection.Execute strSQL
Exit Function
ErrHandle:
UpdateMedicarePayments = False
MsgBox Err.Description, vbCritical + vbOKOnly, "Error"
End Function
Public Function CheckifAlreadySaveCompensable(strIdNum As String) As Boolean
'
On Error GoTo CheckifAlreadySaveCompensable_Err
'
Dim Rec As New ADODB.Recordset
Dim SQL As String
100 CheckifAlreadySaveCompensable = False
102 SQL = "Select idnum from Medicare..Medic_DumpCompensable where IDNum = '" & strIdNum & "'"
104 With Rec
106 If .State > 0 Then .Close
108 .CursorLocation = adUseClient
110 .Open SQL, user.SQLConnection, adOpenDynamic, adLockReadOnly
112 If .RecordCount > 0 Then
114 CheckifAlreadySaveCompensable = True
End If
116 .Close
End With
118 Set Rec = Nothing
'
Exit Function
CheckifAlreadySaveCompensable_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.CheckifAlreadySaveCompensable " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Public Function CheckifAlreadySaveActual(strIdNum As String) As Boolean
'
On Error GoTo CheckifAlreadySaveActual_Err
'
Dim Rec As New ADODB.Recordset
Dim SQL As String
100 CheckifAlreadySaveActual = False
102 SQL = "Select idnum from Medicare..tbMedActual where IDNum = '" & strIdNum & "'"
104 With Rec
106 If .State > 0 Then .Close
108 .CursorLocation = adUseClient
110 .Open SQL, user.SQLConnection, adOpenDynamic, adLockReadOnly
112 If .RecordCount > 0 Then
114 CheckifAlreadySaveActual = True
End If
116 .Close
End With
118 Set Rec = Nothing
'
Exit Function
CheckifAlreadySaveActual_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.CheckifAlreadySaveActual " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Public Function GetActual(strIdNum As String)
'
On Error GoTo GetActual_Err
'
Dim Rec As New ADODB.Recordset
Dim SQL As String
' CheckifAlreadySaveActual = False
100 SQL = "Select * from Medicare..tbMedActual where IDNum = '" & strIdNum & "'"
102 With Rec
104 If .State > 0 Then .Close
106 .CursorLocation = adUseClient
108 .Open SQL, user.SQLConnection, adOpenDynamic, adLockReadOnly
110 If .RecordCount > 0 Then
' CheckifAlreadySaveActual = True
End If
112 .Close
End With
114 Set Rec = Nothing
'
Exit Function
GetActual_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.GetActual " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Public Function CalculateBirthday(strBirthday As String, strAdmDate As String) As String
'
On Error GoTo CalculateBirthday_Err
'
Dim dDOB As Date, iAgeInYears As Integer, iAgeInMonth As Integer, iDayDiff As Integer
Dim Date1 As Date, Date2 As Date, iHlpDay As Integer, iHlpMonth As Integer
Dim iHlpYear As Integer, dHlpDate As String
100 strBirthday = IIf(strBirthday = "", " / / ", strBirthday)
102 Date1 = CDate(IIf(strBirthday = " / / ", Now, strBirthday))
'If pubstrAdmDate = "" Then
104 Date2 = CDate(strAdmDate)
'Else
' Date2 = Format(CDate(pubstrAdmDate), "dd/mm/yyyy")
'End If
106 iDayDiff = Day(Date2) - Day(Date1)
108 If iDayDiff < 0 Then
' e.g we have date1 18.2.62 and date2 7.5.65
'we will use a helpdate 7.3.62 and then calculate from 7.3.62 - 7.5.66
110 iHlpDay = Day(Date2)
112 iHlpMonth = Month(Date1) + 1 'next month
114 iHlpYear = Year(Date1)
116 If iHlpMonth > 12 Then
118 iHlpMonth = 1
120 iHlpYear = iHlpYear + 1
End If
122 If iHlpMonth = 2 Then
124 If (iHlpYear Mod 4) = 0 Then
126 iHlpDay = IIf(iHlpDay >= 30, 29, iHlpDay)
Else
128 iHlpDay = IIf(iHlpDay >= 29, 28, iHlpDay)
End If
End If
130 dHlpDate = Format(IIf(Len(CStr(iHlpMonth)) = 1, "0" + CStr(iHlpMonth), CStr(iHlpMonth)) & _
"/" & IIf(Len(CStr(iHlpDay)) = 1, "0" + CStr(iHlpDay), CStr(iHlpDay)) & "/" & CStr(iHlpYear), "mm/dd/yyyy")
132 iDayDiff = DateDiff("d", Date1, dHlpDate) ' Thats the days
134 Date1 = dHlpDate
End If
136 iAgeInMonth = DateDiff("m", Date1, Date2)
138 iAgeInYears = DateDiff("yyyy", Date1, Date2)
140 If Month(Date1) > Month(Date2) Then
142 iAgeInYears = iAgeInYears - 1
End If
144 iAgeInMonth = iAgeInMonth - 12 * iAgeInYears
'CalculateBirthday = CStr(iDayDiff) + "D " + CStr(iAgeInMonth) + "M"
146 CalculateBirthday = CStr(iAgeInMonth) + "M"
'
Exit Function
CalculateBirthday_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.CalculateBirthday " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Public Function BirthDate(strHospNum As String) As String
'
On Error GoTo BirthDate_Err
'
Dim Rec As New ADODB.Recordset
Dim SQL As String
100 SQL = "Select BirthDate from Patient_Data..tbMaster where Hospnum = '" & strHospNum & "'"
102 With Rec
104 If .State > 0 Then .Close
106 .CursorLocation = adUseClient
108 .Open SQL, user.SQLConnection, adOpenDynamic, adLockReadOnly
110 If .RecordCount > 0 Then
112 BirthDate = Format(!BirthDate, "mm/dd/yyyy")
End If
114 .Close
End With
116 Set Rec = Nothing
118 strBirthDate = BirthDate
'
Exit Function
BirthDate_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.BirthDate " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Public Function GetActualMeds(strIdNum As String, strPosition As String)
'
On Error GoTo GetActualMeds_Err
'
Dim Rec As New ADODB.Recordset
Dim SQL As String
100 If strPosition = "5" Then
102 GetActualUserID strIdNum '
104 SQL = "Medicare..Medic_GetTempActualAmounts '" & strPosition & "','" & strIdNum & "','" & ActualUserID & "'"
Else
106 SQL = "Medicare..Medic_GetTempActualMedAmounts '" & strPosition & "','" & strIdNum & "','" & user.EmployeeCode & "'"
End If
108 With Rec
110 If .State > 0 Then .Close
112 .CursorLocation = adUseClient
114 .Open SQL, user.SQLConnection, adOpenDynamic, adLockReadOnly
116 If .RecordCount > 0 Then
118 GetActualMeds = Format(!Total, "###,##0.00")
End If
120 .Close
End With
122 Set Rec = Nothing
'
Exit Function
GetActualMeds_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.GetActualMeds " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Public Function GetBatchNum(strTransDate As String, strMedType As String)
'
On Error GoTo GetBatchNum_Err
'
Dim Rec As New ADODB.Recordset
Dim SQL As String
' CheckifAlreadySaveActual = False
100 SQL = "Select max(isnull(BatchNum,1)) BatchNum from Medicare..tbMedPatient where TransDate between '" & strTransDate & "' and '" + strTransDate + " 23:59:59.99' and " + _
"MemberType = '" & strMedType & "' group by BatchNum"
102 With Rec
104 If .State > 0 Then .Close
106 .CursorLocation = adUseClient
108 .Open SQL, user.SQLConnection, adOpenDynamic, adLockReadOnly
110 If .RecordCount > 0 Then
' CheckifAlreadySaveActual = True
End If
112 .Close
End With
114 Set Rec = Nothing
'
Exit Function
GetBatchNum_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.GetBatchNum " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Public Sub OpenMainReport(ByVal strReportFileName As String, ParamArray strParameters())
'
On Error GoTo OpenMainReport_Err
'
Dim crxParameterField As CRAXDRT.ParameterFieldDefinition
Dim intctr As Integer
Dim intTotalParam As Integer
Dim crxtable As CRAXDRT.DatabaseTable
Dim crxApplication As New CRAXDRT.Application
100 intTotalParam = UBound(strParameters)
102 If Not Report Is Nothing Then Set Report = Nothing
104 Set Report = crxApplication.OpenReport(strReportFileName, 1)
106 Report.ReportTitle = pstrHospitalName
108 Report.ReportComments = pstrHospitalAddress
110 For Each crxtable In Report.Database.Tables
112 crxtable.Location = "Billing" + Mid(crxtable.Location, InStr(1, crxtable.Location, "."))
114 crxtable.SetLogOnInfo user.ServerName, "Billing", user.UserID, user.ServerPassword
Next
116 If intTotalParam >= 0 Then
118 For Each crxParameterField In Report.ParameterFields
120 If intTotalParam >= intctr Then
122 crxParameterField.AddCurrentValue strParameters(intctr)
Else
Exit For
End If
124 intctr = intctr + 1
Next
End If
126 Set crxParameterField = Nothing
128 Set crxtable = Nothing
130 Set crxApplication = Nothing
'
Exit Sub
OpenMainReport_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.OpenMainReport " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Sub
Public Sub OpenSubReport(ByVal strSubReport As String, ParamArray strParameters())
'
On Error GoTo OpenSubReport_Err
'
Dim crxParameterField As CRAXDRT.ParameterFieldDefinition
Dim intctr As Integer
Dim intTotalParam As Integer
Dim crxtable As CRAXDRT.DatabaseTable
Dim crxSubreport As CRAXDRT.Report
100 intTotalParam = UBound(strParameters)
102 Set crxSubreport = Report.OpenSubReport(strSubReport)
104 For Each crxtable In crxSubreport.Database.Tables
106 crxtable.Location = "Billing" + Mid(crxtable.Location, InStr(1, crxtable.Location, "."))
108 crxtable.SetLogOnInfo user.ServerName, "Billing", user.UserID, user.ServerPassword
Next
110 If intTotalParam >= 0 Then
112 For Each crxParameterField In crxSubreport.ParameterFields
114 If intTotalParam >= intctr Then
116 crxParameterField.AddCurrentValue strParameters(intctr)
Else
Exit For
End If
118 intctr = intctr + 1
Next
End If
120 Set crxParameterField = Nothing
122 Set crxtable = Nothing
124 Set crxSubreport = Nothing
'
Exit Sub
OpenSubReport_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.OpenSubReport " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Sub
Public Sub ShowReportViewer(Optional blnShowGroupTree As Boolean = False, Optional strCaption As String = "", Optional blnDirectToPrinter As Boolean = False, Optional blnvbModal As Boolean = False)
'
On Error GoTo ShowReportViewer_Err
'
100 If blnDirectToPrinter Then
102 Report.DisplayProgressDialog = False
104 Report.PrintOut False
106 Set Report = Nothing
Else
108 If Not blnvbModal Then
Dim frmRView As New frmReportViewer
110 With frmRView
112 .ShowGroupTree = blnShowGroupTree
114 .Caption = strCaption
116 .DirectPrint = blnDirectToPrinter
118 .Show
End With
Else
Dim frmRViewvbmodal As New frmReportViewervbModal
120 With frmRViewvbmodal
122 .ShowGroupTree = blnShowGroupTree
124 .Caption = strCaption
126 .DirectPrint = blnDirectToPrinter
128 .Show vbModal
End With
End If
End If
'
Exit Sub
ShowReportViewer_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.ShowReportViewer " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Sub
Public Function GetAccNumber(strIdNum As String) As String
'
On Error GoTo GetAccNumber_Err
'
Dim Rec As New ADODB.Recordset
Dim SQL As String
100 SQL = "select top 1 isnull(AccountNum,'') [AccNum] from Patient_Data..tbpatient where IdNum = '" + strIdNum + "'"
102 GetAccNumber = 0
104 With Rec
106 If .State > 0 Then .Close
108 .CursorLocation = adUseClient
110 .Open SQL, user.SQLConnection, adOpenDynamic, adLockReadOnly
112 If .RecordCount > 0 Then
114 GetAccNumber = ![AccNum]
End If
116 .Close
End With
118 Set Rec = Nothing
'
Exit Function
GetAccNumber_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.GetAccNumber " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Public Function GetPaymentAmount(strIdNum As String) As Double
'
On Error GoTo GetPaymentAmount_Err
'
Dim Rec As New ADODB.Recordset
Dim SQL As String
' If GetIsBenefits(strIdNum) = True Then
'
' SQL = "(Select(Select IsNull(Sum(IsNull(Amount,0)) + Sum(IsNull(Tax,0)),0)[Amount] from Medicare..tbMedPayment where IDNum = '" & _
' Trim$(strIdNum) & "') + (Select IsNull(Sum(isnull((Payment),0)),0)[Amount] from Medicare..tbMedDoctors where IDNum = '" & _
' Trim$(strIdNum) & "') as [Amount])"
'
' Else
100 SQL = "(Select(Select isnull(Sum(IsNull(Amount,0)) + Sum(IsNull(Tax,0)),0)[Amount] from Medicare..tbMedPayment where IDNum = '" & _
Trim$(strIdNum) & "') as [Amount])"
' End If
102 GetPaymentAmount = 0
104 With Rec
106 If .State > 0 Then .Close
108 .CursorLocation = adUseClient
110 .Open SQL, user.SQLConnection, adOpenDynamic, adLockReadOnly
112 If .RecordCount > 0 Then
114 GetPaymentAmount = !Amount
End If
116 .Close
End With
118 Set Rec = Nothing
'
Exit Function
GetPaymentAmount_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.GetPaymentAmount " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Public Function IsHMOAccount(strIdNum As String) As Boolean
'
On Error GoTo IsHMOAccount_Err
'
Dim Rec As New ADODB.Recordset
Dim SQL As String
100 IsHMOAccount = False
102 SQL = "Medicare..Medic_CheckIfHMOAccount '" & Trim$(strIdNum) & "'"
104 With Rec
106 If .State > 0 Then .Close
108 .CursorLocation = adUseClient
110 .CursorType = adOpenDynamic
112 .LockType = adLockOptimistic
114 .Open SQL, user.SQLConnection
116 If .RecordCount > 0 Then
118 IsHMOAccount = True
End If
120 .Close
End With
122 Set Rec = Nothing
'
Exit Function
IsHMOAccount_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.IsHMOAccount " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Public Sub GetRVSInfo(strtmpIDNum As String)
'
On Error GoTo GetRVSInfo_Err
'
Dim SQL As String
Dim Rec As New ADODB.Recordset
100 SQL = "Select isnull(RVS,'') RVS, isnull(IllnessCode,'') IllnessCode from Medicare..tbMedPatient where IDNum = '" & Trim$(strtmpIDNum) & "'"
102 With Rec
104 If .State > 0 Then .Close
106 .CursorLocation = adUseClient
108 .CursorType = adOpenDynamic
110 .LockType = adLockOptimistic
112 .Open SQL, user.SQLConnection
114 If .RecordCount > 0 Then
116 strForm2RVS = !RVS & ""
118 strForm2IllnessCOde = !IllnessCode & ""
End If
120 .Close
End With
122 Set Rec = Nothing
'
Exit Sub
GetRVSInfo_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.GetRVSInfo " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Sub
Public Sub PrintConfinementInfo(strtmpIDNum As String)
'
On Error GoTo PrintConfinementInfo_Err
'
Dim SQL As String
Dim Rec As New ADODB.Recordset
Dim PatientDisposition As String
Dim isPatientReferred As Boolean
Dim NameOfReferringHCI As String
Dim ReferringAddress As String
Dim ReferralReason As String
Dim AccomodationType As String
Dim isHemoProcedure As Boolean
Dim isPDProcedure As Boolean
Dim isRLINACProcedure As Boolean
Dim isRCOBALTProcedure As Boolean
Dim isBTProcedure As Boolean
Dim isBrachyProcedure As Boolean
Dim isChemoProcedure As Boolean
Dim isSDProcedure As Boolean
Dim HemoProcedureDates As String
Dim PDProcedureDates As String
Dim RLINACProcedureDates As String
Dim RCOBALTProcedureDates As String
Dim BTProcedureDates As String
Dim BrachyProcedureDates As String
Dim ChemoProcedureDates As String
Dim SDProcedureDates As String
Dim ZBPCode As String
Dim ABPackageDayZero As String
Dim ABPackageDayThree As String
Dim ABPackageDaySeven As String
Dim ABPackageRIG As String
Dim ABPackageOthers As String
Dim MCPPackageFirst As String
Dim MCPPackageSecond As String
Dim MCPPackageThird As String
Dim MCPPackageFourth As String
Dim ENewbornCareIDON As String
Dim ENewbornCareEStSC As String
Dim ENewbornCareTCC As String
Dim ENewbornCareEP As String
Dim ENewbornCareWotN As String
Dim ENewbornCareVkA As String
Dim ENewbornCareBCGV As String
Dim ENewbornCareNsoMBfEBFI As String
Dim ENewbornCareHepaB As String
Dim TBDotsPackge As String
Dim NewbornCarePackge As String
Dim LaboratoryNumber As String
100 SQL = "Medicare..Medic_GetConfinementInfo '" & Trim$(strtmpIDNum) & "'"
102 With Rec
104 If .State > 0 Then .Close
106 .CursorLocation = adUseClient
108 .CursorType = adOpenDynamic
110 .LockType = adLockOptimistic
112 .Open SQL, user.SQLConnection
114 If .RecordCount > 0 Then
116 PatientDisposition = !PatientDisposition
118 isPatientReferred = !isPatientReferred
120 NameOfReferringHCI = !NameOfReferralHCI
122 ReferringAddress = !ReferralAddress
124 ReferralReason = !ReferralReason
126 AccomodationType = !AccomodationType
128 isHemoProcedure = !isHemoProcedure
130 isPDProcedure = !isPDProcedure
132 isRLINACProcedure = !isRLINACProcedure
134 isRCOBALTProcedure = !isRCOBALTProcedure
136 isBTProcedure = !isBTProcedure
138 isBrachyProcedure = !isBrachyProcedure
140 isChemoProcedure = !isChemoProcedure
142 isSDProcedure = !isSDProcedure
144 HemoProcedureDates = !HemoProcedureDates
146 PDProcedureDates = !PDProcedureDates
148 RLINACProcedureDates = !RLINACProcedureDates
150 RCOBALTProcedureDates = !RCOBALTProcedureDates
152 BTProcedureDates = !BTProcedureDates
154 BrachyProcedureDates = !BrachyProcedureDates
156 ChemoProcedureDates = !ChemoProcedureDates
158 SDProcedureDates = !SDProcedureDates
160 ZBPCode = !ZBPCode
162 ABPackageDayZero = !ABPackageDayZero
164 ABPackageDayThree = !ABPackageDayThree
166 ABPackageDaySeven = !ABPackageDaySeven
168 ABPackageRIG = !ABPackageRIG
170 ABPackageOthers = !ABPackageOthers
172 MCPPackageFirst = !MCPPackageFirst
174 MCPPackageSecond = !MCPPackageSecond
176 MCPPackageThird = !MCPPackageThird
178 MCPPackageFourth = !MCPPackageFourth
180 ENewbornCareIDON = !ENewbornCareIDON
182 ENewbornCareEStSC = !ENewbornCareEStSC
184 ENewbornCareTCC = !ENewbornCareTCC
186 ENewbornCareEP = !ENewbornCareEP
188 ENewbornCareWotN = !ENewbornCareWotN
190 ENewbornCareVkA = !ENewbornCareVkA
192 ENewbornCareBCGV = !ENewbornCareBCGV
194 ENewbornCareNsoMBfEBFI = !ENewbornCareNsoMBfEBFI
196 ENewbornCareHepaB = !ENewbornCareHepaB
198 TBDotsPackge = !TBDotsPackge
200 NewbornCarePackge = !NewbornCarePackge
202 LaboratoryNumber = !LaboratoryNumber
204 Form2Report.ParameterFields(F_PatientDisposition).AddCurrentValue PatientDisposition
206 Form2Report.ParameterFields(F_isPatientReferred).AddCurrentValue isPatientReferred
208 Form2Report.ParameterFields(F_NameOfReferringHCI).AddCurrentValue NameOfReferringHCI
210 Form2Report.ParameterFields(F_ReferringAddress).AddCurrentValue ReferringAddress
212 Form2Report.ParameterFields(F_ReferralReason).AddCurrentValue ReferralReason
214 Form2Report.ParameterFields(F_AccomodationType).AddCurrentValue AccomodationType
216 Form2Report.ParameterFields(F_isHemoProcedure).AddCurrentValue isHemoProcedure
218 Form2Report.ParameterFields(F_isPDProcedure).AddCurrentValue isPDProcedure
220 Form2Report.ParameterFields(F_isRLINACProcedure).AddCurrentValue isRLINACProcedure
222 Form2Report.ParameterFields(F_isRCOBALTProcedure).AddCurrentValue isRCOBALTProcedure
224 Form2Report.ParameterFields(F_isBTProcedure).AddCurrentValue isBTProcedure
226 Form2Report.ParameterFields(F_isBrachyProcedure).AddCurrentValue isBrachyProcedure
228 Form2Report.ParameterFields(F_isChemoProcedure).AddCurrentValue isChemoProcedure
230 Form2Report.ParameterFields(F_isSDProcedure).AddCurrentValue isSDProcedure
232 Form2Report.ParameterFields(F_HemoProcedureDates).AddCurrentValue HemoProcedureDates
234 Form2Report.ParameterFields(F_PDProcedureDates).AddCurrentValue PDProcedureDates
236 Form2Report.ParameterFields(F_RLINACProcedureDates).AddCurrentValue RLINACProcedureDates
238 Form2Report.ParameterFields(F_RCOBALTProcedureDates).AddCurrentValue RCOBALTProcedureDates
240 Form2Report.ParameterFields(F_BTProcedureDates).AddCurrentValue BTProcedureDates
242 Form2Report.ParameterFields(F_BrachyProcedureDates).AddCurrentValue BrachyProcedureDates
244 Form2Report.ParameterFields(F_ChemoProcedureDates).AddCurrentValue ChemoProcedureDates
246 Form2Report.ParameterFields(F_SDProcedureDates).AddCurrentValue SDProcedureDates
248 Form2Report.ParameterFields(F_ZBPCode).AddCurrentValue ZBPCode
250 Form2Report.ParameterFields(F_ABPackageDayZero).AddCurrentValue Replace(ABPackageDayZero, "/", "-")
252 Form2Report.ParameterFields(F_ABPackageDayThree).AddCurrentValue Replace(ABPackageDayThree, "/", "-")
254 Form2Report.ParameterFields(F_ABPackageDaySeven).AddCurrentValue Replace(ABPackageDaySeven, "/", "-")
256 Form2Report.ParameterFields(F_ABPackageRIG).AddCurrentValue Replace(ABPackageRIG, "/", "-")
258 Form2Report.ParameterFields(F_ABPackageOthers).AddCurrentValue Replace(ABPackageOthers, "/", "-")
260 Form2Report.ParameterFields(F_MCPPackageFirst).AddCurrentValue Replace(MCPPackageFirst, "/", "-")
262 Form2Report.ParameterFields(F_MCPPackageSecond).AddCurrentValue Replace(MCPPackageSecond, "/", "-")
264 Form2Report.ParameterFields(F_MCPPackageThird).AddCurrentValue Replace(MCPPackageThird, "/", "-")
266 Form2Report.ParameterFields(F_MCPPackageFourth).AddCurrentValue Replace(MCPPackageFourth, "/", "-")
268 Form2Report.ParameterFields(F_ENewbornCareIDON).AddCurrentValue ENewbornCareIDON
270 Form2Report.ParameterFields(F_ENewbornCareEStSC).AddCurrentValue ENewbornCareEStSC
272 Form2Report.ParameterFields(F_ENewbornCareTCC).AddCurrentValue ENewbornCareTCC
274 Form2Report.ParameterFields(F_ENewbornCareEP).AddCurrentValue ENewbornCareEP
276 Form2Report.ParameterFields(F_ENewbornCareWotN).AddCurrentValue ENewbornCareWotN
278 Form2Report.ParameterFields(F_ENewbornCareVkA).AddCurrentValue ENewbornCareVkA
280 Form2Report.ParameterFields(F_ENewbornCareBCGV).AddCurrentValue ENewbornCareBCGV
282 Form2Report.ParameterFields(F_ENewbornCareNsoMBfEBFI).AddCurrentValue ENewbornCareNsoMBfEBFI
284 Form2Report.ParameterFields(F_ENewbornCareHepaB).AddCurrentValue ENewbornCareHepaB
286 Form2Report.ParameterFields(F_TBDotsPackge).AddCurrentValue TBDotsPackge
288 Form2Report.ParameterFields(F_NewbornCarePackge).AddCurrentValue NewbornCarePackge
290 Form2Report.ParameterFields(F_LaboratoryNumber).AddCurrentValue LaboratoryNumber
End If
292 .Close
End With
294 Set Rec = Nothing
'
Exit Sub
PrintConfinementInfo_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.PrintConfinementInfo " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Sub
Public Sub PrintCardiologist(intCount As Integer, strIdNum As String)
'
On Error GoTo PrintCardiologist_Err
'
Dim strPerformedDate As String
100 With clsCardiologist
102 .IdNum = strIdNum
104 If .LoadCardioInfo Then
106 If Len(.DocCode(intCount)) > 0 And .DocCode(intCount) <> "36M" And .DocCode(intCount) <> "37M" Then
108 Form2Report.ParameterFields(F_CARDIO_NAME).AddCurrentValue .DocName(intCount)
110 Form2Report.ParameterFields(F_CARDIO_PHIC).AddCurrentValue .PHICNumber(intCount)
112 If Len(Trim$(.ServicePerformed(intCount))) > 110 And ClientName = "DDH" Then
114 blnServicePerformed = True
116 Form2Report.ParameterFields(F_CARDIO_SERVICES).AddCurrentValue "SEE ATTACHED"
Else
118 Form2Report.ParameterFields(F_CARDIO_SERVICES).AddCurrentValue .ServicePerformed(intCount)
End If
120 Form2Report.ParameterFields(F_CARDIO_ACTUAL).AddCurrentValue Format(.ActualPF(intCount), "##,###,##0.00")
122 Form2Report.ParameterFields(F_CARDIO_MED).AddCurrentValue Format(.MedicarePF(intCount), "##,###,##0.00")
124 Form2Report.ParameterFields(F_CARDIO_PATIENT).AddCurrentValue Format(.PatientPF(intCount), "##,###,##0.00")
126 strPerformedDate = Format(.DatePeformed(intCount), "MM/dd/yyyy")
128 If strPerformedDate <> "01/01/1900" And CDate(strPerformedDate) > CDate("01/01/1900") Then
130 Form2Report.ParameterFields(F_CARDIO_PERFORMEDDATE).AddCurrentValue Format(.DatePeformed(intCount), "MM/dd/yyyy")
Else
132 Form2Report.ParameterFields(F_CARDIO_PERFORMEDDATE).AddCurrentValue "n/a"
End If
Else
134 Form2Report.ParameterFields(F_CARDIO_NAME).AddCurrentValue "n/a"
136 Form2Report.ParameterFields(F_CARDIO_PHIC).AddCurrentValue "n/a"
138 Form2Report.ParameterFields(F_CARDIO_SERVICES).AddCurrentValue "n/a"
140 Form2Report.ParameterFields(F_CARDIO_ACTUAL).AddCurrentValue "n/a"
142 Form2Report.ParameterFields(F_CARDIO_MED).AddCurrentValue "n/a"
144 Form2Report.ParameterFields(F_CARDIO_PATIENT).AddCurrentValue "n/a"
146 Form2Report.ParameterFields(F_CARDIO_PERFORMEDDATE).AddCurrentValue "n/a"
End If
Else
148 Form2Report.ParameterFields(F_CARDIO_NAME).AddCurrentValue "n/a"
150 Form2Report.ParameterFields(F_CARDIO_PHIC).AddCurrentValue "n/a"
152 Form2Report.ParameterFields(F_CARDIO_SERVICES).AddCurrentValue "n/a"
154 Form2Report.ParameterFields(F_CARDIO_ACTUAL).AddCurrentValue "n/a"
156 Form2Report.ParameterFields(F_CARDIO_MED).AddCurrentValue "n/a"
158 Form2Report.ParameterFields(F_CARDIO_PATIENT).AddCurrentValue "n/a"
160 Form2Report.ParameterFields(F_CARDIO_PERFORMEDDATE).AddCurrentValue "n/a"
End If
End With
'
Exit Sub
PrintCardiologist_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.PrintCardiologist " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Sub
Public Function GetRoomClass(strIdNum As String) As String
'
On Error GoTo GetRoomClass_Err
'
Dim SQL As String
100 SQL = "Select dbo.Fn_GetRoomClass('" & strIdNum & "') As RoomClass"
102 GetRoomClass = ""
104 With Rec
106 If .State > 0 Then .Close
108 .CursorLocation = adUseClient
110 .CursorType = adOpenDynamic
112 .LockType = adLockOptimistic
114 .Open SQL, user.SQLConnection
116 If .RecordCount > 0 Then
118 GetRoomClass = !RoomClass
End If
120 .Close
End With
122 Set Rec = Nothing
'
Exit Function
GetRoomClass_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.GetRoomClass " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Public Function GetAge(strBirthDate As String) As String
'
On Error GoTo GetAge_Err
'
Dim SQL As String
100 SQL = "Select isnull(Patient_data.dbo.Fn_GetAge('" & strBirthDate & "','" & Format(Now, "mm/dd/yyyy") & "'),'') As Age"
102 GetAge = ""
104 With Rec
106 If .State > 0 Then .Close
108 .CursorLocation = adUseClient
110 .CursorType = adOpenDynamic
112 .LockType = adLockOptimistic
114 .Open SQL, user.SQLConnection
116 If .RecordCount > 0 Then
118 GetAge = !Age
End If
120 .Close
End With
122 Set Rec = Nothing
'
Exit Function
GetAge_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.GetAge " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Public Function GetActualOutside(strIdNum As String) As String
'
On Error GoTo GetActualOutside_Err
'
Dim SQL As String
100 SQL = "Select IsNull(ActualOutside,0) ActualOutside From Medicare..tbMedClaim Where IDNum = '" & strIdNum & "'"
102 GetActualOutside = "0"
104 With Rec
106 If .State > 0 Then .Close
108 .CursorLocation = adUseClient
110 .CursorType = adOpenDynamic
112 .LockType = adLockOptimistic
114 .Open SQL, user.SQLConnection
116 If .RecordCount > 0 Then
118 GetActualOutside = Format(!ActualOutside, "#######.00")
End If
120 .Close
End With
122 Set Rec = Nothing
'
Exit Function
GetActualOutside_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.GetActualOutside " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Public Function GetReportDescription(strReportID As String) As String
'
On Error GoTo GetReportDescription_Err
'
Dim SQL As String
100 SQL = "Select IsNull(Name,0) Name, IsNull(Description,0) Description From Medicare..tbReportsDescription Where ReportID = isnull('" & strReportID & "',0)"
102 GetReportDescription = "0"
104 With Rec
106 If .State > 0 Then .Close
108 .CursorLocation = adUseClient
110 .CursorType = adOpenDynamic
112 .LockType = adLockOptimistic
114 .Open SQL, user.SQLConnection
116 If .RecordCount > 0 Then
118 GetReportDescription = !Description & "-" & !Name
End If
120 .Close
End With
122 Set Rec = Nothing
'
Exit Function
GetReportDescription_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.GetReportDescription " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Private Function GetPatientDays(strIdNum As String) As Integer
'
On Error GoTo GetPatientDays_Err
'
Dim SQL As String
100 GetPatientDays = 0
102 SQL = "Select IsNull(PatientDays,0) PatientDays From Medicare..tbMedPatient Where IDNum = '" & Trim$(strIdNum) & "'"
104 With Rec
106 If .State > 0 Then .Close
108 .CursorLocation = adUseClient
110 .CursorType = adOpenDynamic
112 .LockType = adLockOptimistic
114 .Open SQL, user.SQLConnection
116 If .RecordCount > 0 Then
118 GetPatientDays = !PatientDays
End If
End With
120 Set Rec = Nothing
'
Exit Function
GetPatientDays_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.GetPatientDays " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Public Function GetButtonStatus(btnID As String) As Boolean
'
On Error GoTo GetButtonStatus_Err
'
Dim SQL As String
100 GetButtonStatus = 0
102 SQL = "Select * from Medicare..tbMedUserSetting where EmployeeID = '" & Trim$(user.EmployeeCode) & "' and menuid = '" & btnID & "' and status = 1 "
104 With Rec
106 If .State > 0 Then .Close
108 .CursorLocation = adUseClient
110 .CursorType = adOpenDynamic
112 .LockType = adLockOptimistic
114 .Open SQL, user.SQLConnection
116 If .RecordCount > 0 Then
118 GetButtonStatus = 1
End If
End With
120 Set Rec = Nothing
'
Exit Function
GetButtonStatus_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.GetButtonStatus " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Public Function isHemo(strIdNum As String) As Boolean
'
On Error GoTo isHemo_Err
'
Dim SQL As String
100 SQL = "Select * From Patient_data..tboutpatient Where IDNum = '" & strIdNum & "' and isnull(HemoNum,'') <> ''"
102 With recMember
104 If .State > 0 Then .Close
106 .CursorLocation = adUseClient
108 .Open SQL, user.SQLConnection, adOpenDynamic, adLockReadOnly
110 If .RecordCount > 0 Then
112 isHemo = True
Else
114 isHemo = False
End If
116 .Close
End With
118 Set recMember = Nothing
'
Exit Function
isHemo_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.isHemo " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Public Function isER(strIdNum As String) As String
'
On Error GoTo isER_Err
'
Dim SQL As String
100 SQL = "Select * From Patient_data..tboutpatient Where IDNum = '" & strIdNum & "' and isnull(ERNum,'') <> ''"
102 With recMember
104 If .State > 0 Then .Close
106 .CursorLocation = adUseClient
108 .Open SQL, user.SQLConnection, adOpenDynamic, adLockReadOnly
110 If .RecordCount > 0 Then
112 isER = "W/ ER"
Else
114 isER = ""
End If
116 .Close
End With
118 Set recMember = Nothing
'
Exit Function
isER_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.isER " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Public Function GetSession(strIdNum As String) As String
'
On Error GoTo GetSession_Err
'
Dim SQL As String
100 SQL = " SELECT sum(tbinvstockcard.quantity) Quantity FROM Inventory..TBINVSTOCKCARD tbinvstockcard LEFT OUTER JOIN BUILD_FILE..tbcoRevenueCode tbcoRevenueCode" & _
" on tbInvStockCard.LocationID = tbcoRevenueCode.LocationID WHERE TBINVSTOCKCARD.IDNUM= '" & strIdNum & _
"' and tbinvstockcard.packageid is null and isnull(tbInvStockCard.Status,'') = '' and left(tbInvStockCard.RefNum, 2) not in ('OR', 'AS', 'CC', 'AC')" & _
" and (case when isnull(TBINVSTOCKCARD.LocationID, '') = '' then TBINVSTOCKCARD.RevenueID else TBcoRevenueCode.RevenueID end) = 'KS'"
102 With recMember
104 If .State > 0 Then .Close
106 .CursorLocation = adUseClient
108 .Open SQL, user.SQLConnection, adOpenDynamic, adLockReadOnly
110 If .RecordCount > 0 Then
112 GetSession = "(" & !Quantity & " session/s)"
Else
114 GetSession = 0
End If
116 .Close
End With
118 Set recMember = Nothing
'
Exit Function
GetSession_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.GetSession " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Public Function GetBagCount(strIdNum As String) As String
'
On Error GoTo GetBagCount_Err
'
Dim SQL As String
100 If IsNumeric(Right(strIdNum, 1)) = True Then
102 SQL = "select sum(isnull(a.Quantity,0)) Quantity from Billing..tbbilldailybill a left outer join Build_File..tbCoLabExam b on a.ItemID = b.LabExamID where a.RevenueID = 'LB' and idnum = '" & strIdNum & "' and b.MedicareType = '2'"
Else
104 SQL = "select sum(isnull(a.Quantity,0)) Quantity from Billing..tbbillopdailyout a left outer join Build_File..tbCoLabExam b on a.ItemID = b.LabExamID where a.RevenueID = 'LB' and idnum = '" & strIdNum & "' and b.MedicareType = '2'"
End If
106 With recMember
108 If .State > 0 Then .Close
110 .CursorLocation = adUseClient
112 .Open SQL, user.SQLConnection, adOpenDynamic, adLockReadOnly
114 If .RecordCount > 0 Then
116 GetBagCount = "(" & !Quantity & " bag/s)"
Else
118 GetBagCount = 0
End If
120 .Close
End With
122 Set recMember = Nothing
'
Exit Function
GetBagCount_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.GetBagCount " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Public Function isEndoscopy(strIdNum As String) As Boolean
'
On Error GoTo isEndoscopy_Err
'
Dim SQL As String
100 isEndoscopy = False
102 If IsNumeric(Right(strIdNum, 1)) Then
104 SQL = "select * from Billing..tbbilldailybill where RevenueID in ('EA', 'EC') and IDNum = '" & strIdNum & "'"
Else
106 SQL = "select * from Billing..tbBillOPDailyOut where RevenueID in ('EA', 'EC') and IDNum = '" & strIdNum & "'"
End If
108 With recMember
110 If .State > 0 Then .Close
112 .CursorLocation = adUseClient
114 .Open SQL, user.SQLConnection, adOpenDynamic, adLockReadOnly
116 If .RecordCount > 0 Then
118 isEndoscopy = True
End If
120 .Close
End With
122 Set recMember = Nothing
'
Exit Function
isEndoscopy_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.isEndoscopy " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
'Public Function PurchaseDate(strIdNum As String) As String
' With Rec
' If .State > 0 Then .Close
' .CursorLocation = adUseClient
' .Open "Medicare..MedicRep_Waiver '" + Trim$(strIdNum) + "','CA'", user.SQLConnection, adOpenDynamic, adLockReadOnly
' If .RecordCount > 0 Then
' PurchaseDate = Format(!Confinement, "mm/dd/yyyy")
' End If
'
' If .State > 0 Then .Close
' Set Rec = Nothing
' End With
'End Function
Public Function GetMedicareCategory(strIdNum As String) As String
'
On Error GoTo GetMedicareCategory_Err
'
Dim RecSQL As New ADODB.Recordset
Dim strSQL As String
100 GetMedicareCategory = ""
102 strSQL = "Medicare.dbo.Medic_GetMedicareCategory '" & strIdNum & "'"
104 With RecSQL
106 If .State > 0 Then .Close
108 .CursorLocation = adUseClient
110 .Open strSQL, user.SQLConnection, adOpenDynamic, adLockOptimistic
112 If .RecordCount > 0 Then
114 GetMedicareCategory = !Category & ""
End If
116 If .State > 0 Then .Close
End With
'
Exit Function
GetMedicareCategory_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.GetMedicareCategory " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Public Function HasBC(strIdNum As String) As String
'
On Error GoTo HasBC_Err
'
Dim SQL As String
100 SQL = "Select idnum From Billing..tbbilldailybill Where IDNum = '" & strIdNum & "' and itemid IN ('1938', '1939', '1937', '1936', '1935', '228','229','230', '234','235') and revenueid = 'LB'" & _
"UNION ALL Select idnum From Billing..tbbillopdailyout Where IDNum = '" & strIdNum & "' and itemid IN ('1938', '1939', '1937', '1936', '1935', '228','229','230', '234','235') and revenueid = 'LB'"
102 With recMember
104 If .State > 0 Then .Close
106 .CursorLocation = adUseClient
108 .Open SQL, user.SQLConnection, adOpenDynamic, adLockReadOnly
110 If .RecordCount > 0 Then
112 HasBC = "BLOOD COMPONENT"
Else
114 HasBC = ""
End If
116 .Close
End With
118 Set recMember = Nothing
'
Exit Function
HasBC_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.HasBC " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Public Function DeletePreviousComputations(strIdNum As String, strtype As String)
'
On Error GoTo DeletePreviousComputations_Err
'
100 If strtype = "2" Then
102 MsgBox "Previous computation is greater than the amount of this package. It will be automatically deleted. ", vbInformation, "MESSAGE"
End If
104 user.SQLConnection.Execute "delete from medicare..tbmedsoa where idnum = '" & _
strIdNum & "'"
'
Exit Function
DeletePreviousComputations_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.DeletePreviousComputations " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Public Function GetOPDIdNum(strIdNum As String)
'
On Error GoTo GetOPDIdNum_Err
'
Dim Rec As New ADODB.Recordset
Dim SQL As String
100 GetOPDIdNum = ""
102 SQL = "Select isnull(OPDIdNum,'') as OPDIdNum from Patient_Data..tbPatient where IDNum = '" & strIdNum & "'"
104 With Rec
106 If .State > 0 Then .Close
108 .CursorLocation = adUseClient
110 .Open SQL, user.SQLConnection, adOpenDynamic, adLockReadOnly
112 If .RecordCount > 0 Then
114 GetOPDIdNum = !OPDIdNum
End If
116 .Close
End With
118 Set Rec = Nothing
'
Exit Function
GetOPDIdNum_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.GetOPDIdNum " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Public Function CheckifAlreadyComputedOutPatient(strIdNum As String) As Boolean
'
On Error GoTo CheckifAlreadyComputedOutPatient_Err
'
Dim Rec As New ADODB.Recordset
Dim SQL As String
100 CheckifAlreadyComputedOutPatient = False
102 SQL = "select IdNum from Medicare..tbMedActual where IDNum = '" & strIdNum & "'"
104 With Rec
106 If .State > 0 Then .Close
108 .CursorLocation = adUseClient
110 .Open SQL, user.SQLConnection, adOpenDynamic, adLockReadOnly
112 If .RecordCount > 0 Then
114 CheckifAlreadyComputedOutPatient = True
End If
116 .Close
End With
118 Set Rec = Nothing
'
Exit Function
CheckifAlreadyComputedOutPatient_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.CheckifAlreadyComputedOutPatient " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
'dxAnge
Public Function countDiag(strIdNum As String) As String
'
On Error GoTo countDiag_Err
'
Dim recX As New ADODB.Recordset
Dim SQL As String
100 SQL = "SELECT COUNT(DiagID) [Total] from Medicare..tbMedDiagnosis Where IDNum = '" & strIdNum & "'"
102 With recX
104 If .State > 0 Then .Close
106 .CursorLocation = adUseClient
108 .Open SQL, user.SQLConnection, adOpenDynamic, adLockReadOnly
110 countDiag = "1"
112 If .RecordCount > 0 Then
114 If !Total > 4 And !Total < 9 Then
116 countDiag = "2"
118 ElseIf !Total > 8 And !Total < 13 Then
120 countDiag = "3"
122 ElseIf !Total > 12 And !Total < 17 Then
124 countDiag = "4"
126 ElseIf !Total > 16 And !Total < 21 Then
128 countDiag = "5"
130 ElseIf !Total > 20 And !Total < 25 Then
132 countDiag = "6"
End If
End If
134 .Close
End With
136 Set recX = Nothing
'
Exit Function
countDiag_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.countDiag " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Public Function countDoctor(strIdNum As String) As String
'
On Error GoTo countDoctor_Err
'
Dim recX As New ADODB.Recordset
Dim SQL As String
100 SQL = "SELECT isnull(COUNT(DocType),1) [Total] from Medicare..tbMedDoctors Where IDNum = '" & strIdNum & "' and doctype = 'P'"
102 With recX
104 If .State > 0 Then .Close
106 .CursorLocation = adUseClient
108 .Open SQL, user.SQLConnection, adOpenDynamic, adLockReadOnly
110 If .RecordCount > 0 Then
112 countDoctor = !Total
End If
114 .Close
End With
116 Set recX = Nothing
'
Exit Function
countDoctor_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.countDoctor " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Public Function countAllDoctor(strIdNum As String) As String
'
On Error GoTo countAllDoctor_Err
'
Dim recX As New ADODB.Recordset
Dim SQL As String
100 SQL = "SELECT count(doccode) [Total] from Medicare..tbMedDoctors Where IDNum = '" & strIdNum & "'"
102 With recX
104 If .State > 0 Then .Close
106 .CursorLocation = adUseClient
108 .Open SQL, user.SQLConnection, adOpenDynamic, adLockReadOnly
110 If .RecordCount > 0 Then
112 countAllDoctor = !Total
End If
114 .Close
End With
116 Set recX = Nothing
'
Exit Function
countAllDoctor_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.countAllDoctor " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Public Function countDiagSave(strIdNum As String) As String
'
On Error GoTo countDiagSave_Err
'
Dim recX As New ADODB.Recordset
Dim SQL As String
100 SQL = "SELECT COUNT(DiagID) [Total] from Medicare..tbMedDiagnosis Where IDNum = '" & strIdNum & "'"
102 With recX
104 If .State > 0 Then .Close
106 .CursorLocation = adUseClient
108 .Open SQL, user.SQLConnection, adOpenDynamic, adLockReadOnly
110 countDiagSave = "0"
112 If .RecordCount > 0 Then
114 countDiagSave = !Total
End If
116 .Close
End With
118 Set recX = Nothing
'
Exit Function
countDiagSave_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.countDiagSave " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Public Property Get PurchaseDate() As String
'
On Error GoTo PurchaseDate_Err
'
100 PurchaseDate = mvarPurchaseDate
'
Exit Property
PurchaseDate_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.PurchaseDate " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Property
Public Property Let PurchaseDate(ByVal vNewValue As String)
'
On Error GoTo PurchaseDate_Err
'
100 mvarPurchaseDate = vNewValue
'
Exit Property
PurchaseDate_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.PurchaseDate " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Property
Public Property Get PayService() As String
'
On Error GoTo PayService_Err
'
100 PayService = mvarPayService
'
Exit Property
PayService_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.PayService " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Property
Public Property Let PayService(ByVal vNewValue As String)
'
On Error GoTo PayService_Err
'
100 mvarPayService = vNewValue
'
Exit Property
PayService_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.PayService " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Property
Public Property Get DocChief() As String
'
On Error GoTo DocChief_Err
'
100 DocChief = mvarDocChief
'
Exit Property
DocChief_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.DocChief " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Property
Public Property Let DocChief(ByVal vNewValue As String)
'
On Error GoTo DocChief_Err
'
100 mvarDocChief = vNewValue
'
Exit Property
DocChief_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.DocChief " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Property
'added by ange 8.12.2016 allow caserate as first and Second
Public Function isAllowSecondCase(strPackageID As String) As Boolean
'
On Error GoTo isAllowSecondCase_Err
'
Dim RecSQL As New ADODB.Recordset
Dim strSQL As String
100 strSQL = "Select isnull(isAllowSecondCR, '') [isAllowSecondCR] from Medicare..tbMedPackage where packageid = '" & strPackageID & "'"
102 isAllowSecondCase = False
104 With RecSQL
106 If .State > 0 Then .Close
108 .CursorLocation = adUseClient
110 .Open strSQL, user.SQLConnection, adOpenDynamic, adLockReadOnly
112 If .RecordCount > 0 Then
114 isAllowSecondCase = !isAllowSecondCR
End If
116 If .State > 0 Then .Close
End With
'
Exit Function
isAllowSecondCase_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.isAllowSecondCase " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Public Function LoadSwitchValue(strIDKey As String) As Boolean
'
On Error GoTo LoadSwitchValue_Err
'
Dim recX As New ADODB.Recordset
100 LoadSwitchValue = False
102 If recX.State > 0 Then recX.Close
104 recX.CursorLocation = adUseClient
106 recX.Open "Select isnull(KeyValue,0) KeyValue from Medicare..tbMedSwitch Where IDKey = '" & strIDKey & "'", user.SQLConnection, adOpenDynamic, adLockReadOnly
108 If recX.RecordCount > 0 Then
110 LoadSwitchValue = recX!KeyValue
Else
112 LoadSwitchValue = False
End If
114 If recX.State > 0 Then recX.Close
116 Set recX = Nothing
'
Exit Function
LoadSwitchValue_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.LoadSwitchValue " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Public Sub UserLogs(strUserID As String, strRemarks As String, strIdNum As String)
'user.SQLConnection.Execute "Insert into Medicare..tbMedLogs values('" & strUserID & "', '" & strRemarks & "', getDate())"
'
On Error GoTo UserLogs_Err
'
100 user.SQLConnection.Execute "Insert into Medicare..tbMedLogs(userid, remarks,loginperiod, IDNum) values('" & strUserID & "', '" & strRemarks & "', getDate(), '" & strIdNum & "')"
'
Exit Sub
UserLogs_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.UserLogs " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Sub
Public Function Load_ModSettings_Value(strModSet_ID As String) As Boolean
'
On Error GoTo Load_ModSettings_Value_Err
'
Dim recX As New ADODB.Recordset
100 Load_ModSettings_Value = False
102 If recX.State > 0 Then recX.Close
104 recX.CursorLocation = adUseClient
106 recX.Open "Select isnull(ModSet_Status,0) ModSet_Status from Medicare..tbMed_ModuleSettings Where ModSet_ID = '" & strModSet_ID & "'", user.SQLConnection, adOpenDynamic, adLockReadOnly
108 If recX.RecordCount > 0 Then
110 Load_ModSettings_Value = recX!ModSet_Status
Else
112 Load_ModSettings_Value = False
End If
114 If recX.State > 0 Then recX.Close
116 Set recX = Nothing
'
Exit Function
Load_ModSettings_Value_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.Load_ModSettings_Value " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Function
Public Sub TransmittalLogs(strUserID As String, strRemarks As String, strIdNum As String)
'
On Error GoTo TransmittalLogs_Err
'
100 user.SQLConnection.Execute "Insert into Medicare..tbMedTransmittalLogs(userid, remarks,transdate, IDNum, Mod_Version) values('" & strUserID & "', '" & strRemarks & "', getDate(), '" & strIdNum & "', '" & App.Major & "." & App.Minor & "." & App.Revision & "')"
'
Exit Sub
TransmittalLogs_Err:
MsgBox Err.Description & vbCrLf & _
"in prjMedicare.modTemp.TransmittalLogs " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'
End Sub