'!Manufacture_Form_Permit:

'!Manufacture_Form_Permit:

'Option Declare
'Option Public
Use "RequestNumber"
Use "lsError"
Use "SelectDataFromMarketing"
Use "ManufactureCommon"


%INCLUDE "x:\proLOG_CheckServer.lss"



Const nline = |
|



'Dim doc_ku As Notesdocument ' КУ, который соответствует текущему документу ПУ


'Dim db_mark As NotesDatabase

'Dim db_start As NotesDatabase













































Dim doc_cred As NotesDocument
Dim doc_client As Notesdocument ' Клиент
Dim doc_provider As NotesDocument ' Поставщик
Dim view_cred As NotesView
Dim doc_ku As NotesDocument
Dim view_pu As NotesView                        ' разрешенные ПУ по UID КУ
Dim view_partner As NotesView
Dim view_contract As NotesView
Dim view_GK As NotesView
Dim doc_group As NotesDocument
Dim doc_comp As NotesDocument
Dim doc_ex As NotesDocument
Dim view_ex As NotesView
Dim checkok As Integer
Dim check As Variant
Dim msg As String
Dim errmsg As String
Dim con_num As String
Dim RequestCauseMessage$, RequestCauseInput$ ' для причины спец. разрешения
Dim sumGross_pu As Single

Sub PermitKU
    If CatchErrors Then On Error Goto catch
    If CheckServer <> 1 Then Exit Sub

    Call UIDoc_cur.Save

    If InitDbAndViews = 0 Then Exit Sub

    ' проверка откуда брать параметры
    Call GetCheck("ControlPermitKU")

' Код экспедитора
    If IsNeedToCheck("ExecutorCode") = 1 Then
        Print "Проверяем код экспедитора"
        If doc_cur.ExecutorCode(0) = "" Then
            Messagebox "Не найден индивидуальный код исполнителя сделки. Обратитесь к администратору."
            Exit Sub
        End If
    End If
' Реквизиты договора
    Call CheckContract(0)
' Статус Клиента
    Call CheckStatus(doc_client, 0)
' Отсрочка платежа
    Call CheckPayDelay("KU", 0)
' Текущий Кредит и Кредитный лимит
    Call CheckCredit(0)
' Финансовые реквизиты
    Call CheckFinInfo(doc_client, 0)
' Тарифное Приложение для Внутренних перевозок
    Call CheckTariffForInner(0)

' Выводим результаты
    If errmsg = "" Then
        ' Разрешаем
        msg = |Сделка разрешена системой | + nline + |Пользователь: | + Session.CommonUserName + nline + "Дата и время: " + Format(Now, "dd.mm.yyyy hh:nn") + nline + msg

        ' Выставляем в документе КУ флаг разрешения КУ (IsPermit)
        doc_cur.IsPermit = "1"
        doc_cur.PermitDate = Now

'       doc_cur.ContractNumber = con_num

        ' Добавляем стоимость КУ < SumGrossBC> к «Локальному» Текущему кредиту в документе Текущего кредита
        doc_cred.LocalCredit = doc_cred.LocalCredit(0) + doc_cur.SumGrossBC(0)
        ' Сохраняем документ Текущего кредита в PostSave формы

        ' Нумеруем документ
        doc_cur.RequestNumber = SetNumber(doc_cur)
        ' проверяем нужна ли связь с Запросом
        If doc_cur.UIDRequestMarketing(0) <> "" Then PopulateMarketingDoc
    Else
        ' запрещаем
        msg = |Сделка запрещена системой.| + nline + |Пользователь: | + Session.CommonUserName + nline + "Дата и время: " + Format(Now, "dd.mm.yyyy hh:nn") + nline + errmsg

        'Выставляем в документе КУ флаг разрешения КУ (IsPermit)
        doc_cur.IsPermit = "-1"
    End If

    'Записываем msg в поле истории разрешения услуги (PermitHistory)
    doc_cur.PermitHistory = msg

    'Call doc_cur.Save(True, True)

    'Call UIDoc_cur.Refresh
    'Call UIDoc_cur.Reload
    'Messagebox msg, 0, "Разрешение исполнения КУ"
    If doc_cur.IsPermit(0) = "1" Then
        Call doc_cur.Save(True, True)
        UpdateAddOpAndAgentAndOwnKU
        ReopenDocument
    Else
        UIDoc_cur.Refresh
        Messagebox msg, 0, "Продолжить заполнение заявки"
    End If
    Exit Sub
catch:
    If Err<>0 Then
        doc_cur.IsPermit = "-1"
        ErrorDlg "Продолжить заполнение заявки"
    End If
    Exit Sub
End Sub
Sub PermitKU_Spec
    If CatchErrors Then On Error Goto catch

    If CheckServer <> 1 Then Exit Sub

    Call UIDoc_cur.Save

    If InitDbAndViews = 0 Then Exit Sub

    ' проверка откуда брать параметры
    Call GetCheck("ControlPermitKU")

' код экспедитора
    If IsNeedToCheck("ExecutorCode") = 1 Then
        Print "Проверяем код экспедитора"
        If doc_cur.ExecutorCode(0) = "" Then
            Messagebox "Не найден индивидуальный код исполнителя сделки. Обратитесь к администратору."
            Exit Sub
        End If
    End If
' Реквизиты договора
    Call CheckContract(1)
' Статус Клиента
    Call CheckStatus(doc_client, 1)
' Отсрочка платежа
    Call CheckPayDelay("KU", 1)
' Текущий Кредит и Кредитный лимит
    Call CheckCredit(1)
' Финансовые реквизиты
    Call CheckFinInfo(doc_client, 1)
' Тарифное Приложение для Внутренних перевозок
    Call CheckTariffForInner(1)
' Сроки отсрочки
'msg = msg & checkPayment

' Выводим запросы и результаты
    If Messagebox("Вы подали запрос на разрешение исполнения Комплексной услуги при следующих условиях: " & nline & msg & nline & nline & "Продолжить?", 4+32, "Разрешение исполнения КУ") <> 6 Then
        Exit Sub
    End If

    If Messagebox("Операцию разрешения исполнения Комплексной услуги будет невозможно отменить. Продолжить?", 4+32, "Разрешение исполнения КУ") <> 6 Then
        Exit Sub
    End If

    ' Запрашиваем причину спец. разрешения сделки
    Call InputRequestCauseInput

    'Выставляем в документе КУ флаг разрешения КУ (IsPermit)
    doc_cur.IsPermit = "1"


    If RequestCauseMessage <> "" Then
        msg = |Заявка разрешена пользователем | & Session.CommonUserName & nline & "Дата и время: " & Format(Now, "dd.mm.yyyy hh:nn") & nline & |Причина специального разрешения сделки: | & RequestCauseInput & nline & msg

        Call SendToRM(RequestCauseMessage, RequestCauseInput)
    Else
        msg = |Заявка разрешена пользователем | & Session.CommonUserName & nline & "Дата и время: " & Format(Now, "dd.mm.yyyy hh:nn") & nline & msg
    End If
    'Записываем msg в поле истории разрешения услуги (PermitHistory)
    doc_cur.PermitHistory = msg

    doc_cur.RequestNumber = SetNumber(doc_cur)

    doc_cur.PermitSpec = "1"    ' флаг спец. разрешения

    ' проверяем нужна ли связь с Запросом
    If doc_cur.UIDRequestMarketing(0) <> "" Then PopulateMarketingDoc


    doc_cur.RequestCauseInput = RequestCauseInput
    doc_cur.RequestCauseMessage = RequestCauseMessage

    doc_cur.PermitDate = Now
    doc_cur.PermitName = Session.CommonUserName

    Call doc_cur.Save(True, True)

    'Добавляем стоимость КУ <SumGrossBC> к «Локальному» Текущему кредиту в документе Текущего кредита
    doc_cred.LocalCredit = doc_cred.LocalCredit(0) + doc_cur.SumGrossBC(0)
    Call doc_cred.save(True, False)

    If doc_cur.IsPermit(0)="1" Then UpdateAddOpAndAgentAndOwnKU


    If doc_cur.Executor(0) = session.UserName Then
        Messagebox msg, 0, "Специальное разрешение заявки клиента"
        ReopenDocument
    Else
        Messagebox msg, 0, "Специальное разрешение заявки клиента"
        doc_cur.SaveOptions="0"
        UIDoc_cur.Close True
    End If


    Exit Sub
catch:
    If Err<>0 Then
        doc_cur.IsPermit = "-1"
        ErrorDlg "Специальное разрешение заявки клиента"
    End If

    Exit Sub
End Sub
Function checkPayment
    If CatchErrors Then On Error Goto catch

    Dim tmpVar As Variant
    Dim db_start As New NotesDatabase("", "")
    Dim view As NotesView

    checkPayment = ""
    tmpVar = Evaluate({
@if(Extension=""; @Return(""); 1);
REM "Получаем настойку для Отсрочки из Старт базы";
extensionTmp :=@DbLookup("":NoCache; srv:db_start; "CompanyByNameF"; CompanyNameF; "ListOfExtensionFilled");

@If(@IsError(extensionTmp); @Return(@Prompt([Ok];"Границы отсрочки: отсрочка не найдена (2)";"Отсрочка \"" + Extension + "\" для " + CompanyName + " не найдена"));@True);

ListOfExtension := @Left(extensionTmp; "^");

indx := @Member(Extension; ListOfExtension);
@If(indx = 0; @Return(@Prompt([Ok]; "Границы отсрочки: отсрочка не найдена (3)"; "Отсрочка \"" + Extension + "\" для " + CompanyName + " не найдена" )); 1);

@If(indx <= @Elements(extensionTmp); @True; @Return(""));

processList := @Explode(extensionTmp[indx]; "^");
PUcheck := @Subset(@Subset(processList; 2); -1);

Rem "проверяем установлена ли просрочка для Подрядчика";
@if(@Contains(PUcheck; "0"); "1"; @Return(""));

processList := @Explode(extensionTmp[indx]; "^");
min_max := @Subset(@Subset(processList; 4); -1);
min_max := min_max + "," + @Subset(@Subset(processList; 5); -1);
min_max}, doc_cur)

    If Not Isarray(tmpVar) Then Exit Function

    If Not Isnumeric(doc_cur.PaymentDelay(0)) Then
        'Messagebox {Необходимо ввести КОРРЕКТНОЕ значение в поле "Количество дней отсрочки платежа"}, 16, ""
        Exit Function
    End If

    If tmpVar(0) = "" Then Exit Function

    tmpVar = Split(tmpVar(0), ",")
    If Isnumeric(tmpVar(0)) Then
        If Not doc_cur.PaymentDelay(0) => Cint(tmpVar(0)) Then
            checkPayment = Chr(10) & {"Количество дней отсрочки платежа" выходят за границы установленные для Компании "} & doc_cur.CompanyName(0) & Chr(10) & {"Количество дней отсрочки платежа" должно быть больше } & tmpVar(0) & { дней.}
            Exit Function
        End If
    End If

    If Isnumeric(tmpVar(1)) Then
        If Not doc_cur.PaymentDelay(0) <= Cint(tmpVar(1)) Then
            checkPayment = Chr(10) & {"Количество дней отсрочки платежа" выходят за границы установленные для Компании "} & doc_cur.CompanyName(0) & Chr(10) & {"Количество дней отсрочки платежа" не должно превышать } & tmpVar(1) & { дней.}
            Exit Function
        End If
    End If

    checkPayment = ""
catch: rethrow
End Function
Function PopulateMarketingDoc()
    If CatchErrors Then On Error Goto catch

    Dim db_mar As NotesDatabase
    Dim mar_doc As NotesDocument
    Dim t As Variant

    PopulateMarketingDoc = True

    Set db_mar=GetDatabaseE(db_cur.server, ex375 + "\Marketing_G.nsf")
    Set mar_doc = GetDocument(db_mar, "RequestByUIDRequest", doc_cur.UIDRequestMarketing(0))
    assert Not mar_doc Is Nothing, "Запрос клиента не найден: " & doc_cur.UIDRequestMarketing(0)

    If mar_doc.LockHolders(0) <> "" Then
        t="Заявка готова к исполнению, но Запрос №" & mar_doc.RequestNumber(0) & _
        " в данный момент редактируется пользователем, и поэтому не будет изменен. Выберите в запросе эту заявку №" _
        & doc_cur.RequestNumber(0) & " вручную."
        Messagebox t, 64, "Отметить запрос клиента"

        doc_cur.PermitHistoryPre=doc_cur.PermitHistoryPre(0) & t & Chr(13)

        PopulateMarketingDoc = False
    End If

    mar_Doc.UIDRequestMnf = doc_cur.UIDRequest(0)
    mar_Doc.RequestMnfNumber = doc_cur.RequestNumber(0)
    mar_Doc.Status8 = "Получена заявка"
    mar_Doc.StatusDate8 = Today
    t = Evaluate({@If (status9 !=""; "9. "+Status9;
                status8 !=""; "8. "+Status8;
                status7 !=""; "7. "+Status7;
                status6 !=""; "6. "+Status6;
                status5 !=""; "5. "+Status5;
                status4 !=""; "4. "+Status4;
                status3 !=""; "3. "+Status3;
                status2 !=""; "2. "+Status2; "1. Новый")}, mar_doc)
    mar_doc.State = t(0)

    mar_Doc.UIDOrder = doc_cur.UIDRequest(0)
    mar_Doc.OrdersList = doc_cur.RequestNumber(0)
    Call mar_doc.save(True, False)

catch:rethrow
End Function
Sub PermitPU
    If CatchErrors Then On Error Goto catch

    If CheckServer <> 1 Then Exit Sub
    Print "Begin2"

    UIDoc_cur.EditMode = True
    Call UIDoc_cur.Save

    If InitDbAndViews = 0 Then
        Exit Sub
    End If

    ' проверка откуда брать параметры
    Call GetCheck("ControlPermitPU")

' Реквизиты договора
    Call CheckContract(0)
' Сатус Поставщика
    Call CheckStatus(doc_provider, 0)

    msg = msg + nline + |Стоимость сделки: | + Cstr(doc_cur.SumNet(0)) + | | + doc_cur.CurrencyNet(0)
    msg = msg + nline + |Стоимость сделки в БВ: | + Format$(doc_cur.SumNetBC(0), "Standard") + | | + doc_cur.CurrencyBC(0)

' Страховка
    Call CheckInsurance(0)
' Отсрочка платежа
    Call CheckPayDelay("PU", 0)
' Рентабельность
    Call CheckRent(0)

' Автоматическое увеличение суммы брутто в КУ
'Krupenin 24/4/07       Call CheckIsMayUpSumGross(0)

' Проверяем, залочена ли КУ
'Krupenin 24/4/07       If IsLockedKU = 1 Then
'Krupenin 24/4/07           Exit Sub
'Krupenin 24/4/07       End If

' Финансовые реквизиты
    Call CheckFinInfo(doc_provider, 0)

    If errmsg = "" Then
        ' Стоимость груза
        Call CheckGoodCost
        msg = |Сделка разрешена системой | + nline + |Пользователь: | + Session.CommonUserName + nline + "Дата и время: " + Format(Now, "dd.mm.yyyy hh:nn") + nline + msg

        'Выставляем в документе ПУ флаг разрешения ПУ (IsPermit)
        doc_cur.IsPermit = "1"
        doc_cur.PermitDate = Now

'       doc_cur.ContractNumber = con_num

        If doc_cur.Form(0) = "SimpleService" Then
            doc_cur.RequestNumber_S = SetNumber(doc_cur)
        End If

        ' Увеличиваем сумму брутто в КУ
'Krupenin 24/4/07       Call UpSumGross

        Call CreateKU ' продолжение сделки
    Else
        ' иначе (errmsg <> “”)
        doc_cur.IsPermit = "-1"
        msg = |Сделка запрещена системой.| + nline + |Пользователь: | + Session.CommonUserName + nline + "Дата и время: " + Format(Now, "dd.mm.yyyy hh:nn") + nline + errmsg
    End If

    'Записываем msg в поле истории разрешения услуги (PermitHistory)
    doc_cur.PermitHistory = msg

    If doc_cur.IsPermit(0) = "1" Then
        Call doc_cur.Save(True, True)
        UpdateAddOpAndAgentPU
        ReopenDocument
    Else
        UIDoc_cur.Refresh
        Messagebox msg, 0, "Продолжить заполнение заявки"
    End If
    Exit Sub

catch:
    If Err<>0 Then
        doc_cur.IsPermit = "-1"
        ErrorDlg "Разрешение заявки поставщику"
    End If
    Exit Sub
End Sub
Sub PermitPU_Spec
    If CatchErrors Then On Error Goto catch

    If CheckServer <> 1 Then Exit Sub

    UIDoc_cur.EditMode = True
    Call UIDoc_cur.Save

    If InitDbAndViews = 0 Then
        Exit Sub
    End If

    ' проверка откуда брать параметры
    Call GetCheck("ControlPermitPU")

' Реквизиты договора
    Call CheckContract(1)
' Статус Поставщика
    Call CheckStatus(doc_provider, 1)

    msg = msg + nline + |Стоимость сделки: | + Cstr(doc_cur.SumNet(0)) + | | + doc_cur.CurrencyNet(0)
    msg = msg + nline + |Стоимость сделки в БВ: | + Format$(doc_cur.SumNetBC(0), "Standard") + | | + doc_cur.CurrencyBC(0)

' Страховка
    Call CheckInsurance(1)
' Отсрочка платежа
    Call CheckPayDelay("PU", 1)
' Рентабельность
    Call CheckRent(1)

' Автоматическое увеличение суммы брутто в КУ
'Krupenin 24/4/07       Call CheckIsMayUpSumGross(1)

' Проверяем, залочена ли КУ
    If IsLockedKU = 1 Then
        Exit Sub
    End If
' Финансовые реквизиты
    Call CheckFinInfo(doc_provider, 1)

    If Messagebox("Вы подали запрос на разрешение исполнения Простой услуги при следующих условиях: " & nline & msg & nline & nline & "Продолжить?", 4+32, "Разрешение исполнения ПУ") <> 6 Then
        Exit Sub
    End If

    If Messagebox("Операцию разрешения исполнения Простой услуги будет невозможно отменить. Продолжить?", 4+32, "Разрешение исполнения ПУ") <> 6 Then
        Exit Sub
    End If

' Запрашиваем причину спец. разрешения сделки
    Call InputRequestCauseInput

' Стоимость груза
    Call CheckGoodCost
' Запись флагов

    If RequestCauseMessage <> "" Then
        msg = |Заявка разрешена пользователем | & Session.CommonUserName & nline & "Дата и время: " & Format(Now, "dd.mm.yyyy hh:nn") & nline & |Причина специального разрешения сделки: | & RequestCauseInput & nline & msg
        Print "Отправляем причину спец. разрешения сделки"
        Call SendToRM(RequestCauseMessage, RequestCauseInput)
    Else
        msg = |Заявка разрешена пользователем | & Session.CommonUserName & nline & "Дата и время: " & Format(Now, "dd.mm.yyyy hh:nn") & nline & msg
    End If

    Print "Записываем флаги"

    'Выставляем в документе КУ флаг разрешения КУ (IsPermit)
    doc_cur.IsPermit = "1"

    'Записываем msg в поле истории разрешения услуги (PermitHistory)
    doc_cur.PermitHistory = msg

    doc_cur.PermitSpec = "1"    ' флаг спец. разрешения

    doc_cur.RequestCauseInput = RequestCauseInput
    doc_cur.RequestCauseMessage = RequestCauseMessage

    'сохраняем дату разрешения
    doc_cur.PermitDate = Now
    'сохраняем имя разрешившего сделку
    doc_cur.PermitName = Session.CommonUserName

    Print "Присваиваем номер"
    If doc_cur.Form(0) = "SimpleService" Or doc_cur.Form(0) = "GoodSbornTransport" Then
        doc_cur.RequestNumber_S = SetNumber(doc_cur)
    End If



'   Call CreateKU ' продолжение сделки

    Print "Сохраняем текущий документ"
    Call doc_cur.Save(True, True)

    If doc_cur.IsPermit(0)="1" Then UpdateAddOpAndAgentPU

    If doc_cur.Executor(0) = session.UserName Then
        Messagebox msg, 0, "Специальное разрешение заявки поставщику"
        ReopenDocument
    Else
        Messagebox msg, 0, "Специальное разрешение заявки поставщику"
        doc_cur.SaveOptions="0"
        UIDoc_cur.Close True
    End If

    Exit Sub
catch:
    If Err<>0 Then
        doc_cur.IsPermit = "-1"
        ErrorDlg "Специальное разрешение заявки поставщику"
    End If
    Exit Sub
End Sub
Function CreateKU As Integer
    ' продолжение сделки из ПУ - создаем КУ в системе "Производство" той Компании, которая является Поставщиком
    If CheckServer <> 1 Then
        Exit Function
    End If

    Dim view_client As NotesView

    Dim col_chief As NotesDocumentCollection ' выбор руководителя отдела
    Dim doc_chief As NotesDocument ' документ отдела

    Dim db_provider As NotesDatabase ' БД Производство, в которой создаем продолжение
    Dim doc_new As NotesDocument ' новый документ КУ
    Dim uidoc_new As NotesUIDocument ' для открытия новой КУ на экран

    CreateKU = 0 ' не продолжили

    ' проверяем является ли данный поставщик компанией группы
    If doc_cur.PartnerCompanyUID(0) = "" Then
    ' Не является компаний группы - выходим
        Exit Function
    End If

    If doc_cur.IsForwarder(0) = "" Then
        ' нет прав на продолжение сделки
        Messagebox "Вы не можете продолжить сделку. Обратитесь к Руководителю отдела экспедирования либо Риск-менеджеру,либо Старшему финансисту"
        Exit Function
    End If

    If InitDbAndViews = 0 Then
        Exit Function
    End If

    'инициализируем представление (среди Клиентов и Поставщиков) отсортированое по UID компании
    Set view_client = db_mark.GetView("(PartnerByUIDCompany)")
    If view_client Is Nothing Then
        Messagebox "Не найден список для поиска Контрагента по Компании. Обратитесь к разработчикам."
        Exit Function
    End If

    ' документ Клиента, которая соответствует текущей Компании
    Set doc_client = view_client.GetDocumentByKey(doc_cur.UIDCompany(0) & "~Client", True)
    If doc_client Is Nothing Then
        Messagebox "Не найден Клиент соответствующий Компании " & doc_cur.CompanyName(0) & ". Обратитесь к администратору."
        Exit Function
    End If

    ' документ Поставщика, который выбран в ПУ
    Set doc_provider = view_client.GetDocumentByKey(doc_cur.PartnerCompanyUID(0) & "~Provider")
    If doc_provider Is Nothing Then
        Messagebox "Не найден Поставщик " & doc_cur.PartnerNameR(0) & ". Обратитесь к администратору."
        Exit Function
    End If

    ' Запрашиваем подтверждение
    If doc_cur.IsContinued(0) = "1" Then
        If Messagebox( "Новый документ КУ был создан ранее. Продолжить создание нового документа КУ?", 32+4, "Подтверждение") <> 6 Then
            Exit Function
        End If
    Else
        If Messagebox( "Продолжить сделку в системе Производство Компании " & doc_provider.CompanyName(0) & "?", 32+4, "Подтверждение") <> 6 Then
            Exit Function
        End If
    End If

    Select Case doc_cur.IsForwarder(0)
    Case "1"
        ' Пользователь является экспедитором в Компании, которой соответствует Поставщик в документе ПУ
        Set db_provider = New NotesDataBase(db_cur.Server, Ex375 + "/" + doc_provider.CompanyNameF(0) + "/Manufacture.nsf")
        If Not db_provider.IsOpen Then
            Messagebox "БД Производство для Компании" & doc_provider.CompanyName(0) & " не найдена или у вас не хватает прав доступа. Обратитесь к администратору."
            Exit Function
        End If

        ' Создаем новый КУ со всеми полями
        Set doc_new = db_provider.CreateDocument
        doc_new.Form = "ClientRequest"
        Call NewKU(doc_new, "")

        ' открываем созданный документ на экран
        Set uidoc_new = ws.EditDocument(True, doc_new)
        CreateKU = 1 ' сделка продолжена
    Case "2"
        'пользователь не является экспедитором в Компании, которой соответствует Поставщик,
        'но является либо Руководителем отдела экспедирования, либо Риск-менеджером,
        'либо Старшим финансистом в текущей системе Производство

        ' выбираем Руководителя отдела экспедирования
        Set col_chief = ws.PickListCollection( 1 , False, db_cur.Server, Ex375 & "/Start.nsf", "ChiefByCompanyUID"_
        , "Выбор руководителя" , "Выберите руководителя отдела, который будет «продолжать» исполнение сделки", _
        doc_cur.PartnerCompanyUID(0))

        Set doc_chief = col_chief.GetFirstDocument

        If doc_chief Is Nothing Then
            ' не выбрали Руководителя
            Exit Function
        End If

        ' Создаем новый КУ со всеми полями
        Set doc_new = db_cur.CreateDocument
        doc_new.Form = "Memo" ' чтобы не отображалось до отпраки ссылки
        Call NewKU(doc_new, doc_chief.DepartmentName(0)) ' передаем название отдела экспедирования для заполнения прав доступа
        doc_new.Executor = doc_chief.ForwarderChief(0)
        doc_new.DepartmentName = doc_chief.DepartmentName(0)
        doc_new.ForwarderChief = doc_chief.ForwarderChief(0)
        doc_new.IsPermit = "-1"

        ' отправляем новый документ КУ в Производство Компании, которая соответствует Поставщику
        Call doc_new.Send(False, "Manufacture_" & doc_provider.CompanyNameF(0))

        Messagebox "Сделка продолжена."
        CreateKU = 1 ' сделка продолжена
    Case Else
        Exit Function
    End Select
    doc_cur.IsContinued = "1" ' запоминаем флаг о том, что продолжили сделку
catch: rethrow
End Function
Sub NewKU(doc_new As NotesDocument, deptName$)
    Dim item_s As NotesItem
    Dim item_d As NotesItem
    Dim i%

    Dim itemAuth As NotesItem
    Dim itemRead As NotesItem
    Dim itemAuthGroup As NotesItem

    doc_new.CompanyNameF = doc_provider.CompanyNameF(0)

    ' поля информация о клиенте - из Клиента, который соответствует текущей Компании
    doc_new.UIDPartner = doc_client.UIDPartner(0)
    doc_new.PartnerNameR = doc_client.PartnerNameR(0)
    doc_new.PartnerAddress = doc_client.Country(0) + ", "+doc_client.City(0) + ", " + doc_client.Street(0)
    doc_new.PartnerFax = doc_client.Fax
    doc_new.PartnerCompanyUID = doc_client.CompanyUID(0)

    ' заполняем БД начала сделки и номер начала сделки
    doc_new.FirstCompanyNameF = Ucase(doc_ku.CompanyNameF(0))
    doc_new.Num_C123 = Mid(doc_ku.RequestNumber(0), 6, 4)
    doc_new.RequestNumberCust = doc_cur.RequestNumber_S(0)

    ' записываем в продолжение сделки UID ПУ, из которого продолжали и идентификатор Компании, из которой продолжали и автора продолжения
    doc_new.UID_StartPU = doc_cur.UIDRequest_S(0)
    doc_new.CompanyNameF_StartPU = doc_cur.CompanyNameF(0)
    doc_new.Author_StartPU = session.CommonUserName
    doc_new.FullOrBrief = doc_cur.FullOrBrief(0)

    ' сумма нетто в ПУ становится суммой брутто для нового КУ
    doc_new.SumGross = doc_cur.SumNet(0)
    doc_new.CurrencyGross = doc_cur.CurrencyNet(0)

    ' копируем поля на второй - предпоследней закладках
    Call ArrayNames ' инициализируем названия полей

    ' погрузка и разгрузка - по 10 групп полей
    Print "Заполняем погрузку и разгрузку..."
    For i = 1 To 10
        Forall iname In LoadUnloadItems
            If i <> 1 Then
                iname = iname & "_" & i
            End If
            Set item_s = doc_ku.GetFirstItem(iname)
            If Not item_s Is Nothing Then
                Set item_d = doc_new.CopyItem( item_s, iname )
            End If
        End Forall
    Next

    ' уникальные поля
    Print "Заполняем остальные поля..."
    Forall iname In InfoItems
        Set item_s = doc_ku.GetFirstItem(iname)
        If Not item_s Is Nothing Then
            Set item_d = doc_new.CopyItem( item_s, iname )
        End If
    End Forall

    ' поля доступа
    Set ItemAuth = New NotesItem( doc_new, "AuthorsList", "[RiskManager]", AUTHORS)
    Call ItemAuth.AppendToTextList("[FinancierChief]")

    Set ItemRead = New NotesItem( doc_new, "ReadersList", "[Financier]",READERS)
    Call ItemRead.AppendToTextList("[Marketolog]")
    Call ItemRead.AppendToTextList("[ForwarderChief]")

    ' делаем доступным для того руководителя отдела, которому посылают ссылку
    If DeptName <> "" Then
        Set ItemAuthGroup = New NotesItem( doc_new, "GroupAuthorsList", _
        "Exped375_"& doc_provider.CompanyNameF(0) & "_" & DeptName & "_ForwarderChief", AUTHORS)
    End If

catch: rethrow
End Sub

Sub SendToRM(RequestCauseMessage$, RequestCauseInput$)
    If CatchErrors Then On Error Goto catch

    Dim doc_memo As NotesDocument
    Dim Body As NotesRichTextItem
    Dim nm_cur As New NotesName(session.UserName)
    Dim nm_to As NotesName
    Dim view_company As NotesView
    Dim doc_company As NotesDocument

    ' проверяем, если только текущий пользователь является и Старшим Риск-менеджером и Директором,

    Set doc_memo = db_cur.CreateDocument

    If doc_cur.Form(0) = "ClientRequest" Then
        ' КУ
        doc_memo.Subject = "Специальное разрешение Заявки Клиента  " & doc_cur.PartnerNameR(0)
    Else
        ' ПУ
        doc_memo.Subject = "Специальное разрешение Заявки Поставщику  " & doc_cur.PartnerNameR(0)
    End If

    Set Body = New NotesRichTextItem(doc_memo, "Body")
    Call body.AppendText("Пользователь " & session.CommonUserName & " разрешил исполнение Заявки при следующих условиях: " & nline & RequestCauseMessage)
    Call body.AddNewLine(2)
    Call body.AppendText("Причина специального разрешения: " & RequestCauseInput)
    Call body.AddNewLine(2)
    Call body.AppendText("Для открытия разрешенной Заявки используйте ссылку -> ")
    Call body.AppendDocLink(doc_cur, "Ссылка на Заявку")

' отправка Старшему Риск-менеджеру
    If doc_group.RiskManagerGK(0) <> "" Then
        Set nm_to = New NotesName(doc_group.RiskManagerGK(0))
        If Ubound(doc_group.RiskManagerGK) > 0 Or nm_to.Abbreviated <> nm_cur.Abbreviated Then
            ' отправляем не себе, либо не только себе
            Call doc_memo.Send(False, doc_group.RiskManagerGK)
        End If
    End If

' отправка Директору
    'инициализируется представление Компаний
    Set view_company = db_start.GetView("CompanyByUID")
    If view_company Is Nothing Then
        Messagebox "Не найдено представление для поиска Компаний. Обратитесь к разработчикам."
        Exit Sub
    End If
    Call view_company.Refresh
    ' инициализируем документ Компании
    Set doc_company = view_company.GetDocumentByKey(doc_cur.UIDCompany(0), True)
    If doc_company Is Nothing Then
        Messagebox "Не найден документ Компании. Обратитесь к администратору."
        Exit Sub
    End If
    If doc_company.Director(0) <> "" Then
        Set nm_to = New NotesName(doc_company.Director(0))
        If Ubound(doc_company.Director) > 0 Or nm_to.Abbreviated <> nm_cur.Abbreviated Then
            ' отправляем не себе, либо не только себе
            Call doc_memo.Send(False, doc_company.Director)
        End If
    End If

catch:rethrow
End Sub
Function IsNeedToCheck(element$) As Integer
    If CatchErrors Then On Error Goto catch

    Dim arresult

    If checkok = 1 Then
        ' нужно проверять все параметры
        IsNeedToCheck = 1 ' нужно проверять
    Else
        ' смотрим, установлен ли нужный флаг в массиве флагов
        arresult = Arraygetindex(check, element)
        If Isnull(arresult) Then
            IsNeedToCheck = 0  ' не нужно проверять
        Else
            IsNeedToCheck = 1  ' нужно проверять
        End If
    End If

catch: rethrow
End Function
Sub GetCheck(FieldName As String)
    If CatchErrors Then On Error Goto catch

    ' смотрим, что нужно проверять при разрешении КУ/ПУ

    checkok = 0 ' берем из настроек

    If doc_ex.CheckControlPermit(0) = "1" Then
        check = doc_ex.GetItemValue(FieldName)
    Elseif doc_comp.CheckControlPermit(0) = "1" Then
        check = doc_comp.GetItemValue(FieldName)
    Else
        checkok = 1 ' проверяем все параметры (не вводили индивидуальные в настройках системы
    End If

catch: rethrow
End Sub
Sub CheckContract(IsSpec%)
    If CatchErrors Then On Error Goto catch

    Dim col_contract As NotesDocumentCollection
    Dim doc_contract As NotesDocument


    If IsNeedToCheck("Contract") = 1 Then
        Print "Проверяем реквизиты договора"

        If IsSpec = 1 Then
        ' спец. разрешение
            errmsg = msg
        End If

        ' находим последние Реквизиты договора
        Set col_contract = view_contract.GetAllDocumentsByKey(doc_cur.UIDContract(0), True)
        Set doc_contract = col_contract.GetFirstDocument

        If doc_contract Is Nothing Then
        ' нет договора
            errmsg = nline + |Наличие договора: Нет|
        Else
        ' проверяем дату окончания договора
            If Cstr(doc_contract.ContractEndDate(0)) = "" Then
                msg = nline + |Наличие договора: дата окончания не указана|
                con_num = doc_contract.ContractNumber(0) + " от " + Cstr(doc_contract.ContractStartDate(0))
            Else
                If Cdat(doc_contract.ContractEndDate(0)) < Today Then
                'Если дата окончания договора наступила, то
                    errmsg = nline + |Наличие договора: просрочен|
                Else
                'Иначе (дата окончания не наступила)
                    msg = nline + |Наличие договора: № | & doc_contract.ContractNumber(0) & | от | & doc_contract.ContractStartDate(0) & | по | & doc_contract.ContractEndDate(0)
                    con_num = doc_contract.ContractNumber(0) + " от " + Cstr(doc_contract.ContractStartDate(0))
                End If
            End If
        End If

        If IsSpec = 1 And Len(errmsg) > Len(msg) Then
        ' спец. разрешение
            msg = errmsg
        End If

    End If

catch: rethrow
End Sub
Sub CheckStatus(doc_partner As NotesDocument, IsSpec%)
    If CatchErrors Then On Error Goto catch

    If IsNeedToCheck("Status") = 1 Then
        Print "Проверяем статус Контрагента"

        If IsSpec = 1 Then
            ' спец. разрешение
            errmsg = msg
        End If

        Select Case doc_partner.Status(0)
        Case "1": msg = msg + nline + |Статус: Активный|
        Case "2": msg = msg + nline + |Статус: Пассивный|
        Case "3":
            msg = msg + nline + |Статус: Запрещенный|
            If IsSpec = 1 Then
                RequestCauseMessage = |Статус: Запрещенный|
            Else
                errmsg = errmsg + nline + |Статус: Запрещенный|
            End If
        Case "4":
            msg = msg + nline + |Статус: Потенциальный|
            If IsSpec = 1 Then
                RequestCauseMessage = |Статус: Потенциальный|
            Else
                errmsg = errmsg + nline + |Статус: Потенциальный|
            End If
        Case "5":
            msg = msg + nline + |Статус: Временно запрещенный|
            If IsSpec = 1 Then
                RequestCauseMessage = |Статус: Временно запрещенный|
            Else
                errmsg = errmsg + nline + |Статус: Временно запрещенный|
            End If
        Case "6": errmsg = errmsg + nline + |Статус: Конкурент|
        End Select

        If IsSpec = 1 And Len(errmsg) > Len(msg) Then
            ' спец. разрешение
            msg = errmsg
        End If

    End If

catch: rethrow
End Sub
Sub CheckPayDelay(KUorPU$, IsSpec%)
    If CatchErrors Then On Error Goto catch

    Dim tmpVar As Variant
    Dim db_start As New NotesDatabase("", "")
    Dim view As NotesView

    If IsNeedToCheck("PaymentDelay") = 1 Then
        If IsSpec = 1 Then
    ' спец. разрешение
            errmsg = msg
        End If

        tmpVar = Evaluate({
@if(Extension=""; @Return(""); 1);
REM "Получаем настойку для Отсрочки из Старт базы";
extensionTmp :=@DbLookup("":NoCache; srv:db_start; "CompanyByNameF"; CompanyNameF; "ListOfExtensionFilled");

@If(@IsError(extensionTmp); @Return(@Prompt([Ok];"Границы отсрочки: отсрочка не найдена (2)";"Отсрочка \"" + Extension + "\" для " + CompanyName + " не найдена"));@True);

ListOfExtension := @Left(extensionTmp; "^");

indx := @Member(Extension; ListOfExtension);
@If(indx = 0; @Return(@Prompt([Ok]; "Границы отсрочки: отсрочка не найдена (3)"; "Отсрочка \"" + Extension + "\" для " + CompanyName + " не найдена" )); 1);

@If(indx <= @Elements(extensionTmp); @True; @Return(""));

processList := @Explode(extensionTmp[indx]; "^");
PUcheck := @Subset(@Subset(processList; 2); -1);

Rem "проверяем установлена ли просрочка для Клиента-Подрядчика";
@if(@Contains(PUcheck; @if("} & KUorPU & {"= "PU";"1";"0")); "1"; @Return(""));

processList := @Explode(extensionTmp[indx]; "^");
min_max := @Subset(@Subset(processList; @if("} & KUorPU & {"= "PU"; 6; 4)); -1);
min_max := min_max + "," + @Subset(@Subset(processList; @if("} & KUorPU & {"= "PU"; 7; 5)); -1);
min_max}, doc_cur)

        If Not Isarray(tmpVar) Then Goto ExitSub

        If tmpVar(0) = "" Then Goto ExitSub

        tmpVar = Split(tmpVar(0), ",")
        If Isnumeric(tmpVar(0)) Then
            If Not doc_cur.PaymentDelay(0) => Cint(tmpVar(0)) Then
                errmsg = errmsg + nline + {"Количество дней отсрочки платежа" выходят за границы установленные для Компании "} & doc_cur.CompanyName(0) & Chr(10) & {"Количество дней отсрочки платежа" должно быть больше } & tmpVar(0) & { дней.}
                Goto ExitSub
            End If
        End If

        If Isnumeric(tmpVar(1)) Then
            If Not doc_cur.PaymentDelay(0) <= Cint(tmpVar(1)) Then
                errmsg = errmsg + nline + {"Количество дней отсрочки платежа" выходят за границы установленные для Компании "} & doc_cur.CompanyName(0) & Chr(10) & {"Количество дней отсрочки платежа" не должно превышать } & tmpVar(1) & { дней.}
                Goto ExitSub
            End If
        End If


ExitSub:
        If IsSpec = 1 And Len(errmsg) > Len(msg) Then
        ' спец. разрешение
            msg = errmsg
        End If
    End If


%REM
'старый код

    Dim PaymentDelay As Single, border As Single

    If IsNeedToCheck("PaymentDelay") = 1 Then
        Print "Проверяем отсрочку платежа"

        If IsSpec = 1 Then
        ' спец. разрешение
            errmsg = msg
        End If

        If KUorPU = "KU" Then
            border = doc_group.DelayMax(0)
            PaymentDelay = doc_cur.PaymentDelay(0)
        Else
            border = - doc_group.DelayMin(0)
            PaymentDelay = - doc_cur.PaymentDelay(0)
        End If

        If PaymentDelay > PaymentDelay Then
            ' Отсрочка в КУ больше DelayMax
            ' Отсрочка в ПУ меньше DelayMin
            errmsg = errmsg + nline + |Отсрочка платежа: | + Cstr(doc_cur.PaymentDelay(0)) + | дней|
        Else
            msg = msg + nline + |Отсрочка платежа: | + Cstr(doc_cur.PaymentDelay(0)) + | дней|
        End If

        If IsSpec = 1 And Len(errmsg) > Len(msg) Then
        ' спец. разрешение
            msg = errmsg
        End If

    End If
%END REM
catch: rethrow
End Sub
Sub CheckCredit(IsSpec%)
    If CatchErrors Then On Error Goto catch

    If IsNeedToCheck("Credit") = 1 Then
        Print "Проверяем текущий кредит"

        If IsSpec = 1 Then
        ' спец. разрешение
            errmsg = msg
        End If

        If Cstr(doc_client.Limit(0)) = "" Then
            errmsg = errmsg + nline + |Кредитный лимит не установлен|
            errmsg = errmsg + nline + |Стоимость сделки: | + Cstr(doc_cur.SumGross(0)) + | | + doc_cur.CurrencyGross(0)
            errmsg = errmsg + nline + |Стоимость сделки в БВ: | + Format$(doc_cur.SumGrossBC(0), "Standard") + | | + doc_cur.CurrencyBC(0)
        Else
            If doc_cred.LocalCredit(0) + doc_cur.SumGrossBC(0) > doc_client.Limit(0) Then
            'если («Локальный» Текущий кредит Клиента)+(SumGrossBC)>(Limit)
                errmsg = errmsg + nline + |Кредитный лимит: | + Cstr(doc_client.Limit(0)) + | | + doc_cur.CurrencyBC(0)
                errmsg = errmsg + nline + |Текущий кредит: | + Cstr(doc_cred.LocalCredit(0)) + | | + doc_cur.CurrencyBC(0)
                errmsg = errmsg + nline + |Стоимость сделки: | + Cstr(doc_cur.SumGross(0)) + | | + doc_cur.CurrencyGross(0)
                errmsg = errmsg + nline + |Стоимость сделки в БВ: | + Format$(doc_cur.SumGrossBC(0), "Standard") + | | + doc_cur.CurrencyBC(0)
            Else
            'иначе ( («Локальный» Текущий кредит Клиента)+(SumFrossBC)>(Limit) )
                msg = msg + nline + |Кредитный лимит: | + Cstr(doc_client.Limit(0)) + | | + doc_cur.CurrencyBC(0)
                msg = msg + nline + |Текущий кредит: | + Cstr(doc_cred.LocalCredit(0)) + | | + doc_cur.CurrencyBC(0)
                msg = msg + nline + |Стоимость сделки: | + Cstr(doc_cur.SumGross(0)) + | | + doc_cur.CurrencyGross(0)
                msg = msg + nline + |Стоимость сделки в БВ: | + Format$(doc_cur.SumGrossBC(0), "Standard") + | | + doc_cur.CurrencyBC(0)
            End If
        End If

        If IsSpec = 1 And Len(errmsg) > Len(msg) Then
        ' спец. разрешение
            msg = errmsg
        End If

    End If

catch: rethrow
End Sub
Function CheckFinInfo(doc_partner As NotesDocument, IsSpec%) As String
    If CatchErrors Then On Error Goto catch

    Dim msg_t$ ' сообщение об ошибке
    Dim fld List As String ' массив полей
    Dim fn$ ' название поля

    If IsNeedToCheck("FinInfo") = 1 Then
        Print "Проверяем фин. реквизиты"

        fld("UNN") = "УНН, ИНН, номер налоговой регистрации"
        fld("OKPO") = "ОКПО"
        fld("BankName_1") = "Наименование банка"
        fld("BankAddress_1") = "Адрес банка"
        fld("BankCode_1") = "Код банка"
        fld("BankSWIFT_1") = "SWIFT code банка"
        fld("AccCurrency_1_1") = "Валюта счета"
        fld("AccAccount_1_1") = "№ счета"

        msg_t = ""
        Forall x In fld
            If Cstr(doc_partner.GetItemValue(Listtag(x))(0)) = "" Then
                If msg_t = "" Then
                    msg_t = nline & "Не заполнены финансовые реквизиты:"
                End If
                msg_t = msg_t & nline & |- | & x
            End If
        End Forall

        If IsSpec = 1 Then
        ' спец. разрешение
            msg = msg & msg_t
        Else
            errmsg = errmsg & msg_t
        End If

    End If
catch: rethrow
End Function
Sub CheckTariffForInner(IsSpec%)
    If CatchErrors Then On Error Goto catch

    If IsNeedToCheck("TariffForInner") = 1 Then

        If IsSpec = 1 Then
        ' спец. разрешение
            errmsg = msg
        End If

        If doc_cur.FullOrBrief(0) = "Internal" Then
            Print "Проверяем Тарифное Приложение для ВП"
            If doc_cur.UIDAppendix(0) = "" Then
                errmsg = errmsg + nline + |Тарифное Приложение не выбрано.|
            Else
                msg = msg + nline + |Тарифное Приложение | & doc_cur.TariffAppendixRoute(0)
            End If
        End If

        If IsSpec = 1 And Len(errmsg) > Len(msg) Then
        ' спец. разрешение
            msg = errmsg
        End If

    End If

catch: rethrow
End Sub
Sub CheckInsurance(IsSpec%)
    If CatchErrors Then On Error Goto catch

    If IsNeedToCheck("Insurance") = 1 Then
        Print "Проверяем страховку"

        If IsSpec = 1 Then
        ' спец. разрешение
            errmsg = msg
        End If

        If Cstr(doc_provider.InsuranceEnd(0))="" Then
            errmsg = errmsg + nline + |Срок действия страховки: не указан|
        Else
            If Cdat(doc_provider.InsuranceEnd(0))<Date Then
            'если Дата окончания страховки Поставщика наступила
                errmsg = errmsg + nline + |Срок действия страховки: | + Format(doc_provider.InsuranceEnd(0), "dd.mm.yyyy")
            Else
            'иначе (Дата окончания страховки Поставщика не наступила)
                msg = msg + nline + |Срок действия страховки: | + Format(doc_provider.InsuranceEnd(0), "dd.mm.yyyy")
            End If
        End If

        If IsSpec = 1 And Len(errmsg) > Len(msg) Then
        ' спец. разрешение
            msg = errmsg
        End If

    End If

catch: rethrow
End Sub
Sub CheckRent(IsSpec%)
    If CatchErrors Then On Error Goto catch

    Dim col_pu As NotesDocumentCollection   ' коллекция разрешенных ПУ для рентабельности
    Dim doc_pu As NotesDocument             ' разрешенная ПУ
    Dim sumNet_pu As Single
    Dim rent As Single

    If doc_cur.Form(0) <> "SimpleService" Then
        Exit Sub
    End If

    If IsNeedToCheck("Rent") = 1 Then
        Print "Проверяем рентабельность сделки"

        If IsSpec = 1 Then
        ' спец. разрешение
            errmsg = msg
        End If

        'rent = ( КУ.SumGrossBC - КУ.SumNetBC - ПУ. SumNetBC ) / КУ.SumGrossBC
        Set col_pu = view_pu.GetAllDocumentsByKey(doc_cur.UIDRequest(0))
        Set doc_pu = col_pu.GetFirstDocument
        sumNet_pu = doc_cur.SumNetBC(0)
        While Not doc_pu Is Nothing
            sumNet_pu = sumNet_pu + doc_pu.SumNetBC(0)
            Set doc_pu = col_pu.GetNextDocument(doc_pu)
        Wend

        If doc_ku.SumGrossBC(0)>0 Then
            rent = 100 * (doc_ku.SumGrossBC(0) - sumNet_pu) / doc_ku.SumGrossBC(0)
        Else
            Print "Рентабельность не может быть рассчитана -- ставка клиента равна 0"
            rent = -100
        End If

        'если rent < Profitability
        If rent < doc_ex.Profitability(0) Then
            errmsg = errmsg + nline + |Рентабельность КУ: | + Format(rent, "Standard")
        Else
            msg = msg + nline + |Рентабельность КУ: | + Format(rent, "Standard")
        End If

        If IsSpec = 1 And Len(errmsg) > Len(msg) Then
        ' спец. разрешение
            msg = errmsg
        End If

    End If

catch: rethrow
End Sub
Sub CheckIsMayUpSumGross(IsSpec%)
    If CatchErrors Then On Error Goto catch

    Dim col_pu As NotesDocumentCollection   ' коллекция разрешенных ПУ для рентабельности
    Dim doc_pu As NotesDocument             ' разрешенная ПУ

    If doc_cur.Form(0) <> "SimpleService" Then
        Exit Sub
    End If

    If doc_cur.OnOff342(0) = "On" Then
        Print "Автоматическое увеличение суммы брутто в КУ"

        If IsSpec = 1 Then
        ' спец. разрешение
            errmsg = msg
        End If

        ' в данный релиз включена функция автоматического увеличения суммы брутто в КУ
        Set col_pu = db_cur.Search({ ( (Form="SimpleService" & IsPermit="1") | Form = "AddOperation" )  & !@IsAvailable($Conflict) & UIDRequest = "} & doc_cur.UIDRequest(0) & {"}, Nothing, 0)
        Set doc_pu = col_pu.GetFirstDocument
        sumGross_pu = doc_cur.SumGrossBC(0)
        While Not doc_pu Is Nothing
            sumGross_pu = sumGross_pu + doc_pu.SumGrossBC(0)
            Set doc_pu = col_pu.GetNextDocument(doc_pu)
        Wend

        If sumGross_pu > doc_ku.SumGrossBC(0) Then
            ' нужно увеличивать сумму брутто в КУ
            If Cstr(doc_client.Limit(0)) = "" Then
                errmsg = errmsg + nline + |Автоматическое увеличение суммы брутто в КУ:|
                errmsg = errmsg + nline & | - Сумма брутто в КУ автоматически увеличивается на: | & (sumGross_pu - doc_ku.SumGrossBC(0)) & | | & doc_cur.CurrencyBC(0)
                errmsg = errmsg + nline + | - Кредитный лимит Клиента: не установлен|
            Else
                If doc_cred.LocalCredit(0) + sumGross_pu - doc_ku.SumGrossBC(0) > doc_client.Limit(0) Then
                    ' превышен кредитный лимит
                    errmsg = errmsg + nline + |Автоматическое увеличение суммы брутто в КУ:|
                    errmsg = errmsg + nline & | - Сумма брутто в КУ автоматически увеличивается на: | & (sumGross_pu - doc_ku.SumGrossBC(0)) & | | & doc_cur.CurrencyBC(0)
                    errmsg = errmsg + nline + | - Кредитный лимит Клиента: | + Cstr(doc_client.Limit(0)) + | | + doc_cur.CurrencyBC(0)
                    errmsg = errmsg + nline + | - Текущий кредит Клиента: | + Cstr(doc_cred.LocalCredit(0)) + | | + doc_cur.CurrencyBC(0)
                Else
                    msg = msg + nline + |Автоматическое увеличение суммы брутто в КУ:|
                    msg = msg + nline & | - Сумма брутто в КУ автоматически увеличивается на: | & (sumGross_pu - doc_ku.SumGrossBC(0)) & | | & doc_cur.CurrencyBC(0)
                    msg = msg + nline + | - Кредитный лимит Клиента: | + Cstr(doc_client.Limit(0)) + | | + doc_cur.CurrencyBC(0)
                    msg = msg + nline + | - Текущий кредит Клиента: | + Cstr(doc_cred.LocalCredit(0)) + | | + doc_cur.CurrencyBC(0)
                End If
            End If

        End If

        If IsSpec = 1 And Len(errmsg) > Len(msg) Then
        ' спец. разрешение
            msg = errmsg
        End If

    End If
catch: rethrow
End Sub
Function IsLockedKU As Integer
    If CatchErrors Then On Error Goto catch

    Dim holders ' для проверки блокировки

    If doc_cur.Form(0) <> "SimpleService" Then
        IsLockedKU = 0 ' НЕ заблокировано
        Exit Function
    End If

    IsLockedKU = 1 ' заблокировано

    If doc_cur.OnOff342(0) = "On" Then
        ' в данный релиз включена функция автоматического увеличения суммы брутто в КУ
        Print "Проверяем, заблокирован ли документ КУ"

        If sumGross_pu > doc_ku.SumGrossBC(0) Then
            ' нужно увеличивать сумму брутто в КУ
            Print "Проверяем блокировку КУ"

            holders = doc_ku.LockHolders
            If holders(0) <> "" Then
                If holders(0) = session.UserName Then
                    Messagebox "Вы заблокировали Заявку Клиента. Закройте Заявку Клиента либо откройте ее в режиме чтения."
                Else
                    Messagebox  "Заявка Клиента заблокирована пользователем " & holders(0)
                End If
                Exit Function
            End If

        End If

    End If

    IsLockedKU = 0 ' НЕ заблокировано

catch: rethrow
End Function
Sub CheckGoodCost
    If CatchErrors Then On Error Goto catch

    Dim doc_memo As NotesDocument
    Dim Body As NotesRichTextItem
    Dim nm_cur As New NotesName(session.UserName)
    Dim nm_to As NotesName

    If doc_cur.Form(0) <> "SimpleService" Then
        Exit Sub
    End If

    If IsNeedToCheck("GoodCost") = 1 Then
        If Cstr(doc_group.GoodCostMax(0)) <> "" And Cstr(doc_ku.GoodCostBC(0)) <> "" Then
            Print "Проверяем стоимость груза"
            If doc_ku.GoodCostBC(0) >= doc_group.GoodCostMax(0) Then
                Print "Отправляем сообщение о большой стоимости груза"
                Set doc_memo = db_cur.CreateDocument

                doc_memo.Subject = "Перевозка дорогого груза Поставщиком <" & doc_cur.PartnerNameR(0) & ">"

                Set Body = New NotesRichTextItem(doc_memo, "Body")
                Call body.AppendText("Пользователь " & session.CommonUserName & " разрешил исполнение Заявки при следующих условиях: ")
                Call body.AddNewLine(1)
                Call body.AppendText("Клиент: " & doc_cur.ClientName(0))
                Call body.AddNewLine(1)
                Call body.AppendText("Поставщик: " & doc_cur.PartnerNameR(0))
                Call body.AddNewLine(1)
                Call body.AppendText("Стоимость груза: " & doc_ku.GoodCostBC(0) & " " & doc_ku.CurrencyBC(0))

                Call body.AddNewLine(2)
                Call body.AppendText("Для открытия разрешенной Заявки используйте ссылку -> ")
                Call body.AppendDocLink(doc_cur, "Ссылка на Заявку")

            ' отправка Руководителю отдела экспедирования
                Set nm_to = New NotesName(doc_cur.DepartmentChief(0))
                If nm_to.Abbreviated <> nm_cur.Abbreviated Then
                    ' отправляем не себе
                    Call doc_memo.Send(False, doc_cur.DepartmentChief(0))
                End If

            ' отправка Риск-менеджеру Компании
                If doc_comp.RiskManager(0) <> "" Then
                    Set nm_to = New NotesName(doc_comp.RiskManager(0))
                    If Ubound(doc_comp.RiskManager) > 0 Or nm_to.Abbreviated <> nm_cur.Abbreviated Then
                        ' отправляем не себе, либо не только себе
                        Call doc_memo.Send(False, doc_comp.RiskManager)
                    End If
                End If

            End If
            msg = msg + nline + |Стоимость груза: | & doc_ku.GoodCostBC(0) & " " & doc_ku.CurrencyBC(0)
        End If
    End If
catch: rethrow
End Sub
Sub UpSumGross
    If CatchErrors Then On Error Goto catch

    If doc_cur.Form(0) <> "SimpleService" Then
        Exit Sub
    End If

    If doc_cur.OnOff342(0) = "On" Then
        ' в данный релиз включена функция автоматического увеличения суммы брутто в КУ
        If sumGross_pu > doc_ku.SumGrossBC(0) Then
            ' нужно увеличивать сумму брутто в КУ

            Print "Увеличиваем сумму брутто в КУ"
            If doc_ku.SumGrossBC(0)<>0 Then doc_ku.SumGross = doc_ku.SumGross(0) * sumGross_pu / doc_ku.SumGrossBC(0)
            doc_ku.SumGrossBC = sumGross_pu

            Print "Обновляем Кредитный лимит"
            doc_cred.LocalCredit = doc_cred.LocalCredit(0) + sumGross_pu - doc_ku.SumGrossBC(0)
            Call doc_cred.Save(True, True)

            Print "Обновляем историю разрешения КУ"
            doc_ku.PermitHistory = doc_ku.PermitHistory(0) & nline & nline & |Автоматическое увеличение суммы брутто:|
            doc_ku.PermitHistory = doc_ku.PermitHistory(0) & nline & | - Дата и время: | & Format(Now, "dd.mm.yyyy hh:nn")
            doc_ku.PermitHistory = doc_ku.PermitHistory(0) & nline & | - Пользователь: | & Session.CommonUserName
            doc_ku.PermitHistory = doc_ku.PermitHistory(0) & nline & | - Причина: разрешение ПУ для Поставщика | & doc_cur.PartnerNameR(0)
            doc_ku.PermitHistory = doc_ku.PermitHistory(0) & nline & | - Сумма брутто увеличена на : | & (sumGross_pu - doc_ku.SumGrossBC(0)) & | | & doc_cur.CurrencyBC(0)

            Print "Сохраняем документ КУ"
            Call doc_ku.Save(True, True)
        End If
    End If

catch: rethrow
End Sub
Sub InputRequestCauseInput
    If CatchErrors Then On Error Goto catch

    If doc_cur.OnOff327(0) <> "On" Then
        ' в данный релиз не включена функция запроса причины спец. разрешения и отправки уведомлений Директору и Старшему Риск-менеджеру
        RequestCauseMessage = ""
    End If

    If RequestCauseMessage <> "" Then
rpt_inp:
        Print "Вводим причину спец. разрешения"
        RequestCauseInput = ws.Prompt( PROMPT_OKCANCELEDIT, "Причина специального разрешения", |Необходимо ввести причину специального разрешения сделки, т.к.| & nline & RequestCauseMessage)

        If Isempty(RequestCauseInput) Then
            Messagebox "Причина специального разрешения сделки не введена. Введите причину!"
            Goto rpt_inp
        End If
        If RequestCauseInput = "" Then
            Messagebox "Причина специального разрешения сделки не введена. Введите причину!"
            Goto rpt_inp
        End If
    End If

catch: rethrow
End Sub
Sub Terminate

End Sub

Sub UpdateAddOpAndAgentAndOwnKU
    If CatchErrors Then On Error Goto catch

    'Функция обновляет название компании и др параметры в подчиненных документах после разрешения заказа.
    'Нужна для корректного содержания в подчиненных документах скопированных заказов

    Dim view_p As NotesView
    Dim col_p As NotesDocumentCollection
    Dim doc_p As NotesDocument

    Set view_p= GetViewE(db_cur, "PUAndAddOpByAndAgentUIDRequestC")

    Set col_p = view_p.GetAllDocumentsByKey(doc_cur.UIDRequest(0), True)
    Set doc_p = col_p.GetFirstDocument
    While Not doc_p Is Nothing

        Select Case doc_p.Form(0)
        Case "SimpleService"
            doc_p.ClientContactName = doc_cur.ContactName(0)
            doc_p.ClientContactPhone = doc_cur.ContactPhone(0)
            doc_p.ClientCountry = doc_cur.PartnerCountry(0)
            doc_p.ClientName = doc_cur.PartnerNameR(0)
            doc_p.UIDClient = doc_cur.UIDPartner(0)

        Case "AddOperation", "OwnService"
            doc_p.UIDClient = doc_cur.UIDPartner(0)
            doc_p.ClientName = doc_cur.PartnerNameR(0)

        Case "AgentPay"
            doc_p.RequestNumber=doc_cur.RequestNumber(0)

            If doc_p.UIDRequest_S(0)="" Then
                doc_p.RequestNumber_CU=doc_cur.RequestNumber(0)
                doc_p.PartnerNameR = doc_cur.PartnerNameR(0)
                doc_p.UIDPartner = doc_cur.UIDPartner(0)
            End If
        End Select

        Call doc_p.Save(True, True)
        Set doc_p = col_p.GetNextDocument(doc_p)
    Wend
catch: rethrow
End Sub

Sub UpdateAddOpAndAgentPU
    If CatchErrors Then On Error Goto catch
    Dim view_p As NotesView
    Dim col_p As NotesDocumentCollection
    Dim doc_p As NotesDocument

    Set view_p= GetViewE(db_cur, "PUAndAddOpByAndAgentUIDRequestC")

    Set col_p = view_p.GetAllDocumentsByKey(doc_cur.UIDRequest_S(0), True)
    Set doc_p = col_p.GetFirstDocument
    While Not doc_p Is Nothing
        Select Case doc_p.Form(0)
        Case "AddOperation"
            doc_p.UIDProvider = doc_cur.UIDPartner(0)
            doc_p.ProviderName = doc_cur.PartnerNameR(0)
            doc_p.RequestNumber_S = doc_cur.RequestNumber_S(0)
        Case "AgentPay"
            doc_p.PartnerNameR = doc_cur.PartnerNameR(0)
            doc_p.UIDPartner = doc_cur.UIDPartner(0)
            doc_p.RequestNumber_S = doc_cur.RequestNumber_S(0)
        End Select

        Call doc_p.Save(True, True)
        Set doc_p = col_p.GetNextDocument(doc_p)
    Wend
catch: rethrow
End Sub

Function InitDbAndViews As Integer
    If CatchErrors Then On Error Goto catch

    InitDbAndViews = 0 ' инициализация не провелась

    Dim view_ku As NotesView
    Dim view_cnf As NotesView

    If doc_cur.Form(0) = "ClientRequest" Then
        ' список для поиска Текущего Кредита
        Set view_cred = db_cur.GetView("CurrentCreditView")
        If view_cred Is Nothing Then
            Messagebox "Не найдено представление с данными о текущем кредите. Обратитесь к разработчикам."
            Exit Function
        End If
'       Call view_cred.Refresh
'       Sleep 1

    ' документ Текущего кредита
'   If doc_cur.Form(0) = "ClientRequest" Then
'       Set doc_cred = view_cred.GetDocumentByKey(doc_cur.UIDPartner(0), True)
'   Elseif doc_cur.Form(0) = "SimpleService" Then
'       Set doc_cred = view_cred.GetDocumentByKey(doc_cur.UIDClient(0), True)
'   End If
'   If doc_cur.Form(0) = "ClientRequest" Or doc_cur.Form(0) = "SimpleService" Then

        Set doc_cred = view_cred.GetDocumentByKey(doc_cur.UIDPartner(0), True)

        If doc_cred Is Nothing Then
            Dim itm_a As NotesItem
            Set doc_cred = db_cur.CreateDocument
            doc_cred.Form = "CurrentCredit"
            doc_cred.UIDPartner = doc_cur.UIDPartner(0)

'           If doc_cur.Form(0) = "ClientRequest" Then
'               doc_cred.UIDPartner = doc_cur.UIDPartner(0)
'           Else
'               doc_cred.UIDPartner = doc_cur.UIDClient(0)
'           End If

            Set itm_a = New NotesItem(doc_cred, "AuthorsList", "*", AUTHORS)
            doc_cred.LocalCredit = 0
            doc_cred.GlobalCredit = 0
            Call doc_cred.save(True, False)
        End If
    End If

    ' список для поиска КУ
    Set view_ku = db_cur.GetView("ClientRequestByUID")
    If view_ku Is Nothing Then
        Messagebox "Не найдено представление с данными о Комплексных услугах. Обратитесь к разработчикам."
        Exit Function
    End If
    Call view_ku.Refresh

    ' документ КУ
    If doc_cur.Form(0) = "ClientRequest" Or doc_cur.Form(0) = "SimpleService" Then
        Set doc_ku = view_ku.GetDocumentByKey(doc_cur.UIDRequest(0), True)
        If doc_ku Is Nothing Then
            Messagebox "Не найден документ КУ."
            Exit Function
        End If
    End If

    ' список для поиска разрешенных ПУ по UID КУ
    Set view_pu = db_cur.GetView("PUByUIDRequest4Finance")
    If view_pu Is Nothing Then
        Messagebox "Не найдено представление с данными о Простых услугах. Обратитесь к разработчикам."
        Exit Function
    End If
'   Call view_pu.Refresh

' БД Маркетинг
'   Set db_mark = New NotesDataBase (db_cur.Server, ex375 & "/Marketing_G.nsf")
'   If Not db_mark.IsOpen Then
'       Messagebox "БД Маркетинг и CRM не найдена. Обратитесь к разработчикам."
'       Exit Function
'   End If

    ' список для поиска контрагентов
    Set view_partner = db_mark.GetView( "PartnerByUID" )
    If view_partner Is Nothing Then
        Messagebox "В БД Маркетинг и CRM не найден вид с Контрагентами. Обратитесь к разработчикам."
        Exit Function
    End If
'   Call view_partner.Refresh

    ' документ Клиента
'   If doc_cur.Form(0) = "ClientRequest" Or doc_cur.Form(0) = "SimpleService" Then
    If doc_cur.Form(0) = "ClientRequest" Then
        If doc_cur.Form(0) = "ClientRequest" Then
            Set doc_client = view_partner.GetDocumentByKey(doc_cur.UIDPartner(0), True)
        Else
            Set doc_client = view_partner.GetDocumentByKey(doc_cur.UIDClient(0), True)
        End If
        If doc_client Is Nothing Then
            Messagebox "Ошибка при получении документа Клиента. Обратитесь к разработчикам."
            Exit Function
        End If
    End If

    ' документ Поставщика
    If doc_cur.Form(0) = "ClientRequest" Then
        Set doc_provider = Nothing ' КУ - Поставщик не нужен
    Else
        Set doc_provider = view_partner.GetDocumentByKey(doc_cur.UIDPartner(0), True)
        If doc_provider Is Nothing Then
            Messagebox "Ошибка при получении документа Поставщика. Обратитесь к разработчикам."
            Exit Function
        End If
    End If

    ' список для поиска Реквизитов договора
    Set view_contract = db_mark.GetView( "ContractByUIDContract" )
    If view_contract Is Nothing Then
        Messagebox "В БД Маркетинг и CRM не найден вид с Контрактами. Обратитесь к разработчикам."
        Exit Function
    End If
'   Call view_contract.Refresh

' БД Старт
    Set db_start = New NotesDataBase (db_cur.Server, ex375 & "\start.nsf")
    If Not db_start.IsOpen Then
        Messagebox "БД Старт не найдена. Обратитесь к разработчикам."
        Exit Function
    End If

    ' список для поиска Группы компаний
    Set view_GK = db_start.GetView("CompanyGroupList")
    If view_GK Is Nothing Then
        Messagebox "Не найдено представление с документом Группы Компаний. Обратитесь к разработчикам."
        Exit Function
    End If
'   Call view_GK.Refresh

    ' документ Группы Компаний
    Set doc_group = view_GK.GetFirstDocument
    If doc_group Is Nothing Then
        Messagebox "Не найден документ с группой компаний. Обратитесь к разработчикам или администраторам."
        Exit Function
    End If

    ' список для поиска документа Компании
    Set view_cnf = db_start.GetView("CompanyByNameF")
    If view_cnf Is Nothing Then
        Messagebox "Не найдено представление с документами Компаний. Обратитесь к разработчикам."
        Exit Function
    End If

    ' документ Компании
    Set doc_comp = view_cnf.GetDocumentByKey(doc_cur.CompanyNameF(0), True)
    If doc_comp Is Nothing Then
        Messagebox "Не найден документ Компании. Обратитесь к администраторам."
        Exit Function
    End If

    ' список для поиска Отдела экспедирования
    Set view_ex = db_start.GetView("DepartmentByUID")
    If view_ex Is Nothing Then
        Messagebox "Не найдено представление сотрудников отделов. Обратитесь к разработчикам."
        Exit Function
    End If

    ' документ Отдела Экспедиторов
    Set doc_ex = view_ex.GetDocumentByKey(doc_cur.UIDDepartment(0), True)
    If doc_ex Is Nothing Then
        Messagebox "Не найден документ сотрудников отделов. Обратитесь к разработчикам."
        Exit Function
    End If

    ' обнуляем глобальные переменные
    msg  = ""
    errmsg = ""
    con_num = ""
    RequestCauseMessage = ""
    RequestCauseInput = ""
    sumGross_pu  = 0

    InitDbAndViews = 1 ' все ок
catch: rethrow
End Function