· 9 years ago · Jan 20, 2017, 05:24 PM
1////////////////////////////////////////////////////////////////////////
2//
3// WARNING: do not declare same procedure name twice!
4//
5////////////////////////////////////////////////////////////////////////
6
7// Updated 5 DEC 2014 Lorenz Wolf
8// Updated 11 DEC 2015 Lorenz Wolf
9// Checked 25 Jan 2015 Lorenz Wolf
10// Updated 4 MARCH 2015 Wallpaper Changes block sell from stock
11// Updated 4 MARCH 2015 Wallpaper Changes block sell from stock added quantity check to make sure Walpaper can be returned
12
13// Updated 8 April 2015 Web service IFS CUSTOMER CHECK BAL only for IFS Credit account customers 'TRC' Account type
14
15
16// Update 9 April Cannot include sales items with a cancel customer order add to after valid.
17// Update 14 Error message on cancel and Sales warning
18// Update 27 MAY 2015 Error Report from IFS Added to menu options
19// updated 16 June Cancel Customer order Cancel item can no longer be deleted
20// Updated 29 June Replace Updete delivert trigger on hand over goods to customer
21// updated July 1 Update Zero negative quantity prevent
22// update Dec 3 2015 ALF are now generate from IFS IPT_receipt view ,Previously they where created by transforming the CF to an ALF
23// update 15 March 2016 Carrige Offer Changes implemented see FB Requirements folder.
24
25
26var
27 DebugTOB,GlobalTOB,INTERNAL_REF_G,ZBN_ARTICLES, DEBUG_MODE, GLOBALCOUNT;
28
29
30procedure CbrReceipt.BeforeValid(TOBD, TOBR)
31var
32 GP_NATUREPIECEG,Register;
33begin
34 DEBUG_MODE := False;
35 Register := CbrRegister.Current();
36 GlobalTOB := TobDetail(TOBD, 0) ;
37 GP_NATUREPIECEG := TobGetValue(GlobalTOB, 'GP_NATUREPIECEG');
38 INTERNAL_REF_G := '';
39 ZBN_ARTICLES := '';
40 if NeedShowForm(GlobalTOB,GP_NATUREPIECEG) = True then
41 begin
42 INTERNAL_REF_G := OuvreFiche('Z','ZBN_REF_RETURN', '','','');
43 if INTERNAL_REF_G = '' then
44 begin
45 TobPutValue(TOBR, 'MESSAGE', 'Cancelled by user !');
46 TobPutValue(TOBR, 'VALID', '2');
47 end else
48 begin
49 ZBN_ARTICLES := RunBatchNumsForm(GlobalTOB);
50 if ZBN_ARTICLES = '' then
51 begin
52 TobPutValue(TOBR, 'MESSAGE', 'Cancelled by user !');
53 TobPutValue(TOBR, 'VALID', '2');
54 ExecuteSQLExt('DELETE FROM ZRITBATCHNUMBERS WHERE ZBN_NUMERO = 0 and ZBN_QUALIFMVT = "' + Register + '"',False);
55 end else
56 begin
57 TobPutValue(TOBR, 'MESSAGE', 'Success');
58 TobPutValue(TOBR, 'VALID', '0');
59 end;
60 end;
61 end;
62
63 // Check no wallpaper from Stock
64 CbrReceipt_BeforeValid_NoWallPaperFromStock(TOBD, TOBR);
65 // Check restricted Items
66
67
68 CbrReceipt_BeforeValid_SUBSALERESTRICT(TOBD, TOBR);
69 // Check for cancel lines with sales together
70 CbrReceipt_BeforeValid_CheckContainSales(TOBD, TOBR);
71
72 // Check for carriage items
73 CbrReceipt_BeforeValid_Carriage_Offering_Trial(TOBD, TOBR);
74
75//check single service items
76 CbrReceipt_BeforeValid_CheckonlySingleServiceItem(TOBD, TOBR)
77end;
78
79procedure CbrReceipt_BeforeValid_Carriage_Offering_Trial(TOBD, TOBR);
80var
81 tobDoc,
82 tobLine,
83 I,
84 SamplesOnly,
85 SamplesQty,
86 IPDExists,
87 IPDTotalValue,
88 CarriageOfferMsg;
89begin
90
91 tobDoc := TobDetail(TOBD, 0);
92 if (TobGetValue(tobDoc, 'GP_NATUREPIECEG') <> 'FFO') or
93 (CbrStore.GetField('ET_PAYS', TobGetValue(tobDoc, 'GP_ETABLISSEMENT')) <> 'GBR') then
94 begin
95 Exit;
96 end;
97 SamplesOnly := True;
98 SamplesQty := 0;
99 IPDTotalValue := 0;
100 IPDExists := False;
101 I := TobCount(tobDoc) - 1;
102 while I >= 0 do
103 begin
104 tobLine := TobDetail(tobDoc, I);
105 if TobGetValue(tobLine, 'GL_STATUTENVOI') = 'LIC' then
106 begin // it's an IPD item
107 IPDExists := True;
108 if TobGetValue(tobLine, 'GL_FAMILLENIV1') = 'SAM' then
109 SamplesQty := SamplesQty + TobGetValue(tobLine, 'GL_QTEFACT')
110 else
111 SamplesOnly := False;
112 IPDTotalValue := IPDTotalValue + TobGetValue(tobLine, 'GL_TOTALTTC');
113 end;
114 I := I - 1;
115 end;
116
117 if not IPDExists then
118 Exit;
119 if SamplesOnly then
120 begin
121 if SamplesQty > 3 then
122 CarriageOfferMsg := 'Carriage Offer: Express £5 otherwise FOC.' // M3
123 else
124 CarriageOfferMsg := 'Carriage Offer: Express £10 otherwise 95p.'; // M4
125 end
126 else
127 begin
128 if IPDTotalValue > 100 then
129 CarriageOfferMsg := 'Carriage offer: Express £5 otherwise FOC.' // M1
130 else
131 CarriageOfferMsg := 'Carriage Offer: Express £10 otherwise £4.95.'; // M2
132 end;
133
134 if OuvreFiche('Z', 'CARRIAGEOFFER', '', '', CarriageOfferMsg) <> 'X' then
135 //if PgiAsk(CarriageOfferMsg, 'Carriage offer') <> mrYes then
136 begin
137 TobPutValue(TOBR, 'MESSAGE', CarriageOfferMsg);
138 TobPutValue(TOBR, 'VALID', '2');
139 end;
140end;
141
142procedure CbrReceipt_BeforeValid_CheckContainSales(TOBD, TOBR)
143begin
144 if CheckOrderContent(TOBD, True, True) then
145 begin
146 TobPutValue(TOBR, 'MESSAGE', 'Please remove sales line(s) from cancellation'+chr(13)+chr(10)+'Sales must be processed in a seperate transaction.');
147 TobPutValue(TOBR, 'VALID', '2');
148 end;
149end;
150
151procedure CbrReceipt_BeforeValid_CheckonlySingleServiceItem(TOBD, TOBR)
152begin
153 if CheckOrderforShipQty(TOBD) then
154 begin
155 TobPutValue(TOBR, 'MESSAGE', 'Please adjust shipping item quantitiy'+chr(13)+chr(10)+'Shipping service items can only have a qty of one');
156 TobPutValue(TOBR, 'VALID', '2');
157 end;
158end;
159
160function CheckOrderforShipQty(tobData)
161var
162 tobDoc,
163 tobLine,
164 ContainsInvalidShipQty,
165 I;
166begin
167 Result := False;
168 tobDoc := TobDetail(tobData, 0);
169
170
171 ContainsInvalidShipQty := False;
172 I := TobCount(tobDoc) - 1;
173 while I >= 0 do
174 begin
175 tobLine := TobDetail(tobDoc, I);
176 if TobGetValue(tobLine, 'GL_FAMILLENIV1') = 'SHI' then
177 begin
178 if not ( TobGetValue(tobLine, 'GL_QTEFACT') =1 or TobGetValue(tobLine, 'GL_QTEFACT') = -1) then
179 Begin
180 I := True
181 CbpTraceVerbose('SHIPQTYCHECK', 'SHIPPING QUANTITY <> to 1');
182 ContainsInvalidShipQty:=True;
183 Result:= ContainsInvalidShipQty;
184 Break;
185 End;
186 end;
187 I := I - 1;
188 end;
189
190
191Result:=ContainsInvalidShipQty;
192
193// TobDebug(tobDoc);
194
195end;
196
197procedure CbrReceipt_BeforeValid_NoWallPaperFromStock(TOBD, TOBR)
198var
199 ItemStatus,
200 iLine,
201 tobDoc,
202 tobLines,
203 STATUTENVOI ;
204begin
205 tobDoc := TobDetail(TOBD, 0);
206 iLine := 0;
207 while iLine < TobCount(tobDoc) do
208 begin
209// TobDebug(tobLines) ;
210 tobLines := TobDetail(tobDoc, iLine);
211 STATUTENVOI :=TobGetValue(tobLines, 'GL_STATUTENVOI');
212 if (not (STATUTENVOI='RET' or STATUTENVOI='REC' or STATUTENVOI='LIC')) and (TobGetValue(tobLines, 'GL_FAMILLENIV1')='WAL') and (TobGetValue(tobLines, 'GL_QTEFACT')>0) then
213 Begin
214 TobPutValue(TOBR, 'MESSAGE', 'Wallpaper Cannot be sold from Stock !' + TobGetValue(tobLines,'GL_LIBELLE'));
215 TobPutValue(TOBR, 'VALID', '2');
216 break; // exit for loop
217 end
218 iLine := iLine + 1;
219 end;
220end;
221
222
223
224// restrict selling items (by barcode) in an overseas subsidiary
225// to be called from procedure CbrReceipt.BeforeValid(TOBD, TOBR)
226procedure CbrReceipt_BeforeValid_SUBSALERESTRICT(TOBD, TOBR)
227var
228 ItemStatus,
229 Query,
230 BarcodesStr,
231 Barcode,
232 iLine,
233 tobDoc,
234 tobLines;
235begin
236 tobDoc := TobDetail(TOBD, 0);
237 iLine := 0;
238 BarcodesStr := '';
239 while iLine < TobCount(tobDoc) do
240 begin
241 tobLines := TobDetail(tobDoc, iLine);
242 Query := OpenSQL(
243 'select ZRI_FILIALE, ZRI_CODEBARRE, ZRI_STATUS from ZSUBSALERESTRICT join ARTICLE on ZRI_CODEBARRE=GA_CODEBARRE join ETABLISS on ZRI_FILIALE=ET_FILIALE where ET_ETABLISSEMENT="'+
244 TobGetValue(tobLines, 'GL_ETABLISSEMENT')+'" and GA_ARTICLE in ("'+TobGetValue(tobLines, 'GL_ARTICLE')+'")',
245 True);
246 if not QueryEOF(Query) then
247 begin
248 Barcode := FieldSQL(Query, 1) + '(' + ItemStatus + ')';
249 ItemStatus := Upper(FieldSQL(Query, 2));
250 if (ItemStatus = 'BLOCKED') or ((ItemStatus = 'CLOSED') and (TobGetValue(tobLines, 'GL_STATUTENVOI') <> '')) then
251 if BarcodesStr = '' then
252 BarcodesStr := Barcode
253 else
254 BarcodesStr := BarcodesStr + ', ' + Barcode;
255 end;
256 CloseSQL(Query);
257 iLine := iLine + 1;
258 end;
259
260 if BarcodesStr <> '' then
261 begin
262 TobPutValue(TOBR, 'MESSAGE', 'Restricted subsidiary barcode(s): ' + BarcodesStr);
263 TobPutValue(TOBR, 'VALID', '2');
264 end;
265end;
266
267
268function CheckforZeroOrNegLine(TOBD);
269var
270 iLine,TobLigne,GL_ARTICLE,sql,GA_BOOLLIBRE3,sql,TobPiece;
271begin
272 result:=False;
273 iLine := TobCount(TOBD) - 1;
274 TobPiece:=TobDetail(TOBD, 0);
275
276 while iLine >= 0 do
277 begin
278
279 tobLigne := TobDetail(TobPiece, iLine);
280 // TobDebug(tobLigne);
281 GL_ARTICLE := TobGetValue(tobLigne, 'GL_ARTICLE');
282 if (TobGetValue(tobLigne, 'GL_QTEFACT') <= 0) and (TobGetValue(tobLigne, 'GL_TYPEREF') ='ART') then
283 begin
284 result := True;
285 Exit;
286 end;
287
288 iLine := iLine - 1;
289 end; {lines tob}
290end;
291
292
293
294// Quick Work around
295procedure CbrDocument.BeforeValid_xxx( TOBD, TOBR )
296var
297 GP_NATUREPIECEG,Register,tmp,ETABLISS,DEPOTS,msg;
298begin
299 Register := CbrRegister.Current();
300 DEBUG_MODE := False;
301 GlobalTOB := TobDetail(TOBD, 0) ;
302 GP_NATUREPIECEG := TobGetValue(GlobalTOB, 'GP_NATUREPIECEG');
303 ZBN_ARTICLES := '';
304 INTERNAL_REF_G := '';
305
306if GP_NATUREPIECEG<>'FFO' and GP_NATUREPIECEG<>'CC'
307 Begin
308
309 if CheckforZeroOrNegLine(TOBD)=True then
310 begin
311 TobPutValue(TOBR, 'MESSAGE', 'Please correct ! ' + Chr(13) + Chr(10) + 'Negative/Zero Quantities not allowed !');
312 TobPutValue(TOBR, 'VALID', '2');
313 exit;
314 end;
315
316
317 end;
318
319
320 if NeedShowForm(GlobalTOB,GP_NATUREPIECEG) = True then
321 begin
322 ZBN_ARTICLES := RunBatchNumsForm(GlobalTOB);
323 if ZBN_ARTICLES = '' then
324 begin
325 TobPutValue(TOBR, 'MESSAGE', 'Cancelled by user !');
326 TobPutValue(TOBR, 'VALID', '2');
327 ExecuteSQLExt('DELETE FROM ZRITBATCHNUMBERS WHERE ZBN_NUMERO = 0 and ZBN_QUALIFMVT = "' + Register + '"',False);
328 end else
329 begin
330 TobPutValue(TOBR, 'MESSAGE', 'Success');
331 TobPutValue(TOBR, 'VALID', '0');
332 end;
333 end;
334
335 tmp := TobDetail(TOBD, 0) ;
336 if TobGetValue(tmp, 'GP_NATUREPIECEG') = 'BTR' then
337 begin
338 ETABLISS := '@@SELECT ET_ETABLISSEMENT FROM ETABLISS WHERE ET_ABREGE IN (''HUDDE'',''HTORO'',''HLOSA'') AND ET_ETABLISSEMENT = ''' + TobGetValue(tmp, 'GP_ETABLISSDEST') + '''';
339 DEPOTS := '@@SELECT GDE_DEPOT FROM DEPOTS WHERE GDE_LIBELLE LIKE ''%Returns%'' AND GDE_DEPOT = ''' + TobGetValue(tmp, 'GP_DEPOT') + '''';
340// StrDebug(DEPOTS);
341 if (not ExisteSQL(ETABLISS)) or (not ExisteSQL(DEPOTS)) then
342 begin
343 msg := 'Sender Warehouse can only be a "Return" warehouse of sending store, the recipient warehouse can only one of HUDDE, HTORO or HLOSA';
344
345 TobPutValue(TOBR, 'MESSAGE', msg);
346 TobPutValue(TOBR, 'VALID', '2');
347 end else
348 begin
349 TobPutValue(TOBR, 'MESSAGE', 'Success');
350 TobPutValue(TOBR, 'VALID', '0');
351 end;
352 end;
353
354
355
356
357end;
358
359
360function CreateTransferTob(TOBPiece)
361var
362 TobLigne,TOBDetailRec,I,GA_BOOLLIBRE3,sql;
363begin
364 result := TobCreate('MASTER', 0, -1);
365 TobAddChampSupValeur(result,'NUMERO', TobGetValue(TOBPiece, 'GP_NUMERO'), False);
366 TobAddChampSupValeur(result,'NATUREPIECEG',TobGetValue(TOBPiece, 'GP_NATUREPIECEG') , False);
367 TobAddChampSupValeur(result,'DEPOT',TobGetValue(TOBPiece, 'GP_DEPOT'), False);
368 TobAddChampSupValeur(result,'INTERNAL_REF',INTERNAL_REF_G, False);
369 TobAddChampSupValeur(result,'CODEBARE',TobGetValue(TOBPiece, 'GP_CODEBARE'), False);
370 I := 0;
371 while I < TobCount(TOBPiece) do
372 begin
373 TobLigne := TobDetail(TOBPiece, I) ;
374 if (TobGetValue(TOBPiece, 'GP_NATUREPIECEG') ='FFO') and (TobGetValue(TobLigne, 'GL_QTEFACT') > 0) then
375 begin
376 I := I + 1;
377 Continue;
378 end;
379 sql := 'select GA_BOOLLIBRE3 from ARTICLE where GA_ARTICLE = "' + TobGetValue(TobLigne, 'GL_ARTICLE') + '"';
380 GA_BOOLLIBRE3 := ReturnSQLField(sql,0);
381 if (GA_BOOLLIBRE3 = 'X') then
382 begin
383 TOBDetailRec := TobCreate('DETAIL', result, -1);
384 TobAddChampSupValeur(TOBDetailRec,'NATUREPIECEG',TobGetValue(TobLigne, 'GL_NATUREPIECEG'), False);
385 TobAddChampSupValeur(TOBDetailRec,'NUMERO',TobGetValue(TobLigne, 'GL_NUMERO'), False);
386 TobAddChampSupValeur(TOBDetailRec,'DEPOT',TobGetValue(TobLigne, 'GL_DEPOT'), False);
387 TobAddChampSupValeur(TOBDetailRec,'NUMLIGNE',TobGetValue(TobLigne, 'GL_NUMLIGNE'), False);
388 TobAddChampSupValeur(TOBDetailRec,'CODEBARE',TobGetValue(TobLigne, 'GL_CODEBARE'), False);
389 TobAddChampSupValeur(TOBDetailRec,'ARTICLE',TobGetValue(TobLigne, 'GL_ARTICLE'), False);
390 TobAddChampSupValeur(TOBDetailRec,'CODEARTICLE',TobGetValue(TobLigne, 'GL_CODEARTICLE'), False);
391 TobAddChampSupValeur(TOBDetailRec,'LIBELLE',TobGetValue(TobLigne, 'GL_LIBELLE'), False);
392 TobAddChampSupValeur(TOBDetailRec,'QTEINV', ABS(TobGetValue(TobLigne, 'GL_QTEFACT')), False);
393 TobAddChampSupValeur(TOBDetailRec,'SOUCHE',TobGetValue(TobLigne, 'GL_SOUCHE'), False);
394 end;
395 I := I + 1;
396 end;
397end;
398
399function RunBatchNumsForm(TOBPiece)
400var
401 FileName,TransferTob,ZBN_ARTICLES,sql,FieldDesc,DirName;
402begin
403// StrDebug('RunBatchNumsForm');
404 DirName := GetCbpPath('GetCegidUserLocalAppData');
405 if not FileExists(DirName) then
406 CreateDir(DirName)
407 FileName := DirName + '\' + 'BatchNumbersTob.xml';
408 FieldDesc := 'NATUREPIECEG,NUMERO,DEPOT,NUMLIGNE,CODEBARRE,ARTICLE,CODEARTICLE,LIBELLE';
409 DeleteFile (FileName);
410 TransferTob := CreateTransferTob(TOBPiece);
411 TobSaveToXMLFile(TransferTob, FileName, False, True, False, '');
412 result := OuvreFiche('Z','ZBATCHNUMS_GSE', '','','FileName=' + FileName + ';FieldDesc=' + FieldDesc);
413end;
414
415procedure INSERT_STKMOUVEMENTS_IPD(DO_ORDER_NO,GLP_NUMERO_ALF,GP_DEPOT,STORE)
416var
417 IPT_RECEIPT_SQL,IPT_RECEIPT_QRY,
418 GSM_SOUCHE,GSM_DEPOT,GSM_ARTICLE,I,GSM_PHYSIQUE,LOT_BATCH_NO,INT_REF;
419begin
420
421// Most probalbly returning more than one row multipe batchno returned her
422 IPT_RECEIPT_SQL := 'SELECT DO_SITE,"CCOLL" ,' +
423 ' QTY_DUE ,GA_ARTICLE,LOT_BATCH_NO,DO_REF_ID from ZCBR_ORDER_INFO join ARTICLE ON (GA_CODEBARRE = PART_NO) WHERE DO_ORDER_NO = "' + DO_ORDER_NO + '"';
424
425 // StrDebug(IPT_RECEIPT_SQL);
426
427
428 if not CHECK_SQL(IPT_RECEIPT_SQL) then Exit;
429 IPT_RECEIPT_QRY := OpenSQL(IPT_RECEIPT_SQL, True);
430
431
432 I := 1;
433 while not QueryEOF(IPT_RECEIPT_QRY) do
434 begin
435 GSM_SOUCHE := STORE;
436 GSM_DEPOT := GP_DEPOT;
437 GSM_PHYSIQUE := FieldSQL(IPT_RECEIPT_QRY, 2);
438 GSM_ARTICLE := FieldSQL(IPT_RECEIPT_QRY, 3);
439 LOT_BATCH_NO := FieldSQL(IPT_RECEIPT_QRY, 4);
440 INT_REF := Trim(FieldSQL(IPT_RECEIPT_QRY, 5));
441
442
443 INSERT_STKMOUVEMENT(GLP_NUMERO_ALF,GSM_DEPOT,GSM_SOUCHE,GSM_PHYSIQUE,LOT_BATCH_NO,GSM_ARTICLE,I + 1,INT_REF,'BLC');
444 QueryNext(IPT_RECEIPT_QRY);
445 I := I + 1;
446 end;
447end;
448
449procedure RunTransformToIPD()
450var
451 COI_CUSTOMER_PO_NO,COI_PO_ORDER_NO,IPT_RECEIPT_SQL_ALL,IPT_RECEIPT_QRY_ALL;
452begin
453 DebugMsg('RunTransformToIPD','TRANSFORM IPD');
454 IPT_RECEIPT_SQL_ALL := 'SELECT COI_CUSTOMER_PO_NO,COI_PO_ORDER_NO FROM ZCBR_ORDER_INFO_V';
455 if not CHECK_SQL(IPT_RECEIPT_SQL_ALL) then Exit;
456
457 IPT_RECEIPT_QRY_ALL := OpenSQL(IPT_RECEIPT_SQL_ALL, True);
458 QueryFirst(IPT_RECEIPT_QRY_ALL);
459 while not QueryEOF(IPT_RECEIPT_QRY_ALL) do
460 begin
461 COI_CUSTOMER_PO_NO := Trim(FieldSQL(IPT_RECEIPT_QRY_ALL, 0));
462 COI_PO_ORDER_NO := FieldSQL(IPT_RECEIPT_QRY_ALL, 1);
463 QueryNext(IPT_RECEIPT_QRY_ALL);
464 GenerateOrderDocIPD(COI_CUSTOMER_PO_NO,COI_PO_ORDER_NO);
465 end;
466
467end
468
469procedure INSERT_STKMOUVEMENTS_IPT(PO_ORDER_NO,GLP_NUMERO_ALF)
470var
471 IPT_RECEIPT_SQL,IPT_RECEIPT_QRY,DEPOT_SQL,DEPOT_QRY,RECIPIENT_WAREHOUSE,RECIPIENT_STORE,
472 GSM_SOUCHE,GSM_DEPOT,GSM_ARTICLE,I,GSM_PHYSIQUE,LOT_BATCH_NO,INT_REF;
473begin
474 DebugMsg('INSERT_STKMOUVEMENTS_IPT','TRANSFORM IPT');
475 IPT_RECEIPT_SQL := 'SELECT DO_SITE,"CCOLL" , SO_ORDER_NO ,SO_LINE_NO ,PO_ORDER_NO ,DEMAND_REF_ID, ' +
476 ' QTY_DUE ,GA_ARTICLE,LOT_BATCH_NO from ZCBR_IPT_RECEIPT join ARTICLE ON (GA_CODEBARRE = SO_PART_NO) WHERE PO_ORDER_NO = "' + PO_ORDER_NO + '" and LOT_BATCH_NO<>"*^*" ';
477 if not CHECK_SQL(IPT_RECEIPT_SQL) then Exit;
478 IPT_RECEIPT_QRY := OpenSQL(IPT_RECEIPT_SQL, True);
479
480 DEPOT_SQL := 'SELECT DEPOTS.GDE_DEPOT,ET_ETABLISSEMENT FROM METABDEPOT ' +
481 'INNER JOIN DEPOTS ON (METABDEPOT.MDE_DEPOT = DEPOTS.GDE_DEPOT) ' +
482 'INNER JOIN ETABLISS ON (METABDEPOT.MDE_ETABLISSEMENT = ETABLISS.ET_ETABLISSEMENT) ' +
483 'WHERE ET_ABREGE = "' + FieldSQL(IPT_RECEIPT_QRY, 0) + '" and GDE_CHARLIBRE2 = "' + FieldSQL(IPT_RECEIPT_QRY, 1) + '"';
484 if not CHECK_SQL(DEPOT_SQL) then Exit;
485 DEPOT_QRY := OpenSQL(DEPOT_SQL, True);
486 RECIPIENT_STORE := FieldSQL(DEPOT_QRY, 1);
487 RECIPIENT_WAREHOUSE := FieldSQL(DEPOT_QRY, 0);
488
489 I := 1;
490 while not QueryEOF(IPT_RECEIPT_QRY) do
491 begin
492 GSM_SOUCHE := RECIPIENT_STORE;
493 GSM_DEPOT := RECIPIENT_WAREHOUSE;
494 INT_REF := Trim(FieldSQL(IPT_RECEIPT_QRY, 5));
495 GSM_PHYSIQUE := FieldSQL(IPT_RECEIPT_QRY, 6);
496 GSM_ARTICLE := FieldSQL(IPT_RECEIPT_QRY, 7);
497 LOT_BATCH_NO := FieldSQL(IPT_RECEIPT_QRY, 8);
498
499 INSERT_STKMOUVEMENT(GLP_NUMERO_ALF,GSM_DEPOT,GSM_SOUCHE,GSM_PHYSIQUE,LOT_BATCH_NO,GSM_ARTICLE,I + 1,INT_REF,'ALF');
500 QueryNext(IPT_RECEIPT_QRY);
501 I := I + 1;
502 end;
503end;
504
505
506
507procedure OnChargeMag
508BEGIN
509//
510GLOBALCOUNT:=0;
511END ;
512
513procedure OnChangeModule(num)
514BEGIN
515//le test
516
517GLOBALCOUNT:=0;
518END ;
519
520
521procedure dispatchTT( num,action,Lequel,TT,Range )
522begin
523
524end ;
525
526function ZoomEdt(Qui,Quoi)
527begin
528 result:=false ;
529end ;
530
531
532function CalcEdt(NomFonction,Param1,Param2,Param3,Param4,Param5)
533var
534 FuncName,InfoMsg;
535begin
536 DEBUG_MODE := False;
537 Result := '&#@' ; // cette ligne est destinée à gérer les fonctions @ standards
538
539 FuncName := Upper(NomFonction);
540 if FuncName = 'TOBTODELIMITEDSTRING' then Result := TOBToDelimitedString(Param1,Param2,Param3) else
541 if FuncName = 'DELIMITEDSTRTOTOB' then Result := DelimitedStrToTOB(Param1,Param2,Param3) else
542 if FuncName = 'GETRETOURSTRING' then Result := GetRetourString(Param1,Param2) else
543 if FuncName = 'LOADCONFIGFILE' then Result := LoadConfigFile(Param1) else
544 if FuncName = 'LOADPARAMETRS' then Result := LoadParametrs(Param1,Param2) else
545 if FuncName = 'LOADDEFAULTRECORDS' then Result := LoadDefaultRecords(Param1,Param2) else
546 if FuncName = 'APPLYCOLPROPS' then Result := ApplyColProps(Param1,Param2) else
547 if FuncName = 'SAVEPARAMVALUE' then Result := SaveParamValue(Param1,Param2,Param3,Param4) else
548 if FuncName = 'GETPARAMVALUE' then Result := GetParamValue(Param1,Param2,Param3) else
549 if FuncName = 'LOCATE' then Result := Locate(Param1,Param2,Param3) else
550 if FuncName = 'TOBSORTBYFIELD' then Result := TOBSortByField(Param1,Param2) else
551 if FuncName = 'DECODEPARAMS' then Result := DecodeParams(Param1) else
552 if FuncName = 'ENCODEPARAMS' then Result := EncodeParams(Param1) else
553 if FuncName = 'REGREADVALUE' then Result := RegReadValue(Param1,Param2) else
554 if FuncName = 'SAVEPARAMETRSDB' then Result := SaveParametrsDB(Param1,Param2,Param3) else
555 if FuncName = 'LOADPARAMETRSDB' then Result := LoadParametrsDB(Param1,Param2) else
556 if FuncName = 'NAMEBYFIELDINDEX' then Result := NameByFieldIndex(Param1) else
557 if FuncName = 'LOADDEFAULTFIELDS' then Result := LoadDefaultFields(Param1,Param2,Param3,Param4);
558 if FuncName = 'EXECUTESQLEXT' then Result := ExecuteSQLExt(Param1,Param2) else
559 if FuncName = 'RETURNSQLFIELD' then Result := ReturnSQLField(Param1,Param2) else
560 if FuncName = 'CHECK_SQL' then Result := CHECK_SQL(Param1) else
561 if FuncName = 'INSERT_LINKS_CC_ALF_TOB_PARAMS' then Result := INSERT_LINKS_CC_ALF_TOB_PARAMS(Param1) else
562 if FuncName = 'UPDATE_MPIECEECO_IPT' then Result := UPDATE_MPIECEECO_IPT(Param1,Param2) else
563 if FuncName = 'INSERT_STKMOUVEMENTS_IPT' then Result := INSERT_STKMOUVEMENTS_IPT(Param1,Param2) else
564
565
566 if Result = '&#@' then
567 begin
568 CbpTraceWarning('GLOBALSCRIPT', 'Function not found: ' + NomFonction);
569 if DEBUG_MODE = true then StrDebug('GLOBALSCRIPT', 'Function not found: ' + NomFonction);
570 end
571 else
572 begin
573 InfoMsg := 'Func: ' + NomFonction + ' P1: ' + Param1 + '; P2: ' + Param2 + '; P3: ' + Param3 + '; P4: ' + Param4 + ' Result: ' + Result;
574 CbpTraceInformation('GLOBALSCRIPT',InfoMsg);
575 if DEBUG_MODE = true then StrDebug(InfoMsg);
576 end;
577end
578
579
580function RegReadValue(sKeyName, sValueName);
581var
582 N,
583 iOutFile,
584 sOutFileName,
585 sKeyNoRoot,
586 sFileLine;
587begin
588 Result := '';
589 N := Pos('\', sKeyName);
590 sKeyNoRoot := Copy(sKeyName, N + 1, Length(sKeyName) - N)
591 sOutFileName := GetCbpPath('GetCegidUserTempFileName');
592 CreateProcess('cmd /c reg query "' + sKeyName + '" /v "' + sValueName + '" > "' + sOutFileName + '"', True, True);
593 iOutFile := AglOpenFile(sOutFileName, fmOpenRead);
594 while not AglEofFile(iOutFile) do
595 begin
596 sFileLine := AglReadFile(iOutFile);
597 if (sFileLine = '') or (Pos(sKeyNoRoot, Upper(sFileLine)) > 0) then
598 begin
599 // just skip
600 end
601 else
602 begin
603 N := Pos(sValueName, sFileLine);
604 if N > 0 then
605 begin
606 N := N + Length(sValueName);
607 while Copy(sFileLine, N, 1) = ' ' do
608 N := N + 1; // skip spaces between value name and value type
609 while Copy(sFileLine, N, 1) <> ' ' do
610 N := N + 1; // skip value type
611 while Copy(sFileLine, N, 1) = ' ' do
612 N := N + 1; // skip spaces between value type and value data
613 Result := Copy(sFileLine, N, Length(sFileLine) - N + 1);
614 end;
615 end;
616 end;
617 AglCloseFile(iOutFile);
618 DeleteFile(sOutFileName);
619end;
620
621
622function ApplyColProps(GridName,TOBColumns)
623var
624 ReadOnly,ASize,I,TOBField,Name,Desc,Visible,ColID,display_format;
625begin
626 I := 0;
627 ColID := 0;
628 while I < TobCount(TOBColumns) do
629 begin
630 TOBField := TobDetail(TOBColumns, I);
631 Name := TobGetValue(TOBField, 'NAME');
632 Desc := TobGetValue(TOBField, 'DESC');
633 ASize := TobGetValue(TOBField, 'SIZE');
634 Visible := TobGetValue(TOBField, 'Visible');
635 ReadOnly := TobGetValue(TOBField, 'READ_ONLY');
636 display_format := TobGetValue(TOBField, 'display_format');
637 if Visible = 1 then
638 begin
639 SetWidthOfColGrid(GridName, ColID, ASize);
640 SetEditOfColGrid(GridName, ColID, not ReadOnly)
641 if display_format <> '' then
642 SetAlignOfColGrid(GridName, ColID, taRightJustify)
643 else
644 SetAlignOfColGrid(GridName, ColID, taLeftJustify);
645 SetFormatOfColGrid(GridName, ColID, display_format);
646 ColID := ColID + 1;
647 end;
648 I := I + 1;
649 end;
650 result := ColID;
651end;
652
653
654
655// ~T = ~ | ~C = , | ~S = ;
656// Input: 'hello,test;x~Switter'
657// Output: 'hello,test;x;witter'
658
659function DecodeParams(params)
660begin
661 result := FindETReplace(params, '~C', ',', true);
662 result := FindETReplace(result, '~S', ';', true);
663 result := FindETReplace(result, '~T', '~', true);
664end
665
666function EncodeParams(params)
667begin
668 result := FindETReplace(params, '~', '~T', true);
669 result := FindETReplace(result, ',', '~C', true);
670 result := FindETReplace(result, ';', '~S', true);
671end
672
673
674function TOBSortByField(TOBTable,FieldName)
675var
676 i,j,TOBTemp,TOBField,TobField1,TobField2;
677begin
678 // bubble sort
679 TOBTemp := TobCreate('TMP', 0, -1);
680 I := 0;
681 while I < TobCount(TOBTable) do
682 begin
683 J := 0;
684 while J < TobCount(TOBTable) - 1 do
685 begin
686 if ( TobGetValue(TobDetail(TOBTable, J),FieldName) > TobGetValue(TobDetail(TOBTable, J + 1),FieldName) ) then
687 begin
688 TOBField := TobDetail(TOBTable, J);
689 TobDupliquer(TOBTemp, TOBField, true, true);
690 TobField1 := TobDetail(TOBTable, J + 1);
691 TobField2 := TobDetail(TOBTable, J);
692 TobDupliquer(TobField2, TobField1, true, true);
693 TobDupliquer(TobField1, TOBTemp, true, true);
694 end;
695 J := J + 1;
696 end;
697 I := I + 1;
698 end;
699 TobFree(TOBTemp);
700 Result := 1;
701end;
702
703
704function SaveParamValue(FormName,ParamName,Value,DocType)
705var
706 DeleteSQL,InsertSQL;
707begin
708 Result:=0; //assigned LW test index out of bounds
709 DeleteSQL := 'DELETE FROM ZRITSETTINGS WHERE ([ZRS_FORM] = "'+ FormName +'")and([ZRS_NAME] = "'+ ParamName +'")and([ZRS_USER] = "' + V_PGI.user + '")and(ZRS_DOCTYPE="' + DocType + '");';
710 ExecuteSQLExt(DeleteSQL,False);
711 InsertSQL := 'INSERT INTO ZRITSETTINGS (ZRS_FORM,ZRS_NAME,[ZRS_VALUE],ZRS_USER,ZRS_DOCTYPE)VALUES ("' + FormName + '","' + ParamName +'","' + Value + '","' + V_PGI.user + '","' + DocType +'");';
712 ExecuteSQLExt(InsertSQL,False);
713 Result := 1;
714end
715
716function GetParamValue(FormName,ParamName,DocType)
717var
718 SelectSQL,Query;
719begin
720 SelectSQL := 'SELECT [ZRS_VALUE] FROM ZRITSETTINGS WHERE (ZRS_FORM = "' + FormName + '")and(ZRS_NAME="' + ParamName + '")and([ZRS_USER] = "' + V_PGI.user + '")and(ZRS_DOCTYPE="' + DocType + '");';
721 Query := OpenSQL(SelectSQL, true);
722 result := FieldSQL(Query,0);
723 CloseSQL(Query);
724end;
725
726Function DelimitedStrToTOB(DelStr,Delim,TOBFieldNames)
727var
728 TOBFields,delta,txt,dx,ns,MaxInt;
729begin
730 TobClearDetail(TOBFieldNames);
731 delta := Length(Delim);
732 txt := DelStr + Delim;
733 MaxInt := Length(DelStr);
734 while Length(txt) > 0 do
735 begin
736 dx := Pos(Delim, txt);
737 ns := Copy(txt,0,dx-1);
738 ns := DecodeParams(ns);
739 TOBFields := TOBCreate('Item', TOBFieldNames, -1);
740 TOBAddChampSupValeur(TOBFields, 'NAME', ns , false);
741 txt := Copy(txt,dx+delta,MaxInt);
742 end;
743 Result := 1;
744end
745
746Function TOBToDelimitedString(TOBTable,FieldName,Delim)
747var
748 I,TOBField;
749begin
750 I := 0;
751 Result := '';
752 while I < TobCount(TOBTable) do
753 begin
754 TOBField := TobDetail(TOBTable, I);
755 if i <> 0 then
756 Result := Result + Delim;
757 Result := Result + TobGetValue(TOBField, FieldName);
758 i := i + 1;
759 end;
760end
761
762
763
764function Locate(TOBTable,FieldName,FieldValue)
765var
766 i,TOBField ;
767begin
768 I := 0;
769 result := 0;
770 while I < TobCount(TOBTable) do
771 begin
772 TOBField := TobDetail(TOBTable, I);
773 if TobGetValue(TOBField,FieldName) = FieldValue then
774 begin
775 result := TOBField;
776 exit;
777 end
778 i := i + 1;
779 end;
780end
781
782
783function GetRetourString(TOBTable,QuoteNames)
784var
785 I,Name,Desc,Sorted,Visible,SQL,TOBField,SelectedFields,SQLFields,SortedOrder,
786 SelectedDesc,OrderFieldsDesc,OrderFieldsNames,SelectedFieldsWithDesc,SQLFieldsDesc;
787begin
788 I := 0;
789 SelectedFieldsWithDesc := 'SelectedFieldsWithDesc=';
790 OrderFieldsNames := 'OrderFieldsNames=';
791 OrderFieldsDesc := 'OrderFieldsDesc=';
792 SelectedFields := 'SelectedFields=';
793 SelectedDesc := 'SelectedDesc=';
794 SQLFields := 'SQLFields=';
795 SQLFieldsDesc := 'SQLFieldsDesc=';
796
797 while I < TobCount(TOBTable) do
798 begin
799 TOBField := TobDetail(TOBTable, I);
800 Name := TobGetValue(TOBField, 'NAME');
801 Desc := TobGetValue(TOBField, 'DESC');
802 if TobGetValue(TOBField, 'SORTED_ORDER') = '1' then SortedOrder := ' DESC' else SortedOrder := ' ASC';
803 if QuoteNames = true then
804 begin
805 if TobGetValue(TOBField, 'NAME') <> '' then
806 Name := '[' + TobGetValue(TOBField, 'NAME') + ']';
807 if TobGetValue(TOBField, 'DESC') <> '' then
808 Desc := '[' + TobGetValue(TOBField, 'DESC') + ']';
809 end;
810 Visible := TobGetValue(TOBField, 'VISIBLE');
811 Sorted := TobGetValue(TOBField, 'Sorted');
812 SQL := TobGetValue(TOBField, 'SQL');
813 if Visible = true then
814 begin
815 SelectedFieldsWithDesc := SelectedFieldsWithDesc + Name + ' as [' + Desc + ']';
816 SelectedFieldsWithDesc := SelectedFieldsWithDesc + ',';
817 SelectedFields := SelectedFields + Name;
818 SelectedFields := SelectedFields + ',';
819 SelectedDesc := SelectedDesc + Desc;
820 SelectedDesc := SelectedDesc + ',';
821 end;
822 if Sorted = true then
823 begin
824 OrderFieldsNames := OrderFieldsNames + Name + SortedOrder;
825 OrderFieldsNames := OrderFieldsNames + ',';
826 OrderFieldsDesc := OrderFieldsDesc + Desc + SortedOrder;
827 OrderFieldsDesc := OrderFieldsDesc + ',';
828 end;
829
830 if SQL = true then
831 begin
832 SQLFields := SQLFields + Name;
833 SQLFields := SQLFields + ',';
834 SQLFieldsDesc := SQLFieldsDesc + Desc;
835 SQLFieldsDesc := SQLFieldsDesc + ',';
836 end;
837
838 i := i + 1;
839 end;
840 if SelectedDesc <> 'SelectedDesc=' then
841 SelectedDesc := Delete (SelectedDesc, Length(SelectedDesc),1);
842 if SelectedFields <> 'SelectedFields=' then
843 SelectedFields := Delete (SelectedFields, Length(SelectedFields),1);
844 if OrderFieldsDesc <> 'OrderFieldsDesc=' then
845 OrderFieldsDesc := Delete (OrderFieldsDesc, Length(OrderFieldsDesc),1);
846 if OrderFieldsNames <> 'OrderFieldsNames=' then
847 OrderFieldsNames := Delete (OrderFieldsNames, Length(OrderFieldsNames),1);
848 if SelectedFieldsWithDesc <> 'SelectedDesc=' then
849 SelectedFieldsWithDesc := Delete (SelectedFieldsWithDesc, Length(SelectedFieldsWithDesc),1);
850 if SQLFields <> 'SQLFields=' then
851 SQLFields := Delete (SQLFields, Length(SQLFields),1);
852 if SQLFieldsDesc <> 'SQLFieldsDesc=' then
853 SQLFieldsDesc := Delete (SQLFieldsDesc, Length(SQLFieldsDesc),1);
854
855
856 result := SelectedFields + ';' + OrderFieldsNames + ';' + OrderFieldsDesc + ';' + SelectedFieldsWithDesc + ';' + SelectedDesc + ';' + SQLFields + ';' + SQLFieldsDesc;
857end
858
859
860function SaveParametrsDB(TOBTable,FormName,UserName)
861var
862 DSQL,I,Const,Name,Desc,Index,Sorted,Visible,TOBField,ASize,AReadOnly,DISPLAY_FORMAT,SQL,SortedOrder;
863begin
864 DSQL := 'DELETE FROM ZRITGRIDSETTINGS WHERE ZGS_FORM = "' + FormName + '" and ZGS_USER = "' + UserName + '"';
865 ExecuteSQLExt(DSQL,False);
866 I := 0;
867 while I < TobCount(TOBTable) do
868 begin
869 TOBField := TobDetail(TOBTable, I);
870 Name := TobGetValue(TOBField, 'NAME');
871 Desc := TobGetValue(TOBField, 'DESC');
872 Visible := TobGetValue(TOBField, 'VISIBLE');
873 Index := TobGetValue(TOBField, 'INDEX');
874 Sorted := TobGetValue(TOBField, 'SORTED');
875 ASize := TobGetValue(TOBField, 'SIZE');
876 AReadOnly := TobGetValue(TOBField, 'READ_ONLY');
877 DISPLAY_FORMAT := TobGetValue(TOBField, 'DISPLAY_FORMAT');
878 Const := TobGetValue(TOBField, 'CONST');
879 SortedOrder := TobGetValue(TOBField, 'SORTED_ORDER');
880 SQL := TobGetValue(TOBField, 'SQL');
881 AddFiledDB(Name,Desc,Visible,Index,Sorted,ASize,AReadOnly,DISPLAY_FORMAT,Const,SQL,SortedOrder,FormName,UserName);
882 i := i + 1;
883 end;
884 Result := 1;
885end
886
887
888
889function LoadParametrsDB(FormName,UserName)
890var
891 TOBFields,I,sql1,Query1;
892begin
893 sql1 := 'SELECT * FROM [ZRITGRIDSETTINGS] WHERE ZGS_FORM = "' + FormName + '" and ZGS_USER = "' + UserName + '" ORDER BY ZGS_INDEX';
894 Query1 := OpenSQL(sql1,true);
895 QueryFirst(Query1);
896 Result := TobCreate(FormName, 0, -1);
897 TobAddChampSupValeur(Result, 'TABLE_NAME', FormName, False);
898 while not QueryEOF(Query1) do
899 begin
900 I := 0;
901 TOBFields := TOBCreate('Item', Result, -1);
902 while I < 12 do
903 begin
904 TOBAddChampSupValeur(TOBFields,NameByFieldIndex(I), FieldSQL(Query1, I), false);
905 I := I + 1;
906 end;
907 QueryNext(Query1);
908 end;
909 CloseSQL(Query1);
910end
911
912function LoadConfigFile(FileName)
913begin
914 if FileExists(FileName) then
915 begin
916 result := TobDetail(TobLoadFromXMLFile(FileName, False),0);
917 end else
918 begin
919 result := TobCreate('FieldStore', 0, -1);
920 end;
921end
922
923function LoadParametrs(TOBSettings,FormName)
924var
925 I;
926begin
927 I := 0;
928 while I < TobCount(TOBSettings) do
929 begin
930 result := TobDetail(TOBSettings, I);
931 if not TobFieldExists(result, 'TABLE_NAME') then
932 begin
933 break;
934 end;
935 if (TobGetValue(result, 'TABLE_NAME') = FormName) then
936 begin
937 Exit;
938 end;
939 I := I + 1;
940 end;
941 result := LoadDefaultRecords(TOBSettings,FormName);
942end
943
944function LoadDefaultRecords(TOBSettings,FormName)
945begin
946 result := TobCreate(FormName, TOBSettings, -1);
947 TobAddChampSupValeur(result, 'TABLE_NAME', FormName, False);
948end
949
950function NameByFieldIndex(FieldIndex)
951begin
952 if (FieldIndex = 0) result := 'NAME' else
953 if (FieldIndex = 1) result := 'DESC' else
954 if (FieldIndex = 2) result := 'VISIBLE' else
955 if (FieldIndex = 3) result := 'INDEX' else
956 if (FieldIndex = 4) result := 'SORTED' else
957 if (FieldIndex = 5) result := 'SORTED_ORDER' else
958 if (FieldIndex = 6) result := 'SIZE' else
959 if (FieldIndex = 7) result := 'READ_ONLY' else
960 if (FieldIndex = 8) result := 'DISPLAY_FORMAT' else
961 if (FieldIndex = 9) result := 'CONST' else
962 if (FieldIndex = 10) result := 'SQL' else
963 if (FieldIndex = 11) result := 'FORM' else
964 if (FieldIndex = 12) result := 'USER';
965end
966
967procedure AddFiledDB(Name,Desc,Visible,Index,Sorted,ASize,AReadOnly,DISPLAY_FORMAT,Const,SQL,SortedOrder,FormName,UserName)
968var
969 ISQL;
970begin
971 ISQL := 'INSERT INTO ZRITGRIDSETTINGS(ZGS_NAME,ZGS_DESC,ZGS_VISIBLE,ZGS_INDEX, ZGS_SORTED,ZGS_SORTED_ORDER,ZGS_SIZE,ZGS_READ_ONLY,ZGS_DISPLAY_FORMAT,ZGS_CONST,ZGS_SQL,ZGS_FORM,ZGS_USER)' +
972 ' VALUES ("' + Name + '","' + Desc + '","'+ Visible + '","' + Index + '","'+ Sorted + '","' + SortedOrder + '","'+ ASize + '","'
973 + AReadOnly + '","'+ DISPLAY_FORMAT + '","' + Const + '","' + SQL + '","' + FormName + '","' + UserName + '")';
974 ExecuteSQLExt(ISQL,False);
975end;
976
977
978function LoadDefaultFields(AvailableFieldsNames,AvailableDescs,ConstFieldsNames,FormName)
979var
980 I,Name,Desc,TOBFieldNames,TOBFieldDescs,TOBConstFields,Const,TOBConstField;
981begin
982 TOBFieldNames := TobCreate('TOBDelVals', 0, -1);
983 TOBFieldDescs := TobCreate('TOBDelVals', 0, -1);
984 TOBConstFields := TobCreate('TOBDelVals', 0, -1);
985 DelimitedStrToTOB(AvailableFieldsNames,',',TOBFieldNames);
986 DelimitedStrToTOB(AvailableDescs,',',TOBFieldDescs);
987 DelimitedStrToTOB(ConstFieldsNames,',',TOBConstFields);
988 I := 0;
989 while I < TobCount(TOBFieldNames) do
990 begin
991 Name := TobGetValue(TobDetail(TOBFieldNames, I), 'NAME');
992 Desc := TobGetValue(TobDetail(TOBFieldDescs, I), 'NAME');
993 TOBConstField := Locate(TOBConstFields,'NAME',Name);
994 Const := TOBConstField <> 0;
995 AddFiledDB(Name,Desc,Const,I,False,50,false,'',Const,Const,0,FormName,V_PGI.user);
996 i := i + 1;
997
998
999 end;
1000 result := 1;
1001end
1002
1003
1004
1005function NeedShowForm(TOBPiece,GP_NATUREPIECEG)
1006var
1007 iLine,TobLigne,GL_ARTICLE,sql,GA_BOOLLIBRE3,sql;
1008begin
1009// StrDebug('NeedShowForm');
1010 iLine := TobCount(TOBPiece) - 1;
1011 result := False;
1012 while iLine >= 0 do
1013 begin
1014 tobLigne := TobDetail(tobPiece, iLine);
1015 GL_ARTICLE := TobGetValue(tobLigne, 'GL_ARTICLE');
1016 sql := 'select GA_BOOLLIBRE3 from ARTICLE where GA_ARTICLE = "' + GL_ARTICLE + '"';
1017 GA_BOOLLIBRE3 := ReturnSQLField(sql,0);
1018// DebugMsg('GA_BOOLLIBRE3: ' + GA_BOOLLIBRE3 + ' GP_NATUREPIECEG: ' + GP_NATUREPIECEG,'GLOBAL SCRIPT');
1019 if (GA_BOOLLIBRE3 = 'X') then
1020 begin
1021 if GP_NATUREPIECEG = 'FFO' then
1022 begin
1023 if (TobGetValue(tobLigne, 'GL_QTERESTE') < 0) then
1024 begin
1025 result := True;
1026 Exit;
1027 end;
1028 end
1029 else if ((GP_NATUREPIECEG = 'SEX') or(GP_NATUREPIECEG = 'TEM')) then
1030 begin
1031 result := True;
1032 Exit;
1033 end;
1034 end;
1035 iLine := iLine - 1;
1036 end; {lines tob}
1037end;
1038
1039
1040
1041
1042
1043function CheckOrderContent(tobData, DetectSales, DetectCancelLines)
1044var
1045 tobDoc,
1046 tobLine,
1047 ContainCancelLine,
1048 ContainSales,
1049 I;
1050begin
1051 Result := False;
1052 tobDoc := TobDetail(tobData, 0);
1053 ContainCancelLine := False;
1054 ContainSales := False;
1055 I := TobCount(tobDoc) - 1;
1056 while I >= 0 do
1057 begin
1058 tobLine := TobDetail(tobDoc, I);
1059 if TobGetValue(tobLine, 'GL_CODEARTICLE') = 'CANCEL' then
1060 ContainCancelLine := True
1061 else
1062 begin
1063// if TobGetValue(tobLine, 'GL_MONTANTTTC') > 0 then
1064 if TobGetValue(tobLine, 'GL_QTEFACT') <> 0 then
1065 ContainSales := True
1066 end;
1067 I := I - 1;
1068 end;
1069
1070 if DetectCancelLines and DetectSales then
1071 begin
1072 Result := ContainCancelLine and ContainSales;
1073 if Result then
1074 CbpTraceVerbose('CSTRFND', 'Document contains receipt lines and canceled lines');
1075 end
1076 else
1077 begin
1078 if DetectCancelLines then
1079 Result := Result or ContainCancelLine;
1080 if DetectSales then
1081 Result := Result or ContainSales;
1082 if ContainCancelLine then
1083 CbpTraceVerbose('CSTRFND', 'Document contains canceled lines');
1084 if ContainSales then
1085 CbpTraceVerbose('CSTRFND', 'Document contains receipt lines');
1086 end;
1087 // TobDebug(tobDoc);
1088end
1089
1090
1091procedure CbrReceipt.AfterValid(tobData, tobResult)
1092var
1093 GP_NATUREPIECEG, UpdatePO, sqlQuery;
1094begin
1095 DEBUG_MODE := False;
1096
1097 GlobalTOB := TobDetail(tobData, 0);
1098 GP_NATUREPIECEG := TobGetValue(GlobalTOB, 'GP_NATUREPIECEG');
1099 if (GP_NATUREPIECEG = 'FFO') and CheckOrderContent(tobData, False, True) then
1100 begin
1101 sqlQuery := OpenSQL('select ZCR_SOUCHE, ZCR_NUMERO, ZCR_NATUREPIECEG, ZCR_TIERS, ZCR_NUMLIGNE, ZCR_UPDATEPO from ZCUSTORDREFUND where ZCR_STATUS="A" and ZCR_REGISTER="' + CbrRegister.Current() + '"', True);
1102 QueryFirst(sqlQuery);
1103 UpdatePO := FieldSQL(sqlQuery, 5); // ZCR_UPDATEPO
1104 UpdateRefundStateOnOrder(tobData, 'X', 'X', UpdatePO);
1105 ExecuteSQL(
1106 'INSERT INTO RIT_EVENTS (EVENT_TYPE, EVENT_STATUS, EVENT_KEY, DOC_ID, FIELDS_DATA)' +
1107 'VALUES ("RIT06 CANCEL ORD", "New",' +
1108 ' CONVERT(VARCHAR(max), "' + FieldSQL(sqlQuery, 0) + '"),' + // ZCR_SOUCHE
1109 ' CONVERT(VARCHAR(max), "' + FieldSQL(sqlQuery, 1) + '"),' + // ZCR_NUMERO
1110 ' CONVERT(VARCHAR(max), ' +
1111 ' "ZCR_NATUREPIECEG=" + CONVERT(VARCHAR(max), "' + FieldSQL(sqlQuery, 2) + '") + CHAR(11) + ' + // ZCR_NATUREPIECEG
1112 ' "ZCR_TIERS=" + CONVERT(VARCHAR(max), "' + FieldSQL(sqlQuery, 3) + '") + CHAR(11) + ' + // ZCR_TIERS
1113 ' "ZCR_FFOSOUCHE=" + CONVERT(VARCHAR(max), "' + TobGetValue(GlobalTOB, 'GP_SOUCHE') + '") + CHAR(11) + ' + // ZCR_FFOSOUCHE
1114 ' "ZCR_FFONUMERO=" + CONVERT(VARCHAR(max), "' + TobGetValue(GlobalTOB, 'GP_NUMERO') + '") + CHAR(11) + ' + // ZCR_FFONUMERO
1115 ' "ZCR_NUMLIGNE=" + CONVERT(VARCHAR(max), "' + FieldSQL(sqlQuery, 4) + '")' + // ZCR_NUMLIGNE
1116 ' )' +
1117 ')'
1118 );
1119 // set CC status to closed if all valid merchandise lines have been canceled
1120 ExecuteSQL(
1121 'update MPIECEECO set MEJ_CDEECOMSUIVI="014" where MEJ_NATUREPIECEG="CC" and MEJ_NUMERO='+FieldSQL(sqlQuery, 1)+' and MEJ_SOUCHE="'+FieldSQL(sqlQuery, 0)+'"'+
1122 ' and (select COUNT(*) from LIGNE LT where LT.GL_NATUREPIECEG=MEJ_NATUREPIECEG and LT.GL_NUMERO=MEJ_NUMERO and LT.GL_SOUCHE=MEJ_SOUCHE and LT.GL_TYPEARTICLE in ("MAR", "PRE") and GL_BLOQUETARIF in ("-", "A")) = 0'
1123 );
1124 CloseSQL(sqlQuery);
1125 end;
1126 UpdateBatchNos(TobDetail(tobData, 0),ZBN_ARTICLES);
1127end;
1128
1129
1130
1131
1132
1133procedure UpdateBatchNos(TOBPiece,ARTICLES)
1134var
1135 iLine,TobLigne,GL_ARTICLE,GL_SOUCHE,GL_DEPOT,GL_NUMERO,GL_NATUREPIECEG,usql,Register;
1136begin
1137 if ARTICLES = '' then exit;
1138
1139 iLine := TobCount(TOBPiece) - 1;
1140 Register:=CbrRegister.Current();
1141 while iLine >= 0 do
1142 begin
1143 tobLigne := TobDetail(tobPiece, iLine);
1144 iLine := iLine - 1;
1145 GL_ARTICLE := TobGetValue(tobLigne, 'GL_ARTICLE');
1146 GL_NUMERO := TobGetValue(tobLigne, 'GL_NUMERO');
1147 GL_DEPOT := TobGetValue(tobLigne, 'GL_DEPOT');
1148 GL_SOUCHE := TobGetValue(tobLigne, 'GL_SOUCHE');
1149 GL_NATUREPIECEG := TobGetValue(tobLigne, 'GL_NATUREPIECEG');
1150 if Pos (GL_ARTICLE, ARTICLES) then
1151 begin
1152 usql := 'UPDATE ZRITBATCHNUMBERS SET ZBN_NUMERO = ' + GL_NUMERO +',ZBN_SOUCHE = "' + GL_SOUCHE + '", ZBN_NATUREPIECEG = "' + GL_NATUREPIECEG + '" ,ZBN_QUALIFMVT="XXX"' +
1153 ' WHERE ZBN_QUALIFMVT="' + Register + '" and ZBN_ARTICLE = "' + GL_ARTICLE + '"';
1154 ExecuteSQLExt(usql,False);
1155 end;
1156 end; {lines tob}
1157end;
1158
1159procedure CbrDocument.AfterValid( TOBD, TOBR )
1160begin
1161 UpdateBatchNos(TobDetail(TOBD, 0),ZBN_ARTICLES);
1162end;
1163
1164
1165procedure CbrApplication.CommandLineOnExecute(TOBD, TOBR)
1166var
1167 CMDLINEID;
1168begin
1169 ZBN_ARTICLES := '';
1170 CMDLINEID:= TOBGetValue(TOBD, 'CMDLINEID');
1171 DEBUG_MODE := False;
1172 DebugTOB := TobCreate('DebugTOB', 0, -1);
1173
1174
1175 // ZCBR_IPT_RECEIPT
1176 if (CMDLINEID = 'TRANSFORM_IPT') then
1177 Begin
1178 RunTransformToIPT();
1179 end;
1180 // ZCBR_ORDER_INFO
1181 if (CMDLINEID = 'TRANSFORM_IPD') then
1182 Begin
1183 RunTransformToIPD();
1184 end;
1185
1186 if (CMDLINEID = 'TRANSFORM') then
1187 Begin
1188 RunTransformToIPT();
1189 RunTransformToIPD();
1190 end;
1191
1192 if (CMDLINEID = 'TRANSFORM_GENERATE') then
1193 Begin
1194 // Process IPT's
1195 GEN_ALL_ALF_DOCS();
1196 //Process IPD's
1197 // RunTransformToIPD();
1198 end;
1199
1200
1201 TobFree(DebugTOB);
1202end;
1203
1204
1205
1206
1207function dispatch( num )
1208begin
1209 Result := True;
1210 GlobalTOB := '';
1211 case Num of
1212 901052 : OuvreFiche('Z','CUST_PRICE_LIST', '','','') ;
1213 901053 : OuvreFiche('Z','ZAGREEMENTS', '','','') ;
1214 // 901054 : OuvreFiche('Z','ZFBIFSLOG_MUL', '','',''); // THIS MENU ITEM APPEAR TO HAVE INCORRECT id iT HINK THIS SHOULD BE TAX MAPPING TABLE
1215 900201 : OuvreFiche('Z','ZFBIFSLOG_MUL', '','','');
1216 901056 : OuvreFiche('Z','ZCBR_IPT_RECEIPT', '','','') ;
1217 901057 : OuvreFiche('Z','ZCBR_ORDER_INFO', '','','IPT_MODE') ;
1218 901059 : OuvreFiche('Z','ZCBR_ORDER_INFO', '','','HGC_MODE') ;
1219 901058 : OuvreFiche('Z','ZBATCHNUMBERS', '','','') ;
1220 901060 : OuvreFiche('Z','ZSUBSALERESTRICT', '','','') ;
1221 901090 : OuvreFiche('Z','ZEVENTSREPORT', '','','');
1222 901075 : OuvreFiche('Z','WEEKLYSALES', '','','') ;
1223 901069 : OuvreFiche('Z','TEST', '','','') ;
1224 999998 : OuvreFiche('Z','ALF_GEN_MUL', '','','') ;
1225 else
1226 Result := False;
1227 end;
1228end;
1229
1230
1231procedure RunTransformToIPT()
1232var
1233 IPT_RECEIPT_SQL_ALL,IPT_RECEIPT_QRY_ALL,CIR_PO_ORDER_NO;
1234begin
1235 DebugMsg('RunTransformToIPT','TRANSFORM IPT');
1236 IPT_RECEIPT_SQL_ALL := 'SELECT CIR_PO_ORDER_NO FROM ZCBRIPTRECEIPT';
1237 if not CHECK_SQL(IPT_RECEIPT_SQL_ALL) then Exit;
1238 IPT_RECEIPT_QRY_ALL := OpenSQL(IPT_RECEIPT_SQL_ALL, True);
1239 QueryFirst(IPT_RECEIPT_QRY_ALL);
1240
1241 while not QueryEOF(IPT_RECEIPT_QRY_ALL) do
1242 begin
1243 CIR_PO_ORDER_NO := FieldSQL(IPT_RECEIPT_QRY_ALL, 0);
1244 GenerateOrderDocIPT(CIR_PO_ORDER_NO);
1245 QueryNext(IPT_RECEIPT_QRY_ALL);
1246 end;
1247end
1248
1249
1250procedure GenerateOrderDocIPT(CIR_PO_ORDER_NO)
1251var
1252 IPT_RECEIPT_SQL,IPT_RECEIPT_QRY,INT_REF,DEPOT_SQL,DEPOT_QRY,RECIPIENT_STORE,RECIPIENT_WAREHOUSE,PIECE_SQL,GLP_NUMERO_CF,UpdateFlagSQL;
1253begin
1254 DebugMsg('GenerateOrderDocIPT','TRANSFORM IPT');
1255 IPT_RECEIPT_SQL := 'SELECT SO_SITE As CIR_FROM_STORE,"GOOD" As CIR_FROM_WAREHOUSE,DO_SITE As CIR_TO_STORE,"CCOLL" as CIR_TO_WAREHOUSE, ' +
1256 ' SO_ORDER_NO As CIR_SO_ORDER_NO,SO_LINE_NO As CIR_SO_LINE_NO,PO_ORDER_NO As CIR_SO_PART_NO,left(replace(DEMAND_REF_ID,"UAT2", ""),13) As CIR_DEMAND_REF_ID, ' +
1257 ' QTY_DUE As CIR_QTY_DUE,GA_ARTICLE from ZCBR_IPT_RECEIPT join ARTICLE ON (GA_CODEBARRE = SO_PART_NO) WHERE PO_ORDER_NO = "' + CIR_PO_ORDER_NO + '"';
1258 if not CHECK_SQL(IPT_RECEIPT_SQL) then Exit;
1259 IPT_RECEIPT_QRY := OpenSQL(IPT_RECEIPT_SQL, True);
1260 INT_REF := FieldSQL(IPT_RECEIPT_QRY, 7);
1261 DEPOT_SQL := 'SELECT DEPOTS.GDE_DEPOT,ET_ETABLISSEMENT FROM METABDEPOT ' +
1262 'INNER JOIN DEPOTS ON (METABDEPOT.MDE_DEPOT = DEPOTS.GDE_DEPOT) ' +
1263 'INNER JOIN ETABLISS ON (METABDEPOT.MDE_ETABLISSEMENT = ETABLISS.ET_ETABLISSEMENT) ' +
1264 'WHERE ET_ABREGE = "' + FieldSQL(IPT_RECEIPT_QRY, 2) + '" and GDE_CHARLIBRE2 = "' + FieldSQL(IPT_RECEIPT_QRY, 3) + '"';
1265 if not CHECK_SQL(DEPOT_SQL) then Exit;
1266 DEPOT_QRY := OpenSQL(DEPOT_SQL, True);
1267 RECIPIENT_STORE := FieldSQL(DEPOT_QRY, 1);
1268 RECIPIENT_WAREHOUSE := FieldSQL(DEPOT_QRY, 0);
1269 PIECE_SQL := 'Select GP_numero from PIECE WHERE GP_REFINTERNE like "' +INT_REF+ '_%" and GP_NATUREPIECEG="CF" and GP_STATUTENVOI="REC" ';
1270 GLP_NUMERO_CF := ReturnSQLField(PIECE_SQL, 0);
1271 TRANSFORM_CF_TO_ALF(GLP_NUMERO_CF,RECIPIENT_STORE,CIR_PO_ORDER_NO,INT_REF);
1272
1273
1274 // This sql is to replace trigger UpdateDeliveryItemState_FFO WWI-REC delivered from stock
1275 // Update flag GP_STATUTENVOI on origial receipt
1276 // Code
1277 // UpdateFlagSQL:='UPDATE LIGNE SET GL_STATUTENVOI = "" WHERE GL_STATUTENVOI in ("REC") AND GL_NATUREPIECEG = "FFO" AND ( SELECT GP_REFINTERNE FROM PIECE WHERE GP_NATUREPIECEG = "FFO" AND GP_NUMERO = GL_NUMERO AND GP_SOUCHE = GL_SOUCHE and GP_NATUREPIECEG=GL_NATUREPIECEG) = LEFT( "'+INT_REF+'",13) ';
1278 // ExecuteSQL(UpdateFlagSQL);
1279 // This is being done in the handhover to customer form now.
1280
1281end;
1282
1283
1284
1285procedure TRANSFORM_CF_TO_ALF(GLP_NUMERO_CF,RECIPIENT_STORE,PO_ORDER_NO,INT_REF)
1286var
1287 GLP_NUMERO_ALF,TOBR_D,GP_SOUCHE,sql,TOBR,TOBR_D,CurDate;
1288begin
1289 DebugMsg('TRANSFORM_CF_TO_ALF','TRANSFORM IPT');
1290 CurDate := Date();
1291 TOBR := TOBCreate('Result', 0, -1);
1292 CbrDocument.Transform(
1293 'ALF', // new doc type
1294 'CF', // old doc type
1295 RECIPIENT_STORE, // "souche"
1296 GLP_NUMERO_CF, // document no
1297 0, // always 0
1298 True, // auto=true, manual=false
1299 CurDate, //
1300 True, // progress bar
1301 TOBR // put result to command lne result :)
1302 );
1303// TobDebug(TOBR);
1304 if TobAssigned(TOBR) and (TobGetValue (TOBR, 'VALID') = 0 ) then
1305 begin
1306 TOBR_D := TobDetail(TOBR, 0);
1307 if TobAssigned(TOBR_D) then
1308 begin
1309 GLP_NUMERO_ALF := TobGetValue (TOBR_D, 'GP_NUMERO');
1310 GP_SOUCHE := TobGetValue (TOBR_D, 'GP_SOUCHE');
1311 sql := 'update PIECE Set GP_TYPEPROVENANCE="DEP" ,GP_STATUTENVOI="REC",GP_CONTREMARQUE="X",GP_REFEXTERNE="'+PO_ORDER_NO+'" where GP_NATUREPIECEG="ALF" and GP_NUMERO=' + GLP_NUMERO_ALF + ' and GP_SOUCHE = "' + GP_SOUCHE + '"';
1312 ExecuteSQLExt(sql,False);
1313 INSERT_LINKS_CC_ALF(GP_SOUCHE,GLP_NUMERO_CF,GLP_NUMERO_ALF,INT_REF,PO_ORDER_NO);
1314 UPDATE_MPIECEECO_IPT(GP_SOUCHE,INT_REF);
1315 INSERT_STKMOUVEMENTS_IPT(PO_ORDER_NO,GLP_NUMERO_ALF);
1316 end else
1317 ShowMessage('CbrDocument.Transform to ALF Creation error!');
1318
1319 end else
1320 ShowMessage('CbrDocument.Transform to ALF Error:' + TobGetValue (TOBR, 'MESSAGE'));
1321end;
1322
1323function GET_GP_NUMERO(GP_REFEXTERNE,GP_STATUTENVOI,GP_NATUREPIECEG)
1324var
1325 sql;
1326begin
1327 sql := 'SELECT GP_NUMERO FROM PIECE WHERE GP_REFINTERNE like "' + Copy (GP_REFEXTERNE , 1, 13) +
1328 '%" and GP_NATUREPIECEG = "' +GP_NATUREPIECEG+ '" and GP_STATUTENVOI="' + GP_STATUTENVOI + '"';
1329 Result := ReturnSQLField(sql,0);
1330end
1331
1332
1333procedure INSERT_LINKS_CC_ALF_TOB_PARAMS(TobParams);
1334var
1335 STORE,GLP_NUMERO_CF,GLP_NUMERO_ALF,GP_REFEXTERNE,PO_ORDER_NO;
1336begin
1337// TobDebug(TobParams);
1338 STORE := TobGetValue (TobParams, 'GP_SOUCHE');
1339 GLP_NUMERO_CF := TobGetValue (TobParams, 'GLP_NUMERO_CF');
1340 GLP_NUMERO_ALF := TobGetValue (TobParams, 'GLP_NUMERO_ALF');
1341 GP_REFEXTERNE := TobGetValue (TobParams, 'SO_CUSTOMER_PO_NO');
1342 PO_ORDER_NO := TobGetValue (TobParams, 'PO_ORDER_NO');
1343
1344 INSERT_LINKS_CC_ALF(STORE,GLP_NUMERO_CF,GLP_NUMERO_ALF,GP_REFEXTERNE,PO_ORDER_NO);
1345end
1346
1347
1348procedure INSERT_LINKS_CC_ALF(STORE,GLP_NUMERO_CF,GLP_NUMERO_ALF,GP_REFEXTERNE,PO_ORDER_NO);
1349var
1350 sql,GEC_LASTCHRONO,CurDate,GLP_NUMERO_CC,LogString;
1351BEGIN
1352 DebugMsg('INSERT_LINKS_CC_ALF','TRANSFORM IPT');
1353 GLP_NUMERO_CC := GET_GP_NUMERO(GP_REFEXTERNE,'REC','CC');
1354
1355
1356 CurDate := FormatDateTime('yyyymmdd hh:nn:ss', NowH());
1357 GEC_LASTCHRONO := GET_GEC_LASTCHRONO(STORE);
1358 LogString:='GLP_NUMERO_CF purchase order from Habitat plugin:' + GLP_NUMERO_CF + ' GLP_NUMERO_ALF linked: ' + GLP_NUMERO_ALF + ' to GLP_NUMERO_CC: ' + GLP_NUMERO_CC;
1359 if DEBUG_MODE = True then
1360 begin
1361 ShowMessage(LogString);
1362 end;
1363
1364 PgiInfo (LogString, 'INSERT_LINKS_CC_ALF debug')
1365
1366 CbpTraceVerbose('InsertLinks CC customer order - customer delivery ALF',LogString);
1367
1368 sql := 'INSERT INTO LIAISONPIECE (GLP_ARTICLE, GLP_CODESITE, GLP_CREATEUR, GLP_DATECREATION, GLP_DATEINTEGR, GLP_DATEMODIF, GLP_ETABLISSEMENT, GLP_INDICEG, GLP_NATUREPIECEG, GLP_NUMERO, GLP_NUMLIEN, GLP_NUMORDRE, GLP_RANG, GLP_SOUCHE, GLP_SUPPRIME, GLP_TYPELIEN, GLP_UTILISATEUR) ' +
1369 'VALUES ("", "' + STORE + '", "CEG", "' + CurDate + '", "19000101 00:00:00", "' + CurDate + '", "", 0, "CC", ' + GLP_NUMERO_CC + ', ' + GEC_LASTCHRONO + ', 0, "O", "' + STORE + '", "-", "DEP", "CEG")';
1370 ExecuteSQLExt(sql,False);
1371
1372 sql := 'INSERT INTO LIAISONPIECE (GLP_ARTICLE, GLP_CODESITE, GLP_CREATEUR, GLP_DATECREATION, GLP_DATEINTEGR, GLP_DATEMODIF, GLP_ETABLISSEMENT, GLP_INDICEG, GLP_NATUREPIECEG, GLP_NUMERO, GLP_NUMLIEN, GLP_NUMORDRE, GLP_RANG, GLP_SOUCHE, GLP_SUPPRIME, GLP_TYPELIEN, GLP_UTILISATEUR) ' +
1373 'VALUES ("", "' + STORE + '", "CEG", "' + CurDate + '", "19000101 00:00:00", "' + CurDate + '", "", 0, "ALF", ' + GLP_NUMERO_ALF + ', ' + GEC_LASTCHRONO + ', 0, "D", "' + STORE + '", "-", "DEP", "CEG")';
1374 ExecuteSQLExt(sql,False);
1375
1376
1377END ;
1378
1379
1380
1381
1382procedure INSERT_LINKS_CC_BLC2(STORE,GLP_NUMERO_CC,GLP_NUMERO_BLC,GP_REFINTERNE);
1383var
1384 sql,GEC_LASTCHRONO,CurDate;
1385BEGIN
1386 CurDate := FormatDateTime('yyyymmdd hh:nn:ss', NowH());
1387 GEC_LASTCHRONO := GET_GEC_LASTCHRONO(STORE);
1388
1389 sql := 'INSERT INTO LIAISONPIECE (GLP_ARTICLE, GLP_CODESITE, GLP_CREATEUR, GLP_DATECREATION, GLP_DATEINTEGR, GLP_DATEMODIF, GLP_ETABLISSEMENT, GLP_INDICEG, GLP_NATUREPIECEG, GLP_NUMERO, GLP_NUMLIEN, GLP_NUMORDRE, GLP_RANG, GLP_SOUCHE, GLP_SUPPRIME, GLP_TYPELIEN, GLP_UTILISATEUR) ' +
1390 'VALUES ("", "' + STORE + '", "CEG", "' + CurDate + '", "19000101 00:00:00", "' + CurDate + '", "", 0, "CC", ' + GLP_NUMERO_CC + ', ' + GEC_LASTCHRONO + ', 0, "O", "' + STORE + '", "-", "DEP", "CEG")';
1391 ExecuteSQLExt(sql,False);
1392 sql := 'INSERT INTO LIAISONPIECE (GLP_ARTICLE, GLP_CODESITE, GLP_CREATEUR, GLP_DATECREATION, GLP_DATEINTEGR, GLP_DATEMODIF, GLP_ETABLISSEMENT, GLP_INDICEG, GLP_NATUREPIECEG, GLP_NUMERO, GLP_NUMLIEN, GLP_NUMORDRE, GLP_RANG, GLP_SOUCHE, GLP_SUPPRIME, GLP_TYPELIEN, GLP_UTILISATEUR) ' +
1393 'VALUES ("", "' + STORE + '", "CEG", "' + CurDate + '", "19000101 00:00:00", "' + CurDate + '", "", 0, "BLC", ' + GLP_NUMERO_BLC + ', ' + GEC_LASTCHRONO + ', 0, "D", "' + STORE + '", "-", "DEP", "CEG")';
1394 ExecuteSQLExt(sql,False);
1395END ;
1396
1397
1398
1399procedure GenerateOrderDocIPD(GP_REFINTERNE,DO_ORDER_NO)
1400// IPD purchase delivered direct to customer
1401var
1402 IPT_RECEIPT_SQL,IPT_RECEIPT_QRY,GP_NUMERO,GP_SOUCHE,GP_STATUTENVOI,UpdateFlagSQL;
1403begin
1404 DebugMsg('GenerateOrderDocIPD','TRANSFORM IPD');
1405 IPT_RECEIPT_SQL := 'select GP_NUMERO,GP_SOUCHE,GP_STATUTENVOI ' +
1406 ' from PIECE where GP_refinterne like "' + GP_REFINTERNE + '%" and GP_NATUREPIECEG in ("CF") '+
1407 ' Order by GP_NATUREPIECEG desc ';
1408
1409 IPT_RECEIPT_QRY := OpenSQL(IPT_RECEIPT_SQL, True);
1410
1411 GP_NUMERO := FieldSQL(IPT_RECEIPT_QRY, 0);
1412 GP_SOUCHE := FieldSQL(IPT_RECEIPT_QRY, 1);
1413 GP_STATUTENVOI := FieldSQL(IPT_RECEIPT_QRY, 2);
1414
1415 if GP_STATUTENVOI='LIC' then
1416 begin
1417 TRANSFORM_CF2BLC(GP_NUMERO,GP_SOUCHE,GP_REFINTERNE,DO_ORDER_NO);
1418 // This sql is to replace trigger UpdateDeliveryItemState_FFO
1419 // Update flag GP_STATUTENVOI on origial receipt
1420 //Code
1421 UpdateFlagSQL:='UPDATE LIGNE SET GL_STATUTENVOI = "" WHERE GL_STATUTENVOI = "LIC" AND GL_NATUREPIECEG = "FFO" AND ( SELECT GP_REFINTERNE FROM PIECE WHERE GP_NATUREPIECEG = "FFO" AND GP_NUMERO = GL_NUMERO AND GP_SOUCHE = GL_SOUCHE and GP_NATUREPIECEG=GL_NATUREPIECEG) = LEFT( "'+GP_REFINTERNE+'",13) ';
1422 ExecuteSQL(UpdateFlagSQL);
1423 end
1424
1425 IPT_RECEIPT_SQL := 'select GP_NUMERO,GP_SOUCHE,GP_STATUTENVOI ' +
1426 ' from PIECE where GP_refinterne like "' + GP_REFINTERNE + '%" and GP_NATUREPIECEG in ("CDI") '+
1427 ' Order by GP_NATUREPIECEG desc ';
1428
1429 IPT_RECEIPT_QRY := OpenSQL(IPT_RECEIPT_SQL, True);
1430
1431 GP_NUMERO := FieldSQL(IPT_RECEIPT_QRY, 0);
1432 GP_SOUCHE := FieldSQL(IPT_RECEIPT_QRY, 1);
1433 GP_STATUTENVOI := FieldSQL(IPT_RECEIPT_QRY, 2);
1434
1435 if GP_STATUTENVOI='RET' then
1436 begin
1437 TRANSFORM_CDI2BLC(GP_NUMERO,GP_SOUCHE,GP_REFINTERNE,DO_ORDER_NO);
1438 // This sql is to replace trigger UpdateDeliveryItemState_FFO
1439 // Update flag GP_STATUTENVOI on origial receipt GL_STATUTENVOI in ('RET')
1440 // CODE
1441 UpdateFlagSQL:='UPDATE LIGNE SET GL_STATUTENVOI = "" WHERE GL_STATUTENVOI in ("RET") AND GL_NATUREPIECEG = "FFO" AND ( SELECT GP_REFINTERNE FROM PIECE WHERE GP_NATUREPIECEG = "FFO" AND GP_NUMERO = GL_NUMERO AND GP_SOUCHE = GL_SOUCHE and GP_NATUREPIECEG=GL_NATUREPIECEG) = LEFT( "'+GP_REFINTERNE+'",13) ';
1442 ExecuteSQL(UpdateFlagSQL);
1443 end
1444end
1445
1446
1447
1448procedure TRANSFORM_CDI2BLC(GLP_NUMERO_CDI,RECIPIENT_STORE,INT_REF,DO_ORDER_NO)
1449var
1450 GLP_NUMERO_BLC,TOBR_D,GP_SOUCHE,sql,TOBR,TOBR_D,GP_DEPOT,CurDate,GLP_NUMERO_CC;
1451begin
1452 DebugMsg('Transform CDI to BLC','TRANSFORM IPD');
1453 CurDate := Date();
1454 TOBR := TOBCreate('Result', 0, -1);
1455 CbrDocument.Transform(
1456 'BLC', // new doc type
1457 'CDI', // old doc type
1458 RECIPIENT_STORE, // "souche"
1459 GLP_NUMERO_CDI, // document no
1460 0, // always 0
1461 True, // auto=true, manual=false
1462 CurDate, //
1463 True, // progress bar
1464 TOBR // put result to command lne result :)
1465 );
1466 if DEBUG_MODE = True then TobDebug(TOBR);
1467 if TobAssigned(TOBR) and (TobGetValue (TOBR, 'VALID') = 0 ) then
1468 begin
1469 TOBR_D := TobDetail(TOBR, 0);
1470 if TobAssigned(TOBR_D) then
1471 begin
1472 GLP_NUMERO_BLC := TobGetValue (TOBR_D, 'GP_NUMERO');
1473 GP_SOUCHE := TobGetValue (TOBR_D, 'GP_SOUCHE');
1474 UPDATE_BLC_CUSTOMER_CODE(GLP_NUMERO_BLC,GP_SOUCHE,Copy (INT_REF , 1, 13));
1475// INSERT_LINKS_CDI_BLC(GP_SOUCHE,GLP_NUMERO_CDI,GLP_NUMERO_BLC,INT_REF);
1476 GLP_NUMERO_CC := GET_GP_NUMERO(INT_REF,'LIC','CC');
1477 INSERT_LINKS_CC_BLC(GP_SOUCHE,GLP_NUMERO_CC,GLP_NUMERO_BLC,INT_REF);
1478 UPDATE_MPIECEECO_IPD(GP_SOUCHE,INT_REF,'REC');
1479 sql := 'SELECT GP_DEPOT FROM PIECE WHERE GP_NUMERO = ' + GLP_NUMERO_BLC;
1480 GP_DEPOT := ReturnSQLField(sql,0);
1481 COPY_STOCKMOVEMENTS(GP_SOUCHE,GP_DEPOT,GLP_NUMERO_BLC,INT_REF);
1482 end else
1483 ShowMessage('Transform Document error!');
1484
1485 end else
1486 ShowMessage('Transform Document Error:' + TobGetValue (TOBR, 'MESSAGE'));
1487 TobFree(TOBR);
1488end;
1489
1490procedure UPDATE_MPIECEECO_IPT(STORE,GP_REFEXTERNE);
1491var
1492 GLP_NUMERO_CC,sql;
1493begin
1494 DebugMsg('UPDATE_MPIECEECO_IPT','TRANSFORM IPT');
1495 GLP_NUMERO_CC := GET_GP_NUMERO(GP_REFEXTERNE,'REC','CC');
1496 sql := 'update MPIECEECO set MEJ_CDEECOMEXPED="" '+
1497 ' WHERE MEJ_NATUREPIECEG = "CC" AND MEJ_NUMERO = ' + GLP_NUMERO_CC + ' AND MEJ_SOUCHE = "'+ STORE +'" AND MEJ_INDICEG = 0';
1498 ExecuteSQLExt(sql,False);
1499end;
1500
1501procedure UPDATE_MPIECEECO_IPD(STORE,GP_REFEXTERNE);
1502var
1503 GLP_NUMERO_CC,sql;
1504begin
1505 DebugMsg('UPDATE_MPIECEECO_IPD','TRANSFORM IPD');
1506 GLP_NUMERO_CC := GET_GP_NUMERO(GP_REFEXTERNE,'LIC','CC');
1507 sql := 'update MPIECEECO set MEJ_CDEECOMRETOUR="001",MEJ_CDEECOMREGLT="002",MEJ_CDEECOMSUIVI="008",MEJ_CDEECOMFACT="002",MEJ_CDEECOMENVOI="001",MEJ_CDEECOMETAB="028",MEJ_CDEECOMEXPED="002" '+
1508 ' WHERE MEJ_NATUREPIECEG = "CC" AND MEJ_NUMERO = ' + GLP_NUMERO_CC + ' AND MEJ_SOUCHE = "'+ STORE +'" AND MEJ_INDICEG = 0';
1509 ExecuteSQLExt(sql,False);
1510end;
1511
1512
1513
1514(*procedure INSERT_LINKS_CDI_BLC(STORE,GLP_NUMERO_CDI,GLP_NUMERO_BLC,GP_REFEXTERNE);
1515
1516 Still needed LW ? 6 Nov 2014
1517var
1518 sql,Query1,GEC_LASTCHRONO,CurDate;
1519BEGIN
1520 DebugMsg('INSERT_LINKS_CDI_BLC','TRANSFORM IPD');
1521 CurDate := FormatDateTime('yyyymmdd hh:nn:ss', NowH());
1522 GEC_LASTCHRONO := GET_GEC_LASTCHRONO(STORE);
1523 DebugMsg('GLP_NUMERO_CDI:' + GLP_NUMERO_CDI + ' GLP_NUMERO_BLC: ' + GLP_NUMERO_BLC,'TRANSFORM IPD');
1524
1525 sql := 'INSERT INTO LIAISONPIECE (GLP_ARTICLE, GLP_CODESITE, GLP_CREATEUR, GLP_DATECREATION, GLP_DATEINTEGR, GLP_DATEMODIF, GLP_ETABLISSEMENT, GLP_INDICEG, GLP_NATUREPIECEG, GLP_NUMERO, GLP_NUMLIEN, GLP_NUMORDRE, GLP_RANG, GLP_SOUCHE, GLP_SUPPRIME, GLP_TYPELIEN, GLP_UTILISATEUR) ' +
1526 'VALUES ("", "' + STORE + '", "CEG", "' + CurDate + '", "19000101 00:00:00", "' + CurDate + '", "", 0, "CDI", ' + GLP_NUMERO_CDI + ', ' + GEC_LASTCHRONO + ', 0, "O", "' + STORE + '", "-", "DEP", "CEG")';
1527 ExecuteSQLExt(sql,False);
1528
1529 sql := 'INSERT INTO LIAISONPIECE (GLP_ARTICLE, GLP_CODESITE, GLP_CREATEUR, GLP_DATECREATION, GLP_DATEINTEGR, GLP_DATEMODIF, GLP_ETABLISSEMENT, GLP_INDICEG, GLP_NATUREPIECEG, GLP_NUMERO, GLP_NUMLIEN, GLP_NUMORDRE, GLP_RANG, GLP_SOUCHE, GLP_SUPPRIME, GLP_TYPELIEN, GLP_UTILISATEUR) ' +
1530 'VALUES ("", "' + STORE + '", "CEG", "' + CurDate + '", "19000101 00:00:00", "' + CurDate + '", "", 0, "BLC", ' + GLP_NUMERO_BLC + ', ' + GEC_LASTCHRONO + ', 0, "D", "' + STORE + '", "-", "DEP", "CEG")';
1531 ExecuteSQLExt(sql,False);
1532END ;
1533
1534*)
1535
1536
1537
1538procedure COPY_STOCKMOVEMENTS(SOUCHE,DEPOT,NUMERO,INT_REF)
1539var
1540 sql,CurDate;
1541begin
1542 DebugMsg('COPY_STOCKMOVEMENTS','TRANSFORM IPD');
1543 DebugMsg('SOUCHE:' + SOUCHE + ' DEPOT: ' + DEPOT + ' NUMERO: ' + NUMERO + ' INT_REF: ' + INT_REF,'TRANSFORM IPD');
1544 CurDate := FormatDateTime('yyyymmdd hh:nn:ss', NowH());
1545 sql :=
1546 ' insert into ZRITBATCHNUMBERS ( [ZBN_STKTYPEMVT], [ZBN_QUALIFMVT], [ZBN_GUID], [ZBN_DATECREATION], [ZBN_DATEMODIF], [ZBN_DATEINTEGR], [ZBN_CREATEUR], [ZBN_UTILISATEUR], [ZBN_DATEMVT], [ZBN_NATUREPIECEG], [ZBN_SOUCHE], [ZBN_NUMERO], [ZBN_NUMLIGNE], [ZBN_NUMORDRE], [ZBN_GUIDORI], [ZBN_DEPOT], [ZBN_ARTICLE], [ZBN_LOTEXTERNE], [ZBN_LOTINTERNE], [ZBN_LOTSUIVI], [ZBN_DATEPEREMPTION], [ZBN_DATEDLU], [ZBN_DATEENTREELOT], [ZBN_PHYSIQUE], [ZBN_DPA], [ZBN_DPR], [ZBN_PMAP], [ZBN_PMRP], [ZBN_REFINTERNE],[zbn_do_ref_id] )' +
1547 ' select [ZBN_STKTYPEMVT]' +
1548 ' , [ZBN_QUALIFMVT]' +
1549 ' , [ZBN_GUID]' +
1550 ' , "' + CurDate + '"' +
1551 ' , "' + CurDate + '"' +
1552 ' , [ZBN_DATEINTEGR]' +
1553 ' , [ZBN_CREATEUR]' +
1554 ' , [ZBN_UTILISATEUR]' +
1555 ' , [ZBN_DATEMVT]' +
1556 ' , "BLC"' +
1557 ' , "' + SOUCHE + '"' +
1558 ' , "' + NUMERO + '"' +
1559 ' , [ZBN_NUMLIGNE]' +
1560 ' , [ZBN_NUMORDRE]' +
1561 ' , [ZBN_GUIDORI]' +
1562 ' , "' + DEPOT + '"' +
1563 ' , [ZBN_ARTICLE]' +
1564 ' , [ZBN_LOTEXTERNE]' +
1565 ' , [ZBN_LOTINTERNE]' +
1566 ' , [ZBN_LOTSUIVI]' +
1567 ' , [ZBN_DATEPEREMPTION]' +
1568 ' , [ZBN_DATEDLU]' +
1569 ' , [ZBN_DATEENTREELOT]' +
1570 ' , [ZBN_PHYSIQUE]' +
1571 ' , [ZBN_DPA]' +
1572 ' , [ZBN_DPR]' +
1573 ' , [ZBN_PMAP]' +
1574 ' , [ZBN_PMRP]' +
1575 ' , [ZBN_REFINTERNE]' +
1576 ' , [zbn_do_ref_id]' +
1577 ' from ZRITBATCHNUMBERS' +
1578 ' where ZBN_REFINTERNE = left("' + INT_REF + '",13) and ZBN_NATUREPIECEG="ALF"';
1579 ExecuteSQLExt(sql,False);
1580end;
1581
1582procedure TRANSFORM_CF2BLC(GLP_NUMERO_CF,RECIPIENT_STORE,INT_REF,DO_ORDER_NO)
1583var
1584 GLP_NUMERO_BLC,TOBR_D,GP_SOUCHE,sql,TOBR,TOBR_D,GP_DEPOT,CurDate,GLP_NUMERO_CC;
1585begin
1586 DebugMsg('Transform CF to BLC','TRANSFORM IPD');
1587 TOBR := TOBCreate('Result', 0, -1);
1588 CurDate := Date();
1589 CbrDocument.Transform(
1590 'BLC', // new doc type
1591 'CF', // old doc type
1592 RECIPIENT_STORE, // "souche"
1593 GLP_NUMERO_CF, // document no
1594 0, // always 0
1595 True, // auto=true, manual=false
1596 CurDate, //
1597 True, // progress bar
1598 TOBR // put result to command lne result :)
1599 );
1600 if DEBUG_MODE = True then TobDebug(TOBR);
1601 if TobAssigned(TOBR) and (TobGetValue (TOBR, 'VALID') = 0 ) then
1602 begin
1603 TOBR_D := TobDetail(TOBR, 0);
1604 if TobAssigned(TOBR_D) then
1605 begin
1606 GLP_NUMERO_BLC := TobGetValue (TOBR_D, 'GP_NUMERO');
1607 GP_SOUCHE := TobGetValue (TOBR_D, 'GP_SOUCHE');
1608 UPDATE_BLC_CUSTOMER_CODE(GLP_NUMERO_BLC,GP_SOUCHE,Copy (INT_REF , 1, 13));
1609 sql := 'update PIECE Set GP_TYPEPROVENANCE="DEP" ,GP_STATUTENVOI="LIC",GP_CONTREMARQUE="X",GP_REFEXTERNE="'+INT_REF+
1610 '" where GP_NATUREPIECEG="BLC" and GP_NUMERO=' + GLP_NUMERO_BLC + ' and GP_SOUCHE = "' + GP_SOUCHE + '"';
1611 ExecuteSQLExt(sql,False);
1612 GLP_NUMERO_CC := GET_GP_NUMERO(INT_REF,'LIC','CC');
1613 INSERT_LINKS_CC_BLC2(GP_SOUCHE,GLP_NUMERO_CC,GLP_NUMERO_BLC,INT_REF);
1614 UPDATE_MPIECEECO_IPD(GP_SOUCHE,INT_REF,'LIC');
1615 sql := 'Select GP_DEPOT from PIECE WHERE GP_REFINTERNE like "' +INT_REF+ '_%" and GP_NATUREPIECEG="CC" and GP_STATUTENVOI="LIC" ';
1616 GP_DEPOT := ReturnSQLField(sql,0);
1617 INSERT_STKMOUVEMENTS_IPD(DO_ORDER_NO,GLP_NUMERO_BLC,GP_DEPOT,GP_SOUCHE);
1618 end else
1619 ShowMessage('CbrDocument.Transform CF to BLC Creation error!');
1620
1621 end else
1622 ShowMessage('CbrDocument.Transform CF to BLC Error:' + TobGetValue (TOBR, 'MESSAGE'));
1623 TobFree(TOBR);
1624end;
1625
1626procedure UPDATE_BLC_CUSTOMER_CODE(GP_NUMERO,GP_SOUCHE,GP_refinterne);
1627var
1628 sql;
1629begin
1630 sql := 'UPDATE piece SET GP_TIERS=(select GP_TIERS from Piece where GP_refinterne like "'+GP_refinterne+
1631 '%" AND GP_NATUREPIECEG = "FFO") WHERE GP_NUMERO='+GP_NUMERO+' AND GP_SOUCHE='+GP_SOUCHE+' AND GP_NATUREPIECEG="BLC"';
1632 ExecuteSQLExt(sql,False);
1633end;
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643procedure INSERT_STKMOUVEMENT(GLP_NUMERO_ALF,GSM_DEPOT,GSM_SOUCHE,GSM_PHYSIQUE,LOT_BATCH_NO,GSM_ARTICLE,GSM_NUMLIGNE,INT_REF,NATUREPIECEG)
1644var
1645 ISQL,GUID,DH,ret,INT_REF_13;
1646begin
1647 GUID := AglGetGuid();
1648 DH := FormatDateTime('yyyymmdd hh:nn:ss', NowH());
1649 INT_REF_13 := Copy (INT_REF,1,13);
1650
1651 ISQL := 'INSERT INTO ZRITBATCHNUMBERS([ZBN_STKTYPEMVT],[ZBN_QUALIFMVT],[ZBN_GUID],[ZBN_DATECREATION],[ZBN_DATEMODIF],[ZBN_DATEINTEGR],[ZBN_CREATEUR],[ZBN_UTILISATEUR],[ZBN_DATEMVT],[ZBN_NATUREPIECEG],[ZBN_SOUCHE], [ZBN_NUMERO],[ZBN_NUMLIGNE], [ZBN_NUMORDRE],[ZBN_GUIDORI],[ZBN_DEPOT],[ZBN_ARTICLE], [ZBN_LOTEXTERNE],[ZBN_LOTINTERNE],[ZBN_LOTSUIVI], [ZBN_DATEPEREMPTION],[ZBN_DATEDLU],[ZBN_DATEENTREELOT],[ZBN_PHYSIQUE],[ZBN_DPA],[ZBN_DPR],[ZBN_PMAP],[ZBN_PMRP],[ZBN_REFINTERNE], [zbn_do_ref_id])' +
1652 ' SELECT "ATT", "", "' + GUID + '","' + DH + '","' + DH +'","19000101 00:00:00","CEG", "CEG","' +DH+'", "'+ NATUREPIECEG + '", "' + GSM_SOUCHE +'","' +GLP_NUMERO_ALF+'","' + GSM_NUMLIGNE +'","' + GSM_NUMLIGNE + '","","' + GSM_DEPOT +'","' + GSM_ARTICLE + '","'+LOT_BATCH_NO+'","' +LOT_BATCH_NO+'","'+LOT_BATCH_NO+'","20991231 00:00:00","20991231 00:00:00","' +DH+'","' + GSM_PHYSIQUE +'","0", "0", "0", "0","' + INT_REF_13 + '","' + INT_REF + '"' +
1653 ' WHERE NOT EXISTS (SELECT 1 FROM ZRITBATCHNUMBERS WHERE ' +
1654 ' [ZBN_LOTEXTERNE] = "' + LOT_BATCH_NO + '"' +
1655 ' AND [ZBN_NATUREPIECEG] = "' + NATUREPIECEG + '"' +
1656 ' AND [ZBN_REFINTERNE] = "' + INT_REF_13 + '"' +
1657 ' AND [ZBN_ARTICLE] = "' + GSM_ARTICLE + '"' + ')';
1658 ret := ExecuteSQL(ISQL);
1659 if ret = -1 then PgiInfo(GetLastError());
1660end;
1661
1662
1663procedure DebugMsg(Msg,Category)
1664var
1665 TOB;
1666begin
1667 TOB := TobCreate('DebugTOB', 0, -1);
1668 if DEBUG_MODE = True then
1669 begin
1670 TobClearDetail(TOB);
1671 TobAddChampSupValeur(TOB,'MESSAGE', Msg, True);
1672 TobDebug(TOB);
1673 end;
1674 CbpTraceInformation(Category,Msg);
1675 TobFree(TOB);
1676end;
1677
1678function CHECK_SQL(SQL)
1679begin
1680 Result := True;
1681 if not ExisteSQL(sql) then
1682 Begin
1683 DebugMsg('ERROR DATASET IS EMPTY','GLOBAL SCRIPT');
1684 if DEBUG_MODE = True then StrDebug(FindETReplace(sql,'"','''',True));
1685 Result := False;
1686 end;
1687end;
1688
1689
1690
1691
1692function ExecuteSQLExt(sql,ZeroWarning)
1693var
1694 NATIVE_MODE;
1695begin
1696 if (Copy (sql , 1, 1) = '@') and (Copy (sql , 2, 1) = '@') then
1697 NATIVE_MODE := ''
1698 else
1699 NATIVE_MODE := '@@';
1700
1701 result := ExecuteSQL(NATIVE_MODE + FindETReplace(sql,'"','''',True));
1702 if result = -1 then
1703 begin
1704 StrDebug(GetLastError());
1705 end else if (result = 0)and(ZeroWarning) then
1706 begin
1707 DebugMsg('ExecuteSQLExt return 0 records','GLOBAL SCRIPT ALF');
1708 StrDebug(sql);
1709 end;
1710end;
1711
1712
1713function ReturnSQLField(sql,field)
1714var
1715 Query1;
1716begin
1717 result := '';
1718 Query1 := OpenSQL(sql,true);
1719 if Query1 = 0 then
1720 begin
1721 StrDebug(GetLastError());
1722 Exit;
1723 end;
1724 result := FieldSQL(Query1, field);
1725end;
1726
1727
1728function GET_GEC_LASTCHRONO(STORE)
1729var
1730 sql;
1731begin
1732 sql := 'select GEC_LASTCHRONO + 1 from ETABCHRONO WHERE GEC_ETABLISSEMENT = "' + STORE +
1733 '" AND GEC_TYPECHRONO = "LIP" AND ((GEC_ANNEE = "..." AND GEC_GEREANNUEL = "-") OR (GEC_ANNEE = "..." AND GEC_GEREANNUEL = "X"))';
1734 result := ReturnSQLField(sql,0);
1735 sql := 'UPDATE ETABCHRONO SET GEC_LASTCHRONO = (Select GEC_LASTCHRONO+1 from ETABCHRONO WHERE GEC_ETABLISSEMENT = "' + STORE +
1736 '" AND GEC_TYPECHRONO = "LIP" AND ((GEC_ANNEE = "..." AND GEC_GEREANNUEL = "-") OR (GEC_ANNEE = "..." AND GEC_GEREANNUEL = "X"))) WHERE GEC_ETABLISSEMENT = "' +
1737 STORE + '" AND GEC_TYPECHRONO = "LIP" AND ((GEC_ANNEE = "..." AND GEC_GEREANNUEL = "-") OR (GEC_ANNEE = "..." AND GEC_GEREANNUEL = "X"))';
1738 ExecuteSQLExt(sql,False);
1739end;
1740
1741
1742
1743
1744////////////////////////////////////////////////////////////////////////////////
1745function GetCustomerOrderItems(tobParentAddItems, tobResult)
1746var
1747 ItemIdx,
1748 sWhereCnd,
1749 tobAddItems,
1750 ItemLabel,
1751 ItemQty,
1752 ItemTotalAmt,
1753 LinesUpdated,
1754 sqlQuery;
1755
1756begin
1757 CbpTraceVerbose('CUSTORDER', 'GetCustomerOrderItems begin');
1758 TobPutValue(tobResult, 'VALID', '0');
1759 sWhereCnd := ' where ZCR_STATUS="-" and ZCR_REGISTER="' + CbrRegister.Current() + '"';
1760 sqlQuery := OpenSQL('select ZCR_LABEL, ZCR_QUANTITY, ZCR_AMOUNT from ZCUSTORDREFUND' + sWhereCnd, True);
1761 QueryFirst(sqlQuery);
1762 ItemIdx := 0;
1763 Result := not QueryEOF(sqlQuery);
1764 if Result then
1765 begin
1766 while not QueryEOF(sqlQuery) do
1767 begin
1768 CbpTraceVerbose('CUSTORDER', 'New refund item ' + IntToStr(ItemIdx));
1769 ItemLabel := FieldSQL(sqlQuery, 0);
1770 ItemQty := FieldSQL(sqlQuery, 1) * (-1);
1771 ItemTotalAmt := FieldSQL(sqlQuery, 2);
1772 CbpTraceVerbose('CUSTORDER', 'Label: ' + ItemLabel + ', quantity: ' + FloatToStrf(ItemQty, 15, 2) + ', amount: ' + FloatToStrf(ItemTotalAmt, 15, 2));
1773
1774 tobAddItems := TobCreate('ADD_ITEM_' + IntToStr(ItemIdx), TobParentAddItems, -1); // 1 Tob Child by 1 new item to add
1775
1776 //TobAddChampSupValeur(tobAddItems, 'ITEMID', ItemCode, False); // GA_CODEARTICLE is ok
1777 TobAddChampSupValeur(tobAddItems, 'ITEMID', 'CANCEL', False); // hardcoded item ID
1778 TobAddChampSupValeur(tobAddItems, 'QUANTITY', ItemQty, False);
1779 TobAddChampSupValeur(tobAddItems, 'DESCRIPTION', ItemLabel, False);
1780 TobAddChampSupValeur(tobAddItems, 'APPENDDESCRIPTION', '-', False);
1781 TobAddChampSupValeur(tobAddItems, 'TOTALAMOUNT', FloatToStrf(ItemTotalAmt, 15, 2) * (-1), False);
1782 TobAddChampSupValeur(tobAddItems, 'DISABLEUPDATE', 'X', False);
1783 TobAddChampSupValeur(tobAddItems, 'DISABLEDELETE', 'X', False);
1784
1785 QueryNext(sqlQuery);
1786 ItemIdx := ItemIdx + 1;
1787 end;
1788 CbpTraceVerbose('CUSTORDER', 'Updating ZCUSTORDREFUND');
1789 LinesUpdated := ExecuteSQL(FindEtReplace('@@update ZCUSTORDREFUND set ZCR_STATUS="A"' + sWhereCnd, '"', '''', True));
1790
1791 if LinesUpdated = -1 then
1792 begin
1793 CbpTraceError('CUSTORDER', Sql.LastError());
1794 TobPutValue(tobResult, 'MESSAGE', 'Error updating Customer Order Refund table');
1795 //TobPutValue(tobResult, 'VALID', '2');
1796 end
1797 else
1798 TobPutValue(tobResult, 'MESSAGE', 'Success');
1799 end
1800 else
1801 CbpTraceVerbose('CUSTORDER', 'No refund items');
1802 CloseSQL(sqlQuery);
1803 CbpTraceVerbose('CUSTORDER', 'GetCustomerOrderItems end');
1804end;
1805
1806procedure CbrReceipt.LineOnExit(tobData, tobResult)
1807var
1808 CBS_ADD_ITEMS;
1809
1810begin
1811 if TobGetValue(TobDetail(tobData, 0), 'GP_NATUREPIECEG') = 'FFO' then
1812 begin
1813 CbpTraceVerbose('CUSTORDER', 'CbrReceipt.LineOnExit FFO begin');
1814 CBS_ADD_ITEMS := TobDetail(tobResult, 1);
1815 GetCustomerOrderItems(CBS_ADD_ITEMS, tobResult);
1816 CbpTraceVerbose('CUSTORDER', 'CbrReceipt.LineOnExit FFO end');
1817 end
1818 {
1819 else
1820 TobDebug(tobData);
1821 }
1822end;
1823
1824procedure UpdateRefundStateOnOrder(tobData, RefundState, RefundStatusInt, UpdatePO);
1825var
1826 QtyStr,
1827 tobDataDetail,
1828 sqlQuery,
1829 sWhereCnd;
1830begin
1831 tobDataDetail := TobDetail(tobData, 0);
1832 if TobGetValue(tobDataDetail, 'GP_NATUREPIECEG') = 'FFO' then
1833 begin
1834 if RefundState = 'X' then
1835 QtyStr := 'GL_QTERESTE=0, GL_QTEFACT=0,'
1836 else
1837 QtyStr := '';
1838 sWhereCnd := ' where ZCR_STATUS="A" and ZCR_REGISTER="' + CbrRegister.Current() + '"';
1839 sqlQuery := OpenSQL('select distinct ZCR_SOUCHE, ZCR_NUMERO, ZCR_NUMLIGNE from ZCUSTORDREFUND' + sWhereCnd, True);
1840 QueryFirst(sqlQuery);
1841 while not QueryEOF(sqlQuery) do
1842 begin
1843 ExecuteSQL('update LIGNE set ' + QtyStr + ' GL_BLOQUETARIF="' + RefundState +
1844 '" where GL_NATUREPIECEG="CC" and GL_SOUCHE="' + FieldSQL(sqlQuery, 0) +
1845 '" and GL_NUMERO=' + FieldSQL(sqlQuery, 1) + ' and GL_BLOQUETARIF="A"');
1846 if UpdatePO = 'X' then
1847 begin
1848 ExecuteSQL('update LIGNE set ' + QtyStr + ' GL_BLOQUETARIF="' + RefundState +
1849 '" where GL_NATUREPIECEG="CF" and GL_PIECEPRECEDENTE like "%;CC;' + FieldSQL(sqlQuery, 0) + ';' + FieldSQL(sqlQuery, 1) + ';%;' + FieldSQL(sqlQuery, 2) + '"');
1850{
1851 ExecuteSQL('update LIGNE set GL_QTERESTE=0, GL_QTEFACT=0, GL_BLOQUETARIF="' + RefundState +
1852 '" where GL_NATUREPIECEG="CF" and GL_SOUCHE="' + FieldSQL(sqlQuery, 0) +
1853 '" and GL_NUMERO=' + FieldSQL(sqlQuery, 1) + ' and GL_BLOQUETARIF="A"');
1854}
1855 end;
1856 QueryNext(sqlQuery);
1857 end;
1858 CloseSQL(sqlQuery);
1859 ExecuteSQL('update ZCUSTORDREFUND set ZCR_STATUS="' + RefundStatusInt + '", ZCR_FFOSOUCHE="'+TobGetValue(tobDataDetail, 'GP_SOUCHE')+'",ZCR_FFONUMERO="'+TobGetValue(tobDataDetail, 'GP_NUMERO')+'"' + sWhereCnd);
1860 end
1861end;
1862
1863
1864procedure CbrReceipt.AfterCancel(tobData, tobResult)
1865begin
1866 UpdateRefundStateOnOrder(tobData, '-', 'F', '-');
1867end;
1868
1869
1870procedure SimulateReceiptKeyDown();
1871var
1872 ritCegidFOReceiptSendKeyDownApp;
1873begin
1874 ritCegidFOReceiptSendKeyDownApp := GetCbpPath('GetCegid') +
1875 '\Cegid RIT\ritCegidFOReceiptSendKeyDown\ritCegidFOReceiptSendKeyDown.exe';
1876 if FileExists(ritCegidFOReceiptSendKeyDownApp) then
1877 CreateProcess(ritCegidFOReceiptSendKeyDownApp, True, True)
1878 else
1879 begin
1880 CbpTraceInformation('CUSTORDER', 'ritCegidFOReceiptSendKeyDown executable not found, manual line change required');
1881 PgiInfo('Please press the down arrow on your keyboard in order to add the cancelled items.');
1882 end;
1883end;
1884
1885procedure DisplayCustomerOrdersClick(TOBD, TOBR, EnableUpdate, EnableCancelLine)
1886var
1887 tobPiece;
1888
1889begin
1890 tobPiece := TobDetail(TOBD, 0);
1891 if OuvreFiche('GC', 'ZCUSTORDERS', '', '',
1892 'GP_TIERS=' + TobGetValue(tobPiece, 'GP_TIERS') +
1893 ';EnableUpdate=' + EnableUpdate +
1894 ';EnableCancelLine=' + EnableCancelLine
1895 ) <> '' then
1896 begin
1897 SimulateReceiptKeyDown();
1898 end;
1899end;
1900
1901procedure ScanCustomerOrderClick(TOBD, TOBR)
1902var
1903 tobPiece;
1904
1905begin
1906 tobPiece := TobDetail(TOBD, 0);
1907 if OuvreFiche('Z', 'ZCUSTORDERSCAN', '', '',
1908 'GP_TIERS=' + TobGetValue(tobPiece, 'GP_TIERS') + ';') <> '' then
1909 begin
1910 SimulateReceiptKeyDown();
1911 end;
1912end;
1913
1914// Retrieves the identifier of the FrontOffice button
1915// and calls the corresponding function
1916procedure CbrReceipt.CBSButtonOnClick(TOBD, TOBR)
1917begin
1918 if TOBGetValue(TOBD, 'BUTTONID') = 'DisplayCustomerOrders' then
1919 DisplayCustomerOrdersClick(TOBD, TOBR, 'X', 'X');
1920
1921 if TOBGetValue(TOBD, 'BUTTONID') = 'DisplayCustomerOrdersUpdate' then
1922 DisplayCustomerOrdersClick(TOBD, TOBR, 'X', '-');
1923
1924 if TOBGetValue(TOBD, 'BUTTONID') = 'DisplayCustomerOrdersCancelLine' then
1925 {if CheckOrderContent(TOBD, True, False) then // does not contain items
1926 PgiError('Documen contain sales!', 'Error')
1927 else}
1928 DisplayCustomerOrdersClick(TOBD, TOBR, '-', 'X');
1929
1930 if TOBGetValue(TOBD, 'BUTTONID') = 'MBOCCLIV_MUL' then
1931 OuvreFiche('MBO', 'MBODEPCC_MUL', '', '', '');
1932
1933 if TOBGetValue(TOBD, 'BUTTONID') = 'DisplayCustomerAccount' then
1934 DisplayCustomerAccountClick(TOBD, TOBR);
1935
1936 if TOBGetValue(TOBD, 'BUTTONID') = 'ScanCustomerOrder' then
1937 ScanCustomerOrderClick(TOBD, TOBR);
1938
1939 if TOBGetValue(TOBD, 'BUTTONID') = 'WEEKLYSALES' then
1940 OuvreFiche('Z', 'WEEKLYSALES', '', '', '');
1941
1942end;
1943
1944/////////////////////////////////////////////////////////
1945// Customer account payment
1946/////////////////////////////////////////////////////////
1947
1948function GetCustomerAccountInfo(CustomerID)
1949var
1950 IFSCustomerNo,
1951 ClientApp,
1952 hOutFile,
1953 OutFileName,
1954 Params,
1955 sqlQuery,
1956 CreditAccCustomer;
1957
1958begin
1959 CreditAccCustomer:='';
1960 Result := 'AccountInfoResult=Unknown error';
1961 ClientApp := GetCbpPath('GetCegid') + '\Cegid RIT\ritUniDBWebService\ritUniDBWSClient.exe';
1962 if FileExists(ClientApp) then
1963 begin
1964 sqlQuery := OpenSQL('select T_NIF,YTC_TABLELIBRETIERS2 from TIERS join Tierscompl on T_tiers =YTC_TIERS where T_NATUREAUXI = "CLI" /* and T_NIF<>"" */ and T_TIERS="' + CustomerID + '" and ', True);
1965 QueryFirst(sqlQuery);
1966 if not QueryEOF(sqlQuery) then
1967 begin
1968 IFSCustomerNo := FieldSQL(sqlQuery, 0);
1969 CreditAccCustomer := FieldSQL(sqlQuery, 1);
1970
1971
1972 if (IFSCustomerNo <> '') and (IFSCustomerNo <> 0) and (CreditAccCustomer='TRC') then
1973 begin
1974 OutFileName := GetCbpPath('GetCegidUserTempFileName');
1975 Params := ' "-fn=IFS Customer BAL BLOCK" "-outxml=' + OutFileName + '" "CUSTID=' + IFSCustomerNo + '"';
1976 CbpTraceInformation('IFS', '"' + ClientApp + '"' + Params);
1977 CreateProcess('"' + ClientApp + '"' + Params, True, True);
1978 if FileExists(OutFileName) then
1979 begin
1980 CbpTraceInformation('IFS', 'Loading result file: ' + OutFileName);
1981 hOutFile := AglOpenFile(OutFileName, fmOpenRead);
1982
1983
1984 Result := AglReadFile(hOutFile) + ';AccountInfoResult=OK';
1985 AglCloseFile(hOutFile);
1986 DeleteFile(OutFileName);
1987 end
1988 else
1989 Result := 'AccountInfoResult=Web service error';
1990 end
1991 else begin
1992 if CreditAccCustomer<>'TRC' then Result := 'AccountInfoResult=Not a credit account customer'
1993
1994
1995 else Result := 'AccountInfoResult=Customer reference is not set'
1996 end
1997 end
1998 else
1999 Result := 'AccountInfoResult=Invalid customer';
2000 end
2001 else
2002 Result := 'AccountInfoResult=Client application not found: ' + ClientApp;
2003 Result := Result + ';IFSCustomerNo=' + IFSCustomerNo;
2004 CbpTraceVerbose('IFS', Result);
2005end;
2006
2007// Receipt update
2008//procedure AccountPaymentsBeforeValid(TOBD, TOBR)
2009procedure CbrReceipt.PaymentsBeforeValid(TOBD, TOBR)
2010var
2011 IsStandaloneMode,
2012 MsgWebServiceNotAvailable,
2013 I,
2014 FailOnWebServiceError,
2015 AccountAmountDue,
2016 CustomerAccountInfo,
2017 CustomerAccountInfoResult,
2018 RemainCredit,
2019 PaymentMode,
2020 IsAccountPaymentMode,
2021 CastomerWithoutNIF,
2022 tobPiece,
2023 tobPayments,
2024 tobPaymentDetail;
2025
2026begin
2027 IsAccountPaymentMode := False;
2028 CastomerWithoutNIF := False;
2029 IsStandaloneMode := TobGetValue(TOBD, 'ACTION') = 'STANDALONERECEIPTINTEGRATION';
2030 if IsStandaloneMode then
2031 CbpTraceInformation('IFS', 'Standalone mode payment');
2032 tobPiece := TobDetail(TOBD, 0);
2033 MsgWebServiceNotAvailable :=
2034 'The credit check web service is not available.' + Chr(13) + Chr(10) + Chr(13) + Chr(10) +
2035 'Payment cannot be made on account at this time.' + Chr(13) + Chr(10) + Chr(13) + Chr(10) +
2036 'Please choose a different form of payment.';
2037 I := 0;
2038 AccountAmountDue := 0; // amount due can not be zero - CEGID will return an error
2039 tobPayments := TobDetail(TOBD, 1);
2040 while I < TobCount(tobPayments) do
2041 begin
2042 tobPaymentDetail := TobDetail(tobPayments, I);
2043 PaymentMode := TobGetValue(tobPaymentDetail, 'GPE_MODEPAIE');
2044 IsAccountPaymentMode :=
2045 (PaymentMode = 'ACC') or
2046 (PaymentMode = 'ACD') or
2047 (PaymentMode = 'AEU') or
2048 (PaymentMode = 'AUS');
2049 if IsAccountPaymentMode then
2050 begin
2051 if IsStandaloneMode then
2052 begin
2053 TobPutValue(TOBR, 'MESSAGE', MsgWebServiceNotAvailable);
2054 TobPutValue(TOBR, 'VALID', '2');
2055 Exit;
2056 end;
2057 AccountAmountDue := AccountAmountDue + TobGetValue(tobPaymentDetail, 'GPE_MONTANTECHE');
2058 Break;
2059 end;
2060 I := I + 1;
2061 end;
2062
2063 CustomerAccountInfo := GetCustomerAccountInfo(TobGetValue(tobPiece, 'GP_TIERS'));
2064 CustomerAccountInfoResult := ExtractValeur2(CustomerAccountInfo, 'AccountInfoResult', ';');
2065
2066
2067
2068 if CustomerAccountInfoResult <> 'OK' then
2069 begin
2070 FailOnWebServiceError := True;
2071 if CustomerAccountInfoResult = 'Web service error' then
2072 begin
2073 if AccountAmountDue = 0 then
2074 begin
2075 if PgiAsk('The credit check web service is not available. Accept payment anyway?', CustomerAccountInfoResult) = mrYes then
2076 begin
2077 CbpTraceWarning('IFS', 'Offline mode payment');
2078 CustomerAccountInfo := 'REMAIN_CREDIT=0;CREDIT_BLOCK=FALSE;CREDIT_LIMIT=0';
2079 FailOnWebServiceError := False;
2080 end;
2081 end
2082 else
2083 begin
2084 // account payment is not awailable when web service down
2085 CustomerAccountInfoResult := MsgWebServiceNotAvailable;
2086 end;
2087 end;
2088
2089 if CustomerAccountInfoResult = 'Customer reference is not set' then
2090 begin
2091 CastomerWithoutNIF := True;
2092 FailOnWebServiceError := IsAccountPaymentMode;
2093 CustomerAccountInfoResult :=
2094 'IFS Account number is not set.' + Chr(13) + Chr(10) + Chr(13) + Chr(10) +
2095 'Account payment type is not available' + Chr(13) + Chr(10) + Chr(13) + Chr(10) +
2096 'Please choose a different form of payment.';
2097 end;
2098
2099
2100 if (CustomerAccountInfoResult = 'Not a credit account customer') then
2101 begin
2102
2103 CastomerWithoutNIF := True;
2104 FailOnWebServiceError := IsAccountPaymentMode;
2105 if IsAccountPaymentMode then
2106 begin
2107 CustomerAccountInfoResult :=
2108 'Not an IFS Credit Account Customer ' + Chr(13) + Chr(10) + Chr(13) + Chr(10) +
2109 'Account payment type is not available' + Chr(13) + Chr(10) + Chr(13) + Chr(10) +
2110 'Please choose a different form of payment.';
2111 end;
2112 end;
2113
2114
2115 if FailOnWebServiceError then
2116 begin
2117 TobPutValue(TOBR, 'MESSAGE', CustomerAccountInfoResult);
2118 TobPutValue(TOBR, 'VALID', '2');
2119 Exit;
2120 end;
2121
2122 end;
2123
2124 if (not CastomerWithoutNIF) and (ExtractValeur2(CustomerAccountInfo, 'CREDIT_BLOCK', ';') <> 'FALSE') then
2125 begin
2126 TobPutValue(
2127 TOBR,
2128 'MESSAGE',
2129 'Credit blocked' + Chr(13) + Chr(10) + Chr(13) + Chr(10) + Chr(13) + Chr(10) +
2130 FormatCustomerInfoString(CustomerAccountInfo)
2131 );
2132 TobPutValue(TOBR, 'VALID', '2');
2133 end
2134 else
2135 begin
2136 RemainCredit := ExtractValeur2(CustomerAccountInfo, 'REMAIN_CREDIT', ';');
2137 CbpTraceInformation('IFS', 'Account payment requited: ' + AccountAmountDue);
2138 if StrToInt(RemainCredit * 100) < StrToInt(AccountAmountDue * 100) then // comparing double is not a good idea - better cast it to string and convert to ineteger
2139 begin
2140 TobPutValue(
2141 TOBR,
2142 'MESSAGE',
2143 'Insufficient funds:' + Chr(13) + Chr(10) + Chr(13) + Chr(10) + Chr(13) + Chr(10) +
2144 FormatCustomerInfoString(CustomerAccountInfo)
2145 );
2146 TobPutValue(TOBR, 'VALID', '2');
2147 end
2148 else
2149 CbpTraceInformation('IFS', 'We have a deal: customer credit = ' + RemainCredit + ', order total =' + TobGetValue(tobPiece, 'GP_TOTALTTC'));
2150 end;
2151
2152end;
2153
2154
2155
2156function FormatCustomerInfoString(CustomerAccountInfo)
2157begin
2158 Result :=
2159 'IFS Customer No: ' + ExtractValeur2(CustomerAccountInfo, 'IFSCustomerNo', ';') + Chr(13) + Chr(10) + Chr(13) + Chr(10) +
2160// 'Credit blocked: ' + ExtractValeur2(CustomerAccountInfo, 'CREDIT_BLOCK', ';') + Chr(13) + Chr(10) + Chr(13) + Chr(10) +
2161 'Credit blocked: ' + FindETReplace(FindETReplace( ExtractValeur2(CustomerAccountInfo, 'CREDIT_BLOCK', ';'),'TRUE','YES',true),'FALSE','NO',true) + Chr(13) + Chr(10) + Chr(13) + Chr(10) +
2162 'Credit limit: ' + FloatToStrf(ExtractValeur2(CustomerAccountInfo, 'CREDIT_LIMIT', ';'), 15, 2) + Chr(13) + Chr(10) + Chr(13) + Chr(10) +
2163 'Remain credit: ' + FloatToStrf(ExtractValeur2(CustomerAccountInfo, 'REMAIN_CREDIT', ';'), 15, 2);
2164end;
2165
2166procedure DisplayCustomerAccountClick(TOBD, TOBR)
2167var
2168 IFSCustomerNo,
2169 CustomerAccountInfo,
2170 CustomerAccountInfoResult;
2171
2172begin
2173 CustomerAccountInfo := GetCustomerAccountInfo(TobGetValue(TobDetail(TOBD, 0), 'GP_TIERS'));
2174 IFSCustomerNo := ExtractValeur2(CustomerAccountInfo, 'IFSCustomerNo', ';');
2175 CustomerAccountInfoResult := ExtractValeur2(CustomerAccountInfo, 'AccountInfoResult', ';');
2176 if CustomerAccountInfoResult <> 'OK' then
2177 PgiError(
2178 'IFS Customer No: ' + IFSCustomerNo + Chr(13) + Chr(10) + Chr(13) + Chr(10) +
2179 'Account information error:' + Chr(13) + Chr(10) + Chr(13) + Chr(10) +
2180 CustomerAccountInfoResult
2181 )
2182 else
2183 PgiInfo(
2184 FormatCustomerInfoString(CustomerAccountInfo),
2185 'Account information'
2186 );
2187end;
2188
2189
2190procedure GENERATE_ALF()
2191// Generate ALF-Delivery Notice from the customer CF - Purchase order
2192var
2193 QRY_ZCBR_IPT_RECEIPT,tobDocItems,tobDocHeader,sHeader,sItems,SO_CUSTOMER_PO_NO,GLP_NUMERO_CF,
2194 PO_ORDER_NO,TOBR,TOBR_D,GP_SOUCHE,sql,GLP_NUMERO_ALF,PIECE_SQL,I,DEMAND_ORDER_NO,GL_PIECEORIGINE;
2195begin
2196 TOBR := TOBCreate('Result', 0, -1);
2197 tobDocHeader := TOBCreate('DocHeader', 0, -1);
2198 tobDocItems := TOBCreate('DocItems', 0, -1);
2199
2200 sHeader := '@@SELECT PO_ORDER_NO, ET_ETABLISSEMENT, MDE_DEPOT,SO_CUSTOMER_PO_NO,DEMAND_ORDER_NO FROM ZCBR_IPT_RECIEPT_ITEM_V ' +
2201 ' LEFT OUTER JOIN ETABLISS ON ET_ABREGE = DO_SITE ' +
2202 ' LEFT OUTER JOIN METABDEPOT ON MDE_ETABLISSEMENT = ET_ETABLISSEMENT AND MDE_DEPOT = (SELECT GDE_DEPOT FROM DEPOTS WHERE GDE_DEPOT=MDE_DEPOT AND GDE_CHARLIBRE2=''CCOLL'' ) ' +
2203 // ' WHERE PO_ORDER_NO = ''' + EDT_PO_NUM.Text + '''' +
2204 ' GROUP BY PO_ORDER_NO,ET_ETABLISSEMENT,MDE_DEPOT,SO_CUSTOMER_PO_NO,DEMAND_ORDER_NO';
2205
2206 TobLoadDetailFromSql(tobDocHeader, sHeader, false, False, -1, 0);
2207// TobDebug(tobDocHeader);
2208 QRY_ZCBR_IPT_RECEIPT := OpenSQL(sHeader, True);
2209 QueryFirst(QRY_ZCBR_IPT_RECEIPT);
2210
2211 I := 0;
2212 //Loop through IPT Header information
2213 while not QueryEOF(QRY_ZCBR_IPT_RECEIPT) do
2214 begin
2215 PO_ORDER_NO := FieldSQL(QRY_ZCBR_IPT_RECEIPT, 0);
2216 GP_SOUCHE := FieldSQL(QRY_ZCBR_IPT_RECEIPT, 1);
2217 SO_CUSTOMER_PO_NO := FieldSQL(QRY_ZCBR_IPT_RECEIPT, 3);
2218 DEMAND_ORDER_NO := FieldSQL(QRY_ZCBR_IPT_RECEIPT, 4);
2219
2220 // Lookup CF purchase order number numero
2221 PIECE_SQL := 'Select GP_numero from PIECE WHERE GP_REFINTERNE like "' +SO_CUSTOMER_PO_NO+ '_%" and GP_NATUREPIECEG="CF" and GP_STATUTENVOI="REC" ';
2222 GLP_NUMERO_CF := ReturnSQLField(PIECE_SQL, 0);
2223 if GLP_NUMERO_CF = '' then
2224 begin
2225 QueryNext(QRY_ZCBR_IPT_RECEIPT);
2226 I := I + 1;
2227 break;
2228 end;
2229
2230
2231
2232
2233 sItems := '@@SELECT case when GA_FAMILLENIV1=''WAL'' then 1 else QTY_DUE end AS QTY, GA_ARTICLE, PO_ORDER_NO , LOT_BATCH_NO FROM ZCBR_IPT_RECIEPT_ITEM_V ' +
2234 ' JOIN ARTICLE ON (GA_CODEBARRE = SO_PART_NO) ' +
2235 ' WHERE PO_ORDER_NO = ''' + PO_ORDER_NO + '''';
2236// StrDebug(sItems);
2237 TobLoadDetailFromSql(tobDocItems, sItems, false, False, -1, 0);
2238
2239
2240 GLP_NUMERO_ALF := GenerateDocALF(tobDocHeader,tobDocItems,I);
2241
2242 if GLP_NUMERO_ALF <> '' then
2243 begin
2244
2245 //alf reference to original CC looked up by the demand reference no.
2246// Old Datepiece
2247
2248 sql := '@@Select replace(CONVERT(varchar(10),GP_DATEPIECE,103 ),''/'','''')+'';CC;''+GP_SOUCHE+'';''+CONVERT(varchar(18),GP_numero)+'';0;1'' from PIECE where GP_REFSUIVI=''' + DEMAND_ORDER_NO + ''' ' +
2249 ' and GP_STATUTENVOI=''REC'' and GP_NATUREPIECEG=''CC'' and GP_DATEPIECE>getdate()-6*30 '; // last half year only to speed up select assume IPT will be stale after half a year
2250
2251//Select replace(CONVERT(varchar(10),GP_DATEPIECE, ),'/','')+';CC;'+GP_SOUCHE+';'+CONVERT(varchar(18),GP_numero)+';0;1' from PIECE where GP_REFSUIVI='A4199989'
2252// and GP_STATUTENVOI='REC' and GP_NATUREPIECEG='CC' and GP_DATEPIECE>getdate()-6*30
2253
2254 GL_PIECEORIGINE := ReturnSQLField(sql, 0);
2255
2256 // Update ALF GL_PIECEORIGINE with original CC details otherwise you cannot receive the stock via BLF
2257 // LW Cegid supplied info on field that requires update
2258 // update ALF line otherwise cannot create customer delivery BLF LW see support incident multiple IPT deliveries
2259
2260 sql='update ligne set GL_PIECEORIGINE="' +GL_PIECEORIGINE+ '" where GL_NATUREPIECEG="ALF" and GL_NUMERO=' + GLP_NUMERO_ALF + ' and GL_SOUCHE = "' + GP_SOUCHE + '" and GL_PIECEORIGINE="" ';
2261 ExecuteSQLExt(sql,False);
2262
2263 // Update ALF Header fields
2264 sql := 'update PIECE Set GP_TYPEPROVENANCE="DEP" ,GP_STATUTENVOI="REC",GP_CONTREMARQUE="X", GP_REFSUIVI="'+DEMAND_ORDER_NO+'"' +
2265 ' Where GP_NATUREPIECEG="ALF" and GP_NUMERO=' + GLP_NUMERO_ALF + ' and GP_SOUCHE = "' + GP_SOUCHE + '"';
2266 ExecuteSQLExt(sql,False);
2267
2268
2269
2270
2271 INSERT_LINKS_CC_ALF(GP_SOUCHE,GLP_NUMERO_CF,GLP_NUMERO_ALF,SO_CUSTOMER_PO_NO,PO_ORDER_NO);
2272 UPDATE_MPIECEECO_IPT(GP_SOUCHE,SO_CUSTOMER_PO_NO); //Need to check status
2273 INSERT_STKMOUVEMENTS_IPT(PO_ORDER_NO,GLP_NUMERO_ALF);
2274
2275 // Update history table so ZCBR_IPT_RECIEPT_ITEM_V only contain ALF that have not yet been created in CBR
2276 sql := '@@INSERT INTO ZCBR_IPT_RECIEPT_ITEM_HISTORY( DEMAND_REF_ID ,SO_PART_NO ,LOT_BATCH_NO ,SO_LINE_NO ,DateCreated ,ProcessFlag)' +
2277 ' SELECT DEMAND_REF_ID ,SO_PART_NO ,LOT_BATCH_NO ,SO_LINE_NO , GETDATE(),null from ZCBR_IPT_RECEIPT WHERE PO_ORDER_NO = ''' + PO_ORDER_NO + '''';
2278 ExecuteSQLExt(sql,False);
2279 end;
2280
2281 QueryNext(QRY_ZCBR_IPT_RECEIPT);
2282 I := I + 1;
2283 end;
2284end;
2285
2286function GenerateDocALF(tobDocHeaders,tobDocItems,HeaderNum)
2287var
2288 Cmt,tobDocItemDetail,
2289 Comments,tobDocHeader,
2290 tobResult,
2291 tobAllDoc,
2292 tob1Doc,
2293 tobLine,
2294 I;
2295begin
2296 result := '';
2297 tobResult := TOBCreate('Result', 0, -1);
2298 tobAllDoc := TOBCreate('Documents', 0, -1);
2299 tob1Doc := TOBCreate('Header', tobAllDoc, -1);
2300 tobDocHeader := TobDetail(tobDocHeaders, HeaderNum);
2301 TOBAddChampSupValeur(tob1Doc, 'DOCUMENTTYPE', 'ALF');
2302 TOBAddChampSupValeur(tob1Doc, 'STORE', TobGetValue(tobDocHeader, 'ET_ETABLISSEMENT'));
2303 TOBAddChampSupValeur(tob1Doc, 'WAREHOUSE', TobGetValue(tobDocHeader, 'MDE_DEPOT'));
2304 TOBAddChampSupValeur(tob1Doc, 'INTERNALREFERENCE', TobGetValue(tobDocHeader, 'SO_CUSTOMER_PO_NO'));
2305 TOBAddChampSupValeur(tob1Doc, 'EXTERNALREFERENCE', TobGetValue(tobDocHeader, 'PO_ORDER_NO'));
2306 TOBAddChampSupValeur(tob1Doc, 'THIRDPARTY', 'FAB');
2307// TOBAddChampSupValeur(tob1Doc, 'DATE', TobGetValue(tobDocHeader, 'GP_NATUREPICIEG'));
2308
2309
2310 I := 0;
2311
2312 while I < TobCount(tobDocItems) do
2313 begin
2314 tobDocItemDetail := TobDetail(tobDocItems, I);
2315 tobLine := TOBCreate('Line', tob1Doc, -1);
2316 TOBAddChampSupValeur(tobLine, 'ITEMID', TobGetValue(tobDocItemDetail, 'GA_ARTICLE'));
2317 TOBAddChampSupValeur(tobLine, 'QUANTITY', TobGetValue(tobDocItemDetail, 'QTY'));
2318
2319 if TobGetValue(tobDocItemDetail, 'LOT_BATCH_NO')<>'*^*' then
2320 TOBAddChampSupValeur(tobLine, 'NOTEPAD', TobGetValue(tobDocItemDetail, 'LOT_BATCH_NO'));
2321
2322 I := I + 1;
2323 end;
2324
2325
2326 // TobDebug(tobAllDoc);
2327 CbrDocument.Generate(tobAllDoc, tobResult, false);
2328 //TobDebug(tobResult);
2329
2330 if TobCount(tobResult) > 0 then
2331 begin
2332 if TOBGetValue(tobResult, 'VALID') = 2 then
2333 PgiError(TOBGetValue(tobResult, 'MESSAGE'))
2334 else
2335 begin
2336 result := IntToStr(TobGetValue(TobDetail(tobResult, 0), 'GP_NUMERO'));
2337 end;
2338 end
2339 else
2340 PgiError('Document was not created');
2341
2342 TobDebug(tobResult);
2343 TobFree(tobResult);
2344 TobFree(tobAllDoc);
2345end;
2346
2347procedure GEN_ALL_ALF_DOCS()
2348var
2349 SQL,I,tobSelDetail,tobSel,GP_REFINTERNE;
2350begin
2351 SQL := 'select ZMD_SOCUSTOMERPONO FROM ZIFS_ALF_GEN order by ZMD_SOCUSTOMERPONO';
2352 tobSel := TOBCreate('DocItems', 0, -1);
2353 TobLoadDetailFromSql(tobSel, SQL, false, False, -1, 0);
2354 I := 0;
2355 while I < TobCount(tobSel) do
2356 begin
2357 tobSelDetail := TobDetail(tobSel, I);
2358 GP_REFINTERNE := TobGetValue(tobSelDetail, 'ZMD_SOCUSTOMERPONO');
2359 SQL := GEN_ALF_SQL(GP_REFINTERNE);
2360 ALF_DOC_GENERATE(SQL,GP_REFINTERNE);
2361 I := I + 1;
2362 end;
2363 TobFree(tobSel);
2364end;
2365
2366function GEN_ALF_SQL(GP_REFINTERNE)
2367begin
2368 result := '@@SELECT ' +
2369 'REPLACE(CONVERT(VARCHAR(10), CC.GP_DATEPIECE, 103), ''/'', '''') + '';CC;'' + GP_SOUCHE + '';'' + CONVERT(VARCHAR(18), CC.GP_NUMERO) + '';0;'' + CONVERT(VARCHAR(MAX), CC.GL_NUMLIGNE) AS ALF_GL_PIECEORIGINE ' +
2370 ',ISNULL(IFS.QTY_DUE, 0) AS IFSQty ' +
2371 ',CC.GL_QTEFACT - ISNULL(ALF.TOTALDEL_QTEFACT, 0) AS QtyStillToBeDelivered ' +
2372 ',TOTALDEL_QTEFACT ' +
2373 ',GA_CODEBARRE ' +
2374 ',PO_ORDER_NO ' +
2375 ',* ' +
2376 'FROM (SELECT ' +
2377 'GL_ARTICLE ' +
2378 ',GA_CODEBARRE ' +
2379 ',GA_FAMILLENIV1 ' +
2380 ',GL_QTEFACT ' +
2381 ',GL_QTERESTE ' +
2382 ',GL_PIECEORIGINE ' +
2383 ',GL_NUMLIGNE ' +
2384 ',GL_SOUCHE AS GP_souche ' +
2385 ',METABDEPOT.MDE_DEPOT AS GP_DEPOT ' +
2386 ',GP_DATEPIECE ' +
2387 ',GP_NUMERO ' +
2388 'FROM LIGNE ' +
2389 'LEFT OUTER JOIN METABDEPOT ' +
2390 'ON MDE_ETABLISSEMENT = GL_ETABLISSEMENT ' +
2391 'AND MDE_DEPOT = (SELECT ' +
2392 'GDE_DEPOT ' +
2393 'FROM DEPOTS ' +
2394 'WHERE GDE_DEPOT = MDE_DEPOT ' +
2395 'AND GDE_CHARLIBRE2 = ''CCOLL'') ' +
2396 'JOIN PIECE ' +
2397 'ON GL_NUMERO = GP_NUMERO ' +
2398 'AND GL_NATUREPIECEG = GP_NATUREPIECEG ' +
2399 'AND GL_SOUCHE = GP_souche ' +
2400 'JOIN ARTICLE ' +
2401 'ON GL_ARTICLE = GA_ARTICLE ' +
2402 'WHERE GL_NATUREPIECEG = ''CC'' ' +
2403 'AND GP_REFINTERNE LIKE ''' +GP_REFINTERNE+ '%'') CC ' +
2404 'LEFT OUTER JOIN (SELECT ' +
2405 'GL_ARTICLE ' +
2406 ',SUM(GL_QTEFACT) AS TOTALDEL_QTEFACT ' +
2407 ',SUM(GL_QTERESTE) AS TOTALDEL_QTERESTE ' +
2408 ',GL_PIECEORIGINE ' +
2409 'FROM LIGNE ' +
2410 'JOIN PIECE ' +
2411 'ON GL_NUMERO = GP_NUMERO ' +
2412 'AND GL_NATUREPIECEG = GP_NATUREPIECEG ' +
2413 'AND GL_SOUCHE = GP_SOUCHE ' +
2414 'WHERE GL_NATUREPIECEG = ''ALF'' ' +
2415 'AND GP_REFINTERNE LIKE ''' + GP_REFINTERNE + '%'' ' +
2416 'GROUP BY GL_ARTICLE ' +
2417 ',GL_PIECEORIGINE) ALF ' +
2418 'ON CC.GL_ARTICLE = ALF.GL_ARTICLE ' +
2419 'AND CONVERT(VARCHAR(10), CC.GL_NUMLIGNE) = LEFT(REVERSE(ALF.GL_PIECEORIGINE), CHARINDEX(REVERSE(ALF.GL_PIECEORIGINE), '';'') + 1) ' +
2420 'LEFT OUTER JOIN (SELECT ' +
2421 'Max(Qty_due) as Qty_due ' +
2422 ',SO_PART_NO ' +
2423 ',SO_LINE_NO ' +
2424 ',PO_ORDER_NO ' +
2425 'FROM ZCBR_IPT_RECEIPT ' +
2426 'WHERE SO_CUSTOMER_PO_NO LIKE ''' + GP_REFINTERNE + '%'' '+
2427 'GROUP BY SO_PART_NO ,SO_LINE_NO ,PO_ORDER_NO ) IFS ' +
2428 'ON IFS.SO_LINE_NO = CC.GL_NUMLIGNE ' +
2429 'AND IFS.SO_PART_NO = CC.GA_CODEBARRE ' +
2430 'WHERE 0 = 0 ' +
2431 'AND ( ISNULL(CC.GL_QTEFACT - ISNULL(ALF.TOTALDEL_QTEFACT, 0), 0) > 0 ' +
2432 'OR (isnull(IFS.QTY_DUE, 0) >0 and isnull(CC.GL_QTEFACT - isnull(ALF.TOTALDEL_QTEFACT, 0), 0) > 0)) '+
2433 'ORDER BY CC.GL_NUMLIGNE';
2434end;
2435
2436function ALF_DOC_GENERATE(ALF_SQL,GP_REFINTERNE)
2437var
2438 Cmt,tobDocItemDetail, tobDocItems,
2439 Comments,tobDocHeader,TCH1,
2440 tobResult,ResultDetail,
2441 tobAllDoc,
2442 tob1Doc,
2443 tobLine,GP_NUMERO,GP_SOUCHE,SQL, PO_ORDER_NO,
2444 I;
2445begin
2446 result := '';
2447 tobDocItems := TOBCreate('DocItems', 0, -1);
2448 TobLoadDetailFromSql(tobDocItems, ALF_SQL, false, False, -1, 0);
2449
2450// TobDebug(tobDocItems);
2451 TCH1 := '';
2452 while TobAssigned(TCH1) do
2453 begin
2454 TCH1 := TobFindFirst(tobDocItems, 'IFSQty', 0, False);
2455 TobFree (TCH1);
2456 end;
2457// TobDebug(tobDocItems)
2458
2459
2460 if TobCount(tobDocItems) = 0 then
2461 begin
2462 StrDebug(ALF_SQL);
2463 Exit;
2464 end;
2465
2466 tobDocItemDetail := TobDetail(tobDocItems, 0);
2467
2468 tobResult := TOBCreate('Result', 0, -1);
2469 tobAllDoc := TOBCreate('Documents', 0, -1);
2470 tob1Doc := TOBCreate('Header', tobAllDoc, -1);
2471 TOBAddChampSupValeur(tob1Doc, 'DOCUMENTTYPE', 'ALF');
2472 TOBAddChampSupValeur(tob1Doc, 'STORE', TobGetValue(tobDocItemDetail, 'GP_SOUCHE'));
2473 TOBAddChampSupValeur(tob1Doc, 'WAREHOUSE', TobGetValue(tobDocItemDetail, 'GP_DEPOT'));
2474// TOBAddChampSupValeur(tob1Doc, 'EXTERNALREFERENCE', TobGetValue(tobDocHeader, 'SO_CUSTOMER_PO_NO'));
2475 TOBAddChampSupValeur(tob1Doc, 'INTERNALREFERENCE', GP_REFINTERNE); // from
2476 TOBAddChampSupValeur(tob1Doc, 'THIRDPARTY', 'FAB');
2477// TOBAddChampSupValeur(tob1Doc, 'DATE', TobGetValue(tobDocHeader, 'GP_NATUREPICIEG'));
2478
2479 I := 0;
2480
2481 while I < TobCount(tobDocItems) do
2482 begin
2483 tobDocItemDetail := TobDetail(tobDocItems, I);
2484 tobLine := TOBCreate('Line', tob1Doc, -1);
2485 TOBAddChampSupValeur(tobLine, 'ITEMID', TobGetValue(tobDocItemDetail, 'GL_ARTICLE'));
2486 TOBAddChampSupValeur(tobLine, 'QUANTITY', TobGetValue(tobDocItemDetail, 'IFSQty'));
2487 I := I + 1;
2488 end;
2489
2490
2491 TobDebug(tob1Doc);
2492
2493 CbrDocument.Generate(tobAllDoc, tobResult, false);
2494
2495 if TobCount(tobResult) > 0 then
2496 begin
2497 if TOBGetValue(tobResult, 'VALID') = 2 then
2498 PgiError(TOBGetValue(tobResult, 'MESSAGE'))
2499 else
2500 begin
2501 ResultDetail := TobDetail(tobResult, 0);
2502// TobDebug(ResultDetail);
2503 // Update ALF Header fields
2504 GP_NUMERO := TobGetValue(ResultDetail, 'GP_NUMERO');
2505 GP_SOUCHE := TobGetValue(ResultDetail, 'GP_SOUCHE');
2506 //Set ALF Delivered / Pickup document flags with SQL
2507 Result := GP_NUMERO;
2508
2509 PO_ORDER_NO := TobGetValue(tobDocItemDetail, 'PO_ORDER_NO')
2510 sql := 'update PIECE Set GP_TYPEPROVENANCE="DEP" ,GP_STATUTENVOI="REC",GP_CONTREMARQUE="X" '+
2511 ' Where GP_NATUREPIECEG="ALF" and GP_NUMERO=' + GP_NUMERO + ' and GP_SOUCHE = "' + GP_SOUCHE + '"';
2512 ExecuteSQLExt(sql,True);
2513
2514// Insert document links in LaisionPiece Relation ship table
2515 INSERT_LINKS_CC_ALF(GP_SOUCHE,'X',GP_NUMERO(*ALF*),GP_REFINTERNE,PO_ORDER_NO);
2516// Update Delivered Pickup status Flags
2517 UPDATE_MPIECEECO_IPT(GP_SOUCHE,GP_REFINTERNE)
2518// for Multiple deliveries set item link on the delivery to point too the delivered item on the CC
2519 UPDATE_ALF_PIECEORIGINE(tobDocItems,GP_NUMERO,GP_SOUCHE);
2520 INSERT_STKMOUVEMENTS_IPT(PO_ORDER_NO,GP_NUMERO);
2521 UPDATE_HISTORY(PO_ORDER_NO);
2522 UPDATE_PO(tobDocItems,GP_REFINTERNE,GP_SOUCHE,GP_NUMERO);
2523
2524
2525 end;
2526 end
2527 else
2528 PgiError('Document was not created');
2529
2530// TobDebug(tobResult);
2531
2532 TobFree(tobResult);
2533 TobFree(tobDocItems);
2534 TobFree(tobAllDoc);
2535 TobFree(tob1Doc);
2536end;
2537
2538procedure UPDATE_PO(tobDocItems,GP_REFINTERNE,GP_SOUCHE,GP_NUMERO)
2539var
2540 I,tobDocItemDetail,sql,GP_STATUTRECEPTION,GP_TOTALQTEFACT,
2541 LIVING,GP_NUMERO_CF,GP_DEVENIRPIECE,GL_QTEFACT,GL_NUMLIGNE;
2542begin
2543 // GP_STATUTRECEPTION REC-Complete QTEreste0 ATT - no delivery - PAR partial delivery
2544 GP_NUMERO_CF := GET_GP_NUMERO(GP_REFINTERNE,'REC','CF');
2545 // '12012017;ALF;026;375;0;;';
2546
2547 GP_DEVENIRPIECE := Copy (TobGetValue(TobDetail(tobDocItems, 0), 'ALF_GL_PIECEORIGINE'),1,8) + ';ALF;' + GP_SOUCHE + ';' + GP_NUMERO + ';0;;'
2548
2549 sql := 'SELECT GP_TOTALQTEFACT FROM PIECE ' +
2550 ' WHERE GP_NATUREPIECEG="ALF" AND GP_SOUCHE="' + GP_SOUCHE + '" AND GP_NUMERO=' + GP_NUMERO + ' AND GP_INDICEG=0 ' ;
2551 StrDebug(sql);
2552 GP_TOTALQTEFACT := ReturnSQLField(sql,0);
2553
2554 sql := 'UPDATE PIECE SET GP_TOTALQTERESTE=GP_TOTALQTERESTE- ' + IntToStr(GP_TOTALQTEFACT) +
2555 ' WHERE GP_NATUREPIECEG=''CF'' AND GP_SOUCHE=''' + GP_SOUCHE + ''' AND GP_NUMERO=' + GP_NUMERO_CF + ' AND GP_INDICEG=0 ' ;
2556 StrDebug(sql);
2557 ExecuteSQLExt(sql,True);
2558
2559 sql := 'SELECT GP_TOTALQTERESTE FROM PIECE ' +
2560 ' WHERE GP_NATUREPIECEG="CF" AND GP_SOUCHE="' + GP_SOUCHE + '" AND GP_NUMERO=' + GP_NUMERO_CF + ' AND GP_INDICEG=0 ' ;
2561 StrDebug(sql);
2562 if ReturnSQLField(sql,0) = 0 then
2563 begin
2564 GP_STATUTRECEPTION = 'REC';
2565 LIVING ='-';
2566 end else
2567 begin
2568 GP_STATUTRECEPTION = 'PAR';
2569 LIVING ='X';
2570 end
2571
2572
2573 sql := 'UPDATE PIECE SET GP_DATEMODIF=getdate(),GP_VIVANTE='''+LIVING+''', GP_DEVENIRPIECE=''' + GP_DEVENIRPIECE + ''', GP_STATUTRECEPTION='''+GP_STATUTRECEPTION + '''' +
2574 ' WHERE GP_NATUREPIECEG=''CF'' AND GP_SOUCHE=''' + GP_SOUCHE + ''' AND GP_NUMERO=' + GP_NUMERO_CF + ' AND GP_INDICEG=0 ' ;
2575 StrDebug(sql);
2576 ExecuteSQLExt(sql,True);
2577
2578 I := 0;
2579
2580
2581
2582 while I < TobCount(tobDocItems) do
2583 begin
2584 tobDocItemDetail := TobDetail(tobDocItems, I);
2585 GL_QTEFACT := TobGetValue(tobDocItemDetail, 'GL_QTEFACT');
2586 GL_NUMLIGNE := NUMLIGNE_FROM_PIECEORIGINE(TobGetValue(tobDocItemDetail, 'ALF_GL_PIECEORIGINE')); // Return line no from end of string
2587 SQL := 'UPDATE LIGNE SET GL_DATEMODIF=GETDATE(), GL_QTERESTE=0 , GL_vivante=''-'' '+ // only whole lines get delivered therefore it is always =0
2588 ' WHERE GL_NATUREPIECEG=''CF'' AND GL_SOUCHE=''' + GP_SOUCHE +
2589 ''' AND GL_NUMERO=' + GP_NUMERO_CF + ' AND GL_INDICEG=0 AND GL_NUMLIGNE=' + GL_NUMLIGNE
2590 StrDebug(sql);
2591 ExecuteSQLExt(sql,True);
2592 sql := 'UPDATE DISPO SET GQ_ANNONCELIV=GQ_ANNONCELIV + ' + GL_QTEFACT +
2593 ',GQ_DATEMODIF=GETDATE(),GQ_RESERVEFOU=GQ_RESERVEFOU + - ' + GL_QTEFACT +
2594 ' WHERE GQ_ARTICLE=''' + TobGetValue(tobDocItemDetail, 'GL_ARTICLE') +
2595 ''' AND GQ_DEPOT=''' + TobGetValue(tobDocItemDetail, 'GP_DEPOT') +
2596 ''' AND GQ_CLOTURE=''-''';
2597 StrDebug(sql);
2598 ExecuteSQLExt(sql,True);
2599 I := I + 1;
2600 end;
2601
2602end;
2603
2604procedure UPDATE_HISTORY(PO_ORDER_NO)
2605var
2606 sql;
2607begin
2608 // Update history table so ZCBR_IPT_RECIEPT_ITEM_V only contain ALF that have not yet been created in CBR
2609 sql := 'INSERT INTO ZCBR_IPT_RECIEPT_ITEM_HISTORY( DEMAND_REF_ID ,SO_PART_NO ,LOT_BATCH_NO ,SO_LINE_NO ,DateCreated ,ProcessFlag)' +
2610 ' SELECT DEMAND_REF_ID ,SO_PART_NO ,LOT_BATCH_NO ,SO_LINE_NO , GETDATE(),null from ZCBR_IPT_RECEIPT WHERE PO_ORDER_NO = ''' + PO_ORDER_NO + '''';
2611 ExecuteSQLExt(sql,True);
2612end;
2613
2614procedure UPDATE_ALF_PIECEORIGINE(tobDocItems,NUMERO_ALF,GP_SOUCHE);
2615var
2616 I,tobDocItemDetail,sql;
2617begin
2618 I := 0;
2619
2620 while I < TobCount(tobDocItems) do
2621 begin
2622 tobDocItemDetail := TobDetail(tobDocItems, I);
2623 sql := 'update ligne set GL_PIECEORIGINE="' + TobGetValue(tobDocItemDetail, 'ALF_GL_PIECEORIGINE') +
2624 '" where GL_NATUREPIECEG="ALF" and GL_NUMERO=' + NUMERO_ALF + ' and GL_SOUCHE = "' + GP_SOUCHE + '" and GL_PIECEORIGINE="" ' +
2625 ' AND GL_NUMLIGNE= ' + IntToStr(I + 1) ;
2626 StrDebug('UPDATE_ALF_PIECEORIGINE: ' + sql);
2627 ExecuteSQLExt(sql,True);
2628 I := I + 1;
2629 end;
2630end;
2631
2632function NUMLIGNE_FROM_PIECEORIGINE(PIECEORIGINE)
2633var
2634 I,LC;
2635begin
2636 // 11012017;CC;026;538;0;1
2637 result := '';
2638 I := Length (PIECEORIGINE);
2639 LC := '';
2640 while (LC <> ';') do
2641 begin
2642 result := LC + result;
2643 LC := Copy(PIECEORIGINE,I,1);
2644 I := I - 1;
2645 end;
2646end;