&ANALYZE-SUSPEND _VERSION-NUMBER AB_v10r12 GUI ADM2 &ANALYZE-RESUME &Scoped-define WINDOW-NAME wretouren {adecomm/appserv.i} &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS wretouren /*------------------------------------------------------------------------ File: Description: from cntnrwin.w - ADM SmartWindow Template Input Parameters: Output Parameters: History: New V9 Version - January 15, 1998 ------------------------------------------------------------------------*/ /* This .W file was created with the Progress AB. */ /*----------------------------------------------------------------------*/ /* Create an unnamed pool to store all the widgets created by this procedure. This is a good default which assures that this procedure's triggers and internal procedures will execute in this procedure's storage, and that proper cleanup will occur on deletion of the procedure. */ CREATE WIDGET-POOL. /* *************************** Definitions ************************** */ /* Parameters Definitions --- */ /* Local Variable Definitions --- */ DEF VAR cUser AS CHAR NO-UNDO. DEF VAR iBeg AS INT NO-UNDO. DEF VAR iArtnr AS INT NO-UNDO. DEF VAR iInhalt AS INT NO-UNDO. DEF VAR iJahr AS INT NO-UNDO. DEF VAR iKGeb_Me AS INT NO-UNDO. DEF VAR iVGeb_Me AS INT NO-UNDO. DEF VAR iGGeb_Me AS INT NO-UNDO. DEF VAR lBatch AS LOG NO-UNDO. DEF VAR cLogName AS CHAR NO-UNDO. DEF TEMP-TABLE tAufko LIKE Aufko. DEF TEMP-TABLE tAufze LIKE Aufze. DEF VAR htAufze AS HANDLE NO-UNDO. htAufze = TEMP-TABLE tAufze:DEFAULT-BUFFER-HANDLE. DEF STREAM Out_Stream. DEF STREAM LogStream. { incl/windefinition.i } { incl/ttdruckparam.i } {src/adm2/widgetprto.i} /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK /* ******************** Preprocessor Definitions ******************** */ &Scoped-define PROCEDURE-TYPE SmartWindow &Scoped-define DB-AWARE no &Scoped-define ADM-CONTAINER WINDOW &Scoped-define ADM-SUPPORTED-LINKS Data-Target,Data-Source,Page-Target,Update-Source,Update-Target,Filter-target,Filter-Source /* Name of designated FRAME-NAME and/or first browse and/or first query */ &Scoped-define FRAME-NAME fMain /* Standard List Definitions */ &Scoped-Define ENABLED-OBJECTS F_Status /* Custom List Definitions */ /* List-1,List-2,List-3,List-4,List-5,List-6 */ /* _UIB-PREPROCESSOR-BLOCK-END */ &ANALYZE-RESUME /* ************************ Function Prototypes ********************** */ &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD calculateAufGebKo wretouren FUNCTION calculateAufGebKo RETURNS LOGICAL ( ipRecid AS RECID, ipMenge AS INT ) FORWARD. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getDruckProgramm wretouren FUNCTION getDruckProgramm RETURNS CHARACTER ( /* parameter-definitions */ ) FORWARD. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getLogName wretouren FUNCTION getLogName RETURNS CHARACTER ( /* parameter-definitions */ ) FORWARD. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getProgname wretouren FUNCTION getProgname RETURNS CHARACTER ( /* parameter-definitions */ ) FORWARD. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD writeLogFile wretouren FUNCTION writeLogFile RETURNS LOGICAL ( ipMessage AS CHAR ) FORWARD. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME /* *********************** Control Definitions ********************** */ /* Define the widget handle for the window */ DEFINE VAR wretouren AS WIDGET-HANDLE NO-UNDO. /* Definitions of the field level widgets */ DEFINE VARIABLE F_Status AS CHARACTER FORMAT "X(256)":U LABEL "Status" VIEW-AS FILL-IN NATIVE SIZE 65 BY 1 BGCOLOR 15 FONT 6 NO-UNDO. /* ************************ Frame Definitions *********************** */ DEFINE FRAME fMain F_Status AT ROW 2.57 COL 12 COLON-ALIGNED WIDGET-ID 2 NO-TAB-STOP WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY SIDE-LABELS NO-UNDERLINE THREE-D AT COL 1 ROW 1 SIZE 85.4 BY 5.52 WIDGET-ID 100. /* *********************** Procedure Settings ************************ */ &ANALYZE-SUSPEND _PROCEDURE-SETTINGS /* Settings for THIS-PROCEDURE Type: SmartWindow Allow: Basic,Browse,DB-Fields,Query,Smart,Window Container Links: Data-Target,Data-Source,Page-Target,Update-Source,Update-Target,Filter-target,Filter-Source Other Settings: COMPILE APPSERVER */ &ANALYZE-RESUME _END-PROCEDURE-SETTINGS /* ************************* Create Window ************************** */ &ANALYZE-SUSPEND _CREATE-WINDOW IF SESSION:DISPLAY-TYPE = "GUI":U THEN CREATE WINDOW wretouren ASSIGN HIDDEN = YES TITLE = "Retouren" HEIGHT = 5.52 WIDTH = 85.4 MAX-HEIGHT = 30.48 MAX-WIDTH = 160 VIRTUAL-HEIGHT = 30.48 VIRTUAL-WIDTH = 160 RESIZE = no SCROLL-BARS = no STATUS-AREA = no BGCOLOR = ? FGCOLOR = ? THREE-D = yes MESSAGE-AREA = no SENSITIVE = yes. ELSE {&WINDOW-NAME} = CURRENT-WINDOW. &IF '{&WINDOW-SYSTEM}' NE 'TTY' &THEN IF NOT wretouren:LOAD-ICON("grafik/appl.ico":U) THEN MESSAGE "Unable to load icon: grafik/appl.ico" VIEW-AS ALERT-BOX WARNING BUTTONS OK. &ENDIF /* END WINDOW DEFINITION */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB wretouren /* ************************* Included-Libraries *********************** */ {src/adm2/containr.i} /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME /* *********** Runtime Attributes and AppBuilder Settings *********** */ &ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES /* SETTINGS FOR WINDOW wretouren VISIBLE,,RUN-PERSISTENT */ /* SETTINGS FOR FRAME fMain FRAME-NAME */ /* SETTINGS FOR FILL-IN F_Status IN FRAME fMain NO-DISPLAY */ ASSIGN F_Status:READ-ONLY IN FRAME fMain = TRUE. IF SESSION:DISPLAY-TYPE = "GUI":U AND VALID-HANDLE(wretouren) THEN wretouren:HIDDEN = yes. /* _RUN-TIME-ATTRIBUTES-END */ &ANALYZE-RESUME /* ************************ Control Triggers ************************ */ &Scoped-define SELF-NAME wretouren &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL wretouren wretouren ON WINDOW-CLOSE OF wretouren /* Retouren */ DO: /* This ADM code must be left here in order for the SmartWindow and its descendents to terminate properly on exit. */ DEF VAR cMeldung AS CHAR NO-UNDO. DEF VAR ja AS LOG NO-UNDO. RUN ENDE. RETURN NO-APPLY. END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &UNDEFINE SELF-NAME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK wretouren /* *************************** Main Block *************************** */ DEF VAR iTime AS INT NO-UNDO. DEF VAR iRecId AS RECID NO-UNDO. DEF VAR cRetVal AS CHAR NO-UNDO. DEF VAR iTrnr AS INT INIT 0 NO-UNDO. DEF VAR iWoTag AS INT NO-UNDO. DEF VAR iHH AS INT NO-UNDO. DEF VAR cMessage AS CHAR NO-UNDO. DEF VAR iAblauf AS INT NO-UNDO. { incl/winmainblock.i } ASSIGN CURRENT-WINDOW = {&WINDOW-NAME} {&WINDOW-NAME}:KEEP-FRAME-Z-ORDER = YES THIS-PROCEDURE:CURRENT-WINDOW = {&WINDOW-NAME}. cUser = DYNAMIC-FUNCTION('getBenutzer') NO-ERROR. cLogName = DYNAMIC-FUNCTION('getLogName':U) NO-ERROR. lBatch = DYNAMIC-FUNCTION('getBatch':U) NO-ERROR. cMessage = SUBSTITUTE('Programm &1 gestartet', ProgName). DYNAMIC-FUNCTION('writeLogFile':U, cMessage) NO-ERROR. RUN createObjects. RUN initializeObject. iBeg = TIME. iTime = ETIME(TRUE). iTrnr = -1. MAIN-BLOCK: REPEAT WITH FRAME {&FRAME-NAME} ON ERROR UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK ON QUIT UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK : IF (TIME - iBeg) >= 285 THEN RUN ENDE. /* ordentliches beenden nach 4min 45sek */ F_Status:SCREEN-VALUE = 'warten auf Auftrag'. FIND FIRST ASMutation NO-lOCK USE-INDEX ASMutation-k2 WHERE ASMutation.Aktiv = TRUE AND ASMutation.asmutation_id > iTrnr AND ASMutation.cStatus = '' NO-ERROR. IF NOT AVAILABLE ASMutation THEN DO: iTrnr = -1. WAIT-FOR WINDOW-CLOSE OF THIS-PROCEDURE PAUSE 2. APPLY LASTKEY TO THIS-PROCEDURE. NEXT MAIN-BLOCK. END. iTime = ETIME(TRUE). iTrnr = ASMutation.asmutation_id. iRecid = RECID(ASMutation). F_Status:SCREEN-VALUE = 'Verarbeiten -> ' + ASMutation.MutArt. IF NOT ASMutation.MutArt BEGINS 'RETOUREN' THEN NEXT. REPEAT TRANSACTION: FIND ASMutation EXCLUSIVE-LOCK WHERE RECID(ASMutation) = iRecid NO-WAIT NO-ERROR. IF NOT AVAILABLE ASMutation AND LOCKED ASMutation THEN NEXT MAIN-BLOCK. ASSIGN ASMutation.cStatus = 'A'. RELEASE ASMutation. LEAVE. END. cRetVal = ''. EMPTY TEMP-TABLE tAufko. EMPTY TEMP-TABLE tAufze. FIND ASMutation NO-LOCK WHERE RECID(ASMutation) = iRecid. CASE ASMutation.MutArt: WHEN 'RETOUREN' THEN RUN CREATE_RETOUREN_AUFZE ( iRecid ). WHEN 'RETOURENGEBINDE' THEN RUN CREATE_RETOUREN_GEBINDE ( iRecid ). WHEN 'RETOURENENDE' THEN RUN CREATE_RETOUREN_ENDE ( iRecid ). END CASE. cRetVal = RETURN-VALUE. RUN viewObject. IF cRetVal BEGINS 'ERROR' THEN DO: IF lBatch THEN DO: cMessage = SUBSTITUTE('Fehler &1 bei Retouren von &2', ENTRY(2, cRetVal, ';'), ASMutation.MutArt). DYNAMIC-FUNCTION('writeLogFile':U, cMessage) NO-ERROR. END. F_Status:SCREEN-VALUE = ASMutation.MutArt + ' -> ' + ENTRY(2, cRetVal, ';'). PAUSE 10 NO-MESSAGE. iAblauf = 0. REPEAT TRANSACTION: FIND ASMutation EXCLUSIVE-LOCK WHERE RECID(ASMutation) = iRecid NO-WAIT NO-ERROR. IF NOT AVAILABLE ASMutation AND LOCKED ASMutation THEN DO: PAUSE 1 NO-MESSAGE. iAblauf = iAblauf + 1. IF iAblauf >= 10 THEN LEAVE. NEXT. END. ASSIGN ASMutation.cStatus = ''. RELEASE ASMutation. LEAVE. END. WAIT-FOR WINDOW-CLOSE OF THIS-PROCEDURE PAUSE 1. APPLY LASTKEY TO THIS-PROCEDURE. NEXT MAIN-BLOCK. END. ELSE DO: iAblauf = 0. REPEAT TRANSACTION: FIND ASMutation EXCLUSIVE-LOCK WHERE RECID(ASMutation) = iRecid NO-WAIT NO-ERROR. IF NOT AVAILABLE ASMutation AND LOCKED ASMutation THEN DO: PAUSE 1 NO-MESSAGE. iAblauf = iAblauf + 1. IF iAblauf >= 10 THEN LEAVE. NEXT. END. ASSIGN ASMutation.cStatus = 'E' ASMutation.Aktiv = FALSE. RELEASE ASMutation. LEAVE. END. END. WAIT-FOR WINDOW-CLOSE OF THIS-PROCEDURE PAUSE 1. APPLY LASTKEY TO THIS-PROCEDURE. END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME /* ********************** Internal Procedures *********************** */ &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE adm-create-objects wretouren _ADM-CREATE-OBJECTS PROCEDURE adm-create-objects : /*------------------------------------------------------------------------------ Purpose: Create handles for all SmartObjects used in this procedure. After SmartObjects are initialized, then SmartLinks are added. Parameters: ------------------------------------------------------------------------------*/ END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE CREATE_RETOUREN_AUFZE wretouren PROCEDURE CREATE_RETOUREN_AUFZE : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DEF INPUT PARAMETER ipRecid AS RECID NO-UNDO. DEF VAR cRuester AS CHAR NO-UNDO. DEF VAR iAufnr AS INT NO-UNDO. DEF VAR iPos AS INT NO-UNDO. DEF VAR iRecid AS RECID NO-UNDO. DEF VAR ix AS INT NO-UNDO. DEF VAR nTotale AS DEC EXTENT 15 NO-UNDO. DEF VAR cFirma AS CHAR NO-UNDO. DEF VAR cMessage AS CHAR NO-UNDO. DEF BUFFER bAufze FOR Aufze . DEF BUFFER bAufko FOR Aufko . FIND ASMutation NO-LOCK WHERE RECID(ASMutation) = ipRecid. ASSIGN cRuester = ASMutation.cFeld_2 iAufnr = ASMutation.iKey_1 cFirma = ASMutation.Firma. FIND Aufko NO-LOCK USE-INDEX Aufko-k1 WHERE Aufko.Firma = cFirma AND Aufko.Aufnr = iAufnr NO-ERROR. IF NOT AVAILABLE Aufko THEN RETURN ''. DO ix = 1 TO NUM-ENTRIES(ASMutation.cFeld_1, ';'): CASE ix: WHEN 1 THEN iArtnr = INTEGER(ENTRY(ix, ASMutation.cFeld_1, ';')). WHEN 2 THEN iInhalt = INTEGER(ENTRY(ix, ASMutation.cFeld_1, ';')). WHEN 3 THEN iJahr = INTEGER(ENTRY(ix, ASMutation.cFeld_1, ';')). WHEN 4 THEN iKGeb_Me = INTEGER(ENTRY(ix, ASMutation.cFeld_1, ';')). WHEN 5 THEN iVGeb_Me = INTEGER(ENTRY(ix, ASMutation.cFeld_1, ';')). WHEN 6 THEN iGGeb_Me = INTEGER(ENTRY(ix, ASMutation.cFeld_1, ';')). END. END. cMessage = SUBSTITUTE('Create_Retouren_Aufze -> Aufnr &1 Artnr &2 Inhalt &3 Jahr &4 KGeb &5 VGeb &6 GGeb &7', Aufko.Aufnr, iArtnr, iInhalt, iJahr, iKGeb_Me, iVGeb_Me, iGGeb_Me). DYNAMIC-FUNCTION('writeLogFile':U, cMessage) NO-ERROR. FIND FIRST bAufze NO-LOCK WHERE bAufze.Firma = cFirma AND bAufze.Aufnr = iAufnr AND bAufze.Artnr = iArtnr AND bAufze.Inhalt = iInhalt AND bAufze.Jahr = iJahr NO-ERROR. IF AVAILABLE bAufze THEN DO: iRecid = RECID(bAufze). REPEAT TRANSACTION: FIND bAufze WHERE RECID(bAufze) = iRecid. CREATE tAufze. BUFFER-COPY bAufze TO tAufze. ASSIGN tAufze.MBest = tAufze.MBest - iKGeb_Me tAufze.MGeli = tAufze.MGeli - iKGeb_Me tAufze.KGeb_Be = tAufze.KGeb_Be - iKGeb_Me tAufze.KGeb_Me = tAufze.KGeb_Me - iKGeb_Me tAufze.VGeb_Be = tAufze.VGeb_Be - iVGeb_Me tAufze.VGeb_Me = tAufze.VGeb_Me - iVGeb_Me tAufze.GGeb_Be = tAufze.GGeb_Be - iGGeb_Me tAufze.GGeb_Me = tAufze.GGeb_Me - iGGeb_Me. DYNAMIC-FUNCTION('calculateZeilenTotal':U, INPUT-OUTPUT htAufze) NO-ERROR. DYNAMIC-FUNCTION('fillArtbwFromAufze':U , INPUT-OUTPUT htAufze) NO-ERROR. BUFFER-COPY tAufze TO bAufze. DYNAMIC-FUNCTION('calculateAuftragsTotal':U, cFirma, iAufnr, OUTPUT nTotale ) NO-ERROR. RELEASE bAufze. LEAVE. END. RETURN ''. END. iRecid = ?. FOR EACH bAufko NO-LOCK WHERE bAufko.Firma = Aufko.Firma AND bAufko.Samm_Nr = Aufko.Samm_Nr AND bAufko.Aufnr <> Aufko.Aufnr, EACH bAufze NO-LOCK WHERE bAufze.Firma = bAufko.Firma AND bAufze.Aufnr = bAufko.Aufnr AND bAufze.Artnr > 0 AND bAufze.Artnr = iArtnr AND bAufze.Inhalt = iInhalt AND bAufze.Jahr = iJahr. iRecid = RECID(bAufze). LEAVE. END. FIND LAST bAufze NO-LOCK WHERE bAufze.Firma = Aufko.Firma AND bAufze.Aufnr = Aufko.Aufnr NO-ERROR. iPos = (IF AVAILABLE bAufze THEN bAufze.Pos + 5 ELSE 5). REPEAT TRANSACTION WHILE iRecid <> ?: FIND bAufze NO-LOCK WHERE RECID(bAufze) = iRecid. CREATE tAufze. BUFFER-COPY bAufze EXCEPT Aufnr Pos Artnr Inhalt Jahr MBest MGeli MRuek KGeb_Be KGeb_Me VGeb_Be VGeb_Me GGeb_Be GGeb_Me KGeb_Ru VGeb_Ru GGeb_Ru Trnr TO tAufze ASSIGN tAufze.Aufnr = Aufko.Aufnr tAufze.Artnr = iArtnr tAufze.Inhalt = iInhalt tAufze.Jahr = iJahr tAufze.Pos = iPos tAufze.MBest = - iKGeb_Me tAufze.MGeli = - iKGeb_Me tAufze.KGeb_Be = - iKGeb_Me tAufze.KGeb_Me = - iKGeb_Me tAufze.VGeb_Be = - iVGeb_Me tAufze.VGeb_Me = - iVGeb_Me tAufze.GGeb_Be = - iGGeb_Me tAufze.GGeb_Me = - iGGeb_Me . DYNAMIC-FUNCTION('calculateZeilenTotal':U, INPUT-OUTPUT htAufze) NO-ERROR. DYNAMIC-FUNCTION('fillArtbwFromAufze':U , INPUT-OUTPUT htAufze) NO-ERROR. CREATE Aufze. BUFFER-COPY tAufze TO Aufze. LEAVE. END. REPEAT TRANSACTION WHILE iRecid = ?: CREATE tAufze. ASSIGN tAufze.Firma = Aufko.Firma tAufze.Aufnr = Aufko.Aufnr tAufze.Pos = iPos tAufze.Artnr = iArtnr tAufze.Inhalt = iInhalt tAufze.Jahr = iJahr. DYNAMIC-FUNCTION('fillAufze':U, INPUT-OUTPUT htAufze ). ASSIGN tAufze.MBest = - iKGeb_Me tAufze.MGeli = - iKGeb_Me tAufze.KGeb_Be = - iKGeb_Me tAufze.KGeb_Me = - iKGeb_Me tAufze.VGeb_Be = - iVGeb_Me tAufze.VGeb_Me = - iVGeb_Me tAufze.GGeb_Be = - iGGeb_Me tAufze.GGeb_Me = - iGGeb_Me. tAufze.PreisArt = DYNAMIC-FUNCTION('getPreisAufze':U, INPUT-OUTPUT htAufze) NO-ERROR. DYNAMIC-FUNCTION('calculateZeilenTotal':U, INPUT-OUTPUT htAufze) NO-ERROR. DYNAMIC-FUNCTION('fillArtbwFromAufze':U , INPUT-OUTPUT htAufze) NO-ERROR. CREATE Aufze. BUFFER-COPY tAufze TO Aufze. LEAVE. END. DYNAMIC-FUNCTION('calculateAuftragsTotal':U, Aufko.Firma, Aufko.Aufnr, OUTPUT nTotale ) NO-ERROR. RELEASE bAufko . RELEASE bAufze . RELEASE Aufze . RELEASE bAufze . RETURN ''. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE CREATE_RETOUREN_ENDE wretouren PROCEDURE CREATE_RETOUREN_ENDE : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DEF INPUT PARAMETER ipRecid AS RECID NO-UNDO. DEF VAR cRuester AS CHAR NO-UNDO. DEF VAR iAufnr AS INT NO-UNDO. DEF VAR iRecid AS RECID NO-UNDO. DEF VAR ix AS INT NO-UNDO. DEF VAR cFirma AS CHAR NO-UNDO. DEF VAR cMessage AS CHAR NO-UNDO. DEF BUFFER bAufko FOR Aufko . FIND ASMutation NO-LOCK WHERE RECID(ASMutation) = ipRecid. ASSIGN cRuester = ASMutation.cFeld_2 iAufnr = ASMutation.iKey_1 cFirma = ASMutation.Firma. FIND bAufko NO-LOCK USE-INDEX Aufko-k1 WHERE bAufko.Firma = cFirma AND bAufko.Aufnr = iAufnr NO-ERROR. IF NOT AVAILABLE bAufko THEN RETURN ''. cMessage = SUBSTITUTE('Create_Retouren_Ende -> Aufnr &1 ', bAufko.Aufnr). DYNAMIC-FUNCTION('writeLogFile':U, cMessage) NO-ERROR. RUN WEITER ( bAufko.Aufnr ). RETURN ''. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE CREATE_RETOUREN_GEBINDE wretouren PROCEDURE CREATE_RETOUREN_GEBINDE : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DEF INPUT PARAMETER ipRecid AS RECID NO-UNDO. DEF VAR cRuester AS CHAR NO-UNDO. DEF VAR iAufnr AS INT NO-UNDO. DEF VAR iRecid AS RECID NO-UNDO. DEF VAR ix AS INT NO-UNDO. DEF VAR nTotale AS DEC EXTENT 15 NO-UNDO. DEF VAR cFirma AS CHAR NO-UNDO. DEF VAR cGebinde AS CHAR NO-UNDO. DEF VAR cGebKto AS CHAR NO-UNDO. DEF VAR iGebMe AS INT NO-UNDO. DEF VAR iMwst_Cd AS INT INIT 11 NO-UNDO. DEF BUFFER bAufko FOR Aufko . DEF BUFFER bAufGebKo FOR AufGebKo. DEF BUFFER bGebKonto FOR GebKonto. FIND ASMutation NO-LOCK WHERE RECID(ASMutation) = ipRecid. ASSIGN cRuester = ASMutation.cFeld_2 iAufnr = ASMutation.iKey_1 cFirma = ASMutation.Firma. FIND bAufko NO-LOCK USE-INDEX Aufko-k1 WHERE bAufko.Firma = cFirma AND bAufko.Aufnr = iAufnr NO-ERROR. IF NOT AVAILABLE bAufko THEN RETURN ''. cMessage = SUBSTITUTE('Create_Retouren_Gebinde -> Aufnr &1 ', bAufko.Aufnr). DYNAMIC-FUNCTION('writeLogFile':U, cMessage) NO-ERROR. DO WHILE TRUE: FIND FIRST bAufGebKo NO-LOCK WHERE bAufGebKo.Firma = Firma AND bAufGebKo.Aufnr = iAufnr NO-ERROR. IF AVAILABLE bAufGebKo THEN LEAVE. REPEAT TRANSACTION: FOR EACH GebRueck NO-LOCK WHERE GebRueck.Firma = cFirma: CREATE bAufGebKo. BUFFER-COPY GebRueck TO bAufGebKo ASSIGN bAufGebKo.Aufnr = iAufnr. IF bAufGebKo.Kto_Cd1 <> '' THEN DO: FIND bGebKonto NO-LOCK WHERE bGebKonto.Firma = bAufGebKo.Firma AND bGebKonto.Geb_Cd = bAufGebKo.Kto_Cd1. ASSIGN bAufGebKo.Wert_1 = bGebKonto.Depot + bGebKonto.Gebuehr. RELEASE bGebKonto. END. IF bAufGebKo.Kto_Cd2 <> '' THEN DO: FIND bGebKonto NO-LOCK WHERE bGebKonto.Firma = bAufGebKo.Firma AND bGebKonto.Geb_Cd = bAufGebKo.Kto_Cd2. ASSIGN bAufGebKo.Wert_2 = bGebKonto.Depot + bGebKonto.Gebuehr. RELEASE bGebKonto. END. IF bAufGebKo.Kto_Cd3 <> '' THEN DO: FIND bGebKonto NO-LOCK WHERE bGebKonto.Firma = bAufGebKo.Firma AND bGebKonto.Geb_Cd = bAufGebKo.Kto_Cd3. ASSIGN bAufGebKo.Wert_3 = bGebKonto.Depot + bGebKonto.Gebuehr. RELEASE bGebKonto. END. END. RELEASE bAufGebKo. LEAVE. END. LEAVE. END. DO ix = 1 TO NUM-ENTRIES(ASMutation.cFeld_1, ';'): cGebinde = ENTRY(ix, ASMutation.cFeld_1, ';'). cGebKto = ENTRY(1, cGebinde, ','). iGebMe = INTEGER(ENTRY(2, cGebinde, ',')). FIND FIRST bAufGebKo NO-LOCK WHERE bAufGebKo.Firma = cFirma AND bAufGebKo.Aufnr = iAufnr AND bAufGebKo.Geb_Cd = cGebKto NO-ERROR. IF NOT AVAILABLE bAufGebKo THEN DO: FIND GebKonto NO-LOCK WHERE GebKonto.Firma = cFirma AND GebKonto.Geb_Cd = cGebKto NO-ERROR. IF NOT AVAILABLE GebKonto THEN NEXT. REPEAT TRANSACTION: CREATE bAufGebKo. BUFFER-COPY GebRueck TO bAufGebKo ASSIGN bAufGebKo.Aufnr = iAufnr. IF bAufGebKo.Kto_Cd1 <> '' THEN DO: FIND bGebKonto NO-LOCK WHERE bGebKonto.Firma = bAufGebKo.Firma AND bGebKonto.Geb_Cd = bAufGebKo.Kto_Cd1. ASSIGN bAufGebKo.Wert_1 = bGebKonto.Depot + bGebKonto.Gebuehr. RELEASE bGebKonto. END. IF bAufGebKo.Kto_Cd2 <> '' THEN DO: FIND bGebKonto NO-LOCK WHERE bGebKonto.Firma = bAufGebKo.Firma AND bGebKonto.Geb_Cd = bAufGebKo.Kto_Cd2. ASSIGN bAufGebKo.Wert_2 = bGebKonto.Depot + bGebKonto.Gebuehr. RELEASE bGebKonto. END. IF bAufGebKo.Kto_Cd3 <> '' THEN DO: FIND bGebKonto NO-LOCK WHERE bGebKonto.Firma = bAufGebKo.Firma AND bGebKonto.Geb_Cd = bAufGebKo.Kto_Cd3. ASSIGN bAufGebKo.Wert_3 = bGebKonto.Depot + bGebKonto.Gebuehr. RELEASE bGebKonto. END. LEAVE. END. END. DYNAMIC-FUNCTION('calculateAufGebKo':U, RECID(bAufGebKo), iGebMe). RELEASE GebKonto. RELEASE bAufGebKo. END. DYNAMIC-FUNCTION('calculateAuftragsTotal':U, cFirma, iAufnr, OUTPUT nTotale ) NO-ERROR. RELEASE bAufko . RELEASE bAufGebKo . RELEASE GebKonto. RETURN ''. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI wretouren _DEFAULT-DISABLE PROCEDURE disable_UI : /*------------------------------------------------------------------------------ Purpose: DISABLE the User Interface Parameters: Notes: Here we clean-up the user-interface by deleting dynamic widgets we have created and/or hide frames. This procedure is usually called when we are ready to "clean-up" after running. ------------------------------------------------------------------------------*/ /* Delete the WINDOW we created */ IF SESSION:DISPLAY-TYPE = "GUI":U AND VALID-HANDLE(wretouren) THEN DELETE WIDGET wretouren. IF THIS-PROCEDURE:PERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enableObject wretouren PROCEDURE enableObject : /*------------------------------------------------------------------------------ Purpose: Super Override Parameters: Notes: ------------------------------------------------------------------------------*/ { incl/winenableobject.i } RUN SUPER. /* Code placed here will execute AFTER standard behavior. */ END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enable_UI wretouren _DEFAULT-ENABLE PROCEDURE enable_UI : /*------------------------------------------------------------------------------ Purpose: ENABLE the User Interface Parameters: Notes: Here we display/view/enable the widgets in the user-interface. In addition, OPEN all queries associated with each FRAME and BROWSE. These statements here are based on the "Other Settings" section of the widget Property Sheets. ------------------------------------------------------------------------------*/ ENABLE F_Status WITH FRAME fMain IN WINDOW wretouren. {&OPEN-BROWSERS-IN-QUERY-fMain} VIEW wretouren. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE ENDE wretouren PROCEDURE ENDE : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DEF VAR wx AS INT NO-UNDO. DEF VAR wy AS INT NO-UNDO. IF KEYLABEL(LASTKEY) = 'ESC' THEN RETURN NO-APPLY. wx = {&WINDOW-NAME}:X NO-ERROR. wy = {&WINDOW-NAME}:Y NO-ERROR. DYNAMIC-FUNCTION('setFensterposition':U, INPUT 'Fensterposition', INPUT Progname, INPUT wx, INPUT wy) NO-ERROR. RUN CLOSE_FUNKTIONEN. APPLY "CLOSE":U TO THIS-PROCEDURE. QUIT. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE exitObject wretouren PROCEDURE exitObject : /*------------------------------------------------------------------------------ Purpose: Window-specific override of this procedure which destroys its contents and itself. Notes: ------------------------------------------------------------------------------*/ RUN ENDE. RETURN NO-APPLY. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE initializeObject wretouren PROCEDURE initializeObject : /*------------------------------------------------------------------------------ Purpose: Super Override Parameters: Notes: ------------------------------------------------------------------------------*/ /* Code placed here will execute PRIOR to standard behavior. */ RUN SUPER. { incl/wininitializeobject.i } DO WITH FRAME {&FRAME-NAME}: F_Status:READ-ONLY = TRUE. END. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE viewObject wretouren PROCEDURE viewObject : /*------------------------------------------------------------------------------ Purpose: Super Override Parameters: Notes: ------------------------------------------------------------------------------*/ /* Code placed here will execute PRIOR to standard behavior. */ RUN SUPER. /* Code placed here will execute AFTER standard behavior. */ END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME /* ************************ Function Implementations ***************** */ &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION calculateAufGebKo wretouren FUNCTION calculateAufGebKo RETURNS LOGICAL ( ipRecid AS RECID, ipMenge AS INT ) : /*------------------------------------------------------------------------------ Purpose: Notes: ------------------------------------------------------------------------------*/ DEF BUFFER bAufGebKo FOR AufGebKo. DEF BUFFER bAufGKon FOR AufGKon . DEF BUFFER bGebKonto FOR GebKonto. DEF VAR DiffMenge AS INT NO-UNDO. DEF VAR MW AS INT NO-UNDO. REPEAT TRANSACTION WITH FRAME {&FRAME-NAME}: FIND bAufGebKo WHERE RECID(bAufGebKo) = ipRecid. DiffMenge = ipMenge - bAufGebKo.Menge. IF DiffMenge = 0 THEN DO: RELEASE bAufGebKo. LEAVE. END. bAufGebKo.Menge = ipMenge. DO WHILE bAufGebKo.Kto_Cd1 <> '': IF bAufGebKo.Anz_1 = 0 THEN LEAVE. FIND bGebKonto NO-LOCK WHERE bGebKonto.Firma = bAufGebKo.Firma AND bGebKonto.Geb_Cd = bAufGebKo.Kto_Cd1. IF bGebKonto.MWST_Art = 0 THEN MW = 11. IF bGebKonto.MWST_Art = 2 THEN MW = bGebKonto.MWST_Cd. IF bGebKonto.MWST_Art = 1 THEN DO: FIND FIRST bAufGKon NO-LOCK WHERE bAufGKon.Firma = bAufGebKo.Firma AND bAufGKon.Aufnr = bAufGebKo.Aufnr AND bAufGKon.Geb_Cd = bGebKonto.Geb_Cd NO-ERROR. IF AVAILABLE bAufGKon THEN MW = bAufGKon.MWSt_Cd. ELSE MW = 11. END. FIND bAufGKon WHERE bAufGKon.Firma = bAufGebKo.Firma AND bAufGKon.Aufnr = bAufGebKo.Aufnr AND bAufGKon.Geb_Cd = bGebKonto.Geb_Cd AND bAufGKon.MWSt_Cd = MW NO-ERROR. IF NOT AVAILABLE bAufGKon THEN DO: CREATE bAufGKon. ASSIGN bAufGKon.Firma = bAufGebKo.Firma bAufGKon.Aufnr = bAufGebKo.Aufnr bAufGKon.Geb_Cd = bGebKonto.Geb_Cd bAufGKon.MWSt_Cd = MW bAufGKon.Gebuehr = bGebKonto.Gebuehr bAufGKon.Depot = bGebKonto.Depot bAufGKon.Sort_Cd = bGebKonto.Sort_Cd. END. bAufGKon.Eingang = bAufGKon.Eingang + (bAufGebKo.Anz_1 * DiffMenge). bAufGKon.Betrag = (bAufGKon.Ausgang - bAufGKon.Eingang) * (bAufGKon.Depot + bAufGKon.Gebuehr). RELEASE bAufGKon. RELEASE bGebKonto. LEAVE. END. DO WHILE bAufGebKo.Kto_Cd2 <> '': IF bAufGebKo.Anz_2 = 0 THEN LEAVE. FIND bGebKonto NO-LOCK WHERE bGebKonto.Firma = bAufGebKo.Firma AND bGebKonto.Geb_Cd = bAufGebKo.Kto_Cd2. IF bGebKonto.MWST_Art = 0 THEN MW = 11. IF bGebKonto.MWST_Art = 2 THEN MW = bGebKonto.MWST_Cd. IF bGebKonto.MWST_Art = 1 THEN DO: FIND FIRST bAufGKon NO-LOCK WHERE bAufGKon.Firma = bAufGebKo.Firma AND bAufGKon.Aufnr = bAufGebKo.Aufnr AND bAufGKon.Geb_Cd = bGebKonto.Geb_Cd NO-ERROR. IF AVAILABLE bAufGKon THEN MW = bAufGKon.MWSt_Cd. ELSE MW = 11. END. FIND bAufGKon WHERE bAufGKon.Firma = bAufGebKo.Firma AND bAufGKon.Aufnr = bAufGebKo.Aufnr AND bAufGKon.Geb_Cd = bGebKonto.Geb_Cd AND bAufGKon.MWSt_Cd = MW NO-ERROR. IF NOT AVAILABLE bAufGKon THEN DO: CREATE bAufGKon. ASSIGN bAufGKon.Firma = bAufGebKo.Firma bAufGKon.Aufnr = bAufGebKo.Aufnr bAufGKon.Geb_Cd = bGebKonto.Geb_Cd bAufGKon.MWSt_Cd = MW bAufGKon.Gebuehr = bGebKonto.Gebuehr bAufGKon.Depot = bGebKonto.Depot bAufGKon.Sort_Cd = bGebKonto.Sort_Cd. END. bAufGKon.Eingang = bAufGKon.Eingang + (bAufGebKo.Anz_2 * DiffMenge). bAufGKon.Betrag = (bAufGKon.Ausgang - bAufGKon.Eingang) * (bAufGKon.Depot + bAufGKon.Gebuehr). RELEASE bAufGKon. RELEASE bGebKonto. LEAVE. END. DO WHILE bAufGebKo.Kto_Cd3 <> '': IF bAufGebKo.Anz_3 = 0 THEN LEAVE. FIND bGebKonto NO-LOCK WHERE bGebKonto.Firma = bAufGebKo.Firma AND bGebKonto.Geb_Cd = bAufGebKo.Kto_Cd3. IF bGebKonto.MWST_Art = 0 THEN MW = 11. IF bGebKonto.MWST_Art = 2 THEN MW = bGebKonto.MWST_Cd. IF bGebKonto.MWST_Art = 1 THEN DO: FIND FIRST bAufGKon NO-LOCK WHERE bAufGKon.Firma = bAufGebKo.Firma AND bAufGKon.Aufnr = bAufGebKo.Aufnr AND bAufGKon.Geb_Cd = bGebKonto.Geb_Cd NO-ERROR. IF AVAILABLE bAufGKon THEN MW = bAufGKon.MWSt_Cd. ELSE MW = 11. END. FIND bAufGKon WHERE bAufGKon.Firma = bAufGebKo.Firma AND bAufGKon.Aufnr = bAufGebKo.Aufnr AND bAufGKon.Geb_Cd = bGebKonto.Geb_Cd AND bAufGKon.MWSt_Cd = MW NO-ERROR. IF NOT AVAILABLE bAufGKon THEN DO: CREATE bAufGKon. ASSIGN bAufGKon.Firma = bAufGebKo.Firma bAufGKon.Aufnr = bAufGebKo.Aufnr bAufGKon.Geb_Cd = bGebKonto.Geb_Cd bAufGKon.MWSt_Cd = MW bAufGKon.Gebuehr = bGebKonto.Gebuehr bAufGKon.Depot = bGebKonto.Depot bAufGKon.Sort_Cd = bGebKonto.Sort_Cd. END. bAufGKon.Eingang = bAufGKon.Eingang + (bAufGebKo.Anz_3 * DiffMenge). bAufGKon.Betrag = (bAufGKon.Ausgang - bAufGKon.Eingang) * (bAufGKon.Depot + bAufGKon.Gebuehr). RELEASE bAufGKon. RELEASE bGebKonto. LEAVE. END. ASSIGN bAufGebKo.Betrag_1 = bAufGebKo.Anz_1 * bAufGebKo.Wert_1 * bAufGebKo.Menge bAufGebKo.Betrag_2 = bAufGebKo.Anz_2 * bAufGebKo.Wert_2 * bAufGebKo.Menge bAufGebKo.Betrag_3 = bAufGebKo.Anz_3 * bAufGebKo.Wert_3 * bAufGebKo.Menge. RELEASE bAufGebKo. RELEASE bAufGKon . END. END FUNCTION. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getDruckProgramm wretouren FUNCTION getDruckProgramm RETURNS CHARACTER ( /* parameter-definitions */ ) : /*------------------------------------------------------------------------------ Purpose: Notes: ------------------------------------------------------------------------------*/ DEF VAR cDruckProgramm AS CHAR NO-UNDO. DEF VAR cInstallation AS CHAR NO-UNDO. cInstallation = DYNAMIC-FUNCTION('getInstallation':U) NO-ERROR. DO WHILE TRUE: cDruckProgramm = 'g-p_' + cInstallation + '.r'. cDruckProgramm = SEARCH(cDruckProgramm). IF cDruckProgramm <> ? THEN LEAVE. cDruckProgramm = 'g-p_' + cInstallation + '.w'. cDruckProgramm = SEARCH(cDruckProgramm). IF cDruckProgramm <> ? THEN LEAVE. LEAVE. END. IF cDruckProgramm = ? THEN cDruckProgramm = ''. RETURN cDruckProgramm. END FUNCTION. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getLogName wretouren FUNCTION getLogName RETURNS CHARACTER ( /* parameter-definitions */ ) : /*------------------------------------------------------------------------------ Purpose: Notes: ------------------------------------------------------------------------------*/ DEF VAR cPath AS CHAR NO-UNDO. GET-KEY-VALUE SECTION 'GrundEinstellungen' KEY 'Ge_MIS_TEMP' VALUE cPath. IF cPath = '' OR cPath = ? THEN cPath = SESSION:TEMP-DIRECTORY. IF SUBSTRING(cPath, LENGTH(cPath), 01) <> '/' AND SUBSTRING(cPath, LENGTH(cPath), 01) <> '\' THEN cPath = cPath + '\'. cPath = cPath + Progname + '-' + REPLACE(STRING(TODAY,'99.99.9999'), '.', '') + '.Log'. RETURN cPath. END FUNCTION. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getProgname wretouren FUNCTION getProgname RETURNS CHARACTER ( /* parameter-definitions */ ) : /*------------------------------------------------------------------------------ Purpose: Notes: ------------------------------------------------------------------------------*/ RETURN Progname. END FUNCTION. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION writeLogFile wretouren FUNCTION writeLogFile RETURNS LOGICAL ( ipMessage AS CHAR ) : /*------------------------------------------------------------------------------ Purpose: Notes: ------------------------------------------------------------------------------*/ DEF VAR cString AS CHAR NO-UNDO. cString = SUBSTITUTE('&1 &2 -> &3', STRING(TODAY,'99.99.9999'), STRING(TIME,'HH:MM:SS'), ipMessage). OUTPUT STREAM LogStream TO VALUE(cLogName) APPEND. PUT STREAM LogStream CONTROL cString CHR(10). OUTPUT STREAM LogStream CLOSE. RETURN TRUE. END FUNCTION. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME