zoukankan      html  css  js  c++  java
  • 功能:由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

  • 相关阅读:
    CSS Sprite笔记
    前端分页页码静态部分制作
    有趣的网页小部件笔记
    Lintcode 85. 在二叉查找树中插入节点
    Lintcode 166. 主元素
    网页失去焦点标题变化效果
    Lintcode 166. 链表倒数第n个节点
    Lintcode 157. 判断字符串是否没有重复字符
    Lintcode 175. 翻转二叉树
    Lintcode 372. O(1)时间复杂度删除链表节点
  • 原文地址:https://www.cnblogs.com/twttafku/p/14295702.html
Copyright © 2011-2022 走看看