' 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 |