&ANALYZE-SUSPEND _VERSION-NUMBER AB_v10r12 &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure /*------------------------------------------------------------------------ File : Purpose : Syntax : Description : Author(s) : Created : Notes : ----------------------------------------------------------------------*/ /* This .W file was created with the Progress AppBuilder. */ /*----------------------------------------------------------------------*/ /* *************************** Definitions ************************** */ DEFINE VARIABLE cUser AS CHARACTER NO-UNDO. DEFINE VARIABLE iBeg AS INTEGER NO-UNDO. DEFINE VARIABLE iAnzTrans AS INTEGER NO-UNDO. DEFINE VARIABLE lBatch AS LOG NO-UNDO INIT TRUE . DEFINE VARIABLE cLogFile AS CHARACTER NO-UNDO. DEFINE VARIABLE cProgramm AS CHARACTER NO-UNDO. DEFINE VARIABLE cDruckart AS CHARACTER NO-UNDO. DEFINE VARIABLE cLogFileProg AS CHARACTER NO-UNDO. DEFINE VARIABLE lAnmeldung AS LOGICAL NO-UNDO INIT FALSE. DEFINE VARIABLE cPasswort AS CHARACTER NO-UNDO. DEFINE VARIABLE cMandant AS CHARACTER NO-UNDO. DEFINE VARIABLE rASMut AS RECID NO-UNDO. DEFINE VARIABLE cMutArten AS CHARACTER NO-UNDO INIT 'RUESTDRUCK,wsLIEFERSCHEIN,wsLADEPAPIER,wsPALETT'. DEFINE STREAM Out_Stream. DEFINE STREAM LogStream. DEFINE BUFFER bASMutation FOR ASMutation. DEFINE BUFFER dASMutation FOR ASMutation. /*DEFINE TEMP-TABLE tRuestPos*/ /* FIELD Aufnr AS INTEGER*/ /* FIELD Pos AS INTEGER*/ /* FIELD Zeit AS INTEGER*/ /* FIELD lDruck AS LOGICAL*/ /* FIELD rASMut AS RECID .*/ { super/funktionen.i } { incl/windefinition.i } { incl/ttdruckparam.i } { incl/properties.i } /* _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-checkIsEnde) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD checkIsEnde Procedure FUNCTION checkIsEnde RETURNS LOGICAL ( ) FORWARD. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-checkIsWorking) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD checkIsWorking Procedure FUNCTION checkIsWorking RETURNS LOGICAL ( ) FORWARD. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-clearControlFlags) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD clearControlFlags Procedure FUNCTION clearControlFlags RETURNS LOGICAL ( ) FORWARD. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-getDruckProgramm) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getDruckProgramm Procedure FUNCTION getDruckProgramm RETURNS CHARACTER ( ) FORWARD. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-getLogfileName) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getLogfileName Procedure FUNCTION getLogfileName RETURNS CHARACTER ( /* parameter-definitions */ ) 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 *************************** */ /* -------------------------------------------------------------- */ /* Start lesen ASMutation */ /* -------------------------------------------------------------- */ DEFINE VARIABLE iTime AS INTEGER NO-UNDO. DEFINE VARIABLE cRetVal AS CHARACTER NO-UNDO. DEFINE VARIABLE iTrnr AS INTEGER NO-UNDO INIT 0. DEFINE VARIABLE iAblauf AS INTEGER NO-UNDO. DEFINE VARIABLE cMessage AS CHARACTER NO-UNDO. DEFINE VARIABLE iRecid AS RECID NO-UNDO. DEFINE VARIABLE lRetVal AS LOGICAL NO-UNDO. REPEAT TRANSACTION ON ERROR UNDO, LEAVE: RUN ANMELDEN. IF NOT lAnmeldung THEN QUIT. LEAVE. END. cLogFileProg = SEARCH ('writeLogFile.p'). cProgramm = DYNAMIC-FUNCTION ('makeProgname':U, THIS-PROCEDURE:HANDLE) NO-ERROR. cLogFile = DYNAMIC-FUNCTION ('getLogFileName':U IN THIS-PROCEDURE) NO-ERROR. /*OUTPUT TO 'C:\LogFiles\xxxx.log'. */ /*PUT CONTROL cLogFileProg CHR(10) cProgramm CHR(10) cLogFile.*/ /*OUTPUT CLOSE. */ SAktiv = DYNAMIC-FUNCTION('getSuperaktiv':U) NO-ERROR. IF SAktiv = ? THEN SAktiv = FALSE. IF NOT sAktiv THEN DO: cMessage = 'Anmeldung nicht möglich / nicht geklappt '. RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, cMessage ) NO-ERROR. QUIT. END. AdFirma = DYNAMIC-FUNCTION('getAdMandant':U) NO-ERROR. FBFirma = DYNAMIC-FUNCTION('getFBMandant':U) NO-ERROR. Firma = DYNAMIC-FUNCTION('getMandant':U) NO-ERROR. cUser = DYNAMIC-FUNCTION('getBenutzer') NO-ERROR. lBatch = DYNAMIC-FUNCTION('getBatch':U) NO-ERROR. cMessage = SUBSTITUTE('Programm &1 gestartet', cProgramm). RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, cMessage ) NO-ERROR. iBeg = TIME. iTime = ETIME(TRUE). iTrnr = -1. iAnzTrans = 0. RUN REORG_ASMUTATION. RUN REORG_TABELLEN. RUN BEREINIGEN_BATCH. DYNAMIC-FUNCTION ('clearControlFlags':U). cMessage = 'Reorg ASMutation, Reorg Tabellen und Bereinigung Batch beendet'. RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, cMessage ) NO-ERROR. MAIN-BLOCK: REPEAT ON ERROR UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK: 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. iAnzTrans = 0. PAUSE 2 NO-MESSAGE. lRetVal = DYNAMIC-FUNCTION ('checkIsWorking':U) NO-ERROR. IF lRetVal THEN NEXT MAIN-BLOCK. lRetVal = DYNAMIC-FUNCTION ('checkIsEnde':U) NO-ERROR. IF lRetVal THEN LEAVE MAIN-BLOCK. NEXT MAIN-BLOCK. END. IF LOOKUP(ASMutation.MutArt, cMutArten, ',') = 0 THEN DO: iTrnr = ASMutation.asmutation_id. NEXT MAIN-BLOCK. END. iTime = ETIME(TRUE). iTrnr = ASMutation.asmutation_id. iRecid = RECID(ASMutation). lRetVal = TRUE. /* -------------------------------------------------------------- */ /* Druck aus TRIGGER t-aufze-write (Aenderung Auftrag) */ /* -------------------------------------------------------------- */ DO WHILE ASMutation.MutArt = 'RUESTDRUCK': /* Druck von Benutzer nach Mutation */ IF ASMutation.cFeld_2 <> 'TRIGGER' THEN DO: REPEAT TRANSACTION ON ERROR UNDO, LEAVE: FOR EACH bASMutation NO-LOCK USE-INDEX ASMutation-k2 WHERE bASMutation.Aktiv = TRUE AND bASMutation.MutArt = ASMutation.MutArt AND bASMutation.iKey_1 = ASMutation.iKey_1 AND bASMutation.cFeld_2 = 'TRIGGER': FIND dASMutation WHERE RECID(dASMutation) = RECID(bASMutation) EXCLUSIVE-LOCK NO-WAIT NO-ERROR. IF AVAILABLE dASMutation THEN DO: DELETE dASMutation. RELEASE dASMutation. RELEASE bASMutation. NEXT. END. IF LOCKED dASMutation THEN DO: lRetVal = FALSE. RELEASE bASMutation. LEAVE. END. END. LEAVE. END. END. IF NOT lRetVal THEN LEAVE. /* ---------------------------------- */ rASMut = ?. REPEAT TRANSACTION ON ERROR UNDO, LEAVE: FOR EACH bASMutation NO-LOCK USE-INDEX ASMutation-k2 WHERE bASMutation.Aktiv = TRUE AND bASMutation.MutArt = ASMutation.MutArt AND bASMutation.iKey_1 = ASMutation.iKey_1 AND bASMutation.cFeld_2 = 'TRIGGER' BREAK BY bASMutation.iKey_1 BY bASMutation.asmutation_id: IF LAST-OF (bASMutation.iKey_1) THEN DO: rAsMut = RECID(bASMutation). LEAVE. END. FIND dASMutation WHERE RECID(dASMutation) = RECID(bASMutation) EXCLUSIVE-LOCK NO-WAIT NO-ERROR. IF AVAILABLE dASMutation THEN DO: DELETE dASMutation. RELEASE dASMutation. RELEASE bASMutation. NEXT. END. IF LOCKED dASMutation THEN DO: lRetVal = FALSE. RELEASE bASMutation. LEAVE. END. lRetVal = FALSE. DELETE bASMutation. END. LEAVE. END. IF rASMut = ? THEN LEAVE. FIND bASMutation NO-LOCK WHERE RECID(bASMutation) = rASMut. IF bASMutation.asmutation_id = ASMutation.asmutation_id AND bASMutation.iFeld_3 < (TIME - 120) THEN LEAVE. lRetVal = FALSE. LEAVE. END. /* -------------------------------------------------------------- */ IF NOT lRetVal 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 = 'NULL'. FIND ASMutation NO-LOCK WHERE RECID(ASMutation) = iRecid. CASE ASMutation.MutArt: WHEN 'RUESTDRUCK' THEN RUN DRUCKEN_RUESTSCHEIN ( iRecid ). WHEN 'wsLADEPAPIER' THEN RUN DRUCKEN_LADESCHEIN ( iRecid ). WHEN 'wsPALETT' THEN RUN DRUCKEN_PALETTENSCHEIN ( iRecid ). WHEN 'wsLIEFERSCHEIN' THEN RUN DRUCKEN_LIEFERSCHEIN ( iRecid ). END CASE. cRetVal = RETURN-VALUE. IF cRetVal BEGINS 'ERROR' THEN DO: cMessage = SUBSTITUTE('Fehler &1 beim Drucken von &2', ENTRY(2, cRetVal, ';'), ASMutation.MutArt). RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, cMessage ) NO-ERROR. 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 NEXT MAIN-BLOCK. NEXT. END. CASE ASMutation.MutArt: WHEN 'wsLIEFERSCHEIN' THEN DO: ASSIGN ASMutation.Aktiv = FALSE ASMutation.cStatus = 'E'. END. OTHERWISE DO: ASSIGN ASMutation.cStatus = '' ASMutation.Aktiv = TRUE. END. END CASE. RELEASE ASMutation. LEAVE. END. NEXT MAIN-BLOCK. END. 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. iAnzTrans = iAnzTrans + 1. IF iAnzTrans <= 5 THEN NEXT. lRetVal = DYNAMIC-FUNCTION ('checkIsWorking':U) NO-ERROR. lRetVal = DYNAMIC-FUNCTION ('checkIsEnde':U) NO-ERROR. IF lRetVal THEN LEAVE MAIN-BLOCK. END. cMessage = SUBSTITUTE('Programm nach einer Laufzeit von &1 Sekunden beendet', (TIME - iBeg) ). RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, cMessage ) NO-ERROR. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME /* ************************ Function Implementations ***************** */ &IF DEFINED(EXCLUDE-checkIsEnde) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION checkIsEnde Procedure FUNCTION checkIsEnde RETURNS LOGICAL ( ): /*------------------------------------------------------------------------------*/ /* Purpose: */ /* Parameters: */ /* Notes: */ /*------------------------------------------------------------------------------*/ DEFINE VARIABLE lOk AS LOGICAL NO-UNDO INIT FALSE. DEFINE BUFFER bTabel FOR Tabel. RELEASE Tabel . RELEASE bTabel. DO WHILE TRUE: FIND Tabel NO-LOCK WHERE Tabel.Firma = Firma AND Tabel.Recart = 'BATCHDRUCK' AND Tabel.CodeC = 'LAGER' AND Tabel.CodeI = 0 AND Tabel.Sprcd = 0 NO-ERROR. IF NOT AVAILABLE Tabel THEN LEAVE. IF Tabel.Flag_2 = FALSE THEN LEAVE. REPEAT TRANSACTION ON ERROR UNDO, LEAVE: FIND bTabel WHERE RECID(bTabel) = RECID(Tabel). ASSIGN bTabel.Flag_2 = FALSE. RELEASE bTabel. RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, '' ) NO-ERROR. cMessage = 'eine ENDE-Anweisung erhalten'. RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, cMessage ) NO-ERROR. RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, '' ) NO-ERROR. LEAVE. END. lOK = TRUE. LEAVE. END. RETURN lOK. END FUNCTION. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-checkIsWorking) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION checkIsWorking Procedure FUNCTION checkIsWorking RETURNS LOGICAL ( ): /*------------------------------------------------------------------------------*/ /* Purpose: */ /* Parameters: */ /* Notes: */ /*------------------------------------------------------------------------------*/ DEFINE VARIABLE lOk AS LOGICAL NO-UNDO INIT FALSE. DEFINE BUFFER bTabel FOR Tabel. RELEASE Tabel . RELEASE bTabel. DO WHILE TRUE: FIND Tabel NO-LOCK WHERE Tabel.Firma = Firma AND Tabel.Recart = 'BATCHDRUCK' AND Tabel.CodeC = 'LAGER' AND Tabel.CodeI = 0 AND Tabel.Sprcd = 0 NO-ERROR. IF NOT AVAILABLE Tabel THEN LEAVE. IF Tabel.Flag_1 = FALSE THEN LEAVE. REPEAT TRANSACTION ON ERROR UNDO, LEAVE: FIND bTabel WHERE RECID(bTabel) = RECID(Tabel). ASSIGN bTabel.Flag_1 = FALSE. RELEASE bTabel. LEAVE. END. RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, '' ) NO-ERROR. cMessage = 'eine isWorking-Anfrage erhalten'. RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, cMessage ) NO-ERROR. lOK = TRUE. LEAVE. END. RETURN lOK. END FUNCTION. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-clearControlFlags) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION clearControlFlags Procedure FUNCTION clearControlFlags RETURNS LOGICAL ( ): /*------------------------------------------------------------------------------*/ /* Purpose: */ /* Parameters: */ /* Notes: */ /*------------------------------------------------------------------------------*/ DEFINE BUFFER bTabel FOR Tabel. DO WHILE TRUE: FIND Tabel NO-LOCK WHERE Tabel.Firma = Firma AND Tabel.Recart = 'BATCHDRUCK' AND Tabel.CodeC = 'LAGER' AND Tabel.CodeI = 0 AND Tabel.Sprcd = 0 NO-ERROR. IF NOT AVAILABLE Tabel THEN DO: REPEAT TRANSACTION ON ERROR UNDO, LEAVE: CREATE Tabel. ASSIGN Tabel.Firma = Firma Tabel.Recart = 'BATCHDRUCK' Tabel.CodeC = 'LAGER' Tabel.CodeI = 0 Tabel.Sprcd = 0 Tabel.Flag_1 = FALSE Tabel.Flag_2 = FALSE. RELEASE Tabel. LEAVE. END. NEXT. END. IF Tabel.Flag_1 = FALSE AND Tabel.Flag_2 = FALSE THEN LEAVE. REPEAT TRANSACTION ON ERROR UNDO, LEAVE: FIND bTabel WHERE RECID(bTabel) = RECID(Tabel). ASSIGN bTabel.Flag_1 = FALSE bTabel.Flag_2 = FALSE. RELEASE bTabel. LEAVE. END. LEAVE. END. RETURN TRUE. END FUNCTION. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-getDruckProgramm) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getDruckProgramm Procedure FUNCTION getDruckProgramm RETURNS CHARACTER ( ): /*------------------------------------------------------------------------------*/ /* Purpose: */ /* Parameters: */ /* Notes: */ /*------------------------------------------------------------------------------*/ DEFINE VARIABLE cDruckProgramm AS CHARACTER NO-UNDO. DO WHILE TRUE: cDruckProgramm = SUBSTITUTE('DruckProgramme/&1/&2', cInstallation, cDruckart). cDruckProgramm = SEARCH(cDruckProgramm). LEAVE. END. IF cDruckProgramm = ? THEN cDruckProgramm = ''. RETURN cDruckProgramm. END FUNCTION. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-getLogfileName) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getLogfileName Procedure FUNCTION getLogfileName RETURNS CHARACTER ( /* parameter-definitions */ ) : /*------------------------------------------------------------------------------*/ /* Purpose: */ /* Parameters: */ /* Notes: */ /*------------------------------------------------------------------------------*/ DEFINE VARIABLE cPath AS CHARACTER NO-UNDO. cPath = DYNAMIC-FUNCTION ('getLogFilePfad':U) NO-ERROR. IF cPath = ? OR cPath = '' THEN cPath = SESSION:TEMP-DIRECTORY. cPath = cPath + cProgramm + '_' + REPLACE(STRING(TODAY,'99.99.9999'), '.', '') + '.Log'. RETURN cPath. END FUNCTION. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF /* ********************** Internal Procedures *********************** */ &IF DEFINED(EXCLUDE-ANMELDEN) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE ANMELDEN Procedure PROCEDURE ANMELDEN: /*------------------------------------------------------------------------------*/ /* Purpose: */ /* Parameters: */ /* Notes: */ /*------------------------------------------------------------------------------*/ DEFINE VARIABLE cString AS CHARACTER NO-UNDO. DEFINE VARIABLE ix AS INTEGER NO-UNDO. DO WHILE TRUE: IF ENTRY(1, SESSION:PARAMETER, ';') <> 'batch' THEN LEAVE. ASSIGN cBenutzer = '' cPasswort = '' cMandant = ''. DO ix = 1 TO NUM-ENTRIES(SESSION:PARAMETER, ';'): CASE ix: WHEN 2 THEN cBenutzer = ENTRY(ix, SESSION:PARAMETER, ';') NO-ERROR. WHEN 3 THEN cPasswort = ENTRY(ix, SESSION:PARAMETER, ';') NO-ERROR. WHEN 4 THEN cMandant = ENTRY(ix, SESSION:PARAMETER, ';') NO-ERROR. WHEN 5 THEN lBatch = FALSE NO-ERROR. END CASE. END. DYNAMIC-FUNCTION('setBatch':U, lBatch) NO-ERROR. FIND FIRST Benutzer NO-LOCK USE-INDEX Benutzer-k1 WHERE Benutzer.Benutzer = cBenutzer AND Benutzer.Kennwort = cPasswort NO-ERROR. IF NOT AVAILABLE Benutzer THEN DO: cString = SUBSTITUTE('Benutzer &1 mit Kennwort &2 ungültig', cBenutzer, cPasswort). RUN VALUE(cLogFileProg) (cProgramm, cLogFile, cString) NO-ERROR. LEAVE. END. FIND Mandant NO-LOCK USE-INDEX Mandant-k1 WHERE Mandant.Firma = cMandant NO-ERROR. IF NOT AVAILABLE Mandant THEN DO: cString = SUBSTITUTE('Mandat &1 ungültig', cMandant). RUN VALUE(cLogFileProg) (cProgramm, cLogFile, cString) NO-ERROR. LEAVE. END. cString = cBenutzer + CHR(01) + cPasswort + CHR(01) + cMandant. RUN ANMELDUNG ( INPUT cString ). RUN AUFTRAGFUNKTIONENINIT. cInstallation = DYNAMIC-FUNCTION('getInstallation':U) NO-ERROR. lAnmeldung = TRUE. LEAVE. END. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-BEREINIGEN_BATCH) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE BEREINIGEN_BATCH Procedure PROCEDURE BEREINIGEN_BATCH: /*------------------------------------------------------------------------------*/ /* Purpose: */ /* Parameters: */ /* Notes: */ /*------------------------------------------------------------------------------*/ DEFINE VARIABLE iRecid AS RECID NO-UNDO. DEFINE BUFFER bASMutation FOR ASMutation. BEREINIGEN: FOR EACH ASMutation NO-LOCK WHERE ASMutation.cStatus = 'A': iRecid = RECID(ASMutation). CASE ASMutation.MutArt: WHEN 'RUESTDRUCK' THEN RUN BEREINIGEN_RUESTDRUCK ( iRecid ). WHEN 'wsLADEPAPIER' THEN RUN BEREINIGEN_LADEPAPIER ( iRecid ). WHEN 'wsPALETT' THEN RUN BEREINIGEN_PALETTENDOKUMENT ( iRecid ). WHEN 'wsLIEFERSCHEIN' THEN RUN BEREINIGEN_LIEFERSCHEIN ( iRecid ). END. REPEAT TRANSACTION: FIND bASMutation EXCLUSIVE-LOCK WHERE RECID(bASMutation) = iRecid NO-WAIT NO-ERROR. IF LOCKED bASMutation THEN DO: RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, 'ASMutation ist locked' ) NO-ERROR. NEXT BEREINIGEN. END. IF NOT AVAILABLE bASMutation THEN LEAVE. DELETE bASMutation. LEAVE. END. END. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-BEREINIGEN_LADEPAPIER) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE BEREINIGEN_LADEPAPIER Procedure PROCEDURE BEREINIGEN_LADEPAPIER: /*------------------------------------------------------------------------------*/ /* Purpose: */ /* Parameters: */ /* Notes: */ /*------------------------------------------------------------------------------*/ DEFINE INPUT PARAMETER ipRecid AS RECID NO-UNDO. DEFINE VARIABLE iAufnr AS INTEGER NO-UNDO. DEFINE VARIABLE iRuestArt AS INTEGER NO-UNDO. DEFINE VARIABLE cFirma AS CHARACTER NO-UNDO. DEFINE BUFFER bAS FOR ASMutation. DEFINE BUFFER bTabel FOR Tabel. FIND bAS NO-LOCK WHERE RECID(bAS) = ipRecid NO-ERROR. IF NOT AVAILABLE bAS THEN RETURN. IF bAS.cStatus = 'E' THEN RETURN. ASSIGN cBenutzer = bAS.cFeld_2 iAufnr = bAS.iKey_1 iRuestArt = bAS.iKey_2 cFirma = bAS.Firma. FIND FIRST bTabel EXCLUSIVE-LOCK WHERE bTabel.Firma = cFirma AND bTabel.RecArt = 'wsLADEPAPIER' AND bTabel.Sprcd = 1 AND bTabel.Int_1 = iAufnr AND bTabel.Int_3 = iRuestArt NO-WAIT NO-ERROR. IF NOT AVAILABLE bTabel THEN RETURN. DELETE bTabel. RETURN. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-BEREINIGEN_LIEFERSCHEIN) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE BEREINIGEN_LIEFERSCHEIN Procedure PROCEDURE BEREINIGEN_LIEFERSCHEIN: /*------------------------------------------------------------------------------*/ /* Purpose: */ /* Parameters: */ /* Notes: */ /*------------------------------------------------------------------------------*/ DEFINE INPUT PARAMETER ipRecid AS RECID NO-UNDO. DEFINE VARIABLE iAufnr AS INTEGER NO-UNDO. DEFINE VARIABLE iRuestArt AS INTEGER NO-UNDO. DEFINE VARIABLE cFirma AS CHARACTER NO-UNDO. DEFINE BUFFER bAS FOR ASMutation. DEFINE BUFFER bTabel FOR Tabel. FIND bAS NO-LOCK WHERE RECID(bAS) = ipRecid NO-ERROR. IF NOT AVAILABLE bAS THEN RETURN. IF bAS.cStatus = 'E' THEN RETURN. ASSIGN cBenutzer = bAS.cFeld_2 iAufnr = bAS.iKey_1 iRuestArt = bAS.iKey_2 cFirma = bAS.Firma. FIND FIRST bTabel EXCLUSIVE-LOCK WHERE bTabel.Firma = cFirma AND bTabel.RecArt = 'wsLIEFERSCHEIN' AND bTabel.Sprcd = 1 AND bTabel.Int_1 = iAufnr AND bTabel.Int_3 = iRuestArt NO-WAIT NO-ERROR. IF NOT AVAILABLE bTabel THEN RETURN. DELETE bTabel. RETURN. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-BEREINIGEN_PALETTENDOKUMENT) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE BEREINIGEN_PALETTENDOKUMENT Procedure PROCEDURE BEREINIGEN_PALETTENDOKUMENT: /*------------------------------------------------------------------------------*/ /* Purpose: */ /* Parameters: */ /* Notes: */ /*------------------------------------------------------------------------------*/ DEFINE INPUT PARAMETER ipRecid AS RECID NO-UNDO. DEFINE VARIABLE iAufnr AS INTEGER NO-UNDO. DEFINE VARIABLE iRuestArt AS INTEGER NO-UNDO. DEFINE VARIABLE cFirma AS CHARACTER NO-UNDO. DEFINE BUFFER bAS FOR ASMutation. DEFINE BUFFER bTabel FOR Tabel. FIND bAS NO-LOCK WHERE RECID(bAS) = ipRecid NO-ERROR. IF NOT AVAILABLE bAS THEN RETURN. IF bAS.cStatus = 'E' THEN RETURN. ASSIGN cBenutzer = bAS.cFeld_2 iAufnr = bAS.iKey_1 iRuestArt = bAS.iKey_2 cFirma = bAS.Firma. FIND FIRST bTabel EXCLUSIVE-LOCK WHERE bTabel.Firma = cFirma AND bTabel.RecArt = 'wsPALETT' AND bTabel.Sprcd = 1 AND bTabel.Int_1 = iAufnr AND bTabel.Int_3 = iRuestArt NO-WAIT NO-ERROR. IF NOT AVAILABLE bTabel THEN RETURN. DELETE bTabel. RETURN. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-BEREINIGEN_RUESTDRUCK) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE BEREINIGEN_RUESTDRUCK Procedure PROCEDURE BEREINIGEN_RUESTDRUCK: /*------------------------------------------------------------------------------*/ /* Purpose: */ /* Parameters: */ /* Notes: */ /*------------------------------------------------------------------------------*/ DEFINE INPUT PARAMETER ipRecid AS RECID NO-UNDO. DEFINE VARIABLE iAufnr AS INTEGER NO-UNDO. DEFINE VARIABLE iRuestArt AS INTEGER NO-UNDO. DEFINE VARIABLE cFirma AS CHARACTER NO-UNDO. DEFINE BUFFER bAS FOR ASMutation. DEFINE BUFFER bTabel FOR Tabel. FIND bAS NO-LOCK WHERE RECID(bAS) = ipRecid NO-ERROR. IF NOT AVAILABLE bAS THEN RETURN. IF bAS.cStatus = 'E' THEN RETURN. ASSIGN cBenutzer = bAS.cFeld_2 iAufnr = bAS.iKey_1 iRuestArt = bAS.iKey_2 cFirma = bAS.Firma. FIND FIRST bTabel EXCLUSIVE-LOCK WHERE bTabel.Firma = cFirma AND bTabel.RecArt = 'AUFDRUCK' AND bTabel.Sprcd = 1 AND bTabel.Int_1 = iAufnr AND bTabel.Int_3 = iRuestArt NO-WAIT NO-ERROR. IF NOT AVAILABLE bTabel THEN RETURN. DELETE bTabel. RETURN. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-DRUCKEN_LADEPAPIER) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DRUCKEN_LADEPAPIER Procedure PROCEDURE DRUCKEN_LADESCHEIN: /*------------------------------------------------------------------------------*/ /* Purpose: */ /* Parameters: */ /* Notes: */ /*------------------------------------------------------------------------------*/ DEFINE INPUT PARAMETER ipRecid AS RECID NO-UNDO. DEFINE VARIABLE cRuester AS CHARACTER NO-UNDO. DEFINE VARIABLE iKopien AS INTEGER NO-UNDO. DEFINE VARIABLE iAufnr AS INTEGER NO-UNDO. DEFINE VARIABLE iPlatz AS INTEGER NO-UNDO. DEFINE VARIABLE iRuestArt AS INTEGER NO-UNDO. DEFINE VARIABLE ix AS INTEGER NO-UNDO. DEFINE VARIABLE cStockwerk AS CHARACTER INIT ';;;;;;;;;;' NO-UNDO. DEFINE VARIABLE cDruckProgramm AS CHARACTER NO-UNDO. DEFINE VARIABLE iRecid AS RECID NO-UNDO. DEFINE VARIABLE cString AS CHARACTER NO-UNDO. FIND ASMutation NO-LOCK WHERE RECID(ASMutation) = ipRecid. ASSIGN cRuester = ASMutation.cFeld_2 iAufnr = ASMutation.iKey_1 iRuestArt = ASMutation.iKey_2 Firma = ASMutation.Firma. FIND Aufko NO-LOCK USE-INDEX Aufko-k1 WHERE Aufko.Firma = Firma AND Aufko.Aufnr = iAufnr NO-ERROR. IF NOT AVAILABLE Aufko THEN RETURN ''. cDruckart = 'Ladeschein.r'. cDruckProgramm = DYNAMIC-FUNCTION('getDruckProgramm':U) NO-ERROR. IF cDruckProgramm = '' THEN RETURN 'ERROR;Fehler! Kein Programm für den Ausdruck gefunden'. REPEAT TRANSACTION ON ERROR UNDO, LEAVE: FIND LAST Tabel NO-LOCK WHERE Tabel.Firma = Firma AND Tabel.RecArt = 'wsLADEPAPIER' AND Tabel.CodeC = cRuester AND Tabel.Sprcd = 1 NO-ERROR. IF NOT AVAILABLE Tabel THEN ix = 1. ELSE ix = Tabel.CodeI + 1. CREATE Tabel. ASSIGN Tabel.Firma = Firma Tabel.RecArt = 'wsLADEPAPIER' Tabel.CodeC = cRuester Tabel.CodeI = ix Tabel.Sprcd = 1 Tabel.Int_1 = iAufnr Tabel.Int_2 = 3 Tabel.Int_3 = iRuestArt Tabel.Dec_1 = ASMutation.iFeld_1 Tabel.Dec_2 = 1 Tabel.Bez2 = cRuester. iRecid = RECID(Tabel). RELEASE Tabel. LEAVE. END. cString = SUBSTITUTE('Programm &1/&2 gestartet mit Aufnr &3, Rüstart &4, Benutzer &5', cDruckProgramm, 'wsLADEPAPIER', iAufnr, iRuestArt, cRuester). RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, cString ) NO-ERROR. RUN VALUE(cDruckProgramm) NO-ERROR. RETURN RETURN-VALUE. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-DRUCKEN_LIEFERSCHEIN) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DRUCKEN_LIEFERSCHEIN Procedure PROCEDURE DRUCKEN_LIEFERSCHEIN: /*------------------------------------------------------------------------------*/ /* Purpose: */ /* Parameters: */ /* Notes: */ /*------------------------------------------------------------------------------*/ DEFINE INPUT PARAMETER ipRecid AS RECID NO-UNDO. DEFINE VARIABLE cRuester AS CHARACTER NO-UNDO. DEFINE VARIABLE iKopien AS INTEGER NO-UNDO. DEFINE VARIABLE iAufnr AS INTEGER NO-UNDO. DEFINE VARIABLE iPlatz AS INTEGER NO-UNDO. DEFINE VARIABLE iRuestArt AS INTEGER NO-UNDO. DEFINE VARIABLE ix AS INTEGER NO-UNDO. DEFINE VARIABLE cStockwerk AS CHARACTER INIT ';;;;;;;;;' NO-UNDO. DEFINE VARIABLE cDruckProgramm AS CHARACTER NO-UNDO. DEFINE VARIABLE iRecid AS RECID NO-UNDO. DEFINE VARIABLE lSammFak AS LOG NO-UNDO. DEFINE VARIABLE cResult AS CHARACTER NO-UNDO. DEFINE VARIABLE cString AS CHARACTER NO-UNDO. DEFINE BUFFER bViperDoc FOR ViperDoc. FIND ASMutation NO-LOCK WHERE RECID(ASMutation) = ipRecid. ASSIGN cRuester = ASMutation.cFeld_2 iAufnr = ASMutation.iKey_1 iRuestArt = ASMutation.iKey_2 Firma = ASMutation.Firma. FIND Aufko NO-LOCK USE-INDEX Aufko-k1 WHERE Aufko.Firma = Firma AND Aufko.Aufnr = iAufnr NO-ERROR. IF NOT AVAILABLE Aufko THEN RETURN ''. EMPTY TEMP-TABLE tParam. CREATE tParam. FIND Steuer NO-LOCK WHERE Steuer.Firma = Firma. ASSIGN iRuestArt = Steuer.RuestArt. ASSIGN tParam.cFirma = Aufko.Firma tParam.iRecid = RECID(Aufko) tParam.iAufnr = iAufnr tParam.iKnr = Aufko.Knr tParam.iFak_Knr = Aufko.Fak_Knr tParam.iFakArt = Aufko.Fak_Art tParam.iAufSta = Aufko.Auf_Sta tParam.cBenutzer = DYNAMIC-FUNCTION('getBenutzer':U) tParam.cDBUser = DYNAMIC-FUNCTION('getDBUser':U) tParam.cWinUser = DYNAMIC-FUNCTION('getSysUser':U) tParam.cInstall = DYNAMIC-FUNCTION('getInstallation':U) tParam.lPreis = FALSE tParam.lBatch = TRUE tParam.Programm = ''. IF ASMutation.iFeld_1 = 1 THEN DO: /* Abschluss (Ablieferung Fahrer) */ ASSIGN tParam.cBenutzer = 'Fahrer' tParam.cDBUser = 'Fahrer' tParam.cWinUser = 'Fahrer'. END. IF Aufko.AlsOfferte THEN RETURN 'Error;Offerte'. FIND FIRST Tabel NO-LOCK WHERE Tabel.Firma = tParam.cFirma AND Tabel.RecArt = 'FAKART' AND Tabel.CodeI = Aufko.Fak_Art NO-ERROR. IF NOT AVAILABLE Tabel THEN RETURN ''. tParam.cDokument = Tabel.Bez2. lSammFak = (IF Tabel.Int_3 = 4 THEN TRUE ELSE FALSE). IF lSammFak THEN RETURN 'Error;Sammelrechnung'. iVDRecid = ?. DO ix = 1 TO 3: CASE ix: WHEN 1 THEN cUser = tParam.cBenutzer. WHEN 2 THEN cUser = tParam.cDBUser. WHEN 3 THEN cUser = tParam.cWinUser. END CASE. FIND FIRST ViperDoc NO-LOCK WHERE ViperDoc.Firma = Aufko.Firma AND ViperDoc.Benutzer = cUser AND ViperDoc.Formular = tParam.cDokument AND ViperDoc.DokArt = 0 NO-ERROR. IF AVAILABLE ViperDoc THEN DO: iVDRecid = RECID(ViperDoc). LEAVE. END. END. DO WHILE iVDRecid = ?: FIND FIRST ViperDoc NO-LOCK WHERE ViperDoc.Firma = Aufko.Firma AND ViperDoc.Formular = tParam.cDokument AND ViperDoc.DokArt = 0 NO-ERROR. IF NOT AVAILABLE ViperDoc THEN RETURN ''. REPEAT TRANSACTION ON ERROR UNDO, LEAVE: CREATE bViperDoc. BUFFER-COPY ViperDoc EXCEPT Benutzer TO bViperDoc ASSIGN bViperDoc.Benutzer = tParam.cBenutzer. iVDRecid = RECID(bViperDoc). RELEASE bViperDoc. RELEASE ViperDoc. LEAVE. END. LEAVE. END. FIND ViperDoc NO-LOCK WHERE RECID(ViperDoc) = iVDRecid. ASSIGN tParam.iVDRecid = iVDRecid tParam.Programm = ViperDoc.Programm tParam.Anzahl = ViperDoc.Anzahl tParam.Drucker = ViperDoc.Drucker tParam.lCreatePDF = ViperDoc.lCreatePDF tParam.lDokDruck = ViperDoc.lDokDruck tParam.lSendMail = FALSE. RELEASE Aufko. RELEASE ViperDoc. RELEASE Tabel. cDruckProgramm = SUBSTITUTE('DruckProgramme/&1/&2', tParam.cInstall, tParam.Programm ). cDruckProgramm = SEARCH(cDruckProgramm). IF cDruckProgramm = ? THEN RETURN 'ERROR;Fehler! Kein Programm für den Ausdruck gefunden'. cString = SUBSTITUTE('Programm &1 gestartet mit Aufnr &2, Benutzer &3', cDruckProgramm, tParam.iAufnr, tParam.cBenutzer). RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, cString ) NO-ERROR. RUN VALUE(cDruckProgramm) ( htParam, OUTPUT cResult ). IF cResult BEGINS 'ERROR' THEN RETURN cResult. IF ASMutation.iFeld_1 <> 1 THEN RETURN cResult. DO WHILE TRUE: /* Mailversand bei Nettokunden mit LS-Mailadresse */ FIND FIRST tParam. FIND Aufko NO-LOCK WHERE Aufko.Firma = tParam.cFirma AND Aufko.Aufnr = tParam.iAufnr NO-ERROR. FIND FIRST Ansprech NO-LOCK WHERE Ansprech.Firma = AdFirma AND Ansprech.Knr = Aufko.Knr AND Ansprech.Lieferschein = TRUE NO-ERROR. IF NOT AVAILABLE Ansprech THEN LEAVE. FIND Debst NO-LOCK WHERE Debst.Firma = Aufko.Firma AND Debst.Knr = Aufko.Knr NO-ERROR. RUN FIND_PREISGRUPPE ( Debst.Preis_Grp, OUTPUT cString ) NO-ERROR. IF NUM-ENTRIES(cString, CHR(01)) < 4 THEN LEAVE. IF INTEGER(ENTRY(3, cString, CHR(01))) > 0 THEN LEAVE. /* 0 = Nettokunde (exkl. Mwst) */ RUN SEND_MAIL ( Aufko.Knr, Aufko.Aufnr, Aufko.Lief_Datum, Ansprech.Mail, Ansprech.Sprcd ) NO-ERROR. RELEASE Aufko . RELEASE Ansprech. RELEASE Debst. LEAVE. END. RETURN cResult. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-DRUCKEN_PALETTENDOKUMENT) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DRUCKEN_PALETTENDOKUMENT Procedure PROCEDURE DRUCKEN_PALETTENSCHEIN: /*------------------------------------------------------------------------------*/ /* Purpose: */ /* Parameters: */ /* Notes: */ /*------------------------------------------------------------------------------*/ DEFINE INPUT PARAMETER ipRecid AS RECID NO-UNDO. DEFINE VARIABLE cRuester AS CHARACTER NO-UNDO. DEFINE VARIABLE iKopien AS INTEGER NO-UNDO. DEFINE VARIABLE iAufnr AS INTEGER NO-UNDO. DEFINE VARIABLE iPlatz AS INTEGER NO-UNDO. DEFINE VARIABLE iRuestArt AS INTEGER NO-UNDO. DEFINE VARIABLE ix AS INTEGER NO-UNDO. DEFINE VARIABLE cStockwerk AS CHARACTER INIT ';;;;;;;;;' NO-UNDO. DEFINE VARIABLE cDruckProgramm AS CHARACTER NO-UNDO. DEFINE VARIABLE iRecid AS RECID NO-UNDO. DEFINE VARIABLE cString AS CHARACTER NO-UNDO. FIND ASMutation NO-LOCK WHERE RECID(ASMutation) = ipRecid. ASSIGN cRuester = ASMutation.cFeld_2 iPlatz = ASMutation.iFeld_1 iKopien = ASMutation.iFeld_2 iAufnr = ASMutation.iKey_1 iRuestArt = ASMutation.iKey_2 Firma = ASMutation.Firma. FIND Aufko NO-LOCK USE-INDEX Aufko-k1 WHERE Aufko.Firma = Firma AND Aufko.Aufnr = iAufnr NO-ERROR. IF NOT AVAILABLE Aufko THEN RETURN ''. cDruckart = 'Palettenschein.r'. cDruckProgramm = DYNAMIC-FUNCTION('getDruckProgramm':U) NO-ERROR. IF cDruckProgramm = '' THEN RETURN 'ERROR;Fehler! Kein Programm für den Ausdruck gefunden'. REPEAT TRANSACTION ON ERROR UNDO, LEAVE: FIND LAST Tabel NO-LOCK WHERE Tabel.Firma = Firma AND Tabel.RecArt = 'wsPALETT' AND Tabel.CodeC = ASMutation.cFeld_2 AND Tabel.Sprcd = 1 NO-ERROR. IF NOT AVAILABLE Tabel THEN ix = 1. ELSE ix = Tabel.CodeI + 1. CREATE Tabel. ASSIGN Tabel.Firma = Firma Tabel.RecArt = 'wsPALETT' Tabel.CodeC = ASMutation.cFeld_2 Tabel.CodeI = ix Tabel.Sprcd = 1 Tabel.Int_1 = iAufnr Tabel.Int_2 = 2 Tabel.Int_3 = iRuestArt Tabel.Dec_1 = iPlatz Tabel.Dec_2 = (IF iKopien > 10 THEN 1 ELSE iKopien) Tabel.Bez2 = cRuester. iRecid = RECID(Tabel). RELEASE Tabel. LEAVE. END. cString = SUBSTITUTE('Programm &1/&2 gestartet mit Aufnr &3, Rüstart &4, Rüstplatz &5, Benutzer &6', cDruckProgramm, 'wsPALETT', iAufnr, iRuestArt, iPlatz, cRuester). RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, cString ) NO-ERROR. RUN VALUE(cDruckProgramm) NO-ERROR. RETURN RETURN-VALUE. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-DRUCKEN_RUESTSCHEIN) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DRUCKEN_RUESTSCHEIN Procedure PROCEDURE DRUCKEN_RUESTSCHEIN: /*------------------------------------------------------------------------------*/ /* Purpose: */ /* Parameters: */ /* Notes: */ /*------------------------------------------------------------------------------*/ DEFINE INPUT PARAMETER ipRecid AS RECID NO-UNDO. DEFINE VARIABLE iKopien AS INTEGER NO-UNDO. DEFINE VARIABLE iAufnr AS INTEGER NO-UNDO. DEFINE VARIABLE iPlatz AS INTEGER NO-UNDO. DEFINE VARIABLE iRuestArt AS INTEGER NO-UNDO. DEFINE VARIABLE ix AS INTEGER NO-UNDO. DEFINE VARIABLE cStockwerk AS CHARACTER INIT ';;;;;;;;;' NO-UNDO. DEFINE VARIABLE cDruckProgramm AS CHARACTER NO-UNDO. DEFINE VARIABLE iRecid AS RECID NO-UNDO. DEFINE VARIABLE cString AS CHARACTER NO-UNDO. DEFINE VARIABLE cStatus AS CHARACTER NO-UNDO. FIND ASMutation NO-LOCK WHERE RECID(ASMutation) = ipRecid. ASSIGN cBenutzer = ASMutation.cFeld_2 iAufnr = ASMutation.iKey_1 iRuestArt = ASMutation.iKey_2 Firma = ASMutation.Firma cStatus = ASMutation.cFeld_3. FIND Aufko NO-LOCK USE-INDEX Aufko-k1 WHERE Aufko.Firma = Firma AND Aufko.Aufnr = iAufnr NO-ERROR. IF NOT AVAILABLE Aufko THEN RETURN ''. cDruckart = 'Auftragsschein.r'. cDruckProgramm = DYNAMIC-FUNCTION('getDruckProgramm':U) NO-ERROR. IF cDruckProgramm = '' THEN RETURN 'ERROR;Fehler! Kein Programm für den Ausdruck gefunden'. REPEAT TRANSACTION: FIND LAST Tabel NO-LOCK WHERE Tabel.Firma = Firma AND Tabel.RecArt = 'AUFDRUCK' AND Tabel.CodeC = cBenutzer AND Tabel.Sprcd = 1 NO-ERROR. IF NOT AVAILABLE Tabel THEN ix = 1. ELSE ix = Tabel.CodeI + 1. CREATE Tabel. ASSIGN Tabel.Firma = Firma Tabel.RecArt = 'AUFDRUCK' Tabel.CodeC = cBenutzer Tabel.CodeI = ix Tabel.Sprcd = 1 Tabel.Int_1 = iAufnr Tabel.Int_2 = 1 Tabel.Int_3 = iRuestArt Tabel.Dec_1 = 0 Tabel.Dec_2 = 1 Tabel.Bez2 = cBenutzer Tabel.Flag_3 = (IF ASMutation.cFeld_2 = 'TRIGGER' THEN FALSE ELSE TRUE). iRecid = RECID(Tabel). RELEASE Tabel. LEAVE. END. RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, ASMutation.cFeld_2 ) NO-ERROR. cString = SUBSTITUTE('Programm &1 (Auftragspapier/Rüstschein) gestartet mit Aufnr &2, Rüstart &3, Benutzer &4', cDruckProgramm, iAufnr, iRuestArt, cBenutzer). RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, cString ) NO-ERROR. REPEAT TRANSACTION: RUN VALUE(cDruckProgramm) NO-ERROR. LEAVE. END. RETURN RETURN-VALUE. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-REORG_ASMUTATION) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE REORG_ASMUTATION Procedure PROCEDURE REORG_ASMUTATION: /*------------------------------------------------------------------------------*/ /* Purpose: */ /* Parameters: */ /* Notes: */ /*------------------------------------------------------------------------------*/ cMessage = 'Reorg ASMutation gestartet'. RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, cMessage ) NO-ERROR. FOR EACH ASMutation WHERE ASMutation.Datum = ? TRANSACTION: ASMutation.Datum = TODAY. END. FOR EACH ASMutation WHERE ASMutation.Aktiv = FALSE AND ASMutation.cStatus = 'E' AND ASMutation.Datum < (TODAY - 30) TRANSACTION: DELETE ASMutation. END. FOR EACH ASMutation WHERE ASMutation.Aktiv = TRUE AND ASMutation.cStatus <> '' AND ASMutation.Datum < (TODAY - 30) TRANSACTION: DELETE ASMutation. END. FOR EACH ASMutation WHERE ASMutation.Aktiv = TRUE AND ASMutation.cStatus <> '' TRANSACTION: ASMutation.cStatus = ''. END. FOR EACH Tabel WHERE Tabel.Firma = Firma AND Tabel.RecArt = 'GERUEST': FIND Aufko NO-LOCK WHERE Aufko.Firma = Tabel.Firma AND Aufko.Aufnr = Tabel.CodeI NO-ERROR. IF AVAILABLE Aufko THEN NEXT. DELETE Tabel. END. cMessage = 'Reorg ASMutation beendet'. RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, cMessage ) NO-ERROR. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-REORG_TABELLEN) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE REORG_TABELLEN Procedure PROCEDURE REORG_TABELLEN: /*------------------------------------------------------------------------------*/ /* Purpose: */ /* Parameters: */ /* Notes: */ /*------------------------------------------------------------------------------*/ DEFINE VARIABLE iRecid AS RECID NO-UNDO. DEFINE VARIABLE iAnz AS INTEGER NO-UNDO. DEFINE BUFFER bRuestAuf FOR RuestAuf. DEFINE BUFFER bTabel FOR Tabel. cMessage = 'Reorg Tabellen gestartet'. RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, cMessage ) NO-ERROR. iAnz = 0. FOR EACH RuestAuf NO-LOCK WHERE RuestAuf.Firma = Firma AND iAnz < 100: FIND Aufko NO-LOCK WHERE Aufko.Firma = RuestAuf.Firma AND Aufko.Aufnr = RuestAuf.Aufnr NO-ERROR. IF AVAILABLE Aufko THEN NEXT. FIND bRuestAuf WHERE RECID(bRuestAuf) = RECID(RuestAuf). DELETE RuestAuf. iAnz = iAnz + 1. END. RELEASE bRuestAuf. FOR EACH Tabel NO-LOCK WHERE Tabel.Firma = Firma AND Tabel.RecArt = 'AUFDRUCK' AND iAnz < 100: iRecid = Tabel.Int_3. FIND Aufko NO-LOCK WHERE RECID(Aufko) = iRecid NO-ERROR. IF AVAILABLE Aufko THEN NEXT. FIND bTabel WHERE RECID(bTabel) = RECID(Tabel) NO-ERROR. IF AVAILABLE bTabel THEN DELETE bTabel. iAnz = iAnz + 1. END. RELEASE bTabel. cMessage = 'Reorg Tabellen beendet'. RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, cMessage ) NO-ERROR. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-SEND_MAIL) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE SEND_MAIL Procedure PROCEDURE SEND_MAIL: /*------------------------------------------------------------------------------*/ /* Purpose: */ /* Parameters: */ /* Notes: */ /*------------------------------------------------------------------------------*/ DEFINE INPUT PARAMETER ipiKnr AS INTEGER NO-UNDO. DEFINE INPUT PARAMETER ipiAufnr AS INTEGER NO-UNDO. DEFINE INPUT PARAMETER ipdDatum AS DATE NO-UNDO. DEFINE INPUT PARAMETER ipcMail AS CHARACTER NO-UNDO. DEFINE INPUT PARAMETER ipiSprcd AS INTEGER NO-UNDO. DEFINE VARIABLE cTo AS CHARACTER NO-UNDO. DEFINE VARIABLE cCC AS CHARACTER NO-UNDO. DEFINE VARIABLE cFrom AS CHARACTER NO-UNDO. DEFINE VARIABLE lRetValue AS LOG NO-UNDO. DEFINE VARIABLE cMeldung AS CHARACTER NO-UNDO. DEFINE VARIABLE cSubject AS CHARACTER NO-UNDO. DEFINE VARIABLE cBody AS CHARACTER NO-UNDO. DEFINE VARIABLE lBody AS LONGCHAR NO-UNDO. DEFINE VARIABLE cBodyName AS CHARACTER NO-UNDO. DEFINE VARIABLE cPDFName AS CHARACTER NO-UNDO. DEFINE VARIABLE ii AS INTEGER NO-UNDO. FIND FIRST tParam. cTo = ipcMail. cBodyName = SUBSTITUTE ('DruckProgramme/&1/Mail-Lieferschein-&2.html', cInstallation, ipiSprcd ). cPDFName = SUBSTITUTE (cMailVersandPathLS, STRING(ipiKnr,'999999'), STRING(ipiAufnr,'9999999'), 'Lieferschein'). IF cTo = '' THEN RETURN. IF INDEX(cTo, '@') = 0 THEN RETURN. /* cFrom = cMailFromLS.*/ cSubject = SUBSTITUTE('Lieferschein &1 vom &2', ipiAufnr, STRING(ipdDatum,'99.99.9999') ). COPY-LOB FROM FILE cBodyName TO lBody. cBody = lBody. ii = 0. FOR EACH Ansprech NO-LOCK WHERE Ansprech.Firma = AdFirma AND Ansprech.Knr = tParam.iKnr AND Ansprech.Lieferschein = TRUE AND Ansprech.Mail <> '' AND INDEX(Ansprech.Mail, '@') > 0 : ii = ii + 1. IF ii = 1 THEN DO: cBody = SUBSTITUTE(cBody, Ansprech.BriefAnr ) NO-ERROR. cTo = Ansprech.Mail. END. ELSE DO: cCC = cCC + (IF cCC = '' THEN '' ELSE ';') + Ansprech.Mail. END. END. cCC = cCC + (IF cCC = '' THEN '' ELSE ';') + cMailCCLS. RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, SUBSTITUTE ('Mail in ASMutation From &1 TO &2 CC &3 &5 Subject &4 ', cFrom, cTo, cCC, cSubject ) ). FIND FIRST ASMutation NO-LOCK WHERE ASMutation.Firma = Firma AND ASMutation.Aktiv = TRUE AND ASMutation.cStatus = '' AND ASMutation.MutArt = 'MAIL' AND ASMutation.cKey_2 = cPDFName AND ASMutation.Aktiv = TRUE AND ASMutation.cStatus = '' NO-ERROR. IF AVAILABLE ASMutation THEN RETURN cMeldung. REPEAT TRANSACTION ON ERROR UNDO, LEAVE: CREATE ASMutation. ASSIGN ASMutation.asmutation_id = NEXT-VALUE(asmutation_id) ASMutation.MutArt = 'MAIL' ASMutation.Aktiv = TRUE ASMutation.cStatus = '' ASMutation.Datum = TODAY ASMutation.Firma = tParam.cFirma ASMutation.cFeld_1 = SUBSTITUTE('TO:&1;CC:&2', cTo, cCC) ASMutation.cFeld_2 = cSubject ASMutation.cFeld_3 = cBody ASMutation.cKey_1 = '' ASMutation.cKey_2 = cPDFName ASMutation.cKey_3 = 'LIEFERSCHEIN' ASMutation.iFeld_1 = TIME. RELEASE ASMutation. LEAVE. END. RETURN cMeldung. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF