Alternatively, to handle the exceptions noted by Greg:
Code:
Sub DeleteCap3Word()
With ActiveDocument.Range
With .Find
.ClearFormatting
.Text = "<[A-Z]{3}>"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchWildcards = True
.Execute
End With
Do While .Find.Found
Select Case .Text
Case "MRI", "USB", "PSA"
Case Else: .Words.First.Delete
End Select
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
End Sub