четверг, 28 мая 2015 г.

Средство поиска текста С-должности на дату

Постоянно сталкиваюсь с построением средства поиска к какой-либо таблице с данными. 

В программе :

SELECT-OPTIONS: pa_objid FOR hrp1000-objid NO INTERVALS.

*** Средство поиска  ***
AT SELECTION-SCREEN ON VALUE-REQUEST FOR pa_objid-low.
  PERFORM get_objid.


FORM get_objid.
  REFRESH dt_tabs.

  CALL FUNCTION 'ZHR_READ_C_PLANS'
    TABLES
      p_objid = pa_objid.

  IF pa_objid[] IS NOT INITIAL.
    READ TABLE pa_objid INDEX 1.
  ENDIF.
ENDFORM
.           


ФМ для поиска и формирования данных:

FUNCTION zhr_read_c_plans.
*"----------------------------------------------------------------------
*"*"Локальный интерфейс:
*"  TABLES
*"      P_OBJID
*"----------------------------------------------------------------------

  TYPES:
        BEGIN OF stab,
          plvar LIKE hrp1000-plvar,
          otype LIKE hrp1000-otype,
          objid LIKE hrp1000-objid,
          priox LIKE hrp1001-priox, " приоритет  для сортировки должностей
          sobid LIKE hrp1001-sobid,
          short LIKE p1000-short, " Код КП
         END OF stab.

  DATA:
        BEGIN OF ftab OCCURS 0,
          objid LIKE hrp1000-objid,
          short LIKE p1000-short, " Код КП
          stext TYPE zhr_char255, " Название должности
         END OF ftab.


  DATA: dt_tabs TYPE stab OCCURS 0 WITH HEADER LINE.
  DATA: it_return LIKE ddshretval OCCURS 0 WITH HEADER LINE.


  DATA: wa_fields LIKE sval,
         li_fields TYPE STANDARD TABLE OF sval WITH HEADER LINE.

RANGES: pa_objid FOR hrp1000-objid.

**********************************************************************
  MOVE 'Q1005' TO wa_fields-tabname.
  MOVE 'INDDA' TO wa_fields-fieldname.
  APPEND wa_fields TO li_fields.

  CALL FUNCTION 'POPUP_GET_VALUES'
    EXPORTING
*   NO_VALUE_CHECK        = ' '
      popup_title           = 'Выберите дату'
     start_column          = '5'
     start_row             = '5'
* IMPORTING
*   RETURNCODE            =
    TABLES
      fields                =  li_fields
   EXCEPTIONS
     error_in_fields       = 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.

  CHECK  li_fields IS NOT INITIAL.
  READ TABLE li_fields INDEX 1.
  sdate = li_fields-value.

  SELECT plvar priox sobid FROM hrp1001
      INTO CORRESPONDING FIELDS OF TABLE dt_tabs
            WHERE otype = 'CZ'
              AND plvar = '01'
              AND begda <= sdate
              AND endda >= sdate.

  LOOP AT dt_tabs.
    SELECT SINGLE objid otype short stext FROM hrp1000 INTO
          (dt_tabs-objid, dt_tabs-otype, dt_tabs-short, dt_tabs-stext)
            WHERE otype = 'C'
              AND plvar = '01'
              AND objid = dt_tabs-sobid
              AND begda <= sdate
              AND endda >= sdate.

    PERFORM search_ltext USING '70' dt_tabs-objid CHANGING dt_tabs-stext_70.

    MODIFY dt_tabs ."index sy-tabix.
    CLEAR dt_tabs.

  ENDLOOP.

  SORT dt_tabs BY priox objid.

  LOOP AT dt_tabs.
    MOVE-CORRESPONDING dt_tabs TO ftab.
    APPEND ftab.
    CLEAR ftab.
  ENDLOOP.

  CALL FUNCTION 'F4IF_INT_TABLE_VALUE_REQUEST'
    EXPORTING
      retfield        = 'OBJID'
      value_org       = 'S'
      multiple_choice = 'X'
    TABLES
      value_tab       = ftab
      return_tab      = it_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.


  IF it_return[] IS NOT INITIAL.
    REFRESH: pa_objid.
  LOOP AT it_return.
    pa_objid-sign = 'I'.
    pa_objid-option = 'EQ'.
    pa_objid-low = it_return-FIELDVAL.
    APPEND pa_objid.
  ENDLOOP.
  p_objid[] = pa_objid[].
  ENDIF.

ENDFUNCTION.

Комментариев нет:

Отправить комментарий