Thursday, October 18, 2007

Sample ABAP Program to EXPORT LIST TO MEMORY

************************************************************************
* Author - Sheila Titchener *
* Program - Report of orders with billing/delivery blocks
* Date - October 1998 *
* Company - IconeT Services *
************************************************************************
************************************************************************

REPORT YVREE024 LINE-SIZE 185 LINE-COUNT 63 NO STANDARD PAGE HEADING.

*---------------------------------------------------------------------*
* DATA DECLARATIONS *
*---------------------------------------------------------------------*

TABLES: VBAK, VBAP, VBEP, KNA1, TVFST, TVLST.

* Selection screens.
*-----------------------------------------------------------------------
* mandatory parameters
SELECTION-SCREEN BEGIN OF BLOCK PARAMETERS
WITH FRAME
TITLE TEXT-020 .
PARAMETERS: P_VKORG LIKE VBAK-VKORG OBLIGATORY ,
P_VTWEG LIKE VBAK-VTWEG OBLIGATORY ,
P_SPART LIKE VBAK-SPART OBLIGATORY .

SELECTION-SCREEN END OF BLOCK PARAMETERS.
*-----------------------------------------------------------------------
* optional selection ranges
SELECTION-SCREEN BEGIN OF BLOCK SELECT_CRITERIA
WITH FRAME
TITLE TEXT-010 .
SELECT-OPTIONS:
S_VKBUR FOR VBAK-VKBUR,
S_VKGRP FOR VBAK-VKGRP,
S_KUNNR FOR VBAK-KUNNR.

SELECTION-SCREEN END OF BLOCK SELECT_CRITERIA .


* Order header table.
DATA: BEGIN OF I_VBAK OCCURS 0,
VBELN LIKE VBAK-VBELN,
KUNNR LIKE VBAK-KUNNR,
FAKSK LIKE VBAK-FAKSK, "billing block
LIFSK LIKE VBAK-LIFSK, "delivery block
END OF I_VBAK.
* report table
DATA: BEGIN OF ITAB OCCURS 0,
VBELN LIKE VBAP-VBELN, " Order Number
KUNNR LIKE VBAK-KUNNR, " Customer Number
NAME1 LIKE KNA1-NAME1, " Customer Name
ERNAM LIKE VBAK-ERNAM, " User created
POSNR LIKE VBAP-POSNR, " Line Item
MATNR LIKE VBAP-MATNR, " Material Number
KWMENG LIKE VBAP-KWMENG, " Quantity
MEINS LIKE VBAP-MEINS, " Unit of measure
NETWR LIKE VBAP-NETWR, " value
FAKSP LIKE VBAP-FAKSP, " billing block
LIFSP LIKE VBEP-LIFSP, " delivery block
END OF ITAB.


*---------------------------------------------------------------------*
INITIALIZATION .
GET PARAMETER ID 'VKO' FIELD P_VKORG.
GET PARAMETER ID 'VTW' FIELD P_VTWEG.
GET PARAMETER ID 'SPA' FIELD P_SPART.

*---------------------------------------------------------------------*
START-OF-SELECTION .
*---------------------------------------------------------------------*
* populate vbak table from selection criteria with headers that have
* billing or delivery blocks
PERFORM SELECT_DOCUMENTS.
* select blocked items from documents selected from vbak
PERFORM SELECT_BLOCKED_ITEMS.
*---------------------------------------------------------------------*
END-OF-SELECTION.
*---------------------------------------------------------------------*

SORT ITAB BY VBELN POSNR.

* print report from internal table
PERFORM PRINT_REPORT.

* run report of orders with payment block on customer
SUBMIT YVREE025 EXPORTING LIST TO MEMORY
AND RETURN
WITH P_VKORG = P_VKORG
WITH P_VTWEG = P_VTWEG
WITH P_SPART = P_SPART
WITH S_VKBUR IN S_VKBUR
WITH S_VKGRP IN S_VKGRP
WITH S_KUNNR IN S_KUNNR.

DATA: ABAPLIST LIKE ABAPLIST OCCURS 0.
* recover YVREE025 report and display
CALL FUNCTION 'LIST_FROM_MEMORY'
TABLES
LISTOBJECT = ABAPLIST
EXCEPTIONS
NOT_FOUND = 1
OTHERS = 2.

*if sy-batch = space.
CALL FUNCTION 'DISPLAY_LIST'
EXPORTING
FULLSCREEN = 'X'
* CALLER_HANDLES_EVENTS =
IMPORTING
USER_COMMAND = SY-UCOMM
TABLES
LISTOBJECT = ABAPLIST
EXCEPTIONS
EMPTY_LIST = 1
OTHERS = 2.
*else.
* using write_list duplicates yvree024 headings on yvree025 list
* display_list prints ok in background as long as print immediately is
* NOT switched off

*call function 'WRITE_LIST'
* tables
* listobject = abaplist
* exceptions
* empty_list = 1
* others = 2.
*endif.
*---------------------------------------------------------------------*
TOP-OF-PAGE.
*---------------------------------------------------------------------*
* write top of page title.
PERFORM WRITE_TITLE .
* write column headings.
PERFORM WRITE_HEADER.


*&---------------------------------------------------------------------*
*& Form SELECT_DOCUMENTS
*&---------------------------------------------------------------------*
* select order header details from vbak depending on selection
* criteria entered
*----------------------------------------------------------------------*
FORM SELECT_DOCUMENTS.

SELECT VBELN KUNNR LIFSK FAKSK
FROM VBAK INTO CORRESPONDING FIELDS OF TABLE I_VBAK
WHERE VKORG = P_VKORG
AND VTWEG = P_VTWEG
AND SPART = P_SPART
AND VKGRP IN S_VKGRP
AND VKBUR IN S_VKBUR
AND KUNNR IN S_KUNNR.
ENDFORM. " SELECT_DOCUMENTS

*&---------------------------------------------------------------------*
*& Form SELECT_BLOCKED_ITEMS
*&---------------------------------------------------------------------*
* check extracted documents for blocks *
*----------------------------------------------------------------------*
FORM SELECT_BLOCKED_ITEMS.
* process oders selected
LOOP AT I_VBAK.
* if order blocked at header level select all items
IF I_VBAK-FAKSK NE SPACE OR I_VBAK-LIFSK NE SPACE.
PERFORM SELECT_ALL_ITEMS.
ELSE.
* check for block at item level
SELECT VBELN POSNR MATNR KWMENG MEINS NETWR FAKSP ERNAM
FROM VBAP INTO
(VBAP-VBELN, VBAP-POSNR, VBAP-MATNR, VBAP-KWMENG, VBAP-MEINS,
VBAP-NETWR, VBAP-FAKSP, VBAP-ERNAM)
WHERE VBELN = I_VBAK-VBELN.
IF VBAP-FAKSP NE SPACE.
CLEAR ITAB.
MOVE-CORRESPONDING VBAP TO ITAB.
MOVE I_VBAK-KUNNR TO ITAB-KUNNR.
APPEND ITAB.
ELSE.
* check for block at delivery level
SELECT LIFSP WMENG FROM VBEP INTO
(VBEP-LIFSP, VBEP-WMENG)
WHERE VBELN = I_VBAK-VBELN
AND POSNR = VBAP-POSNR.
IF VBEP-LIFSP NE SPACE.
CLEAR ITAB.
MOVE-CORRESPONDING VBAP TO ITAB.
MOVE I_VBAK-KUNNR TO ITAB-KUNNR.
* use schedule qty
MOVE VBEP-WMENG TO ITAB-KWMENG.
* and reason
MOVE VBEP-LIFSP TO ITAB-LIFSP.
* recalculate value
ITAB-NETWR = ITAB-NETWR / VBAP-KWMENG * VBEP-WMENG.
APPEND ITAB.
ENDIF.
ENDSELECT.
ENDIF.
ENDSELECT.

ENDIF.
ENDLOOP.


ENDFORM. " SELECT_BLOCKED_ITEMS

*&---------------------------------------------------------------------*
*& Form PRINT_REPORT
*&---------------------------------------------------------------------*
* text *
*----------------------------------------------------------------------*
FORM PRINT_REPORT.

DATA: W_REASON_TEXT(25).

LOOP AT ITAB.
* get name
SELECT SINGLE NAME1 FROM KNA1 INTO KNA1-NAME1
WHERE KUNNR = ITAB-KUNNR .
* get reason text
IF ITAB-FAKSP NE SPACE.
SELECT SINGLE VTEXT FROM TVFST INTO W_REASON_TEXT
WHERE SPRAS = SY-LANGU
AND FAKSP = ITAB-FAKSP .
ELSE.

SELECT SINGLE VTEXT FROM TVLST INTO W_REASON_TEXT
WHERE SPRAS = SY-LANGU
AND LIFSP = ITAB-LIFSP.
ENDIF.
*
WRITE: / SY-VLINE , (10) ITAB-VBELN,
SY-VLINE , (10) ITAB-KUNNR,
SY-VLINE , (35) KNA1-NAME1,
SY-VLINE , (12) ITAB-ERNAM,
SY-VLINE , (6) ITAB-POSNR,
SY-VLINE , (18) ITAB-MATNR,
SY-VLINE , (10) ITAB-KWMENG DECIMALS 0,
SY-VLINE , (3) ITAB-MEINS,
SY-VLINE , (15) ITAB-NETWR,
SY-VLINE , (02) ITAB-LIFSP,
SY-VLINE , (02) ITAB-FAKSP,
SY-VLINE , (25) W_REASON_TEXT,
SY-VLINE .
ENDLOOP.

WRITE:/1(185) SY-ULINE.
ENDFORM. " PRINT_REPORT

*---------------------------------------------------------------------*
* FORM WRITE_TITLE *
*---------------------------------------------------------------------*
* Form to write top of page title. *
*---------------------------------------------------------------------*
FORM WRITE_TITLE.

WRITE:/1(185) SY-ULINE.
WRITE:/ 'Pirelli Cables Limited' ,
40 SY-TITLE , " Report title
120 'Date :' , 130 SY-DATUM .

WRITE:/120 'Page :' ,
130 SY-PAGNO , " Page number of the report
160 'YV24 / YVREE024 /', SY-MANDT.
WRITE:/160 'Report 2 of 2'.
WRITE:/1(185) SY-ULINE.

* format color col_heading intensified off.

WRITE:/(25) 'Report generated for; ',
'Sales Organisation:',
P_VKORG ,
' Distribution Channel:',
P_VTWEG,
' Division:',
P_SPART.
WRITE: /27
'Sales Office:',
S_VKBUR-LOW.
IF S_VKBUR-HIGH NE SPACE.
WRITE: ' - ', S_VKBUR-HIGH.
ENDIF.
WRITE: 59 ' Sales Group:',
S_VKGRP-LOW.
IF S_VKGRP-HIGH NE SPACE.
WRITE: ' - ', S_VKGRP-HIGH.
ENDIF.
WRITE: 92 ' Customer:',
S_KUNNR-LOW.
IF S_KUNNR-HIGH NE SPACE.
WRITE: ' - ', S_KUNNR-HIGH.
ENDIF.
WRITE:/1(185) SY-ULINE.

ENDFORM.

*---------------------------------------------------------------------*
* FORM WRITE-HEADER *
*---------------------------------------------------------------------*
* Form to write Column headings *
*---------------------------------------------------------------------*
FORM WRITE_HEADER.

SKIP.

FORMAT COLOR COL_HEADING INTENSIFIED.

WRITE:/1(185) SY-ULINE.
WRITE:/
SY-VLINE , (10) ' Order ' ,
SY-VLINE , (10) ' Customer ' ,
SY-VLINE , (35) ' Name ' ,
SY-VLINE , (12) ' User created',
SY-VLINE , (06) ' Item ' ,
SY-VLINE , (18) ' Material',
SY-VLINE , (10) 'Quantity' CENTERED DECIMALS 0,
SY-VLINE , (03) 'UOM' ,
SY-VLINE , (15) ' Value ',
SY-VLINE , (02) 'DB',
SY-VLINE , (02) 'BB',
SY-VLINE , (25) ' Reason',
SY-VLINE .


ENDFORM.

*&---------------------------------------------------------------------*
*& Form SELECT_ALL_ITEMS
*&---------------------------------------------------------------------*
* select all items for this header when blocked at header level *
*----------------------------------------------------------------------*
FORM SELECT_ALL_ITEMS.

SELECT VBELN POSNR MATNR KWMENG MEINS NETWR ERNAM
FROM VBAP INTO
(VBAP-VBELN, VBAP-POSNR, VBAP-MATNR, VBAP-KWMENG, VBAP-MEINS,
VBAP-NETWR, VBAP-ERNAM)
* REMOVED appending corresponding fields of table itab
WHERE VBELN = I_VBAK-VBELN.
MOVE-CORRESPONDING VBAP TO ITAB.
MOVE I_VBAK-FAKSK TO ITAB-FAKSP.
MOVE I_VBAK-LIFSK TO ITAB-LIFSP.
MOVE I_VBAK-KUNNR TO ITAB-KUNNR.
APPEND ITAB.
ENDSELECT.

ENDFORM. " SELECT_ALL_ITEMS

No comments: