Solved

# split the days between two dates into days in each month

Posted on 2004-09-10
377 Views
In MS Access 2000
I want to split the days between two dates into days in each month. I have the start date and end date. I will show below:

Startdate      Enddate      Days      Nov 2003      Dec 2003      Jan 2004      Feb 2004      Mar 2004
01/11/2003      05/02/2004      97      30      31      31      5

0
Question by:peterjerry

LVL 41

Expert Comment

ID: 12027493
Are you trying to write a query that returns the data in a datasheet view?

What are you using the result for?
0

Author Comment

ID: 12027558
Yes, I am trying to write a query that returns data in a data sheet view.
I want this to calcualte the length of stay of patients in each month. If a patient has started occupying a bed from a start date to end date. I need to split his stay over each month. There by when I get a table listing all the patients, I can calculate the average length of stay of each ward, sector, etc.
0

LVL 120

Expert Comment

ID: 12027941
this could easily be done in Excel
using the functions like this

=MAX(0,(MIN(\$B2,DATE(YEAR(C\$1),MONTH(C\$1)+1,0))-MAX(\$A2,C\$1)+1))

after you create this in excel

interested?

drop me a line at email at profile
0

Author Comment

ID: 12042719
I prefer to have it in a query as I have a lot of information. And also I have similar date splitting required in other queries too.
0

LVL 1

Expert Comment

ID: 12045079

Public Sub stay_duration()

Dim db As DAO.Database

Dim rst As DAO.Recordset

Dim days_per As Integer, month_hold As Integer

Dim start_date As Double, release_date As Double, year_num As Double, x As Double, y As Double, hold_date As Double

Dim month_name As String

Dim body As Variant

Set db = CurrentDb

body = ""
body = body & ("select *")
body = body & (" ")
body = body & ("from release_dates;")
Set rst = db.OpenRecordset(body)
Do Until rst.EOF
start_date = rst.Fields!start_data
release_date = rst.Fields!release_data
x = (release_date - start_date) + 1
Debug.Print "Entrant Date: " & Format(start_date, "d mmm yyyy") & " Release Date: " & Format(release_date, "d mmm yyyy") & " Stayed for: " & x & " days"
month_hold = Month(start_date)
hold_date = start_date
days_per = 0
For y = 0 To x - 1
days_per = 0
Do While Month(hold_date) = month_hold
days_per = days_per + 1
hold_date = hold_date + 1
y = y + 1
Select Case y
Case Is > x - 1
Exit Do
End Select
Loop
y = y - 1
Debug.Print "Days per " & Format(hold_date - 1, "mm-yyyy") & ": " & days_per
month_hold = Month(hold_date)
Next y
rst.MoveNext
Loop

End Sub

where your data set might look like this:

1/1/2004      3/15/2004      37987      38061
1/15/2004      6/1/2004      38001      38139
2/15/2004      2/29/2004      38032      38046

By converting the dates to Julian numbers, you can do the calcs a lot cleaner.

By changing the debug.prints to a tabledef write, you can store all the answers in a dynamic table that you could refer to for a report... or maybe a dynamic array that you could output to excel or something...
0

LVL 1

Accepted Solution

pendeb earned 250 total points
ID: 12045089
Sorry forgot to show the output:

call stay_duration
Entrant Date: 1 Jan 2004 Release Date: 15 Mar 2004 Stayed for: 75 days
Days per 01-2004: 31
Days per 02-2004: 29
Days per 03-2004: 15
Entrant Date: 15 Jan 2004 Release Date: 1 Jun 2004 Stayed for: 139 days
Days per 01-2004: 17
Days per 02-2004: 29
Days per 03-2004: 31
Days per 04-2004: 30
Days per 05-2004: 31
Days per 06-2004: 1
Entrant Date: 15 Feb 2004 Release Date: 29 Feb 2004 Stayed for: 15 days
Days per 02-2004: 15

0

Author Comment

ID: 12053757
I am getting a compile error : user-defined type not defined.
As you mentioned aboout the table def's. I would really like to output into a query with table headings like
start_date, end_date, days_stayed, Nov 2003, Dec 2003, Jan 2003, etc. How can we modify this code to output that. Sorry for being too demanding, I am really a novice...
0

Author Comment

ID: 12062715
Sorry pendeb, That problem was due to the fact that I did not set up the refernces for DAO.
Now its working. Dont think I am trying to be a bit fuzzy. If you can help me to put it up into a table that would be great. Thankx a lot ....
0

LVL 1

Expert Comment

ID: 12063590
Not a problem. Thanks for getting the references set. I was away from my computer yesterday. I hope that the code makes sense, and that the modified code in this post makes just as much sense.

Please note the code has the following changes:

--I've broken them into sections.--

The code now does a creation of an output table, and with the heightened functionality, comes some heightened opportunity for something to break. With that in mind, I've got a basic error handling routine that will deal with problems arising from not having the table "stay_table" in existence in the database. Now, when the system doesn't find it, it'll just carry on. Other errors will create a pop-up box and let you know what the error numbers are. If you determine that the resulting errors are not heartstopping, then you can include those in the line before Resume Next. I'm not sure how much you've used select statements, but a simple comma followed by the new error number is all that's needed here.

--I've added a reference for patient_id--

Obviously, you're pulling the data from somewhere, and it's probably got a patient_id reference. Now, you can create a table that only has the results you're seeking, and then you can create queries with your result set that would join back in to all that patient demographic/personal data.

--I've changed my data source for this code--

I've made a copy of that data source available at the end of the code.

--Final Note--

You may want to verify that your source data has no nulls in any key fields needed for this code. If you've got nulls, or just want to filter your source data, you may want to look into either using a hard-coded filter (not recommended for anything other than nulls), some kind of InputBox (that's an actual VBA piece that creates a pop-up requesting your input) or some kind of conditional filter (no more than 180 days back in history, only closed out patient records... something like that).

The code with the table definition would look something like this:

Public Sub stay_duration()
On Error GoTo err_report

Dim db As DAO.Database

Dim tblnew As DAO.tabledef

Dim tbl As DAO.Recordset, rst As DAO.Recordset

Dim days_per As Integer, month_hold As Integer

Dim start_date As Double, release_date As Double, year_num As Double, x As Double, y As Double, hold_date As Double

Dim month_name As String, output_table As String, patient_id As String

Dim body As Variant

Set db = CurrentDb

main:
output_table = "stay_table"
DoCmd.DeleteObject acTable, output_table
Set tblnew = db.CreateTableDef(output_table)
With tblnew
.Fields.Append .CreateField("patient_id", dbText)
.Fields.Append .CreateField("date_code", dbDouble)
.Fields.Append .CreateField("days_per", dbLong)
End With
db.TableDefs.Append tblnew
body = ""
body = body & ("select *")
body = body & (" ")
body = body & ("from release_dates;")
Set rst = db.OpenRecordset(body)
Do Until rst.EOF
start_date = rst.Fields!start_date
release_date = rst.Fields!release_date
x = (release_date - start_date) + 1
month_hold = Month(start_date)
hold_date = start_date
days_per = 0
For y = 0 To x - 1
days_per = 0
Do While Month(hold_date) = month_hold
days_per = days_per + 1
hold_date = hold_date + 1
y = y + 1
Select Case y
Case Is > x - 1
Exit Do
End Select
Loop
y = y - 1
Set tbl = db.OpenRecordset(output_table, dbOpenDynaset)
With tbl
.Fields(0) = rst.Fields!patient_id
.Fields(1) = hold_date
.Fields(2) = days_per
.Update
End With
month_hold = Month(hold_date)
Next y
rst.MoveNext
Loop
GoTo exit_sub

err_report:
Select Case Err.Number
Case 7874
Resume Next
Case Else
MsgBox Err.Number & vbCrLf & Err.Description
GoTo exit_sub
End Select

exit_sub:
End Sub

-- Sample Data --

patient_id      start_date      release_date
4124pen      37987      38061
4137sol      38001      38139
4357mon      38032      38046

Hope that sums it up.
0

## Featured Post

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question