Function runReports(Period, Year As String, Start, finish As Date)
Dim dbs, rst, rst2
'Check to see if any new assignment groups. If not open form to add them to db.
'Stop
Set dbs = CodeDb
'The below recordset is empty if no known new assignment groups.
'Set rst = CodeDb.OpenRecordset("QyNewAssignmentGroupCheck", dbOpenDynaset)
Set rst = CodeDb.OpenRecordset("SELECT IIF(dbo_probsummarym1.assignment IS NULL,dbo_incidentsm1.tec_owners_assignment, dbo_probsummarym1.assignment) AS [Name] FROM dbo_probsummarym1 RIGHT JOIN (dbo_incidentsm1 LEFT JOIN dbo_screlationm1 ON dbo_incidentsm1.incident_id = dbo_screlationm1.source) ON dbo_probsummarym1.number = dbo_screlationm1.depend " & _
"WHERE dbo_incidentsm1.open_time >=#" & Format(Start, "mm/dd/yyyy") & "# And dbo_incidentsm1.open_time <= #" & Format(finish, "mm/dd/yyyy") & "# " & _
"GROUP BY IIF(dbo_probsummarym1.assignment IS NULL,dbo_incidentsm1.tec_owners_assignment, dbo_probsummarym1.assignment)", dbOpenDynaset)
Set rst2 = CodeDb.OpenRecordset("SELECT [Name] FROM [TBAssignmentGroups] ORDER BY [Name]", dbOpenDynaset)
With rst
' .MoveFirst
'Continue flag is used to tell the database when the user has entered their assignment group.
continue = False
Do While Not .EOF
' First check to see if rst![Name] is in rst
If IsNull(rst![Name]) = False Then
rst2.FindFirst "[Name]='" & rst![Name] & "'"
If rst2.NoMatch = True Then
DoCmd.OpenForm "fmAddAssignmentGroup", acNormal
Forms!fmAddAssignmentGroup.AssignmentNAme.Value = !Name
Do While Not continue
DoEvents
Loop
End If
End If
continue = False
'Give a second for the form to close.
wait (1)
.MoveNext
Loop
End With
rst.Close
rst2.Requery
Set rst = CodeDb.OpenRecordset("SELECT dbo_cm3rm1.request_dept AS [Name] FROM dbo_cm3rm1 " & _
"WHERE dbo_cm3rm1.close_time >=#" & Format(Start, "mm/dd/yyyy") & "# And dbo_cm3rm1.close_time <= #" & Format(finish, "mm/dd/yyyy") & "# " & _
"GROUP BY dbo_cm3rm1.request_dept", dbOpenDynaset)
With rst
' .MoveFirst
'Continue flag is used to tell the database when the user has entered their assignment group.
continue = False
Do While Not .EOF
' First check to see if rst![Name] is in rst
If IsNull(rst![Name]) = False Then
rst2.FindFirst "[Name]='" & rst![Name] & "'"
If rst2.NoMatch = True Then
DoCmd.OpenForm "fmAddAssignmentGroup", acNormal
Forms!fmAddAssignmentGroup.AssignmentNAme.Value = !Name
Do While Not continue
DoEvents
Loop
End If
End If
continue = False
'Give a second for the form to close.
wait (1)
.MoveNext
Loop
End With
rst.Close
dbs.Close
'Prepare Table
Call prepareMainRecords(Period, Year, Start, finish)
'Populate Database
Call data_FTFSR(Period, Year)
'NumberIRs has to be run BEFORE RLAPerformance
Call data_NumberIRs(Period, Year)
Call data_RLAPerformance(Period, Year)
Call data_AgedIRs(Period, Year)
Call data_ChangeSuccess(Period, Year)
Call data_ChangeOnTime(Period, Year)
Call data_ChangeQuality(Period, Year)
'DrillDown EOP Reports
'Call runCRReports(True) (KELLY)
End Function
Function prepareMainRecords(Period, Year, Start, finish)
'This function populates the mainrecords table with every tuple of active
'assignment group and period. This does create a lot of extra unused
'records but it makes crystal reports easier to use as there is data there,
'if not zero.
Dim dbs, rst, rst2
Dim exists, periodIDNo, assignmentGroup As Long
'Add Period to Period Table and return ID field.
exists = DLookup("Periodid", "tbPeriods", "[period] = " & """P" & Period & " " & Year & """")
If IsNull(exists) Then
Set dbs = CodeDb
Set rst = CodeDb.OpenRecordset("tbPeriods", dbOpenDynaset)
With rst
.AddNew
!Period = "P" & Period & " " & Year
!DateFrom = Start
!DateTo = finish
.Update
End With
rst.Close
dbs.Close
exists = DLookup("Periodid", "tbPeriods", "[period] = " & """P" & Period & " " & Year & """")
'Take ID and each assignment group and add to table.
Set dbs = CodeDb
Set rst = CodeDb.OpenRecordset("tbMainRecords", dbOpenDynaset)
Set rst2 = CodeDb.OpenRecordset("Qy_Populate_ActiveAssignments", dbOpenDynaset)
With rst2
.MoveFirst
assignmentGroup = !AssignmentID
End With
Do While Not rst2.EOF
With rst
.AddNew
!PeriodID = exists
!assignmentGroup = assignmentGroup
.Update
End With
With rst2
.MoveNext
If Not rst2.EOF Then
assignmentGroup = !AssignmentID
End If
End With
Loop
rst.Close
dbs.Close
'If period already given then show error.
Else
MsgBox "P" & Period & " " & Year & " already exists"
End If
'Done
End Function
Function data_FTFSR(Period, Year As String)
'This function collates data for the first time fix measure.
Dim PeriodID, assignmentgroupid, FTFSR As Long
Dim dbs, rst, rst2, qdfnew
PeriodID = DLookup("Periodid", "tbPeriods", "[period] = " & """P" & Period & " " & Year & """")
Set dbs = CodeDb
Set qdfnew = dbs.CreateQueryDef("Temp_FTFSR", _
"INSERT INTO tb_Data_FTFSR ( masterData, data_FTFSR ) " & _
"SELECT tbMainRecords.id, Count(qry_dbo_incidentsm1.incident_id) AS CountOfincident_id " & _
"FROM qry_dbo_incidentsm1 INNER JOIN (tbAssignmentGroups INNER JOIN tbMainRecords ON tbAssignmentGroups.AssignmentID = tbMainRecords.AssignmentGroup) ON qry_dbo_incidentsm1.[tec owners assignment] = tbAssignmentGroups.Name " & _
"WHERE (((tbMainRecords.periodid) = " & PeriodID & ") And ((qry_dbo_incidentsm1.tec_first_time_fix) = ""Yes"")) and qry_dbo_incidentsm1.open_time >=#" & returnPeriodStart(Period, Year) & "# And qry_dbo_incidentsm1.open_time <= #" & returnPeriodEnd(Period, Year) & "#" & _
"GROUP BY tbMainRecords.id, qry_dbo_incidentsm1.tec_first_time_fix ")
qdfnew.Execute
GoTo EndOfF
'Create Tempory Query Definition
Set qdfnew = dbs.CreateQueryDef("Temp_FTFSR", _
"SELECT tbAssignmentGroups.AssignmentID, Count(dbo_incidentsm1.incident_id) AS CountOfincident_id, dbo_incidentsm1.tec_first_time_fix " & _
"FROM tbAssignmentGroups RIGHT JOIN dbo_incidentsm1 ON tbAssignmentGroups.Name = dbo_incidentsm1.tec_owners_assignment " & _
"GROUP BY tbAssignmentGroups.AssignmentID, dbo_incidentsm1.tec_first_time_fix, dbo_incidentsm1.close_time " & _
"HAVING (((dbo_incidentsm1.tec_first_time_fix)=""Yes"") AND (((dbo_incidentsm1.open_time) >=#" & returnPeriodStart(Period, Year) & "# And (dbo_incidentsm1.open_time) <= #" & returnPeriodEnd(Period, Year) & "#)));")
'Append Data to Data Table
Set rst = CodeDb.OpenRecordset("Temp_FTFSR", dbOpenDynaset)
Set rst2 = CodeDb.OpenRecordset("tb_data_FTFSR", dbOpenDynaset)
Stop
With rst
If Not .EOF Then
.MoveFirst
assignmentgroupid = !AssignmentID
If IsNull(assignmentgroupid) Then
assignmentgroupid = 1 ' 1 = Unknown Group
End If
FTFSR = !countofincident_id
End If
End With
Do While Not rst.EOF
With rst2
.AddNew
!masterdata = DLookup("id", "tbmainrecords", "[PeriodID] = " & PeriodID & " and [assignmentgroup] = " & assignmentgroupid)
!data_FTFSR = FTFSR
.Update
End With
With rst
.MoveNext
If Not rst.EOF Then
assignmentgroupid = !AssignmentID