SAP R/3 форум ABAP консультантов
Russian ABAP Developer's Club

Home - FAQ - Search - Memberlist - Usergroups - Profile - Log in to check your private messages - Register - Log in - English
Blogs - Weblogs News

Infotype operations



 
Post new topic   Reply to topic    Russian ABAP Developer's Club Forum Index -> HR
View previous topic :: View next topic  
Author Message
admin
Администратор
Администратор



Joined: 01 Sep 2007
Posts: 1639

PostPosted: Fri May 22, 2009 2:45 pm    Post subject: Infotype operations Reply with quote

Source from: http: /saper.egloos.com/332040

Code:
FUNCTION Z_HR_INFOTYPE_OPERATION.
*"----------------------------------------------------------------------
*"*"Local interface:
*"  IMPORTING
*"     VALUE(INFTY) LIKE  PRELP-INFTY
*"     VALUE(NUMBER) LIKE  P0001-PERNR
*"     VALUE(SUBTYPE) LIKE  P0001-SUBTY OPTIONAL
*"     VALUE(OBJECTID) LIKE  P0001-OBJPS OPTIONAL
*"     VALUE(LOCKINDICATOR) LIKE  P0001-SPRPS OPTIONAL
*"     VALUE(VALIDITYEND) LIKE  P0001-ENDDA OPTIONAL
*"     VALUE(VALIDITYBEGIN) LIKE  P0001-BEGDA OPTIONAL
*"     VALUE(RECORDNUMBER) LIKE  P0001-SEQNR OPTIONAL
*"     VALUE(RECORD)
*"     VALUE(OPERATION) LIKE  PSPAR-ACTIO
*"     VALUE(TCLAS) LIKE  PSPAR-TCLAS DEFAULT 'A'
*"     VALUE(DIALOG_MODE) TYPE  C DEFAULT '0'
*"     VALUE(NOCOMMIT) LIKE  BAPI_STAND-NO_COMMIT OPTIONAL
*"     VALUE(VIEW_IDENTIFIER) LIKE  P0003-VIEKN OPTIONAL
*"     VALUE(SECONDARY_RECORD) OPTIONAL
*"  EXPORTING
*"     VALUE(RETURN) LIKE  BAPIRETURN1 STRUCTURE  BAPIRETURN1
*"     VALUE(KEY) LIKE  BAPIPAKEY STRUCTURE  BAPIPAKEY
*"  EXCEPTIONS
*"      INFTY_NOT_FOUND
*"----------------------------------------------------------------------

DATA tabname  LIKE dntab-tabname VALUE 'P'.
  DATA strname LIKE t777d-ppnnn.
  DATA dbname  LIKE t777d-aptab.
  DATA: BEGIN OF i777d OCCURS 10,
          infty LIKE t777d-infty,
          ppnnn LIKE t777d-dbtab,
          dbtab LIKE t777d-dbtab,
          aptab LIKE t777d-dbtab,
        END OF i777d.
  DATA luw_mode.
  FIELD-SYMBOLS <field_value>.
  DATA retcd LIKE sy-subrc.

 DATA p0003 LIKE p0003 OCCURS   0 WITH HEADER LINE.         "XDPK000210
 DATA secondary_infty   LIKE t777d-infty.                   "XDPK000210
 DATA secondary_dbname  LIKE t777d-ppnnn.                   "XDPK000210
 DATA subrc LIKE sy-subrc.                                  "XDPK000210
 DATA par1 LIKE sy-msgv1.                                   "XDPK000210
 DATA: BEGIN OF i582v OCCURS   0,                           "XDPK000210
         molga LIKE t582v-molga,                            "XDPK000210
         infty LIKE t582v-infty,                            "XDPK000210
         vinft LIKE t582v-vinft,                            "XDPK000210
       END OF i582v.                                        "XDPK000210
 DATA: i582w LIKE t582w OCCURS   0 WITH HEADER LINE.        "XDPK000210
 DATA record_key LIKE pshdr.                                "XDPK000210
*DATA KEY_LENGTH TYPE P.                    "XDPK000210    "XDP UniCode

  FIELD-SYMBOLS <record> TYPE ANY.       "XDP UniCode
  FIELD-SYMBOLS <secondary_record> TYPE ANY.       "XDP UniCode

  DATA  modified_keys LIKE pskey OCCURS 0 WITH HEADER LINE.

  DATA: BEGIN OF nametab OCCURS 50.
          INCLUDE STRUCTURE dntab.
  DATA END OF nametab.

  DATA: proposed_values LIKE pprop OCCURS 0 WITH HEADER LINE.

  CONSTANTS: change           LIKE pspar-actio VALUE 'MOD',
             create           LIKE pspar-actio VALUE 'INS',
             delete           LIKE pspar-actio VALUE 'DEL',
             approve          LIKE pspar-actio VALUE 'EDQ',
             createsuccessor  LIKE pspar-actio VALUE 'COP',
             check_record     LIKE pspar-actio VALUE 'CHK'.

* v=========================== XRGN452928 ===========================v
  IF operation = delete.
    DATA typ.
    DATA comps TYPE i.
    DATA rec_key LIKE pskey.
    FIELD-SYMBOLS: <record_comp> TYPE ANY,
                  <rec_key_comp> TYPE ANY.
*   RECORD -> RECORD_KEY
    rec_key = record.
*   Clear RECORD
    CLEAR record.
*   RECORD_KEY -> RECORD
    DESCRIBE FIELD rec_key TYPE typ COMPONENTS comps.
    DO.
      ASSIGN COMPONENT sy-index OF STRUCTURE record TO
      <record_comp>.
      IF sy-subrc <> 0.
        EXIT.
      ENDIF.
      ASSIGN COMPONENT sy-index OF STRUCTURE rec_key TO
      <rec_key_comp>.
      IF sy-subrc <> 0.
        EXIT.
      ENDIF.
      <record_comp> = <rec_key_comp>.
      IF sy-index >= comps.
        EXIT.
      ENDIF.
    ENDDO.
  ENDIF.
* ^=========================== XRGN452928 ===========================^

  IF operation EQ change OR operation EQ delete
                         OR operation EQ approve.
    CALL FUNCTION 'HR_INFOTYPE_CHECKEXISTENCE'
      EXPORTING
        number        = number
        infty         = infty
        subtype       = subtype
        objectid      = objectid
        lockindicator = lockindicator
        validitybegin = validitybegin
        validityend   = validityend
        recordnumber  = recordnumber
        tclas         = tclas
      IMPORTING
        return        = return
      EXCEPTIONS
        OTHERS        = 0.
    IF NOT return IS INITIAL.
      EXIT.
    ENDIF.
  ENDIF.

  IF NOT view_identifier IS INITIAL.                        "XDPK000210
    IF tclas = 'B'.                                         "XDPK000210
      CALL FUNCTION 'BALW_BAPIRETURN_GET1'                  "XDPK000210
           EXPORTING                                        "XDPK000210
                type       = 'E'                            "XDPK000210
                cl         = 'PG'                           "XDPK000210
                number     = '429'                          "XDPK000210
           IMPORTING                                        "XDPK000210
                bapireturn = return                         "XDPK000210
           EXCEPTIONS                                       "XDPK000210
                OTHERS     = 1.                             "XDPK000210
      EXIT.                                                 "XDPK000210
    ENDIF.                                                  "XDPK000210
    CALL FUNCTION 'HR_READ_INFOTYPE'                        "XDPK000210
         EXPORTING                                          "XDPK000210
              tclas           = tclas                       "XDPK000210
              pernr           = number                      "XDPK000210
              infty           = '0003'                      "XDPK000210
         IMPORTING                                          "XDPK000210
              subrc           = subrc                       "XDPK000210
         TABLES                                             "XDPK000210
              infty_tab       = p0003                       "XDPK000210
         EXCEPTIONS                                         "XDPK000210
              infty_not_found = 1                           "XDPK000210
              OTHERS          = 2.                          "XDPK000210
    IF sy-subrc NE 0 OR subrc NE 0.                         "XDPK000210
      par1 = '0003'.                                        "XDPK000210
      CALL FUNCTION 'BALW_BAPIRETURN_GET1'                  "XDPK000210
           EXPORTING                                        "XDPK000210
                type       = 'E'                            "XDPK000210
                cl         = 'PG'                           "XDPK000210
                number     = '009'                          "XDPK000210
                par1       = par1                           "XDPK000210
           IMPORTING                                        "XDPK000210
                bapireturn = return                         "XDPK000210
           EXCEPTIONS                                       "XDPK000210
                OTHERS     = 1.                             "XDPK000210
      EXIT.                                                 "XDPK000210
    ENDIF.                                                  "XDPK000210
    READ TABLE p0003 INDEX 1.                               "XDPK000210
    IF p0003-viekn NE view_identifier.                      "XDPK000210
      CALL FUNCTION 'BALW_BAPIRETURN_GET1'                  "XDPK000210
           EXPORTING                                        "XDPK000210
                type       = 'E'                            "XDPK000210
                cl         = 'PG'                           "XDPK000210
                number     = '430'                          "XDPK000210
           IMPORTING                                        "XDPK000210
                bapireturn = return                         "XDPK000210
           EXCEPTIONS                                       "XDPK000210
                OTHERS     = 1.                             "XDPK000210
      EXIT.                                                 "XDPK000210
    ENDIF.                                                  "XDPK000210
  ENDIF.                                                    "XDPK000210

  REFRESH proposed_values.
  CLEAR   proposed_values.
  REFRESH modified_keys.
  CLEAR   modified_keys.

  IF nocommit IS INITIAL.
    luw_mode = '1'.
  ELSE.
    luw_mode = '0'.
  ENDIF.
  IF operation EQ check_record.
    luw_mode = '3'.
    operation = create.
  ENDIF.

*--- T777D ---------------------------------------------------------
  DESCRIBE TABLE i777d LINES sy-tabix.
  IF sy-tabix EQ 0.
    SELECT infty ppnnn dbtab aptab FROM t777d INTO TABLE i777d.
    SORT i777d.
  ENDIF.

  READ TABLE i777d WITH KEY infty = infty
             BINARY SEARCH.
  IF sy-subrc <> 0.
*   message a018(pn) with infty.                            "XDPK000210
    par1 = infty.                                           "XDPK000210
    CALL FUNCTION 'BALW_BAPIRETURN_GET1'                    "XDPK000210
         EXPORTING                                          "XDPK000210
              type       = 'A'                              "XDPK000210
              cl         = 'PN'                             "XDPK000210
              number     = '018'                            "XDPK000210
              par1       = par1                             "XDPK000210
         IMPORTING                                          "XDPK000210
              bapireturn = return                           "XDPK000210
         EXCEPTIONS                                         "XDPK000210
              OTHERS     = 1.                               "XDPK000210
    EXIT.                                                   "XDPK000210
  ENDIF.
  IF i777d-ppnnn IS INITIAL.
*   message a018(pn) with infty.                            "XDPK000210
    par1 = infty.                                           "XDPK000210
    CALL FUNCTION 'BALW_BAPIRETURN_GET1'                    "XDPK000210
         EXPORTING                                          "XDPK000210
              type       = 'A'                              "XDPK000210
              cl         = 'PN'                             "XDPK000210
              number     = '018'                            "XDPK000210
              par1       = par1                             "XDPK000210
         IMPORTING                                          "XDPK000210
              bapireturn = return                           "XDPK000210
         EXCEPTIONS                                         "XDPK000210
              OTHERS     = 1.                               "XDPK000210
    EXIT.                                                   "XDPK000210
  ELSE.
    tabname = i777d-ppnnn.
    strname = i777d-ppnnn.
  ENDIF.
  IF tclas = 'B'.
    IF i777d-aptab IS INITIAL.
*   message a018(pn) with infty.                            "XDPK000210
     par1 = infty.                                          "XDPK000210
     CALL FUNCTION 'BALW_BAPIRETURN_GET1'                   "XDPK000210
          EXPORTING                                         "XDPK000210
               type       = 'A'                             "XDPK000210
               cl         = 'PN'                            "XDPK000210
               number     = '018'                           "XDPK000210
               par1       = par1                            "XDPK000210
          IMPORTING                                         "XDPK000210
               bapireturn = return                          "XDPK000210
          EXCEPTIONS                                        "XDPK000210
               OTHERS     = 1.                              "XDPK000210
     EXIT.                                                  "XDPK000210
    ENDIF.
  ELSE.
    IF i777d-dbtab IS INITIAL.
*   message a018(pn) with infty.                            "XDPK000210
     par1 = infty.                                          "XDPK000210
     CALL FUNCTION 'BALW_BAPIRETURN_GET1'                   "XDPK000210
          EXPORTING                                         "XDPK000210
               type       = 'A'                             "XDPK000210
               cl         = 'PN'                            "XDPK000210
               number     = '018'                           "XDPK000210
               par1       = par1                            "XDPK000210
          IMPORTING                                         "XDPK000210
               bapireturn = return                          "XDPK000210
          EXCEPTIONS                                        "XDPK000210
               OTHERS     = 1.                              "XDPK000210
     EXIT.                                                  "XDPK000210
    ENDIF.
  ENDIF.


*--- T777D ---------------------------------------------------------

  READ TABLE nametab WITH KEY tabname = tabname.
  IF sy-subrc NE 0.
    CALL FUNCTION 'NAMETAB_GET'
      EXPORTING
        only    = 'T'
        tabname = tabname
      TABLES
        nametab = nametab.
  ENDIF.

  ASSIGN record TO <record> CASTING TYPE (tabname). "XDP UniCode

  MOVE infty TO proposed_values-infty.
  MOVE '00' TO proposed_values-seqnr.

* loop at nametab.                                          "XDPK000210
  LOOP AT nametab WHERE tabname = tabname.                  "XDPK000210

* XDP begin UniCode

*    IF OPERATION NE CHANGE.
*      PERFORM CHECK_INITIAL_VALUE
*                USING RECORD+NAMETAB-OFFSET(NAMETAB-INTLEN)
*                      RETCD.
*      CHECK RETCD EQ 0.
*    ENDIF.
*    IF NAMETAB-INTTYPE EQ 'D'.
*      ASSIGN RECORD+NAMETAB-OFFSET(NAMETAB-INTLEN)
*             TO <FIELD_VALUE>.
*    ELSEIF NAMETAB-INTTYPE EQ 'P'.
*      ASSIGN RECORD+NAMETAB-OFFSET(NAMETAB-INTLEN)
*             TO <FIELD_VALUE> TYPE NAMETAB-INTTYPE
*                              DECIMALS NAMETAB-DECIMALS.
*    ELSE.
*      ASSIGN RECORD+NAMETAB-OFFSET(NAMETAB-INTLEN)
*             TO <FIELD_VALUE> TYPE NAMETAB-INTTYPE.
*    ENDIF.

    IF nametab-inttype EQ 'D'.
      ASSIGN COMPONENT sy-tabix OF
             STRUCTURE <record>
             TO <field_value>.
    ELSEIF nametab-inttype EQ 'P'.
      ASSIGN COMPONENT sy-tabix OF
             STRUCTURE <record>
             TO <field_value> TYPE nametab-inttype
                              DECIMALS nametab-decimals.
    ELSE.
      ASSIGN COMPONENT sy-tabix OF
             STRUCTURE <record>
             TO <field_value> TYPE nametab-inttype.
    ENDIF.

    IF operation NE change.
      CHECK NOT <field_value> IS INITIAL. "continue loop
    ENDIF.

* XDP end UniCode

    MOVE <field_value> TO proposed_values-fval.
    CONCATENATE strname  '-' nametab-fieldname
                       INTO proposed_values-fname.
    APPEND proposed_values.
  ENDLOOP.

*-------------- following lines have been inserted (4.0C)  "XDPK000210
*-------------------------------------------------------------------
*--- secondary infotype --------------------------------------------
*-------------------------------------------------------------------

*--- T582v ---------------------------------------------------------
  DESCRIBE TABLE i582v LINES sy-tabix.
  IF sy-tabix EQ 0.
    SELECT molga infty vinft FROM t582v INTO TABLE i582v.
    SORT i582v.
  ENDIF.

*--- T582w ---------------------------------------------------------
  DESCRIBE TABLE i582w LINES sy-tabix.
  IF sy-tabix EQ 0.
    SELECT * FROM t582w INTO TABLE i582w.
    SORT i582w.
  ENDIF.

  READ TABLE i582v WITH KEY molga = view_identifier infty = infty
             BINARY SEARCH.
  IF sy-subrc = 0.
    READ TABLE i582w WITH KEY vinft = i582v-vinft
                              seqnr = '1'
                              infty = infty
               BINARY SEARCH.
    IF sy-subrc = 0.
      READ TABLE i582w WITH KEY vinft = i582v-vinft
                                seqnr = '2'
                 BINARY SEARCH.
      IF sy-subrc = 0.
        MOVE i582w-infty  TO secondary_infty.
      ENDIF.
    ENDIF.
  ENDIF.
  IF NOT secondary_infty IS INITIAL.
    READ TABLE i777d WITH KEY infty = secondary_infty
               BINARY SEARCH.
    IF sy-subrc <> 0.
      par1 = infty.
      CALL FUNCTION 'BALW_BAPIRETURN_GET1'
        EXPORTING
          type       = 'A'
          cl         = 'PN'
          number     = '018'
          par1       = par1
        IMPORTING
          bapireturn = return
        EXCEPTIONS
          OTHERS     = 1.
      EXIT.
    ENDIF.
    IF i777d-ppnnn IS INITIAL.
      par1 = infty.
      CALL FUNCTION 'BALW_BAPIRETURN_GET1'
        EXPORTING
          type       = 'A'
          cl         = 'PN'
          number     = '018'
          par1       = par1
        IMPORTING
          bapireturn = return
        EXCEPTIONS
          OTHERS     = 1.
      EXIT.
    ELSE.
      secondary_dbname = i777d-ppnnn.
    ENDIF.
    IF tclas = 'B'.
      IF i777d-aptab IS INITIAL.
        par1 = infty.
        CALL FUNCTION 'BALW_BAPIRETURN_GET1'
          EXPORTING
            type       = 'A'
            cl         = 'PN'
            number     = '018'
            par1       = par1
          IMPORTING
            bapireturn = return
          EXCEPTIONS
            OTHERS     = 1.
        EXIT.
      ENDIF.
    ELSE.
      IF i777d-dbtab IS INITIAL.
        par1 = infty.
        CALL FUNCTION 'BALW_BAPIRETURN_GET1'
          EXPORTING
            type       = 'A'
            cl         = 'PN'
            number     = '018'
            par1       = par1
          IMPORTING
            bapireturn = return
          EXCEPTIONS
            OTHERS     = 1.
        EXIT.
      ENDIF.
    ENDIF.

    READ TABLE nametab WITH KEY tabname = secondary_dbname.
    IF sy-subrc NE 0.
      CALL FUNCTION 'NAMETAB_GET'
        EXPORTING
          only    = 'T'
          tabname = secondary_dbname
        TABLES
          nametab = nametab.
    ENDIF.

    MOVE infty TO proposed_values-infty.
    MOVE '00' TO proposed_values-seqnr.

*   DESCRIBE FIELD RECORD_KEY LENGTH KEY_LENGTH. "XDP UniCode
    MOVE record TO record_key.
    record_key-infty = secondary_infty.
* begin XDP UniCode
*   MOVE RECORD_KEY TO SECONDARY_RECORD(KEY_LENGTH).
    MOVE-CORRESPONDING record_key TO secondary_record.

    ASSIGN secondary_record
        TO <secondary_record>
        CASTING TYPE (secondary_dbname).
* end   XDP UniCode

    LOOP AT nametab WHERE tabname = secondary_dbname.

* begin XDP UniCode

*      IF OPERATION NE CHANGE.
*        PERFORM CHECK_INITIAL_VALUE
*          USING SECONDARY_RECORD+NAMETAB-OFFSET(NAMETAB-INTLEN)
*                        RETCD.
*        CHECK RETCD EQ 0.
*      ENDIF.
*      IF NAMETAB-INTTYPE EQ 'D'.
*        ASSIGN SECONDARY_RECORD+NAMETAB-OFFSET(NAMETAB-INTLEN)
*               TO <FIELD_VALUE>.
*      ELSEIF NAMETAB-INTTYPE EQ 'P'.
*        ASSIGN SECONDARY_RECORD+NAMETAB-OFFSET(NAMETAB-INTLEN)
*               TO <FIELD_VALUE> TYPE NAMETAB-INTTYPE
*                                DECIMALS NAMETAB-DECIMALS.
*      ELSE.
*        ASSIGN SECONDARY_RECORD+NAMETAB-OFFSET(NAMETAB-INTLEN)
*               TO <FIELD_VALUE> TYPE NAMETAB-INTTYPE.
*      ENDIF.

      IF nametab-inttype EQ 'D'.
        ASSIGN COMPONENT sy-tabix OF
               STRUCTURE <secondary_record>
               TO <field_value>.
      ELSEIF nametab-inttype EQ 'P'.
        ASSIGN COMPONENT sy-tabix OF
               STRUCTURE <secondary_record>
               TO <field_value> TYPE nametab-inttype
                                DECIMALS nametab-decimals.
      ELSE.
        ASSIGN COMPONENT sy-tabix OF
               STRUCTURE <secondary_record>
               TO <field_value> TYPE nametab-inttype.
      ENDIF.

      IF operation NE change.
        CHECK NOT <field_value> IS INITIAL. "continue loop
      ENDIF.

* end   XDP UniCode

      MOVE <field_value> TO proposed_values-fval.
      CONCATENATE secondary_dbname  '-' nametab-fieldname
                         INTO proposed_values-fname.
      APPEND proposed_values.
    ENDLOOP.
  ENDIF.
*-------------- preceding lines have been inserted (4.0C)  "XDPK000210

  CALL FUNCTION 'HR_MAINTAIN_MASTERDATA'
    EXPORTING
      pernr           = number
      actio           = operation
      tclas           = tclas
      begda           = validitybegin
      endda           = validityend
      objps           = objectid
      seqnr           = recordnumber
      sprps           = lockindicator
      subty           = subtype
      luw_mode        = luw_mode
      dialog_mode     = dialog_mode
      no_enqueue      = 'X'
    IMPORTING
      return1         = return
    TABLES
      proposed_values = proposed_values
      modified_keys   = modified_keys
    EXCEPTIONS
      OTHERS          = 0.
  IF return IS INITIAL.
    READ TABLE modified_keys INDEX 1.
    MOVE modified_keys(8) TO key(8).
    MOVE modified_keys+12 TO key+8.
  ELSE.
    IF NOT nocommit IS INITIAL.
      ROLLBACK WORK.
    ENDIF.
  ENDIF.

ENDFUNCTION.
Back to top
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic    Russian ABAP Developer's Club Forum Index -> HR All times are GMT + 4 Hours
Page 1 of 1

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum
You cannot attach files in this forum
You can download files in this forum


All product names are trademarks of their respective companies. SAPNET.RU websites are in no way affiliated with SAP AG.
SAP, SAP R/3, R/3 software, mySAP, ABAP, BAPI, xApps, SAP NetWeaver and any other are registered trademarks of SAP AG.
Every effort is made to ensure content integrity. Use information on this site at your own risk.