Registration

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Registration (Module)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Provides the necessary commands for performing a program registration for _
    Job Corps students.
' Requires two sets of actions: Adding the student to the AddressBook, then _
    performing the course enrollment.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

'AS400 specific values
    Const rowHome As Long = 19
    Const colHome As Long = 7
    Const optionCustomerService As String = "1"
    Const optionAddressBook As String = "3"
    Const optionOrderEntry As String = "20"
    Const optionEducationInquiry As String = "15"
    Const locationAddressBook As String = "01051"
    Const locationExtraEnrollScreen As String = "66302"
    Const locationPaymentTerms As String = "66314"
    Const actionCodeC As String = "C"
    Const actionCodeI As String = "I"
    Const actionCodeA As String = "A"
    Const searchType As String = "TR"
    Const schoolType As String = "HS"
    Const degreeCode As String = "N"
    Const emailCode As String = "E"
    Const PACode As String = "PA"
    Const TUICode As String = "TUI"

Public Sub RegisterToAddressBook(ByRef Student As cStudent, _
    ByVal AS400 As cAS400, ByRef Exception As cException)
    
    'Passes error handling up the call stack
    On Error GoTo 0
    Exception.Push "Registration.RegisterToAddressBook"
    
    NavigateHome AS400, Exception
    If ConfirmHomeScreen(AS400, Exception) = False Then GoTo NavigationFailure
    
    Exception.ErrMessage = "Navigating to the AddressBook"
    AS400.SetText optionCustomerService, rowHome, colHome
    AS400.SendKeys EnterKey
    
    AS400.SetText optionAddressBook, rowHome, colHome
    AS400.SendKeys EnterKey
    
    Exception.ErrMessage = "Checking if navigation successful"
    If AS400.SearchText(locationAddressBook, 1, 1, forward) = False Then GoTo NavigationFailure
    
    Exception.ErrMessage = "Entering the student information"
    With AS400
        .SetText actionCodeA, 3, 19
        .SetText searchType, 14, 19
        .SetText Student.GetPrefixCode, 23, 19
        .SetText Student.GetMailingName, 4, 19
        .SetText Student.GetAlphaName, 6, 19
        .SetText Student.GetParentCode, 17, 55
    
    
    If Len(Student.GetLongNumber) >= 1 Then
            .SetText Student.GetLongNumber, 2, 60
    End If
    
        .SendKeys EnterKey
    
    Exception.ErrMessage = "Pulling the Student ID#"
    Student.StudentID = Trim(.GetText(4, 32, modLength))
    
    End With
    
    If Len(Student.StudentID) < modLength Or Not IsNumeric(Student.StudentID) Then GoTo NavigationFailure
    
    Exception.ErrMessage = "Navigating the Enter=>F3 sequence"
    With AS400
        .SendKeys EnterKey
        .SendKeys F3Key
        .SendKeys EnterKey
        .SendKeys F3Key
        .SendKeys EnterKey
        .SendKeys F3Key
        .SendKeys EnterKey
        .SendKeys F3Key
        
    Exception.ErrMessage = "Entering the Web Times"
        .SetText Student.GetWebStartTime, 13, 23
        .SetText Student.GetWebEndTime, 14, 23
        .SendKeys EnterKey
        .SendKeys F3Key
        
    Exception.ErrMessage = "Entering the Account Info"
        .SetText schoolType, 6, 23
        .SetText degreeCode, 10, 23
        .SetText Student.GetGender, 19, 57
        .SendKeys EnterKey
        .SendKeys F3Key
        .SendKeys EnterKey
        .SendKeys EnterKey
        
    Exception.ErrMessage = "Entering the phone number"
    If Len(Trim(Student.GetPhoneNumber)) > 0 Then
            .SendKeys F12Key
            .SetText actionCodeC, 4, 21
            .SetText Student.GetAreaCode, 11, 9
            .SetText Student.GetPhoneNumber, 11, 16
            .SendKeys EnterKey
            .SendKeys F3Key
    End If
    
    Exception.ErrMessage = "Entering the email"
        .SendKeys F5Key
        .SendKeys F4Key
        .SetText actionCodeC, 3, 18
        .SetText emailCode, 11, 62
        .SetText Student.GetEmail, 10, 4
        .SendKeys EnterKey
        .SendKeys F3Key
        .SendKeys F3Key
        
    End With
    
Cleanup:

    Exception.Pop
    
Exit Sub

NavigationFailure:

    Exception.Flag = True
        
GoTo Cleanup

End Sub

Public Sub RegisterToProgramEntry(ByRef Student As cStudent, _
    ByVal AS400 As cAS400, ByRef Exception As cException, Optional ByRef StatusBox As Object)
    
    'Passes error handling up the call stack
    On Error GoTo 0
    Exception.Push "Registration.RegisterToAddressBook"
    
    NavigateHome AS400, Exception
    If ConfirmHomeScreen(AS400, Exception) = False Then GoTo NavigationFailure
    
    Exception.ErrMessage = "Navigating to OrderEntry"
    
    With AS400
        
        .SetText optionOrderEntry, rowHome, colHome
        .SendKeys EnterKey
        
    Exception.ErrMessage = "Applying the enrollment information"
        .SetText actionCodeA, 3, 20
        .SetText Student.StudentID, 4, 20
        .SetText Student.GetSalesperson, 6, 20
        .SetText Student.GetProgramNumber, 7, 20
        
    If Len(Trim(Student.GetPONumber)) > 0 Then
            .SetText Student.GetPONumber, 8, 20
    End If
    
        .SendKeys EnterKey

    Exception.ErrMessage = "Checking for PS screen 66302"
    If .SearchText(locationExtraEnrollScreen, 1, 1, forward) Then
            .SendKeys EnterKey
    End If
    
    Exception.ErrMessage = "Entering the tuition information"
        .SetText PACode, 11, 11
        .SetText TUICode, 11, 16
        .SetText Student.GetProgramTuition, 11, 54
        .SendKeys EnterKey
        
    End With
        
    Exception.ErrMessage = "Entering the payment terms"
    If AS400.SearchText(locationPaymentTerms, 1, 1, forward) = False Then GoTo ItemNotFound
    
    With AS400
    
        .SendKeys EnterKey
        .SendKeys EnterKey
        .SendKeys F3Key
    
    End With
    
    Exception.ErrMessage = "Executing final registration"
    AS400.SendKeys F11Key
    
    Exception.ErrMessage = "Navigating the Eduction Inquiry screen"
    With AS400
        .SendKeys F3Key
        .SetText optionCustomerService, rowHome, colHome
        .SendKeys EnterKey
        .SetText optionEducationInquiry, rowHome, colHome
        .SendKeys EnterKey
        .SetText Student.StudentID, 3, 13
        .SendKeys EnterKey
    End With
    
Cleanup:

    Exception.Pop
    
Exit Sub

ItemNotFound:

    With Exception
        .Flag = True
        .IsError = False
        .ErrMessage = "The AS/400 has red bar'd an entry field"
        .Throw "The Parent, Salesperson, or Course Number is invalid and " & _
                    "has prevented the AS/400 from proceeding forward."
    End With

NavigationFailure:

    With Exception
        .Flag = True
        .IsError = False
        .ErrMessage = "Navigation has failed"
    End With
    
GoTo Cleanup
    
End Sub
    
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' LoadUserformObjects
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub LoadUserformObjects(ByRef Student As cStudent, ByVal RegForm As MSForms.UserForm, _
    ByRef Exception As cException)
    
    'Pass error handling up the call stack
    On Error GoTo 0
    Exception.Push "Registration.LoadUserformObjects"

    'Pass userform
    Set Student.UserFormObject = RegForm
    
    With RegForm
    'Pass textboxes
        Set Student.SalespersonTextbox = .Salesperson_Textbox
        Set Student.ParentCodeTextBox = .ParentCode_Textbox
        Set Student.FirstNameTextbox = .Firstname_Textbox
        Set Student.LastNameTextbox = .Lastname_Textbox
        Set Student.MiddleNameTextbox = .Middlename_Textbox
        Set Student.WebStartTimeTextbox = .WebStartTime_Textbox
        Set Student.WebEndTimeTextbox = .WebEndTime_Textbox
        Set Student.ProgramNumberTextbox = .ProgramNumber_Textbox
        Set Student.ProgramTuitionTextbox = .ProgramTuition_Textbox
        Set Student.EmailTextbox = .Email_Textbox
        Set Student.PONumberTextbox = .PONumber_Textbox
        Set Student.LongNumberTextbox = .LongNumber_Textbox
        Set Student.AreaCodeTextbox = .AreaCode_Textbox
        Set Student.PhoneNumberTextbox = .PhoneNumber_Textbox
        
        'Pass comboboxes
        Set Student.SessionComboBox = .Session_ComboBox
        Set Student.PrefixCodeTextbox = .PrefixCode_Textbox
        
        'Pass option selection
        Set Student.MaleOptionButton = .Male_Optionselect
        Set Student.FemaleOptionButton = .Female_Optionselect
    End With
    
Cleanup:

    If Not Exception Is Nothing Then Exception.Pop

End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ApproveRegistration
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function ApproveRegistration(ByVal Student As cStudent, ByRef Exception As cException) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Allows the user to confirm the current enrollment _
    information prior to executing the AS/400 procedures.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'Pass error handling up the call stack
    On Error GoTo 0
    
    Exception.Push "Registration.ApproveRegistration"
    
    Dim redMessage As String
    redMessage = vbTab & "FINAL CONFIRMATION" & vbNewLine & vbNewLine & _
                        "One or more errors have occurred. Please" & _
                        "resolve the following issues before proceeding." & vbNewLine & vbNewLine
    
    Dim blueMessage As String
    blueMessage = vbTab & "FINAL CONFIRMATION" & vbNewLine & vbNewLine & _
                        "Please confirm the following information " & _
                        "before proceeding with the enrollment script." & vbNewLine & vbNewLine
    
    Dim approvalFlag As Boolean
    approvalFlag = True
    
    Dim userSelection As Integer
    userSelection = 2
    
    If Exception.Flag = True Then approvalFlag = False
    
    ConfirmAccountInfo Student, approvalFlag, redMessage, blueMessage, Exception
    ConfirmStudentFile Student, approvalFlag, redMessage, blueMessage, Exception
    
    If Not Exception Is Nothing Then Exception.ErrMessage = "Providing the final checklist..."
    
    If approvalFlag = False Then
    
         
        MsgBox redMessage, vbCritical, "Pre-Enrollment Checklist"
        
    Else
    
         
        userSelection = MsgBox(blueMessage, vbOKCancel, "Pre-Enrollment Checklist")
        If userSelection = vbOK Then approvalFlag = True
        If userSelection = vbCancel Then approvalFlag = False
        
    End If
    
    ApproveRegistration = approvalFlag
    
Cleanup:

    Exception.Pop

End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ConfirmAccountInfo
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub ConfirmAccountInfo(ByVal Student As cStudent, ByRef approvalFlag As Boolean, _
    ByRef redMessage As String, ByRef blueMessage As String, Optional ByRef Exception As cException)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' For the ApproveRegistration procedure
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'Pass error handling up the call stack
    On Error GoTo 0
    
    If Not Exception Is Nothing Then Exception.Push "Registration.ConfirmAccountInfo"
    
    Dim temp As String
    With Student
    
    'AS/400 Session
    temp = .GetSession
    If Len(temp) = 1 And InStr("ABCDEFGHIJKLMNOPQRSTUVWXYZ", temp) >= 1 Then
        blueMessage = blueMessage & "Session:" & vbTab & vbTab & temp & vbNewLine & vbNewLine
    Else
        approvalFlag = False
        redMessage = redMessage & "* The AS/400 session name must be a single letter" & vbNewLine
    End If
    
    'PrefixCode
    temp = .GetPrefixCode
    If Len(temp) = 3 Then
        blueMessage = blueMessage & "PrefixCode:" & vbTab & temp & vbNewLine
    Else
        approvalFlag = False
        redMessage = redMessage & "* The prefix code must be 3 characters long" & vbNewLine
    End If
    
    'Program Number
    temp = .GetProgramNumber
    If IsNumeric(temp) And Len(temp) = 8 Then
        blueMessage = blueMessage & "Program Number:" & vbTab & temp & vbNewLine
    Else
        approvalFlag = False
        redMessage = redMessage & "* The program number must be numeric and 8 digits long" & vbNewLine
    End If
    
    'Program Tuition
    temp = .GetProgramTuition
    If IsNumeric(temp) And Val(temp) >= 1 Then
        blueMessage = blueMessage & "Program Tuition:" & vbTab & Format(temp, "Currency") & vbNewLine & vbNewLine
    Else
        approvalFlag = False
        redMessage = redMessage & "* The program tuition must be numeric and greater than zero" & vbNewLine
    End If
    
    'Web Start Time
    temp = .GetWebStartTime
    If IsNumeric(temp) And Len(temp) <= 6 Then
        blueMessage = blueMessage & "WebStartTime:" & vbTab & temp & vbNewLine
    Else
        blueMessage = blueMessage & "WebStartTime:" & vbTab & "000000" & vbNewLine
    End If
    
    'Web End Time
    temp = .GetWebEndTime
    If IsNumeric(temp) And Len(temp) <= 6 Then
        blueMessage = blueMessage & "WebEndTime:" & vbTab & temp & vbNewLine & vbNewLine
    Else
        blueMessage = blueMessage & "WebEndTime:" & vbTab & "000000" & vbNewLine
    End If
    
    If Len(.GetPONumber) >= 1 Then
        blueMessage = blueMessage & "PO Number:" & vbTab & .GetPONumber & vbNewLine & vbNewLine
    End If
    
Cleanup:
    
    End With
    If Not Exception Is Nothing Then Exception.Pop
    
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ConfirmStudentFile
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub ConfirmStudentFile(ByVal Student As cStudent, ByRef approvalFlag As Boolean, _
    ByRef redMessage As String, ByRef blueMessage As String, Optional ByRef Exception As cException)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' For the ApproveRegistration procedure
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'Pass error handling up the call stack
    On Error GoTo 0
    If Not Exception Is Nothing Then Exception.Push "Registration.ConfirmStudentFile"
    
    With Student
    
    'Student Name
    If Len(.GetMailingName) < 4 Or Len(.GetMailingName) > 38 Then
        approvalFlag = False
        redMessage = redMessage & "* The student's full name must be between 4 and 38 characters" & vbNewLine
    Else
        blueMessage = blueMessage & "MailingName:" & vbTab & .GetMailingName & vbNewLine
        blueMessage = blueMessage & "AlphaName:" & vbTab & .GetAlphaName & vbNewLine
    End If
    
    blueMessage = blueMessage & "Gender:" & vbTab & vbTab & .GetGender & vbNewLine
    
    'Phone Number
    blueMessage = blueMessage & "Phone:" & vbTab & vbTab & .GetAreaCode & "-" & .GetPhoneNumber & vbNewLine
        
    'Student Email
    blueMessage = blueMessage & "Email:" & vbTab & vbTab & .GetEmail & vbNewLine & vbNewLine
    
    'Long Number
    blueMessage = blueMessage & "Long#:" & vbTab & vbTab & .GetLongNumber & vbNewLine
    
    'PO Number
    blueMessage = blueMessage & "PO#:" & vbTab & vbTab & .GetPONumber & vbNewLine
    
Cleanup:
    
    End With
    If Not Exception Is Nothing Then Exception.Pop
    
End Sub