Calculation of customer payment performance   by profit center

I want to calculate customer payment performance by profit center  it is a report.
Caluation clue.
<b>Performance is a measure of when the payment was made versus the due date calculated by the payment terms</b>.
i want the logic to be included in the following code.
REPORT                                               
TABLE DECLARATIONS
TABLES: BFOD_A,         "FI subsequent BA/PC adjustment: Customer items
        BSID,           "Open Items
        BSAD,           "Cleared Items
        BKPF,           "Docuemnt Header
        KNA1,           "Customer Master
        CEPCT,          "Texts for Profit Center Master Data
        CEPC,           "Profit center master data table
        SKB1,           "G/L account master
        VBFA,           "Sales Document Flow
        VBAK.           "Sales Document: Header Data
CONTROLS: TABAGING TYPE TABLEVIEW USING SCREEN 9000.
FIELD-SYMBOLS: <COLUMN>.
Internal tables followed by types
TYPES: BEGIN OF T_TOTAL,
         WAERS  LIKE COEP-TWAER,
         DAYS01 LIKE COEP-WTGBTR,
         DAYS02 LIKE COEP-WTGBTR,
         DAYS03 LIKE COEP-WTGBTR,
         DAYS04 LIKE COEP-WTGBTR,
         DAYS05 LIKE COEP-WTGBTR,
         TOTAL  LIKE COEP-WTGBTR,
       END OF T_TOTAL.
DATA: V_DISVARIANT       TYPE DISVARIANT,
      REF_CUSTOM         TYPE REF TO CL_GUI_CUSTOM_CONTAINER,
      REF_ALV_ZRPT       TYPE REF TO CL_GUI_ALV_GRID.
DATA: V_SAVE(1)    TYPE C,
      V_DEFAULT(1) TYPE C,
      V_VARIANT    TYPE DISVARIANT,
      V_SORT       TYPE LVC_S_SORT,
      V_LAYOUT     TYPE LVC_S_LAYO,
      V_SAVE_TABIX LIKE SY-TABIX,
      V_SAVE_TIME  LIKE SY-UZEIT,
      V_ALV_FIELDCAT TYPE LVC_S_FCAT,
      V_SAVE_INDEX LIKE SY-TABIX,
      V_ROW        TYPE LVC_S_ROW,
      V_ROWS       TYPE LINE OF LVC_T_ROW.
DATA: BEGIN OF V_HDR,
        CURKY(9) TYPE C,
        CURR(20) TYPE C,
        COL1(20) TYPE C,
        COL2(20) TYPE C,
        COL3(20) TYPE C,
        COL4(20) TYPE C,
        TOTAL(20) TYPE C,
      END OF V_HDR.
DATA: BEGIN OF V_FIELD,
        NAME(15) TYPE C,
        VALUE(17) TYPE C,
      END OF V_FIELD.
DATA: BEGIN OF I_BFOD_A OCCURS 0,
        PRCTR LIKE BFOD_A-PRCTR,
        KUNNR LIKE BFOD_A-KUNNR,
        BUKRS LIKE BFOD_A-BUKRS,
        GJAHR LIKE BFOD_A-GJAHR,
        BELNR LIKE BFOD_A-BELNR,
        BUZEI LIKE BFOD_A-BUZEI,
        AUGDT LIKE BFOD_A-AUGDT,
        HKONT LIKE BFOD_A-HKONT,
        BUDAT LIKE BFOD_A-BUDAT,
        SHKZG LIKE BFOD_A-SHKZG,
        DMBTR LIKE BFOD_A-DMBTR,
        DMBE2 LIKE BFOD_A-DMBE2,
      END OF I_BFOD_A.
DATA: I_SET_VALUES   LIKE SETVALUES OCCURS 0 WITH HEADER LINE,
      I_SORT         TYPE LVC_T_SORT,
      I_ALV_FIELDCAT TYPE LVC_T_FCAT,
      I_PRCTR_COCD   TYPE FCINPCA001 OCCURS 0 WITH HEADER LINE,
      I_BFODA_KUNNR  LIKE I_BFOD_A OCCURS 0 WITH HEADER LINE,
Begin of changes for DEVK909110
     I_REPORT       TYPE ZFR0ARPR_S1 OCCURS 0 WITH HEADER LINE,
      I_REPORT       TYPE ZPSS_ARBYPC OCCURS 0 WITH HEADER LINE,
End of changes for DEVK909110
      I_FAEDE        LIKE FAEDE,
      I_TOTAL        TYPE T_TOTAL OCCURS 0 WITH HEADER LINE.
DATA: BEGIN OF I_BKPF OCCURS 0,
        BUKRS LIKE BKPF-BUKRS,
        BELNR LIKE BKPF-BELNR,
        GJAHR LIKE BKPF-GJAHR,
        BKTXT LIKE BKPF-BKTXT,
        XBLNR LIKE BKPF-XBLNR,
        HWAER LIKE BKPF-HWAER,
        HWAE2 LIKE BKPF-HWAE2,
      END OF I_BKPF.
*... combine BSAD and BSID
DATA: BEGIN OF I_BSYD OCCURS 0,
        KUNNR LIKE BSID-KUNNR,
        BUKRS LIKE BSID-BUKRS,
        GJAHR LIKE BSID-GJAHR,
        BELNR LIKE BSID-BELNR,
        BUZEI LIKE BSID-BUZEI,
        AUGDT LIKE BSID-AUGDT,
        BLDAT LIKE BSID-BLDAT,
        BUDAT LIKE BSID-BUDAT,
        HKONT LIKE BSID-HKONT,
        WAERS LIKE BSID-WAERS,
        ZFBDT LIKE BSID-ZFBDT,
        ZBD1T LIKE BSID-ZBD1T,
        ZBD2T LIKE BSID-ZBD2T,
        ZBD3T LIKE BSID-ZBD3T,
        XBLNR LIKE BSID-XBLNR,
        REBZG LIKE BSID-REBZG,
        SHKZG LIKE BSID-SHKZG,
        DMBTR LIKE BSID-DMBTR,
        WRBTR LIKE BSID-WRBTR,
      END OF I_BSYD.
DATA: BEGIN OF I_CEPC OCCURS 0,
         PRCTR LIKE CEPC-PRCTR,
         KHINR LIKE CEPC-KHINR,
      END OF I_CEPC.
DATA: BEGIN OF I_CEPCT OCCURS 0,
         PRCTR LIKE CEPCT-PRCTR,
         MCTXT LIKE CEPCT-MCTXT,
      END OF I_CEPCT.
DATA: BEGIN OF I_PRCTR OCCURS 0,
        PRCTR LIKE BFOD_A-PRCTR,
      END OF I_PRCTR.
DATA: BEGIN OF I_KNA1 OCCURS 0,
         KUNNR LIKE KNA1-KUNNR,
         NAME1 LIKE KNA1-NAME1,
      END OF I_KNA1.
Working Variables Declarations
*... accumulators
DATA: V_BFOD_TXNAMT LIKE BSID-WRBTR,    "transaction currency amt
      V_FRCURR      LIKE TCURR-FCURR,   "local currency
      V_TOCURR      LIKE TCURR-FCURR,   "local currency
      V_LCURR       LIKE T001-WAERS,    "local currency
      V_CUSTTOTUSD  LIKE BFOD_A-DMBE2,  "customer total grp curr
      V_TOTAL       LIKE BPPE-WTP03,    "days total grp curr
      V_CURRENT     LIKE BPPE-WTP03,    "days current grp curr
      V_TOTAL_USD   LIKE BPPE-WTP03,    "days total grp curr
      V_TOTAL_ROW   LIKE BPPE-WTP03.    "total of local curr/row
DATA: V_PRCTR          LIKE CEPC-PRCTR,   "profit center
      V_SUBRC          LIKE SY-SUBRC,
      V_FLAG           TYPE I,
      V_DPAST          TYPE I,     "past due days working
      V_GRAND          TYPE C,
      V_DIFF_COLOR     TYPE C,
      V_MSG(50)        TYPE C,
      V_SAVE_PCFN(128) TYPE C,
      V_EXTENSION(4)   TYPE C,
      V_PREV_PRCTR     LIKE CEPC-PRCTR,
      V_POS            LIKE SY-FDPOS,
      V_SAVE_BUKRS     LIKE BFOD_A-BUKRS,
      V_SAVE_KHINR     LIKE CEPC-KHINR,
      V_PERC           TYPE P DECIMALS 10,
      V_ZBD1T          LIKE BSID-ZBD1T,
      V_ZFBDT          LIKE BSID-ZFBDT,
      V_GROUP_CLASS    LIKE RGSBS-CLASS,
      V_GROUP_NAME     LIKE RGSBS-SETNR,
      V_GROUP_TITLE    LIKE RGSBS-TITLE,
      V_SETID          LIKE SETHIER-SETID,
      V_FILETYPE       LIKE RLGRAP-FILETYPE VALUE 'DAT',
      V_CNT            LIKE SY-TABIX,
      V_PREV_BELNR     LIKE BSID-BELNR,
      V_REPORT1        LIKE I_REPORT,
      V_REPORT         LIKE I_REPORT,
      V_TABIX          LIKE SY-TABIX.
Constants
CONSTANTS:
      C_0H(2)     TYPE C VALUE '0H',
      C_0106(4)   TYPE C VALUE '0106',
      C_SPACE(11) TYPE C VALUE '          ',
      C_USD(3)    TYPE C VALUE 'USD',
      C_KBRC      LIKE CEPC-KOKRS VALUE 'KBRC',
      C_TXT(4)    TYPE C VALUE '.txt',
      C_XLS(4)    TYPE C VALUE '.xls',
      C_RTF(4)    TYPE C VALUE '.rtf',
      C_PERIOD(1) TYPE C VALUE '.',
      C_TODATE    LIKE CEPC-DATBI VALUE '99991231'.
RANGES: R_KUNNR FOR KNA1-KUNNR.         "Customer
Selection Screen Parameters and Select-options
SELECTION-SCREEN SKIP 1.
SELECTION-SCREEN BEGIN OF BLOCK B1 WITH FRAME TITLE TEXT-001.
PARAMETERS:     P_KHINR LIKE CEPC-KHINR.
SELECT-OPTIONS: S_PRCTR FOR CEPC-PRCTR,
                S_KUNNR FOR KNA1-KUNNR,
                S_BUKRS FOR BKPF-BUKRS,
                S_HKONT FOR SKB1-SAKNR.
PARAMETERS:     P_BUDAT LIKE BFOD_A-BUDAT OBLIGATORY.
SELECTION-SCREEN ULINE.
SELECT-OPTIONS: S_BELNR FOR BFOD_A-BELNR,
                S_AUART FOR VBAK-AUART,
                S_VTWEG FOR VBAK-VTWEG,
                S_VBTYP FOR VBFA-VBTYP_V.
SELECTION-SCREEN ULINE.
PARAMETERS: P_AGEDY TYPE ZZAGEMULT DEFAULT '30' OBLIGATORY.
SELECTION-SCREEN END OF BLOCK B1.
SELECTION-SCREEN SKIP.
SELECTION-SCREEN BEGIN OF BLOCK B2 WITH FRAME.
PARAMETERS: P_DSVAR LIKE DISVARIANT-VARIANT.
SELECTION-SCREEN END OF BLOCK B2.
class lcl_event_receiver: local class to handle event DOUBLE_CLICK
Definition:
CLASS LCL_EVENT_RECEIVER DEFINITION.
  PUBLIC SECTION.
    METHODS:
    MTH_PRINT_TOP_OF_PAGE
        FOR EVENT PRINT_TOP_OF_PAGE OF CL_GUI_ALV_GRID.
    METHODS:
    MTH_PRINT_TOP_OF_LIST
        FOR EVENT PRINT_TOP_OF_LIST OF CL_GUI_ALV_GRID.
  PRIVATE SECTION.
ENDCLASS.                    "lcl_event_receiver DEFINITION
class lcl_event_receiver: local class to handle event DOUBLE_CLICK
Implementation:
CLASS LCL_EVENT_RECEIVER IMPLEMENTATION.
  METHOD MTH_PRINT_TOP_OF_PAGE.
    CALL FUNCTION 'Z_CA_STD_HEADER'
      EXPORTING
        HEADING    = SY-TITLE
        P_REPID    = SY-CPROG
        LINE_WIDTH = SY-LINSZ.
  ENDMETHOD.                    "MTH_PRINT_TOP_OF_PAGE
  METHOD MTH_PRINT_TOP_OF_LIST.
    CALL FUNCTION 'Z_CA_STD_HEADER'
      EXPORTING
        HEADING    = SY-TITLE
        P_REPID    = SY-CPROG
        LINE_WIDTH = SY-LINSZ.
    CALL FUNCTION 'Z_CA_PRINT_SELECTION_OPTIONS'
      EXPORTING
        P_PGMN  = SY-CPROG
        P_SKIP  = 'X'
        P_NOTOP = 'X'.
    NEW-PAGE.
  ENDMETHOD.                    "MTH_PRINT_TOP_OF_LIST
ENDCLASS.                    "LCL_EVENT_RECEIVER IMPLEMENTATION
DATA: REF_EVENT_RECEIVER TYPE REF TO LCL_EVENT_RECEIVER.
Selection Screen Prompt values
  At Selection Screen
AT SELECTION-SCREEN ON VALUE-REQUEST FOR P_DSVAR.
  DATA: LS_DISPLAY_VARIANT TYPE DISVARIANT.
Get the display variant
  V_DISVARIANT-REPORT  = SY-CPROG.
  V_DISVARIANT-VARIANT = P_DSVAR.
  CALL FUNCTION 'REUSE_ALV_VARIANT_F4'
    EXPORTING
      IS_VARIANT = V_DISVARIANT
      I_SAVE     = 'A'
    IMPORTING
      ES_VARIANT = LS_DISPLAY_VARIANT
    EXCEPTIONS
      OTHERS     = 3.
Load results to parameter
  IF SY-SUBRC = 0 AND NOT LS_DISPLAY_VARIANT IS INITIAL.
    P_DSVAR = LS_DISPLAY_VARIANT-VARIANT.
  ENDIF.
*...performed when looking for values in fields
  performs the drop down selection list
AT SELECTION-SCREEN ON VALUE-REQUEST FOR P_KHINR.     "Profit center grp
  PERFORM F_GET_S_KHINR.
Selection Screen validations
AT SELECTION-SCREEN.
  IF P_KHINR IS INITIAL.
    IF S_PRCTR[] IS INITIAL.
      IF S_BUKRS[] IS INITIAL.
        MESSAGE E000 WITH TEXT-300 TEXT-302.
      ENDIF.
    ENDIF.
  ELSE.
    IF S_PRCTR[] IS INITIAL.
      PERFORM F_VALIDATE_KHINR.
    ELSE.
*.. Error msg: Please enter either a Profit Center Group or a
             profit center, but not both
      MESSAGE E000 WITH TEXT-300 TEXT-301.
      EXIT.
    ENDIF.
  ENDIF.
  IF NOT S_AUART[] IS INITIAL.
    MESSAGE E000 WITH TEXT-303.
  ENDIF.
  IF NOT S_VTWEG[] IS INITIAL.
    MESSAGE E000 WITH TEXT-304.
  ENDIF.
   Event AT LINE-SELECTION
AT LINE-SELECTION.
  CHECK SY-LSIND LE 1.
  CHECK NOT I_REPORT-BELNR IS INITIAL.
  SET PARAMETER ID 'BLN'  FIELD I_REPORT-BELNR.
  SET PARAMETER ID 'BUK'  FIELD I_REPORT-BUKRS.
  SET PARAMETER ID 'GJR'  FIELD I_REPORT-GJAHR.
  CALL TRANSACTION 'FB03' AND SKIP FIRST SCREEN.
  CLEAR: I_REPORT-BELNR, I_REPORT-BUKRS, I_REPORT-GJAHR.
INITIALIZATION
INITIALIZATION.
START OF MAIN PROCESSING
START-OF-SELECTION.
Check aging days multiplier
  IF P_AGEDY LE 0.
    MESSAGE S000 WITH 'Aging Days Multiplier must be greater than zero'.
    EXIT.
  ENDIF.
Populate the s_prctr from a profit center group
  IF NOT I_SET_VALUES[] IS INITIAL.
    PERFORM F_POPULATE_PRCTR_FROM_PRCTRGRP.
  ENDIF.
Build and validate prctr against cepc table
  IF NOT S_PRCTR[] IS INITIAL.
    PERFORM F_BUILD_I_CEPC_TABLE.      "FILLS THE VALID PROFIT CTR TABLE
  ENDIF.
Get base selections
  PERFORM F_SELECT_DATA.               "BUILD REF INTERNAL TABLES
Get additional fields and build reporting structure
  PERFORM F_BUILD_I_REPORT.            "BUILDS INTERNAL REPORTING TABLE
Generate ALV report
  PERFORM F_WRITE_REPORT.              "WRITES i_report AND RUNS CALCS
END-OF-SELECTION.
  FREE: I_BFOD_A, I_KNA1, I_CEPC, I_CEPCT, I_REPORT.
      Form  F_DIS_MSG
FORM F_DIS_MSG USING VALUE(P_PERCENTAGE) VALUE(P_TEXT).
  CALL FUNCTION 'SAPGUI_PROGRESS_INDICATOR'
    EXPORTING
      PERCENTAGE = P_PERCENTAGE
      TEXT       = P_TEXT
    EXCEPTIONS
      OTHERS     = 1.
ENDFORM.                               " F_DIS_MSG
      Form  F_GET_S_KHINR
      Get prompt values for Profit Center Group
FORM F_GET_S_KHINR.
  PERFORM F_DIS_MSG USING 100 'Get prompt values for Profit Ctr Group.'.
  COMMIT WORK.
  CALL FUNCTION 'K_GROUP_SELECT'
    EXPORTING
      BUTTONS            = 'X'
      CLASS              = '0H  '
      CRUSER             = '*'
      FIELD_NAME         = 'RPRCTR'
      SEARCHFLD          = 'KBRC'
      SEARCHFLD_INPUT    = ' '
      SEARCHFLD_REQUIRED = 'X'
      SET                = '*'
      START_COLUMN       = 10
      START_ROW          = 5
      TABLE              = 'GLPCT'
      TYPELIST           = 'BS'
      UPDUSER            = '*'
    IMPORTING
      CLASS_NAME         = V_GROUP_CLASS
      SET_NAME           = V_GROUP_NAME
      SET_TITLE          = V_GROUP_TITLE
    EXCEPTIONS
      NO_SET_PICKED      = 1
      OTHERS             = 2.
  IF SY-SUBRC = 0.
    P_KHINR = V_GROUP_NAME.
  ENDIF.
ENDFORM.                               " F_GET_S_KHINR
      FORM F_VALIDATE_KHINR                                         *
FORM F_VALIDATE_KHINR.
  PERFORM F_DIS_MSG USING 100 'Validate Profit Center group.'.
  COMMIT WORK.
  CLEAR I_SET_VALUES.
  REFRESH I_SET_VALUES.
  CONCATENATE C_0106  C_KBRC P_KHINR INTO V_SETID.
  CONDENSE V_SETID.
  CALL FUNCTION 'G_SET_TREE_IMPORT'
    EXPORTING
      CLIENT                    = SY-MANDT
      FIELDNAME                 = 'RPRCTR'
      LANGU                     = SY-LANGU
      SETID                     = V_SETID
      TABNAME                   = 'GLPCT'
      NO_TABLE_BUFFERING        = 'X'
    TABLES
      SET_VALUES                = I_SET_VALUES
    EXCEPTIONS
      SET_NOT_FOUND             = 1
      ILLEGAL_FIELD_REPLACEMENT = 2
      ILLEGAL_TABLE_REPLACEMENT = 3
      OTHERS                    = 4.
  IF SY-SUBRC NE 0.
E: Unable to find Profit Center Group & - please modify selection
    MESSAGE E000 WITH TEXT-002 P_KHINR.
  ENDIF.
  IF I_SET_VALUES[] IS INITIAL.
    MESSAGE E000 WITH P_KHINR TEXT-039.
  ENDIF.
ENDFORM.                               " F_VALIDATE_KHINR
      Form  F_SELECT_DATA
FORM F_SELECT_DATA.
  PERFORM F_DIS_MSG USING 100 'Retrieve info from SAP tables.'.
  COMMIT WORK.
Build the BFOD_A internal table based on user selections
f i_cepc table is initial, it means derive all prctr under a co cd
  IF S_PRCTR[] IS INITIAL.
    PERFORM F_RETRIEVE_BFODA_BY_COMPANY.
  ELSE.
    PERFORM F_RETRIEVE_BFODA_BY_PRCTR.
  ENDIF.
  IF I_BFOD_A[] IS INITIAL.
*... No records fit selection criteria.
    MESSAGE E000 WITH TEXT-H20.
  ENDIF.
Get the text for profit center
  SELECT SPRAS PRCTR DATBI KOKRS MCTXT FROM CEPCT
             INTO CORRESPONDING FIELDS OF TABLE I_CEPCT
              FOR ALL ENTRIES IN I_CEPC
            WHERE SPRAS = SY-LANGU
              AND PRCTR = I_CEPC-PRCTR.
Build an internal table of unique bfod keys for bsid and bsad
  I_BFODA_KUNNR[] = I_BFOD_A[].
  SORT I_BFODA_KUNNR BY KUNNR BUKRS GJAHR BELNR BUZEI.
  DELETE ADJACENT DUPLICATES FROM I_BFODA_KUNNR COMPARING
     KUNNR BUKRS GJAHR BELNR BUZEI.
Build BSID Internal table
  SELECT MANDT BUKRS KUNNR UMSKS UMSKZ AUGDT AUGBL ZUONR GJAHR BELNR
         BUZEI BUDAT HKONT BLDAT WAERS REBZG XBLNR SHKZG DMBTR
         WRBTR ZFBDT ZBD1T ZBD2T ZBD3T
            FROM BSID INTO CORRESPONDING FIELDS OF TABLE I_BSYD
             FOR ALL ENTRIES IN I_BFODA_KUNNR
           WHERE KUNNR EQ I_BFODA_KUNNR-KUNNR
             AND BUKRS EQ I_BFODA_KUNNR-BUKRS
             AND GJAHR EQ I_BFODA_KUNNR-GJAHR
             AND BELNR EQ I_BFODA_KUNNR-BELNR
             AND BUZEI EQ I_BFODA_KUNNR-BUZEI.
Build BSAD internal table
  SELECT MANDT BUKRS KUNNR UMSKS UMSKZ AUGDT AUGBL ZUONR GJAHR BELNR
      BUZEI HKONT BUDAT BLDAT WAERS REBZG XBLNR SHKZG DMBTR WRBTR ZFBDT
      ZBD1T ZBD2T ZBD3T
         FROM BSAD APPENDING CORRESPONDING FIELDS OF TABLE I_BSYD
          FOR ALL ENTRIES IN I_BFODA_KUNNR
        WHERE KUNNR EQ I_BFODA_KUNNR-KUNNR
          AND BUKRS EQ I_BFODA_KUNNR-BUKRS
          AND AUGDT GT P_BUDAT
          AND GJAHR EQ I_BFODA_KUNNR-GJAHR
          AND BELNR EQ I_BFODA_KUNNR-BELNR
          AND BUZEI EQ I_BFODA_KUNNR-BUZEI.
  IF NOT I_BSYD[] IS INITIAL.
Remove records based on selection criteria
    DELETE I_BSYD WHERE
       NOT BUDAT LE P_BUDAT OR
       NOT HKONT IN S_HKONT.
  ENDIF.
Acquire document headers
  SELECT BUKRS BELNR GJAHR BKTXT XBLNR HWAER HWAE2 FROM BKPF
                INTO TABLE I_BKPF
                FOR ALL ENTRIES IN I_BSYD
                WHERE BUKRS EQ I_BSYD-BUKRS
                  AND BELNR EQ I_BSYD-BELNR
                  AND GJAHR EQ I_BSYD-GJAHR.
Sort document lines
  SORT I_BSYD BY KUNNR BUKRS GJAHR BELNR BUZEI ASCENDING.
  SORT I_BKPF BY  BUKRS BELNR GJAHR ASCENDING.
Create table of unique customers
  SORT I_BFODA_KUNNR BY KUNNR.
  DELETE ADJACENT DUPLICATES FROM I_BFODA_KUNNR COMPARING KUNNR.
Build customer table
  SELECT KUNNR NAME1 FROM KNA1
            INTO TABLE I_KNA1
             FOR ALL ENTRIES IN I_BFODA_KUNNR
           WHERE KUNNR EQ I_BFODA_KUNNR-KUNNR.
Free memory space
  FREE I_BFODA_KUNNR.
ENDFORM.                               " F_SELECT_DATA
      Form  F_BUILD_I_CEPC_TABLE
      build the i_cepc internal table that would populate the
      valid profit centers to processed.
FORM F_BUILD_I_CEPC_TABLE.
  PERFORM F_DIS_MSG USING 100 'Build the Profit Center Ref Table.'.
  COMMIT WORK.
Acquire CEPC table
  IF I_PRCTR[] IS INITIAL.
    SORT S_PRCTR.
    SELECT PRCTR KHINR
      FROM CEPC
      INTO TABLE I_CEPC
      WHERE PRCTR IN S_PRCTR.
Sort table
    SORT I_CEPC BY PRCTR KHINR.
Remove duplicate values
    DELETE ADJACENT DUPLICATES FROM I_CEPC COMPARING PRCTR.
    I_PRCTR[] = I_CEPC[].
Sort table
    SORT I_PRCTR BY PRCTR.
  ELSE.
Sort table
    SORT I_PRCTR BY PRCTR.
Acquire CEPC table
    SELECT PRCTR KHINR
      FROM CEPC
      INTO TABLE I_CEPC
      FOR ALL ENTRIES IN I_PRCTR
      WHERE PRCTR = I_PRCTR-PRCTR.
SOrt table
    SORT I_CEPC BY PRCTR KHINR.
  ENDIF.
  IF I_CEPC[] IS INITIAL.
    MESSAGE E000 WITH TEXT-006.
  ENDIF.
ENDFORM.                               " F_BUILD_i_CEPC_TABLE
      Form  F_BUILD_I_REPORT
      Build the A/R report internal table from bfod_a, bsid and bsad
      It is necessary to go to BSAD/BSID to get the document currency
      not present in bfod_a.
FORM F_BUILD_I_REPORT.
  PERFORM F_DIS_MSG USING 100 'Build the report information.'.
  COMMIT WORK.
Sort all internal tables, this is essential for later processing
  SORT I_BFOD_A BY KUNNR BUKRS GJAHR BELNR BUZEI .
  SORT I_BSYD BY KUNNR BUKRS GJAHR BELNR BUZEI.
  SORT I_CEPC BY PRCTR KHINR.
  LOOP AT I_BFOD_A.
New customer
    AT NEW KUNNR.
      READ TABLE I_KNA1 WITH KEY KUNNR = I_BFOD_A-KUNNR BINARY SEARCH.
      IF SY-SUBRC EQ 0.
        MOVE I_KNA1-NAME1 TO I_REPORT-NAME1.
      ENDIF.
    ENDAT.
Acquire header fields
    READ TABLE I_BKPF WITH KEY BUKRS = I_BFOD_A-BUKRS
                               BELNR = I_BFOD_A-BELNR
                               GJAHR = I_BFOD_A-GJAHR BINARY SEARCH.
    IF SY-SUBRC NE 0.
      CLEAR I_BKPF.
    ENDIF.
Build base record
    PERFORM F_MOVE_BASE_TO_REPORT.
Load profit center data
    IF P_KHINR IS INITIAL.
      IF V_PREV_PRCTR = I_BFOD_A-PRCTR.
        I_REPORT-KHINR = I_CEPC-KHINR.
      ELSE.
        READ TABLE I_CEPC WITH KEY PRCTR = I_BFOD_A-PRCTR BINARY SEARCH.
        IF SY-SUBRC = 0.
          I_REPORT-KHINR = I_CEPC-KHINR.
        ELSE.
          CLEAR I_REPORT-KHINR.
        ENDIF.
        V_PREV_PRCTR = I_BFOD_A-PRCTR.
      ENDIF.
    ELSE.
      I_REPORT-KHINR = P_KHINR.
    ENDIF.
Reverse signs
    IF I_REPORT-SHKZG = 'H'.
      I_REPORT-DMBTR = I_REPORT-DMBTR * -1.
      I_REPORT-DMBE2 = I_REPORT-DMBE2 * -1.
    ENDIF.
Additional details
    READ TABLE I_BSYD WITH KEY KUNNR = I_BFOD_A-KUNNR
                               BUKRS = I_BFOD_A-BUKRS
                               GJAHR = I_BFOD_A-GJAHR
                               BELNR = I_BFOD_A-BELNR
                               BUZEI = I_BFOD_A-BUZEI BINARY SEARCH.
    IF SY-SUBRC = 0.
      PERFORM F_FORMAT_I_REPORT_FR_BSYD.
      APPEND I_REPORT.
    ENDIF.
  ENDLOOP.
ENDFORM.                               " F_BUILD_I_REPORT
      Form  F_FORMAT_I_REPORT_FR_BSYD
Retrieve all the information needed for reporting from BSID.
If a document has a referencing invoice (REBZG), the payment terms
   and the baseline date to be used will come from the referencing
   invoice.
FORM F_FORMAT_I_REPORT_FR_BSYD.
*=> get the document currency amount from bsid
  I_REPORT-BLDAT = I_BSYD-BLDAT.
  I_REPORT-WAERS = I_BSYD-WAERS.
PERFORM F_CONVERT_CURRENCY_FR_2_AMTS USING I_REPORT-HWAER I_BSYD-WAERS
                                            I_BSYD-DMBTR   I_BSYD-WRBTR
                                                         I_BFOD_A-DMBTR
                                                 CHANGING V_BFOD_TXNAMT.
  I_REPORT-WRBTR = V_BFOD_TXNAMT.
  IF I_BSYD-SHKZG = 'H'.
    I_REPORT-WRBTR = I_REPORT-WRBTR * -1.
  ENDIF.
  V_ZBD1T = I_BSYD-ZBD1T.
  V_ZFBDT = I_BSYD-ZFBDT.
*=> determine reference document (referencing invoice)
  CLEAR I_REPORT-SORT.
  CASE I_BSYD-REBZG.
    WHEN ' '.
      I_REPORT-SORT = I_BFOD_A-BELNR.
    WHEN 'V'.
      I_REPORT-SORT = I_BSYD-XBLNR.
    WHEN OTHERS.
      I_REPORT-SORT = I_BSYD-REBZG.
      PERFORM F_GET_DATEPAYTERM_FR_ORIGDOC.
  ENDCASE.
  CLEAR I_FAEDE.
  I_FAEDE-SHKZG = I_BSYD-SHKZG.
  I_FAEDE-KOART = 'D'.
  I_FAEDE-ZFBDT = I_BSYD-ZFBDT.
  I_FAEDE-ZBD1T = I_BSYD-ZBD1T.
  I_FAEDE-ZBD2T = I_BSYD-ZBD2T.
  I_FAEDE-ZBD3T = I_BSYD-ZBD3T.
  I_FAEDE-REBZG = I_BSYD-REBZG.
  I_FAEDE-BLDAT = I_BSYD-BLDAT.
  CALL FUNCTION 'DETERMINE_DUE_DATE'
    EXPORTING
      I_FAEDE                    = I_FAEDE
    IMPORTING
      E_FAEDE                    = I_FAEDE
    EXCEPTIONS
      ACCOUNT_TYPE_NOT_SUPPORTED = 1
      OTHERS                     = 2.
  V_DPAST = P_BUDAT - I_FAEDE-NETDT.
  IF V_DPAST < 0.
    I_REPORT-DPAST = 0.
  ELSE.
    MOVE V_DPAST TO I_REPORT-DPAST.
  ENDIF.
  I_REPORT-ZBD1T = V_ZBD1T.
  I_REPORT-NETDT = I_FAEDE-NETDT.
Update totals
  PERFORM F_BUILD_TOTALS.
ENDFORM.                               " F_FORMAT_I_REPORT_FR_BSYD
      Form  F_GET_DATEPAYTERM_FR_ORIGDOC
FORM F_GET_DATEPAYTERM_FR_ORIGDOC.
In order to go back to the original document's payment terms and
baseline date, we neeed to resort bsid/bsad to a different sort
order b-coz only these 3 fields logically matched the orig doc
  SORT I_BSYD BY KUNNR BUKRS BELNR.
  READ TABLE I_BSYD WITH KEY KUNNR = I_BFOD_A-KUNNR
                             BUKRS = I_BFOD_A-BUKRS
                             BELNR = I_REPORT-SORT BINARY SEARCH.
  IF SY-SUBRC = 0.
    V_ZBD1T = I_BSYD-ZBD1T.            "payment term
    V_ZFBDT = I_BSYD-ZFBDT.            "baseline due date
  ENDIF.
  SORT I_BSYD BY KUNNR BUKRS GJAHR BELNR BUZEI.
ENDFORM.                               " F_GET_DATEPAYTERM_FR_ORIGDOC
      Form  F_WRITE_REPORT
      Write A/R report summarized by profit center.
      Report will be build by profit center and sum all customers
         then will sum past do for profit center and catagorized
         will also sum by project / wbs element.
FORM F_WRITE_REPORT.
  SORT I_REPORT BY PRCTR KUNNR SORT BLDAT BELNR DPAST DESCENDING.
  CALL SCREEN 9000.
ENDFORM.                               " F_WRITE_REPORT
      Form  F_POPULATE_PRCTR_FROM_PRCTRGRP
FORM F_POPULATE_PRCTR_FROM_PRCTRGRP.
  LOOP AT I_SET_VALUES.
    IF I_SET_VALUES-TO = I_SET_VALUES-FROM.
      I_PRCTR-PRCTR = I_SET_VALUES-TO.
      COLLECT I_PRCTR.
      S_PRCTR-SIGN   = 'I'.
      S_PRCTR-OPTION = 'EQ'.
      S_PRCTR-LOW    = I_SET_VALUES-TO.
      COLLECT S_PRCTR.
    ELSE.
      MESSAGE E000 WITH 'System Error, contact programmer'
              I_SET_VALUES-TO I_SET_VALUES-FROM.
    ENDIF.
  ENDLOOP.
ENDFORM.                               " F_POPULATE_PRCTR_FROM_PRCTRGRP
      Form  F_CONVERT_CURRENCY_FR_2_AMTS
      This function module will ensure proper handling of decimals
      and conversion of currency. This will give you the historical
      exchange rate used.
      BFOD_A does not have the trans curr amt so we will get it
       using:  ( bsid trans curr amt / bsid loc curr amt ) *
               bfod_a loc currency amt
FORM F_CONVERT_CURRENCY_FR_2_AMTS USING V_FRCURR V_TOCURR
                                        V_OFRAMT V_OTOAMT V_NFRAMT
                                 CHANGING V_NTOAMT.
  CALL FUNCTION 'Z_CONVERT_CURRENCY_FROM_2_AMTS'
    EXPORTING
      FROM_CURRENCY   = V_FRCURR
      TO_CURRENCY     = V_TOCURR
      OLD_FROM_AMOUNT = V_OFRAMT
      OLD_TO_AMOUNT   = V_OTOAMT
      NEW_FROM_AMOUNT = V_NFRAMT
    IMPORTING
      NEW_TO_AMOUNT   = V_NTOAMT
    EXCEPTIONS
      OTHERS          = 1.
  IF SY-SUBRC <> 0.
    MESSAGE E000 WITH TEXT-005.
  ENDIF.
ENDFORM.                               " F_CONVERT_CURRENCY_FR_2_AMTS
      Form  F_RETRIEVE_BFODA_BY_COMPANY
FORM F_RETRIEVE_BFODA_BY_COMPANY.
Acquire BFOD_A table
  SELECT PRCTR KUNNR BUKRS GJAHR BELNR BUZEI AUGDT HKONT BUDAT
         SHKZG DMBTR DMBE2 FROM BFOD_A
     INTO TABLE I_BFOD_A
     WHERE BUKRS IN S_BUKRS.
  IF I_BFOD_A[] IS INITIAL.
    EXIT.
  ELSE.
Remove records based on selection criteria
    DELETE I_BFOD_A WHERE NOT KUNNR IN S_KUNNR OR
                          NOT BUDAT LE P_BUDAT OR
                          NOT HKONT IN S_HKONT OR
                          NOT BELNR IN S_BELNR OR
                        ( NOT AUGDT IS INITIAL AND
                          NOT AUGDT > P_BUDAT ).
  ENDIF.
Build selection option
  LOOP AT I_BFOD_A.
    I_PRCTR-PRCTR  = I_BFOD_A-PRCTR.
    COLLECT I_PRCTR.
    S_PRCTR-SIGN   = 'I'.
    S_PRCTR-OPTION = 'EQ'.
    S_PRCTR-LOW    = I_BFOD_A-PRCTR.
    COLLECT S_PRCTR.
  ENDLOOP.
  SORT S_PRCTR.
  SORT I_PRCTR BY PRCTR.
  PERFORM F_BUILD_I_CEPC_TABLE.
ENDFORM.                    " F_RETRIEVE_BFODA_BY_COMPANY
      Form  F_RETRIEVE_BFODA_BY_PRCTR
FORM F_RETRIEVE_BFODA_BY_PRCTR.
Acquire BFOD_A table
  SELECT PRCTR KUNNR BUKRS GJAHR BELNR BUZEI AUGDT HKONT BUDAT
         SHKZG DMBTR DMBE2 FROM BFOD_A
     INTO TABLE I_BFOD_A
     FOR ALL ENTRIES IN I_PRCTR
     WHERE PRCTR = I_PRCTR-PRCTR AND
           KUNNR IN S_KUNNR AND
           BUKRS IN S_BUKRS.
  IF I_BFOD_A[] IS INITIAL.
    EXIT.
  ELSE.
Remove records based on selection criteria
    DELETE I_BFOD_A WHERE NOT KUNNR IN S_KUNNR OR
                          NOT BUKRS IN S_BUKRS OR
                          NOT BUDAT LE P_BUDAT OR
                          NOT HKONT IN S_HKONT OR
                          NOT BELNR IN S_BELNR OR
                        ( NOT AUGDT IS INITIAL AND
                          NOT AUGDT > P_BUDAT ).
  ENDIF.
ENDFORM.                    " F_RETRIEVE_BFODA_BY_PRCTR
      Form  F_MOVE_BASE_TO_REPORT
FORM F_MOVE_BASE_TO_REPORT.
  I_REPORT-PRCTR = I_BFOD_A-PRCTR.
  I_REPORT-KUNNR = I_BFOD_A-KUNNR.
  I_REPORT-BELNR = I_BFOD_A-BELNR.
  I_REPORT-BUKRS = I_BFOD_A-BUKRS.
  I_REPORT-HKONT = I_BFOD_A-HKONT.
  I_REPORT-AUGDT = I_BFOD_A-AUGDT.
  I_REPORT-BUDAT = I_BFOD_A-BUDAT.
  I_REPORT-GJAHR = I_BFOD_A-GJAHR.
  I_REPORT-BUZEI = I_BFOD_A-BUZEI.
  I_REPORT-SHKZG = I_BFOD_A-SHKZG.
  I_REPORT-DMBTR = I_BFOD_A-DMBTR.
  I_REPORT-DMBE2 = I_BFOD_A-DMBE2.
  I_REPORT-HWAER = I_BKPF-HWAER.
  I_REPORT-HWAE2 = I_BKPF-HWAE2.
  I_REPORT-BKTXT = I_BKPF-BKTXT.
  I_REPORT-XBLNR = I_BKPF-XBLNR.
ENDFORM.                    " F_MOVE_BASE_TO_REPORT
     Module  STATUS_9000  OUTPUT
      text
MODULE STATUS_9000 OUTPUT.
  SET PF-STATUS '9000'.
  SET TITLEBAR '900'.
Launch standard ALV grid
  PERFORM F_CREATE_ALV_GRID_CONTROL.
  PERFORM F_LOAD_COLUMN_HEADINGS.
ENDMODULE.                 " STATUS_9000  OUTPUT
      Module  USER_COMMAND_9000  INPUT
      text
MODULE USER_COMMAND_9000 INPUT.
  CASE SY-UCOMM.
    WHEN 'EXIT' OR 'CANC' OR 'BACK'.
      CALL METHOD REF_CUSTOM->FREE.
      SET SCREEN 0.
      LEAVE SCREEN.
Begin of changes for Release 2 by HBE7890 - DEVK909110
    WHEN 'PRIN'.
      PERFORM PRINT_AGING_TOTALS.
End of changes.
  ENDCASE.
ENDMODULE.                 " USER_COMMAND_9000  INPUT
      Form  F_CREATE_ALV_GRID_CONTROL
      text
FORM F_CREATE_ALV_GRID_CONTROL.
Set field catalog for ALV
  PERFORM F_SET_FIELDCAT.
  IF REF_CUSTOM IS INITIAL.
  Create ALV container
    CREATE OBJECT REF_CUSTOM
      EXPORTING
        CONTAINER_NAME = 'ZRPT_CONTAINER'.
  Create ALV grid control
    CREATE OBJECT REF_ALV_ZRPT
      EXPORTING
        I_PARENT          = REF_CUSTOM.
Adjust look and feel
    PERFORM F_CHANGE_SETTINGS.
Call the ALV Build
    CALL METHOD REF_ALV_ZRPT->SET_TABLE_FOR_FIRST_DISPLAY
      EXPORTING
        IS_LAYOUT       = V_LAYOUT
        IS_VARIANT      = V_VARIANT
        I_SAVE          = V_SAVE
        I_DEFAULT       = V_DEFAULT
      CHANGING
        IT_SORT         = I_SORT
        IT_OUTTAB       = I_REPORT[]
        IT_FIELDCATALOG = I_ALV_FIELDCAT[].
Create print top of page
    CREATE OBJECT REF_EVENT_RECEIVER.
    SET HANDLER REF_EVENT_RECEIVER->MTH_PRINT_TOP_OF_PAGE
        FOR REF_ALV_ZRPT.
Create print top of page
    CREATE OBJECT REF_EVENT_RECEIVER.
    SET HANDLER REF_EVENT_RECEIVER->MTH_PRINT_TOP_OF_LIST
        FOR REF_ALV_ZRPT.
  ENDIF.
ENDFORM.                    " F_CREATE_ALV_GRID_CONTROL
     Form  F_CHANGE_SETTINGS
      text
FORM F_CHANGE_SETTINGS .
Set layout parameters
  V_LAYOUT-GRID_TITLE = 'A/R by Profit Center'.
  V_LAYOUT-SEL_MODE   = 'A'.
  V_LAYOUT-INFO_FNAME = 'LINECOLOR'.
  V_LAYOUT-CWIDTH_OPT = 'X'.
  V_LAYOUT-NO_MERGING = 'X'.
  V_LAYOUT-NUMC_TOTAL = 'X'.
  V_DEFAULT           = 'X'.
  V_SAVE              = 'A'.
Set display variant
  V_VARIANT-REPORT  = SY-REPID.
  IF P_DSVAR NE ''.
    V_VARIANT-VARIANT = P_DSVAR.
  ENDIF.
ENDFORM.                    " F_CHANGE_SETTINGS
      Form  F_SET_FIELDCAT
      text
FORM F_SET_FIELDCAT .
Set field catalog for ALV
  CALL FUNCTION 'LVC_FIELDCATALOG_MERGE'
    EXPORTING
     I_STRUCTURE_NAME       = 'ZFR0ARPR_S1'  "DEVK909110
      I_STRUCTURE_NAME       = 'ZPSS_ARBYPC'                "DEVK909110
    CHANGING
      CT_FIELDCAT            = I_ALV_FIELDCAT
    EXCEPTIONS
      INCONSISTENT_INTERFACE = 1
      PROGRAM_ERROR          = 2
      OTHERS                 = 3.
Override any attributes
  LOOP AT I_ALV_FIELDCAT INTO V_ALV_FIELDCAT.
    IF V_ALV_FIELDCAT-FIELDNAME EQ 'NAME1'.
      MOVE 'Customer Name' TO: V_ALV_FIELDCAT-REPTEXT,
                               V_ALV_FIELDCAT-SCRTEXT_L,
                               V_ALV_FIELDCAT-SCRTEXT_M,
                               V_ALV_FIELDCAT-SCRTEXT_S.
    ENDIF.
    IF V_ALV_FIELDCAT-FIELDNAME EQ 'SORT'.
      MOVE 'Documentation' TO: V_ALV_FIELDCAT-REPTEXT,
                               V_ALV_FIELDCAT-SCRTEXT_L,
                               V_ALV_FIELDCAT-SCRTEXT_M.
      MOVE 'DocRef' TO         V_ALV_FIELDCAT-SCRTEXT_S.
    ENDIF.
    MODIFY I_ALV_FIELDCAT FROM V_ALV_FIELDCAT.
  ENDLOOP.
ENDFORM.                    " F_SET_FIELDCAT
      Form  F_BUILD_TOTALS
      text
FORM F_BUILD_TOTALS .
  DATA: V_DAYS TYPE I,
        V_INDEX(2) TYPE N.
  CLEAR I_TOTAL.
Build total line
  MOVE I_REPORT-HWAER TO I_TOTAL-WAERS.
  MOVE I_REPORT-DMBTR TO I_TOTAL-TOTAL.
  DO 5 TIMES.
    V_DAYS = ( SY-INDEX - 1 ) * P_AGEDY.
    V_INDEX = SY-INDEX.
    IF I_REPORT-DPAST LE V_DAYS.
      CONCATENATE 'I_TOTAL-DAYS' V_INDEX INTO V_FIELD-NAME.
      ASSIGN (V_FIELD-NAME) TO <COLUMN>.
      <COLUMN> = I_REPORT-DMBTR.
      EXIT.
    ELSEIF SY-INDEX EQ 5.
      CONCATENATE 'I_TOTAL-DAYS' V_INDEX INTO V_FIELD-NAME.
      ASSIGN (V_FIELD-NAME) TO <COLUMN>.
      <COLUMN> = I_REPORT-DMBTR.
      EXIT.
    ENDIF.
  ENDDO.
  COLLECT I_TOTAL.
ENDFORM.                    " F_BUILD_TOTALS
    

CO-PA has all the information you need...
Profitability Analysis is that part of CO where operations will access its performance factors and profitability statements contain margins, standard cost variance, sales information, allocations and other related profit or loss data. This module helps analyze profitability of customers, markets and products at various levels of contribution margins. Profitability is measured down to the SD billing document line and is adjusted periodically against standard costs and other costs.
It has 2 methods of approach :
Costing based Profitability Analysis - This is primarily designed to let you analyze profits quickly for the purpose of sales management.
Account based Profitabilty Analysis - This type of Profitability Analysis enables you to reconcile cost and financial accounting at any time using accounts.
Guess, the second approach is what you are looking for...

Similar Messages

  • Logic to get customer balance confirmation at profit center level.

    Hi All
    Please help me understand the logic to get customer balance confirmation at profit center level.(not at company codewhichis available)
    On what basis developments can be done.
    Detailed and early Inputs will be appreciated
    Thanks in advance.
    vadapav

    Hi
    First of all, I liked your user name...
    I have a basic question with regards to your requirement... Customer is an external party... he has got nothing to do with your internal definition of profit centers..
    Hence, if Customer A is buying goods from you belonging to Pr Ctr B and C - He wlil expect you to send a balance conf letter which aggregates total balance... He will be, in no way, concerned with your internal division of profit center wise balance
    Still, if you would like to go ahead with your requirement ,  then identify the open line items from BSID or BSAD (I dont know which one of these stores open line items) , Take that document no to table FAGLFLEXA and identify your profit center... This is assuming you are on ECC 6.0 and use New GL
    If you are not on ECC 6.0, then identify the open line items from BSID or BSAD and Take that document no to table  BSEG and read the profit center from revenue line item.. These revenue accounts can be included in a SET created in GS01 rather than hard coding in the program
    Regards
    Ajay M

  • F110 - Automatic Payment Program (APP) - Profit Center wise

    Has anyone worked on plant wise/profit center wise payments before? We have done necessary enhancement to populate profit center in vendor line item at the time of posting invoice. We are doing profit center wise proposal run in F110 by using additional selection criteria in F110.
    However, the problem arises when different profit centers want to make payment to same vendor. In such cases when one profit center has created the proposal for the vendor, F110 locks the vendor for any other payment proposal by making an entry in REGUS table. Hence, when the other profit center creates proposal in F110, the vendor is shown as locked. The lock is released only after the payment run.
    All the profit center will run proposal at the same time and after that payment run will be carried out by central treasury. Hence, I cannot schdule the payment run of different profit center at different time.
    Is there any work around? Is it possible that same vendor can be contained in different proposals of different profit centers?
    We were thinking of doing an enhancement to delete the entries from REGUS table after proposal run. Would it be right way?

    It is standard behaviour in F110 for locking vendor.
    Try luck to use same paying company code for all your profit center company codes.  Keep update

  • APP- Single Payment Document per Profit Center

    Hi All,
    Like we have option making single payment per business area wise in APP, client request to make per profit center Wise. But, sap not given any option like that till ECC 6.0 EH4.
    Can anybody have any work round solution for this requirement.
    Thanks and Regards,
    Ram

    Hi Sachin,
    the question is in fact how can we tie back the postings to the original documents:
    e.g. I have 1 custumer invoice. Document number 1 which through document split has received 2 profit centers.
    On the first screen 1 get 1 line:
                                                original FX rate          reval FX rate
    document 1 : 100 USD        ,75          75 EUR       ,80     80 EUR       5 EUR exchange rate difference to be posted
    If I click on the postings button I see :
    debit FX differences    3 EUR profit center 1
    credit FX gain               3 EUR profit center 1
    debit FX differences    2 EUR profit center 2
    credit FX gain               2 EUR profit center 2
    We are searching for a list that replaces the first list and looks like:
                                                                         original FX rate          reval FX rate
    document 1 :  profit center 1 60 USD        ,75          45 EUR       ,80     48 EUR       3 EUR exchange rate difference to be posted
    document 1 :  profit center 2 40 USD        ,75          30 EUR       ,80     32 EUR       2 EUR exchange rate difference to be posted
    Thanks in advance for your answer.
    Best regards
    Sven

  • Transfer of Customer balance from one profit center to another profit cente

    Hi,
    Actually we  are working in SAP version 4.7, and now i want to transfer some accounting document from one profit center to another profit center like in a customer a/c lots of documents are showing in different profit balance and right now i want to change the profit center in some documents, pls advice how can we do the same in Detail if possible provide any user manual related to that.
    Thanks  & Regards
    Sandeep

    Once again, this are you possibilities:
    You can use the PCA allocations like 3KE5 (assessment) or 4KE5 (distribution) or the manual PCA posting trnsactions 9KE0 or 1KEL.
    If you speak about cost element accounts that are assigned to real account assignment objects and you have changed the assignment of the profitcenter to the CO-object (like in the cost center master data, WBS element, internal order master data and so on) you can repost the respective accounting document into PCA. Please have a look in SAP note 858363 for more information regarding that.
    Best regards,
    Andreas

  • Payment performance

    I want to calculate customer payment performance by profit center it is a report.
    Caluation clue.
    Performance is a measure of when the payment was made versus the due date calculated by the payment terms.
    i want the logic to be included in the following code.

    hi,
    try with this function module
    ITEM_OVERDUE_DAYS
    cheers,
    sasi

  • Dummy Profit Center -- Customer Line item

    Hello
    I have a scenerrio on dummy profit center
    1. On Augst 2006 -- A customer invoice has been posted using FB70 and some how the customer account  line item when to dummy profit center and other line items were posted to a the correct profit center.
    2. On August 2006 -- Due to this business reversed original customer invoice using FB08 which again has customer account line item when to dummy profit center and other line items were posted to the correct profit center.
    Origianl Invoice: Customer XYZ Ltd - GL 130024 ( Customer Reconciliation Account)--- Dummy profit Center -- Dr. 235,000 USD
    Reversal          : Customer XYZ Ltd - GL 130024 (Customer Reconciliation Account) -- Dummy profit center -- Cr. 235,000 USD
    This is want we want and this is want we see in our FI entries and all are with the same posting dates.
    Now some how when you look at KE5Z (Profit Center line items report) for dummy profit centers even today.
    1. You see the original customer invoice showing dummy profit center  on the customer account  line item as Dr. 235,000 on GL 130024.
    2. You see the reversal customer invoice showing correct profit center on the other line items and you dont see customer account line item that is GL130024 on this document.
    3. Because of which dummy profit center is showing Dr.balance.
    PCA report:
    Origianl Invoice: Customer XYZ Ltd - GL 130024 ( Customer Reconciliation Account)--- Dummy profit Center -- Dr. 235,000 USD
    Reversal          : Customer XYZ Ltd - No entry except the same document number with the other line items.
    Could you please give us the thoughts except the PCA entry only as business dont have to have this entry. Business basically want to know the reason for not showing the customer line item on the reversal document which will knot out the dummy.
    Will assign good points
    Thanks
    Kumar

    Not answered but closing

  • Profit Center : Reflect - Vendor, Customer, Bank/Cash Balance

    Dear Experts,
    Ref. : Reflect - Vendor, Customer, Bank/Cash Balance, Balance Sheet GL Accounts - Profit Center wise.
    When we do postings to P&L Items, we assign a CO / Cost Object. Such Cost objects may be Orders, Cost Centers, etc., which has a Profit Center assigned to it.
    Now, we wish to view Balance Profit Center wise.
    My Concerns :
    1.  Can Vendor, Customer, Bank/Cash Balance, Balance Sheet GL Accounts - Profit Center wise. Since we do not assign CO objects to such line items, but the correspondense line items (P&L GL) has a CO object.
    2.  If yes, how do we move balance of such items, to Profit Center / profit Center wise.
    Experts, please help me to understand the concept.
    Regards,
    Hussein.

    Hi,
    Are you in ECC activated new G/L? If yes, then you can define Profit Center as Document Splitting Characteristic for General Ledger and profit center will be in the AR/AP line item as well in ledger view (though you don't enter profit center during document entry).
    You cannot give the Profit center in line item level to the Subledger accounts like vendor and customers.Vendor and customer accounts take the profit center from the offsetting entry.If want to see the profit center to the particular document, open the document go to Environment field and select Balance Sheet Adjustment option.
    If you want to see the Profit center wise payables and receivables, use T.code GR55 and take report group 8A90 for Periodic Receivables and 8A91 for Payable.
    If you want to see the all payables with Profit center use Table BFOK_A for vendors BFOD_A for customers.
    Regards,
    Viswa

  • CUSTOMER BALANCE LINE ITEM DISPLAY WITH PROFIT CENTER WISE

    Dear Folks,
                     Please suggest whether is there any standard report related to
    customer balance report against Profit center wise or suggest the best way to create the Z  REPORT LOGIC
    Thanx In advance
    REGARDS
    ASHOK K

    Hi, Ashok 
    Welcome to SCN
    Please Don't USE ALL CAPS, it is against the Forum Rules, Check Bellow
    Please read "The Forum Rules of Engagement" before posting!  HOT NEWS!!
    Faisal

  • Default Profit Center to Customer Account.

    Dear Friends,
    We have posted an FI Document using T.code FB70.
    After the document in posted, I have checked in T.code FB03.
    For Customer Account, Profit Center is defaulted .
    EX: for Customer Account is 40, Profit center 99,0000 is defaulted.
    Why this ahppening, Where can i check this configuration.
    We have not implemented NEW GL, although we are using ECC 6.0.
    Please suggest.
    Regards
    Sridhar

    Sridhar,
    Profit Center default in GL Account Number  wise , i.e, while creating customer master data Recon account, you check Default Profit center in T.code FAGL3KEH , .
    With regards,
    Ganesh Sadula.

  • Wrong profit center posted for a customer invoice

    Dear All
    I have posted customer invoice with wrong profit center, is there any way to reverse the same other than FB08 as I used the transaction 9KE0 but it doesn't support customer and vendor account.
    I want to correct the same through profit center only.( i.e. reducing the balance of wrong profit center and
    increasing the balance of correct profit center )
    Thanks in advance.
    Viru.

    Hello,
    Even if you posted a customer invoice only Control Account totals will be moved to PCA.
    Hence, see the control account for the customer masteer assigned and adjust the account accordingly by posting the entry through 9KE0.
    Regards,
    Ravi

  • Profit center to vendor/customer reconciliation accounts

    Hi All,
    Dummy Profit center has already been assigned to customer/vendor reconciliation accounts in 3KEH in PCA.  Will that affect F.5D  - post balance sheet adjustment process?
    Thanks!
    Rajesh

    Normally in 3KEH is to assign the default profit center, all Balance sheet accounts are assigned to a Dummy Profit Center.
    This profit center is only considered if as per the process, Profit center is not populated in the Customer or Vendor, Dummy profit center would be assigned so that Legal Balance sheet and Profit centerwise Balance sheet can always match.
    We can always repost from Dummy profit center to the right profit center.

  • Profit center Field in customer master

    Dear Experts,
    Is it possible to activate the profit center field in customer master under billing data, I saw the account group layout but center field is not there.
    Is there any other way is there for activating the profit center field.
    I saw this field in one of my client.
    please help how to activate the profit center field in customer master
    Regards
    Sri

    Hi
    Profit center as a field is not available in Customer Master. However, if you have new gl activitaed it is copied to the customer line item  from the offsetting line item. By system design, it is imperative, that the subledgers like customer or vendors are updated with the profit center of the line item. This is what the concept of document splitting is all about.
    Regards
    Sanil Bhandari

  • PCA  postings to DUMMY profit center

    I have a customer invoice posted to profit center A and then it is cleared after customer payment is received. After balance sheet adjustment is calculated using F.5D transaction, the customer line item in the payment document is "attached" to DUMMY profit center.  Shouldn't it "attach" to  profit center of the invoice.
    Thanks in advance.
    Sanjiv Agrawal

    I am not concerned with AR or AP invoice.   My question pertains to payment for AR or AP invoice.
    Let's take AP invoice:
    Cr  Vendor  $100
    Dr  Expense $100
    AP payment:
    Dr Vendor   $100    ->  CLEARED ITEM
    Cr Cash       $100
    Does it make sense if SAP program F.5D  determines PC "DUMMY" for the vendor cleared item?  It is not going to be transferred to PCA anyway since it is no more open item.
    Thanks
    Sanjiv

  • F-28 Transaction , Customer Payment posting

    Hi,
    I am getting the errror message below when trying to post the customer payment with transaction code F-28. We have New GL implemented at our client.
    I have checked and found that field status of the "Profit Center" field is optional in case of posting key and field status group.
    Please let me know the way to rectify this error in the line item of customer.
    ===============================
    Balancing field "Profit Center" in line item 003 not filled
    Message no. GLT2201
    Diagnosis
    The field Profit Center marked as balancing is not filled with any value in line item 003, even after document splitting.
    System Response
    The document cannot be posted.
    Procedure
    First check your entries.
    Additional causes could be:
    No value can be derived for this field from the current document data.
    You have entered a document type that is not designed for this business purpose.
    Procedure for System Administration
    Customizing
    ==========================================
    Regards,
    Viswanath

    Hi,
    I have already maintained this setting and also maintained the default profit center for the bank accounts. But the error message is thrown at the 03 line item which pertains to the customer line item.
    Please suggest the needful to be done for this case.
    Also let me know if there is any option to make postings to different profit centers for different line items to the same customer.
    Regards,
    Viswanath

Maybe you are looking for

  • EFI Update v2.6 breaks Windows dual boot

    The EFI Update MBA51.00EF.B02 has broken WIndows on my MacBook Air 2012 Bootcamp Dual boot using OSX Lion & WIndows 7 was working fine prior to the EFI update. Since then, the WIndows initial boot screen displays, but as soon as the GUI starts there

  • IDOC message type for "Site" in SAP Retail module?

    Hi All, We have the need to transfer master data (through master data change pointers) of Retail Sites within the SAP Retail module (transaction:  WB01, WB02).  Does anyone know if there's an IDOC message/type already associated with this?  Thanks in

  • Using Sony Bravia as display brightness issue

    I'm using a Mini as a media server, hooked up via HDMI to a recently purchased Sony Bravia TV. When watching video, the picture will automatically get brighter or darker -- but in the most annoying way possible. When watching a movie with a particula

  • Can't send emails in google mail

    I cannot compose emails when in my google mail account. When I click the Compose button it says Loading in the toolbar but nothing happens.

  • I can't share a contact using email on my iphone 4 or ipad. Using iOS 7.1.2

    Recently I have been unable to share contacts or notes from my iPhone or iPad.  I can't be sure but I believe this is occurring after I downloaded iOS 7.1.2. I've been playing around in settings to see if something was turned on or off but don't see