功能：由STO採購訂單創建交貨單

REPORT  ZSDA11N_LOCAL.
*&---------------------------------------------------------------------*
*&使用核心標準功能BAPI_OUTB_DELIVERY_CREATE_STO創建
*&
*&---------------------------------------------------------------------*
*&自動交貨  NB
*&---------------------------------------------------------------------*
TABLES: EKPO,EKKO,EKPV.
PARAMETERS: P_DATU  TYPE INT1 DEFAULT 100.
PARAMETERS: P_BSART  TYPE ESART DEFAULT 'NB' .
SELECT-OPTIONS: S_LIFNR FOR EKKO-LIFNR DEFAULT '6000'."供應商帳戶號
SELECT-OPTIONS: S_EKORG FOR EKKO-EKORG ."採購組織
SELECT-OPTIONS: S_EKGRP FOR EKKO-EKGRP ."採購組
SELECT-OPTIONS: S_FRGZU FOR EKKO-FRGZU. "是否審批
SELECT-OPTIONS: S_WERKS FOR EKPO-WERKS . "工廠
SELECT-OPTIONS: S_BUKRS  FOR EKKO-BUKRS ."公司代碼
SELECT-OPTIONS: S_LGORT  FOR EKPO-LGORT ."DEFAULT '6026' TO '6028'.
SELECT-OPTIONS: S_VSTEL  FOR EKPV-VSTEL .
SELECT-OPTIONS: S_RESWK  FOR EKKO-RESWK.
SELECT-OPTIONS: S_RETPO FOR EKPO-RETPO.
SELECT-OPTIONS: S_RESLO  for ekpo-RESLO.
IF S_RETPO IS INITIAL.
  S_RETPO-SIGN = 'I'.
  S_RETPO-OPTION = 'EQ'.
  S_RETPO-LOW = ''.
APPEND S_RETPO.
ENDIF.
*0 計算是否是計算時間
DATA:
   C_PRUEFLOS  LIKE QALS-PRUEFLOS.
CONCATENATE 'NB' SY-DATUM  INTO C_PRUEFLOS.
DATA: X(10),M(10), L_MESSAGE(300).
CALL FUNCTION 'ENQUEUE_EQQALS1'
EXPORTING
    PRUEFLOS     = C_PRUEFLOS
EXCEPTIONS
    FOREIGN_LOCK = 1.
IF NOT SY-SUBRC IS INITIAL.
  L_MESSAGE = '正在進行計算操作，ZSDA11N '.
CONCATENATE L_MESSAGE  '退出!' INTO L_MESSAGE.
WRITE L_MESSAGE .
RETURN.
ENDIF.
*DATA: S(1).
*CLEAR S.
*DATA: LINE LIKE ZSDA19.
*IF SY-BATCH = 'X' ."後臺執行
*  S = 'A'.
*  SELECT * INTO LINE
*  FROM ZSDA19
*  WHERE DAT1 = SY-DATUM.
**  AND FLAG = 'PO'.
**  AND VSTEL = P_VSTEL.
*    IF SY-UZEIT < LINE-ETIM AND  SY-UZEIT >= LINE-STIM.
*      S = 'X'.
*      EXIT.
*    ENDIF.
*  ENDSELECT.
*ENDIF.
*
*IF S = 'A' AND P_FORCE IS INITIAL. "沒有工作日曆
*  WRITE '沒有工作日曆'.
*  RETURN.
*ENDIF.
*1. 取要操作的訂單
DATA: CDATE LIKE SY-DATUM.
IF P_DATU IS INITIAL.
  P_DATU = 100.
ENDIF.
IF SY-BATCH = 'X'.
  P_DATU = 100.
ENDIF.
CDATE = SY-DATUM + P_DATU.
DATA: BEGIN OF ITABH OCCURS 0,
        ETDAT  TYPE ERDAT,
        TY(20),
        LS(10),
        VSTEL  TYPE VSTEL,
        INT2   TYPE DZMENG,
        VBELN  TYPE VBELN,
        VBELP  TYPE VBELP,
        EBELN  TYPE EBELN,
END OF ITABH.
DATA NUM TYPE I.
****-----取NB單-----------------------------------------------------------
SELECT-OPTIONS: S_EBELN FOR EKKO-EBELN.
DATA:
  ST_EKBE LIKE EKBE OCCURS 0 WITH HEADER LINE,
BEGIN OF ST_EKPO OCCURS 0,
    EBELN TYPE EBELN,
    EBELP TYPE EBELP,
    MATNR TYPE MATNR,
    MENGE TYPE BSTMG,
    BSTDK TYPE ERDAT,
    LGORT TYPE LGORT_D,
    BEDNR TYPE BEDNR,
    VSTEL TYPE VSTEL,
END OF ST_EKPO.
CDATE = SY-DATUM - 100. "UB訂單隻處理100天前的記錄
SELECT
  EKPO~EBELN
  EKPO~EBELP
  EKPO~MATNR
  EKPO~MENGE
  EKKO~BEDAT AS BSTDK
  EKPO~LGORT
  EKPO~BEDNR
  EKPV~VSTEL
INTO TABLE ST_EKPO
FROM EKKO
JOIN EKPO ON EKKO~EBELN = EKPO~EBELN
JOIN EKPV ON EKPO~EBELN = EKPV~EBELN AND EKPO~EBELP = EKPV~EBELP
WHERE EKKO~EBELN IN S_EBELN
AND BSART = P_BSART
AND ELIKZ <> 'X'
AND EKPO~LOEKZ <> 'L'
AND FRGZU IN S_FRGZU "= 'X'
AND RETPO IN S_RETPO
AND BSART =    P_BSART
AND EKKO~BUKRS IN S_BUKRS
AND LIFNR IN S_LIFNR
AND EKORG IN  S_EKORG
AND WERKS IN S_WERKS
AND LGORT IN S_LGORT
AND EKPV~VSTEL IN  S_VSTEL
*  AND BEDAT >= '20170601'
AND BEDAT >= CDATE
AND EKGRP IN S_EKGRP
AND RESWK IN S_RESWK
and RESLO in S_RESLO.
PERFORM GETNOMATNR_UB.
DATA SINFO TYPE STRING.
*
*DATA:
*  ITAB2 LIKE EKET,
*  S1 TYPE ETMEN,
*  S2 TYPE WAMNG.
*LOOP AT ST_EKPO.
*  CLEAR: S1,S2,ITAB2.
*  SELECT * INTO ITAB2 FROM EKET WHERE EBELN = ST_EKPO-EBELN AND EBELP = ST_EKPO-EBELP.
*    S1 = S1 + ITAB2-MENGE .
*    S2 = S2 + ITAB2-WAMNG .
*    CLEAR ITAB2.
*  ENDSELECT.
*  IF S1 = S2 .
*    DELETE ST_EKPO.
*    CONCATENATE ST_EKPO-EBELN '-' ST_EKPO-EBELP '交貨完成.' INTO SINFO.
*    WRITE /: SINFO.
*  ENDIF.
*ENDLOOP.
CLEAR ITABH.
LOOP AT ST_EKPO.
MOVE ST_EKPO-BSTDK TO ITABH-ETDAT.
MOVE ST_EKPO-EBELN TO ITABH-EBELN.
IF ST_EKPO-BEDNR IS INITIAL.
CALL FUNCTION 'ZDYNAMI_OUTPUT_LENGTH'
EXPORTING
FIELD = ST_EKPO-EBELN
IMPORTING
        LEN   = NUM.
    NUM = NUM - 1.
CALL FUNCTION 'Z_FIY_OFFSET_EDIT'
EXPORTING
        IM_INPUT     = ST_EKPO-EBELN
        IM_OFFSET_IN = NUM
        IM_LENGTH_IN = 1
*       IM_OFFSET_OUT       = 0
*       IM_LENGTH_OUT       = 0
CHANGING
        CH_OUTPUT    = ITABH-LS.
*    NUM = STRLEN( ST_EKPO-EBELN ) - 1."字符長度
*    ITABH-LS = ST_EKPO-EBELN+NUM(1)."取最後一個字符
ELSE.
CALL FUNCTION 'ZDYNAMI_OUTPUT_LENGTH'
EXPORTING
FIELD = ST_EKPO-BEDNR
IMPORTING
        LEN   = NUM.
    NUM = NUM - 1.
CALL FUNCTION 'Z_FIY_OFFSET_EDIT'
EXPORTING
        IM_INPUT     = ST_EKPO-BEDNR
        IM_OFFSET_IN = NUM
        IM_LENGTH_IN = 1
*       IM_OFFSET_OUT       = 0
*       IM_LENGTH_OUT       = 0
CHANGING
        CH_OUTPUT    = ITABH-LS.
*    NUM = STRLEN( ST_EKPO-BEDNR ) - 1."字符長度
*    ITABH-LS = ST_EKPO-BEDNR+NUM(1)."取最後一個字符
ENDIF.
  ITABH-VSTEL = ST_EKPO-VSTEL."裝運點
DATA:
  L_TIPO  LIKE  DD01V-DATATYPE.
CALL FUNCTION 'NUMERIC_CHECK'
EXPORTING
      STRING_IN = ITABH-LS
IMPORTING
      HTYPE     = L_TIPO.
IF L_TIPO <> 'NUMC' .
    ITABH-LS = '0'.
CLEAR L_TIPO.
ENDIF.
*  ITABH-INT2 = '90' + ST_EKPO-MENGE .
DATA LV_BEDNR TYPE CHAR4.
CALL FUNCTION 'Z_FIY_OFFSET_EDIT'
EXPORTING
      IM_INPUT     = ST_EKPO-BEDNR
      IM_OFFSET_IN = 0
      IM_LENGTH_IN = 4
*     IM_OFFSET_OUT       = 0
*     IM_LENGTH_OUT       = 0
CHANGING
      CH_OUTPUT    = LV_BEDNR.
IF ST_EKPO-BEDNR+0(4) = '需求'.
    ITABH-TY = 'XQ'.
ELSE.
    ITABH-TY = 'BH'.
ENDIF.
COLLECT ITABH.
ENDLOOP.
SORT ITABH.
DELETE ADJACENT DUPLICATES FROM ITABH.
*****-------以下產生交貨單-------------------------------
*************1.按日期排序
*SORT ITABH BY ETDAT INT2 LS TY.
*LOOP AT ITABH WHERE TY = 'XQ'.
*  PERFORM GET_EBELN-LIKP USING ITABH-EBELN.
*ENDLOOP.
*
**********最後跑備貨
*LOOP AT ITABH WHERE TY = 'BH'.
*  PERFORM GET_EBELN-LIKP USING ITABH-EBELN.
*ENDLOOP.
************1.按日期排序
SORT ITABH BY ETDAT INT2 LS TY.
LOOP AT ITABH WHERE TY = 'XQ'.
CONCATENATE ITABH-EBELN '-' 'XQ開始處理.....' INTO SINFO.
WRITE /: SINFO.
PERFORM GET_EBELN-LIKP USING ITABH-EBELN.
CONCATENATE ITABH-EBELN '-' 'XQ處理結束.....' INTO SINFO.
WRITE /: SINFO.
ENDLOOP.
*********最後跑備貨
LOOP AT ITABH WHERE TY = 'BH'.
CONCATENATE ITABH-EBELN '-' 'BH開始處理.....' INTO SINFO.
WRITE /: SINFO.
PERFORM GET_EBELN-LIKP USING ITABH-EBELN.
CONCATENATE ITABH-EBELN '-' 'BH處理結束.....' INTO SINFO.
WRITE /: SINFO.
ENDLOOP.
FORM   GET_EBELN-LIKP USING V_EBELN.
DATA:   VSTEL             LIKE TVST-VSTEL,                             "裝運點/接收點
          LF_NUM            TYPE VBNUM,
          STOCK_TRANS_ITEMS LIKE BAPIDLVREFTOSTO OCCURS 0 WITH HEADER LINE,
          LF_VBELN          TYPE VBELN_VL,
          LS_DELI           TYPE BAPISHPDELIVNUMB,
          LT_DELI           TYPE TABLE OF BAPISHPDELIVNUMB,
          LT_EXTOUT         TYPE TABLE OF BAPIPAREX,
          LS_EXT            TYPE BAPIPAREX,
          LT_RETURN         TYPE TABLE OF BAPIRET2,
          LS_RET            TYPE BAPIRET2,
          LS_ITM            TYPE BAPIDLVITEMCREATED,
          LT_ITM            TYPE TABLE OF BAPIDLVITEMCREATED.
MOVE ITABH-VSTEL TO VSTEL .                                                       "裝運點
  STOCK_TRANS_ITEMS-REF_DOC = V_EBELN.        "參考憑證
APPEND STOCK_TRANS_ITEMS.
REFRESH LT_RETURN.
REFRESH LT_ITM.
CALL FUNCTION 'BAPI_OUTB_DELIVERY_CREATE_STO'
EXPORTING
      SHIP_POINT        = VSTEL
IMPORTING
      DELIVERY          = LF_VBELN
      NUM_DELIVERIES    = LF_NUM
TABLES
      STOCK_TRANS_ITEMS = STOCK_TRANS_ITEMS
      DELIVERIES        = LT_DELI
      CREATED_ITEMS     = LT_ITM
      EXTENSION_OUT     = LT_EXTOUT
RETURN            = LT_RETURN.
DATA: ISOK.
CLEAR ISOK.
LOOP AT  LT_ITM INTO LS_ITM WHERE  DLV_QTY > 0.
CALL FUNCTION 'BAPI_TRANSACTION_COMMIT'
EXPORTING
WAIT = 'X'.
    ISOK = 'X'.
EXIT.
ENDLOOP.
IF ISOK IS INITIAL.
CALL FUNCTION 'BAPI_TRANSACTION_ROLLBACK'.
ELSE.
WRITE / LF_VBELN .
ENDIF.
CHECK  ISOK = 'X'.
DATA: WA_HDATA    LIKE BAPIOBDLVHDRCHG,
        WA_HCONT    LIKE BAPIOBDLVHDRCTRLCHG,
        D_DELIVY    LIKE BAPIOBDLVHDRCHG-DELIV_NUMB,
        ITEMCTRL    LIKE BAPIOBDLVITEMCTRLCHG OCCURS 0 WITH HEADER LINE,
        ITEMDATA    LIKE  BAPIOBDLVITEMCHG OCCURS 0 WITH HEADER LINE,
        IT_BAPIRET2 LIKE BAPIRET2 OCCURS 0 WITH HEADER LINE.
DATA: TBL_ITEMS LIKE LS_ITM OCCURS 0 WITH HEADER LINE.
LOOP AT  LT_ITM INTO LS_ITM .
MOVE LS_ITM-REF_DOC TO TBL_ITEMS-REF_DOC.
MOVE LS_ITM-REF_ITEM TO TBL_ITEMS-REF_ITEM.
MOVE LS_ITM-DLV_QTY TO TBL_ITEMS-DLV_QTY.
COLLECT TBL_ITEMS.
ENDLOOP.
*DELIV_NUMB
*DELIV_ITEM
*刪除數量爲0的交貨單
LOOP AT TBL_ITEMS WHERE DLV_QTY  = 0.
LOOP AT  LT_ITM INTO LS_ITM WHERE REF_DOC = TBL_ITEMS-REF_DOC
AND REF_ITEM = TBL_ITEMS-REF_ITEM.
CLEAR TBL_ITEMS.
MOVE-CORRESPONDING LS_ITM TO TBL_ITEMS.
      WA_HDATA-DELIV_NUMB = TBL_ITEMS-DELIV_NUMB.
      WA_HCONT-DELIV_NUMB = TBL_ITEMS-DELIV_NUMB.
      D_DELIVY            = TBL_ITEMS-DELIV_NUMB.
      ITEMCTRL-DELIV_NUMB = TBL_ITEMS-DELIV_NUMB.
      ITEMCTRL-DELIV_ITEM = TBL_ITEMS-DELIV_ITEM.
      ITEMCTRL-DEL_ITEM = 'X'.
APPEND ITEMCTRL.
      ITEMDATA-DELIV_NUMB = TBL_ITEMS-DELIV_NUMB.
      ITEMDATA-DELIV_ITEM = TBL_ITEMS-DELIV_ITEM.
      ITEMDATA-FACT_UNIT_NOM = 1.
      ITEMDATA-FACT_UNIT_DENOM = 1.
APPEND ITEMDATA.
CLEAR LS_ITM.
ENDLOOP.
ENDLOOP.
CALL FUNCTION 'BAPI_OUTB_DELIVERY_CHANGE'
EXPORTING
      HEADER_DATA    = WA_HDATA
      HEADER_CONTROL = WA_HCONT
      DELIVERY       = D_DELIVY
TABLES
      ITEM_CONTROL   = ITEMCTRL
      ITEM_DATA      = ITEMDATA
RETURN         = IT_BAPIRET2.
CALL FUNCTION 'BAPI_TRANSACTION_COMMIT'
EXPORTING
WAIT = 'X'.
ENDFORM.
FORM GETNOMATNR_UB.
ENDFORM.                    "GetNoMatnr