/*------------------------------------------------------------------------ File : createAuftrag Purpose : Syntax : Description : Author(s) : walter.riechsteiner Created : Mon Feb 27 11:25:49 CET 2023 Notes : ----------------------------------------------------------------------*/ /* *************************** Definitions ************************** */ USING Progress.Json.ObjectModel.JsonObject FROM PROPATH. USING Progress.Json.ObjectModel.JsonArray FROM PROPATH. USING Progress.Json.ObjectModel.ObjectModelParser FROM PROPATH. DEFINE INPUT PARAMETER iplcJson AS CHARACTER NO-UNDO. DEFINE OUTPUT PARAMETER opcMessage AS CHARACTER NO-UNDO. DEFINE OUTPUT PARAMETER oplRetVal AS LOGICAL NO-UNDO. DEFINE VARIABLE cFileName AS CHARACTER NO-UNDO. DEFINE VARIABLE cField AS CHARACTER NO-UNDO. DEFINE VARIABLE cValue AS CHARACTER NO-UNDO. DEFINE VARIABLE cZeile AS CHARACTER NO-UNDO. DEFINE VARIABLE iStufe AS INTEGER NO-UNDO. DEFINE VARIABLE ii AS INTEGER NO-UNDO. DEFINE VARIABLE ix AS INTEGER NO-UNDO. DEFINE VARIABLE iPos AS INTEGER NO-UNDO. DEFINE VARIABLE cNames AS CHARACTER EXTENT 100. DEFINE VARIABLE cFullName AS CHARACTER NO-UNDO. DEFINE VARIABLE iZeile AS INTEGER NO-UNDO. DEFINE VARIABLE lArray AS LOGICAL NO-UNDO. DEFINE VARIABLE lArrayBeginn AS LOGICAL NO-UNDO. DEFINE VARIABLE iArrayStufe AS INTEGER NO-UNDO. DEFINE VARIABLE cString AS CHARACTER NO-UNDO. DEFINE VARIABLE lRetVal AS LOGICAL NO-UNDO. DEFINE VARIABLE iRetVal AS INTEGER NO-UNDO. DEFINE VARIABLE iKnr AS INTEGER NO-UNDO. DEFINE VARIABLE iAufnr AS INTEGER NO-UNDO. DEFINE VARIABLE nKredTot AS DECIMAL NO-UNDO. DEFINE VARIABLE iPreisArt AS INTEGER NO-UNDO. DEFINE VARIABLE nTotal AS DECIMAL DECIMALS 4 NO-UNDO EXTENT 15. DEFINE VARIABLE lLiterPreis AS LOGICAL NO-UNDO. DEFINE VARIABLE iInhalt AS INTEGER NO-UNDO. DEFINE BUFFER bFDebst FOR Debst. DEFINE BUFFER bLDebst FOR Debst. DEFINE BUFFER bAufko FOR Aufko. DEFINE TEMP-TABLE tParameter FIELD iStufe AS INTEGER FIELD cFileName AS CHARACTER FIELD cFieldName AS CHARACTER FIELD cValue AS CHARACTER . DEFINE BUFFER btParameter FOR tParameter. DEFINE TEMP-TABLE tAufko LIKE Aufko. DEFINE TEMP-TABLE tAufze LIKE Aufze. DEFINE VARIABLE htAufko AS HANDLE NO-UNDO. DEFINE VARIABLE htAufze AS HANDLE NO-UNDO. htAufko = TEMP-TABLE tAufko:DEFAULT-BUFFER-HANDLE. htAufze = TEMP-TABLE tAufze:DEFAULT-BUFFER-HANDLE. { propertiesYBM.i } { funktionen.i } /* ******************** Preprocessor Definitions ******************** */ /* ************************ Function Prototypes ********************** */ FUNCTION createAuftrag RETURNS LOGICAL ( ) FORWARD. FUNCTION createParameters RETURNS LOGICAL ( ) FORWARD. /* *************************** Main Block *************************** */ cString = iplcJson NO-ERROR. RUN writeLogfile.r ( ENTRY(1, THIS-PROCEDURE:NAME, '.'), cLogFileName, SUBSTITUTE('&1&2', CHR(10), cString) ). lRetVal = DYNAMIC-FUNCTION ('createParameters':U IN THIS-PROCEDURE) NO-ERROR. IF NOT lRetVal THEN DO: opcMessage = 'Auftrags-Parameter konnten nicht erstellt werden'. oplRetVal = FALSE. RETURN. END. lRetVal = DYNAMIC-FUNCTION ('createAuftrag':U) NO-ERROR. oplRetVal = lRetVal. RETURN. /* ************************ Function Implementations ***************** */ FUNCTION createAuftrag RETURNS LOGICAL ( ): /*------------------------------------------------------------------------------*/ /* Purpose: Super Override */ /* Parameters: */ /* Notes: */ /*------------------------------------------------------------------------------*/ DEFINE VARIABLE lok AS LOGICAL NO-UNDO. DEFINE VARIABLE lRetVal AS LOGICAL NO-UNDO INIT FALSE. DEFINE VARIABLE cIBest AS CHARACTER NO-UNDO. /* opcMessage = ''. */ oplRetVal = FALSE. cString = SUBSTITUTE('&1&4&2&4&3', cYBMBenutzer, cYBMPassword, cYBMFirma, CHR(01)). RUN ANMELDUNG ( cString ) NO-ERROR. lok = DYNAMIC-FUNCTION('getSuperAktiv':U) NO-ERROR. IF NOT lOK THEN DO: opcMessage = 'Request konnte sich nicht am System anmelden'. RETURN lRetVal. END. CREATEAUFTRAG: DO WHILE TRUE ON ERROR UNDO, LEAVE: FIND FIRST tParameter WHERE tParameter.cFileName = 'Auftrag' AND tParameter.cField = 'type' NO-ERROR. IF NOT AVAILABLE tParameter THEN DO: opcMessage = 'Request-Type "request-delivery" fehlt '. LEAVE CREATEAUFTRAG. END. tParameter.cValue = REPLACE(tParameter.cValue, '"', ''). IF tParameter.cValue <> 'request-delivery' THEN DO: opcMessage = 'Request-Type "request-delivery" fehlt '. LEAVE CREATEAUFTRAG. END. FIND FIRST tParameter WHERE tParameter.cFileName = 'Auftrag:data' AND tParameter.cField = 'id' NO-ERROR. IF AVAILABLE tParameter THEN DO: tParameter.cValue = REPLACE(tParameter.cValue, '"', ''). cIBest = 'YBM: ' + tParameter.cValue. FIND FIRST Aufko NO-LOCK WHERE Aufko.Firma = cYBMFirma AND Aufko.I_Best = cIBest NO-ERROR. IF AVAILABLE Aufko THEN DO: opcMessage = SUBSTITUTE('Auftrag mit der ID &1 gibt es schon':U, tParameter.cValue ). LEAVE CREATEAUFTRAG. END. END. ELSE DO: opcMessage = SUBSTITUTE('Auftrag:data Feld Id (AuftragsID) nicht gefunden'). LEAVE CREATEAUFTRAG. END. /* Besteller- / Lieferadresse */ FIND FIRST tParameter WHERE tParameter.cFileName = 'Auftrag:data:customer' AND tParameter.cField = 'id' NO-ERROR. IF NOT AVAILABLE tParameter THEN DO: opcMessage = 'Kundennummer fehlt '. LEAVE CREATEAUFTRAG. END. iKnr = INTEGER(REPLACE(tParameter.cValue, '"', '')) NO-ERROR. FIND FIRST bLDebst NO-LOCK WHERE bLDebst.Firma = cYBMFirma AND bLDebst.Knr = iKnr NO-ERROR. IF NOT AVAILABLE bLDebst THEN DO: opcMessage = SUBSTITUTE('Kundennummer &1 nicht gefunden', iKnr). LEAVE CREATEAUFTRAG. END. FIND FIRST tParameter WHERE tParameter.cFileName = 'Auftrag:data:request' AND tParameter.cField = 'customer_id' NO-ERROR. IF AVAILABLE tParameter THEN DO: tParameter.cValue = REPLACE(tParameter.cValue, '"', ''). FIND FIRST bFDebst NO-LOCK WHERE bFDebst.Firma = bLDebst.Firma AND bFDebst.Knr = INTEGER(tParameter.cValue) NO-ERROR. IF NOT AVAILABLE bFDebst THEN DO: opcMessage = SUBSTITUTE('Faktura-Kundennummer &1 nicht gefunden', tParameter.cValue). LEAVE CREATEAUFTRAG. END. END. ELSE DO: IF bLDebst.KnrFak > 0 THEN DO: FIND FIRST bFDebst NO-LOCK WHERE bFDebst.Firma = bLDebst.Firma AND bFDebst.Knr = bLDebst.KnrFak NO-ERROR. END. ELSE DO: FIND FIRST bFDebst NO-LOCK WHERE bFDebst.Firma = bLDebst.Firma AND bFDebst.Knr = bLDebst.Knr NO-ERROR. END. END. CREATE tAufko. ASSIGN tAufko.Firma = bLDebst.Firma tAufko.Aufnr = -1 tAufko.Knr = iKnr tAufko.Abhol = FALSE tAufko.Lager = 0 tAufko.Auf_Datum = TODAY tAufko.Fak_Knr = bFDebst.Knr . htAufko = TEMP-TABLE tAufko:DEFAULT-BUFFER-HANDLE. lok = DYNAMIC-FUNCTION('fillAufko':U, 0, INPUT-OUTPUT htAufko ) NO-ERROR. IF NOT lok THEN DO: opcMessage = 'Problem beim erstellen des Auftragskopfes'. LEAVE. END. FIND FIRST tAufko. tAufko.I_Best = cIBest. FIND FIRST tParameter WHERE tParameter.cFileName = 'Auftrag:data:request:scheduled' AND tParameter.cField = 'date' NO-ERROR. IF AVAILABLE tParameter THEN DO: tParameter.cValue = REPLACE(tParameter.cValue, '"', ''). tAufko.Lief_Datum = DATE(INTEGER(SUBSTRING(tParameter.cValue,06,02)), INTEGER(SUBSTRING(tParameter.cValue,09,02)), INTEGER(SUBSTRING(tParameter.cValue,01,04)) ) NO-ERROR. IF ERROR-STATUS:ERROR OR tAufko.Lief_Datum = ? THEN tAufko.Lief_Datum = TODAY. tAufko.Kond_Datum = TODAY. END. IF bFDebst.Kred_Lim > 0 THEN DO: nKredTot = bFDebst.Saldo. FOR EACH bAufko NO-LOCK WHERE bAufko.Firma = bFDebst.Firma AND bAufko.Fak_Knr = bFDebst.Knr: nKredTot = nKredTot + bAufko.Auf_Tot. END. IF nKredTot >= bFDebst.Kred_Lim THEN DO: opcMessage = SUBSTITUTE('Kreditlimite von &1 ist mit &2 überschritten', bFDebst.Kred_Lim, nKredTot). LEAVE CREATEAUFTRAG. END. END. FOR EACH tParameter WHERE tParameter.cFileName = 'Auftrag:data:request:user' BY tParameter.iStufe: tParameter.cValue = REPLACE (tParameter.cValue, '"', ''). tAufko.Auf_Text = tAufko.Auf_Text + (IF tAufko.Auf_Text = '' THEN '' ELSE CHR(10)) + tParameter.cValue. END. iAufnr = ?. tAufko.Aufnr = 0. RUN NUMMER_LOESEN ( 1, OUTPUT iAufnr ) NO-ERROR. IF iAufnr = ? OR iAufnr = 0 THEN DO: opcMessage = 'Es konnte keine Auftragsnummer gelöst werden'. LEAVE CREATEAUFTRAG. END. tAufko.Aufnr = iAufnr. REPEAT TRANSACTION ON ERROR UNDO, RETRY: CREATE bAufko. BUFFER-COPY tAufko TO bAufko. RELEASE bAufko. LEAVE. END. FIND bAufko NO-LOCK WHERE bAufko.Firma = bLDebst.Firma AND bAufko.Aufnr = iAufnr. lok = DYNAMIC-FUNCTION('createAufGebKo':U, iAufnr ) NO-ERROR. FOR EACH tParameter WHERE tParameter.cFileName = 'Auftrag:data:request:items' BY tParameter.iStufe: CASE tParameter.cFieldName: WHEN 'id' THEN DO: tParameter.cValue = REPLACE(tParameter.cValue, '"', ''). EMPTY TEMP-TABLE tAufze. CREATE tAufze. ASSIGN tAufze.Firma = bAufko.Firma tAufze.Aufnr = bAufko.Aufnr tAufze.Artnr = INTEGER(ENTRY(1, tParameter.cValue, '-')) tAufze.Inhalt = INTEGER(ENTRY(2, tParameter.cValue, '-')) tAufze.Jahr = INTEGER(ENTRY(3, tParameter.cValue, '-')) . iRetVal = DYNAMIC-FUNCTION ('fillAufze':U, INPUT-OUTPUT htAufze) NO-ERROR. IF iRetVal <> 0 THEN DO: FIND FIRST Femeld NO-LOCK WHERE Femeld.Fenr = iRetVal NO-ERROR. IF AVAILABLE Femeld THEN opcMessage = SUBSTITUTE('&1 (&2)', Femeld.Fetext, iRetVal). LEAVE CREATEAUFTRAG. END. FIND FIRST btParameter WHERE btParameter.iStufe > tParameter.iStufe AND btParameter.cFileName = 'Auftrag:data:request:items:vessel' AND btParameter.cFieldName = 'unit' NO-ERROR. lLiterPreis = FALSE. IF AVAILABLE btParameter THEN DO: btParameter.cValue = REPLACE(btParameter.cValue, '"', ''). IF btParameter.cValue = 'cl' THEN lLiterPreis = TRUE. FIND FIRST btParameter WHERE btParameter.iStufe > tParameter.iStufe AND btParameter.cFileName = 'Auftrag:data:request:items:vessel' AND btParameter.cFieldName = 'size' NO-ERROR. btParameter.cValue = REPLACE(btParameter.cValue, '"', ''). iInhalt = INTEGER(btParameter.cValue). END. END. WHEN 'vessel_count' THEN DO: tParameter.cValue = REPLACE(tParameter.cValue, '"', ''). FIND FIRST tAufze. ASSIGN tAufze.MBest = INTEGER(tParameter.cValue) tAufze.KGeb_Be = INTEGER(tParameter.cValue) tAufze.KGeb_Me = INTEGER(tParameter.cValue) tAufze.KGeb_Ru = 0 tAufze.VGeb_Ru = 0 tAufze.GGeb_Ru = 0 . FIND GGebinde NO-LOCK WHERE GGebinde.Firma = tAufze.Firma AND GGebinde.Geb_Cd = tAufze.GGeb_Cd NO-ERROR. FIND VGebinde NO-LOCK WHERE VGebinde.Firma = tAufze.Firma AND VGebinde.Geb_Cd = tAufze.VGeb_Cd NO-ERROR. FIND KGebinde NO-LOCK WHERE KGebinde.Firma = tAufze.Firma AND KGebinde.Geb_Cd = tAufze.KGeb_Cd NO-ERROR. IF AVAILABLE VGebinde AND VGebinde.Inhalt > 0 THEN DO: IF INDEX(VGebinde.Bez, 'Tank' ) > 0 OR INDEX(VGebinde.Bez, 'Box' ) > 0 OR INDEX(VGebinde.Bez, 'Bidon') > 0 THEN DO: IF lLiterPreis THEN DO: tAufze.VGeb_Be = tAufze.MBest * iInhalt / KGebinde.Inhalt / VGebinde.Inhalt. tAufze.MBest = tAufze.VGeb_Be * VGebinde.Inhalt. tAufze.KGeb_Be = tAufze.VGeb_Be * VGebinde.Inhalt. tAufze.KGeb_Me = tAufze.VGeb_Be * VGebinde.Inhalt. END. END. ELSE tAufze.VGeb_Be = (tAufze.KGeb_Be - (tAufze.KGeb_Be MOD VGebinde.Inhalt)) / VGebinde.Inhalt. END. IF AVAILABLE GGebinde AND GGebinde.Inhalt > 0 THEN DO: tAufze.GGeb_Be = (tAufze.VGeb_Be - (tAufze.VGeb_Be MOD GGebinde.Inhalt)) / GGebinde.Inhalt. END. ASSIGN tAufze.VGeb_Me = tAufze.VGeb_Be tAufze.GGeb_Me = tAufze.GGeb_Be tAufze.MBest = tAufze.KGeb_Me tAufze.MGeli = tAufze.KGeb_Me . iPreisArt = DYNAMIC-FUNCTION('getPreisAufze':U, INPUT-OUTPUT htAufze) NO-ERROR. tAufze.PreisArt = (IF iPreisArt < 0 THEN 0 ELSE iPreisArt). DYNAMIC-FUNCTION('calculateZeilenTotal':U, INPUT-OUTPUT htAufze ) NO-ERROR. DYNAMIC-FUNCTION('fillArtbwFromAufze':U , INPUT-OUTPUT htAufze ) NO-ERROR. REPEAT TRANSACTION ON ERROR UNDO, LEAVE: CREATE Aufze. BUFFER-COPY tAufze TO Aufze. RELEASE Aufze. LEAVE. END. END. OTHERWISE NEXT. END CASE. END. FIND FIRST tParameter WHERE tParameter.cFileName = 'Auftrag:data:request' AND tParameter.cField = 'message' NO-ERROR. IF AVAILABLE tParameter THEN DO: tParameter.cValue = REPLACE(tParameter.cValue, '"', ''). EMPTY TEMP-TABLE tAufze. CREATE tAufze. ASSIGN tAufze.Firma = bAufko.Firma tAufze.Aufnr = bAufko.Aufnr tAufze.Pos = 0 tAufze.Artnr = 0 tAufze.Inhalt = 0 tAufze.Jahr = 0 tAufze.Bez1 = tParameter.cValue . iRetVal = DYNAMIC-FUNCTION ('fillAufze':U, INPUT-OUTPUT htAufze) NO-ERROR. FIND FIRST tAufze. REPEAT TRANSACTION ON ERROR UNDO, LEAVE: CREATE Aufze. BUFFER-COPY tAufze TO Aufze. RELEASE Aufze. LEAVE. END. END. DYNAMIC-FUNCTION('calculateAuftragsTotal':U, bAufko.Firma, bAufko.Aufnr, OUTPUT nTotal ) NO-ERROR. opcMessage = STRING(iAufnr). lRetVal = TRUE. LEAVE. END. RETURN lRetVal. END FUNCTION. FUNCTION createParameters RETURNS LOGICAL ( ): /*------------------------------------------------------------------------------*/ /* Purpose: Super Override */ /* Parameters: */ /* Notes: */ /*------------------------------------------------------------------------------*/ ASSIGN iArrayStufe = 0 lArray = FALSE lArrayBeginn = FALSE. DO ii = 1 TO NUM-ENTRIES(cString, CHR(10)): cZeile = TRIM(ENTRY(ii, cString, CHR(10) )). IF cZeile = ']' OR cZeile = '],' THEN DO: lArray = FALSE. iArrayStufe = 0. IF iStufe > 0 THEN iStufe = iStufe - 1. IF iStufe > 1 THEN cFileName = cNames[iStufe]. NEXT. END. IF cZeile = CHR(125) OR cZeile = '},' THEN DO: IF lArray AND iStufe = iArrayStufe THEN NEXT. IF iStufe > 0 THEN iStufe = iStufe - 1. IF iStufe > 1 THEN cFileName = cNames[iStufe]. NEXT. END. iPos = INDEX(cZeile, ':'). IF iPos = 0 THEN NEXT. cValue = TRIM(SUBSTRING(cZeile, iPos + 1)). IF SUBSTRING(cValue, LENGTH(cValue),01) = ',' THEN cValue = SUBSTRING(cValue,01,LENGTH(cValue) - 1). cField = TRIM(REPLACE(ENTRY(1, cZeile, ':'), '"', '')). IF cValue = '[' THEN DO: lArray = TRUE. lArrayBeginn = TRUE. iStufe = iStufe + 1. iArrayStufe = iStufe. cFileName = cField. cNames[iStufe] = cFileName. NEXT. END. IF cValue = '' OR cValue = CHR(123) THEN DO: IF lArrayBeginn THEN DO: /* iTitel = iTitel + 1.*/ lArrayBeginn = FALSE. NEXT. END. iStufe = iStufe + 1. cFileName = cField. cNames[iStufe] = cFileName. NEXT. END. IF cFileName = '' THEN DO: iStufe = iStufe + 1. cFileName = 'Auftrag'. cNames[iStufe] = cFileName. /* iTitel = iTitel + 1.*/ END. lArrayBeginn = FALSE. cFullName = ''. DO ix = 1 TO iStufe: cFullName = cFullName + (IF cFullName = '' THEN '' ELSE ':') + cNames[ix]. END. iZeile = iZeile + 1. CREATE tParameter. ASSIGN tParameter.iStufe = iZeile tParameter.cFileName = cFullName tParameter.cFieldName = cField tParameter.cValue = cValue. END. opcMessage = ''. oplRetVal = TRUE. OUTPUT TO 'C:\LogFiles\YourBarMate\tParameter.csv' APPEND NO-MAP NO-CONVERT. PUT CONTROL 'Parameter ' STRING(TODAY,'99.99.9999') ' -> ' STRING(TIME,'HH:MM:SS') CHR(10). FOR EACH tParameter BY tParameter.iStufe BY tParameter.cFileName BY tParameter.cFieldName: EXPORT DELIMITER ';' tParameter. END. PUT CONTROL CHR(10) CHR(10). OUTPUT CLOSE. END FUNCTION.