GeMIS_WEB/GUI/f-aktionen-spez.w

&ANALYZE-SUSPEND _VERSION-NUMBER AB_v10r12 GUI ADM2
&ANALYZE-RESUME
&Scoped-define WINDOW-NAME CURRENT-WINDOW
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS fFrameWin 
/*------------------------------------------------------------------------

  File: 

  Description: from cntnrfrm.w - ADM2 SmartFrame Template

  Input Parameters:
      <none>

  Output Parameters:
      <none>

 
------------------------------------------------------------------------*/
/*          This .W file was created with the Progress AppBuilder.      */
/*----------------------------------------------------------------------*/

/* Create an unnamed pool to store all the widgets created 
     by this procedure. This is a good default which assures
     that this procedure's triggers and internal procedures 
     will execute in this procedure's storage, and that proper
     cleanup will occur on deletion of the procedure. */

CREATE WIDGET-POOL.

/* ***************************  Definitions  ************************** */

/* Parameters Definitions ---                                           */

/* Local Variable Definitions ---                                       */

DEF VAR Firma   AS CHAR                     NO-UNDO.
DEF VAR Aktion  AS CHAR                     NO-UNDO.
DEF VAR Bemerk  AS CHAR                     NO-UNDO.
DEF VAR AktGrp  AS INT                      NO-UNDO.
DEF VAR aAktion AS CHAR                     NO-UNDO.

DEF WORKFILE   WArtPreis    LIKE ArtPreis.
DEF TEMP-TABLE TGruppen     FIELD Grp   AS INT
                            FIELD Bez   AS CHAR.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK 

/* ********************  Preprocessor Definitions  ******************** */

&Scoped-define PROCEDURE-TYPE SmartFrame
&Scoped-define DB-AWARE no

&Scoped-define ADM-CONTAINER FRAME

&Scoped-define ADM-SUPPORTED-LINKS Data-Target,Data-Source,Page-Target,Update-Source,Update-Target

/* Name of designated FRAME-NAME and/or first browse and/or first query */
&Scoped-define FRAME-NAME fMain

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS F_AbDatum F_BisDatum CB_Art F_Betrag ~
Btn_Zuteilen S_Gruppen RECT-8 
&Scoped-Define DISPLAYED-OBJECTS F_AbDatum F_BisDatum CB_Art F_Betrag ~
S_Gruppen 

/* Custom List Definitions                                              */
/* List-1,List-2,List-3,List-4,List-5,List-6                            */
&Scoped-define List-5 vBrutto vNetto vMarge vDatum 
&Scoped-define List-6 F_AbDatum F_BisDatum F_Betrag 

/* _UIB-PREPROCESSOR-BLOCK-END */
&ANALYZE-RESUME



/* ***********************  Control Definitions  ********************** */


/* Definitions of the field level widgets                               */
DEFINE BUTTON Btn_Zuteilen 
     IMAGE-UP FILE "grafik/add.bmp":U
     LABEL "&Zuteilen" 
     SIZE 5.2 BY 1.24.

DEFINE VARIABLE CB_Art AS CHARACTER FORMAT "X(256)":U 
     LABEL "Abschlagsart" 
     VIEW-AS COMBO-BOX INNER-LINES 5
     LIST-ITEM-PAIRS "Betrag","0",
                     "Prozent","1"
     DROP-DOWN-LIST
     SIZE 16 BY 1
     BGCOLOR 15  NO-UNDO.

DEFINE VARIABLE F_AbDatum AS DATE FORMAT "99.99.9999":U 
     LABEL "Ab Datum" 
     VIEW-AS FILL-IN NATIVE 
     SIZE 16 BY 1
     BGCOLOR 15  NO-UNDO.

DEFINE VARIABLE F_Betrag AS DECIMAL FORMAT "zzz9.9999-":U INITIAL 0 
     LABEL "Abschlag" 
     VIEW-AS FILL-IN NATIVE 
     SIZE 16 BY 1
     BGCOLOR 15  NO-UNDO.

DEFINE VARIABLE F_BisDatum AS DATE FORMAT "99.99.9999":U 
     LABEL "Bis Datum" 
     VIEW-AS FILL-IN NATIVE 
     SIZE 16 BY 1
     BGCOLOR 15  NO-UNDO.

DEFINE VARIABLE vBrutto AS DECIMAL FORMAT "->>>>>>9.9999":U INITIAL 0 
     LABEL "Brutto" 
     VIEW-AS FILL-IN 
     SIZE 4 BY 1.

DEFINE VARIABLE vDatum AS DATE FORMAT "99.99.9999":U 
     LABEL "Ab Datum" 
     VIEW-AS FILL-IN 
     SIZE 4 BY 1.

DEFINE VARIABLE vMarge AS DECIMAL FORMAT "->>>>>>9.9999":U INITIAL 0 
     LABEL "Marge" 
     VIEW-AS FILL-IN 
     SIZE 4 BY 1.

DEFINE VARIABLE vNetto AS DECIMAL FORMAT "->>>>>>9.9999":U INITIAL 0 
     LABEL "Netto" 
     VIEW-AS FILL-IN 
     SIZE 4 BY 1.

DEFINE RECTANGLE RECT-8
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL   
     SIZE 65.2 BY 7.

DEFINE VARIABLE S_Gruppen AS CHARACTER 
     VIEW-AS SELECTION-LIST MULTIPLE SCROLLBAR-VERTICAL 
     SIZE 30 BY 6.29
     BGCOLOR 15  NO-UNDO.


/* ************************  Frame Definitions  *********************** */

DEFINE FRAME fMain
     F_AbDatum AT ROW 1.48 COL 46 COLON-ALIGNED
     F_BisDatum AT ROW 2.48 COL 46 COLON-ALIGNED
     CB_Art AT ROW 3.48 COL 46 COLON-ALIGNED
     F_Betrag AT ROW 4.48 COL 46 COLON-ALIGNED
     Btn_Zuteilen AT ROW 5.76 COL 58.2
     S_Gruppen AT ROW 1.48 COL 3 NO-LABEL
     vBrutto AT ROW 6.43 COL 48.2 COLON-ALIGNED NO-TAB-STOP 
     vNetto AT ROW 6.43 COL 48.2 COLON-ALIGNED NO-TAB-STOP 
     vMarge AT ROW 6.43 COL 48.2 COLON-ALIGNED NO-TAB-STOP 
     vDatum AT ROW 6.43 COL 48.2 COLON-ALIGNED NO-TAB-STOP 
     RECT-8 AT ROW 1.24 COL 2
    WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 1
         SIZE 67.6 BY 7.62.


/* *********************** Procedure Settings ************************ */

&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
   Type: SmartFrame
   Allow: Basic,Browse,DB-Fields,Query,Smart
   Container Links: Data-Target,Data-Source,Page-Target,Update-Source,Update-Target
   Other Settings: PERSISTENT-ONLY COMPILE
 */

/* This procedure should always be RUN PERSISTENT.  Report the error,  */
/* then cleanup and return.                                            */
IF NOT THIS-PROCEDURE:PERSISTENT THEN DO:
  MESSAGE "{&FILE-NAME} should only be RUN PERSISTENT.":U
          VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  RETURN.
END.

&ANALYZE-RESUME _END-PROCEDURE-SETTINGS

/* *************************  Create Window  ************************** */

&ANALYZE-SUSPEND _CREATE-WINDOW
/* DESIGN Window definition (used by the UIB) 
  CREATE WINDOW fFrameWin ASSIGN
         HEIGHT             = 7.62
         WIDTH              = 67.6.
/* END WINDOW DEFINITION */
                                                                        */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB fFrameWin 
/* ************************* Included-Libraries *********************** */

{src/adm2/containr.i}

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME




/* ***********  Runtime Attributes and AppBuilder Settings  *********** */

&ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
/* SETTINGS FOR WINDOW fFrameWin
  VISIBLE,,RUN-PERSISTENT                                               */
/* SETTINGS FOR FRAME fMain
   NOT-VISIBLE FRAME-NAME Custom                                        */
ASSIGN 
       FRAME fMain:HIDDEN           = TRUE.

/* SETTINGS FOR FILL-IN F_AbDatum IN FRAME fMain
   6                                                                    */
/* SETTINGS FOR FILL-IN F_Betrag IN FRAME fMain
   6                                                                    */
/* SETTINGS FOR FILL-IN F_BisDatum IN FRAME fMain
   6                                                                    */
/* SETTINGS FOR FILL-IN vBrutto IN FRAME fMain
   NO-DISPLAY NO-ENABLE 5                                               */
ASSIGN 
       vBrutto:HIDDEN IN FRAME fMain           = TRUE
       vBrutto:READ-ONLY IN FRAME fMain        = TRUE.

/* SETTINGS FOR FILL-IN vDatum IN FRAME fMain
   NO-DISPLAY NO-ENABLE 5                                               */
ASSIGN 
       vDatum:HIDDEN IN FRAME fMain           = TRUE
       vDatum:READ-ONLY IN FRAME fMain        = TRUE.

/* SETTINGS FOR FILL-IN vMarge IN FRAME fMain
   NO-DISPLAY NO-ENABLE 5                                               */
ASSIGN 
       vMarge:HIDDEN IN FRAME fMain           = TRUE
       vMarge:READ-ONLY IN FRAME fMain        = TRUE.

/* SETTINGS FOR FILL-IN vNetto IN FRAME fMain
   NO-DISPLAY NO-ENABLE 5                                               */
ASSIGN 
       vNetto:HIDDEN IN FRAME fMain           = TRUE
       vNetto:READ-ONLY IN FRAME fMain        = TRUE.

/* _RUN-TIME-ATTRIBUTES-END */
&ANALYZE-RESUME


/* Setting information for Queries and Browse Widgets fields            */

&ANALYZE-SUSPEND _QUERY-BLOCK FRAME fMain
/* Query rebuild information for FRAME fMain
     _Options          = ""
     _Query            is NOT OPENED
*/  /* FRAME fMain */
&ANALYZE-RESUME

 



/* ************************  Control Triggers  ************************ */

&Scoped-define SELF-NAME Btn_Zuteilen
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_Zuteilen fFrameWin
ON CHOOSE OF Btn_Zuteilen IN FRAME fMain /* Zuteilen */
DO:
    RUN ZUFUEGEN_AKTION.
    IF RETURN-VALUE = 'ERROR' THEN RETURN NO-APPLY.
    APPLY 'U1'.
    RETURN NO-APPLY.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME CB_Art
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL CB_Art fFrameWin
ON RETURN OF CB_Art IN FRAME fMain /* Abschlagsart */
DO:
    APPLY 'TAB' TO SELF.
    RETURN NO-APPLY.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME F_AbDatum
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL F_AbDatum fFrameWin
ON LEAVE OF F_AbDatum IN FRAME fMain /* Ab Datum */
DO:
    IF DATE(SELF:SCREEN-VALUE) = ? THEN DO:
        APPLY 'ENTRY' TO SELF.
        RETURN NO-APPLY.
    END.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME F_BisDatum
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL F_BisDatum fFrameWin
ON LEAVE OF F_BisDatum IN FRAME fMain /* Bis Datum */
DO:
    IF DATE(SELF:SCREEN-VALUE) = ? THEN DO:
        APPLY 'ENTRY' TO SELF.
        RETURN NO-APPLY.
    END.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&Scoped-define SELF-NAME S_Gruppen
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL S_Gruppen fFrameWin
ON RETURN OF S_Gruppen IN FRAME fMain
DO:
    APPLY 'ENTRY' TO F_AbDatum IN FRAME {&FRAME-NAME}.
    RETURN NO-APPLY.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL S_Gruppen fFrameWin
ON TAB OF S_Gruppen IN FRAME fMain
DO:
    APPLY 'ENTRY' TO F_AbDatum IN FRAME {&FRAME-NAME}.
    RETURN NO-APPLY.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&UNDEFINE SELF-NAME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK fFrameWin 


/* ***************************  Main Block  *************************** */

    Firma = DYNAMIC-FUNCTION('GETMANDANT':U) NO-ERROR.

    SUBSCRIBE TO 'AKTIONSANZEIGE' ANYWHERE.

&IF DEFINED(UIB_IS_RUNNING) <> 0 &THEN
   /* Now enable the interface  if in test mode - otherwise this happens when
      the object is explicitly initialized from its container. */
   RUN initializeObject.
&ENDIF

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


/* **********************  Internal Procedures  *********************** */

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE adm-create-objects fFrameWin  _ADM-CREATE-OBJECTS
PROCEDURE adm-create-objects :
/*------------------------------------------------------------------------------
  Purpose:     Create handles for all SmartObjects used in this procedure.
               After SmartObjects are initialized, then SmartLinks are added.
  Parameters:  <none>
------------------------------------------------------------------------------*/

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE AKTIONSANZEIGE fFrameWin 
PROCEDURE AKTIONSANZEIGE :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/

    DEF INPUT PARAMETER ipAktion    AS CHAR             NO-UNDO.

    DEF VAR ix      AS INT                      NO-UNDO.
    DEF VAR cString AS CHAR                     NO-UNDO.
    DEF VAR cGruppe AS CHAR                     NO-UNDO.

    aAktion = ipAktion.
    IF FRAME {&FRAME-NAME}:VISIBLE = FALSE THEN RETURN.

    FIND Aktionen USE-INDEX Aktionen-k1
                  WHERE Aktionen.Firma  = Firma
                  AND   Aktionen.Aktion = aAktion NO-LOCK NO-ERROR.
    IF NOT AVAILABLE Aktionen THEN RETURN.

    DO WITH FRAME {&FRAME-NAME}:
        cString = ''.
        cGruppe = ''.
        S_Gruppen:DELIMITER = CHR(01).
        IF Aktionen.Gruppen[01] <> 0    OR
           Aktionen.Gruppen[02] <> 0    THEN DO:
            DO ix = 1 TO 50:
                IF ix > 1 AND Aktionen.Gruppen[ix] = 0 THEN LEAVE.
                IF ix > 1 THEN cGruppe = cGruppe + CHR(01).
                cGruppe = cGruppe + STRING(Aktionen.Gruppen[ix],'999').
                FIND FIRST TGruppen WHERE TGruppen.Grp = Aktionen.Gruppen[ix]
                                          NO-LOCK NO-ERROR.
                IF NOT AVAILABLE TGruppen THEN NEXT.
                IF cString <> '' THEN cString = cString + CHR(01).
                cString = cString + TGruppen.Bez + CHR(01) + STRING(TGruppen.Grp,'999').
            END.
        END.
        IF cString = '' THEN cString = CHR(01).
        S_Gruppen:LIST-ITEM-PAIRS = cString.

        DO ix = 1 TO NUM-ENTRIES(cGruppe, CHR(01)):
            S_Gruppen:SCREEN-VALUE = ENTRY(ix, cGruppe, CHR(01)) NO-ERROR.
        END.
        Aktion     = Aktionen.Aktion.
        Bemerk     = Aktionen.Bemerkung.
        F_AbDatum  = Aktionen.Ab_Datum.
        F_BisDatum = Aktionen.Bis_Datum.
        F_Betrag   = Aktionen.Wert.
        CB_Art:SCREEN-VALUE = STRING(Aktionen.Art,'9').
        DISPLAY {&List-6}.
    END.

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI fFrameWin  _DEFAULT-DISABLE
PROCEDURE disable_UI :
/*------------------------------------------------------------------------------
  Purpose:     DISABLE the User Interface
  Parameters:  <none>
  Notes:       Here we clean-up the user-interface by deleting
               dynamic widgets we have created and/or hide 
               frames.  This procedure is usually called when
               we are ready to "clean-up" after running.
------------------------------------------------------------------------------*/
  /* Hide all frames. */
  HIDE FRAME fMain.
  IF THIS-PROCEDURE:PERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enable_UI fFrameWin  _DEFAULT-ENABLE
PROCEDURE enable_UI :
/*------------------------------------------------------------------------------
  Purpose:     ENABLE the User Interface
  Parameters:  <none>
  Notes:       Here we display/view/enable the widgets in the
               user-interface.  In addition, OPEN all queries
               associated with each FRAME and BROWSE.
               These statements here are based on the "Other 
               Settings" section of the widget Property Sheets.
------------------------------------------------------------------------------*/
  DISPLAY F_AbDatum F_BisDatum CB_Art F_Betrag S_Gruppen 
      WITH FRAME fMain.
  ENABLE F_AbDatum F_BisDatum CB_Art F_Betrag Btn_Zuteilen S_Gruppen RECT-8 
      WITH FRAME fMain.
  {&OPEN-BROWSERS-IN-QUERY-fMain}
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE initializeObject fFrameWin 
PROCEDURE initializeObject :
/*------------------------------------------------------------------------------
  Purpose:     Super Override
  Parameters:  
  Notes:       
------------------------------------------------------------------------------*/

    DEF VAR RecArt      AS CHAR                     NO-UNDO.
    DEF VAR cString     AS CHAR                     NO-UNDO.
    
    EMPTY TEMP-TABLE TGruppen.

    AktGrp = DYNAMIC-FUNCTION('GETFWAKTIONSPREISE':U) NO-ERROR.

    IF AktGrp = 0 THEN RecArt = 'PREGRP'.
    IF AktGrp = 1 THEN RecArt = 'KUNDGRP'.

    FOR EACH Tabel USE-INDEX Tabel-k1
                   WHERE Tabel.Firma  = Firma
                   AND   Tabel.RecArt = RecArt NO-LOCK:
        CREATE  TGruppen.
        ASSIGN  TGruppen.Grp = Tabel.CodeI
                TGruppen.Bez = Tabel.Bez1.
    END.

    RUN SUPER.

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE viewObject fFrameWin 
PROCEDURE viewObject :
/*------------------------------------------------------------------------------
  Purpose:     Super Override
  Parameters:  
  Notes:       
------------------------------------------------------------------------------*/

    RUN SUPER.

    RUN AKTIONSANZEIGE ( INPUT aAktion ).

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE ZUFUEGEN_AKTION fFrameWin 
PROCEDURE ZUFUEGEN_AKTION :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/

    DEF VAR cArtikel    AS CHAR                     NO-UNDO.
    DEF VAR Artnr       AS INT                      NO-UNDO.
    DEF VAR Inhalt      AS INT                      NO-UNDO.
    DEF VAR Jahr        AS INT                      NO-UNDO.
    DEF VAR ix          AS INT                      NO-UNDO.
    DEF VAR i1          AS INT                      NO-UNDO.
    DEF VAR cPreisGrp   AS CHAR                     NO-UNDO.
    DEF VAR cString     AS CHAR                     NO-UNDO.
    DEF VAR Bru_Netto   AS LOG                      NO-UNDO.
    DEF VAR Betrag      AS DEC DECIMALS 4           NO-UNDO.
    DEF VAR vArt        AS INT                      NO-UNDO.
    DEF VAR vBruNet     AS INT                      NO-UNDO.
    DEF VAR Grp         AS INT                      NO-UNDO.
    DEF VAR hDaten      AS HANDLE                   NO-UNDO.

    IF FRAME {&FRAME-NAME}:VISIBLE = FALSE THEN RETURN.

    hDaten = DYNAMIC-FUNCTION('getDataSource':U) NO-ERROR.

DO WITH FRAME {&FRAME-NAME}:
    IF DATE(F_AbDatum:SCREEN-VALUE) = ? THEN DO:
        APPLY 'ENTRY' TO F_AbDatum.
        RETURN 'ERROR'.
    END.
    IF DATE(F_BisDatum:SCREEN-VALUE) = ? THEN DO:
        APPLY 'ENTRY' TO F_BisDatum.
        RETURN 'ERROR'.
    END.
    ASSIGN  {&List-6}.
    vArt     = INTEGER(CB_Art:SCREEN-VALUE).
    cArtikel = DYNAMIC-FUNCTION('getArtikel':U) NO-ERROR.
    IF cArtikel = '' THEN RETURN NO-APPLY.
    IF cArtikel = ?  THEN RETURN NO-APPLY.
    Artnr    = INTEGER(ENTRY(2, cArtikel, CHR(01))).
    Inhalt   = INTEGER(ENTRY(3, cArtikel, CHR(01))).
    Jahr     = INTEGER(ENTRY(4, cArtikel, CHR(01))).

    FIND Artst WHERE RECID(Artst) = INTEGER(ENTRY(1, cArtikel, CHR(01)))
                     NO-LOCK NO-ERROR.
    IF NOT AVAILABLE Artst THEN RETURN NO-APPLY.
    IF NOT Artst.Aktiv     THEN RETURN NO-APPLY.

    i1 = S_Gruppen:NUM-ITEMS.
    cPreisGrp = ''.
    DO ix = 1 TO i1:
        IF S_Gruppen:IS-SELECTED(ix) = FALSE THEN NEXT.
        Grp = INTEGER(ENTRY((ix * 2), S_Gruppen:LIST-ITEM-PAIRS, CHR(01))).
        IF AktGrp = 0 THEN DO:
            FIND LAST ArtPreis USE-INDEX ArtPreis-k1
                               WHERE ArtPreis.Firma     = Firma
                               AND   ArtPreis.Artnr     = Artnr
                               AND   ArtPreis.Inhalt    = Inhalt
                               AND   ArtPreis.Jahr      = Jahr
                               AND   ArtPreis.Preis_Grp = Grp
                               AND   ArtPreis.Aktion    = FALSE
                               AND   ArtPreis.Aktiv     = TRUE NO-LOCK NO-ERROR.
            IF NOT AVAILABLE ArtPreis THEN NEXT.
        END.
        IF cPreisGrp <> '' THEN cPreisGrp = cPreisGrp + CHR(01).
        cPreisGrp = cPreisGrp + STRING(Grp,'999').
    END.

    DO i1 = 1 TO NUM-ENTRIES(cPreisGrp, CHR(01)):
        ix = INTEGER(ENTRY(i1, cPreisGrp, CHR(01))).
        FIND AktPreis USE-INDEX AktPreis-k1
                      WHERE AktPreis.Firma    = Firma
                      AND   AktPreis.Artnr    = Artnr
                      AND   AktPreis.Inhalt   = Inhalt
                      AND   AktPreis.Jahr     = Jahr
                      AND   AktPreis.Grp      = ix
                      AND   AktPreis.Ab_Datum = F_AbDatum NO-LOCK NO-ERROR.
        IF AVAILABLE AktPreis THEN NEXT.
        CREATE  AktPreis.
        ASSIGN  AktPreis.Firma     = Firma
                AktPreis.Artnr     = Artnr
                AktPreis.Inhalt    = Inhalt
                AktPreis.Jahr      = Jahr
                AktPreis.Grp       = ix
                AktPreis.Ab_Datum  = F_AbDatum
                AktPreis.Bis_Datum = F_BisDatum
                AktPreis.Art       = vArt
                AktPreis.Wert      = F_Betrag
                AktPreis.Bemerkung = Bemerk
                AktPreis.Aktion    = Aktion.
    END.

    IF AktGrp = 0 THEN DO:  /*  Aktionen auf Preisgruppen   */
        FOR EACH WArtPreis:
            DELETE  WArtPreis.
        END.
        CREATE  WArtPreis.

        DO i1 = 1 TO NUM-ENTRIES(cPreisGrp, CHR(01)):
            ix = INTEGER(ENTRY(i1, cPreisGrp, CHR(01))).
            FIND ArtPreis USE-INDEX ArtPreis-k1
                          WHERE ArtPreis.Firma     = Firma
                          AND   ArtPreis.Artnr     = Artnr
                          AND   ArtPreis.Inhalt    = Inhalt
                          AND   ArtPreis.Jahr      = Jahr
                          AND   ArtPreis.Preis_Grp = ix
                          AND   ArtPreis.Ab_Datum  = F_AbDatum NO-LOCK NO-ERROR.
            IF AVAILABLE ArtPreis THEN NEXT.
            FIND LAST ArtPreis USE-INDEX ArtPreis-k1
                               WHERE ArtPreis.Firma     = Firma
                               AND   ArtPreis.Artnr     = Artnr
                               AND   ArtPreis.Inhalt    = Inhalt
                               AND   ArtPreis.Jahr      = Jahr
                               AND   ArtPreis.Preis_Grp = ix
                               AND   ArtPreis.Ab_Datum  < F_AbDatum
                               AND   ArtPreis.Aktion    = FALSE
                               AND   ArtPreis.Aktiv     = TRUE
                                     NO-LOCK NO-ERROR.
            IF NOT AVAILABLE ArtPreis THEN NEXT.
    
            FIND FIRST WArtPreis.
            BUFFER-COPY ArtPreis TO WArtPreis.
    
            RUN FIND_PREISGRUPPE ( INPUT WArtPreis.Preis_Grp,
                                   OUTPUT cString ) NO-ERROR.
            IF cString = '' THEN NEXT.
            IF INTEGER(ENTRY(3, cString, CHR(01))) = 1 THEN Bru_Netto = TRUE.
            ELSE                                            Bru_Netto = FALSE.
    
            vNetto  = 0.
            vBrutto = 0.
            vMarge  = 0.
            vDatum  = F_AbDatum.
            IF Bru_Netto THEN DO:
                IF vArt = 0 THEN Betrag = ArtPreis.VK_Brutto
                                        - F_Betrag.
                IF vArt = 1 THEN Betrag = ArtPreis.VK_Brutto 
                                        * (100 - F_Betrag) / 100.
                RUN RUNDEN ( INPUT 1, INPUT-OUTPUT Betrag ).
                vBrutto = Betrag.
                vBruNet = 2.
            END.
            ELSE DO:
                IF vArt = 0 THEN Betrag = ArtPreis.VK_Netto
                                        - F_Betrag.
                IF vArt = 1 THEN Betrag = ArtPreis.VK_Netto 
                                        * (100 - F_Betrag) / 100.
                vNetto  = Betrag.
                vBruNet = 1.
            END.
            vNetto  :SCREEN-VALUE = STRING(vNetto ).
            vBrutto :SCREEN-VALUE = STRING(vBrutto).
            vMarge  :SCREEN-VALUE = STRING(vMarge ).
            vDatum  :SCREEN-VALUE = STRING(vDatum ).
            RUN ARTPREISRECHNEN ( INPUT vBruNet, INPUT vNetto :HANDLE,
                                                 INPUT vBrutto:HANDLE,
                                                 INPUT vMarge :HANDLE,
                                                 INPUT vDatum :HANDLE,
                                                 INPUT 'CHF'          ).
            ASSIGN  {&List-5}.
    
            ASSIGN  WArtPreis.Ab_Datum  = vDatum
                    WArtPreis.VK_Netto  = vNetto
                    WArtPreis.VK_Brutto = vBrutto
                    WArtPreis.Marge     = vMarge
                    WArtPreis.Aktion    = TRUE
                    WArtPreis.Aktiv     = TRUE
                    WArtPreis.AktName   = Aktion.
            CREATE  ArtPreis.
            BUFFER-COPY WArtPreis TO ArtPreis.
        END.
        IF VALID-HANDLE(hDaten) THEN RUN SET_OPENFLAG IN hDaten ( TRUE ).
    END.
END.

    RETURN ''.

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME