w-batch.w 50 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441
  1. &ANALYZE-SUSPEND _VERSION-NUMBER AB_v10r12 GUI ADM2
  2. &ANALYZE-RESUME
  3. &Scoped-define WINDOW-NAME wBatch
  4. {adecomm/appserv.i}
  5. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS wBatch
  6. /*------------------------------------------------------------------------
  7. File:
  8. Description: from cntnrwin.w - ADM SmartWindow Template
  9. Input Parameters:
  10. <none>
  11. Output Parameters:
  12. <none>
  13. History: New V9 Version - January 15, 1998
  14. ------------------------------------------------------------------------*/
  15. /* This .W file was created with the Progress AB. */
  16. /*----------------------------------------------------------------------*/
  17. /* Create an unnamed pool to store all the widgets created
  18. by this procedure. This is a good default which assures
  19. that this procedure's triggers and internal procedures
  20. will execute in this procedure's storage, and that proper
  21. cleanup will occur on deletion of the procedure. */
  22. CREATE WIDGET-POOL.
  23. /* *************************** Definitions ************************** */
  24. /* Parameters Definitions --- */
  25. /* Local Variable Definitions --- */
  26. DEF VAR cUser AS CHAR NO-UNDO.
  27. DEF VAR iBeg AS INT NO-UNDO.
  28. DEF VAR lBatch AS LOG NO-UNDO.
  29. DEF VAR cLogName AS CHAR NO-UNDO.
  30. DEF STREAM Out_Stream.
  31. DEF STREAM LogStream.
  32. { incl/windefinition.i }
  33. { incl/ttdruckparam.i }
  34. {src/adm2/widgetprto.i}
  35. /* _UIB-CODE-BLOCK-END */
  36. &ANALYZE-RESUME
  37. &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  38. /* ******************** Preprocessor Definitions ******************** */
  39. &Scoped-define PROCEDURE-TYPE SmartWindow
  40. &Scoped-define DB-AWARE no
  41. &Scoped-define ADM-CONTAINER WINDOW
  42. &Scoped-define ADM-SUPPORTED-LINKS Data-Target,Data-Source,Page-Target,Update-Source,Update-Target,Filter-target,Filter-Source
  43. /* Name of designated FRAME-NAME and/or first browse and/or first query */
  44. &Scoped-define FRAME-NAME fMain
  45. /* Standard List Definitions */
  46. &Scoped-Define ENABLED-OBJECTS F_Status
  47. /* Custom List Definitions */
  48. /* List-1,List-2,List-3,List-4,List-5,List-6 */
  49. /* _UIB-PREPROCESSOR-BLOCK-END */
  50. &ANALYZE-RESUME
  51. /* ************************ Function Prototypes ********************** */
  52. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getDruckProgramm wBatch
  53. FUNCTION getDruckProgramm RETURNS CHARACTER
  54. ( /* parameter-definitions */ ) FORWARD.
  55. /* _UIB-CODE-BLOCK-END */
  56. &ANALYZE-RESUME
  57. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getLogName wBatch
  58. FUNCTION getLogName RETURNS CHARACTER
  59. ( /* parameter-definitions */ ) FORWARD.
  60. /* _UIB-CODE-BLOCK-END */
  61. &ANALYZE-RESUME
  62. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getProgname wBatch
  63. FUNCTION getProgname RETURNS CHARACTER
  64. ( /* parameter-definitions */ ) FORWARD.
  65. /* _UIB-CODE-BLOCK-END */
  66. &ANALYZE-RESUME
  67. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD writeLogFile wBatch
  68. FUNCTION writeLogFile RETURNS LOGICAL
  69. ( ipMessage AS CHAR ) FORWARD.
  70. /* _UIB-CODE-BLOCK-END */
  71. &ANALYZE-RESUME
  72. /* *********************** Control Definitions ********************** */
  73. /* Define the widget handle for the window */
  74. DEFINE VAR wBatch AS WIDGET-HANDLE NO-UNDO.
  75. /* Definitions of the field level widgets */
  76. DEFINE VARIABLE F_Status AS CHARACTER FORMAT "X(256)":U
  77. LABEL "Status"
  78. VIEW-AS FILL-IN NATIVE
  79. SIZE 65 BY 1
  80. BGCOLOR 15 FONT 6 NO-UNDO.
  81. /* ************************ Frame Definitions *********************** */
  82. DEFINE FRAME fMain
  83. F_Status AT ROW 2.57 COL 12 COLON-ALIGNED WIDGET-ID 2 NO-TAB-STOP
  84. WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY
  85. SIDE-LABELS NO-UNDERLINE THREE-D
  86. AT COL 1 ROW 1
  87. SIZE 85.4 BY 5.52 WIDGET-ID 100.
  88. /* *********************** Procedure Settings ************************ */
  89. &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
  90. /* Settings for THIS-PROCEDURE
  91. Type: SmartWindow
  92. Allow: Basic,Browse,DB-Fields,Query,Smart,Window
  93. Container Links: Data-Target,Data-Source,Page-Target,Update-Source,Update-Target,Filter-target,Filter-Source
  94. Other Settings: COMPILE APPSERVER
  95. */
  96. &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
  97. /* ************************* Create Window ************************** */
  98. &ANALYZE-SUSPEND _CREATE-WINDOW
  99. IF SESSION:DISPLAY-TYPE = "GUI":U THEN
  100. CREATE WINDOW wBatch ASSIGN
  101. HIDDEN = YES
  102. TITLE = "Bachtverarbeitung"
  103. HEIGHT = 5.52
  104. WIDTH = 85.4
  105. MAX-HEIGHT = 30.48
  106. MAX-WIDTH = 160
  107. VIRTUAL-HEIGHT = 30.48
  108. VIRTUAL-WIDTH = 160
  109. RESIZE = NO
  110. SCROLL-BARS = NO
  111. STATUS-AREA = NO
  112. BGCOLOR = ?
  113. FGCOLOR = ?
  114. THREE-D = YES
  115. MESSAGE-AREA = NO
  116. SENSITIVE = YES.
  117. ELSE {&WINDOW-NAME} = CURRENT-WINDOW.
  118. &IF '{&WINDOW-SYSTEM}' NE 'TTY' &THEN
  119. IF NOT wBatch:LOAD-ICON("grafik/appl.ico":U) THEN
  120. MESSAGE "Unable to load icon: grafik/appl.ico"
  121. VIEW-AS ALERT-BOX WARNING BUTTONS OK.
  122. &ENDIF
  123. /* END WINDOW DEFINITION */
  124. &ANALYZE-RESUME
  125. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB wBatch
  126. /* ************************* Included-Libraries *********************** */
  127. {src/adm2/containr.i}
  128. /* _UIB-CODE-BLOCK-END */
  129. &ANALYZE-RESUME
  130. /* *********** Runtime Attributes and AppBuilder Settings *********** */
  131. &ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
  132. /* SETTINGS FOR WINDOW wBatch
  133. VISIBLE,,RUN-PERSISTENT */
  134. /* SETTINGS FOR FRAME fMain
  135. FRAME-NAME */
  136. /* SETTINGS FOR FILL-IN F_Status IN FRAME fMain
  137. NO-DISPLAY */
  138. ASSIGN
  139. F_Status:READ-ONLY IN FRAME fMain = TRUE.
  140. IF SESSION:DISPLAY-TYPE = "GUI":U AND VALID-HANDLE(wBatch)
  141. THEN wBatch:HIDDEN = YES.
  142. /* _RUN-TIME-ATTRIBUTES-END */
  143. &ANALYZE-RESUME
  144. /* ************************ Control Triggers ************************ */
  145. &Scoped-define SELF-NAME wBatch
  146. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL wBatch wBatch
  147. ON WINDOW-CLOSE OF wBatch /* Bachtverarbeitung */
  148. DO:
  149. /* This ADM code must be left here in order for the SmartWindow
  150. and its descendents to terminate properly on exit. */
  151. DEF VAR cMeldung AS CHAR NO-UNDO.
  152. DEF VAR ja AS LOG NO-UNDO.
  153. RUN ENDE.
  154. RETURN NO-APPLY.
  155. END.
  156. /* _UIB-CODE-BLOCK-END */
  157. &ANALYZE-RESUME
  158. &UNDEFINE SELF-NAME
  159. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK wBatch
  160. /* *************************** Main Block *************************** */
  161. DEF VAR iTime AS INT NO-UNDO.
  162. DEF VAR iRecId AS RECID NO-UNDO.
  163. DEF VAR cRetVal AS CHAR NO-UNDO.
  164. DEF VAR iTrnr AS INT INIT 0 NO-UNDO.
  165. DEF VAR iWoTag AS INT NO-UNDO.
  166. DEF VAR iHH AS INT NO-UNDO.
  167. DEF VAR iAblauf AS INT NO-UNDO.
  168. DEF VAR cMessage AS CHAR NO-UNDO.
  169. { incl/winmainblock.i }
  170. ASSIGN CURRENT-WINDOW = {&WINDOW-NAME}
  171. {&WINDOW-NAME}:KEEP-FRAME-Z-ORDER = YES
  172. THIS-PROCEDURE:CURRENT-WINDOW = {&WINDOW-NAME}.
  173. cUser = DYNAMIC-FUNCTION('getBenutzer') NO-ERROR.
  174. cLogName = DYNAMIC-FUNCTION('getLogName':U) NO-ERROR.
  175. lBatch = DYNAMIC-FUNCTION('getBatch':U) NO-ERROR.
  176. cMessage = SUBSTITUTE('Programm &1 gestartet', ProgName).
  177. DYNAMIC-FUNCTION('writeLogFile':U, cMessage) NO-ERROR.
  178. RUN createObjects.
  179. RUN initializeObject.
  180. iBeg = TIME.
  181. iTime = ETIME(TRUE).
  182. iTrnr = -1.
  183. RUN BEREINIGEN_BATCH.
  184. cMessage = 'Batch bereinigt'.
  185. DYNAMIC-FUNCTION('writeLogFile':U, cMessage) NO-ERROR.
  186. MAIN-BLOCK:
  187. REPEAT WITH FRAME {&FRAME-NAME}
  188. ON ERROR UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
  189. ON QUIT UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK :
  190. IF (TIME - iBeg) >= 285 AND
  191. lBatch = TRUE THEN RUN ENDE. /* ordentliches beenden (wenn lBatch = TRUE)
  192. nach 4min 45sek */
  193. F_Status:SCREEN-VALUE = 'warten auf Auftrag'.
  194. FIND FIRST ASMutation NO-LOCK USE-INDEX ASMutation-k2
  195. WHERE ASMutation.Aktiv = TRUE
  196. AND ASMutation.asmutation_id > iTrnr
  197. AND ASMutation.cStatus = ''
  198. AND ASMutation.MutArt <> 'MAIL' NO-ERROR.
  199. IF NOT AVAILABLE ASMutation THEN DO:
  200. iTrnr = -1.
  201. WAIT-FOR WINDOW-CLOSE OF THIS-PROCEDURE PAUSE 2.
  202. APPLY LASTKEY TO THIS-PROCEDURE.
  203. NEXT MAIN-BLOCK.
  204. END.
  205. iTime = ETIME(TRUE).
  206. iTrnr = ASMutation.asmutation_id.
  207. iRecid = RECID(ASMutation).
  208. F_Status:SCREEN-VALUE = 'Verarbeiten -> ' + ASMutation.MutArt.
  209. IF ASMutation.MutArt BEGINS 'RETOUREN' THEN NEXT.
  210. REPEAT TRANSACTION:
  211. FIND ASMutation EXCLUSIVE-LOCK
  212. WHERE RECID(ASMutation) = iRecid NO-WAIT NO-ERROR.
  213. IF NOT AVAILABLE ASMutation AND
  214. LOCKED ASMutation THEN NEXT MAIN-BLOCK.
  215. ASSIGN ASMutation.cStatus = 'A'.
  216. RELEASE ASMutation.
  217. LEAVE.
  218. END.
  219. cRetVal = 'NULL'.
  220. FIND ASMutation NO-LOCK WHERE RECID(ASMutation) = iRecid.
  221. CASE ASMutation.MutArt:
  222. WHEN 'RUESTDRUCK' THEN RUN DRUCKEN_RUESTSCHEIN ( iRecid ).
  223. WHEN 'wsLADEPAPIER' THEN RUN DRUCKEN_LADEPAPIER ( iRecid ).
  224. WHEN 'wsPALETT' THEN RUN DRUCKEN_PALETTENDOKUMENT ( iRecid ).
  225. WHEN 'wsLIEFERSCHEIN' THEN RUN DRUCKEN_LIEFERSCHEIN ( iRecid ).
  226. END CASE.
  227. cRetVal = RETURN-VALUE.
  228. RUN viewObject.
  229. IF cRetVal BEGINS 'ERROR' THEN DO:
  230. IF lBatch THEN DO:
  231. cMessage = SUBSTITUTE('Fehler &1 beim Drucken von &2', ENTRY(2, cRetVal, ';'), ASMutation.MutArt).
  232. DYNAMIC-FUNCTION('writeLogFile':U, cMessage) NO-ERROR.
  233. END.
  234. F_Status:SCREEN-VALUE = ASMutation.MutArt + ' -> ' + ENTRY(2, cRetVal, ';').
  235. PAUSE 10 NO-MESSAGE.
  236. iAblauf = 0.
  237. REPEAT TRANSACTION:
  238. FIND ASMutation EXCLUSIVE-LOCK
  239. WHERE RECID(ASMutation) = iRecid NO-WAIT NO-ERROR.
  240. IF NOT AVAILABLE ASMutation AND
  241. LOCKED ASMutation THEN DO:
  242. PAUSE 1 NO-MESSAGE.
  243. iAblauf = iAblauf + 1.
  244. IF iAblauf >= 10 THEN LEAVE.
  245. NEXT.
  246. END.
  247. CASE ASMutation.MutArt:
  248. WHEN 'wsLIEFERSCHEIN' THEN DO:
  249. ASSIGN ASMutation.Aktiv = FALSE
  250. ASMutation.cStatus = 'E'.
  251. END.
  252. OTHERWISE DO:
  253. ASSIGN ASMutation.cStatus = ''
  254. ASMutation.Aktiv = TRUE.
  255. END.
  256. END CASE.
  257. RELEASE ASMutation.
  258. LEAVE.
  259. END.
  260. WAIT-FOR WINDOW-CLOSE OF THIS-PROCEDURE PAUSE 1.
  261. APPLY LASTKEY TO THIS-PROCEDURE.
  262. NEXT MAIN-BLOCK.
  263. END.
  264. ELSE DO:
  265. iAblauf = 0.
  266. REPEAT TRANSACTION:
  267. FIND ASMutation EXCLUSIVE-LOCK
  268. WHERE RECID(ASMutation) = iRecid NO-WAIT NO-ERROR.
  269. IF NOT AVAILABLE ASMutation AND
  270. LOCKED ASMutation THEN DO:
  271. PAUSE 1 NO-MESSAGE.
  272. iAblauf = iAblauf + 1.
  273. IF iAblauf >= 10 THEN LEAVE.
  274. NEXT.
  275. END.
  276. ASSIGN ASMutation.cStatus = 'E'
  277. ASMutation.Aktiv = FALSE.
  278. RELEASE ASMutation.
  279. LEAVE.
  280. END.
  281. END.
  282. WAIT-FOR WINDOW-CLOSE OF THIS-PROCEDURE PAUSE 1.
  283. APPLY LASTKEY TO THIS-PROCEDURE.
  284. END.
  285. /* _UIB-CODE-BLOCK-END */
  286. &ANALYZE-RESUME
  287. /* ********************** Internal Procedures *********************** */
  288. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE adm-create-objects wBatch _ADM-CREATE-OBJECTS
  289. PROCEDURE adm-create-objects :
  290. /*------------------------------------------------------------------------------
  291. Purpose: Create handles for all SmartObjects used in this procedure.
  292. After SmartObjects are initialized, then SmartLinks are added.
  293. Parameters: <none>
  294. ------------------------------------------------------------------------------*/
  295. END PROCEDURE.
  296. /* _UIB-CODE-BLOCK-END */
  297. &ANALYZE-RESUME
  298. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE BEREINIGEN_BATCH wBatch
  299. PROCEDURE BEREINIGEN_BATCH :
  300. /*------------------------------------------------------------------------------
  301. Purpose:
  302. Parameters: <none>
  303. Notes:
  304. ------------------------------------------------------------------------------*/
  305. DEF VAR iRecid AS RECID NO-UNDO.
  306. DEF BUFFER bASMutation FOR ASMutation.
  307. FOR EACH ASMutation NO-LOCK
  308. WHERE ASMutation.cStatus = 'A':
  309. iRecid = RECID(ASMutation).
  310. CASE ASMutation.MutArt:
  311. WHEN 'RUESTDRUCK' THEN RUN BEREINIGEN_RUESTDRUCK ( iRecid ).
  312. WHEN 'wsLADEPAPIER' THEN RUN BEREINIGEN_LADEPAPIER ( iRecid ).
  313. WHEN 'wsPALETT' THEN RUN BEREINIGEN_PALETTENDOKUMENT ( iRecid ).
  314. WHEN 'wsLIEFERSCHEIN' THEN RUN BEREINIGEN_LIEFERSCHEIN ( iRecid ).
  315. END.
  316. REPEAT TRANSACTION:
  317. FIND bASMutation EXCLUSIVE-LOCK
  318. WHERE RECID(bASMutation) = iRecid NO-WAIT NO-ERROR.
  319. IF LOCKED bASMutation THEN DO:
  320. MESSAGE 'ASMutation ist locked' VIEW-AS ALERT-BOX.
  321. NEXT.
  322. END.
  323. IF NOT AVAILABLE bASMutation THEN LEAVE.
  324. DELETE bASMutation.
  325. LEAVE.
  326. END.
  327. END.
  328. END PROCEDURE.
  329. /* _UIB-CODE-BLOCK-END */
  330. &ANALYZE-RESUME
  331. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE BEREINIGEN_LADEPAPIER wBatch
  332. PROCEDURE BEREINIGEN_LADEPAPIER :
  333. /*------------------------------------------------------------------------------
  334. Purpose:
  335. Parameters: <none>
  336. Notes:
  337. ------------------------------------------------------------------------------*/
  338. DEF INPUT PARAMETER ipRecid AS RECID NO-UNDO.
  339. DEF VAR iAufnr AS INT NO-UNDO.
  340. DEF VAR cBenutzer AS CHAR NO-UNDO.
  341. DEF VAR iRuestArt AS INT NO-UNDO.
  342. DEF VAR cFirma AS CHAR NO-UNDO.
  343. DEF BUFFER bAS FOR ASMutation.
  344. DEF BUFFER bTabel FOR Tabel.
  345. FIND bAS NO-LOCK WHERE RECID(bAS) = ipRecid NO-ERROR.
  346. IF NOT AVAILABLE bAS THEN RETURN.
  347. IF bAS.cStatus = 'E' THEN RETURN.
  348. ASSIGN cBenutzer = bAS.cFeld_2
  349. iAufnr = bAS.iKey_1
  350. iRuestArt = bAS.iKey_2
  351. cFirma = bAS.Firma.
  352. FIND FIRST bTabel EXCLUSIVE-LOCK
  353. WHERE bTabel.Firma = cFirma
  354. AND bTabel.RecArt = 'wsLADEPAPIER'
  355. AND bTabel.Sprcd = 1
  356. AND bTabel.Int_1 = iAufnr
  357. AND bTabel.Int_3 = iRuestArt NO-WAIT NO-ERROR.
  358. IF NOT AVAILABLE bTabel THEN RETURN.
  359. DELETE bTabel.
  360. RETURN.
  361. END PROCEDURE.
  362. /* _UIB-CODE-BLOCK-END */
  363. &ANALYZE-RESUME
  364. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE BEREINIGEN_LIEFERSCHEIN wBatch
  365. PROCEDURE BEREINIGEN_LIEFERSCHEIN :
  366. /*------------------------------------------------------------------------------
  367. Purpose:
  368. Parameters: <none>
  369. Notes:
  370. ------------------------------------------------------------------------------*/
  371. DEF INPUT PARAMETER ipRecid AS RECID NO-UNDO.
  372. DEF VAR iAufnr AS INT NO-UNDO.
  373. DEF VAR cBenutzer AS CHAR NO-UNDO.
  374. DEF VAR iRuestArt AS INT NO-UNDO.
  375. DEF VAR cFirma AS CHAR NO-UNDO.
  376. DEF BUFFER bAS FOR ASMutation.
  377. DEF BUFFER bTabel FOR Tabel.
  378. FIND bAS NO-LOCK WHERE RECID(bAS) = ipRecid NO-ERROR.
  379. IF NOT AVAILABLE bAS THEN RETURN.
  380. IF bAS.cStatus = 'E' THEN RETURN.
  381. ASSIGN cBenutzer = bAS.cFeld_2
  382. iAufnr = bAS.iKey_1
  383. iRuestArt = bAS.iKey_2
  384. cFirma = bAS.Firma.
  385. FIND FIRST bTabel EXCLUSIVE-LOCK
  386. WHERE bTabel.Firma = cFirma
  387. AND bTabel.RecArt = 'wsLIEFERSCHEIN'
  388. AND bTabel.Sprcd = 1
  389. AND bTabel.Int_1 = iAufnr
  390. AND bTabel.Int_3 = iRuestArt NO-WAIT NO-ERROR.
  391. IF NOT AVAILABLE bTabel THEN RETURN.
  392. DELETE bTabel.
  393. RETURN.
  394. END PROCEDURE.
  395. /* _UIB-CODE-BLOCK-END */
  396. &ANALYZE-RESUME
  397. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE BEREINIGEN_PALETTENDOKUMENT wBatch
  398. PROCEDURE BEREINIGEN_PALETTENDOKUMENT :
  399. /*------------------------------------------------------------------------------
  400. Purpose:
  401. Parameters: <none>
  402. Notes:
  403. ------------------------------------------------------------------------------*/
  404. DEF INPUT PARAMETER ipRecid AS RECID NO-UNDO.
  405. DEF VAR iAufnr AS INT NO-UNDO.
  406. DEF VAR cBenutzer AS CHAR NO-UNDO.
  407. DEF VAR iRuestArt AS INT NO-UNDO.
  408. DEF VAR cFirma AS CHAR NO-UNDO.
  409. DEF BUFFER bAS FOR ASMutation.
  410. DEF BUFFER bTabel FOR Tabel.
  411. FIND bAS NO-LOCK WHERE RECID(bAS) = ipRecid NO-ERROR.
  412. IF NOT AVAILABLE bAS THEN RETURN.
  413. IF bAS.cStatus = 'E' THEN RETURN.
  414. ASSIGN cBenutzer = bAS.cFeld_2
  415. iAufnr = bAS.iKey_1
  416. iRuestArt = bAS.iKey_2
  417. cFirma = bAS.Firma.
  418. FIND FIRST bTabel EXCLUSIVE-LOCK
  419. WHERE bTabel.Firma = cFirma
  420. AND bTabel.RecArt = 'wsPALETT'
  421. AND bTabel.Sprcd = 1
  422. AND bTabel.Int_1 = iAufnr
  423. AND bTabel.Int_3 = iRuestArt NO-WAIT NO-ERROR.
  424. IF NOT AVAILABLE bTabel THEN RETURN.
  425. DELETE bTabel.
  426. RETURN.
  427. END PROCEDURE.
  428. /* _UIB-CODE-BLOCK-END */
  429. &ANALYZE-RESUME
  430. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE BEREINIGEN_RUESTDRUCK wBatch
  431. PROCEDURE BEREINIGEN_RUESTDRUCK :
  432. /*------------------------------------------------------------------------------
  433. Purpose:
  434. Parameters: <none>
  435. Notes:
  436. ------------------------------------------------------------------------------*/
  437. DEF INPUT PARAMETER ipRecid AS RECID NO-UNDO.
  438. DEF VAR iAufnr AS INT NO-UNDO.
  439. DEF VAR cBenutzer AS CHAR NO-UNDO.
  440. DEF VAR iRuestArt AS INT NO-UNDO.
  441. DEF VAR cFirma AS CHAR NO-UNDO.
  442. DEF BUFFER bAS FOR ASMutation.
  443. DEF BUFFER bTabel FOR Tabel.
  444. FIND bAS NO-LOCK WHERE RECID(bAS) = ipRecid NO-ERROR.
  445. IF NOT AVAILABLE bAS THEN RETURN.
  446. IF bAS.cStatus = 'E' THEN RETURN.
  447. ASSIGN cBenutzer = bAS.cFeld_2
  448. iAufnr = bAS.iKey_1
  449. iRuestArt = bAS.iKey_2
  450. cFirma = bAS.Firma.
  451. FIND FIRST bTabel EXCLUSIVE-LOCK
  452. WHERE bTabel.Firma = cFirma
  453. AND bTabel.RecArt = 'AUFDRUCK'
  454. AND bTabel.Sprcd = 1
  455. AND bTabel.Int_1 = iAufnr
  456. AND bTabel.Int_3 = iRuestArt NO-WAIT NO-ERROR.
  457. IF NOT AVAILABLE bTabel THEN RETURN.
  458. DELETE bTabel.
  459. RETURN.
  460. END PROCEDURE.
  461. /* _UIB-CODE-BLOCK-END */
  462. &ANALYZE-RESUME
  463. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI wBatch _DEFAULT-DISABLE
  464. PROCEDURE disable_UI :
  465. /*------------------------------------------------------------------------------
  466. Purpose: DISABLE the User Interface
  467. Parameters: <none>
  468. Notes: Here we clean-up the user-interface by deleting
  469. dynamic widgets we have created and/or hide
  470. frames. This procedure is usually called when
  471. we are ready to "clean-up" after running.
  472. ------------------------------------------------------------------------------*/
  473. /* Delete the WINDOW we created */
  474. IF SESSION:DISPLAY-TYPE = "GUI":U AND VALID-HANDLE(wBatch)
  475. THEN DELETE WIDGET wBatch.
  476. IF THIS-PROCEDURE:PERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE.
  477. END PROCEDURE.
  478. /* _UIB-CODE-BLOCK-END */
  479. &ANALYZE-RESUME
  480. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DRUCKEN_LADEPAPIER wBatch
  481. PROCEDURE DRUCKEN_LADEPAPIER :
  482. /*------------------------------------------------------------------------------
  483. Purpose:
  484. Parameters: <none>
  485. Notes:
  486. ------------------------------------------------------------------------------*/
  487. DEF INPUT PARAMETER ipRecid AS RECID NO-UNDO.
  488. DEF VAR cRuester AS CHAR NO-UNDO.
  489. DEF VAR iKopien AS INT NO-UNDO.
  490. DEF VAR iAufnr AS INT NO-UNDO.
  491. DEF VAR iPlatz AS INT NO-UNDO.
  492. DEF VAR iRuestArt AS INT NO-UNDO.
  493. DEF VAR ix AS INT NO-UNDO.
  494. DEF VAR cStockwerk AS CHAR INIT ';;;;;;;;;' NO-UNDO.
  495. DEF VAR cProgname AS CHAR NO-UNDO.
  496. DEF VAR cDruckProgramm AS CHAR NO-UNDO.
  497. DEF VAR iRecid AS RECID NO-UNDO.
  498. DEF VAR cString AS CHAR NO-UNDO.
  499. FIND ASMutation NO-LOCK
  500. WHERE RECID(ASMutation) = ipRecid.
  501. ASSIGN cRuester = ASMutation.cFeld_2
  502. iAufnr = ASMutation.iKey_1
  503. iRuestArt = ASMutation.iKey_2
  504. Firma = ASMutation.Firma.
  505. FIND Aufko NO-LOCK USE-INDEX Aufko-k1
  506. WHERE Aufko.Firma = Firma
  507. AND Aufko.Aufnr = iAufnr NO-ERROR.
  508. IF NOT AVAILABLE Aufko THEN RETURN ''.
  509. cDruckProgramm = DYNAMIC-FUNCTION('getDruckProgramm':U) NO-ERROR.
  510. IF cDruckProgramm = '' THEN RETURN 'ERROR;Fehler! Kein Programm für den Ausdruck gefunden'.
  511. REPEAT TRANSACTION:
  512. FIND LAST Tabel NO-LOCK
  513. WHERE Tabel.Firma = Firma
  514. AND Tabel.RecArt = 'wsLADEPAPIER'
  515. AND Tabel.CodeC = cRuester
  516. AND Tabel.Sprcd = 1 NO-ERROR.
  517. IF NOT AVAILABLE Tabel THEN ix = 1.
  518. ELSE ix = Tabel.CodeI + 1.
  519. CREATE Tabel.
  520. ASSIGN Tabel.Firma = Firma
  521. Tabel.RecArt = 'wsLADEPAPIER'
  522. Tabel.CodeC = cRuester
  523. Tabel.CodeI = ix
  524. Tabel.Sprcd = 1
  525. Tabel.Int_1 = iAufnr
  526. Tabel.Int_2 = 3
  527. Tabel.Int_3 = iRuestArt
  528. Tabel.Dec_1 = ASMutation.iFeld_1
  529. Tabel.Dec_2 = 1
  530. Tabel.Bez2 = cRuester.
  531. iRecid = RECID(Tabel).
  532. RELEASE Tabel.
  533. LEAVE.
  534. END.
  535. cString = SUBSTITUTE('Programm &1/&2 gestartet mit Aufnr &3, Rüstart &4, Benutzer &5',
  536. cDruckProgramm, 'wsLADEPAPIER', iAufnr, iRuestArt, cRuester).
  537. DYNAMIC-FUNCTION('writeLogFile':U, cString) NO-ERROR.
  538. RUN VALUE(cDruckProgramm) NO-ERROR.
  539. RETURN ''.
  540. END PROCEDURE.
  541. /* _UIB-CODE-BLOCK-END */
  542. &ANALYZE-RESUME
  543. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DRUCKEN_LIEFERSCHEIN wBatch
  544. PROCEDURE DRUCKEN_LIEFERSCHEIN :
  545. /*------------------------------------------------------------------------------
  546. Purpose:
  547. Parameters: <none>
  548. Notes:
  549. ------------------------------------------------------------------------------*/
  550. DEF INPUT PARAMETER ipRecid AS RECID NO-UNDO.
  551. DEF VAR cRuester AS CHAR NO-UNDO.
  552. DEF VAR iKopien AS INT NO-UNDO.
  553. DEF VAR iAufnr AS INT NO-UNDO.
  554. DEF VAR iPlatz AS INT NO-UNDO.
  555. DEF VAR iRuestArt AS INT NO-UNDO.
  556. DEF VAR ix AS INT NO-UNDO.
  557. DEF VAR cStockwerk AS CHAR INIT ';;;;;;;;;' NO-UNDO.
  558. DEF VAR cProgname AS CHAR NO-UNDO.
  559. DEF VAR cDruckProgramm AS CHAR NO-UNDO.
  560. DEF VAR iRecid AS RECID NO-UNDO.
  561. DEF VAR lSammFak AS LOG NO-UNDO.
  562. DEF VAR cResult AS CHAR NO-UNDO.
  563. DEF VAR cInstallation AS CHAR NO-UNDO.
  564. DEF VAR cString AS CHAR NO-UNDO.
  565. DEF BUFFER bViperDoc FOR ViperDoc.
  566. FIND ASMutation NO-LOCK
  567. WHERE RECID(ASMutation) = ipRecid.
  568. ASSIGN cRuester = ASMutation.cFeld_2
  569. iAufnr = ASMutation.iKey_1
  570. iRuestArt = ASMutation.iKey_2
  571. Firma = ASMutation.Firma.
  572. FIND Aufko NO-LOCK USE-INDEX Aufko-k1
  573. WHERE Aufko.Firma = Firma
  574. AND Aufko.Aufnr = iAufnr NO-ERROR.
  575. IF NOT AVAILABLE Aufko THEN RETURN ''.
  576. iAufnr = Aufko.Aufnr.
  577. F_Status = SUBSTITUTE('Lieferschein &1 wird gedruckt', Aufko.Aufnr).
  578. DISPLAY F_Status WITH FRAME {&FRAME-NAME}.
  579. EMPTY TEMP-TABLE tParam.
  580. CREATE tParam.
  581. FIND Steuer NO-LOCK
  582. WHERE Steuer.Firma = Firma.
  583. ASSIGN iRuestArt = Steuer.RuestArt.
  584. ASSIGN tParam.cFirma = Aufko.Firma
  585. tParam.iRecid = RECID(Aufko)
  586. tParam.iAufnr = iAufnr
  587. tParam.iKnr = Aufko.Knr
  588. tParam.iFak_Knr = Aufko.Fak_Knr
  589. tParam.iFakArt = Aufko.Fak_Art
  590. tParam.iAufSta = Aufko.Auf_Sta
  591. tParam.cBenutzer = DYNAMIC-FUNCTION('getBenutzer':U)
  592. tParam.cDBUser = DYNAMIC-FUNCTION('getDBUser':U)
  593. tParam.cWinUser = DYNAMIC-FUNCTION('getSysUser':U)
  594. tParam.cInstall = DYNAMIC-FUNCTION('getInstallation':U)
  595. tParam.lPreis = FALSE
  596. tParam.lBatch = TRUE.
  597. IF ASMutation.iFeld_1 = 1 THEN DO: /* Abschluss (Ablieferung Fahrer) */
  598. ASSIGN tParam.cBenutzer = 'Fahrer'
  599. tParam.cDBUser = 'Fahrer'
  600. tParam.cWinUser = 'Fahrer'.
  601. END.
  602. IF Aufko.AlsOfferte THEN RETURN 'Error;Offerte'.
  603. FIND FIRST Tabel NO-LOCK
  604. WHERE Tabel.Firma = tParam.cFirma
  605. AND Tabel.RecArt = 'FAKART'
  606. AND Tabel.CodeI = Aufko.Fak_Art NO-ERROR.
  607. IF NOT AVAILABLE Tabel THEN RETURN ''.
  608. tParam.cDokument = Tabel.Bez2.
  609. lSammFak = (IF Tabel.Int_3 = 4 THEN TRUE ELSE FALSE).
  610. IF lSammFak THEN RETURN 'Error;Sammelrechnung'.
  611. iVDRecid = ?.
  612. DO ix = 1 TO 3:
  613. CASE ix:
  614. WHEN 1 THEN cUser = tParam.cBenutzer.
  615. WHEN 2 THEN cUser = tParam.cDBUser.
  616. WHEN 3 THEN cUser = tParam.cWinUser.
  617. END CASE.
  618. FIND FIRST ViperDoc NO-LOCK
  619. WHERE ViperDoc.Firma = Aufko.Firma
  620. AND ViperDoc.Benutzer = cUser
  621. AND ViperDoc.Formular = tParam.cDokument
  622. AND ViperDoc.DokArt = 0 NO-ERROR.
  623. IF AVAILABLE ViperDoc THEN DO:
  624. iVDRecid = RECID(ViperDoc).
  625. LEAVE.
  626. END.
  627. END.
  628. DO WHILE iVDRecid = ?:
  629. FIND FIRST ViperDoc NO-LOCK
  630. WHERE ViperDoc.Firma = Aufko.Firma
  631. AND ViperDoc.Formular = tParam.cDokument
  632. AND ViperDoc.DokArt = 0 NO-ERROR.
  633. IF NOT AVAILABLE ViperDoc THEN RETURN ''.
  634. REPEAT TRANSACTION:
  635. CREATE bViperDoc.
  636. BUFFER-COPY ViperDoc
  637. EXCEPT Benutzer
  638. TO bViperDoc
  639. ASSIGN bViperDoc.Benutzer = tParam.cBenutzer.
  640. iVDRecid = RECID(bViperDoc).
  641. RELEASE bViperDoc.
  642. RELEASE ViperDoc.
  643. LEAVE.
  644. END.
  645. LEAVE.
  646. END.
  647. tParam.iVDRecid = iVDRecid.
  648. RELEASE Aufko.
  649. RELEASE ViperDoc.
  650. RELEASE Tabel.
  651. RUN 'g-druck-bestaetigung.w':U ( INPUT-OUTPUT htParam, OUTPUT cResult ).
  652. IF cResult <> 'OK' THEN RETURN ''.
  653. cInstallation = DYNAMIC-FUNCTION('getInstallation':U) NO-ERROR.
  654. cDruckProgramm = SUBSTITUTE('DruckProgramme/&1/&2', cInstallation, tParam.Programm ).
  655. cDruckProgramm = SEARCH(cDruckProgramm).
  656. IF cDruckProgramm = ? THEN RETURN 'ERROR;Fehler! Kein Programm für den Ausdruck gefunden'.
  657. cString = SUBSTITUTE('Programm &1 gestartet mit Aufnr &2, Benutzer &3',
  658. cDruckProgramm, tParam.iAufnr, tParam.cBenutzer).
  659. DYNAMIC-FUNCTION('writeLogFile':U, cString) NO-ERROR.
  660. RUN VALUE(cDruckProgramm) ( htParam, OUTPUT cResult ).
  661. IF cResult BEGINS 'ERROR' THEN RETURN cResult.
  662. IF ASMutation.iFeld_1 <> 1 THEN RETURN cResult.
  663. RUN SEND_MAIL ( iAufnr, cResult ).
  664. RETURN cResult.
  665. END PROCEDURE.
  666. /* _UIB-CODE-BLOCK-END */
  667. &ANALYZE-RESUME
  668. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DRUCKEN_PALETTENDOKUMENT wBatch
  669. PROCEDURE DRUCKEN_PALETTENDOKUMENT :
  670. /*------------------------------------------------------------------------------
  671. Purpose:
  672. Parameters: <none>
  673. Notes:
  674. ------------------------------------------------------------------------------*/
  675. DEF INPUT PARAMETER ipRecid AS RECID NO-UNDO.
  676. DEF VAR cRuester AS CHAR NO-UNDO.
  677. DEF VAR iKopien AS INT NO-UNDO.
  678. DEF VAR iAufnr AS INT NO-UNDO.
  679. DEF VAR iPlatz AS INT NO-UNDO.
  680. DEF VAR iRuestArt AS INT NO-UNDO.
  681. DEF VAR ix AS INT NO-UNDO.
  682. DEF VAR cStockwerk AS CHAR INIT ';;;;;;;;;' NO-UNDO.
  683. DEF VAR cProgname AS CHAR NO-UNDO.
  684. DEF VAR cDruckProgramm AS CHAR NO-UNDO.
  685. DEF VAR iRecid AS RECID NO-UNDO.
  686. DEF VAR cString AS CHAR NO-UNDO.
  687. FIND ASMutation NO-LOCK
  688. WHERE RECID(ASMutation) = ipRecid.
  689. ASSIGN cRuester = ASMutation.cFeld_2
  690. iPlatz = ASMutation.iFeld_1
  691. iKopien = ASMutation.iFeld_2
  692. iAufnr = ASMutation.iKey_1
  693. iRuestArt = ASMutation.iKey_2
  694. Firma = ASMutation.Firma.
  695. FIND Aufko NO-LOCK USE-INDEX Aufko-k1
  696. WHERE Aufko.Firma = Firma
  697. AND Aufko.Aufnr = iAufnr NO-ERROR.
  698. IF NOT AVAILABLE Aufko THEN RETURN ''.
  699. cDruckProgramm = DYNAMIC-FUNCTION('getDruckProgramm':U) NO-ERROR.
  700. IF cDruckProgramm = '' THEN RETURN 'ERROR;Fehler! Kein Programm für den Ausdruck gefunden'.
  701. REPEAT TRANSACTION:
  702. FIND LAST Tabel NO-LOCK
  703. WHERE Tabel.Firma = Firma
  704. AND Tabel.RecArt = 'wsPALETT'
  705. AND Tabel.CodeC = ASMutation.cFeld_2
  706. AND Tabel.Sprcd = 1 NO-ERROR.
  707. IF NOT AVAILABLE Tabel THEN ix = 1.
  708. ELSE ix = Tabel.CodeI + 1.
  709. CREATE Tabel.
  710. ASSIGN Tabel.Firma = Firma
  711. Tabel.RecArt = 'wsPALETT'
  712. Tabel.CodeC = ASMutation.cFeld_2
  713. Tabel.CodeI = ix
  714. Tabel.Sprcd = 1
  715. Tabel.Int_1 = iAufnr
  716. Tabel.Int_2 = 2
  717. Tabel.Int_3 = iRuestArt
  718. Tabel.Dec_1 = iPlatz
  719. Tabel.Dec_2 = (IF iKopien > 10 THEN 1 ELSE iKopien)
  720. Tabel.Bez2 = cRuester.
  721. iRecid = RECID(Tabel).
  722. RELEASE Tabel.
  723. LEAVE.
  724. END.
  725. cString = SUBSTITUTE('Programm &1/&2 gestartet mit Aufnr &3, Rüstart &4, Rüstplatz &5, Benutzer &6',
  726. cDruckProgramm, 'wsPALETT', iAufnr, iRuestArt, iPlatz, cRuester).
  727. DYNAMIC-FUNCTION('writeLogFile':U, cString) NO-ERROR.
  728. RUN VALUE(cDruckProgramm) NO-ERROR.
  729. RETURN ''.
  730. END PROCEDURE.
  731. /* _UIB-CODE-BLOCK-END */
  732. &ANALYZE-RESUME
  733. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DRUCKEN_RUESTSCHEIN wBatch
  734. PROCEDURE DRUCKEN_RUESTSCHEIN :
  735. /*------------------------------------------------------------------------------
  736. Purpose:
  737. Parameters: <none>
  738. Notes:
  739. ------------------------------------------------------------------------------*/
  740. DEF INPUT PARAMETER ipRecid AS RECID NO-UNDO.
  741. DEF VAR cBenutzer AS CHAR NO-UNDO.
  742. DEF VAR iKopien AS INT NO-UNDO.
  743. DEF VAR iAufnr AS INT NO-UNDO.
  744. DEF VAR iPlatz AS INT NO-UNDO.
  745. DEF VAR iRuestArt AS INT NO-UNDO.
  746. DEF VAR ix AS INT NO-UNDO.
  747. DEF VAR cStockwerk AS CHAR INIT ';;;;;;;;;' NO-UNDO.
  748. DEF VAR cProgname AS CHAR NO-UNDO.
  749. DEF VAR cDruckProgramm AS CHAR NO-UNDO.
  750. DEF VAR iRecid AS RECID NO-UNDO.
  751. DEF VAR cString AS CHAR NO-UNDO.
  752. FIND ASMutation NO-LOCK
  753. WHERE RECID(ASMutation) = ipRecid.
  754. ASSIGN cBenutzer = ASMutation.cFeld_2
  755. iAufnr = ASMutation.iKey_1
  756. iRuestArt = ASMutation.iKey_2
  757. Firma = ASMutation.Firma.
  758. FIND Aufko NO-LOCK USE-INDEX Aufko-k1
  759. WHERE Aufko.Firma = Firma
  760. AND Aufko.Aufnr = iAufnr NO-ERROR.
  761. IF NOT AVAILABLE Aufko THEN RETURN ''.
  762. cDruckProgramm = DYNAMIC-FUNCTION('getDruckProgramm':U) NO-ERROR.
  763. IF cDruckProgramm = '' THEN RETURN 'ERROR;Fehler! Kein Programm für den Ausdruck gefunden'.
  764. REPEAT TRANSACTION:
  765. FIND LAST Tabel NO-LOCK
  766. WHERE Tabel.Firma = Firma
  767. AND Tabel.RecArt = 'AUFDRUCK'
  768. AND Tabel.CodeC = cBenutzer
  769. AND Tabel.Sprcd = 1 NO-ERROR.
  770. IF NOT AVAILABLE Tabel THEN ix = 1.
  771. ELSE ix = Tabel.CodeI + 1.
  772. CREATE Tabel.
  773. ASSIGN Tabel.Firma = Firma
  774. Tabel.RecArt = 'AUFDRUCK'
  775. Tabel.CodeC = cBenutzer
  776. Tabel.CodeI = ix
  777. Tabel.Sprcd = 1
  778. Tabel.Int_1 = iAufnr
  779. Tabel.Int_2 = 1
  780. Tabel.Int_3 = iRuestArt
  781. Tabel.Dec_1 = 0
  782. Tabel.Dec_2 = 1
  783. Tabel.Bez2 = cBenutzer.
  784. iRecid = RECID(Tabel).
  785. RELEASE Tabel.
  786. LEAVE.
  787. END.
  788. cString = SUBSTITUTE('Programm &1 (Auftragspapier/Rüstschein) gestartet mit Aufnr &2, Rüstart &3, Benutzer &4',
  789. cDruckProgramm, iAufnr, iRuestArt, cBenutzer).
  790. DYNAMIC-FUNCTION('writeLogFile':U, cString) NO-ERROR.
  791. RUN VALUE(cDruckProgramm) NO-ERROR.
  792. RETURN ''.
  793. END PROCEDURE.
  794. /* _UIB-CODE-BLOCK-END */
  795. &ANALYZE-RESUME
  796. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enableObject wBatch
  797. PROCEDURE enableObject :
  798. /*------------------------------------------------------------------------------
  799. Purpose: Super Override
  800. Parameters:
  801. Notes:
  802. ------------------------------------------------------------------------------*/
  803. { incl/winenableobject.i }
  804. RUN SUPER.
  805. /* Code placed here will execute AFTER standard behavior. */
  806. RUN REORG_ASMUTATION.
  807. RUN REORG_TABELLEN.
  808. END PROCEDURE.
  809. /* _UIB-CODE-BLOCK-END */
  810. &ANALYZE-RESUME
  811. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enable_UI wBatch _DEFAULT-ENABLE
  812. PROCEDURE enable_UI :
  813. /*------------------------------------------------------------------------------
  814. Purpose: ENABLE the User Interface
  815. Parameters: <none>
  816. Notes: Here we display/view/enable the widgets in the
  817. user-interface. In addition, OPEN all queries
  818. associated with each FRAME and BROWSE.
  819. These statements here are based on the "Other
  820. Settings" section of the widget Property Sheets.
  821. ------------------------------------------------------------------------------*/
  822. ENABLE F_Status
  823. WITH FRAME fMain IN WINDOW wBatch.
  824. {&OPEN-BROWSERS-IN-QUERY-fMain}
  825. VIEW wBatch.
  826. END PROCEDURE.
  827. /* _UIB-CODE-BLOCK-END */
  828. &ANALYZE-RESUME
  829. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE ENDE wBatch
  830. PROCEDURE ENDE :
  831. /*------------------------------------------------------------------------------
  832. Purpose:
  833. Parameters: <none>
  834. Notes:
  835. ------------------------------------------------------------------------------*/
  836. DEF VAR wx AS INT NO-UNDO.
  837. DEF VAR wy AS INT NO-UNDO.
  838. IF KEYLABEL(LASTKEY) = 'ESC' THEN RETURN NO-APPLY.
  839. wx = {&WINDOW-NAME}:X NO-ERROR.
  840. wy = {&WINDOW-NAME}:Y NO-ERROR.
  841. DYNAMIC-FUNCTION('setFensterposition':U, INPUT 'Fensterposition',
  842. INPUT Progname,
  843. INPUT wx,
  844. INPUT wy) NO-ERROR.
  845. cMessage = SUBSTITUTE('Programm &1 beendet', ProgName).
  846. DYNAMIC-FUNCTION('writeLogFile':U, cMessage) NO-ERROR.
  847. RUN CLOSE_FUNKTIONEN.
  848. APPLY "CLOSE":U TO THIS-PROCEDURE.
  849. QUIT.
  850. END PROCEDURE.
  851. /* _UIB-CODE-BLOCK-END */
  852. &ANALYZE-RESUME
  853. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE exitObject wBatch
  854. PROCEDURE exitObject :
  855. /*------------------------------------------------------------------------------
  856. Purpose: Window-specific override of this procedure which destroys
  857. its contents and itself.
  858. Notes:
  859. ------------------------------------------------------------------------------*/
  860. RUN ENDE.
  861. RETURN NO-APPLY.
  862. END PROCEDURE.
  863. /* _UIB-CODE-BLOCK-END */
  864. &ANALYZE-RESUME
  865. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE initializeObject wBatch
  866. PROCEDURE initializeObject :
  867. /*------------------------------------------------------------------------------
  868. Purpose: Super Override
  869. Parameters:
  870. Notes:
  871. ------------------------------------------------------------------------------*/
  872. /* Code placed here will execute PRIOR to standard behavior. */
  873. RUN SUPER.
  874. { incl/wininitializeobject.i }
  875. DO WITH FRAME {&FRAME-NAME}:
  876. F_Status:READ-ONLY = TRUE.
  877. END.
  878. END PROCEDURE.
  879. /* _UIB-CODE-BLOCK-END */
  880. &ANALYZE-RESUME
  881. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE REORG_ASMUTATION wBatch
  882. PROCEDURE REORG_ASMUTATION :
  883. /*------------------------------------------------------------------------------
  884. Purpose:
  885. Parameters: <none>
  886. Notes:
  887. ------------------------------------------------------------------------------*/
  888. cMessage = 'Reorg ASMutation gestartet'.
  889. DYNAMIC-FUNCTION('writeLogFile':U, cMessage) NO-ERROR.
  890. FOR EACH ASMutation
  891. WHERE ASMutation.Aktiv = FALSE
  892. AND ASMutation.cStatus = 'E'
  893. AND ASMutation.Datum < (TODAY - 30) TRANSACTION:
  894. DELETE ASMutation.
  895. END.
  896. FOR EACH ASMutation
  897. WHERE ASMutation.Aktiv = TRUE
  898. AND ASMutation.cStatus <> ''
  899. AND ASMutation.Datum < (TODAY - 30) TRANSACTION:
  900. DELETE ASMutation.
  901. END.
  902. FOR EACH ASMutation
  903. WHERE ASMutation.Aktiv = TRUE
  904. AND ASMutation.cStatus <> '' TRANSACTION:
  905. ASMutation.cStatus = ''.
  906. END.
  907. FOR EACH Tabel
  908. WHERE Tabel.Firma = Firma
  909. AND Tabel.RecArt = 'GERUEST':
  910. FIND Aufko NO-LOCK
  911. WHERE Aufko.Firma = Tabel.Firma
  912. AND Aufko.Aufnr = Tabel.CodeI NO-ERROR.
  913. IF AVAILABLE Aufko THEN NEXT.
  914. DELETE Tabel.
  915. END.
  916. cMessage = 'Reorg ASMutation beendet'.
  917. DYNAMIC-FUNCTION('writeLogFile':U, cMessage) NO-ERROR.
  918. END PROCEDURE.
  919. /* _UIB-CODE-BLOCK-END */
  920. &ANALYZE-RESUME
  921. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE REORG_TABELLEN wBatch
  922. PROCEDURE REORG_TABELLEN :
  923. /*------------------------------------------------------------------------------
  924. Purpose:
  925. Parameters: <none>
  926. Notes:
  927. ------------------------------------------------------------------------------*/
  928. DEF VAR iRecid AS RECID NO-UNDO.
  929. DEF VAR iAnz AS INT NO-UNDO.
  930. DEF BUFFER bRuestAuf FOR RuestAuf.
  931. DEF BUFFER bTabel FOR Tabel.
  932. cMessage = 'Reorg Tabellen gestartet'.
  933. DYNAMIC-FUNCTION('writeLogFile':U, cMessage) NO-ERROR.
  934. DO WITH FRAME {&FRAME-NAME}:
  935. F_Status:SCREEN-VALUE = 'Reorg Ruestauftraege in Bearbeitung ... '.
  936. iAnz = 0.
  937. FOR EACH RuestAuf NO-LOCK
  938. WHERE RuestAuf.Firma = Firma
  939. AND iAnz < 100:
  940. FIND Aufko NO-LOCK
  941. WHERE Aufko.Firma = RuestAuf.Firma
  942. AND Aufko.Aufnr = RuestAuf.Aufnr NO-ERROR.
  943. IF AVAILABLE Aufko THEN NEXT.
  944. FIND bRuestAuf WHERE RECID(bRuestAuf) = RECID(RuestAuf).
  945. DELETE RuestAuf.
  946. iAnz = iAnz + 1.
  947. END.
  948. RELEASE bRuestAuf.
  949. F_Status:SCREEN-VALUE = 'Reorg Tabellen in Bearbeitung ... '.
  950. FOR EACH Tabel NO-LOCK
  951. WHERE Tabel.Firma = Firma
  952. AND Tabel.RecArt = 'AUFDRUCK'
  953. AND iAnz < 100:
  954. iRecid = Tabel.Int_3.
  955. FIND Aufko NO-LOCK WHERE RECID(Aufko) = iRecid NO-ERROR.
  956. IF AVAILABLE Aufko THEN NEXT.
  957. FIND bTabel WHERE RECID(bTabel) = RECID(Tabel) NO-ERROR.
  958. IF AVAILABLE bTabel THEN DELETE bTabel.
  959. iAnz = iAnz + 1.
  960. END.
  961. RELEASE bTabel.
  962. END.
  963. cMessage = 'Reorg Tabellen beendet'.
  964. DYNAMIC-FUNCTION('writeLogFile':U, cMessage) NO-ERROR.
  965. END PROCEDURE.
  966. /* _UIB-CODE-BLOCK-END */
  967. &ANALYZE-RESUME
  968. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE SEND_MAIL wBatch
  969. PROCEDURE SEND_MAIL :
  970. /*------------------------------------------------------------------------------
  971. Purpose:
  972. Parameters: <none>
  973. Notes:
  974. ------------------------------------------------------------------------------*/
  975. DEF INPUT PARAMETER ipiAufnr AS INT NO-UNDO.
  976. DEF INPUT PARAMETER ipcPDF AS CHAR NO-UNDO.
  977. DEF VAR cTo AS CHAR NO-UNDO.
  978. DEF VAR lRetValue AS LOG NO-UNDO.
  979. DEF VAR cMeldung AS CHAR NO-UNDO.
  980. DEF VAR cSubject AS CHAR NO-UNDO.
  981. DEF VAR cBody AS CHAR NO-UNDO.
  982. FIND Aufko NO-LOCK USE-INDEX Aufko-k1
  983. WHERE Aufko.Firma = Firma
  984. AND Aufko.Aufnr = ipiAufnr NO-ERROR.
  985. FIND Adresse NO-LOCK
  986. WHERE Adresse.Firma = AdFirma
  987. AND Adresse.Knr = Aufko.Knr NO-ERROR.
  988. cTo = Adresse.Mail.
  989. IF cTo = '' THEN RETURN.
  990. IF INDEX(cTo, '@') = 0 THEN RETURN.
  991. cSubject = SUBSTITUTE('Lieferschein &1 vom &2', Aufko.Aufnr, STRING(TODAY,'99.99.9999') ).
  992. cBody = SUBSTITUTE('Im Anhang den Lieferschein/die Rechnung von der Lieferung vom &1 ', STRING(TODAY,'99.99.9999') ).
  993. /*
  994. RUN "sendMail/smtpmail.p" (
  995. 'mail.analytikdataprime.ch', /* cMailServer, /* mailserver */*/
  996. cTo, /* TO: */
  997. 'info@adprime.ch', /* From: */
  998. 'walter.riechsteiner@adprime.ch', /* CC: */
  999. 'Lieferschein.pdf:type=application/pdf', /* Attachment Name im Mail */
  1000. ipcPDF, /* Filename auf Local-Server */
  1001. cSubject, /* Subject */
  1002. cBody, /* Body */
  1003. 'type=text/html:charset=iso-8859-1:filetype=binary', /* MIMEHeader */
  1004. 'text/html', /* Body-Type */
  1005. 2, /* Prioritaet */
  1006. FALSE, /* Authentifizierung n”tig */
  1007. 'base64', /* Authentifizierungstype */
  1008. 'walter.riechsteiner', /* Benutzer */
  1009. 'habasch_009', /* Passwort */
  1010. OUTPUT lRetValue, /* Erfolgreich ? */
  1011. OUTPUT cMeldung /* Sendergebnistext */
  1012. ).
  1013. RELEASE Aufko.
  1014. */
  1015. RETURN cMeldung.
  1016. END PROCEDURE.
  1017. /* _UIB-CODE-BLOCK-END */
  1018. &ANALYZE-RESUME
  1019. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE viewObject wBatch
  1020. PROCEDURE viewObject :
  1021. /*------------------------------------------------------------------------------
  1022. Purpose: Super Override
  1023. Parameters:
  1024. Notes:
  1025. ------------------------------------------------------------------------------*/
  1026. /* Code placed here will execute PRIOR to standard behavior. */
  1027. RUN SUPER.
  1028. /* Code placed here will execute AFTER standard behavior. */
  1029. END PROCEDURE.
  1030. /* _UIB-CODE-BLOCK-END */
  1031. &ANALYZE-RESUME
  1032. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE WARTEN wBatch
  1033. PROCEDURE WARTEN :
  1034. /*------------------------------------------------------------------------------
  1035. Purpose:
  1036. Parameters: <none>
  1037. Notes:
  1038. ------------------------------------------------------------------------------*/
  1039. DEF VAR iWait AS INT NO-UNDO.
  1040. DEF VAR iHH AS INT NO-UNDO.
  1041. DEF VAR iMM AS INT NO-UNDO.
  1042. iHH = INTEGER(SUBSTRING(STRING(TIME,'HH:MM:SS'),01,02)).
  1043. iMM = INTEGER(SUBSTRING(STRING(TIME,'HH:MM:SS'),04,02)).
  1044. DO WITH FRAME {&FRAME-NAME}:
  1045. F_Status:SCREEN-VALUE = '--> PAUSE <--'.
  1046. END.
  1047. DISCONNECT AnaDat NO-ERROR.
  1048. IF iHH = 22 THEN iWait = (6 * 3600) - (iMM * 60). /* Wartezeit für Connect = 7 Std. */
  1049. IF iHH = 20 THEN iWait = (8 * 3600) - (iMM * 60). /* Wartezeit für Connect = 9 Std. */
  1050. PAUSE iWait NO-MESSAGE.
  1051. DO WHILE NOT CONNECTED('AnaDat'):
  1052. CONNECT -pf db_connect.pf NO-ERROR.
  1053. PAUSE 1 NO-MESSAGE.
  1054. END.
  1055. RETURN.
  1056. END PROCEDURE.
  1057. /* _UIB-CODE-BLOCK-END */
  1058. &ANALYZE-RESUME
  1059. /* ************************ Function Implementations ***************** */
  1060. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getDruckProgramm wBatch
  1061. FUNCTION getDruckProgramm RETURNS CHARACTER
  1062. ( /* parameter-definitions */ ) :
  1063. /*------------------------------------------------------------------------------
  1064. Purpose:
  1065. Notes:
  1066. ------------------------------------------------------------------------------*/
  1067. DEF VAR cDruckProgramm AS CHAR NO-UNDO.
  1068. DEF VAR cInstallation AS CHAR NO-UNDO.
  1069. cInstallation = DYNAMIC-FUNCTION('getInstallation':U) NO-ERROR.
  1070. DO WHILE TRUE:
  1071. cDruckProgramm = 'g-p_' + cInstallation + '.r'.
  1072. cDruckProgramm = SEARCH(cDruckProgramm).
  1073. IF cDruckProgramm <> ? THEN LEAVE.
  1074. cDruckProgramm = 'g-p_' + cInstallation + '.w'.
  1075. cDruckProgramm = SEARCH(cDruckProgramm).
  1076. IF cDruckProgramm <> ? THEN LEAVE.
  1077. LEAVE.
  1078. END.
  1079. IF cDruckProgramm = ? THEN cDruckProgramm = ''.
  1080. RETURN cDruckProgramm.
  1081. END FUNCTION.
  1082. /* _UIB-CODE-BLOCK-END */
  1083. &ANALYZE-RESUME
  1084. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getLogName wBatch
  1085. FUNCTION getLogName RETURNS CHARACTER
  1086. ( /* parameter-definitions */ ) :
  1087. /*------------------------------------------------------------------------------
  1088. Purpose:
  1089. Notes:
  1090. ------------------------------------------------------------------------------*/
  1091. DEF VAR cPath AS CHAR NO-UNDO.
  1092. GET-KEY-VALUE SECTION 'GrundEinstellungen'
  1093. KEY 'Ge_MIS_TEMP'
  1094. VALUE cPath.
  1095. IF cPath = '' OR
  1096. cPath = ? THEN cPath = SESSION:TEMP-DIRECTORY.
  1097. IF SUBSTRING(cPath, LENGTH(cPath), 01) <> '/' AND
  1098. SUBSTRING(cPath, LENGTH(cPath), 01) <> '\' THEN cPath = cPath + '\'.
  1099. cPath = cPath
  1100. + Progname
  1101. + '-'
  1102. + REPLACE(STRING(TODAY,'99.99.9999'), '.', '')
  1103. + '.Log'.
  1104. RETURN cPath.
  1105. END FUNCTION.
  1106. /* _UIB-CODE-BLOCK-END */
  1107. &ANALYZE-RESUME
  1108. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getProgname wBatch
  1109. FUNCTION getProgname RETURNS CHARACTER
  1110. ( /* parameter-definitions */ ) :
  1111. /*------------------------------------------------------------------------------
  1112. Purpose:
  1113. Notes:
  1114. ------------------------------------------------------------------------------*/
  1115. RETURN Progname.
  1116. END FUNCTION.
  1117. /* _UIB-CODE-BLOCK-END */
  1118. &ANALYZE-RESUME
  1119. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION writeLogFile wBatch
  1120. FUNCTION writeLogFile RETURNS LOGICAL
  1121. ( ipMessage AS CHAR ) :
  1122. /*------------------------------------------------------------------------------
  1123. Purpose:
  1124. Notes:
  1125. ------------------------------------------------------------------------------*/
  1126. DEF VAR cString AS CHAR NO-UNDO.
  1127. cString = SUBSTITUTE('&1 &2 -> &3', STRING(TODAY,'99.99.9999'), STRING(TIME,'HH:MM:SS'), ipMessage).
  1128. OUTPUT STREAM LogStream TO VALUE(cLogName) APPEND.
  1129. PUT STREAM LogStream CONTROL cString CHR(10).
  1130. OUTPUT STREAM LogStream CLOSE.
  1131. RETURN TRUE.
  1132. END FUNCTION.
  1133. /* _UIB-CODE-BLOCK-END */
  1134. &ANALYZE-RESUME