&ANALYZE-SUSPEND _VERSION-NUMBER AB_v10r12 &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DECLARATIONS Procedure USING Progress.Json.ObjectModel.JsonObject FROM PROPATH. USING Progress.Json.ObjectModel.ObjectModelParser FROM PROPATH. &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure /*------------------------------------------------------------------------ File : Purpose : Syntax : Description : Author(s) : Created : Notes : ----------------------------------------------------------------------*/ /* This .W file was created with the Progress AppBuilder. */ /*----------------------------------------------------------------------*/ /* *************************** Definitions ************************** */ DEFINE INPUT PARAMETER ipcParam AS CHARACTER NO-UNDO EXTENT. DEFINE VARIABLE cFirma AS CHARACTER NO-UNDO. DEFINE VARIABLE AdFirma AS CHARACTER NO-UNDO. DEFINE VARIABLE cInstall AS CHARACTER NO-UNDO. DEFINE VARIABLE nMenge AS DECIMAL NO-UNDO. DEFINE VARIABLE hDS AS HANDLE NO-UNDO. DEFINE VARIABLE hTempTable AS HANDLE NO-UNDO. DEFINE VARIABLE iTransDet AS INTEGER NO-UNDO. DEFINE VARIABLE cZeile AS CHARACTER NO-UNDO. DEFINE VARIABLE iZeile AS INTEGER NO-UNDO. DEFINE VARIABLE iSpace AS INTEGER NO-UNDO. DEFINE VARIABLE cDatei AS CHARACTER NO-UNDO. DEFINE VARIABLE cParameter AS CHARACTER NO-UNDO. DEFINE VARIABLE ii AS INTEGER NO-UNDO. DEFINE VARIABLE lBatch AS LOGICAL NO-UNDO. DEFINE VARIABLE ipFirma AS CHARACTER NO-UNDO INIT '1000'. DEFINE VARIABLE ipSalerId AS CHARACTER NO-UNDO INIT '2700721304'. DEFINE VARIABLE ipHerst AS INTEGER NO-UNDO INIT 35. DEFINE VARIABLE ipLiefnr AS INTEGER NO-UNDO INIT 523. DEFINE VARIABLE ipabDatum AS DATE NO-UNDO INIT 01/01/2023. DEFINE VARIABLE ipDatei AS CHARACTER NO-UNDO INIT 'C:\TEMP\'. DEFINE VARIABLE oJsonObject AS JsonObject NO-UNDO. DEFINE VARIABLE oParser AS ObjectModelParser NO-UNDO. DEFINE VARIABLE lcJsonObject AS LONGCHAR NO-UNDO. DEFINE STREAM sXML. DEFINE STREAM sTEMP. DEFINE BUFFER bSteuer FOR Steuer. { incl/cocacola_v2_ds.i } DEFINE TEMP-TABLE tArtbw LIKE Artbw FIELD Herst AS INTEGER FIELD ProdVol AS DECIMAL FIELD LiefKnr AS CHARACTER INDEX tArtbw-k1 IS PRIMARY Knr Artnr Inhalt Jahr Datum INDEX tArtbw-k2 Artnr Inhalt Jahr INDEX tArtbw-k3 Knr Aufnr Artnr Inhalt Jahr. DEFINE TEMP-TABLE tCustomer FIELD Knr AS INTEGER FIELD Ku_Grp AS CHARACTER FIELD lFakKnr AS LOGICAL INDEX tCustomer-k1 IS PRIMARY Knr . DEFINE TEMP-TABLE tXML FIELD iZeile AS INTEGER FIELD iSpace AS INTEGER FIELD cLine AS CHARACTER . /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK /* ******************** Preprocessor Definitions ******************** */ &Scoped-define PROCEDURE-TYPE Procedure &Scoped-define DB-AWARE no /* _UIB-PREPROCESSOR-BLOCK-END */ &ANALYZE-RESUME /* ************************ Function Prototypes ********************** */ &IF DEFINED(EXCLUDE-createControlList) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD createControlList Procedure FUNCTION createControlList RETURNS LOGICAL ( ) FORWARD. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-createCustomers) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD createCustomers Procedure FUNCTION createCustomers RETURNS INTEGER ( ) FORWARD. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-createProducts) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD createProducts Procedure FUNCTION createProducts RETURNS INTEGER ( ) FORWARD. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-createSales) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD createSales Procedure FUNCTION createSales RETURNS LOGICAL ( /* parameter-definitions */ ) FORWARD. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-findArtbw) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD findArtbw Procedure FUNCTION findArtbw RETURNS DECIMAL ( /* parameter-definitions */ ) FORWARD. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF /* *********************** Procedure Settings ************************ */ &ANALYZE-SUSPEND _PROCEDURE-SETTINGS /* Settings for THIS-PROCEDURE Type: Procedure Allow: Frames: 0 Add Fields to: Neither Other Settings: CODE-ONLY COMPILE */ &ANALYZE-RESUME _END-PROCEDURE-SETTINGS /* ************************* Create Window ************************** */ &ANALYZE-SUSPEND _CREATE-WINDOW /* DESIGN Window definition (used by the UIB) CREATE WINDOW Procedure ASSIGN HEIGHT = 15 WIDTH = 60. /* END WINDOW DEFINITION */ */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure /* *************************** Main Block *************************** */ hDS = DATASET dsSALE:HANDLE. hDS:SET-CALLBACK-PROCEDURE ("BEFORE-FILL", "POSTDATAFILLDS", THIS-PROCEDURE ). hDS:SET-CALLBACK-PROCEDURE ("AFTER-FILL" , "POSTDATAFILLDS", THIS-PROCEDURE ). DO ii = 1 TO EXTENT(ipcParam): CASE ii: WHEN 1 THEN ipFirma = ipcParam[ii]. WHEN 2 THEN ipSalerId = ipcParam[ii]. WHEN 3 THEN ipHerst = INTEGER(ipcParam[ii]). WHEN 4 THEN ipLiefnr = INTEGER(ipcParam[ii]). WHEN 5 THEN ipabDatum = DATE(ipcParam[ii]). WHEN 6 THEN ipDatei = ipcParam[ii]. END CASE. END. lBatch = DYNAMIC-FUNCTION ('getBatch':U) NO-ERROR. IF lBatch = ? THEN lBatch = TRUE. IF SESSION:BATCH THEN lBatch = TRUE. IF lBatch THEN ipabDatum = TODAY - 60. FIND bSteuer NO-LOCK WHERE bSteuer.Firma = ipFirma NO-ERROR. AdFirma = bSteuer.AdFirma. cInstall = bSteuer.Fwc10. cFirma = ipFirma. nMenge = DYNAMIC-FUNCTION ('findArtbw':U). DYNAMIC-FUNCTION ('createCustomers':U). DYNAMIC-FUNCTION ('createProducts':U). DYNAMIC-FUNCTION ('createSales':U). DYNAMIC-FUNCTION ('createControlList':U). cDatei = ipDatei + SUBSTITUTE('CUS_&1&2&3_&4.txt', STRING(YEAR(TODAY),'9999'), STRING(MONTH(TODAY),'99'), STRING(DAY(TODAY),'99'), REPLACE(STRING(TIME,'HH:MM'), ':', '') ). hTempTable = TEMP-TABLE CUS:DEFAULT-BUFFER-HANDLE. hTempTable:WRITE-JSON('File', cDatei, TRUE /*formatted*/, "UTF-8"). cDatei = ipDatei + SUBSTITUTE('PRO_&1&2&3_&4.txt', STRING(YEAR(TODAY),'9999'), STRING(MONTH(TODAY),'99'), STRING(DAY(TODAY),'99'), REPLACE(STRING(TIME,'HH:MM'), ':', '') ). hTempTable = TEMP-TABLE PRO:DEFAULT-BUFFER-HANDLE. hTempTable:WRITE-JSON('File', cDatei, TRUE /*formatted*/, "UTF-8"). hDS:FILL() NO-ERROR. cDatei = ipDatei + SUBSTITUTE('SAL_&1&2&3_&4.txt', STRING(YEAR(TODAY),'9999'), STRING(MONTH(TODAY),'99'), STRING(DAY(TODAY),'99'), REPLACE(STRING(TIME,'HH:MM'), ':', '') ). oJsonObject = NEW JsonObject(). oJsonObject:READ(hDS). oJsonObject:WRITE(lcJsonObject, FALSE). lcJsonObject = SUBSTRING(lcJsonObject,10). lcJsonObject = SUBSTRING(lcJsonObject,01, LENGTH(lcJsonObject) - 3). DELETE OBJECT oJsonObject. oJsonObject = NEW JsonObject(). oParser = NEW ObjectModelParser(). oJsonObject = CAST(oParser:PARSE (lcJsonObject), JsonObject). oJsonObject:WRITE(lcJsonObject, TRUE). COPY-LOB lcJsonObject TO FILE cDatei NO-CONVERT. DELETE OBJECT oJsonObject. DELETE OBJECT oParser. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME /* ********************** Internal Procedures *********************** */ &IF DEFINED(EXCLUDE-POSTDATAFILLDS) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE POSTDATAFILLDS Procedure PROCEDURE POSTDATAFILLDS : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DEFINE INPUT PARAMETER DATASET-HANDLE iphDS. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF /* ************************ Function Implementations ***************** */ &IF DEFINED(EXCLUDE-createControlList) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION createControlList Procedure FUNCTION createControlList RETURNS LOGICAL ( ): /*------------------------------------------------------------------------------ Purpose: Notes: ------------------------------------------------------------------------------*/ cDatei = ipDatei + SUBSTITUTE('SAL_&1&2&3_&4.xml', STRING(YEAR(TODAY),'9999'), STRING(MONTH(TODAY),'99'), STRING(DAY(TODAY),'99'), REPLACE(STRING(TIME,'HH:MM'), ':', '') ). hTempTable = TEMP-TABLE tControlList:DEFAULT-BUFFER-HANDLE. hTempTable:WRITE-XML('File', cDatei, TRUE /*formatted*/, "UTF-8", ?, FALSE, FALSE, ?, FALSE). END FUNCTION. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-createCustomers) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION createCustomers Procedure FUNCTION createCustomers RETURNS INTEGER ( ): /*------------------------------------------------------------------------------ Purpose: Notes: ------------------------------------------------------------------------------*/ DEFINE VARIABLE iAnz AS INTEGER NO-UNDO. DEFINE VARIABLE cStrasse AS CHARACTER NO-UNDO. DEFINE VARIABLE cName1 AS CHARACTER NO-UNDO. DEFINE VARIABLE cName2 AS CHARACTER NO-UNDO. DEFINE VARIABLE cLeerPlz AS CHARACTER NO-UNDO. DEFINE VARIABLE cLeerOrt AS CHARACTER NO-UNDO. FIND FIRST Steuer NO-LOCK WHERE Steuer.Firma = cFirma NO-ERROR. IF NUM-ENTRIES(Steuer.Ort, '-') > 1 THEN cLeerOrt = ENTRY(2, Steuer.Ort, '-'). ELSE cLeerOrt = Steuer.Ort. /* cLeerPlz = ENTRY(1, cLeerOrt, ' '). */ /* cLeerOrt = TRIM(REPLACE(cLeerOrt, cLeerPlz, '')).*/ cLeerPlz = 'N/A'. cLeerOrt = 'N/A'. FOR EACH tArtbw NO-LOCK USE-INDEX tArtbw-k1 BREAK BY tArtbw.Knr: IF NOT FIRST-OF ( tArtbw.Knr ) THEN NEXT. FIND Adresse NO-LOCK WHERE Adresse.Firma = AdFirma AND Adresse.Knr = tArtbw.Knr NO-ERROR. FIND Debst NO-LOCK WHERE Debst.Firma = cFirma AND Debst.Knr = Adresse.Knr NO-ERROR. FIND Tabel NO-LOCK WHERE Tabel.Firma = cFirma AND Tabel.RecArt = 'KUNDGRP' AND Tabel.CodeI = Debst.Ku_Grp AND Tabel.CodeC = '' AND Tabel.Sprcd = 1 NO-ERROR. IF Adresse.Firma1 <> '' THEN DO: cName1 = TRIM(Adresse.Firma1 + ' ' + Adresse.Firma2). cName2 = TRIM(Adresse.Vorname + ' ' + Adresse.Name). IF cName2 = '' THEN DO: cName1 = Adresse.Firma1. cName2 = Adresse.Firma2. END. IF cName2 = '' THEN cName2 = 'N/A'. END. ELSE DO: cName1 = Adresse.Name. cName2 = Adresse.Vorname. IF cName2 = '' THEN DO: cName2 = 'N/A'. END. END. cStrasse = Adresse.Strasse. IF cStrasse = '' THEN cStrasse = Adresse.Postfach. IF cStrasse = '' THEN cStrasse = 'N/A'. FIND FIRST tCustomer NO-LOCK WHERE tCustomer.Knr = tArtbw.Knr NO-ERROR. IF NOT AVAILABLE tCustomer THEN DO: CREATE CUS. ASSIGN CUS.BRANCH_ID = ipSalerId CUS.CUSTOMER_ID = TRIM(STRING(tArtbw.Knr,'>>>>>9')) CUS.PAYER_ID = (IF Debst.KnrFak = 0 THEN TRIM(STRING(Debst.Knr,'>>>>>>9')) ELSE TRIM(STRING(Debst.KnrFak,'>>>>>>9')) ) CUS.CUSTOMER_NAME_1 = cName1 CUS.CUSTOMER_NAME_2 = cName2 CUS.STREET = cStrasse CUS.POSTAL_CODE = (IF Adresse.Plz = '' THEN cLeerPlz ELSE Adresse.Plz) CUS.CITY = (IF Adresse.Ort = '' THEN cLeerOrt ELSE Adresse.Ort) CUS.COUNTRY_ID = (IF Adresse.Lkz = '' THEN 'CH' ELSE Adresse.Lkz) CUS.ACTIVITY = (IF Debst.Aktiv THEN 1 ELSE 0) CUS.CUSTOMER_TYPE = (IF AVAILABLE Tabel THEN Tabel.Bez1 ELSE ''). IF CUS.COUNTRY_ID = 'D' THEN CUS.COUNTRY_ID = 'DE'. IF CUS.COUNTRY_ID = 'I' THEN CUS.COUNTRY_ID = 'IT'. IF CUS.COUNTRY_ID = 'A' THEN CUS.COUNTRY_ID = 'AT'. CREATE tCustomer. ASSIGN tCustomer.Knr = tArtbw.Knr tCustomer.Ku_Grp = (IF AVAILABLE Tabel THEN Tabel.Bez1 ELSE '') tCustomer.lFakKnr = (IF CUS.CUSTOMER_ID = CUS.PAYER_ID THEN TRUE ELSE FALSE). iAnz = iAnz + 1. END. IF tCustomer.lFakKnr THEN NEXT. FIND FIRST tCustomer NO-LOCK WHERE tCustomer.Knr = tArtbw.Fak_Knr NO-ERROR. IF NOT AVAILABLE tCustomer THEN DO: FIND Adresse NO-LOCK WHERE Adresse.Firma = AdFirma AND Adresse.Knr = tArtbw.Fak_Knr NO-ERROR. FIND Debst NO-LOCK WHERE Debst.Firma = cFirma AND Debst.Knr = Adresse.Knr NO-ERROR. FIND Tabel NO-LOCK WHERE Tabel.Firma = cFirma AND Tabel.RecArt = 'KUNDGRP' AND Tabel.CodeI = Debst.Ku_Grp AND Tabel.CodeC = '' AND Tabel.Sprcd = 1 NO-ERROR. CREATE CUS. ASSIGN CUS.BRANCH_ID = ipSalerId CUS.CUSTOMER_ID = TRIM(STRING(tArtbw.Fak_Knr,'>>>>>9')) CUS.PAYER_ID = TRIM(STRING(tArtbw.Fak_Knr,'>>>>>>9')) CUS.CUSTOMER_NAME_1 = (IF Adresse.Firma1 <> '' THEN Adresse.Firma1 ELSE Adresse.Name) CUS.CUSTOMER_NAME_2 = (IF Adresse.Firma1 <> '' THEN Adresse.Name ELSE '' ) CUS.STREET = Adresse.Strasse CUS.POSTAL_CODE = Adresse.Plz CUS.CITY = Adresse.Ort CUS.COUNTRY_ID = Adresse.Lkz CUS.ACTIVITY = (IF Debst.Aktiv THEN 1 ELSE 0) CUS.CUSTOMER_TYPE = (IF AVAILABLE Tabel THEN Tabel.Bez1 ELSE ''). IF CUS.COUNTRY_ID = 'D' THEN CUS.COUNTRY_ID = 'DE'. IF CUS.COUNTRY_ID = 'I' THEN CUS.COUNTRY_ID = 'IT'. IF CUS.COUNTRY_ID = 'A' THEN CUS.COUNTRY_ID = 'AT'. CREATE tCustomer. ASSIGN tCustomer.Knr = tArtbw.Knr tCustomer.Ku_Grp = (IF AVAILABLE Tabel THEN Tabel.Bez1 ELSE '') tCustomer.lFakKnr = TRUE. iAnz = iAnz + 1. END. END. RETURN iAnz. END FUNCTION. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-createProducts) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION createProducts Procedure FUNCTION createProducts RETURNS INTEGER ( ): /*------------------------------------------------------------------------------*/ /* Purpose: Super Override */ /* Parameters: */ /* Notes: */ /*------------------------------------------------------------------------------*/ DEFINE VARIABLE iAnz AS INTEGER NO-UNDO. DEFINE VARIABLE cStrichcode AS CHARACTER NO-UNDO. FOR EACH tArtbw USE-INDEX tArtbw-k2 BREAK BY tArtbw.Artnr BY tArtbw.Inhalt BY tArtbw.Jahr : IF NOT FIRST-OF ( tArtbw.Jahr ) THEN NEXT. FIND Artst NO-LOCK WHERE Artst.Firma = cFirma AND Artst.Artnr = tArtbw.Artnr AND Artst.Inhalt = tArtbw.Inhalt AND Artst.Jahr = tArtbw.Jahr NO-ERROR. FIND FIRST Artbez NO-LOCK OF Artst. FIND VGebinde NO-LOCK WHERE VGebinde.Firma = cFirma AND VGebinde.Geb_Cd = Artst.VGeb_Cd NO-ERROR. FIND KGebinde NO-LOCK WHERE KGebinde.Firma = cFirma AND KGebinde.Geb_Cd = Artst.KGeb_Cd NO-ERROR. FIND ArtLief NO-LOCK WHERE ArtLief.Firma = cFirma AND ArtLief.Knr = ipLiefNr AND ArtLief.Artnr = tArtbw.Artnr AND ArtLief.Inhalt = tArtbw.Inhalt AND ArtLief.Jahr = tArtbw.Jahr NO-ERROR. IF NOT AVAILABLE ArtLief THEN NEXT. FIND Tabel NO-LOCK WHERE Tabel.Firma = cFirma AND Tabel.RecArt = 'HERST' AND Tabel.CodeI = Artst.Herst AND Tabel.CodeC = '' AND Tabel.Sprcd = 1 NO-ERROR. cStrichcode = Artst.Strichcode. IF cStrichcode = '' THEN cStrichcode = ArtLief.Strichcode_KGeb. IF cStrichcode = '' THEN cStrichcode = ArtLief.Strichcode_VGeb. IF cStrichcode = '' THEN cStrichcode = FILL('0', 13). CREATE PRO. ASSIGN PRO.BRANCH_ID = ipSalerId PRO.PRODUCT_ID = SUBSTITUTE('&1.&2.&3', STRING(Artst.Artnr,'999999'), STRING(Artst.Inhalt,'9999'), STRING(Artst.Jahr,'9999')) PRO.PRODUCER_PRODUCT_ID = ArtLief.S_Artnr PRO.EAN = cStrichcode PRO.PRODUCT_NAME_1 = TRIM(Artbez.Bez1 + ' ' + Artbez.Bez2) PRO.PRODUCT_NAME_2 = KGebinde.Bez PRO.MEASURE_UNIT_ID = KGebinde.Geb_Cd PRO.MEASURE_UNIT = KGebinde.KBez PRO.PRODUCER_ID = (IF AVAILABLE ArtLief THEN TRIM(STRING(ArtLief.Knr,'>>>>>9')) ELSE '') PRO.PRODUCER_NAME = (IF AVAILABLE Tabel THEN Tabel.Bez1 ELSE '') PRO.ACTIVITY = (IF Artst.Aktiv THEN 1 ELSE 0) PRO.MULTIPLIER = 1.0 PRO.MULTIPLIER_VOL = tArtbw.ProdVol . ASSIGN tArtbw.ProdVol = PRO.MULTIPLIER_VOL. iAnz = iAnz + 1. END. RETURN iANz. END FUNCTION. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-createSales) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION createSales Procedure FUNCTION createSales RETURNS LOGICAL ( /* parameter-definitions */ ) : /*------------------------------------------------------------------------------*/ /* Purpose: Super Override */ /* Parameters: */ /* Notes: */ /*------------------------------------------------------------------------------*/ DEFINE VARIABLE iAnz AS INTEGER NO-UNDO. DEFINE VARIABLE iPos AS INTEGER NO-UNDO. DEFINE VARIABLE rRecid AS RECID NO-UNDO. DEFINE VARIABLE rSal AS RECID NO-UNDO. CREATE SAL_HEADER. ASSIGN SAL_HEADER.FROM_DATE = SUBSTITUTE('&1-&2-&3', STRING(YEAR(ipabDatum),'9999'), STRING(MONTH(ipabDatum),'99'), STRING(DAY(ipabDatum),'99') ) SAL_HEADER.TO_DATE = SUBSTITUTE('&1-&2-&3', STRING(YEAR(TODAY),'9999') , STRING(MONTH(TODAY),'99') , STRING(DAY(TODAY),'99') ) SAL_HEADER.TYPE_DATE = 'ISSUE_DATE' . rRecid = RECID(SAL_HEADER). SAL_HEADER.SAL_HEADER_ID = rRecid. EMPTY TEMP-TABLE tControlList. FOR EACH tArtbw USE-INDEX tArtbw-k3 BREAK BY tArtbw.Knr BY tArtbw.Aufnr BY tArtbw.Artnr BY tArtbw.Inhalt BY tArtbw.Jahr. IF FIRST-OF (tArtbw.Knr) THEN DO: CREATE SAL. ASSIGN SAL.TYPE_ID = 'DEL' SAL.BRANCH_ID = ipSalerId SAL.DOC_ID = TRIM(STRING(tArtbw.Aufnr,'>999999')) SAL.ISSUE_DATE = SUBSTITUTE('&1-&2-&3', STRING(YEAR(tArtbw.Datum),'9999') , STRING(MONTH(tArtbw.Datum),'99') , STRING(DAY(tArtbw.Datum),'99') ) SAL.SALE_DATE = SUBSTITUTE('&1-&2-&3', STRING(YEAR(tArtbw.Fak_Dat),'9999'), STRING(MONTH(tArtbw.Fak_Dat),'99'), STRING(DAY(tArtbw.Fak_Dat),'99') ) SAL.CUSTOMER_ID = TRIM(STRING(tArtbw.Knr,'>>>>>9')) SAL.COR_DOC_ID = ? SAL.COR_DOC_DATE = ? SAL.TYPE_SALE_ID = 'ST' SAL.FIELD_1 = SUBSTITUTE('&1-&2-&3', STRING(YEAR(tArtbw.Datum),'9999') , STRING(MONTH(tArtbw.Datum),'99') , STRING(DAY(tArtbw.Datum),'99') ) SAL.FIELD_2 = TRIM(STRING(tArtbw.Faknr,'>999999')) SAL.SAL_HEADER_ID = rRecid. . iPos = 0. iAnz = iAnz + 1. rSal = RECID(SAL). SAL.SAL_ID = rSal. END. CREATE SAL_ITEM. iPos = iPos + 1. ASSIGN SAL_ITEM.SAL_ID = rSal SAL_ITEM.ITEM = iPos SAL_ITEM.PRODUCT_ID = SUBSTITUTE('&1.&2.&3', STRING(tArtbw.Artnr,'999999'), STRING(tArtbw.Inhalt,'9999'), STRING(tArtbw.Jahr,'9999')) SAL_ITEM.MEASURE_UNIT_ID = tArtbw.KGeb_Cd SAL_ITEM.PRODUCER_ID = tArtbw.LiefKnr SAL_ITEM.QUANTITY = tArtbw.Menge SAL_ITEM.QUANTITY_VOL = tArtbw.Liter /* SAL_ITEM.QUANTITY_WAS = 0.0*/ /* SAL_ITEM.QUANTITY_VOL_WAS = 0.0*/ SAL_ITEM.PURCHASE_ORDER = '' SAL_ITEM.FIELD_1 = '0' SAL_ITEM.FIELD_2 = '' SAL_ITEM.FIELD_3 = '' . IF tArtbw.Aktion_Text <> '' THEN SAL_ITEM.FIELD_1 = '1'. IF tArtbw.Preis = 0 THEN SAL_ITEM.FIELD_1 = '2'. FIND FIRST Artbez NO-LOCK WHERE Artbez.Firma = tArtbw.Firma AND Artbez.Artnr = tArtbw.Artnr AND Artbez.Inhalt = tArtbw.Inhalt AND Artbez.Jahr = tArtbw.Jahr NO-ERROR. CREATE tControlList. ASSIGN tControlList.BRANCH_ID = ipSalerId tControlList.CUSTOMER_ID = TRIM(STRING(tArtbw.Knr,'>>>>>9')) tControlList.PRODUCT_ID = SAL_ITEM.PRODUCT_ID tControlList.PRODUCT_NAME = (IF AVAILABLE Artbez THEN TRIM(Artbez.Bez1 + ' ' + Artbez.Bez2) ELSE '') tControlList.DOCUMENT_TYPE = 'INV' tControlList.DOCUMENT_NUMBER = TRIM(STRING(tArtbw.Aufnr,'>999999')) tControlList.DOCUMENT_ISSUE_DATE = SUBSTITUTE('&1-&2-&3', STRING(YEAR(tArtbw.Datum),'9999') , STRING(MONTH(tArtbw.Datum),'99') , STRING(DAY(tArtbw.Datum),'99') ) tControlList.QUANTITY_SOLD = tArtbw.Menge . END. RETURN TRUE. END FUNCTION. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-findArtbw) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION findArtbw Procedure FUNCTION findArtbw RETURNS DECIMAL ( /* parameter-definitions */ ) : /*------------------------------------------------------------------------------ Purpose: Notes: ------------------------------------------------------------------------------*/ DEFINE VARIABLE nMenge AS DECIMAL NO-UNDO. FOR EACH Artst NO-LOCK WHERE Artst.Firma = cFirma AND Artst.Herst = ipHerst AND Artst.Aktiv = TRUE, FIRST ArtLief NO-LOCK WHERE ArtLief.Firma = Artst.Firma AND ArtLief.Artnr = Artst.Artnr AND ArtLief.Inhalt = Artst.Inhalt AND ArtLief.Jahr = Artst.Jahr AND ArtLief.Knr = ipLiefnr AND ArtLief.Haupt = TRUE: FIND KGebinde NO-LOCK WHERE KGebinde.Firma = cFirma AND KGebinde.Geb_Cd = Artst.KGeb_Cd NO-ERROR. FOR EACH Artbw NO-LOCK WHERE Artbw.Firma = cFirma AND Artbw.Artnr = Artst.Artnr AND Artbw.Inhalt = Artst.Inhalt AND Artbw.Jahr = Artst.Jahr AND Artbw.Faknr > 0 AND Artbw.Tr_Art < 10 AND Artbw.Fak_Dat <> ? AND Artbw.Datum >= ipabDatum : FIND FIRST tArtbw USE-INDEX tArtbw-k3 WHERE tArtbw.Knr = Artbw.Knr AND tArtbw.Artnr = Artbw.Artnr AND tArtbw.Inhalt = Artbw.Inhalt AND tArtbw.Jahr = Artbw.Jahr NO-ERROR. IF NOT AVAILABLE tArtbw THEN DO: CREATE tArtbw. BUFFER-COPY Artbw TO tArtbw ASSIGN tArtbw.Herst = ipHerst tArtbw.LiefKnr = TRIM(STRING(ArtLief.Knr,'>>>>>9')) tArtbw.ProdVol = (IF KGebinde.Inhalt < 10 THEN 1.0 ELSE (KGebinde.Inhalt / 100) ) nMenge = nMenge + tArtbw.Liter. NEXT. END. ASSIGN tArtbw.Menge = tArtbw.Menge + Artbw.Menge tArtbw.GGeb_Me = tArtbw.GGeb_Me + Artbw.GGeb_Me tArtbw.VGeb_Me = tArtbw.VGeb_Me + Artbw.VGeb_Me tArtbw.KGeb_Me = tArtbw.KGeb_Me + Artbw.KGeb_Me tArtbw.Liter = tArtbw.Liter + Artbw.Liter tArtbw.Herst = ipHerst tArtbw.LiefKnr = TRIM(STRING(ArtLief.Knr,'>>>>>9')) tArtbw.ProdVol = (IF KGebinde.Inhalt < 10 THEN 1.0 ELSE (KGebinde.Inhalt / 100) ) . nMenge = nMenge + Artbw.Liter. END. END. RETURN nMenge. END FUNCTION. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF