PDA

View Full Version : Critical Thinking Challenge



giraffe3289
08-19-2008, 07:46 AM
Hi all,

I work at a hospital and we are trying to update our physician profiles process. Physician profiles are like each physician's report card that the hospital keeps track of. As of right now, data gets mailed, emailed, scribbled on scraps of paper and sent to one person who gets to enter it all in and do a mail merge. Pretty ancient, I know.

I've written a VBA program to try and update everything automatically. My program currently does the following:

imports a list of active doctors for a specific department into a spreadsheet from an Access database along with basic information like licensure, insurance, etc. each of these fields are put into an array
asks the user to enter the current year
creates a new Excel file for that department and that year; each doctor from the list of active doctors is given their own tab in the Excel file and the tabs are named after the doctors
the profile template is then copied from another excel file into each doctor's worksheet
the program loops through the arrays, copying and pasting the insurance information, licensure information, etc. (Doctor 1 = worksheet 1 = the first entry of every array)
the program then compiles several spreadsheets into one spreadsheet. these spreadsheets are where several individuals report their numbers. they are in separate spreadsheets so that confidential data is only known to those who need to know it. the program takes this data and puts it into arrays
the program then loops through the arrays, copying and pasting the information into each doctor's excel fileThe program runs and works well; however, it does not account for a few things:

If a doctor leaves the institution, their name will not show up from the Access database because they are no longer active. So if the program is run during the middle of the year when we already have a file for that year, the file is overwritten, and any new doctors will be added but any doctors that have left will disappear. We need to keep their information for the time that they were at our institution, and all of this information would be lost.
Secondly, since all the data is put into arrays, the program copies the information, rather than links it. It would be very helpful if the program linked all the information so it would automatically update. However, the number of active doctors will vary so I don't know how to link without it being attached to a specific doctor/file.I'd really appreciate ANY insight that you may have. I'm new to VBA and programming and have been teaching myself. I'll attach my code below though be warned, it is a little lengthy.


Dim i As Integer
Dim tabName As String
Dim wk As Workbook
Dim awk As Workbook
Dim DocListName As Variant
Dim DocFirstLast As Variant
Dim year As String
Dim num_DocListName As Integer
Dim objSheet As Worksheet
Dim StatusName As Variant
Dim NYSLic As Variant
Dim Boards As Variant
Dim DEA As Variant
Dim MalPrac As Variant
Dim nxt_reappt_dt As Variant
Dim LastRow As Long
Dim Individual_Data As Workbook
Dim Peer_Review_Num_Cases_QTR1 As Variant
Dim Aspir_Pneumonia_QTR1 As Variant
Dim CNS_Complications_QTR1 As Variant
Dim Dental_Trauma_QTR1 As Variant
Dim MI_48hrs_QTR1 As Variant
Dim Ocular_Trauma_QTR1 As Variant
Dim Periph_Neuro_Def_QTR1 As Variant
Dim Post_LP_Headache_QTR1 As Variant
Dim Respiratory_Arrests_QTR1 As Variant
Dim Unplanned_ICU_QTR1 As Variant
Dim Other_Complications_QTR1 As Variant
Dim Num_ReIntubations_QTR1 As Variant
Dim FocusedReview_PerformIssues_QTR1 As Variant
Dim PatientComplaint_QTR1 As Variant
Dim HospitalStaffComplaint_QTR1 As Variant
Dim FamilyComplaint_QTR1 As Variant
Dim MedicalStaffComplaint_QTR1 As Variant
Dim HCAHPS_QTR1 As Variant
Dim PG_QTR1 As Variant
Dim Peer_Review_Num_Cases_QTR2 As Variant
Dim Aspir_Pneumonia_QTR2 As Variant
Dim CNS_Complications_QTR2 As Variant
Dim Dental_Trauma_QTR2 As Variant
Dim MI_48hrs_QTR2 As Variant
Dim Ocular_Trauma_QTR2 As Variant
Dim Periph_Neuro_Def_QTR2 As Variant
Dim Post_LP_Headache_QTR2 As Variant
Dim Respiratory_Arrests_QTR2 As Variant
Dim Unplanned_ICU_QTR2 As Variant
Dim Other_Complications_QTR2 As Variant
Dim Num_ReIntubations_QTR2 As Variant
Dim FocusedReview_PerformIssues_QTR2 As Variant
Dim PatientComplaint_QTR2 As Variant
Dim HospitalStaffComplaint_QTR2 As Variant
Dim FamilyComplaint_QTR2 As Variant
Dim MedicalStaffComplaint_QTR2 As Variant
Dim HCAHPS_QTR2 As Variant
Dim PG_QTR2 As Variant
Dim Peer_Review_Num_Cases_QTR3 As Variant
Dim Aspir_Pneumonia_QTR3 As Variant
Dim CNS_Complications_QTR3 As Variant
Dim Dental_Trauma_QTR3 As Variant
Dim MI_48hrs_QTR3 As Variant
Dim Ocular_Trauma_QTR3 As Variant
Dim Periph_Neuro_Def_QTR3 As Variant
Dim Post_LP_Headache_QTR3 As Variant
Dim Respiratory_Arrests_QTR3 As Variant
Dim Unplanned_ICU_QTR3 As Variant
Dim Other_Complications_QTR3 As Variant
Dim Num_ReIntubations_QTR3 As Variant
Dim FocusedReview_PerformIssues_QTR3 As Variant
Dim PatientComplaint_QTR3 As Variant
Dim HospitalStaffComplaint_QTR3 As Variant
Dim FamilyComplaint_QTR3 As Variant
Dim MedicalStaffComplaint_QTR3 As Variant
Dim HCAHPS_QTR3 As Variant
Dim PG_QTR3 As Variant
Dim Peer_Review_Num_Cases_QTR4 As Variant
Dim Aspir_Pneumonia_QTR4 As Variant
Dim CNS_Complications_QTR4 As Variant
Dim Dental_Trauma_QTR4 As Variant
Dim MI_48hrs_QTR4 As Variant
Dim Ocular_Trauma_QTR4 As Variant
Dim Periph_Neuro_Def_QTR4 As Variant
Dim Post_LP_Headache_QTR4 As Variant
Dim Respiratory_Arrests_QTR4 As Variant
Dim Unplanned_ICU_QTR4 As Variant
Dim Other_Complications_QTR4 As Variant
Dim Num_ReIntubations_QTR4 As Variant
Dim FocusedReview_PerformIssues_QTR4 As Variant
Dim PatientComplaint_QTR4 As Variant
Dim HospitalStaffComplaint_QTR4 As Variant
Dim FamilyComplaint_QTR4 As Variant
Dim MedicalStaffComplaint_QTR4 As Variant
Dim HCAHPS_QTR4 As Variant
Dim PG_QTR4 As Variant
Dim NosocomialInfections_QTR1 As Variant
Dim NosocomialInfections_QTR2 As Variant
Dim NosocomialInfections_QTR3 As Variant
Dim NosocomialInfections_QTR4 As Variant
Dim HIM_Suspension_QTR1 As Variant
Dim HIM_Suspension_QTR2 As Variant
Dim HIM_Suspension_QTR3 As Variant
Dim HIM_Suspension_QTR4 As Variant
Dim Meeting_Attendance_QTR1 As Variant
Dim Meeting_Attendance_QTR2 As Variant
Dim Meeting_Attendance_QTR3 As Variant
Dim Meeting_Attendance_QTR4 As Variant
Dim Drug_Utilization_QTR1 As Variant
Dim Illegible_Handwriting_QTR1 As Variant
Dim Unsafe_Abbreviations_QTR1 As Variant
Dim PRNs_QTR1 As Variant
Dim Drug_Utilization_QTR2 As Variant
Dim Illegible_Handwriting_QTR2 As Variant
Dim Unsafe_Abbreviations_QTR2 As Variant
Dim PRNs_QTR2 As Variant
Dim Drug_Utilization_QTR3 As Variant
Dim Illegible_Handwriting_QTR3 As Variant
Dim Unsafe_Abbreviations_QTR3 As Variant
Dim PRNs_QTR3 As Variant
Dim Drug_Utilization_QTR4 As Variant
Dim Illegible_Handwriting_QTR4 As Variant
Dim Unsafe_Abbreviations_QTR4 As Variant
Dim PRNs_QTR4 As Variant
Dim NYPORTS_QTR1 As Variant
Dim PRO_QTR1 As Variant
Dim DOH_QTR1 As Variant
Dim Blood_Utilization_QTR1 As Variant
Dim NYPORTS_QTR2 As Variant
Dim PRO_QTR2 As Variant
Dim DOH_QTR2 As Variant
Dim Blood_Utilization_QTR2 As Variant
Dim NYPORTS_QTR3 As Variant
Dim PRO_QTR3 As Variant
Dim DOH_QTR3 As Variant
Dim Blood_Utilization_QTR3 As Variant
Dim NYPORTS_QTR4 As Variant
Dim PRO_QTR4 As Variant
Dim DOH_QTR4 As Variant
Dim Blood_Utilization_QTR4 As Variant
Dim Focus_Peer_Review_QTR1 As Variant
Dim Focus_Peer_Review_QTR2 As Variant
Dim Focus_Peer_Review_QTR3 As Variant
Dim Focus_Peer_Review_QTR4 As Variant

Public Sub RunProfiles_Anesthesia()

' RunProfiles_Anesthesia:
' Updates Anesthesia Practitioner Profiles
' Makes "Anesthesia" sheet the active sheet
Set awk = Workbooks.Open("E:\Practitioner Profiling\TEST\CredData.xls")
Sheets("Anesthesia").Activate
' Refresh the data
ActiveSheet.Range("A1").Select
Selection.QueryTable.Refresh BackgroundQuery:=False
' Finds the last row of the column
LastRow = Cells(Rows.Count, "B").End(xlUp).Row
' Turns off alerts
Application.DisplayAlerts = False
' Imports JBK's anesthesia data into the Individual Data spreadsheet
Set awk = Workbooks.Open("E:\Practitioner Profiling\Practitioner Profiles\Reporting Individuals\BK,J.xls")
awk.Sheets("Anesthesia").Range("B3", "BZ" & LastRow + 3).Copy
Set Individual_Data = Workbooks.Open("E:\Practitioner Profiling\TEST\Individual Data.xls")
Individual_Data.Sheets("Anesthesia").Activate
Range("A1").Select
ActiveSheet.Paste
awk.Close SaveChanges:=False
' Selects the number of peer review cases for quarter one
Peer_Review_Num_Cases_QTR1 = Range("B3", "B" & LastRow + 1).Value
' Selects the number of aspir. pneumonia for quarter one
Aspir_Pneumonia_QTR1 = Range("C3", "C" & LastRow + 1).Value
' Selects CNS Complications for quarter one
CNS_Complications_QTR1 = Range("D3", "D" & LastRow + 1).Value
' Selects Dental Trauma for quarter one
Dental_Trauma_QTR1 = Range("E3", "E" & LastRow + 1).Value
' Selects MI within 48 hours for quarter one
MI_48hrs_QTR1 = Range("F3", "F" & LastRow + 1).Value
' Selects Ocular Trauma for quarter one
Ocular_Trauma_QTR1 = Range("G3", "G" & LastRow + 1).Value
' Selects Periph. Neuro Def. for quarter one
Periph_Neuro_Def_QTR1 = Range("H3", "H" & LastRow + 1).Value
' Selects Post-LP Headache for quarter one
Post_LP_Headache_QTR1 = Range("I3", "I" & LastRow + 1).Value
' Selects Respiratory Arrests for quarter one
Respiratory_Arrests_QTR1 = Range("J3", "J" & LastRow + 1).Value
' Selects Unplanned ICU within 24 hours of anesthesia for quarter one
Unplanned_ICU_QTR1 = Range("K3", "K" & LastRow + 1).Value
' Selects Other Complications for quarter one
Other_Complications_QTR1 = Range("L3", "L" & LastRow + 1).Value
' Selects Number of Re-Intubations for quarter one
Num_ReIntubations_QTR1 = Range("M3", "M" & LastRow + 1).Value
' Selects Number of Times Placed on Focused Review Due to Performance Issues for quarter one
FocusedReview_PerformIssues_QTR1 = Range("N3", "N" & LastRow + 1).Value
' Selects Patient COmplaint/Concern/Grievance for quarter one
PatientComplaint_QTR1 = Range("O3", "O" & LastRow + 1).Value
' Selects Hospital Staff Complaint/Concerns for quarter one
HospitalStaffComplaint_QTR1 = Range("P3", "P" & LastRow + 1).Value
' Selects Family Complaint/Concern/Grievance for quarter one
FamilyComplaint_QTR1 = Range("Q3", "Q" & LastRow + 1).Value
' Selects Medical/AHP Staff Complaint/Concern/Grievance for quarter one
MedicalStaffComplaint_QTR1 = Range("R3", "R" & LastRow + 1).Value
' Selects HCAHPS Physician Rate for quarter one
HCAHPS_QTR1 = Range("S3", "S" & LastRow + 1).Value
' Selects Press Ganey Customer Satisfaction for quarter one
PG_QTR1 = Range("T3", "T" & LastRow + 1).Value
' Selects the number of peer review cases for quarter two
Peer_Review_Num_Cases_QTR2 = Range("U3", "U" & LastRow + 1).Value
' Selects the number of aspir. pneumonia for quarter two
Aspir_Pneumonia_QTR2 = Range("V3", "V" & LastRow + 1).Value
' Selects CNS Complications for quarter two
CNS_Complications_QTR2 = Range("W3", "W" & LastRow + 1).Value
' Selects Dental Trauma for quarter two
Dental_Trauma_QTR2 = Range("X3", "X" & LastRow + 1).Value
' Selects MI within 48 hours for quarter two
MI_48hrs_QTR2 = Range("Y3", "Y" & LastRow + 1).Value
' Selects Ocular Trauma for quarter two
Ocular_Trauma_QTR2 = Range("Z3", "Z" & LastRow + 1).Value
' Selects Periph. Neuro Def. for quarter two
Periph_Neuro_Def_QTR2 = Range("AA3", "AA" & LastRow + 1).Value
' Selects Post-LP Headache for quarter two
Post_LP_Headache_QTR2 = Range("AB3", "AB" & LastRow + 1).Value
' Selects Respiratory Arrests for quarter two
Respiratory_Arrests_QTR2 = Range("AC3", "AC" & LastRow + 1).Value
' Selects Unplanned ICU within 24 hours of anesthesia for quarter two
Unplanned_ICU_QTR2 = Range("AD3", "AD" & LastRow + 1).Value
' Selects Other Complications for quarter two
Other_Complications_QTR2 = Range("AE3", "AE" & LastRow + 1).Value
' Selects Number of Re-Intubations for quarter two
Num_ReIntubations_QTR2 = Range("AF3", "AF" & LastRow + 1).Value
' Selects Number of Times Placed on Focused Review Due to Performance Issues for quarter two
FocusedReview_PerformIssues_QTR2 = Range("AG3", "AG" & LastRow + 1).Value
' Selects Patient COmplaint/Concern/Grievance for quarter two
PatientComplaint_QTR2 = Range("AH3", "AH" & LastRow + 1).Value
' Selects Hospital Staff Complaint/Concerns for quarter two
HospitalStaffComplaint_QTR2 = Range("AI3", "AI" & LastRow + 1).Value
' Selects Family Complaint/Concern/Grievance for quarter two
FamilyComplaint_QTR2 = Range("AJ3", "AJ" & LastRow + 1).Value
' Selects Medical/AHP Staff Complaint/Concern/Grievance for quarter two
MedicalStaffComplaint_QTR2 = Range("AK3", "AK" & LastRow + 1).Value
' Selects HCAHPS Physician Rate for quarter two
HCAHPS_QTR2 = Range("AL3", "AL" & LastRow + 1).Value
' Selects Press Ganey Customer Satisfaction for quarter two
PG_QTR2 = Range("AM3", "AM" & LastRow + 1).Value
' Selects the number of peer review cases for quarter three
Peer_Review_Num_Cases_QTR3 = Range("AN3", "AN" & LastRow + 1).Value
' Selects the number of aspir. pneumonia for quarter three
Aspir_Pneumonia_QTR3 = Range("AO3", "AO" & LastRow + 1).Value
' Selects CNS Complications for quarter three
CNS_Complications_QTR3 = Range("AP3", "AP" & LastRow + 1).Value
' Selects Dental Trauma for quarter three
Dental_Trauma_QTR3 = Range("AQ3", "AQ" & LastRow + 1).Value
' Selects MI within 48 hours for quarter three
MI_48hrs_QTR3 = Range("AR3", "AR" & LastRow + 1).Value
' Selects Ocular Trauma for quarter three
Ocular_Trauma_QTR3 = Range("AS3", "AS" & LastRow + 1).Value
' Selects Periph. Neuro Def. for quarter three
Periph_Neuro_Def_QTR3 = Range("AT3", "AT" & LastRow + 1).Value
' Selects Post-LP Headache for quarter three
Post_LP_Headache_QTR3 = Range("AU3", "AU" & LastRow + 1).Value
' Selects Respiratory Arrests for quarter three
Respiratory_Arrests_QTR3 = Range("AV3", "AV" & LastRow + 1).Value
' Selects Unplanned ICU within 24 hours of anesthesia for quarter three
Unplanned_ICU_QTR3 = Range("AW3", "AW" & LastRow + 1).Value
' Selects Other Complications for quarter three
Other_Complications_QTR3 = Range("AX3", "AX" & LastRow + 1).Value
' Selects Number of Re-Intubations for quarter three
Num_ReIntubations_QTR3 = Range("AY3", "AY" & LastRow + 1).Value
' Selects Number of Times Placed on Focused Review Due to Performance Issues for quarter three
FocusedReview_PerformIssues_QTR3 = Range("AZ3", "AZ" & LastRow + 1).Value
' Selects Patient COmplaint/Concern/Grievance for quarter three
PatientComplaint_QTR3 = Range("BA3", "BA" & LastRow + 1).Value
' Selects Hospital Staff Complaint/Concerns for quarter three
HospitalStaffComplaint_QTR3 = Range("BB3", "BB" & LastRow + 1).Value
' Selects Family Complaint/Concern/Grievance for quarter three
FamilyComplaint_QTR3 = Range("BC3", "BC" & LastRow + 1).Value
' Selects Medical/AHP Staff Complaint/Concern/Grievance for quarter three
MedicalStaffComplaint_QTR3 = Range("BD3", "BD" & LastRow + 1).Value
' Selects HCAHPS Physician Rate for quarter three
HCAHPS_QTR3 = Range("BE3", "BE" & LastRow + 1).Value
' Selects Press Ganey Customer Satisfaction for quarter three
PG_QTR3 = Range("BF3", "BF" & LastRow + 1).Value
' Selects the number of peer review cases for quarter four
Peer_Review_Num_Cases_QTR4 = Range("BG3", "BG" & LastRow + 1).Value
' Selects the number of aspir. pneumonia for quarter four
Aspir_Pneumonia_QTR4 = Range("BH3", "BH" & LastRow + 1).Value
' Selects CNS Complications for quarter four
CNS_Complications_QTR4 = Range("BI3", "BI" & LastRow + 1).Value
' Selects Dental Trauma for quarter four
Dental_Trauma_QTR4 = Range("BJ3", "BJ" & LastRow + 1).Value
' Selects MI within 48 hours for quarter four
MI_48hrs_QTR4 = Range("BK3", "BK" & LastRow + 1).Value
' Selects Ocular Trauma for quarter four
Ocular_Trauma_QTR4 = Range("BL3", "BL" & LastRow + 1).Value
' Selects Periph. Neuro Def. for quarter four
Periph_Neuro_Def_QTR4 = Range("BM3", "BM" & LastRow + 1).Value
' Selects Post-LP Headache for quarter four
Post_LP_Headache_QTR4 = Range("BN3", "BN" & LastRow + 1).Value
' Selects Respiratory Arrests for quarter four
Respiratory_Arrests_QTR4 = Range("BO3", "BO" & LastRow + 1).Value
' Selects Unplanned ICU within 24 hours of anesthesia for quarter four
Unplanned_ICU_QTR4 = Range("BP3", "BP" & LastRow + 1).Value
' Selects Other Complications for quarter four
Other_Complications_QTR4 = Range("BQ3", "BQ" & LastRow + 1).Value
' Selects Number of Re-Intubations for quarter four
Num_ReIntubations_QTR4 = Range("BR3", "BR" & LastRow + 1).Value
' Selects Number of Times Placed on Focused Review Due to Performance Issues for quarter four
FocusedReview_PerformIssues_QTR4 = Range("BS3", "BS" & LastRow + 1).Value
' Selects Patient Complaint/Concern/Grievance for quarter four
PatientComplaint_QTR4 = Range("BT3", "BT" & LastRow + 1).Value
' Selects Hospital Staff Complaint/Concerns for quarter four
HospitalStaffComplaint_QTR4 = Range("BU3", "BU" & LastRow + 1).Value
' Selects Family Complaint/Concern/Grievance for quarter four
FamilyComplaint_QTR4 = Range("BV3", "BV" & LastRow + 1).Value
' Selects Medical/AHP Staff Complaint/Concern/Grievance for quarter four
MedicalStaffComplaint_QTR4 = Range("BW3", "BW" & LastRow + 1).Value
' Selects HCAHPS Physician Rate for quarter four
HCAHPS_QTR4 = Range("BX3", "BX" & LastRow + 1).Value
' Selects Press Ganey Customer Satisfaction for quarter four
PG_QTR4 = Range("BY3", "BY" & LastRow + 1).Value
' Imports SC's anesthesia data into the Individual Data spreadsheet
Set awk = Workbooks.Open("E:\Practitioner Profiling\Practitioner Profiles\Reporting Individuals\C,S.xls")
awk.Sheets("Anesthesia").Range("C3", "F" & LastRow + 3).Copy
Individual_Data.Sheets("Anesthesia").Activate
Range("BZ1").Select
ActiveSheet.Paste
awk.Close SaveChanges:=False
' Selects Number of Nosocomial Infection Issues for quarter one
NosocomialInfections_QTR1 = Range("BZ3", "BZ" & LastRow + 1).Value
' Selects Number of Nosocomial Infection Issues for quarter two
NosocomialInfections_QTR2 = Range("CA3", "CA" & LastRow + 1).Value
' Selects Number of Nosocomial Infection Issues for quarter three
NosocomialInfections_QTR3 = Range("CB3", "CB" & LastRow + 1).Value
' Selects Number of Nosocomial Infection Issues for quarter four
NosocomialInfections_QTR4 = Range("CC3", "CC" & LastRow + 1).Value
' Imports TC's anesthesia data into the Individual Data spreadsheet
Set awk = Workbooks.Open("E:\Practitioner Profiling\Practitioner Profiles\Reporting Individuals\C,T.xls")
awk.Sheets("Anesthesia").Range("C3", "F" & LastRow + 3).Copy
Individual_Data.Sheets("Anesthesia").Activate
Range("CD1").Select
ActiveSheet.Paste
awk.Close SaveChanges:=False
' Selects Number of Times Suspended for Delinquent Medical Records for quarter one
HIM_Suspension_QTR1 = Range("CD3", "CD" & LastRow + 1).Value
' Selects Number of Times Suspended for Delinquent Medical Records for quarter two
HIM_Suspension_QTR2 = Range("CE3", "CE" & LastRow + 1).Value
' Selects Number of Times Suspended for Delinquent Medical Records for quarter three
HIM_Suspension_QTR3 = Range("CF3", "CF" & LastRow + 1).Value
' Selects Number of Times Suspended for Delinquent Medical Records for quarter four
HIM_Suspension_QTR4 = Range("CG3", "CG" & LastRow + 1).Value
' Imports JH's anesthesia data into the Individual Data spreadsheet
Set awk = Workbooks.Open("E:\Practitioner Profiling\Practitioner Profiles\Reporting Individuals\H,J.xls")
awk.Sheets("Anesthesia").Range("C3", "F" & LastRow + 3).Copy
Individual_Data.Sheets("Anesthesia").Activate
Range("CH1").Select
ActiveSheet.Paste
awk.Close SaveChanges:=False
' Selects Meeting Attendance for quarter one
Meeting_Attendance_QTR1 = Range("CH3", "CH" & LastRow + 1).Value
' Selects Meeting Attendance for quarter two
Meeting_Attendance_QTR2 = Range("CI3", "CI" & LastRow + 1).Value
' Selects Meeting Attendance for quarter three
Meeting_Attendance_QTR3 = Range("CJ3", "CJ" & LastRow + 1).Value
' Selects Meeting Attendance for quarter four
Meeting_Attendance_QTR4 = Range("CK3", "CK" & LastRow + 1).Value
' Imports MJ's anesthesia data into the Individual Data spreadsheet
Set awk = Workbooks.Open("E:\Practitioner Profiling\Practitioner Profiles\Reporting Individuals\J,M.xls")
awk.Sheets("Anesthesia").Range("C3", "R" & LastRow + 3).Copy
Individual_Data.Sheets("Anesthesia").Activate
Range("CL1").Select
ActiveSheet.Paste
awk.Close SaveChanges:=False
' Selects Drug Utilization Review for quarter one
Drug_Utilization_QTR1 = Range("CL3", "CL" & LastRow + 1).Value
' Selects Illegible Handwriting for quarter one
Illegible_Handwriting_QTR1 = Range("CM3", "CM" & LastRow + 1).Value
' Selects Unsafe Abbreviations for quarter one
Unsafe_Abbreviations_QTR1 = Range("CN3", "CN" & LastRow + 1).Value
' Selects # of PRNs for quarter one
PRNs_QTR1 = Range("CO3", "CO" & LastRow + 1).Value
' Selects Drug Utilization Review for quarter two
Drug_Utilization_QTR2 = Range("CL3", "CL" & LastRow + 1).Value
' Selects Illegible Handwriting for quarter two
Illegible_Handwriting_QTR2 = Range("CM3", "CM" & LastRow + 1).Value
' Selects Unsafe Abbreviations for quarter two
Unsafe_Abbreviations_QTR2 = Range("CN3", "CN" & LastRow + 1).Value
' Selects # of PRNs for quarter two
PRNs_QTR2 = Range("CO3", "CO" & LastRow + 1).Value
' Selects Drug Utilization Review for quarter three
Drug_Utilization_QTR3 = Range("CL3", "CL" & LastRow + 1).Value
' Selects Illegible Handwriting for quarter three
Illegible_Handwriting_QTR3 = Range("CM3", "CM" & LastRow + 1).Value
' Selects Unsafe Abbreviations for quarter three
Unsafe_Abbreviations_QTR3 = Range("CN3", "CN" & LastRow + 1).Value
' Selects # of PRNs for quarter three
PRNs_QTR3 = Range("CO3", "CO" & LastRow + 1).Value
' Selects Drug Utilization Review for quarter four
Drug_Utilization_QTR4 = Range("CL3", "CL" & LastRow + 1).Value
' Selects Illegible Handwriting for quarter four
Illegible_Handwriting_QTR4 = Range("CM3", "CM" & LastRow + 1).Value
' Selects Unsafe Abbreviations for quarter four
Unsafe_Abbreviations_QTR4 = Range("CN3", "CN" & LastRow + 1).Value
' Selects # of PRNs for quarter four
PRNs_QTR4 = Range("CO3", "CO" & LastRow + 1).Value
' Imports CL's anesthesia data into the Individual Data spreadsheet
Set awk = Workbooks.Open("E:\Practitioner Profiling\Practitioner Profiles\Reporting Individuals\L,C.xls")
awk.Sheets("Anesthesia").Range("C3", "R" & LastRow + 3).Copy
Individual_Data.Sheets("Anesthesia").Activate
Range("DB1").Select
ActiveSheet.Paste
awk.Close SaveChanges:=False
' Selects NYPORTS for quarter one
NYPORTS_QTR1 = Range("DB3", "DB" & LastRow + 1).Value
' Selects PRO Denials and Quality Issues for quarter one
PRO_QTR1 = Range("DC3", "DC" & LastRow + 1).Value
' Selects DOH Reportable Incidents for quarter one
DOH_QTR1 = Range("DD3", "DD" & LastRow + 1).Value
' Selects Blood Utilization Reivew for quarter one
Blood_Utilization_QTR1 = Range("DE3", "DE" & LastRow + 1).Value
' Selects NYPORTS for quarter two
NYPORTS_QTR2 = Range("DF3", "DF" & LastRow + 1).Value
' Selects PRO Denials and Quality Issues for quarter two
PRO_QTR2 = Range("DG3", "DG" & LastRow + 1).Value
' Selects DOH Reportable Incidents for quarter two
DOH_QTR2 = Range("DH3", "DH" & LastRow + 1).Value
' Selects Blood Utilization Reivew for quarter two
Blood_Utilization_QTR2 = Range("DI3", "DI" & LastRow + 1).Value
' Selects NYPORTS for quarter three
NYPORTS_QTR3 = Range("DJ3", "DJ" & LastRow + 1).Value
' Selects PRO Denials and Quality Issues for quarter three
PRO_QTR3 = Range("DK3", "DK" & LastRow + 1).Value
' Selects DOH Reportable Incidents for quarter three
DOH_QTR3 = Range("DL3", "DL" & LastRow + 1).Value
' Selects Blood Utilization Reivew for quarter three
Blood_Utilization_QTR3 = Range("DM3", "DM" & LastRow + 1).Value
' Selects NYPORTS for quarter four
NYPORTS_QTR4 = Range("DN3", "DN" & LastRow + 1).Value
' Selects PRO Denials and Quality Issues for quarter four
PRO_QTR4 = Range("DO3", "DO" & LastRow + 1).Value
' Selects DOH Reportable Incidents for quarter four
DOH_QTR4 = Range("DP3", "DP" & LastRow + 1).Value
' Selects Blood Utilization Reivew for quarter four
Blood_Utilization_QTR4 = Range("DQ3", "DQ" & LastRow + 1).Value
' Imports PP's anesthesia data into the Individual Data spreadsheet
Set awk = Workbooks.Open("E:\Practitioner Profiling\Practitioner Profiles\Reporting Individuals\P,P.xls")
awk.Sheets("Anesthesia").Range("C3", "F" & LastRow + 3).Copy
Individual_Data.Sheets("Anesthesia").Activate
Range("DR1").Select
ActiveSheet.Paste
awk.Close SaveChanges:=False
' Selects Focus Peer Review for quarter one
Focus_Peer_Review_QTR1 = Range("DR3", "DR" & LastRow + 1).Value
' Selects Focus Peer Review for quarter two
Focus_Peer_Review_QTR2 = Range("DS3", "DS" & LastRow + 1).Value
' Selects Focus Peer Review for quarter three
Focus_Peer_Review_QTR3 = Range("DT3", "DT" & LastRow + 1).Value
' Selects Focus Peer Review for quarter four
Focus_Peer_Review_QTR4 = Range("DU3", "DU" & LastRow + 1).Value
' Turns on alerts
Application.DisplayAlerts = True
' Activates CredData workbook and Anesthesia worksheet
Set awk = Workbooks("CredData.xls")
awk.Sheets("Anesthesia").Activate
' Selects active practitioner list with last name, first name, and title
DocListName = Range("B2", "B" & LastRow).Value
' Counts the number of active practitioners
num_DocListName = UBound(DocListName)
' Selects active practitioner list with first name, last name, and title
DocFirstLast = Range("G2", "G" & LastRow).Value
' Selects status list
StatusName = Range("H2", "H" & LastRow).Value
' Selects NYS License list
NYSLic = Range("J2", "J" & LastRow).Value
' Selects boards list
Boards = Range("K2", "K" & LastRow).Value
' Selects DEA list
DEA = Range("L2", "L" & LastRow).Value
' Selects malpractice insurance list
MalPrac = Range("N2", "N" & LastRow).Value
' Selects reappointment period list
nxt_reappt_dt = Range("U2", "U" & LastRow).Value
' Asks user to input the year that the profiles will be for
year = InputBox("Please enter the profile year:")
If year = "" Then Exit Sub
' Creates new workbook for the department for the appropriate year
Set wk = Workbooks.Add
wk.SaveAs ("E:\Practitioner Profiling\TEST\Anesthesia " & year & ".xls")
' Creates sheets for each individual practitioner
For i = 1 To UBound(DocListName)
For Each objSheet In ActiveWorkbook.Sheets
If objSheet.Name = DocListName(i, 1) Then Exit Sub
Next objSheet
Worksheets.Add after:=Sheets(ActiveWorkbook.Sheets.Count)
ActiveSheet.Name = DocListName(i, 1)
ActiveWindow.DisplayGridlines = False
Next
' Deletes the worksheet's original blank sheet
Application.DisplayAlerts = False
Sheets("Sheet1").Delete
Application.DisplayAlerts = True
i = 1
' Opens profile template for anesthesia department and copies the template, then closes without saving changes
Workbooks.Open ("E:\Practitioner Profiling\Modified Lakeside Templates\Anesthesiology Mock Up.xls")
ActiveSheet.Range("A1:I94").Copy
wk.Sheets(DocListName(i, 1)).Paste
Application.DisplayAlerts = False
ActiveWorkbook.Close SaveChanges:=False
Application.DisplayAlerts = True
' Loop to paste the template into each practitioner's sheet, format the sheet, and add the practitioner's name and profile time period
wk.Sheets(DocListName(1, 1)).Range("A1:I94").Copy
For i = 1 To UBound(DocListName)
For Each Sheet In wk.Sheets
wk.Sheets(DocListName(1, 1)).Range("A1:I94").Copy
wk.Sheets(DocListName(i, 1)).Paste
wk.Sheets(DocListName(i, 1)).Activate
' Merges cells to keep profile formatting
ActiveSheet.Range("A2:I2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
ActiveSheet.Range("A4:I4").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
ActiveSheet.Range("A6:I6").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
ActiveSheet.Range("A30:I30").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge

Range("B11:G11").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Range("C12:G12,C13:G13,C14:G14,C15:G15,C16:G16,C17:G17").Select
Range("C17").Activate
Range("C12:G12,C13:G13,C14:G14,C15:G15,C16:G16,C17:G17,B33:H33,B53:H53,B59:H59" _
).Select
Range("B59").Activate
Range( _
"C12:G12,C13:G13,C14:G14,C15:G15,C16:G16,C17:G17,B33:H33,B53:H53,B59:H59,B63 :H63,B67:H67,B75:H75" _
).Select
Range("B75").Activate
With Selection
.HorizontalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
With Selection
.HorizontalAlignment = xlLeft
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With


ActiveSheet.PageSetup.PrintArea = "$A$1:$I$94"
ActiveSheet.Range("H9").Select
ActiveCell.Value = year
ActiveSheet.PageSetup.Zoom = False
ActiveSheet.PageSetup.FitToPagesWide = 1
ActiveSheet.PageSetup.FitToPagesTall = 1
ActiveSheet.Range("C9").Select
ActiveCell.Value = DocFirstLast(i, 1)
ActiveSheet.PageSetup.CenterHorizontally = True
ActiveSheet.PageSetup.CenterVertically = False
' Copy CredData
' Board Certification
ActiveSheet.Range("C12").Select
ActiveCell.Value = Boards(i, 1)
' Appointment Period
ActiveSheet.Range("C13").Select
ActiveCell.Value = nxt_reappt_dt(i, 1)
' Present Status
ActiveSheet.Range("C14").Select
ActiveCell.Value = StatusName(i, 1)
' NYS License Expiration
ActiveSheet.Range("C15").Select
ActiveCell.Value = NYSLic(i, 1)
' DEA Expiration
ActiveSheet.Range("C16").Select
ActiveCell.Value = DEA(i, 1)
' Insurance Expiration
ActiveSheet.Range("C17").Select
ActiveCell.Value = MalPrac(i, 1)
' Copy Individual Data
' Copy JBK's Data
' Peer Review: # Cases
ActiveSheet.Range("C34").Select
ActiveCell.Value = Peer_Review_Num_Cases_QTR1(i, 1)
ActiveSheet.Range("D34").Select
ActiveCell.Value = Peer_Review_Num_Cases_QTR2(i, 1)
ActiveSheet.Range("E34").Select
ActiveCell.Value = Peer_Review_Num_Cases_QTR3(i, 1)
ActiveSheet.Range("F34").Select
ActiveCell.Value = Peer_Review_Num_Cases_QTR4(i, 1)
' Aspir. Pneumonia
ActiveSheet.Range("C41").Select
ActiveCell.Value = Aspir_Pneumonia_QTR1(i, 1)
ActiveSheet.Range("D41").Select
ActiveCell.Value = Aspir_Pneumonia_QTR2(i, 1)
ActiveSheet.Range("E41").Select
ActiveCell.Value = Aspir_Pneumonia_QTR3(i, 1)
ActiveSheet.Range("F41").Select
ActiveCell.Value = Aspir_Pneumonia_QTR4(i, 1)
' CNS Complications
ActiveSheet.Range("C42").Select
ActiveCell.Value = CNS_Complications_QTR1(i, 1)
ActiveSheet.Range("D42").Select
ActiveCell.Value = CNS_Complications_QTR2(i, 1)
ActiveSheet.Range("E42").Select
ActiveCell.Value = CNS_Complications_QTR3(i, 1)
ActiveSheet.Range("F42").Select
ActiveCell.Value = CNS_Complications_QTR4(i, 1)
' Dental Trauma
ActiveSheet.Range("C43").Select
ActiveCell.Value = Dental_Trauma_QTR1(i, 1)
ActiveSheet.Range("D43").Select
ActiveCell.Value = Dental_Trauma_QTR2(i, 1)
ActiveSheet.Range("E43").Select
ActiveCell.Value = Dental_Trauma_QTR3(i, 1)
ActiveSheet.Range("F43").Select
ActiveCell.Value = Dental_Trauma_QTR4(i, 1)
' MI within 48 hours
ActiveSheet.Range("C44").Select
ActiveCell.Value = MI_48hrs_QTR1(i, 1)
ActiveSheet.Range("D44").Select
ActiveCell.Value = MI_48hrs_QTR2(i, 1)
ActiveSheet.Range("E44").Select
ActiveCell.Value = MI_48hrs_QTR3(i, 1)
ActiveSheet.Range("F44").Select
ActiveCell.Value = MI_48hrs_QTR4(i, 1)
' Ocular Trauma
ActiveSheet.Range("C45").Select
ActiveCell.Value = Ocular_Trauma_QTR1(i, 1)
ActiveSheet.Range("D45").Select
ActiveCell.Value = Ocular_Trauma_QTR2(i, 1)
ActiveSheet.Range("E45").Select
ActiveCell.Value = Ocular_Trauma_QTR3(i, 1)
ActiveSheet.Range("F45").Select
ActiveCell.Value = Ocular_Trauma_QTR4(i, 1)
' Periph. Neuro Def.
ActiveSheet.Range("C46").Select
ActiveCell.Value = Periph_Neuro_Def_QTR1(i, 1)
ActiveSheet.Range("D46").Select
ActiveCell.Value = Periph_Neuro_Def_QTR2(i, 1)
ActiveSheet.Range("E46").Select
ActiveCell.Value = Periph_Neuro_Def_QTR3(i, 1)
ActiveSheet.Range("F46").Select
ActiveCell.Value = Periph_Neuro_Def_QTR4(i, 1)
' Post-LP Headache
ActiveSheet.Range("C47").Select
ActiveCell.Value = Post_LP_Headache_QTR1(i, 1)
ActiveSheet.Range("D47").Select
ActiveCell.Value = Post_LP_Headache_QTR2(i, 1)
ActiveSheet.Range("E47").Select
ActiveCell.Value = Post_LP_Headache_QTR3(i, 1)
ActiveSheet.Range("F47").Select
ActiveCell.Value = Post_LP_Headache_QTR4(i, 1)
' Respiratory Arrests
ActiveSheet.Range("C48").Select
ActiveCell.Value = Respiratory_Arrests_QTR1(i, 1)
ActiveSheet.Range("D48").Select
ActiveCell.Value = Respiratory_Arrests_QTR2(i, 1)
ActiveSheet.Range("E48").Select
ActiveCell.Value = Respiratory_Arrests_QTR3(i, 1)
ActiveSheet.Range("F48").Select
ActiveCell.Value = Respiratory_Arrests_QTR4(i, 1)
' Unplanned ICU visit within 24 hours of anesthesia
ActiveSheet.Range("C49").Select
ActiveCell.Value = Unplanned_ICU_QTR1(i, 1)
ActiveSheet.Range("D49").Select
ActiveCell.Value = Unplanned_ICU_QTR2(i, 1)
ActiveSheet.Range("E49").Select
ActiveCell.Value = Unplanned_ICU_QTR3(i, 1)
ActiveSheet.Range("F49").Select
ActiveCell.Value = Unplanned_ICU_QTR4(i, 1)
' Other Complications
ActiveSheet.Range("C50").Select
ActiveCell.Value = Other_Complications_QTR1(i, 1)
ActiveSheet.Range("D50").Select
ActiveCell.Value = Other_Complications_QTR2(i, 1)
ActiveSheet.Range("E50").Select
ActiveCell.Value = Other_Complications_QTR3(i, 1)
ActiveSheet.Range("F50").Select
ActiveCell.Value = Other_Complications_QTR4(i, 1)
' Number of Reintubations
ActiveSheet.Range("C65").Select
ActiveCell.Value = Num_ReIntubations_QTR1(i, 1)
ActiveSheet.Range("D65").Select
ActiveCell.Value = Num_ReIntubations_QTR2(i, 1)
ActiveSheet.Range("E65").Select
ActiveCell.Value = Num_ReIntubations_QTR3(i, 1)
ActiveSheet.Range("F65").Select
ActiveCell.Value = Num_ReIntubations_QTR4(i, 1)
' Number of Times Placed on Focused Review Due to Performance Issues
ActiveSheet.Range("C62").Select
ActiveCell.Value = FocusedReview_PerformIssues_QTR1(i, 1)
ActiveSheet.Range("D62").Select
ActiveCell.Value = FocusedReview_PerformIssues_QTR2(i, 1)
ActiveSheet.Range("E62").Select
ActiveCell.Value = FocusedReview_PerformIssues_QTR3(i, 1)
ActiveSheet.Range("F62").Select
ActiveCell.Value = FocusedReview_PerformIssues_QTR4(i, 1)
' Patient Complaint/Concern/Grievance
ActiveSheet.Range("C68").Select
ActiveCell.Value = PatientComplaint_QTR1(i, 1)
ActiveSheet.Range("D68").Select
ActiveCell.Value = PatientComplaint_QTR2(i, 1)
ActiveSheet.Range("E68").Select
ActiveCell.Value = PatientComplaint_QTR3(i, 1)
ActiveSheet.Range("F68").Select
ActiveCell.Value = PatientComplaint_QTR4(i, 1)
' Hospital Staff Complaint/Concerns
ActiveSheet.Range("C69").Select
ActiveCell.Value = HospitalStaffComplaint_QTR1(i, 1)
ActiveSheet.Range("D69").Select
ActiveCell.Value = HospitalStaffComplaint_QTR2(i, 1)
ActiveSheet.Range("E69").Select
ActiveCell.Value = HospitalStaffComplaint_QTR3(i, 1)
ActiveSheet.Range("F69").Select
ActiveCell.Value = HospitalStaffComplaint_QTR4(i, 1)
' Family Complaint/Concern/Grievance
ActiveSheet.Range("C70").Select
ActiveCell.Value = FamilyComplaint_QTR1(i, 1)
ActiveSheet.Range("D70").Select
ActiveCell.Value = FamilyComplaint_QTR2(i, 1)
ActiveSheet.Range("E70").Select
ActiveCell.Value = FamilyComplaint_QTR3(i, 1)
ActiveSheet.Range("F70").Select
ActiveCell.Value = FamilyComplaint_QTR4(i, 1)
' Medical/AHP Staff Complaint/Concern
ActiveSheet.Range("C71").Select
ActiveCell.Value = MedicalStaffComplaint_QTR1(i, 1)
ActiveSheet.Range("D71").Select
ActiveCell.Value = MedicalStaffComplaint_QTR2(i, 1)
ActiveSheet.Range("E71").Select
ActiveCell.Value = MedicalStaffComplaint_QTR3(i, 1)
ActiveSheet.Range("F71").Select
ActiveCell.Value = MedicalStaffComplaint_QTR4(i, 1)
' HCAHPS Physician Rate
ActiveSheet.Range("C72").Select
ActiveCell.Value = HCAHPS_QTR1(i, 1)
ActiveSheet.Range("D72").Select
ActiveCell.Value = HCAHPS_QTR2(i, 1)
ActiveSheet.Range("E72").Select
ActiveCell.Value = HCAHPS_QTR3(i, 1)
ActiveSheet.Range("F72").Select
ActiveCell.Value = HCAHPS_QTR4(i, 1)
' Press Ganey Customer Satisfaction
ActiveSheet.Range("C73").Select
ActiveCell.Value = PG_QTR1(i, 1)
ActiveSheet.Range("D73").Select
ActiveCell.Value = PG_QTR2(i, 1)
ActiveSheet.Range("E73").Select
ActiveCell.Value = PG_QTR3(i, 1)
ActiveSheet.Range("F73").Select
ActiveCell.Value = PG_QTR4(i, 1)
' Copy SC's Data
' Number of Nosocomial Infection Issues
ActiveSheet.Range("C54").Select
ActiveCell.Value = NosocomialInfections_QTR1(i, 1)
ActiveSheet.Range("D54").Select
ActiveCell.Value = NosocomialInfections_QTR2(i, 1)
ActiveSheet.Range("E54").Select
ActiveCell.Value = NosocomialInfections_QTR3(i, 1)
ActiveSheet.Range("F54").Select
ActiveCell.Value = NosocomialInfections_QTR4(i, 1)
' Copy TC's Data
' Number of Times Suspended for Delinquent Medical Records
ActiveSheet.Range("C79").Select
ActiveCell.Value = HIM_Suspension_QTR1(i, 1)
ActiveSheet.Range("D79").Select
ActiveCell.Value = HIM_Suspension_QTR2(i, 1)
ActiveSheet.Range("E79").Select
ActiveCell.Value = HIM_Suspension_QTR3(i, 1)
ActiveSheet.Range("F79").Select
ActiveCell.Value = HIM_Suspension_QTR4(i, 1)
' Copy JH's Data
' Meeting Attendance
ActiveSheet.Range("C61").Select
ActiveCell.Value = Meeting_Attendance_QTR1(i, 1)
ActiveSheet.Range("D61").Select
ActiveCell.Value = Meeting_Attendance_QTR2(i, 1)
ActiveSheet.Range("E61").Select
ActiveCell.Value = Meeting_Attendance_QTR3(i, 1)
ActiveSheet.Range("F61").Select
ActiveCell.Value = Meeting_Attendance_QTR4(i, 1)
' Copy MJ's Data
' Drug Utilization Review
ActiveSheet.Range("C51").Select
ActiveCell.Value = Drug_Utilization_QTR1(i, 1)
ActiveSheet.Range("D51").Select
ActiveCell.Value = Drug_Utilization_QTR2(i, 1)
ActiveSheet.Range("E51").Select
ActiveCell.Value = Drug_Utilization_QTR3(i, 1)
ActiveSheet.Range("F51").Select
ActiveCell.Value = Drug_Utilization_QTR4(i, 1)
' Illegible Handwriting
ActiveSheet.Range("C77").Select
ActiveCell.Value = Illegible_Handwriting_QTR1(i, 1)
ActiveSheet.Range("D77").Select
ActiveCell.Value = Illegible_Handwriting_QTR2(i, 1)
ActiveSheet.Range("E77").Select
ActiveCell.Value = Illegible_Handwriting_QTR3(i, 1)
ActiveSheet.Range("F77").Select
ActiveCell.Value = Illegible_Handwriting_QTR4(i, 1)
' Unsafe Abbreviations
ActiveSheet.Range("C76").Select
ActiveCell.Value = Unsafe_Abbreviations_QTR1(i, 1)
ActiveSheet.Range("D76").Select
ActiveCell.Value = Unsafe_Abbreviations_QTR2(i, 1)
ActiveSheet.Range("E76").Select
ActiveCell.Value = Unsafe_Abbreviations_QTR3(i, 1)
ActiveSheet.Range("F76").Select
ActiveCell.Value = Unsafe_Abbreviations_QTR4(i, 1)
' Number of PRNs
ActiveSheet.Range("C80").Select
ActiveCell.Value = PRNs_QTR1(i, 1)
ActiveSheet.Range("D80").Select
ActiveCell.Value = PRNs_QTR2(i, 1)
ActiveSheet.Range("E80").Select
ActiveCell.Value = PRNs_QTR3(i, 1)
ActiveSheet.Range("F80").Select
ActiveCell.Value = PRNs_QTR4(i, 1)
' Copy CL's Data
' NYPORTS
ActiveSheet.Range("C52").Select
ActiveCell.Value = NYPORTS_QTR1(i, 1)
ActiveSheet.Range("D52").Select
ActiveCell.Value = NYPORTS_QTR2(i, 1)
ActiveSheet.Range("E52").Select
ActiveCell.Value = NYPORTS_QTR3(i, 1)
ActiveSheet.Range("F52").Select
ActiveCell.Value = NYPORTS_QTR4(i, 1)
' PRO Denials and Quality Issues
ActiveSheet.Range("C56").Select
ActiveCell.Value = PRO_QTR1(i, 1)
ActiveSheet.Range("D56").Select
ActiveCell.Value = PRO_QTR2(i, 1)
ActiveSheet.Range("E56").Select
ActiveCell.Value = PRO_QTR3(i, 1)
ActiveSheet.Range("F56").Select
ActiveCell.Value = PRO_QTR4(i, 1)
' DOH Reportable Incidents
ActiveSheet.Range("C55").Select
ActiveCell.Value = DOH_QTR1(i, 1)
ActiveSheet.Range("D55").Select
ActiveCell.Value = DOH_QTR2(i, 1)
ActiveSheet.Range("E55").Select
ActiveCell.Value = DOH_QTR3(i, 1)
ActiveSheet.Range("F55").Select
ActiveCell.Value = DOH_QTR4(i, 1)
' Blood Utilization Review
ActiveSheet.Range("C57").Select
ActiveCell.Value = Blood_Utilization_QTR1(i, 1)
ActiveSheet.Range("D57").Select
ActiveCell.Value = Blood_Utilization_QTR2(i, 1)
ActiveSheet.Range("E57").Select
ActiveCell.Value = Blood_Utilization_QTR3(i, 1)
ActiveSheet.Range("F57").Select
ActiveCell.Value = Blood_Utilization_QTR4(i, 1)
' Copy PP's Data
' Focus Peer Review
ActiveSheet.Range("C64").Select
ActiveCell.Value = Focus_Peer_Review_QTR1(i, 1)
ActiveSheet.Range("D64").Select
ActiveCell.Value = Focus_Peer_Review_QTR2(i, 1)
ActiveSheet.Range("E64").Select
ActiveCell.Value = Focus_Peer_Review_QTR3(i, 1)
ActiveSheet.Range("F64").Select
ActiveCell.Value = Focus_Peer_Review_QTR4(i, 1)

ActiveSheet.Columns("A:I").Select
ActiveSheet.Columns("A:I").EntireColumn.AutoFit
ActiveSheet.Rows("1:94").Select
ActiveSheet.Rows("1:94").EntireRow.AutoFit
Rows("18:19").Select
Selection.EntireRow.Hidden = True
Rows("60").Select
Selection.EntireRow.Hidden = True
Rows("66").Select
Selection.EntireRow.Hidden = True
Rows("72").Select
Selection.EntireRow.Hidden = True
Rows("78").Select
Selection.EntireRow.Hidden = True
i = i + 1
Next
Next
Workbooks("Individual Data.xls").Close SaveChanges:=True
Workbooks("Anesthesia " & year & ".xls").Save
Workbooks("CredData.xls").Close SaveChanges:=True

End Sub


Thanks so much!

Giraffe3289

RonMcK
08-19-2008, 08:40 AM
Giraffe3289,

Your organization has a systemic problem in the Access database's tables.

The master record(s) for the doctors in the files and database tables must have begin date and termination date fields for each doctor. And the tables should enforce the rule that no record(s) can be purged from a file or table during the period of time that your reports need to cover. So, at the very least, no purges in the current year for any doctor active during any part of the year.

These doctors (and their data needed for reports) need to stay in the files, tables and subsidiary records until they age out. Thus, if you need to prepare year-to-year comparisons of summarized data for the current and last 5 years (as a for instance), a doctor's records remain in the file until the end (termination) date is older than the oldest begin date of any period being reported on.

These are quick, random reactions to your query.

HTH,

giraffe3289
08-19-2008, 08:48 AM
The data is imported through a database query, so I'm sure I can talk to some people and get the query changed.

Any input on the linking situation or do you think that I'm pretty much stuck with it? :help

Thanks,

Giraffe3289

Aussiebear
08-20-2008, 04:18 AM
One quick thing that came to mind is the non use of Option Explicit. Is it there in the real version of the code?