&ANALYZE-SUSPEND _VERSION-NUMBER AB_v10r12 GUI ADM2 &ANALYZE-RESUME &Scoped-define WINDOW-NAME wBatch {adecomm/appserv.i} &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS wBatch /*------------------------------------------------------------------------ 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 lBatch AS LOG NO-UNDO. DEF VAR cLogName AS CHAR NO-UNDO. 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 getDruckProgramm wBatch FUNCTION getDruckProgramm RETURNS CHARACTER ( /* parameter-definitions */ ) FORWARD. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getLogName wBatch FUNCTION getLogName RETURNS CHARACTER ( /* parameter-definitions */ ) FORWARD. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getProgname wBatch FUNCTION getProgname RETURNS CHARACTER ( /* parameter-definitions */ ) FORWARD. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD writeLogFile wBatch 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 wBatch 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 wBatch ASSIGN HIDDEN = YES TITLE = "Bachtverarbeitung" 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 wBatch: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 wBatch /* ************************* 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 wBatch 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(wBatch) THEN wBatch:HIDDEN = YES. /* _RUN-TIME-ATTRIBUTES-END */ &ANALYZE-RESUME /* ************************ Control Triggers ************************ */ &Scoped-define SELF-NAME wBatch &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL wBatch wBatch ON WINDOW-CLOSE OF wBatch /* Bachtverarbeitung */ 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 wBatch /* *************************** 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 iAblauf AS INT NO-UNDO. DEF VAR cMessage AS CHAR 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. RUN BEREINIGEN_BATCH. cMessage = 'Batch bereinigt'. DYNAMIC-FUNCTION('writeLogFile':U, cMessage) NO-ERROR. 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 AND lBatch = TRUE THEN RUN ENDE. /* ordentliches beenden (wenn lBatch = TRUE) 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 = '' AND ASMutation.MutArt <> 'MAIL' 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 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 = 'NULL'. FIND ASMutation NO-LOCK WHERE RECID(ASMutation) = iRecid. CASE ASMutation.MutArt: WHEN 'RUESTDRUCK' THEN RUN DRUCKEN_RUESTSCHEIN ( iRecid ). WHEN 'wsLADEPAPIER' THEN RUN DRUCKEN_LADEPAPIER ( iRecid ). WHEN 'wsPALETT' THEN RUN DRUCKEN_PALETTENDOKUMENT ( iRecid ). WHEN 'wsLIEFERSCHEIN' THEN RUN DRUCKEN_LIEFERSCHEIN ( iRecid ). END CASE. cRetVal = RETURN-VALUE. RUN viewObject. IF cRetVal BEGINS 'ERROR' THEN DO: IF lBatch THEN DO: cMessage = SUBSTITUTE('Fehler &1 beim Drucken 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. 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. 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 wBatch _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 BEREINIGEN_BATCH wBatch PROCEDURE BEREINIGEN_BATCH : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DEF VAR iRecid AS RECID NO-UNDO. DEF BUFFER bASMutation FOR ASMutation. 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: MESSAGE 'ASMutation ist locked' VIEW-AS ALERT-BOX. NEXT. END. IF NOT AVAILABLE bASMutation THEN LEAVE. DELETE bASMutation. LEAVE. END. END. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE BEREINIGEN_LADEPAPIER wBatch PROCEDURE BEREINIGEN_LADEPAPIER : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DEF INPUT PARAMETER ipRecid AS RECID NO-UNDO. DEF VAR iAufnr AS INT NO-UNDO. DEF VAR cBenutzer AS CHAR NO-UNDO. DEF VAR iRuestArt AS INT NO-UNDO. DEF VAR cFirma AS CHAR NO-UNDO. DEF BUFFER bAS FOR ASMutation. DEF 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 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE BEREINIGEN_LIEFERSCHEIN wBatch PROCEDURE BEREINIGEN_LIEFERSCHEIN : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DEF INPUT PARAMETER ipRecid AS RECID NO-UNDO. DEF VAR iAufnr AS INT NO-UNDO. DEF VAR cBenutzer AS CHAR NO-UNDO. DEF VAR iRuestArt AS INT NO-UNDO. DEF VAR cFirma AS CHAR NO-UNDO. DEF BUFFER bAS FOR ASMutation. DEF 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 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE BEREINIGEN_PALETTENDOKUMENT wBatch PROCEDURE BEREINIGEN_PALETTENDOKUMENT : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DEF INPUT PARAMETER ipRecid AS RECID NO-UNDO. DEF VAR iAufnr AS INT NO-UNDO. DEF VAR cBenutzer AS CHAR NO-UNDO. DEF VAR iRuestArt AS INT NO-UNDO. DEF VAR cFirma AS CHAR NO-UNDO. DEF BUFFER bAS FOR ASMutation. DEF 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 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE BEREINIGEN_RUESTDRUCK wBatch PROCEDURE BEREINIGEN_RUESTDRUCK : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DEF INPUT PARAMETER ipRecid AS RECID NO-UNDO. DEF VAR iAufnr AS INT NO-UNDO. DEF VAR cBenutzer AS CHAR NO-UNDO. DEF VAR iRuestArt AS INT NO-UNDO. DEF VAR cFirma AS CHAR NO-UNDO. DEF BUFFER bAS FOR ASMutation. DEF 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 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI wBatch _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(wBatch) THEN DELETE WIDGET wBatch. IF THIS-PROCEDURE:PERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DRUCKEN_LADEPAPIER wBatch PROCEDURE DRUCKEN_LADEPAPIER : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DEF INPUT PARAMETER ipRecid AS RECID NO-UNDO. DEF VAR cRuester AS CHAR NO-UNDO. DEF VAR iKopien AS INT NO-UNDO. DEF VAR iAufnr AS INT NO-UNDO. DEF VAR iPlatz AS INT NO-UNDO. DEF VAR iRuestArt AS INT NO-UNDO. DEF VAR ix AS INT NO-UNDO. DEF VAR cStockwerk AS CHAR INIT ';;;;;;;;;' NO-UNDO. DEF VAR cProgname AS CHAR NO-UNDO. DEF VAR cDruckProgramm AS CHAR NO-UNDO. DEF VAR iRecid AS RECID NO-UNDO. DEF VAR cString AS CHAR 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 ''. 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 = '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). DYNAMIC-FUNCTION('writeLogFile':U, cString) NO-ERROR. RUN VALUE(cDruckProgramm) NO-ERROR. RETURN ''. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DRUCKEN_LIEFERSCHEIN wBatch PROCEDURE DRUCKEN_LIEFERSCHEIN : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DEF INPUT PARAMETER ipRecid AS RECID NO-UNDO. DEF VAR cRuester AS CHAR NO-UNDO. DEF VAR iKopien AS INT NO-UNDO. DEF VAR iAufnr AS INT NO-UNDO. DEF VAR iPlatz AS INT NO-UNDO. DEF VAR iRuestArt AS INT NO-UNDO. DEF VAR ix AS INT NO-UNDO. DEF VAR cStockwerk AS CHAR INIT ';;;;;;;;;' NO-UNDO. DEF VAR cProgname AS CHAR NO-UNDO. DEF VAR cDruckProgramm AS CHAR NO-UNDO. DEF VAR iRecid AS RECID NO-UNDO. DEF VAR lSammFak AS LOG NO-UNDO. DEF VAR cResult AS CHAR NO-UNDO. DEF VAR cInstallation AS CHAR NO-UNDO. DEF VAR cString AS CHAR NO-UNDO. DEF 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 ''. iAufnr = Aufko.Aufnr. F_Status = SUBSTITUTE('Lieferschein &1 wird gedruckt', Aufko.Aufnr). DISPLAY F_Status WITH FRAME {&FRAME-NAME}. 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. 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: 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. tParam.iVDRecid = iVDRecid. RELEASE Aufko. RELEASE ViperDoc. RELEASE Tabel. RUN 'g-druck-bestaetigung.w':U ( INPUT-OUTPUT htParam, OUTPUT cResult ). IF cResult <> 'OK' THEN RETURN ''. cInstallation = DYNAMIC-FUNCTION('getInstallation':U) NO-ERROR. cDruckProgramm = SUBSTITUTE('DruckProgramme/&1/&2', cInstallation, 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). DYNAMIC-FUNCTION('writeLogFile':U, cString) NO-ERROR. RUN VALUE(cDruckProgramm) ( htParam, OUTPUT cResult ). IF cResult BEGINS 'ERROR' THEN RETURN cResult. IF ASMutation.iFeld_1 <> 1 THEN RETURN cResult. RUN SEND_MAIL ( iAufnr, cResult ). RETURN cResult. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DRUCKEN_PALETTENDOKUMENT wBatch PROCEDURE DRUCKEN_PALETTENDOKUMENT : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DEF INPUT PARAMETER ipRecid AS RECID NO-UNDO. DEF VAR cRuester AS CHAR NO-UNDO. DEF VAR iKopien AS INT NO-UNDO. DEF VAR iAufnr AS INT NO-UNDO. DEF VAR iPlatz AS INT NO-UNDO. DEF VAR iRuestArt AS INT NO-UNDO. DEF VAR ix AS INT NO-UNDO. DEF VAR cStockwerk AS CHAR INIT ';;;;;;;;;' NO-UNDO. DEF VAR cProgname AS CHAR NO-UNDO. DEF VAR cDruckProgramm AS CHAR NO-UNDO. DEF VAR iRecid AS RECID NO-UNDO. DEF VAR cString AS CHAR 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 ''. 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 = '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). DYNAMIC-FUNCTION('writeLogFile':U, cString) NO-ERROR. RUN VALUE(cDruckProgramm) NO-ERROR. RETURN ''. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DRUCKEN_RUESTSCHEIN wBatch PROCEDURE DRUCKEN_RUESTSCHEIN : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DEF INPUT PARAMETER ipRecid AS RECID NO-UNDO. DEF VAR cBenutzer AS CHAR NO-UNDO. DEF VAR iKopien AS INT NO-UNDO. DEF VAR iAufnr AS INT NO-UNDO. DEF VAR iPlatz AS INT NO-UNDO. DEF VAR iRuestArt AS INT NO-UNDO. DEF VAR ix AS INT NO-UNDO. DEF VAR cStockwerk AS CHAR INIT ';;;;;;;;;' NO-UNDO. DEF VAR cProgname AS CHAR NO-UNDO. DEF VAR cDruckProgramm AS CHAR NO-UNDO. DEF VAR iRecid AS RECID NO-UNDO. DEF VAR cString AS CHAR 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. FIND Aufko NO-LOCK USE-INDEX Aufko-k1 WHERE Aufko.Firma = Firma AND Aufko.Aufnr = iAufnr NO-ERROR. IF NOT AVAILABLE Aufko THEN RETURN ''. 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. iRecid = RECID(Tabel). RELEASE Tabel. LEAVE. END. cString = SUBSTITUTE('Programm &1 (Auftragspapier/Rüstschein) gestartet mit Aufnr &2, Rüstart &3, Benutzer &4', cDruckProgramm, iAufnr, iRuestArt, cBenutzer). DYNAMIC-FUNCTION('writeLogFile':U, cString) NO-ERROR. RUN VALUE(cDruckProgramm) NO-ERROR. RETURN ''. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enableObject wBatch PROCEDURE enableObject : /*------------------------------------------------------------------------------ Purpose: Super Override Parameters: Notes: ------------------------------------------------------------------------------*/ { incl/winenableobject.i } RUN SUPER. /* Code placed here will execute AFTER standard behavior. */ RUN REORG_ASMUTATION. RUN REORG_TABELLEN. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enable_UI wBatch _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 wBatch. {&OPEN-BROWSERS-IN-QUERY-fMain} VIEW wBatch. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE ENDE wBatch 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. cMessage = SUBSTITUTE('Programm &1 beendet', ProgName). DYNAMIC-FUNCTION('writeLogFile':U, cMessage) 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 wBatch 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 wBatch 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 REORG_ASMUTATION wBatch PROCEDURE REORG_ASMUTATION : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ cMessage = 'Reorg ASMutation gestartet'. DYNAMIC-FUNCTION('writeLogFile':U, cMessage) NO-ERROR. 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'. DYNAMIC-FUNCTION('writeLogFile':U, cMessage) NO-ERROR. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE REORG_TABELLEN wBatch PROCEDURE REORG_TABELLEN : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DEF VAR iRecid AS RECID NO-UNDO. DEF VAR iAnz AS INT NO-UNDO. DEF BUFFER bRuestAuf FOR RuestAuf. DEF BUFFER bTabel FOR Tabel. cMessage = 'Reorg Tabellen gestartet'. DYNAMIC-FUNCTION('writeLogFile':U, cMessage) NO-ERROR. DO WITH FRAME {&FRAME-NAME}: F_Status:SCREEN-VALUE = 'Reorg Ruestauftraege in Bearbeitung ... '. 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. F_Status:SCREEN-VALUE = 'Reorg Tabellen in Bearbeitung ... '. 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. END. cMessage = 'Reorg Tabellen beendet'. DYNAMIC-FUNCTION('writeLogFile':U, cMessage) NO-ERROR. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE SEND_MAIL wBatch PROCEDURE SEND_MAIL : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DEF INPUT PARAMETER ipiAufnr AS INT NO-UNDO. DEF INPUT PARAMETER ipcPDF AS CHAR NO-UNDO. DEF VAR cTo AS CHAR NO-UNDO. DEF VAR lRetValue AS LOG NO-UNDO. DEF VAR cMeldung AS CHAR NO-UNDO. DEF VAR cSubject AS CHAR NO-UNDO. DEF VAR cBody AS CHAR NO-UNDO. FIND Aufko NO-LOCK USE-INDEX Aufko-k1 WHERE Aufko.Firma = Firma AND Aufko.Aufnr = ipiAufnr NO-ERROR. FIND Adresse NO-LOCK WHERE Adresse.Firma = AdFirma AND Adresse.Knr = Aufko.Knr NO-ERROR. cTo = Adresse.Mail. IF cTo = '' THEN RETURN. IF INDEX(cTo, '@') = 0 THEN RETURN. cSubject = SUBSTITUTE('Lieferschein &1 vom &2', Aufko.Aufnr, STRING(TODAY,'99.99.9999') ). cBody = SUBSTITUTE('Im Anhang den Lieferschein/die Rechnung von der Lieferung vom &1 ', STRING(TODAY,'99.99.9999') ). /* RUN "sendMail/smtpmail.p" ( 'mail.analytikdataprime.ch', /* cMailServer, /* mailserver */*/ cTo, /* TO: */ 'info@adprime.ch', /* From: */ 'walter.riechsteiner@adprime.ch', /* CC: */ 'Lieferschein.pdf:type=application/pdf', /* Attachment Name im Mail */ ipcPDF, /* Filename auf Local-Server */ cSubject, /* Subject */ cBody, /* Body */ 'type=text/html:charset=iso-8859-1:filetype=binary', /* MIMEHeader */ 'text/html', /* Body-Type */ 2, /* Prioritaet */ FALSE, /* Authentifizierung n”tig */ 'base64', /* Authentifizierungstype */ 'walter.riechsteiner', /* Benutzer */ 'habasch_009', /* Passwort */ OUTPUT lRetValue, /* Erfolgreich ? */ OUTPUT cMeldung /* Sendergebnistext */ ). RELEASE Aufko. */ RETURN cMeldung. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE viewObject wBatch 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 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE WARTEN wBatch PROCEDURE WARTEN : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DEF VAR iWait AS INT NO-UNDO. DEF VAR iHH AS INT NO-UNDO. DEF VAR iMM AS INT NO-UNDO. iHH = INTEGER(SUBSTRING(STRING(TIME,'HH:MM:SS'),01,02)). iMM = INTEGER(SUBSTRING(STRING(TIME,'HH:MM:SS'),04,02)). DO WITH FRAME {&FRAME-NAME}: F_Status:SCREEN-VALUE = '--> PAUSE <--'. END. DISCONNECT AnaDat NO-ERROR. IF iHH = 22 THEN iWait = (6 * 3600) - (iMM * 60). /* Wartezeit für Connect = 7 Std. */ IF iHH = 20 THEN iWait = (8 * 3600) - (iMM * 60). /* Wartezeit für Connect = 9 Std. */ PAUSE iWait NO-MESSAGE. DO WHILE NOT CONNECTED('AnaDat'): CONNECT -pf db_connect.pf NO-ERROR. PAUSE 1 NO-MESSAGE. END. RETURN. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME /* ************************ Function Implementations ***************** */ &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getDruckProgramm wBatch 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 wBatch 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 wBatch 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 wBatch 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