Solved: excelv ado as400 speed issue

[calenger]

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

[XLGibbs]

Is this being run from Excel VBA?

Some of the For x = 0 to rs400.count etc...can be more simplified to be

Do While Not rs400.EOF....Loop

instead of all the For Next, If Thens.....but that won't necessarily reduce the processing time.

I am not sure about as400 systems, but I know that I can query 100 million records with much more complex SQL and get results in 30 minutes.

I can't rewrite this for you, but it also seems that you can potentially add a view or two to the as400 system that would do some of your grouping for you, and you may not need to cycle through each record to populate the data.......

[calenger]

Hi again

yes i would love to see how someone else would write this. Thanks

I am a little stumped myself. I have writen much more complex sql on mssql and do not have any of these speed issues.

I belive (as400 rookie) that the T1#DTA is an exsisting view? I have limited access to the server. I am in MA and it is in TX.

[XLGibbs]

I wasn't suggesting that I would re-write it...but it is executing that SQL over and over and over again inside a for next loop. Certainly not efficient.

Would be better to get one recordset to work with and move through that recordset locally...just guessing though.