Problema para guardar me manda error el recordset

Buenas estoy empezando a programar en visula studio ya que yo nunca lo había echo es por cuestión de trabajo y estoy trancado en el sistema que estoy desarrollando con el recordset.
Estoy tratando de insertar con recordset y el addnew pero me manda un erro que dice que el recordset actual no permite actualizaciones. Lo que entiendo es que solo puedo consultar pero no modificar en el y ese es el error te enseño mi código para ver que hago mal y de como me puedes ayudar:
/******Codigo para guardar******/
Private Sub btnguardar_Click() 'Boton de guardar
On Error GoTo error
'Variables declaradas
Dim PacienteRs As ADODB.Recordset
Dim pregunta As String
Dim CODIGO As Integer
Dim CONT, REGIS As Integer
Dim PESO As Double
pregunta = MsgBox("¿Desea guardar este caso?", vbQuestion + vbYesNo, "Guardar caso")
If pregunta = vbYes Then
''''''''verificamos que los campos no se queden en blanco
If Me.txtcodigo.Text = "" Then
    MsgBox "Debe llenar el campo.Introduzca el codigo de laboratorio"
    Me.txtcodigo.SetFocus
    Exit Sub
End If
If Me.cbosexo.Text = "" Then
    MsgBox "Debe llenar el campo.Seleccione el sexo del Paciente"
    Me.cbosexo.SetFocus
    Exit Sub
End If
If Me.Dtpfecham.Value = "" Then
    MsgBox "Debe llenar el campo.Introduzca la fecha de la muestra"
    Me.Dtpfecham.SetFocus
    Exit Sub
End If
Set PacienteRs = New ADODB.Recordset
With PacienteRs
.Open "Select * From paciente", CONEXION_ADO, adOpenForwardOnly, adLockReadOnly
    If .RecordCount <> 0 Then
            .MoveFirst
        Do
            .AddNew
            .Fields("num_tarjeta") = Me.txttarjeta.Text
            .Fields("codigo_lab") = Me.txtcodigo.Text
            .Fields("nombre") = Me.txtnombre.Text
            .Fields("primer_apellido") = Me.txtapellido1.Text
            .Fields("segundo_apellido") = Me.txtapellido2.Text
            .Fields("sexo") = Me.cbosexo.ListIndex
            .Fields("peso_kg") = Me.txtpeso.Text
            .Fields("semana_gestacion") = Me.txtgestacion.Text
            .Fields("hospital_procedencia") = Me.txtprocedencia.Text
            .Fields("hospital_nacimiento") = Me.txtnacimiento.Text
                '.Fields("fecha_nacimiento") = Format(Me.txtfechan.Text, "dd/mm/yy")
                '.Fields("fecha_nacimiento") = Me.Dtpfechan.Value
            .Fields("fecha_nacimiento") = Me.txtfechan.Text
               '.Fields("fecha_muestra") = Format(Me.Dtpfecham.Value, "dd/mm/yy")
               '.Fields("fecha_muestra") = Me.Dtpfecham.Value
            .Fields("fecha_muestra") = Me.txtfechan.Text
            .Fields("telefono_cel") = Me.txtcelular.Text
            .Fields("telefono_res") = Me.txtresidencial.Text
            .Update
            .Close
            CONT = CONT + 1 'cuenta mas 1 para poder agregar un registro a la ves
        Loop While REGIS <= CONT
    End If
.Close
End With
Set PacienteRs = Nothing
End If
Exit Sub
error:
MsgBox Err.Description, vbCritical, "Mensaje"
End Sub