REPORT z_alv_shdb_doc.
*---------------------------------------------------------------------*
* This report generates and displays a documentation for a SHDB record*
*---------------------------------------------------------------------*
* Author : Michel PIOUD                                               *
* Email : mpioud@yahoo.fr  HomePage : http://www.geocities.com/mpioud *
*---------------------------------------------------------------------*
* Macro definition
DEFINE m_append.
  add 1 to g_j.
  gt_data-colx = g_i.
  gt_data-colj = g_j.
  append gt_data.
  clear gt_data.
END-OF-DEFINITION.

CONSTANTS c_%bdc(4) VALUE '%BDC'.

TABLES apqi.                           " Queue info definition

SELECTION-SCREEN :
  SKIP, BEGIN OF LINE, COMMENT 10(20) v_1 FOR FIELD p_grpid."#EC NEEDED
* SHDB Group name
PARAMETERS p_grpid LIKE apqi-groupid OBLIGATORY.
SELECTION-SCREEN END OF LINE.

DATA:
* SHDB Queue identification (unique key)
  p_qid LIKE apqi-qid,

  BEGIN OF gs_field,
    ddtext      LIKE dd04v-ddtext,
    type        LIKE dd03l-datatype,
    length      LIKE dd03l-leng,
    decimal     LIKE dd03l-decimals,
    tab_control LIKE dd03l-checktable,
  END OF gs_field,

* Data to display
  BEGIN OF gt_data OCCURS 0,
    colx TYPE i,
    colj TYPE i,
    col0(40),
    col1(100),
    col2(100),
    col3(3),
    col4(3),
    col5(4),
    col6(40),
    color(4),
    box,
  END OF gt_data,

  g_descript(100),                      " Work field (column 3)
  g_prog TYPE progname,
  g_i    TYPE i,
  g_j    TYPE i,
* Internal table of data from SHDB record
  gt_dynprotab LIKE bdcdata OCCURS 0 WITH HEADER LINE.

*---------------------------------------------------------------------*
INITIALIZATION.

  v_1 = 'SHDB record'.

*---------------------------------------------------------------------*
AT SELECTION-SCREEN ON VALUE-REQUEST FOR p_grpid.

  PERFORM f_choose_shdb USING 'GROUPID'
                              'P_GRPID'
                     CHANGING p_grpid.

  CHECK NOT p_grpid IS INITIAL.

  SELECT qid INTO p_qid FROM apqi UP TO 2 ROWS
                       WHERE groupid = p_grpid
                         AND mandant = sy-mandt
                         AND datatyp = c_%bdc.
  ENDSELECT.

  CHECK sy-dbcnt = 2.

  PERFORM f_choose_shdb USING 'QID' ''
                     CHANGING p_qid.

*---------------------------------------------------------------------*
AT SELECTION-SCREEN.

  IF NOT p_qid IS INITIAL.
*   SHDB record exists ?
    SELECT qid INTO p_qid FROM apqi UP TO 1 ROWS
                         WHERE qid     = p_qid
                           AND groupid = p_grpid
                           AND mandant = sy-mandt
                           AND datatyp = c_%bdc.
    ENDSELECT.
    CHECK sy-subrc NE 0.
  ENDIF.
* SHDB record exists ?
  SELECT qid INTO p_qid FROM apqi UP TO 1 ROWS
                       WHERE groupid = p_grpid
                         AND mandant = sy-mandt
                         AND datatyp = c_%bdc.
  ENDSELECT.
  CHECK sy-subrc NE 0.
* Recording & is not available
  MESSAGE i627(ms) WITH p_grpid.
  STOP.

*---------------------------------------------------------------------*
START-OF-SELECTION.

* Read SHDB record
  CALL FUNCTION 'BDC_OBJECT_READ'
       EXPORTING
            queue_id         = p_qid
       TABLES
            dynprotab        = gt_dynprotab
       EXCEPTIONS
            not_found        = 1
            system_failure   = 2
            invalid_datatype = 3
            OTHERS           = 4.

  IF sy-subrc >< 0.
*   Recording & is not available
    MESSAGE s627(ms) WITH p_qid.
    EXIT.
  ENDIF.

  CLEAR apqi.
  SELECT * FROM apqi UP TO 1 ROWS WHERE qid     = p_qid
                                    AND datatyp = c_%bdc
                                    AND mandant = sy-mandt.
  ENDSELECT.

  CHECK sy-subrc EQ 0.

* SHDB properties
  CLEAR g_descript.
  WRITE apqi-credate TO g_descript DD/MM/YY.
  CONCATENATE 'Created on :' g_descript '-'
         INTO g_descript SEPARATED BY space.
  WRITE apqi-cretime TO g_descript+22.
  CONCATENATE g_descript 'by' apqi-creator
         INTO g_descript SEPARATED BY space.

  ADD 1 TO g_i.
  gt_data-col0  = 'Object name'.
  gt_data-col1  = apqi-groupid.
  gt_data-col2  = g_descript.
  gt_data-color = 'C110'.
  m_append.

  LOOP AT gt_dynprotab.
    CLEAR g_descript.
    CASE gt_dynprotab-dynbegin.
      WHEN 'T'.                        " New transaction
        PERFORM transaction.
      WHEN 'X'.                        " New dynpro
        PERFORM dynpro.
      WHEN space.                      " Dynpro field
        IF gt_dynprotab-fnam(10) = 'BDC_OKCODE'.
          PERFORM okcode.
        ELSEIF gt_dynprotab-fnam(10) = 'BDC_CURSOR'.
          PERFORM cursor.
        ELSEIF gt_dynprotab-fnam(10) = 'BDC_SUBSCR'.
          PERFORM subscr.
        ELSE.
          PERFORM f_field.
        ENDIF.
    ENDCASE.
  ENDLOOP.

  PERFORM f_display.

*---------------------------------------------------------------------*
*    Form COMPLETE                                                    *
*---------------------------------------------------------------------*
FORM complete USING u_field TYPE c.

  DATA :
    l_table LIKE dd03l-tabname,        " Table name
    l_field LIKE dd03l-fieldname,      " Field Name
    l_temp  LIKE dd03l-fieldname,                           "#EC NEEDED

    lt_dd03l LIKE dd03l OCCURS 0 WITH HEADER LINE,
    lt_dd04v LIKE dd04v OCCURS 0 WITH HEADER LINE.

  CLEAR gs_field.

  SPLIT u_field AT '-' INTO l_table l_field.
  IF l_table(1) = '*'.
    SHIFT l_table.
  ENDIF.

  IF l_field CA '('.
    SPLIT l_field AT '(' INTO l_field l_temp.
  ENDIF.

* Get text for field
  CALL FUNCTION 'FIELDNAME_ROLLNAME_TEXT'
       EXPORTING
            i_as4local          = 'A'
            i_fieldname         = l_field
            i_tabname           = l_table
       TABLES
            e_dd03l             = lt_dd03l
            e_dd04v             = lt_dd04v
       EXCEPTIONS
            error_in_parameters = 1
            not_found           = 2
            OTHERS              = 3.

  CHECK sy-subrc EQ 0.
  CLEAR : lt_dd03l, lt_dd04v, gs_field.
  READ TABLE lt_dd03l INDEX 1.
  READ TABLE lt_dd04v INDEX 1.
  MOVE lt_dd03l-leng       TO gs_field-length.
  MOVE lt_dd03l-datatype   TO gs_field-type.
  MOVE lt_dd03l-checktable TO gs_field-tab_control.
  MOVE lt_dd04v-ddtext     TO gs_field-ddtext.
  MOVE lt_dd03l-decimals   TO gs_field-decimal.

ENDFORM.                               " COMPLETE
*---------------------------------------------------------------------*
*       Form  TRANSACTION
*---------------------------------------------------------------------*
FORM transaction.

* Read transaction text
  SELECT SINGLE ttext INTO g_descript FROM tstct
                                     WHERE tcode = gt_dynprotab-fnam
                                       AND sprsl = sy-langu.
  IF sy-subrc NE 0.
*   Read transaction text
    SELECT ttext INTO g_descript FROM tstct UP TO 1 ROWS
                                WHERE tcode = gt_dynprotab-fnam.
    ENDSELECT.
    IF sy-subrc NE 0.
      g_descript = 'Text of transaction unkowned'.          "#EC *
    ENDIF.
  ENDIF.

  ADD 1 TO g_i.
  CLEAR g_j.
  gt_data-col0 = 'Transaction'.
  gt_data-col1 = gt_dynprotab-fnam.
  gt_data-col2 = g_descript.
  gt_data-color = 'C100'.
  m_append.

  gt_data-col0  = 'Name'.
  gt_data-col1  = 'Value'.
  gt_data-col2  = 'Description'.
  gt_data-col3  = 'Lng'.
  gt_data-col4  = 'Dec'.
  gt_data-col5  = 'Type'.
  gt_data-col6  = 'TbCtrl'.                                 "#EC *
  gt_data-color = 'C100'.
  m_append.

ENDFORM.                               " TRANSACTION
*---------------------------------------------------------------------*
*       Form  DYNPRO
*---------------------------------------------------------------------*
FORM dynpro.

* Read dynpro text
  SELECT SINGLE dtxt INTO g_descript FROM d020t
                    WHERE prog = gt_dynprotab-program
                      AND dynr = gt_dynprotab-dynpro
                      AND lang = sy-langu.
  IF sy-subrc NE 0.
*   Read dynpro text
    SELECT dtxt INTO g_descript FROM d020t UP TO 1 ROWS
               WHERE prog = gt_dynprotab-program
                 AND dynr = gt_dynprotab-dynpro.
    ENDSELECT.
    IF sy-subrc NE 0.
      g_descript = 'Unkowned'.                              "#EC *
    ENDIF.
  ENDIF.

  IF g_j = 2.
    ADD 1 TO g_i.
  ELSE.
    m_append.
  ENDIF.
  gt_data-col0 = gt_dynprotab-program.
  g_prog       = gt_dynprotab-program.
  gt_data-col1 = gt_dynprotab-dynpro.
  gt_data-col2 = g_descript.
  m_append.

ENDFORM.                               " DYNPRO
*---------------------------------------------------------------------*
*       Form  OKCODE
*---------------------------------------------------------------------*
FORM okcode.

  DATA l_code LIKE sy-tcode.

  l_code = gt_dynprotab-fval.
  IF l_code(1) EQ '='.
    SHIFT l_code LEFT.
  ENDIF.

* Read OKcode text
  SELECT text INTO gt_data-col2 UP TO 1 ROWS
              FROM rsmptexts
             WHERE progname = g_prog
               AND sprsl    = sy-langu
               AND obj_code = l_code.
  ENDSELECT.
  IF sy-subrc NE 0.
*   Read OKcode text
    SELECT text INTO gt_data-col2 UP TO 1 ROWS
                FROM rsmptexts
               WHERE progname = g_prog
                 AND obj_code = l_code.
    ENDSELECT.
  ENDIF.

  gt_data-col0 = gt_dynprotab-fnam.
  gt_data-col1 = gt_dynprotab-fval.
  m_append.

ENDFORM.                               " OKCODE
*---------------------------------------------------------------------*
*       Form  cursor
*---------------------------------------------------------------------*
FORM cursor.

  IF gt_dynprotab-fval CA '-'.
    PERFORM complete USING gt_dynprotab-fval.
  ENDIF.

  CHECK gt_dynprotab-fval CA '-'.

  gt_data-col0 = gt_dynprotab-fnam.
  gt_data-col1 = gt_dynprotab-fval.
  gt_data-col2 = gs_field-ddtext(60).
  m_append.

ENDFORM.                               " CURSOR
*---------------------------------------------------------------------*
*       Form  subscr
*---------------------------------------------------------------------*
FORM subscr.

  DATA : l_prog TYPE progname,
         l_dynp TYPE dynnr.

  l_prog = gt_dynprotab-fval.
  l_dynp = gt_dynprotab-fval+40(4).

* Read Subscr text
  SELECT SINGLE dtxt INTO g_descript FROM d020t
                    WHERE prog = l_prog
                      AND dynr = l_dynp
                      AND lang = sy-langu.
  IF sy-subrc NE 0.
*   Read Subscr text
    SELECT dtxt INTO g_descript FROM d020t UP TO 1 ROWS
               WHERE prog = l_prog
                 AND dynr = l_dynp.
    ENDSELECT.
    IF sy-subrc NE 0.
      g_descript = 'Unkwoned'.                              "#EC *
    ENDIF.
  ENDIF.
  CONDENSE gt_dynprotab-fval.
  gt_data-col0 = gt_dynprotab-fnam.
  gt_data-col1 = gt_dynprotab-fval.
  gt_data-col2 = g_descript.
  m_append.

ENDFORM.                               " SUBSCR
*---------------------------------------------------------------------*
*       Form  F_FIELD
*---------------------------------------------------------------------*
FORM f_field.

  IF gt_dynprotab-fnam CA '-'.
    PERFORM complete USING gt_dynprotab-fnam.
  ENDIF.

  CHECK gt_dynprotab-fnam CA '-'.

  gt_data-col0 = gt_dynprotab-fnam.
  gt_data-col1 = gt_dynprotab-fval(40).
  gt_data-col2 = gs_field-ddtext(60).
  WRITE gs_field-length+3(3) TO gt_data-col3 NO-ZERO RIGHT-JUSTIFIED.
  WRITE gs_field-decimal+3(3)  TO gt_data-col4 NO-ZERO RIGHT-JUSTIFIED.
  gt_data-col5 = gs_field-type.
  gt_data-col6 = gs_field-tab_control.
  m_append.

ENDFORM.                               " F_FIELD
*---------------------------------------------------------------------*
*       FORM F_DISPLAY                                                *
*---------------------------------------------------------------------*
FORM f_display.

  TYPE-POOLS: slis.                    " Generic list types

  DATA :
    ls_layout        TYPE slis_layout_alv,
    ls_print         TYPE slis_print_alv,
    ls_fieldcat      TYPE slis_fieldcat_alv,
    lt_fieldcat      TYPE slis_t_fieldcat_alv,
    lt_sort          TYPE slis_t_sortinfo_alv,
    ls_sort          TYPE slis_sortinfo_alv,
    ls_grid_settings TYPE lvc_s_glay,
    lt_excluding     TYPE slis_t_extab.

  ls_grid_settings-top_p_only = 'X'.

  ls_layout-group_change_edit = 'X'.
  ls_layout-colwidth_optimize = 'X'.
  ls_layout-zebra             = 'X'.
  ls_layout-cell_merge        = 'X'.
  ls_layout-detail_popup      = 'X'.
  ls_layout-get_selinfos      = 'X'.
  ls_layout-no_colhead        = 'X'.
  ls_layout-no_sumchoice      = 'X'.
  ls_layout-no_totalline      = 'X'.
  ls_layout-info_fieldname    = 'COLOR'.
  ls_layout-box_fieldname     = 'BOX'.

  ls_print-no_print_selinfos  = 'X'.   " Display no selection infos
  ls_print-no_print_listinfos = 'X'.   " Display no listinfos

* Exclude CUA functions
  APPEND '&OUP' TO lt_excluding.
  APPEND '&ODN' TO lt_excluding.
  APPEND '&ILT' TO lt_excluding.

* Build field catalog
  CALL FUNCTION 'REUSE_ALV_FIELDCATALOG_MERGE'
       EXPORTING
            i_program_name     = sy-cprog
            i_internal_tabname = 'GT_DATA'
            i_inclname         = sy-cprog
       CHANGING
            ct_fieldcat        = lt_fieldcat.

  ls_fieldcat-just = 'R'.
  MODIFY lt_fieldcat FROM ls_fieldcat
  TRANSPORTING just WHERE fieldname = 'COL3' OR fieldname = 'COL4'.

  ls_fieldcat-tech = 'X'.
  MODIFY lt_fieldcat FROM ls_fieldcat
  TRANSPORTING tech WHERE fieldname = 'COLX'  OR fieldname = 'COLJ'
                       OR fieldname = 'COLOR' OR fieldname = 'BOX'.

* Build sort table
  CLEAR ls_sort.
  ls_sort-fieldname = 'COLX'.
  ls_sort-up        = 'X'.
  ls_sort-group     = 'UL'.            " Underline
  APPEND ls_sort TO lt_sort.

  CLEAR ls_sort.
  ls_sort-fieldname = 'COLJ'.
  ls_sort-up        = 'X'.             " Sort
  APPEND ls_sort TO lt_sort.

  CALL FUNCTION 'REUSE_ALV_GRID_DISPLAY'
       EXPORTING
            i_interface_check  = ' '
            i_buffer_active    = ' '
            i_callback_program = sy-cprog
            i_grid_settings    = ls_grid_settings
            is_layout          = ls_layout
            it_fieldcat        = lt_fieldcat
            it_excluding       = lt_excluding
            it_sort            = lt_sort
            i_default          = ' '
            i_save             = 'A'
            is_print           = ls_print
       TABLES
            t_outtab           = gt_data
       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.
*---------------------------------------------------------------------*
*      Form  F_CHOOSE_SHDB
*---------------------------------------------------------------------*
FORM f_choose_shdb USING u_value1 TYPE fieldname
                         u_value2 TYPE dynfnam
                CHANGING u_val.

  TYPES:
    BEGIN OF ty_s_values,
      qid      TYPE apq_quid,
      groupid  TYPE apq_grpn,
      creator  TYPE apq_mapn,
      credate  TYPE apq_crda,
      cretime  TYPE apq_crti,
      transcnt TYPE apq_tran,
      msgcnt   TYPE apq_reco,
    END OF ty_s_values.

  DATA:
    lt_values  TYPE TABLE OF ty_s_values,
    Lt_return  TYPE HRRETURN_TAB WITH HEADER LINE,
    l_progname TYPE sy-repid,
    l_dynnum   TYPE sy-dynnr.

  l_progname = sy-repid.
  l_dynnum   = sy-dynnr.

  IF u_value1 = 'GROUPID'.
    SELECT *
      FROM apqi
      INTO CORRESPONDING FIELDS OF TABLE lt_values
     WHERE datatyp = c_%bdc
       AND mandant = sy-mandt.
  ELSE.
    SELECT *
      FROM apqi
      INTO CORRESPONDING FIELDS OF TABLE lt_values
     WHERE datatyp = c_%bdc
       AND mandant = sy-mandt
       AND groupid = p_grpid.
  ENDIF.

* F4 help
  CALL FUNCTION 'F4IF_INT_TABLE_VALUE_REQUEST'
       EXPORTING
            retfield        = u_value1
            dynpprog        = l_progname
            dynpnr          = l_dynnum
            dynprofield     = u_value2
            value_org       = 'S'
       TABLES
            value_tab       = lt_values
            return_tab      = lt_return
       EXCEPTIONS
            parameter_error = 1
            no_values_found = 2
            OTHERS          = 3.
  IF sy-subrc <> 0.
    MESSAGE ID sy-msgid TYPE sy-msgty NUMBER sy-msgno
            WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.
  ENDIF.

  CHECK NOT lt_return[] IS INITIAL.
  READ TABLE lt_return INDEX 1.
  u_val = lt_return-fieldval.

ENDFORM.                               " F_CHOOSE_SHDB
***************** END OF PROGRAM Z_ALV_SHDB_DOC ***********************