Option Explicit


'<Script Language="VBScript">
'******************************************************************************************
' In general, for any given type of data you wish to
' validate (currency, numeric, ssn, etc), there are two routines.
'
' For example: ValidateNumericValue and ValidateNumericField.
' ValidateNumericValue -- Pass it a value and it performs the validation
'                         and adds error messages to the Odyssey message
'                         area if the data is invalid.
' ValidateNumericField -- Pass it an HTML control and it uses ValidateNumericValue
'                         to perform the validation and message area additions, then
'                         sets the appropriate className on your HTML object.
'******************************************************************************************
' There are several routines in the upper portion of this class that pre-date
' the Odyssey message area and thus are obsolete, but will not be removed until
' we get a chance to search the code base to ensure that they are not in use.
'
' DON'T USE THEM IN NEW CODE!
'******************************************************************************************


'******************************************************************************************
'* cValidate
'* Class is intended to encapsulate any client side validation of fields.
'******************************************************************************************
'******************************************************************************************
'* WHO     WHEN               WHAT
'*========================================================================================
'* CTP     08/21/2000         Original
'* DJN     08/30/2000         Added ValidateDate and ValidateNumeric and ValidatePhone and
'*                            Trim
'* DJN     09/05/2000         Removed the focus call on error
'* PKB     12/04/2000         Added OkayToSave routine.
'* DJN     01/11/2001         Fixed the phone number validator after some yak
'*                            changed it
'* RLS     04/04/2001         Modified the error message in ValidateTrimReqValue to properly address a missing Case Category.
'* JKA     04/04/2001         GetPhoneNS was checking the length of the wrong string
'* JKA     04/05/2001         Added function AddShellWarning
'* JKA     04/24/2001         ValidatePhoneValue and ValidatePhone - strip parentheses from phone numbers
'* RLS     04/25/2001         Added FormatCurrency() function.
'* MCB     05/08/2001         Added ValidateZip
'* JKA     05/08/2001         ValidateZip wasn't checking for a minimum of 5/9 digits
'* PKB     05/16/2001         Added ValidateCurrencyField method.
'* PKB     05/17/2001         Modified FormatCurrency() to handle negatives.
'* MCB     05/18/2001         Added ValidateEMail
'* RLS     06/20/2001         Modified ValidateZip to handle 5 digit/single char/4 digit input
'* TEM     07/11/2001         Modified FormatTime to allow time to contain mixed delimiters.
'* TEM     07/12/2001         Modified FormatTime to recognize "noon" and "midnight".
'* RLS     08/21/2001         Modified ValidateDateValue to set a more explicit error message when date is greater
'*							              than upper date limit (to conform to UI standards (16.4.2)).
'* JPD	   08/27/2001		      Removed single quotes around field names in error messages (UI standard 9.1.2)
'* CTP     09/04/2001         Modified AddErrorStreamToMessageArea to only add errors to the
'*                            window that have the DisplayError property set to true.  Also changed
'*                            the sub to be a function that returns the EMPErrors collection to 
'*                            the caller
'* EDB     09/12/2001         Removed single quotes for field names in ValidateTimeValue.
'* MAN	   09/28/2001		      Altered regular-expression of ValidateEMail to accept uppercase letters in area following @ symbol
'*                            in response to QA Entry #1565
'* TEM     11/05/2001         Changed ValidateNumericValue to not pass an empty string as a valid number for required fields 
'*                            in response to QA #2175
'* MJH     11/15/2001         Added ValidateCodeName to adhere to the UI Standards of what characters are valid
'*                            in a code name/userID.
'* RLS     11/20/2001         Added functionality to detect and reroute a code maintenance generated logical 
'*                            error in several of the validation routines. This supresses the error until the user clicks save.
'* JKA     11/20/2001         updated ValidateDateValue to check for values outside the range handled by SQL Server's
'*                            DATETIME type.  
'* MAN	   11/30/2001		      Made ValidateZip check to see if the zip code is valid regaurdless of whether it was required or not(unless blank)
'* RLS     12/06/2001         Modified ValidateCodeName to optionally allow white space (blanks) to be valid input.
'* MSD	   02/06/2002		      Added ValidateField for those moments when you need validation, without trimming.  :-)
'* MSD	   02/19/2002		      Added FormatUIDate for formatting dates to UI Standards.
'* DMS     03/22/2002         Added the Window property so that an instance can be hosted in another document's engine
'* EDB     05/17/2002         Changed the ModalMsgBox call to ModalMsgBoxNotUsed.  The proper function
'*                            is in ModalMessageBox.vbs.  It is called ModalMsgBox but the arguments are different
'*                            to allow for the setting of a Safe Button on the Modal.  Updated DebugMsg to use this call.
'* SSM     06/03/2002         Changed ModalMsgBoxNotUsed back to ModalMsgBox to help with retrofit.  Updated DebugMsg reference.
'* JPB     06/19/2002         Changed ValidatePhoneValue so that it creates an error when a non-numeric value is entered for the phone number.
'* RLS     07/22/2002         Removed all references to old code maintenance logic added 11/20/2001.
'* JB      08/08/2002         Changed ValidatePhoneValue to allow letter-based phone numbers of at least 7 dialable characters
'*                            in response to QA Entry #227.
'* SK      11/12/2002         Capitalized phone number in the error message of ValidatePhoneValue 
'*                            in response to QA #953 (UI SRS 23.1.2)
'* MPC     11/19/2002         Added IsAlphaNumeric
'* CTP     04/17/2003         Split text email validation into separate function called ValidateEMailText
'*                            to be able to validate an email address without passing a control object.
'* CC      01/04/2005         Changed email validation to a better regular expression, left old one if new causes
'*                            problems (QA #8640).
'******************************************************************************************

'  Do not change the validation logic in ANY of these routines.
'  If some of the logic seem wierd, it's probably intentional to
'  conform to a specification in the general requirements document


Class cValidate
  Private mvaroWindow
  
'*========================================
' this property allows the validation class to
' be hosted in another document's script engine. if
' we retrieve the external reference from the window
' object the the error messages will be added to
' which ever window is specified here.  Fear not, for
' it defaults to the current window!
Public Property Set Window(oWindow)
  Set mvaroWindow = oWindow
End Property

Public Property Get Window()
  Set Window = mvaroWindow
End Property

'*========================================
Public Function ValidateTrimField(txtObject, fRequired, ErrClass, NormClass, Description, ErrorID)
  txtObject.Value = Trim(txtObject.Value)

  ValidateTrimField = True
  If fRequired Then
    If Len(txtObject.Value) = 0 Then
      ValidateTrimField = False
    End If
  End If
  
  If ValidateTrimField Then
    txtObject.className = NormClass
    Call RemoveShellMessage(ErrorID)
  Else
    txtObject.className = ErrClass
    Call AddShellMessage(ErrorID, Description & " is a required field.")
  End If
End Function
'*========================================
Public Function ValidateTrimNoUpperASCII(txtObject, fRequired, ErrClass, NormClass, Description, ErrorID)
  Dim i
  Dim chrChar
  Dim intCharASCII
  
  txtObject.Value = Trim(txtObject.Value)

  ValidateTrimNoUpperASCII = 0
  If fRequired Then
    If Len(txtObject.Value) = 0 Then
      ValidateTrimNoUpperASCII = 1
    End If
  End If
  
  'Validate to insure no upper asci characters are in the string.     
  If Len(txtObject.Value) > 0 Then
  
    For i = 1 to Len(txtObject.Value)
      chrChar = Mid(txtObject.Value,i,1)
      intCharASCII = Asc(chrChar)
      If intCharASCII > 127 Then
        ValidateTrimNoUpperASCII = 2
      End If    
    Next
    
  End If
  
  Select Case ValidateTrimNoUpperASCII
    Case 0
      txtObject.className = NormClass
      Call RemoveShellMessage(ErrorID)
    Case 1
      txtObject.className = ErrClass
      Call AddShellMessage(ErrorID, Description & " is a required field.")
    Case 2
      txtObject.className = ErrClass
      Call AddShellMessage(ErrorID, Description & " contains an invalid character.")
  End Select    
  
End Function
'*========================================
Public Function ValidateField(txtObject, fRequired, ErrClass, NormClass, Description, ErrorID)

  ValidateField = True
  If fRequired Then
    If Len(txtObject.Value) = 0 Then
      ValidateField = False
    End If
  End If
  
  If ValidateField Then
    txtObject.className = NormClass
    Call RemoveShellMessage(ErrorID)
  Else
    txtObject.className = ErrClass
    Call AddShellMessage(ErrorID, Description & " is a required field.")
  End If
End Function

'*========================================
Public Sub ValidateTrim(txtObject)
  txtObject.Value = Trim(txtObject.Value)
End Sub

Public Sub ValidateTrimReq(txtObject, ErrClass, NormClass)
  txtObject.Value = Trim(txtObject.Value)

  If txtObject.Value <> vbNullString Then
    txtObject.className = NormClass
  Else
    txtObject.className = ErrClass
  End If
End Sub


'*========================================
Public Sub ValidatePhone(txtObject, DefAreaCode, fRequired, ErrClass, NormClass)
'  Inputs
'  txtObject    - The object representing the control ( Me )
'  DefAreaCode  - The default area code to be prefixed to the front of a 7 digit phone number
'  fRequired    - Is "" a valid response for this field?
'  ErrClass     - Class to set the control to if an error is detected
'  NormClass    - Class to set the control to if the data if valid
  Dim OrigValue, StrippedValue, LenValue, fCorrect, Delim
  
  'This is the delimiter to use in the final formated phone number
  Delim = "-"
  
  fCorrect = False
  OrigValue = Trim(txtObject.Value)
  StrippedValue = OrigValue

  txtObject.Value = OrigValue

  If (StrippedValue <> "") Then
    StrippedValue = Replace(StrippedValue, "-", "")
    StrippedValue = Replace(StrippedValue, ".", "")
    StrippedValue = Replace(StrippedValue, ",", "")
    StrippedValue = Replace(StrippedValue, "/", "")
    StrippedValue = Replace(StrippedValue, "\", "")
    StrippedValue = Replace(StrippedValue, "|", "")
    StrippedValue = Replace(StrippedValue, "+", "")
    StrippedValue = Replace(StrippedValue, "=", "")
    StrippedValue = Replace(StrippedValue, "_", "")
    StrippedValue = Replace(StrippedValue, "(", "")
    StrippedValue = Replace(StrippedValue, ")", "")
    
    If (IsNumeric(StrippedValue)) Then
      LenValue = Len(StrippedValue)

      If (Left(StrippedValue, 3) = "011") Then
        fCorrect = True
      Else
        If ((LenValue = 11) And (Left(StrippedValue, 1) = "1")) Then
          StrippedValue = Mid(StrippedValue, 2)
          LenValue = 10
        End If

        If ((LenValue = 7) And (DefAreaCode <> "")) Then
          txtObject.Value = DefAreaCode & Delim & Left(StrippedValue, 3) & Delim & Right(StrippedValue, 4)
          fCorrect = True
        ElseIf (LenValue = 10) Then
          txtObject.Value = Left(StrippedValue, 3) & Delim & Mid(StrippedValue, 4, 3) & Delim & Right(StrippedValue, 4)
          fCorrect = True
        End If
      End If
    Else
      fCorrect = True
    End If
  ElseIf (Not (fRequired)) Then
    fCorrect = True
  End If

  If (fCorrect) Then
    txtObject.className = NormClass
  Else
    txtObject.className = ErrClass
    MsgBox "'" & OrigValue & "' is an invalid phone number"
  End If
End Sub

'*========================================
Public Sub ValidateSSN(txtObject, fRequired, ErrClass, NormClass)
'  Inputs
'  txtObject   - The object representing the control ( Me )
'  fRequired   - Is "" a valid response for this field?
'  ErrClass    - Class to set the control to if an error is detected
'  NormClass   - Class to set the control to if the data if valid
  Dim InSSN, StripSSN

  InSSN = Trim(txtObject.Value)
  StripSSN = Replace(InSSN, "-", "")
  
  If ((InSSN = "") And Not (fRequired)) Then
    txtObject.className = NormClass
  ElseIf ((Len(StripSSN) = 9) And IsNumeric(StripSSN)) Then
    txtObject.Value = Left(StripSSN, 3) & "-" & Mid(StripSSN, 4, 2) & "-" & Right(StripSSN, 4)
    txtObject.className = NormClass
  Else
    txtObject.className = ErrClass
 '   MsgBox "Social security must contain 9 digits." & vbCrLf &"It must be entered as 123456789 or 123-45-6789", ,"Invalid social security number"
  End If
End Sub

'*========================================
Public Function ValidateZip(txtObject, fRequired, ErrClass, NormClass, ErrorID)
'  Inputs
'  txtObject   - The object representing the control ( Me )
'  fRequired   - Is "" a valid response for this field?
'  ErrClass    - Class to set the control to if an error is detected
'  NormClass   - Class to set the control to if the data if valid
  Dim InZip, StripZip

  InZip = Trim(txtObject.Value)
  StripZip = Replace(InZip, "-", "")
  ValidateZip = True
  If ((InZip = "") And Not (fRequired)) Then
    txtObject.className = NormClass
    RemoveShellMessage ErrorID
  ElseIf ((Len(StripZip) = 9) And IsNumeric(StripZip)) Then
    txtObject.Value = Left(StripZip, 5) & "-" & Right(StripZip, 4)
    txtObject.className = NormClass
    RemoveShellMessage ErrorID
  ElseIf ((Len(StripZip) = 5) And IsNumeric(StripZip)) Then
    txtObject.Value = StripZip
    txtObject.className = NormClass
    RemoveShellMessage ErrorID

'---| RLS 06/20/2001 - QA Defect #17 |----------------------------------------------------------
  
  ElseIf ((Len(StripZip) = 10) And (IsNumeric(Left(StripZip, 5))) And (IsNumeric(Right(StripZip, 4))) And Not (IsNumeric(Mid(StripZip, 6, 1)))) Then
    txtObject.Value = Left(StripZip, 5) & "-" & Right(StripZip, 4)
    txtObject.className = NormClass
    RemoveShellMessage ErrorID

'-----------------------------------------------------------------------------------------------

  ElseIf InZip = "" And (fRequired) then 
    txtObject.className = ErrClass
    AddShellMessage ErrorID, "ZIP Code is a required field."
    ValidateZip = False
  Else
    'jka  05/08/2001 - need to verify that ZIP code is correct number of digits
    txtObject.className = ErrClass
    AddShellMessage ErrorID, "'" & InZip & "' is an invalid ZIP Code."
    ValidateZip = False
  End If
End Function

'*========================================
' ValidateEMail
'    txtObject    -   Object representing the control
'    fRequired    -   Is the field required?  (boolean)
'    ErrorClass   -   Class for field when error found
'    NormClass    -   Class for field when object validates
'    ErrorID      -   Unique identifier for error message
'*========================================
Public Function ValidateEMail(txtObject, fRequired, ErrorClass, NormClass, ErrorID)
  Dim Flag: Flag = False
  Dim sErrorMsg
  
  
  ValidateEMail = True
  
   If txtObject.Value <> "" Then
      If Not ((ValidateEMailText(txtObject.Value))) Then
        Flag = True
        sErrorMsg = "'" & txtObject.Value & "'" & " is an invalid E-mail address."
        AddShellMessage ErrorID, sErrorMsg
        txtObject.className = ErrorClass
        ValidateEMail = False
      End If
   End If

      If Not (Flag) Then
        RemoveShellMessage ErrorID
        txtObject.className = NormClass
      End If
   
   If fRequired = True And txtObject.Value = "" Then
       AddShellMessage ErrorID, "E-mail is a required field."
       txtObject.className = ErrorClass
   End If
End Function


Public Function ValidateEMailText(strEMail)
  '' Returns true if the email address is valid, else false
  Dim oRegExp
  Set oRegExp = New RegExp
  
  oRegExp.Pattern = "^((?:(?:(?:[a-zA-Z0-9][\.\-\+_]?)*)[a-zA-Z0-9_~])+)\@((?:(?:(?:[a-zA-Z0-9][\.\-_]?){0,62})[a-zA-Z0-9])+)\.([a-zA-Z0-9]{2,6})$"
  
  ValidateEMailText = oRegExp.Test(strEMail)
End Function

'*========================================
' ValidateCodeName
'    txtObject    -   Object representing the control
'    fRequired    -   Is the field required?  (boolean)
'    ErrorClass   -   Class for field when error found
'    NormClass    -   Class for field when object validates
'    ErrorID      -   Unique identifier for error message
'    Description  -   Name of the field being validated
'    fAllowSpaces -   Is white space valid?  (boolean)     ' RLS 12/06/2001
'*========================================
Public Function ValidateCodeName(txtObject, fRequired, ErrorClass, NormClass, ErrorID, Description, fAllowSpaces)

  Dim Flag: Flag = False
  Dim oRegExp
  Dim sErrorMsg
  Dim regPattern                     ' RLS 12/06/2001
  
  Set oRegExp = New RegExp
  
  If Not fAllowSpaces Then           ' RLS 12/06/2001	
    regPattern = "^[\w-\.()]+$"      ' RLS 12/06/2001
  Else                               ' RLS 12/06/2001
    regPattern = "^[\w-\.\s()]+$"    ' RLS 12/06/2001
  End If                             ' RLS 12/06/2001
  
  oRegExp.Pattern = regPattern       ' RLS 12/06/2001
  
  ValidateCodeName = True
  
 
   If txtObject.Value <> vbNullString Then
      If Not ((oRegExp.Test(txtObject.Value))) or (uCase(txtObject.Value) = "ALL")Then
        Flag = True
        sErrorMsg = "'" & txtObject.Value & "'" & " is an invalid "& Description & "."
        AddShellMessage ErrorID, sErrorMsg
        txtObject.className = ErrorClass
        ValidateCodeName = False
      End If
   End If

   If Not (Flag) Then
      RemoveShellMessage ErrorID
      txtObject.className = NormClass
   End If

   If fRequired = True And txtObject.Value = vbNullString Then
       AddShellMessage ErrorID, Description & " is a required field."
       txtObject.className = ErrorClass
       ValidateCodeName = False
   End If
 

End Function
'*========================================
' ValidateCAMACodeName
'    txtObject    -   Object representing the control
'    fRequired    -   Is the field required?  (boolean)
'    ErrorClass   -   Class for field when error found
'    NormClass    -   Class for field when object validates
'    ErrorID      -   Unique identifier for error message
'    Description  -   Name of the field being validated
'    fAllowSpaces -   Is white space valid?  (boolean)
'
' CAG 07/29/2003 QA3219
'*========================================
Public Function ValidateCAMACodeName(txtObject, fRequired, ErrorClass, NormClass, ErrorID, Description, fAllowSpaces)

  Dim Flag: Flag = False
  Dim oRegExp
  Dim sErrorMsg
  Dim regPattern
  
  Set oRegExp = New RegExp
  
  If Not fAllowSpaces Then
    regPattern = "^[\w-\.()+-]+$"
  Else
    regPattern = "^[\w-\.\s()+-]+$"
  End If
  
  oRegExp.Pattern = regPattern
  
  ValidateCAMACodeName = True
  
 
   If txtObject.Value <> vbNullString Then
      If Not ((oRegExp.Test(txtObject.Value))) or (uCase(txtObject.Value) = "ALL")Then
        Flag = True
        sErrorMsg = "'" & txtObject.Value & "'" & " is an invalid "& Description & "."
        AddShellMessage ErrorID, sErrorMsg
        txtObject.className = ErrorClass
        ValidateCAMACodeName = False
      End If
   End If

   If Not (Flag) Then
      RemoveShellMessage ErrorID
      txtObject.className = NormClass
   End If

   If fRequired = True And txtObject.Value = vbNullString Then
       AddShellMessage ErrorID, Description & " is a required field."
       txtObject.className = ErrorClass
       ValidateCAMACodeName = False
   End If
 

End Function
'*========================================
Function GetPhoneNS(PhoneNum)
'  Inputs
'  PhoneNum   - Text string representing the phone number
'  Output
'  True  - Non Standard Number
'  False - Standard Number
' Comments : Has to be used on a validated number

   Dim LenStrip
   Dim StripPhone
      
   StripPhone = PhoneNum
      
   StripPhone = Replace(StripPhone, "-", "")

   'JKA 4/4/2001
   'LenStrip = len(PhoneNum)
   LenStrip = Len(StripPhone)
     
   If ((LenStrip = 10) And IsNumeric(StripPhone)) Then
      GetPhoneNS = False
   Else
      GetPhoneNS = True
   End If
End Function

'*========================================
Public Sub ValidateNumeric(Description, txtObject, MinVal, MaxVal, Precision, fRequired, ErrClass, NormClass)
'  Inputs
'  Description - The description of the field
'  txtObject   - The object representing the control ( Me )
'  MinVal      - If this number needs to be in a range, then put the smallest value here
'                If no range is needed, then pass ""
'  MaxVal      - If this number needs to be in a range, then put the largest value here
'                If no range is needed, then pass ""
'  Precision   - If you want your output to have a certain number of decimal value, then
'                 put that value here.  If you don't want to modify the precision, then pas ""
'  fRequired   - Is "" a valid response for this field?
'  ErrClass    - Class to set the control to if an error is detected
'  NormClass   - Class to set the control to if the data if valid
  Dim Succeeded, VerifiedValue, Errors
  
  Succeeded = External.MOM.NumericValidator.Validate(txtObject.Value, MinVal, MaxVal, Description, Precision, fRequired, VerifiedValue, Errors)
  
  If Not (Succeeded) Then
    txtObject.className = ErrClass
  Else
    txtObject.Value = VerifiedValue
    txtObject.className = NormClass
  End If
End Sub

'*========================================
Public Sub ValidateDate(Description, txtObject, MinDate, MaxDate, fRequired, ErrClass, NormClass)
'  Designed to be called as an event handler
'  ex: <input type="Text" class="Data" id='DOB' onblur='Validator.ValidateDate "Date of Birth", Me, "", "", false, "errNormal", "Data">
'
'  Inputs
'  Description - The description of the field
'  txtObject   - The object representing the control ( Me )
'  MinDate     - If this date needs to be in a range, then put the oldest date here
'                If no range is needed, then pass ""
'  MaxDate     - If this date needs to be in a range, then put the newest date here
'                If no range is needed, then pass ""
'  fRequired   - Is "" a valid response for this field?
'  ErrClass    - Class to set the control to if an error is detected
'  NormClass   - Class to set the control to if the data if valid

   Dim Succeeded, FinalDate, WasStatic, Errors
   Succeeded = External.MOM.DateValidator.Validate(txtObject.Value, MinDate, MaxDate, Description, fRequired, FinalDate, WasStatic, Errors)
       
   If Not (Succeeded) Then
     txtObject.className = ErrClass
     If (FinalDate <> "") Then txtObject.Value = FinalDate
   Else
     txtObject.Value = FinalDate
     txtObject.className = NormClass
   End If
End Sub


'*========================================
Public Function FormatTime(ByVal External, ByVal FormatCode)
' Returns validates parts of a time passed in and formats the
' output base on format code.  Returns empt
' This currently only supports time.  Will later add date
' as needed
'
' Input  :  External   :   External time or date format
'                          TIME - hh:mm  Also supports am, pm
'                          on the end of the time.  Will also convert seconds
'           FormatCode :   'S' - For hh:mm am/pm.  Ignores seconds
'
' Output :  Formatted time or empty if invalid date
'
' WHO   WHEN      WHY
' ===== ========  =========================================================
' CTP   08/21/00  This was done so that time could be validated in a web page.
' TEM   07/11/01  QA Defect #19 - Code was changed to allow time to contain mixed delimiters.
' TEM   07/12/01  QA Defect #21 - Code was changed to recognize "noon" and "midnight".

  Dim iHours                ' # hours for time conversion
  Dim iMinutes              ' # minutes for time conversion
  Dim iSeconds              ' # seconds for time conversion
  
  Dim Position              ' Location of First Time delimiter
  Dim Position2             ' Location of Second Time delimiter
  Dim Temp                  ' Temp variable for delimiter location
  
  Dim ModExternal           ' External date minus AM, PM, etc.
  Dim Delimit               ' List of Time Delimiters
  Dim Index                 ' Index Variable
  Dim NumDelimiters         ' Highest index of Delimit
  Dim strLength             ' Length of Time string
    
  ' TIME CONVERSION

  If UCase(External) = "NOON" Then
    FormatTime = AugmentTime(12, 0, 0, FormatCode, "12:00:00 PM")
    Exit Function
  ElseIf UCase(External) = "MIDNIGHT" Then
    FormatTime = AugmentTime(12, 0, 0, FormatCode, "12:00:00 AM")
    Exit Function
  End If
  
  ' If the user entered A, P, AM, PM, etc, get rid
  ' of that data and store the time only portion  

  If InStr(UCase(External), "A") > 0 Then
    ModExternal = Left(External, InStr(UCase(External), "A") - 1)
  ElseIf InStr(UCase(External), "P") > 0 Then
    ModExternal = Left(External, InStr(UCase(External), "P") - 1)
  Else
    ModExternal = External
  End If
  
  If ModExternal = "" Then  ' Invalid time entered, exit
    FormatTime = ""
    Exit Function
  End If
    
  ' Next, we will allow users to enter time with ; . , ; / \ - _ ' " or
  ' space as delimiters.  Users may use mixed delimiters.  
  ' ie.  09:30:00 and 09.30.00 are valid as well as 09:30.00.
  '
  ' Here we will set the delimiters.  Note: 34 is ASCII value for quotation mark.
  Delimit = Array(":", ".", ",", ";", "/", "\", "-", "_", "'", Chr(34))
  
	Position = 0
  Position2 = 0
  Temp = 0
  NumDelimiters = UBound(Delimit) ' Highest index of Delimit
	strLength = Len(ModExternal)
	
  ' Loop through the list of delimiters and mark the positions where 
  ' delimiters occur.  If more than two delimiters occur, exit function.

	For Index = 0 to NumDelimiters
		If (Position = 0) Then
			Position = InStr(ModExternal, Delimit(Index))
			If (Position > 0 and strLength > Position+1) Then
				Position2 = InStr(Right(ModExternal, strLength-Position-1), Delimit(Index))
				' if a third delimiter is present, input is invalid
				If (Position2 > 0) Then
					Position2 = Position2 + Position + 1
					If (strLength > Position2+1) Then
						If (InStr(Right(ModExternal, strLength-Position2-1), Delimit(Index)) > 0) Then
							FormatTime = ""
							Exit Function
						End If
					End If
				End If
			End If
    Else
			If (Position2 = 0) Then
				Position2 = InStr(ModExternal, Delimit(Index))
			Else
				' if a third delimiter is present, input is invalid
				If (InStr(ModExternal, Delimit(Index)) > 0) Then
					FormatTime = ""
					Exit Function
				End If
			End If
		End If
	Next
      
  ' Reorder Position and Position2 if necessary
  If (Position2 > 0 and Position2 < Position) Then
    Temp = Position
    Position = Position2
    Position2 = Temp
  End If

  ' Get each piece of the time.  If the string input by the user
  ' did not contain a delimiter, then they just input
  ' the hour.

  If Position = 0 Then
    If Len(ModExternal) = 4 Then ' Input Military Time
      iHours = Left(ModExternal, 2)
      iMinutes = Right(ModExternal, 2)
    Else
      iHours = ModExternal
      iMinutes = 0
    End If
    iSeconds = 0
  Else
    iHours = Mid(ModExternal, 1, Position - 1)
    
    If Position2 = 0 Then
			' Check if delimiter is at end of the Time string
			If (strLength > Position+1) Then
			  iMinutes = Mid(ModExternal, Position + 1)
			Else
				iMinutes = 0
			End If
			iSeconds = 0
    Else
      iMinutes = Mid(ModExternal, Position + 1, Position2 - Position - 1)
			If (strLength > Position2+1) Then
	      iSeconds = Mid(ModExternal, Position2 + 1)
	    Else
				iSeconds = 0
			End If
    End If
  End If
  
  ' Now that we have each piece of the time, validate those items
  ' First, make sure that each part is numeric.
    
  If Not (IsNumeric(iHours)) Then
    FormatTime = ""
    Exit Function
  Else
    If Not (IsNumeric(iMinutes)) Then
      FormatTime = ""
      Exit Function
    Else
      If Not (IsNumeric(iSeconds)) Then
        FormatTime = ""
        Exit Function
      End If
    End If
  End If
    
  iHours = iHours + 0
  iSeconds = iSeconds + 0
  iMinutes = iMinutes + 0
    
  ' Make sure that each part is an integer
      
  If CStr(Int(iHours)) <> CStr(iHours) Then
    FormatTime = ""
    Exit Function
  Else
    If CStr(Int(iMinutes)) <> CStr(iMinutes) Then
      FormatTime = ""
      Exit Function
    Else
      If CStr(Int(iSeconds)) <> CStr(iSeconds) Then
        FormatTime = ""
        Exit Function
      End If
    End If
  End If
   
    
  ' Make sure that the hours entered is between 0 and 23, minutes
  ' are between 0 and 59 and seconds are between 0 and 59
    
  If Int(iHours) < 0 Or Int(iHours) > 23 Then
    FormatTime = ""
    Exit Function
  Else
    If Int(iMinutes) < 0 Or Int(iMinutes) > 59 Then
      FormatTime = ""
      Exit Function
    Else
      If Int(iSeconds) < 0 Or Int(iSeconds) > 59 Then
        FormatTime = ""
        Exit Function
      End If
    End If
  End If
    
 ' Compute Internal Time
 ' NewTime = (iHours * 3600) + (iMinutes * 60) + iSeconds
    
  FormatTime = AugmentTime(iHours, iMinutes, iSeconds, FormatCode, External)
End Function


'*========================================
Private Function AugmentTime(ByVal iHours, ByVal iMinutes, ByVal iSeconds, ByVal FormatCode, ByVal InputTime)
  
  ' Augment times between 12:00am and 6:59:59am so that they are
  ' in the PM range.  This will save the client from having to type P.M.
  '
  ' iHours - Hours to augment, display
  ' iMinutes - Minutes to augment, display
  ' iSeconds - Seconds to augment, display
  ' InputTime - String time that the user entered

  Dim Meridian
  Dim PostMeridian
 

  If InStr(InputTime, "p") Or InStr(InputTime, "P") Then
    PostMeridian = True
    Meridian = False
  Else
    PostMeridian = False
  
    If InStr(InputTime, "a") Or InStr(InputTime, "A") Then
      Meridian = True
    Else
      Meridian = False
    End If
  End If
    
  If Not (Meridian) And Not (PostMeridian) And ((iHours >= 1 And iHours <= 6) Or iHours >= 12) Then
    PostMeridian = True
    Meridian = False
  Else
    If Not (Meridian) And Not (PostMeridian) Then
      Meridian = True
    End If
  End If
    
  Select Case FormatCode
    Case "S"               ' Standard time format, no seconds
      If iHours > 12 Then
        If PostMeridian Then
          iHours = iHours - 12
        Else
          AugmentTime = ""
          Exit Function
        End If
      Else
        If iHours = 0 Then
          iHours = 12
        End If
      End If
   
      AugmentTime = iHours & ":"
   
      If iMinutes < 10 Then
        AugmentTime = AugmentTime & "0"
      End If
      AugmentTime = AugmentTime & iMinutes
   
      If Meridian Then
        AugmentTime = AugmentTime & " " & "AM"
      Else
        AugmentTime = AugmentTime & " " & "PM"
      End If
    Case "M"               ' Military time format
      If Len(iHours) = 1 Then iHours = "0" & iHours
      If Len(iMinutes) = 1 Then iMinutes = "0" & iMinutes
      AugmentTime = iHours & iMinutes
    Case Else
      AugmentTime = ""
  End Select
  
End Function


'=========================================================================================================
'Formats the dates in the tooltips according to UI Standards
'MSD  02/19/2002  Original
'------------------------------------------------------------------------------
  Public Function FormatUIDate(strDate)
    Dim DateArray
    DateArray = Split(strDate, "/")
    If UBound(DateArray) > -1 Then
      If Len(DateArray(0)) = 1 Then
        DateArray(0) = "0" & DateArray(0)
      End If
      If Len(DateArray(1)) = 1 Then
        DateArray(1) = "0" & DateArray(1)
      End If
      FormatUIDate = DateArray(0) & "/" & DateArray(1) & "/" & DateArray(2)
    Else
      FormatUIDate = strDate
    End If
  End Function
'=========================================================================================================

Public Function ValidateTrimReqField(txtObject, ErrClass, NormClass, Description, ErrorID)
  Dim NewValue
  ValidateTrimReqField = Me.ValidateTrimReqValue(txtObject.Value, Description, ErrorID, NewValue)
  
  If ValidateTrimReqField Then
    txtObject.className = NormClass
    txtObject.Value = NewValue
  Else
    txtObject.className = ErrClass
  End If
End Function


'*========================================
Public Function ValidateTrimReqValue(textValue, Description, ErrorID, NewValue)
  NewValue = Trim(textValue)
 
  If NewValue <> vbNullString Then
    ValidateTrimReqValue = True
    RemoveShellMessage ErrorID
  Else
    ValidateTrimReqValue = False
    Dim NewMessage
        If Description = "Case Categories" Then                              ' RLS 04/04/2001
			NewMessage = "At least one case category is required."           ' RLS 04/04/2001
        ElseIf Description = "Financial Categories" Then
			NewMessage = "At least one financial category is required."      ' JPD 8/10/2001
        Else																																								 ' JPD 8/10/2001
            NewMessage = Description & " is a required field."
        End If                                                               ' RLS 04/04/2001
	    AddShellMessage ErrorID, NewMessage
  End If
End Function

'*== 05/16/2001 JPD===============================
Public Function ValidateSelectField(optObject, fRequired, ErrClass, NormClass, Description, ErrorID)
        ValidateSelectField = Me.ValidateSelectValue(optObject.Value, fRequired, Description, ErrorID)

  If ValidateSelectField Then
    optObject.className = NormClass
  Else
    optObject.className = ErrClass
  End If
End Function

'*========================================
Public Function ValidateSelectValue(optValue, fRequired, Description, ErrorID)
  If Trim(optValue) = vbNullString And fRequired Then
    ValidateSelectValue = False
    Dim NewMessage
    NewMessage = Description & " is a required field."
    AddShellMessage ErrorID, NewMessage
  Else
    ValidateSelectValue = True
    RemoveShellMessage ErrorID
  End If
End Function

'*========================================
Public Function ValidateSelectReqField(optObject, ErrClass, NormClass, Description, ErrorID)
  ValidateSelectReqField = Me.ValidateSelectReqValue(optObject.Value, Description, ErrorID)
  
  If ValidateSelectReqField Then
    optObject.className = NormClass
  Else
    optObject.className = ErrClass
  End If
End Function


'*========================================
Public Function ValidateSelectReqValue(optValue, Description, ErrorID)
  If Trim(optValue) <> vbNullString Then
    ValidateSelectReqValue = True
    RemoveShellMessage ErrorID
  Else
    ValidateSelectReqValue = False
    Dim NewMessage
    NewMessage = Description & " is a required field."
    AddShellMessage ErrorID, NewMessage
  End If
End Function

'*========================================
'SSS 3/15/2002
'Does same validation as function ValidateSelectReqField, but it displays a custom message
Public Function ValidateReqFieldWithMsg(obj, ErrClass, NormClass, Message, ErrorID)
  
  ValidateReqFieldWithMsg = Me.ValidateReqValueWithMsg(obj.Value, Message, ErrorID)
  If  ValidateReqFieldWithMsg Then
    obj.className = NormClass
  Else
    obj.className = ErrClass
  End If
End Function

'*========================================
'SSS 3/15/2002
Public Function ValidateReqValueWithMsg(obj, Message, ErrorID)
  If Len(Trim(obj)) > 0 Then
    ValidateReqValueWithMsg = True
    RemoveShellMessage ErrorID
  Else
    ValidateReqValueWithMsg = False
    AddShellMessage ErrorID, Message
  End If
End Function


'*========================================
Public Function ValidateDateFields(txtObjects, MinDates, MaxDates, fRequireds, ErrClass, NormClass, Descriptions, DateErrorIDs, LogicErrorID)
Dim i
Dim DateResults()
Dim NewDates()
Dim WasStatic, Errors
Dim FirstPassValid: FirstPassValid = True
ReDim DateResults(UBound(txtObjects) - LBound(txtObjects))
ReDim NewDates(UBound(txtObjects) - LBound(txtObjects))
Dim Stat1, Stat2
Dim StartIdx, EndIdx
Dim NewDate
Dim DoLogicalCheck: DoLogicalCheck = True

  StartIdx = LBound(txtObjects)
  EndIdx = UBound(txtObjects)
  
  For i = StartIdx To EndIdx
  
'    DateResults(i) = ValidateDateField (txtObjects(i), "", "", fRequireds(i), ErrClass, NormClass, Descriptions(i), DateErrorID)
    DateResults(i) = ValidateDateValue(txtObjects(i).Value, "", "", fRequireds(i), Descriptions(i), DateErrorIDs(i), NewDate)
    If DateResults(i) Then
      txtObjects(i).className = NormClass
      txtObjects(i).Value = NewDate
    Else
      txtObjects(i).className = ErrClass
      DoLogicalCheck = False
    End If
  Next

If DoLogicalCheck Then
  For i = StartIdx To (EndIdx - 1)
    If (DateResults(i) And DateResults(i + 1)) Then
      Stat1 = External.MOM.DateValidator.Validate(txtObjects(i).Value, MinDates(i), MaxDates(i), Descriptions(i), fRequireds(i), NewDates(i), WasStatic, Errors)
      Stat2 = External.MOM.DateValidator.Validate(txtObjects(i + 1).Value, MinDates(i + 1), MaxDates(i + 1), Descriptions(i + 1), fRequireds(i + 1), NewDates(i + 1), WasStatic, Errors)
      
      If Not (Stat1) Or Not (Stat2) Then
        AddShellMessage LogicErrorID & ".Logical", "The " & Descriptions(i) & " must be on or before the " & Descriptions(i + 1) & "."
        txtObjects(i).className = ErrClass
        txtObjects(i + 1).className = ErrClass
        FirstPassValid = False
      Else
        RemoveShellMessage LogicErrorID & ".Logical"
        txtObjects(i).className = NormClass
'        txtObjects(i).value = NewDates(i)

        If FirstPassValid Then
          txtObjects(i + 1).className = NormClass
 '         txtObjects(i+1).value = NewDates(i+1)
        End If
        FirstPassValid = True
      End If
    End If
  Next
End If
      
End Function

'*========================================
Public Function ValidateDateField(txtObject, MinDate, MaxDate, fRequired, ErrClass, NormClass, Description, ErrorID)
  Dim NewDate
  ValidateDateField = Me.ValidateDateValue(txtObject.Value, MinDate, MaxDate, fRequired, Description, ErrorID, NewDate)
  
  If ValidateDateField Then
    txtObject.className = NormClass
    txtObject.Value = NewDate
  Else
    txtObject.className = ErrClass
  End If
End Function


'*========================================
Public Function ValidateDateValue(dateText, MinDate, MaxDate, fRequired, Description, ErrorID, NewDate)

  Dim Succeeded, WasStatic, Errors
  dim SysMaxDate : SysMaxDate = "12/31/9999"
  dim SysMinDate : SysMinDate = "01/01/1753"

  Succeeded = External.MOM.DateValidator.Validate(dateText, MinDate, MaxDate, Description, fRequired, NewDate, WasStatic, Errors)

  ' jka 11/21/2001 - QA #2402.  SQL Server DATETIME type supports dates from 1/1/1753 to 12/31/9999.  Anything outside
  '                  that range will break the DB, so we catch it here and treat it as a bogus date value.  Oracle
  '                  has the same MAX restriction, but can handle dates to 4713 BC, so we'll stick with SQL's range.
  '
  '                  NOTE: if a column is a SMALLDATETIME, then the range is 1/1/1900 to 6/6/2079.  Errors caused by
  '                  SMALLDATETIMES should be handled by changing the type in the DB, if possible.
  'JRM 07/22/2002 - Added some logic to produce a better sounding error message if they enter a MinDate and/or MaxDate
  '
  '
  
  if (Succeeded and (NewDate <> "")) then
    if IsDate(NewDate) then
      if ( (CDate(NewDate) > CDate(SysMaxDate)) or (CDate(NewDate) < CDate(SysMinDate))) then Succeeded = false
    else
      Succeeded = false
    end if
  end if
  
  ValidateDateValue = Succeeded
    
  If Not (Succeeded) Then
  
    AddShellMessage ErrorID, Errors

  Else
    RemoveShellMessage ErrorID
  End If
End Function


'*========================================
Public Function ValidateTimeField(txtObject, MinTime, MaxTime, fRequired, FormatCode, ErrClass, NormClass, Description, ErrorID)
  Dim NewTime
  ValidateTimeField = Me.ValidateTimeValue(txtObject.Value, MinTime, MaxTime, fRequired, FormatCode, Description, ErrorID, NewTime)
  
  If ValidateTimeField Then
    txtObject.className = NormClass
    txtObject.Value = Trim(NewTime)
  Else
    txtObject.className = ErrClass
  End If
End Function


'*========================================
Public Function ValidateTimeValue(timeValue, MinTime, MaxTime, fRequired, FormatCode, Description, ErrorID, NewTime)
  Dim MessageText
  NewTime = Me.FormatTime(Trim(timeValue), FormatCode)

  If NewTime = "" And Not (Not (fRequired) And Trim(timeValue) = "") Then
    ValidateTimeValue = False
    
    If Trim(timeValue) = "" Then
      MessageText = Description & " is a required field."
    Else
      MessageText = "'" & Trim(timeValue) & "' is an invalid " & Description & "."
    End If
 
    AddShellMessage ErrorID, MessageText
    Exit Function
  Else
  
    '' Time is syntatically valid, not check to make sure it is greater than or equal
    '' to the min and less than or equal to the max.
    
    If MinTime <> vbNullString And NewTime <> vbNullString Then
      If Replace(FormatDateTime(NewTime, vbShortTime), ":", "") < Replace(FormatDateTime(MinTime, vbShortTime), ":", "") Then
        MessageText = Description & " must be greater than or equal to " & Me.FormatTime(MinTime, FormatCode) & "."
        AddShellMessage ErrorID, MessageText
        Exit Function
      End If
    End If
  
    If MaxTime <> vbNullString And NewTime <> vbNullString Then
      If Replace(FormatDateTime(NewTime, vbShortTime), ":", "") > Replace(FormatDateTime(MaxTime, vbShortTime), ":", "") Then
        MessageText = Description & " must be less than or equal to " & Me.FormatTime(MaxTime, FormatCode) & "."
        AddShellMessage ErrorID, MessageText
        Exit Function
      End If
    End If
  
    ValidateTimeValue = True
    RemoveShellMessage ErrorID
  End If
End Function

'*========================================
Public Function ValidateCurrencyField(txtObject, MinVal, MaxVal, Precision, fRequired, ErrClass, NormClass, Description, ErrorID)
  Dim StrippedValue
  Dim NewValue
  Dim blnParensExist
  
  StrippedValue = Replace(txtObject.Value, ",", "")

  blnParensExist = False
  '
  ' Strip the $ out of -$ or $-
  '

  If Left(StrippedValue, 1) = "-" Then
    If Mid(StrippedValue, 2, 1) = "$" Then
      StrippedValue = "-" & Right(StrippedValue, Len(StrippedValue) - 2)
    End If
  End If

  If Left(StrippedValue, 1) = "$" Then
    StrippedValue = Right(StrippedValue, Len(StrippedValue) - 1)
  End If
  
  'Strip of leading and trailing parenthesis
  If Left(StrippedValue, 1) = "(" Then
        blnParensExist = True
    StrippedValue = "-" & Right(StrippedValue, Len(StrippedValue) - 1)
  End If
  
  If Right(StrippedValue, 1) = ")" Then
    StrippedValue = Left(StrippedValue, Len(StrippedValue) - 1)
  End If
  
   ValidateCurrencyField = Me.ValidateNumericValue(StrippedValue, MinVal, MaxVal, Precision, fRequired, Description, ErrorID, NewValue)
  
  If ValidateCurrencyField Then
    txtObject.className = NormClass
    NewValue = FormatCurrency(NewValue, False)
        If blnParensExist Then
                NewValue = Replace(NewValue, "-", "(") & ")"
        End If

    txtObject.Value = NewValue
  Else
    txtObject.className = ErrClass
  End If
End Function

'*========================================
Public Function ValidateNumericField(txtObject, MinVal, MaxVal, Precision, fRequired, ErrClass, NormClass, Description, ErrorID)
  Dim NewValue
  ValidateNumericField = Me.ValidateNumericValue(txtObject.Value, MinVal, MaxVal, Precision, fRequired, Description, ErrorID, NewValue)
  
  If ValidateNumericField Then
    txtObject.className = NormClass
    txtObject.Value = NewValue
  Else
    txtObject.className = ErrClass
  End If

End Function

'*========================================
Public Function ValidateNumericValue(NumericText, MinVal, MaxVal, Precision, fRequired, Description, ErrorID, NewValue)
  Dim Succeeded, Errors, MessageText, cleanNbr, Re
  
        Set Re = New RegExp             '' Added by MTR, 5/22/01, to remove $ and commas from numbers
        Re.Pattern = "[$,]"
        Re.Global = True
        cleanNbr = Re.Replace(NumericText, "")
 
   if NumericText = "" and fRequired = True then            '' Added by TEM, 11/05/2001, to not pass an empty string as a valid number for required fields (in response to QA #2175)
      Succeeded = False
   else
      Succeeded = External.MOM.NumericValidator.Validate(cleanNbr, MinVal, MaxVal, Description, Precision, fRequired, NewValue, Errors)
   '  Succeeded = ValidateMoney(NumericText, NewValue, ErrorID)
   End If
   ValidateNumericValue = Succeeded
   'msgbox "Validating " & NumericText & " = " & Succeeded
    
  If Not (Succeeded) Then
    If Trim(NumericText) = "" And fRequired Then
      MessageText = Description & " is a required field."
    Else
      MessageText = "'" & Trim(NumericText) & "' is an invalid " & Description & "."
    End If
    
    AddShellMessage ErrorID, MessageText
  Else
    RemoveShellMessage ErrorID
  End If
End Function

'*========================================
Public Function ValidateSSNField(txtObject, fRequired, ErrClass, NormClass, ErrorID)
  Dim NewValue
  ValidateSSNField = Me.ValidateSSNValue(txtObject.Value, fRequired, ErrorID, NewValue)
  
  If ValidateSSNField Then
    txtObject.className = NormClass
    txtObject.Value = NewValue
  Else
    txtObject.className = ErrClass
  End If

End Function

'*========================================
Public Function ValidateSSNValue(SSNText, fRequired, ErrorID, NewValue)
'  Inputs
'  txtObject   - The object representing the control ( Me )
'  fRequired   - Is "" a valid response for this field?
'  ErrClass    - Class to set the control to if an error is detected
'  NormClass   - Class to set the control to if the data if valid
  Dim InSSN, StripSSN
  Dim Succeeded, MessageText
   
  InSSN = Trim(SSNText)
  StripSSN = Replace(InSSN, "-", "")


  If ((InSSN = "") And Not (fRequired)) Then
    Succeeded = True
  ElseIf ((Len(StripSSN) = 9) And IsNumeric(StripSSN)) Then
    NewValue = Left(StripSSN, 3) & "-" & Mid(StripSSN, 4, 2) & "-" & Right(StripSSN, 4)
    Succeeded = True
  ElseIf Not IsNumeric(StripSSN) Then
    MessageText = "A social security number cannot contain alpha characters."
    AddShellMessage ErrorID, MessageText
    Succeeded = False
  Else
    MessageText = "A social security number must contain nine digits."
    AddShellMessage ErrorID, MessageText
    Succeeded = False
  End If
 
  If Succeeded Then
    RemoveShellMessage ErrorID
  End If

  ValidateSSNValue = Succeeded
End Function

'*========================================
Public Function ValidateFEINField(txtObject, fRequired, ErrClass, NormClass, ErrorID)
  Dim NewValue
  ValidateFEINField = Me.ValidateFEINValue(txtObject.Value, fRequired, ErrorID, NewValue)
  
  If ValidateFEINField Then
    txtObject.className = NormClass
    txtObject.Value = NewValue
  Else
    txtObject.className = ErrClass
  End If

End Function
 
'*========================================
Public Function ValidateFEINValue(FEINText, fRequired, ErrorID, NewValue)
'  Inputs
'  txtObject   - The object representing the control ( Me )
'  fRequired   - Is "" a valid response for this field?
'  ErrClass    - Class to set the control to if an error is detected
'  NormClass   - Class to set the control to if the data if valid
  Dim InFEIN, StripFEIN
  Dim Succeeded, MessageText
   
  InFEIN = Trim(FEINText)
  StripFEIN = Replace(InFEIN, "-", "")


  If ((InFEIN = "") And Not (fRequired)) Then
    Succeeded = True
  ElseIf ((Len(StripFEIN) = 9) And IsNumeric(StripFEIN)) Then
    NewValue = Left(StripFEIN, 2) & "-" & Mid(StripFEIN, 3, 7) 
    Succeeded = True
  ElseIf Not IsNumeric(StripFEIN) Then
    MessageText = "A FEIN cannot contain alpha characters."
    AddShellMessage ErrorID, MessageText
    Succeeded = False
  Else
    MessageText = "A FEIN must contain nine digits."
    AddShellMessage ErrorID, MessageText
    Succeeded = False
  End If
 
  If Succeeded Then
    RemoveShellMessage ErrorID
  End If

  ValidateFEINValue = Succeeded
End Function

'*========================================
Public Function ValidatePhoneField(txtObject, DefAreaCode, fRequired, ErrClass, NormClass, ErrorID)
  Dim NewValue
  ValidatePhoneField = Me.ValidatePhoneValue(txtObject.Value, DefAreaCode, fRequired, ErrorID, NewValue)
  
  If ValidatePhoneField Then
    txtObject.className = NormClass
    txtObject.Value = NewValue
  Else
    txtObject.className = ErrClass
  End If

End Function

'*========================================
Public Function ValidatePhoneValue(PhoneText, DefAreaCode, fRequired, ErrorID, NewValue)
'  Inputs
'  PhoneText    - The text to validate
'  DefAreaCode  - The default area code to be prefixed to the front of a 7 digit phone number
'  fRequired    - Is "" a valid response for this field?

  Dim OrigValue, StrippedValue, LenValue, fCorrect, Delim
  
  'This is the delimiter to use in the final formated phone number
  Delim = "-"
  
  fCorrect = False
  OrigValue = Trim(PhoneText)
  StrippedValue = OrigValue

  NewValue = OrigValue

  If (StrippedValue <> "") Then
    StrippedValue = Replace(StrippedValue, "-", "")
    StrippedValue = Replace(StrippedValue, ".", "")
    StrippedValue = Replace(StrippedValue, ",", "")
    StrippedValue = Replace(StrippedValue, "/", "")
    StrippedValue = Replace(StrippedValue, "\", "")
    StrippedValue = Replace(StrippedValue, "|", "")
    StrippedValue = Replace(StrippedValue, "+", "")
    StrippedValue = Replace(StrippedValue, "=", "")
    StrippedValue = Replace(StrippedValue, "_", "")
    StrippedValue = Replace(StrippedValue, "(", "")
    StrippedValue = Replace(StrippedValue, ")", "")

    If StrippedValue = "" Then StrippedValue = OrigValue
       
    LenValue = Len(StrippedValue)

'User Interface SRS Items 29.1.7 and 29.1.8 state that any phone number that has 011 at the beginning
' or contains letters and is of a dialable length should be left as is.
    If (Left(StrippedValue, 3) = "011") Or (Alphabetic(StrippedValue) And LenValue >= 7) Then
      fCorrect = True
    Else
      If ((LenValue = 11) And (Left(StrippedValue, 1) = "1")) Then
        StrippedValue = Mid(StrippedValue, 2)
        LenValue = 10
      End If

      If ((LenValue = 7) And (DefAreaCode <> "")) Then
        NewValue = DefAreaCode & Delim & Left(StrippedValue, 3) & Delim & Right(StrippedValue, 4)
        fCorrect = True
      ElseIf (LenValue = 10) Then
        NewValue = Left(StrippedValue, 3) & Delim & Mid(StrippedValue, 4, 3) & Delim & Right(StrippedValue, 4)
        fCorrect = True
      End If
    End If
  ElseIf (Not (fRequired)) Then
    fCorrect = True
  End If

  If fCorrect Then
    RemoveShellMessage ErrorID
  Else
    If (StrippedValue <> "") Then
      AddShellMessage ErrorID, "'" & OrigValue & "' is an invalid Phone Number."
    Else
      AddShellMessage ErrorID, "Phone Number is a required field."
    End If
  End If

  ValidatePhoneValue = fCorrect
  
End Function

Function Alphabetic(strValue)
  Dim LenValue, i, CurrChar
  
  Alphabetic = false
  LenValue = Len(strValue)
  For i = 1 to LenValue
    CurrChar = Asc(UCase(Mid(strValue, i, 1)))
    If CurrChar > 64 And CurrChar < 91 Then
      Alphabetic = true
      Exit Function
    End If
  Next
End Function

' isAplphaNumeric
' Params - strValue - A string value to test if its alphanumeric or not
' Return Value - True if string contains only letters and numbers or if the string is empty
'                False otherwise
Function isAlphaNumeric(ByVal strValue)
  Dim LenValue, i, CurrChar

  isAlphaNumeric = True
  LenValue = Len(strValue)
  For i = 1 to LenValue
    CurrChar = Asc(UCase(Mid(strValue, i, 1)))
    If Not ((CurrChar > 64 And CurrChar < 91) Or (CurrChar > 47 and CurrChar < 58)) Then
      isAlphaNumeric = False
      Exit Function
    End If
  Next
End Function

Private Function AddArticle(Desc)
  Dim FC: FC = LCase(Left(Desc, 1))
  
  If (FC = "a") Or (FC = "e") Or (FC = "i") Or (FC = "o") Or (FC = "u") Then
    AddArticle = "an " & Desc
  Else
    AddArticle = "a " & Desc
  End If
  
End Function

'*========================================
Public Function ValidateCustomExp(txtObject, strPattern, fRequired, ErrClass, NormClass, ErrorID)
  ValidateCustomExp = Me.ValidateCustomExpValue(txtObject.Value, strPattern, fRequired, ErrorID)
  
  If ValidateCustomExp Then
    txtObject.className = NormClass
  Else
    txtObject.className = ErrClass
  End If

End Function

'*========================================
Public Function ValidateCustomExpValue(strFieldValue, strPattern, fRequired, ErrorID)
  Dim oRegExp : Set oRegExp = new RegExp
  Dim Succeeded, MessageText
  Dim str

  oRegExp.Pattern = strPattern

  str = Trim(strFieldValue)
  If Len(str) = 0 Then
    If fRequired Then
      MessageText = "Legacy ID is a required field"
      AddShellMessage ErrorID, MessageText
      Succeeded = False
    Else
      Succeeded = True
    End If
  Else
    If oRegExp.Test(str) Then
      Succeeded = True
    Else
      MessageText = "Legacy ID contains invalid characters"
      AddShellMessage ErrorID, MessageText
      Succeeded = False
    End If
  End If

    If Succeeded Then
      RemoveShellMessage ErrorID
    End If

  ValidateCustomExpValue = Succeeded
End Function

'*========================================
Public Function AddShellWarning(MessageID, MessageText)
 
  'jka 04/05/2001 - display a warning message instead of an error

  Dim objNewMessage
  Set objNewMessage = mvaroWindow.External.ShellMessages.Add(MessageID)
  
  objNewMessage.ShortMessage = MessageText
  objNewMessage.TagID = MessageID
  objNewMessage.DisplayCategory = 1
  
  Set AddShellWarning = objNewMessage

  '
  ' If we are running within a modal dialog, immediately
  ' display the error.
  '
    
  If mvaroWindow.External.DocumentMode = 2 Then
    mvaroWindow.External.MessageArea.Visible = True
  End If
End Function

'*========================================
Public Function AddShellMessage(MessageID, MessageText)

  Dim objNewMessage
  Set objNewMessage = mvaroWindow.External.ShellMessages.Add(MessageID)
  
  objNewMessage.ShortMessage = MessageText
  objNewMessage.TagID = MessageID
  
  Set AddShellMessage = objNewMessage

  '
  ' If we are running within a modal dialog, immediately
  ' display the error.
  '
    
  If mvaroWindow.External.DocumentMode = 2 Then
    mvaroWindow.External.MessageArea.Visible = True
  End If
End Function

'*========================================
Public Sub RemoveShellMessage(MessageID)
  mvaroWindow.External.ShellMessages.Remove MessageID

  '
  ' If we are running within a modal dialog, immediately
  ' hide the message area if there are no messages remaining.
  '
    
  If mvaroWindow.External.DocumentMode = 2 Then
    If mvaroWindow.External.ShellMessages.Count < 1 Then
      mvaroWindow.External.MessageArea.Visible = False
    End If
  End If
 
End Sub

'========================================================================================================
Public Function FormatCurrency(sOriginalValue, bIncludeDollarSign)
        Dim Re, iPointPosition, sReturnValue, strLen
        Dim isNegative: isNegative = False
        
        If CStr(sOriginalValue) = "" Then
                FormatCurrency = sOriginalValue
                Exit Function
        End If
        
        If Left(CStr(sOriginalValue), 1) = "-" Then
          isNegative = True
          sOriginalValue = Right(sOriginalValue, Len(sOriginalValue) - 1)
        End If
        
        Set Re = New RegExp
        Re.Pattern = "^\$?(\.\d{1,2}|\d{1,3}(\,?\d{3})*(\.\d{0,2})?)$"
        If Re.Test(sOriginalValue) Then
                Re.Pattern = "[\,\$]"
                Re.Global = True
                sOriginalValue = Re.Replace(sOriginalValue, "")
                sReturnValue = vbNullString
                iPointPosition = InStr(sOriginalValue, ".")
                If iPointPosition > 0 Then
                        strLen = Len(sOriginalValue) - iPointPosition + 1
                        sReturnValue = Right(sOriginalValue, strLen) & String(3 - strLen, "0")
                        sOriginalValue = Left(sOriginalValue, (iPointPosition - 1))
                End If
                While Len(sOriginalValue) > 3
                        sReturnValue = "," & Right(sOriginalValue, 3) & sReturnValue
                        sOriginalValue = Left(sOriginalValue, (Len(sOriginalValue) - 3))
                Wend
                sReturnValue = sOriginalValue & sReturnValue
                If InStr(sReturnValue, ".") = 0 Then sReturnValue = sReturnValue & ".00"
                If bIncludeDollarSign Then
                        FormatCurrency = "$" & sReturnValue
                Else
                        FormatCurrency = sReturnValue
                End If
                
                If isNegative Then
                  FormatCurrency = "-" & FormatCurrency
                End If
        Else
                FormatCurrency = "Err"
        End If
End Function
'===========================================================================================================

Function OkayToSave(MessageAreaVisible)
  Dim Message
  
  '' If we have any messages that are errors, we cannot continue.  If we
  '' have any that are warnings or information, then we can continue
  '' only if the message window was open when the user clicked save.
    
  OkayToSave = True
     
  If mvaroWindow.External.ShellMessages.Count > 0 Then
    For Each Message In mvaroWindow.External.ShellMessages
      If Message.DisplayCategory = 0 Then
        OkayToSave = False
        Exit For
      End If
    Next
    Set Message = Nothing
    
    If OkayToSave Then
      '' No errors, just warnings.  Only allow save if message window
      '' was open when user clicked save.
      
      If Not (MessageAreaVisible) Then
        OkayToSave = False
      End If
    End If

    '
    ' We have messages, so make sure the message area is visible.
    '
    
    mvaroWindow.External.MessageArea.Visible = True
  End If
End Function

Private Sub Class_Initialize
  Set mvaroWindow = document.parentWindow
End Sub


 '-----------------------------------------------------------------------------------------------------   
Public Function ValidateTrimTextBox(txtObject, fRequired, Description, ErrorID)
  txtObject.Value = Trim(txtObject.Value)

  ValidateTrimTextBox = True
  If fRequired Then
    If Len(txtObject.Value) = 0 Then
      ValidateTrimTextBox = False
    End If
  End If
  
  If ValidateTrimTextBox Then
    txtObject.Required = false
    Call RemoveShellMessage(ErrorID)
  Else
    txtObject.Required = true
    Call txtObject.AddError(Description & " is a required field.")
  End If
End Function

 '-----------------------------------------------------------------------------------------------------
Public Function ValidateZipTextBox(txtObject, fRequired, ErrorID)

  Dim InZip, StripZip

  InZip = Trim(txtObject.Value)
  StripZip = Replace(InZip, "-", "")
  ValidateZipTextBox = True
  If ((InZip = "") And Not (fRequired)) Then
    txtObject.Required = False
    oValidator.RemoveShellMessage ErrorID
  ElseIf ((Len(StripZip) = 9) And IsNumeric(StripZip)) Then
    txtObject.Value = Left(StripZip, 5) & "-" & Right(StripZip, 4)
    txtObject.Required = False
    RemoveShellMessage ErrorID
  ElseIf ((Len(StripZip) = 5) And IsNumeric(StripZip)) Then
    txtObject.Value = StripZip
    txtObject.Required = False
    RemoveShellMessage ErrorID

'---| RLS 06/20/2001 - QA Defect #17 |----------------------------------------------------------
  
  ElseIf ((Len(StripZip) = 10) And (IsNumeric(Left(StripZip, 5))) And (IsNumeric(Right(StripZip, 4))) And Not (IsNumeric(Mid(StripZip, 6, 1)))) Then
    txtObject.Value = Left(StripZip, 5) & "-" & Right(StripZip, 4)
    txtObject.Required = False
    RemoveShellMessage ErrorID

'-----------------------------------------------------------------------------------------------

  ElseIf InZip = "" And (fRequired) then 
    txtObject.Required = True
    txtObject.AddError "ZIP Code is a required field."
    ValidateZipTextBox = False
  Else
    'jka  05/08/2001 - need to verify that ZIP code is correct number of digits
    txtObject.Required = True
    txtObject.AddError "'" & InZip & "' is an invalid ZIP Code."
    ValidateZipTextBox = False
  End If
End Function


End Class

'*========================================
'
' Use the Function ModalMsgBox in the ModalMessageBox.vbs instead of this. This vbs file
' also contains a class that can be used to pass arguments and allow a full dialog box
' to be called in modal mode as well as unique naming of the modal.
'
' A function to make a Meridian style MsgBox a one line call.
' Buttons, Width, and Height are optional and can be passed in as vbNullString.
' Intentionally not part of the validate class, yet included here b/c virtually
' every page includes it.
'*========================================
Function ModalMsgBox(bodyMessage, headingMessage, buttonType, bodyWidth, bodyHeight)
 
 
	Dim ModalDialog
	Dim DialogArg
	Dim DialogArray(2)    
  Dim mModalName
  
	If buttonType = vbNullString Then buttonType = vbOKOnly
	If bodyWidth  = vbNullString Then bodyWidth  = 250
	If bodyHeight = vbNullString Then bodyHeight = 150
  mModalName	= "ValidateClassModal" & cstr(external.CreateID)			    
	DialogArray(0) = buttonType
	DialogArray(1) = bodyMessage
	DialogArray(2) = headingMessage   
	DialogArg      = DialogArray
     
	Set ModalDialog = external.ActiveDocuments.AddDialog(mModalName, 6, 0, 0, bodyWidth, bodyHeight)
	If Not ModalDialog Is Nothing Then
		ModalDialog.URI				= "/Common/MsgBox.htm"
		ModalDialog.Opacity			= 100
		ModalDialog.AllowScrollBar	= False
		ModalMsgBox = ModalDialog.ShowDialog(DialogArg)	
		external.ActiveDocuments.Remove(mModalName)
		Set ModalDialog = Nothing
	End If

 
End Function



'*========================================
' A function that will display a messagebox only when
' the commandline parameter "-debug xxx" sets the
' specified ErrLevel bit value.
'
' As a convention, fatal errors should use level 1
' whereas informational messsages should use 255.
' Anything else can be somewhere in between.
'
' MTR 03/19/2003 - Updated to use the InfoBox
'*========================================

Function DebugMsg(ErrLevel, Msg, Heading, Buttons, Width, Height)
  Dim Item
  Dim vbIcon
  
  Set Item = External.MOM.CommandlineTokens.Item("debug")
  

  If Not Item Is Nothing Then
    If Not IsNumeric(Buttons) Then
      Buttons = 0
    End If
    
    If ErrLevel = 1 Then
    '' Show Error Labels
      vbIcon = vbCritical
    Else
    '' Show Warning Labels
      vbIcon = vbExclamation
    End If
    
    '
    ' If user is running at this error level, display the message.
    '
    
    If IsNumeric (Item.Token) Then
      If (CInt(Item.Token) And ErrLevel) = ErrLevel Then
        if len(Width) = 0 then
          Width = "600"
        end if
      
        if len(Height) = 0 then
          Height = "400"
        end if
              
'        DebugMsg = ModalMsgBox(Msg, Heading, CInt(Buttons) Or vbSystemModal, Width, Height)
        DebugMsg = InfoBox(Msg, Heading, Buttons + vbIcon)
      End If
    End If
    
    Set Item = Nothing
  Else
    DebugMsg = -1
  End If
End Function




'*========================================
' Pass in whether the message area was visible prior to the user's
' attempt to save.  Return will indicate whether the save should
' proceed.  In other words, this routine will return false if
' either of the following conditions exist:
'
'  1. Errors exist in the message area.
'  2. Warnings exist and the message area was not visible prior to
'     the save attempt.
'*========================================

Function OkayToSave(MessageAreaVisible)
  Dim Message
  
  '' If we have any messages that are errors, we cannot continue.  If we
  '' have any that are warnings or information, then we can continue
  '' only if the message window was open when the user clicked save.
    
  OkayToSave = True
     
  If External.ShellMessages.Count > 0 Then
    For Each Message In External.ShellMessages
      If Message.DisplayCategory = 0 Then
        OkayToSave = False
        Exit For
      End If
    Next
    Set Message = Nothing
    
    If OkayToSave Then
      '' No errors, just warnings.  Only allow save if message window
      '' was open when user clicked save.
      
      If Not (MessageAreaVisible) Then
        OkayToSave = False
      End If
    End If

    '
    ' We have messages, so make sure the message area is visible.
    '
    
    External.MessageArea.Visible = True
  End If
  
End Function


'*========================================
'  ErrorStream should be the XML of a EMPErrors collection
Function AddErrorStreamToMessageArea(ErrorStream)
  Dim ShellMessage
  Dim ErrCount
  Dim Errors
  Dim ErrorsSerialize
  Dim Error
  
  Set Errors = External.CreateObject("EMPCLIENT.EMPErrors")
  Set AddErrorStreamToMessageArea = Errors
  
  If (Not (Errors Is Nothing)) Then
    Set ErrorsSerialize = Errors.GetIEMPErrorsSerialize()
  
    If (Not (ErrorsSerialize Is Nothing)) Then
      If (ErrorsSerialize.DecodeFromXML(ErrorStream, False)) Then
        ErrCount = 0

        For Each Error In Errors
          '' CTP 09/04/2001 - Added logic to only add the error to the message
          '' window if if it's DisplayError property is set to true
          
          If Error.DisplayError Then
            ErrCount = ErrCount + 1
            Set ShellMessage = External.ShellMessages.Add("ServerErr" & ErrCount)

            If (Not (ShellMessage Is Nothing)) Then
              ShellMessage.ShortMessage = Error.MessageShort
            
              '' CTP 6/8/2001 - Added additional properties available in the
              '' errors collection
              ShellMessage.LongMessage = Error.MessageDisplay
              ShellMessage.HelpFile = Error.HelpFile
            
              If IsNumeric(Error.HelpContext) Then
                ShellMessage.HelpContext = Error.HelpContext
              End If
            
              ShellMessage.DisplayCategory = Error.DisplayCategory
           
              Set ShellMessage = Nothing
            End If
          End If

          Set Error = Nothing
        Next

        If (ErrCount > 0) Then
          External.MessageArea.Visible = True
        End If
      Else
        Set ShellMessage = External.ShellMessages.Add("ServerErr0")
        ShellMessage.ShortMessage = ErrorStream
        Set ShellMessage = Nothing
      End If
  
      Set ErrorsSerialize = Nothing
    End If
    
    Set Errors = Nothing
  End If
End Function

'==================================================
'        Function ValidateMoney
'==================================================
        Function ValidateMoney(ByVal objStr, outStr, outErr)
                Dim Re

                If objStr = vbNullString Then objStr = "0"
                Set Re = New RegExp
                '' This Regular Expression checks for the existence of a plus or minus sign,
                '' a dollar sign, and a series of digits.  These digits may be separated by
                '' commas.  It also checks for a decimal point followed by one or two digits.
                '' Acceptably formatetted numbers include:
                ''              1000    -$500   2,600.00        +450.1
                ''
                '' Incorrectly formatted Numbers include:
                ''              $-200   3,00    450.    +-4             5.000
                ''
                Re.Pattern = "^([\+\-])?\$?\d{0,3}(\,?\d{3})*(\.\d{1,2})?$"
                ValidateMoney = Re.Test(objStr)
                If ValidateMoney Then
                        Re.Pattern = "[^0-9\.]"
                        Re.Global = True
                        objStr = Re.Replace(objStr, "") ' first remove any commas or "$" sign
                        outStr = FormatNumber(objStr, 2, -2, -2, -2)
                Else
                        outStr = objStr
                        outErr = "Incorrect Format"
                End If
        End Function