GeMIS_WEB/GUI/DruckProgramme/wiederkehr/Ruecknahme.p

&ANALYZE-SUSPEND _VERSION-NUMBER AB_v10r12
&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 iphParam   AS HANDLE           NO-UNDO.
DEFINE OUTPUT PARAMETER opcResult  AS CHARACTER             NO-UNDO.

DEFINE VARIABLE iSeite         AS INTEGER   NO-UNDO.
DEFINE VARIABLE iAnzDok        AS INTEGER   NO-UNDO.
DEFINE VARIABLE iLauf          AS INTEGER   NO-UNDO.
DEFINE VARIABLE lFirst         AS LOG       INIT FALSE NO-UNDO.
DEFINE VARIABLE lLast          AS LOG       INIT FALSE NO-UNDO.
DEFINE VARIABLE lPreis         AS LOG       NO-UNDO.
DEFINE VARIABLE lEnde          AS LOGICAL   NO-UNDO.

DEFINE VARIABLE cFirma         AS CHARACTER NO-UNDO.
DEFINE VARIABLE AdFirma        AS CHARACTER NO-UNDO.
DEFINE VARIABLE nFakBetr       AS DECIMAL   NO-UNDO.
DEFINE VARIABLE dFakDatum      AS DATE      NO-UNDO.
DEFINE VARIABLE iFaknr         AS INTEGER   NO-UNDO.
DEFINE VARIABLE iSprcd         AS INTEGER   NO-UNDO.
DEFINE VARIABLE nTotale        AS DECIMAL   EXTENT 15 NO-UNDO.
DEFINE VARIABLE cFormtext      AS CHARACTER EXTENT 30 NO-UNDO.
DEFINE VARIABLE cRabText       AS CHARACTER NO-UNDO.
DEFINE VARIABLE cZusText       AS CHARACTER NO-UNDO.
DEFINE VARIABLE cEpzText       AS CHARACTER NO-UNDO.
DEFINE VARIABLE cBesrKopf      AS CHARACTER EXTENT 12 NO-UNDO.
DEFINE VARIABLE lDebIncl       AS LOG       NO-UNDO.
DEFINE VARIABLE Rundbetr       AS DECIMAL   DECIMALS 4 NO-UNDO.
DEFINE VARIABLE RundCode       AS INTEGER   INIT 1 NO-UNDO.
DEFINE VARIABLE htTabTexte     AS HANDLE    NO-UNDO.
DEFINE VARIABLE hAufko         AS HANDLE    NO-UNDO.
DEFINE VARIABLE cLieferscheine AS CHARACTER NO-UNDO.

DEFINE VARIABLE iMaxPos        AS INTEGER   INIT 2650 NO-UNDO.
DEFINE VARIABLE cvpr_Dokument  AS CHARACTER NO-UNDO.
DEFINE VARIABLE iArtZeile      AS INTEGER   NO-UNDO.
DEFINE VARIABLE iVPagePos      AS INTEGER   NO-UNDO.
DEFINE VARIABLE iVGroupPos     AS INTEGER   NO-UNDO.
DEFINE VARIABLE VWg_Grp        AS INTEGER   INIT 0 NO-UNDO.
DEFINE VARIABLE VProd_Grp      AS INTEGER   INIT 0 NO-UNDO.
DEFINE VARIABLE VArt_Grp       AS INTEGER   INIT 0 NO-UNDO.
DEFINE VARIABLE AArtnr         AS INTEGER   INIT 0 NO-UNDO.
DEFINE VARIABLE AInhalt        AS INTEGER   INIT 0 NO-UNDO.
DEFINE VARIABLE AJahr          AS INTEGER   INIT 0 NO-UNDO.

DEFINE BUFFER bAufko   FOR Aufko   .
DEFINE BUFFER bAufze   FOR Aufze   .
DEFINE BUFFER FDebst   FOR Debst   .       /*  Fakturaadresse  */
DEFINE BUFFER LDebst   FOR Debst   .       /*  Lieferadresse   */
DEFINE BUFFER LAdresse FOR Adresse .
DEFINE BUFFER bAdresse FOR Adresse .
DEFINE BUFFER bWust    FOR Wust    .
DEFINE BUFFER bSteuer  FOR Steuer  .

{ incl/ttdruckparam.i }
{ properties.i }

DEFINE TEMP-TABLE tDokument
    FIELD cGruppe AS CHARACTER
    FIELD iZeile  AS INTEGER
    FIELD cFeld   AS CHARACTER
    FIELD cInhalt AS CHARACTER
    
    INDEX tDokument-k1 IS PRIMARY
    cGruppe
    iZeile
    cFeld
    .
DEFINE TEMP-TABLE tTotale
    FIELD nMwstPfl AS DECIMAL EXTENT 12
    FIELD nMwstBet AS DECIMAL EXTENT 12
    FIELD nSammTot AS DECIMAL
    FIELD nSkBer   AS DECIMAL
    FIELD nWW      AS DECIMAL
    .
DEFINE TEMP-TABLE sAufko
    FIELD cFirma      AS CHARACTER
    FIELD iAufnr      AS INTEGER
    FIELD iFak_Knr    AS INTEGER
    FIELD iKnr        AS INTEGER
    FIELD iSamm_Nr    AS INTEGER
    FIELD iRecid      AS RECID
    FIELD iFaknr      AS INTEGER
    FIELD dLief_Datum AS DATE
    .
DEFINE TEMP-TABLE tAufko LIKE Aufko
    FIELD iRecid  AS RECID
    FIELD lBetrag AS LOGICAL
    .
DEFINE TEMP-TABLE tAufze
    FIELD Aufnr   AS INTEGER
    FIELD Sort1   AS CHARACTER
    FIELD Sort2   AS CHARACTER
    FIELD Sort3   AS CHARACTER
    FIELD Artnr   AS INTEGER
    FIELD Inhalt  AS INTEGER
    FIELD Jahr    AS INTEGER
    FIELD Pos     AS INTEGER
    FIELD Zeile   AS RECID
    FIELD Preis   AS DECIMAL   DECIMALS 4
    FIELD Aktion  AS LOG
    FIELD LagOrt  AS CHARACTER
    FIELD MGeli   AS DECIMAL
    FIELD MRuek   AS DECIMAL
    FIELD GGeb_Me AS DECIMAL 
    FIELD VGeb_Me AS DECIMAL 
    FIELD KGeb_Me AS DECIMAL 
    
    INDEX tAufze-k1 IS PRIMARY
    Aufnr
    Sort1
    Sort2
    Sort3
    .
DEFINE TEMP-TABLE tRueckst LIKE tAufze
    .

DEFINE TEMP-TABLE tSpeRab
    FIELD Rab_Grp  AS INTEGER
    FIELD Auf_Betr AS DECIMAL DECIMALS 4
    .
DEFINE TEMP-TABLE tGebKto
    FIELD Sort_Cd  AS CHARACTER
    FIELD Geb_Cd   AS CHARACTER
    FIELD Bez      AS CHARACTER
    FIELD Preis    AS DECIMAL
    FIELD A_Anz    AS DECIMAL
    FIELD A_Betrag AS DECIMAL
    FIELD E_Anz    AS DECIMAL
    FIELD E_Betrag AS DECIMAL
    FIELD MWST_Art AS INTEGER
    FIELD MWST_Cd  AS INTEGER
    .
DEFINE TEMP-TABLE tRabSumm
    FIELD Rab_Summ  AS INTEGER
    FIELD Bez       AS CHARACTER
    FIELD F_Rab_Art AS INTEGER
    FIELD F_Wert    AS DECIMAL   DECIMALS 4
    FIELD A_Rab_Art AS INTEGER
    FIELD A_Wert    AS DECIMAL   DECIMALS 4
    FIELD Auf_Rab   AS DECIMAL   DECIMALS 4
    FIELD Abh_Rab   AS DECIMAL   DECIMALS 4
    .
DEFINE TEMP-TABLE tUmsGrp
    FIELD Ums_Grp  AS INTEGER
    FIELD Mwst     AS INTEGER
    FIELD Ansatz   AS DECIMAL
    FIELD Bez      AS CHARACTER
    FIELD Ums_Betr AS DECIMAL   DECIMALS 4
    .
DEFINE TEMP-TABLE tTabTexte
    FIELD cRecArt AS CHARACTER
    FIELD iZeile  AS INTEGER
    FIELD cFeld1  AS CHARACTER
    FIELD cFeld2  AS CHARACTER
    FIELD cFeld3  AS CHARACTER
    FIELD iFeld1  AS INTEGER
    FIELD iFeld2  AS INTEGER
    FIELD iFeld3  AS INTEGER
    
    INDEX tTabTexte-k1 IS PRIMARY
    cRecArt
    iZeile.

/* _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-calculateBlock) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD calculateBlock Procedure
FUNCTION calculateBlock RETURNS INTEGER 
    (ipGruppe AS CHARACTER) 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  *************************** */

opcResult = ''.

CREATE tParam.
htParam:BUFFER-COPY(iphParam).
    
ASSIGN  
    cFirma  = tParam.cFirma
    iAnzDok = tParam.Anzahl
    lPreis  = tParam.lPreis.
            
FIND bSteuer NO-LOCK WHERE bSteuer.Firma = cFirma.
AdFirma = bSteuer.AdFirma.

RUN AUFTRAG_ERMITTELN.
IF opcResult <> '' THEN RETURN.
    
FOR FIRST sAufko:

    FIND bAdresse NO-LOCK
        WHERE bAdresse.Firma = AdFirma
        AND   bAdresse.Knr   = sAufko.iKnr.
    iSprcd = bAdresse.Sprcd.
    RUN GET_FORMTEXT ( tParam.cInstall, tParam.cDokument, iSprcd,
        OUTPUT cFormText ) NO-ERROR.
    cRabText =   TRIM(SUBSTRING(cFormText[21],01,20)).
    cZusText =   TRIM(SUBSTRING(cFormText[21],21,20)).
    cEpzText =   TRIM(SUBSTRING(cFormText[21],41,20)).
    RELEASE bAdresse.
        
    { vpr.i INIT  }
{ vpr.i START }
                
    DO iLauf = 1 TO iAnzDok:

        dFakDatum = TODAY.
        iSeite    = 0.
        iFaknr    = sAufko.iSamm_Nr.
        lFirst    = TRUE.
        lLast     = FALSE.
                    
        EMPTY TEMP-TABLE tUmsGrp    .
        EMPTY TEMP-TABLE tTotale    .
            
        CREATE  tTotale.
            
        FOR EACH bAufko NO-LOCK
            WHERE bAufko.Firma      = sAufko.cFirma
            AND   bAufko.Aufnr      = sAufko.iAufnr
                    
            BREAK BY bAufko.Firma
            BY bAufko.Aufnr :

            EMPTY TEMP-TABLE tAufze     .
            EMPTY TEMP-TABLE tGebKto    .
            EMPTY TEMP-TABLE tRabSumm   .
            EMPTY TEMP-TABLE tSpeRab    .
            EMPTY TEMP-TABLE tTabTexte  .
            EMPTY TEMP-TABLE tRueckst   .
                
            FIND bAdresse NO-LOCK USE-INDEX Adresse-k1
                WHERE bAdresse.Firma = AdFirma
                AND   bAdresse.Knr   = bAufko.Knr NO-ERROR.
            FIND LDebst NO-LOCK USE-INDEX Debst-k1
                WHERE LDebst.Firma  = cFirma
                AND   LDebst.Knr    = bAufko.Knr NO-ERROR.
            FIND FDebst NO-LOCK USE-INDEX Debst-k1
                WHERE FDebst.Firma  = cFirma
                AND   FDebst.Knr    = bAufko.Fak_Knr NO-ERROR.
            FIND bWust NO-LOCK USE-INDEX Wust-k1
                WHERE bWust.CodeK    = LDebst.MWST
                AND   bWust.CodeA    = 99 NO-ERROR.
            lDebIncl  = FALSE.
            IF AVAILABLE bWust THEN lDebIncl = bWust.Incl.
            dFakDatum  = (IF bAufko.Lief_Datum < TODAY THEN TODAY ELSE bAufko.Lief_Datum).
            hAufko     = BUFFER bAufko:HANDLE.
            htTabTexte = TEMP-TABLE tTabTexte:DEFAULT-BUFFER-HANDLE.
                
            /*  Texte und Werte aus Tabelle 'Tabel' laden für RecArt */
            /*  FAKART, AUFSTATUS, LIEFART, FAHRER, WISO, ABLAD      */
                
            RUN CREATE_TABTEXTE ( hAufko, INPUT-OUTPUT htTabTexte ) NO-ERROR.
                
            RUN FUELLEN_tAufze ( bAufko.Aufnr ) NO-ERROR.
                
            FOR EACH tAufze
                WHERE tAufze.Artnr > 0:
                
                FIND bAufze NO-LOCK WHERE RECID(bAufze) = tAufze.Zeile.
                    
                /*  Spezial-Auftragsrabatt pro Lieferschein bilden  */
                
                IF bAufze.Auf_Sp_Grp > 0 THEN 
                DO:
                    FIND FIRST tSpeRab
                        WHERE tSpeRab.Rab_Grp = bAufze.Auf_Sp_Grp NO-ERROR.
                    IF NOT AVAILABLE tSpeRab THEN 
                    DO:
                        CREATE  tSpeRab.
                        ASSIGN  
                            tSpeRab.Rab_Grp = bAufze.Auf_Sp_Grp.
                    END.
                    tSpeRab.Auf_Betr = tSpeRab.Auf_Betr + bAufze.Auf_Sp_Rab.
                END.
                    
                /*  Summengruppen-Totale pro Lieferschein bilden  */
                    
                DO WHILE bAufze.Rab_Su_Grp > 0:
                    FIND FIRST tRabSumm
                        WHERE tRabSumm.Rab_Summ = bAufze.Rab_Su_Grp NO-ERROR.
                    IF NOT AVAILABLE tRabSumm THEN 
                    DO:
                        FIND FIRST RabSumm NO-LOCK
                            WHERE RabSumm.Firma    = bAufze.Firma
                            AND   RabSumm.Rab_Summ = bAufze.Rab_Su_Grp NO-ERROR.
                        IF NOT AVAILABLE RabSumm THEN LEAVE.
                        CREATE  tRabSumm.
                        ASSIGN  
                            tRabSumm.Rab_Summ = bAufze.Rab_Su_Grp
                            tRabSumm.Bez      = RabSumm.Bez
                            tRabSumm.Auf_Rab  = 0
                            tRabSumm.Abh_Rab  = 0.
                    END.
                    LEAVE.
                END.
            END.
                
            IF LAST-OF ( bAufko.Aufnr ) THEN lLast = TRUE.

            RUN DRUCKEN.
            
            /*  Auftragskopf mutieren       */
                
            REPEAT TRANSACTION:
                IF iLauf < iAnzDok THEN LEAVE.
                RUN AUFTRAG_GEDRUCKT ( bAufko.Aufnr ).
                LEAVE.
            END.
        END.
    END.
    { vpr.i STOP }
END.

PROCEDURE ShellExecuteA EXTERNAL "shell32.dll" :
    DEFINE INPUT PARAMETER lphwnd       AS LONG.
    DEFINE INPUT PARAMETER lpOperation  AS CHARACTER.
    DEFINE INPUT PARAMETER lpFile       AS CHARACTER.
    DEFINE INPUT PARAMETER lpParameters AS CHARACTER.
    DEFINE INPUT PARAMETER lpDirectory  AS CHARACTER.
    DEFINE INPUT PARAMETER nShowCmd     AS LONG.
    DEFINE RETURN PARAMETER hInstance   AS LONG.
END PROCEDURE.

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

&IF DEFINED(EXCLUDE-GEBINDE_SALDO) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE GEBINDE_SALDO Procedure
PROCEDURE GEBINDE_SALDO:
    /*------------------------------------------------------------------------------
     Purpose:
     Notes:
    ------------------------------------------------------------------------------*/

    EMPTY TEMP-TABLE tGebKto.

    FOR EACH sAufko:
        FOR EACH AufGKon USE-INDEX AufGKon-k1
            WHERE AufGKon.Firma    = sAufko.cFirma
            AND   AufGKon.Aufnr    = sAufko.iAufnr
            AND   AufGKon.Depot   <> 0
            AND  (AufGKon.Eingang <> 0 OR
            AufGKon.Ausgang <> 0) NO-LOCK:
            FIND FIRST tGebKto WHERE tGebKto.Geb_Cd = AufGKon.Geb_Cd NO-ERROR.
            IF NOT AVAILABLE tGebKto THEN 
            DO:
                FIND GebKonto USE-INDEX GebKonto-k1
                    WHERE GebKonto.Firma  = AufGKon.Firma
                    AND   GebKonto.Geb_Cd = AufGKon.Geb_Cd NO-LOCK.
                CREATE  tGebKto.
                ASSIGN  
                    tGebKto.Sort_Cd = GebKonto.Sort_Cd
                    tGebKto.Geb_Cd  = GebKonto.Geb_Cd
                    tGebKto.Bez     = GebKonto.Bez
                    tGebKto.Preis   = AufGKon.Depot
                    tGebKto.MWST_Cd = AufGKon.MWSt_Cd.
            END.
            tGebKto.A_Anz    = tGebKto.A_Anz + AufGKon.Ausgang.
            tGebKto.A_Betrag = tGebKto.A_Anz * tGebKto.Preis.
            tGebKto.E_Anz    = tGebKto.E_Anz + AufGKon.Eingang.
            tGebKto.E_Betrag = tGebKto.E_Anz * tGebKto.Preis.
        END.
    END.
    
END PROCEDURE.
    
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ENDIF
&IF DEFINED(EXCLUDE-FUELLEN_UEBERSCHRIFT) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE FUELLEN_UEBERSCHRIFT Procedure
PROCEDURE FUELLEN_UEBERSCHRIFT:
    /*------------------------------------------------------------------------------
     Purpose:
     Notes:
    ------------------------------------------------------------------------------*/
    
    DEFINE VARIABLE cZellen AS CHARACTER NO-UNDO.
    DEFINE VARIABLE cWerte  AS CHARACTER NO-UNDO.

    CREATE  tDokument.
    ASSIGN  
        tDokument.cGruppe = 'UEBERSCHRIFT'
        tDokument.iZeile  = 1
        tDokument.cFeld   = 'Artnr_T'
        tDokument.cInhalt = ENTRY(1, cFormText[23], ';').

    CREATE  tDokument.
    ASSIGN  
        tDokument.cGruppe = 'UEBERSCHRIFT'
        tDokument.iZeile  = 1
        tDokument.cFeld   = 'VGeb_Menge_T'
        tDokument.cInhalt = ENTRY(2, cFormText[23], ';').

    CREATE  tDokument.
    ASSIGN  
        tDokument.cGruppe = 'UEBERSCHRIFT'
        tDokument.iZeile  = 1
        tDokument.cFeld   = 'VGeb_T'
        tDokument.cInhalt = ENTRY(3, cFormText[23], ';').

    CREATE  tDokument.
    ASSIGN  
        tDokument.cGruppe = 'UEBERSCHRIFT'
        tDokument.iZeile  = 1
        tDokument.cFeld   = 'KGeb_Menge_T'
        tDokument.cInhalt = ENTRY(4, cFormText[23], ';').

    CREATE  tDokument.
    ASSIGN  
        tDokument.cGruppe = 'UEBERSCHRIFT'
        tDokument.iZeile  = 1
        tDokument.cFeld   = 'KGeb_T'
        tDokument.cInhalt = ENTRY(5, cFormText[23], ';').

    CREATE  tDokument.
    ASSIGN  
        tDokument.cGruppe = 'UEBERSCHRIFT'
        tDokument.iZeile  = 1
        tDokument.cFeld   = 'Bez_T'
        tDokument.cInhalt = ENTRY(6, cFormText[23], ';').

    CREATE  tDokument.
    ASSIGN  
        tDokument.cGruppe = 'UEBERSCHRIFT'
        tDokument.iZeile  = 1
        tDokument.cFeld   = 'Alk%_T'
        tDokument.cInhalt = ENTRY(7, cFormText[23], ';').

    CREATE  tDokument.
    ASSIGN  
        tDokument.cGruppe = 'UEBERSCHRIFT'
        tDokument.iZeile  = 1
        tDokument.cFeld   = 'JG_T'
        tDokument.cInhalt = ENTRY(8, cFormText[23], ';').

    CREATE  tDokument.
    ASSIGN  
        tDokument.cGruppe = 'UEBERSCHRIFT'
        tDokument.iZeile  = 1
        tDokument.cFeld   = 'VGebinde'
        tDokument.cInhalt = ENTRY(9, cFormText[23], ';').

    CREATE  tDokument.
    ASSIGN  
        tDokument.cGruppe = 'UEBERSCHRIFT'
        tDokument.iZeile  = 1
        tDokument.cFeld   = 'KGebinde'
        tDokument.cInhalt = ENTRY(10, cFormText[23], ';').

    cZellen = ''.
    cWerte  = ''.
    FOR EACH tDokument
        WHERE tDokument.cGruppe = 'Ueberschrift'
        BREAK BY tDokument.cGruppe
        BY tDokument.cFeld:
        cWerte  = cWerte 
            + tDokument.cInhalt.
        cZellen = cZellen
            + tDokument.cFeld.
        IF NOT LAST-OF ( tDokument.cGruppe ) THEN ASSIGN cWerte  = cWerte  + CHR(01)
                cZellen = cZellen + ','.
    END.
    RUN vpr_SetDelimiter (CHR(01)).
    RUN vpr_setGroupText ('Ueberschrift', cZellen, cWerte).

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


&ENDIF


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

&IF DEFINED(EXCLUDE-ARTIKELZEILE) = 0 &THEN

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

    DEFINE INPUT PARAMETER ipRecid AS RECID            NO-UNDO.
    
    DEFINE VARIABLE cString  AS CHARACTER NO-UNDO.
    DEFINE VARIABLE nRabWert AS DECIMAL   NO-UNDO.
    DEFINE VARIABLE xRabText AS CHARACTER NO-UNDO.
    
    FIND tAufze WHERE RECID(tAufze) = ipRecid      NO-LOCK.
    FIND Aufze  WHERE RECID(Aufze)  = tAufze.Zeile NO-LOCK.

    iArtZeile = iArtZeile + 1.    
    DO WHILE Aufze.Artnr = 0:
        cString = Aufze.Bez1.
        IF Aufze.Bez2 <> '' THEN 
        DO:
            cString = cString
                + (IF cString = '' THEN '' ELSE CHR(10))
                + Aufze.Bez2.
        END.
        CREATE  tDokument.
        ASSIGN  
            tDokument.cGruppe = 'ArtikelZeile1'
            tDokument.iZeile  = iArtZeile
            tDokument.cFeld   = 'Bez1'
            tDokument.cInhalt = cString.
        RETURN.
    END.

    FIND Artst OF Aufze NO-LOCK.
            
    FIND GGebinde NO-LOCK
        WHERE GGebinde.Firma  = cFirma
        AND   GGebinde.Geb_Cd = Aufze.GGeb_Cd NO-ERROR.
    FIND VGebinde NO-LOCK
        WHERE VGebinde.Firma  = cFirma
        AND   VGebinde.Geb_Cd = Aufze.VGeb_Cd NO-ERROR.
    FIND KGebinde NO-LOCK
        WHERE KGebinde.Firma  = cFirma
        AND   KGebinde.Geb_Cd = Aufze.KGeb_Cd NO-ERROR.

    RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Artnr'   , STRING(Aufze.Artnr   ,"999999") ).
    
    IF Aufze.VGeb_Me <> 0 THEN 
    DO:
        RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Menge_VGeb', STRING(Aufze.VGeb_Me,'->>,>>9') ).
        RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'VGebinde'  , VGebinde.KBez ).
    END.
    
    RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Menge'   , STRING(Aufze.MGeli,'->>,>>9') ).
    RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'KGebinde', KGebinde.KBez ).
    
    cString = Aufze.Bez1.
    IF Aufze.Bez2 <> '' THEN 
    DO:
        cString = cString
            + (IF cString = '' THEN '' ELSE CHR(10))
            + Aufze.Bez2.
    END.
    IF Aufze.Aktion THEN 
    DO:
        cString = cString
            + (IF cString = '' THEN '' ELSE CHR(10))
            + Aufze.Aktion_Text.
    END.
    RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1', cString ).
    
    IF Aufze.Jahr > 9 THEN 
    DO:
        cString = STRING(Aufze.Jahr,"9999").
        RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'JG', cString ).
    END.
    
    IF Aufze.Alk_Gehalt <> 0 THEN 
    DO:
        cString = STRING(Aufze.Alk_Gehalt,"zz9.9%").
        RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Alk%', cString ).
    END.
    
END PROCEDURE.

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

&ENDIF

&IF DEFINED(EXCLUDE-AUFTRAG_ERMITTELN) = 0 &THEN

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

    DEFINE VARIABLE iAufnr  AS INTEGER NO-UNDO.
    DEFINE VARIABLE iSammNr AS INTEGER NO-UNDO.

    FIND FIRST tParam.
    
    EMPTY TEMP-TABLE sAufko.
    
    FIND FIRST Aufko NO-LOCK
        WHERE Aufko.Firma   = tParam.cFirma
        AND   Aufko.Fak_Art = tParam.iFakArt
        AND   Aufko.Fak_Knr = tParam.iFak_Knr
        AND   Aufko.Aufnr   = tParam.iAufnr NO-ERROR.
    IF NOT AVAILABLE Aufko THEN RETURN.
    iSammNr = Aufko.Samm_Nr. 
    
    /*  Sammeln aller Aufträge pro Sammelnummer  */
    
    FOR EACH Aufko NO-LOCK USE-INDEX Aufko-k5
        WHERE Aufko.Firma       = tParam.cFirma
        AND   Aufko.Fak_Art     = tParam.iFakArt
        AND   Aufko.Auf_Sta     = tParam.iAufSta
        AND   Aufko.Samm_Nr     = iSammNr:

        CREATE  sAufko.
        ASSIGN  
            sAufko.cFirma    = Aufko.Firma
            sAufko.iAufnr    = Aufko.Aufnr
            sAufko.iFak_Knr  = Aufko.Fak_Knr
            sAufko.iKnr      = Aufko.Knr
            sAufko.iSamm_Nr  = Aufko.Samm_Nr
            sAufko.iRecid    = RECID(Aufko)
            sAufko.iFaknr    = Aufko.Faknr
            sAufko.dLief_Dat = Aufko.Lief_Dat.
    END.
    
END PROCEDURE.

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

&ENDIF

&IF DEFINED(EXCLUDE-AUSGABE_ARTIKELZEILE) = 0 &THEN

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

    DEFINE VARIABLE cZellen AS CHARACTER NO-UNDO.
    DEFINE VARIABLE cWerte  AS CHARACTER NO-UNDO.
    DEFINE VARIABLE iPos    AS INTEGER   NO-UNDO.
    
    FOR EACH tDokument
        WHERE tDokument.cGruppe = 'ArtikelZeile1'
        BREAK BY tDokument.cGruppe
        BY tDokument.iZeile:
            
        IF FIRST-OF ( tDokument.cGruppe ) THEN 
        DO:
            iVPagePos = vpr_getPageVPos() + 20.
            RUN vpr_setPageVPos  ( iVPagePos ).
            RUN vpr_setGroupVPos ( 'ArtikelZeile1', iVPagePos ).
        END.
        IF FIRST-OF ( tDokument.iZeile ) THEN 
        DO:
            cZellen = ''.
            cWerte  = ''.
        END.
/*        IF tDokument.cFeld = 'Bez1' THEN RUN vpr_Asc2RTF ( tDokument.cInhalt, '', OUTPUT tDokument.cInhalt).*/
        IF tDokument.cFeld = 'Bez1' THEN tDokument.cInhalt = REPLACE(tDokument.cInhalt, CHR(10), '\par ').
        cWerte  = cWerte 
            + tDokument.cInhalt.
        cZellen = cZellen
            + tDokument.cFeld.
        IF NOT LAST-OF ( tDokument.iZeile ) THEN 
        DO:
            ASSIGN 
                cWerte  = cWerte  + CHR(01)
                cZellen = cZellen + ','.
            NEXT.
        END.
        
        RUN vpr_SetDelimiter (CHR(01)).
        RUN vpr_setGroupText ('ArtikelZeile1', cZellen, cWerte).
        iVPagePos = vpr_getPageVPos().
        iPos      = iVPagePos + vpr_getGroupHeight('ArtikelZeile1').
        IF iPos > iMaxPos THEN 
        DO:
            RUN VIPER_NEUE_SEITE.
            iVPagePos = vpr_getPageVPos() + 20.
            RUN vpr_setPageVPos ( iVPagePos ).
            RUN vpr_setGroupText ('ArtikelZeile1', cZellen, cWerte).
        END.
        RUN vpr_FlushGroup   ('ArtikelZeile1').
        iVPagePos = vpr_getPageVPos().

        IF LAST-OF ( tDokument.cGruppe ) THEN LEAVE.
            
        iVPagePos = vpr_getPageVPos().
        RUN vpr_setGroupVPos ( 'ArtikelZeile1', iVPagePos ).
    END.
    FOR EACH tDokument
        WHERE tDokument.cGruppe = 'ArtikelZeile1':
        DELETE  tDokument.
    END.

END PROCEDURE.

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

&ENDIF

&IF DEFINED(EXCLUDE-AUSGABE_GRUPPE) = 0 &THEN

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

    DEFINE INPUT PARAMETER ipGruppe    AS CHARACTER     NO-UNDO.

    DEFINE VARIABLE cZellen AS CHARACTER NO-UNDO.
    DEFINE VARIABLE cWerte  AS CHARACTER NO-UNDO.
    DEFINE VARIABLE iSpace  AS INTEGER   NO-UNDO.
    
    FIND FIRST tParam.
    
    iSpace = vpr_getPageVPos().
    FOR EACH tDokument NO-LOCK
        WHERE tDokument.cGruppe = ipGruppe
        BREAK BY tDokument.cGruppe
        BY tDokument.iZeile:
        IF FIRST-OF ( tDokument.iZeile ) THEN iSpace = iSpace + 40.
    END.
    IF iSpace > iMaxPos THEN 
    DO:
        RUN VIPER_NEUE_SEITE.
        iVPagePos = vpr_getPageVPos() + 20.
        RUN vpr_setPageVPos ( iVPagePos ).
    END.
    
    FOR EACH tDokument
        WHERE tDokument.cGruppe = ipGruppe
        BREAK BY tDokument.cGruppe
        BY tDokument.iZeile:
        IF FIRST-OF ( tDokument.cGruppe ) THEN 
        DO:
            IF  ipGruppe <> 'Kondition' AND
                ipGruppe <> 'BESR'      AND
                ipGruppe <> 'ADRESSE'   THEN 
            DO:
                iVPagePos = vpr_getPageVPos().
                RUN vpr_setGroupVPos ( ipGruppe, iVPagePos ).
            END.
        END.
        IF FIRST-OF ( tDokument.iZeile ) THEN 
        DO:
            cZellen = ''.
            cWerte  = ''.
        END.
        cWerte  = cWerte 
            + tDokument.cInhalt.
        cZellen = cZellen
            + tDokument.cFeld.
        IF NOT LAST-OF ( tDokument.iZeile ) THEN 
        DO:
            ASSIGN 
                cWerte  = cWerte  + CHR(01)
                cZellen = cZellen + ','.
            NEXT.
        END.
        RUN vpr_SetDelimiter (CHR(01)).
        RUN vpr_setGroupText (ipGruppe, cZellen, cWerte).
        RUN vpr_FlushGroup   (ipGruppe).
    END.
    FOR EACH tDokument
        WHERE tDokument.cGruppe = ipGruppe:
        DELETE  tDokument.
    END.

END PROCEDURE.

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

&ENDIF

&IF DEFINED(EXCLUDE-DRUCKEN) = 0 &THEN

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

    DEFINE VARIABLE cText     AS CHARACTER NO-UNDO.
    DEFINE VARIABLE cLAdresse AS CHARACTER NO-UNDO.
    DEFINE VARIABLE RText     AS CHARACTER NO-UNDO.
    DEFINE VARIABLE WText     AS CHARACTER NO-UNDO.
    DEFINE VARIABLE ii        AS INTEGER   NO-UNDO.
    DEFINE VARIABLE i1        AS INTEGER   NO-UNDO.
    DEFINE VARIABLE nBetrag   AS DECIMAL   NO-UNDO.
    DEFINE VARIABLE iMwstCd   AS INTEGER   NO-UNDO.
    DEFINE VARIABLE nZeiTot   AS DECIMAL   DECIMALS 4 NO-UNDO.
    DEFINE VARIABLE lJa       AS LOG       NO-UNDO.
    DEFINE VARIABLE cPDFName  AS CHARACTER INIT '' NO-UNDO.
    DEFINE VARIABLE xString   AS CHARACTER NO-UNDO.
    
    FIND FIRST tParam.
    IF tParam.lBatch THEN 
    DO:
        ASSIGN  
            tParam.lOpenPDF = FALSE.
    END.
    lEnde = FALSE.
    
    FIND FIRST tAufko NO-ERROR.
    IF NOT AVAILABLE tAufko THEN CREATE tAufko.
    BUFFER-COPY bAufko TO tAufko
        ASSIGN  
        tAufko.iRecid  = RECID(bAufko)
        tAufko.lBetrag = TRUE.

    nFakBetr = 0.
    IF iSeite = 0 THEN RUN VIPER_INIT.
    
    RUN DRUCKEN_KOPF.

    iArtZeile = 0.
    iVPagePos = vpr_getPageVPos().
    RUN vpr_setGroupVPos ( 'ArtikelZeile1', iVPagePos ).
    
    FOR EACH tAufze NO-LOCK
        BY tAufze.Aufnr
        BY tAufze.Sort1
        BY tAufze.Sort2 :
             
        FIND Aufze NO-LOCK WHERE RECID(Aufze) = tAufze.Zeile.
        
        RUN ARTIKELZEILE ( RECID(tAufze) ).

        nFakBetr = nFakBetr + Aufze.Net_Betr.
        RELEASE Aufze.
    END.

    RUN AUSGABE_ARTIKELZEILE.

    iVPagePos = vpr_getPageVPos() + 100.
    RUN vpr_setPageVPos  ( iVPagePos ).
    
    /*  Gebindelieferungen  ------------------------------------------------    */

    RUN VIPER_CREATE_DOKUMENT ( 'Zusatztext', iArtZeile,  'Bemerkung_1' , 'Liefergebinde:' ).
    nBetrag   = 0.
    iArtZeile = 0.
    ii        = 0.
    FOR EACH TGebKto BY TGebKto.Sort_Cd
        BY TGebKto.Geb_Cd :
        ii = ii + 1.
        IF ii MOD 2 > 0 THEN 
        DO:
            iArtZeile = iArtZeile + 1.
            RUN VIPER_CREATE_DOKUMENT ( 'GebindeLieferung', iArtZeile, 'GebindeGel_1' , TRIM(STRING(tGebKto.A_Anz,"->>,>>9")) ).
            RUN VIPER_CREATE_DOKUMENT ( 'GebindeLieferung', iArtZeile, 'Gebindetext_1', tGebKto.Bez ).
            RUN VIPER_CREATE_DOKUMENT ( 'GebindeLieferung', iArtZeile, 'a_1'          , 'à'          ).
            RUN VIPER_CREATE_DOKUMENT ( 'GebindeLieferung', iArtZeile, 'GebindeBetr_1', TRIM(STRING(tGebKto.Preis,'->>>9.99')) ).
        END.
        ELSE 
        DO:
            RUN VIPER_CREATE_DOKUMENT ( 'GebindeLieferung', iArtZeile, 'GebindeGel_2' , TRIM(STRING(tGebKto.A_Anz,"->>,>>9")) ).
            RUN VIPER_CREATE_DOKUMENT ( 'GebindeLieferung', iArtZeile, 'Gebindetext_2', tGebKto.Bez  ).
            RUN VIPER_CREATE_DOKUMENT ( 'GebindeLieferung', iArtZeile, 'a_2'          , 'à'          ).
            RUN VIPER_CREATE_DOKUMENT ( 'GebindeLieferung', iArtZeile, 'GebindeBetr_2', TRIM(STRING(tGebKto.Preis,'->>>9.99')) ).
        END.
    END.
    /*    FOR EACH AufGKon NO-LOCK                                                                                                       */
    /*        WHERE AufGKon.Firma    = BAufko.Firma                                                                                      */
    /*        AND   AufGKon.Aufnr    = iFaknr                                                                                            */
    /*        AND   AufGKon.Depot   <> 0                                                                                                 */
    /*        AND  (AufGKon.Eingang <> 0  OR                                                                                             */
    /*        AufGKon.Ausgang <> 0)                                                                                                      */
    /*                                                                                                                                   */
    /*        BREAK BY AufgKon.Firma                                                                                                     */
    /*        BY AufGKon.Aufnr:                                                                                                          */
    /*                                                                                                                                   */
    /*        FIND GebKonto NO-LOCK                                                                                                      */
    /*            WHERE GebKonto.Firma  = cFirma                                                                                         */
    /*            AND   GebKonto.Geb_Cd = AufGKon.Geb_Cd.                                                                                */
    /*        i1        = AufGKon.Ausgang - AufGKon.Eingang.                                                                             */
    /*        Rundbetr  = AufGKon.Betrag.                                                                                                */
    /*        iMwstCd   = AufGKon.MWSt_Cd.                                                                                               */
    /*        nBetrag   = nBetrag   + Rundbetr.                                                                                          */
    /*        ii = ii + 1.                                                                                                               */
    /*        IF ii MOD 2 > 0 THEN                                                                                                       */
    /*        DO:                                                                                                                        */
    /*            iArtZeile = iArtZeile + 1.                                                                                             */
    /*            RUN VIPER_CREATE_DOKUMENT ( 'GebindeLieferung', iArtZeile, 'GebindeGel_1' , TRIM(STRING(AufGKon.Ausgang,"->>,>>9")) ). */
    /*            RUN VIPER_CREATE_DOKUMENT ( 'GebindeLieferung', iArtZeile, 'Gebindetext_1', GebKonto.Bez ).                            */
    /*            RUN VIPER_CREATE_DOKUMENT ( 'GebindeLieferung', iArtZeile, 'a_1'          , 'à'          ).                            */
    /*            RUN VIPER_CREATE_DOKUMENT ( 'GebindeLieferung', iArtZeile, 'GebindeBetr_1', TRIM(STRING(GebKonto.Depot ,'->>>9.99')) ).*/
    /*        END.                                                                                                                       */
    /*        ELSE                                                                                                                       */
    /*        DO:                                                                                                                        */
    /*            RUN VIPER_CREATE_DOKUMENT ( 'GebindeLieferung', iArtZeile, 'GebindeGel_2' , TRIM(STRING(AufGKon.Ausgang,"->>,>>9")) ). */
    /*            RUN VIPER_CREATE_DOKUMENT ( 'GebindeLieferung', iArtZeile, 'Gebindetext_2', GebKonto.Bez ).                            */
    /*            RUN VIPER_CREATE_DOKUMENT ( 'GebindeLieferung', iArtZeile, 'a_2'          , 'à'          ).                            */
    /*            RUN VIPER_CREATE_DOKUMENT ( 'GebindeLieferung', iArtZeile, 'GebindeBetr_2', TRIM(STRING(GebKonto.Depot ,'->>>9.99')) ).*/
    /*        END.                                                                                                                       */
    /*    END.                                                                                                                           */
    RELEASE AufGKon.
    RELEASE GebKonto.
    
    IF iArtZeile > 0 THEN 
    DO:
        RUN AUSGABE_GRUPPE ('ZusatzText').
        RUN AUSGABE_GRUPPE ('GebindeLieferung').
    END.
    
    /*  Gebindelrücknahmetablle  -------------------------------------------    */
        
    iArtZeile = 0.
    xString   = SUBSTITUTE('GEBINDERETOUR&1', STRING(bAufko.Fak_Art,'99')).
    cText     = ''.

    FIND TabTexte NO-LOCK USE-INDEX TabTexte-k1
        WHERE TabTexte.Firma   = bAufko.Firma
        AND   TabTexte.TextArt = xString
        AND   TabTexte.Sprcd   = iSprcd NO-ERROR.
    IF NOT AVAILABLE TabTexte THEN 
    DO:
        FIND TabTexte NO-LOCK USE-INDEX TabTexte-k1
            WHERE TabTexte.Firma   = bAufko.Firma
            AND   TabTexte.TextArt = xString
            AND   TabTexte.Sprcd   = 1 NO-ERROR.
    END.
    IF NOT AVAILABLE TabTexte THEN 
    DO:
        xString = 'GEBINDERETOUR'.
        FIND TabTexte NO-LOCK USE-INDEX TabTexte-k1
            WHERE TabTexte.Firma   = bAufko.Firma
            AND   TabTexte.TextArt = xString
            AND   TabTexte.Sprcd   = iSprcd NO-ERROR.
    END.
    IF NOT AVAILABLE TabTexte THEN 
    DO:
        FIND TabTexte NO-LOCK USE-INDEX TabTexte-k1
            WHERE TabTexte.Firma   = bAufko.Firma
            AND   TabTexte.TextArt = xString
            AND   TabTexte.Sprcd   = 1 NO-ERROR.
    END.
    IF AVAILABLE TabTexte THEN cText = TabTexte.Inhalt.

    IF cText <> '' THEN 
    DO:
        RUN vpr_asc2rtf ( cText, '', OUTPUT cText ).
        RUN VIPER_CREATE_DOKUMENT ( 'GebindeRuecknahme', 1,  'GebindeRuecknahme_T' , cText ).
        ii = DYNAMIC-FUNCTION ('calculateBlock':U, 'GebindeRuecknahme') NO-ERROR.
        ii = ii + vpr_getPageVPos() + 150.
        IF ii > (iMaxPos) THEN 
        DO:
            RUN VIPER_NEUE_SEITE.
            iVPagePos = vpr_getPageVPos() + 75.
        END.
        ELSE iVPagePos = vpr_getPageVPos() + 150.

        RUN vpr_setPageVPos  ( iVPagePos ).
        RUN vpr_setGroupVPos ( 'GebindeRuecknahme', iVPagePos ).
        RUN AUSGABE_GRUPPE   ( 'GebindeRuecknahme' ).
    END.
    
    lEnde = TRUE.
    RUN VIPER_NEUE_SEITE.
    
    RUN vpr_EndDoc.
    
    cvpr_Dokument = SUBSTITUTE(cERPDokumente,
        tParam.cInstall, 
        'Lieferscheine',
        SUBSTITUTE('&1-&2_&3.vpr',
        STRING(bAufko.Knr  ,'999999'),
        STRING(bAufko.Aufnr,'9999999'),
        tParam.cDokument) ).
    RUN vpr_SaveDoc ( cvpr_Dokument ).

    IF tParam.lCreatePDF THEN 
    DO:
        cPDFName = REPLACE(cvpr_Dokument, '.vpr', '.pdf').
        RUN vpr_printPDF (0, 0, INPUT-OUTPUT cPDFName ).
    END.

    IF tParam.lOpenPDF THEN 
    DO:    
        DEFINE VARIABLE o-i AS i NO-UNDO.    
        FILE-INFO:FILE-NAME = cPDFName.
        cPDFName = FILE-INFO:FULL-PATHNAME.
        RUN shellExecuteA (0,
            "open",
            cPDFName,
            "",
            "",
            0,
            OUTPUT o-i).
    END.
    
END PROCEDURE.

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

&ENDIF

&IF DEFINED(EXCLUDE-DRUCKEN_ADRESSE) = 0 &THEN

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

    DEFINE VARIABLE cZellen AS CHARACTER NO-UNDO.
    DEFINE VARIABLE cWerte  AS CHARACTER NO-UNDO.
    DEFINE VARIABLE iPos    AS INTEGER   NO-UNDO.
    
    FIND FIRST tParam.

    FIND FIRST tDokument
        WHERE tDokument.cGruppe = 'KOPF'
        AND   tDokument.iZeile  = 1
        AND   tDokument.cFeld   = 'Seite' NO-ERROR.
    IF NOT AVAILABLE tDokument THEN 
    DO:
        CREATE  tDokument.
        ASSIGN  
            tDokument.cGruppe = 'KOPF'
            tDokument.iZeile  = 1
            tDokument.cFeld   = 'Seite'.
    END.
    tDokument.cInhalt = STRING(iSeite,'z9').

    cZellen = ''.
    cWerte  = ''.
    FOR EACH tDokument
        WHERE tDokument.cGruppe = 'Kopf'
        BREAK BY tDokument.cGruppe
        BY tDokument.cFeld:
        cWerte  = cWerte 
            + tDokument.cInhalt.
        cZellen = cZellen
            + tDokument.cFeld.
        IF NOT LAST-OF ( tDokument.cGruppe ) THEN ASSIGN cWerte  = cWerte  + CHR(01)
                cZellen = cZellen + ','.
    END.

    RUN vpr_SetDelimiter (CHR(01)).
    RUN vpr_setGroupText ('Kopf', cZellen, cWerte).
    RUN vpr_FlushGroup   ('Kopf').
    
    IF iSeite  = 1 THEN 
    DO:
        cZellen = ''.
        cWerte  = ''.
        FOR EACH tDokument
            WHERE tDokument.cGruppe = 'KopfDetail'
            BREAK BY tDokument.cGruppe
            BY tDokument.cFeld:
            cWerte  = cWerte 
                + tDokument.cInhalt.
            cZellen = cZellen
                + tDokument.cFeld.
            IF NOT LAST-OF ( tDokument.cGruppe ) THEN ASSIGN cWerte  = cWerte  + CHR(01)
                    cZellen = cZellen + ','.
        END.
        RUN vpr_SetDelimiter (CHR(01)).
        RUN vpr_setGroupText ('KopfDetail', cZellen, cWerte).
        RUN vpr_FlushGroup   ('KopfDetail').
    END.

    iPos      = vpr_getGroupVPos('KopfDetail').
    iVPagePos = vpr_getCellVPos('Seite_T', 'Kopf') + vpr_getCellHeight('Seite_T', 'Kopf').
    IF iPos > iVPagePos THEN iVPagePos = iPos.
    iVPagePos = iVPagePos + 20.

    RUN vpr_setGroupVPos ( 'Ueberschrift', iVPagePos ).
    RUN vpr_FlushGroup   ( 'Ueberschrift' ).

    iPos = vpr_getGroupVPos('Ueberschrift') + vpr_getGroupHeight('Ueberschrift').
    RUN vpr_setPageVPos ( iPos ).
    
END PROCEDURE.

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

&ENDIF

&IF DEFINED(EXCLUDE-DRUCKEN_KOPF) = 0 &THEN

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

    DEFINE VARIABLE cText AS CHARACTER NO-UNDO.
    DEFINE VARIABLE ii    AS INTEGER   NO-UNDO.
    DEFINE VARIABLE i1    AS INTEGER   NO-UNDO.
    
    FIND FIRST tParam.

    RUN VIPER_NEUE_SEITE.

    IF iSeite = 1 THEN 
    DO:
        cBesrKopf = ''.
        IF bAufko.Adresse[05] <> '' THEN 
        DO:
            i1 = 6.
            DO ii = 1 TO 5:
                CREATE  tDokument.
                ASSIGN  
                    tDokument.cGruppe = 'KOPF'
                    tDokument.iZeile  = 1
                    tDokument.cFeld   = 'Adresse_' + STRING((6 + ii),'99')
                    tDokument.cInhalt = bAufko.Adresse[ii].
                i1 = i1 + 1.
                cBesrKopf[i1] = bAufko.Adresse[ii].
            END.
        END.
        ELSE 
        DO:
            DO ii = 5 TO 11:
                CREATE  tDokument.
                ASSIGN  
                    tDokument.cGruppe = 'KOPF'
                    tDokument.iZeile  = 1
                    tDokument.cFeld   = 'Adresse_' + STRING(ii,'99')
                    tDokument.cInhalt = bAdresse.Anschrift[ii].
                cBesrKopf[ii] = bAdresse.Anschrift[ii].
            END.
        END.
        
        CREATE  tDokument.
        ASSIGN  
            tDokument.cGruppe = 'KOPF'
            tDokument.iZeile  = 1
            tDokument.cFeld   = 'T_Dokument'
            tDokument.cInhalt = TRIM(SUBSTRING(cFormText[02],01,20)).
        tDokument.cInhalt = tDokument.cInhalt
            + ' '
            + STRING(iFaknr,'z999999').
    
        CREATE  tDokument.
        ASSIGN  
            tDokument.cGruppe = 'KOPF'
            tDokument.iZeile  = 1
            tDokument.cFeld   = 'Ort_Datum'
            tDokument.cInhalt = TRIM(SUBSTRING(cFormText[07],01,20))
                                  + " "
                                  + STRING(TODAY,"99.99.9999").

        /*  Kundennummer        */
        CREATE  tDokument.
        ASSIGN  
            tDokument.cGruppe = 'KOPF'
            tDokument.iZeile  = 1
            tDokument.cFeld   = 'Knr_T'
            tDokument.cInhalt = ENTRY(1, cFormText[24], ';').
        CREATE  tDokument.
        ASSIGN  
            tDokument.cGruppe = 'KOPF'
            tDokument.iZeile  = 1
            tDokument.cFeld   = 'Knr'
            tDokument.cInhalt = STRING(bAufko.Knr,'999999').
    
        /*  Lieferscheine   */
        CREATE  tDokument.
        ASSIGN  
            tDokument.cGruppe = 'KOPF'
            tDokument.iZeile  = 1
            tDokument.cFeld   = 'Lieferscheine_T'
            tDokument.cInhalt = ENTRY(5, cFormText[19], ';').
        CREATE  tDokument.
        ASSIGN  
            tDokument.cGruppe = 'KOPF'
            tDokument.iZeile  = 1
            tDokument.cFeld   = 'Lieferscheine'
            tDokument.cInhalt = cLieferscheine.
    
        /*  Auftragstext, Abladevorschrift, Abholtext   */
        cText = ''.
        IF bAufko.Auf_Text <> '' THEN
            cText = cText
                + (IF cText = '' THEN '' ELSE CHR(10) )
                + bAufko.Auf_Text.
                                            
        FIND FIRST tTabTexte WHERE tTabTexte.cRecArt = 'ABLAD' NO-ERROR.
        IF AVAILABLE tTabTexte THEN 
        DO:
            IF tTabTexte.cFeld3 <> '' THEN
                cText = cText
                    + (IF cText = '' THEN '' ELSE CHR(10) + CHR(10) )
                    + tTabTexte.cFeld3.
        END.
        IF bAufko.Abh_Text <> '' THEN
            cText = cText
                + (IF cText = '' THEN '' ELSE CHR(10) + CHR(10) )
                + bAufko.Abh_Text.
                
        IF cText <> '' THEN 
        DO:
            RUN vpr_asc2rtf ( cText, '', OUTPUT cText).
            CREATE  tDokument.
            ASSIGN  
                tDokument.cGruppe = 'KOPFDETAIL'
                tDokument.iZeile  = 1
                tDokument.cFeld   = 'Kopftexte'
                tDokument.cInhalt = cText.
        END.

        /*  Seite           */
        CREATE  tDokument.
        ASSIGN  
            tDokument.cGruppe = 'KOPF'
            tDokument.iZeile  = 1
            tDokument.cFeld   = 'Seite_T'
            tDokument.cInhalt = ENTRY(2, cFormText[24], ';').
    END.
    
    RUN DRUCKEN_ADRESSE.

END PROCEDURE.

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

&ENDIF
&IF DEFINED(EXCLUDE-FUELLEN_tAufze) = 0 &THEN

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

    DEFINE INPUT PARAMETER ipAufnr     AS INTEGER          NO-UNDO.

    DEFINE VARIABLE cLagOrt AS CHARACTER NO-UNDO.
    DEFINE VARIABLE cSort   AS CHARACTER NO-UNDO.

    EMPTY TEMP-TABLE tAufze.
    
    cLieferscheine = ''.
    FOR EACH sAufko:     
        cLieferscheine = cLieferscheine
            + (IF cLieferscheine = '' THEN '' ELSE ', ')
            + STRING(sAufko.iAufnr,'z999999')
            + '/'
            + STRING(sAufko.dLief_Datum,'99.99.9999').
        cLagOrt = ''.
        
        FOR EACH Aufze NO-LOCK
            WHERE Aufze.Firma = sAufko.cFirma
            AND   Aufze.Aufnr = sAufko.iAufnr
            AND   Aufze.Artnr > 0,
        
            FIRST Artst NO-LOCK
            WHERE Artst.Firma  = Aufze.Firma
            AND   Artst.Artnr  = Aufze.Artnr
            AND   Artst.Inhalt = Aufze.Inhalt
            AND   Artst.Jahr   = Aufze.Jahr :

            FIND ArtLager NO-LOCK
                WHERE ArtLager.Firma  = Aufze.Firma
                AND   ArtLager.Artnr  = Aufze.Artnr
                AND   ArtLager.Inhalt = Aufze.Inhalt
                AND   ArtLager.Jahr   = Aufze.Jahr
                AND   ArtLager.Lager  = Aufze.Lager NO-ERROR.
            IF AVAILABLE ArtLager THEN cLagort = ArtLager.Ort.
            
            cSort = STRING(Artst.Wg_Grp,'9999')
                + STRING(Artst.Prod_Grp,'9999')
                + STRING(Artst.Art_Grp ,'9999')
                + STRING(Aufze.Pos     ,'9999').
            FIND FIRST tAufze
                WHERE tAufze.Aufnr  = sAufko.iSamm_Nr
                AND   tAufze.Artnr  = Aufze.Artnr 
                AND   tAufze.Inhalt = Aufze.Inhalt
                AND   tAufze.Jahr   = Aufze.Jahr NO-ERROR.
            IF NOT AVAILABLE tAufze THEN 
            DO:
                CREATE  tAufze.
                ASSIGN  
                    tAufze.Aufnr  = sAufko.iSamm_Nr
                    tAufze.Artnr  = Aufze.Artnr
                    tAufze.Inhalt = Aufze.Inhalt
                    tAufze.Jahr   = Aufze.Jahr
                    tAufze.Pos    = Aufze.Pos
                    tAufze.Zeile  = RECID(Aufze)
                    tAufze.Aktion = Aufze.Aktion
                    tAufze.Preis  = Aufze.Preis
                    tAufze.Sort1  = cLagOrt
                    tAufze.Sort2  = cSort
                    tAufze.Sort3  = STRING(Aufze.Artnr ,'999999')
                                  + STRING(Aufze.Inhalt,'9999')
                                  + STRING(Aufze.Jahr  ,'9999')
                    tAufze.LagOrt = cLagort.
            END.
            ASSIGN  
                tAufze.MGel    = tAufze.MGel    + Aufze.MGel
                tAufze.GGeb_Me = tAufze.GGeb_Me + Aufze.GGeb_Me
                tAufze.VGeb_Me = tAufze.VGeb_Me + Aufze.VGeb_Me
                tAufze.KGeb_Me = tAufze.KGeb_Me + Aufze.KGeb_Me.
        END.
    END.
    
    RUN GEBINDE_SALDO.
    
END PROCEDURE.

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

&ENDIF

&IF DEFINED(EXCLUDE-VIPER_CREATE_DOKUMENT) = 0 &THEN

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

    DEFINE INPUT PARAMETER ipGruppe    AS CHARACTER         NO-UNDO.
    DEFINE INPUT PARAMETER ipZeile     AS INTEGER          NO-UNDO.
    DEFINE INPUT PARAMETER ipFeld      AS CHARACTER         NO-UNDO.
    DEFINE INPUT PARAMETER ipInhalt    AS CHARACTER         NO-UNDO.
    
    CREATE  tDokument.
    ASSIGN  
        tDokument.cGruppe = ipGruppe
        tDokument.iZeile  = ipZeile
        tDokument.cFeld   = ipFeld
        tDokument.cInhalt = ipInhalt.

END PROCEDURE.

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

&ENDIF

&IF DEFINED(EXCLUDE-VIPER_INIT) = 0 &THEN

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

    DEFINE VARIABLE cTemplate AS CHARACTER NO-UNDO.
    DEFINE VARIABLE cDokument AS CHARACTER NO-UNDO.
    DEFINE VARIABLE cZellen   AS CHARACTER NO-UNDO.
    DEFINE VARIABLE cZelle    AS CHARACTER NO-UNDO.
    DEFINE VARIABLE cGruppe   AS CHARACTER NO-UNDO.
    DEFINE VARIABLE ii        AS INTEGER   NO-UNDO.
    DEFINE VARIABLE cString   AS CHARACTER NO-UNDO.
    
    FIND FIRST tParam.

    IF iLauf = 1 THEN 
    DO:
        cTemplate = tParam.cInstall  + '/' + tParam.cDokument + '.vfr'.
        RUN vpr_LoadVFR         (cTemplate).
        RUN vpr_ActivateReport  (tParam.cDokument).
        RUN vpr_SelectPrinter   (tParam.Drucker).
        RUN vpr_setPrinterAttrib('duplex=1').
        /*         cString = SUBSTITUTE('copies=&1', tParam.Anzahl). */
        RUN vpr_SetPrinterAttrib('copies=1').
        RUN vpr_ResetDoc.
        RUN vpr_SetDocAttrib    ('PAPERSIZE=A4').
        RUN vpr_SetPreviewMode  ('Direct').
        RUN vpr_setDocTitle     (tParam.cDokument).
        IF tParam.Schacht_Original > 0 THEN RUN vpr_SetCurrentPageProperties ( "Papertray", tParam.Schacht_Original ).
    END.
    ELSE 
    DO:
        RUN vpr_NewPage.
        IF tParam.Schacht_Kopie    > 0 THEN RUN vpr_SetCurrentPageProperties ( "Papertray", tParam.Schacht_Kopie    ).
    END.
    RUN vpr_InitGroups("").
    RUN vpr_InitGraphObj.
    
    RUN vpr_SetGroupAttrib ("Kopf", "Fixed=true").
    
    iMaxPos = 2800.
    
END PROCEDURE.

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

&ENDIF

&IF DEFINED(EXCLUDE-VIPER_NEUE_SEITE) = 0 &THEN

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

    DEFINE VARIABLE iPos           AS INTEGER   NO-UNDO.
    DEFINE VARIABLE cTempDateiName AS CHARACTER NO-UNDO.
    
    FIND FIRST tParam.

    DO WHILE TRUE:
        IF iSeite = 0 THEN 
        DO:
            RUN vpr_InitGroups('').
            iSeite = iSeite + 1.
            RUN FUELLEN_UEBERSCHRIFT.
            LEAVE.
        END.
        
        RUN vpr_SetCurrentPageProperties ( "Papertray", tParam.Schacht_Original ).
        RUN vpr_printdoc ( iSeite, iSeite ).
        PAUSE 0.2 NO-MESSAGE.
        RUN vpr_SetCurrentPageProperties ( "Papertray", tParam.Schacht_Kopie    ).
        RUN vpr_printdoc ( iSeite, iSeite ).
        
        IF NOT lEnde THEN 
        DO:
            RUN vpr_NewPage.
            RUN vpr_InitGroups('').
            iSeite = iSeite + 1.
            RUN DRUCKEN_ADRESSE.
        END.
        LEAVE.
    END.
    
END PROCEDURE.

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

&ENDIF



/* ************************  Function Implementations ***************** */
&IF DEFINED(EXCLUDE-calculateBlock) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION calculateBlock Procedure
FUNCTION calculateBlock RETURNS INTEGER 
    ( ipGruppe AS CHARACTER  ):
    /*------------------------------------------------------------------------------
     Purpose:
     Notes:
    ------------------------------------------------------------------------------*/

    DEF VAR cZellen AS CHAR NO-UNDO.
    DEF VAR cWerte  AS CHAR NO-UNDO.
    DEF VAR iSpace  AS INT  NO-UNDO.
    DEF VAR iGrpHo  AS INT  NO-UNDO.

    FOR EACH tDokument
        WHERE tDokument.cGruppe = ipGruppe
        BREAK BY tDokument.cGruppe
        BY tDokument.iZeile :

        IF FIRST-OF ( tDokument.iZeile ) THEN 
        DO:
            cZellen = ''.
            cWerte  = ''.
        END.

        cWerte  = cWerte 
            + tDokument.cInhalt.
        cZellen = cZellen
            + tDokument.cFeld.
        IF NOT LAST-OF ( tDokument.iZeile ) THEN 
        DO:
            ASSIGN 
                cWerte  = cWerte  + CHR(01)
                cZellen = cZellen + ','.
            NEXT.
        END.

        RUN vpr_setGroupText (ipGruppe, cZellen, cWerte).

        iGrpHo = vpr_getGroupHeight ( ipGruppe ).
        iSpace = iSpace + iGrpHo.
    END.
    
    /*    RUN vpr_InitGroups(ipGruppe).*/
    
    RETURN iSpace.
    
END FUNCTION.
    
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ENDIF