OBJNR
ANLN1
ANLN2
EXTNR
PROZS
PERBZ

*&---------------------------------------------------------------------*
*&      Form  SETTLEMENT_RULE_CREATE_PROCESS
*&---------------------------------------------------------------------*
*       Создание правила расчета для СПП-элемента
*----------------------------------------------------------------------*
FORM settlement_rule_create_process
      USING    ls_prps    TYPE prps
      CHANGING cv_subrc   TYPE sysubrc.

  TYPES:
    BEGIN OF ty_s_cobra_buf.
  INCLUDE               TYPE cobra.
  TYPES: uflag          TYPE dkobr-upd_flag,
  END OF ty_s_cobra_buf.
  TYPES:
    ty_t_cobra_buf      TYPE STANDARD TABLE OF ty_s_cobra_buf.

  TYPES:
    BEGIN OF ty_s_cobrb_buf.
  INCLUDE               TYPE cobrb.
  TYPES: uflag          TYPE dkobr-upd_flag,
  END OF ty_s_cobrb_buf.
  TYPES:
    ty_t_cobrb_buf      TYPE STANDARD TABLE OF ty_s_cobrb_buf .

  DATA:
    ls_objnr            TYPE ionrb,
    lt_objnr            TYPE STANDARD TABLE OF ionrb,
    ls_cobra            TYPE cobra,
    lt_cobra            TYPE STANDARD TABLE OF cobra,
    ls_cobrb            TYPE cobrb,
    lt_cobrb            TYPE STANDARD TABLE OF cobrb,
    ls_cobra_mem        TYPE ty_s_cobra_buf,
    lt_cobra_mem        TYPE ty_t_cobra_buf,
    ls_cobrb_mem        TYPE ty_s_cobrb_buf,
    lt_cobrb_mem        TYPE ty_t_cobrb_buf,
    ls_cobrb_ins        TYPE ty_s_cobrb_buf,
    l_pos               TYPE sytabix.
  CONSTANTS:
    c_uflag_insert      TYPE dkobr-upd_flag VALUE 'I',
    c_uflag_update      TYPE dkobr-upd_flag VALUE 'U',
    c_uflag_delete      TYPE dkobr-upd_flag VALUE 'D'.
  FIELD-SYMBOLS:
    <cobrb_mem>         TYPE ty_s_cobrb_buf.

*-----------------
* ПРЕДВАРИТЕЛЬНО ФОРМИРУЕМ СОЗДАВАЕМУЮ ПОЗИЦИЮ ДЛЯ ПРАВИЛА РАСЧЕТА

  ls_cobrb_ins-uflag = c_uflag_insert.
  ls_cobrb_ins-mandt = sy-mandt.
  ls_cobrb_ins-objnr = ls_prps-objnr.
  ls_cobrb_ins-bureg = '000'.
  ls_cobrb_ins-perbz = 'PER'.  " ПРД
  ls_cobrb_ins-prozs = '100'.
  ls_cobrb_ins-bwaer = 'UED'.
* ls_cobrb_ins-brtyp = '01'.
  ls_cobrb_ins-avorg = 'KOAO'.
  ls_cobrb_ins-konty = 'SK'.
  ls_cobrb_ins-kokrs = ls_prps-pkokr.                       "'2000'.
  ls_cobrb_ins-bukrs = ls_prps-pbukr.                       "'1000'.
  ls_cobrb_ins-urzuo = '001'.
  ls_cobrb_ins-hkont = '0091053104'.
  CONCATENATE ls_cobrb_ins-konty
              ls_cobrb_ins-bukrs
              ls_cobrb_ins-hkont INTO ls_cobrb_ins-rec_objnr1.

*-----------------
* ЗАПОЛНЯЕМ БУФЕР УЖЕ СУЩЕСТВУЮЩИМИ ПОЗИЦИЯМИ ПРАВИЛА РАСЧЕТА

  ls_objnr = ls_prps-objnr.
  APPEND ls_objnr TO lt_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 NE 0.
    MESSAGE ID sy-msgid TYPE 'I' NUMBER sy-msgno
            WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.
    EXIT.
  ENDIF.

  CALL FUNCTION 'K_SETTLEMENT_RULE_GET'
    EXPORTING
      objnr     = ls_prps-objnr
      x_all     = ' '
    TABLES
      e_cobra   = lt_cobra
      e_cobrb   = lt_cobrb
    EXCEPTIONS
      not_found = 1
      OTHERS    = 2.
  IF sy-subrc NE 0.
    MESSAGE ID sy-msgid TYPE 'I' NUMBER sy-msgno
            WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.
    EXIT.
  ENDIF.

*-----------------
* ИЗВЛЕКАЕМ ИЗ БУФЕРА СУЩЕСТВУЮЩЕЕ ПРАВИЛО РАСЧЕТА

  CALL FUNCTION 'K_SRULE_EXPORT_IMPORT'
    EXPORTING
      i_mode     = 'EX'
    EXCEPTIONS
      wrong_mode = 1
      OTHERS     = 2.
  IF sy-subrc NE 0.
    MESSAGE ID sy-msgid TYPE 'I' NUMBER sy-msgno
            WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.
    EXIT.
  ENDIF.

  IMPORT l_mem_cobra TO lt_cobra_mem
         l_mem_cobrb TO lt_cobrb_mem FROM MEMORY ID 'K_SRULE'.

*-----------------
* ВНОСИМ ИЗМЕНЕНИЯ В ПРАВИЛО РАСЧЕТА

* есть ли "использованная" позиция правила расчета?
  LOOP AT lt_cobrb_mem TRANSPORTING NO FIELDS
    WHERE objnr EQ ls_cobrb_ins-objnr
      AND ( NOT letja IS INITIAL OR NOT letpe IS INITIAL )
      AND uflag NE c_uflag_delete.
  ENDLOOP.
  IF sy-subrc EQ 0.
*   "использованная" позиция есть - удаляем остальные позиции
    LOOP AT lt_cobrb_mem ASSIGNING <cobrb_mem>
      WHERE objnr EQ ls_cobrb_ins-objnr
        AND ( letja IS INITIAL AND letpe IS INITIAL )
        AND uflag NE c_uflag_delete.
      IF <cobrb_mem>-uflag EQ c_uflag_insert.
        DELETE lt_cobrb_mem.
      ELSE.
        <cobrb_mem>-uflag = c_uflag_delete.
      ENDIF.
    ENDLOOP.

  ELSE.
*   "использованной" позиции нет,
*   в имеющихся позициях - оставляем только первую позиции (корректируя её, если она отличается от требуемой)
    LOOP AT lt_cobrb_mem ASSIGNING <cobrb_mem>
      WHERE objnr EQ ls_cobrb_ins-objnr
        AND uflag NE c_uflag_delete.

      ADD 1 TO l_pos.

      IF l_pos EQ 1. " -->> первую позицию оставляем (корректируя её, если надо)
        CHECK <cobrb_mem>-konty EQ ls_cobrb_ins-konty
           OR <cobrb_mem>-hkont EQ ls_cobrb_ins-hkont
           OR <cobrb_mem>-prozs EQ ls_cobrb_ins-prozs
           OR <cobrb_mem>-perbz EQ ls_cobrb_ins-perbz
           OR <cobrb_mem>-brtyp EQ ls_cobrb_ins-brtyp
           OR <cobrb_mem>-urzuo EQ ls_cobrb_ins-urzuo
           OR <cobrb_mem>-extnr EQ ls_cobrb_ins-extnr
           OR <cobrb_mem>-betrr EQ ls_cobrb_ins-betrr
           OR <cobrb_mem>-aqzif EQ ls_cobrb_ins-aqzif .

        <cobrb_mem>-konty =  ls_cobrb_ins-konty.
        <cobrb_mem>-hkont =  ls_cobrb_ins-hkont.
        <cobrb_mem>-prozs =  ls_cobrb_ins-prozs.
        <cobrb_mem>-perbz =  ls_cobrb_ins-perbz.
        <cobrb_mem>-brtyp =  ls_cobrb_ins-brtyp.
        <cobrb_mem>-urzuo =  ls_cobrb_ins-urzuo.
        <cobrb_mem>-extnr =  ls_cobrb_ins-extnr.
        <cobrb_mem>-betrr =  ls_cobrb_ins-betrr.
        <cobrb_mem>-aqzif =  ls_cobrb_ins-aqzif.
        IF <cobrb_mem>-uflag NE c_uflag_insert.
          <cobrb_mem>-uflag =  c_uflag_update.
        ENDIF.

      ELSE.       " -->> остальные позиции удаляем
        IF <cobrb_mem>-uflag EQ c_uflag_insert.
          DELETE lt_cobrb_mem.
        ELSE.
          <cobrb_mem>-uflag = c_uflag_delete.
        ENDIF.
      ENDIF.
    ENDLOOP.
    IF sy-subrc NE 0.
*     если вообще нет позиций - создаем позицию
*     порядковый номер создаваемой позиции
      LOOP AT lt_cobrb_mem INTO ls_cobrb_mem ." WHERE uflag NE 'D'.
        CHECK ls_cobrb_mem-lfdnr GT ls_cobrb_ins-lfdnr.
        ls_cobrb_ins-lfdnr = ls_cobrb_mem-lfdnr.
      ENDLOOP.
      ADD 1 TO ls_cobrb_ins-lfdnr.

*     добавляем позицию
      APPEND ls_cobrb_ins TO lt_cobrb_mem.
    ENDIF.
  ENDIF.



**проверка отсутствия в правиле расчета создаваемой позиции
* LOOP AT lt_cobrb_mem TRANSPORTING NO FIELDS
*   WHERE objnr EQ ls_cobrb_ins-objnr
*     AND hkont EQ ls_cobrb_ins-hkont
*     AND uflag NE 'D'.
* ENDLOOP.
*
* CHECK sy-subrc NE 0.
*
**порядковый номер создаваемой позиции
* LOOP AT lt_cobrb_mem INTO ls_cobrb_mem ." WHERE uflag NE 'D'.
*   CHECK ls_cobrb_mem-lfdnr GT ls_cobrb_ins-lfdnr.
*   ls_cobrb_ins-lfdnr = ls_cobrb_mem-lfdnr.
* ENDLOOP.
* ADD 1 TO ls_cobrb_ins-lfdnr.
*
**добавляем позицию
* APPEND ls_cobrb_ins TO lt_cobrb_mem.

*-----------------
* ОТПРАВЛЯЕМ ПРАВИЛО РАСЧЕТА ОБРАТНО В БУФЕР

  CALL FUNCTION 'K_SETTLEMENT_RULE_REFRESH'
    EXPORTING
      objnr = ls_prps-objnr.

  EXPORT l_mem_cobra FROM lt_cobra_mem
         l_mem_cobrb FROM lt_cobrb_mem TO MEMORY ID 'K_SRULE'.

  CALL FUNCTION 'K_SRULE_EXPORT_IMPORT'
    EXPORTING
      i_mode     = 'IM'
    EXCEPTIONS
      wrong_mode = 1
      OTHERS     = 2.
  IF sy-subrc NE 0.
    MESSAGE ID sy-msgid TYPE 'I' NUMBER sy-msgno
            WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.
    EXIT.
  ENDIF.

*-----------------
* СОХРАНЯЕМ ПРАВИЛО РАСЧЕТА
*
* CALL FUNCTION 'K_SETTLEMENT_RULE_SAVE'
*   EXPORTING
*     dialog            = 'X'
*     objnr             = ls_prps-objnr
*     i_status_update   = ' '
*   EXCEPTIONS
*     no_rule_for_objnr = 1
*     OTHERS            = 2.
* IF sy-subrc NE 0.
*   MESSAGE ID SY-MSGID TYPE 'I' NUMBER SY-MSGNO
*           WITH SY-MSGV1 SY-MSGV2 SY-MSGV3 SY-MSGV4.
*   EXIT.
* ENDIF.

ENDFORM. " SETTLEMENT_RULE_CREATE_PROCESS