Increment Access Date Field

I want to increment an access form date field every 90 days based on another date field -- the starting point. Another exchange expert wrote the code below however when I add a new record the form is in an endless loop and locks the database. I'm looking for a solution to the  loop problem. I have attached the databses - from the main menu select Add/Chng Veterans ALL to access the form VASH1.

Private Sub Form_Current()
Me.TreatmentDate = DateAdd("d", 90, Me.AdmitDate)
Do
     Me.TreatmentDate = DateAdd("d", 90, Me.TreatmentDate)
   
Loop Until Date <= Me.TreatmentDate

End Sub


Private Sub Form_Load()
If Not IsNull(Me.TreatmentDate) Then
  If Date > Me.TreatmentDate Then
    Me.TreatmentDate = DateAdd("d", 90, Me.TreatmentDate)
  End If
Else
'MsgBox "TreatMent Date is " & Nz(Me.TreatmentDate, #1/1/1900#)
Me.TreatmentDate = DateAdd("d", 90, Me.AdmitDate)
Do
     Me.TreatmentDate = DateAdd("d", 90, Me.TreatmentDate)
   
Loop Until Date <= Me.TreatmentDate

End If
End Sub

VASH-V1-4.accdb