I'M trying to change LQ02 program to zlq02 to add the document hearder text(mkpf-bktxt) field to the selection screen, so that when the IM material documents is are created it can populate the document header text with that data on each material document.
here is the program for lq02
REPORT RLLQ0200 NO STANDARD PAGE HEADING
MESSAGE-ID L3.
*{SEL-OPT Begin} http://intranet.sap.com/materialversion
*Do not change coding between begin and end comments PA9 20040220
INITIALIZATION.
DATA: mgv_matnr_prog LIKE rsvar-report,
mgv_matnr_selopt_tab like rsldbdfs occurs 0 with header line.
FIELD-SYMBOLS .
ENDIF.
ENDLOOP.
*{SEL-OPT End}
*----
*
Umbuchen in WM und IM *
Listausgabe über FB mit ALV *
*----
*
INCLUDE .
TABLES: LAGP , " Lagerplätze
LQUA , " Lagerquants
LEIN , " Lagereeinheiten
LUBUI, " Übergabestruktur FB
MAKT , " Materialkurztexte
MSEG , " Materialkurztexte
RLIST,
RL034, " Struktur für RLS10034
RLDRU,
RL01S, " E/A-Felder für Stammdaten
LMESS,
T300T,
T301T,
T333 ,
T333T,
T329F,
T300 ,
T331 , " Lagertypsteuerung
T333U, " Umbuchungssteuerung
T340D. " Lagernummerndefinition
*----
*
Konstanten *
*----
*
*......Farben..........................................................
TYPES: FARBE(3) TYPE C.
CONSTANTS: WHITE TYPE FARBE VALUE 'C20', " weiß, intensified off
YELLOW TYPE FARBE VALUE 'C30', " gelb, intensified off
RED TYPE FARBE VALUE 'C60', " rot, intensified off
GREEN TYPE FARBE VALUE 'C50'. " grün, intensified off
.........Umbuchungsvarianten.........................................
DATA: UMB_VARI_BESTQ(1) TYPE C VALUE 'B', "Umbuchung Bestandsq.
UMB_VARI_SOBKZ(1) TYPE C VALUE 'S'. "Umbuchung Sonderbst.
.........Sonderbestandsumbuchen......................................
DATA: UMB_SOBKZ_SPACE_KONSI(2) TYPE C VALUE ' K', "Umb. an Konsi
UMB_SOBKZ_KONSI_SPACE(2) TYPE C VALUE 'K ', "Umb. aus Konsi
UMB_SOBKZ_SPACE_EINZL(2) TYPE C VALUE ' E', "Umb. an Einzelbst.
UMB_SOBKZ_EINZL_SPACE(2) TYPE C VALUE 'E ', "Umb. aus Einzelbst.
UMB_SOBKZ_SPACE_MEHRW(2) TYPE C VALUE ' M', "Umb. an Mehrweg
UMB_SOBKZ_MEHRW_SPACE(2) TYPE C VALUE 'M ', "Umb. aus Mehrweg
UMB_SOBKZ_SPACE_PROJN(2) TYPE C VALUE ' Q', "Umb. an Projekt
UMB_SOBKZ_PROJN_SPACE(2) TYPE C VALUE 'Q '. "Umb. aus Projekt
.........Bestandsqualifikationen.....................................
DATA: CON_BESTQ_QUALITAET(1) TYPE C VALUE 'Q', "Qualitätsprüfbestand
CON_BESTQ_GESPERRT(1) TYPE C VALUE 'S', "Gesperrter Bestand
CON_BESTQ_RETOURE(1) TYPE C VALUE 'R'. "Retourenbestand
.........Listvarianten...............................................
DATA: UMB_LISTE_MATNR(1) TYPE C VALUE 'M', "Umbuch. für Material
UMB_LISTE_LGTYP(1) TYPE C VALUE 'L'. "Umbuch. für Lag.typ
*........Allgemeine LVS-Konstanten.....................................
INCLUDE MLLVSKON.
*----
*
Hilfsfelder *
*----
*
DATA: SAV_SY_REPID LIKE SY-REPID,
SAV_LGPLA LIKE LQUA-LGPLA,
SAV_LGTYP LIKE LQUA-LGTYP,
SAV_LQNUM LIKE LQUA-LQNUM,
SAV_INDEX LIKE SY-INDEX,
SAV_LENUM LIKE LQUA-LENUM,
SAV_TABIX LIKE SY-TABIX,
FLG_NO_MARK TYPE C,
FLG_ERROR TYPE C,
FLG_DIFF TYPE C,
FLG_DUNKL TYPE C,
FLG_SOBUB TYPE C,
HLP_TANUM LIKE LTAK-TANUM,
HLP_MJAHR LIKE MSEG-MJAHR,
HLP_MBLNR LIKE MSEG-MBLNR,
HLP_FARBE LIKE RL034-FARBE,
HLP_IKONE LIKE RL034-IKONE,
HLP_TEXT(300) TYPE C.
DATA: UMB_VARI(1) TYPE C, "Umb.variante BQ/Sond
UMB_SOBKZ(2) TYPE C, "Umb. Sond. E/K/M/Q
UMB_LISTE(1) TYPE C, "Listvariante Mat/Lag
UMB_ERROR(1) TYPE C. "Fehler bei Umbuchung
*----
*
Interne Tabellen *
*----
*
DATA: ITAB LIKE RL034 OCCURS 0 WITH HEADER LINE.
DATA: BEGIN OF SELTAB OCCURS 0.
INCLUDE STRUCTURE RSPARAMS.
DATA: END OF SELTAB.
DATA: T_LTAP_CREAT LIKE LTAP_CREAT OCCURS 0 WITH HEADER LINE.
DATA: BEGIN OF ILUBQU OCCURS 20.
INCLUDE STRUCTURE LUBQU.
DATA: END OF ILUBQU.
DATA: BEGIN OF ILQUA_IM OCCURS 0.
INCLUDE STRUCTURE LQUA_IM.
DATA: END OF ILQUA_IM.
DATA: BEGIN OF T_IMSEG OCCURS 0.
INCLUDE STRUCTURE IMSEG.
DATA: END OF T_IMSEG.
DATA: BEGIN OF T_EMKPF OCCURS 0.
INCLUDE STRUCTURE EMKPF.
DATA: END OF T_EMKPF.
DATA: BEGIN OF T_LQUA_PROT OCCURS 0.
INCLUDE STRUCTURE LQUA_PROT.
DATA: END OF T_LQUA_PROT.
DATA: BEGIN OF T_LQUA_PROT_2 OCCURS 0.
INCLUDE STRUCTURE LQUA_PROT.
DATA: END OF T_LQUA_PROT_2.
DATA: BEGIN OF TAP OCCURS 0.
INCLUDE STRUCTURE LTAP_VB.
DATA: END OF TAP.
DATA: BEGIN OF KOPF.
INCLUDE STRUCTURE IMKPF.
DATA: END OF KOPF.
*........Tabelle der erzeugten IDOCs....................................
DATA: T_IDOC_PROT LIKE SWOTOBJID OCCURS 0 WITH HEADER LINE.
RANGES: R_LGTYP FOR T331-LGTYP.
*----
*
Daten für den ALV *
*----
*
TYPE-POOLS: SLIS.
DATA: XHEADER TYPE SLIS_T_LISTHEADER WITH HEADER LINE.
DATA: VARIANT LIKE DISVARIANT.
*----
*
Sonstige Daten *
*----
*
DATA: RETURNCODE TYPE C,
RETCODE LIKE SY-SUBRC.
DATA: SICHT TYPE C VALUE 'Q'.
DATA: LNUMT LIKE T300T-LNUMT,
LTYPT LIKE T301T-LTYPT.
*----
*
INITIALIZATION *
*----
*
INITIALIZATION.
SET TITLEBAR '002'.
*......Selektions- und Steuerdaten.....................................
SELECT-OPTIONS: SOBKZ FOR LQUA-SOBKZ NO INTERVALS
NO-EXTENSION.
PARAMETERS: PA_LSONR LIKE RL01S-LSONR.
SELECT-OPTIONS: BESTQ FOR LQUA-BESTQ NO INTERVALS
NO-EXTENSION.
PARAMETERS: PA_BWLVS LIKE T333U-BWLVS MEMORY ID BWL OBLIGATORY.
SELECTION-SCREEN SKIP 1.
*......Selektionskriterien.............................................
SELECTION-SCREEN BEGIN OF BLOCK XXX WITH FRAME TITLE TEXT-100.
SELECT-OPTIONS: MATNR FOR LQUA-MATNR.
SELECT-OPTIONS: WERKS FOR LQUA-WERKS.
SELECT-OPTIONS: LGORT FOR LQUA-LGORT.
SELECT-OPTIONS: CHARG FOR LQUA-CHARG.
SELECT-OPTIONS: WEDAT FOR LQUA-WDATU.
SELECT-OPTIONS: WENUM FOR LQUA-WENUM.
SELECTION-SCREEN END OF BLOCK XXX.
*......Steuerdaten.....................................................
SELECTION-SCREEN BEGIN OF BLOCK YYY WITH FRAME TITLE TEXT-101.
PARAMETERS: PA_BLDAT LIKE IMKPF-BLDAT DEFAULT SY-DATLO.
PARAMETERS: PA_BUDAT LIKE IMKPF-BUDAT DEFAULT SY-DATLO.
PARAMETERS: PA_KZMAI LIKE RL03T-KZMAI.
PARAMETERS: PA_DUNKL LIKE RL03T-DUNKL.
PARAMETERS: PA_LISTV LIKE DISVARIANT-VARIANT.
SELECTION-SCREEN END OF BLOCK YYY.
*----
*
AT SELECTION SCREEN ON VALUE-REQUEST *
*----
*
AT SELECTION-SCREEN ON VALUE-REQUEST FOR PA_LISTV.
PERFORM F4_FOR_VARIANT.
AT SELECTION-SCREEN ON VALUE-REQUEST FOR PA_BWLVS.
PERFORM F4_FOR_BWLVS.
*----
*
AT-SELECTION-SCREEN *
*----
*
AT SELECTION-SCREEN.
*------- Authority-check -
*
If you need this authorization you will have to create a *
profile which comprises the authority object L_SFUNC. *
According to the values of L_SFUNC you are allowed to work *
with the reports or not. Add the profile to your user master *
But this is normal WM-Authorization -> See Customizing *
*----
*
PERFORM BERECHTIGUNG_SFUNC(SAPFL000)
USING CON_BER_MP CON_BER_SFUNC_2.
CHECK SY-SUBRC = 0.
*........Bewegungsart und Selektionen prüfen...........................
PERFORM SELEKTION_PRUEFEN.
*........Prüfen eingegebene Variante..................................
PERFORM CHECK_VARIANT_EXISTENCE.
*----
*
START-OF-SELECTION *
*----
*
START-OF-SELECTION.
CLEAR ITAB.
REFRESH ITAB.
IF ( PA_DUNKL EQ CON_HELL ) OR ( PA_DUNKL IS INITIAL ).
CLEAR FLG_DUNKL.
ELSEIF PA_DUNKL EQ CON_DUNKEL.
*........Dunkel Umbuchen, ohne Listausgabe.............................
FLG_DUNKL = CON_X.
ENDIF.
*----
*
GET LAGP *
*----
*
GET LAGP.
*----
*
GET LQUA *
*----
*
GET LQUA.
IF NOT RL01S-SONUM IS INITIAL.
CHECK LQUA-SONUM = RL01S-SONUM.
ENDIF.
CLEAR ITAB.
*........Platzposition in MISCH_PLATZ einmischen.......................
IF LQUA-PLPOS NE SPACE.
CALL FUNCTION 'L_PLATZ_POSITION_MISCHEN'
EXPORTING
LGPLA = LQUA-LGPLA
PLPOS = LQUA-PLPOS
IMPORTING
O_LGPLA = ITAB-MISCH_PLATZ.
ELSE.
ITAB-MISCH_PLATZ = LQUA-LGPLA.
ENDIF.
*......Daten in interne Tabelle übertragen.............................
MOVE-CORRESPONDING LQUA TO ITAB.
MOVE-CORRESPONDING LAGP TO ITAB.
*........doppelte Felder einzeln einfügen (aus LAGP und LQUA)..........
MOVE: LQUA-LGPLA TO ITAB-LQUA_LGPLA,
LQUA-LGNUM TO ITAB-LQUA_LGNUM,
LQUA-LGTYP TO ITAB-LQUA_LGTYP,
LQUA-SKZUA TO ITAB-LQUA_SKZUA,
LQUA-SKZUE TO ITAB-LQUA_SKZUE,
LQUA-SKZSA TO ITAB-LQUA_SKZSA,
LQUA-SKZSE TO ITAB-LQUA_SKZSE,
LQUA-SKZSI TO ITAB-LQUA_SKZSI,
LQUA-SPGRU TO ITAB-LQUA_SPGRU,
LQUA-BDATU TO ITAB-LQUA_BDATU,
LQUA-BZEIT TO ITAB-LQUA_BZEIT,
LQUA-BTANR TO ITAB-LQUA_BTANR,
LQUA-BTAPS TO ITAB-LQUA_BTAPS,
LQUA-MGEWI TO ITAB-LQUA_MGEWI,
LQUA-GEWEI TO ITAB-LQUA_GEWEI,
LQUA-IVNUM TO ITAB-LQUA_IVNUM,
LQUA-IVPOS TO ITAB-LQUA_IVPOS,
LQUA-KOBER TO ITAB-LQUA_KOBER.
*........zusätzliche Felder ergänzen...................................
IF LQUA-SOBKZ = SOBKZ_PROJEKT.
*........Konvertierung bei Sonderbestand Q.............................
PERFORM SONUM_CONV_INT_EXT(SAPFL000) USING LQUA-SOBKZ
LQUA-SONUM
RL01S-LSONR.
WRITE RL01S-LSONR TO ITAB-LSONR.
ELSE.
WRITE LQUA-SONUM TO ITAB-LSONR.
ENDIF.
*........Farbe initialisieren..........................................
MOVE WHITE TO ITAB-FARBE.
*........Selektierbarkeit Quant prüfen und setzen......................
PERFORM QUANT_PRUEFEN.
APPEND ITAB.
*----
*
END-OF-SELECTION *
*----
*
END-OF-SELECTION.
IF FLG_DUNKL IS INITIAL.
*........Listausgabe mit dem ALV.......................................
PERFORM LISTKOPF_AUFBAUEN.
PERFORM AUSGABE.
LEAVE TO TRANSACTION SY-TCODE.
ELSE.
*........Dunkel Umbuchen, ohne Listausgabe.............................
PERFORM UMBUCHEN.
ENDIF.
***********************************************************************
*
FORM-Routinen *
*
***********************************************************************
*----
*
Form AUSGABE *
*----
*
Ausgabe der selektierten Daten über FB mit ALV *
*----
*
--> ITAB Selektierte Daten aus LAGP und LQUA
*----
*
FORM AUSGABE.
SAV_SY_REPID = SY-REPID.
variant-variant = listv.
variant-handle = 'LQ02'.
variant-report = 'SAPLL01L'.
CALL FUNCTION 'L_QUANT_SELECT'
EXPORTING
I_REPID = SAV_SY_REPID
I_TITLE = '001'
I_STATUS = 'ALVSTAND'
I_HEADER = XHEADER[]
I_SICHT = SICHT "Default: Quantsicht
I_VARIANT = VARIANT
TABLES
T_LIST = ITAB
EXCEPTIONS
OTHERS = 0.
ENDFORM. " AUSGABE
*----
*
Form QUANT_PRUEFEN *
*----
*
Quant prüfen und entsprechende Ikone setzen *
*----
*
--> ITAB Selektierte Quants *
<-- ITAB Selektierte Quants mit passender Ikone *
*----
*
FORM QUANT_PRUEFEN.
*........Quants sind zunächst alle markierbar..........................
ITAB-IKONE = SYM_LARGE_SQUARE.
*........Quants mit negativer verfügbarer Menge nicht markierbar!......
IF ITAB-VERME LE 0.
ITAB-IKONE = SYM_LOCKED.
ITAB-MSGID = 'L1'.
ITAB-MSGNO = '604'.
ITAB-MSGTY = 'E'.
ENDIF.
*........Quants mit einzulagernden Mengen nicht markierbar!............
IF ITAB-EINME NE 0.
ITAB-IKONE = SYM_LOCKED.
ITAB-MSGID = 'L1'.
ITAB-MSGNO = '605'.
ITAB-MSGTY = 'E'.
ENDIF.
*........Quants mit auszulagernden Mengen nicht markierbar!............
IF ITAB-AUSME NE 0.
ITAB-IKONE = SYM_LOCKED.
ITAB-MSGID = 'L1'.
ITAB-MSGNO = '606'.
ITAB-MSGTY = 'E'.
ENDIF.
*........Quants mit Prüflos nicht markierbar falls Umbuchen mit 'Q'....
IF NOT ITAB-QPLOS IS INITIAL AND UMB_VARI = UMB_VARI_BESTQ and
( T333U-BSTQ1 = con_bestq_qualitaet or
T333U-BSTQ2 = con_bestq_qualitaet ).
ITAB-IKONE = SYM_LOCKED.
ITAB-MSGID = 'L1'.
ITAB-MSGNO = '611'.
ITAB-MSGTY = 'E'.
ENDIF.
*........gesperrte Quants (Auslagerung, Inventur) nicht markierbar!....
IF NOT ITAB-LQUA_SKZUA IS INITIAL
OR NOT ITAB-LQUA_SKZUE IS INITIAL
OR NOT ITAB-LQUA_SKZSA IS INITIAL
OR NOT ITAB-LQUA_SKZSE IS INITIAL
OR NOT ITAB-LQUA_SKZSI IS INITIAL
OR NOT ITAB-SKZUA IS INITIAL
OR NOT ITAB-SKZUE IS INITIAL
OR NOT ITAB-SKZSA IS INITIAL
OR NOT ITAB-SKZSE IS INITIAL
OR NOT ITAB-SKZSI IS INITIAL.
ITAB-IKONE = SYM_LOCKED.
ITAB-MSGID = 'L1'.
ITAB-MSGNO = '607'.
ITAB-MSGTY = 'E'.
ENDIF.
*........Quants auf Lagereinheiten 'in Bewegung' nicht markierbar!.....
IF NOT ITAB-LENUM IS INITIAL.
SELECT SINGLE * FROM LEIN WHERE LENUM = ITAB-LENUM.
IF SY-SUBRC = 0 AND LEIN-STATU NE ' '.
ITAB-IKONE = SYM_LOCKED.
ITAB-MSGID = 'L1'.
ITAB-MSGNO = '608'.
ITAB-MSGTY = 'E'.
ENDIF.
ENDIF.
*........Quants auf noch nicht WE-gebuchten HU's nicht markierbar
IF NOT ITAB-LENUM IS INITIAL.
SELECT SINGLE * FROM LEIN WHERE LENUM = ITAB-LENUM.
IF SY-SUBRC = 0 AND LEIN-WESTA NE ' '.
ITAB-IKONE = SYM_LOCKED.
ITAB-MSGID = 'L1'.
ITAB-MSGNO = '617'.
ITAB-MSGTY = 'E'.
ENDIF.
ENDIF.
*........Quants in Lagertyp mit Blocklager und LE nicht markierbar !...
IF T331-LGNUM NE S1_LGNUM OR T331-LGTYP NE ITAB-LGTYP.
SELECT SINGLE * FROM T331 WHERE LGNUM = S1_LGNUM
AND LGTYP = ITAB-LGTYP.
ENDIF.
IF T331-STEIN = 'B' AND NOT T331-LENVW IS INITIAL.
ITAB-IKONE = SYM_LOCKED.
ITAB-MSGID = 'L1'.
ITAB-MSGNO = '612'.
ITAB-MSGTY = 'E'.
ENDIF.
*........Bei Dunkelablauf Quants sofort selektieren....................
IF FLG_DUNKL EQ CON_X AND NOT ITAB-IKONE = SYM_LOCKED.
ITAB-IKONE = SYM_CHECKBOX.
ENDIF.
ENDFORM. " QUANT_PRUEFEN
*----
*
Form USER_COMMAND *
*----
*
User-Commands abarbeiten *
*----
*
FORM USER_COMMAND USING R_UCOMM LIKE SY-UCOMM.
CASE R_UCOMM.
WHEN 'UMBU'.
*........Prüfen, ob etwas markiert wurde...............................
READ TABLE ITAB WITH KEY IKONE = SYM_CHECKBOX
TRANSPORTING NO FIELDS.
IF SY-SUBRC NE 0.
MESSAGE E594.
Markieren Sie zuerst die zu bearbeitenden Positionen
ENDIF.
*........Popup-Felder initialisieren...................................
CLEAR: SAV_LGTYP,
SAV_LGPLA,
LAGP,
LEIN,
RLDRU,
RETURNCODE.
PERFORM UMBUCHEN.
WHEN 'REFR'.
*........Liste auffrischen.............................................
SAV_SY_REPID = SY-REPID.
CALL FUNCTION 'RS_REFRESH_FROM_SELECTOPTIONS'
EXPORTING
CURR_REPORT = SAV_SY_REPID
TABLES
SELECTION_TABLE = SELTAB.
exceptions
not_found = 1
no_report = 2
others = 3.
IF SY-SUBRC = 0.
Check if dynamic selections are made "v_n_659727
type-pools: rsds.
data: ls_trange type rsds_trange.
data: texpr type rsds_texpr.
CALL FUNCTION 'RS_REFRESH_FROM_DYNAMICAL_SEL'
EXPORTING
CURR_REPORT = sav_sy_repid
MODE_WRITE_OR_MOVE = 'M'
IMPORTING
P_TRANGE = LS_TRANGE
EXCEPTIONS
NOT_FOUND = 1
WRONG_TYPE = 2
OTHERS = 3
.
IF SY-SUBRC > 1.
MESSAGE ID SY-MSGID TYPE SY-MSGTY NUMBER SY-MSGNO
WITH SY-MSGV1 SY-MSGV2 SY-MSGV3 SY-MSGV4.
ELSE.
call function 'FREE_SELECTIONS_RANGE_2_EX'
EXPORTING
field_ranges = ls_trange
IMPORTING
expressions = texpr.
submit (sav_sy_repid) with selection-table seltab
with free selections texpr.
ENDIF. "^_n_659727
ENDIF.
ENDCASE.
ENDFORM. " USER_COMMAND
*----
*
Form F4_FOR_VARIANT *
*----
*
F4-Hilfe für Anzeigevariante *
*----
*
FORM F4_FOR_VARIANT.
VARIANT-REPORT = 'SAPLL01L'.
VARIANT-HANDLE = 'LQ02'.
CALL FUNCTION 'REUSE_ALV_VARIANT_F4'
EXPORTING
IS_VARIANT = VARIANT
I_SAVE = 'A'
IMPORTING
ES_VARIANT = VARIANT
EXCEPTIONS
NOT_FOUND = 2.
IF SY-SUBRC = 2.
MESSAGE S205(0K).
Keine Auswahl vorhanden!
ELSE.
PA_LISTV = VARIANT-VARIANT.
ENDIF.
ENDFORM. " F4_FOR_VARIANT
*----
*
Form CHECK_VARIANT_EXISTENCE *
*----
*
Prüfung, ob selektierte Variante vorhanden *
*----
*
FORM CHECK_VARIANT_EXISTENCE.
IF NOT PA_LISTV IS INITIAL.
MOVE: PA_LISTV TO VARIANT-VARIANT,
'LQ02' TO VARIANT-HANDLE,
'SAPLL01L' TO VARIANT-REPORT.
CALL FUNCTION 'REUSE_ALV_VARIANT_EXISTENCE'
EXPORTING
I_SAVE = 'A'
CHANGING
CS_VARIANT = VARIANT.
ENDIF.
ENDFORM. " CHECK_VARIANT_EXISTENCE
*----
*
Form PLATZ_SPERREN *
*----
*
Platz zur weiteren Verarbeitung sperren *
*----
*
-->P_ITAB_LGTYP Lagertyp *
-->P_ITAB_LGPLA Lagerplatz *
*----
*
FORM PLATZ_SPERREN USING P_ITAB_LGTYP P_ITAB_LGPLA.
CALL FUNCTION 'L_BIN_LOCATION_ENQUEUE'
EXPORTING
I_LGNUM = S1_LGNUM
I_LGTYP = P_ITAB_LGTYP
I_LGPLA = P_ITAB_LGPLA
I_LENUM = ' '
I_ENQUE = ' '
EXCEPTIONS
ERROR_MESSAGE = 99.
ENDFORM. " PLATZ_SPERREN
*----
*
Form ERROR_MESSAGE *
*----
*
Fehlermeldung aufbereiten *
*----
*
-->IV_MSGID Message-ID *
-->IV_MSGTY Message-Typ *
-->IV_MSGNO Message-Nummer *
-->IV_MSGV1 Message-Variable 1 *
-->IV_MSGV2 Message-Variable 2 *
-->IV_MSGV3 Message-Variable 3 *
-->IV_MSGV4 Message-Variable 4 *
*----
*
FORM ERROR_MESSAGE using value(iv_msgid) like sy-msgid
value(iv_msgty) like sy-msgty
value(iv_msgno) like sy-msgno
value(iv_msgv1) like sy-msgv1
value(iv_msgv2) like sy-msgv2
value(iv_msgv3) like sy-msgv3
value(iv_msgv4) like sy-msgv4.
ITAB-MSGID = iv_MSGID.
ITAB-MSGTY = iv_MSGTY.
ITAB-MSGNO = iv_MSGNO.
ITAB-MSGV1 = iv_MSGV1.
ITAB-MSGV2 = iv_MSGV2.
ITAB-MSGV3 = iv_MSGV3.
ITAB-MSGV4 = iv_MSGV4.
ENDFORM. " ERROR_MESSAGE
*----
*
Form L_TO_CREATE_SINGLE *
*----
*
Funktionsbaustein L_TO_CREATE_SINGLE aufrufen *
*----
*
FORM L_TO_CREATE_SINGLE.
CALL FUNCTION 'L_TO_CREATE_SINGLE'
EXPORTING
I_LGNUM = ITAB-LGNUM
I_BWLVS = PA_BWLVS
I_BETYP = ' '
I_BENUM = ' '
I_MATNR = ITAB-MATNR
I_WERKS = ITAB-WERKS
I_CHARG = ITAB-CHARG
I_BESTQ = ITAB-BESTQ
I_SOBKZ = ITAB-SOBKZ
I_SONUM = ITAB-SONUM
I_LETYP = LEIN-LETYP
I_ANFME = ITAB-VERME
I_ALTME = ITAB-MEINS
I_WDATU = SY-DATLO
I_VFDAT = INIT_DATUM
I_ZEUGN = ' '
I_LZNUM = ' '
I_SQUIT = SPACE "LTAK-KQUIT
I_NIDRU = RLDRU-PROTO
I_DRUKZ = RLDRU-DRUKZ
I_LDEST = RLDRU-LDEST
I_WEMPF = ' '
I_ABLAD = ' '
I_VLTYP = ITAB-LGTYP
I_VLBER = ' '
I_VLPLA = ITAB-LGPLA
I_VPPOS = ' '
I_VLENR = ' '
I_VLQNR = ' '
I_NLTYP = LAGP-LGTYP
I_NLBER = LAGP-LGBER
I_NLPLA = LAGP-LGPLA
I_NPPOS = ' '
I_NLENR = LEIN-LENUM
I_NLQNR = ' '
I_RLTYP = ' '
I_RLBER = ' '
I_RLPLA = ' '
I_RLQNR = ' '
I_UPDATE_TASK = ' '
I_COMMIT_WORK = 'X'
I_BNAME = SY-UNAME
I_KOMPL = 'X'
IMPORTING
E_TANUM = ITAB-TANUM
E_LTAP =
EXCEPTIONS
ERROR_MESSAGE = 99.
IF SY-SUBRC EQ 99.
*........Fehler bei der TA-Erstellung aufgetreten......................
ITAB-FARBE = RED.
ITAB-IKONE = SYM_FLASH.
PERFORM ERROR_MESSAGE using sy-msgid
sy-msgty
sy-msgno
sy-msgv1
sy-msgv2
sy-msgv3
sy-msgv4.
ELSE.
*........TA erzeugt....................................................
ITAB-FARBE = GREEN.
ITAB-IKONE = SYM_CHECK_MARK.
ENDIF.
ENDFORM. " L_TO_CREATE_SINGLE
*----
*
Form UMBUCHEN *
*----
*
Umbuchen in WM und IM ansteuern *
*----
*
FORM UMBUCHEN.
REFRESH: ILUBQU, ILQUA_IM, T_LQUA_PROT.
CLEAR: ILUBQU, ILQUA_IM, T_LQUA_PROT, RL034, RETCODE.
REFRESH: T_LQUA_PROT_2.
CLEAR: T_LQUA_PROT_2, RETURNCODE.
*........Ansteuern Umbuchungs-POPUPs...................................
PERFORM UMBUCHUNGS_POPUP.
CHECK RETURNCODE NE 'A'.
*........Loop über alle markierten Einträge............................
LOOP AT ITAB WHERE IKONE = SYM_CHECKBOX.
REFRESH: ILUBQU, ILQUA_IM, T_LQUA_PROT.
CLEAR: ILUBQU, ILQUA_IM, T_LQUA_PROT, RL034, RETCODE.
*........Platz sperren.................................................
PERFORM PLATZ_SPERREN USING ITAB-LGTYP ITAB-LGPLA.
IF SY-SUBRC NE 0.
*........Platz konnte nicht gesperrt werden............................
PERFORM ERROR_MESSAGE using sy-msgid
sy-msgty
sy-msgno
sy-msgv1
sy-msgv2
sy-msgv3
sy-msgv4.
ITAB-IKONE = SYM_FLASH.
ITAB-FARBE = RED.
ELSE.
*........Platz gesperrt -> Daten nachlesen.............................
SELECT SINGLE * FROM LQUA WHERE LGNUM = ITAB-LGNUM
AND LGTYP = ITAB-LGTYP
AND LGPLA = ITAB-LGPLA
AND LQNUM = ITAB-LQNUM.
IF SY-SUBRC = 0.
*........Quant ist (noch) vorhanden -> Stimmen die Daten überein?......
IF ITAB-GESME NE LQUA-GESME OR
ITAB-VERME NE LQUA-VERME OR
ITAB-EINME NE LQUA-EINME OR
ITAB-AUSME NE LQUA-AUSME.
*........Daten stimmen nicht überein -> Mengen aktualisieren...........
ITAB-GESME = LQUA-GESME.
ITAB-VERME = LQUA-VERME.
ITAB-EINME = LQUA-EINME.
ITAB-AUSME = LQUA-AUSME.
ITAB-FARBE = RED.
ITAB-IKONE = SYM_FLASH.
ITAB-MSGID = 'L1'.
ITAB-MSGTY = 'E'.
ITAB-MSGNO = '609'.
ELSE.
*........Daten stimmen überein -> Füllen Quant in Umbuchungstabelle....
PERFORM ILUBQU_FUELLEN.
SET UPDATE TASK LOCAL.
PERFORM UMBUCHEN_WM.
PERFORM UMBUCHEN_IM.
ENDIF.
ELSE.
*........Quant ist nicht mehr vorhanden -> Listzeile 'sperren'.........
ITAB-FARBE = RED.
ITAB-IKONE = SYM_LOCKED.
ITAB-MSGID = 'L1'.
ITAB-MSGTY = 'E'.
ITAB-MSGNO = '610'.
ENDIF.
ENDIF.
MODIFY ITAB.
ENDLOOP.
SET UPDATE TASK LOCAL.
PERFORM UMBUCHEN_WM.
PERFORM UMBUCHEN_IM.
PERFORM ERGEBNIS.
IF NOT FLG_DUNKL IS INITIAL AND SY-BATCH IS INITIAL.
*........Listausgabe mit dem ALV.......................................
PERFORM LISTKOPF_AUFBAUEN.
PERFORM AUSGABE.
ENDIF.
ENDFORM. " UMBUCHEN
*----
*
Module STATUS_0101 OUTPUT *
*----
*
Status für Popup setzen *
*----
*
MODULE STATUS_0101 OUTPUT.
SET PF-STATUS 'POPUP'.
SET TITLEBAR '003'.
ENDMODULE. " STATUS_0101 OUTPUT
*----
*
Module STATUS_0102 OUTPUT *
*----
*
Status für Popup setzen *
*----
*
MODULE STATUS_0102 OUTPUT.
SET PF-STATUS 'POPUP'.
SET TITLEBAR '004'.
ENDMODULE. " STATUS_0102 OUTPUT
*----
*
Module STATUS_0103 OUTPUT *
*----
*
Status für Popup setzen *
*----
*
MODULE STATUS_0103 OUTPUT.
SET PF-STATUS 'POPUP'.
SET TITLEBAR '005'.
ENDMODULE. " STATUS_0103 OUTPUT
*----
*
Module USER_COMMAND INPUT *
*----
*
Funktionstasten im Popup bei 'Umlagern hell' *
*----
*
MODULE USER_COMMAND INPUT.
CASE SY-UCOMM.
WHEN 'GOON'.
SET SCREEN 0.
LEAVE SCREEN.
ENDCASE.
ENDMODULE. " USER_COMMAND INPUT
*----
*
Module EXIT_COMMAND INPUT *
*----
*
Exit im Popup bei 'Umlagern hell' *
*----
*
MODULE EXIT_COMMAND INPUT.
CASE SY-UCOMM.
WHEN 'EESC'.
RETURNCODE = 'A'.
CLEAR MSEG-LIFNR.
CLEAR MSEG-KDAUF.
CLEAR MSEG-KDPOS.
CLEAR MSEG-PS_PSP_PNR.
SET SCREEN 0.
LEAVE SCREEN.
ENDCASE.
ENDMODULE. " EXIT_COMMAND INPUT
*----
*
Form T331_LESEN *
*----
*
Prüfen, ob Lagertyp LE-verwaltet ist *
*----
*
FORM T331_LESEN.
SELECT SINGLE * FROM T331 WHERE LGNUM = S1_LGNUM
AND LGTYP = S1_LGTYP-LOW.
IF T331-LENVW NE CON_X.
MESSAGE S602(L1) WITH S1_LGTYP-LOW.
Lagereinheitenverwaltung ist in Lagertyp & nicht aktiv
SET SCREEN 0.
LEAVE TO TRANSACTION SY-TCODE.
ENDIF.
ENDFORM. " T331_LESEN
*----
*
Form UMBUCHUNGS_POPUP *
*----
*
Beim Umbuchen nach Sonderbestand Einzelbestand, Konsi, Mehrweg *
und Projekt muß der Zielsonderbestand angegeben werden (Kun- *
denauftrag, Lieferant oder Projektnummer). Dies geschieht über *
Dialogfenster. *
*----
*
FORM UMBUCHUNGS_POPUP.
DATA: BEGIN OF HLP_EINZL,
KDAUF LIKE MSEG-KDAUF,
KDPOS LIKE MSEG-KDPOS,
END OF HLP_EINZL.
CHECK UMB_VARI = UMB_VARI_SOBKZ.
*........Umbuchen an Konsi.............................................
IF UMB_SOBKZ = UMB_SOBKZ_SPACE_KONSI.
CALL SCREEN 0101 STARTING AT 30 15. "NDING AT 41 16.
IF RETURNCODE = 'A'.
*......Abbruch; keine Aktion notwendig.................................
EXIT.
ELSE.
RL01S-LSONR = MSEG-LIFNR.
ENDIF.
ENDIF.
*........Umbuchen an Mehrweg...........................................
IF UMB_SOBKZ = UMB_SOBKZ_SPACE_MEHRW.
CALL SCREEN 0101 STARTING AT 30 15. "NDING AT 41 16.
IF RETURNCODE = 'A'.
*......Abbruch; keine Aktion notwendig.................................
EXIT.
ELSE.
RL01S-LSONR = MSEG-LIFNR.
ENDIF.
ENDIF.
*........Umbuchen an Kundeneinzelbestand...............................
IF UMB_SOBKZ = UMB_SOBKZ_SPACE_EINZL.
CALL SCREEN 0102 STARTING AT 30 15. "NDING AT 41 16.
IF RETURNCODE = 'A'.
*......Abbruch; keine Aktion notwendig.................................
EXIT.
ELSE.
HLP_EINZL-KDAUF = MSEG-KDAUF.
HLP_EINZL-KDPOS = MSEG-KDPOS.
RL01S-LSONR = HLP_EINZL.
ENDIF.
ENDIF.
*........Umbuchen an Projektbestand....................................
IF UMB_SOBKZ = UMB_SOBKZ_SPACE_PROJN.
CALL SCREEN 0103 STARTING AT 30 15. "NDING AT 41 16.
IF RETURNCODE = 'A'.
*......Abbruch; keine Aktion notwendig.................................
EXIT.
ELSE.
RL01S-LSONR = MSEG-PS_PSP_PNR.
ENDIF.
ENDIF.
ENDFORM. " UMBUCHUNGS_POPUP
*----
*
Form LISTKOPF_AUFBAUEN *
*----
*
Listkopf für ALV aufbauen *
*----
*
FORM LISTKOPF_AUFBAUEN.
DATA: BEGIN OF LINE,
FLD1(19) TYPE C,
FLD2(40) TYPE C,
END OF LINE.
DATA: BEGIN OF LINE_MAT,
FLD1 LIKE LQUA-MATNR,
FLD2(1) TYPE C,
FLD3(40) TYPE C,
END OF LINE_MAT.
CLEAR XHEADER.
REFRESH XHEADER.
*........Ausgeben Lagernummer..........................................
PERFORM T300T_LESEN USING S1_LGNUM.
CLEAR LINE.
LINE-FLD1 = S1_LGNUM.
LINE-FLD2 = T300T-LNUMT.
XHEADER-TYP = 'S'.
XHEADER-KEY = TEXT-004.
XHEADER-INFO = LINE.
APPEND XHEADER.
*........Umbuchen Materialsicht........................................
*........Ausgeben Material.............................................
IF UMB_LISTE EQ UMB_LISTE_MATNR.
PERFORM MAKT_LESEN USING MATNR-LOW.
CLEAR LINE.
WRITE MATNR-LOW TO LINE_MAT-FLD1.
LINE_MAT-FLD3 = MAKT-MAKTX.
XHEADER-TYP = 'S'.
XHEADER-KEY = TEXT-006.
XHEADER-INFO = LINE_MAT.
APPEND XHEADER.
ENDIF.
*........Umbuchen Lagersicht...........................................
*........Ausgeben Lagertyp.............................................
IF UMB_LISTE EQ UMB_LISTE_LGTYP AND
( NOT S1_LGTYP-LOW IS INITIAL AND S1_LGTYP-HIGH IS INITIAL ).
PERFORM T301T_LESEN USING S1_LGNUM S1_LGTYP-LOW.
CLEAR LINE.
LINE-FLD1 = S1_LGTYP-LOW.
LINE-FLD2 = T301T-LTYPT.
XHEADER-TYP = 'S'.
XHEADER-KEY = TEXT-005.
XHEADER-INFO = LINE.
APPEND XHEADER.
ENDIF.
*........Ausgeben Bewegungsart.........................................
PERFORM T333T_LESEN USING S1_LGNUM PA_BWLVS.
CLEAR LINE.
LINE-FLD1 = PA_BWLVS.
LINE-FLD2 = T333T-LBWAT.
XHEADER-TYP = 'S'.
XHEADER-KEY = TEXT-015.
XHEADER-INFO = LINE.
APPEND XHEADER.
*........Umbuchen Bestandsqualifikation................................
*........Ausgeben Bestandsqualifikation Von - Nach.....................
IF UMB_VARI = UMB_VARI_BESTQ.
XHEADER-TYP = 'S'.
XHEADER-KEY = TEXT-011.
XHEADER-INFO = T333U-BSTQ1.
APPEND XHEADER.
XHEADER-TYP = 'S'.
XHEADER-KEY = TEXT-012.
XHEADER-INFO = T333U-BSTQ2.
APPEND XHEADER.
ENDIF.
*........Umbuchen Sonderbestand........................................
*........Ausgeben Sonderbestand Von - Nach.............................
IF UMB_VARI = UMB_VARI_SOBKZ.
XHEADER-TYP = 'S'.
XHEADER-KEY = TEXT-013.
XHEADER-INFO = T333U-SOKZ1.
APPEND XHEADER.
XHEADER-TYP = 'S'.
XHEADER-KEY = TEXT-014.
XHEADER-INFO = T333U-SOKZ2.
APPEND XHEADER.
ENDIF.
ENDFORM. " LISTKOPF_AUFBAUEN
*----
*
Form SELEKTION_PRUEFEN *
*----
*
Prüfen der auf dem Anforderbild angegebenen Selektions- und *
Steuerkriterien. *
*----
*
FORM SELEKTION_PRUEFEN.
SELECT SINGLE * FROM T333U WHERE LGNUM = S1_LGNUM
AND BWLVS = PA_BWLVS.
IF SY-SUBRC NE 0.
MESSAGE E124(L2) WITH PA_BWLVS.
ENDIF.
*........Umbuchen Bestandsqualifikation.................................
IF NOT ( T333U-BSTQ1 IS INITIAL AND T333U-BSTQ2 IS INITIAL ).
IF BESTQ-LOW NE T333U-BSTQ1.
MESSAGE I596 WITH BESTQ-LOW T333U-BSTQ1.
ENDIF.
IF NOT T333U-SOKZ1 IS INITIAL OR NOT T333U-SOKZ2 IS INITIAL.
MESSAGE I598.
ENDIF.
REFRESH BESTQ.
UMB_VARI = UMB_VARI_BESTQ.
BESTQ-LOW = T333U-BSTQ1.
BESTQ-OPTION = 'EQ'.
BESTQ-SIGN = 'I'.
COLLECT BESTQ.
ENDIF.
*........Umbuchen Sonderbestand.........................................
IF NOT T333U-SOKZ1 IS INITIAL OR NOT T333U-SOKZ2 IS INITIAL.
IF SOBKZ-LOW NE T333U-SOKZ1.
MESSAGE I599 WITH SOBKZ-LOW T333U-SOKZ1.
ENDIF.
IF NOT T333U-BSTQ1 IS INITIAL OR NOT T333U-BSTQ2 IS INITIAL.
MESSAGE I598.
ENDIF.
REFRESH SOBKZ.
UMB_VARI = UMB_VARI_SOBKZ.
SOBKZ-LOW = T333U-SOKZ1.
SOBKZ-OPTION = 'EQ'.
SOBKZ-SIGN = 'I'.
COLLECT SOBKZ.
*........Festlegen welche Umbuchung und welche Richtung.................
IF T333U-SOKZ1 IS INITIAL AND T333U-SOKZ2 EQ SOBKZ_EINZELBESTAND.
UMB_SOBKZ = UMB_SOBKZ_SPACE_EINZL.
ENDIF.
IF T333U-SOKZ1 IS INITIAL AND T333U-SOKZ2 EQ SOBKZ_LIEFERANT.
UMB_SOBKZ = UMB_SOBKZ_SPACE_KONSI.
ENDIF.
IF T333U-SOKZ1 IS INITIAL AND T333U-SOKZ2 EQ SOBKZ_MEHRWEG.
UMB_SOBKZ = UMB_SOBKZ_SPACE_MEHRW.
ENDIF.
IF T333U-SOKZ1 IS INITIAL AND T333U-SOKZ2 EQ SOBKZ_PROJEKT.
UMB_SOBKZ = UMB_SOBKZ_SPACE_PROJN.
ENDIF.
IF T333U-SOKZ2 IS INITIAL AND T333U-SOKZ1 EQ SOBKZ_EINZELBESTAND.
UMB_SOBKZ = UMB_SOBKZ_EINZL_SPACE.
ENDIF.
IF T333U-SOKZ2 IS INITIAL AND T333U-SOKZ1 EQ SOBKZ_LIEFERANT.
UMB_SOBKZ = UMB_SOBKZ_KONSI_SPACE.
ENDIF.
IF T333U-SOKZ2 IS INITIAL AND T333U-SOKZ1 EQ SOBKZ_MEHRWEG.
UMB_SOBKZ = UMB_SOBKZ_MEHRW_SPACE.
ENDIF.
IF T333U-SOKZ2 IS INITIAL AND T333U-SOKZ1 EQ SOBKZ_PROJEKT.
UMB_SOBKZ = UMB_SOBKZ_PROJN_SPACE.
ENDIF.
ENDIF.
*........Prüfen Selektion nach Charge...................................
IF NOT CHARG[] IS INITIAL AND MATNR[] IS INITIAL.
MESSAGE E600.
ENDIF.
*........Prüfen Selektion nach Material oder Lagertyp...................
IF S1_LGTYP[] IS INITIAL AND MATNR[] IS INITIAL.
MESSAGE E601.
ENDIF.
*........Bei Selektion nach Material Angabe Werk zwingend...............
IF ( NOT MATNR[] IS INITIAL AND WERKS[] IS INITIAL ) OR
( NOT WERKS[] IS INITIAL AND MATNR[] IS INITIAL ).
MESSAGE E602.
ENDIF.
*........Selektierte Lagertypen prüfen nach Blocklager mit LE..........
IF NOT S1_LGTYP[] IS INITIAL.
R_LGTYP[] = S1_LGTYP[].
SELECT * FROM T331 WHERE LGNUM = S1_LGNUM
AND LGTYP IN R_LGTYP.
IF T331-STEIN = 'B' AND NOT T331-LENVW IS INITIAL.
MESSAGE E605 WITH T331-LGTYP.
ENDIF.
ENDSELECT.
ENDIF.
*........Setzen Umbuchungsvariante Lager oder Material..................
IF NOT MATNR-LOW IS INITIAL AND MATNR-HIGH IS INITIAL.
UMB_LISTE = UMB_LISTE_MATNR.
ELSE.
UMB_LISTE = UMB_LISTE_LGTYP.
ENDIF.
*........Prüfen Dunkelablauf............................................
IF PA_DUNKL EQ CON_DUNKEL.
MESSAGE W603.
ENDIF.
*........Setzen Sonderbestand...........................................
IF NOT PA_LSONR IS INITIAL AND
NOT SOBKZ-LOW IS INITIAL.
PERFORM SONUM_CONV_EXT_INT(SAPFL000) USING SOBKZ-LOW
PA_LSONR
RL01S-SONUM.
ELSE.
CLEAR: RL01S-SONUM.
CLEAR: PA_LSONR.
ENDIF.
ENDFORM.
*----
*
Form T300T_LESEN
*----
*
Lesen des Lagernummerntextes
*----
*
--> P_LGNUM Lagernummer *
*----
*
FORM T300T_LESEN USING P_LGNUM.
SELECT SINGLE * FROM T300T WHERE SPRAS = SY-LANGU
AND LGNUM = P_LGNUM.
ENDFORM. " T300T_LESEN
*----
*
Form T301T_LESEN
*----
*
Lesen der Lagertypbezeichnung
*----
*
--> P_LGNUM Lagernummer *
--> P_LGTYP Lagertyp *
*----
*
FORM T301T_LESEN USING P_LGNUM P_LGTYP.
SELECT SINGLE * FROM T301T WHERE SPRAS = SY-LANGU
AND LGNUM = P_LGNUM
AND LGTYP = P_LGTYP.
ENDFORM. " T301T_LESEN
*----
*
Form T333T_LESEN
*----
*
Lesen des Bewegungsartentextes
*----
*
--> P_LGNUM Lagernummer *
--> P_BWLVS WM-Bewegungsart *
*----
*
FORM T333T_LESEN USING P_LGNUM P_BWLVS.
SELECT SINGLE * FROM T333T WHERE SPRAS = SY-LANGU
AND LGNUM = P_LGNUM
AND BWLVS = P_BWLVS.
ENDFORM. " T333T_LESEN
*----
*
Form T340D_LESEN
*----
*
Lesen der Lagernummerndefinition
*----
*
--> P_LGNUM Lagernummer *
*----
*
FORM T340D_LESEN USING P_LGNUM.
SELECT SINGLE * FROM T340D WHERE LGNUM = P_LGNUM.
ENDFORM. " T340D_LESEN
*----
*
Form MAKT_LESEN
*----
*
Lesen des Materialkurztextes
*----
*
--> P_LGNUM Lagernummer *
*----
*
FORM MAKT_LESEN USING P_MATNR.
SELECT SINGLE * FROM MAKT WHERE MATNR = P_MATNR
AND SPRAS = SY-LANGU.
ENDFORM. " MAKT_LESEN
*----
*
Form ILUBQU_FUELLEN
*----
*
Tabelle umzubuchender Quants füllen.
*----
*
--> ITAB selektiertes Quant
<-- ILUBQU Eintrag in Schnittst.tabelle des Umbuchungsbausteins
*----
*
FORM ILUBQU_FUELLEN.
CLEAR: ILUBQU.
ILUBQU-LQNUM = ITAB-LQNUM.
ILUBQU-MENGE = ITAB-GESME.
ILUBQU-KZUAP = CON_X.
ILUBQU-SQUIT = CON_X.
ILUBQU-LETYP = ITAB-LETYP.
ILUBQU-ZEUGN = ITAB-ZEUGN.
ILUBQU-WDATU = ITAB-WDATU.
ILUBQU-VFDAT = ITAB-VFDAT.
APPEND ILUBQU.
ENDFORM. " ILUBQU_FUELLEN
*----
*
Form LUBUI_FUELLEN
*----
*
Füllen Übergabestruktur für Umbuchung WM.
*----
*
--> ITAB selektiertes Quant
<-- LUBUI gefüllte Übergabestruktur für Umbuchungsbaustein WM
*----
*
FORM LUBUI_FUELLEN.
CLEAR LUBUI.
CASE UMB_VARI.
WHEN UMB_VARI_BESTQ.
LUBUI-MATN1 = ITAB-MATNR.
LUBUI-WERK1 = ITAB-WERKS.
LUBUI-LGOR1 = ITAB-LGORT.
LUBUI-BSTQ1 = T333U-BSTQ1.
LUBUI-CHRG1 = ITAB-CHARG.
LUBUI-SOKZ1 = ITAB-SOBKZ.
LUBUI-SONR1 = ITAB-SONUM.
LUBUI-MATN2 = ITAB-MATNR.
LUBUI-WERK2 = ITAB-WERKS.
LUBUI-LGOR2 = ITAB-LGORT.
LUBUI-BSTQ2 = T333U-BSTQ2.
LUBUI-CHRG2 = ITAB-CHARG.
LUBUI-SOKZ2 = ITAB-SOBKZ.
LUBUI-SONR2 = ITAB-SONUM.
LUBUI-BWLVS = PA_BWLVS.
LUBUI-BWART = T333U-BWART.
LUBUI-MENGE = ITAB-VERME.
LUBUI-MEINS = ITAB-MEINS.
LUBUI-ALTM1 = ITAB-MEINS.
LUBUI-ALTM2 = ITAB-MEINS.
WHEN UMB_VARI_SOBKZ.
LUBUI-MATN1 = ITAB-MATNR.
LUBUI-WERK1 = ITAB-WERKS.
LUBUI-LGOR1 = ITAB-LGORT.
LUBUI-BSTQ1 = ITAB-BESTQ.
LUBUI-CHRG1 = ITAB-CHARG.
LUBUI-MATN2 = ITAB-MATNR.
LUBUI-WERK2 = ITAB-WERKS.
LUBUI-LGOR2 = ITAB-LGORT.
LUBUI-BSTQ2 = ITAB-BESTQ.
LUBUI-CHRG2 = ITAB-CHARG.
LUBUI-BWLVS = PA_BWLVS.
LUBUI-BWART = T333U-BWART.
LUBUI-MENGE = ITAB-VERME.
LUBUI-MEINS = ITAB-MEINS.
LUBUI-ALTM1 = ITAB-MEINS.
LUBUI-ALTM2 = ITAB-MEINS.
CASE UMB_SOBKZ.
WHEN UMB_SOBKZ_KONSI_SPACE.
LUBUI-SOKZ1 = ITAB-SOBKZ.
LUBUI-SONR1 = ITAB-SONUM.
LUBUI-SOKZ2 = T333U-SOKZ2.
CLEAR LUBUI-SONR2.
WHEN UMB_SOBKZ_SPACE_KONSI.
LUBUI-SOKZ1 = ITAB-SOBKZ.
LUBUI-SONR1 = ITAB-SONUM.
LUBUI-SOKZ2 = T333U-SOKZ2.
PERFORM SONUM_CONV_EXT_INT(SAPFL000) USING 'K'
RL01S-LSONR
LUBUI-SONR2.
IF RL01S-LSONR CO ' 0123456789'.
*......Numerisch.......................................................
UNPACK RL01S-LSONR TO LUBUI-SONR2.
ELSE.
*......Charakter.......................................................
MOVE RL01S-LSONR TO LUBUI-SONR2.
ENDIF.
WHEN UMB_SOBKZ_MEHRW_SPACE.
LUBUI-SOKZ1 = ITAB-SOBKZ.
LUBUI-SONR1 = ITAB-SONUM.
LUBUI-SOKZ2 = T333U-SOKZ2.
CLEAR LUBUI-SONR2.
WHEN UMB_SOBKZ_SPACE_MEHRW.
LUBUI-SOKZ1 = ITAB-SOBKZ.
LUBUI-SONR1 = ITAB-SONUM.
LUBUI-SOKZ2 = T333U-SOKZ2.
PERFORM SONUM_CONV_EXT_INT(SAPFL000) USING 'M'
RL01S-LSONR
LUBUI-SONR2.
IF RL01S-LSONR CO ' 0123456789'.
*......Numerisch.......................................................
UNPACK RL01S-LSONR TO LUBUI-SONR2.
ELSE.
*......Charakter.......................................................
MOVE RL01S-LSONR TO LUBUI-SONR2.
ENDIF.
WHEN UMB_SOBKZ_EINZL_SPACE.
LUBUI-SOKZ1 = ITAB-SOBKZ.
LUBUI-SONR1 = ITAB-SONUM.
LUBUI-SOKZ2 = T333U-SOKZ2.
CLEAR LUBUI-SONR2.
WHEN UMB_SOBKZ_SPACE_EINZL.
LUBUI-SOKZ1 = ITAB-SOBKZ.
LUBUI-SONR1 = ITAB-SONUM.
LUBUI-SOKZ2 = T333U-SOKZ2.
PERFORM SONUM_CONV_EXT_INT(SAPFL000) USING 'E'
RL01S-LSONR
LUBUI-SONR2.
IF RL01S-LSONR CO ' 0123456789'.
*......Numerisch.......................................................
UNPACK RL01S-LSONR TO LUBUI-SONR2.
ELSE.
*......Charakter.......................................................
MOVE RL01S-LSONR TO LUBUI-SONR2.
ENDIF.
WHEN UMB_SOBKZ_PROJN_SPACE.
LUBUI-SOKZ1 = ITAB-SOBKZ.
LUBUI-SONR1 = ITAB-SONUM.
LUBUI-SOKZ2 = T333U-SOKZ2.
CLEAR LUBUI-SONR2.
WHEN UMB_SOBKZ_SPACE_PROJN.
LUBUI-SOKZ1 = ITAB-SOBKZ.
LUBUI-SONR1 = ITAB-SONUM.
LUBUI-SOKZ2 = T333U-SOKZ2.
PERFORM SONUM_CONV_EXT_INT(SAPFL000) USING 'Q'
RL01S-LSONR
LUBUI-SONR2.
IF RL01S-LSONR CO ' 0123456789'.
*......Numerisch.......................................................
UNPACK RL01S-LSONR TO LUBUI-SONR2.
ELSE.
*......Charakter.......................................................
MOVE RL01S-LSONR TO LUBUI-SONR2.
ENDIF.
WHEN OTHERS.
ENDCASE. " UMB_SOBKZ
WHEN OTHERS.
ENDCASE. " UMB_VARI
ENDFORM.
*----
*
Form ILQUA_IM_FUELLEN
*----
*
Füllen Übergabestruktur für Umbuchung IM.
*----
*
--> ITAB selektiertes Quant
<-- ILQUA_IM gefüllte Übergabestruktur für Umbuchungsbaustein IM
*----
*
FORM ILQUA_IM_FUELLEN.
CLEAR: ILQUA_IM.
LOOP AT TAP WHERE VORGA = 'U1'.
MOVE-CORRESPONDING TAP TO ILQUA_IM.
MOVE: TAP-NLQNR TO ILQUA_IM-LQNUM,
TAP-NSOLM TO ILQUA_IM-MENGE,
TAP-NLTYP TO ILQUA_IM-LGTYP,
TAP-NLPLA TO ILQUA_IM-LGPLA,
TAP-NPPOS TO ILQUA_IM-PLPOS,
TAP-NLENR TO ILQUA_IM-LENUM.
MOVE: LUBUI-BSTQ2 TO ILQUA_IM-UMBSQ.
if tap-sobkz is initial.
move: LUBUI-SOKZ2 TO ILQUA_IM-SOBKZ,
LUBUI-SONR2 TO ILQUA_IM-SONUM.
else.
move: LUBUI-SOKZ2 TO ILQUA_IM-UMSOK,
LUBUI-SONR2 TO ILQUA_IM-USONU.
endif.
COLLECT ILQUA_IM.
Determine direction of posting in case "v_n_661138
of special stock posting changes
if umb_vari = umb_vari_sobkz.
if tap-sobkz is initial.
flg_sobub = '1'. "Free to Special Stock
else.
if lubui-sokz2 is initial.
flg_sobub = '2'. "Special Stock to Free
else.
flg_sobub = '3'. "Special Stock to Special Stock
endif.
endif.
endif. "^_n_661138
ENDLOOP.
ENDFORM. " ILQUA_IM_FUELLEN
*----
*
Form UMBUCHEN_WM
*----
*
Das Umbuchen im WM wird über den FB L_TO_CREATE_POSTING_CHANGE
angestoßen.
*----
*
FORM UMBUCHEN_WM.
CHECK NOT ILUBQU[] IS INITIAL.
*........Füllen Übergabestruktur Umbuchung WM..........................
PERFORM LUBUI_FUELLEN.
CALL FUNCTION 'L_TO_CREATE_POSTING_CHANGE'
EXPORTING
I_LGNUM = S1_LGNUM
I_LUBUI = LUBUI
I_SQUIT = CON_X
I_NIDRU = CON_X
I_UPDATE_TASK = SPACE
I_COMMIT_WORK = SPACE
I_BNAME = SY-UNAME
IMPORTING
E_TANUM = HLP_TANUM
TABLES
T_LUBQU = ILUBQU
T_LTAP_VB = TAP
EXCEPTIONS
ERROR_MESSAGE = 99.
RETCODE = SY-SUBRC.
IF SY-SUBRC NE 0.
*........Fehler bei der TA-Erstellung aufgetreten......................
HLP_FARBE = RED.
HLP_IKONE = SYM_FLASH.
PERFORM ERROR_MESSAGE using sy-msgid
sy-msgty
sy-msgno
sy-msgv1
sy-msgv2
sy-msgv3
sy-msgv4.
ROLLBACK WORK.
ELSE.
*........TA erzeugt....................................................
HLP_FARBE = GREEN.
HLP_IKONE = SYM_CHECK_MARK.
ENDIF.
ENDFORM. " UMBUCHEN_WM
*----
*
Form UMBUCHEN_IM
*----
*
Das Umbuchen in IM wird über den FB MB_CREATE_GOODS_MOVEMENT
angestoßen.
*----
*
FORM UMBUCHEN_IM.
CHECK NOT ILUBQU[] IS INITIAL.
IF RETCODE IS INITIAL.
*........Füllen Übergabestruktur Umbuchung IM..........................
PERFORM ILQUA_IM_FUELLEN.
FLG_SOBUB is now set in ILQUA_IM_FUELLEN "v_n_661138
IF UMB_VARI = UMB_VARI_SOBKZ.
FLG_SOBUB = CON_X.
ENDIF. "^_n_661138
*>>>>>> Begin of Insertion HP_206308 <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
KOPF-BUDAT = PA_BUDAT.
KOPF-BLDAT = PA_BLDAT.
*>>>>>> End of Insertion HP_206308 <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
CALL FUNCTION 'L_IM_POSTING_CREATE'
EXPORTING
I_IMKPF = KOPF
I_TCODE = CON_IM_TCODE_UMBU
i_item_number = pos_anz
I_SOBUB = FLG_SOBUB
I_BWART = T333U-BWART
I_AUFRUFER = CON_AUFRUF_VU
TABLES
T_LQUA_IM = ILQUA_IM
T_EMKPF = T_EMKPF
T_LQUA_PROT = T_LQUA_PROT
T_IDOCS = T_IDOC_PROT
EXCEPTIONS
ERROR_MESSAGE = 99
OTHERS = 0.
*........Globale Fehler in der Verarbeitung............................
IF SY-SUBRC NE 0.
HLP_FARBE = RED.
HLP_IKONE = SYM_FLASH.
CLEAR HLP_TANUM.
RETCODE = 4.
PERFORM ERROR_MESSAGE using sy-msgid
sy-msgty
sy-msgno
sy-msgv1
sy-msgv2
sy-msgv3
sy-msgv4.
ROLLBACK WORK.
ELSE.
*........Fehler in der IM-Buchung......................................
LOOP AT T_LQUA_PROT WHERE NOT MSGNO IS INITIAL.
EXIT.
ENDLOOP.
IF SY-SUBRC EQ 0.
*........Fehler bei der IM-Buchung aufgetreten.........................
HLP_FARBE = RED.
HLP_IKONE = SYM_FLASH.
CLEAR HLP_TANUM.
RETCODE = 4.
PERFORM ERROR_MESSAGE using t_lqua_prot-msgid
t_lqua_prot-msgty
t_lqua_prot-msgno
t_lqua_prot-msgv1
t_lqua_prot-msgv2
t_lqua_prot-msgv3
t_lqua_prot-msgv4.
ROLLBACK WORK.
ELSE.
*........IM-Buchung ausgeführt.........................................
LOOP AT T_EMKPF.
HLP_MBLNR = T_EMKPF-MBLNR.
HLP_MJAHR = T_EMKPF-MJAHR.
ENDLOOP.
HLP_FARBE = GREEN.
HLP_IKONE = SYM_CHECK_MARK.
COMMIT WORK.
ENDIF.
ENDIF.
ENDIF.
LOOP AT ITAB WHERE IKONE = SYM_CHECKBOX.
ITAB-IKONE = HLP_IKONE.
ITAB-FARBE = HLP_FARBE.
ITAB-TANUM = HLP_TANUM.
ITAB-MBLNR = HLP_MBLNR.
ITAB-MJAHR = HLP_MJAHR.
MODIFY ITAB.
IF RETCODE = 99.
CLEAR T_LQUA_PROT.
MOVE-CORRESPONDING ITAB TO T_LQUA_PROT.
T_LQUA_PROT-MSGID = SY-MSGID.
T_LQUA_PROT-MSGNO = SY-MSGNO.
T_LQUA_PROT-MSGV1 = SY-MSGV1.
T_LQUA_PROT-MSGV2 = SY-MSGV2.
T_LQUA_PROT-MSGV3 = SY-MSGV3.
T_LQUA_PROT-MSGV4 = SY-MSGV4.
APPEND T_LQUA_PROT.
ENDIF.
ENDLOOP.
MOVE: T_LQUA_PROT TO T_LQUA_PROT_2.
APPEND T_LQUA_PROT_2.
ENDFORM. " UMBUCHEN_IM
*----
*
Form ERGEBNIS
*----
*
Es wird auf Anforderung ein Mail erstellt.
Im Batchlauf wird ein Abschlußbild ausgegeben.
*----
*
--> T_LQUA_PROT Tabelle der fehlerhaften Quants
--> T_EMKPF Tabelle der erzeugten Materialbelege
*----
*
FORM ERGEBNIS.
IF NOT PA_KZMAI IS INITIAL AND
NOT T_LQUA_PROT_2[] IS INITIAL.
CALL FUNCTION 'L_IM_MAIL_CREATE'
EXPORTING
I_AUFRUFER = CON_AUFRUF_VU
I_BUSER = SY-UNAME
I_MAILK = T333U-MAILK
I_LGNUM = S1_LGNUM
TABLES
T_LQUA_PROT = T_LQUA_PROT_2
EXCEPTIONS
OTHERS = 0.
ENDIF.
*........Im Batchlauf ein Ergebnisbild ausgeben........................
CHECK NOT SY-BATCH IS INITIAL.
*........Erzeugte Transportaufträge ausgeben...........................
LOOP AT itab TRANSPORTING NO FIELDS
WHERE ikone = sym_check_mark
AND NOT tanum IS initial.
EXIT.
ENDLOOP.
IF sy-subrc = 0.
WRITE:/ text-302 INTENSIFIED ON.
SKIP.
LOOP AT itab WHERE ikone = sym_check_mark
AND NOT tanum IS initial.
WRITE:/ itab-lgnum INTENSIFIED OFF,
itab-tanum INTENSIFIED OFF.
ENDLOOP.
SKIP 2.
ENDIF.
*........Erzeugte Materialbelegnummern ausgeben........................
LOOP AT T_EMKPF.
AT FIRST.
WRITE:/ TEXT-300 INTENSIFIED ON.
SKIP.
ENDAT.
WRITE:/ T_EMKPF-MBLNR INTENSIFIED OFF.
AT LAST.
SKIP 2.
ENDAT.
ENDLOOP.
*........Fehlernachrichten ausgeben....................................
LOOP AT t_lqua_prot_2 TRANSPORTING NO FIELDS
WHERE NOT msgno IS INITIAL.
EXIT.
ENDLOOP.
IF sy-subrc = 0.
SKIP 2.
WRITE:/ text-301 INTENSIFIED ON.
SKIP.
LOOP AT t_lqua_prot_2 WHERE NOT msgno IS INITIAL.
MOVE: t_lqua_prot_2-msgid TO lmess-msgid,
T_LQUA_PROT_2-MSGNO TO LMESS-MSGNO,
T_LQUA_PROT_2-MSGV1 TO LMESS-MSGV1,
T_LQUA_PROT_2-MSGV2 TO LMESS-MSGV2,
T_LQUA_PROT_2-MSGV3 TO LMESS-MSGV3,
T_LQUA_PROT_2-MSGV4 TO LMESS-MSGV4.
CALL FUNCTION 'L_MESSAGE_AUFBEREITEN'
EXPORTING
I_MESS = LMESS
IMPORTING
O_TEXT = HLP_TEXT.
WRITE:/ t_lqua_prot_2-lqnum INTENSIFIED ON,
/ hlp_text(80) INTENSIFIED OFF.
ENDLOOP.
ENDIF.
CLEAR T_LQUA_PROT_2.
REFRESH T_LQUA_PROT_2.
ENDFORM. " ERGEBNIS
*----
*
Form F4_FOR_BWLVS *
*----
*
F4-Hilfe für Umbuchungs-BWA (Tabelle T333U) *
*----
*
FORM F4_FOR_BWLVS.
CALL FUNCTION 'L_VALUES_T333U_BWLVS'
EXPORTING
I_LGNUM = S1_LGNUM
IMPORTING
E_BWLVS = PA_BWLVS.
ENDFORM. " F4_FOR_BWLVS
