Private Sub UserForm_Initialize()

    'Me.txtRoom.Value = "1234"
    'Me.txtFirst.Value = "First"
    'Me.txtLast.Value = "Last"
    'Me.txtDOB.Value = "12/25/2017"
    'Me.cboCode.Value = "Full Code"
    'Me.txtMRN.Value = "123456"
    'Me.cboResident.Value = "PGuilford"
    'Me.txtMeds.Value = "meds"
    'Me.txtHPI.Value = "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum."
    'Me.txtFU.Value = "f/u this"

    Me.txtAdmit.Value = Format(Date, "mm/dd/yyyy")
    
    Me.cboCode.List = codeArray()

    Me.cboResident.List = residentArray()
    

End Sub
Private Sub cmdCommit_Click()
    
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' ROOM
    
    If Len(txtRoom) <> 4 Then
        MsgBox "A four-digit room number is required.", vbOKOnly, "Room Error"
        txtRoom.SetFocus
        Exit Sub
    ElseIf IsNumeric(txtRoom) = False Then
        MsgBox "Your room number contains alpha characters.", vbOKOnly, "Room Error"
        txtRoom.SetFocus
        Exit Sub
    End If
    
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' NAME
    
    If Len(txtLast) = 0 Or Len(txtFirst) = 0 Then
        MsgBox "Both first and last names are required.", vbOKOnly, "Name Error"
        If Len(txtLast) = 0 Then
            txtLast.SetFocus
        Else
            txtFirst.SetFocus
        End If
        Exit Sub
    End If
    
    
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' DATE OF BIRTH
    
    If IsDate(txtDOB) Then
        
        If Not dateCheckDOB(txtDOB) Then
            MsgBox "Please enter date as MM/DD/YYYY.", vbOKOnly, "DOB Error"
            txtDOB.SetFocus
            Exit Sub
        Else
            'MsgBox "This is a date.", vbOKOnly, "DOB Error"
        End If
        
    Else
    
        If Len(txtDOB) = 0 Then
            MsgBox "Date of Birth is required.", vbOKOnly, "DOB Error"
        Else
            MsgBox "Please check date of birth.", vbOKOnly, "DOB Error"
        End If
        
        txtDOB.SetFocus
        Exit Sub
        
    End If


    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' GENDER
    
    If optMale = False And optFemale = False Then
        MsgBox "Please select gender.", vbOKOnly, "Gender Error"
        optMale.SetFocus
        Exit Sub
    End If


    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' ADMIT DATE
    
    If IsDate(txtAdmit) Then
        
        If Not dateCheckAdmit(txtAdmit) Then
            MsgBox "Please enter date as MM/DD/YYYY.", vbOKOnly, "Admission Date Error"
            txtAdmit.SetFocus
            Exit Sub
        End If
        
    Else
    
        If Len(txtAdmit) = 0 Then
            MsgBox "Admission date is required.", vbOKOnly, "Admission Date Error"
        Else
            MsgBox "Please check admission date.", vbOKOnly, "Admission Date Error"
        End If
        
        txtAdmit.SetFocus
        Exit Sub
        
    End If

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' CODE STATUS
    
    If Len(cboCode) = 0 Then
        MsgBox "Please select a code status.", vbOKOnly, "Code Status Error"
        cboCode.SetFocus
        Exit Sub
    End If
    
    
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' MRN
    If Len(txtMRN) <> 6 Then
        MsgBox "MRN is six digits.", vbOKOnly, "MRN Error"
        txtMRN.SetFocus
        Exit Sub
    End If
    
    
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' RESIDENT
    
    If Len(cboResident) = 0 Then
        MsgBox "Please select a resident.", vbOKOnly, "Resident Error"
        cboResident.SetFocus
        Exit Sub
    End If
    
    
    ufAddPatient.txtRoom.Text = Me.txtRoom.Value
    ufAddPatient.txtFirst.Text = StrConv(Me.txtFirst.Value, vbProperCase)
    ufAddPatient.txtLast.Text = StrConv(Me.txtLast.Value, vbProperCase)
    ufAddPatient.txtDOB.Text = Me.txtDOB.Value
    ufAddPatient.optMale.Value = Me.optMale.Value
    ufAddPatient.optFemale.Value = Me.optFemale.Value
    ufAddPatient.txtAdmit.Text = Me.txtAdmit.Value
    ufAddPatient.cboCode.Value = Me.cboCode.Value
    ufAddPatient.txtMRN.Value = Me.txtMRN.Value
    ufAddPatient.txtMeds.Text = Me.txtMeds.Value
    ufAddPatient.txtHPI.Text = Me.txtHPI.Value
    ufAddPatient.txtFU.Text = Me.txtFU.Value
    ufAddPatient.txtAllergies.Text = Me.txtAllergies.Value
    ufAddPatient.txtPPx.Text = Me.txtPPx.Value
    ufAddPatient.txtDDx.Text = Me.txtDDx.Value
    ufAddPatient.txtPain.Text = Me.txtPain.Value
    ufAddPatient.txtLabs.Text = Me.txtLabs.Value
    ufAddPatient.txtImaging.Text = Me.txtImaging.Value
    ufAddPatient.txtProcedures.Text = Me.txtProcedures.Value
    ufAddPatient.chkAnticoag.Value = Me.chkAnticoag.Value
    ufAddPatient.chkInsulin.Value = Me.chkInsulin.Value
    ufAddPatient.cboResident.Value = Me.cboResident.Value
    ufAddPatient.txtDispo.Text = Me.txtDispo.Value
    
    If Me.chkTime.Value = True Then
        vTimestamp = Now()
    Else
        vTimestamp = dict.Item("timestamp")
    End If
    
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' CHECK IF ROOM EXISTS
    
    Dim n As Integer
    n = ActiveDocument.Bookmarks.Count
    
    If n <> 0 Then
        Dim roomArray()
        ReDim roomArray(1 To n)
   
        For i = 1 To n
            roomArray(i) = Split(ActiveDocument.Bookmarks(i).Name, "_")(1)
        Next
    
        d = "#"
        s = Join(roomArray, d)
        s = d & s & d
        
        If InStr(1, s, d & ufAddPatient.txtRoom.Text & d, vbBinaryCompare) Then
            MsgBox "Room " & Me.txtRoom.Value & " is already on census.", vbOKOnly, "Room Number Exists"
            txtRoom.SetFocus
            Exit Sub
        End If

    End If
    
    'Me.Hide
    ufAdd.Hide
    Call main("ADD", "ROOM")

End Sub
Private Sub cmdCancel_Click()
    Unload Me
    End
End Sub
Function dateCheckDOB(dateValueDOB As String) As Boolean
    If Format(CDate(txtDOB), "mm/dd/yyyy") = dateValueDOB Or _
            Format(CDate(txtDOB), "m/d/yyyy") = dateValueDOB Or _
            Format(CDate(txtDOB), "mm/d/yyyy") = dateValueDOB Or _
            Format(CDate(txtDOB), "m/dd/yyyy") = dateValueDOB Then
            
        dateCheckDOB = True
    End If
End Function
Function dateCheckAdmit(dateValueAdmit As String) As Boolean
    If Format(CDate(txtAdmit), "mm/dd/yyyy") = dateValueAdmit Or _
            Format(CDate(txtAdmit), "m/d/yyyy") = dateValueAdmit Or _
            Format(CDate(txtAdmit), "mm/d/yyyy") = dateValueAdmit Or _
            Format(CDate(txtAdmit), "m/dd/yyyy") = dateValueAdmit Then
        
        dateCheckAdmit = True
    End If
End Function