[kapetang]

Καλησπέρα

Δημήτρη, καλωσόρισες στην παρέα του φόρουμ.

Στην επισυναπτόμενη ΒΔ , θα βρεις μια πρόταση για το ζητούμενο.

Συγκεκριμένα έχω προσθέσει στη ΒΔ που ανέβασες:

1) Τη φόρμα frmPatiensPerMonth, στην οποία όταν πιέσουμε το μοναδικό κουμπί της, τρέχει ο παρακάτω κώδικας.

Option Compare Database
Option Explicit

Private Sub cmdPatiensPerMonth_Click()
    On Error GoTo Err_Hander
    Dim strSQL As String, StartMonth As Integer, EndMonth As Integer
    Dim rs As DAO.Recordset, J As Integer, PatientIn As Date, PatientOut As Date
    Dim Y1 As Integer, strSQLIns As String, D1 As Date, D2 As Date

    strSQL = "SELECT Patients.ID,[Admission Date], [Discharge Date]" & _
             "FROM Patients ORDER BY [Admission Date];"

    Set rs = CurrentDb.OpenRecordset(strSQL)
    If rs.RecordCount > 0 Then
        CurrentDb.Execute ("Delete * From PatiensPerMonth")
        strSQL = "Insert Into PatiensPerMonth (ID, Apo, Eos) Values("
        rs.MoveFirst
        Do While Not rs.EOF
            PatientIn = rs![Admission Date]
            If IsNull(rs![Discharge Date]) Then
                PatientOut = Date
            Else
                PatientOut = rs![Discharge Date]
            End If
            Y1 = Year(PatientIn)
            StartMonth = Month(PatientIn)
            EndMonth = StartMonth + DateDiff("m", PatientIn, PatientOut)
            For J = StartMonth To EndMonth
                If J <> StartMonth Then
                    D1 = DateSerial(Y1, J, 1)
                Else
                    D1 = PatientIn
                End If
                If PatientOut > DateSerial(Y1, J + 1, 0) Then
                    D2 = DateSerial(Y1, J + 1, 0)
                Else
                    D2 = PatientOut
                End If

                strSQLIns = strSQL & rs!ID & ", #" & Format(D1, "mm/dd/yyyy") & "#, #" & Format(D2, "mm/dd/yyyy") & "#)"
                CurrentDb.Execute (strSQLIns)
            Next
            rs.MoveNext
        Loop
    End If
Exit_sub:
    If Not rs Is Nothing Then rs.Close
    MsgBox "Η διαδικασία ολοκληρώθηκε ..."
    Exit Sub

Err_Hander:
    MsgBox Err.Description, "Error"
    Resume Exit_sub


End Sub

Ο κώδικας για κάθε εγγραφή του πίνακα Patiens (κάθε νοσηλεία ID), κατανέμει το χρονικό διάστημα [PatientIn, PatientOut] (Έναρξη νοσηλείας, Τέλος νοσηλείας), κατά μήνα.

Δηλαδή χωρίζει το διάστημα [PatientIn, PatientOut] σε ένα ή περισσότερα διαστήματα [D1, D2] ανήκοντα στον ίδιο μήνα.

Οι εγγραφές μία ή περισσότερες, που προκύπτουν, αποθηκεύονται στον πίνακα PatientsPerMonth.

2) Τον πίνακα PatientsPerMonths που περιέχει το ID της νοσηλείας και τα διαστήματα [Apo, Eos] στα οποία χωρίστηκε το διάστημα νοσηλείας, όταν κατανεμήθηκε σε μήνες.

Στηριζόμενοι στον πίνακα, με κατάλληλο ερώτημα, μπορούμε να πάρουμε και τα υπολογιζόμενα πεδία:

Etos: year(Apo), Minas:Month(Apo), MeresPerMonth: Eos-Apo+1,κλπ.

Έχω τη γνώμη ότι πρέπει να ξαναδείς τη σχεδίαση της ΒΔ.

Ένας ασθενής (Patient) μπορεί να νοσηλευτεί πολλές φορές. Συνεπώς θα έπρεπε να υπάρχει:

1) Ένας πίνακας (πχ Patients) με τα ατομικά στοιχεία του ασθενούς (πχ Patient_ID, LastName, FirstName, κλπ).

2) Ένας πίνακας (πχ Nosilies) με τα στοιχεία νοσηλείας (πχ Nosilias_ID, Patient_ID, PatientIn, PatientOut, κλπ).

Φιλικά/Γιώργος