REORG_HUBER.p 22 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686
  1. &ANALYZE-SUSPEND _VERSION-NUMBER AB_v10r12
  2. &ANALYZE-RESUME
  3. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure
  4. /*------------------------------------------------------------------------
  5. File :
  6. Purpose :
  7. Syntax :
  8. Description :
  9. Author(s) :
  10. Created :
  11. Notes :
  12. ----------------------------------------------------------------------*/
  13. /* This .W file was created with the Progress AppBuilder. */
  14. /*----------------------------------------------------------------------*/
  15. /* *************************** Definitions ************************** */
  16. DEF VAR xRecArt AS CHAR NO-UNDO
  17. INIT 'ABONUS,ARABGRP,AREG,TRAUB,FARB,HERST'.
  18. DEF VAR cFirma AS CHAR INIT '1000' NO-UNDO.
  19. DEF STREAM out.
  20. DEF STREAM artst.
  21. DEF TEMP-TABLE tGruppen NO-UNDO
  22. FIELD cKey AS CHAR
  23. FIELD cWert AS CHAR
  24. FIELD iAnz AS INT
  25. FIELD aktiv AS LOG INIT FALSE.
  26. DEF TEMP-TABLE tArtst NO-UNDO LIKE Artst
  27. FIELD KGeb AS INT
  28. FIELD iRecid AS RECID
  29. INDEX tArtst-k1 IS PRIMARY UNIQUE
  30. Firma
  31. Artnr
  32. Inhalt
  33. Jahr
  34. INDEX tArtst-k2
  35. Firma
  36. FremdNr.
  37. DEF TEMP-TABLE tArtstN NO-UNDO LIKE Artst
  38. FIELD KGeb AS INT
  39. FIELD iRecid AS RECID
  40. INDEX tArtstN-k1 IS PRIMARY UNIQUE
  41. Firma
  42. Artnr
  43. Inhalt
  44. Jahr
  45. INDEX tArtstN-k2
  46. Firma
  47. FremdNr.
  48. DEF TEMP-TABLE tDateien NO-UNDO
  49. FIELD cName AS CHAR.
  50. DEF TEMP-TABLE tKGebinde LIKE KGebinde
  51. FIELD Aktiv AS LOG.
  52. DEF TEMP-TABLE tVGebinde LIKE VGebinde
  53. FIELD Aktiv AS LOG.
  54. DEF TEMP-TABLE tGGebinde LIKE GGebinde
  55. FIELD Aktiv AS LOG.
  56. DEF TEMP-TABLE tWarenGrp LIKE Warengrp
  57. FIELD Aktiv AS LOG.
  58. DEF TEMP-TABLE tProdGrp LIKE Prodgrp
  59. FIELD Aktiv AS LOG.
  60. DEF TEMP-TABLE tArtikGrp LIKE Artikgrp
  61. FIELD Aktiv AS LOG.
  62. /* _UIB-CODE-BLOCK-END */
  63. &ANALYZE-RESUME
  64. &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  65. /* ******************** Preprocessor Definitions ******************** */
  66. &Scoped-define PROCEDURE-TYPE Procedure
  67. &Scoped-define DB-AWARE no
  68. /* _UIB-PREPROCESSOR-BLOCK-END */
  69. &ANALYZE-RESUME
  70. /* *********************** Procedure Settings ************************ */
  71. &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
  72. /* Settings for THIS-PROCEDURE
  73. Type: Procedure
  74. Allow:
  75. Frames: 0
  76. Add Fields to: Neither
  77. Other Settings: CODE-ONLY COMPILE
  78. */
  79. &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
  80. /* ************************* Create Window ************************** */
  81. &ANALYZE-SUSPEND _CREATE-WINDOW
  82. /* DESIGN Window definition (used by the UIB)
  83. CREATE WINDOW Procedure ASSIGN
  84. HEIGHT = 15
  85. WIDTH = 60.
  86. /* END WINDOW DEFINITION */
  87. */
  88. &ANALYZE-RESUME
  89. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure
  90. /* *************************** Main Block *************************** */
  91. RUN ARTIKEL_TABELLEN.
  92. RUN REORG_ARTIKEL.
  93. RUN REORG_DEBITOR.
  94. RUN NEUE_ARTIKELNUMMER.
  95. RUN UMNUMMERIEREN.
  96. /* _UIB-CODE-BLOCK-END */
  97. &ANALYZE-RESUME
  98. /* ********************** Internal Procedures *********************** */
  99. &IF DEFINED(EXCLUDE-ARTIKEL_TABELLEN) = 0 &THEN
  100. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE ARTIKEL_TABELLEN Procedure
  101. PROCEDURE ARTIKEL_TABELLEN :
  102. /*------------------------------------------------------------------------------
  103. Purpose:
  104. Parameters: <none>
  105. Notes:
  106. ------------------------------------------------------------------------------*/
  107. DEF VAR cRecArt AS CHAR NO-UNDO.
  108. DEF VAR ix AS INT NO-UNDO.
  109. DEF VAR iCodeI AS INT NO-UNDO.
  110. DO ix = 1 TO NUM-ENTRIES(xRecArt, ','):
  111. cRecArt = ENTRY(ix, xRecArt, ',').
  112. FOR EACH Tabel
  113. WHERE Tabel.Firma = cFirma
  114. AND Tabel.RecArt = cRecart:
  115. ASSIGN Tabel.Int_1 = 0.
  116. END.
  117. FOR EACH Artst NO-LOCK
  118. WHERE Artst.Firma = cFirma
  119. AND Artst.Aktiv :
  120. CASE cRecArt:
  121. WHEN 'ABONUS' THEN iCodeI = Artst.Bonus_Grp .
  122. WHEN 'ARABGRP' THEN iCodeI = Artst.Rab_Grp .
  123. WHEN 'AREG' THEN iCodeI = Artst.Reg_Grp .
  124. WHEN 'TRAUB' THEN iCodeI = Artst.Traub_Grp .
  125. WHEN 'FARB' THEN iCodeI = Artst.Farbe .
  126. WHEN 'HERST' THEN iCodeI = Artst.Herst .
  127. END.
  128. FIND Tabel
  129. WHERE Tabel.Firma = cFirma
  130. AND Tabel.RecArt = cRecArt
  131. AND Tabel.CodeI = iCodeI
  132. AND Tabel.CodeC = ''
  133. AND Tabel.Sprcd = 1.
  134. ASSIGN Tabel.Int_1 = 1.
  135. END.
  136. FOR EACH Tabel
  137. WHERE Tabel.Firma = cFirma
  138. AND Tabel.RecArt = cRecart.
  139. IF Tabel.Int_1 = 0 THEN DELETE Tabel.
  140. ELSE Tabel.Int_1 = 0.
  141. END.
  142. END.
  143. EMPTY TEMP-TABLE tWarengrp.
  144. EMPTY TEMP-TABLE tProdgrp .
  145. EMPTY TEMP-TABLE tArtikgrp.
  146. FOR EACH Warengrp NO-LOCK
  147. WHERE Warengrp.Firma = cFirma.
  148. CREATE tWarengrp.
  149. BUFFER-COPY Warengrp to tWarengrp
  150. ASSIGN tWarengrp.Aktiv = FALSE.
  151. END.
  152. FOR EACH Prodgrp NO-LOCK
  153. WHERE Prodgrp.Firma = cFirma.
  154. CREATE tProdgrp.
  155. BUFFER-COPY Prodgrp to tProdgrp
  156. ASSIGN tProdgrp.Aktiv = FALSE.
  157. END.
  158. FOR EACH Artikgrp NO-LOCK
  159. WHERE Artikgrp.Firma = cFirma.
  160. CREATE tArtikgrp.
  161. BUFFER-COPY Artikgrp to tArtikgrp
  162. ASSIGN tArtikgrp.Aktiv = FALSE.
  163. END.
  164. FOR EACH Artst NO-LOCK
  165. WHERE Artst.Firma = cFirma
  166. AND Artst.Aktiv:
  167. FIND tWarengrp
  168. WHERE tWarengrp.Firma = cFirma
  169. AND tWarengrp.Wgr = Artst.Wg_Grp NO-ERROR.
  170. IF NOT AVAILABLE tWarengrp THEN DO:
  171. CREATE Warengrp.
  172. ASSIGN Warengrp.Firma = cFirma
  173. Warengrp.Wgr = Artst.Wg_Grp
  174. Warengrp.Bez1 = 'unbekannt'.
  175. CREATE tWarengrp.
  176. BUFFER-COPY Warengrp TO tWarengrp
  177. ASSIGN tWarengrp.Aktiv = TRUE.
  178. END.
  179. ELSE tWarengrp.Aktiv = TRUE.
  180. END.
  181. FOR EACH Artst NO-LOCK
  182. WHERE Artst.Firma = cFirma
  183. AND Artst.Aktiv:
  184. FIND tProdgrp
  185. WHERE tProdgrp.Firma = cFirma
  186. AND tProdgrp.Wgr = Artst.Wg_Grp
  187. AND tProdgrp.Prod_Grp = Artst.Prod_Grp NO-ERROR.
  188. IF NOT AVAILABLE tProdgrp THEN DO:
  189. CREATE Prodgrp.
  190. ASSIGN Prodgrp.Firma = cFirma
  191. Prodgrp.Wgr = Artst.Wg_Grp
  192. Prodgrp.Prod_Grp = Artst.Prod_Grp
  193. Prodgrp.Bez1 = 'unbekannt'.
  194. CREATE tProdgrp.
  195. BUFFER-COPY Prodgrp TO tProdgrp
  196. ASSIGN tProdgrp.Aktiv = TRUE.
  197. END.
  198. ELSE tProdgrp.Aktiv = TRUE.
  199. END.
  200. FOR EACH Artst NO-LOCK
  201. WHERE Artst.Firma = cFirma
  202. AND Artst.Aktiv:
  203. FIND tArtikgrp
  204. WHERE tArtikgrp.Firma = cFirma
  205. AND tArtikgrp.Wgr = Artst.Wg_Grp
  206. AND tArtikgrp.Prod_Grp = Artst.Prod_Grp
  207. AND tArtikgrp.Art_Grp = Artst.Art_Grp NO-ERROR.
  208. IF NOT AVAILABLE tArtikgrp THEN DO:
  209. CREATE Artikgrp.
  210. ASSIGN Artikgrp.Firma = cFirma
  211. Artikgrp.Wgr = Artst.Wg_Grp
  212. Artikgrp.Prod_Grp = Artst.Prod_Grp
  213. Artikgrp.Art_Grp = Artst.Art_Grp
  214. Artikgrp.Bez1 = 'unbekannt'.
  215. CREATE tArtikgrp.
  216. BUFFER-COPY Artikgrp TO tArtikgrp
  217. ASSIGN tArtikgrp.Aktiv = TRUE.
  218. END.
  219. ELSE tArtikgrp.Aktiv = TRUE.
  220. END.
  221. FOR EACH tArtikgrp WHERE NOT tArtikgrp.Aktiv:
  222. FIND Artikgrp OF tArtikgrp.
  223. DELETE Artikgrp.
  224. END.
  225. FOR EACH tProdGrp WHERE NOT tProdGrp.Aktiv:
  226. FIND ProdGrp OF tProdGrp.
  227. DELETE ProdGrp.
  228. END.
  229. FOR EACH tWarenGrp WHERE NOT tWarenGrp.Aktiv:
  230. FIND WarenGrp OF WarenGrp.
  231. DELETE WarenGrp.
  232. END.
  233. END PROCEDURE.
  234. /* _UIB-CODE-BLOCK-END */
  235. &ANALYZE-RESUME
  236. &ENDIF
  237. &IF DEFINED(EXCLUDE-NEUE_ARTIKELNUMMER) = 0 &THEN
  238. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE NEUE_ARTIKELNUMMER Procedure
  239. PROCEDURE NEUE_ARTIKELNUMMER :
  240. /*------------------------------------------------------------------------------
  241. Purpose:
  242. Parameters: <none>
  243. Notes:
  244. ------------------------------------------------------------------------------*/
  245. DEF VAR Artnr AS INT INIT 0 NO-UNDO.
  246. EMPTY TEMP-TABLE tArtst.
  247. EMPTY TEMP-TABLE tArtstN.
  248. FOR EACH Artst NO-LOCK:
  249. CREATE tArtst.
  250. BUFFER-COPY Artst TO tArtst.
  251. ASSIGN tArtst.iRecid = RECID(Artst).
  252. END.
  253. Artnr = 100000.
  254. FOR EACH tArtst
  255. BY tArtst.Wg_Grp
  256. BY tArtst.Herst
  257. BY tArtst.Bez
  258. BY tArtst.KGeb :
  259. Artnr = Artnr + 1.
  260. CREATE tArtstN.
  261. BUFFER-COPY tArtst EXCEPT Artnr Inhalt Jahr FremdNr
  262. TO tArtstN
  263. ASSIGN tArtstN.Artnr = Artnr
  264. tArtstN.Inhalt = 0
  265. tArtstN.Jahr = tArtst.Jahr
  266. tArtstN.FremdNr = STRING(tArtst.Artnr ,'999999')
  267. + STRING(tArtst.Inhalt,'9999')
  268. + STRING(tArtst.Jahr ,'9999').
  269. END.
  270. FOR EACH tArtstN:
  271. IF tArtstN.Wg_Grp = 05 THEN NEXT.
  272. IF tArtstN.Wg_Grp = 07 THEN NEXT.
  273. IF tArtstN.Wg_Grp = 08 THEN NEXT.
  274. ASSIGN tArtstN.Jahr = 0.
  275. END.
  276. FOR EACH _Field WHERE _Field._Field-Name = 'Artnr',
  277. FIRST _File OF _Field:
  278. CREATE tDateien.
  279. ASSIGN tDateien.cName = _File._File-Name.
  280. END.
  281. OUTPUT TO 'D:\Temp\Huber_Artst_N.csv' NO-MAP NO-CONVERT.
  282. FOR EACH tArtstN NO-LOCK:
  283. EXPORT DELIMITER ';' tArtstN.
  284. END.
  285. OUTPUT CLOSE.
  286. END PROCEDURE.
  287. /* _UIB-CODE-BLOCK-END */
  288. &ANALYZE-RESUME
  289. &ENDIF
  290. &IF DEFINED(EXCLUDE-REORG_ARTIKEL) = 0 &THEN
  291. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE REORG_ARTIKEL Procedure
  292. PROCEDURE REORG_ARTIKEL :
  293. /*------------------------------------------------------------------------------
  294. Purpose:
  295. Parameters: <none>
  296. Notes:
  297. ------------------------------------------------------------------------------*/
  298. DEF VAR cWert AS CHAR NO-UNDO.
  299. DEF VAR iWert AS INT NO-UNDO.
  300. DEF VAR cRecArt AS CHAR NO-UNDO.
  301. DEF VAR yRecArt AS CHAR NO-UNDO.
  302. DEF VAR ix AS INT NO-UNDO.
  303. DEF BUFFER bArtst FOR Artst.
  304. FOR EACH Artst WHERE Artst.Firma = cFirma:
  305. IF NOT Artst.Aktiv THEN NEXT.
  306. IF Artst.Bestand > 0 THEN NEXT.
  307. IF Artst.EDat >= 07/01/2003 THEN NEXT.
  308. FIND FIRST Artbw NO-LOCK USE-INDEX Artbw-k9
  309. WHERE Artbw.Firma = Artst.Firma
  310. AND Artbw.Artnr = Artst.Artnr
  311. AND Artbw.Inhalt = Artst.Inhalt
  312. AND Artbw.Jahr = Artst.Jahr NO-ERROR.
  313. IF NOT AVAILABLE Artbw OR
  314. Artbw.Datum < 07/01/2003 THEN DO:
  315. Artst.Aktiv = FALSE.
  316. END.
  317. END.
  318. EMPTY TEMP-TABLE tKGebinde.
  319. EMPTY TEMP-TABLE tVGebinde.
  320. EMPTY TEMP-TABLE tGGebinde.
  321. FOR EACH KGebinde WHERE KGebinde.Firma = cFirma NO-LOCK:
  322. CREATE tKGebinde.
  323. BUFFER-COPY KGebinde TO tKGebinde
  324. ASSIGN tKGebinde.Aktiv = FALSE.
  325. END.
  326. FOR EACH Artst NO-LOCK
  327. WHERE Artst.Firma = '1000'
  328. AND Artst.Aktiv = TRUE
  329. BREAK BY Artst.KGeb_Cd:
  330. IF FIRST-OF ( Artst.KGeb_Cd ) THEN DO:
  331. FIND FIRST tKGebinde
  332. WHERE tKGebinde.Firma = Artst.Firma
  333. AND tKGebinde.Geb_Cd = Artst.KGeb_Cd NO-ERROR.
  334. tKGebinde.Aktiv = TRUE.
  335. END.
  336. END.
  337. FOR EACH tKGebinde WHERE NOT tkgebinde.aktiv.
  338. FIND KGebinde OF tKGebinde.
  339. DELETE KGebinde.
  340. END.
  341. FOR EACH VGebinde WHERE VGebinde.Firma = cFirma NO-LOCK:
  342. CREATE tVGebinde.
  343. BUFFER-COPY VGebinde TO tVGebinde
  344. ASSIGN tVGebinde.Aktiv = FALSE.
  345. END.
  346. FOR EACH Artst NO-LOCK
  347. WHERE Artst.Firma = '1000'
  348. AND Artst.Aktiv = TRUE
  349. BREAK BY Artst.VGeb_Cd:
  350. IF FIRST-OF ( Artst.VGeb_Cd ) THEN DO:
  351. FIND FIRST tVGebinde
  352. WHERE tVGebinde.Firma = Artst.Firma
  353. AND tVGebinde.Geb_Cd = Artst.VGeb_Cd.
  354. tVGebinde.Aktiv = TRUE.
  355. END.
  356. END.
  357. FOR EACH tVGebinde WHERE NOT tVGebinde.aktiv.
  358. FIND VGebinde OF tVGebinde.
  359. DELETE VGebinde.
  360. END.
  361. FOR EACH GGebinde WHERE GGebinde.Firma = cFirma NO-LOCK:
  362. CREATE tGGebinde.
  363. BUFFER-COPY GGebinde TO tGGebinde
  364. ASSIGN tGGebinde.Aktiv = FALSE.
  365. END.
  366. FOR EACH Artst NO-LOCK
  367. WHERE Artst.Firma = '1000'
  368. AND Artst.Aktiv = TRUE
  369. BREAK BY Artst.GGeb_Cd:
  370. IF FIRST-OF ( Artst.GGeb_Cd ) THEN DO:
  371. FIND FIRST tGGebinde
  372. WHERE tGGebinde.Firma = Artst.Firma
  373. AND tGGebinde.Geb_Cd = Artst.GGeb_Cd.
  374. tGGebinde.Aktiv = TRUE.
  375. END.
  376. END.
  377. FOR EACH tGGebinde WHERE NOT tGGebinde.aktiv.
  378. FIND GGebinde OF tGGebinde.
  379. DELETE GGebinde.
  380. END.
  381. /*
  382. FOR EACH Artst
  383. WHERE Artst.Firma = '1000'
  384. AND Artst.Aktiv :
  385. IF Artst.Wg_Grp > 16 THEN ASSIGN Artst.Sk_Ber = FALSE.
  386. ELSE Artst.Sk_Ber = TRUE.
  387. IF Artst.Wg_Grp = 9 THEN ASSIGN Artst.Sk_Ber = FALSE.
  388. ASSIGN Artst.Netto = TRUE.
  389. IF Artst.Wg_Grp < 6 THEN ASSIGN Artst.Netto = FALSE.
  390. IF Artst.Wg_Grp > 10 AND
  391. Artst.Wg_Grp < 13 THEN ASSIGN Artst.Netto = FALSE.
  392. IF Artst.Wg_Grp > 13 AND
  393. Artst.Wg_Grp < 17 THEN ASSIGN Artst.Netto = FALSE.
  394. END.
  395. */
  396. END PROCEDURE.
  397. /* _UIB-CODE-BLOCK-END */
  398. &ANALYZE-RESUME
  399. &ENDIF
  400. &IF DEFINED(EXCLUDE-REORG_DEBITOR) = 0 &THEN
  401. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE REORG_DEBITOR Procedure
  402. PROCEDURE REORG_DEBITOR :
  403. /*------------------------------------------------------------------------------
  404. Purpose:
  405. Parameters: <none>
  406. Notes:
  407. ------------------------------------------------------------------------------*/
  408. DEF VAR cWert AS CHAR NO-UNDO.
  409. DEF VAR iWert AS INT NO-UNDO.
  410. DEF VAR cRecArt AS CHAR NO-UNDO.
  411. DEF VAR yRecArt AS CHAR NO-UNDO.
  412. DEF VAR ix AS INT NO-UNDO.
  413. DEF BUFFER bArtst FOR Artst.
  414. FOR EACH Tabel
  415. WHERE Tabel.Firma = '1000'
  416. AND Tabel.RecArt = 'PREGRP':
  417. Tabel.Int_2 = 0.
  418. END.
  419. FOR EACH Debst NO-LOCK
  420. WHERE Debst.Firma = cFirma
  421. AND Debst.Aktiv
  422. BREAK BY Debst.Preis_Grp:
  423. IF NOT FIRST-OF ( Debst.Preis_Grp ) THEN NEXT.
  424. FIND Tabel
  425. WHERE Tabel.Firma = Debst.Firma
  426. AND Tabel.RecArt = 'PREGRP'
  427. AND Tabel.CodeC = ''
  428. AND Tabel.CodeI = Debst.Preis_Grp
  429. AND Tabel.Sprcd = 1.
  430. ASSIGN Tabel.Int_2 = 1.
  431. END.
  432. END PROCEDURE.
  433. /* _UIB-CODE-BLOCK-END */
  434. &ANALYZE-RESUME
  435. &ENDIF
  436. &IF DEFINED(EXCLUDE-UMNUMMERIEREN) = 0 &THEN
  437. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE UMNUMMERIEREN Procedure
  438. PROCEDURE UMNUMMERIEREN :
  439. /*------------------------------------------------------------------------------
  440. Purpose:
  441. Parameters: <none>
  442. Notes:
  443. ------------------------------------------------------------------------------*/
  444. DEF VAR iArtnr AS INT NO-UNDO.
  445. DEF VAR iInhalt AS INT NO-UNDO.
  446. DEF VAR iJahr AS INT NO-UNDO.
  447. DEF VAR hFeld AS HANDLE NO-UNDO.
  448. DEF VAR hArtstN AS HANDLE NO-UNDO.
  449. DEF VAR hBuffer AS HANDLE NO-UNDO.
  450. DEF VAR hQuery AS HANDLE NO-UNDO.
  451. DEF VAR hTemp AS HANDLE NO-UNDO.
  452. DEF VAR hTempBuff AS HANDLE NO-UNDO.
  453. DEF VAR cWhere AS CHAR NO-UNDO.
  454. DEF VAR cFeld AS CHAR NO-UNDO.
  455. DEF VAR cDumpName AS CHAR NO-UNDO.
  456. DEF VAR cString AS CHAR NO-UNDO.
  457. DEF VAR i1 AS INT NO-UNDO.
  458. DEF VAR i2 AS INT NO-UNDO.
  459. DEF VAR iZeit AS INT NO-UNDO.
  460. DEF VAR iAnz AS INT NO-UNDO.
  461. hArtstN = TEMP-TABLE tArtstN:DEFAULT-BUFFER-HANDLE.
  462. FOR EACH tArtstN USE-INDEX tArtstN-k1 TRANSACTION:
  463. ASSIGN iArtnr = INTEGER(SUBSTRING(tArtstN.FremdNr,01,06))
  464. iInhalt = INTEGER(SUBSTRING(tArtstN.FremdNr,07,04))
  465. iJahr = INTEGER(SUBSTRING(tArtstN.FremdNr,11,04)).
  466. FIND Artst WHERE RECID(Artst) = tArtstN.iRecid.
  467. FOR EACH tDateien WHERE tDateien.cName <> 'Artst':
  468. iZeit = ETIME(TRUE).
  469. iAnz = 0.
  470. CREATE BUFFER hBuffer FOR TABLE tDateien.cName.
  471. CREATE QUERY hQuery.
  472. hQuery:SET-BUFFERS(hBuffer).
  473. CASE tDateien.cName:
  474. WHEN 'ArtUms' OR
  475. WHEN 'DeArUms' THEN DO:
  476. cWhere = 'FOR EACH &1 '
  477. + 'WHERE &1.Firma = &2 '
  478. + 'AND &1.Artnr = &3 '
  479. + 'AND &1.Inhalt = &4 '
  480. + 'AND &1.Jahrg = &5 '.
  481. END.
  482. OTHERWISE DO:
  483. cWhere = 'FOR EACH &1 '
  484. + 'WHERE &1.Firma = &2 '
  485. + 'AND &1.Artnr = &3 '
  486. + 'AND &1.Inhalt = &4 '
  487. + 'AND &1.Jahr = &5 '.
  488. END.
  489. END CASE.
  490. cWhere = SUBSTITUTE(cWhere, tDateien.cName,
  491. '"1000"' ,
  492. iArtnr ,
  493. iInhalt,
  494. iJahr ).
  495. hQuery:QUERY-PREPARE(cWhere) NO-ERROR.
  496. IF ERROR-STATUS:ERROR THEN DO:
  497. MESSAGE cWhere 'funktioniert nicht!' VIEW-AS ALERT-BOX.
  498. NEXT.
  499. END.
  500. cDumpName = tDateien.cName + '.d'.
  501. CREATE TEMP-TABLE hTemp.
  502. hTemp:CREATE-LIKE(hBuffer).
  503. hTemp:TEMP-TABLE-PREPARE("tDump").
  504. hTempBuff = hTemp:DEFAULT-BUFFER-HANDLE.
  505. hQuery:QUERY-OPEN().
  506. hQuery:GET-FIRST().
  507. DO WHILE NOT hQuery:QUERY-OFF-END:
  508. iAnz = iAnz + 1.
  509. hTempBuff:BUFFER-CREATE.
  510. hTempBuff:BUFFER-COPY(hBuffer, "Artnr,Inhalt").
  511. ASSIGN hTempBuff::Artnr = hArtstN::Artnr
  512. hTempBuff::Inhalt = hArtstN::Inhalt.
  513. CASE tDateien.cName:
  514. WHEN 'ArtUms' OR
  515. WHEN 'DeArUms' THEN ASSIGN hTempBuff::Jahrg = hArtstN::Jahr.
  516. OTHERWISE ASSIGN hTempBuff::Jahr = hArtstN::Jahr.
  517. END CASE.
  518. hQuery:GET-NEXT().
  519. END.
  520. OUTPUT TO 'D:\Temp\Reorg.log' APPEND.
  521. PUT CONTROL 'Verarbeitet -> ' tDateien.cName ' / Zeit ' ETIME(FALSE) CHR(10).
  522. OUTPUT CLOSE.
  523. hQuery:QUERY-CLOSE().
  524. DELETE OBJECT hQuery NO-ERROR.
  525. DELETE OBJECT hBuffer NO-ERROR.
  526. CREATE QUERY hQuery.
  527. hQuery:SET-BUFFERS(hTempBuff).
  528. hQuery:QUERY-PREPARE("FOR EACH tDump").
  529. hQuery:QUERY-OPEN().
  530. hQuery:GET-FIRST(NO-LOCK).
  531. OUTPUT STREAM out TO VALUE(cDumpName) APPEND NO-MAP NO-CONVERT.
  532. DO WHILE NOT hQuery:QUERY-OFF-END:
  533. cString = ''.
  534. DO i1 = 1 TO hTempBuff:NUM-FIELDS:
  535. hFeld = hTempBuff:BUFFER-FIELD(i1).
  536. IF hFeld:EXTENT = 0 THEN DO:
  537. cFeld = hFeld:BUFFER-VALUE(0).
  538. IF cFeld = ? THEN cFeld = '?'.
  539. IF hFeld:DATA-TYPE = 'character' THEN DO:
  540. cFeld = '"' + REPLACE(cFeld, '"', '""') + '"'.
  541. END.
  542. IF cString <> '' THEN cString = cString + ' '.
  543. cString = cString + cFeld.
  544. END.
  545. ELSE DO:
  546. DO i2 = 1 TO hFeld:EXTENT:
  547. cFeld = hFeld:BUFFER-VALUE(i2).
  548. IF cFeld = ? THEN cFeld = '?'.
  549. IF hFeld:DATA-TYPE = 'character' THEN DO:
  550. cFeld = '"' + REPLACE(cFeld, '"', '""') + '"'.
  551. END.
  552. IF cString <> '' THEN cString = cString + ' '.
  553. cString = cString + cFeld.
  554. END.
  555. END.
  556. END.
  557. PUT STREAM out UNFORMATTED cString SKIP.
  558. hQuery:GET-NEXT(NO-LOCK).
  559. END.
  560. OUTPUT STREAM out CLOSE.
  561. hQuery:QUERY-CLOSE().
  562. DELETE OBJECT hTemp NO-ERROR.
  563. DELETE OBJECT hTempBuff NO-ERROR.
  564. DELETE OBJECT hQuery NO-ERROR.
  565. END.
  566. END.
  567. OUTPUT STREAM artst TO 'Artst.d' NO-MAP NO-CONVERT.
  568. FOR EACH tArtstN:
  569. EXPORT STREAM artst tArtstN EXCEPT KGeb iRecid .
  570. END.
  571. OUTPUT STREAM artst CLOSE.
  572. END PROCEDURE.
  573. /* _UIB-CODE-BLOCK-END */
  574. &ANALYZE-RESUME
  575. &ENDIF