1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134
| Option Compare Binary
'-------------------------------------
' Chargement du formulaire
'-------------------------------------
Private Sub Form_Load()
Me.PatientId = 0
Me.VisiteId = 0
Me.VisiteDate = Now()
End Sub
'-------------------------------------------------
' Cézigue a cliqué sur le bouton "Ajouter"
'-------------------------------------------------
Private Sub Ajouter_Click()
Dim theVisiteId As Integer
'------------------------------
' Contrôle de la date
'------------------------------
If IsNull(VisiteDate) Or Not IsDate(VisiteDate) Then
R = MsgBox("Veuillez fournir une date de visite", vbExclamation, Me.Name)
Exit Sub
End If
'------------------------------------------------------
'Contrôle de la structure de l'identifiant du patient
'------------------------------------------------------
If Not IsNumeric(Me.PatientId) Then
R = MsgBox("Id du patient : numérique svp", vbExclamation, Me.Name)
Exit Sub
End If
'--------------------------------------------------------------------------
'Relais à la fonction incrémentant VisiteId
'--------------------------------------------------------------------------
If Not IncrementerVisiteIdOK(Me.PatientId, theVisiteId, VisiteDate) Then
Exit Sub
End If
'---------------------------------------
'Affichage de VisiteId incrémenté
'---------------------------------------
Me.VisiteId = theVisiteId
End Sub
'------------------------------------------------------------------------------------------
'Fonction permettant d'incrémenter Visiteid et effectuant les inserts dans la table VISITE
'------------------------------------------------------------------------------------------
Function IncrementerVisiteIdOK(ByRef Patient As Integer, ByRef Visite As Integer, ByRef VisiteDate As String) As Boolean
Dim MaBase As dao.Database, SqlResult As dao.Recordset, R As String
On Error Resume Next
IncrementerVisiteIdOK = False
Set MaBase = CurrentDb
'-----------------------------------
' On vérifie que le patient existe
'-----------------------------------
R = "SELECT '' FROM PATIENT WHERE PatientId = " & Patient
Set SqlResult = MaBase.OpenRecordset(R, dbOpenDynaset)
theKount = SqlResult.RecordCount
If theKount = 0 Then
Reponse = MsgBox("Le patient '" & Patient & "' est inconnu au bataillon", vbExclamation, Me.Name)
Exit Function
End If
SqlResult.Close
'-------------------------------------------------
'On vérifie si c'est une 1re visite du patient
'-------------------------------------------------
R = "SELECT '' FROM VISITE WHERE PatientId = " & Patient
Set SqlResult = MaBase.OpenRecordset(R, dbOpenDynaset)
theKount = SqlResult.RecordCount
If theKount = 0 Then
'-------------------------------------------------------
'C'est la 1re visite du patient
'-------------------------------------------------------
R = "INSERT INTO VISITE (PatientId, VisiteId, VisiteDate) VALUES (" & Patient & ", 1, '" & VisiteDate & "') ;"
Else
'-------------------------------------------------------
'Ça n'est pas la 1re visite du patient, on incrémente
'-------------------------------------------------------
R = "INSERT INTO VISITE (PatientId, VisiteId, VisiteDate) "
R = R & "SELECT PatientId, (SELECT MAX(VisiteId)+1 FROM VISITE WHERE PatientId = " & Patient & "), '" & VisiteDate & "' "
R = R & " FROM VISITE "
R = R & " WHERE PatientId = " & Patient & " And VisiteId = (SELECT MAX(VisiteId) FROM VISITE WHERE PatientId = " & Patient & ") ;"
End If
''Debug.Print Chr(13) & R & Chr(13)
MaBase.Execute R, dbFailOnError
x = Err.Number
If x = 0 Then
IncrementerVisiteIdOK = True
'--------------------------------------------------------------
'On récupère la valeur résultant de l'incrémentation
'--------------------------------------------------------------
R = "SELECT MAX(VisiteId) AS MaxVisite FROM VISITE WHERE PatientId = " & Patient
Set SqlResult = MaBase.OpenRecordset(R, dbOpenDynaset)
Visite = SqlResult.Fields("MaxVisite").Value
SqlResult.Close
Else
Reponse = MsgBox("Access rouspète : " & vbCr & vbCr & Err.Description, vbCritical, Me.Name)
End If
End Function
'----------------------------------------
'Cézigue en a terminé
'----------------------------------------
Private Sub Terminer_Click()
DoCmd.Close
End Sub |
Partager