by Muriel4178 » Tue Dec 07, 2004 2:00 pm
Hallo, habe diese Anforderung bei uns mit einem FuBau lösen können:
function z_offene_menge_eintlg.
*"----------------------------------------------------------------------
*"*"Lokale Schnittstelle:
*" IMPORTING
*" VALUE(VBELV) LIKE VBFA-VBELV
*" VALUE(POSNV) LIKE VBFA-POSNV
*" VALUE(ETENR) LIKE VBEP-ETENR OPTIONAL
*" EXPORTING
*" VALUE(OMENG) LIKE VBEPD-VSMNG
*" VALUE(KZ_NIXOFFEN) TYPE C
*" EXCEPTIONS
*" EINTLG_UNGUELTIG
*" BELEG_UNGUELTIG
*"----------------------------------------------------------------------
************************************************************************
tables: vbap, vbep, vblb.
data: begin of r_vbfa,
vbelv like vbfa-vbelv,
posnv like vbfa-posnv,
vbeln like vbfa-vbeln,
vbtyp_n like vbfa-vbtyp_n,
rfmng like vbfa-rfmng,
erdat like vbfa-erdat,
end of r_vbfa.
data: i_vbfa like r_vbfa occurs 0 with header line.
data: begin of r_vbep,
vbeln like vbep-vbeln,
posnr like vbep-posnr,
etenr like vbep-etenr,
edatu like vbep-edatu,
wmeng like vbep-wmeng,
bmeng like vbep-bmeng,
end of r_vbep.
data: lfmng like vbfa-rfmng,
kwmeng like vbap-kwmeng,
index type i,
summe type p decimals 2,
edatu_eintlg type d,
lfnkd like vblb-lfnkd,
lfdkd like vblb-lfdkd.
************************************************************************
* Kontrolle auf Belegnummer
select single * from vbak
where vbeln = vbelv.
if sy-subrc <> 0.
raise beleg_ungueltig.
exit.
endif.
* gibt es gewählte Eintlg. überhaupt ?
if not etenr is initial.
select single * from vbep
where vbeln = vbelv
and posnr = posnv
and etenr = etenr.
if sy-subrc <> 0.
raise eintlg_ungueltig.
exit.
endif.
endif.
clear: lfnkd, lfdkd.
case vbak-vbtyp.
when 'E'.
clear: vblb, lfnkd.
select * from vblb
where vbeln = vbak-vbeln
order by abrdt ascending.
endselect.
lfnkd = vblb-lfnkd.
lfdkd = vblb-lfdkd.
endcase.
clear: lfmng, kz_nixoffen.
select vbelv posnv vbeln vbtyp_n rfmng erdat
from vbfa into r_vbfa
where vbelv = vbelv
and posnv = posnv.
case r_vbfa-vbtyp_n.
when 'J'.
if vbak-vbtyp = 'E' and r_vbfa-vbeln > lfnkd.
* wenn Korrekturlieferung --> keine Liefermenge, Gautsch, am: 01.07.02
select single * from likp where vbeln = r_vbfa-vbeln.
if sy-subrc <> 0. clear likp. endif.
if likp-lfart <> 'ZLKO'.
add r_vbfa-rfmng to lfmng.
endif.
endif.
if vbak-vbtyp = 'C'.
add r_vbfa-rfmng to lfmng.
endif.
* WHEN 'H' OR 'T'.
* IF vbak-vbtyp = 'E' AND r_vbfa-erdat > lfdkd.
* SUBTRACT r_vbfa-rfmng FROM lfmng.
* ENDIF.
* IF vbak-vbtyp = 'C'.
* SUBTRACT r_vbfa-rfmng FROM lfmng.
* ENDIF.
endcase.
endselect.
* handelt es sich um einen SD-Lieferplan oder Kauftr. ?
case vbak-vbtyp.
when 'E'.
clear kwmeng.
if etenr is initial.
* bilde KW-Meng zu allen Einteilungen
select vbeln posnr etenr edatu wmeng bmeng
from vbep into r_vbep
where vbeln = vbelv
and posnr = posnv.
add r_vbep-wmeng to kwmeng.
endselect.
else.
* hole Einteilungsdatum
select single * from vbep
where vbeln = vbelv
and posnr = posnv
and etenr = etenr.
if sy-subrc = 0.
clear edatu_eintlg.
edatu_eintlg = vbep-edatu.
* bilde KW-Meng bis zu Einteilung
select vbeln posnr etenr edatu wmeng bmeng
from vbep into r_vbep
where vbeln = vbelv
and posnr = posnv
order by edatu ascending.
if r_vbep-edatu > edatu_eintlg.
exit.
endif.
add r_vbep-wmeng to kwmeng.
endselect.
endif.
endif.
***********
when 'C'.
clear kwmeng.
if etenr is initial.
* bilde KW-Meng zu allen Einteilungen
select vbeln posnr etenr edatu wmeng bmeng
from vbep into r_vbep
where vbeln = vbelv
and posnr = posnv.
add r_vbep-bmeng to kwmeng.
endselect.
else.
* hole Einteilungsdatum
select single * from vbep
where vbeln = vbelv
and posnr = posnv
and etenr = etenr.
if sy-subrc = 0.
clear edatu_eintlg.
edatu_eintlg = vbep-edatu.
* bilde KW-Meng bis zu Einteilung
select vbeln posnr etenr edatu wmeng bmeng
from vbep into r_vbep
where vbeln = vbelv
and posnr = posnv
order by edatu ascending.
if r_vbep-edatu > edatu_eintlg.
exit.
endif.
add r_vbep-bmeng to kwmeng.
endselect.
endif.
endif.
endcase.
clear: omeng.
* berechne offene Menge zur Einteilung
omeng = kwmeng - lfmng.
if omeng <= 0.
omeng = 0.
kz_nixoffen = 'X'.
endif.
endfunction.
lG Harald