&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 ************************** */ DEF INPUT PARAMETER iphParam AS HANDLE NO-UNDO. DEF OUTPUT PARAMETER opcResult AS CHAR NO-UNDO. DEF VAR iSeite AS INT NO-UNDO. DEF VAR iAnzDok AS INT NO-UNDO. DEF VAR iLauf AS INT NO-UNDO. DEF VAR lFirst AS LOG INIT FALSE NO-UNDO. DEF VAR lLast AS LOG INIT FALSE NO-UNDO. DEF VAR lPreis AS LOG NO-UNDO. DEF VAR cFirma AS CHAR NO-UNDO. DEF VAR AdFirma AS CHAR NO-UNDO. DEF VAR nFakBetr AS DEC NO-UNDO. DEF VAR dFakDatum AS DATE NO-UNDO. DEF VAR iFaknr AS INT NO-UNDO. DEF VAR iSprcd AS INT NO-UNDO. DEF VAR nTotale AS DEC EXTENT 15 NO-UNDO. DEF VAR cFormtext AS CHAR EXTENT 30 NO-UNDO. DEF VAR cRabText AS CHAR NO-UNDO. DEF VAR cZusText AS CHAR NO-UNDO. DEF VAR cEpzText AS CHAR NO-UNDO. DEF VAR cBesrKopf AS CHAR EXTENT 12 NO-UNDO. DEF VAR lDebIncl AS LOG NO-UNDO. DEF VAR Rundbetr AS DEC DECIMALS 4 NO-UNDO. DEF VAR RundCode AS INT INIT 1 NO-UNDO. DEF VAR htTabTexte AS HANDLE NO-UNDO. DEF VAR hSavko AS HANDLE NO-UNDO. DEF VAR cFaktext AS CHAR NO-UNDO. DEF VAR iDokumentStatus AS INT NO-UNDO. DEF VAR iMaxPos AS INT INIT 2650 NO-UNDO. DEF VAR cvpr_Dokument AS CHAR NO-UNDO. DEF VAR iArtZeile AS INT NO-UNDO. DEF VAR iVPagePos AS INT NO-UNDO. DEF VAR iVGroupPos AS INT NO-UNDO. DEF BUFFER bSavko FOR Savko . DEF BUFFER bSavze FOR Savze . DEF BUFFER bDebst FOR Debst . /* Fakturaadresse */ DEF BUFFER FDebst FOR Debst . /* Fakturaadresse */ DEF BUFFER LDebst FOR Debst . /* Lieferadresse */ DEF BUFFER LAdresse FOR Adresse . DEF BUFFER bAdresse FOR Adresse . DEF BUFFER bWust FOR Wust . DEF BUFFER bSteuer FOR Steuer . { incl/ttdruckparam.i } DEF TEMP-TABLE tDokument FIELD cGruppe AS CHAR FIELD iZeile AS INT FIELD cFeld AS CHAR FIELD cInhalt AS CHAR INDEX tDokument-k1 IS PRIMARY cGruppe iZeile cFeld . DEF TEMP-TABLE tTotale FIELD nMwstPfl AS DEC EXTENT 12 FIELD nMwstBet AS DEC EXTENT 12 FIELD nSammTot AS DEC FIELD nSkBer AS DEC FIELD nWW AS DEC . DEF TEMP-TABLE sSavko FIELD cFirma AS CHAR FIELD iAufnr AS INT FIELD iFak_Knr AS INT FIELD iKnr AS INT FIELD iSamm_Nr AS INT FIELD iRecid AS RECID FIELD iFaknr AS INT FIELD iFak_Art AS INT FIELD iAuf_Sta AS INT . DEF TEMP-TABLE tSavko LIKE Savko FIELD iRecid AS RECID . DEF TEMP-TABLE tSavze FIELD Aufnr AS INT FIELD Sort1 AS CHAR FIELD Sort2 AS CHAR FIELD Sort3 AS CHAR FIELD Artnr AS INT FIELD Inhalt AS INT FIELD Jahr AS INT FIELD Pos AS INT FIELD Zeile AS RECID FIELD Preis AS DEC DECIMALS 4 FIELD Aktion AS LOG FIELD LagOrt AS CHAR FIELD MGeli AS DEC FIELD MRuek AS DEC INDEX tSavze-k1 IS PRIMARY Aufnr Sort1 Sort2 Sort3 . DEF TEMP-TABLE tSpeRab FIELD Rab_Grp AS INT FIELD Auf_Betr AS DEC DECIMALS 4 . DEF TEMP-TABLE tGebKto FIELD Sort_Cd AS CHAR FIELD Geb_Cd AS CHAR FIELD Bez AS CHAR FIELD Preis AS DEC FIELD A_Anz AS DEC FIELD A_Betrag AS DEC FIELD E_Anz AS DEC FIELD E_Betrag AS DEC FIELD MWST_Art AS INT FIELD MWST_Cd AS INT . DEF TEMP-TABLE tRabSumm FIELD Rab_Summ AS INT FIELD Bez AS CHAR FIELD F_Rab_Art AS INT FIELD F_Wert AS DEC DECIMALS 4 FIELD A_Rab_Art AS INT FIELD A_Wert AS DEC DECIMALS 4 FIELD Auf_Rab AS DEC DECIMALS 4 FIELD Abh_Rab AS DEC DECIMALS 4 . DEF TEMP-TABLE tUmsGrp FIELD Ums_Grp AS INT FIELD Mwst AS INT FIELD Ansatz AS DEC FIELD Bez AS CHAR FIELD Ums_Betr AS DEC DECIMALS 4 . DEF TEMP-TABLE tTabTexte FIELD cRecArt AS CHAR FIELD iZeile AS INT FIELD cFeld1 AS CHAR FIELD cFeld2 AS CHAR FIELD cFeld3 AS CHAR FIELD iFeld1 AS INT FIELD iFeld2 AS INT FIELD iFeld3 AS INT INDEX tTabTexte-k1 IS PRIMARY cRecArt iZeile. DEF TEMP-TABLE tRabSumTot FIELD Aufnr AS INT FIELD Grp AS INT FIELD AufRabatt AS DEC FIELD AbhRabatt AS DEC . /* _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-getPDFDocument) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getPDFDocument Procedure FUNCTION getPDFDocument RETURNS CHARACTER ( ipAufnr AS INT ) FORWARD. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-getVPRDocument) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getVPRDocument Procedure FUNCTION getVPRDocument RETURNS CHARACTER ( ipAufnr AS INT ) 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 *************************** */ DEF VAR cPDFName AS CHAR NO-UNDO. DEF VAR cVPRName AS CHAR NO-UNDO. DEF VAR lVPRDatei AS LOG NO-UNDO. opcResult = ''. CREATE tParam. htParam:BUFFER-COPY(iphParam). ASSIGN cFirma = tParam.cFirma iAnzDok = tParam.Anzahl. FIND bSteuer NO-LOCK WHERE bSteuer.Firma = cFirma. AdFirma = bSteuer.AdFirma. RUN AUFTRAG_ERMITTELN. IF opcResult <> '' THEN RETURN. FOR EACH sSavko BY sSavko.iFak_Knr: cPDFName = DYNAMIC-FUNCTION('getPDFDocument':U, sSavko.iAufnr ) NO-ERROR. cVPRName = DYNAMIC-FUNCTION('getVPRDocument':U, sSavko.iAufnr ) NO-ERROR. IF cPDFName <> '' THEN DO: FILE-INFO:FILE-NAME = cPDFName. IF FILE-INFO:FILE-SIZE > 9000 THEN DO: RUN OPEN_PDF ( cPDFName ). LEAVE. END. OS-DELETE VALUE(cPDFName) NO-ERROR. END. IF cVPRName <> '' THEN DO: FILE-INFO:FILE-NAME = cVPRName NO-ERROR. IF FILE-INFO:FULL-PATHNAME <> ? AND FILE-INFO:FULL-PATHNAME <> '' THEN DO: lVPRDatei = TRUE. END. END. FIND bAdresse NO-LOCK WHERE bAdresse.Firma = AdFirma AND bAdresse.Knr = sSavko.iFak_Knr. 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. FIND bDebst NO-LOCK WHERE bDebst.Firma = sSavko.cFirma AND bDebst.Knr = sSavko.iFak_Knr. iDokumentStatus = bDebst.DokumentStatus. RELEASE bDebst. FIND FIRST tParam. iAnzDok = tParam.Anzahl. { vpr.i INIT } { vpr.i START } IF lVPRDatei THEN DO: cPDFName = REPLACE(cVPRName, '.vpr', '.pdf'). RUN vpr_openDoc ( cVPRName ). RUN vpr_printPDF ( 0, 0, INPUT-OUTPUT cPDFName ). { vpr.i STOP } RUN OPEN_PDF ( cPDFName ). LEAVE. END. DO iLauf = 1 TO iAnzDok: dFakDatum = tParam.dFakDatum. iSeite = 0. iFaknr = sSavko.iFaknr. lFirst = TRUE. lPreis = TRUE. lLast = FALSE. EMPTY TEMP-TABLE tUmsGrp . EMPTY TEMP-TABLE tTotale . EMPTY TEMP-TABLE tDokument . CREATE tTotale. FOR EACH bSavko NO-LOCK WHERE bSavko.Firma = sSavko.cFirma AND bSavko.Fak_Knr = sSavko.iFak_Knr AND bSavko.Samm_Nr = sSavko.iSamm_Nr AND bSavko.Faknr = sSavko.iFaknr BREAK BY bSavko.Fak_Knr BY bSavko.Samm_Nr BY bSavko.Knr BY bSavko.Aufnr : EMPTY TEMP-TABLE tSavze . EMPTY TEMP-TABLE tGebKto . EMPTY TEMP-TABLE tRabSumm . EMPTY TEMP-TABLE tSpeRab . EMPTY TEMP-TABLE tTabTexte . FIND bAdresse NO-LOCK USE-INDEX Adresse-k1 WHERE bAdresse.Firma = AdFirma AND bAdresse.Knr = bSavko.Fak_Knr NO-ERROR. FIND LDebst NO-LOCK USE-INDEX Debst-k1 WHERE LDebst.Firma = cFirma AND LDebst.Knr = bSavko.Knr NO-ERROR. FIND FDebst NO-LOCK USE-INDEX Debst-k1 WHERE FDebst.Firma = cFirma AND FDebst.Knr = bSavko.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. hSavko = BUFFER bSavko: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 ( hSavko, INPUT-OUTPUT htTabTexte ) NO-ERROR. RUN FUELLEN_tSavze ( bSavko.Aufnr ) NO-ERROR. FOR EACH tSavze WHERE tSavze.Artnr > 0: FIND bSavze NO-LOCK WHERE RECID(bSavze) = tSavze.Zeile. /* Spezial-Auftragsrabatt pro Lieferschein bilden */ IF bSavze.Auf_Sp_Grp > 0 THEN DO: FIND FIRST tSpeRab WHERE tSpeRab.Rab_Grp = bSavze.Auf_Sp_Grp NO-ERROR. IF NOT AVAILABLE tSpeRab THEN DO: CREATE tSpeRab. ASSIGN tSpeRab.Rab_Grp = bSavze.Auf_Sp_Grp. END. tSpeRab.Auf_Betr = tSpeRab.Auf_Betr + bSavze.Auf_Sp_Rab. END. /* Summengruppen-Totale pro Lieferschein bilden */ DO WHILE bSavze.Rab_Su_Grp > 0: FIND FIRST tRabSumm WHERE tRabSumm.Rab_Summ = bSavze.Rab_Su_Grp NO-ERROR. IF NOT AVAILABLE tRabSumm THEN DO: FIND FIRST RabSumm NO-LOCK WHERE RabSumm.Firma = bSavze.Firma AND RabSumm.Rab_Summ = bSavze.Rab_Su_Grp NO-ERROR. IF NOT AVAILABLE RabSumm THEN LEAVE. CREATE tRabSumm. ASSIGN tRabSumm.Rab_Summ = bSavze.Rab_Su_Grp tRabSumm.Bez = RabSumm.Bez tRabSumm.Auf_Rab = 0 tRabSumm.Abh_Rab = 0. END. LEAVE. END. END. IF LAST-OF ( bSavko.Samm_Nr ) THEN lLast = TRUE. RUN DRUCKEN. END. END. { vpr.i STOP } END. PROCEDURE ShellExecuteA EXTERNAL "shell32.dll" : DEFINE INPUT PARAMETER lphwnd AS LONG. DEFINE INPUT PARAMETER lpOperation AS CHAR. DEFINE INPUT PARAMETER lpFile AS CHAR. DEFINE INPUT PARAMETER lpParameters AS CHAR. DEFINE INPUT PARAMETER lpDirectory AS CHAR. DEFINE INPUT PARAMETER nShowCmd AS LONG. DEFINE RETURN PARAMETER hInstance AS LONG. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME /* ********************** Internal Procedures *********************** */ &IF DEFINED(EXCLUDE-ARTIKELZEILE) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE ARTIKELZEILE Procedure PROCEDURE ARTIKELZEILE : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DEF INPUT PARAMETER ipRecid AS RECID NO-UNDO. DEF VAR cString AS CHAR NO-UNDO. DEF VAR nRabWert AS DEC NO-UNDO. DEF VAR xRabText AS CHAR NO-UNDO. FIND tSavze WHERE RECID(tSavze) = ipRecid NO-LOCK. FIND Savze WHERE RECID(Savze) = tSavze.Zeile NO-LOCK. iArtZeile = iArtZeile + 1. DO WHILE Savze.Artnr = 0: cString = Savze.Bez1. IF Savze.Bez1 <> '' THEN DO: cString = cString + (IF cString = '' THEN '' ELSE CHR(10)) + Savze.Bez2. END. CREATE tDokument. ASSIGN tDokument.cGruppe = 'ArtikelZeile1' tDokument.iZeile = iArtZeile tDokument.cFeld = 'Bez1' tDokument.cInhalt = cString. RETURN. END. FIND Artst OF Savze NO-LOCK. FIND GGebinde NO-LOCK WHERE GGebinde.Firma = cFirma AND GGebinde.Geb_Cd = Savze.GGeb_Cd NO-ERROR. FIND VGebinde NO-LOCK WHERE VGebinde.Firma = cFirma AND VGebinde.Geb_Cd = Savze.VGeb_Cd NO-ERROR. FIND KGebinde NO-LOCK WHERE KGebinde.Firma = cFirma AND KGebinde.Geb_Cd = Savze.KGeb_Cd NO-ERROR. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'KGebinde', KGebinde.Kbez ). IF Savze.VGeb_Me <> 0 THEN DO: cString = STRING(Savze.VGeb_Me,'->>>>') + 'x ' + VGebinde.KBez. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'VGebinde', cString ). END. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Menge', STRING(Savze.MGeli,'->>,>>9') ). cString = Savze.Bez1. IF Savze.Bez2 <> '' THEN DO: cString = cString + (IF cString = '' THEN '' ELSE CHR(10)) + Savze.Bez2. END. IF Savze.Aktion THEN DO: cString = cString + (IF cString = '' THEN '' ELSE CHR(10)) + Savze.Aktion_Text. END. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1', cString ). IF Savze.Jahr > 9 THEN DO: cString = STRING(Savze.Jahr,"9999"). RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'JG', cString ). END. IF Savze.Alk_Gehalt <> 0 THEN DO: cString = STRING(Savze.Alk_Gehalt,"zz9.9%"). RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Alk%', cString ). END. DO WHILE lPreis : RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Artnr' , STRING(Savze.Artnr ,"999999") ). RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Preis' , STRING(Savze.Preis ,'>>>,>>9.99') ). RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', STRING(Savze.Bru_Betr,'->>>,>>9.99') ). RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'MC' , STRING(Savze.WuCd ,'z9') ). IF Savze.Rab_Betr = 0 THEN LEAVE. iArtZeile = iArtZeile + 1. nRabWert = ABSOLUTE(Savze.Rab_Wert). IF Savze.Rab_Art = 3 THEN xRabText = cEpzText. ELSE DO: IF Savze.Rab_Betr < 0 THEN xRabText = cZusText. IF Savze.Rab_Betr > 0 THEN xRabText = cRabText. END. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1', TRIM(xRabText) ). IF Savze.Rab_Art = 1 THEN cString = STRING(nRabWert,"->9.9%"). IF Savze.Rab_Art = 2 OR Savze.Rab_Art = 3 THEN cString = STRING(nRabWert,"-9.99"). RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Preis', cString ). RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', TRIM(STRING(- Savze.Rab_Betr,"->>>,>>9.99")) ). LEAVE. END. DO WHILE lPreis: IF Savze.Zus_Betr = 0 THEN LEAVE. iArtZeile = iArtZeile + 1. nRabWert = ABSOLUTE(Savze.Zus_Wert). IF Savze.Zus_Art = 3 THEN xRabText = cEpzText. ELSE DO: IF Savze.Zus_Betr < 0 THEN xRabText = cRabText. IF Savze.Zus_Betr > 0 THEN xRabText = cZusText. END. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1', TRIM(xRabText) ). IF Savze.Zus_Art = 1 THEN cString = STRING(nRabWert,"->9.9%"). IF Savze.Zus_Art = 2 OR Savze.Zus_Art = 3 THEN cString = STRING(nRabWert,"-9.99"). RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Preis', cString ). RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', TRIM(STRING(+ Savze.Zus_Betr,"->>>,>>9.99")) ). LEAVE. END. /* ---- Summengruppen-Total -------------------------------------------- */ IF Savze.Rab_Su_Grp <> 0 THEN DO: FIND FIRST tRabSumm WHERE tRabSumm.Rab_Summ = Savze.Rab_Su_Grp NO-ERROR. IF AVAILABLE tRabSumm THEN DO: tRabSumm.Auf_Rab = tRabSumm.Auf_Rab + Savze.Auf_Rab. tRabSumm.Abh_Rab = tRabSumm.Abh_Rab + Savze.Abh_Rab. END. FIND FIRST tRabSumTot WHERE tRabSumTot.Aufnr = Savze.Aufnr AND tRabSumTot.Grp = Savze.Rab_Su_Grp NO-ERROR. IF NOT AVAILABLE tRabSumTot THEN DO: CREATE tRabSumTot. ASSIGN tRabSumTot.Aufnr = Savze.Aufnr tRabSumTot.Grp = Savze.Rab_Su_Grp. END. ASSIGN tRabSumTot.AufRabatt = tRabSumTot.AufRabatt + Savze.Auf_Rab tRabSumTot.AbhRabatt = tRabSumTot.AbhRabatt + Savze.Abh_Rab. END. /* ---- Warengruppen-Totale -------------------------------------------- */ FIND FIRST TUmsGrp WHERE TUmsGrp.Ums_Grp = Artst.Wg_Grp AND TUmsGrp.MWst = Savze.WuCd AND TUmsGrp.Ansatz = Savze.Mwst% NO-ERROR. IF NOT AVAILABLE TUmsGrp THEN DO: FIND WarenGrp NO-LOCK USE-INDEX WarenGrp-k1 WHERE WarenGrp.Firma = cFirma AND WarenGrp.Wgr = Artst.Wg_Grp NO-ERROR. CREATE TUmsGrp. ASSIGN TUmsGrp.Ums_Grp = Artst.Wg_Grp TUmsGrp.Mwst = Savze.WuCd TUmsGrp.Ansatz = Savze.MWST%. IF AVAILABLE WarenGrp THEN TUmsGrp.Bez = WarenGrp.Bez1. ELSE TUmsGrp.Bez = "??????????". END. TUmsGrp.Ums_Betr = TUmsGrp.Ums_Betr + Savze.Net_Betr - Savze.Auf_Rab - Savze.Abh_Rab. 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: Notes: ------------------------------------------------------------------------------*/ DEF VAR iAufnr AS INT NO-UNDO. DEF VAR iFaknr AS INT NO-UNDO. DEF BUFFER bDebst FOR Debst. FIND FIRST tParam. EMPTY TEMP-TABLE sSavko . EMPTY TEMP-TABLE tRabSumTot . /* Sammeln aller Aufträge pro Sammelnummer */ cFakText = ''. FOR EACH Savko NO-LOCK USE-INDEX Savko-k9 WHERE Savko.Firma = tParam.cFirma AND Savko.Faknr = tParam.iFaknr BREAK BY Savko.Fak_Knr BY Savko.Samm_Nr BY Savko.Faknr DESCENDING: IF NOT FIRST-OF ( Savko.Samm_Nr ) THEN NEXT. CREATE sSavko. ASSIGN sSavko.cFirma = Savko.Firma sSavko.iAufnr = Savko.Aufnr sSavko.iFak_Knr = Savko.Fak_Knr sSavko.iSamm_Nr = Savko.Samm_Nr sSavko.iRecid = RECID(Savko) sSavko.iFaknr = Savko.Faknr. IF cFakText = '' AND Savko.Auf_Text <> '' THEN cFakText = Savko.Auf_Text. 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: Notes: ------------------------------------------------------------------------------*/ DEF VAR cZellen AS CHAR NO-UNDO. DEF VAR cWerte AS CHAR NO-UNDO. DEF VAR iPos AS INT 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. 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. RUN DRUCKEN_ADRESSE. 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: Notes: ------------------------------------------------------------------------------*/ DEF INPUT PARAMETER ipGruppe AS CHAR NO-UNDO. DEF VAR cZellen AS CHAR NO-UNDO. DEF VAR cWerte AS CHAR NO-UNDO. DEF VAR iSpace AS INT NO-UNDO. 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 vpr_NewPage. RUN vpr_InitGroups(''). IF iLauf = iAnzDok THEN RUN vpr_initGraphObj. iSeite = iSeite + 1. RUN DRUCKEN_ADRESSE. END. iVPagePos = vpr_getPageVPos(). CASE ipGruppe: WHEN 'Gebindeabrechnung' THEN DO: iVPagePos = iVPagePos + 20. RUN vpr_setGroupVPos ( 'GebindeabrechnungTitel', iVPagePos ). RUN vpr_FlushGroup ( 'GebindeabrechnungTitel'). iVPagePos = vpr_getPageVPos(). END. OTHERWISE DO: END. END CASE. 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: Notes: ------------------------------------------------------------------------------*/ DEF VAR xString AS CHAR NO-UNDO. DEF VAR cLAdresse AS CHAR NO-UNDO. DEF VAR RText AS CHAR NO-UNDO. DEF VAR WText AS CHAR NO-UNDO. DEF VAR ii AS INT NO-UNDO. DEF VAR i1 AS INT NO-UNDO. DEF VAR nRabWert AS DEC NO-UNDO. DEF VAR iMwstCd AS INT NO-UNDO. DEF VAR nZeiTot AS DEC DECIMALS 4 NO-UNDO. FIND FIRST tParam. nFakBetr = 0. IF iSeite = 0 THEN RUN VIPER_INIT. RUN DRUCKEN_KOPF. iVPagePos = vpr_getPageVPos() + 20. RUN vpr_setPageVPos ( iVPagePos ). RUN vpr_setGroupVPos ( 'FetteZeile', iVPagePos ). iArtZeile = 1. IF cFakText <> '' THEN DO: RUN VIPER_CREATE_DOKUMENT ( 'FetteZeile', iArtZeile, 'Bez_1_Fett', cFakText ). cFakText = ''. END. iArtZeile = iArtZeile + 1. RUN VIPER_CREATE_DOKUMENT ( 'FetteZeile', iArtZeile, 'Bez_1_Fett', TRIM(SUBSTRING(cFormText[18],01,20)) ). RUN VIPER_CREATE_DOKUMENT ( 'FetteZeile', iArtZeile, 'Bez_2_Fett', TRIM(STRING(bSavko.Aufnr,"zzzzzzzzz9")) ). iArtZeile = iArtZeile + 1. RUN VIPER_CREATE_DOKUMENT ( 'FetteZeile', iArtZeile, 'Bez_1_Fett', TRIM(SUBSTRING(cFormText[17],21,20)) ). RUN VIPER_CREATE_DOKUMENT ( 'FetteZeile', iArtZeile, 'Bez_2_Fett', TRIM(STRING(bSavko.Lief_Datum,"99.99.9999")) ). iArtZeile = iArtZeile + 1. RUN VIPER_CREATE_DOKUMENT ( 'FetteZeile', iArtZeile, 'Bez_1_Fett', ' ' ). DO WHILE TRUE: lFirst = TRUE. cLAdresse = ''. IF bSavko.Knr = bSavko.Fak_Knr AND NOT FDebst.Passant THEN LEAVE. DO ii = 1 TO 5: IF bSavko.Adresse[ii] = '' THEN NEXT. iArtZeile = iArtZeile + 1. RUN VIPER_CREATE_DOKUMENT ( 'FetteZeile', iArtZeile, 'Bez_1_Fett', bSavko.Adresse[ii] ). lFirst = FALSE. END. IF NOT lFirst THEN LEAVE. IF bSavko.Knr = bSavko.Fak_Knr THEN LEAVE. FIND LAdresse NO-LOCK WHERE LAdresse.Firma = AdFirma AND LAdresse.Knr = bSavko.Knr NO-ERROR. IF NOT AVAILABLE LAdresse THEN LEAVE. DO ii = 1 TO 12: IF LAdresse.Anschrift[ii] = '' THEN NEXT. iArtZeile = iArtZeile + 1. RUN VIPER_CREATE_DOKUMENT ( 'FetteZeile', iArtZeile, 'Bez_1_Fett', LAdresse.Anschrift[ii] ). lFirst = FALSE. END. LEAVE. END. IF NOT lFirst THEN DO: iArtZeile = iArtZeile + 1. RUN VIPER_CREATE_DOKUMENT ( 'FetteZeile', iArtZeile, 'Bez_1_Fett', ' ' ). END. RUN AUSGABE_GRUPPE ( 'FetteZeile' ). iArtZeile = 0. iVPagePos = vpr_getPageVPos(). RUN vpr_setGroupVPos ( 'ArtikelZeile1', iVPagePos ). FOR EACH tSavze NO-LOCK BY tSavze.Aufnr BY tSavze.Sort1 BY tSavze.LagOrt BY tSavze.Sort2 BY tSavze.Pos : FIND Savze NO-LOCK WHERE RECID(Savze) = tSavze.Zeile. RUN ARTIKELZEILE ( RECID(tSavze) ). nFakBetr = nFakBetr + Savze.Net_Betr. RELEASE Savze. END. iArtZeile = iArtZeile + 1. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1' , TRIM(SUBSTRING(cFormText[10],41,20)) ). RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', TRIM(STRING(nFakBetr,'->>>,>>9.99')) ). iArtZeile = iArtZeile + 1. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1' , ' ' ). RUN AUSGABE_ARTIKELZEILE. /* Auftragsrabatt ---------------------------------------------------- */ iArtZeile = 0. FOR EACH tRabSumm WHERE tRabSumm.Auf_Rab <> 0 BY tRabSumm.Rab_Summ: Rundbetr = tRabSumm.Auf_Rab. nFakBetr = nFakBetr - Rundbetr. IF Rundbetr < 0 THEN RText = cZusText. ELSE RText = cRabText. xString = RText + " " + tRabSumm.Bez. iArtZeile = iArtZeile + 1. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1', xString ). FIND FIRST AufRabSu NO-LOCK USE-INDEX AufRabSu-k1 WHERE AufRabSu.Firma = bSavko.Firma AND AufRabSu.Aufnr = bSavko.Aufnr AND AufRabSu.Rab_Summ = tRabSumm.Rab_Summ. nRabWert = ABSOLUT(AufRabSu.F_Wert). IF AufRabSu.F_Proz_Betr THEN WText = "%". ELSE WText = "Fr.". xString = STRING(nRabWert,"z9.99-") + WText. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Artnr', xString ). RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', TRIM(STRING(- Rundbetr,'->>>,>>9.99')) ). END. /* Abholrabatt ------------------------------------------------------- */ FOR EACH tRabSumm WHERE tRabSumm.Abh_Rab <> 0 BY tRabSumm.Rab_Summ: Rundbetr = tRabSumm.Abh_Rab. nFakBetr = nFakBetr - Rundbetr. IF Rundbetr < 0 THEN RText = cZusText. ELSE RText = cRabText. xString = RText + " " + tRabSumm.Bez. iArtZeile = iArtZeile + 1. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1', xString ). FIND FIRST AufRabSu NO-LOCK USE-INDEX AufRabSu-k1 WHERE AufRabSu.Firma = bSavko.Firma AND AufRabSu.Aufnr = bSavko.Aufnr AND AufRabSu.Rab_Summ = tRabSumm.Rab_Summ. nRabWert = ABSOLUT(AufRabSu.A_Wert). IF AufRabSu.A_Proz_Betr THEN WText = "%". ELSE WText = "Fr.". xString = STRING(nRabWert,"z9.99-") + WText. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Artnr', xString ). RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', TRIM(STRING(- Rundbetr,'->>>,>>9.99')) ). END. /* Spezialpreis-Auftragsrabatte ---------------------------------------- */ FOR EACH TSpeRab WHERE TSpeRab.Auf_Betr <> 0 BY TSpeRab.Rab_Grp: FIND Tabel USE-INDEX Tabel-k1 WHERE Tabel.Firma = cFirma AND Tabel.RecArt = 'ARABGRP' AND Tabel.CodeC = '' AND Tabel.CodeI = TSpeRab.Rab_Grp AND Tabel.Sprcd = 1 NO-LOCK. Rundbetr = TSpeRab.Auf_Betr. nFakBetr = nFakBetr - Rundbetr. IF Rundbetr < 0 THEN RText = cZusText. ELSE RText = cRabText. xString = RText + " " + Tabel.Bez1. iArtZeile = iArtZeile + 1. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1', xString ). FIND FIRST AufSpRab USE-INDEX AufSpRab-k1 WHERE AufSpRab.Firma = bSavko.Firma AND AufSpRab.Aufnr = bSavko.Aufnr AND AufSpRab.Rab_Grp = TSpeRab.Rab_Grp NO-LOCK. nRabWert = ABSOLUT(AufSpRab.Auf_Wert). IF AufSpRab.Auf_Proz_Betr THEN WText = "%". ELSE WText = "Fr.". xString = STRING(nRabWert,"z9.99-") + WText. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Artnr', xString ). RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', TRIM(STRING(- Rundbetr,'->>>,>>9.99')) ). END. IF iArtZeile > 0 THEN DO: iArtZeile = iArtZeile + 1. xString = TRIM(SUBSTRING(cFormText[14],21,20)). RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1', xString ). RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', TRIM(STRING(nFakBetr,'->>>,>>9.99')) ). iArtZeile = iArtZeile + 1. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1', ' ' ). END. RUN AUSGABE_GRUPPE ('ArtikelZeile1'). /* Recycling-Gebuehren ----------------------------------------------- */ iArtZeile = 0. FOR EACH SavGKon USE-INDEX SavGKon-k1 WHERE SavGKon.Firma = bSavko.Firma AND SavGKon.Aufnr = bSavko.Aufnr AND SavGKon.Gebuehr <> 0 AND SavGKon.Betrag <> 0 NO-LOCK: FIND GebKonto OF SavGKon NO-LOCK NO-ERROR. IF NOT AVAILABLE GebKonto THEN xString = TRIM(SUBSTRING(cFormText[11],41,20)). ELSE xString = GebKonto.Bez. iMwstCd = SavGKon.MWST_Cd. nFakBetr = nFakBetr + SavGKon.Betrag. FIND LAST MwstAns NO-LOCK WHERE MwstAns.Mwst_Cd = iMwstCd AND MwstAns.Datum <= bSavko.Fak_Datum NO-ERROR. iArtZeile = iArtZeile + 1. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1', xString ). RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', TRIM(STRING(SavGKon.Betrag,'->>>,>>9.999')) ). RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'MC', STRING(SavGKon.MWSt_Cd,'z9') ). FIND FIRST tUmsGrp WHERE tUmsGrp.Ums_Grp = 1000 AND tUmsGrp.Mwst = iMwstCd AND tUmsGrp.Ansatz = MwstAns.Ansatz NO-ERROR. IF NOT AVAILABLE tUmsGrp THEN DO: FIND WarenGrp USE-INDEX WarenGrp-k1 WHERE WarenGrp.Firma = cFirma AND WarenGrp.Wgr = 1000 NO-LOCK NO-ERROR. CREATE tUmsGrp. ASSIGN tUmsGrp.Ums_Grp = 1000 tUmsGrp.Mwst = iMwstCd tUmsGrp.Ansatz = MwstAns.Ansatz tUmsGrp.Bez = (IF AVAILABLE WarenGrp THEN WarenGrp.Bez1 ELSE 'Recyclinggebühren'). END. tUmsGrp.Ums_Betr = tUmsGrp.Ums_Betr + SavGKon.Betrag. END. IF iArtZeile > 0 THEN DO: iArtZeile = iArtZeile + 1. xString = TRIM(SUBSTRING(cFormText[14],41,20)). RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1', xString ). RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', TRIM(STRING(nFakBetr,'->>>,>>9.999')) ). END. RUN AUSGABE_GRUPPE ('ArtikelZeile1'). /* Gebindelieferungen ------------------------------------------------ */ IF FDebst.Geb_Rg THEN DO: nZeiTot = 0. iArtZeile = 0. FOR EACH SavGKon USE-INDEX SavGKon-k1 WHERE SavGKon.Firma = bSavko.Firma AND SavGKon.Aufnr = bSavko.Aufnr AND SavGKon.Depot <> 0 AND (SavGKon.Eingang <> 0 OR SavGKon.Ausgang <> 0) NO-LOCK: iMwstCd = SavGKon.MWSt_Cd. FIND LAST MwstAns NO-LOCK WHERE MwstAns.Mwst_Cd = iMwstCd AND MwstAns.Datum <= bSavko.Fak_Datum NO-ERROR. FIND FIRST tUmsGrp WHERE tUmsGrp.Ums_Grp = 1001 AND tUmsGrp.Mwst = iMwstCd AND tUmsGrp.Ansatz = MwstAns.Ansatz NO-ERROR. IF NOT AVAILABLE tUmsGrp THEN DO: FIND WarenGrp NO-LOCK USE-INDEX WarenGrp-k1 WHERE WarenGrp.Firma = cFirma AND WarenGrp.Wgr = 1001 NO-ERROR. CREATE tUmsGrp. ASSIGN tUmsGrp.Ums_Grp = 1001 tUmsGrp.Mwst = iMwstCd tUmsGrp.Ansatz = MwstAns.Ansatz tUmsGrp.Bez = (IF AVAILABLE WarenGrp THEN WarenGrp.Bez1 ELSE 'Gebindesaldo'). END. tUmsGrp.Ums_Betr = tUmsGrp.Ums_Betr + SavGKon.Betrag. FIND GebKonto NO-LOCK USE-INDEX GebKonto-k1 WHERE GebKonto.Firma = cFirma AND GebKonto.Geb_Cd = SavGKon.Geb_Cd. i1 = SavGKon.Ausgang - SavGKon.Eingang. Rundbetr = SavGKon.Betrag. nZeiTot = nZeiTot + Rundbetr. iArtZeile = iArtZeile + 1. RUN VIPER_CREATE_DOKUMENT ( 'Gebindeabrechnung', iArtZeile, 'Gebindetext' , GebKonto.Bez ). RUN VIPER_CREATE_DOKUMENT ( 'Gebindeabrechnung', iArtZeile, 'GebindeGel' , TRIM(STRING(SavGKon.Ausgang,"->>,>>9")) ). RUN VIPER_CREATE_DOKUMENT ( 'Gebindeabrechnung', iArtZeile, 'GebindeRet' , TRIM(STRING(SavGKon.Eingang,"->>,>>9")) ). RUN VIPER_CREATE_DOKUMENT ( 'Gebindeabrechnung', iArtZeile, 'GebindeSaldo', TRIM(STRING(i1 ,"->>,>>9")) ). RUN VIPER_CREATE_DOKUMENT ( 'Gebindeabrechnung', iArtZeile, 'GebindeBetr' , TRIM(STRING(Rundbetr ,"->>,>>9.999")) ). END. IF iArtZeile > 0 THEN DO: RUN VIPER_CREATE_DOKUMENT ( 'Gebindeabrechnung', iArtZeile, 'GebindeTot' , TRIM(STRING(nZeiTot,"->>>,>>9.999")) ). iArtZeile = iArtZeile + 1. RUN VIPER_CREATE_DOKUMENT ( 'Gebindeabrechnung', iArtZeile, 'GebindeTot' , ' ' ). END. nFakBetr = nFakBetr + nZeiTot. IF iArtZeile > 0 THEN RUN AUSGABE_GRUPPE ('Gebindeabrechnung'). END. FIND FIRST tTotale. DO ii = 1 TO 12: tTotale.nMwstPfl[ii] = tTotale.nMwstPfl[ii] + bSavko.Wpfl[ii]. tTotale.nMwstBet[ii] = tTotale.nMwstBet[ii] + bSavko.Wust[ii]. END. tTotale.nSammTot = tTotale.nSammTot + nFakBetr. tTotale.nSkBer = tTotale.nSkBer + bSavko.Sk_Ber. iArtZeile = 1. RUN VIPER_CREATE_DOKUMENT ( 'FetteZeile', iArtZeile, 'Bez_1_Fett' , TRIM(SUBSTRING(cFormText[15],21,20)) ). RUN VIPER_CREATE_DOKUMENT ( 'FetteZeile', iArtZeile, 'Betrag_Fett', TRIM(STRING(nFakBetr,"->>>,>>9.99")) ). IF lLast THEN DO: iArtZeile = iArtZeile + 1. RUN VIPER_CREATE_DOKUMENT ( 'FetteZeile', iArtZeile, 'Bez_1_Fett' , ' ' ). iArtZeile = iArtZeile + 1. RUN VIPER_CREATE_DOKUMENT ( 'FetteZeile', iArtZeile, 'Bez_1_Fett' , TRIM(SUBSTRING(cFormText[14],01,20)) ). RUN VIPER_CREATE_DOKUMENT ( 'FetteZeile', iArtZeile, 'Betrag_Fett', TRIM(STRING(tTotale.nSammTot,"->>>,>>9.99")) ). END. iArtZeile = iArtZeile + 1. RUN VIPER_CREATE_DOKUMENT ( 'FetteZeile', iArtZeile, 'Bez_1_Fett' , ' ' ). RUN AUSGABE_GRUPPE ( 'FetteZeile' ). IF lLast THEN RUN DRUCKEN_ENDE. 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: Notes: ------------------------------------------------------------------------------*/ DEF VAR cZellen AS CHAR NO-UNDO. DEF VAR cWerte AS CHAR 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'). RUN vpr_FlushGroup ('Fusstext'). RUN vpr_FlushGroup ('Ueberschrift'). END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-DRUCKEN_BESR) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DRUCKEN_BESR Procedure PROCEDURE DRUCKEN_BESR : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DEF INPUT PARAMETER ipDokument AS CHAR NO-UNDO. DEF VAR ix AS INT NO-UNDO. DEF VAR i1 AS INT NO-UNDO. DEF VAR cFeld AS CHAR NO-UNDO. DEF VAR cInhalt AS CHAR NO-UNDO. DEF VAR cVorlage AS CHAR NO-UNDO. DEF VAR iKopfZeile AS INT NO-UNDO. DEF VAR PZBetrag AS CHAR NO-UNDO. DEF VAR PZReferenz AS CHAR NO-UNDO. DEF VAR PZTNNummer AS CHAR NO-UNDO. DEF VAR cReferenz AS CHAR NO-UNDO. DEF BUFFER bViperDoc FOR ViperDoc. FIND FIRST tParam. FIND bViperDoc NO-LOCK WHERE bViperDoc.Firma = bSavko.Firma AND bViperDoc.Benutzer = '' AND bViperDoc.Formular = ipDokument AND bViperDoc.DokArt = 0 NO-ERROR. cVorlage = tParam.cInstall + '/' + ipDokument + '.vfr'. RUN vpr_LoadVFR (cVorlage). RUN vpr_ActivateReport (ipDokument). RUN vpr_SelectPrinter (bViperDoc.Drucker). RUN vpr_setPrinterAttrib('duplex=1'). RUN vpr_SetDocAttrib ("PAPERSIZE=A4"). RUN vpr_SetPrinterAttrib('copies=1'). RUN vpr_InitGroups (""). RUN vpr_initGraphObj. IF bViperDoc.Schacht_Besr > 0 THEN RUN vpr_SetCurrentPageProperties ( "Papertray", bViperDoc.Schacht_Besr ). RUN vpr_SetGroupAttrib ("ADRESSE", "Fixed=true"). RUN vpr_SetGroupAttrib ("BESR" , "Fixed=true"). FIND Adresse NO-LOCK USE-INDEX Adresse-k1 WHERE Adresse.Firma = AdFirma AND Adresse.Knr = bSavko.Fak_Knr NO-ERROR. iKopfZeile = 1. cBesrKopf = ''. IF bSavko.Adresse[05] <> '' THEN DO: i1 = 6. DO ix = 1 TO 5: CREATE tDokument. ASSIGN tDokument.cGruppe = 'ADRESSE' tDokument.iZeile = 1 tDokument.cFeld = 'Adresse_' + STRING((6 + ix),'99') tDokument.cInhalt = bSavko.Adresse[ix]. i1 = i1 + 1. cBesrKopf[i1] = bSavko.Adresse[ix]. END. END. ELSE DO: DO ix = 6 TO 11: CREATE tDokument. ASSIGN tDokument.cGruppe = 'ADRESSE' tDokument.iZeile = 1 tDokument.cFeld = 'Adresse_' + STRING(ix,'99') tDokument.cInhalt = Adresse.Anschrift[ix]. cBesrKopf[ix] = Adresse.Anschrift[ix]. END. END. DO ix = 6 TO 11: CREATE tDokument. ASSIGN tDokument.cGruppe = 'BESR' tDokument.iZeile = 1 tDokument.cFeld = 'Adresse_R_' + STRING(ix,'99') tDokument.cInhalt = cBesrKopf[ix]. IF ix < 7 THEN NEXT. CREATE tDokument. ASSIGN tDokument.cGruppe = 'BESR' tDokument.iZeile = 1 tDokument.cFeld = 'Adresse_L_' + STRING(ix,'99') tDokument.cInhalt = cBesrKopf[ix]. END. IF Rundbetr > 0.00 THEN DO: cFeld = STRING(Rundbetr,'zzzzzz9.99'). cFeld = REPLACE(cFeld, '.', ' '). cFeld = STRING(cFeld,'X X X X X X X X X X'). END. ELSE cFeld = ' . '. RUN VIPER_CREATE_DOKUMENT ( 'BESR', iKopfZeile, 'Betrag_L', cFeld ). RUN VIPER_CREATE_DOKUMENT ( 'BESR', iKopfZeile, 'Betrag_R', cFeld ). IF Rundbetr > 0 THEN PZBetrag = '01' + STRING(Rundbetr * 100,'9999999999 '). ELSE PZBetrag = ' 04 '. PZReferenz = '80401100000' + STRING(bSavko.Fak_Knr,'999999') + STRING(bSavko.Faknr ,'9999999') + '00'. PZTNNummer = '01007648'. RUN PRUEFZIFFER ( INPUT-OUTPUT PZBetrag, INPUT-OUTPUT PZReferenz, INPUT-OUTPUT PZTNNummer, OUTPUT cReferenz ). RUN VIPER_CREATE_DOKUMENT ( 'BESR', iKopfZeile, 'Referenz_OCRB', cReferenz ). RUN VIPER_CREATE_DOKUMENT ( 'BESR', iKopfZeile, 'Referenz_R', STRING(PZReferenz,'XX XXXXX XXXXX XXXXX XXXXX XXXXX') ). RUN VIPER_CREATE_DOKUMENT ( 'BESR', iKopfZeile, 'Referenz_L', STRING(PZReferenz,'XX XXXXX XXXXX XXXXX XXXXX XXXXX') ). RUN AUSGABE_GRUPPE ( 'ADRESSE' ). RUN AUSGABE_GRUPPE ( 'BESR' ). END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-DRUCKEN_ENDE) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DRUCKEN_ENDE Procedure PROCEDURE DRUCKEN_ENDE : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DEF VAR cPDFName AS CHAR INIT '' NO-UNDO. DEF VAR iSpace AS INT INIT 0 NO-UNDO. DEF VAR iPos AS INT NO-UNDO. DEF VAR iKopie AS INT NO-UNDO. DEF VAR ix AS INT NO-UNDO. DEF VAR iPageBesr AS INT NO-UNDO. DEF VAR lJa AS LOG NO-UNDO. DEF VAR cString AS CHAR NO-UNDO. FIND FIRST tParam. FIND FIRST tTotale. iPos = vpr_getPageVPos(). iArtZeile = 1. iSpace = iSpace + 40. RUN VIPER_CREATE_DOKUMENT ( 'Mehrwertsteuer', iArtZeile, 'MwstBez' , ' ' ). FIND FIRST tTotale. DO ix = 1 TO 11: IF tTotale.nMwstPfl[ix] = 0 THEN NEXT. tTotale.nSammTot = tTotale.nSammTot + tTotale.nMwstBet[ix]. FIND LAST MWSTAns USE-INDEX MWSTAns-k1 WHERE MWSTAns.MWST_Cd = ix AND MWSTAns.Datum <= bSavko.Kond_Datum NO-LOCK. iArtZeile = iArtZeile + 1. iSpace = iSpace + 40. RUN VIPER_CREATE_DOKUMENT ( 'Mehrwertsteuer', iArtZeile, 'MwstBez' , MWStAns.Bez ). RUN VIPER_CREATE_DOKUMENT ( 'Mehrwertsteuer', iArtZeile, 'MwstPfl' , TRIM(STRING(tTotale.nMwstPfl[ix],"->>>,>>9.99")) ). RUN VIPER_CREATE_DOKUMENT ( 'Mehrwertsteuer', iArtZeile, 'MwstBetr', TRIM(STRING(tTotale.nMwstBet[ix],"->>>,>>9.99")) ). RUN VIPER_CREATE_DOKUMENT ( 'Mehrwertsteuer', iArtZeile, 'MwstCd' , TRIM(STRING(ix ,">>9")) ). END. IF (iSpace + iPos + 80) >= iMaxPos THEN DO: RUN vpr_NewPage. RUN vpr_InitGroups(''). IF iAnzDok = iLauf THEN RUN vpr_initGraphObj. iSeite = iSeite + 1. RUN DRUCKEN_ADRESSE. END. RUN AUSGABE_GRUPPE ( 'Mehrwertsteuer' ). Rundbetr = tTotale.nSammTot. Rundcode = 1. RUN RUNDEN ( Rundcode, INPUT-OUTPUT Rundbetr ). tTotale.nSammTot = Rundbetr. iArtZeile = 1. RUN VIPER_CREATE_DOKUMENT ( 'RechnungsTotal', iArtZeile, 'EndBetrag' , TRIM(STRING(tTotale.nSammTot,"->,>>>,>>9.99")) ). RUN AUSGABE_GRUPPE ( 'RechnungsTotal' ). /* Rekap nach Umsatzgruppen ---------------------------------------- */ iArtZeile = 1. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1' , TRIM(SUBSTRING(cFormText[15],41,20)) ). FOR EACH TUmsGrp NO-LOCK BY TUmsGrp.Ums_Grp BY TUmsGrp.Mwst : iArtZeile = iArtZeile + 1. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1' , TUmsGrp.Bez ). RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Alk%' , BSteuer.Fwc03 ). RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Preis' , TRIM(STRING(TUmsGrp.Ums_Betr,"->>>,>>9.99")) ). RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', TRIM(STRING(TUmsGrp.Ansatz ,">9.99%")) ). RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'MC' , TRIM(STRING(TUmsGrp.Mwst ,"z9")) ). END. RUN AUSGABE_GRUPPE ( 'ArtikelZeile1' ). /* Zahlungskondition ------------------------------------------------- */ FIND Kondi NO-LOCK USE-INDEX Kondi-k1 WHERE Kondi.Kond = bSavko.Kond AND Kondi.Sprcd = iSprcd NO-ERROR. IF AVAILABLE Kondi THEN DO: iArtZeile = 1. RUN VIPER_CREATE_DOKUMENT ( 'Kondition', iArtZeile, 'Zahkond', Kondi.KoText ). RUN VIPER_CREATE_DOKUMENT ( 'Kondition', iArtZeile, 'Faellig', STRING((dFakDatum + Kondi.Faellig),"99.99.9999") ). IF Kondi.Skonto[01] <> 0 THEN DO: Rundbetr = tTotale.nSkBer * Kondi.Skonto[01] / 100. Rundcode = 1. RUN RUNDEN ( Rundcode, INPUT-OUTPUT Rundbetr ). RUN VIPER_CREATE_DOKUMENT ( 'Kondition', iArtZeile, 'Skonto', TRIM(STRING(Rundbetr,"->>>,>>9.99")) ). END. END. ELSE DO: iArtZeile = 1. RUN VIPER_CREATE_DOKUMENT ( 'Kondition', iArtZeile, 'Zahkond', FILL('?', 29) ). END. RUN VIPER_CREATE_DOKUMENT ( 'Kondition', iArtZeile, 'Netto', TRIM(STRING(tTotale.nSammTot,"->>>,>>9.99")) ). RUN AUSGABE_GRUPPE ( 'Kondition' ). nFakBetr = tTotale.nSammTot. IF nFakBetr = 0 THEN Rundbetr = -1. ELSE Rundbetr = nFakBetr. IF AVAILABLE Kondi AND Kondi.Skonto[01] <> 0 AND nFakBetr > 0 THEN Rundbetr = 0. IF iLauf < iAnzDok /* AND iDokumentStatus < 2 */ THEN DO: RUN vpr_EndDoc. IF tParam.lDokDruck THEN RUN vpr_printDoc (0, 0). RETURN. END. /* ------------------------------------------------------ */ /* Druckausgabe */ /* ------------------------------------------------------ */ cvpr_Dokument = SUBSTITUTE('Rechnungen\&1-&2_&3_Kopie.vpr', STRING(bSavko.Fak_Knr,'999999'), STRING(bSavko.Faknr ,'9999999'), tParam.cDokument). DO WHILE tParam.lDokDruck: SESSION:PRINTER-NAME = tParam.Drucker NO-ERROR. IF SESSION:PRINTER-NAME <> tParam.Drucker THEN DO: RUN vpr_printerDialog ( OUTPUT lJa ). IF NOT lJa THEN LEAVE. END. IF iDokumentStatus < 2 THEN DO: RUN vpr_printDoc (0, 0). END. /* BESR DRUCKEN ---------------------------- */ IF Rundbetr >= 0 THEN DO: RUN vpr_NewPage. RUN DRUCKEN_BESR ( 'BESR' ). END. RUN vpr_FetchPageNo ( OUTPUT iPageBesr ). RUN vpr_EndDoc. RUN vpr_SaveDoc ( cvpr_Dokument ). IF iDokumentStatus < 2 AND Rundbetr >= 0 THEN RUN vpr_printDoc (iPageBesr, iPageBesr). LEAVE. END. DO WHILE NOT tParam.lDokDruck: IF Rundbetr >= 0 THEN DO: RUN vpr_NewPage. RUN DRUCKEN_BESR ( 'BESR' ). END. RUN vpr_EndDoc. RUN vpr_SaveDoc ( cvpr_Dokument ). LEAVE. END. IF tParam.lCreatePDF OR iDokumentStatus > 0 THEN DO: cPDFName = REPLACE(cvpr_Dokument, '.vpr', '.pdf'). RUN vpr_openDoc ( cvpr_Dokument ). RUN vpr_printPDF (0, 0, INPUT-OUTPUT cPDFName ). END. IF tParam.lOpenPDF THEN DO: DEF VAR 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_KOPF) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DRUCKEN_KOPF Procedure PROCEDURE DRUCKEN_KOPF : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DEF VAR cString AS CHAR NO-UNDO. DEF VAR ii AS INT NO-UNDO. DEF VAR i1 AS INT NO-UNDO. DEF VAR iOldSeite AS INT NO-UNDO. FIND FIRST tParam. iOldSeite = iSeite. RUN VIPER_NEUE_SEITE. IF iSeite = 1 /* OR iSeite > iOldSeite */ THEN DO: cBesrKopf = ''. IF bSavko.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 = bSavko.Adresse[ii]. i1 = i1 + 1. cBesrKopf[i1] = bSavko.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 = 'Ort_Datum' tDokument.cInhalt = TRIM(SUBSTRING(cFormText[07],01,20)) + " " + STRING(dFakDatum,"99.99.9999"). CREATE tDokument. ASSIGN tDokument.cGruppe = 'KOPF' tDokument.iZeile = 1 tDokument.cFeld = 'T_Dokument' tDokument.cInhalt = (IF bSavko.Auf_Tot >= 0 THEN TRIM(SUBSTRING(cFormText[02],01,20)) ELSE TRIM(SUBSTRING(cFormText[02],21,20))). CREATE tDokument. ASSIGN tDokument.cGruppe = 'KOPF' tDokument.iZeile = 1 tDokument.cFeld = 'Aufnr' tDokument.cInhalt = STRING(bSavko.Faknr,'z999999'). CREATE tDokument. ASSIGN tDokument.cGruppe = 'KOPF' tDokument.iZeile = 1 tDokument.cFeld = 'Knr' tDokument.cInhalt = STRING(bSavko.Fak_Knr,'999999'). IF iDokumentStatus > 0 AND iLauf < iAnzDok THEN DO: CREATE tDokument. ASSIGN tDokument.cGruppe = 'KOPF' tDokument.iZeile = 1 tDokument.cFeld = 'PDF' tDokument.cInhalt = 'PDF-RECHNUNG'. END. END. IF iSeite > iOldSeite THEN RUN DRUCKEN_ADRESSE. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-FUELLEN_tSavze) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE FUELLEN_tSavze Procedure PROCEDURE FUELLEN_tSavze : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DEF INPUT PARAMETER ipAufnr AS INT NO-UNDO. DEF VAR minPos AS INT NO-UNDO. DEF VAR maxPos AS INT NO-UNDO. DEF VAR jPlatz AS INT NO-UNDO. DEF VAR cLagOrt AS CHAR NO-UNDO. DEF VAR iRuestArt AS INT NO-UNDO. DEF VAR iPlusMinus AS INT NO-UNDO. DEF VAR lArtikel AS LOG NO-UNDO. EMPTY TEMP-TABLE tSavze. FIND Steuer NO-LOCK WHERE Steuer.Firma = cFirma NO-ERROR. IF AVAILABLE Steuer THEN iRuestArt = Steuer.RuestArt. ASSIGN minPos = 0 maxPos = 9999 iPlusMinus = 0. /* Kommentar zu Beginn eines Auftrages */ lArtikel = FALSE. FOR EACH Savze NO-LOCK WHERE Savze.Firma = cFirma AND Savze.Aufnr = ipAufnr AND Savze.Pos > minPos: IF Savze.Artnr > 0 THEN DO: lArtikel = TRUE. LEAVE. END. minPos = Savze.Pos. CREATE tSavze. ASSIGN tSavze.Aufnr = Savze.Aufnr tSavze.Artnr = Savze.Artnr tSavze.Inhalt = Savze.Inhalt tSavze.Jahr = Savze.Jahr tSavze.Pos = Savze.Pos tSavze.Zeile = RECID(Savze) tSavze.Aktion = Savze.Aktion tSavze.Preis = Savze.Preis tSavze.MGeli = Savze.MGeli tSavze.MRuek = Savze.MRuek. ASSIGN tSavze.Sort1 = STRING(0,'99') tSavze.Sort2 = '' tSavze.Sort3 = STRING(tSavze.Artnr ,'999999') + STRING(tSavze.Inhalt,'9999') + STRING(tSavze.Jahr ,'9999') + STRING(iPlusMinus ,'9') + STRING(tSavze.Pos ,'9999'). tSavze.LagOrt = ''. END. /* Kommentar am Ende eines Auftrages */ IF lArtikel THEN DO: FOR EACH Savze NO-LOCK WHERE Savze.Firma = cFirma AND Savze.Aufnr = ipAufnr BY Savze.Pos DESCENDING: IF Savze.Artnr > 0 THEN LEAVE. maxPos = Savze.Pos. CREATE tSavze. ASSIGN tSavze.Aufnr = Savze.Aufnr tSavze.Artnr = Savze.Artnr tSavze.Inhalt = Savze.Inhalt tSavze.Jahr = Savze.Jahr tSavze.Pos = Savze.Pos tSavze.Zeile = RECID(Savze) tSavze.Aktion = Savze.Aktion tSavze.Preis = Savze.Preis tSavze.MGeli = Savze.MGeli tSavze.MRuek = Savze.MRuek. ASSIGN tSavze.Sort1 = STRING(0,'99') tSavze.Sort2 = '' tSavze.Sort3 = STRING(tSavze.Artnr ,'999999') + STRING(tSavze.Inhalt,'9999') + STRING(tSavze.Jahr ,'9999') + STRING(iPlusMinus ,'9') + STRING(tSavze.Pos ,'9999'). tSavze.LagOrt = ''. END. END. /* Artikelzeilen nach Ruestplatz und Ort */ cLagOrt = ''. FOR EACH Savze NO-LOCK WHERE Savze.Firma = cFirma AND Savze.Aufnr = ipAufnr AND Savze.Pos > minPos AND Savze.Pos < MaxPos BY Savze.Pos DESCENDING: IF Savze.Artnr > 0 THEN DO: FIND ArtLager NO-LOCK WHERE ArtLager.Firma = Savze.Firma AND ArtLager.Artnr = Savze.Artnr AND ArtLager.Inhalt = Savze.Inhalt AND ArtLager.Jahr = Savze.Jahr AND ArtLager.Lager = Savze.Lager. cLagOrt = ArtLager.Ort. END. iPlusMinus = (IF Savze.MGeli < 0 THEN 1 ELSE 0). FIND LAST RuestPlatz USE-INDEX RuestPlatz-k2 WHERE RuestPlatz.Firma = Savze.Firma AND RuestPlatz.RuestArt = iRuestArt AND RuestPlatz.abLagOrt <= cLagOrt NO-ERROR. IF NOT AVAILABLE RuestPlatz THEN jPlatz = 90. ELSE jPlatz = RuestPlatz.Platz. CREATE tSavze. ASSIGN tSavze.Aufnr = Savze.Aufnr tSavze.Artnr = Savze.Artnr tSavze.Inhalt = Savze.Inhalt tSavze.Jahr = Savze.Jahr tSavze.Pos = Savze.Pos tSavze.Zeile = RECID(Savze) tSavze.Aktion = Savze.Aktion tSavze.Preis = Savze.Preis tSavze.MGeli = Savze.MGeli tSavze.MRuek = Savze.MRuek. ASSIGN tSavze.Sort1 = STRING(jPlatz,'99') tSavze.Sort2 = cLagOrt tSavze.Sort3 = STRING(tSavze.Artnr ,'999999') + STRING(tSavze.Inhalt,'9999') + STRING(tSavze.Jahr ,'9999') + STRING(iPlusMinus ,'9') + STRING(tSavze.Pos ,'9999'). tSavze.LagOrt = cLagort. IF tSavze.Artnr > 0 AND tSavze.MGeli = 0 THEN DELETE tSavze. END. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-OPEN_PDF) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE OPEN_PDF Procedure PROCEDURE OPEN_PDF : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DEF INPUT PARAMETER ipDocument AS CHAR NO-UNDO. DEF VAR o-i AS i NO-UNDO. FILE-INFO:FILE-NAME = ipDocument. ipDocument = FILE-INFO:FULL-PATHNAME. RUN ShellExecuteA (0, "open", ipDocument, "", "", 0, OUTPUT o-i). END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-PRUEFZIFFER) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE PRUEFZIFFER Procedure PROCEDURE PRUEFZIFFER : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ /* ------------------------------------------------------------------------- */ /* Prufziffer MODULO 10, Rekursiv (27 Stellig Ref.-Nr.) */ /* ------------------------------------------------------------------------- */ /* */ /* Uebergabe Variable: 1. String Betrag (12-stellig) */ /* 2. String Referenz (27-stellig) */ /* 3. String Teilnehmernummer ( 9-stellig) */ /* */ /* Erstellung der VESR-Codierzeile */ /* */ /*---------------------------------------------------------------------------*/ DEF INPUT-OUTPUT PARAMETER PZBetrag AS CHAR FORMAT "x(13)". DEF INPUT-OUTPUT PARAMETER PZReferenz AS CHAR FORMAT "x(27)". DEF INPUT-OUTPUT PARAMETER PZTNummer AS CHAR FORMAT "x(09)". DEF OUTPUT PARAMETER VSZeile AS CHAR FORMAT "x(58)". DEF VAR l1 AS INT. DEF VAR l2 AS INT. DEF VAR l3 AS INT. DEF VAR PZ AS INT. DEF VAR x1 AS INT. DEF VAR x2 AS INT. DEF VAR x3 AS INT. DEF VAR VMOD10 AS CHAR FORMAT "x(11)" EXTENT 11. VMOD10[01] = "09468271350". VMOD10[02] = "94682713509". VMOD10[03] = "46827135098". VMOD10[04] = "68271350947". VMOD10[05] = "82713509466". VMOD10[06] = "27135094685". VMOD10[07] = "71350946824". VMOD10[08] = "13509468273". VMOD10[09] = "35094682712". VMOD10[10] = "50946827131". l1 = 12. l2 = 26. l3 = 08. DO WHILE SUBSTRING(PZBetrag,01,01) <> " ": /* Mit Betrag */ x2 = 1. x1 = INT(SUBSTRING(PZBetrag ,01 ,01)). x2 = INT(SUBSTRING(VMOD10[x2],x1 + 1,01)). DO x3 = 2 TO 12: x1 = INT(SUBSTRING(PZBetrag ,x3 ,01)). x2 = INT(SUBSTRING(VMOD10[x2 + 1],x1 + 1,01)). END. PZ = INT(SUBSTRING(VMOD10[x2 + 1],11,1)). SUBSTRING(PZBetrag,13) = STRING(PZ,"9"). LEAVE. END. DO WHILE SUBSTRING(PZBetrag,01,01) = " ": /* Ohne Betrag */ x2 = 11. x1 = INT(SUBSTRING(PZBetrag ,11 ,01)). x2 = INT(SUBSTRING(VMOD10[x2],x1 + 1,01)). DO x3 = 12 TO 12: x1 = INT(SUBSTRING(PZBetrag ,x3 ,01)). x2 = INT(SUBSTRING(VMOD10[x2 + 1],x1 + 1,01)). END. PZ = INT(SUBSTRING(VMOD10[x2 + 1],11,1)). SUBSTRING(PZBetrag,13) = STRING(PZ,"9"). LEAVE. END. DO WHILE l2 = 26: x2 = 1. x1 = INT(SUBSTRING(PZReferenz,01 ,01)). x2 = INT(SUBSTRING(VMOD10[x2],x1 + 1,01)). DO x3 = 2 TO 26: x1 = INT(SUBSTRING(PZReferenz ,x3 ,01)). x2 = INT(SUBSTRING(VMOD10[x2 + 1],x1 + 1,01)). END. PZ = INT(SUBSTRING(VMOD10[x2 + 1],11,1)). SUBSTRING(PZReferenz,27) = STRING(PZ,"9"). LEAVE. END. DO WHILE l3 = 08: x2 = 1. x1 = INT(SUBSTRING(PZTNummer ,01 ,01)). x2 = INT(SUBSTRING(VMOD10[x2],x1 + 1,01)). DO x3 = 2 TO 08: x1 = INT(SUBSTRING(PZTNummer ,x3 ,01)). x2 = INT(SUBSTRING(VMOD10[x2 + 1],x1 + 1,01)). END. PZ = INT(SUBSTRING(VMOD10[x2 + 1],11,1)). SUBSTRING(PZTNummer,09) = STRING(PZ,"9"). LEAVE. END. VSZeile = "". SUBSTRING(VSZeile,01) = PZBetrag. SUBSTRING(VSZeile,14) = ">". SUBSTRING(VSZeile,15) = PZReferenz. SUBSTRING(VSZeile,42) = "+ ". SUBSTRING(VSZeile,44) = PZTNummer. SUBSTRING(VSZeile,53) = ">". /* SUBSTRING(VSZeile,58) = "H". */ 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: Notes: ------------------------------------------------------------------------------*/ DEF INPUT PARAMETER ipGruppe AS CHAR NO-UNDO. DEF INPUT PARAMETER ipZeile AS INT NO-UNDO. DEF INPUT PARAMETER ipFeld AS CHAR NO-UNDO. DEF INPUT PARAMETER ipInhalt AS CHAR 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: Notes: ------------------------------------------------------------------------------*/ DEF VAR cTemplate AS CHAR NO-UNDO. DEF VAR cDokument AS CHAR NO-UNDO. DEF VAR cZellen AS CHAR NO-UNDO. DEF VAR cZelle AS CHAR NO-UNDO. DEF VAR cGruppe AS CHAR NO-UNDO. DEF VAR ii AS INT NO-UNDO. DEF VAR lInit AS LOG INIT TRUE NO-UNDO. FIND FIRST tParam. /* IF iLauf > 1 THEN lInit = FALSE. */ /* IF iDokumentStatus > 1 THEN lInit = TRUE. */ IF lInit THEN DO: IF iLauf = 1 THEN DO: cTemplate = tParam.cInstall + '/' + tParam.cDokument + '.vfr'. RUN vpr_LoadVFR (cTemplate). RUN vpr_ActivateReport (tParam.cDokument). END. RUN vpr_ResetDoc. RUN vpr_SelectPrinter (tParam.Drucker). RUN vpr_setPrinterAttrib('duplex=1'). RUN vpr_SetPrinterAttrib('copies=1'). 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(""). IF iLauf = iAnzDok THEN RUN vpr_InitGraphObj. RUN vpr_SetGroupAttrib ("Kopf" , "Fixed=true"). RUN vpr_SetGroupAttrib ("Fusstext" , "Fixed=true"). RUN vpr_SetGroupAttrib ("Kondition", "Fixed=true"). iMaxPos = 2600. 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: Notes: ------------------------------------------------------------------------------*/ DEF VAR iPos AS INT NO-UNDO. FIND FIRST tParam. DO WHILE TRUE: IF iSeite = 0 THEN DO: RUN vpr_InitGroups(''). IF iLauf = iAnzDok THEN RUN vpr_initGraphObj. iSeite = iSeite + 1. LEAVE. END. iPos = vpr_getPageVPos(). IF (iPos + 160) < iMaxPos THEN DO: iPos = iPos + 20. RUN vpr_setPageVPos ( iPos ). LEAVE. END. RUN vpr_NewPage. RUN vpr_InitGroups(''). IF iLauf = 1 THEN RUN vpr_SetCurrentPageProperties ( "Papertray", tParam.Schacht_Original ). ELSE RUN vpr_SetCurrentPageProperties ( "Papertray", tParam.Schacht_Kopie ). IF iLauf = iAnzDok THEN RUN vpr_initGraphObj. iSeite = iSeite + 1. LEAVE. END. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF /* ************************ Function Implementations ***************** */ &IF DEFINED(EXCLUDE-getPDFDocument) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getPDFDocument Procedure FUNCTION getPDFDocument RETURNS CHARACTER ( ipAufnr AS INT ) : /*------------------------------------------------------------------------------ Purpose: Notes: ------------------------------------------------------------------------------*/ DEF VAR cDokument AS CHAR NO-UNDO. DEF BUFFER xSavko FOR Savko. FIND xSavko NO-LOCK WHERE xSavko.Firma = Firma AND xSavko.Aufnr = ipAufnr NO-ERROR. IF NOT AVAILABLE xSavko THEN RETURN ''. FIND FIRST tParam. cDokument = SUBSTITUTE('Rechnungen/&1-&2_&3_Kopie.pdf', STRING(xSavko.Knr ,'999999'), STRING(xSavko.Faknr,'9999999'), tParam.cDokument). FILE-INFO:FILE-NAME = cDokument. IF FILE-INFO:FULL-PATHNAME <> ? AND FILE-INFO:FULL-PATHNAME <> '' THEN RETURN FILE-INFO:FULL-PATHNAME. cDokument = SUBSTITUTE('Rechnungen/&1-&2_&3_Kopie.pdf', STRING(xSavko.Fak_Knr,'999999'), STRING(xSavko.Faknr ,'9999999'), tParam.cDokument). FILE-INFO:FILE-NAME = cDokument. IF FILE-INFO:FULL-PATHNAME <> ? AND FILE-INFO:FULL-PATHNAME <> '' THEN RETURN FILE-INFO:FULL-PATHNAME. cDokument = SUBSTITUTE('Rechnungen/&1-&2_&3_Kopie.pdf', STRING(xSavko.Knr ,'999999'), STRING(xSavko.Aufnr,'9999999'), tParam.cDokument). FILE-INFO:FILE-NAME = cDokument. IF FILE-INFO:FULL-PATHNAME <> ? AND FILE-INFO:FULL-PATHNAME <> '' THEN RETURN FILE-INFO:FULL-PATHNAME. cDokument = SUBSTITUTE('Rechnungen/&1-&2_&3_Kopie.pdf', STRING(xSavko.Fak_Knr,'999999'), STRING(xSavko.Aufnr ,'9999999'), tParam.cDokument). FILE-INFO:FILE-NAME = cDokument. IF FILE-INFO:FULL-PATHNAME <> ? AND FILE-INFO:FULL-PATHNAME <> '' THEN RETURN FILE-INFO:FULL-PATHNAME. IF xSavko.Faknr < 1000000 THEN DO: cDokument = SUBSTITUTE('Rechnungen/&1-&2_&3_Kopie.pdf', STRING(xSavko.Knr ,'999999'), STRING(xSavko.Faknr,'999999'), tParam.cDokument). FILE-INFO:FILE-NAME = cDokument. IF FILE-INFO:FULL-PATHNAME <> ? AND FILE-INFO:FULL-PATHNAME <> '' THEN RETURN FILE-INFO:FULL-PATHNAME. cDokument = SUBSTITUTE('Rechnungen/&1-&2_&3_Kopie.pdf', STRING(xSavko.Fak_Knr,'999999'), STRING(xSavko.Faknr ,'999999'), tParam.cDokument). FILE-INFO:FILE-NAME = cDokument. IF FILE-INFO:FULL-PATHNAME <> ? AND FILE-INFO:FULL-PATHNAME <> '' THEN RETURN FILE-INFO:FULL-PATHNAME. END. IF xSavko.Aufnr < 1000000 THEN DO: cDokument = SUBSTITUTE('Rechnungen/&1-&2_&3_Kopie.pdf', STRING(xSavko.Knr ,'999999'), STRING(xSavko.Aufnr,'999999'), tParam.cDokument). FILE-INFO:FILE-NAME = cDokument. IF FILE-INFO:FULL-PATHNAME <> ? AND FILE-INFO:FULL-PATHNAME <> '' THEN RETURN FILE-INFO:FULL-PATHNAME. cDokument = SUBSTITUTE('Rechnungen/&1-&2_&3_Kopie.pdf', STRING(xSavko.Fak_Knr,'999999'), STRING(xSavko.Aufnr ,'999999'), tParam.cDokument). FILE-INFO:FILE-NAME = cDokument. IF FILE-INFO:FULL-PATHNAME <> ? AND FILE-INFO:FULL-PATHNAME <> '' THEN RETURN FILE-INFO:FULL-PATHNAME. END. RETURN "". /* Function return value. */ END FUNCTION. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-getVPRDocument) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getVPRDocument Procedure FUNCTION getVPRDocument RETURNS CHARACTER ( ipAufnr AS INT ) : /*------------------------------------------------------------------------------ Purpose: Notes: ------------------------------------------------------------------------------*/ DEF VAR cDokument AS CHAR NO-UNDO. DEF BUFFER xSavko FOR Savko. FIND xSavko NO-LOCK WHERE xSavko.Firma = Firma AND xSavko.Aufnr = ipAufnr NO-ERROR. IF NOT AVAILABLE xSavko THEN RETURN ''. FIND FIRST tParam. cDokument = SUBSTITUTE('Rechnungen/&1-&2_&3_Kopie.vpr', STRING(xSavko.Knr ,'999999'), STRING(xSavko.Faknr,'9999999'), tParam.cDokument). FILE-INFO:FILE-NAME = cDokument. IF FILE-INFO:FULL-PATHNAME <> ? AND FILE-INFO:FULL-PATHNAME <> '' THEN RETURN FILE-INFO:FULL-PATHNAME. cDokument = SUBSTITUTE('Rechnungen/&1-&2_&3_Kopie.vpr', STRING(xSavko.Fak_Knr,'999999'), STRING(xSavko.Faknr ,'9999999'), tParam.cDokument). FILE-INFO:FILE-NAME = cDokument. IF FILE-INFO:FULL-PATHNAME <> ? AND FILE-INFO:FULL-PATHNAME <> '' THEN RETURN FILE-INFO:FULL-PATHNAME. cDokument = SUBSTITUTE('Rechnungen/&1-&2_&3_Kopie.vpr', STRING(xSavko.Knr ,'999999'), STRING(xSavko.Aufnr,'9999999'), tParam.cDokument). FILE-INFO:FILE-NAME = cDokument. IF FILE-INFO:FULL-PATHNAME <> ? AND FILE-INFO:FULL-PATHNAME <> '' THEN RETURN FILE-INFO:FULL-PATHNAME. cDokument = SUBSTITUTE('Rechnungen/&1-&2_&3_Kopie.vpr', STRING(xSavko.Fak_Knr,'999999'), STRING(xSavko.Aufnr ,'9999999'), tParam.cDokument). FILE-INFO:FILE-NAME = cDokument. IF FILE-INFO:FULL-PATHNAME <> ? AND FILE-INFO:FULL-PATHNAME <> '' THEN RETURN FILE-INFO:FULL-PATHNAME. IF xSavko.Faknr < 1000000 THEN DO: cDokument = SUBSTITUTE('Rechnungen/&1-&2_&3_Kopie.vpr', STRING(xSavko.Knr ,'999999'), STRING(xSavko.Faknr,'999999'), tParam.cDokument). FILE-INFO:FILE-NAME = cDokument. IF FILE-INFO:FULL-PATHNAME <> ? AND FILE-INFO:FULL-PATHNAME <> '' THEN RETURN FILE-INFO:FULL-PATHNAME. cDokument = SUBSTITUTE('Rechnungen/&1-&2_&3_Kopie.vpr', STRING(xSavko.Fak_Knr,'999999'), STRING(xSavko.Faknr ,'999999'), tParam.cDokument). FILE-INFO:FILE-NAME = cDokument. IF FILE-INFO:FULL-PATHNAME <> ? AND FILE-INFO:FULL-PATHNAME <> '' THEN RETURN FILE-INFO:FULL-PATHNAME. END. IF xSavko.Aufnr < 1000000 THEN DO: cDokument = SUBSTITUTE('Rechnungen/&1-&2_&3_Kopie.vpr', STRING(xSavko.Knr ,'999999'), STRING(xSavko.Aufnr,'999999'), tParam.cDokument). FILE-INFO:FILE-NAME = cDokument. IF FILE-INFO:FULL-PATHNAME <> ? AND FILE-INFO:FULL-PATHNAME <> '' THEN RETURN FILE-INFO:FULL-PATHNAME. cDokument = SUBSTITUTE('Rechnungen/&1-&2_&3_Kopie.vpr', STRING(xSavko.Fak_Knr,'999999'), STRING(xSavko.Aufnr ,'999999'), tParam.cDokument). FILE-INFO:FILE-NAME = cDokument. IF FILE-INFO:FULL-PATHNAME <> ? AND FILE-INFO:FULL-PATHNAME <> '' THEN RETURN FILE-INFO:FULL-PATHNAME. END. RETURN "". /* Function return value. */ END FUNCTION. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF