Concatenate Records Text Field

How to de-normalize records

Sometimes you'll need to concatenate records into a single text field.  This requirement occurs most often on reports where it is impractical to list many small records down the report.

In this example we have patient medical records - in particular we have a table that contains one record for each patient allergies.

We have a patient report where we want to list the allergies in one line in a text box - ie. allergy1; allergy2; allergy3....

In an non-normalized database (spreadsheet) we would layout the spreadsheet with columns, one for each allergy and then there is no need to concatenate the multiple records - we can just concatenate the fixed columns to create a single-line list of allergies.

In a relational database there are overriding reason to normalize the table so that each allergy is listed in a separate record for each patient.  Here is the structure of our M_Patient_alrgy table:

M_Patient_alrgy

Patient_ID	Allergy_ID
4	1
4	2
4	3
4	4

The Allergy_ID is a foreign key to our allergy lookup table:

L_alrgy

Allergy_ID	Allergy
8	acetaminophen
7	dander
1	aspirin
6	flowers
3	erythromycin
4	macrolides
5	cats
2	Penicillin

You can see our patient has four allergies: Aspirin; Penicillin; Erythromycin; Macrolides.  And that is exactly how we want to show the list of allergies in our report - denormalize the multiple records into a list of allergies separated by a semicolon.  This process is can be called dynamic de-normalizing.

To make querying all the data for the report easier we will load the concatenated string into a little temporary table:

T_Patient_alrgy

Patient_ID	Allergy
4	aspirin; Penicillin; erythromycin; macrolides

The end result is that we will have a field called Allergy that we can place on our report.  Here is the VBA code that concatenates the records to a single text field:

Public Function concat_alrgy(Patient_ID)
Dim rst As DAO.Recordset
Dim db As DAO.Database
Dim hold_alrgy As String
Set db = CurrentDb
hold_alrgy = ""

'  clear out old list

DoCmd.RunSQL ("delete * from t_patient_alrgy")

'  start creating new list

'  select list of records for this patient

Set rst = db.OpenRecordset("SELECT Allergy " & _
" FROM L_alrgy INNER JOIN M_Patient_alrgy " & _
" ON L_alrgy.Allergy_ID = M_Patient_alrgy.Allergy_ID " & _
" WHERE Patient_ID=" & Patient_ID)

'  skip process if there are no items in the list

If rst.BOF Or rst.EOF = True Then GoTo jump_out
  rst.MoveFirst

  '  start Concatenate Multiple Records to Text Field

Do While Not rst.EOF
  If hold_alrgy = "" Then
    hold_alrgy = rst!Allergy
  Else
    hold_alrgy = hold_alrgy & "; " & rst!Allergy
  End If
  rst.MoveNext
Loop
  '  end Concatenate Multiple Records to Text Field
jump_out:
rst.Close
Set rst = Nothing

'  load the concatenated  list

DoCmd.RunSQL ("INSERT INTO T_Patient_alrgy ( Patient_ID, Allergy ) " & _
" SELECT " & Patient_ID & ",'" & hold_alrgy & "'")

End Function

---

In the following example we demonstration gathering multiple records for airline landing and takeoff information to create a single string route.  This example is from our Airline Reservations Software case study.

Do While Not rst.EOF
    ' get the route records
    hold_route = ""
    hold_number_passengers = ""
    hold_connection = ""
    sqltext = "Select airport_abbr,number_passengers FROM L_Airports  INNER JOIN Q_Route_Sorted ON " & _
    "L_Airports.Airport_ID = q_route_Sorted.Airport_ID where reservation_Id=" & rst!Reservation_ID & " order by rsort"
    Set rsroute = db.OpenRecordset(sqltext)
    If rsroute.EOF = True Then
        GoTo skip_route1
    End If
    rsroute.MoveFirst
    ' concatenate route and passenger info
    Do While Not rsroute.EOF
        ' concatenate route list
        hold_route = hold_route & rsroute!Airport_Abbr & "/"
        If IsNull(rsroute!Number_Passengers) = False Then
            hold_number_passengers = hold_number_passengers & CStr(rsroute!Number_Passengers) & "/"
        End If
        rsroute.MoveNext
    Loop

skip_route1:
    rsroute.Close
    sqltext = "Select Airline_ID,Flight_No,Connect_Time from M_Passengers where Reservation_ID=" & rst!Reservation_ID
    Set rsroute = db.OpenRecordset(sqltext)
    If rsroute.BOF = True Then GoTo skip_route
    rsroute.MoveFirst

    Do While Not rsroute.EOF
        'concatenate connection info
        hold_connection = hold_connection & DLookup("Airline", "L_Airlines", "Airline_id=" & Nz(rsroute!Airline_ID, 0)) & "-" &           Nz(rsroute!Flight_No, " ") & "(" & rsroute!Connect_Time & ") "
  
        rsroute.MoveNext
    Loop

skip_route:
    rsroute.Close
    hold_pilots = ""
    hold_aircraft = ""
    'If IsNull(rst!Dispatch_ID) = False Then
        sqltext = "SELECT [M_Reservation-Dispatch].Reservation_ID, Aircraft_Number, Pilot_Initials" & _
        " FROM L_Pilots INNER JOIN (L_Aircraft INNER JOIN (M_Dispatch INNER JOIN [M_Reservation-Dispatch] ON                     M_Dispatch.Dispatch_ID = " & _
    " [M_Reservation-Dispatch].Dispatch_ID) ON L_Aircraft.Aircraft_ID = M_Dispatch.Aircraft_ID) ON L_Pilots.Pilot_ID =                 M_Dispatch.Pilot_ID" & _
    " Where [M_Reservation-Dispatch].Reservation_ID=" & rst!Reservation_ID
    Set rspilots = db.OpenRecordset(sqltext)
    If rspilots.EOF = False Then
        rspilots.MoveFirst
        Do While Not rspilots.EOF
            hold_pilots = hold_pilots & rspilots!pilot_initials & "/"
            hold_aircraft = hold_aircraft & rspilots!Aircraft_Number & "/"
            rspilots.MoveNext
        Loop
    End If
    rspilots.Close
'End If
' writtem
With rst
    .Edit
    If Len(hold_route) > 2 Then
        !Route = Mid(hold_route, 1, Len(hold_route) - 1)
    End If
    If IsNull(hold_number_passengers) = False And Len(hold_number_passengers) > 2 Then
        !PAX = Mid(hold_number_passengers, 1, Len(hold_number_passengers) - 3)
    End If
    If Len(hold_pilots) > 1 Then
        !Pilots = Mid(hold_pilots, 1, Len(hold_pilots) - 1)
    End If
    If Len(hold_aircraft) > 1 Then
        !Aircraft = Mid(hold_aircraft, 1, Len(hold_aircraft) - 1)
    End If
    !Connections = hold_connection
    .Update
End With
rst.MoveNext
Loop
rst.Close
'