VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.1#0"; "mscomctl.ocx"
Begin VB.Form frmDPC_PrdSel 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "#Price book selection"
   ClientHeight    =   10995
   ClientLeft      =   -15
   ClientTop       =   375
   ClientWidth     =   15630
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   10995
   ScaleWidth      =   15630
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Tag             =   "frmDPC_PrdSel"
   Visible         =   0   'False
   Begin MSComctlLib.TabStrip tbs_Main 
      Height          =   390
      Left            =   3390
      TabIndex        =   8
      Tag             =   "tbs_Main"
      Top             =   0
      Width           =   12195
      _ExtentX        =   21511
      _ExtentY        =   688
      _Version        =   393216
      BeginProperty Tabs {1EFB6598-857C-11D1-B16A-00C0F0283628} 
         NumTabs         =   2
         BeginProperty Tab1 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "#Standard"
            Key             =   "tab_Standard"
            Object.Tag             =   "tab_Standard"
            ImageVarType    =   2
         EndProperty
         BeginProperty Tab2 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "#Custom"
            Key             =   "tab_Custom"
            Object.Tag             =   "tab_Custom"
            ImageVarType    =   2
         EndProperty
      EndProperty
   End
   Begin VB.PictureBox pct_SelArticle 
      Appearance      =   0  'Flat
      AutoRedraw      =   -1  'True
      BackColor       =   &H80000005&
      ForeColor       =   &H80000008&
      Height          =   6855
      Left            =   9780
      ScaleHeight     =   6825
      ScaleWidth      =   5745
      TabIndex        =   7
      Top             =   3375
      Width           =   5775
   End
   Begin Project1.ArmGrid grd_Product 
      Height          =   2565
      Left            =   3465
      TabIndex        =   6
      Tag             =   "grd_Product"
      Top             =   435
      Width           =   12150
      _ExtentX        =   21431
      _ExtentY        =   4524
   End
   Begin VB.PictureBox pct_SelImage 
      Appearance      =   0  'Flat
      AutoRedraw      =   -1  'True
      BackColor       =   &H80000005&
      ForeColor       =   &H80000008&
      Height          =   6855
      Left            =   3450
      ScaleHeight     =   6825
      ScaleWidth      =   6315
      TabIndex        =   3
      Top             =   3375
      Width           =   6345
   End
   Begin VB.CommandButton btn_Validate 
      Default         =   -1  'True
      Height          =   612
      Left            =   14205
      Style           =   1  'Graphical
      TabIndex        =   2
      Tag             =   "btn_Validate"
      Top             =   10305
      Width           =   612
   End
   Begin VB.CommandButton btn_Quit 
      Height          =   612
      Left            =   14925
      Style           =   1  'Graphical
      TabIndex        =   1
      Tag             =   "btn_Quit"
      Top             =   10305
      Width           =   612
   End
   Begin Project1.ArmTreeView tvw_Main 
      Height          =   10920
      Left            =   60
      TabIndex        =   0
      Top             =   0
      Width           =   3315
      _ExtentX        =   5847
      _ExtentY        =   19262
   End
   Begin VB.Label lbl_SelDesc 
      Caption         =   "#Desc"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   8.25
         Charset         =   238
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   765
      Left            =   3465
      TabIndex        =   5
      Tag             =   "lbl_SelDesc"
      Top             =   10230
      Width           =   10350
      WordWrap        =   -1  'True
   End
   Begin VB.Label lbl_SelName 
      Caption         =   "#Name"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   8.25
         Charset         =   238
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   270
      Left            =   3465
      TabIndex        =   4
      Tag             =   "lbl_SelName"
      Top             =   3105
      Width           =   12060
   End
End
Attribute VB_Name = "frmDPC_PrdSel"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Const CL_COLOR_ENABLED As Long = &H80000005
Private Const CL_COLOR_DISABLED As Long = &H8000000F

Private Const C_ERRORRAISE As Long = 2500
Private Const SEP = "®©"
Private Const C_SEP As String = "@@"
Private Const SEP1 As String = "®"
Private Const SEP2 As String = "©"
Private Const SCREEN_NAME As String = "frmDPC_PrdSel"

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
    SQLFailure = vbObjectError + 6               ' A SQL runtime error has occured : syntax wrong....
    SQLBadRowAffectedCount = vbObjectError + 7   ' A SQL request has not affected the expected rowcount (ex: one Update do nothing)
    SQLBadRowExpectedCount = vbObjectError + 8   ' A SQL request does not return the expected rowcount : select an item return nothing...
    DrivingError = vbObjectError + 9
    CompFncFailed = vbObjectError + 10           ' when component function fail
    GridLoadFailed = vbObjectError + 11          ' load function failed ... bad sql
    QuietException = vbObjectError + 12          ' do not display error message
    SQLTableReferenceConstraint = vbObjectError + 13 ' A SQL request cannot be executed : Table reference constraint
    DuplicityDetected = vbObjectError + 2301     ' detected row with same unique id
End Enum

Public Result As Boolean

#If ENV = LIVE Then
Private mo_Db As Object
Private mo_FSO As Object
#Else
Private mo_Db As ARMSYSCOMLib.ArmDb
Private mo_FSO As FileSystemObject
#End If

Private me_OfferStatus As eOfferStatus
Private ms_DPCImageCachePath As String
Private ml_U_Code As Long
Private ms_Language_Code As String
Private mc_ScreenLabels As Long
Private mb_InternalInit As Boolean
Private mv_TreeviewInfo As Variant

Private mo_Tools As DPC_Tools

Property Let OfferStatus(le_Value As eOfferStatus)
  me_OfferStatus = le_Value
End Property

Property Get OFD_Type() As eDPCPriceBookType
On Error GoTo ErrHandler
 
  If StrComp(tbs_Main.SelectedItem.Key, "tab_Standard", vbTextCompare) = 0 Then
    OFD_Type = eDPCPriceBookType.eStockMetal
  Else
    OFD_Type = eDPCPriceBookType.eCustomMetal
  End If
  Exit Property
ErrHandler:
  Call ErrorHandler("OFD_Type.Get")
End Property

Property Get CAT_Id() As eDPCCategory
On Error GoTo ErrHandler
  
  If grd_Product.SelectedCount = 1 Then
    CAT_Id = grd_Product.SelectedLine(0, "CAT_Id")
  Else
    CAT_Id = eDPCCategory.cgNone
  End If
  Exit Property
ErrHandler:
  Call ErrorHandler("CAT_Id.Get")
End Property

Property Get LEV_Id() As eDPCLevel
On Error GoTo ErrHandler
  
  If grd_Product.SelectedCount = 1 Then
    LEV_Id = grd_Product.SelectedLine(0, "LEV_Id")
  Else
    LEV_Id = eDPCLevel.lvNone
  End If
  Exit Property
ErrHandler:
  Call ErrorHandler("LEV_Id.Get")
End Property

Property Get PRD_Id() As String
On Error GoTo ErrHandler
  
  If grd_Product.SelectedCount = 1 Then
    PRD_Id = grd_Product.SelectedLine(0, "PRD_Id")
  Else
    PRD_Id = ""
  End If
  Exit Property
ErrHandler:
  Call ErrorHandler("PRD_Id.Get")
End Property

Property Get PRD_Code() As String
On Error GoTo ErrHandler
  
  If grd_Product.SelectedCount = 1 Then
    PRD_Code = grd_Product.SelectedLine(0, "PRD_Code")
  Else
    PRD_Code = ""
  End If
  Exit Property
ErrHandler:
  Call ErrorHandler("PRD_Code.Get")
End Property

Property Let Language_Code(AString As String)
  ms_Language_Code = AString
End Property

Property Get Language_Code() As String
  Language_Code = ms_Language_Code
End Property

Public Property Set Tools(ByRef ao_Tools As Object)
On Error GoTo ErrorHandler

  Set mo_Tools = ao_Tools
  Exit Property
ErrorHandler:
  Call ErrorHandler("Tools.Set")
End Property

Public Property Set ArmDb(ByRef lo_Db As Object)
  If Not (lo_Db Is Nothing) Then
      Set mo_Db = lo_Db
  End If
End Property

Property Let U_Code(al_Code As Long)
  ml_U_Code = al_Code
End Property

Public Sub Load_A_COM()
On Error GoTo ErrHandler
  
  mb_InternalInit = True
  
  If mo_Db Is Nothing Then
      Call Err.Raise(ArmErr.PropertyNotSet)
  End If
  If mo_Tools Is Nothing Then
      Call Err.Raise(ArmErr.PropertyNotSet)
  End If
  
  Set mo_FSO = New FileSystemObject
  
  Call mo_Tools.Load_A_ComControls(Me.Controls, mo_Db, ms_Language_Code)

  btn_Validate.Picture = LoadResPicture(RES_OK, 1)
  btn_Quit.Picture = LoadResPicture(RES_QUIT, 1)
  
  ms_DPCImageCachePath = prg.AppCache_Dir & DPC_IMAGE_CACHE
  
  
  tvw_Main.UseImages = True
  Set pct_SelImage.Picture = Nothing
  lbl_SelName.Caption = ""
  lbl_SelDesc.Caption = ""
  
  ReDim la_Columns(15) As Variant
  la_Columns(0) = "PRD_Id" & CH_LDELIMIT & "0" & CH_LDELIMIT & "1" & CH_LDELIMIT & "PRD_Id" & CH_LDELIMIT & ""
  la_Columns(1) = "PRD_Code" & CH_LDELIMIT & "1100" & CH_LDELIMIT & "0" & CH_LDELIMIT & "PRD_Code" & CH_LDELIMIT & "#BP Number"
  la_Columns(2) = "PRD_CodeAMC" & CH_LDELIMIT & "750" & CH_LDELIMIT & "0" & CH_LDELIMIT & "PRD_CodeAMC" & CH_LDELIMIT & "#AMC Code"
  la_Columns(3) = "PRD_Name" & CH_LDELIMIT & "1900" & CH_LDELIMIT & "0" & CH_LDELIMIT & "PRD_Name" & CH_LDELIMIT & "#Name"
  la_Columns(4) = "RPL_ModA" & CH_LDELIMIT & "750" & CH_LDELIMIT & "0" & CH_LDELIMIT & "RPL_ModA" & CH_LDELIMIT & "#Module (L)"
  la_Columns(5) = "RPL_ModB" & CH_LDELIMIT & "750" & CH_LDELIMIT & "0" & CH_LDELIMIT & "RPL_ModB" & CH_LDELIMIT & "#Module (W)"
  la_Columns(6) = "RPL_PanA" & CH_LDELIMIT & "700" & CH_LDELIMIT & "0" & CH_LDELIMIT & "RPL_PanA" & CH_LDELIMIT & "#Panel (L)"
  la_Columns(7) = "RPL_PanB" & CH_LDELIMIT & "700" & CH_LDELIMIT & "0" & CH_LDELIMIT & "RPL_PanB" & CH_LDELIMIT & "#Panel (W)"
  la_Columns(8) = "PRF_Name" & CH_LDELIMIT & "900" & CH_LDELIMIT & "0" & CH_LDELIMIT & "PRF_Name" & CH_LDELIMIT & "#Perforation"
  la_Columns(9) = "IMG_Id" & CH_LDELIMIT & "0" & CH_LDELIMIT & "0" & CH_LDELIMIT & "IMG_Id" & CH_LDELIMIT & ""
  la_Columns(10) = "LEV_Id" & CH_LDELIMIT & "0" & CH_LDELIMIT & "0" & CH_LDELIMIT & "LEV_Id" & CH_LDELIMIT & ""
  la_Columns(11) = "CAT_Id" & CH_LDELIMIT & "0" & CH_LDELIMIT & "0" & CH_LDELIMIT & "CAT_Id" & CH_LDELIMIT & ""
  la_Columns(12) = "IMI_Valid" & CH_LDELIMIT & "0" & CH_LDELIMIT & "0" & CH_LDELIMIT & "IMI_Valid" & CH_LDELIMIT & ""
  la_Columns(13) = "COA_Name" & CH_LDELIMIT & "1800" & CH_LDELIMIT & "0" & CH_LDELIMIT & "COA_Name" & CH_LDELIMIT & "#Coating"
  la_Columns(14) = "GSK_Name" & CH_LDELIMIT & "700" & CH_LDELIMIT & "0" & CH_LDELIMIT & "GSK_Name" & CH_LDELIMIT & "#Gasket"
  la_Columns(15) = "INL_Name" & CH_LDELIMIT & "1500" & CH_LDELIMIT & "0" & CH_LDELIMIT & "INL_Name" & CH_LDELIMIT & "#Inlay"
  Call grd_Product.SetColumns(la_Columns)
  
  Call mo_Tools.PrintMessage(pct_SelImage, DPC_IMAGE_CLICK_MSG)

  'Screen csts
  mc_ScreenLabels = mo_Tools.LoadLabels(mo_Db, Me.Controls, Me, SCREEN_NAME, ms_Language_Code)
  Call mo_Tools.ChangeCharset(Me.Controls, gl_CodePage, gl_CodePage, Me)
  
  If me_OfferStatus = eOfferStatus.osSAPSalesOrderChange Then
    Call tbs_Main.Tabs.Remove("tab_Standard")
  End If
  
  mv_TreeviewInfo = mo_Tools.LoadTreeViewInfo(mo_Db, SCREEN_NAME, "TV1")
  Call LoadTreeView(tvw_Main, mv_TreeviewInfo)
  Call LoadGrid(True)
  
  mb_InternalInit = False
  
  Result = False
  Exit Sub
ErrHandler:
  Call ErrorHandler("Load_A_COM")
End Sub

Public Sub Unload_A_COM()
On Error GoTo ErrHandler

  Call mo_Tools.Unload_A_ComControls(Me.Controls)
  Call mo_Db.Close(mc_ScreenLabels)
  Set mo_Db = Nothing
  Set mo_FSO = Nothing
  Exit Sub
ErrHandler:
  Call ErrorHandler("Unload_A_COM")
End Sub

Private Sub btn_Quit_Click()
On Error GoTo ErrHandler
    
  Result = False
  Hide
  Exit Sub
ErrHandler:
  Call ErrorMessage("btn_Quit_Click")
End Sub

Private Sub btn_Validate_Click()
On Error GoTo ErrHandler
    
  If tvw_Main.SelectedItem Is Nothing Then Exit Sub
  
  Call mo_Tools.LockScreen(Me, True)
  If grd_Product.SelectedCount <> 1 Then
    MsgBox "Please article from grid"
    Call mo_Tools.LockScreen(Me, False)
    Exit Sub
  End If
  Result = True
  Hide
  Call mo_Tools.LockScreen(Me, False)
  Exit Sub
ErrHandler:
  Call ErrorMessage("btn_Validate_Click")
End Sub

Private Sub grd_Product_Click()
On Error GoTo ErrHandler
  
  Call mo_Tools.LockScreen(Me, True)
  If grd_Product.SelectedCount = 0 Then
    Set pct_SelArticle.Picture = Nothing
  Else
    Call mo_Tools.DrawDPCImage(mo_Db, mo_FSO, ms_DPCImageCachePath, grd_Product.SelectedLine(0, "IMG_Id"), pct_SelArticle, , StrComp(grd_Product.SelectedLine(0, "IMI_Valid"), "X", vbTextCompare) = 0)
  End If
  Call mo_Tools.LockScreen(Me, False)
  Exit Sub
ErrHandler:
  Call ErrorMessage("grd_Product_Click")
End Sub

Private Sub grd_Product_ItemSelected()
On Error GoTo ErrHandler
  
  Call btn_Validate_Click
  Exit Sub
ErrHandler:
  Call ErrorMessage("grd_Product_ItemSelected")
End Sub

Private Sub pct_SelImage_Click()
On Error GoTo ErrHandler
    
Dim lo_Frm As frmDPC_ImgSel
Dim lv_SCT_Id As Variant
Dim ls_req As String

  Call mo_Tools.LockScreen(Me, True)
  Set lo_Frm = New frmDPC_ImgSel
  Load lo_Frm
  ls_req = "SELECT SYS.SYS_Id,SYS.IMG_Id,SYSD.SYS_Name,SYSD.SYS_Desc "
  ls_req = ls_req & "FROM DPC_System SYS "
  ls_req = ls_req & "INNER JOIN DPC_SystemDesc SYSD ON (SYSD.SYS_Id=SYS.SYS_Id AND SYSD.Language_Code=$Language_Code$) "
  ls_req = ls_req & "WHERE SYS.Drop_Flag='' "
  ls_req = ls_req & "ORDER BY SYS.SYS_Order"
  lo_Frm.Request = ls_req
  Set lo_Frm.Tools = mo_Tools
  Set lo_Frm.ArmDb = mo_Db
  lo_Frm.Language_Code = ms_Language_Code
  Call lo_Frm.Load_A_COM
  
  Call mo_Tools.LockScreen(Me, False)
  Call mo_Tools.ShowModalForm(lo_Frm)
  Call mo_Tools.LockScreen(Me, True)
  
  If lo_Frm.Result Then
    mb_InternalInit = True
    lv_SCT_Id = mo_Tools.SelectValue(mo_Db, "SELECT SCT_Id FROM DPC_System WHERE SYS_Id=" & lo_Frm.SelectedId)
    Call tvw_Main.Find(lv_SCT_Id, 0, Nothing, 0)
    Call tvw_Main.ExpandNode(tvw_Main.SelectedItem)
    Call tvw_Main.Find(lo_Frm.SelectedId, 0, tvw_Main.SelectedItem, 1)
    mb_InternalInit = False
  End If
  Call lo_Frm.Unload_A_COM
  Unload lo_Frm
  Call mo_Tools.LockScreen(Me, False)
  Exit Sub
ErrHandler:
  Call ErrorMessage("pct_SelImage_Click")
End Sub

Private Sub tvw_Main_NodeClick(ByVal Node As MSComctlLib.Node)
On Error GoTo ErrHandler

Dim ls_Request As String
  
  If Node Is Nothing Then Exit Sub
  

  If mb_InternalInit Then Exit Sub
  If Node Is Nothing Then Exit Sub
  
  Call mo_Tools.LockScreen(Me, True)
  If Node.Tag.ml_Level = 0 Then
    Set pct_SelImage.Picture = Nothing
    Set pct_SelArticle.Picture = Nothing
    Call mo_Tools.PrintMessage(pct_SelImage, DPC_IMAGE_CLICK_MSG)
    lbl_SelName.Caption = ""
    lbl_SelDesc.Caption = ""
    Call grd_Product.ClearGrid
  Else
    Set pct_SelArticle.Picture = Nothing
    Call mo_Tools.DrawDPCImage(mo_Db, mo_FSO, ms_DPCImageCachePath, Node.Tag.GetData(3), pct_SelImage, , StrComp(Node.Tag.GetData(5), "X", vbTextCompare) = 0)
    lbl_SelName.Caption = Node.Text
    lbl_SelDesc.Caption = Node.Tag.GetData(4)
    Call LoadGrid(False)
  End If
  Call mo_Tools.LockScreen(Me, False)
  Exit Sub
ErrHandler:
  Call ErrorMessage("tvw_PriceBook_NodeClick")
End Sub

Private Sub tbs_Main_Click()
On Error GoTo ErrHandler

  If mb_InternalInit Then Exit Sub
  Call mo_Tools.LockScreen(Me, True)
  Call LoadGrid(False)
  Call mo_Tools.LockScreen(Me, False)
  Exit Sub
ErrHandler:
  Call ErrorMessage("tbs_Main_Click")
End Sub


Private Sub LoadTreeView(ByVal ao_Tree As ArmTreeView, ByVal av_TreeviewInfo As Variant)
On Error GoTo ErrHandler

  Dim lv_NodeReq As Variant
  Dim lv_GridReq As Variant
  Dim lv_Images As Variant
  Dim lv_SelectedImages As Variant
  Dim ll_Levels As Long, ll_Idx As Long
  
  lv_NodeReq = av_TreeviewInfo(0)
  lv_GridReq = av_TreeviewInfo(1)
  lv_Images = av_TreeviewInfo(2)
  lv_SelectedImages = av_TreeviewInfo(3)
  
  ll_Levels = UBound(lv_NodeReq) + 1
  If ll_Levels > 0 Then
    ao_Tree.Levels = ll_Levels
    For ll_Idx = 0 To ll_Levels - 1
      lv_NodeReq(ll_Idx) = ReplaceCommonPlaceholders(lv_NodeReq(ll_Idx))
    Next
    ao_Tree.NodeRequests = lv_NodeReq
    ao_Tree.GridRequests = lv_GridReq
    ao_Tree.Images = lv_Images
    ao_Tree.SelectedImages = lv_SelectedImages
    If Not ao_Tree.LoadTree(LoadTypeChildsDemand) Then
      Err.Raise ArmErr.CompFncFailed, "ao_Tree.LoadTree(LoadTypeChildsDemand)", "Tree load failed: " & lv_NodeReq(0)
    End If
  End If
  Exit Sub
ErrHandler:
  Call ErrorHandler("LoadTreeView")
End Sub

Private Sub LoadGrid(ByVal ab_DelayedLoad As Boolean)
On Error GoTo ErrHandler

Dim lv_Requests As Variant

  If tvw_Main.SelectedItem Is Nothing Then
    grd_Product.Visible = False
  Else
    lv_Requests = tvw_Main.SelectedNodeRequest
    If StrComp(tbs_Main.SelectedItem.Key, "tab_Standard", vbTextCompare) = 0 Then
      lv_Requests = Replace(lv_Requests, "$CAT_Id$", mo_Tools.SqlInt(eDPCCategory.cgMetalPanelSKU), , , vbTextCompare)
    ElseIf StrComp(tbs_Main.SelectedItem.Key, "tab_Custom", vbTextCompare) = 0 Then
      lv_Requests = Replace(lv_Requests, "$CAT_Id$", mo_Tools.SqlInt(eDPCCategory.cgMetalCustomPanelTemplate), , , vbTextCompare)
    Else
      Err.Raise ArmErr.InvalidArgument, "tbs_Main", "Unknown tab selected: " & tbs_Main.SelectedItem.Key
    End If
    lv_Requests = ReplaceCommonPlaceholders(lv_Requests)
    If Not grd_Product.Load(lv_Requests, False, , , ab_DelayedLoad) Then
      Err.Raise ArmErr.CompFncFailed, "grd_Product.Load", "Method Load failed: " & lv_Requests
    End If
    grd_Product.Visible = True
  End If
  Exit Sub
ErrHandler:
  Call ErrorHandler("LoadGrid")
End Sub

Private Function ReplaceCommonPlaceholders(ByVal as_Request As String) As String
On Error GoTo ErrHandler

  as_Request = Replace(as_Request, "$Z_Creator$", mo_Tools.SqlInt(ml_U_Code), , , vbTextCompare)
  as_Request = Replace(as_Request, "$U_Code$", mo_Tools.SqlInt(ml_U_Code), , , vbTextCompare)
  as_Request = Replace(as_Request, "$Z_Last_Upd_User$", mo_Tools.SqlInt(ml_U_Code), , , vbTextCompare)
  as_Request = Replace(as_Request, "$Language_Code$", mo_Tools.SQLStr(ms_Language_Code), , , vbTextCompare)
  ReplaceCommonPlaceholders = as_Request
  Exit Function
ErrHandler:
  Call ErrorHandler("ReplaceCommonPlaceholders")
End Function

' display standard error message
Public Sub ErrorMessage(ByVal as_Fct As String)
  Dim ls_ErrSource As String
  Dim ls_errDescription As String
  Dim ls_Message As String
  
  ls_ErrSource = as_Fct & SEP1 & Err.Source
  ls_errDescription = Err.Description
  ls_Message = SCREEN_NAME & " exception. Nr:" & Err.Number & ",Desc: " & ls_errDescription & ",Src:" & ls_ErrSource & "@"
  Call mo_Tools.LogMessage(mo_Db, ml_U_Code, SCREEN_NAME, ls_Message, "E")
  Call MsgBox("Error occured, please contact IT. Application will now shutdown." & vbCrLf & ls_ErrSource & vbCrLf & "Description: " & ls_errDescription, vbCritical, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision)
  End
End Sub

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

