GeMIS_WEB/GUI/yourBarMate/createAuftrag.p

/*------------------------------------------------------------------------
    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.