calenger
02-24-2006, 08:23 AM
Hi and thanks for reading.
I have created the below to pull patient level data for all patients seen during a fiscal period. Although not fully tested it runs and completes. My problem is our over taxed as400. It runs at an average of 70% system resources. about 60% processor usage. When executing the below processor usage climbs to about 96%. My question is: there anyway through my code to help ekeviate the added burden to the server? Any suggestions are appreciated. Also this program takes about 40 hrs to complete.
Thanks.
Private Sub cmd1_Click()
Dim conn_as400_str, conn_as400, rs_as400
Dim test As String
Dim MedRecArr() As String
Dim DeptArr() As String
Set conn_as400 = CreateObject("ADODB.Connection")
'conn_as400_str = "Provider=IBMDA400;Data Source=ToolBox"
conn_as400_str = "DSN=ToolBox;UID=myname;PWD=mypass;"
conn_as400.Open conn_as400_str
Set rs_as400 = CreateObject("ADODB.Recordset")
rs_as400.CursorLocation = adUseClient
sql = "SELECT DISTINCT DS_CHARGE_DETAIL.DEPARTMENT" & _
" FROM" & _
" TSIDB.T1#DTA.DS_ENCOUNTER DS_ENCOUNTER LEFT OUTER JOIN TSIDB.T1#DTA.DS_CHARGE_DETAIL " & _
"DS_CHARGE_DETAIL ON DS_ENCOUNTER.COMPANY_CODE = DS_CHARGE_DETAIL.COMPANY_CODE AND " & _
"DS_ENCOUNTER.ENCOUNTER_NUMBER = DS_CHARGE_DETAIL.ENCOUNTER_NUMBER " & _
" WHERE" & _
" DS_ENCOUNTER.DISCHARGE_FISCAL_YEAR = 2006 AND DS_ENCOUNTER.DISCHARGE_FISCAL_PERIOD = 2 AND" & _
" DS_ENCOUNTER.COMPANY_CODE = '100' AND DS_ENCOUNTER.DISCHARGE_DATE <> 0 AND DS_ENCOUNTER.INOUT_CODE = 'I'" & _
" ORDER BY DS_CHARGE_DETAIL.DEPARTMENT"
'SELECT DISTINCT DS_ENCOUNTER.DISCHARGE_DEPARTMENT FROM TSIDB.T1#DTA.DS_ENCOUNTER DS_ENCOUNTER"
rs_as400.Open sql, conn_as400
If rs_as400.RecordCount > 0 Then
rs_as400.MoveLast
rs_as400.MoveFirst
ReDim DeptArr(rs_as400.RecordCount - 1)
For i = 0 To rs_as400.RecordCount - 1
If test <> Trim(rs_as400.Fields(0).Value) Then
DeptArr(i) = Trim(rs_as400.Fields(0).Value)
test = Trim(rs_as400.Fields(0).Value)
rs_as400.MoveNext
End If
Next
Else
MsgBox " Error Retriving Departments", vbCritical, "Department Error"
rs_as400.Close
conn_as400.Close
Exit Sub
End If
rs_as400.Close
For i = 0 To UBound(DeptArr())
sql = "SELECT DS_ENCOUNTER.MEDICAL_RECORD_NUMBER" & _
" FROM" & _
" TSIDB.T1#DTA.DS_ENCOUNTER DS_ENCOUNTER LEFT OUTER JOIN TSIDB.T1#DTA.DS_CHARGE_DETAIL " & _
"DS_CHARGE_DETAIL ON DS_ENCOUNTER.COMPANY_CODE = DS_CHARGE_DETAIL.COMPANY_CODE AND " & _
"DS_ENCOUNTER.ENCOUNTER_NUMBER = DS_CHARGE_DETAIL.ENCOUNTER_NUMBER " & _
" WHERE" & _
" DS_ENCOUNTER.DISCHARGE_FISCAL_YEAR = 2006 AND DS_ENCOUNTER.DISCHARGE_FISCAL_PERIOD = 2 AND DS_CHARGE_DETAIL.DEPARTMENT = '" & DeptArr(i) & "' AND" & _
" DS_ENCOUNTER.COMPANY_CODE = '100' AND DS_ENCOUNTER.DISCHARGE_DATE <> 0 AND DS_ENCOUNTER.INOUT_CODE = 'I'" & _
" ORDER BY DS_ENCOUNTER.MEDICAL_RECORD_NUMBER"
rs_as400.Open sql, conn_as400
If rs_as400.RecordCount > 0 Then
rs_as400.MoveLast
rs_as400.MoveFirst
ReDim MedRecArr(rs_as400.RecordCount - 1)
For l = 0 To rs_as400.RecordCount - 1
MedRecArr(l) = Trim(rs_as400.Fields(0).Value)
rs_as400.MoveNext
Next
rs_as400.Close
Else
MsgBox " Error Retriving Medical Record Numbers", vbCritical, "Medical Record Number Error"
rs_as400.Close
conn_as400.Close
Exit Sub
End If
For l = 0 To UBound(MedRecArr())
sql = "SELECT DS_PERSON.PERSON_SOCIAL_SECURITY_NB, DS_CHARGE_DETAIL.ENCOUNTER_NUMBER, DS_ENCOUNTER.MEDICAL_RECORD_NUMBER, DS_PERSON.PERSON_LAST_NAME, DS_ENCOUNTER.ADMIT_DATE, DS_ENCOUNTER.DISCHARGE_DATE, DS_ENCOUNTER.PRODUCT_LINE_CODE, DS_ENCOUNTER.LENGTH_OF_STAY, DS_ENCOUNTER.BIRTHDATE, DS_ENCOUNTER.AGE, DS_ENCOUNTER.AGE_DAY, DS_ENCOUNTER.SEX, DS_ENCOUNTER.BIRTHWEIGHT_GRAMS, COUNT(DISTINCT DS_INDICATOR_ENCOUNTER.INDICATOR_TRIGGER_DATE), DS_ENCOUNTER.ADMIT_DIAGNOSIS, DS_ENCOUNTER.PRINCIPAL_DIAGNOSIS, DS_ENCOUNTER_SECONDARY_DIAG.SECONDARY_DIAGNOSIS," & _
" DS_ENCOUNTER.PRINCIPAL_PROCEDURE, DS_ENCOUNTER.ADMIT_DEPARTMENT" & _
" FROM" & _
" ((((TSIDB.T1#DTA.DS_ENCOUNTER DS_ENCOUNTER LEFT OUTER JOIN TSIDB.T1#DTA.DS_ENCOUNTER_SECONDARY_DIAG" & _
" DS_ENCOUNTER_SECONDARY_DIAG ON DS_ENCOUNTER.COMPANY_CODE = DS_ENCOUNTER_SECONDARY_DIAG.COMPANY_CODE AND" & _
" DS_ENCOUNTER.ENCOUNTER_NUMBER = DS_ENCOUNTER_SECONDARY_DIAG.ENCOUNTER_NUMBER) LEFT OUTER JOIN TSIDB.T1#DTA.DS_ENCOUNTER_PROCEDURE DS_ENCOUNTER_PROCEDURE ON" & _
" DS_ENCOUNTER.COMPANY_CODE = DS_ENCOUNTER_PROCEDURE.COMPANY_CODE AND DS_ENCOUNTER.ENCOUNTER_NUMBER = DS_ENCOUNTER_PROCEDURE.ENCOUNTER_NUMBER)" & _
" LEFT OUTER JOIN TSIDB.T1#DTA.DS_PERSON DS_PERSON ON DS_ENCOUNTER.MEDICAL_RECORD_NUMBER = DS_PERSON.MPI_NUMBER)" & _
" LEFT OUTER JOIN TSIDB.T1#DTA.DS_INDICATOR_ENCOUNTER DS_INDICATOR_ENCOUNTER ON DS_ENCOUNTER.COMPANY_CODE = DS_INDICATOR_ENCOUNTER.COMPANY_CODE AND" & _
" DS_ENCOUNTER.ENCOUNTER_NUMBER = DS_INDICATOR_ENCOUNTER.ENCOUNTER_NUMBER AND DS_ENCOUNTER.MEDICAL_RECORD_NUMBER = DS_INDICATOR_ENCOUNTER.MEDICAL_RECORD_NUMBER)" & _
" LEFT OUTER JOIN TSIDB.T1#DTA.DS_CHARGE_DETAIL DS_CHARGE_DETAIL ON DS_ENCOUNTER.COMPANY_CODE = DS_CHARGE_DETAIL.COMPANY_CODE AND" & _
" DS_ENCOUNTER.ENCOUNTER_NUMBER = DS_CHARGE_DETAIL.ENCOUNTER_NUMBER " & _
"WHERE " & _
"DS_ENCOUNTER.COMPANY_CODE = '100' AND DS_ENCOUNTER.MEDICAL_RECORD_NUMBER = '" & MedRecArr(l) & "' AND DS_ENCOUNTER_SECONDARY_DIAG.SECONDARY_DIAG_SEQUENCE <> 1 " & _
"AND DS_CHARGE_DETAIL.FISCAL_YEAR = 2006 AND DS_CHARGE_DETAIL.FISCAL_PERIOD = 2 AND DS_ENCOUNTER.INOUT_CODE = 'I'" & _
" GROUP BY" & _
" DS_PERSON.PERSON_SOCIAL_SECURITY_NB, DS_CHARGE_DETAIL.ENCOUNTER_NUMBER, DS_ENCOUNTER.MEDICAL_RECORD_NUMBER, DS_PERSON.PERSON_LAST_NAME, DS_ENCOUNTER.ADMIT_DATE, DS_ENCOUNTER.DISCHARGE_DATE, DS_ENCOUNTER.PRODUCT_LINE_CODE, DS_ENCOUNTER.LENGTH_OF_STAY, DS_ENCOUNTER.BIRTHDATE, DS_ENCOUNTER.AGE, DS_ENCOUNTER.AGE_DAY, DS_ENCOUNTER.SEX, DS_ENCOUNTER.BIRTHWEIGHT_GRAMS, DS_ENCOUNTER.ADMIT_DIAGNOSIS, DS_ENCOUNTER.PRINCIPAL_DIAGNOSIS, DS_ENCOUNTER_SECONDARY_DIAG.SECONDARY_DIAGNOSIS," & _
" DS_ENCOUNTER.PRINCIPAL_PROCEDURE, DS_ENCOUNTER.ADMIT_DEPARTMENT" & _
" ORDER BY DS_ENCOUNTER.DISCHARGE_DATE"
rs_as400.Open sql, conn_as400
If rs_as400.RecordCount > 0 Then
rs_as400.MoveLast
rs_as400.MoveFirst
Worksheets("Main").Cells(l + 2, 1) = Trim(rs_as400.Fields(0).Value)
Worksheets("Main").Cells(l + 2, 2) = Trim(rs_as400.Fields(1).Value)
Worksheets("Main").Cells(l + 2, 3) = Trim(rs_as400.Fields(2).Value)
Worksheets("Main").Cells(l + 2, 4) = Trim(rs_as400.Fields(3).Value)
Worksheets("Main").Cells(l + 2, 5) = "UMMHC"
Worksheets("Main").Cells(l + 2, 6) = "TEST"
Worksheets("Main").Cells(l + 2, 7) = Left(Right(Trim(rs_as400.Fields(4)), 4), 2) & Right(Trim(rs_as400.Fields(4)), 2) & Left(Trim(rs_as400.Fields(4)), 4)
Worksheets("Main").Cells(l + 2, 8) = Left(Right(Trim(rs_as400.Fields(5)), 4), 2) & Right(Trim(rs_as400.Fields(5)), 2) & Left(Trim(rs_as400.Fields(5)), 4)
Worksheets("Main").Cells(l + 2, 9) = Trim(rs_as400.Fields(6).Value)
Worksheets("Main").Cells(l + 2, 11) = Trim(rs_as400.Fields(7).Value)
Worksheets("Main").Cells(l + 2, 13) = Left(Right(Trim(rs_as400.Fields(8)), 4), 2) & Right(Trim(rs_as400.Fields(8)), 2) & Left(Trim(rs_as400.Fields(8)), 4)
Worksheets("Main").Cells(l + 2, 14) = Trim(rs_as400.Fields(9).Value)
Worksheets("Main").Cells(l + 2, 15) = Trim(rs_as400.Fields(10).Value)
Worksheets("Main").Cells(l + 2, 16) = Trim(rs_as400.Fields(11).Value)
Worksheets("Main").Cells(l + 2, 17) = Trim(rs_as400.Fields(12).Value)
Worksheets("Main").Cells(l + 2, 18) = Trim(rs_as400.Fields(13).Value)
Worksheets("Main").Cells(l + 2, 23) = Trim(rs_as400.Fields(14).Value)
Worksheets("Main").Cells(l + 2, 24) = Trim(rs_as400.Fields(15).Value)
Worksheets("Main").Cells(l + 2, 74) = Trim(rs_as400.Fields(17).Value)
Worksheets("Main").Cells(l + 2, 240) = Trim(rs_as400.Fields(18).Value)
For j = 0 To rs_as400.RecordCount - 1
Worksheets("Main").Cells(l + 2, 25 + j) = Trim(rs_as400.Fields(16).Value)
rs_as400.MoveNext
Next
rs_as400.Close
j = 0
sql = "SELECT DS_ENCOUNTER.MEDICAL_RECORD_NUMBER, DS_ENCOUNTER.PRINCIPAL_PROCEDURE, DS_ENCOUNTER_PROCEDURE.PROCEDURE_CODE__ENCTR_, DS_ENCOUNTER_PROCEDURE.DATE_OF_SERVICE, DS_ENCOUNTER_PROCEDURE.SURGEON, " & _
" DS_ENCOUNTER_PROCEDURE.ENCOUNTER_PROC_SEQUENCE" & _
" FROM" & _
" (((TSIDB.T1#DTA.DS_ENCOUNTER DS_ENCOUNTER LEFT OUTER JOIN TSIDB.T1#DTA.DS_ENCOUNTER_SECONDARY_DIAG" & _
" DS_ENCOUNTER_SECONDARY_DIAG ON DS_ENCOUNTER.COMPANY_CODE = DS_ENCOUNTER_SECONDARY_DIAG.COMPANY_CODE AND" & _
" DS_ENCOUNTER.ENCOUNTER_NUMBER = DS_ENCOUNTER_SECONDARY_DIAG.ENCOUNTER_NUMBER) LEFT OUTER JOIN TSIDB.T1#DTA.DS_ENCOUNTER_PROCEDURE DS_ENCOUNTER_PROCEDURE ON" & _
" DS_ENCOUNTER.COMPANY_CODE = DS_ENCOUNTER_PROCEDURE.COMPANY_CODE AND DS_ENCOUNTER.ENCOUNTER_NUMBER = DS_ENCOUNTER_PROCEDURE.ENCOUNTER_NUMBER)" & _
" LEFT OUTER JOIN TSIDB.T1#DTA.DS_CHARGE_DETAIL DS_CHARGE_DETAIL ON DS_ENCOUNTER.COMPANY_CODE = DS_CHARGE_DETAIL.COMPANY_CODE AND" & _
" DS_ENCOUNTER.ENCOUNTER_NUMBER = DS_CHARGE_DETAIL.ENCOUNTER_NUMBER) " & _
"WHERE " & _
"DS_ENCOUNTER.COMPANY_CODE = '100' AND DS_ENCOUNTER.MEDICAL_RECORD_NUMBER = '" & MedRecArr(l) & "' AND DS_ENCOUNTER_PROCEDURE.ENCOUNTER_PROC_SEQUENCE <> 1 AND DS_ENCOUNTER_SECONDARY_DIAG.SECONDARY_DIAG_SEQUENCE <> 1 " & _
"AND DS_CHARGE_DETAIL.FISCAL_YEAR = 2006 AND DS_CHARGE_DETAIL.FISCAL_PERIOD = 2 AND DS_ENCOUNTER.INOUT_CODE = 'I'" & _
" GROUP BY" & _
" DS_ENCOUNTER.MEDICAL_RECORD_NUMBER, DS_ENCOUNTER.PRINCIPAL_PROCEDURE, DS_ENCOUNTER_PROCEDURE.PROCEDURE_CODE__ENCTR_, DS_ENCOUNTER_PROCEDURE.DATE_OF_SERVICE, DS_ENCOUNTER_PROCEDURE.SURGEON, " & _
" DS_ENCOUNTER_PROCEDURE.ENCOUNTER_PROC_SEQUENCE" & _
" ORDER BY DS_ENCOUNTER.MEDICAL_RECORD_NUMBER"
rs_as400.Open sql, conn_as400
If rs_as400.RecordCount > 0 Then
rs_as400.MoveLast
rs_as400.MoveFirst
For j = 0 To rs_as400.RecordCount - 1
Worksheets("Main").Cells(l + 2, 75 + j) = Trim(rs_as400.Fields(1).Value)
Worksheets("Main").Cells(l + 2, 124 + j) = Left(Right(Trim(rs_as400.Fields(2)), 4), 2) & Right(Trim(rs_as400.Fields(2)), 2) & Left(Trim(rs_as400.Fields(2)), 4)
Worksheets("Main").Cells(l + 2, 174 + j) = Trim(rs_as400.Fields(3).Value)
Next
End If
End If
rs_as400.Close
Next
Next
conn_as400.Close
I have created the below to pull patient level data for all patients seen during a fiscal period. Although not fully tested it runs and completes. My problem is our over taxed as400. It runs at an average of 70% system resources. about 60% processor usage. When executing the below processor usage climbs to about 96%. My question is: there anyway through my code to help ekeviate the added burden to the server? Any suggestions are appreciated. Also this program takes about 40 hrs to complete.
Thanks.
Private Sub cmd1_Click()
Dim conn_as400_str, conn_as400, rs_as400
Dim test As String
Dim MedRecArr() As String
Dim DeptArr() As String
Set conn_as400 = CreateObject("ADODB.Connection")
'conn_as400_str = "Provider=IBMDA400;Data Source=ToolBox"
conn_as400_str = "DSN=ToolBox;UID=myname;PWD=mypass;"
conn_as400.Open conn_as400_str
Set rs_as400 = CreateObject("ADODB.Recordset")
rs_as400.CursorLocation = adUseClient
sql = "SELECT DISTINCT DS_CHARGE_DETAIL.DEPARTMENT" & _
" FROM" & _
" TSIDB.T1#DTA.DS_ENCOUNTER DS_ENCOUNTER LEFT OUTER JOIN TSIDB.T1#DTA.DS_CHARGE_DETAIL " & _
"DS_CHARGE_DETAIL ON DS_ENCOUNTER.COMPANY_CODE = DS_CHARGE_DETAIL.COMPANY_CODE AND " & _
"DS_ENCOUNTER.ENCOUNTER_NUMBER = DS_CHARGE_DETAIL.ENCOUNTER_NUMBER " & _
" WHERE" & _
" DS_ENCOUNTER.DISCHARGE_FISCAL_YEAR = 2006 AND DS_ENCOUNTER.DISCHARGE_FISCAL_PERIOD = 2 AND" & _
" DS_ENCOUNTER.COMPANY_CODE = '100' AND DS_ENCOUNTER.DISCHARGE_DATE <> 0 AND DS_ENCOUNTER.INOUT_CODE = 'I'" & _
" ORDER BY DS_CHARGE_DETAIL.DEPARTMENT"
'SELECT DISTINCT DS_ENCOUNTER.DISCHARGE_DEPARTMENT FROM TSIDB.T1#DTA.DS_ENCOUNTER DS_ENCOUNTER"
rs_as400.Open sql, conn_as400
If rs_as400.RecordCount > 0 Then
rs_as400.MoveLast
rs_as400.MoveFirst
ReDim DeptArr(rs_as400.RecordCount - 1)
For i = 0 To rs_as400.RecordCount - 1
If test <> Trim(rs_as400.Fields(0).Value) Then
DeptArr(i) = Trim(rs_as400.Fields(0).Value)
test = Trim(rs_as400.Fields(0).Value)
rs_as400.MoveNext
End If
Next
Else
MsgBox " Error Retriving Departments", vbCritical, "Department Error"
rs_as400.Close
conn_as400.Close
Exit Sub
End If
rs_as400.Close
For i = 0 To UBound(DeptArr())
sql = "SELECT DS_ENCOUNTER.MEDICAL_RECORD_NUMBER" & _
" FROM" & _
" TSIDB.T1#DTA.DS_ENCOUNTER DS_ENCOUNTER LEFT OUTER JOIN TSIDB.T1#DTA.DS_CHARGE_DETAIL " & _
"DS_CHARGE_DETAIL ON DS_ENCOUNTER.COMPANY_CODE = DS_CHARGE_DETAIL.COMPANY_CODE AND " & _
"DS_ENCOUNTER.ENCOUNTER_NUMBER = DS_CHARGE_DETAIL.ENCOUNTER_NUMBER " & _
" WHERE" & _
" DS_ENCOUNTER.DISCHARGE_FISCAL_YEAR = 2006 AND DS_ENCOUNTER.DISCHARGE_FISCAL_PERIOD = 2 AND DS_CHARGE_DETAIL.DEPARTMENT = '" & DeptArr(i) & "' AND" & _
" DS_ENCOUNTER.COMPANY_CODE = '100' AND DS_ENCOUNTER.DISCHARGE_DATE <> 0 AND DS_ENCOUNTER.INOUT_CODE = 'I'" & _
" ORDER BY DS_ENCOUNTER.MEDICAL_RECORD_NUMBER"
rs_as400.Open sql, conn_as400
If rs_as400.RecordCount > 0 Then
rs_as400.MoveLast
rs_as400.MoveFirst
ReDim MedRecArr(rs_as400.RecordCount - 1)
For l = 0 To rs_as400.RecordCount - 1
MedRecArr(l) = Trim(rs_as400.Fields(0).Value)
rs_as400.MoveNext
Next
rs_as400.Close
Else
MsgBox " Error Retriving Medical Record Numbers", vbCritical, "Medical Record Number Error"
rs_as400.Close
conn_as400.Close
Exit Sub
End If
For l = 0 To UBound(MedRecArr())
sql = "SELECT DS_PERSON.PERSON_SOCIAL_SECURITY_NB, DS_CHARGE_DETAIL.ENCOUNTER_NUMBER, DS_ENCOUNTER.MEDICAL_RECORD_NUMBER, DS_PERSON.PERSON_LAST_NAME, DS_ENCOUNTER.ADMIT_DATE, DS_ENCOUNTER.DISCHARGE_DATE, DS_ENCOUNTER.PRODUCT_LINE_CODE, DS_ENCOUNTER.LENGTH_OF_STAY, DS_ENCOUNTER.BIRTHDATE, DS_ENCOUNTER.AGE, DS_ENCOUNTER.AGE_DAY, DS_ENCOUNTER.SEX, DS_ENCOUNTER.BIRTHWEIGHT_GRAMS, COUNT(DISTINCT DS_INDICATOR_ENCOUNTER.INDICATOR_TRIGGER_DATE), DS_ENCOUNTER.ADMIT_DIAGNOSIS, DS_ENCOUNTER.PRINCIPAL_DIAGNOSIS, DS_ENCOUNTER_SECONDARY_DIAG.SECONDARY_DIAGNOSIS," & _
" DS_ENCOUNTER.PRINCIPAL_PROCEDURE, DS_ENCOUNTER.ADMIT_DEPARTMENT" & _
" FROM" & _
" ((((TSIDB.T1#DTA.DS_ENCOUNTER DS_ENCOUNTER LEFT OUTER JOIN TSIDB.T1#DTA.DS_ENCOUNTER_SECONDARY_DIAG" & _
" DS_ENCOUNTER_SECONDARY_DIAG ON DS_ENCOUNTER.COMPANY_CODE = DS_ENCOUNTER_SECONDARY_DIAG.COMPANY_CODE AND" & _
" DS_ENCOUNTER.ENCOUNTER_NUMBER = DS_ENCOUNTER_SECONDARY_DIAG.ENCOUNTER_NUMBER) LEFT OUTER JOIN TSIDB.T1#DTA.DS_ENCOUNTER_PROCEDURE DS_ENCOUNTER_PROCEDURE ON" & _
" DS_ENCOUNTER.COMPANY_CODE = DS_ENCOUNTER_PROCEDURE.COMPANY_CODE AND DS_ENCOUNTER.ENCOUNTER_NUMBER = DS_ENCOUNTER_PROCEDURE.ENCOUNTER_NUMBER)" & _
" LEFT OUTER JOIN TSIDB.T1#DTA.DS_PERSON DS_PERSON ON DS_ENCOUNTER.MEDICAL_RECORD_NUMBER = DS_PERSON.MPI_NUMBER)" & _
" LEFT OUTER JOIN TSIDB.T1#DTA.DS_INDICATOR_ENCOUNTER DS_INDICATOR_ENCOUNTER ON DS_ENCOUNTER.COMPANY_CODE = DS_INDICATOR_ENCOUNTER.COMPANY_CODE AND" & _
" DS_ENCOUNTER.ENCOUNTER_NUMBER = DS_INDICATOR_ENCOUNTER.ENCOUNTER_NUMBER AND DS_ENCOUNTER.MEDICAL_RECORD_NUMBER = DS_INDICATOR_ENCOUNTER.MEDICAL_RECORD_NUMBER)" & _
" LEFT OUTER JOIN TSIDB.T1#DTA.DS_CHARGE_DETAIL DS_CHARGE_DETAIL ON DS_ENCOUNTER.COMPANY_CODE = DS_CHARGE_DETAIL.COMPANY_CODE AND" & _
" DS_ENCOUNTER.ENCOUNTER_NUMBER = DS_CHARGE_DETAIL.ENCOUNTER_NUMBER " & _
"WHERE " & _
"DS_ENCOUNTER.COMPANY_CODE = '100' AND DS_ENCOUNTER.MEDICAL_RECORD_NUMBER = '" & MedRecArr(l) & "' AND DS_ENCOUNTER_SECONDARY_DIAG.SECONDARY_DIAG_SEQUENCE <> 1 " & _
"AND DS_CHARGE_DETAIL.FISCAL_YEAR = 2006 AND DS_CHARGE_DETAIL.FISCAL_PERIOD = 2 AND DS_ENCOUNTER.INOUT_CODE = 'I'" & _
" GROUP BY" & _
" DS_PERSON.PERSON_SOCIAL_SECURITY_NB, DS_CHARGE_DETAIL.ENCOUNTER_NUMBER, DS_ENCOUNTER.MEDICAL_RECORD_NUMBER, DS_PERSON.PERSON_LAST_NAME, DS_ENCOUNTER.ADMIT_DATE, DS_ENCOUNTER.DISCHARGE_DATE, DS_ENCOUNTER.PRODUCT_LINE_CODE, DS_ENCOUNTER.LENGTH_OF_STAY, DS_ENCOUNTER.BIRTHDATE, DS_ENCOUNTER.AGE, DS_ENCOUNTER.AGE_DAY, DS_ENCOUNTER.SEX, DS_ENCOUNTER.BIRTHWEIGHT_GRAMS, DS_ENCOUNTER.ADMIT_DIAGNOSIS, DS_ENCOUNTER.PRINCIPAL_DIAGNOSIS, DS_ENCOUNTER_SECONDARY_DIAG.SECONDARY_DIAGNOSIS," & _
" DS_ENCOUNTER.PRINCIPAL_PROCEDURE, DS_ENCOUNTER.ADMIT_DEPARTMENT" & _
" ORDER BY DS_ENCOUNTER.DISCHARGE_DATE"
rs_as400.Open sql, conn_as400
If rs_as400.RecordCount > 0 Then
rs_as400.MoveLast
rs_as400.MoveFirst
Worksheets("Main").Cells(l + 2, 1) = Trim(rs_as400.Fields(0).Value)
Worksheets("Main").Cells(l + 2, 2) = Trim(rs_as400.Fields(1).Value)
Worksheets("Main").Cells(l + 2, 3) = Trim(rs_as400.Fields(2).Value)
Worksheets("Main").Cells(l + 2, 4) = Trim(rs_as400.Fields(3).Value)
Worksheets("Main").Cells(l + 2, 5) = "UMMHC"
Worksheets("Main").Cells(l + 2, 6) = "TEST"
Worksheets("Main").Cells(l + 2, 7) = Left(Right(Trim(rs_as400.Fields(4)), 4), 2) & Right(Trim(rs_as400.Fields(4)), 2) & Left(Trim(rs_as400.Fields(4)), 4)
Worksheets("Main").Cells(l + 2, 8) = Left(Right(Trim(rs_as400.Fields(5)), 4), 2) & Right(Trim(rs_as400.Fields(5)), 2) & Left(Trim(rs_as400.Fields(5)), 4)
Worksheets("Main").Cells(l + 2, 9) = Trim(rs_as400.Fields(6).Value)
Worksheets("Main").Cells(l + 2, 11) = Trim(rs_as400.Fields(7).Value)
Worksheets("Main").Cells(l + 2, 13) = Left(Right(Trim(rs_as400.Fields(8)), 4), 2) & Right(Trim(rs_as400.Fields(8)), 2) & Left(Trim(rs_as400.Fields(8)), 4)
Worksheets("Main").Cells(l + 2, 14) = Trim(rs_as400.Fields(9).Value)
Worksheets("Main").Cells(l + 2, 15) = Trim(rs_as400.Fields(10).Value)
Worksheets("Main").Cells(l + 2, 16) = Trim(rs_as400.Fields(11).Value)
Worksheets("Main").Cells(l + 2, 17) = Trim(rs_as400.Fields(12).Value)
Worksheets("Main").Cells(l + 2, 18) = Trim(rs_as400.Fields(13).Value)
Worksheets("Main").Cells(l + 2, 23) = Trim(rs_as400.Fields(14).Value)
Worksheets("Main").Cells(l + 2, 24) = Trim(rs_as400.Fields(15).Value)
Worksheets("Main").Cells(l + 2, 74) = Trim(rs_as400.Fields(17).Value)
Worksheets("Main").Cells(l + 2, 240) = Trim(rs_as400.Fields(18).Value)
For j = 0 To rs_as400.RecordCount - 1
Worksheets("Main").Cells(l + 2, 25 + j) = Trim(rs_as400.Fields(16).Value)
rs_as400.MoveNext
Next
rs_as400.Close
j = 0
sql = "SELECT DS_ENCOUNTER.MEDICAL_RECORD_NUMBER, DS_ENCOUNTER.PRINCIPAL_PROCEDURE, DS_ENCOUNTER_PROCEDURE.PROCEDURE_CODE__ENCTR_, DS_ENCOUNTER_PROCEDURE.DATE_OF_SERVICE, DS_ENCOUNTER_PROCEDURE.SURGEON, " & _
" DS_ENCOUNTER_PROCEDURE.ENCOUNTER_PROC_SEQUENCE" & _
" FROM" & _
" (((TSIDB.T1#DTA.DS_ENCOUNTER DS_ENCOUNTER LEFT OUTER JOIN TSIDB.T1#DTA.DS_ENCOUNTER_SECONDARY_DIAG" & _
" DS_ENCOUNTER_SECONDARY_DIAG ON DS_ENCOUNTER.COMPANY_CODE = DS_ENCOUNTER_SECONDARY_DIAG.COMPANY_CODE AND" & _
" DS_ENCOUNTER.ENCOUNTER_NUMBER = DS_ENCOUNTER_SECONDARY_DIAG.ENCOUNTER_NUMBER) LEFT OUTER JOIN TSIDB.T1#DTA.DS_ENCOUNTER_PROCEDURE DS_ENCOUNTER_PROCEDURE ON" & _
" DS_ENCOUNTER.COMPANY_CODE = DS_ENCOUNTER_PROCEDURE.COMPANY_CODE AND DS_ENCOUNTER.ENCOUNTER_NUMBER = DS_ENCOUNTER_PROCEDURE.ENCOUNTER_NUMBER)" & _
" LEFT OUTER JOIN TSIDB.T1#DTA.DS_CHARGE_DETAIL DS_CHARGE_DETAIL ON DS_ENCOUNTER.COMPANY_CODE = DS_CHARGE_DETAIL.COMPANY_CODE AND" & _
" DS_ENCOUNTER.ENCOUNTER_NUMBER = DS_CHARGE_DETAIL.ENCOUNTER_NUMBER) " & _
"WHERE " & _
"DS_ENCOUNTER.COMPANY_CODE = '100' AND DS_ENCOUNTER.MEDICAL_RECORD_NUMBER = '" & MedRecArr(l) & "' AND DS_ENCOUNTER_PROCEDURE.ENCOUNTER_PROC_SEQUENCE <> 1 AND DS_ENCOUNTER_SECONDARY_DIAG.SECONDARY_DIAG_SEQUENCE <> 1 " & _
"AND DS_CHARGE_DETAIL.FISCAL_YEAR = 2006 AND DS_CHARGE_DETAIL.FISCAL_PERIOD = 2 AND DS_ENCOUNTER.INOUT_CODE = 'I'" & _
" GROUP BY" & _
" DS_ENCOUNTER.MEDICAL_RECORD_NUMBER, DS_ENCOUNTER.PRINCIPAL_PROCEDURE, DS_ENCOUNTER_PROCEDURE.PROCEDURE_CODE__ENCTR_, DS_ENCOUNTER_PROCEDURE.DATE_OF_SERVICE, DS_ENCOUNTER_PROCEDURE.SURGEON, " & _
" DS_ENCOUNTER_PROCEDURE.ENCOUNTER_PROC_SEQUENCE" & _
" ORDER BY DS_ENCOUNTER.MEDICAL_RECORD_NUMBER"
rs_as400.Open sql, conn_as400
If rs_as400.RecordCount > 0 Then
rs_as400.MoveLast
rs_as400.MoveFirst
For j = 0 To rs_as400.RecordCount - 1
Worksheets("Main").Cells(l + 2, 75 + j) = Trim(rs_as400.Fields(1).Value)
Worksheets("Main").Cells(l + 2, 124 + j) = Left(Right(Trim(rs_as400.Fields(2)), 4), 2) & Right(Trim(rs_as400.Fields(2)), 2) & Left(Trim(rs_as400.Fields(2)), 4)
Worksheets("Main").Cells(l + 2, 174 + j) = Trim(rs_as400.Fields(3).Value)
Next
End If
End If
rs_as400.Close
Next
Next
conn_as400.Close