66 Loading of Subjects Dim AMDayTime(0 To 6) As DAYTIME Dim PMDayTime(0 To 6) As DAYTIME Dim fullLoad As Boolean Dim currentDays As String 'stores the current days for scheduling Dim currentTimes As String 'stores the current times for scheduling Dim currentUnits As Integer 'stores the unit of a course Dim currentSubject As Integer 'identifies the current course being scheduled based on the array of courses derived from the curriculum Dim totalSubjects As Integer 'tells the total number of courses for a specific curriculum part Dim subjects() As CURRCOURSES 'array of subjects for a particular curriculum Dim ThisBlock As Boolean 'tells whether a schedule for the current block has been created Dim UseThisFaculty As Boolean 'tells whether a faculty should be scheduled for an entry Dim timePointer As Integer Dim noFaculty As Boolean Dim noCurriculum As Boolean Dim DesignationUnits As Integer Dim pbCount As Integer Dim pbtotal As Integer Dim startHere As Integer Dim results As rdoResultset Private Sub cmdCreateSched_Click() Dim a As String Dim b As String Dim c As String ConnectToMySQL sqlquery = "select distinct(COUNT(blockcode)) as counted from block;" Set results = MySQLConnection.OpenResultset(sqlquery, rdOpenStatic, rdConcurRowVer, rdExecDirect) With results Do While Not .EOF pbtotal = !counted .MoveNext Loop .Close End With pbrScheduler.Max = 100
stbSchedule.Panels(2) = "0/" & pbtotal sqlquery = "select distinct(blockcode),session,degreecode,year from block order by year desc;" Set results = MySQLConnection.OpenResultset(sqlquery, rdOpenStatic, rdConcurRowVer, rdExecDirect) With results pbCount = 0 Do While Not .EOF pbrScheduler.Value = CInt((pbCount / pbtotal) * 100) stbSchedule.Panels(2) = pbCount & "/" & pbtotal timePointer = 0 InitializeDayTime noCurriculum = True sqlquery = "select * from curriculum where sem='" & frmMain.StatusBar1.Panels(1) & "'and year='" & !Year & "' and degreecode='" & ! degreecode & "';" Set Results2 = MySQLConnection.OpenResultset(sqlquery, rdOpenStatic, rdConcurRowVer, rdExecDirect) With Results2 totalSubjects = 0 Do While Not .EOF noCurriculum = False totalSubjects = totalSubjects + 1 .MoveNext Loop .Close End With If noCurriculum Then GoTo NOCURRICULUMSET ReDim subjects(0 To (totalSubjects 1)) 'Redeclares the array to proper dimension sqlquery = "select coursecode from curriculum where sem='" & frmMain.StatusBar1.Panels(1) & "'and year='" & !Year & "' and degreecode='" & ! degreecode & "';" Set Results2 = MySQLConnection.OpenResultset(sqlquery, rdOpenStatic, rdConcurRowVer, rdExecDirect) With Results2
67 currentSubject = 0 Do While Not .EOF subjects(currentSubject).sched uled = False subjects(currentSubject).subject Code = Results2!coursecode currentSubject = currentSubject +1 .MoveNext Loop .Close End With For i = 0 To totalSubjects - 1 sqlquery = "select * from subject where coursecode='" & subjects(i).subjectCode & "';" Set Results2 = MySQLConnection.OpenResultset(sqlquery, rdOpenStatic, rdConcurRowVer, rdExecDirect) With Results2 Do While Not .EOF subjects(i).level = !level 'the level of a course subjects(i).units = !unit 'the unit of a course subjects(i).description = ! description subjects(i).lab = !lab subjects(i).lect = !lecture Exit Do .MoveNext Loop .Close End With Next i
currentSubject = i Exit For End If Next i startHere = 0 noFaculty = True sqlquery = "select * from handledcourse where (handledcourse.coursecode='" & subjects(currentSubject).subjectCode & "') and rank<>'Contractual';" 'handledcourse.priority = '3' ;" Set Results2 = MySQLConnection.OpenResultset(sqlquery, rdOpenStatic, rdConcurRowVer, rdExecDirect) With Results2 Do While Not .EOF noFaculty = False UseThisFaculty = True 'get the names of faculty sqlquery = "select lname,fname,middle from faculty where facultycode='" & Results2!facultycode & "';" Set results6 = MySQLConnection.OpenResultset(sqlquery, rdOpenStatic, rdConcurRowVer, rdExecDirect) With results6 Do While Not .EOF a = results6!lname b = results6!fname c = results6!middle .MoveNext Loop .Close End With
fullLoad = False ThisBlock = False currentSubject = 0
'check if faculty is active or on-leave
Do While Not ThisBlock If !Session = "AM" Then 'initialize daytime currentDays = AMDayTime(timePointer).days currentTimes = AMDayTime(timePointer).times 'check for level 2 course and then prioritize it for scheduling For i = 0 To totalSubjects - 1 If subjects(i).level <= 2 And subjects(i).scheduled = False Then
sqlquery = "select * from facultystatus where facultycode=" & ! facultycode & " and status<>'ACTIVE';" Set results3 = MySQLConnection.OpenResultset(sqlquery, rdOpenStatic, rdConcurRowVer, rdExecDirect) With results3 Do While Not .EOF UseThisFaculty = False .MoveNext Loop
68 With results3 Do While Not .EOF UseThisFaculty = False .MoveNext Loop .Close End With 'check for overloading If UseThisFaculty Then DesignationUnits = 0 sqlquery = "select SUM(unit) as adminLoad from designation, facultydesignation where facultycode=" & ! facultycode & " and designation.position=designation.position group by facultycode;" Set results3 = MySQLConnection.OpenResultset(sqlquery, rdOpenStatic, rdConcurRowVer, rdExecDirect) With results3 Do While Not .EOF DesignationUnits = !adminLoad .MoveNext Loop .Close End With sqlquery = "select * from facultyload where facultycode=" & ! facultycode & " and (unitload + " & subjects(currentSubject).units & " + " & DesignationUnits & ")=18;" Set results3 = MySQLConnection.OpenResultset(sqlquery, rdOpenStatic, rdConcurRowVer, rdExecDirect) With results3 Do While Not .EOF UseThisFaculty = False .MoveNext Loop fullLoad = True .Close End With
'insert in schedule sqlquery = "insert into schedule (degreecode, blockcode, sem, acadyear, coursecode, days, times, facultycode) " & _ "values ('" & results!degreecode & "', '" & results!blockcode & "', '" & frmMain.StatusBar1.Panels(1) & "', '" & frmMain.StatusBar1.Panels(2) & "', '" & ! coursecode & "', '" & currentDays & "', '" & currentTimes & "', " & !facultycode & ");" MySQLConnection.E xecute sqlquery, rdExecDirect 'update faculty's load sqlquery = "update facultyload set unitload=unitload+" & subjects(currentSubject).units & " where facultycode=" & !facultycode & ";" MySQLConnection.E xecute sqlquery, rdExecDirect 'update faculty's schedule sqlquery = "insert into facultysched (facultycode,lname,fname,mname, sem, acadyear, days, times, coursecode, description,unit,lab,lecture,block) values (" & !facultycode & ",'" & a & "','" & b & "','" & c & "', '" & frmMain.StatusBar1.Panels(1) & "', '" & frmMain.StatusBar1.Panels(2) & "', '" & currentDays & "', '" & currentTimes & "', '" & subjects(currentSubject).subjectCode & "', '" & subjects(currentSubject).description & "','" & subjects(currentSubject).units & "','" & subjects(currentSubject).lab & "','" & subjects(currentSubject).lect & "','" & results!blockcode & "' );" MySQLConnection.E xecute sqlquery, rdExecDirect 'tell that the subject has been scheduled and the daytime used subjects(currentSubje ct).scheduled = True PMDayTime(timePoin ter).units = subjects(currentSubject).units If subjects(currentSubject).level = 6 Then PMDayTime(timeP ointer + 1).used = True End If
End If 'insert in the schedule If UseThisFaculty Then
If fullLoad Then checkConFaculty1PM End If
69 If noFaculty Then 'leave the course blank in the schedule since no faculty and daytime matched the need sqlquery = "insert into schedule (degreecode, blockcode, sem, acadyear, coursecode, days, times, facultycode) " & _ "values ('" & results!degreecode & "', '" & results!blockcode & "', '" & frmMain.StatusBar1.Panels(1) & "', '" & frmMain.StatusBar1.Panels(2) & "', '" & subjects(currentSubject).subjectCode & "', ' ', ' ', 0);" MySQLConnection.Execut e sqlquery, rdExecDirect subjects(currentSubject).s cheduled = True End If If subjects(currentSubject).scheduled = False Then sqlquery = "insert into schedule (degreecode, blockcode, sem, acadyear, coursecode, days, times, facultycode) " & _ "values ('" & results!degreecode & "', '" & results!blockcode & "', '" & frmMain.StatusBar1.Panels(1) & "', '" & frmMain.StatusBar1.Panels(2) & "', '" & subjects(currentSubject).subjectCode & "', ' ', ' ', 0);" MySQLConnection.Execut e sqlquery, rdExecDirect subjects(currentSubject).s cheduled = True End If 'move the subject pointer to the next subject For i = 0 To totalSubjects - 1 If subjects(i).scheduled = False Then currentSubject = i Exit For End If Next i For i = 0 To 6 If PMDayTime(i).used = False Then 'move the daytime pointer to the next slot timePointer = i
Exit For End If Next i End If ThisBlock = True 'assumes that a schedule for a block has been successfuly created For i = 0 To totalSubjects - 1 If subjects(i).scheduled = False Then ThisBlock = False 'tells that the block still have courses not scheduled Exit For End If Next i If ThisBlock Then timePointer = 0 InitializeDayTime End If Loop 'end loop for block scheduling NOCURRICULUMSET: pbCount = pbCount + 1 .MoveNext Loop .Close End With MySQLConnection.Close pbrScheduler.Value = 100 stbSchedule.Panels(2) = pbtotal & "/" & pbtotal MsgBox "Scheduling done!", vbInformation UpdateMsf3 End Sub Function checkConFaculty1PM() sqlquery = "select * from handledcourse where (handledcourse.coursecode='" & subjects(currentSubject).subjectCode & "') and rank='Contractual';" 'and handledcourse.priority = '3' Set results11 = MySQLConnection.OpenResultset(sqlquery, rdOpenStatic, rdConcurRowVer, rdExecDirect) With results11 Do While Not .EOF noFaculty = False UseThisFaculty = True 'get the names of faculty
70 sqlquery = "select lname,fname,middle from faculty where facultycode='" & results11!facultycode & "';" Set results6 = MySQLConnection.OpenResultset(sqlquery, rdOpenStatic, rdConcurRowVer, rdExecDirect) With results6 Do While Not .EOF a = results6!lname b = results6!fname c = results6!middle .MoveNext Loop .Close End With 'check if faculty is active or on-leave sqlquery = "select * from facultystatus where facultycode=" & ! facultycode & " and status<>'ACTIVE';" Set results3 = MySQLConnection.OpenResultset(sqlquery, rdOpenStatic, rdConcurRowVer, rdExecDirect) With results3 Do While Not .EOF UseThisFaculty = False .MoveNext Loop .Close End With 'check for conflict in schedule sqlquery = "select * from facultysched where facultycode = " & results11!facultycode & " And sem = '" & frmMain.StatusBar1.Panels(1) & "' And acadYear = " & frmMain.StatusBar1.Panels(2) & " And (days = '" & currentDays & "' And times = '" & currentTimes & "');" Set results3 = MySQLConnection.OpenResultset(sqlquery, rdOpenStatic, rdConcurRowVer, rdExecDirect) With results3 Do While Not .EOF UseThisFaculty = False .MoveNext
Loop .Close End With 'check conflict sqlquery = "select * from facultysched where block='" & results!blockcode & "' and days='" & currentDays & "' and times='" & currentTimes & "';" Set results3 = MySQLConnection.OpenResultset(sqlquery, rdOpenStatic, rdConcurRowVer, rdExecDirect) With results3 Do While Not .EOF UseThisFaculty = False .MoveNext Loop .Close End With 'check conflict sqlquery = "select * from facultysched where coursecode = '" & ! coursecode & "' and block='" & results!blockcode & "';" Set results3 = MySQLConnection.OpenResultset(sqlquery, rdOpenStatic, rdConcurRowVer, rdExecDirect) With results3 Do While Not .EOF UseThisFaculty = False .MoveNext Loop .Close End With 'check for overloading If UseThisFaculty Then DesignationUnits = 0 sqlquery = "select SUM(unit) as adminLoad from designation, facultydesignation where facultycode=" & ! facultycode & " and designation.position=designation.position group by facultycode;" Set results3 = MySQLConnection.OpenResultset(sqlquery, rdOpenStatic, rdConcurRowVer, rdExecDirect) With results3
71 Do While Not .EOF DesignationUnits = !adminLoad .MoveNext Loop .Close End With sqlquery = "select * from facultyload where facultycode=" & ! facultycode & " and (unitload + " & subjects(currentSubject).units & " + " & DesignationUnits & ")>27;" Set results3 = MySQLConnection.OpenResultset(sqlquery, rdOpenStatic, rdConcurRowVer, rdExecDirect) With results3 Do While Not .EOF UseThisFaculty = False fullLoad = True .MoveNext Loop .Close End With End If 'insert in the schedule If UseThisFaculty Then 'insert in schedule sqlquery = "insert into schedule (degreecode, blockcode, sem, acadyear, coursecode, days, times, facultycode) " & _ "values ('" & results!degreecode & "', '" & results!blockcode & "', '" & frmMain.StatusBar1.Panels(1) & "', '" & frmMain.StatusBar1.Panels(2) & "', '" & ! coursecode & "', '" & currentDays & "', '" & currentTimes & "', " & !facultycode & ");" MySQLConnection.E xecute sqlquery, rdExecDirect 'update faculty's load sqlquery = "update facultyload set unitload=unitload+" & subjects(currentSubject).units & " where facultycode=" & !facultycode & ";" AMDayTime(3).days = "MWF" AMDayTime(3).times = "10:30-11:30" AMDayTime(3).units = 0 AMDayTime(3).used = False AMDayTime(4).days = "TTh"
AMDayTime(4).times = "7:30-9:00" AMDayTime(4).units = 0 AMDayTime(4).used = False AMDayTime(5).days = "TTh" AMDayTime(5).times = "9:00-10:30" AMDayTime(5).units = 0 AMDayTime(5).used = False AMDayTime(6).days = "TTh" AMDayTime(6).times = "10:30-12:00" AMDayTime(6).units = 0 AMDayTime(6).used = False PMDayTime(0).days = "MWF" PMDayTime(0).times = "1:00-2:00" PMDayTime(0).units = 0 PMDayTime(0).used = False PMDayTime(1).days = "MWF" PMDayTime(1).times = "2:00-3:00" PMDayTime(1).units = 0 PMDayTime(1).used = False PMDayTime(2).days = "MWF" PMDayTime(2).times = "3:00-4:00" PMDayTime(2).units = 0 PMDayTime(2).used = False PMDayTime(3).days = "MWF" PMDayTime(3).times = "4:00-5:00" PMDayTime(3).units = 0 PMDayTime(3).used = False PMDayTime(4).days = "TTh" PMDayTime(4).times = "1:00-2:30" PMDayTime(4).units = 0 PMDayTime(4).used = False PMDayTime(5).days = "TTh" PMDayTime(5).times = "2:30-4:00" PMDayTime(5).units = 0 PMDayTime(5).used = False PMDayTime(6).days = "TTh" PMDayTime(6).times = "4:00-5:30" PMDayTime(6).units = 0 PMDayTime(6).used = False End Function
Private Sub Form_Load() Updatemsf1 UpdateMsf2
72
End Sub Public Sub UpdateMsf2() Dim row As Integer row = 1 msf2.Rows = 2 ConnectToMySQL sqlquery = "select * from subject" Set result = MySQLConnection.OpenResultset(sqlquery, rdOpenStatic, rdConcurRowVer, rdExecDirect) With result Do While Not .EOF If row >= msf2.Rows Then msf2.Rows = msf2.Rows + 1 msf2.TextMatrix(row, 0) = !coursecode msf2.TextMatrix(row, 1) = !description row = row + 1 .MoveNext Loop End With MySQLConnection.Close End Sub Sub Updatemsf1() Dim row As Integer row = 1 msf2.Rows = 2 ConnectToMySQL sqlquery = "select * from faculty" Set result = MySQLConnection.OpenResultset(sqlquery, rdOpenStatic, rdConcurRowVer, rdExecDirect) MySQLConnection.Close End Sub Sub RefreshSchedule() msf3.Clear msf3.Rows = 2 msf3.FormatString = "Degree Code |^ Block Code |^ Course Code |^ Faculty Code |^ Day |^ Time |^ Sem |^ Academic Year " End Sub Sub UpdateMsf3()
Dim row As Integer RefreshSchedule row = 1 ConnectToMySQL sqlquery = "select * from schedule where facultycode<>'0' and sem='" & frmMain.StatusBar1.Panels(1) & "' And acadyear ='" & frmMain.StatusBar1.Panels(2) & "';" Set result = MySQLConnection.OpenResultset(sqlquery, rdOpenStatic, rdConcurRowVer, rdExecDirect) With result Do While Not .EOF If row >= msf3.Rows Then msf3.Rows = msf3.Rows + 1 msf3.TextMatrix(row, 0) = ! degreecode msf3.TextMatrix(row, 1) = !blockcode msf3.TextMatrix(row, 2) = !coursecode msf3.TextMatrix(row, 3) = !facultycode msf3.TextMatrix(row, 4) = !days msf3.TextMatrix(row, 5) = !times msf3.TextMatrix(row, 6) = !sem msf3.TextMatrix(row, 7) = !acadYear row = row + 1 .MoveNext Loop End With MySQLConnection.Close End Sub