Сценарий VBS "Выдача номера при открытии карточки"

' v 1.0.0

Const NUMERATOR_ID = "{8851DE5C-3CB9-427B-B4BD-43AC9190E7B6}"

Function DoEvent(UserSession, CardFrame, CardData, ActivateFlags, ModeID, FolderID)

    DoEvent = 2

    Dim NumberText
    NumberText = GetProp(CardData, "Номер запроса", Null)
    If Not (IsNull(NumberText) Or NumberText = vbNullString) Then Exit Function

    Dim Number,  NumberID, Fmt, GotNumber, IsOk
    GotNumber = GetNumber(UserSession, NUMERATOR_ID, Number, NumberID, Fmt)
    If GotNumber Then
        NumberText = FormatStr("{0}", Array( _
            FormatNum("0000", Number))) ', GetDeptCode(UserSession, CardData, NUMERATOR_ID, IsOk)))
        SetProp CardData, "Номер запроса", NumberText, NumberText
    End If

End Function

' Получение кода подразделения
Function GetDeptCode(UserSession, CardData, NumeratorID, IsOk)
    GetDeptCode = vbNullString
    Dim DeptID, Numerators
    If CardData.Type.Alias = "CardOrd" Then
        DeptID = MainInfo(CardData).Value("RecipientDep")
    ElseIf CardData.Type.Alias = "CardOut" Then
        DeptID = MainInfo(CardData).Value("SenderDep")
    ElseIf CardData.Type.Alias = "CardInc" Then
        DeptID = MainInfo(CardData).Value("RecipientDep")
    End If
    If Not IsNull(DeptID) Then
        Set Numerators = Sect(RefNumerators(UserSession), "Numerators")
        Dim Row: Set Row = Nothing
        On Error Resume Next
        Set Row = Numerators.GetRow(NumeratorID)
        On Error GoTo 0
        If Not Row Is Nothing Then
            Dim Depts, DeptRow
            Set Depts = SubSect(Row, "Departments")
            For Each DeptRow In Depts.Rows
                If DeptRow.Value("DepartmentID") = DeptID Then
                    GetDeptCode = DeptRow.Value("NumberSuffix")
                    Exit Function
                End If
            Next
        End If
    End If
    IsOk = True
    If GetDeptCode = vbNullString Then
        MsgBox "Код подразделения не определен", vbOKOnly Or vbExclamation, "Передупреждение"
        IsOk = False
    End If
End Function

' Получение первой буквы фамилии отправителя
Function GetSenderLetter(CardData, IsOk)
    Dim SenderLastName
    SenderLastName = MainInfo(CardData).Value("Sender_LName")
    If IsNull(SenderLastName) Then
        SenderLastName = MainInfo(CardData).Value("SenderName")
    End If
    If IsNull(SenderLastName) Then
        GetSenderLetter = vbNullString
    Else
        GetSenderLetter = Mid(SenderLastName, 1, 1)
    End If
    IsOk = True
    If GetSenderLetter = vbNullString Then
        MsgBox "Не задан отравитель", vbOKOnly Or vbExclamation, "Передупреждение"
        IsOk = False
    End If
End Function

' Дополнить число нулями
Function FormatNum(FmtString, Num)
    Dim S: S = FmtString & Num
    FormatNum = Mid(S, Len(S) - Len(FmtString) + 1)
End Function

' Форматное преобразование строки
Function FormatStr(FmtString, Pars())
    Dim I, Marker
    FormatStr = FmtString
    For I = LBound(Pars) To UBound(Pars)
        Marker = "{" & CStr(I) & "}"
        FormatStr = Replace(FormatStr, Marker, Pars(I))
    Next
End Function

' Получить номер из указанного нумератора и указанной зоны
Function GetNumber(UserSession, NumeratorID, OutNumber, OutNumberID, Fmt)
    Dim Numerators
    Set Numerators = Sect(RefNumerators(UserSession), "Numerators")
    Dim Row: Set Row = Nothing
    On Error Resume Next
    Set Row = Numerators.GetRow(NumeratorID)
    On Error GoTo 0
    If Not Row Is Nothing Then
        Dim Numerator, Zone
        Set Numerator = UserSession.CardManager.Card(Row.Value("NumeratorID"))
        Fmt = Row.Value("NumberFormat")
        Set Zone = Nothing
        On Error Resume Next
        Set Zone = Numerator.Zones.GetByName("Y" & CStr(Year(Date)))
        On Error GoTo 0
        If Not Zone Is Nothing Then
            OutNumber = Zone.GetNumber(StaffObject(UserSession).GetCurrentUserID)
            OutNumberID = Zone.GetNumberID(OutNumber)
            GetNumber = True
            Exit Function
        End If
    End If
    GetNumber = False
End Function

' Получение StaffObject
Function StaffObject(UserSession)
    Set StaffObject = CreateObject("TOHelperObjects.StaffObject")
    Set StaffObject.UserSession = UserSession
End Function

' Универсальный справочник
Function RefUniversal(UserSession)
    Set RefUniversal = UserSession.CardManager.DictionaryData("{B2A438B7-8BB3-4B13-AF6E-F2F8996E148B}")
End Function

' Справочник нумераторов
Function RefNumerators(UserSession)
    Set RefNumerators = UserSession.CardManager.DictionaryData("{D4491E04-F030-4798-BD11-7912C0CA6714}")
End Function


' Получение секции карточки по имени
Function Sect(CardData, Alias)
    Set Sect = CardData.Sections(CardData.Type.AllSections.GetByAlias(Alias).ID)
End Function

' Получение подчиненной секции по имени
Function SubSect(RowData, Alias)
    Set SubSect = RowData.ChildSections(RowData.Section.Type.ChildSections.GetByAlias(Alias).ID)
End Function

' Нулевая строка секции MainInfo
Function MainInfo(CardData)
    Set MainInfo = Sect(CardData, "MainInfo").FirstRow
End Function

' Строка свойства
Function Prop(CardData, Alias)
    Set Prop = Nothing
    Dim Row: For Each Row In Sect(CardData, "Properties").Rows
        If Row.Value("Name") = Alias Then
            Set Prop = Row
            Exit Function
        End If
    Next
End Function

' Получение значения свойства
Function GetProp(CardData, Alias, DefaultValue)
    Dim Row: Set Row = Prop(CardData, Alias)
    If Row Is Nothing Then
        GetProp = DefaultValue
    Else
        GetProp = Row.Value("Value")
        If IsNull(GetProp) Then GetProp = DefaultValue
    End If
End Function

' Установка значения свойства
Sub SetProp(CardData, Alias, Value, DisplayValue)
    Prop(CardData, Alias).Value("Value") = Value
    Prop(CardData, Alias).Value("DisplayValue") = DisplayValue
End Sub