A friend of mine, who is a doctor, wanted me to write a scheduling webapp. He had some perticular requests:
1. You should be able to schedule per 5 minutes
2. But still need to be able to see the whole week
3. Wanted only to see the 5 working days (no weekends)
4. Should see from 06:00 to 21:00
5. As his assistant has to ‘fill’ the schedule, he also wanted somehow to show her when he would not be available.
I told him this quickly added up to showing about 840 possible appointments I had to show him on his desktop, tablet and iPhone. “Yes”, was his dry answer…
I didn’t know any such object, so I’ve put on my thinking hat and came up with ABMPlanner for B4J!
Although it has been written especially for his needs, I’m sure it can come in handy for other kind of projects too. For example you can schedule per 5, 10, 15, 20 or 30 minutes. You can set the start/end time of a day. And it can show a full week (including the weekend). You can give each task different colors etc…
It can also show the week as a ‘HeatMap’, so he can see very fast where he can put someone in-between other patients.
The second component ABMPercentSlider (in the video when the modalsheet is opened) is an alternative radio group component. It ranges the possibilities in a ‘percentage’ range, with 5% intervals.
But have a look at the video (app is work in progress and sorry it is in dutch). It can be intimidating at first glance, but once you ‘get’ it, it’s actually a breeze to schedule stuff.
Some relevant code:
BuildPage:
Dim plan As ABMPlanner plan.Initialize(page, "plan", False, 6,20, 5,False,"black") plan.UseHeatMap("1,3,6") page.Cell(2,1).AddComponent(plan)
Adding a task (loading a random generated week):
Sub LoadRandomWeek(StartDay As Long,doRefresh As Boolean) Dim plan As ABMPlanner = page.Component("plan") plan.ClearPlanner Dim Days(7) As String Dim Day As Int = DateTime.GetDayOfMonth(StartDay) Dim nextDay As Long = StartDay Dim perNext As Period perNext.Initialize perNext.Days = 1 For i = 0 To 6 If ActiveDay = -1 Then If DateTime.Date(nextDay) = DateTime.Date(DateTime.Now) Then ActiveDay = i End If End If Days(i) = Day If Days(i).Length = 1 Then Days(i) = "0" & Days(i) End If nextDay = DateUtils.AddPeriod(nextDay, perNext) Day = DateTime.GetDayOfMonth(nextDay) Next Dim mins As List mins.Initialize mins.Add(1) mins.Add(3) mins.Add(6) mins.Add(12) plan.SetDayLabels("MA " & Days(0), "DI " & Days(1), "WO " & Days(2), "DO " & Days(3), "VR " & Days(4), "ZA " & Days(5), "ZO " & Days(6)) Dim PerTotal As Int = 12 For i = 0 To 4 Dim u As Int = 6 Dim m As Int = 0 Dim l As Int = 0 Dim lIndex As Int Do While u < 21 Do While m < PerTotal m = m + Rnd(1,3) lIndex = Rnd(0,3) l = mins.Get(lIndex) If (u*PerTotal + m + l) < (21*PerTotal) And m < PerTotal And (i <> 2 Or u <=11 ) Then Dim patient As String = FirstNames.get(Rnd(0,19)) & " " & LastNames.get(Rnd(0,19)) counter = counter + 1 plan.AddTask(NewTask(i, "T" & counter,u,m,l,patient,lIndex)) ' taskid must be a string! End If m = m + l Loop m = m - PerTotal u = u + 1 Loop Next plan.SetActiveDay(ActiveDay) For i = 12 To 20 plan.SetHourStatus(2,i,False) Next If doRefresh Then plan.Refresh End If End Sub
Events:
Sub plan_ActiveDayChanged(day As Int) Log("New day: " & day) ActiveDay = day ' important to sync the server with the browser! Dim plan As ABMPlanner = page.Component("plan") plan.SetActiveDay(ActiveDay) End Sub Sub plan_MinutesClicked(Value As String) Dim spl() As String = Regex.Split(";", Value) ' spl(0) is here always 0, as this would contain the menu item clicked. This is to be uniform with the MenuClicked Value param Log("Day: " & spl(1)) Log("Hour: " & spl(2)) Log("MinPer5: " & spl(3)) ' use the ABM.PLANNER_STATUS_ constants to check the status Log("Status: " & spl(4)) Log("Task ID: " & spl(5)) page.ShowModalSheet("patientafspraak") End Sub Sub plan_MenuClicked(MenuType As String, Value As String) Dim spl() As String = Regex.Split(";", Value) Dim plan As ABMPlanner = page.Component("plan") Log("MenuType: " & MenuType) Log("Value: " & Value) Select Case MenuType Case ABM.PLANNER_MENUTYPE_DAY ' update the database Log("Day: " & spl(1)) Select Case spl(0) Case ABM.PLANNER_MENU_SETFREE plan.SetDayStatus(spl(1), True) Case ABM.PLANNER_MENU_SETNOTAVAILABLE plan.SetDayStatus(spl(1), False) End Select ' IMPORTANT to perform the action in the browser plan.PerfromDayHourMenuAction Case ABM.PLANNER_MENUTYPE_HOUR ' update the database Log("Day: " & spl(1)) Log("Hour: " & spl(2)) Select Case spl(0) Case ABM.PLANNER_MENU_SETFREE plan.SetHourStatus(spl(1), spl(2), True) Case ABM.PLANNER_MENU_SETNOTAVAILABLE plan.SetHourStatus(spl(1), spl(2), False) End Select ' IMPORTANT to perform the action in the browser plan.PerfromDayHourMenuAction Case ABM.PLANNER_MENUTYPE_MIN ' update the database Log("Day: " & spl(1)) Log("Hour: " & spl(2)) Log("MinPer5: " & spl(3)) ' use the ABM.PLANNER_STATUS_ constants to check the status Log("Status: " & spl(4)) Log("Task ID: " & spl(5)) Select Case spl(0) Case ABM.PLANNER_MENU_CUT cutTaskID = spl(5) copyTask = plan.GetTask(spl(5)) IsCut = True myToastID = myToastID + 1 page.ShowToast("toast" & myToastID, "toastred", "Verplaats " & copyTask.Text & " naar...", 5000) Case ABM.PLANNER_MENU_COPY copyTask = plan.GetTask(spl(5)) IsCut = False myToastID = myToastID + 1 page.ShowToast("toast" & myToastID, "toastred", "Kopieer " & copyTask.Text & " naar...", 5000) Case ABM.PLANNER_MENU_PASTE If IsCut Then plan.RemoveTask2(cutTaskID) Else counter = counter + 1 copyTask = copyTask.Clone("T" & counter) End If copyTask.Day = spl(1) copyTask.StartHour = spl(2) copyTask.StartMinututesPer = spl(3) plan.AddTask(copyTask) plan.Refresh If IsCut Then myToastID = myToastID + 1 page.ShowToast("toast" & myToastID, "toastred", copyTask.Text & " verplaatst!", 5000) Else myToastID = myToastID + 1 page.ShowToast("toast" & myToastID, "toastred", copyTask.Text & " gekopieerd!", 5000) End If Case ABM.PLANNER_MENU_DELETE plan.RemoveTask2(spl(5)) plan.Refresh End Select End Select End Sub
These are the final components for ABMaterial 2.50. I’m now going to prepare everything for the next release. (updating the demos etc), so donators will receive these new toys shortly…
Alwaysbusy
Click here to and support ABMaterial