RE合同记账会计凭证

*&---------------------------------------------------------------------*
*& Title            : 不动产转租合同自动出成本                         *
*& Module           : RE                                               *
*& Author           : linxin                                           *
*& Create Date      : 11/11/2008                                       *
*& Program Type     : Report                                           *
*& SAP Release      : 4.6c                                             *
*& Description      : 不动产转租合同自动出成本                         *
*&                                                                     *
*&---------------------------------------------------------------------*
*----------------------------------------------------------------------*
*& 修改记录 :                                                          *
*& 日期        修改人           修改内容                               *
*& 2014/08/04  chenqy           取租赁合同时,排除类型为ZU80的         *
*&---------------------------------------------------------------------*

REPORT  zre_cost01 NO STANDARD PAGE HEADING
                LINE-SIZE 200 LINE-COUNT 30.

TYPE-POOLS: slis.

*-------------------------Table Definition-----------------------------*

TABLES:t001,bkpf,vicncn.

*-------------------------Internal Table Definition--------------------*

DATA: it_sort TYPE slis_t_sortinfo_alv  WITH HEADER LINE.
DATA: fieldcat TYPE slis_t_fieldcat_alv WITH HEADER LINE.
DATA: gs_layout TYPE slis_layout_alv,
      i_events TYPE slis_t_event WITH HEADER LINE.
DATA: g_repid LIKE sy-repid.
DATA: msg(255) TYPE c.
DATA: v_lines TYPE i.

DATA: BEGIN OF i_out1 OCCURS 0,
        type(2) TYPE c,"A U AU
        zzht    LIKE   vicncn-recnnr,
        zlht    LIKE   vicncn-recnnr,
        zzmj    LIKE   vibdmeas-measvalue,"转租面积
        zlmj    LIKE   vibdmeas-measvalue,"租赁面积
        objnr   LIKE   vicncn-objnr,
        condtype LIKE vicdcond-condtype,
        dayfrom TYPE d,
        dayto TYPE d,
        condvalidfrom_zl LIKE vicdcond-condvalidfrom,
        condvalidto_zl LIKE vicdcond-condvalidto,
        gjahr   LIKE   bkpf-gjahr,
        monat   LIKE   bkpf-monat,
        bukrs   LIKE   vicncn-bukrs,
        recntxt LIKE   vicncn-recntxt,
        cost    LIKE   bseg-dmbtr,
      END OF i_out1.

DATA: BEGIN OF i_out2 OCCURS 0,
        type(2) TYPE c,"A U AU
        zzht    LIKE   vicncn-recnnr,
        zlht    LIKE   vicncn-recnnr,
        condtype LIKE vicdcond-condtype,
        dayfrom TYPE d,
        dayto TYPE d,
        condvalidfrom_zl LIKE vicdcond-condvalidfrom,
        condvalidto_zl LIKE vicdcond-condvalidto,
        gjahr   LIKE   bkpf-gjahr,
        monat   LIKE   bkpf-monat,
        bukrs   LIKE   vicncn-bukrs,
        kostl   LIKE   cobrb-kostl,
        recntxt LIKE   vicncn-recntxt,
        cost    LIKE   bseg-dmbtr,
      END OF i_out2.

DATA: BEGIN OF i_out3 OCCURS 0,
        bukrs   LIKE   vicncn-bukrs,
        gjahr   LIKE   bkpf-gjahr,
        monat   LIKE   bkpf-monat,
        zzht    LIKE   vicncn-recnnr,
        recntxt LIKE   vicncn-recntxt,
        kostl   LIKE   cobrb-kostl,
        cost    LIKE   bseg-dmbtr,
      END OF i_out3.
DATA: wa_out LIKE i_out3.
DATA: it_in LIKE i_out3 OCCURS 0 WITH HEADER LINE.

DATA: BEGIN OF i_mon OCCURS 0,"月份
        monat LIKE   bkpf-monat,
      END OF i_mon.

DATA: BEGIN OF i_ym OCCURS 0,"年月
        ym(6) TYPE c,
      END OF i_ym.

DATA: BEGIN OF i_zzht OCCURS 0,"转租合同
        intreno LIKE   vibdro-intreno,
        bukrs   LIKE   vicncn-bukrs,
        recnnr  LIKE   vicncn-recnnr,
        recntxt LIKE   vicncn-recntxt,
        objnr   LIKE   vicncn-objnr,
      END OF i_zzht.

DATA: BEGIN OF i_ass1 OCCURS 0,"Object Assignment  IM
        objnrsrc   LIKE   vibdobjass-objnrsrc,
        objnrtrg   LIKE   vibdobjass-objnrtrg,
      END OF i_ass1.

DATA: BEGIN OF i_ro OCCURS 0,"Rental Object
        intreno LIKE   vibdro-intreno,
        objnr   LIKE   vibdro-objnr,
        bukrs   LIKE   vibdro-bukrs,
        swenr   LIKE   vibdro-swenr,
        sgenr   LIKE   vibdro-sgenr,
      END OF i_ro.

DATA: BEGIN OF i_bd OCCURS 0,"Building
        intreno LIKE vibdbu-intreno,
        objnr LIKE vibdbu-objnr,
        xgetxt  LIKE   vibdbu-xgetxt,
        bukrs   LIKE   vibdbu-bukrs,
        swenr   LIKE   vibdbu-swenr,
        sgenr   LIKE   vibdbu-sgenr,
      END OF i_bd.

DATA: BEGIN OF i_ass2 OCCURS 0,"Object Assignment  IB
        objnrsrc   LIKE   vibdobjass-objnrsrc,
        objnrtrg   LIKE   vibdobjass-objnrtrg,
      END OF i_ass2.

DATA: BEGIN OF i_zlht OCCURS 0,"租赁合同
        intreno LIKE   vicncn-intreno,
        bukrs   LIKE   vicncn-bukrs,
        recnnr  LIKE   vicncn-recnnr,
        recntxt LIKE   vicncn-recntxt,
        objnr   LIKE   vicncn-objnr,
      END OF i_zlht.

DATA: BEGIN OF i_mea1 OCCURS 0,"Measurement 转租合同
        intreno LIKE vibdmeas-intreno,
        validto LIKE vibdmeas-validto,
        validfrom LIKE vibdmeas-validfrom,
        meas    LIKE vibdmeas-meas,
        measvalue   LIKE   vibdmeas-measvalue,
      END OF i_mea1.
DATA: wa_mea1 LIKE STANDARD TABLE OF i_mea1 WITH HEADER LINE.

DATA: BEGIN OF i_mea2 OCCURS 0,"Measurement 租赁合同
        intreno LIKE vibdmeas-intreno,
        validto LIKE vibdmeas-validto,
        validfrom LIKE vibdmeas-validfrom,
        meas    LIKE vibdmeas-meas,
        measvalue   LIKE   vibdmeas-measvalue,
      END OF i_mea2.
DATA: wa_mea2 LIKE STANDARD TABLE OF i_mea2 WITH HEADER LINE.

DATA: BEGIN OF i_cobrb OCCURS 0,"结算规则cobrb
        objnr LIKE cobrb-objnr,
        gabja LIKE cobrb-gabja,
        gabpe LIKE cobrb-gabpe,
        gbisj LIKE cobrb-gbisj,
        gbisp LIKE cobrb-gbisp,
        prozs LIKE cobrb-prozs,"百分比
        perbz LIKE cobrb-perbz,
        bukrs LIKE cobrb-bukrs,
        kostl LIKE cobrb-kostl,
      END OF i_cobrb.

DATA: BEGIN OF i_condzz OCCURS 0,"条件(转租合同)
        intreno LIKE vicdcond-intreno,
        condtype LIKE vicdcond-condtype,
        condvalidfrom LIKE vicdcond-condvalidfrom,
        condvalidto LIKE vicdcond-condvalidto,
      END OF i_condzz.
DATA: wa_condzz LIKE i_condzz.

DATA: BEGIN OF i_condzl OCCURS 0,"条件(租赁合同)
        intreno LIKE vicdcond-intreno,
        condtype LIKE vicdcond-condtype,
        calcrule LIKE vicdcond-calcrule,"fomula
        termnorh LIKE vicdcond-termnorh,"Number of Frequency Term
        termnosr LIKE vicdcond-termnosr,"Number of Sales Term
        condvalidfrom LIKE vicdcond-condvalidfrom,
        condvalidto LIKE vicdcond-condvalidto,
        unitprice LIKE vicdcond-unitprice,
        monthcost LIKE  vicdcond-unitprice,"每月成本
END OF i_condzl.

DATA: BEGIN OF i_vitmrh OCCURS 0,
        intreno LIKE vitmrh-intreno,
        termtype LIKE vitmrh-termtype,
        termno LIKE vitmrh-termno,
        validfrom LIKE vitmrh-validfrom,
        frequency LIKE vitmrh-frequency,
        frequencyunit LIKE vitmrh-frequencyunit,
      END OF i_vitmrh.

DATA: BEGIN OF i_vicdcfpay OCCURS 0,
        intreno LIKE vicdcfpay-intreno,
        dbervon LIKE vicdcfpay-dbervon,
        dberbis LIKE vicdcfpay-dberbis,
        bnwhr LIKE vicdcfpay-bnwhr,
        atage LIKE vicdcfpay-atage,
        condtype LIKE vicdcfpay-condtype,
      END OF i_vicdcfpay.

*reporting rule相关
DATA: BEGIN OF i_visrtmsbrpi OCCURS 0,"Assignment of Reporting Rule to Sales Rule (Grading)
        intreno LIKE visrtmsbrpi-intreno,
        sbtermno LIKE visrtmsbrpi-sbtermno,
        rptermno LIKE visrtmsbrpi-rptermno,
        itemno LIKE visrtmsbrpi-itemno,
        rentpercent LIKE visrtmsbrpi-rentpercent,
      END OF i_visrtmsbrpi.
*
DATA: BEGIN OF i_visrtmrprh OCCURS 0,"Assignment of Frequency Rule to Reporting Rule
        intreno LIKE visrtmrprh-intreno,
        rptermno LIKE visrtmrprh-rptermno,
        rhythmtype LIKE visrtmrprh-rhythmtype,
        frequency LIKE visrtmrprh-frequency,
      END OF i_visrtmrprh.
*
DATA: BEGIN OF i_visrreport OCCURS 0,"Sales Report
        intreno LIKE visrreport-intreno,
        termno LIKE visrreport-termno,
        rhythmtype LIKE visrreport-rhythmtype,
        net_sales LIKE visrreport-net_sales,
        validfrom LIKE visrreport-validfrom,
        validto LIKE visrreport-validto,
        monthcost LIKE visrreport-net_sales,"每月成本
      END OF i_visrreport.

DATA: i_cost LIKE zre_cost01 OCCURS 0 WITH HEADER LINE.
DATA: wa_cost LIKE zre_cost01.

DATA: l_ym(6) TYPE c.
DATA: flag_exit TYPE c.
DATA: l_dbervon LIKE vicdcfpay-dbervon.
DATA: l_dberbis LIKE vicdcfpay-dberbis.
DATA: begin_day LIKE vicdcfpay-dbervon.
DATA: last_day LIKE vicdcfpay-dbervon.
DATA: all_day TYPE i.
DATA: i_status TYPE jstat OCCURS 0.
DATA: lin TYPE i .
DATA: v_tabix LIKE sy-tabix.
DATA: l_tabix LIKE sy-tabix.
DATA: l_monthcost1 LIKE vicdcond-unitprice.
DATA: l_monthcost2 LIKE vicdcond-unitprice.
DATA: l_monthcost3 LIKE vicdcond-unitprice.
DATA: l_monthcost LIKE vicdcond-unitprice.
DATA: day1 LIKE vibdmeas-validto.
DATA: day2 LIKE vibdmeas-validto.
DATA: day TYPE i.
DATA: day_ht TYPE i.
DATA: l_mear LIKE vibdmeas-measvalue.
DATA: v_char TYPE c.
DATA: l_bukrs LIKE bkpf-bukrs.
DATA: l_gjahr LIKE bkpf-gjahr.
DATA: l_monat LIKE bkpf-monat.
DATA: l_recnnr LIKE vicncn-recnnr.
DATA: gjahr LIKE bkpf-gjahr.
DATA: s_monat LIKE bkpf-monat.
DATA: l_ksrq(7) TYPE c.
DATA: v_ksrq(7) TYPE c.
DATA: v_jsrq(7) TYPE c.
DATA: BEGIN OF i_bukrs OCCURS 0,
        bukrs LIKE t001-bukrs,
      END OF i_bukrs.
RANGES: r_bukrs FOR t001-bukrs.

DATA: i_bkpf LIKE bkpf OCCURS 0 WITH HEADER LINE.
DATA: i_bseg LIKE bseg OCCURS 0 WITH HEADER LINE.
DATA: i_bkdf LIKE bkdf OCCURS 0 WITH HEADER LINE.
DATA: i_bsec LIKE bsec OCCURS 0 WITH HEADER LINE.
DATA: i_bsed LIKE bsed OCCURS 0 WITH HEADER LINE.
DATA: i_bset LIKE bset OCCURS 0 WITH HEADER LINE.

*-------------------------Selection Screen-----------------------------*

SELECTION-SCREEN BEGIN OF BLOCK block1 WITH FRAME TITLE text-001.
SELECT-OPTIONS s_bukrs FOR t001-bukrs OBLIGATORY.
SELECT-OPTIONS s_zzht FOR vicncn-recnnr.
SELECT-OPTIONS s_zlht FOR vicncn-recnnr.
PARAMETERS: p_budat LIKE bkpf-budat OBLIGATORY.
PARAMETER p_cs AS CHECKBOX DEFAULT 'X'.
SELECTION-SCREEN END   OF BLOCK block1.

*-------------------------Initialization-------------------------------*
INITIALIZATION.
  p_budat = sy-datum.

AT SELECTION-SCREEN.
  CLEAR i_bukrs.  REFRESH i_bukrs.
  CLEAR r_bukrs.  REFRESH r_bukrs.
  SELECT bukrs FROM t001 INTO CORRESPONDING FIELDS OF TABLE i_bukrs WHERE bukrs IN s_bukrs.
  IF i_bukrs[] IS INITIAL.
    MESSAGE e001(00) WITH '没有此公司代码,请检查输入!'.
  ELSE.
    LOOP AT i_bukrs.
      AUTHORITY-CHECK OBJECT 'F_BKPF_BUK' ID 'BUKRS' FIELD i_bukrs-bukrs.
      IF sy-subrc = 0.
        r_bukrs-sign = 'I'.
        r_bukrs-option = 'EQ'.
        r_bukrs-low = i_bukrs-bukrs.
        APPEND r_bukrs.  CLEAR r_bukrs.
      ENDIF.
    ENDLOOP.
    IF r_bukrs[] IS INITIAL.
      MESSAGE e001(00) WITH '你没有操作此公司的权限!'.
    ENDIF.
  ENDIF.

*--------------------------Start-of-Selection---------------------------*

START-OF-SELECTION.
  CLEAR: gjahr, s_monat.
  gjahr = p_budat+0(4).
  s_monat = p_budat+4(2).
  CLEAR flag_exit.
  PERFORM get_data.
  IF flag_exit = 'X'.
    EXIT.
  ENDIF.
  PERFORM cal_cost.
  IF p_cs = 'X'.
    PERFORM sub_output.
  ENDIF.
  IF p_cs = ''.
    PERFORM process.
  ENDIF.

*&---------------------------------------------------------------------*
*&      Form  get_data
*&---------------------------------------------------------------------*
*       text
*----------------------------------------------------------------------*

FORM get_data.
  DATA:flag(1) TYPE c.
  CLEAR: l_ym, l_dbervon, l_dberbis.
  l_ym+0(4) = gjahr.
  l_ym+4(2) = s_monat.
  l_dbervon+0(6) = l_ym.
  l_dbervon+6(2) = '01'.
  CALL FUNCTION 'BKK_GET_MONTH_LASTDAY'
    EXPORTING
      i_date = l_dbervon
    IMPORTING
      e_date = l_dberbis.

*取转租合同
  CLEAR i_zzht.  REFRESH i_zzht.

**** MODIFY BY lius AT 20111214 FOR 冒香香 BEGIN****
** 新添加的合同类型有‘ZO03’‘ZO04’‘ZO05’‘ZO40’‘ZO50’
*  SELECT intreno bukrs recnnr recntxt objnr INTO CORRESPONDING FIELDS OF TABLE i_zzht
*  FROM vicncn WHERE bukrs IN r_bukrs AND recnnr IN s_zzht AND recntype IN ('ZO01','ZO02').
  SELECT intreno bukrs recnnr recntxt objnr
    INTO CORRESPONDING FIELDS OF TABLE i_zzht
    FROM vicncn
   WHERE bukrs IN r_bukrs
    AND recnnr IN s_zzht
****** MODIFY BY lius AT 20120326 FOR冒香香 BEGIN ****
** 增加新配置的合同类型:‘ZO60’(内部公司间办公区转租合同),‘ZO70’(内部公司间物流转租合同)
*    AND recntype IN ('ZO01','ZO02','ZO03','ZO04','ZO05','ZO40','ZO50').
    AND recntype IN ('ZO01','ZO02','ZO03','ZO04','ZO05','ZO40','ZO50','ZO60','ZO70').
****** MODIFY BY lius AT 20120326 FOR冒香香 END   ****

**** MODIFY BY lius AT 20111214 FOR 冒香香 END  ****

*将锁定的合同去掉
  LOOP AT i_zzht.
    CALL FUNCTION 'STATUS_READ'
      EXPORTING
        objnr            = i_zzht-objnr
        only_active      = 'X'
      TABLES
        status           = i_status
      EXCEPTIONS
        object_not_found = 1
        OTHERS           = 2.

    READ TABLE i_status TRANSPORTING NO FIELDS WITH KEY stat = 'I0119'.   "激活
    IF sy-subrc EQ 0 .
      READ TABLE i_status TRANSPORTING NO FIELDS WITH KEY stat = 'I0064' . "主数据锁定
      IF sy-subrc EQ 0 .
        DELETE i_zzht.
      ELSE.
        READ TABLE i_status TRANSPORTING NO FIELDS WITH KEY stat = 'I0065' . "范围锁定
        IF sy-subrc EQ 0 .
          DELETE i_zzht.
        ENDIF.
      ENDIF.
    ELSE.
      DELETE i_zzht.
    ENDIF.
  ENDLOOP.

  DESCRIBE TABLE i_zzht LINES lin.
  IF lin < 1.
    flag_exit = 'X'.
    WRITE:/10 '无满足条件的转租合同!'.
    EXIT.
  ENDIF.

*取转租合同条件
  SORT i_zzht BY intreno.
  CLEAR i_condzz.  REFRESH i_condzz.
  SELECT intreno condtype  condvalidfrom condvalidto INTO CORRESPONDING FIELDS OF TABLE i_condzz
  FROM vicdcond FOR ALL ENTRIES IN i_zzht WHERE intreno = i_zzht-intreno  AND conddelete = ''.

*判断转租合同是否符合月份条件,去掉不符的,初步过滤
  LOOP AT i_zzht.
    CLEAR flag.
    LOOP AT i_condzz WHERE intreno = i_zzht-intreno.
      IF l_ym >= i_condzz-condvalidfrom+0(6) AND l_ym <= i_condzz-condvalidto+0(6).
        flag = 'X'.
        EXIT.
      ENDIF.
    ENDLOOP.
    IF flag NE 'X'.
      DELETE i_zzht.
    ENDIF.
  ENDLOOP.
  IF i_zzht[] IS INITIAL.
    flag_exit = 'X'.
    WRITE:/10 '无满足年度、月份条件的转租合同!'.
    EXIT.
  ENDIF.

*取Object Assignment  IM
  SORT i_zzht BY objnr.
  CLEAR i_ass1.  REFRESH i_ass1.
  SELECT objnrsrc objnrtrg INTO CORRESPONDING FIELDS OF TABLE i_ass1 FROM vibdobjass
  FOR ALL ENTRIES IN i_zzht WHERE objnrsrc = i_zzht-objnr.
  SORT i_ass1 BY objnrtrg.
  LOOP AT i_ass1.
    IF i_ass1-objnrtrg+0(2) NE 'IM'.
      DELETE i_ass1.
    ENDIF.
  ENDLOOP.
  IF i_ass1[] IS INITIAL.
    flag_exit = 'X'.
    WRITE:/10 '无满足条件的Object Assignment IM!'.
    EXIT.
  ENDIF.

*取Rental Object
  CLEAR i_ro.  REFRESH i_ro.
  SELECT intreno objnr bukrs swenr sgenr INTO CORRESPONDING FIELDS OF TABLE i_ro
  FROM vibdro FOR ALL ENTRIES IN i_ass1 WHERE objnr = i_ass1-objnrtrg.
  IF i_ro[] IS INITIAL.
    flag_exit = 'X'.
    WRITE:/10 '无满足条件的Rental Object!'.
    EXIT.
  ENDIF.
  SORT i_ro BY intreno.

*取转租面积
  CLEAR i_mea1.  REFRESH i_mea1.
  SELECT intreno validto validfrom meas measvalue INTO CORRESPONDING FIELDS OF TABLE i_mea1 FROM vibdmeas
  FOR ALL ENTRIES IN i_ro WHERE intreno = i_ro-intreno AND ( meas = 'Z001' OR meas = 'Z002' ).
  IF i_mea1[] IS INITIAL.
    flag_exit = 'X'.
    WRITE:/10 '无满足条件的转租合同Measurement!'.
    EXIT.
  ELSE.
    CLEAR wa_mea1.  REFRESH wa_mea1.
    wa_mea1[] = i_mea1[].
  ENDIF.
  SORT i_ro BY bukrs swenr swenr.

*取Building
  CLEAR i_bd.  REFRESH i_bd.
  SELECT intreno objnr xgetxt bukrs swenr sgenr INTO CORRESPONDING FIELDS OF TABLE i_bd FROM vibdbu
  FOR ALL ENTRIES IN i_ro WHERE bukrs = i_ro-bukrs AND swenr =  i_ro-swenr AND sgenr = i_ro-sgenr.
  IF i_bd[] IS INITIAL.
    flag_exit = 'X'.
    WRITE:/10 '无满足条件的Building!'.
    EXIT.
  ENDIF.
  SORT i_bd BY intreno.

*取租赁面积
  CLEAR i_mea2.  REFRESH i_mea2.
  SELECT intreno validto validfrom meas measvalue INTO CORRESPONDING FIELDS OF TABLE i_mea2 FROM vibdmeas
  FOR ALL ENTRIES IN i_bd WHERE intreno = i_bd-intreno AND ( meas = 'Z001' OR meas = 'Z002' ).
  IF i_mea2[] IS INITIAL.
    flag_exit = 'X'.
    WRITE:/10 '无满足条件的租赁合同Measurement!'.
    EXIT.
  ELSE.
    CLEAR wa_mea2.  REFRESH wa_mea2.
    wa_mea2[] = i_mea2[].
  ENDIF.
  SORT i_bd BY objnr.

*取Object Assignment  IB
  CLEAR i_ass2.  REFRESH i_ass2.
  SELECT objnrsrc objnrtrg INTO CORRESPONDING FIELDS OF TABLE i_ass2 FROM vibdobjass
  FOR ALL ENTRIES IN i_bd WHERE objnrtrg = i_bd-objnr.
  IF i_ass2[] IS INITIAL.
    flag_exit = 'X'.
    WRITE:/10 '无满足条件的Object Assignment  IB!'.
    EXIT.
  ENDIF.
  SORT i_ass2 BY objnrsrc.

*取租赁合同
  CLEAR i_zlht.  REFRESH i_zlht.
*** MODIFY BY CHENQY AT 20140804 FOR 冒香香 BEGIN ***
* 排除ZU80的合同
  "在根据规则(转租合同中的租赁对象取对应的建筑物,找出建筑物上所建立的合同)取租赁合同时(如下图),剔除合同类型(VICNCN-RECNTYPE)为ZU80的合同;
*  SELECT intreno bukrs recnnr recntxt objnr INTO CORRESPONDING FIELDS OF TABLE i_zlht FROM vicncn
*  FOR ALL ENTRIES IN i_ass2 WHERE objnr = i_ass2-objnrsrc AND recnnr IN s_zlht.
  SELECT intreno bukrs recnnr recntxt objnr
    INTO CORRESPONDING FIELDS OF TABLE i_zlht
    FROM vicncn
    FOR ALL ENTRIES IN i_ass2
    WHERE objnr = i_ass2-objnrsrc
      AND recnnr IN s_zlht
      AND recntype <> 'ZU80'.
*** MODIFY BY CHENQY AT 20140804 FOR 冒香香 END ***

*将锁定的合同去掉
  LOOP AT i_zlht.
    CLEAR i_status[].
    CALL FUNCTION 'STATUS_READ'
      EXPORTING
        objnr            = i_zlht-objnr
        only_active      = 'X'
      TABLES
        status           = i_status
      EXCEPTIONS
        object_not_found = 1
        OTHERS           = 2.
    READ TABLE i_status TRANSPORTING NO FIELDS WITH KEY stat = 'I0119'.   "激活
    IF sy-subrc EQ 0 .
      READ TABLE i_status TRANSPORTING NO FIELDS WITH KEY stat = 'I0064' . "主数据锁定
      IF sy-subrc EQ 0 .
        DELETE i_zlht.
      ELSE.
        READ TABLE i_status TRANSPORTING NO FIELDS WITH KEY stat = 'I0065' . "范围锁定
        IF sy-subrc EQ 0 .
          DELETE i_zlht.
        ENDIF.
      ENDIF.
    ELSE.
      DELETE i_zlht.
    ENDIF.
  ENDLOOP.

  DESCRIBE TABLE i_zlht LINES lin.
  IF lin < 1 .
    flag_exit = 'X'.
    WRITE:/10 '无满足条件的租赁合同!'.
    EXIT.
  ENDIF.
  SORT i_zlht BY objnr.

*取租赁合同结算规则
  CLEAR i_cobrb.  REFRESH i_cobrb.
  SELECT objnr gabja gabpe gbisj gbisp prozs perbz bukrs kostl INTO CORRESPONDING FIELDS OF TABLE i_cobrb
  FROM cobrb FOR ALL ENTRIES IN i_zlht WHERE objnr = i_zlht-objnr.

*取租赁合同条件 fomula
  SORT i_zlht BY intreno.
  CLEAR i_condzl.  REFRESH i_condzl.
  SELECT intreno condtype calcrule termnorh termnosr condvalidfrom condvalidto unitprice
  INTO CORRESPONDING FIELDS OF TABLE i_condzl FROM vicdcond
  FOR ALL ENTRIES IN i_zlht WHERE intreno = i_zlht-intreno AND conddelete = ''.

*取期间天数
  CLEAR i_vicdcfpay.  REFRESH i_vicdcfpay.
  SELECT intreno dbervon dberbis bnwhr atage condtype FROM vicdcfpay INTO CORRESPONDING FIELDS OF TABLE i_vicdcfpay
  FOR ALL ENTRIES IN i_zlht WHERE intreno = i_zlht-intreno
  AND ( ( dbervon <= l_dbervon AND dberbis >= l_dbervon ) OR ( dbervon <= l_dberbis AND dberbis >= l_dberbis ) ).

*Assignment of Reporting Rule to Sales Rule (Grading)
  CLEAR i_visrtmsbrpi.  REFRESH i_visrtmsbrpi.
  SELECT intreno sbtermno rptermno itemno rentpercent INTO CORRESPONDING FIELDS OF TABLE i_visrtmsbrpi
  FROM visrtmsbrpi FOR ALL ENTRIES IN i_zlht WHERE intreno = i_zlht-intreno.

*Assignment of Frequency Rule to Reporting Rule
  CLEAR i_visrtmrprh.  REFRESH i_visrtmrprh.
  SELECT intreno rptermno rhythmtype frequency INTO CORRESPONDING FIELDS OF TABLE i_visrtmrprh
  FROM visrtmrprh FOR ALL ENTRIES IN i_zlht WHERE intreno = i_zlht-intreno.

*Sales Report
  CLEAR i_visrreport.  REFRESH i_visrreport.
  SELECT intreno termno rhythmtype net_sales validfrom validto FROM visrreport
  INTO CORRESPONDING FIELDS OF TABLE i_visrreport
  FOR ALL ENTRIES IN i_zlht WHERE intreno = i_zlht-intreno.
ENDFORM.                    "GET_DATA

*&---------------------------------------------------------------------*
*&      Form  cal_cost
*&---------------------------------------------------------------------*
*       text
*----------------------------------------------------------------------*
FORM cal_cost.
  DATA:flag(1) TYPE c.
*U 计算月成本
  SORT i_visrtmsbrpi BY intreno rptermno.
  LOOP AT i_visrreport.
    READ TABLE i_visrtmsbrpi WITH KEY intreno = i_visrreport-intreno rptermno = i_visrreport-termno.
    IF sy-subrc EQ 0.
      i_visrreport-monthcost = i_visrreport-net_sales * i_visrtmsbrpi-rentpercent / 100.
    ENDIF.
    MODIFY i_visrreport.
  ENDLOOP.
*A 计算月成本
  SORT i_vicdcfpay BY intreno.
  LOOP AT i_condzl WHERE calcrule = 'A'.
    CLEAR l_monthcost.
    IF i_condzl-condvalidfrom+0(6) <= l_ym AND i_condzl-condvalidto+0(6) >= l_ym.
      LOOP AT i_vicdcfpay WHERE intreno = i_condzl-intreno AND condtype = i_condzl-condtype.
        CLEAR: begin_day, last_day, all_day, l_monthcost1, l_monthcost2, l_monthcost3.
        IF i_vicdcfpay-dbervon >= i_condzl-condvalidfrom AND i_vicdcfpay-dberbis <= i_condzl-condvalidto.
          IF i_vicdcfpay-atage <> 0.
            IF l_ym = i_vicdcfpay-dbervon+0(6) AND l_ym < i_vicdcfpay-dberbis+0(6).
              begin_day = i_vicdcfpay-dbervon.
              CALL FUNCTION 'BKK_GET_MONTH_LASTDAY'
                EXPORTING
                  i_date = begin_day
                IMPORTING
                  e_date = last_day.
              all_day = last_day - begin_day + 1.
              l_monthcost1 = i_vicdcfpay-bnwhr * all_day / i_vicdcfpay-atage.
              l_monthcost = l_monthcost + l_monthcost1.
            ELSEIF l_ym = i_vicdcfpay-dberbis+0(6) AND l_ym >= i_vicdcfpay-dbervon+0(6).
              begin_day+0(6) = l_ym.
              begin_day+6(2) = '01'.
              last_day = i_vicdcfpay-dberbis.
              all_day = last_day - begin_day + 1.
              l_monthcost2 = i_vicdcfpay-bnwhr * all_day / i_vicdcfpay-atage.
              l_monthcost = l_monthcost + l_monthcost2.
            ELSEIF l_ym > i_vicdcfpay-dbervon+0(6) AND l_ym < i_vicdcfpay-dberbis+0(6).
              begin_day+0(6) = l_ym.
              begin_day+6(2) = '01'.
              CALL FUNCTION 'BKK_GET_MONTH_LASTDAY'
                EXPORTING
                  i_date = begin_day
                IMPORTING
                  e_date = last_day.
              all_day = last_day - begin_day + 1.
              l_monthcost3 = i_vicdcfpay-bnwhr * all_day / i_vicdcfpay-atage.
              l_monthcost = l_monthcost + l_monthcost3.
            ENDIF.
          ENDIF.
        ENDIF.
      ENDLOOP.
    ENDIF.
    i_condzl-monthcost = l_monthcost.
    MODIFY i_condzl.
  ENDLOOP.

*计算每个合同的成本(分月)
*计算类别有A U AU 3类
*这里,假定condtionvalidfrom 和condtionvalidto 不会是同一年月的
  DATA:l_ac TYPE i.
  DATA:l_uc TYPE i.
  DATA:lastd TYPE d.
  DATA:days TYPE i.
  DATA:daym TYPE i."月份的天数
  DATA:daycost LIKE vicdcond-unitprice.
  DATA:dayfrom TYPE d.
  DATA:dayto TYPE d.
  SORT i_ass1 BY objnrsrc.
  SORT i_ro BY objnr.
  SORT i_bd BY bukrs swenr sgenr.
  SORT i_ass2 BY objnrtrg.
  SORT i_zlht BY objnr.
  SORT i_condzz BY intreno condvalidfrom.
  SORT i_condzl BY intreno condvalidfrom.
  SORT i_mea1 BY intreno.
  SORT wa_mea1 BY intreno validfrom.
  SORT i_mea2 BY intreno.
  SORT wa_mea2 BY intreno validfrom.
  SORT i_visrtmsbrpi BY intreno sbtermno.
  SORT i_visrreport BY intreno termno validfrom validto.
  SORT i_visrtmrprh BY intreno rptermno rhythmtype.

  LOOP AT i_zzht.
    CLEAR i_out1.
*计算 dayfrom,dayto
    CLEAR:dayfrom,dayto.
    SORT i_condzz BY condvalidfrom.
    LOOP AT i_condzz WHERE intreno = i_zzht-intreno.
      CLEAR: v_tabix, l_tabix, wa_condzz.
      v_tabix = sy-tabix.
      l_tabix = v_tabix + 1.
      IF i_condzz-condvalidfrom+0(6) = l_ym AND l_ym < i_condzz-condvalidto+0(6).
        IF dayfrom IS INITIAL.
          dayfrom = i_condzz-condvalidfrom.
        ENDIF.
        IF dayto IS INITIAL.
          dayto = i_condzz-condvalidto.
        ENDIF.
        READ TABLE i_condzz INTO wa_condzz INDEX l_tabix.
        IF sy-subrc = 0.
          IF i_condzz-condvalidto+0(6) = wa_condzz-condvalidfrom+0(6).
            dayto = i_condzz-condvalidto.
            CONTINUE.
          ENDIF.
        ENDIF.
      ELSEIF i_condzz-condvalidto+0(6) = l_ym AND l_ym > i_condzz-condvalidfrom+0(6).
        IF dayfrom IS INITIAL.
          dayfrom = i_condzz-condvalidfrom.
        ENDIF.
        IF dayto IS INITIAL.
          dayto = i_condzz-condvalidto.
        ENDIF.
        READ TABLE i_condzz INTO wa_condzz INDEX l_tabix.
        IF sy-subrc = 0.
          IF i_condzz-condvalidto+0(6) = wa_condzz-condvalidfrom+0(6).
            dayto = i_condzz-condvalidto.
            CONTINUE.
          ENDIF.
        ENDIF.
      ELSEIF i_condzz-condvalidfrom+0(6) < l_ym AND l_ym < i_condzz-condvalidto+0(6).
        IF dayfrom IS INITIAL.
          dayfrom = i_condzz-condvalidfrom.
        ENDIF.
        IF dayto IS INITIAL.
          dayto = i_condzz-condvalidto.
        ENDIF.
        READ TABLE i_condzz INTO wa_condzz INDEX l_tabix.
        IF sy-subrc = 0.
          IF i_condzz-condvalidto+0(6) = wa_condzz-condvalidfrom+0(6).
            dayto = i_condzz-condvalidto.
            CONTINUE.
          ENDIF.
        ENDIF.
      ENDIF.
    ENDLOOP.
    IF dayfrom IS INITIAL OR dayto IS INITIAL.
      CLEAR i_zzht.
      CONTINUE.
    ENDIF.
    i_out1-dayfrom = dayfrom.i_out1-dayto = dayto.
    SORT i_condzz BY intreno.
    READ TABLE i_condzz WITH KEY intreno = i_zzht-intreno.
    IF sy-subrc NE 0.
      CLEAR i_zzht.
      CONTINUE.
    ENDIF.
    READ TABLE i_ass1 WITH KEY objnrsrc = i_zzht-objnr.
    IF sy-subrc NE 0.
      CLEAR i_zzht.
      CONTINUE.
    ENDIF.
    READ TABLE i_ro WITH KEY objnr = i_ass1-objnrtrg.
    IF sy-subrc NE 0.
      CLEAR i_zzht.
      CONTINUE.
    ENDIF.
    READ TABLE i_mea1 WITH KEY intreno = i_ro-intreno.
    IF sy-subrc NE 0.
      CLEAR i_zzht.
      CONTINUE.
    ENDIF.
*取租赁面积
    CLEAR: l_mear, day_ht.
    LOOP AT wa_mea1 WHERE intreno = i_ro-intreno.
      CLEAR: day1, day2, day.
      IF l_ym = wa_mea1-validfrom+0(6) AND l_ym < wa_mea1-validto+0(6).
        day1 = wa_mea1-validfrom.
        CALL FUNCTION 'BKK_GET_MONTH_LASTDAY'
          EXPORTING
            i_date = day1
          IMPORTING
            e_date = day2.
        day = day2 - day1 + 1.
      ELSEIF l_ym = wa_mea1-validto+0(6) AND l_ym > wa_mea1-validfrom+0(6).
        day1+0(6) = l_ym.
        day1+6(2) = '01'.
        day2 = wa_mea1-validto.
        day = day2 - day1 + 1.
      ELSEIF l_ym > wa_mea1-validfrom+0(6) AND l_ym < wa_mea1-validto+0(6).
        day1+0(6) = l_ym.
        day1+6(2) = '01'.
        CALL FUNCTION 'BKK_GET_MONTH_LASTDAY'
          EXPORTING
            i_date = day1
          IMPORTING
            e_date = day2.
        day = day2 - day1 + 1.
      ENDIF.
      IF day > day_ht.
        day_ht = day.
        l_mear = wa_mea1-measvalue.
      ENDIF.
      CLEAR wa_mea1.
    ENDLOOP.
    i_out1-zzmj = l_mear.
    READ TABLE i_bd WITH KEY bukrs = i_ro-bukrs swenr = i_ro-swenr sgenr = i_ro-sgenr.
    IF sy-subrc NE 0.
      CLEAR i_zzht.
      CONTINUE.
    ENDIF.
    READ TABLE i_mea2 WITH KEY intreno = i_bd-intreno.
    IF sy-subrc NE 0.
      CLEAR i_zzht.
      CONTINUE.
    ENDIF.
*取转租面积
    CLEAR: l_mear, day_ht.
    LOOP AT wa_mea2 WHERE intreno = i_bd-intreno.
      CLEAR: day1, day2, day.
      IF l_ym = wa_mea2-validfrom+0(6) AND l_ym < wa_mea2-validto+0(6).
        day1 = wa_mea2-validfrom.
        CALL FUNCTION 'BKK_GET_MONTH_LASTDAY'
          EXPORTING
            i_date = day1
          IMPORTING
            e_date = day2.
        day = day2 - day1 + 1.
      ELSEIF l_ym = wa_mea2-validto+0(6) AND l_ym > wa_mea2-validfrom+0(6).
        day1+0(6) = l_ym.
        day1+6(2) = '01'.
        day2 = wa_mea2-validto.
        day = day2 - day1 + 1.
      ELSEIF l_ym > wa_mea2-validfrom+0(6) AND l_ym < wa_mea2-validto+0(6).
        day1+0(6) = l_ym.
        day1+6(2) = '01'.
        CALL FUNCTION 'BKK_GET_MONTH_LASTDAY'
          EXPORTING
            i_date = day1
          IMPORTING
            e_date = day2.
        day = day2 - day1 + 1.
      ENDIF.
      IF day > day_ht.
        day_ht = day.
        l_mear = wa_mea2-measvalue.
      ENDIF.
      CLEAR wa_mea2.
    ENDLOOP.
    i_out1-zlmj = l_mear.
    i_out1-recntxt = i_zzht-recntxt.
    LOOP AT i_ass2 WHERE  objnrtrg = i_bd-objnr.
      READ TABLE i_zlht WITH KEY objnr = i_ass2-objnrsrc.
      IF sy-subrc NE 0.
        CONTINUE.
      ENDIF.
      i_out1-zzht = i_zzht-recnnr.
      i_out1-zlht = i_zlht-recnnr.
      i_out1-objnr = i_zlht-objnr.
      i_out1-bukrs = i_zlht-bukrs.
      i_out1-gjahr = gjahr.
      CLEAR: l_ac, l_uc.
      LOOP AT i_condzl WHERE intreno = i_zlht-intreno.
        IF i_condzl-calcrule = 'A'.l_ac = l_ac + 1.ENDIF.
        IF i_condzl-calcrule = 'U'.l_uc = l_uc + 1.ENDIF.
      ENDLOOP.
      IF l_ac > 0 AND l_uc = 0.i_out1-type = 'A'.ENDIF.
      IF l_uc > 0 AND l_ac = 0.i_out1-type = 'U'.ENDIF.
      IF l_uc > 0 AND l_ac > 0.i_out1-type = 'AU'.ENDIF.
      IF i_out1-type = 'AU'.
        DATA:l_u LIKE visrreport-net_sales.
        DATA:l_a LIKE i_condzl-unitprice.
        DATA:l_flag1(1) TYPE c.
        DATA:l_flag2(1) TYPE c.
        i_out1-monat = l_ym+4(2).
        CLEAR:l_u,l_a,l_flag1,l_flag2.
        LOOP AT i_condzl WHERE intreno = i_zlht-intreno AND condvalidfrom+0(6) <= l_ym AND condvalidto+0(6) >= l_ym AND calcrule = 'U'.
          READ TABLE i_visrtmsbrpi WITH KEY intreno = i_zlht-intreno sbtermno = i_condzl-termnosr.
          IF sy-subrc NE 0.
            CONTINUE.
          ENDIF.
          CLEAR i_visrreport.
          LOOP AT i_visrreport WHERE intreno = i_zlht-intreno AND termno = i_visrtmsbrpi-rptermno AND validfrom+0(6) <= l_ym AND validto+0(6) >= l_ym.
            EXIT.
          ENDLOOP.
          IF i_visrreport IS INITIAL.
            CONTINUE.
          ENDIF.
          IF l_ym EQ i_visrreport-validto+0(6).
            l_flag1 = 'X'.
            l_u = i_visrreport-monthcost.
          ENDIF.
        ENDLOOP.
        IF l_flag1 EQ 'X'.
          i_out1-condvalidfrom_zl = i_condzl-condvalidfrom.
          i_out1-condvalidto_zl = i_condzl-condvalidto.
          READ TABLE i_visrtmrprh WITH KEY intreno = i_visrreport-intreno rptermno = i_visrreport-termno
                                                                          rhythmtype = i_visrreport-rhythmtype.
          IF sy-subrc NE 0.
            CONTINUE.
          ENDIF.
          LOOP AT i_condzl WHERE intreno = i_zlht-intreno AND condvalidfrom+0(6) <= l_ym AND condvalidto+0(6) >= l_ym AND calcrule = 'A'.
            l_a = l_a + i_condzl-unitprice.  "i_condzl-monthcost * i_visrtmrprh-frequency.
          ENDLOOP.
          IF l_a > l_u.
            CONTINUE.
          ENDIF.
          i_out1-cost = l_u - l_a.
          i_out1-condtype = i_condzl-condtype.
          APPEND i_out1.
        ENDIF.
      ENDIF.

      IF i_out1-type = 'A' OR i_out1-type = 'AU'.
        i_out1-monat = l_ym+4(2).
        IF l_ym = dayfrom+0(6).
          LOOP AT i_condzl WHERE intreno = i_zlht-intreno AND condvalidfrom+0(6) <= l_ym AND condvalidto+0(6) >= l_ym AND calcrule = 'A'.
            i_out1-condtype = i_condzl-condtype.
            i_out1-condvalidfrom_zl = i_condzl-condvalidfrom.
            i_out1-condvalidto_zl = i_condzl-condvalidto.
            lastd = sy-datum.
            lastd+0(6) = l_ym.
            CALL FUNCTION 'LAST_DAY_OF_MONTHS'
              EXPORTING
                day_in            = lastd
              IMPORTING
                last_day_of_month = lastd
              EXCEPTIONS
                day_in_no_date    = 1
                OTHERS            = 2.
            daym = lastd+6(2)."月份的天数
            days = lastd - dayfrom + 1."天数计算
            daycost = i_condzl-monthcost / daym.
            i_out1-cost = days * daycost.
            APPEND i_out1.
          ENDLOOP.
        ENDIF.
        IF l_ym = dayto+0(6).
          LOOP AT i_condzl WHERE intreno = i_zlht-intreno AND condvalidfrom+0(6) <= l_ym AND condvalidto+0(6) >= l_ym AND calcrule = 'A'.
            i_out1-condtype = i_condzl-condtype.
            i_out1-condvalidfrom_zl = i_condzl-condvalidfrom.
            i_out1-condvalidto_zl = i_condzl-condvalidto.
            lastd = sy-datum.
            lastd+0(6) = l_ym.
            CALL FUNCTION 'LAST_DAY_OF_MONTHS'
              EXPORTING
                day_in            = lastd
              IMPORTING
                last_day_of_month = lastd
              EXCEPTIONS
                day_in_no_date    = 1
                OTHERS            = 2.
            daym = lastd+6(2)."月份的天数
            days = dayto+6(2)."天数计算
            daycost = i_condzl-monthcost / daym.
            i_out1-cost = days * daycost.
            APPEND i_out1.
          ENDLOOP.
        ENDIF.
        IF l_ym > dayfrom+0(6) AND l_ym < dayto+0(6).
          LOOP AT i_condzl WHERE intreno = i_zlht-intreno AND condvalidfrom+0(6) <= l_ym AND condvalidto+0(6) >= l_ym AND calcrule = 'A'.
            i_out1-condtype = i_condzl-condtype.
            i_out1-condvalidfrom_zl = i_condzl-condvalidfrom.
            i_out1-condvalidto_zl = i_condzl-condvalidto.
            i_out1-cost = i_condzl-monthcost.
            APPEND i_out1.
          ENDLOOP.
        ENDIF.
      ENDIF."TYPE A

      IF i_out1-type = 'U'.
        i_out1-monat = l_ym+4(2).
        IF l_ym = dayfrom+0(6).
          LOOP AT i_condzl WHERE intreno = i_zlht-intreno AND condvalidfrom+0(6) <= l_ym AND condvalidto+0(6) >= l_ym AND calcrule = 'U'.
            IF i_condzl-condtype NE 'Z290' AND i_condzl-condtype NE 'Z900'.
              CONTINUE.
            ENDIF.
            READ TABLE i_visrtmsbrpi WITH KEY intreno = i_zlht-intreno sbtermno = i_condzl-termnosr.
            IF sy-subrc NE 0.
              CONTINUE.
            ENDIF.
            CLEAR i_visrreport.
            LOOP AT i_visrreport WHERE intreno = i_zlht-intreno AND termno = i_visrtmsbrpi-rptermno AND validfrom+0(6) <= l_ym AND validto+0(6) >= l_ym.
              EXIT.
            ENDLOOP.
            IF i_visrreport IS INITIAL.
              CONTINUE.
            ENDIF.
            i_out1-condtype = i_condzl-condtype.
            i_out1-condvalidfrom_zl = i_condzl-condvalidfrom.
            i_out1-condvalidto_zl = i_condzl-condvalidto.
            lastd = sy-datum.
            lastd+0(6) = l_ym.
            CALL FUNCTION 'LAST_DAY_OF_MONTHS'
              EXPORTING
                day_in            = lastd
              IMPORTING
                last_day_of_month = lastd
              EXCEPTIONS
                day_in_no_date    = 1
                OTHERS            = 2.
            daym = lastd+6(2)."月份的天数
            days = lastd - dayfrom + 1."天数计算
            daycost = i_visrreport-monthcost / daym.
            i_out1-cost = days * daycost.
            APPEND i_out1.
          ENDLOOP.
        ENDIF.
        IF l_ym = dayto+0(6).
          LOOP AT i_condzl WHERE intreno = i_zlht-intreno AND condvalidfrom+0(6) <= l_ym AND condvalidto+0(6) >= l_ym AND calcrule = 'U'.
            IF i_condzl-condtype NE 'Z290' AND i_condzl-condtype NE 'Z900'.
              CONTINUE.
            ENDIF.
            READ TABLE i_visrtmsbrpi WITH KEY intreno = i_zlht-intreno sbtermno = i_condzl-termnosr.
            IF sy-subrc NE 0.
              CONTINUE.
            ENDIF.
            CLEAR i_visrreport.
            LOOP AT i_visrreport WHERE intreno = i_zlht-intreno AND termno = i_visrtmsbrpi-rptermno AND validfrom+0(6) <= l_ym AND validto+0(6) >= l_ym.
              EXIT.
            ENDLOOP.
            IF i_visrreport IS INITIAL.
              CONTINUE.
            ENDIF.
            i_out1-condtype = i_condzl-condtype.
            i_out1-condvalidfrom_zl = i_condzl-condvalidfrom.
            i_out1-condvalidto_zl = i_condzl-condvalidto.
            lastd = sy-datum.
            lastd+0(6) = l_ym.
            CALL FUNCTION 'LAST_DAY_OF_MONTHS'
              EXPORTING
                day_in            = lastd
              IMPORTING
                last_day_of_month = lastd
              EXCEPTIONS
                day_in_no_date    = 1
                OTHERS            = 2.
            daym = lastd+6(2)."月份的天数
            days = dayto+6(2)."天数计算
            daycost = i_visrreport-monthcost / daym.
            i_out1-cost = days * daycost.
            APPEND i_out1.
          ENDLOOP.
        ENDIF.
        IF l_ym > dayfrom+0(6) AND l_ym < dayto+0(6).
          LOOP AT i_condzl WHERE intreno = i_zlht-intreno AND condvalidfrom+0(6) <= l_ym AND condvalidto+0(6) >= l_ym AND calcrule = 'U'.
            IF i_condzl-condtype NE 'Z290' AND i_condzl-condtype NE 'Z900'.
              CONTINUE.
            ENDIF.
            READ TABLE i_visrtmsbrpi WITH KEY intreno = i_zlht-intreno sbtermno = i_condzl-termnosr.
            IF sy-subrc NE 0.
              CONTINUE.
            ENDIF.
            CLEAR i_visrreport.
            LOOP AT i_visrreport WHERE intreno = i_zlht-intreno AND termno = i_visrtmsbrpi-rptermno AND validfrom+0(6) <= l_ym AND validto+0(6) >= l_ym.
              EXIT.
            ENDLOOP.
            IF i_visrreport IS INITIAL.
              CONTINUE.
            ENDIF.
            i_out1-condtype = i_condzl-condtype.
            i_out1-condvalidfrom_zl = i_condzl-condvalidfrom.
            i_out1-condvalidto_zl = i_condzl-condvalidto.
            i_out1-cost = i_visrreport-monthcost.
            APPEND i_out1.
          ENDLOOP.
        ENDIF.
      ENDIF."TYPE U
    ENDLOOP.                                                "ASS2
  ENDLOOP."ZZHT

*分摊-成本中心
*面积
  DATA:l_cost LIKE i_out2-cost.
  DATA: v_flag TYPE c.
  DATA: v_kostl TYPE kostl.
  LOOP AT i_out1.
    CLEAR l_cost.
    MOVE-CORRESPONDING i_out1 TO i_out2.
    IF i_out1-zlmj EQ 0.
      CONTINUE.
    ENDIF.
    IF i_out1-zlmj NE 0.
      l_cost = i_out1-cost / i_out1-zlmj * i_out1-zzmj.
    ENDIF.
    CLEAR: v_flag, v_kostl, l_ksrq.
    CONCATENATE p_budat+0(4) '0' p_budat+4(2) INTO l_ksrq.
    LOOP AT i_cobrb WHERE objnr = i_out1-objnr.
      IF i_cobrb-gabja = '0000' AND i_cobrb-gbisj = '0000'.
        IF i_cobrb-kostl+4(1) = 'Y'.
          v_flag = 'X'.
          v_kostl = i_cobrb-kostl.
          EXIT.
        ENDIF.
      ELSE.
        CLEAR: v_ksrq, v_jsrq.
        CONCATENATE i_cobrb-gabja i_cobrb-gabpe INTO v_ksrq.
        CONCATENATE i_cobrb-gbisj i_cobrb-gbisp INTO v_jsrq.
        IF ( v_ksrq = '0000000' AND l_ksrq <= v_jsrq ) OR ( v_jsrq = '0000000' AND v_ksrq <= l_ksrq ).
        ELSE.
          DELETE i_cobrb.
          CLEAR i_cobrb.
          CONTINUE.
        ENDIF.
        IF i_cobrb-kostl+4(1) = 'Y'.
          v_flag = 'X'.
          v_kostl = i_cobrb-kostl.
          EXIT.
        ENDIF.
      ENDIF.
    ENDLOOP.
    IF v_flag = 'X'.
      i_out2-kostl = v_kostl.
      i_out2-cost = l_cost.
      COLLECT i_out2.
    ELSE.
      LOOP AT i_cobrb WHERE objnr = i_out1-objnr.
        i_out2-kostl = i_cobrb-kostl.
        i_out2-cost = l_cost * i_cobrb-prozs / 100.
        COLLECT i_out2.
      ENDLOOP.
    ENDIF.
  ENDLOOP.

  LOOP AT i_out2.
    MOVE-CORRESPONDING i_out2 TO i_out3.
    COLLECT i_out3.
  ENDLOOP.
  SORT i_out3 BY bukrs gjahr monat zzht.
ENDFORM.                    "cal_cost

*&---------------------------------------------------------------------*
*&      Form  sub_output
*&---------------------------------------------------------------------*
*
*----------------------------------------------------------------------*
*  -->  p1        text
*  <--  p2        text
*----------------------------------------------------------------------*

FORM sub_output.
  g_repid = sy-repid.
  REFRESH fieldcat[].

  fieldcat-fieldname    = 'BUKRS'.
  fieldcat-ref_tabname = 'BKPF'.
  APPEND fieldcat.
  CLEAR fieldcat.

  fieldcat-fieldname    = 'GJAHR'.
  fieldcat-ref_tabname = 'BKPF'.
  APPEND fieldcat.
  CLEAR fieldcat.

  fieldcat-fieldname    = 'MONAT'.
  fieldcat-ref_tabname = 'BKPF'.
  APPEND fieldcat.
  CLEAR fieldcat.

  fieldcat-fieldname    = 'ZZHT'.
  fieldcat-reptext_ddic = '合同号'.
  APPEND fieldcat.
  CLEAR fieldcat.

  fieldcat-fieldname    = 'KOSTL'.
  fieldcat-ref_tabname = 'BSEG'.
  APPEND fieldcat.
  CLEAR fieldcat.

  fieldcat-fieldname    = 'COST'.
  fieldcat-reptext_ddic = '金额'.
  APPEND fieldcat.
  CLEAR fieldcat.

  gs_layout-coltab_fieldname  = 'COLOR_CELL'.
  gs_layout-zebra             = 'X'.
  gs_layout-colwidth_optimize = 'X'.

  CALL FUNCTION 'REUSE_ALV_GRID_DISPLAY'
    EXPORTING
      i_callback_program = g_repid
      is_layout          = gs_layout
      it_fieldcat        = fieldcat[]
      i_save             = 'A'
    TABLES
      t_outtab           = i_out3
    EXCEPTIONS
      program_error      = 1
      OTHERS             = 2.
  IF sy-subrc <> 0.
    MESSAGE ID sy-msgid TYPE sy-msgty NUMBER sy-msgno
            WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.
  ENDIF.
ENDFORM.                    "sub_output

*&---------------------------------------------------------------------*
*&      Form  process
*&---------------------------------------------------------------------*
*       text
*----------------------------------------------------------------------*

FORM process.
  DELETE i_out3 WHERE cost = 0.
  SORT i_out3 BY bukrs gjahr monat zzht.
  LOOP AT i_out3 INTO wa_out.
    CLEAR wa_cost.
    SELECT SINGLE * FROM zre_cost01 INTO wa_cost WHERE bukrs = wa_out-bukrs AND kostl = wa_out-kostl AND recnnr = wa_out-zzht
                                                   AND gjahr = wa_out-gjahr AND monat = wa_out-monat AND status = 'S'.
    IF sy-subrc = 0.
      WRITE: /10 wa_out-bukrs, wa_out-gjahr, wa_out-monat, wa_out-zzht, wa_out-kostl, '已出成本,无需重复执行!'.
      CLEAR wa_out.
      CONTINUE.
    ENDIF.

    CLEAR: v_char, l_bukrs, l_gjahr, l_monat, l_recnnr.
    AT END OF zzht.
      v_char = 'X'.
      l_bukrs = wa_out-bukrs.
      l_gjahr = wa_out-gjahr.
      l_monat = wa_out-monat.
      l_recnnr = wa_out-zzht.
    ENDAT.

    IF v_char = ''.
      CONTINUE.
    ELSE.
      CLEAR it_in.  REFRESH it_in.
      LOOP AT i_out3 INTO wa_out WHERE bukrs = l_bukrs AND gjahr = l_gjahr AND monat = l_monat AND zzht = l_recnnr.
        MOVE-CORRESPONDING wa_out TO it_in.
        APPEND it_in.
        CLEAR: wa_out, it_in.
      ENDLOOP.
      PERFORM fb01 TABLES it_in.
    ENDIF.
  ENDLOOP.
ENDFORM.                    "SAVE

*&---------------------------------------------------------------------*
*&      Form  FB01
*&---------------------------------------------------------------------*
*       text
*----------------------------------------------------------------------*

FORM fb01 TABLES it_in STRUCTURE i_out3.
  DATA: error_flag(1) TYPE c.
  DATA: c1(20) TYPE c.
  DATA: c2(20) TYPE c.
  DATA: c3(20) TYPE c.
  DATA: belnr_ou LIKE bkpf-belnr.
  DATA: bukrs_ou LIKE bkpf-bukrs.
  DATA: gjahr_ou LIKE bkpf-bukrs.
  DATA: documentheader LIKE bapiache09.
  DATA: accountgl LIKE bapiacgl09 OCCURS 0 WITH HEADER LINE.
  DATA: currencyamount LIKE bapiaccr09 OCCURS 0 WITH HEADER LINE.
  DATA: return LIKE bapiret2 OCCURS 0 WITH HEADER LINE.
  DATA: realestate LIKE bapiacre09 OCCURS 0 WITH HEADER LINE.
  DATA: l_currency LIKE bapiaccr09-currency.
****** ADD BY MENGJW 20130815 FOR 黄秀娟 BEGIN ******
  DATA:lt_criteria           TYPE STANDARD TABLE OF bapiackec9,
       ls_criteria           TYPE bapiackec9.
  DATA:BEGIN OF gs_vicncn,
       objnr LIKE vicncn-objnr,
       END OF gs_vicncn,
       gt_vicncn LIKE STANDARD TABLE OF gs_vicncn.
  DATA:BEGIN OF gs_cobrb,
       paobjnr LIKE cobrb-paobjnr,
       gabja LIKE cobrb-gabja,
       gabpe LIKE cobrb-gabpe,
       gbisj LIKE cobrb-gbisj,
       gbisp LIKE cobrb-gbisp,
       END OF gs_cobrb,
       gt_cobrb LIKE STANDARD TABLE OF gs_cobrb.
  DATA:lv_kmvkbu LIKE ce4snjt_acct-kmvkbu.
  DATA:lv_paobjnr LIKE cobrb-paobjnr.
****** ADD BY MENGJW 20130815 FOR 黄秀娟  END  ******

  DATA:l_line TYPE i.
  DATA:l_budat  LIKE bkpf-budat.
  DATA:l_total  LIKE bseg-dmbtr.
  DATA:l_recntxt LIKE vicncn-recntxt.
  DATA:l_sgtxt LIKE bseg-sgtxt.
  l_budat = sy-datum.
  LOOP AT it_in.
    l_total = l_total + it_in-cost.
  ENDLOOP.
  READ TABLE it_in INDEX 1.
  l_budat+0(4) = it_in-gjahr.
  l_budat+4(2) = it_in-monat.
  CALL FUNCTION 'LAST_DAY_OF_MONTHS'
    EXPORTING
      day_in            = l_budat
    IMPORTING
      last_day_of_month = l_budat
    EXCEPTIONS
      day_in_no_date    = 1
      OTHERS            = 2.

  CLEAR: documentheader, accountgl, currencyamount, return, realestate, wa_cost, i_cost.
  REFRESH: accountgl, currencyamount, return, realestate, i_cost.
****** ADD BY MENGJW 20130815 FOR 黄秀娟 BEGIN ******
  CLEAR:lt_criteria,ls_criteria,lv_paobjnr.
****** ADD BY MENGJW 20130815 FOR 黄秀娟  END  ******
  documentheader-bus_act = 'RFBU'.
  documentheader-username   = sy-uname.
  documentheader-header_txt = '不动产转租合同自动成本'.
  documentheader-comp_code  = it_in-bukrs.
  documentheader-doc_date   = sy-datum.
  documentheader-pstng_date = l_budat.
  documentheader-doc_type   = 'TZ'.
  CLEAR l_currency.
  SELECT SINGLE waers FROM t001 INTO l_currency WHERE bukrs = it_in-bukrs.

*取行项目文本
  CLEAR: l_recntxt, l_sgtxt.
  l_recntxt = it_in-recntxt.
  SEARCH l_recntxt  FOR '转租合同' IN CHARACTER MODE.
  IF sy-subrc EQ 0 AND sy-fdpos GT 0.
    l_recntxt = l_recntxt(sy-fdpos).
  ENDIF.
  CONCATENATE gjahr '' s_monat '' l_recntxt '转租成本' INTO l_sgtxt.

*借: 5405090110 其他业务成本-租赁费
  l_line = l_line + 1.
  accountgl-itemno_acc = l_line.
  accountgl-gl_account = '5405090110'.
  accountgl-comp_code  = it_in-bukrs.
  accountgl-alloc_nmbr = it_in-zzht.
  accountgl-item_text  = l_sgtxt.
  accountgl-pstng_date = l_budat.
  accountgl-doc_type   = 'TZ'.
  APPEND accountgl.
*
  currencyamount-itemno_acc = l_line.
  currencyamount-currency   = l_currency.
  currencyamount-amt_doccur = l_total.
  APPEND currencyamount.
  CLEAR accountgl.CLEAR currencyamount.
*
****** MODIFY BY MENGJW 20130815 FOR 黄秀娟 BEGIN ******
**将不动产合同号写入不动产对象中
*  realestate-itemno_acc  = l_line.
*  realestate-contract_no = l_recnnr.
*  APPEND realestate.  CLEAR realestate.
  SELECT objnr
  FROM vicncn
  INTO CORRESPONDING FIELDS OF TABLE gt_vicncn
  WHERE  recnnr = it_in-zzht.

  IF gt_vicncn IS NOT INITIAL.
    SELECT paobjnr gabja gabpe gbisj gbisp
    FROM cobrb
    INTO CORRESPONDING FIELDS OF TABLE gt_cobrb
    FOR ALL ENTRIES IN gt_vicncn
    WHERE objnr = gt_vicncn-objnr.
  ENDIF.
  LOOP AT gt_cobrb INTO gs_cobrb.
    IF gs_cobrb-gbisj = '0000'.
      gs_cobrb-gbisj = '9999'.
    ENDIF.
    IF gs_cobrb-gbisp = '000'.
      gs_cobrb-gbisp = '012'.
    ENDIF.
    IF gs_cobrb-gabja <= p_budat+0(4) AND gs_cobrb-gabpe+1(2) <= p_budat+4(2)
    AND gs_cobrb-gbisj >= p_budat+0(4) AND gs_cobrb-gbisp+1(2) >= p_budat+4(2).
      lv_paobjnr = gs_cobrb-paobjnr.
    ENDIF.
  ENDLOOP.
  SELECT SINGLE kmvkbu
  FROM ce4snjt_acct
  INTO lv_kmvkbu
  WHERE aktbo = 'X'
  AND paobjnr = lv_paobjnr
  AND pasubnr = 1.

  ls_criteria-itemno_acc = l_line.
  ls_criteria-fieldname = 'KMVKBU'.
  ls_criteria-character = lv_kmvkbu.
  APPEND ls_criteria TO lt_criteria.
  CLEAR:ls_criteria.
*  ls_criteria-itemno_acc = l_line.
*  ls_criteria-fieldname = 'PAOBJNR'.
*  ls_criteria-character = gs_cobrb-paobjnr.
*  APPEND ls_criteria TO lt_criteria.
*  CLEAR:ls_criteria.
****** MODIFY BY MENGJW 20130815 FOR 黄秀娟  END  ******
*贷: 5501280000 租赁费 – 成本中心1
  LOOP AT it_in.
    l_line = l_line + 1.
    accountgl-itemno_acc = l_line.
    accountgl-costcenter = it_in-kostl.
    accountgl-gl_account = '5501280000'.
    accountgl-comp_code  = it_in-bukrs.
    accountgl-alloc_nmbr = it_in-zzht.
    accountgl-item_text  = l_sgtxt.
    accountgl-pstng_date = l_budat.
    accountgl-doc_type    = 'TZ'.
    APPEND accountgl.
*
    currencyamount-itemno_acc = l_line.
    currencyamount-currency   = l_currency.
    currencyamount-amt_doccur = - it_in-cost.
    APPEND currencyamount.
    CLEAR accountgl.CLEAR currencyamount.
  ENDLOOP.
*
  CALL FUNCTION 'BAPI_ACC_DOCUMENT_POST'
    EXPORTING
      documentheader = documentheader
    TABLES
      accountgl      = accountgl
      currencyamount = currencyamount
      return         = return
      realestate     = realestate
****** ADD BY MENGJW 20130816 FOR 黄秀娟 BEGIN ******
      criteria       = lt_criteria
****** ADD BY MENGJW 20130816 FOR 黄秀娟  END  ******
    EXCEPTIONS
      OTHERS         = 1.
  IF sy-subrc <> 0.
    CALL FUNCTION 'BAPI_TRANSACTION_ROLLBACK'
      IMPORTING
        return = return.
  ELSE.
    LOOP AT return.
      IF NOT return IS INITIAL.
        IF return-type = 'A' OR return-type = 'E'.
          CONCATENATE msg '~' return-message   INTO msg.
          error_flag = 'X'.
        ENDIF.
      ENDIF.
    ENDLOOP.
    IF error_flag = 'X'.
      LOOP AT it_in.
        wa_cost-bukrs = it_in-bukrs.
        wa_cost-kostl = it_in-kostl.
        wa_cost-recnnr = it_in-zzht.
        wa_cost-gjahr = it_in-gjahr.
        wa_cost-monat = it_in-monat.
        wa_cost-wrbtr = it_in-cost.
        wa_cost-waers = l_currency.
        wa_cost-bukrs_ou = ''.
        wa_cost-belnr_ou = ''.
        wa_cost-gjahr_ou = ''.
        wa_cost-status = 'E'.
        wa_cost-error = msg.
        APPEND wa_cost TO i_cost.
        WRITE:/10 it_in-bukrs,it_in-monat,it_in-kostl,it_in-cost,msg+0(100).
      ENDLOOP.
      CALL FUNCTION 'BAPI_TRANSACTION_ROLLBACK'
        IMPORTING
          return = return.

    ELSE.
      LOOP AT return WHERE type = 'S'.
        SPLIT return-message AT space INTO c1  c2  c3.
        belnr_ou = c3+0(10).
        bukrs_ou = c3+10(4).
        gjahr_ou = c3+14(4).
        LOOP AT it_in.
          wa_cost-bukrs = it_in-bukrs.
          wa_cost-kostl = it_in-kostl.
          wa_cost-recnnr = it_in-zzht.
          wa_cost-gjahr = it_in-gjahr.
          wa_cost-monat = it_in-monat.
          wa_cost-wrbtr = it_in-cost.
          wa_cost-waers = l_currency.
          wa_cost-bukrs_ou = bukrs_ou.
          wa_cost-belnr_ou = belnr_ou.
          wa_cost-gjahr_ou = gjahr_ou.
          wa_cost-status = 'S'.
          wa_cost-error = ''.
          APPEND wa_cost TO i_cost.
          WRITE:/10 it_in-bukrs,it_in-monat,it_in-kostl,it_in-cost,belnr_ou,bukrs_ou,gjahr_ou.
        ENDLOOP.
        EXIT.
      ENDLOOP.
      CALL FUNCTION 'BAPI_TRANSACTION_COMMIT'
        EXPORTING
          wait = 'X'.
*将合同号放入凭证内
*      DO 100 TIMES.
*        CLEAR i_bkpf.  REFRESH i_bkpf.
*        SELECT * FROM bkpf INTO CORRESPONDING FIELDS OF TABLE i_bkpf WHERE bukrs = bukrs_ou AND belnr = belnr_ou AND gjahr = gjahr_ou.
*        IF i_bkpf[] IS NOT INITIAL.
*          EXIT.
*        ELSE.
*          WAIT UP TO 1 SECONDS.
*        ENDIF.
*      ENDDO.
*      CLEAR: i_bseg, i_bkdf, i_bsec, i_bsed, i_bset.
*      REFRESH: i_bseg, i_bkdf, i_bsec, i_bsed, i_bset.
*      SELECT * FROM bseg INTO CORRESPONDING FIELDS OF TABLE i_bseg WHERE bukrs = bukrs_ou AND belnr = belnr_ou AND gjahr = gjahr_ou.
*      IF i_bseg[] IS NOT INITIAL.
*        LOOP AT i_bseg WHERE hkont = '5405090110'.
*          i_bseg-vertn = l_recnnr.
*          SELECT SINGLE imkey FROM vicncn INTO i_bseg-imkey WHERE recnnr = l_recnnr.
*          MODIFY i_bseg.  CLEAR i_bseg.
*        ENDLOOP.
*        CALL FUNCTION 'CHANGE_DOCUMENT'
*          TABLES
*            t_bkdf = i_bkdf
*            t_bkpf = i_bkpf
*            t_bsec = i_bsec
*            t_bsed = i_bsed
*            t_bseg = i_bseg
*            t_bset = i_bset.
*        IF sy-subrc = 0.
*          CALL FUNCTION 'BAPI_TRANSACTION_COMMIT'
*            EXPORTING
*              wait = 'X'.
*        ELSE.
*          CALL FUNCTION 'BAPI_TRANSACTION_ROLLBACK'.
*        ENDIF.
*      ENDIF.
    ENDIF.
  ENDIF.
  IF i_cost[] IS NOT INITIAL.
    MODIFY zre_cost01 FROM TABLE i_cost[].
    IF sy-subrc = 0.
      COMMIT WORK AND WAIT.
    ELSE.
      ROLLBACK WORK.
    ENDIF.
  ENDIF.
ENDFORM.                                                    "f-02
原文地址:https://www.cnblogs.com/rainysblog/p/8537289.html