*&---------------------------------------------------------------------*
*&      Form  CreateCalcRules
*&---------------------------------------------------------------------*
*       text
*----------------------------------------------------------------------*
FORM CreateCalcRules .

    data: begin of lt_aufnr occurs 0,
              aufnr like AUFK-AUFNR,
              objnr like AUFK-OBJNR,
          end of lt_aufnr.

    data: lt_objnr like table of IONRB with header line,
          lt_cobra like table of COBRA with header line,
          lt_cobrb like table of COBRB with header line.
*   Типы TY_T_COBRA_BUF, TY_T_COBRB_BUF см. в LKOBSTOP
    data: l_mem_cobra type TY_T_COBRA_BUF with header line,
          l_mem_cobrb type TY_T_COBRB_BUF with header line.

    data: l_lfdnr like COBRB-LFDNR.

    check not gt_srules[] is initial.

    loop at gt_srules.
        move-corresponding gt_srules to lt_aufnr.
        collect lt_aufnr.
    endloop.

    loop at lt_aufnr.
        refresh: lt_objnr.

        call function 'ENQUEUE_ESORDER'
            exporting
                aufnr          = lt_aufnr-aufnr
            exceptions
                foreign_lock   = 1
                system_failure = 2
                others         = 3.

        if sy-subrc <> 0.
            message e007(ZCO) with lt_aufnr-aufnr sy-msgv1
                                                  sy-msgv3 sy-msgv4.

            continue.
        endif.

        lt_objnr-objnr = lt_aufnr-objnr.
        append lt_objnr.
*       Определяем максимальную позицию в правиле расчета
        select max( LFDNR ) into l_lfdnr from COBRB
            where OBJNR = lt_aufnr-objnr.
*       Считываем правила расчета из БД в память
        call function 'K_SRULE_PRE_READ'
            exporting
                i_pflege         = ' '
            tables
                t_sender_objnr   = lt_objnr
            exceptions
                wrong_parameters = 1
                others           = 2.

        if sy-subrc <> 0.
        endif.
*       Заполняем локальные структуры данными правил расчета
        call function 'K_SETTLEMENT_RULE_GET'
            exporting
                objnr     = lt_aufnr-objnr
                x_all     = 'X'
            tables
                e_cobra   = lt_cobra
                e_cobrb   = lt_cobrb
            exceptions
                not_found = 1
                others    = 2.

        if sy-subrc <> 0.
        endif.

        loop at gt_srules where aufnr = lt_aufnr-aufnr.
*           Проверяем, создано ли правило расчета к объекту
            read table lt_cobra with key objnr = gt_srules-objnr.
*           Если нет, то создаем правило расчета
            if sy-subrc <> 0.
                call function 'K_SRULE_CREATE'
                  exporting
                    i_objnr             = gt_srules-objnr
                    i_check_only_local  = ' '
                  importing
                    e_cobra             = lt_cobra
                  exceptions
                    rule_already_exists = 1
                    others              = 2.

                if sy-subrc <> 0.
                    message type sy-msgty number sy-msgno id sy-msgid
                        with sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.

                    continue.
                endif.

                append lt_cobra.
            endif.
*           Ищем позицию правила расчета
            read table lt_cobrb with key objnr = gt_srules-objnr
                                         perbz = gt_srules-perbz
                                         urzuo = gt_srules-urzuo
                                         gabja = gt_srules-gabja
                                         gabpe = gt_srules-gabpe
                                         gbisj = gt_srules-gbisj
                                         gbisp = gt_srules-gbisp
                                         kostl = gt_srules-kostl
                                         konty = gt_srules-konty.
*           Если позиция правила не найдена - создаем новую, иначе
*           модифицируем имеющуюся сумму
            if sy-subrc <> 0.
                add 1 to l_lfdnr.

                lt_cobrb-objnr = gt_srules-objnr.
                lt_cobrb-lfdnr = l_lfdnr.
                lt_cobrb-perbz = gt_srules-perbz.
                lt_cobrb-urzuo = gt_srules-urzuo.
                lt_cobrb-gabja = gt_srules-gabja.
                lt_cobrb-gabpe = gt_srules-gabpe.
                lt_cobrb-gbisj = gt_srules-gbisj.
                lt_cobrb-gbisp = gt_srules-gbisp.
                lt_cobrb-kostl = gt_srules-kostl.
                lt_cobrb-konty = gt_srules-konty.
                lt_cobrb-bukrs = gt_srules-bukrs.
                lt_cobrb-kokrs = gt_srules-kokrs.
                lt_cobrb-betrr = gt_srules-betrr.
                lt_cobrb-bwaer = gt_srules-bwaer.

                concatenate 'KS' lt_cobrb-kokrs lt_cobrb-kostl
                    into lt_cobrb-rec_objnr1.

                append lt_cobrb.
            else.
                add gt_srules-betrr to lt_cobrb-betrr.

                modify lt_cobrb index sy-tabix transporting betrr.
            endif.
        endloop.
*       Заполняем память данными правил расчета
        call function 'K_SRULE_EXPORT_IMPORT'
            exporting
                i_mode = 'EX'.

        import l_mem_cobra l_mem_cobrb from memory id 'K_SRULE'.

        loop at lt_cobra.
            read table l_mem_cobra with key objnr = lt_cobra-objnr.

            if sy-subrc <> 0.
                move-corresponding lt_cobra to l_mem_cobra.
                l_mem_cobra-uflag = 'I'.

                append l_mem_cobra.
            endif.
        endloop.

        loop at lt_cobrb.
            read table l_mem_cobrb with key objnr = lt_cobrb-objnr
                                            bureg = lt_cobrb-bureg
                                            lfdnr = lt_cobrb-lfdnr.

            if sy-subrc <> 0.
                move-corresponding lt_cobrb to l_mem_cobrb.
                l_mem_cobrb-uflag = 'I'.

                append l_mem_cobrb.
            else.
                move-corresponding lt_cobrb to l_mem_cobrb.
                l_mem_cobrb-uflag = 'U'.

                modify l_mem_cobrb index sy-tabix.
            endif.
        endloop.
*       Очистка памяти для объекта
        call function 'K_SETTLEMENT_RULE_REFRESH'
            exporting
                objnr = lt_aufnr-objnr.

        export l_mem_cobra l_mem_cobrb to memory id 'K_SRULE'.

        call function 'K_SRULE_EXPORT_IMPORT'
            exporting
                i_mode = 'IM'.
*       Сохраняем правила расчета
        call function 'K_SETTLEMENT_RULE_SAVE'
            exporting
                dialog            = 'X'
                objnr             = lt_aufnr-objnr
                i_status_update   = ' '
            exceptions
                no_rule_for_objnr = 1
                others            = 2.

        if sy-subrc <> 0.
            message type sy-msgty number sy-msgno id sy-msgid
                with sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.

            continue.
        endif.


        loop at gt_worklist where aufnr = lt_aufnr-aufnr.
            gt_worklist-xdone = 'X'.
            modify gt_worklist.

            message s009(ZCO) with lt_aufnr-aufnr gt_worklist-bukrs
                                                 gt_worklist-belnr gt_worklist-gjahr.
        endloop.

        call function 'DEQUEUE_ESORDER'
          exporting
            aufnr     = lt_aufnr-aufnr
            _synchron = 'X'.

        message s008(ZCO) with lt_aufnr-aufnr.
    endloop.

ENDFORM.                    " CreateCalcRules

* Abrechnungsprofil aus Puffer holen
     CALL FUNCTION 'K_SETTLEMENT_RULE_EXISTENCE'
       EXPORTING
            OBJNR          = 'OMK00000001'
            FLG_LOCAL      = ' '
       IMPORTING
            E_COBRA        = COBRA
       EXCEPTIONS
            RULE_NOT_FOUND = 1
            OTHERS         = 2.