VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "SPA_Approval"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'what is new
' 2.2.7 Supress confirmation email by settings (JN)

Private Const C_MODULE_NAME As String = "SPA_Approval"

Private Const SEP1 As String = "®"
Private Const SEP2 As String = "©"
Private Const SEP As String = SEP1 + SEP2

Private Const MONEY_FORMAT As String = "###0.00"
Private Const QTY_FORMAT As String = "###0.0"
Private Const PERCENT_FORMAT As String = "###0.00"


' **************************************************************************************************
Private Enum ArmErr
    DBCnxFailed = vbObjectError + 1             ' Unable to connect to the database
    CPTAlreadyInitialized = vbObjectError + 2   ' We try to initialize a component that is already initialized
    CPTNotInitialized = vbObjectError + 3       ' We try to use or free that is not initialized yet
    InvalidArgument = vbObjectError + 4
    PropertyNotSet = vbObjectError + 5
    CompFncFailed = vbObjectError + 6           ' when component function fail
    QuietException = vbObjectError + 7          ' do not display error message
    WarMsgSelectRow = vbObjectError + 8
    SQLBadRowAffectedCount = vbObjectError + 9  ' A SQL request has not affected the expected rowcount (ex: one Update do nothing)
    SQLBadRowExpectedCount = vbObjectError + 10 ' A SQL request does not return the expected rowcount : select an item return nothing...
    SQLFailure = vbObjectError + 11              ' A SQL runtime error has occured : syntax wrong....
End Enum


'__SETTINGS FROM A_Config

'_Configure the email text (with placeholder)
Private Const CFG_Mail_SubjQ As String = "ABPE_SPA_MAIL_SUBJQ"                  ' Subject of the email when query an approval/rejection
Private Const CFG_Mail_SubjA As String = "ABPE_SPA_MAIL_SUBJA"                  ' Subject of the email when the SPA has been Authorized
Private Const CFG_Mail_SubjR As String = "ABPE_SPA_MAIL_SUBJR"                  ' Subject of the email when the SPA has been Rejected
Private Const CFG_Mail_SubjE As String = "ABPE_SPA_MAIL_SUBJE"                  ' Subject of the email when the SPA has some SAP error lines
Private Const CFG_Mail_SubjV As String = "ABPE_SPA_MAIL_SUBJV"                  ' Subject of the email when the SPA valid to date has changed
Private Const CFG_Mail_Matrix As String = "ABPE_SPA_MAIL_MSG_Matrix"            ' A line of the product matrix
Private Const CFG_Mail_MatrixErr As String = "ABPE_SPA_MAIL_MSG_MatrixErr"      ' Error template
Private Const CFG_Mail_MatrixNotApp As String = "ABPE_SPA_MAIL_MSG_MatrixNotApp" ' "No price in SAP – Calculation not applicable"
Private Const CFG_Mail_Title As String = "ABPE_SPA_MAIL_MSG_Title"              ' Title (top of the message) for Project SPA
Private Const CFG_Mail_TitleStock As String = "ABPE_SPA_MAIL_MSG_Title_Stock"   ' Title (top of the message) for Stock SPA
Private Const CFG_Mail_Body As String = "ABPE_SPA_MAIL_MSG_Body"                ' Body of the message
Private Const CFG_Mail_Body_ext As String = "ABPE_SPA_MAIL_MSG_Body_part2"      ' Body of the message part 2
Private Const CFG_Mail_SAP_Body As String = "ABPE_SPA_MAIL_SAP_MSG_Body"        ' Body of the message with error
Private Const CFG_Mail_ValidTo_Body As String = "ABPE_SPA_MAIL_ValidTo_Body"    ' Body of the message when SPA valid to has changed

Private Const CFG_SPA_CONTRACTACTION As String = "SPA_CONTRACTACTION_"          ' manage countries where contractor is attached into SPA task 116 JN


'_Error message and code
Private Enum eCustErr
    eceApprovalPathLoop = 8708   ' There is a loop inside the hierarchy
    eceNoApproverFound = 8709    ' No approver found with a the role indicated
    eceNoValidApprover = 8710    ' No Approver found with a good priority valid for this market
    eceUnableToCreateSIA = 8711  ' Key for SIA missing in A_ID
    eceNotSIATBA = 8712          ' Unable to approve a line not activated
    eceNotSIASleeping = 8713     ' Unable to activate a line not sleeping
    eceNotSPASubmitted = 8714    ' Unable to approve reject an SPA not submitted
    eceMissingSetting = 8715     ' Unable to retrieve the settings from A_Config
End Enum

Private Const MSG_APPR_PATH_LOOP As String = "Unable to configure the approval as the user $u_code$ appears twice, please contact your IT Support"
Private Const MSG_NO_APPROVER As String = "Unable to find an approver with the role or with an higher authority as requested, please contact your SPA Administrator"
Private Const MSG_NO_VALID_APPROVER As String = "Unable to find an approver with the role or with an higher authority for this market as request your SPA Administrator"
Private Const MSG_UNABLE_CREATE_SIA As String = "Unable to get free id to create new approval path. Please contact your IT Support"
Private Const MSG_NOT_SIA_TBA As String = "Unable to approve/reject an Approval demand not activated"
Private Const MSG_NOT_SIA_SLEEPING As String = "Unable to activate an Approval demand not sleeping."
Private Const MSG_NOT_SPA_SUBMITTED As String = "Unable to approve/reject an SPA which is not submitted."
Private Const MSG_MISSING_SETTING As String = "The following setting $key$ cannot be found, please contact your IT Support"


' Type of SPA, impact the title of the email
Private Enum eSPAType
    estProject = 1  ' Means use CFG_Mail_Title
    estStock = 2    ' Means use CFG_Mail_TitleStock
End Enum


' Action types of action generated by the approval process
Private Enum eActionType
    eatSPAAuthorised = 28   ' When the SPA has been Authorized
    eatSPARejected = 29     ' When the SPA has been reject
End Enum


' Status of a line of Approval Path
Private Enum eSIAStatus
    esisToBeAproved = 1     ' Require an approval/rejection action
    esisApproved = 2        ' Has been approved
    esisRejected = 3        ' Has been rejected
    esisSleeping = 4        ' Will need approval/rejection after the answer of the previous Approver in the path
    esisCancelled = 5       ' The line should be approved or rejected, but the query has been cancelled by a previous Rejection or an
                            ' Automatic update (obvious flag)
    esisDropped = 6         ' The SPA has been dropped
    esisAuditDetail = 7     ' The line is not required for the approval
End Enum

' Status of Approval Header
Private Enum eSPAStatus
    eshsNew = 1             ' Has been created
    eshsApproved = 2        ' All approvers or Super User has approved
    eshsRejected = 3        ' At least on approver or Super User has rejected
    eshsNotRequired = 4     ' Has been dropped
    eshsSubmited = 5        ' Has been submitted to Approval Process
    eshsReleased = 6        ' Has been won (ready to be used in SAP)
End Enum

' Type of mail which can be sent by the Approval Process
Private Enum eEMailType
    eemRequest  ' Query an approval or a rejection
    eemApprove  ' Indicates that the SPA has been Approved
    eemReject   ' Indicates that the SPA has been rejected
End Enum

    
' An Approval Line
Private Type TApprovalLine
    Auth_U_Code As Long         ' Who must approve/reject
    
    ' Those rule are relative to the real Approver, not to the Covering Approver
    SPU_ID As Long              ' The rule from SPA_UserRoles validating the Auth_U_Code
    SPR_Code As Long            ' The rule from SPA_AuthRoles validating the Auth_U_Code
    SPAMU_ID As Long            ' The rule to validate the rights of the Approver on the market (SPA_AuthMarketUser_Link)
    SubApprovalCount As Long    ' Count of Previous approver needed for before this approval
    Next_U_Code As Long         ' Next Approver
    Priority  As Long           ' Priority of the Approver
    
    SPUR_ID As Long             ' The rule used in case of replacement, came from SPA_UserReplacement
    
    Status As eSIAStatus         ' Status of the Approval Line
    
    Request As String           ' The request used to Save this Approval Line
    SIA_ID As Long              ' ID of the line in SPA_ApprovalPath
    

End Type


Private mo_Db As ARMSYSCOMLib.ArmDb ' DB Cnx, must be configured before Load_A_Com

Private ms_MailBox As String        ' MailBox configuration for sending Email, must be configured before Load_A_Com
Private mo_MailClient As MailClient ' Interface to send Email

Private ml_U_Code As Long           ' Final user doing the operation (Sender of email, or Super User in Online)


Private mb_PathBuilded As Boolean   ' True when a path has been built (and so can be saved). Can be reset by some properties
Private ml_SPA_Id As Long           ' ID of the SPA
Private ml_SPM_Code As Long         ' ID of the AuthMarket
Private mb_FullAuth_flag            ' True if we use the Full Authorisation path algorithm
Private mb_ObviousAuth_Flag         ' True if we automatic approved the Obvious authorisation
Private ms_Today As String          ' Date of Today from the SQL server
Private ml_Requestor As Long        ' U_Code of the Requestor of the SPA
Private ml_FirstApprU_Code As Long  ' U_Code of the first level user in the Approval Hierarchy
Private ml_iConcurrency As Long     ' IConcurrency of the SPA
Private ml_SPA_Status As eSPAStatus ' Status of the SPA
Private ms_SPA_CT_Code As String    ' CT_Code of SPA task 116
Private ms_CC_CCU_Capkey As String  ' CC_CCU_CapKey of SPA task 116


Private mo_Path() As TApprovalLine  ' Approval Path
'Private ml_AutoApprIdx As Long      ' Idx of the Automatic Approver in the Approver Path (if mb_ObviousAuth_Flag is set, -1 if not)
Private ml_AutoAppU_Code As Long    ' U_Code of the Automatic Approver, usually from Approve path (if mb_ObviousAuth_Flag is set) or ml_requestor if there is no line to approve
Private mb_AutoApp As Boolean       ' True if the SPA has been automatically approved

Private ml_LastReqApprRole As Long      ' Role of the Last Approver requested
Private ml_LastReqApprPriority As Long  ' Priority of the role of the Last Approver requested

Private mc_Settings As Long         ' Cursor containing the settings of the SPA Approval Process

Private mb_Initialized As Boolean   ' True when the SPA_Approval Class has been already configured


Private ml_LastErrorCode As Long        ' Last Error Code
Private ms_LastErrorMessage As String   ' Last Error Message


'___TO BE CONFIGURE BEFORE CALLING LOAD_A_COM


Public Property Set Db(ByRef ao_Db As ARMSYSCOMLib.ArmDb)
    If ao_Db Is Nothing Then Err.Raise ArmErr.InvalidArgument, C_MODULE_NAME & ".DB::Set", "DB cannot be nothing"
    If mb_Initialized Then Err.Raise ArmErr.CPTAlreadyInitialized, C_MODULE_NAME & ".DB::Set"
    Set mo_Db = ao_Db
End Property


Public Property Let MailBox(ByVal as_Value As String)
    If Len(Trim(as_Value)) = 0 Then Err.Raise ArmErr.InvalidArgument, C_MODULE_NAME & ".MailBox::Let", "Cannot use an empty configuration of Mail Box"
    If mb_Initialized Then Err.Raise ArmErr.CPTAlreadyInitialized, C_MODULE_NAME & ".MailBox::Set"
    
    ms_MailBox = Trim(as_Value)
End Property


' U_Code of the logged user
Public Property Let U_Code(ByVal al_U_Code As Long)
    If al_U_Code <= 0 Then Err.Raise ArmErr.InvalidArgument, C_MODULE_NAME & ".U_Code::Let", "Invalid U_Code: " & al_U_Code
    If mb_Initialized Then Err.Raise ArmErr.CPTAlreadyInitialized, C_MODULE_NAME & ".U_Code::Set"
    ml_U_Code = al_U_Code
End Property


' Initialise the class
Public Sub Load_A_COM()
    
    If mb_Initialized Then Err.Raise ArmErr.CPTAlreadyInitialized, C_MODULE_NAME & "Unable to Call twice Load_A_Com"
    
    mb_PathBuilded = False
    
    Set mo_MailClient = New MailClient
    Set mo_MailClient.ArmDb = mo_Db
    mo_MailClient.U_Code = ml_U_Code
    mo_MailClient.Load_A_COM
    
    mo_MailClient.SetActiveMailBox (ms_MailBox)

    ClearError

    mb_Initialized = True
    
End Sub

' Release the ressource
Public Function Unload_A_COM()
   
   Call mo_Db.Close(mc_Settings)
   Set mo_MailClient = Nothing
   Set mo_Db = Nothing
   mb_Initialized = False
   
End Function


' Get the last error code and message (business issue)
Public Property Get LastErrorCode()
    LastErrorCode = ml_LastErrorCode
End Property
Public Property Get LastErrorMessage()
    LastErrorMessage = ms_LastErrorMessage
End Property

' Clear error flag
Private Sub ClearError()
    ml_LastErrorCode = 0
    ms_LastErrorMessage = ""
End Sub
' Set internal error
Private Sub SetError(ByVal al_Code As Long, ByVal as_msg As String)
    ml_LastErrorCode = al_Code
    ms_LastErrorMessage = as_msg
    Debug.Print "Error: " & ml_LastErrorCode & " - " & ms_LastErrorMessage
End Sub


' ************************************************************************************
' **************************** DB-ACCESS FUNCTIONS ***********************************
' ************************************************************************************
#If LIVE = 1 Then
Private Sub ExecuteSQLSafe(ByVal ao_Db As Object, ByVal as_Request As String, Optional ByVal al_RowAffectedCount = -1)
#Else
Private Sub ExecuteSQLSafe(ByVal ao_Db As ARMSYSCOMLib.ArmDb, ByVal as_Request As String, Optional ByVal al_RowAffectedCount = -1)
#End If
On Error GoTo ErrHandler
    ' First execute the request
    
    Debug.Print "ExecuteSQLSafe: " & as_Request
    
    If Not ao_Db.ExecuteSQL(as_Request) Then
        Call Err.Raise(CompFncFailed, "ao_Db.ExecuteSQL - " & "SQL : " & as_Request, "SQL Error: " & GetDbError(ao_Db))
    End If

    If al_RowAffectedCount <> -1 Then
        ' Then check the rowcount
        If ao_Db.SQLRowsAffected <> al_RowAffectedCount Then
            Call Err.Raise(SQLBadRowAffectedCount, "SQL : " & as_Request, al_RowAffectedCount & "<>" & ao_Db.SQLRowsAffected)
        End If
    End If
    Exit Sub
ErrHandler:
    Call ErrorHandler("SPA_Approval.ExecuteSQLSafe")
End Sub

#If LIVE = 1 Then
Private Function OpenSQLSafe(ByVal ao_Db As Object, ByVal as_Request As String, Optional ByVal al_RowExpectedCount = -1) As Long
#Else
Private Function OpenSQLSafe(ByVal ao_Db As ARMSYSCOMLib.ArmDb, ByVal as_Request As String, Optional ByVal al_RowExpectedCount = -1) As Long
#End If
On Error GoTo ErrHandler
    Dim lc_Data As Long
    lc_Data = ao_Db.OpenSQL(as_Request)
    If lc_Data = 0 Then
        Call Err.Raise(CompFncFailed, "ao_Db.OpenSQL - " & "SQL : " & as_Request, "SQL Error: " & GetDbError(ao_Db))
    End If
    
    If al_RowExpectedCount <> -1 Then
        ' Then check the rowcount
        If ao_Db.RowCount(lc_Data) <> al_RowExpectedCount Then
            Call Err.Raise(SQLBadRowExpectedCount, "SQL : " & as_Request, al_RowExpectedCount & "<>" & ao_Db.RowCount(lc_Data))
        End If
    End If
    OpenSQLSafe = lc_Data
    Exit Function
ErrHandler:
    Call ErrorHandler("SPA_Approval.OpenSQLSafe")
End Function


' ************************************************************************************
' ********************** ERROR-HANDLING SUPPORT FUNCTIONS ****************************
' ************************************************************************************
#If LIVE = 1 Then
Private Function GetDbError(ByVal lo_Db As Object) As String
#Else
Private Function GetDbError(ByVal lo_Db As ARMSYSCOMLib.ArmDb) As String
#End If
On Error GoTo ErrHandler
    If IsArray(lo_Db.SQLErrorMessages) Then
        Debug.Assert (IsArray(lo_Db.SQLErrorCodes))
        ' Display errors msgBox
        GetDbError = Join(lo_Db.SQLErrorCodes, ",") & vbCrLf & Join(lo_Db.SQLErrorMessages, vbCrLf)
    Else
        ' ExecuteSQL failed but no error message?
        GetDbError = "Unknown error"
    End If
    Exit Function
ErrHandler:
    Call ErrorHandler("SPA_Approval.GetDbError()")
End Function

Private Function SQLStr(ByVal as_str As String, Optional ByVal al_MaxLen As Long = 8000) As String
On Error GoTo ErrHandler
    SQLStr = "'" & Replace(Left(as_str, IIf(Len(as_str) <= al_MaxLen, Len(as_str), al_MaxLen)), "'", "''") & "'"
    Exit Function
ErrHandler:
    Call ErrorHandler("SQLStr")
End Function

Private Function BeginTran(as_Tran As String) As Boolean

On Error GoTo ErrHandler
    BeginTran = False
    ExecuteSQLSafe mo_Db, "BEGIN TRANSACTION " & as_Tran

    BeginTran = True
    Exit Function
    
ErrHandler:
    'try to log error
    'Call LogMessage("BeginTran: " & as_Tran)
    Call mo_Db.Disconnect
    Set mo_Db = Nothing
    MsgBox "A Fatal error occured in SPA_Approval.BeginTran, your application will be close. Please contact your IT support", , App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
    End
End Function

Private Function CommitTran(as_Tran As String) As Boolean

On Error GoTo ErrHandler
    CommitTran = False
    ExecuteSQLSafe mo_Db, "COMMIT TRANSACTION " & as_Tran

    CommitTran = True
    Exit Function
    
ErrHandler:
    'try to log error
    'Call LogMessage("CommitTran: " & as_Tran)
    Call mo_Db.Disconnect
    Set mo_Db = Nothing
    MsgBox "A Fatal error occured in SPA_Approval.CommitTran, your application will be close. Please contact your IT support", , App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
    End

End Function

Private Function RollbackTran(as_Tran As String) As Boolean
    
    Dim ll_errNumber As Long, ls_errSource As String, ls_errDesc As String
    ll_errNumber = Err.Number
    ls_errSource = Err.Source
    ls_errDesc = Err.Description

On Error GoTo ErrHandler
    RollbackTran = False
    
    ExecuteSQLSafe mo_Db, "ROLLBACK TRANSACTION " & as_Tran


    Err.Number = ll_errNumber
    Err.Source = ls_errSource
    Err.Description = ls_errDesc

    RollbackTran = True
    Exit Function
    
ErrHandler:
    'try to log error
    'Call LogMessage("RollbackTran: " & as_Tran)
    Call mo_Db.Disconnect
    Set mo_Db = Nothing
    MsgBox "A Fatal error occured in SPA_Approval.RollbackTran, your application will be close. Please contact your IT support", , App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
    End
End Function


' Standard error handler
Private Sub ErrorHandler(ByVal as_Fct As String)
    Call Err.Raise(Err.Number, C_MODULE_NAME & "::" & as_Fct & SEP1 & Err.Source, Err.Description)
End Sub


' Build locally the path for the approval
' Return true if success (path existing)
' Fill any error into LastErrorCode / LastErrorMessage
' BC: Must not be called inside a transaction
Public Function BuildApprovalPath(ByVal al_SPA_ID As Long) As Boolean

On Error GoTo onError:
    
    If Not mb_Initialized Then Err.Raise ArmErr.CPTNotInitialized, "BuildApprovalPath", "Unable to call this function before initialisation"
    ClearError
    
    mb_PathBuilded = False
    ml_SPA_Id = al_SPA_ID

    ' Step 1 - Retrieve SPA Configuration
    If Not GetSPASettings(al_SPA_ID) Then Exit Function
    
    ' Step 2 - Retrieve the last approval level requested
    If Not GetLastReqApprover Then Exit Function
    
    ' TODOG Only for debug purpose !
    ' REMOVE !!!!!
    'ml_FirstApprU_Code = 281
    
    
    ' Step 3 - Retrieve the complete hierarchy
    If Not GetHierarchy Then Exit Function
    
    ' Step 4 - Build the final path
    If Not GetApprovalPath Then Exit Function
    
    Debug.Print "PATH"
    Dim ll_Idx As Long
    For ll_Idx = 0 To UBound(mo_Path)
        Debug.Print "U_Code: " & mo_Path(ll_Idx).Auth_U_Code & ",SPR: " & mo_Path(ll_Idx).SPR_Code & ", Status: " & mo_Path(ll_Idx).Status
    Next
    
    mb_PathBuilded = True
    BuildApprovalPath = True
    Exit Function

onError:
    Call ErrorHandler("BuildApprovalPath")
End Function


'_Retrieve the SPA Settings
Private Function GetSPASettings(ByVal al_SPA_ID As Long) As Boolean

  On Error GoTo onError
  
    Const SQL_GetSPASettings As String = "exec SPA_GetSPASettings $SPA_ID$"

    Dim ls_Request As String
    ls_Request = SQL_GetSPASettings
    ls_Request = Replace(ls_Request, "$SPA_ID$", al_SPA_ID, , , vbTextCompare)

    Dim lc_Data As Long
    lc_Data = OpenSQLSafe(mo_Db, ls_Request, 1)

    ml_SPM_Code = mo_Db.GetFields(lc_Data, "SPM_Code")
    mb_FullAuth_flag = StrComp(mo_Db.GetFields(lc_Data, "FullAuth_flag"), "X", vbTextCompare) = 0
    mb_ObviousAuth_Flag = StrComp(mo_Db.GetFields(lc_Data, "ObvioustAuth_Flag"), "X", vbTextCompare) = 0
    ml_FirstApprU_Code = mo_Db.GetFields(lc_Data, "U_Code")
    ms_Today = mo_Db.GetFields(lc_Data, "Today")
    ml_Requestor = mo_Db.GetFields(lc_Data, "Raised_For_U_Code")
    ml_iConcurrency = mo_Db.GetFields(lc_Data, "IConcurrency")
    ml_SPA_Status = mo_Db.GetFields(lc_Data, "SPA_ApprovalStatus")
    ms_SPA_CT_Code = mo_Db.GetFields(lc_Data, "CT_Code")
    ms_CC_CCU_Capkey = mo_Db.GetFields(lc_Data, "CC_CCU_CapKey")
        
    mo_Db.Close (lc_Data)
    
    GetSPASettings = True
    
    Exit Function
    
onError:
    mo_Db.Close (lc_Data)
    GetSPASettings = False
    Call ErrorHandler(GetSPASettings)
End Function



' Retrieve the SPR_Code/priority of the last needed approver
Private Function GetLastReqApprover() As Boolean

On Error GoTo onError
    Const SQL_GETLASTApprovalLine As String = "exec SPA_GetLastAppRole $SPA_ID$"
    
    Dim ls_Request As String
    ls_Request = SQL_GETLASTApprovalLine
    ls_Request = Replace(ls_Request, "$SPA_ID$", ml_SPA_Id, , , vbTextCompare)
    
    Dim lc_Data As Long
    Dim ls_Buffer As String
    ls_Buffer = ""
    
    lc_Data = OpenSQLSafe(mo_Db, ls_Request)
    
    If mo_Db.RowCount(lc_Data) > 0 Then
    ls_Buffer = mo_Db.GetFields(lc_Data, 0)
    End If
    mo_Db.Close (lc_Data)
    
    If ls_Buffer <> "" Then
    
    Dim lv_Buffer As Variant
    lv_Buffer = Split(ls_Buffer, SEP1, , vbTextCompare)
    
    ml_LastReqApprPriority = lv_Buffer(0)
    ml_LastReqApprRole = lv_Buffer(1)
    Else
        ml_LastReqApprPriority = -1
        ml_LastReqApprRole = -1
    End If

    GetLastReqApprover = True
    Exit Function

onError:
  mo_Db.Close (lc_Data)
  Call ErrorHandler("GetLastReqApprover")

End Function


' Retrieve the hierarchy of the initial approver
Private Function GetHierarchy() As Boolean

On Error GoTo onError
    ClearError
    ReDim mo_Path(20)
    Dim ll_Idx As Long
    ll_Idx = -1
    
    ' Start from the initial to the one without next user
    Dim ll_U_Code As Long
    ll_U_Code = ml_FirstApprU_Code
    
    While ll_U_Code <> 0
        ll_Idx = ll_Idx + 1
        ' Prevent out of bound
        If ll_Idx > UBound(mo_Path) Then
            ReDim Preserve mo_Path(ll_Idx + 20)
        End If
        mo_Path(ll_Idx) = GetApprovalLine(ll_U_Code)
        ll_U_Code = mo_Path(ll_Idx).Next_U_Code
        
        ' If user is not replacer
        If mo_Path(ll_Idx).SPUR_ID = 0 Then
            ' Search for Loop inside the configuration
            Dim ll_IdxS As Long
            For ll_IdxS = 0 To (ll_Idx - 1)
                If mo_Path(ll_Idx).Auth_U_Code = mo_Path(ll_IdxS).Auth_U_Code And mo_Path(ll_IdxS).SPUR_ID = 0 Then
                    Call SetError(eceApprovalPathLoop, Replace(MSG_APPR_PATH_LOOP, "$u_code$", ll_U_Code, , , vbTextCompare))
                    Exit Function
                End If
            Next
        End If
    Wend
    
    ' Resize to only what we have
    ReDim Preserve mo_Path(ll_Idx)
    
    GetHierarchy = True
    Exit Function
    
onError:
    Call ErrorHandler("GetHierarchy")
End Function


' Retrieve an Approval line of a hierarchy, according a U_Code
Private Function GetApprovalLine(ByVal al_U_Code As Long) As TApprovalLine
On Error GoTo onError:
    
    Const SQL_GetApprovalLine As String = "exec SPA_GetApprovalLine $U_Code$, $SPM_Code$, '$Date$'"
    
    Dim ls_Request As String
    ls_Request = SQL_GetApprovalLine
    ls_Request = Replace(ls_Request, "$U_Code$", al_U_Code, , , vbTextCompare)
    ls_Request = Replace(ls_Request, "$SPM_Code$", ml_SPM_Code, , , vbTextCompare)
    ls_Request = Replace(ls_Request, "$Date$", ms_Today, , , vbTextCompare)

    Dim lc_Approver As Long
    lc_Approver = OpenSQLSafe(mo_Db, ls_Request, 1)
    
    Dim ll_Cover As Long
    ll_Cover = mo_Db.GetFields(lc_Approver, "Covering_U_Code")
    
    Dim lu_Approver As TApprovalLine
    With lu_Approver
        
        ' If the User is replaced, the covering user will receive the email at his place
        If ll_Cover = 0 Then
            .Auth_U_Code = al_U_Code
        Else
            .Auth_U_Code = ll_Cover
        End If
            
        .SPU_ID = mo_Db.GetFields(lc_Approver, "SPU_ID")
        .Next_U_Code = mo_Db.GetFields(lc_Approver, "Next_U_Code")
        .SPR_Code = mo_Db.GetFields(lc_Approver, "SPR_Code")
        .SubApprovalCount = mo_Db.GetFields(lc_Approver, "SPR_SubApprovalCount")
        .SPAMU_ID = mo_Db.GetFields(lc_Approver, "SPAMU_ID")
        .SPUR_ID = mo_Db.GetFields(lc_Approver, "SPUR_ID")
        .Priority = mo_Db.GetFields(lc_Approver, "Priority")
        
    End With

    mo_Db.Close (lc_Approver)
    GetApprovalLine = lu_Approver
    Exit Function
onError:
    mo_Db.Close (lc_Approver)
    Call ErrorHandler("GetApprovalLine")
End Function


' Find the last approver of an SPA
Private Function GetLastApprover() As Long
On Error GoTo onError
    
    ClearError
    
    Dim ll_ApprIdx As Long ' Last Approver Index in the Path
    Dim ll_Idx As Long, ll_Count As Long
    ll_Count = UBound(mo_Path)
    
    ll_ApprIdx = -1
    If ml_LastReqApprRole = -1 Then
        GetLastApprover = ll_ApprIdx        ' there is no last approver
        Exit Function
    End If
    ' Search for the Last Approver
    ' Can be the user with the exact role needed or we don't found the first role with a lower priority (= higher authority)
    For ll_Idx = 0 To ll_Count
        If (mo_Path(ll_Idx).SPR_Code = ml_LastReqApprRole) _
            Or (mo_Path(ll_Idx).Priority < ml_LastReqApprPriority) _
        Then
           ll_ApprIdx = ll_Idx
           While mo_Path(ll_ApprIdx).SPAMU_ID = 0
                ll_ApprIdx = ll_ApprIdx + 1
                If ll_ApprIdx > ll_Count Then
                    Call SetError(eceNoValidApprover, MSG_NO_VALID_APPROVER)
                    ll_ApprIdx = -1
                    Exit Function
                End If
            Wend
            Exit For
        End If
    Next
    If (ll_ApprIdx = -1) Then
        Call SetError(eceNoApproverFound, MSG_NO_APPROVER)
        ll_ApprIdx = -1
        Exit Function
    End If
    
    GetLastApprover = ll_ApprIdx
    Exit Function
    
onError:
    ll_ApprIdx = -1
    Call ErrorHandler("GetLastApprover")

End Function


' Build Approval path with FullAuth algorithm
Private Function BuildFullAuthPath(ByVal al_LastApprIdx As Long) As Boolean
    On Error GoTo onError
    ClearError
    BuildFullAuthPath = False
    
    Dim ll_Idx As Long, ll_Count As Long
    ll_Count = UBound(mo_Path)
    
    ' Step 1 - Search for the first  valid approver
    ll_Idx = 0
    While mo_Path(ll_Idx).SPAMU_ID = 0
        mo_Path(ll_Idx).Status = eSIAStatus.esisAuditDetail
        ll_Idx = ll_Idx + 1
        If ll_Idx > ll_Count Then
            Call SetError(eceNoValidApprover, MSG_NO_VALID_APPROVER)
            Exit Function
        End If
    Wend
    mo_Path(ll_Idx).Status = eSIAStatus.esisToBeAproved ' <= First approver
        
    
    ' Step 2 - All next approvers are set as Sleeping if valid, Audit Detail if not
    For ll_Idx = (ll_Idx + 1) To al_LastApprIdx
        mo_Path(ll_Idx).Status = IIf(mo_Path(ll_Idx).SPAMU_ID <> 0, eSIAStatus.esisSleeping, eSIAStatus.esisAuditDetail)
    Next
    
    ' Step 3 - Higher level than expected are marked for Audit purpose only
    For ll_Idx = (al_LastApprIdx + 1) To ll_Count
        mo_Path(ll_Idx).Status = eSIAStatus.esisAuditDetail
    Next
       
    BuildFullAuthPath = True
    Exit Function
    
onError:
    Call ErrorHandler("GetBuildFullAuthPath")
End Function

' Build Approval path with default algorithm
Private Function BuildDefaultPath(ByVal al_LastApprIdx As Long) As Boolean
    
    On Error GoTo onError
    BuildDefaultPath = False
    
    Dim ll_Idx As Long, ll_Count As Long
    ll_Count = UBound(mo_Path)

    If al_LastApprIdx <> -1 Then

    Dim ll_SubCount As Long ' Count of Level before approver (go back functionnality)
    ll_SubCount = mo_Path(al_LastApprIdx).SubApprovalCount
 
    'Step 1 - Configure the Last Approver
    ' Can be Sleeping if we implement the go back functionnality
     mo_Path(al_LastApprIdx).Status = IIf(ll_SubCount = 0, eSIAStatus.esisToBeAproved, eSIAStatus.esisSleeping)
 
    Dim ll_IdxFirstAppr As Long ' First Approver
       
    ' Step 2 - Define the first approver
    If ll_SubCount = 0 Then
        ' First approver = Last Approver !
        ll_IdxFirstAppr = al_LastApprIdx
            
    Else
        ' Find the first approver
        Dim ll_FindCount As Long
        ll_FindCount = 0
        ll_IdxFirstAppr = -1
        For ll_Idx = (al_LastApprIdx - 1) To 0 Step -1
            If mo_Path(ll_Idx).SPAMU_ID <> 0 Then ' We validate only valid approver for the go back functionnality
                ll_FindCount = ll_FindCount + 1
                If ll_FindCount = ll_SubCount Then
                    ll_IdxFirstAppr = ll_Idx
                    Exit For
                End If
            End If
        Next
        ' If have don't have the exact count, we have to parse in the other direction !
        ' A wrong count don't generate any errors
        If ll_FindCount <> ll_SubCount Then
            For ll_Idx = 0 To al_LastApprIdx
                If mo_Path(ll_Idx).SPAMU_ID <> 0 Then
                    ll_IdxFirstAppr = ll_Idx
                    Exit For
                End If
            Next
        End If
    End If
    mo_Path(ll_IdxFirstAppr).Status = eSIAStatus.esisToBeAproved
        
        
    ' Step 3 - From first to First Approver are marked for Audit purpose only
    For ll_Idx = 0 To (ll_IdxFirstAppr - 1)
        mo_Path(ll_Idx).Status = eSIAStatus.esisAuditDetail
    Next
        
    ' Step 4 - All between first approver and last approver are marked as Sleeping if valid, Audit Purpose only if not
    For ll_Idx = (ll_IdxFirstAppr + 1) To (al_LastApprIdx - 1)
        mo_Path(ll_Idx).Status = IIf(mo_Path(ll_Idx).SPAMU_ID <> 0, eSIAStatus.esisSleeping, eSIAStatus.esisAuditDetail)
    Next
    End If
    
    ' Step 5 - Higher level than expected are marked for Audit purpose only
    For ll_Idx = al_LastApprIdx + 1 To ll_Count
        mo_Path(ll_Idx).Status = eSIAStatus.esisAuditDetail
    Next
    
    BuildDefaultPath = True
    Exit Function
    
onError:
    Call ErrorHandler("BuildDefaultPath")

End Function

' Apply Obvious optimisation
Private Function ApplyObviousOptimisation() As Boolean
On Error GoTo onError

    Dim ll_Idx As Long, ll_Count As Long
    ll_Count = UBound(mo_Path)
    
    mb_AutoApp = False
'    ml_AutoApprIdx = -1
    ml_AutoAppU_Code = 0
    
    Dim lb_Auto As Boolean
    lb_Auto = False
    
    Dim lb_HasApproval As Boolean
        
    ' Step 1 - Search if the requestor is involved into the Approval Path
    For ll_Idx = ll_Count To 0 Step -1
        If mo_Path(ll_Idx).Auth_U_Code = ml_Requestor Then
            ' Is involved ?
            If mo_Path(ll_Idx).Status = esisToBeAproved Or mo_Path(ll_Idx).Status = esisSleeping Or mo_Path(ll_Idx).Status = esisAuditDetail Then
                lb_Auto = True
'                ml_AutoApprIdx = ll_Idx
                ml_AutoAppU_Code = mo_Path(ll_Idx).Auth_U_Code
                mo_Path(ll_Idx).Status = esisApproved
            End If
        End If
        If lb_Auto Then ' If requestor is involved, all previous approval are automatically cancelled
            If mo_Path(ll_Idx).Status = esisToBeAproved Or mo_Path(ll_Idx).Status = esisSleeping Or mo_Path(ll_Idx).Status = esisAuditDetail Then
                mo_Path(ll_Idx).Status = esisCancelled
            End If
        End If
    Next
        
    ' Step 2 - Check if the SPA is automatically approve, and if not define the new first approver
'    mb_AutoApp = (ml_AutoApprIdx <> -1) ' JN fix: -1 means nothing to approve
    mb_AutoApp = (ml_AutoAppU_Code <> 0) ' JN fix: 0 means nothing to approve
    
    For ll_Idx = 0 To ll_Count
        Select Case mo_Path(ll_Idx).Status
            Case eSIAStatus.esisToBeAproved
                mb_AutoApp = False
                Exit For
            Case eSIAStatus.esisSleeping
                mo_Path(ll_Idx).Status = esisToBeAproved
                mb_AutoApp = False
                Exit For
        End Select
    Next

    ApplyObviousOptimisation = True
    Exit Function
onError:
    Call ErrorHandler("ApplyObviousOptimisation")
    
End Function

Private Function IsSomeApproval()
On Error GoTo onError
    Dim ll_Idx As Long
    Dim ll_Count As Long
    IsSomeApproval = False
    
    ll_Count = UBound(mo_Path)
    
    For ll_Idx = 0 To ll_Count
        If mo_Path(ll_Idx).Status = eSIAStatus.esisToBeAproved Then
            IsSomeApproval = True
            Exit Function
        End If
    Next

    Exit Function
onError:
    Call ErrorHandler("ApplyObviousOptimisation")
End Function

' Build the final approval path
Private Function GetApprovalPath() As Boolean

On Error GoTo onError

    Dim ll_Idx As Long, ll_Count As Long
    Dim ll_ApprIdx As Long ' Last Approver Index in the Path
    
    ll_Count = UBound(mo_Path)
    
    ' Step 1 - Search the last Approver of the SPA
    ll_ApprIdx = GetLastApprover
    If LastErrorCode <> 0 Then Exit Function  'An error has been marked
    
    ' Step 2 - Build the path
    If mb_FullAuth_flag Then
        If Not BuildFullAuthPath(ll_ApprIdx) Then Exit Function
    Else
        If Not BuildDefaultPath(ll_ApprIdx) Then Exit Function
    End If
    
    ' Step 3 - check if there is some line to approve
    If IsSomeApproval Then
    
        ' Step 3.5 - Apply Obvious optimisation of the path
    mb_AutoApp = False
    '    ml_AutoApprIdx = -1
        ml_AutoAppU_Code = 0
    
    If mb_ObviousAuth_Flag Then
        If Not ApplyObviousOptimisation() Then Exit Function
    End If
    Else
        ' nothing to approve => automatically approve by requestor
        mb_AutoApp = True
        ml_AutoAppU_Code = ml_Requestor
    End If
    
    GetApprovalPath = True
    Exit Function
onError:
    Call ErrorHandler("GetApprovalPath")

End Function



' Save the approval path previously build + initiate email
' Return true if success
' Fill any error into LastErrorCode / LastErrorMessage
' Must be called after BuildAppprovalPath if success
Public Function SaveApprovalPath(Optional ByVal ab_CreateTransaction As Boolean = False) As Boolean
    
On Error GoTo onError

    ClearError

    Const SQL_APPRPATH_INS As String = "EXEC SPA_ApprPath_Ins $SPA_ID$, $SIA_ID$, $SIA_Next$, $Auth_U_Code$, $Status_Code$, $SPAMU_ID$, $SPU_ID$, $SPUR_ID$, $S_Order$, $U_Code$"
    Const SQL_APPRPATH_MAIL As String = "UPDATE SPA_ApprovalPath SET EML_Code_Sent = $eml_code_sent$, Date_Emailed=GetDate() WHERE SIA_ID=$SIA_ID$"
    
    If Not mb_Initialized Then Err.Raise ArmErr.CPTNotInitialized, "SaveApprovalPath", "Unable to call this function before initialisation"
    If Not mb_PathBuilded Then Err.Raise ArmErr.CPTNotInitialized, "SaveApprovalPath", "Unable to save before building a path"
    
    ' Build the Queries
    Dim ll_Idx As Long, ll_Count As Long, ll_SIA_ID As Long, ll_SIA_Next As String
    ll_SIA_Next = "NULL"
    
    ll_Count = UBound(mo_Path)
    For ll_Idx = 0 To ll_Count
        mo_Path(ll_Idx).SIA_ID = mo_Db.SQLNextID("SPA_ApprovalPath")
        If mo_Path(ll_Idx).SIA_ID = 0 Then
            Call SetError(eceUnableToCreateSIA, MSG_UNABLE_CREATE_SIA)
            Exit Function
        End If
    Next
    
    Dim ls_RequestApprMailUpd As String ' Request to update the SIA after sending the email
    ' Search for the ToBeApproved, to send the email if
    Dim ll_IdxMail As Long
    ll_IdxMail = -1
    If Not mb_AutoApp Then
        ' Search for the first approver
        For ll_Idx = 0 To ll_Count
            If mo_Path(ll_Idx).Status = esisToBeAproved Then
                ' Preparing the email
                ll_IdxMail = GetEmail(ml_SPA_Id, mo_Path(ll_Idx).SIA_ID, mo_Path(ll_Idx).Auth_U_Code, eemRequest)
                ' the id of the email will be know only after sending
                ls_RequestApprMailUpd = SQL_APPRPATH_MAIL
                ls_RequestApprMailUpd = Replace(ls_RequestApprMailUpd, "$SIA_ID$", mo_Path(ll_Idx).SIA_ID, , , vbTextCompare)
                Exit For
            End If
        Next
    End If
    
    ' Prepare Request for the path
    For ll_Idx = ll_Count To 0 Step -1
        With mo_Path(ll_Idx)
            ll_SIA_ID = .SIA_ID
            .Request = SQL_APPRPATH_INS
            .Request = Replace(.Request, "$SPA_ID$", ml_SPA_Id, , , vbTextCompare)
            .Request = Replace(.Request, "$SIA_ID$", ll_SIA_ID, , , vbTextCompare)
            .Request = Replace(.Request, "$SIA_Next$", ll_SIA_Next, , , vbTextCompare)
            .Request = Replace(.Request, "$Auth_U_Code$", .Auth_U_Code, , , vbTextCompare)
            .Request = Replace(.Request, "$Status_Code$", .Status, , , vbTextCompare)
            .Request = Replace(.Request, "$SPAMU_ID$", IIf(.SPAMU_ID = 0, "NULL", .SPAMU_ID), , , vbTextCompare)
            .Request = Replace(.Request, "$SPU_ID$", .SPU_ID, , , vbTextCompare)
            .Request = Replace(.Request, "$SPUR_ID$", IIf(.SPUR_ID = 0, "NULL", .SPUR_ID), , , vbTextCompare)
            .Request = Replace(.Request, "$S_Order$", ll_Idx, , , vbTextCompare)
            .Request = Replace(.Request, "$U_Code$", ml_U_Code, , , vbTextCompare)
            
            If .Status = esisSleeping Then
                ll_SIA_Next = ll_SIA_ID
            Else
                ll_SIA_Next = "NULL"
            End If
            
        End With
    Next
    
    
    Dim mb_Transaction As Boolean
    ' Run the queries
    If ab_CreateTransaction Then
        Call BeginTran("SPA_SAVEPATH_" & ml_SPA_Id)
        mb_Transaction = True
    End If
    
    
    ' Write the path
    ll_Count = UBound(mo_Path)
    For ll_Idx = ll_Count To 0 Step -1
        Call ExecuteSQLSafe(mo_Db, mo_Path(ll_Idx).Request, 1)
    Next
    
    ' Send the email
    If Not mb_AutoApp Then ' Normal case, the SPA must be approved
        Dim ll_EML_Code As Long
        ' Send Requesting email
        ll_EML_Code = mo_MailClient.SendEmail(ll_IdxMail)
        ' Update the eml_code_sent of the SIA
        ls_RequestApprMailUpd = Replace(ls_RequestApprMailUpd, "$EML_Code_Sent$", ll_EML_Code, , , vbTextCompare)
        Call ExecuteSQLSafe(mo_Db, ls_RequestApprMailUpd, 1)
    Else
        ' The SPA has been approved like by a Super user (due to obvious optimization)
'        Call SetSPAStatus(mo_Path(ml_AutoApprIdx).Auth_U_Code, ml_SPA_Id, True, ab_CreateTransaction)
        Call SetSPAStatus(ml_AutoAppU_Code, ml_SPA_Id, True, ab_CreateTransaction)
        
    End If
    
    If ab_CreateTransaction Then
        Call CommitTran("SPA_SAVEPATH_" & ml_SPA_Id)
        mb_Transaction = False
    End If
    
    SaveApprovalPath = True
    Exit Function
    
onError:
    Debug.Print "Error !"
    If mb_Transaction = True Then
        Call RollbackTran("SPA_SAVEPATH_" & ml_SPA_Id)
    End If
    Call ErrorHandler("SaveApprovalPath")
End Function



' Change the status of an SPA (approval path + email + spa if needed)
' ab_Approve: true if Approve, false if reject
' Return true if success
' Fill any error into LastErrorCode / LastErrorMessage
Public Function SetSIAStatus(ByVal al_Approving_U_Code As Long, ByVal al_SPA_ID As Long, ByVal al_SIA_ID As Long, ByVal ab_Approve As Boolean, ByVal al_EML_Code As Long, Optional ByVal ab_CreateTransaction As Boolean = True) As Boolean
On Error GoTo onError
    ClearError
    If ab_Approve Then
        SetSIAStatus = ApproveSIA(al_Approving_U_Code, al_SPA_ID, al_SIA_ID, al_EML_Code, ab_CreateTransaction)
    Else
        SetSIAStatus = RejectSIA(al_Approving_U_Code, al_SPA_ID, al_SIA_ID, al_EML_Code, ab_CreateTransaction)
    End If
    Exit Function

onError:
    SetSIAStatus = False
    Call ErrorHandler("SetSIAStatus")
    
End Function



' Approve a single Approval Path line
' Can approve the SPA if no more further line to approve
Private Function ApproveSIA(ByVal al_Approving_U_Code As Long, ByVal al_SPA_ID As Long, ByVal al_SIA_ID As Long, ByVal al_EML_Code As Long, Optional ByVal ab_CreateTransaction As Boolean = True) As Boolean
    
On Error GoTo onError:
    
    ClearError
    
    Const SQL_GET_SIA_SETTINGS As String = "exec GetSIASettings $SIA_ID$"
    Const SQL_SIA_UpdateStatus As String = "exec SIA_UpdateStatus $SIA_ID$, $Status_Code$, $EML_Code_Sent$, $EML_Code_Received$, $U_Code$, $date_emailed$, $IConcurrency$, $Approver$"
    Const SQL_SPA_UpdateStatus As String = "exec SPA_UpdateStatus $SPA_ID$, $Status_Code$, $U_Code$, $IConcurrency$"
    
    ApproveSIA = False
    
    ' Step 1 - Get SIA Settings
    Dim ls_Request As String
    ls_Request = SQL_GET_SIA_SETTINGS
    ls_Request = Replace(ls_Request, "$SIA_ID$", al_SIA_ID)
    
    Dim lc_SIASettings As Long
    lc_SIASettings = OpenSQLSafe(mo_Db, ls_Request, 1)
    Dim ls_Today As String                                                                      ' General settings
    Dim ll_SPA_IConcurrency As Long, ll_SPA_Status As eSPAStatus                                ' Settings of SPA
    Dim ll_Status_Code As eSIAStatus, ll_iConcurrency As Long                                   ' Settings of Current SIA
    Dim ll_SIA_Next As Long, ll_Next_Status_Code As eSIAStatus, ll_Next_IConcurrency As Long    ' Settings of next SIA
    Dim ll_NextAuth_U_Code As Long
    Dim ls_SPA_CT_Code As String
    
    ll_Status_Code = mo_Db.GetFields(lc_SIASettings, "Status_Code")
    ll_iConcurrency = mo_Db.GetFields(lc_SIASettings, "IConcurrency")
    
    ls_Today = mo_Db.GetFields(lc_SIASettings, "Today")         ' Today from SQL server
    
    ll_SIA_Next = mo_Db.GetFields(lc_SIASettings, "SIA_Next")   ' Next line to approve
    ll_NextAuth_U_Code = mo_Db.GetFields(lc_SIASettings, "Auth_U_Code")
    ll_Next_Status_Code = mo_Db.GetFields(lc_SIASettings, "Next_Status_Code")
    ll_Next_IConcurrency = mo_Db.GetFields(lc_SIASettings, "Next_IConcurrency")
    
    ll_SPA_IConcurrency = mo_Db.GetFields(lc_SIASettings, "SPA_Concurrency")
    ll_SPA_Status = mo_Db.GetFields(lc_SIASettings, "SPA_ApprovalStatus")
    
    ls_SPA_CT_Code = mo_Db.GetFields(lc_SIASettings, "CT_Code")
    
    mo_Db.Close (lc_SIASettings)
    
    ' Step 2 - Status checking (must be ToBeApprove for current, and sleeping for next sia). SPA must be submitted
    If ll_Status_Code <> esisToBeAproved Then
        Call SetError(eCustErr.eceNotSIATBA, MSG_NOT_SIA_TBA)
        Exit Function
    End If
    
    If (ll_SIA_Next <> 0) And (ll_Next_Status_Code <> esisSleeping) Then
        Call SetError(eCustErr.eceNotSIASleeping, MSG_NOT_SIA_SLEEPING)
        Exit Function
    End If
    
    If (ll_SPA_Status <> eshsSubmited) Then
        Call SetError(eCustErr.eceNotSPASubmitted, MSG_NOT_SPA_SUBMITTED)
        Exit Function
    End If

    ' Step 3 - Approve the current SIA
    Dim ls_ReqApprSIA As String
    ls_ReqApprSIA = SQL_SIA_UpdateStatus
    ls_ReqApprSIA = Replace(ls_ReqApprSIA, "$SIA_ID$", al_SIA_ID, , , vbTextCompare)
    ls_ReqApprSIA = Replace(ls_ReqApprSIA, "$Status_Code$", esisApproved, , , vbTextCompare)
    ls_ReqApprSIA = Replace(ls_ReqApprSIA, "$EML_Code_Sent$", "NULL", , , vbTextCompare)
   
    If al_EML_Code = -1 Then
        ls_ReqApprSIA = Replace(ls_ReqApprSIA, "$EML_Code_Received$", "NULL", , , vbTextCompare)
    Else
        ls_ReqApprSIA = Replace(ls_ReqApprSIA, "$EML_Code_Received$", al_EML_Code, , , vbTextCompare)
    End If
    
    ls_ReqApprSIA = Replace(ls_ReqApprSIA, "$Date_Emailed$", "NULL", , , vbTextCompare)
    ls_ReqApprSIA = Replace(ls_ReqApprSIA, "$U_Code$", al_Approving_U_Code, , , vbTextCompare)
    ls_ReqApprSIA = Replace(ls_ReqApprSIA, "$Approver$", al_Approving_U_Code, , , vbTextCompare)
    ls_ReqApprSIA = Replace(ls_ReqApprSIA, "$IConcurrency$", ll_iConcurrency, , , vbTextCompare)
    
    ' Step 4 - Activate the next sia or terminate the SPA
    Dim ls_ReqActSIANext As String
    Dim ls_ReqApprSPA As String
    Dim lv_ReqApprAction As Variant
    Dim lv_ReqApprActionCC As Variant       ' task 116
    Dim ll_IdxEmail As Long
    ll_IdxEmail = -1
    
    If ll_SIA_Next <> 0 Then 'Activate the next sia
        ls_ReqActSIANext = SQL_SIA_UpdateStatus
        ls_ReqActSIANext = Replace(ls_ReqActSIANext, "$SIA_ID$", ll_SIA_Next, , , vbTextCompare)
        ls_ReqActSIANext = Replace(ls_ReqActSIANext, "$Status_Code$", esisToBeAproved, , , vbTextCompare)
        ls_ReqActSIANext = Replace(ls_ReqActSIANext, "$EML_Code_Received$", "NULL", , , vbTextCompare)
        ls_ReqActSIANext = Replace(ls_ReqActSIANext, "$Date_Emailed$", "'" & ls_Today & "'", , , vbTextCompare)
        ls_ReqActSIANext = Replace(ls_ReqActSIANext, "$U_Code$", al_Approving_U_Code, , , vbTextCompare)
        ls_ReqActSIANext = Replace(ls_ReqActSIANext, "$Approver$", "NULL", , , vbTextCompare)
        ls_ReqActSIANext = Replace(ls_ReqActSIANext, "$IConcurrency$", ll_Next_IConcurrency, , , vbTextCompare)
        
        'Don't generate action
        ReDim lv_ReqApprAction(-1 To -1)
        ' Raise next Approval Request
        'Don't generate action
        ReDim lv_ReqApprActionCC(-1 To -1)
        
        ll_IdxEmail = GetEmail(al_SPA_ID, ll_SIA_Next, ll_NextAuth_U_Code, eemRequest)
    Else ' Approve the SPA
        ls_ReqApprSPA = SQL_SPA_UpdateStatus
        ls_ReqApprSPA = Replace(ls_ReqApprSPA, "$SPA_ID$", al_SPA_ID, , , vbTextCompare)
        ls_ReqApprSPA = Replace(ls_ReqApprSPA, "$Status_Code$", eshsApproved, , , vbTextCompare)
        ls_ReqApprSPA = Replace(ls_ReqApprSPA, "$U_Code$", al_Approving_U_Code, , , vbTextCompare)
        ls_ReqApprSPA = Replace(ls_ReqApprSPA, "$iConcurrency$", ll_SPA_IConcurrency, , , vbTextCompare)
        
        ' Prepare the action
        lv_ReqApprAction = Split(GetReqAction(al_SPA_ID, eatSPAAuthorised), SEP1, , vbTextCompare)
        
        ' task 116 JN
        Call InitConfig     ' to be sure to have config initialised
        Debug.Assert (mc_Settings <> 0)
        If mo_Db.Find(mc_Settings, "CFG_Key", CFG_SPA_CONTRACTACTION & ls_SPA_CT_Code, , 0) > -1 Then
            ' Prepare action for contractor if is attached
            lv_ReqApprActionCC = Split(GetReqAction(al_SPA_ID, eatSPAAuthorised, True), SEP1, , vbTextCompare)
            If UBound(lv_ReqApprActionCC) = 0 Then
                'Don't generate action
                ReDim lv_ReqApprActionCC(-1 To -1)
            End If
        Else
            'Don't generate action
            ReDim lv_ReqApprActionCC(-1 To -1)
        End If
        
        
        ' Send Confirmation email
        ll_IdxEmail = GetEmail(al_SPA_ID, -1, 0, eemApprove)
    
    End If
 
    ' Step 5 - Update the database
    Dim mb_Transaction As Boolean
    If ab_CreateTransaction Then
        Call BeginTran("SIA_APPROVE_" & al_SPA_ID)
        mb_Transaction = True
    End If
 
    ' First launch the email to get the email code
    Dim ll_EML_Code As Long
    ll_EML_Code = mo_MailClient.SendEmail(ll_IdxEmail)
    ' If Next SIA, update the EML_Code_Sent
    If ll_SIA_Next <> 0 Then
        ls_ReqActSIANext = Replace(ls_ReqActSIANext, "$EML_Code_Sent$", ll_EML_Code, , , vbTextCompare)
    End If
    
    ' Update current SIA
    Call ExecuteSQLSafe(mo_Db, ls_ReqApprSIA, 1)
    ' Activate next SIA or complete the SPA
    If Len(ls_ReqActSIANext) <> 0 Then Call ExecuteSQLSafe(mo_Db, ls_ReqActSIANext, 1)
    If Len(ls_ReqApprSPA) <> 0 Then Call ExecuteSQLSafe(mo_Db, ls_ReqApprSPA, 1)
    
    ' Create action if needed
    Dim ll_Idx As Long, ll_Count As Long
    ll_Count = UBound(lv_ReqApprAction)
    For ll_Idx = 0 To ll_Count
'        Call MsgBox(lv_ReqApprAction(ll_Idx))
        Call ExecuteSQLSafe(mo_Db, lv_ReqApprAction(ll_Idx))
    Next
    
    ' Create action for contractor if needed task 116
    ll_Count = UBound(lv_ReqApprActionCC)
    For ll_Idx = 0 To ll_Count
        Call ExecuteSQLSafe(mo_Db, lv_ReqApprActionCC(ll_Idx))
    Next
    
    If ab_CreateTransaction Then
        Call CommitTran("SIA_APPROVE_" & al_SPA_ID)
        mb_Transaction = False
    End If
    
    ApproveSIA = True
    
    Exit Function
    
onError:
'    Call MsgBox(Err.Description & " ERROR NB:" & Err.Number)
    ApproveSIA = False
    mo_Db.Close (lc_SIASettings)
    Debug.Print "Error !"
    If mb_Transaction Then
        Call RollbackTran("SIA_APPROVE_" & al_SPA_ID)
    End If
    Call ErrorHandler("ApproveSIA")
End Function


Private Function RejectSIA(ByVal al_Approving_U_Code As Long, ByVal al_SPA_ID As Long, ByVal al_SIA_ID As Long, ByVal al_EML_Code As Long, Optional ByVal ab_CreateTransaction As Boolean = True) As Boolean
On Error GoTo onError:
    
    ClearError
    
    Const SQL_SIA_UpdateStatus As String = "exec SIA_UpdateStatus $SIA_ID$, $Status_Code$, $EML_Code_Sent$, $EML_Code_Received$, $U_Code$, $Date_Emailed$, $IConcurrency$, $Approver$"
    Const SQL_SPA_UpdAllSIA As String = "exec SPA_AllSleepingSIAUpd $SPA_ID$, $U_Code$, $Status_code$"
    Const SQL_SPA_UpdateStatus As String = "exec SPA_UpdateStatus $SPA_ID$, $Status_Code$, $U_Code$, $IConcurrency$"
    Const SQL_GET_SIA_SETTINGS As String = "exec GetSIASettings $SIA_ID$"
    
    
    ' Step 1 - Get SIA Setting to check status
    Dim ls_Request As String
    ls_Request = SQL_GET_SIA_SETTINGS
    ls_Request = Replace(ls_Request, "$SIA_ID$", al_SIA_ID, , , vbTextCompare)
    Dim lc_Settings As Long
    lc_Settings = OpenSQLSafe(mo_Db, ls_Request, 1)
    Dim ll_SPA_IConcurrency As Long, ll_SPA_Status As eSPAStatus    ' Settings of SPA
    Dim ll_Status_Code As eSIAStatus, ll_iConcurrency As Long       ' Settings of SIA
    
    ll_Status_Code = mo_Db.GetFields(lc_Settings, "Status_Code")
    ll_iConcurrency = mo_Db.GetFields(lc_Settings, "IConcurrency")
    
    ll_SPA_IConcurrency = mo_Db.GetFields(lc_Settings, "SPA_Concurrency")
    ll_SPA_Status = mo_Db.GetFields(lc_Settings, "SPA_ApprovalStatus")
    mo_Db.Close (lc_Settings)
    
    ' Step 2 - Status checking (must be ToBeApprove for current, and sleeping for next sia). SPA must be submitted
    If ll_Status_Code <> esisToBeAproved Then
        Call SetError(eCustErr.eceNotSIATBA, MSG_NOT_SIA_TBA)
        Exit Function
    End If
    
    If (ll_SPA_Status <> eshsSubmited) Then
        Call SetError(eCustErr.eceNotSPASubmitted, MSG_NOT_SPA_SUBMITTED)
        Exit Function
    End If

    ' Step 3 - Reject the current SIA
    Dim ls_ReqApprSIA As String
    ls_ReqApprSIA = SQL_SIA_UpdateStatus
    ls_ReqApprSIA = Replace(ls_ReqApprSIA, "$SIA_ID$", al_SIA_ID, , , vbTextCompare)
    ls_ReqApprSIA = Replace(ls_ReqApprSIA, "$Status_Code$", esisRejected, , , vbTextCompare)
    ls_ReqApprSIA = Replace(ls_ReqApprSIA, "$EML_Code_Sent$", "NULL", , , vbTextCompare)
    
    If al_EML_Code = -1 Then
        ls_ReqApprSIA = Replace(ls_ReqApprSIA, "$Date_Emailed$", "NULL", , , vbTextCompare)
    Else
        ls_ReqApprSIA = Replace(ls_ReqApprSIA, "$Date_Emailed$", al_EML_Code, , , vbTextCompare)
    End If
    
    ls_ReqApprSIA = Replace(ls_ReqApprSIA, "$EML_Code_Received$", al_EML_Code, , , vbTextCompare)
    ls_ReqApprSIA = Replace(ls_ReqApprSIA, "$U_Code$", al_Approving_U_Code, , , vbTextCompare)
    ls_ReqApprSIA = Replace(ls_ReqApprSIA, "$IConcurrency$", ll_iConcurrency, , , vbTextCompare)
    ls_ReqApprSIA = Replace(ls_ReqApprSIA, "$Approver$", al_Approving_U_Code, , , vbTextCompare)

    ' Step 4 - Cancelled all sleeping SIA
    Dim ls_ReqUpdAllSIA As String
    ls_ReqUpdAllSIA = SQL_SPA_UpdAllSIA
    ls_ReqUpdAllSIA = Replace(ls_ReqUpdAllSIA, "$SPA_ID$", al_SPA_ID, , , vbTextCompare)
    ls_ReqUpdAllSIA = Replace(ls_ReqUpdAllSIA, "$U_Code$", al_Approving_U_Code, , , vbTextCompare)
    ls_ReqUpdAllSIA = Replace(ls_ReqUpdAllSIA, "$Status_Code$", esisCancelled, , , vbTextCompare)
    
    ' Step 5 - Reject the SPA
    Dim ls_ReqRejSPA As String
    ls_ReqRejSPA = SQL_SPA_UpdateStatus
    ls_ReqRejSPA = Replace(ls_ReqRejSPA, "$SPA_ID$", al_SPA_ID, , , vbTextCompare)
    ls_ReqRejSPA = Replace(ls_ReqRejSPA, "$Status_Code$", eshsRejected, , , vbTextCompare)
    ls_ReqRejSPA = Replace(ls_ReqRejSPA, "$U_Code$", al_Approving_U_Code, , , vbTextCompare)
    ls_ReqRejSPA = Replace(ls_ReqRejSPA, "$IConcurrency$", ll_SPA_IConcurrency, , , vbTextCompare)
    
    ' Step 6 - Generate the action
    Dim lv_ReqApprAction As Variant
    lv_ReqApprAction = Split(GetReqAction(al_SPA_ID, eatSPARejected), SEP1, , vbTextCompare)
    
    
    ' Step 7 - Generate the email
    Dim ll_IdxEmail As Long
    ll_IdxEmail = GetEmail(al_SPA_ID, -1, 0, eemReject)

    ' Step 8 - Update the database
    
    Dim mb_Transaction As Boolean
    mb_Transaction = False
    If ab_CreateTransaction Then
        Call BeginTran("SIA_REJECT_" & al_SPA_ID)
        mb_Transaction = True
    End If

    Call ExecuteSQLSafe(mo_Db, ls_ReqApprSIA, 1)    ' Reject current SIA
    Call ExecuteSQLSafe(mo_Db, ls_ReqUpdAllSIA)     ' Cancell all other SIA
    Call ExecuteSQLSafe(mo_Db, ls_ReqRejSPA)        ' Reject SPA

    ' Create the action
    Dim ll_Idx As Long, ll_Count As Long
    ll_Count = UBound(lv_ReqApprAction)
    For ll_Idx = 0 To ll_Count
        Call ExecuteSQLSafe(mo_Db, lv_ReqApprAction(ll_Idx))
    Next

    ' and send the mail
    Call mo_MailClient.SendEmail(ll_IdxEmail)

    If ab_CreateTransaction Then
        Call CommitTran("SIA_REJECT_" & al_SPA_ID)
        mb_Transaction = False
    End If
    RejectSIA = True
    Exit Function

onError:
    mo_Db.Close (lc_Settings)
    Debug.Print "Error !"
    If mb_Transaction Then
        Call RollbackTran("SIA_REJECT_" & al_SPA_ID)
    End If
    Call ErrorHandler("RejectSIA")
End Function


' Used by Super user to override the SPA approval process
Public Function SetSPAStatus(ByVal al_Approving_U_Code As Long, ByVal al_SPA_ID As Long, ByVal ab_Approve As Boolean, Optional ByVal ab_CreateTransaction As Boolean = True) As Boolean

    On Error GoTo onError
    
    Const SQL_SPA_UpdAllSIA As String = "exec SPA_AllSleepingSIAUpd $SPA_ID$, $U_Code$, $Status_code$"
    Const SQL_SPA_UpdateStatus As String = "exec SPA_UpdateStatus $SPA_ID$, $Status_Code$, $U_Code$, $IConcurrency$"

    ClearError
    
    ' Step 1 - Get SPA Settings and
    If Not GetSPASettings(al_SPA_ID) Then Exit Function
    
    If (ml_SPA_Status <> eshsSubmited And ml_SPA_Status <> eshsNew) Then    ' JN fix: New can be also
        Call SetError(eCustErr.eceNotSPASubmitted, MSG_NOT_SPA_SUBMITTED)
        Exit Function
    End If

    ' Step 2 - Updated all sleeping SIA
    Dim ls_ReqUpdAllSIA As String
    ls_ReqUpdAllSIA = SQL_SPA_UpdAllSIA
    ls_ReqUpdAllSIA = Replace(ls_ReqUpdAllSIA, "$SPA_ID$", al_SPA_ID, , , vbTextCompare)
    ls_ReqUpdAllSIA = Replace(ls_ReqUpdAllSIA, "$U_Code$", al_Approving_U_Code, , , vbTextCompare)
    ls_ReqUpdAllSIA = Replace(ls_ReqUpdAllSIA, "$Status_Code$", IIf(ab_Approve, esisApproved, esisRejected), , , vbTextCompare)
    
    
    ' Step 3 - Terminate the SPA the SPA
    Dim ls_ReqCptSPA As String
    ls_ReqCptSPA = SQL_SPA_UpdateStatus
    ls_ReqCptSPA = Replace(ls_ReqCptSPA, "$SPA_ID$", al_SPA_ID, , , vbTextCompare)
    ls_ReqCptSPA = Replace(ls_ReqCptSPA, "$Status_Code$", IIf(ab_Approve, eshsApproved, eshsRejected), , , vbTextCompare)
    ls_ReqCptSPA = Replace(ls_ReqCptSPA, "$U_Code$", al_Approving_U_Code, , , vbTextCompare)
    ls_ReqCptSPA = Replace(ls_ReqCptSPA, "$IConcurrency$", ml_iConcurrency, , , vbTextCompare)

    ' Step 4 - Prepare capture action
    Dim lv_ReqApprAction As Variant
    lv_ReqApprAction = Split(GetReqAction(al_SPA_ID, IIf(ab_Approve, eatSPAAuthorised, eatSPARejected)), SEP1, , vbTextCompare)
    ' task 116
    Dim lv_ReqApprActionCC As Variant
    If ab_Approve Then
        Call InitConfig     ' to be sure to have config initialised
        Debug.Assert (mc_Settings <> 0)
        If mo_Db.Find(mc_Settings, "CFG_Key", CFG_SPA_CONTRACTACTION & ms_SPA_CT_Code, , 0) > -1 Then
            ' Prepare action for contractor if is attached
            lv_ReqApprActionCC = Split(GetReqAction(al_SPA_ID, eatSPAAuthorised, True), SEP1, , vbTextCompare)
            If UBound(lv_ReqApprActionCC) = 0 Then
                'Don't generate action
                ReDim lv_ReqApprActionCC(-1 To -1)
            End If
        Else
            'Don't generate action
            ReDim lv_ReqApprActionCC(-1 To -1)
        End If
    Else
        'Don't generate action
        ReDim lv_ReqApprActionCC(-1 To -1)
    End If
    
    ' Step 5 - Prepare email
    Dim ll_IdxEmail As Long
    ll_IdxEmail = GetEmail(al_SPA_ID, -1, 0, IIf(ab_Approve, eEMailType.eemApprove, eEMailType.eemReject))

    
    ' Step 6 - Update the DB
    Dim mb_Transaction As Boolean
    If ab_CreateTransaction Then
        Call BeginTran("SPA_STATUS_" & al_SPA_ID)
        mb_Transaction = True
    End If
    
    Call ExecuteSQLSafe(mo_Db, ls_ReqUpdAllSIA)
    Call ExecuteSQLSafe(mo_Db, ls_ReqCptSPA, 1)
    
    ' Save Action
    Dim ll_Idx As Long, ll_Count As Long
    ll_Count = UBound(lv_ReqApprAction)
    For ll_Idx = 0 To ll_Count
        Call ExecuteSQLSafe(mo_Db, lv_ReqApprAction(ll_Idx))
    Next
    ' task 116
    ll_Count = UBound(lv_ReqApprActionCC)
    For ll_Idx = 0 To ll_Count
        Call ExecuteSQLSafe(mo_Db, lv_ReqApprActionCC(ll_Idx))
    Next
    
    
    ' Save Email
    mo_MailClient.SendEmail (ll_IdxEmail)
    
    If ab_CreateTransaction Then
        Call CommitTran("SPA_STATUS_" & al_SPA_ID)
        mb_Transaction = False
    End If
    SetSPAStatus = True

    Exit Function
onError:
    Debug.Print "Error !"
    If mb_Transaction Then
        Call RollbackTran("SPA_STATUS_" & al_SPA_ID)
    End If
    Call ErrorHandler("SetSPAStatus")
End Function



' Create the Queries to save the action
Private Function GetReqAction(ByVal al_SPA_ID As Long, ByVal ae_AT_Code As eActionType, Optional ByVal ab_use_CC_CCU_CapKey As Boolean = False) As String
On Error GoTo onError
    Const SQL_GetActionSettings = "EXEC GetSPAActSettings $SPA_ID$"

    Const SQL_ACTION_INS As String = "Cap_Action_INS '$CCU_CapKey$', $CNT_code$, $SP_CapKey$, $AT_code$,  1, NULL, '$ACT_raisedFor$', 1, '$ACT_dueDate$', 0, 'M2', '', '', '', NULL, '', '', 0, 0, '$AC_code$'"
    Const SQL_MEMO_INS As String = "EXEC Cap_Memo_ins 'E', $Comment_desc$, $Comment$, 'N', 'N', Null, '$AC_CODE$', '', 2, 0, '$MEM_Code$'"
    Const SQL_DETAIL_ITEMS_GRID As String = "EXEC SPA_Item_Lst $SPA_ID$, $Language_Code$"

    Dim ls_ActionCode As String
    
    ls_ActionCode = mo_Db.SQLNextID("Cap_Action")
    If ls_ActionCode = "" Then Call Err.Raise(SQLFailure, "", "SQL Error: mo_ArmDb.SQLNextID(""Cap_Action"") return nothing.")

    Dim ls_Request As String
    ls_Request = SQL_GetActionSettings
    ls_Request = Replace(ls_Request, "$SPA_ID$", al_SPA_ID, , , vbTextCompare)
    Dim lc_Settings As Long
    lc_Settings = OpenSQLSafe(mo_Db, ls_Request, 1)

    ' task 116 JN
    If ab_use_CC_CCU_CapKey And mo_Db.GetFields(lc_Settings, "CC_CCU_Capkey") = "" Then
        ' if action is raised for Contractor, but contractor is not assigned, we have nothing to create
        Call mo_Db.Close(lc_Settings)
        lc_Settings = 0
        GetReqAction = ""
        Exit Function
    End If

    Dim ls_RequestA As String
    ls_RequestA = SQL_ACTION_INS
    ls_RequestA = Replace(ls_RequestA, "$CCU_Capkey$", mo_Db.GetFields(lc_Settings, IIf(ab_use_CC_CCU_CapKey, "CC_CCU_Capkey", "CCU_Capkey")), , , vbTextCompare)
    ls_RequestA = Replace(ls_RequestA, "$CNT_Code$", "NULL", , , vbTextCompare)
    ls_RequestA = Replace(ls_RequestA, "$SP_Capkey$", IIf(Len(mo_Db.GetFields(lc_Settings, "SP_Capkey")) = 0, "NULL", "'" & mo_Db.GetFields(lc_Settings, "SP_Capkey") & "'"), , , vbTextCompare)
    ls_RequestA = Replace(ls_RequestA, "$AT_Code$", ae_AT_Code, , , vbTextCompare)
    ls_RequestA = Replace(ls_RequestA, "$ACT_raisedFor$", mo_Db.GetFields(lc_Settings, "RaisedFor"), , , vbTextCompare)
    ls_RequestA = Replace(ls_RequestA, "$ACT_dueDate$", mo_Db.GetFields(lc_Settings, "Today"), , , vbTextCompare)
    ls_RequestA = Replace(ls_RequestA, "$AC_Code$", ls_ActionCode, , , vbTextCompare)
    
    
    Dim ls_MEM_Code As String
    ls_MEM_Code = mo_Db.SQLNextID("Cap_Memo")
    If ls_MEM_Code = "" Then Call Err.Raise(SQLFailure, "", "SQL Error: mo_ArmDb.SQLNextID(""Cap_Memo"") return nothing.")
    
    Dim ll_i As Long
    Dim ls_comment As String
    Dim ls_RequestB As String
    
    ls_RequestB = Replace(SQL_DETAIL_ITEMS_GRID, "$SPA_ID$", al_SPA_ID, , , vbTextCompare)
    ls_RequestB = Replace(ls_RequestB, "$Language_Code$", "E", , , vbTextCompare)
    Dim lc_Items As Long
    lc_Items = OpenSQLSafe(mo_Db, ls_RequestB)
    
    ls_comment = "SPA ID:" & al_SPA_ID & vbCrLf & vbCrLf
    
    If lc_Items > 0 Then
        For ll_i = 0 To mo_Db.RowCount(lc_Items) - 1
            ls_comment = ls_comment & mo_Db.GetFields(lc_Items, "BI_Desc") & " ( " & mo_Db.GetFields(lc_Items, "BI_SAP_Code") & " )  " & Format(mo_Db.GetFields(lc_Items, "SPA_Qty"), QTY_FORMAT) & " " & mo_Db.GetFields(lc_Items, "SPA_UoM") & " @ "
            ls_comment = ls_comment & Format(mo_Db.GetFields(lc_Items, "SPA_Price"), MONEY_FORMAT) & " " & mo_Db.GetFields(lc_Items, "SPA_CURR_Code")
            ls_comment = ls_comment & "  (" & Format(mo_Db.GetFields(lc_Items, "SPA_Discount"), PERCENT_FORMAT) & "%)" & vbCrLf
            mo_Db.Next (lc_Items)
        Next
    End If
    
    mo_Db.Close (lc_Items)
    
    Dim ls_RequestM As String
    ls_RequestM = SQL_MEMO_INS
    ls_RequestM = Replace(ls_RequestM, "$AC_Code$", ls_ActionCode, , , vbTextCompare)
    ls_RequestM = Replace(ls_RequestM, "$MEM_Code$", ls_MEM_Code, , , vbTextCompare)
    ls_RequestM = Replace(ls_RequestM, "$Comment_desc$", SQLStr(ls_comment, 80), , , vbTextCompare)
    ls_RequestM = Replace(ls_RequestM, "$Comment$", SQLStr(ls_comment, 1024), , , vbTextCompare)
    
    mo_Db.Close (lc_Settings)
    
    GetReqAction = Join(Array(ls_RequestA, ls_RequestM), SEP1)
    Exit Function
onError:
    Call ErrorHandler("GetReqAction")
End Function


' task 116 JN
Private Sub InitConfig()
    On Error GoTo onError
    Const SQL_GetConfig = "SELECT CFG_Key, CFG_Value FROM A_Config WHERE CFG_Key LIKE 'ABPE_SPA_MAIL_%' OR CFG_Key LIKE '" & CFG_SPA_CONTRACTACTION & "%'"
    
    If mc_Settings = 0 Then
        Dim ls_Request As String
        ls_Request = SQL_GetConfig
        mc_Settings = OpenSQLSafe(mo_Db, ls_Request)
        
    End If
    Exit Sub
onError:
    Call ErrorHandler("InitConfig")
End Sub
' Retrieve a Setting of Approval process from A_Config
' All settings are get and stored locally at the first call
Private Function GetConfig(ByVal as_Key As String) As String
    On Error GoTo onError
    Call InitConfig
    
    Dim ls_value As String
    If mo_Db.Find(mc_Settings, "CFG_Key", as_Key, , 0) > -1 Then
        ls_value = mo_Db.GetFields(mc_Settings, "CFG_Value")
    Else
        Err.Raise eceMissingSetting, "GetConfig", Replace(MSG_MISSING_SETTING, "$key$", as_Key, , , vbTextCompare)
    End If
    GetConfig = ls_value
    Exit Function
    
onError:
    Call ErrorHandler("GetConfig")
End Function


' Build the email
Private Function GetEmail(ByVal al_SPA_ID As Long, ByVal al_SIA_ID As Long, ByVal al_Auth_U_Code As Long, ByVal ae_Type As eEMailType) As Long
    
On Error GoTo onError

    Const SQL_GetMailSettings As String = "exec GetSPAMailSettings $spa_id$, $Auth_U_Code$"
    Const SQL_GetMailMatrix As String = "exec GetSPAMailMatrix $spa_id$"
    Dim ll_codePage As Long
    
    
    GetEmail = -1
    
    ' Build the subject
    Dim ls_Subject As String
    Select Case ae_Type
        Case eEMailType.eemApprove
            ls_Subject = GetConfig(CFG_Mail_SubjA)
        Case eEMailType.eemRequest
        ls_Subject = GetConfig(CFG_Mail_SubjQ)
        Case eEMailType.eemReject
            ls_Subject = GetConfig(CFG_Mail_SubjR)
    End Select
    ls_Subject = Replace(ls_Subject, "$spa_id$", al_SPA_ID, , , vbTextCompare)
    
    If al_SIA_ID = -1 Then
        ls_Subject = Replace(ls_Subject, "$sia_id$", "", , , vbTextCompare)
    Else
        ls_Subject = Replace(ls_Subject, "$sia_id$", al_SIA_ID, , , vbTextCompare)
    
    End If
    
    ' Get mail informations to build msg
    Dim ls_Request As String
    ls_Request = SQL_GetMailSettings
    ls_Request = Replace(ls_Request, "$spa_id$", al_SPA_ID, , , vbTextCompare)
    
    ls_Request = Replace(ls_Request, "$Auth_U_Code$", al_Auth_U_Code, , , vbTextCompare)
'    ls_Request = Replace(ls_Request, "$sia_id$", al_SIA_ID, , , vbTextCompare)
    Dim lc_Settings As Long
    lc_Settings = OpenSQLSafe(mo_Db, ls_Request, 1)
    
    
    ll_codePage = mo_Db.GetFields(lc_Settings, "CodePage")
    
    Dim ls_Title As String
    If mo_Db.GetFields(lc_Settings, "SPA_TypeFlag") = estProject Then
        ls_Title = GetConfig(CFG_Mail_Title)
        ls_Title = Replace(ls_Title, "$sd$", mo_Db.GetFields(lc_Settings, "SP_Desc"), , , vbTextCompare)
        ls_Title = Replace(ls_Title, "$st$", mo_Db.GetFields(lc_Settings, "SP_Town"), , , vbTextCompare)
    Else
        ls_Title = GetConfig(CFG_Mail_TitleStock)
    End If
    ls_Title = Replace(ls_Title, "$spa_id$", al_SPA_ID, , , vbTextCompare)
    
    ' Build the matrix of products
    Dim ls_Line As String, ls_LineTpl As String, lv_Matrix As Variant
    ls_LineTpl = GetConfig(CFG_Mail_Matrix)
    ls_Request = SQL_GetMailMatrix
    ls_Request = Replace(ls_Request, "$SPA_ID$", al_SPA_ID, , , vbTextCompare)
    Dim lc_Matrix As Long
    lc_Matrix = OpenSQLSafe(mo_Db, ls_Request)
    
    Dim ll_Idx As Long, ll_Count As Long
    ll_Count = mo_Db.RowCount(lc_Matrix)
    ReDim lv_Matrix(ll_Count)
    For ll_Idx = 0 To ll_Count - 1
        ls_Line = ls_LineTpl
        ls_Line = Replace(ls_Line, "$bi_sap_code$", mo_Db.GetFields(lc_Matrix, "BI_SAP_Code"), , , vbTextCompare)
        ls_Line = Replace(ls_Line, "$bi_desc$", mo_Db.GetFields(lc_Matrix, "BI_Desc"), , , vbTextCompare)
        ls_Line = Replace(ls_Line, "$spa_price$", Format(mo_Db.GetFields(lc_Matrix, "spa_price"), MONEY_FORMAT), , , vbTextCompare)
        ls_Line = Replace(ls_Line, "$std_price$", Format(mo_Db.GetFields(lc_Matrix, "std_price"), MONEY_FORMAT), , , vbTextCompare)
        ls_Line = Replace(ls_Line, "$discount$", IIf(mo_Db.GetFields(lc_Matrix, "std_price") = 0, GetConfig(CFG_Mail_MatrixNotApp), Format(mo_Db.GetFields(lc_Matrix, "spa_discount"), PERCENT_FORMAT) & "%"), , , vbTextCompare)         ' 09/11/2012 JN
        ls_Line = Replace(ls_Line, "$curr$", mo_Db.GetFields(lc_Matrix, "SPA_CURR_Code"), , , vbTextCompare)        ' task 1054.1 JN(10.1.2018) currency from item
        ls_Line = Replace(ls_Line, "$uom$", mo_Db.GetFields(lc_Matrix, "SPA_UOM"), , , vbTextCompare)
        ls_Line = Replace(ls_Line, "$qty$", Format(mo_Db.GetFields(lc_Matrix, "SPA_QTY"), QTY_FORMAT), , , vbTextCompare)
        If Trim(mo_Db.GetFields(lc_Matrix, "SPI_SAP_Message")) = "" Then
            ls_Line = Replace(ls_Line, "$SAP_msg$", "", , , vbTextCompare)
        Else
            Dim ls_errMsgTmpl As String
            ls_errMsgTmpl = GetConfig(CFG_Mail_MatrixErr)
            ls_Line = Replace(ls_Line, "$SAP_msg$", Replace(ls_errMsgTmpl, "$ERRMSG$", mo_Db.GetFields(lc_Matrix, "SPI_SAP_Message"), , , vbTextCompare), , , vbTextCompare)
        End If
        
        ls_Line = Replace(ls_Line, "$RE$", mo_Db.GetFields(lc_Matrix, "SPI_RebateExempt"), , , vbTextCompare)        ' 30/05/2018 JN Rebate Exempt

        lv_Matrix(ll_Idx) = ls_Line
        mo_Db.Next (lc_Matrix)
    Next
    mo_Db.Close (lc_Matrix)
    Dim ls_Matrix As String
    ls_Matrix = Join(lv_Matrix, vbCrLf)
    
    ' Prepare the body
    Dim ls_Body As String, ls_Date As String
    ls_Body = GetConfig(CFG_Mail_Body) & GetConfig(CFG_Mail_Body_ext)
    
    ls_Body = Replace(ls_Body, "$dr$", mo_Db.GetFields(lc_Settings, "Date_Required"), , , vbTextCompare)
    ls_Body = Replace(ls_Body, "$cd$", mo_Db.GetFields(lc_Settings, "CCU_Desc"), , , vbTextCompare)
    ls_Body = Replace(ls_Body, "$ct$", mo_Db.GetFields(lc_Settings, "CCU_Town"), , , vbTextCompare)
    ls_Body = Replace(ls_Body, "$vt$", mo_Db.GetFields(lc_Settings, "Valid_To"), , , vbTextCompare)
    ls_Body = Replace(ls_Body, "$cm$", mo_Db.GetFields(lc_Settings, "SPA_Comment"), , , vbTextCompare)
    ls_Body = Replace(ls_Body, "$req$", mo_Db.GetFields(lc_Settings, "Requestor_Name"), , , vbTextCompare)  ' P.103
    ls_Body = Replace(ls_Body, "$rep$", mo_Db.GetFields(lc_Settings, "SR_Name"), , , vbTextCompare)         ' P.103
    ls_Body = Replace(ls_Body, "$cre$", mo_Db.GetFields(lc_Settings, "Creator_Name"), , , vbTextCompare)    ' P.103
    ls_Body = Replace(ls_Body, "$cmtInt$", mo_Db.GetFields(lc_Settings, "Internal_comment"), , , vbTextCompare)    ' Task 102 JN
    ls_Body = Replace(ls_Body, "$ds$", mo_Db.GetFields(lc_Settings, "Date_Submitted"), , , vbTextCompare)    ' Task 1080 JN
    
    Dim ls_Msg As String
    ls_Msg = ls_Title & vbCrLf & ls_Body & vbCrLf & vbCrLf & ls_Matrix
    ls_Msg = ConvertCodePageFromAnsi(ls_Msg, ll_codePage)
    
    ' Create the email
    Dim ll_IdxEmail As Long
    ll_IdxEmail = mo_MailClient.AddEmail(ls_Subject, ls_Msg, False, Now, "")
    
    
    ' Define To
    If ae_Type = eemRequest Then ' Sent an approval request to only the approver
        Call mo_MailClient.AddEmailAddress(ll_IdxEmail, mo_Db.GetFields(lc_Settings, "Auth_Email"), etEmailTo)
    Else
        ' Sent confirmation to creator, requestor and customer owner.
        ' Eliminate the duplicate
        ' JN 15/8/2013 suppress confirmation emails
        If mo_Db.GetFields(lc_Settings, "SR_Code_SPA_no_conf_email") <> "X" Then
            Call mo_MailClient.AddEmailAddress(ll_IdxEmail, mo_Db.GetFields(lc_Settings, "SR_Code_Email"), etEmailTo)
        End If
        If mo_Db.GetFields(lc_Settings, "SR_Code_Email") <> mo_Db.GetFields(lc_Settings, "Requestor_Email") Then
            If mo_Db.GetFields(lc_Settings, "Requestor_SPA_no_conf_email") <> "X" Then
                Call mo_MailClient.AddEmailAddress(ll_IdxEmail, mo_Db.GetFields(lc_Settings, "Requestor_Email"), etEmailTo)
            End If
        End If
        If (mo_Db.GetFields(lc_Settings, "Creator_Email") <> mo_Db.GetFields(lc_Settings, "Requestor_Email")) And _
            (mo_Db.GetFields(lc_Settings, "Creator_Email") <> mo_Db.GetFields(lc_Settings, "SR_Code_Email")) Then
            If mo_Db.GetFields(lc_Settings, "Creator_SPA_no_conf_email") <> "X" Then
                Call mo_MailClient.AddEmailAddress(ll_IdxEmail, mo_Db.GetFields(lc_Settings, "Creator_Email"), etEmailTo)
            End If
        End If
    End If
    mo_Db.Close (lc_Settings)

    Debug.Print "Mail To: " & mo_MailClient.GetEmailAddresses(ll_IdxEmail, etEmailTo)
    Debug.Print "Mail Subject: " & ls_Subject
    Debug.Print "Mail Msg: " & ls_Msg
    GetEmail = ll_IdxEmail
    Exit Function
    
onError:
    mo_Db.Close (lc_Matrix)
    mo_Db.Close (lc_Settings)
    Call ErrorHandler("GetEmail")
End Function

Public Sub SendWarningEmail(ByVal al_SPA_ID As Long)
On Error GoTo ErrHandler
Const C_REQ_CNF = "EXEC SPA_Header_SAP_Error_config $SPA_ID$"
Const C_REQ = "EXEC SPA_Header_SAP_Error_mail $CT_CODE$"

    Dim ll_Cursor As Long
    Dim ls_req As String
    Dim ll_IdxEmail As Long
    Dim ls_Subject As String, ls_Msg As String
    Dim ls_CT_Code As String
    
    
    ls_req = Replace(C_REQ_CNF, "$SPA_ID$", al_SPA_ID, , , vbTextCompare)
    ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
    
    ll_IdxEmail = -1
    Dim ls_Message As String
    
    ls_Message = ""
    While Not mo_Db.EOF(ll_Cursor)
        If mo_Db.GetFields(ll_Cursor, "SPI_SAP_Message") <> "" Then
            ls_Message = ls_Message & vbCrLf & mo_Db.GetFields(ll_Cursor, "SPI_SAP_Message")
        End If
        ls_CT_Code = mo_Db.GetFields(ll_Cursor, "CT_Code")
        Call mo_Db.Next(ll_Cursor)
    Wend
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    
    If ls_Message <> "" Then
        ls_Subject = Replace(GetConfig(CFG_Mail_SubjE), "$spa_id$", al_SPA_ID, , , vbTextCompare)
        ls_Msg = Replace(GetConfig(CFG_Mail_SAP_Body), "$SAP_msg$", ls_Message, , , vbTextCompare)
        
        ll_IdxEmail = mo_MailClient.AddEmail(ls_Subject, ls_Msg, False, Now, "")
    End If
    
    
    If ll_IdxEmail = -1 Then
        ' no message to send
        Exit Sub
    End If
    
    Dim lb_EmailAddrExists As Boolean
    lb_EmailAddrExists = False
    
    ls_req = Replace(C_REQ, "$CT_CODE$", SQLStr(ls_CT_Code, 2), , , vbTextCompare)
    ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
    
    While Not mo_Db.EOF(ll_Cursor)
        If mo_Db.GetFields(ll_Cursor, "U_Email_Armstrong") <> "" Then
            Call mo_MailClient.AddEmailAddress(ll_IdxEmail, mo_Db.GetFields(ll_Cursor, "U_Email_Armstrong"), etEmailTo)
            lb_EmailAddrExists = True
        End If
        Call mo_Db.Next(ll_Cursor)
    Wend
    
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    
    If lb_EmailAddrExists Then
        ' send message
        Call mo_MailClient.SendEmail(ll_IdxEmail)
    End If
    'mo_MailClient.ClearData        ' JN ??????? I think we should clear it, at least the email beeing sent should be removed from internal structures
    

    Exit Sub
ErrHandler:
    If ll_Cursor <> 0 Then
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
    Call ErrorHandler("SendWarningEmail")
End Sub

Public Sub SendValidToChangedEmail(ByVal al_SPA_ID As Long)
On Error GoTo ErrHandler
Const C_REQ_CNF = "EXEC SPA_Header_Valid_to_changed_config $SPA_ID$"
Const C_REQ = "EXEC SPA_Header_Valid_to_mail $SPA_ID$"

    Dim ll_Cursor As Long
    Dim ls_req As String
    Dim ll_IdxEmail As Long
    Dim ls_Subject As String, ls_Msg As String
    
    
    ls_req = Replace(C_REQ_CNF, "$SPA_ID$", al_SPA_ID, , , vbTextCompare)
    ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
    
    ll_IdxEmail = -1
    Dim ls_valid_to As String
    Dim ls_updator As String
    
    ls_valid_to = ""
    If Not mo_Db.EOF(ll_Cursor) Then
        ls_valid_to = mo_Db.GetFields(ll_Cursor, "Valid_to")
        ls_updator = mo_Db.GetFields(ll_Cursor, "U_Login_Name")
    End If
    
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    
    ls_Subject = Replace(GetConfig(CFG_Mail_SubjV), "$spa_id$", al_SPA_ID, , , vbTextCompare)
    
    ls_Msg = Replace(GetConfig(CFG_Mail_ValidTo_Body), "$Valid_to$", ls_valid_to, , , vbTextCompare)
    ls_Msg = Replace(ls_Msg, "$USERNAME$", ls_updator, , , vbTextCompare)
    
    ll_IdxEmail = mo_MailClient.AddEmail(ls_Subject, ls_Msg, False, Now, "")
    
    
    If ll_IdxEmail = -1 Then
        ' no message to send
        Exit Sub
    End If
    
    Dim lb_EmailAddrExists As Boolean
    lb_EmailAddrExists = False
    
    ls_req = Replace(C_REQ, "$SPA_ID$", al_SPA_ID, , , vbTextCompare)
    ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
    
    While Not mo_Db.EOF(ll_Cursor)
        If mo_Db.GetFields(ll_Cursor, "U_Email_Armstrong") <> "" Then
            Call mo_MailClient.AddEmailAddress(ll_IdxEmail, mo_Db.GetFields(ll_Cursor, "U_Email_Armstrong"), etEmailTo)
            lb_EmailAddrExists = True
        End If
        Call mo_Db.Next(ll_Cursor)
    Wend
    
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    
    If lb_EmailAddrExists Then
        ' send message
        Call mo_MailClient.SendEmail(ll_IdxEmail)
    End If
    'mo_MailClient.ClearData        ' JN ??????? I think we should clear it, at least the email beeing sent should be removed from internal structures
    

    Exit Sub
ErrHandler:
    If ll_Cursor <> 0 Then
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
    Call ErrorHandler("SendValidToChangedEmail")
End Sub


