Posted: Fri May 22, 2009 2:45 pm Post subject: Infotype operations
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
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.
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.
