View source for SAP SOPORTE VENTAS RV77U903

 <nowiki>************************************************************
*** Atención: Rutina copiada !                           ***
*** Por favor, observe                                    ***
*** Sec. signos 011 sustituida por 903  en todas partes! ***
************************************************************

*---------------------------------------------------------------------*
*       FORM LST1_903                                                 *
*---------------------------------------------------------------------*
*       Liefer und Zahlungsbedingungen                                *
*---------------------------------------------------------------------*
FORM lst1_903.

  DATA: ls_rvkusta1_pay_del_terms TYPE rvkusta1_s_pay_del_terms,
        pos                       TYPE i,
        ls_listpos                TYPE t_list_position.
  DATA element_hlp LIKE element.
  DATA string_length TYPE i.
* to handle SY-SUBRC correct make sure, that LOOP is only processes when
* table is not empty
  DESCRIBE TABLE yknvv.
  CLEAR sy-subrc.
  CHECK sy-tfill > 0.
  tab_name = 'KNVV'.
  objekt   = kunde_faktura.

* determine list position
  pos = 903.
  ls_listpos-listname = 'PAY_DEL_TERMS'.
  ls_listpos-position = pos.
  ls_listpos-objekt = objekt.

  LOOP AT yknvv.
    MOVE yknvv TO knvv.

*   further data to determine list position
    ls_listpos-vkorg = knvv-vkorg.
    ls_listpos-vtweg = knvv-vtweg.
    ls_listpos-spart = knvv-spart.

    CLEAR tvzbt.

    IF NOT ( knvv-zterm IS INITIAL ).  "Zahlungsbedingung
      PERFORM tvzbt_lesen(rvtab001) USING knvv-zterm.
    ENDIF.
    IF xml_ouput_flag IS INITIAL.
      IF sapscript_print = no.
        IF acc_flag IS INITIAL.
          SKIP.
          RESERVE 2 LINES.

*      Liefer- u Zahlungsbedingungen
          WRITE: (90) sy-uline.
          FORMAT COLOR COL_HEADING INTENSIFIED.
          WRITE: /2 'Condiciones de entrega y pago'.
          IF vtber_print = 'X'.
            WRITE: 40(19) 'Área de ventas',
                   yknvv-vkorg,
                   yknvv-vtweg,
                   yknvv-spart.
          ENDIF.
          WRITE: 1 sy-vline, 90 sy-vline.
          WRITE: 91(42) space COLOR OFF.
          FORMAT COLOR OFF.
          PERFORM hide_knvv IN PROGRAM (anwendung).
          WRITE: /(90) sy-uline.
          WRITE: 1 sy-vline, 90 sy-vline.

          FORMAT COLOR COL_BACKGROUND INTENSIFIED.
*      Incoterms
          WRITE: /2(19) 'Incoterms',
                22 knvv-inco1 INTENSIFIED OFF,
                   knvv-inco2 INTENSIFIED OFF.
          WRITE: 1 sy-vline, 90 sy-vline.
          PERFORM hide_knvv IN PROGRAM (anwendung).
*      Rechnungstermine
          WRITE: /2(19) 'Condición de pago',
*             22 TVZBT-VTEXT INTENSIFIED OFF.
                 22 knvv-zterm INTENSIFIED OFF.
          WRITE: 1 sy-vline, 90 sy-vline.
          PERFORM hide_knvv IN PROGRAM (anwendung).

          WRITE: /(90) sy-uline.
          WRITE: 1 sy-vline, 90 sy-vline.

        ELSE.

*         header lines
*         Liefer- u Zahlungsbedingungen
          MOVE 'Condiciones de entrega y pago' TO ls_listpos-line1.
          APPEND ls_listpos TO wa_header-list.

*         item lines
*         Incoterms
          MOVE knvv-inco1 TO ls_rvkusta1_pay_del_terms-knvv_inco1.
          MOVE knvv-inco2 TO ls_rvkusta1_pay_del_terms-knvv_inco2.
*         Rechnungstermine
*           MOVE TVZBT-VTEXT TO ls_rvkusta1_pay_del_terms-tvzbt_vtext.
          MOVE knvv-zterm  TO ls_rvkusta1_pay_del_terms-knvv_zterm.

          MOVE knvv-vkorg TO ls_rvkusta1_pay_del_terms-vkorg.
          MOVE knvv-vtweg TO ls_rvkusta1_pay_del_terms-vtweg.
          MOVE knvv-spart TO ls_rvkusta1_pay_del_terms-spart.

          APPEND ls_rvkusta1_pay_del_terms TO
                                     wa_rvkusta1_cust-pay_del_terms.

        ENDIF.
      ELSE.
        DATA ls_tvzbt TYPE tvzbt.
        SELECT SINGLE * FROM tvzbt INTO ls_tvzbt
              WHERE    spras =    sy-langu
              AND      zterm =    knvv-zterm.

        info_prtlines_lst1_init.
        WRITE:  'Condiciones de entrega y pago'     TO v77komlst1-tline1,
*      1. line
                'Incoterms'     TO v77komlst1-telement1(19),
*      2. line
                'Condición de pago'     TO v77komlst1-telement2(19).

        WRITE ls_tvzbt-vtext TO v77komlst1-telement10.

        DATA   lt_lineitems  TYPE TABLE OF bapi3007_2.
        DATA ls_lineitems LIKE LINE OF lt_lineitems.
        DATA ld_amount LIKE ls_lineitems-lc_amount.
        DATA ld_tlfns TYPE knb1-tlfns.
        DATA ld_kraus TYPE knkk-kraus.
        DATA ld_ctlpc TYPE knkk-ctlpc.
        DATA ld_rtext TYPE   t691t-rtext.
        DATA ld_date TYPE d.
        DATA ld_date_1 TYPE d.
        DATA ls_s520 TYPE s520.

*Atraso promedio (días):
        SELECT  SINGLE tlfns INTO ld_tlfns FROM  knb1
               WHERE  kunnr  = knvv-kunnr
               AND    bukrs  = tvko-bukrs.

        WRITE ld_tlfns TO v77komlst1-telement9.

* Seguro (sí/no)
        SELECT SINGLE * FROM  knkk
               WHERE  kunnr  = knkk-kunnr
               AND    kkber  = knkk-kkber.

        IF knkk-kraus is initial or knkk-kraus = 'ESPACE'.
          v77komlst1-telement8 = 'NO'.
        ELSE."evargas
          data: validate type string,
          importing LIKE DD01V-DATATYPE.
          move knkk-kraus to validate.
          CALL FUNCTION 'NUMERIC_CHECK'
            EXPORTING
              STRING_IN        = validate
           IMPORTING
*   STRING_OUT       =
             HTYPE            = importing.
          if importing = 'NUMC' OR knkk-kraus = 'NOMINADO'.
            v77komlst1-telement8 = 'SI'.
            if knkk-kraus = 'NOMINADO'.
              WRITE knkk-dbekr TO v77komlst1-telement4 CURRENCY knkk-dbwae.
              condense v77komlst1-telement4 NO-GAPS.
            else.
              v77komlst1-telement4 = 'INNOMINADO'.
            endif.
          else.
            v77komlst1-telement8 = 'NO'.
            v77komlst1-telement4 = knkk-kraus.
          endif.
*            CASE knkk-kraus.
*              WHEN 'ESPACE'.
*                v77komlst1-telement8 = 'NO'.
*              WHEN OTHERS.
*                v77komlst1-telement8 = 'SI'.
*                if knkk-kraus = 'NOMINADO'.
*                  WRITE knkk-dbekr TO v77komlst1-telement4 CURRENCY knkk-dbwae.
*                  condense v77komlst1-telement4 NO-GAPS.
*                else.
*                  v77komlst1-telement4 = 'INNOMINADO'.
*                endif.
*            ENDCASE.
        ENDIF.

* Categoría de Riesgo
        SELECT  SINGLE rtext INTO ld_rtext FROM  t691t
               WHERE  spras  = sy-langu
               AND    ctlpc  = knkk-ctlpc
               AND    kkber  = knkk-kkber
               .
        IF sy-subrc = 0.
          WRITE ld_rtext TO v77komlst1-telement7.
          concatenate knkk-ctlpc '#('  v77komlst1-telement7 ')'
               into  v77komlst1-telement7.
          TRANSLATE v77komlst1-telement7 USING '# '.
        ENDIF.

* Atraso en pago
        CALL FUNCTION 'BAPI_AR_ACC_GETOPENITEMS'
          EXPORTING
            companycode = tvko-bukrs
            customer    = knvv-kunnr
            keydate     = sy-datum
          TABLES
            lineitems   = lt_lineitems.

        LOOP AT lt_lineitems INTO ls_lineitems.
          ld_date = ls_lineitems-bline_date + ls_lineitems-dsct_days1.
          CHECK ld_date < sy-datum.
          IF ls_lineitems-db_cr_ind = 'H'.
            ls_lineitems-lc_amount = ls_lineitems-lc_amount * -1.
          ENDIF.

          ADD ls_lineitems-lc_amount TO ld_amount.
        ENDLOOP.
        IF ld_amount <> 0.
          ld_amount = ld_amount / 1000.
          WRITE ld_amount TO v77komlst1-telement6 DECIMALS 0.
        ELSE.
          WRITE ld_amount TO v77komlst1-telement6 DECIMALS 0.
        ENDIF.
        CONDENSE v77komlst1-telement6 NO-GAPS.
*        WRITE v77komlst1-tline3 TO v77komlst1-tline3(14) RIGHT-JUSTIFIED.

* bloqueo (si/no)
        IF knkk-crblb <> space.
          v77komlst1-telement5 = 'SI'.
        ELSE.
          v77komlst1-telement5 = 'NO'.
        ENDIF.

        info_sap_script_write.

* historial de ventas
        DATA ld_m(7) TYPE c.
        DATA ld_count TYPE c.

        info_prtlines_lst1_init.
        element = 'LST1_903_003'.
        ld_count = '1'.

        DO 4 TIMES.
* MES - 1
          CALL FUNCTION 'HR_BR_ADD_MONTH_TO_DATE'
            EXPORTING
              dmm_datin = sy-datum
              dmm_count = ld_count
              dmm_oper  = '-'
              dmm_pos   = space
            IMPORTING
              dmm_daout = ld_date.
          IF ld_count = '1'.
            ld_date_1 = ld_date .
          ENDIF.

          CONCATENATE ld_date+4(2) '.'  ld_date(4) INTO ld_m.

          CLEAR ls_s520.
          SELECT sum( netwr ) INTO ls_s520-netwr FROM  s520
                 WHERE  spmon   = ld_date(6)
                 AND    pkunag  = knvv-kunnr
                 AND vkorg = knvv-vkorg
                 AND vtweg  = knvv-vtweg
                 AND VRSIO = '000'.
*                 AND spart = knvv-spart.

          IF sy-subrc = 0.
            ls_s520-netwr = ls_s520-netwr / 1000.  "Miles de $
            WRITE ls_s520-netwr TO v77komlst1-telement1 CURRENCY knvv-waers.
          ELSE.
            v77komlst1-telement1 = 0.
          ENDIF.

          CONDENSE v77komlst1-telement1 NO-GAPS.
*        WRITE v77komlst1-telement1 TO v77komlst1-telement1(10) RIGHT-JUSTIFIED.  "???
*        v77komlst1-telement6+20 = ld_m.
          v77komlst1-telement2 = ld_m.
          v77komlst1-telement4 = ld_count.
          kna1-erdat = ld_date.

          info_sap_script_write.
          ADD 1 TO ld_count.

        ENDDO.
*Venta último año (M$):

        info_prtlines_lst1_init.
        element = 'LST1_903_004'.

        CALL FUNCTION 'HR_BR_ADD_MONTH_TO_DATE'
          EXPORTING
            dmm_datin = ld_date_1
            dmm_count = '12'
            dmm_oper  = '-'
            dmm_pos   = space
          IMPORTING
            dmm_daout = ld_date.

        CLEAR ls_s520-netwr.
        SELECT  SUM( netwr ) INTO ls_s520-netwr FROM  s520
               WHERE  spmon   BETWEEN ld_date(6) AND ld_date_1(6)
               AND    pkunag  = knvv-kunnr
               AND vkorg = knvv-vkorg
               AND vtweg  = knvv-vtweg
               AND VRSIO = '000'.
*               AND spart = knvv-spart.
        IF sy-subrc = 0.
          ls_s520-netwr = ls_s520-netwr / 1000.  "Miles de $
          WRITE ls_s520-netwr TO v77komlst1-telement1 CURRENCY knvv-waers.
          CONDENSE v77komlst1-telement1 NO-GAPS.
        ELSE.
          v77komlst1-telement1 = '0'.
        ENDIF.

        CONDENSE v77komlst1-telement1 NO-GAPS.
*        WRITE v77komlst1-telement1 TO v77komlst1-telement1(14) RIGHT-JUSTIFIED.
*        v77komlst1-telement1+20 = 'Año'.
*        v77komlst1-telement1+24 = ld_date(4).

        info_sap_script_write.   "???
      ENDIF.
    ELSE. "XML-OUTPUT
*      DATA: lvt_para TYPE sdcas_t_w3_html WITH HEADER LINE.
*      DATA: lvt_paralines TYPE sdcas_t_w3_html WITH HEADER LINE.
*      DATA: lvt_keyline TYPE sdcas_t_w3_html WITH HEADER LINE.
*      DATA: lvt_keyline_spart TYPE sdcas_t_w3_html WITH HEADER LINE.
*      DATA: lvt_link TYPE sdcas_t_w3_html WITH HEADER LINE.
*      DATA: lvt_paymentruleline TYPE sdcas_t_w3_html WITH HEADER LINE.
*      DATA: lvt_paymentrulelines TYPE sdcas_t_w3_html WITH HEADER LINE.
*      DATA: lvf_offset TYPE i.
*      DATA: lvf_offset_link TYPE i.
*      DATA: html_line TYPE w3_html.
*      REFRESH lvt_paralines.
*      PERFORM xml_fill_paraline USING 'DDY' '/320/320' lvt_para[].
*      APPEND LINES OF lvt_para TO lvt_paralines.
*      PERFORM xml_fill_paraline USING 'KUN' ykna1-kunnr lvt_para[].
*      APPEND LINES OF lvt_para TO lvt_paralines.
*      PERFORM xml_fill_paraline USING 'VKO' xvtber-vkorg lvt_para[].
*      APPEND LINES OF lvt_para TO lvt_paralines.
*      PERFORM xml_fill_paraline USING 'VTW' yknvv-vtweg lvt_para[].
*      APPEND LINES OF lvt_para TO lvt_paralines.
*      PERFORM xml_fill_paraline USING 'SPA' yknvv-spart lvt_para[].
*      APPEND LINES OF lvt_para TO lvt_paralines.
*
*      REFRESH lvt_keyline_spart.
*      REFRESH lvt_keyline.
*      REFRESH lvt_paymentrulelines.
**      PERFORM xml_fill_linkline USING
**                          'TRX' '' 'VD03' text-x13 lvt_paralines[]
**                            CHANGING  lvt_link[]
**                               lvf_offset_link.
*      PERFORM xml_fill_keyline USING
*                               'TSPA'
*                               yknvv-spart
*                               ''
*                               ''
*                               lvt_link[]
*                              CHANGING
*                               lvt_keyline_spart[]
*                               lvf_offset.
*      PERFORM xml_fill_keyline USING
*                               'TVTW'
*                               yknvv-vtweg
*                               ''
*                               ''
*                               lvt_keyline_spart[]
*                              CHANGING
*                               lvt_keyline[]
*                               lvf_offset.
*      INSERT lines of lvt_keyline INTO xml_output INDEX
*                                    gvf_infoblock_pointer.
*      DESCRIBE TABLE lvt_keyline LINES sy-tfill.
*      gvf_infoblock_pointer = gvf_infoblock_pointer + sy-tfill -
*                        ( 2 * lvf_offset ) - lvf_offset_link.
*      gvf_customer_pointer = gvf_customer_pointer + sy-tfill.
*
**      Liefer- u Zahlungsbedingungen
**      PERFORM xml_template_ib USING  '903'
**                                     text-u13
**                                     text-u13
**                       .
*      gvf_infoblock_pointer = gvf_infoblock_pointer +
*                              ( 2 * lvf_offset ) + lvf_offset_link.
*
*
**      Incoterms
*      CLEAR html_line.
*      WRITE knvv-inco1 TO html_line.
*      WRITE knvv-inco2 TO html_line+6.
*      DATA: lvf_html_line TYPE char255.
*      lvf_html_line = html_line.
**      PERFORM escape_xml_text
**        CHANGING lvf_html_line.
*      PERFORM xml_fill_paymentruleline USING text-031
*                                             lvf_html_line
*                                   CHANGING lvt_paymentruleline[].
*      APPEND LINES OF lvt_paymentruleline TO lvt_paymentrulelines.
**      Rechnungstermine
*      PERFORM xml_fill_paymentruleline USING text-032
**                                           TVZBT-VTEXT
*                                         knvv-zterm
*                                   CHANGING lvt_paymentruleline[].
*      APPEND LINES OF lvt_paymentruleline TO lvt_paymentrulelines.
*      DATA: lvt_paymentruletab TYPE w3html OCCURS 30 WITH HEADER LINE.
*      DATA: merge_table TYPE swww_t_merge_table WITH HEADER LINE.
*
*      CALL FUNCTION 'WWW_GET_SCRIPT_AND_HTML'
*        EXPORTING
*          obj_name = 'SDCAS_XML_PAYMENT_BORDER'
*        TABLES
*          html     = lvt_paymentruletab[].
*      xml_addtable2mergetab '<!--row-->' ' '  lvt_paymentrulelines.
*      xml_merge lvt_paymentruletab merge_table.
*      INSERT lines of lvt_paymentruletab INTO xml_output INDEX
*                                gvf_infoblocks_pointer.
*      DESCRIBE TABLE lvt_paymentruletab LINES sy-tfill.
*      gvf_infoblocks_pointer = gvf_infoblocks_pointer + sy-tfill.
*      gvf_infoblock_pointer = gvf_infoblock_pointer + sy-tfill.
*      gvf_customer_pointer = gvf_customer_pointer + sy-tfill.
    ENDIF.
  ENDLOOP.
ENDFORM.                                                    "LST1_903
*&---------------------------------------------------------------------*
*&      Form  xml_fill_paymentruleline
*&---------------------------------------------------------------------*
*       text
*----------------------------------------------------------------------*
FORM xml_fill_paymentruleline USING col1
                                    col2
                   CHANGING paymentruleline TYPE sdcas_t_w3_html.
  STATICS: washere.
  STATICS: lvt_paymentrule TYPE sdcas_t_w3_html WITH HEADER LINE.
  STATICS: col1_offset_l TYPE i.
  STATICS: col2_offset_l TYPE i.
  DATA: html_line TYPE w3_html.

  IF washere IS INITIAL.
    CALL FUNCTION 'WWW_GET_SCRIPT_AND_HTML'
      EXPORTING
        obj_name = 'SDCAS_XML_PAYMENT_ITEM'
      TABLES
        html     = lvt_paymentrule[].
    LOOP AT lvt_paymentrule.
      IF lvt_paymentrule CS '<!--col1-->'.
        col1_offset_l = sy-tabix.
      ENDIF.
      IF lvt_paymentrule CS '<!--col2-->'.
        col2_offset_l = sy-tabix.
      ENDIF.
    ENDLOOP.
    washere = 'X'.
  ENDIF.
  paymentruleline[] = lvt_paymentrule[].

  MODIFY paymentruleline FROM col1 INDEX col1_offset_l.
  MODIFY paymentruleline FROM col2 INDEX col2_offset_l.

ENDFORM.                    " xml_fill_paymentruleline</nowiki>