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

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

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

В программе :

SELECT-OPTIONSpa_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.


  DATAdt_tabs TYPE stab OCCURS WITH HEADER LINE.
  DATAit_return LIKE ddshretval OCCURS WITH HEADER LINE.


  DATAwa_fields LIKE sval,
         li_fields TYPE STANDARD TABLE OF sval WITH HEADER LINE.

RANGESpa_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-objiddt_tabs-otypedt_tabs-shortdt_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.
    REFRESHpa_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.

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

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