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 Public puser As Object '' '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 'khing 6.24.14 Public pubReports As String Public pubSubReports As String '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 clsObstetrician As New clsObstetrician Public clsPediatrician As New clsPediatrician 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 region 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 PubBenefitsImplementationDate As Date Public blnAllowSeparatePart45 As Boolean Public blnAllowEditPatientDays As Boolean Public blnAllowPart23Signatory As Boolean Public blnPart34onEntry As Boolean '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 'Transmittal Per User Public blnTransmittalPerUser 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 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 strDx21 As String Public strDx22 As String Public strDx23 As String Public strDx24 As String Public strDx25 As String Public strDx26 As String Public strDx27 As String Public strDx28 As String Public strDx29 As String Public strDx30 As String Public strDx31 As String Public strDx32 As String Public strDx33 As String Public strDx34 As String Public strDx35 As String Public strDx36 As String Public strDx37 As String Public strDx38 As String Public strDx39 As String Public strDx40 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 strICD21 As String Public strICD22 As String Public strICD23 As String Public strICD24 As String Public strICD25 As String Public strICD26 As String Public strICD27 As String Public strICD28 As String Public strICD29 As String Public strICD30 As String Public strICD31 As String Public strICD32 As String Public strICD33 As String Public strICD34 As String Public strICD35 As String Public strICD36 As String Public strICD37 As String Public strICD38 As String Public strICD39 As String Public strICD40 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 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 strRVSCode21 As String Public strRVSCode22 As String Public strRVSCode23 As String Public strRVSCode24 As String Public strRVSCode25 As String Public strRVSCode26 As String Public strRVSCode27 As String Public strRVSCode28 As String Public strRVSCode29 As String Public strRVSCode30 As String Public strRVSCode31 As String Public strRVSCode32 As String Public strRVSCode33 As String Public strRVSCode34 As String Public strRVSCode35 As String Public strRVSCode36 As String Public strRVSCode37 As String Public strRVSCode38 As String Public strRVSCode39 As String Public strRVSCode40 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 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 strLaterality21 As String Public strLaterality22 As String Public strLaterality23 As String Public strLaterality24 As String Public strLaterality25 As String Public strLaterality26 As String Public strLaterality27 As String Public strLaterality28 As String Public strLaterality29 As String Public strLaterality30 As String Public strLaterality31 As String Public strLaterality32 As String Public strLaterality33 As String Public strLaterality34 As String Public strLaterality35 As String Public strLaterality36 As String Public strLaterality37 As String Public strLaterality38 As String Public strLaterality39 As String Public strLaterality40 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 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 strRelatedProcedure21 As String Public strRelatedProcedure22 As String Public strRelatedProcedure23 As String Public strRelatedProcedure24 As String Public strRelatedProcedure25 As String Public strRelatedProcedure26 As String Public strRelatedProcedure27 As String Public strRelatedProcedure28 As String Public strRelatedProcedure29 As String Public strRelatedProcedure30 As String Public strRelatedProcedure31 As String Public strRelatedProcedure32 As String Public strRelatedProcedure33 As String Public strRelatedProcedure34 As String Public strRelatedProcedure35 As String Public strRelatedProcedure36 As String Public strRelatedProcedure37 As String Public strRelatedProcedure38 As String Public strRelatedProcedure39 As String Public strRelatedProcedure40 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 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 strICDRVS21 As String Public strICDRVS22 As String Public strICDRVS23 As String Public strICDRVS24 As String Public strICDRVS25 As String Public strICDRVS26 As String Public strICDRVS27 As String Public strICDRVS28 As String Public strICDRVS29 As String Public strICDRVS30 As String Public strICDRVS31 As String Public strICDRVS32 As String Public strICDRVS33 As String Public strICDRVS34 As String Public strICDRVS35 As String Public strICDRVS36 As String Public strICDRVS37 As String Public strICDRVS38 As String Public strICDRVS39 As String Public strICDRVS40 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 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 strDateOfOperation21 As String Public strDateOfOperation22 As String Public strDateOfOperation23 As String Public strDateOfOperation24 As String Public strDateOfOperation25 As String Public strDateOfOperation26 As String Public strDateOfOperation27 As String Public strDateOfOperation28 As String Public strDateOfOperation29 As String Public strDateOfOperation30 As String Public strDateOfOperation31 As String Public strDateOfOperation32 As String Public strDateOfOperation33 As String Public strDateOfOperation34 As String Public strDateOfOperation35 As String Public strDateOfOperation36 As String Public strDateOfOperation37 As String Public strDateOfOperation38 As String Public strDateOfOperation39 As String Public strDateOfOperation40 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 ***' '*** Declaration of Employee ***' Public strEmployeeName As String Public strEmployeeCode As String '*** END ***' '*** 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 Public strCase As Integer Public dblCountDoctor As Double Public blnCheckDocExpiry As Boolean Public blnEnable24HoursConfinementRule As Boolean Public lngConfinementHours As Long Public blnCF4ExemptCode As Boolean Public Report As CRAXDRT.Report Public Enum DOCTOR_PF ACTUAL_PF = 1 MEDICARE_PF = 2 FirstCase_PF = 3 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 user.PasswordDeptCode = "8" 114 user.ShowMain 116 DoEvents 118 blnOnLine = False 120 If user.Connected Then ' ' With user.MEDSYSClasses ' .exepath = App.Path ' .OpenMainReport "Report1.rpt", "", "" ' End With ' ' Exit Sub ' ' '' '' ' With user.MEDSYSClasses ' .exepath = App.Path ' .AutoParameter = True ' .AutoParameterVer = 1 ' .ParamClear ' .ParamAdd "@IDNUm", "97" ' .ParamAdd "@UserID", "8" ' .OpenMainReport "ClaimForm4Page1.rpt", "", "" ' End With ' ' Exit Sub ' 122 pclsCodeSearch.SearchMode = True 124 pclsCodeSearch.Initialize_Classes 126 pclsCodeSearch.Connection = user.SQLConnection 128 user.MEDSYSClasses.UseClasses = True 130 user.MEDSYSClasses.InitWithDB 132 MEDSYSClass.MedsysUser = user ' MEDSYSClass.EXEPath = App.Path ' PCLSUser.SetExePath = App.Path 134 user.MEDSYSClasses.EXEPath = App.Path 136 frmSplash.Show 138 frmSplash.Refresh 140 user.SQLConnection.DefaultDatabase = "Medicare" 142 user.SQLConnection.CommandTimeout = 120 144 If ConnectAll Then ' ' blnOnLine = True 146 If recX.State > 0 Then recX.Close 148 recX.CursorLocation = adUseClient 150 recX.Open "Select IsNull(PCF,0) [PCF] from Medicare..tbMedHospital", user.SQLConnection, adOpenDynamic, adLockReadOnly 152 If recX.RecordCount > 0 Then 154 PublicPCF = Format(recX![PCF], "#########0.00") End If 156 GetHospitalCode 158 GetAdministrator 160 GetServerDate 162 HospitalInfo 164 GetUserVerSettings 166 ActivatePhase 168 GetRegion 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 188 pubReports = App.Path + "\REPORTS" 190 pubSubReports = App.Path + "\REPORTS\" + ClientName ' If blnOnLine Then ' ' Else ' End If 192 If recX.State > 0 Then recX.Close 194 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 ' If .Condition = "E" Then ' Form2Report.ParameterFields(F_DATE_OF_DEATH).AddCurrentValue Format(.DischargedDate, "mm/dd/yyyy") ' Else ' Form2Report.ParameterFields(F_DATE_OF_DEATH).AddCurrentValue "n/a" ' End If 176 If blnCashMeds Then 178 blnIsCashMeds = IsCashMeds(stridnum) End If 180 If ClientName = "LMC" Then 182 If IsNumeric(Right(stridnum, 1)) Then 184 If blnAllowEditPatientDays Then 186 intPatientDays = GetPatientDays(stridnum) 188 If intPatientDays > 0 Then 190 Form2Report.ParameterFields(F_CLAIMED_DAYS).AddCurrentValue Trim$(STR(intPatientDays)) Else 192 Form2Report.ParameterFields(F_CLAIMED_DAYS).AddCurrentValue Format(DateDiff("d", .AdmissionDate, .DischargedDate), "#####") End If Else 194 Form2Report.ParameterFields(F_CLAIMED_DAYS).AddCurrentValue Format(DateDiff("d", .AdmissionDate, .DischargedDate), "#####") End If Else 196 Form2Report.ParameterFields(F_CLAIMED_DAYS).AddCurrentValue "0" End If Else 198 If blnAllowEditPatientDays Then 200 intPatientDays = GetPatientDays(stridnum) 202 If intPatientDays > 0 Then 204 Form2Report.ParameterFields(F_CLAIMED_DAYS).AddCurrentValue Trim$(STR(intPatientDays)) Else 206 Form2Report.ParameterFields(F_CLAIMED_DAYS).AddCurrentValue Format(DateDiff("d", .AdmissionDate, .DischargedDate), "#####") End If Else 208 Form2Report.ParameterFields(F_CLAIMED_DAYS).AddCurrentValue Format(DateDiff("d", .AdmissionDate, .DischargedDate), "#####") End If End If 210 With Rec 212 If .State > 0 Then .Close 214 .CursorLocation = adUseClient 216 .CursorType = adOpenDynamic 218 .LockType = adLockOptimistic 220 .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 222 If .RecordCount > 0 Then 224 dblClaimRB = !ActualRoomBoard 226 dblClaimDrugs = !ActualDrug 228 dblClaimOthers = !ActualOthers 230 dblClaimOR = !ActualOR 232 dblClaimOutside = !ActualOutside End If End With 234 Set Rec = Nothing ' If ClientName <> "NKTI" Then 236 Form2Report.ParameterFields(F_ACTUAL_RB).AddCurrentValue Format(.Charges.Claim.ActualRoomAndBoard, "###,###,##0.00") 238 Form2Report.ParameterFields(F_ACTUAL_MEDS).AddCurrentValue Format(.Charges.Claim.ActualDrugs, "###,###,##0.00") 240 Form2Report.ParameterFields(F_ACTUAL_OTHERS).AddCurrentValue Format(.Charges.Claim.ActualOthers, "###,###,##0.00") 242 Form2Report.ParameterFields(F_ACTUAL_OR).AddCurrentValue Format(.Charges.Claim.ActualOR, "###,###,##0.00") 244 Form2Report.ParameterFields(F_ACTUAL_ETC).AddCurrentValue Format(.Charges.Claim.ActualOutsideCharges, "###,###,##0.00") 246 If isMaternityPackage And ClientName = "BOLMSH" Then 248 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 250 If blnIsCashMeds And ClientName = "DDH" And strAdmDate >= PubFormsImplementationDate Then 252 Form2Report.ParameterFields(F_TOTALACTUAL).AddCurrentValue Format((.Charges.Claim.ActualRoomAndBoard + _ .Charges.Claim.ActualDrugs + _ .Charges.Claim.ActualOthers + _ .Charges.Claim.ActualOR), "##,###,##0.00") Else 'jeremy 254 If ClientName = "MJSH" Or ClientName = "BIHMI" Then 256 If GetIsBenefits(stridnum) = True Then 258 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 260 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 262 ElseIf ClientName = "MGH" Then 264 If GetIsBenefits(stridnum) = True Then 266 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 268 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 270 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 ' 272 Form2Report.ParameterFields(F_MED_RB).AddCurrentValue Format(.Charges.Claim.MedicareRoomAndBoard, "##,###,##0.00") 274 Form2Report.ParameterFields(F_MED_MEDS).AddCurrentValue Format(.Charges.Claim.MedicareDrugs, "##,###,##0.00") 276 Form2Report.ParameterFields(F_MED_OTHERS).AddCurrentValue Format(.Charges.Claim.MedicareOthers, "##,###,##0.00") 278 Form2Report.ParameterFields(F_MED_OR).AddCurrentValue Format(.Charges.Claim.MedicareOR, "##,###,##0.00") 280 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 282 If GetIsBenefits(stridnum) = True Then 284 SearchPackageID GetPackageType(stridnum) 286 Form2Report.ParameterFields(F_TOTALMED).AddCurrentValue Format(dblAmountPackage, "##,###,##0.00") Else 288 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 290 If ClientName <> "MJSH" Then 292 Form2Report.ParameterFields(F_PAT_RB).AddCurrentValue Format(.Charges.Claim.PatientRoomAndBoard, "##,###,##0.00") 294 Form2Report.ParameterFields(F_PAT_MEDS).AddCurrentValue Format(.Charges.Claim.PatientDrugs, "##,###,##0.00") 296 Form2Report.ParameterFields(F_PAT_OTHERS).AddCurrentValue Format(.Charges.Claim.PatientOthers, "##,###,##0.00") 298 Form2Report.ParameterFields(F_PAT_OR).AddCurrentValue Format(.Charges.Claim.PatientOR, "##,###,##0.00") 300 Form2Report.ParameterFields(F_PAT_ETC).AddCurrentValue Format(.Charges.Claim.PatientOutsideCharges, "##,###,##0.00") 302 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 304 dblCashMed = Format((.Charges.Claim.PatientRoomAndBoard + _ .Charges.Claim.PatientDrugs + _ .Charges.Claim.PatientOthers + _ .Charges.Claim.PatientOR + _ .Charges.Claim.PatientOutsideCharges), "##,###,##0.00") 306 If blnAllowSignatoryUserAccount Then 308 Form2Report.ParameterFields(F_REPRESENTATIVE).AddCurrentValue user.EmployeeName Else 310 Form2Report.ParameterFields(F_REPRESENTATIVE).AddCurrentValue .Signatory.SignatoryName End If 312 Form2Report.ParameterFields(F_DATE_SIGNED).AddCurrentValue Format(Date, "mm/dd/yyyy") 314 Form2Report.ParameterFields(F_OFFICIAL_CAPACITY).AddCurrentValue .Signatory.OfficialCapacity 316 intDiagCount = .Diagnosis.FinalDiagnosis.count 318 strDx = "" 320 strDx1 = "" 322 strDx2 = "" 324 strDx3 = "" 326 strDx4 = "" 328 strDx5 = "" 330 strICD1 = "" 332 strICD2 = "" 334 strICD3 = "" 336 strICD4 = "" 338 strICD5 = "" 340 strICD6 = "" 342 strICD7 = "" 344 strICD8 = "" 346 strICD9 = "" 348 strICD10 = "" 350 strICD11 = "" 352 strICD12 = "" 354 strICD13 = "" 356 strICD14 = "" 358 strICD15 = "" 360 strICD16 = "" 362 strICD17 = "" 364 strICD18 = "" 366 strICD19 = "" 368 strICD20 = "" 370 strICD21 = "" 372 strICD22 = "" 374 strICD23 = "" 376 strICD24 = "" 378 strICD25 = "" 380 strICD26 = "" 382 strICD27 = "" 384 strICD28 = "" 386 strICD29 = "" 388 strICD30 = "" 390 strICD31 = "" 392 strICD32 = "" 394 strICD33 = "" 396 strICD34 = "" 398 strICD35 = "" 400 strICD36 = "" 402 strICD37 = "" 404 strICD38 = "" 406 strICD39 = "" 408 strICD40 = "" 410 If intDiagCount > 0 Then 412 For intctr = 1 To .Diagnosis.FinalDiagnosis.count 414 strDiag = .Diagnosis.FinalDiagnosis(intctr).DiagText 416 If Len(strDiag) > 0 Then 418 If intctr < .Diagnosis.FinalDiagnosis.count Then 420 strDx = strDx + strDiag Else 422 strDx = strDx + strDiag End If End If 424 Select Case intctr Case 1 426 strDx1 = .Diagnosis.FinalDiagnosis(intctr).DiagText 428 strICD1 = .Diagnosis.FinalDiagnosis(intctr).ICDCode 430 Case 2 432 strDx2 = .Diagnosis.FinalDiagnosis(intctr).DiagText 434 strICD2 = .Diagnosis.FinalDiagnosis(intctr).ICDCode 436 Case 3 438 strDx3 = .Diagnosis.FinalDiagnosis(intctr).DiagText 440 strICD3 = .Diagnosis.FinalDiagnosis(intctr).ICDCode 442 Case 4 444 strDx4 = .Diagnosis.FinalDiagnosis(intctr).DiagText 446 strICD4 = .Diagnosis.FinalDiagnosis(intctr).ICDCode 448 Case 5 450 strDx5 = .Diagnosis.FinalDiagnosis(intctr).DiagText 452 strICD5 = .Diagnosis.FinalDiagnosis(intctr).ICDCode 454 Case 6 456 strDx6 = .Diagnosis.FinalDiagnosis(intctr).DiagText 458 strICD6 = .Diagnosis.FinalDiagnosis(intctr).ICDCode 460 Case 7 462 strDx7 = .Diagnosis.FinalDiagnosis(intctr).DiagText 464 strICD7 = .Diagnosis.FinalDiagnosis(intctr).ICDCode 466 Case 8 468 strDx8 = .Diagnosis.FinalDiagnosis(intctr).DiagText 470 strICD8 = .Diagnosis.FinalDiagnosis(intctr).ICDCode 472 Case 9 474 strDx9 = .Diagnosis.FinalDiagnosis(intctr).DiagText 476 strICD9 = .Diagnosis.FinalDiagnosis(intctr).ICDCode 478 Case 10 480 strDx10 = .Diagnosis.FinalDiagnosis(intctr).DiagText 482 strICD10 = .Diagnosis.FinalDiagnosis(intctr).ICDCode 484 Case 11 486 strDx11 = .Diagnosis.FinalDiagnosis(intctr).DiagText 488 strICD11 = .Diagnosis.FinalDiagnosis(intctr).ICDCode 490 Case 12 492 strDx12 = .Diagnosis.FinalDiagnosis(intctr).DiagText 494 strICD12 = .Diagnosis.FinalDiagnosis(intctr).ICDCode 496 Case 13 498 strDx13 = .Diagnosis.FinalDiagnosis(intctr).DiagText 500 strICD13 = .Diagnosis.FinalDiagnosis(intctr).ICDCode 502 Case 14 504 strDx14 = .Diagnosis.FinalDiagnosis(intctr).DiagText 506 strICD14 = .Diagnosis.FinalDiagnosis(intctr).ICDCode 508 Case 15 510 strDx15 = .Diagnosis.FinalDiagnosis(intctr).DiagText 512 strICD15 = .Diagnosis.FinalDiagnosis(intctr).ICDCode 514 Case 16 516 strDx16 = .Diagnosis.FinalDiagnosis(intctr).DiagText 518 strICD16 = .Diagnosis.FinalDiagnosis(intctr).ICDCode 520 Case 17 522 strDx17 = .Diagnosis.FinalDiagnosis(intctr).DiagText 524 strICD17 = .Diagnosis.FinalDiagnosis(intctr).ICDCode 526 Case 18 528 strDx18 = .Diagnosis.FinalDiagnosis(intctr).DiagText 530 strICD18 = .Diagnosis.FinalDiagnosis(intctr).ICDCode 532 Case 19 534 strDx19 = .Diagnosis.FinalDiagnosis(intctr).DiagText 536 strICD19 = .Diagnosis.FinalDiagnosis(intctr).ICDCode 538 Case 20 540 strDx20 = .Diagnosis.FinalDiagnosis(intctr).DiagText 542 strICD20 = .Diagnosis.FinalDiagnosis(intctr).ICDCode 544 Case 21 546 strDx21 = .Diagnosis.FinalDiagnosis(intctr).DiagText 548 strICD21 = .Diagnosis.FinalDiagnosis(intctr).ICDCode 550 Case 22 552 strDx22 = .Diagnosis.FinalDiagnosis(intctr).DiagText 554 strICD22 = .Diagnosis.FinalDiagnosis(intctr).ICDCode 556 Case 23 558 strDx23 = .Diagnosis.FinalDiagnosis(intctr).DiagText 560 strICD23 = .Diagnosis.FinalDiagnosis(intctr).ICDCode 562 Case 24 564 strDx24 = .Diagnosis.FinalDiagnosis(intctr).DiagText 566 strICD24 = .Diagnosis.FinalDiagnosis(intctr).ICDCode 568 Case 25 570 strDx25 = .Diagnosis.FinalDiagnosis(intctr).DiagText 572 strICD25 = .Diagnosis.FinalDiagnosis(intctr).ICDCode 574 Case 26 576 strDx26 = .Diagnosis.FinalDiagnosis(intctr).DiagText 578 strICD26 = .Diagnosis.FinalDiagnosis(intctr).ICDCode 580 Case 27 582 strDx27 = .Diagnosis.FinalDiagnosis(intctr).DiagText 584 strICD27 = .Diagnosis.FinalDiagnosis(intctr).ICDCode 586 Case 28 588 strDx28 = .Diagnosis.FinalDiagnosis(intctr).DiagText 590 strICD28 = .Diagnosis.FinalDiagnosis(intctr).ICDCode 592 Case 29 594 strDx29 = .Diagnosis.FinalDiagnosis(intctr).DiagText 596 strICD29 = .Diagnosis.FinalDiagnosis(intctr).ICDCode 598 Case 30 600 strDx30 = .Diagnosis.FinalDiagnosis(intctr).DiagText 602 strICD30 = .Diagnosis.FinalDiagnosis(intctr).ICDCode 604 Case 31 606 strDx31 = .Diagnosis.FinalDiagnosis(intctr).DiagText 608 strICD31 = .Diagnosis.FinalDiagnosis(intctr).ICDCode 610 Case 32 612 strDx32 = .Diagnosis.FinalDiagnosis(intctr).DiagText 614 strICD32 = .Diagnosis.FinalDiagnosis(intctr).ICDCode 616 Case 33 618 strDx33 = .Diagnosis.FinalDiagnosis(intctr).DiagText 620 strICD33 = .Diagnosis.FinalDiagnosis(intctr).ICDCode 622 Case 34 624 strDx34 = .Diagnosis.FinalDiagnosis(intctr).DiagText 626 strICD34 = .Diagnosis.FinalDiagnosis(intctr).ICDCode 628 Case 35 630 strDx33 = .Diagnosis.FinalDiagnosis(intctr).DiagText 632 strICD35 = .Diagnosis.FinalDiagnosis(intctr).ICDCode 634 Case 36 636 strDx36 = .Diagnosis.FinalDiagnosis(intctr).DiagText 638 strICD36 = .Diagnosis.FinalDiagnosis(intctr).ICDCode 640 Case 37 642 strDx37 = .Diagnosis.FinalDiagnosis(intctr).DiagText 644 strICD37 = .Diagnosis.FinalDiagnosis(intctr).ICDCode 646 Case 38 648 strDx38 = .Diagnosis.FinalDiagnosis(intctr).DiagText 650 strICD38 = .Diagnosis.FinalDiagnosis(intctr).ICDCode 652 Case 39 654 strDx39 = .Diagnosis.FinalDiagnosis(intctr).DiagText 656 strICD39 = .Diagnosis.FinalDiagnosis(intctr).ICDCode 658 Case 40 660 strDx40 = .Diagnosis.FinalDiagnosis(intctr).DiagText 662 strICD40 = .Diagnosis.FinalDiagnosis(intctr).ICDCode End Select 664 If strAdmDate >= PubACRFormsImplementationDate Then 666 GetDiagnosisLaterality stridnum, .Diagnosis.FinalDiagnosis(intctr).Key, intctr End If 668 Next intctr End If 'by khing 1-2-14 670 If strAdmDate >= PubACRFormsImplementationDate Then 672 GetICDRVS stridnum End If 674 Form2Report.ParameterFields(F_FINAL_DX).AddCurrentValue Left(strDx, 255) 676 If blnWithICD Then 678 Form2Report.ParameterFields(F_DX1).AddCurrentValue Left$(strDx1, 255) 680 Form2Report.ParameterFields(F_DX2).AddCurrentValue Left$(strDx2, 255) 682 Form2Report.ParameterFields(F_DX3).AddCurrentValue Left$(strDx3, 255) 684 Form2Report.ParameterFields(F_DX4).AddCurrentValue Left$(strDx4, 255) 686 Form2Report.ParameterFields(F_DX5).AddCurrentValue Left$(strDx5, 255) 688 Form2Report.ParameterFields(F_ICD1).AddCurrentValue Left$(strICD1, 255) 690 Form2Report.ParameterFields(F_ICD2).AddCurrentValue Left$(strICD2, 255) 692 Form2Report.ParameterFields(F_ICD3).AddCurrentValue Left$(strICD3, 255) 694 Form2Report.ParameterFields(F_ICD4).AddCurrentValue Left$(strICD4, 255) 696 Form2Report.ParameterFields(F_ICD5).AddCurrentValue Left$(strICD5, 255) 698 Form2Report.ParameterFields(F_ICD6).AddCurrentValue Left$(strICD6, 255) 700 Form2Report.ParameterFields(F_ICD7).AddCurrentValue Left$(strICD7, 255) 702 Form2Report.ParameterFields(F_DX6).AddCurrentValue Left$(strDx6, 255) 704 Form2Report.ParameterFields(F_DX7).AddCurrentValue Left$(strDx7, 255) 706 Form2Report.ParameterFields(F_CASETYPE).AddCurrentValue IIf(Len(.CaseType) = 0, "O", .CaseType) 708 If strAdmDate >= PubACRFormsImplementationDate Then 710 Form2Report.ParameterFields(F_DX8).AddCurrentValue Left$(strDx8, 255) 712 Form2Report.ParameterFields(F_DX9).AddCurrentValue Left$(strDx9, 255) 714 Form2Report.ParameterFields(F_ICD8).AddCurrentValue Left$(strICD8, 255) 716 Form2Report.ParameterFields(F_ICD9).AddCurrentValue Left$(strICD9, 255) 718 Form2Report.ParameterFields(F_DX10).AddCurrentValue Left$(strDx10, 255) 720 Form2Report.ParameterFields(F_DX11).AddCurrentValue Left$(strDx11, 255) 722 Form2Report.ParameterFields(F_DX12).AddCurrentValue Left$(strDx12, 255) 724 Form2Report.ParameterFields(F_DX13).AddCurrentValue Left$(strDx13, 255) 726 Form2Report.ParameterFields(F_DX14).AddCurrentValue Left$(strDx14, 255) 728 Form2Report.ParameterFields(F_DX15).AddCurrentValue Left$(strDx15, 255) 730 Form2Report.ParameterFields(F_DX16).AddCurrentValue Left$(strDx16, 255) 732 Form2Report.ParameterFields(F_DX17).AddCurrentValue Left$(strDx17, 255) 734 Form2Report.ParameterFields(F_DX18).AddCurrentValue Left$(strDx18, 255) 736 Form2Report.ParameterFields(F_DX19).AddCurrentValue Left$(strDx19, 255) 738 Form2Report.ParameterFields(F_DX20).AddCurrentValue Left$(strDx20, 255) 740 Form2Report.ParameterFields(F_DX21).AddCurrentValue Left$(strDx21, 255) 742 Form2Report.ParameterFields(F_DX22).AddCurrentValue Left$(strDx22, 255) 744 Form2Report.ParameterFields(F_DX23).AddCurrentValue Left$(strDx23, 255) 746 Form2Report.ParameterFields(F_DX24).AddCurrentValue Left$(strDx24, 255) 748 Form2Report.ParameterFields(F_DX25).AddCurrentValue Left$(strDx25, 255) 750 Form2Report.ParameterFields(F_DX26).AddCurrentValue Left$(strDx26, 255) 752 Form2Report.ParameterFields(F_DX27).AddCurrentValue Left$(strDx27, 255) 754 Form2Report.ParameterFields(F_DX28).AddCurrentValue Left$(strDx28, 255) 756 Form2Report.ParameterFields(F_DX29).AddCurrentValue Left$(strDx29, 255) 758 Form2Report.ParameterFields(F_DX30).AddCurrentValue Left$(strDx30, 255) 760 Form2Report.ParameterFields(F_DX31).AddCurrentValue Left$(strDx31, 255) 762 Form2Report.ParameterFields(F_DX32).AddCurrentValue Left$(strDx32, 255) 764 Form2Report.ParameterFields(F_DX33).AddCurrentValue Left$(strDx33, 255) 766 Form2Report.ParameterFields(F_DX34).AddCurrentValue Left$(strDx34, 255) 768 Form2Report.ParameterFields(F_DX35).AddCurrentValue Left$(strDx35, 255) 770 Form2Report.ParameterFields(F_DX36).AddCurrentValue Left$(strDx36, 255) 772 Form2Report.ParameterFields(F_DX37).AddCurrentValue Left$(strDx37, 255) 774 Form2Report.ParameterFields(F_DX38).AddCurrentValue Left$(strDx38, 255) 776 Form2Report.ParameterFields(F_DX39).AddCurrentValue Left$(strDx39, 255) 778 Form2Report.ParameterFields(F_DX40).AddCurrentValue Left$(strDx40, 255) 780 Form2Report.ParameterFields(F_ICD10).AddCurrentValue Left$(strICD10, 255) 782 Form2Report.ParameterFields(F_ICD11).AddCurrentValue Left$(strICD11, 255) 784 Form2Report.ParameterFields(F_ICD12).AddCurrentValue Left$(strICD12, 255) 786 Form2Report.ParameterFields(F_ICD13).AddCurrentValue Left$(strICD13, 255) 788 Form2Report.ParameterFields(F_ICD14).AddCurrentValue Left$(strICD14, 255) 790 Form2Report.ParameterFields(F_ICD15).AddCurrentValue Left$(strICD15, 255) 792 Form2Report.ParameterFields(F_ICD16).AddCurrentValue Left$(strICD16, 255) 794 Form2Report.ParameterFields(F_ICD17).AddCurrentValue Left$(strICD17, 255) 796 Form2Report.ParameterFields(F_ICD18).AddCurrentValue Left$(strICD18, 255) 798 Form2Report.ParameterFields(F_ICD19).AddCurrentValue Left$(strICD19, 255) 800 Form2Report.ParameterFields(F_ICD20).AddCurrentValue Left$(strICD20, 255) 802 Form2Report.ParameterFields(F_ICD21).AddCurrentValue Left$(strICD21, 255) 804 Form2Report.ParameterFields(F_ICD22).AddCurrentValue Left$(strICD22, 255) 806 Form2Report.ParameterFields(F_ICD23).AddCurrentValue Left$(strICD23, 255) 808 Form2Report.ParameterFields(F_ICD24).AddCurrentValue Left$(strICD24, 255) 810 Form2Report.ParameterFields(F_ICD25).AddCurrentValue Left$(strICD25, 255) 812 Form2Report.ParameterFields(F_ICD26).AddCurrentValue Left$(strICD26, 255) 814 Form2Report.ParameterFields(F_ICD27).AddCurrentValue Left$(strICD27, 255) 816 Form2Report.ParameterFields(F_ICD28).AddCurrentValue Left$(strICD28, 255) 818 Form2Report.ParameterFields(F_ICD29).AddCurrentValue Left$(strICD29, 255) 820 Form2Report.ParameterFields(F_ICD30).AddCurrentValue Left$(strICD30, 255) 822 Form2Report.ParameterFields(F_ICD31).AddCurrentValue Left$(strICD31, 255) 824 Form2Report.ParameterFields(F_ICD32).AddCurrentValue Left$(strICD32, 255) 826 Form2Report.ParameterFields(F_ICD33).AddCurrentValue Left$(strICD33, 255) 828 Form2Report.ParameterFields(F_ICD34).AddCurrentValue Left$(strICD34, 255) 830 Form2Report.ParameterFields(F_ICD35).AddCurrentValue Left$(strICD35, 255) 832 Form2Report.ParameterFields(F_ICD36).AddCurrentValue Left$(strICD36, 255) 834 Form2Report.ParameterFields(F_ICD37).AddCurrentValue Left$(strICD37, 255) 836 Form2Report.ParameterFields(F_ICD38).AddCurrentValue Left$(strICD38, 255) 838 Form2Report.ParameterFields(F_ICD39).AddCurrentValue Left$(strICD39, 255) 840 Form2Report.ParameterFields(F_ICD40).AddCurrentValue Left$(strICD40, 255) 842 Form2Report.ParameterFields(F_Laterality10).AddCurrentValue strLaterality10 844 Form2Report.ParameterFields(F_Laterality11).AddCurrentValue strLaterality11 846 Form2Report.ParameterFields(F_Laterality12).AddCurrentValue strLaterality12 848 Form2Report.ParameterFields(F_Laterality13).AddCurrentValue strLaterality13 850 Form2Report.ParameterFields(F_Laterality14).AddCurrentValue strLaterality14 852 Form2Report.ParameterFields(F_Laterality15).AddCurrentValue strLaterality15 854 Form2Report.ParameterFields(F_Laterality16).AddCurrentValue strLaterality16 856 Form2Report.ParameterFields(F_Laterality17).AddCurrentValue strLaterality17 858 Form2Report.ParameterFields(F_Laterality18).AddCurrentValue strLaterality18 860 Form2Report.ParameterFields(F_Laterality19).AddCurrentValue strLaterality19 862 Form2Report.ParameterFields(F_Laterality20).AddCurrentValue strLaterality20 864 Form2Report.ParameterFields(F_Laterality21).AddCurrentValue strLaterality21 866 Form2Report.ParameterFields(F_Laterality22).AddCurrentValue strLaterality22 868 Form2Report.ParameterFields(F_Laterality23).AddCurrentValue strLaterality23 870 Form2Report.ParameterFields(F_Laterality24).AddCurrentValue strLaterality24 872 Form2Report.ParameterFields(F_Laterality25).AddCurrentValue strLaterality25 874 Form2Report.ParameterFields(F_Laterality26).AddCurrentValue strLaterality26 876 Form2Report.ParameterFields(F_Laterality27).AddCurrentValue strLaterality27 878 Form2Report.ParameterFields(F_Laterality28).AddCurrentValue strLaterality28 880 Form2Report.ParameterFields(F_Laterality29).AddCurrentValue strLaterality29 882 Form2Report.ParameterFields(F_Laterality30).AddCurrentValue strLaterality30 884 Form2Report.ParameterFields(F_Laterality31).AddCurrentValue strLaterality31 886 Form2Report.ParameterFields(F_Laterality32).AddCurrentValue strLaterality32 888 Form2Report.ParameterFields(F_Laterality33).AddCurrentValue strLaterality33 890 Form2Report.ParameterFields(F_Laterality34).AddCurrentValue strLaterality34 892 Form2Report.ParameterFields(F_Laterality35).AddCurrentValue strLaterality35 894 Form2Report.ParameterFields(F_Laterality36).AddCurrentValue strLaterality36 896 Form2Report.ParameterFields(F_Laterality37).AddCurrentValue strLaterality37 898 Form2Report.ParameterFields(F_Laterality38).AddCurrentValue strLaterality38 900 Form2Report.ParameterFields(F_Laterality39).AddCurrentValue strLaterality39 902 Form2Report.ParameterFields(F_Laterality40).AddCurrentValue strLaterality40 904 Form2Report.ParameterFields(F_RelatedProcedure10).AddCurrentValue Left$(strRelatedProcedure10, 255) 906 Form2Report.ParameterFields(F_RelatedProcedure11).AddCurrentValue Left$(strRelatedProcedure11, 255) 908 Form2Report.ParameterFields(F_RelatedProcedure12).AddCurrentValue Left$(strRelatedProcedure12, 255) 910 Form2Report.ParameterFields(F_RelatedProcedure13).AddCurrentValue Left$(strRelatedProcedure13, 255) 912 Form2Report.ParameterFields(F_RelatedProcedure14).AddCurrentValue Left$(strRelatedProcedure14, 255) 914 Form2Report.ParameterFields(F_RelatedProcedure15).AddCurrentValue Left$(strRelatedProcedure15, 255) 916 Form2Report.ParameterFields(F_RelatedProcedure16).AddCurrentValue Left$(strRelatedProcedure16, 255) 918 Form2Report.ParameterFields(F_RelatedProcedure17).AddCurrentValue Left$(strRelatedProcedure17, 255) 920 Form2Report.ParameterFields(F_RelatedProcedure18).AddCurrentValue Left$(strRelatedProcedure18, 255) 922 Form2Report.ParameterFields(F_RelatedProcedure19).AddCurrentValue Left$(strRelatedProcedure19, 255) 924 Form2Report.ParameterFields(F_RelatedProcedure20).AddCurrentValue Left$(strRelatedProcedure20, 255) 926 Form2Report.ParameterFields(F_RelatedProcedure21).AddCurrentValue Left$(strRelatedProcedure21, 255) 928 Form2Report.ParameterFields(F_RelatedProcedure22).AddCurrentValue Left$(strRelatedProcedure22, 255) 930 Form2Report.ParameterFields(F_RelatedProcedure23).AddCurrentValue Left$(strRelatedProcedure23, 255) 932 Form2Report.ParameterFields(F_RelatedProcedure24).AddCurrentValue Left$(strRelatedProcedure24, 255) 934 Form2Report.ParameterFields(F_RelatedProcedure25).AddCurrentValue Left$(strRelatedProcedure25, 255) 936 Form2Report.ParameterFields(F_RelatedProcedure26).AddCurrentValue Left$(strRelatedProcedure26, 255) 938 Form2Report.ParameterFields(F_RelatedProcedure27).AddCurrentValue Left$(strRelatedProcedure27, 255) 940 Form2Report.ParameterFields(F_RelatedProcedure28).AddCurrentValue Left$(strRelatedProcedure28, 255) 942 Form2Report.ParameterFields(F_RelatedProcedure29).AddCurrentValue Left$(strRelatedProcedure29, 255) 944 Form2Report.ParameterFields(F_RelatedProcedure30).AddCurrentValue Left$(strRelatedProcedure30, 255) 946 Form2Report.ParameterFields(F_RelatedProcedure31).AddCurrentValue Left$(strRelatedProcedure31, 255) 948 Form2Report.ParameterFields(F_RelatedProcedure32).AddCurrentValue Left$(strRelatedProcedure32, 255) 950 Form2Report.ParameterFields(F_RelatedProcedure33).AddCurrentValue Left$(strRelatedProcedure33, 255) 952 Form2Report.ParameterFields(F_RelatedProcedure34).AddCurrentValue Left$(strRelatedProcedure34, 255) 954 Form2Report.ParameterFields(F_RelatedProcedure35).AddCurrentValue Left$(strRelatedProcedure35, 255) 956 Form2Report.ParameterFields(F_RelatedProcedure36).AddCurrentValue Left$(strRelatedProcedure36, 255) 958 Form2Report.ParameterFields(F_RelatedProcedure37).AddCurrentValue Left$(strRelatedProcedure37, 255) 960 Form2Report.ParameterFields(F_RelatedProcedure38).AddCurrentValue Left$(strRelatedProcedure38, 255) 962 Form2Report.ParameterFields(F_RelatedProcedure39).AddCurrentValue Left$(strRelatedProcedure39, 255) 964 Form2Report.ParameterFields(F_RelatedProcedure40).AddCurrentValue Left$(strRelatedProcedure40, 255) 966 Form2Report.ParameterFields(F_DateOfOperation10).AddCurrentValue Left$(strDateOfOperation10, 255) 968 Form2Report.ParameterFields(F_DateOfOperation11).AddCurrentValue Left$(strDateOfOperation11, 255) 970 Form2Report.ParameterFields(F_DateOfOperation12).AddCurrentValue Left$(strDateOfOperation12, 255) 972 Form2Report.ParameterFields(F_DateOfOperation13).AddCurrentValue Left$(strDateOfOperation13, 255) 974 Form2Report.ParameterFields(F_DateOfOperation14).AddCurrentValue Left$(strDateOfOperation14, 255) 976 Form2Report.ParameterFields(F_DateOfOperation15).AddCurrentValue Left$(strDateOfOperation15, 255) 978 Form2Report.ParameterFields(F_DateOfOperation16).AddCurrentValue Left$(strDateOfOperation16, 255) 980 Form2Report.ParameterFields(F_DateOfOperation17).AddCurrentValue Left$(strDateOfOperation17, 255) 982 Form2Report.ParameterFields(F_DateOfOperation18).AddCurrentValue Left$(strDateOfOperation18, 255) 984 Form2Report.ParameterFields(F_DateOfOperation19).AddCurrentValue Left$(strDateOfOperation19, 255) 986 Form2Report.ParameterFields(F_DateOfOperation20).AddCurrentValue Left$(strDateOfOperation20, 255) 988 Form2Report.ParameterFields(F_DateOfOperation21).AddCurrentValue Left$(strDateOfOperation21, 255) 990 Form2Report.ParameterFields(F_DateOfOperation22).AddCurrentValue Left$(strDateOfOperation22, 255) 992 Form2Report.ParameterFields(F_DateOfOperation23).AddCurrentValue Left$(strDateOfOperation23, 255) 994 Form2Report.ParameterFields(F_DateOfOperation24).AddCurrentValue Left$(strDateOfOperation24, 255) 996 Form2Report.ParameterFields(F_DateOfOperation25).AddCurrentValue Left$(strDateOfOperation25, 255) 998 Form2Report.ParameterFields(F_DateOfOperation26).AddCurrentValue Left$(strDateOfOperation26, 255) 1000 Form2Report.ParameterFields(F_DateOfOperation27).AddCurrentValue Left$(strDateOfOperation27, 255) 1002 Form2Report.ParameterFields(F_DateOfOperation28).AddCurrentValue Left$(strDateOfOperation28, 255) 1004 Form2Report.ParameterFields(F_DateOfOperation29).AddCurrentValue Left$(strDateOfOperation29, 255) 1006 Form2Report.ParameterFields(F_DateOfOperation30).AddCurrentValue Left$(strDateOfOperation30, 255) 1008 Form2Report.ParameterFields(F_DateOfOperation31).AddCurrentValue Left$(strDateOfOperation31, 255) 1010 Form2Report.ParameterFields(F_DateOfOperation32).AddCurrentValue Left$(strDateOfOperation32, 255) 1012 Form2Report.ParameterFields(F_DateOfOperation33).AddCurrentValue Left$(strDateOfOperation33, 255) 1014 Form2Report.ParameterFields(F_DateOfOperation34).AddCurrentValue Left$(strDateOfOperation34, 255) 1016 Form2Report.ParameterFields(F_DateOfOperation35).AddCurrentValue Left$(strDateOfOperation35, 255) 1018 Form2Report.ParameterFields(F_DateOfOperation36).AddCurrentValue Left$(strDateOfOperation36, 255) 1020 Form2Report.ParameterFields(F_DateOfOperation37).AddCurrentValue Left$(strDateOfOperation37, 255) 1022 Form2Report.ParameterFields(F_DateOfOperation38).AddCurrentValue Left$(strDateOfOperation38, 255) 1024 Form2Report.ParameterFields(F_DateOfOperation39).AddCurrentValue Left$(strDateOfOperation39, 255) 1026 Form2Report.ParameterFields(F_DateOfOperation40).AddCurrentValue Left$(strDateOfOperation40, 255) 1028 Form2Report.ParameterFields(F_RVSCode10).AddCurrentValue Left$(strICDRVS10, 255) 1030 Form2Report.ParameterFields(F_RVSCode11).AddCurrentValue Left$(strICDRVS11, 255) 1032 Form2Report.ParameterFields(F_RVSCode12).AddCurrentValue Left$(strICDRVS12, 255) 1034 Form2Report.ParameterFields(F_RVSCode13).AddCurrentValue Left$(strICDRVS13, 255) 1036 Form2Report.ParameterFields(F_RVSCode14).AddCurrentValue Left$(strICDRVS14, 255) 1038 Form2Report.ParameterFields(F_RVSCode15).AddCurrentValue Left$(strICDRVS15, 255) 1040 Form2Report.ParameterFields(F_RVSCode16).AddCurrentValue Left$(strICDRVS16, 255) 1042 Form2Report.ParameterFields(F_RVSCode17).AddCurrentValue Left$(strICDRVS17, 255) 1044 Form2Report.ParameterFields(F_RVSCode18).AddCurrentValue Left$(strICDRVS18, 255) 1046 Form2Report.ParameterFields(F_RVSCode19).AddCurrentValue Left$(strICDRVS19, 255) 1048 Form2Report.ParameterFields(F_RVSCode20).AddCurrentValue Left$(strICDRVS20, 255) 1050 Form2Report.ParameterFields(F_RVSCode21).AddCurrentValue Left$(strICDRVS21, 255) 1052 Form2Report.ParameterFields(F_RVSCode22).AddCurrentValue Left$(strICDRVS22, 255) 1054 Form2Report.ParameterFields(F_RVSCode23).AddCurrentValue Left$(strICDRVS23, 255) 1056 Form2Report.ParameterFields(F_RVSCode24).AddCurrentValue Left$(strICDRVS24, 255) 1058 Form2Report.ParameterFields(F_RVSCode25).AddCurrentValue Left$(strICDRVS25, 255) 1060 Form2Report.ParameterFields(F_RVSCode26).AddCurrentValue Left$(strICDRVS26, 255) 1062 Form2Report.ParameterFields(F_RVSCode27).AddCurrentValue Left$(strICDRVS27, 255) 1064 Form2Report.ParameterFields(F_RVSCode28).AddCurrentValue Left$(strICDRVS28, 255) 1066 Form2Report.ParameterFields(F_RVSCode29).AddCurrentValue Left$(strICDRVS29, 255) 1068 Form2Report.ParameterFields(F_RVSCode30).AddCurrentValue Left$(strICDRVS30, 255) 1070 Form2Report.ParameterFields(F_RVSCode31).AddCurrentValue Left$(strICDRVS31, 255) 1072 Form2Report.ParameterFields(F_RVSCode32).AddCurrentValue Left$(strICDRVS32, 255) 1074 Form2Report.ParameterFields(F_RVSCode33).AddCurrentValue Left$(strICDRVS33, 255) 1076 Form2Report.ParameterFields(F_RVSCode34).AddCurrentValue Left$(strICDRVS34, 255) 1078 Form2Report.ParameterFields(F_RVSCode35).AddCurrentValue Left$(strICDRVS35, 255) 1080 Form2Report.ParameterFields(F_RVSCode36).AddCurrentValue Left$(strICDRVS36, 255) 1082 Form2Report.ParameterFields(F_RVSCode37).AddCurrentValue Left$(strICDRVS37, 255) 1084 Form2Report.ParameterFields(F_RVSCode38).AddCurrentValue Left$(strICDRVS38, 255) 1086 Form2Report.ParameterFields(F_RVSCode39).AddCurrentValue Left$(strICDRVS39, 255) 1088 Form2Report.ParameterFields(F_RVSCode40).AddCurrentValue Left$(strICDRVS40, 255) 1090 Form2Report.ParameterFields(F_Laterality1).AddCurrentValue strLaterality1 1092 Form2Report.ParameterFields(F_Laterality2).AddCurrentValue strLaterality2 1094 Form2Report.ParameterFields(F_Laterality3).AddCurrentValue strLaterality3 1096 Form2Report.ParameterFields(F_Laterality4).AddCurrentValue strLaterality4 1098 Form2Report.ParameterFields(F_Laterality5).AddCurrentValue strLaterality5 1100 Form2Report.ParameterFields(F_Laterality6).AddCurrentValue strLaterality6 1102 Form2Report.ParameterFields(F_Laterality7).AddCurrentValue strLaterality7 1104 Form2Report.ParameterFields(F_Laterality8).AddCurrentValue strLaterality8 1106 Form2Report.ParameterFields(F_Laterality9).AddCurrentValue strLaterality9 1108 Form2Report.ParameterFields(F_RelatedProcedure1).AddCurrentValue Left$(strRelatedProcedure1, 255) 1110 Form2Report.ParameterFields(F_RelatedProcedure2).AddCurrentValue Left$(strRelatedProcedure2, 255) 1112 Form2Report.ParameterFields(F_RelatedProcedure3).AddCurrentValue Left$(strRelatedProcedure3, 255) 1114 Form2Report.ParameterFields(F_RelatedProcedure4).AddCurrentValue Left$(strRelatedProcedure4, 255) 1116 Form2Report.ParameterFields(F_RelatedProcedure5).AddCurrentValue Left$(strRelatedProcedure5, 255) 1118 Form2Report.ParameterFields(F_RelatedProcedure6).AddCurrentValue Left$(strRelatedProcedure6, 255) 1120 Form2Report.ParameterFields(F_RelatedProcedure7).AddCurrentValue Left$(strRelatedProcedure7, 255) 1122 Form2Report.ParameterFields(F_RelatedProcedure8).AddCurrentValue Left$(strRelatedProcedure8, 255) 1124 Form2Report.ParameterFields(F_RelatedProcedure9).AddCurrentValue Left$(strRelatedProcedure9, 255) 1126 Form2Report.ParameterFields(F_RVSCode1).AddCurrentValue Left$(strICDRVS1, 255) 1128 Form2Report.ParameterFields(F_RVSCode2).AddCurrentValue Left$(strICDRVS2, 255) 1130 Form2Report.ParameterFields(F_RVSCode3).AddCurrentValue Left$(strICDRVS3, 255) 1132 Form2Report.ParameterFields(F_RVSCode4).AddCurrentValue Left$(strICDRVS4, 255) 1134 Form2Report.ParameterFields(F_RVSCode5).AddCurrentValue Left$(strICDRVS5, 255) 1136 Form2Report.ParameterFields(F_RVSCode6).AddCurrentValue Left$(strICDRVS6, 255) 1138 Form2Report.ParameterFields(F_RVSCode7).AddCurrentValue Left$(strICDRVS7, 255) 1140 Form2Report.ParameterFields(F_RVSCode8).AddCurrentValue Left$(strICDRVS8, 255) 1142 Form2Report.ParameterFields(F_RVSCode9).AddCurrentValue Left$(strICDRVS9, 255) 1144 Form2Report.ParameterFields(F_DateOfOperation1).AddCurrentValue Left$(strDateOfOperation1, 255) 1146 Form2Report.ParameterFields(F_DateOfOperation2).AddCurrentValue Left$(strDateOfOperation2, 255) 1148 Form2Report.ParameterFields(F_DateOfOperation3).AddCurrentValue Left$(strDateOfOperation3, 255) 1150 Form2Report.ParameterFields(F_DateOfOperation4).AddCurrentValue Left$(strDateOfOperation4, 255) 1152 Form2Report.ParameterFields(F_DateOfOperation5).AddCurrentValue Left$(strDateOfOperation5, 255) 1154 Form2Report.ParameterFields(F_DateOfOperation6).AddCurrentValue Left$(strDateOfOperation6, 255) 1156 Form2Report.ParameterFields(F_DateOfOperation7).AddCurrentValue Left$(strDateOfOperation7, 255) 1158 Form2Report.ParameterFields(F_DateOfOperation8).AddCurrentValue Left$(strDateOfOperation8, 255) 1160 Form2Report.ParameterFields(F_DateOfOperation9).AddCurrentValue Left$(strDateOfOperation9, 255) 1162 Form2Report.ParameterFields(F_FirstICDRVS).AddCurrentValue strFirstICDRVS 1164 Form2Report.ParameterFields(F_SecondICDRVS).AddCurrentValue strSecondICDRVS End If 'added 10.16.2007 ************** 1166 Form2Report.ParameterFields(F_AdmNumber).AddCurrentValue stridnum 1168 Form2Report.ParameterFields(F_DxCount).AddCurrentValue .Diagnosis.FinalDiagnosis.count 1170 If strAdmDate >= PubFormsImplementationDate Then 1172 Form2Report.ParameterFields(F_MedType).AddCurrentValue strMembership Else 1174 If ClientName <> "BIHMI" Then 1176 Form2Report.ParameterFields(F_MedType).AddCurrentValue strMembership End If End If 'added 03.13.2008 1178 If blnCashMeds Then 1180 Form2Report.ParameterFields(F_CashMeds).AddCurrentValue blnIsCashMeds End If ' ****************************** 1182 GetRVSInfo (stridnum) 1184 If ClientName = "MJSH" And strAdmDate < PubFormsImplementationDate Then 1186 Form2Report.ParameterFields(F_DX8).AddCurrentValue Left$(strDx8, 255) 1188 Form2Report.ParameterFields(F_DX9).AddCurrentValue Left$(strDx9, 255) 1190 Form2Report.ParameterFields(F_DX10).AddCurrentValue Left$(strDx10, 255) 1192 Form2Report.ParameterFields(F_DX11).AddCurrentValue Left$(strDx11, 255) 1194 Form2Report.ParameterFields(F_DX12).AddCurrentValue Left$(strDx12, 255) 1196 Form2Report.ParameterFields(F_DX13).AddCurrentValue Left$(strDx13, 255) 1198 Form2Report.ParameterFields(F_DX14).AddCurrentValue Left$(strDx14, 255) 1200 Form2Report.ParameterFields(F_ICD8).AddCurrentValue Left$(strICD8, 255) 1202 Form2Report.ParameterFields(F_ICD9).AddCurrentValue Left$(strICD9, 255) 1204 Form2Report.ParameterFields(F_ICD10).AddCurrentValue Left$(strICD10, 255) 1206 Form2Report.ParameterFields(F_ICD11).AddCurrentValue Left$(strICD11, 255) 1208 Form2Report.ParameterFields(F_ICD12).AddCurrentValue Left$(strICD12, 255) 1210 Form2Report.ParameterFields(F_ICD13).AddCurrentValue Left$(strICD13, 255) 1212 Form2Report.ParameterFields(F_ICD14).AddCurrentValue Left$(strICD14, 255) 1214 dblHMORB = HMOAmount(stridnum, "1") 1216 Form2Report.ParameterFields(F_HMORB).AddCurrentValue Format(dblHMORB, "##,###,##0.00") 1218 dblHMOMeds = HMOAmount(stridnum, "2") 1220 Form2Report.ParameterFields(F_HMOMeds).AddCurrentValue Format(dblHMOMeds, "##,###,##0.00") 1222 dblHMOOthers = HMOAmount(stridnum, "3") 1224 Form2Report.ParameterFields(F_HMOOthers).AddCurrentValue Format(dblHMOOthers, "##,###,##0.00") 1226 dblHMOOR = HMOAmount(stridnum, "4") 1228 Form2Report.ParameterFields(F_HMOOR).AddCurrentValue Format(dblHMOOR, "##,###,##0.00") 1230 dblTotalHMO = dblHMORB + dblHMOMeds + dblHMOOthers + dblHMOOR 1232 Form2Report.ParameterFields(F_TotalHMO).AddCurrentValue Format(dblTotalHMO, "##,###,##0.00") 1234 dblDiscountRB = DiscountAmount(stridnum, "1") 1236 Form2Report.ParameterFields(F_DisRB).AddCurrentValue Format(dblDiscountRB, "##,###,##0.00") 1238 dblDiscountMeds = DiscountAmount(stridnum, "2") 1240 Form2Report.ParameterFields(F_DisMeds).AddCurrentValue Format(dblDiscountMeds, "##,###,##0.00") 1242 dblDiscountOthers = DiscountAmount(stridnum, "3") 1244 Form2Report.ParameterFields(F_DisOthers).AddCurrentValue Format(dblDiscountOthers, "##,###,##0.00") 1246 dblDiscountOR = DiscountAmount(stridnum, "4") 1248 Form2Report.ParameterFields(F_DisOR).AddCurrentValue Format(dblDiscountOR, "##,###,##0.00") 1250 dblTotalDiscount = dblDiscountRB + dblDiscountMeds + dblDiscountOthers + dblDiscountOR 1252 Form2Report.ParameterFields(F_TotalDiscount).AddCurrentValue Format(dblTotalDiscount, "##,###,##0.00") 1254 Form2Report.ParameterFields(F_PAT_RB).AddCurrentValue Format(.Charges.Claim.PatientRoomAndBoard - (dblHMORB + dblDiscountRB), "##,###,##0.00") 1256 Form2Report.ParameterFields(F_PAT_MEDS).AddCurrentValue Format(.Charges.Claim.PatientDrugs - (dblHMOMeds + dblDiscountMeds), "##,###,##0.00") 1258 Form2Report.ParameterFields(F_PAT_OTHERS).AddCurrentValue Format(.Charges.Claim.PatientOthers - (dblHMOOthers + dblDiscountOthers), "##,###,##0.00") 1260 Form2Report.ParameterFields(F_PAT_OR).AddCurrentValue Format(.Charges.Claim.PatientOR - (dblHMOOR + dblDiscountOR), "##,###,##0.00") 1262 Form2Report.ParameterFields(F_PAT_ETC).AddCurrentValue Format(.Charges.Claim.PatientOutsideCharges, "##,###,##0.00") 1264 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 1266 Form2Report.ParameterFields(F_RVS).AddCurrentValue strForm2RVS 1268 Form2Report.ParameterFields(F_IllnessCode).AddCurrentValue strForm2IllnessCOde 1270 Form2Report.ParameterFields(F_Initial).AddCurrentValue Trim$(EmployeeInitial) 'F_BirthDate 1272 Form2Report.ParameterFields(F_BirthDate).AddCurrentValue Trim$(strBirthDate) 1274 If (ClientName = "MJSH" Or ClientName = "NDCH") And strAdmDate < PubACRFormsImplementationDate Then 1276 If strAdmDate >= PubFormsImplementationDate Then 1278 Form2Report.ParameterFields(F_IsBenefits).AddCurrentValue GetIsBenefits(stridnum) 1280 SearchPackageID GetPackageType(stridnum) ' If GetIsBenefits(strIdNum) = True Then ' Form2Report.ParameterFields(F_PF).AddCurrentValue Format(dblPackagePF, "##,###,##0.00") ' Else ' Form2Report.ParameterFields(F_PF).AddCurrentValue Format(0, "##,###,##0.00") ' End If 1282 Form2Report.ParameterFields(F_Initial).AddCurrentValue Trim$(GetRoomClass(stridnum)) End If Else 1284 If strAdmDate >= PubFormsImplementationDate And strAdmDate < PubACRFormsImplementationDate Then 1286 If ClientName = "NKTI" Then 1288 Form2Report.ParameterFields(F_PayService).AddCurrentValue PayService 1290 Form2Report.ParameterFields(F_DocChief).AddCurrentValue DocChief 1292 Form2Report.ParameterFields(F_IsHemoPatient).AddCurrentValue isHemo(Medicare.idnum) 1294 Form2Report.ParameterFields(F_BloodComponent).AddCurrentValue HasBC(Medicare.idnum) 1296 Form2Report.ParameterFields(F_ER).AddCurrentValue isER(Medicare.idnum) 1298 Form2Report.ParameterFields(F_PACKAGENAME).AddCurrentValue GetPackageName(Medicare.idnum) 1300 Form2Report.ParameterFields(F_ENDOSCOPY).AddCurrentValue isEndoscopy(Medicare.idnum) 1302 Form2Report.ParameterFields(F_PURCHASEDATE).AddCurrentValue PurchaseDate '(Medicare.IdNum) 1304 Form2Report.ParameterFields(F_HDOCTOR).AddCurrentValue HideDoctor '(Medicare.IdNum) 1306 Form2Report.ParameterFields(F_SESSION).AddCurrentValue GetSession(Medicare.idnum) 1308 Form2Report.ParameterFields(F_BAG).AddCurrentValue GetBagCount(Medicare.idnum) End If 1310 Form2Report.ParameterFields(F_IsBenefits).AddCurrentValue GetIsBenefits(stridnum) 1312 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) 232 Case 13 234 strLaterality13 = IIf(IsNull(!Laterality), "", !Laterality) 236 strRelatedProcedure13 = IIf(IsNull(!RelatedOperation), "", !RelatedOperation) 238 strICDRVS13 = IIf(IsNull(!RVSCode), "", !RVSCode) 240 strDateOfOperation13 = IIf(IsNull(!DateOfOperation), "", !DateOfOperation) 242 Case 14 244 strLaterality14 = IIf(IsNull(!Laterality), "", !Laterality) 246 strRelatedProcedure14 = IIf(IsNull(!RelatedOperation), "", !RelatedOperation) 248 strICDRVS14 = IIf(IsNull(!RVSCode), "", !RVSCode) 250 strDateOfOperation14 = IIf(IsNull(!DateOfOperation), "", !DateOfOperation) 252 Case 15 254 strLaterality15 = IIf(IsNull(!Laterality), "", !Laterality) 256 strRelatedProcedure15 = IIf(IsNull(!RelatedOperation), "", !RelatedOperation) 258 strICDRVS15 = IIf(IsNull(!RVSCode), "", !RVSCode) 260 strDateOfOperation15 = IIf(IsNull(!DateOfOperation), "", !DateOfOperation) 262 Case 16 264 strLaterality16 = IIf(IsNull(!Laterality), "", !Laterality) 266 strRelatedProcedure16 = IIf(IsNull(!RelatedOperation), "", !RelatedOperation) 268 strICDRVS16 = IIf(IsNull(!RVSCode), "", !RVSCode) 270 strDateOfOperation16 = IIf(IsNull(!DateOfOperation), "", !DateOfOperation) 272 Case 17 274 strLaterality17 = IIf(IsNull(!Laterality), "", !Laterality) 276 strRelatedProcedure17 = IIf(IsNull(!RelatedOperation), "", !RelatedOperation) 278 strICDRVS17 = IIf(IsNull(!RVSCode), "", !RVSCode) 280 strDateOfOperation17 = IIf(IsNull(!DateOfOperation), "", !DateOfOperation) 282 Case 18 284 strLaterality18 = IIf(IsNull(!Laterality), "", !Laterality) 286 strRelatedProcedure18 = IIf(IsNull(!RelatedOperation), "", !RelatedOperation) 288 strICDRVS18 = IIf(IsNull(!RVSCode), "", !RVSCode) 290 strDateOfOperation18 = IIf(IsNull(!DateOfOperation), "", !DateOfOperation) 292 Case 19 294 strLaterality19 = IIf(IsNull(!Laterality), "", !Laterality) 296 strRelatedProcedure19 = IIf(IsNull(!RelatedOperation), "", !RelatedOperation) 298 strICDRVS19 = IIf(IsNull(!RVSCode), "", !RVSCode) 300 strDateOfOperation19 = IIf(IsNull(!DateOfOperation), "", !DateOfOperation) 302 Case 20 304 strLaterality20 = IIf(IsNull(!Laterality), "", !Laterality) 306 strRelatedProcedure20 = IIf(IsNull(!RelatedOperation), "", !RelatedOperation) 308 strICDRVS20 = IIf(IsNull(!RVSCode), "", !RVSCode) 310 strDateOfOperation20 = IIf(IsNull(!DateOfOperation), "", !DateOfOperation) 312 Case 21 314 strLaterality21 = IIf(IsNull(!Laterality), "", !Laterality) 316 strRelatedProcedure21 = IIf(IsNull(!RelatedOperation), "", !RelatedOperation) 318 strICDRVS21 = IIf(IsNull(!RVSCode), "", !RVSCode) 320 strDateOfOperation21 = IIf(IsNull(!DateOfOperation), "", !DateOfOperation) 322 Case 22 324 strLaterality22 = IIf(IsNull(!Laterality), "", !Laterality) 326 strRelatedProcedure22 = IIf(IsNull(!RelatedOperation), "", !RelatedOperation) 328 strICDRVS22 = IIf(IsNull(!RVSCode), "", !RVSCode) 330 strDateOfOperation22 = IIf(IsNull(!DateOfOperation), "", !DateOfOperation) 332 Case 23 334 strLaterality23 = IIf(IsNull(!Laterality), "", !Laterality) 336 strRelatedProcedure23 = IIf(IsNull(!RelatedOperation), "", !RelatedOperation) 338 strICDRVS23 = IIf(IsNull(!RVSCode), "", !RVSCode) 340 strDateOfOperation23 = IIf(IsNull(!DateOfOperation), "", !DateOfOperation) 342 Case 24 344 strLaterality24 = IIf(IsNull(!Laterality), "", !Laterality) 346 strRelatedProcedure24 = IIf(IsNull(!RelatedOperation), "", !RelatedOperation) 348 strICDRVS24 = IIf(IsNull(!RVSCode), "", !RVSCode) 350 strDateOfOperation24 = IIf(IsNull(!DateOfOperation), "", !DateOfOperation) 352 Case 25 354 strLaterality25 = IIf(IsNull(!Laterality), "", !Laterality) 356 strRelatedProcedure25 = IIf(IsNull(!RelatedOperation), "", !RelatedOperation) 358 strICDRVS25 = IIf(IsNull(!RVSCode), "", !RVSCode) 360 strDateOfOperation25 = IIf(IsNull(!DateOfOperation), "", !DateOfOperation) 362 Case 26 364 strLaterality26 = IIf(IsNull(!Laterality), "", !Laterality) 366 strRelatedProcedure26 = IIf(IsNull(!RelatedOperation), "", !RelatedOperation) 368 strICDRVS26 = IIf(IsNull(!RVSCode), "", !RVSCode) 370 strDateOfOperation26 = IIf(IsNull(!DateOfOperation), "", !DateOfOperation) 372 Case 27 374 strLaterality27 = IIf(IsNull(!Laterality), "", !Laterality) 376 strRelatedProcedure27 = IIf(IsNull(!RelatedOperation), "", !RelatedOperation) 378 strICDRVS27 = IIf(IsNull(!RVSCode), "", !RVSCode) 380 strDateOfOperation27 = IIf(IsNull(!DateOfOperation), "", !DateOfOperation) 382 Case 28 384 strLaterality28 = IIf(IsNull(!Laterality), "", !Laterality) 386 strRelatedProcedure28 = IIf(IsNull(!RelatedOperation), "", !RelatedOperation) 388 strICDRVS28 = IIf(IsNull(!RVSCode), "", !RVSCode) 390 strDateOfOperation28 = IIf(IsNull(!DateOfOperation), "", !DateOfOperation) 392 Case 29 394 strLaterality29 = IIf(IsNull(!Laterality), "", !Laterality) 396 strRelatedProcedure29 = IIf(IsNull(!RelatedOperation), "", !RelatedOperation) 398 strICDRVS29 = IIf(IsNull(!RVSCode), "", !RVSCode) 400 strDateOfOperation29 = IIf(IsNull(!DateOfOperation), "", !DateOfOperation) 402 Case 30 404 strLaterality30 = IIf(IsNull(!Laterality), "", !Laterality) 406 strRelatedProcedure30 = IIf(IsNull(!RelatedOperation), "", !RelatedOperation) 408 strICDRVS30 = IIf(IsNull(!RVSCode), "", !RVSCode) 410 strDateOfOperation30 = IIf(IsNull(!DateOfOperation), "", !DateOfOperation) 412 Case 31 414 strLaterality31 = IIf(IsNull(!Laterality), "", !Laterality) 416 strRelatedProcedure31 = IIf(IsNull(!RelatedOperation), "", !RelatedOperation) 418 strICDRVS31 = IIf(IsNull(!RVSCode), "", !RVSCode) 420 strDateOfOperation31 = IIf(IsNull(!DateOfOperation), "", !DateOfOperation) 422 Case 32 424 strLaterality32 = IIf(IsNull(!Laterality), "", !Laterality) 426 strRelatedProcedure32 = IIf(IsNull(!RelatedOperation), "", !RelatedOperation) 428 strICDRVS32 = IIf(IsNull(!RVSCode), "", !RVSCode) 430 strDateOfOperation32 = IIf(IsNull(!DateOfOperation), "", !DateOfOperation) 432 Case 33 434 strLaterality33 = IIf(IsNull(!Laterality), "", !Laterality) 436 strRelatedProcedure33 = IIf(IsNull(!RelatedOperation), "", !RelatedOperation) 438 strICDRVS33 = IIf(IsNull(!RVSCode), "", !RVSCode) 440 strDateOfOperation33 = IIf(IsNull(!DateOfOperation), "", !DateOfOperation) 442 Case 34 444 strLaterality34 = IIf(IsNull(!Laterality), "", !Laterality) 446 strRelatedProcedure34 = IIf(IsNull(!RelatedOperation), "", !RelatedOperation) 448 strICDRVS34 = IIf(IsNull(!RVSCode), "", !RVSCode) 450 strDateOfOperation34 = IIf(IsNull(!DateOfOperation), "", !DateOfOperation) 452 Case 35 454 strLaterality35 = IIf(IsNull(!Laterality), "", !Laterality) 456 strRelatedProcedure35 = IIf(IsNull(!RelatedOperation), "", !RelatedOperation) 458 strICDRVS35 = IIf(IsNull(!RVSCode), "", !RVSCode) 460 strDateOfOperation35 = IIf(IsNull(!DateOfOperation), "", !DateOfOperation) 462 Case 36 464 strLaterality36 = IIf(IsNull(!Laterality), "", !Laterality) 466 strRelatedProcedure36 = IIf(IsNull(!RelatedOperation), "", !RelatedOperation) 468 strICDRVS36 = IIf(IsNull(!RVSCode), "", !RVSCode) 470 strDateOfOperation36 = IIf(IsNull(!DateOfOperation), "", !DateOfOperation) 472 Case 37 474 strLaterality37 = IIf(IsNull(!Laterality), "", !Laterality) 476 strRelatedProcedure37 = IIf(IsNull(!RelatedOperation), "", !RelatedOperation) 478 strICDRVS37 = IIf(IsNull(!RVSCode), "", !RVSCode) 480 strDateOfOperation37 = IIf(IsNull(!DateOfOperation), "", !DateOfOperation) 482 Case 38 484 strLaterality38 = IIf(IsNull(!Laterality), "", !Laterality) 486 strRelatedProcedure38 = IIf(IsNull(!RelatedOperation), "", !RelatedOperation) 488 strICDRVS38 = IIf(IsNull(!RVSCode), "", !RVSCode) 490 strDateOfOperation38 = IIf(IsNull(!DateOfOperation), "", !DateOfOperation) 492 Case 39 494 strLaterality39 = IIf(IsNull(!Laterality), "", !Laterality) 496 strRelatedProcedure39 = IIf(IsNull(!RelatedOperation), "", !RelatedOperation) 498 strICDRVS39 = IIf(IsNull(!RVSCode), "", !RVSCode) 500 strDateOfOperation39 = IIf(IsNull(!DateOfOperation), "", !DateOfOperation) 502 Case 40 504 strLaterality40 = IIf(IsNull(!Laterality), "", !Laterality) 506 strRelatedProcedure40 = IIf(IsNull(!RelatedOperation), "", !RelatedOperation) 508 strICDRVS40 = IIf(IsNull(!RVSCode), "", !RVSCode) 510 strDateOfOperation40 = IIf(IsNull(!DateOfOperation), "", !DateOfOperation) End Select End If 512 .Close End With 514 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 MEDICARE..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 isnull(Sum(A.ActualPF),0)[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 isnull(Sum(A.ActualPF),0)[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) ' If dblPatient = 0 Then ' Form2Report.ParameterFields(F_ANES_PATIENT).AddCurrentValue Format(dblPatient, "##,###,##0.00") ' Else ' If blnHMOAccount Then ' Form2Report.ParameterFields(F_ANES_PATIENT).AddCurrentValue Format(dblPatient, "##,###,##0.00") '& "(HMO)" ' Else ' Form2Report.ParameterFields(F_ANES_PATIENT).AddCurrentValue Format(dblPatient, "##,###,##0.00") '& "(Promisory Note)" ' End If ' End If 156 Form2Report.ParameterFields(F_ANES_HMO).AddCurrentValue Format(dblHMOAnes, "##,###,##0.00") 158 Form2Report.ParameterFields(F_ANES_Discount).AddCurrentValue Format(dblDiscountAnes, "##,###,##0.00") Else ' Form2Report.ParameterFields(F_ANES_PATIENT).AddCurrentValue Format(.Doctors.Anesthesiologist(intCount).PatientPF, "##,###,##0.00") End If Else 160 Form2Report.ParameterFields(F_ANES_NAME).AddCurrentValue "n/a" 162 Form2Report.ParameterFields(F_ANES_PHIC).AddCurrentValue "n/a" 164 Form2Report.ParameterFields(F_ANES_TIN).AddCurrentValue "n/a" 166 Form2Report.ParameterFields(F_ANES_SERVICES).AddCurrentValue "n/a" 168 Form2Report.ParameterFields(F_ANES_ACTUAL).AddCurrentValue "n/a" 170 Form2Report.ParameterFields(F_ANES_MED).AddCurrentValue "n/a" ' Form2Report.ParameterFields(F_ANES_PATIENT).AddCurrentValue "n/a" 172 Form2Report.ParameterFields(F_ANES_PERFORMEDDATE).AddCurrentValue "n/a" 174 If ClientName = "MJSH" And strAdmDate < PubFormsImplementationDate Then 176 Form2Report.ParameterFields(F_ANES_HMO).AddCurrentValue Format(0, "##,###,##0.00") 178 Form2Report.ParameterFields(F_ANES_Discount).AddCurrentValue Format(0, "##,###,##0.00") End If End If Else 180 AnesPF = IIf(intCount <= .Doctors.Anesthesiologist.count, AnesPF, 0) 182 SurgeonPF = IIf(intCount <= .Doctors.Surgeon.count, SurgeonPF, 0) 184 PhysicianPF = IIf(intCount <= .Doctors.Physician.count, PhysicianPF, 0) 186 Form2Report.ParameterFields(F_ANES_NAME).AddCurrentValue "n/a" 188 Form2Report.ParameterFields(F_ANES_PHIC).AddCurrentValue "n/a" 190 Form2Report.ParameterFields(F_ANES_TIN).AddCurrentValue "n/a" 192 Form2Report.ParameterFields(F_ANES_SERVICES).AddCurrentValue "n/a" 194 Form2Report.ParameterFields(F_ANES_ACTUAL).AddCurrentValue "n/a" 196 Form2Report.ParameterFields(F_ANES_MED).AddCurrentValue "n/a" ' Form2Report.ParameterFields(F_ANES_PATIENT).AddCurrentValue "n/a" 198 Form2Report.ParameterFields(F_ANES_PERFORMEDDATE).AddCurrentValue "n/a" 200 If ClientName = "MJSH" And strAdmDate < PubFormsImplementationDate Then 202 Form2Report.ParameterFields(F_ANES_HMO).AddCurrentValue Format(0, "##,###,##0.00") 204 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 If ClientName = "WCI" Then 152 Set Form2Report = Form2crxApplication.OpenReport(pubSubReports + "\NewClaimForm2ACR.rpt") Else 154 Set Form2Report = Form2crxApplication.OpenReport(App.Path + "\Reports\NewClaimForm2ACR.rpt") End If 156 ElseIf strAdmDate >= PubFormsImplementationDate Then 158 Set Form2Report = Form2crxApplication.OpenReport(App.Path + "\Reports\NewClaimForm2.rpt") Else 160 Set Form2Report = Form2crxApplication.OpenReport(App.Path + "\Reports\NewClaimWithICD.rpt") End If Else 162 Set Form2Report = Form2crxApplication.OpenReport(App.Path + "\Reports\NewClaimWithICD.rpt") End If 164 Case 4 166 If ServerDate >= PubFormsImplementationDate Then 168 If strAdmDate >= PubFormsImplementationDate Then 'ange 'Set Form2Report = Form2crxApplication.OpenReport(App.Path + "\Reports\NewClaimForm2_Preprinted.rpt") 170 Set Form2Report = Form2crxApplication.OpenReport(App.Path + "\Reports\NewClaimForm2ACR_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") End Select 228 If intOption = 3 Or intOption = 4 Or intOption = 5 Or intOption = 6 Or intOption = 7 Or intOption = 8 Then 230 blnWithICD = True Else 232 blnWithICD = False End If 234 PrintPhysician 1 236 PrintSurgeon 1 238 PrintAnesthesiologist 1 240 If strAdmDate >= PubACRFormsImplementationDate Then 'khing 11.27.13 CF2_ACR Printing 242 PrintConfinementInfo stridnum 244 ElseIf strAdmDate >= PubFormsImplementationDate Then 246 PrintCardiologist 1, stridnum 248 If intOption = 5 Or intOption = 6 Then 250 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) 252 strTrackingNum = GetTrackingNumber(stridnum) 254 Form2Report.ParameterFields(F_TrackingNumber).AddCurrentValue "š" + strTrackingNum & getCheckDigit(strTrackingNum) & "œ" 256 PrintTracking = Val(GetSetting("MEDSYS", "MEDICARE", "printTrackingNumberForm2")) ' If PrintTracking = True Then ' Assign Options Dim iX As Integer 258 For iX = 1 To Form2Report.FormulaFields.count 260 If Form2Report.FormulaFields.Item(iX).Name = "{@Options}" Then 262 Form2Report.FormulaFields.Item(iX).Text = "BooleanVar ShowTrackingNumber:= " & PrintTracking & " as boolean" Exit For End If Next ' Assign Record Selection Formula ' End If 264 If blnPreprinted = False Then 266 If PrintTracking = True Then 268 Form2Report.FormulaFields.Item(iX).Text = "BooleanVar ShowTrackingNumber:=true" Else 270 Form2Report.FormulaFields.Item(iX).Text = "BooleanVar ShowTrackingNumber:=false" End If End If 'End If End If 272 PrintGeneralInfo blnWithICD, HideDoctor 274 If intOption = 5 Or intOption = 6 Then 276 Form2Report.ParameterFields(F_IndexNumber).AddCurrentValue "" End If 278 If intOption = 4 Or intOption = 3 Then 280 If isPaidtoBill(stridnum) Then 282 If MsgBox("Is it Hospital Claim?", vbYesNo) = vbYes Then 284 Form2Report.ParameterFields(F_ConstHospPatient).AddCurrentValue "Y" 286 strOptionType = "Y" Else 288 Form2Report.ParameterFields(F_ConstHospPatient).AddCurrentValue "N" 290 strOptionType = "N" End If Else 292 If strOptionType = "Y" Then 294 Form2Report.ParameterFields(F_ConstHospPatient).AddCurrentValue "Y" Else 296 Form2Report.ParameterFields(F_ConstHospPatient).AddCurrentValue "N" End If End If End If 298 If Not ClientName Like "[DDH, MJSH, LMC]" Then 300 Form2Report.ParameterFields(F_DocBatchNew).AddCurrentValue "1" End If 302 If ClientName = "MJSH" And strAdmDate < PubFormsImplementationDate Then 304 Form2Report.ParameterFields(F_DocBatch).AddCurrentValue "1" 306 Form2Report.ParameterFields(F_DiagBatch).AddCurrentValue "1" End If 308 If strAdmDate >= PubACRFormsImplementationDate Then 310 Form2Report.ParameterFields(F_PageCount).SetCurrentValue CStr(intCount) End If 312 frmViewForm2.WhatReport = 1 314 frmViewForm2.idnum = stridnum 316 frmViewForm2.Index = intCount 318 frmViewForm2.Show vbModal 320 Next intCount 322 If blnPart34onEntry Then 324 If strAdmDate >= PubACRFormsImplementationDate Then 326 frmEntryACR.cmdCancel_Click 328 Select Case intOption Case 3 330 frmMedicare.mnuACRFormat_Click 332 Case 4 334 frmMedicare.mnuACR4and5Preprint_Click End Select End If End If 'Start 336 If strAdmDate < PubACRFormsImplementationDate Then 338 If blnAllowSeparatePart45 Then 340 PrintBlankForm2 5 End If End If 342 If blnAllowPrintPartV And strAdmDate < PubFormsImplementationDate Then 344 If ClientName <> "BIHMI" Then 346 If blnPreprinted = True Then 348 frmView.MedicType = "1" Else 350 If IsNumeric(Right(stridnum, 1)) Then 352 frmView.MedicType = "2" Else 354 If MsgBox("Do you want Preprinted Part 5?", vbYesNo) = vbYes Then 356 frmView.MedicType = "4" Else 358 frmView.MedicType = "2" End If End If End If 360 frmView.Title = strOptionType 362 frmView.idnum = stridnum 364 frmView.TotalPF = DoctorPF 366 frmView.TotalDeduction = dblCashMed 368 frmView.WhatReport = 37 370 frmView.Show vbModal End If End If 372 Screen.MousePointer = vbDefault 374 If strAdmDate < PubACRFormsImplementationDate Then 376 If blnAllowPrintOutDiagnosis Then 378 If intDiagCount > intAllowedPrintOutDiagnosis Then 380 frmView.idnum = stridnum 382 frmView.WhatReport = 45 384 frmView.Show vbModal End If End If End If 386 If CheckHemoChemoDischarges(stridnum) Then 388 frmView.idnum = stridnum 390 frmView.StartDate = GetAdmDate(stridnum) 392 frmView.EndDate = GetDcrDate(stridnum) 394 frmView.WhatReport = 48 396 frmView.Show vbModal End If 398 If blnServicePerformed And ClientName = "DDH" Then 400 frmView.idnum = stridnum 402 frmView.WhatReport = 56 404 frmView.Show vbModal End If 406 If ClientName = "MJSH" Then 408 If intDiagCount > intAllowedPrintOutDiagnosis And strAdmDate < PubFormsImplementationDate Then 410 Set Form2Report = Nothing 412 Set Form2crxApplication = Nothing 414 Set Form2crxApplication = New CRAXDRT.Application 416 Set Form2Report = Form2crxApplication.OpenReport(App.Path + "\Reports\NewClaimWithICD.rpt") 418 PrintPhysician 1 420 PrintSurgeon 1 422 PrintAnesthesiologist 1 424 PrintGeneralInfo True, HideDoctor 426 Form2Report.ParameterFields(F_IndexNumber).AddCurrentValue "" 428 If isPaidtoBill(stridnum) Then 430 If MsgBox("Is it Hospital Claim?", vbYesNo) = vbYes Then 432 Form2Report.ParameterFields(F_ConstHospPatient).AddCurrentValue "Y" 434 strOptionType = "Y" Else 436 Form2Report.ParameterFields(F_ConstHospPatient).AddCurrentValue "N" 438 strOptionType = "N" End If Else 440 If strOptionType = "Y" Then 442 Form2Report.ParameterFields(F_ConstHospPatient).AddCurrentValue "Y" Else 444 Form2Report.ParameterFields(F_ConstHospPatient).AddCurrentValue "N" End If End If 446 Form2Report.ParameterFields(F_DocBatch).AddCurrentValue "1" 448 Form2Report.ParameterFields(F_DiagBatch).AddCurrentValue "2" 450 frmViewForm2.WhatReport = 1 452 frmViewForm2.Show vbModal End If 454 strActualUserID = GetActualUserID(stridnum) ' commented by ange 06.15.2021 ' user.SQLConnection.Execute "Medicare..Medic_CreateTempTable '" & Trim$(stridnum) & "','" & Trim$(strActualUserID) & "'" ' If IsNumeric(Right(stridnum, 1)) Then ' user.SQLConnection.Execute "Medicare..Medic_AutoComputeCharges '" & Trim$(stridnum) & "','" & Trim$(strActualUserID) & "'" ' Else ' user.SQLConnection.Execute "Medicare..Medic_AutoComputeChargesOP '" & Trim$(stridnum) & "','" & Trim$(strActualUserID) & "'" ' End If 456 user.SQLConnection.Execute "Update Medicare..tbMedActual set CountPrinting = IsNull(CountPrinting,0) + 1 where IDNum = '" & Trim$(stridnum) & "'" 458 frmView.PatientName = GetPatientName(stridnum) 460 frmView.TotalDeduction = "" 462 frmView.TotalPF = "" 464 frmView.UserID = Trim$(strActualUserID) 466 frmView.idnum = stridnum 468 If GetPackageType(stridnum) = "4" Then 470 frmView.WhatReport = 2 472 frmView.ReportType = 1 Else 474 frmView.WhatReport = 61 End If 'jeremy' 'blnPrint = True 476 frmView.Show vbModal End If 'End Else 478 Screen.MousePointer = vbDefault 480 If intOption = 6 Then 482 frmForm2.Preprinted = True Else 484 frmForm2.Preprinted = False End If 486 If HideDoctor = True Then 488 frmForm2.HideDoctor = True Else 490 frmForm2.HideDoctor = False End If 492 frmForm2.FormCount = intFormCount 494 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 medicare..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 & "" 116 pstrHospitalTIN = recX!TinNo & "" 118 pstrHospitalTelNo = recX!ContactNo & "" End If 120 If recX.State > 0 Then recX.Close 122 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 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) 'added by arnold 8.10.23 ' If ClientName = "SH" Then ' user.SQLConnection.Execute "Insert into Medicare..tbMedLogs values('" & strUserID & "', '" & strRemarks & "', getDate())" ' Else '------------ ' On Error GoTo UserLogs_Err ' 100 user.SQLConnection.Execute "Insert into Medicare..tbMedLogs(userid, remarks,loginperiod, IDNum, Mod_Version) values('" & strUserID & "', '" & strRemarks & "', getDate(), '" & stridnum & "', '" & App.Major & "." & App.Minor & "." & App.Revision & "')" 'End If ' Exit Sub UserLogs_Err: MsgBox Err.Description & vbCrLf & _ "in prjMedicare.modTemp.UserLogs " & _ "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 * 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 * 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 'DoctorPaymentAmount Public Function GetDoctorPaymentAmount(stridnum As String) As Double ' On Error GoTo GetDoctorPaymentAmount_Err ' Dim Rec As New ADODB.Recordset Dim SQL As String 100 SQL = "Select isnull(Sum(IsNull(Payment,0)),0) [Amount] from Medicare..tbMedDoctors where IDNum = '" & _ Trim$(stridnum) & "'" 102 GetDoctorPaymentAmount = 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 GetDoctorPaymentAmount = !Amount End If 116 .Close End With 118 Set Rec = Nothing ' Exit Function GetDoctorPaymentAmount_Err: MsgBox Err.Description & vbCrLf & _ "in prjMedicare.modTemp.GetDoctorPaymentAmount " & _ "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 If ClientName = "MGH" Then 102 SQL = "(Select(Select isnull(Sum(IsNull(Amount,0)),0) [Amount] from Medicare..tbMedPayment where IDNum = '" & _ Trim$(stridnum) & "') as [Amount])" Else 104 If ClientName = "PSH" Then 106 SQL = "(Select(Select isnull(Sum(IsNull(Amount,0)) + Sum(IsNull(Tax,0)),0) [Amount] from Medicare..tbMedPayment where IDNum = '" & _ Trim$(stridnum) & "') as [Amount])" Else 108 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 End If ' End If 110 GetPaymentAmount = 0 112 With Rec 114 If .State > 0 Then .Close 116 .CursorLocation = adUseClient 118 .Open SQL, user.SQLConnection, adOpenDynamic, adLockReadOnly 120 If .RecordCount > 0 Then 122 GetPaymentAmount = !Amount End If 124 .Close End With 126 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 Dim LMPPackage As String Dim DeathOfDateTime As String Dim IMRTProcedureDates As String Dim NBSFilterCardNo 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 LMPPackage = !LMPPackage 206 DeathOfDateTime = !DeathOfDate 208 IMRTProcedureDates = !IMRTProcedureDates 210 NBSFilterCardNo = !NCPFilterCardNo 212 Form2Report.ParameterFields(F_PatientDisposition).AddCurrentValue PatientDisposition 214 Form2Report.ParameterFields(F_isPatientReferred).AddCurrentValue isPatientReferred 216 Form2Report.ParameterFields(F_NameOfReferringHCI).AddCurrentValue Left$(NameOfReferringHCI, 255) 218 Form2Report.ParameterFields(F_ReferringAddress).AddCurrentValue Left$(ReferringAddress, 255) 220 Form2Report.ParameterFields(F_ReferralReason).AddCurrentValue Left$(ReferralReason, 255) 222 Form2Report.ParameterFields(F_AccomodationType).AddCurrentValue AccomodationType 224 Form2Report.ParameterFields(F_isHemoProcedure).AddCurrentValue isHemoProcedure 226 Form2Report.ParameterFields(F_isPDProcedure).AddCurrentValue isPDProcedure 228 Form2Report.ParameterFields(F_isRLINACProcedure).AddCurrentValue isRLINACProcedure 230 Form2Report.ParameterFields(F_isRCOBALTProcedure).AddCurrentValue isRCOBALTProcedure 232 Form2Report.ParameterFields(F_isBTProcedure).AddCurrentValue isBTProcedure 234 Form2Report.ParameterFields(F_isBrachyProcedure).AddCurrentValue isBrachyProcedure 236 Form2Report.ParameterFields(F_isChemoProcedure).AddCurrentValue isChemoProcedure 238 Form2Report.ParameterFields(F_isSDProcedure).AddCurrentValue isSDProcedure 240 Form2Report.ParameterFields(F_HemoProcedureDates).AddCurrentValue Left$(HemoProcedureDates, 255) 242 Form2Report.ParameterFields(F_PDProcedureDates).AddCurrentValue Left$(PDProcedureDates, 255) 244 Form2Report.ParameterFields(F_RLINACProcedureDates).AddCurrentValue Left$(RLINACProcedureDates, 255) 246 Form2Report.ParameterFields(F_RCOBALTProcedureDates).AddCurrentValue Left$(RCOBALTProcedureDates, 255) 248 Form2Report.ParameterFields(F_BTProcedureDates).AddCurrentValue Left$(BTProcedureDates, 255) 250 Form2Report.ParameterFields(F_BrachyProcedureDates).AddCurrentValue Left$(BrachyProcedureDates, 255) 252 Form2Report.ParameterFields(F_ChemoProcedureDates).AddCurrentValue Left$(ChemoProcedureDates, 255) 254 Form2Report.ParameterFields(F_SDProcedureDates).AddCurrentValue Left$(SDProcedureDates, 255) 256 Form2Report.ParameterFields(F_ZBPCode).AddCurrentValue ZBPCode 258 Form2Report.ParameterFields(F_ABPackageDayZero).AddCurrentValue Replace(ABPackageDayZero, "/", "-") 260 Form2Report.ParameterFields(F_ABPackageDayThree).AddCurrentValue Replace(ABPackageDayThree, "/", "-") 262 Form2Report.ParameterFields(F_ABPackageDaySeven).AddCurrentValue Replace(ABPackageDaySeven, "/", "-") 264 Form2Report.ParameterFields(F_ABPackageRIG).AddCurrentValue Replace(ABPackageRIG, "/", "-") 266 Form2Report.ParameterFields(F_ABPackageOthers).AddCurrentValue Replace(ABPackageOthers, "/", "-") 268 Form2Report.ParameterFields(F_MCPPackageFirst).AddCurrentValue Replace(MCPPackageFirst, "/", "-") 270 Form2Report.ParameterFields(F_MCPPackageSecond).AddCurrentValue Replace(MCPPackageSecond, "/", "-") 272 Form2Report.ParameterFields(F_MCPPackageThird).AddCurrentValue Replace(MCPPackageThird, "/", "-") 274 Form2Report.ParameterFields(F_MCPPackageFourth).AddCurrentValue Replace(MCPPackageFourth, "/", "-") 276 Form2Report.ParameterFields(F_ENewbornCareIDON).AddCurrentValue ENewbornCareIDON 278 Form2Report.ParameterFields(F_ENewbornCareEStSC).AddCurrentValue ENewbornCareEStSC 280 Form2Report.ParameterFields(F_ENewbornCareTCC).AddCurrentValue ENewbornCareTCC 282 Form2Report.ParameterFields(F_ENewbornCareEP).AddCurrentValue ENewbornCareEP 284 Form2Report.ParameterFields(F_ENewbornCareWotN).AddCurrentValue ENewbornCareWotN 286 Form2Report.ParameterFields(F_ENewbornCareVkA).AddCurrentValue ENewbornCareVkA 288 Form2Report.ParameterFields(F_ENewbornCareBCGV).AddCurrentValue ENewbornCareBCGV 290 Form2Report.ParameterFields(F_ENewbornCareNsoMBfEBFI).AddCurrentValue ENewbornCareNsoMBfEBFI 292 Form2Report.ParameterFields(F_ENewbornCareHepaB).AddCurrentValue ENewbornCareHepaB 294 Form2Report.ParameterFields(F_TBDotsPackge).AddCurrentValue TBDotsPackge 296 Form2Report.ParameterFields(F_NewbornCarePackge).AddCurrentValue NewbornCarePackge 298 Form2Report.ParameterFields(F_LaboratoryNumber).AddCurrentValue LaboratoryNumber 300 Form2Report.ParameterFields(F_LMPPackage).AddCurrentValue Replace(LMPPackage, "/", "-") 302 If PatientDisposition = "E" Then 304 Form2Report.ParameterFields(F_DATE_OF_DEATH).AddCurrentValue Format(DeathOfDateTime, "hh:mm AMPM") Else 306 Form2Report.ParameterFields(F_DATE_OF_DEATH).AddCurrentValue "n/a" End If 308 Form2Report.ParameterFields(F_IMRTProcedureDates).AddCurrentValue Left$(Replace(IMRTProcedureDates, "/", "-"), 255) 310 Form2Report.ParameterFields(F_NBSFilterCardNo).AddCurrentValue NBSFilterCardNo End If 312 .Close End With 314 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 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" 134 ElseIf !Total > 24 And !Total < 29 Then 136 countDiag = "7" 138 ElseIf !Total > 28 And !Total < 33 Then 140 countDiag = "8" 142 ElseIf !Total > 32 And !Total < 37 Then 144 countDiag = "9" 146 ElseIf !Total > 36 And !Total < 41 Then 148 countDiag = "10" End If End If 150 .Close End With 152 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 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 Function ChckDiagnosis(stridnum As String, DiagID As String) As Boolean ' On Error GoTo ChckDiagnosis_Err ' Dim recX As New ADODB.Recordset Dim SQL As String 100 SQL = "SELECT DiagID from Medicare..tbMedDiagnosis Where IDNum = '" & stridnum & "' and DiagID = '" & DiagID & "'" 102 ChckDiagnosis = False 104 With recX 106 If .State > 0 Then .Close 108 .CursorLocation = adUseClient 110 .Open SQL, user.SQLConnection, adOpenDynamic, adLockReadOnly 112 If .RecordCount > 0 Then 114 ChckDiagnosis = True End If 116 .Close End With 118 Set recX = Nothing ' Exit Function ChckDiagnosis_Err: MsgBox Err.Description & vbCrLf & _ "in prjMedicare.modTemp.ChckDiagnosis " & _ "at line " & Erl, _ vbExclamation + vbOKOnly, "Application Error" Resume Next ' End Function '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 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 Public Function GetPF_Package(stridnum As String, strDocID As String, Optional intOption As DOCTOR_PF = FirstCase_PF) As Currency ' On Error GoTo GetPF_Package_Err ' Dim recX As New ADODB.Recordset 100 GetPF_Package = 0 102 If recX.State > 0 Then recX.Close 104 recX.CursorLocation = adUseClient 106 recX.Open "Medic_GetMedicarePF_Package '" + stridnum + "','" + strDocID + "'", user.SQLConnection, adOpenDynamic, adLockReadOnly 108 If recX.RecordCount > 0 Then 110 If intOption = FirstCase_PF Then 112 GetPF_Package = recX![FirstMedicarePF] Else 114 GetPF_Package = recX![SecondMedicarePF] End If End If 116 If recX.State > 0 Then recX.Close 118 Set recX = Nothing ' Exit Function GetPF_Package_Err: MsgBox Err.Description & vbCrLf & _ "in prjMedicare.modTemp.GetPF_Package " & _ "at line " & Erl, _ vbExclamation + vbOKOnly, "Application Error" Resume Next ' End Function Public Function MemberTypeNonPhicExists() As Boolean ' On Error GoTo MemberTypeNonPhicExists_Err ' Dim recX As New ADODB.Recordset Dim SQL As String 100 MemberTypeNonPhicExists = False 102 SQL = "SELECT * from Medicare..tbmedtype where code = 0" 104 With recX 106 If .State > 0 Then .Close 108 .CursorLocation = adUseClient 110 .Open SQL, user.SQLConnection, adOpenDynamic, adLockReadOnly 112 If .RecordCount > 0 Then 114 MemberTypeNonPhicExists = True End If 116 .Close End With 118 Set recX = Nothing ' Exit Function MemberTypeNonPhicExists_Err: MsgBox Err.Description & vbCrLf & _ "in prjMedicare.modTemp.MemberTypeNonPhicExists " & _ "at line " & Erl, _ vbExclamation + vbOKOnly, "Application Error" Resume Next ' End Function Public Function IsAutoComputeVATDoctor() As Boolean ' On Error GoTo IsAutoComputeVATDoctor_Err ' Dim SQL As String 100 IsAutoComputeVATDoctor = False 102 SQL = "Select top 1 isnull(isAutoComputeVatPF,0) as isAutoComputeVatPF from Medicare..tbmedhospital" 104 With Rec 106 If .State > 0 Then .Close 108 .CursorLocation = adUseClient 110 .Open SQL, user.SQLConnection, adOpenDynamic, adLockReadOnly 112 If .RecordCount > 0 Then ' If .EOF = False Then 114 IsAutoComputeVATDoctor = !isAutoComputeVatPF End If 116 .Close End With ' Exit Function IsAutoComputeVATDoctor_Err: MsgBox Err.Description & vbCrLf & _ "in prjMedicare.modTemp.IsAutoComputeVATDoctor " & _ "at line " & Erl, _ vbExclamation + vbOKOnly, "Application Error" Resume Next ' End Function Public Function IsAutoComputeTax() As Boolean ' On Error GoTo IsAutoComputeTax_Err ' Dim SQL As String 100 IsAutoComputeTax = False 102 SQL = "Select top 1 isnull(isAutoComputeTaxPF,0) as isAutoComputeTaxPF from Medicare..tbmedhospital" 104 With Rec 106 If .State > 0 Then .Close 108 .CursorLocation = adUseClient 110 .Open SQL, user.SQLConnection, adOpenDynamic, adLockReadOnly 112 If .RecordCount > 0 Then ' If .EOF = False Then 114 IsAutoComputeTax = !isAutoComputeTaxPF End If 116 .Close End With ' Exit Function IsAutoComputeTax_Err: MsgBox Err.Description & vbCrLf & _ "in prjMedicare.modTemp.IsAutoComputeTax " & _ "at line " & Erl, _ vbExclamation + vbOKOnly, "Application Error" Resume Next ' End Function Public Function countDoctorWActualPF(stridnum As String) As Double ' On Error GoTo countDoctorWActualPF_Err ' Dim recX As New ADODB.Recordset Dim SQL As String 100 dblCountDoctor = 0 102 SQL = "SELECT isnull(COUNT(idnum),1) [Total] from Medicare..tbMedDoctors Where IDNum = '" & stridnum & "' and isnull(actualPF, 0) <> 0 " 104 With recX 106 If .State > 0 Then .Close 108 .CursorLocation = adUseClient 110 .Open SQL, user.SQLConnection, adOpenDynamic, adLockReadOnly 112 If .RecordCount > 0 Then 114 countDoctorWActualPF = !Total / 3 End If 116 .Close End With 118 Set recX = Nothing 120 dblCountDoctor = countDoctorWActualPF ' Exit Function countDoctorWActualPF_Err: MsgBox Err.Description & vbCrLf & _ "in prjMedicare.modTemp.countDoctorWActualPF " & _ "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 'added by ange 08142020 Public Function IsSinglePeriodCon(ICDRVS As String) As Boolean ' On Error GoTo IsSinglePeriodCon_Err ' Dim SQL As String 100 IsSinglePeriodCon = False 102 SQL = "Select isnull(IsSinglePeriodCon,0) IsSinglePeriodCon from medicare..vwICDRVS where CaseCode = '" & ICDRVS & "'" 104 With Rec 106 If .State > 0 Then .Close 108 .Open SQL, user.SQLConnection, adOpenDynamic, adLockReadOnly 110 If .EOF = False Then 112 IsSinglePeriodCon = !IsSinglePeriodCon End If 114 .Close End With 116 Set Rec = Nothing ' Exit Function IsSinglePeriodCon_Err: MsgBox Err.Description & vbCrLf & _ "in prjMedicare.modTemp.IsSinglePeriodCon " & _ "at line " & Erl, _ vbExclamation + vbOKOnly, "Application Error" Resume Next ' End Function Public Function Is45DaysAnnualBenefit(ICDRVS As String) As Boolean ' On Error GoTo Is45DaysAnnualBenefit_Err ' Dim SQL As String 100 Is45DaysAnnualBenefit = False 102 SQL = "Select isnull(Is45DaysAnnualBenefit,0) Is45DaysAnnualBenefit from medicare..vwICDRVS where CaseCode = '" & ICDRVS & "'" 104 With Rec 106 If .State > 0 Then .Close 108 .Open SQL, user.SQLConnection, adOpenDynamic, adLockReadOnly 110 If .EOF = False Then 112 Is45DaysAnnualBenefit = !Is45DaysAnnualBenefit End If 114 .Close End With 116 Set Rec = Nothing ' Exit Function Is45DaysAnnualBenefit_Err: MsgBox Err.Description & vbCrLf & _ "in prjMedicare.modTemp.Is45DaysAnnualBenefit " & _ "at line " & Erl, _ vbExclamation + vbOKOnly, "Application Error" Resume Next ' End Function Public Function Load_ModSettings_Value(intModSet_ID As Integer) 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, IsNull(ModSet_ID, 0) ModSet_ID from Medicare..tbMed_ModuleSettings Where ModSet_ID = '" & intModSet_ID & "'", user.SQLConnection, adOpenDynamic, adLockReadOnly 108 If recX.RecordCount > 0 Then 110 Load_ModSettings_Value = recX!ModSet_Status ' intModSet_ID = recX!ModSet_ID End If 112 If recX.State > 0 Then recX.Close 114 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 Function isCF4Verified(stridnum As String) As Boolean ' On Error GoTo isCF4Verified_Err ' Dim SQL As String 100 isCF4Verified = False 102 blnCF4ExemptCode = False 104 SQL = "Select Medicare.dbo.fn_isCF4Verified('" & stridnum & "') as CF4Verified" 106 With Rec 108 If .State > 0 Then .Close 110 .CursorLocation = adUseClient 112 .Open SQL, user.SQLConnection, adOpenDynamic, adLockReadOnly 114 If .RecordCount > 0 Then ' If !CF4Verified = 1 Then ' isCF4Verified = True ' End If 116 Select Case !CF4Verified ' Case 1, 2 ' isCF4Verified = True Case 1 118 isCF4Verified = True 120 Case 2 122 blnCF4ExemptCode = True End Select End If 124 .Close End With 126 Set Rec = Nothing ' Exit Function isCF4Verified_Err: MsgBox Err.Description & vbCrLf & _ "in prjMedicare.modTemp.isCF4Verified " & _ "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 Public Function get_PhicTypeCode(strtype As String, intItem As Integer) As String ' On Error GoTo get_PhicTypeCode_Err ' Dim SQL As String 100 get_PhicTypeCode = "" 102 SQL = "Select Medicare.dbo.get_PhicTypeCode('" & strtype & "', '" & intItem & "') as PhicTypeCode" 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 get_PhicTypeCode = !PhicTypeCode End If 116 .Close End With 118 Set Rec = Nothing ' Exit Function get_PhicTypeCode_Err: MsgBox Err.Description & vbCrLf & _ "in prjMedicare.modTemp.get_PhicTypeCode " & _ "at line " & Erl, _ vbExclamation + vbOKOnly, "Application Error" Resume Next ' End Function 'AAC09222022 Public Function isNotForm2Printed(stridnum As String) As Boolean ' On Error GoTo isNotForm2Printed_Err ' Dim Rec As New ADODB.Recordset Dim SQL As String 100 isNotForm2Printed = True 102 SQL = "Select * from Medicare..tbmedpatient where IDNum = '" & stridnum & "' and isForm2Printed = 1" 104 With Rec 106 If .State > 0 Then .Close 108 .CursorLocation = adUseClient 110 .CursorType = adOpenDynamic 112 .LockType = adLockReadOnly 114 .Open SQL, user.SQLConnection 116 If .RecordCount > 0 Then 118 isNotForm2Printed = False End If 120 .Close End With 122 Set Rec = Nothing ' Exit Function isNotForm2Printed_Err: MsgBox Err.Description & vbCrLf & _ "in prjMedicare.modTemp.isNotForm2Printed " & _ "at line " & Erl, _ vbExclamation + vbOKOnly, "Application Error" Resume Next ' End Function 'added by ange 6.1.2016 Public Function GetCountConfinementHours(stridnum As String) As Long 'Integer ' On Error GoTo GetCountConfinementHours_Err ' Dim SQL As String 100 SQL = "Medicare..Medic_GetConfinementHours '" & stridnum & "'" 102 GetCountConfinementHours = 0 104 With recMember 106 If .State > 0 Then .Close 108 .CursorLocation = adUseClient 110 .Open SQL, user.SQLConnection, adOpenDynamic, adLockReadOnly 112 If .EOF = False Then 114 GetCountConfinementHours = !hours End If 116 .Close End With 118 Set recMember = Nothing 120 lngConfinementHours = GetCountConfinementHours ' Exit Function GetCountConfinementHours_Err: MsgBox Err.Description & vbCrLf & _ "in prjMedicare.modTemp.GetCountConfinementHours " & _ "at line " & Erl, _ vbExclamation + vbOKOnly, "Application Error" Resume Next ' End Function Public Function isFinalCall(stridnum As String) As Boolean ' On Error GoTo isFinalCall_Err ' Dim SQL As String 100 isFinalCall = False 102 SQL = "Select Medicare.dbo.fn_isFinalCall('" & stridnum & "') as isFinalCall" 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 isFinalCall = !isFinalCall End If 116 .Close End With 118 Set Rec = Nothing ' Exit Function isFinalCall_Err: MsgBox Err.Description & vbCrLf & _ "in prjMedicare.modTemp.isFinalCall " & _ "at line " & Erl, _ vbExclamation + vbOKOnly, "Application Error" Resume Next ' End Function 'AAC10212022 Public Sub PatientLogs(strHospNum As String, stridnum As String, strUserID As String, strRemarks As String) ' On Error GoTo PatientLogs_Err ' 100 user.SQLConnection.Execute "INSERT INTO Patient_Data..tbAdmPatientInfoUpdate " & _ " (Hospnum, IDNum, TransDate , UserID, Remarks, Module, Version) " & _ " Values('" & strHospNum & "', '" & stridnum & "', GETDATE(), '" & strUserID & "' , '" & strRemarks & "', 'PhilHealth', '" & App.Major & "." & App.Minor & "." & App.Revision & "' )" ' Exit Sub PatientLogs_Err: MsgBox Err.Description & vbCrLf & _ "in prjMedicare.modTemp.PatientLogs " & _ "at line " & Erl, _ vbExclamation + vbOKOnly, "Application Error" Resume Next ' End Sub Public Function FetchHospnum(stridnum As String) As String ' On Error GoTo FetchHospnum_Err ' Dim SQL As String Dim Rec As New ADODB.Recordset 100 FetchHospnum = "" 102 If IsNumeric(stridnum) Then 104 SQL = "Select hospnum from Patient_data..tbpatient where idnum = '" & stridnum & "'" Else 106 SQL = "Select hospnum from Patient_Data..tboutpatient where idnum = '" & stridnum & "'" End If 108 With Rec 110 If .State > 0 Then .Close 112 .CursorLocation = adUseClient ' .CursorType = adOpenDynamic ' .LockType = adLockOptimistic ' .Open SQL, user.sqlconnection ' ' If .RecordCount > 0 Then 114 .Open SQL, user.SQLConnection, adOpenDynamic, adLockReadOnly 116 If .EOF = False Then 118 FetchHospnum = !HospNum End If 120 .Close End With 122 Set Rec = Nothing ' Exit Function FetchHospnum_Err: MsgBox Err.Description & vbCrLf & _ "in prjMedicare.modTemp.FetchHospnum " & _ "at line " & Erl, _ vbExclamation + vbOKOnly, "Application Error" Resume Next ' End Function Public Function CheckSameDayConfinemenDay(strHospNum As String, stridnum As String) As Boolean ' On Error GoTo CheckSameDayConfinemenDay_Err ' Dim Rec As New ADODB.Recordset Dim SQL As String 100 CheckSameDayConfinemenDay = False 102 SQL = "Medicare..Medic_CheckSameDayConfinement '" & strHospNum & "','" & stridnum & "'" 104 With Rec 106 If .State > 0 Then .Close 108 .CursorLocation = adUseClient 110 .Open SQL, user.SQLConnection, adOpenDynamic, adLockReadOnly 112 If Not .EOF Then 114 CheckSameDayConfinemenDay = !Rec End If 116 .Close End With 118 Set Rec = Nothing ' Exit Function CheckSameDayConfinemenDay_Err: MsgBox Err.Description & vbCrLf & _ "in prjMedicare.modTemp.CheckSameDayConfinemenDay " & _ "at line " & Erl, _ vbExclamation + vbOKOnly, "Application Error" Resume Next ' End Function Public Function isPatient_PNFCirc20210012(stridnum As String) As Boolean ' On Error GoTo isPatient_PNFCirc20210012_Err ' Dim SQL As String 100 isPatient_PNFCirc20210012 = False 102 SQL = "Select Medicare.dbo.fn_isPxPNFCirc20210012('" & stridnum & "') as isPatient_PNFCirc20210012" 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 isPatient_PNFCirc20210012 = !isPatient_PNFCirc20210012 End If 116 .Close End With 118 Set Rec = Nothing ' Exit Function isPatient_PNFCirc20210012_Err: MsgBox Err.Description & vbCrLf & _ "in prjMedicare.modTemp.isPatient_PNFCirc20210012 " & _ "at line " & Erl, _ vbExclamation + vbOKOnly, "Application Error" Resume Next ' End Function ' 'Public Function isPatient_ACRIncCirc20240001(stridnum As String) As Boolean ' Dim SQL As String ' ' isPatient_ACRIncCirc20240001 = False ' SQL = "Select Medicare.dbo.fn_isPxACRIncCirc20240001('" & stridnum & "') as isPatient_ACRIncCirc20240001" ' ' With Rec ' If .State > 0 Then .Close ' .CursorLocation = adUseClient ' .Open SQL, user.SQLConnection, adOpenDynamic, adLockReadOnly ' ' If .RecordCount > 0 Then ' isPatient_ACRIncCirc20240001 = !isPatient_ACRIncCirc20240001 ' End If ' .Close ' End With ' Set Rec = Nothing 'End Function 'modified by arnold 1.9.2025 Public Sub fn_GetDateCaseRate(ByVal stridnum As String, ByRef RetValue As Boolean, ByRef TableDate As String) ' On Error GoTo fn_GetDateCaseRate_Err ' Dim SQL As String 100 SQL = "SELECT RetValue, DateValue FROM medicare..fn_GetDateCaseRate('" & 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 RetValue = .Fields("RetValue").value 114 TableDate = .Fields("DateValue").value Else 116 RetValue = False 118 TableDate = "" End If 120 .Close End With ' Exit Sub fn_GetDateCaseRate_Err: MsgBox Err.Description & vbCrLf & _ "in prjMedicare.modTemp.fn_GetDateCaseRate " & _ "at line " & Erl, _ vbExclamation + vbOKOnly, "Application Error" Resume Next ' End Sub Public Function isPatient_ESOACirc20230021(stridnum As String) As Boolean ' On Error GoTo isPatient_ESOACirc20230021_Err ' Dim SQL As String 100 isPatient_ESOACirc20230021 = False 102 SQL = "Select Medicare.dbo.fn_isPxESOACirc20230021('" & stridnum & "') as isPatient_ESOACirc20230021" 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 isPatient_ESOACirc20230021 = !isPatient_ESOACirc20230021 End If 116 .Close End With 118 Set Rec = Nothing ' Exit Function isPatient_ESOACirc20230021_Err: MsgBox Err.Description & vbCrLf & _ "in prjMedicare.modTemp.isPatient_ESOACirc20230021 " & _ "at line " & Erl, _ vbExclamation + vbOKOnly, "Application Error" Resume Next ' End Function 'Added by arnold 3.7.2024 Public Function isPatient_isMultiple(stridnum As String) As Boolean ' On Error GoTo isPatient_isMultiple_Err ' Dim SQL As String 100 isPatient_isMultiple = False 102 If IsNumeric(Trim$(stridnum)) Then 104 SQL = "Select isnull(isMultiple,'') as isPatient_isMultiple from Patient_data..tbpatient where idnum='" & stridnum & "' and isMultiple=1" Else 106 SQL = "Select isnull(isMultiple,'') as isPatient_isMultiple from Patient_data..tboutpatient where idnum='" & stridnum & "' and isMultiple=1" 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 isPatient_isMultiple = !isPatient_isMultiple End If 120 .Close End With 122 Set Rec = Nothing ' Exit Function isPatient_isMultiple_Err: MsgBox Err.Description & vbCrLf & _ "in prjMedicare.modTemp.isPatient_isMultiple " & _ "at line " & Erl, _ vbExclamation + vbOKOnly, "Application Error" Resume Next ' End Function