· 9 years ago · Oct 28, 2016, 08:18 PM
1* Program....: CLSCOST.PRG
2* Version....: 3.0
3* Author.....:
4* Date.......:
5* Notice.....: Copyright (c) 1997 Garpac Corp, All Rights Reserved.
6* Compiler...: Visual FoxPro 05.00.00.0412 for Windows
7* Abstract...: Base Bill of Material Processing business class
8* Changes....: Multicurrency support -- TechRec 1002576 Dec 2003 - Jan 2004, GS --
9* : TechRec 1004691 Apr 28, 2004 GS:
10* : Replaced all UPPER(<Constant>) with Class Property for speedup.
11* : Removed paCost usage
12* : Removed all Macros like &Table_Name..Field_Name
13* : Optimized for speed, TR #1003958 May, 2004 - Chris (the GREAT)
14* : Brancke using patent-pending CIG Technology.
15
16#INCLUDE SYSTEM.h
17#DEFINE DUTY_ 1
18#DEFINE PRODUCTION_ 2
19#DEFINE MATERIAL_ 3
20#DEFINE TOTAL_COST_ 4
21#DEFINE COMMISSION_ 5 && TAN 33059 Ilya: Agent Commission
22#DEFINE CN_HS_FIXEDAMOUNT "HS Fixed Amount" && TR 1072967 26-SEP-13 Venuk
23
24*!* #DEFINE DUTIABLE_ 5 && ATS 4752
25
26DEFINE CLASS COSTBPOBASE AS BaseBusiness
27 NAME = "COSTBPOBASE"
28 * --- 1003958 04/04 CB - Optimized recalcs and logging:
29 lOptimizedRecalc = .F.
30 oLog = .NULL.
31 lEnableDebugging = .F.
32 lDynamicsPrepped = .F.
33 cLocAlias = ""
34 cHSNAlias = ""
35 cUOMAlias = ""
36 cAgnAlias = ""
37 cCstAlias = ""
38 cStyAlias = ""
39 cColAlias = ""
40 cDetAlias = ""
41 cHdrAlias = ""
42 * === 1003958 End.
43
44 *--- TechRec 1078317 23-Jul-2014 TSV---
45 cTransRetailPrice = ''
46 cTransWhsPrice = ''
47 cTransStdCost = ''
48 *=== TechRec 1078317 23-Jul-2014 TSV===
49
50 nPrepackQty= 1
51 lMultiLevelBOM= .F.
52 lNeedRecalCost= .F.
53 lSetLastProratedDate= .F.
54 nCostLevelPkey= 0
55 cPrePackCode= ""
56 nPrepackItemQty= 1
57 lNoBaseCostSheet= .F. && 5/15
58 *--- TAN 34262 09/25/02 AD
59 lRollUpCost = .F.
60 *=== TAN 34262 09/25/02 AD
61
62 *--- TR 1008559 VSS/SHAN 25-Jan-2005
63 lAutoCreateCostSheet = .F.
64 *=== TR 1008559 VSS/SHAN 25-Jan-2005
65
66 Dimension aMaxLevelCost[5] && PL 06/06/02 && TAN 33059 Ilya Agent Commission (increase to 5)
67 nMaxLevel= 0 && PL 06/06/02
68
69 *--- 32509 06/19/02 PL Cost change to divide by prepack to calcutate cost
70 cProdDetailDivision= ""
71 cProdDetailSize_code= ""
72 *=== 32509 06/19/02 PL
73
74 *--- TechRec 1002576 31-Dec-2003 GS ---
75 cBaseCostCurrency = " "
76 nBaseCostKey = 0 && this value will be checked to see if we need to requery Base Cost
77 *=== TechRec 1002576 31-Dec-2003 GS ===
78
79 *--- TechRec 1004691 27-Apr-2004 GS ---
80 cCN_DUTY_VALUE = ""
81 cCN_PROD_VALUE = ""
82 cCN_TOTAL_MATERIAL = ""
83 cCN_TOTAL_COST = ""
84 cCN_COMMISSION = ""
85 cCN_ER_LOOKUP = ""
86 cCN_HS_LOOKUP = ""
87 cCN_HS_FIXEDAMOUNT = "" && TR 1072967 26-SEP-13 Venuk
88
89 cCatAlias = ""
90 *=== TechRec 1004691 27-Apr-2004 GS ===
91
92 *--- TechRec 1007154 25-Oct-2004 GS ---
93 lLast_Stage = .F.
94 lER_Lookup = .F. && Old way Exchange rate lookup. Used by Cosabella only. Param CUSTCOSTATTR
95 *=== TechRec 1007154 25-Oct-2004 GS ===
96
97 *--- TechRec 1026008 10-Aug-2007 GSternik ---
98 *-- Needed to know this for AP Cost calculations
99 cPO_Dtl_Alias = ""
100
101 *--- TR 1026247 8-Aug-2007 Goutam
102 cMassUpdateCostCategory = ""
103
104 *--- 1032015 04/14/09 Ilya:
105 lPORangeimplosion = .F.
106 cPORangeCSTemplate = ''
107 *=== 1032015 04/14/09 Ilya.
108
109 *--- TechRec 1053716 23-May-2011 vkrishnamurthy ---
110 cCN_ACCOUNTING_COST = ""
111 *=== TechRec 1053716 23-May-2011 vkrishnamurthy ===
112
113 *--- TechRec 1057126 13-Oct-2011 MA ===
114 lNoPrdCstFrmBOM = .f.
115
116 *--- TechRec 1058999 13-Apr-2012 jisingh ---
117 cCN_MULTI_ROYALTY = ""
118 *=== TechRec 1058999 13-Apr-2012 jisingh ===
119
120
121*--- TechRec 1067706 13-Mar-2013 AZhadanov ---
122 cProdDetails = ''
123 cProdcost = ''
124*=== TechRec 1067706 13-Mar-2013 AZhadanov ===
125
126 cHeaderAlias='' && TR 1056306 07-30-2013 RKI
127 nDiv_Rate =0 && TR 1056306 07-30-2013 RKI
128
129 *--- TAN 34262 09/25/02 AD
130 PROCEDURE Init
131 LPARAMETERS poThermoObj && 1003958 04/04 CB.
132 LOCAL llRetVal, lcParm_name, lnSelect
133 llRetVal = DODEFAULT()
134
135 IF llRetVal
136 lnSelect = SELECT()
137 lcParm_name = ""
138 lcParm_name = ALLT(vl_parmr("ROLLUPCOST","parm_name","","ROLL-UP COST"))
139 This.lRollUpCost = !EMPTY(lcParm_name)
140
141 *--- TechRec 1004691 27-Apr-2004 GS ---
142 This.cCN_DUTY_VALUE = Upper(CN_DUTY_VALUE)
143 This.cCN_PROD_VALUE = Upper(CN_PROD_VALUE)
144 This.cCN_TOTAL_MATERIAL = Upper(CN_TOTAL_MATERIAL)
145 This.cCN_TOTAL_COST = Upper(CN_TOTAL_COST)
146 This.cCN_COMMISSION = Upper(CN_COMMISSION)
147 This.cCN_ER_LOOKUP = Upper(CN_ER_LOOKUP)
148 This.cCN_HS_LOOKUP = Upper(CN_HS_LOOKUP)
149 This.cCN_HS_FIXEDAMOUNT = Upper(CN_HS_FIXEDAMOUNT) && TR 1072967 26-SEP-13 Venuk
150
151 *--- TechRec 1053716 23-May-2011 vkrishnamurthy ---
152 This.cCN_ACCOUNTING_COST= goEnv.sv("CN_ACCOUNTING_COST", "Accounting Cost")
153 *=== TechRec 1053716 23-May-2011 vkrishnamurthy ===
154
155 *--- TechRec 1058999 13-Apr-2012 jisingh ---
156 This.cCN_MULTI_ROYALTY = goEnv.sv("CN_MULTI_ROYALTY", "Multi Royalty")
157 *=== TechRec 1058999 13-Apr-2012 jisingh ===
158
159 * --- 1003958 04/04 CB - Added optimized recalc and logging:
160 WITH THIS
161
162 *--- TechRec 1078317 23-Jul-2014 TSV---
163 .cTransStdCost = goEnv.sv("CN_TRANS_STD_COST", "Transfer Standard Cost")
164 .cTransRetailPrice = goEnv.sv("CN_TRANS_RETAIL_PRICE", "Transfer Retail Price")
165 .cTransWhsPrice = goEnv.sv("CN_TRANS_WHOLESALE", "Transfer Wholesale Price")
166 *=== TechRec 1078317 23-Jul-2014 TSV===
167
168 .lOptimizedRecalc = (goEnv.SV("COST_RECALC_VERS", "1") = "2")
169 .lEnableDebugging = (goEnv.SV("COST_DEBUG", "N") = "Y")
170
171 *--- TechRec 1057126 13-Oct-2011 MA ===
172 .lNoPrdCstFrmBOM = (goEnv.SV("NO_PROD_COST_FROM_BOM", "N")= "Y")
173
174*.lOptimizedRecalc = .t.
175*.lEnableDebugging = .t.
176
177 IF .lEnableDebugging
178 LOCAL loLog
179 InstantiateLogging(@loLog) && bclibfwk.prg
180 .oLog = loLog
181 lcLogName = AddBS(goEnv.SystemParm(SP_PATH_LOGS)) + "clsCost.log"
182 lolog.OpenLog("COSTING", I("COSTING"), .F., lcLogName)
183 lolog.LogProgram("clsCost.prg")
184 ENDIF
185
186 llRetVal = llRetVal AND .PrepBaseCursors(poThermoObj)
187
188 *--- 1032015 04/14/09 Ilya:
189 .lPORangeimplosion = (goEnv.SV("PO_IMPLODE_RANGES","N")="Y")
190 .cPORangeCSTemplate = ALLTRIM(goEnv.SV("PO_IMPLODE_RANGES_COSTSHEET_TEMPLATE",""))
191 * Validate the template:
192 IF !vl_dtmplh(.cPORangeCSTemplate)
193 .cPORangeCSTemplate = ''
194 ENDIF
195 *=== 1032015 04/14/09 Ilya.
196 ENDWITH
197 * === 1003958 End.
198
199 *--- TechRec 1007154 25-Oct-2004 GS ---
200 This.lER_Lookup = (goEnv.sv('CUSTCOSTATTR','N') = 'Y')
201 *=== TechRec 1007154 25-Oct-2004 GS ===
202
203 SELECT(lnSelect)
204 ENDIF
205
206 RETURN llRetVal
207 ENDPROC
208 *=== TAN 34262 09/25/02 AD
209
210 *-----------------------------------------------------------------------------------
211 * 04/06/00 Start JT ATS3847, create tmp cursor of bom for costing
212 *
213 PROCEDURE CreateCostBOM
214
215 LPARAMETER pnPkey, pcDetailAlias, pcBomAlias,tcProdCnclDtl
216 &&--- TechRec 1038308 13-Mar-2009 vkrishnamurthy === Added parameter tcProdCnclDtl
217
218 *--- TechRec 1072272 12-Jul-2013 TShenbagavalli added lnIndex ---
219 LOCAL llRetVal, lnxx, lcBucket, laCurrQty[MAX_BUCKETS_STRU], lnIndex
220
221 THIS.pushRecordSet()
222
223 IF EMPTY(pcDetailAlias)
224 pcDetailAlias = "vzzcordrd"
225 ENDIF
226 IF EMPTY(pcBomAlias)
227 pcBomAlias = "vzzcbommd"
228 ENDIF
229
230 SELECT (pcDetailAlias)
231 THIS.pushRecordSet()
232
233 *--- TAN 32086 05/15/02 AD
234 SET FILTER TO
235 *=== TAN 32086 05/15/02 AD
236 LOCATE FOR pkey = pnPkey
237
238 IF FOUND()
239 llRetVal = .T.
240 * first, get production size breakdown.
241 *--- TAN 35242 10/31/02 AD
242*!* FOR lnxx = 1 TO goEnv.MaxBuckets
243*!* lcBucket = PADL(lnxx, 2, "0")
244*!* IF last_stage = "Y"
245*!* laCurrQty[lnxx] = EVAL("size" + lcBucket + "_qty")
246*!* ELSE
247*!* laCurrQty[lnxx] = EVAL("wip" + lcBucket + "_qty")
248*!* ENDIF
249*!* ENDFOR
250 LOCAL ARRAY laCurrQty[24]
251 laCurrQty = 0
252 IF Last_Stage = 'Y'
253 *--- TechRec 1003793 22-Mar-2004 GS ---
254 *SCATTER FIELDS LIKE Size*_Qty TO laCurrQty
255 scatter fields ;
256 Size01_Qty,Size02_Qty,Size03_Qty,Size04_Qty,Size05_Qty,Size06_Qty,;
257 Size07_Qty,Size08_Qty,Size09_Qty,Size10_Qty,Size11_Qty,Size12_Qty,;
258 Size13_Qty,Size14_Qty,Size15_Qty,Size16_Qty,Size17_Qty,Size18_Qty,;
259 Size19_Qty,Size20_Qty,Size21_Qty,Size22_Qty,Size23_Qty,Size24_Qty ;
260 to laCurrQty
261 ELSE
262 *SCATTER FIELDS LIKE WIP*_qty TO laCurrQty
263 scatter fields ;
264 Wip01_Qty,Wip02_Qty,Wip03_Qty,Wip04_Qty,Wip05_Qty,Wip06_Qty,;
265 Wip07_Qty,Wip08_Qty,Wip09_Qty,Wip10_Qty,Wip11_Qty,Wip12_Qty,;
266 Wip13_Qty,Wip14_Qty,Wip15_Qty,Wip16_Qty,Wip17_Qty,Wip18_Qty,;
267 Wip19_Qty,Wip20_Qty,Wip21_Qty,Wip22_Qty,Wip23_Qty,Wip24_Qty ;
268 to laCurrQty
269 *=== TechRec 1003793 22-Mar-2004 GS ====
270 ENDIF
271 *=== TAN 35242 10/31/02 AD
272
273 * create a temp bom cursur for costing. (need to see all items in any stage.)
274 IF USED('tmpCostBom')
275 *--- TAN 34027 09/19/02 AD
276 *THIS.TableClose('tmpCostBom')
277 ZAP IN 'tmpCostBom'
278 *=== TAN 34027 09/19/02 AD
279 ENDIF
280
281 *--- TAN 34027 09/19/02 AD
282 lcMessage = "Creating temporary BOM cursor "
283 *Thermo(lcMessage, 1, 5)
284 *=== TAN 34027 09/19/02 AD
285 IF !USED('tmpCostBom')
286 *--- TAN 34778 06/16/03 AD
287 *AFIELDS(laCostBom, "vzzcbommd")
288
289 *--- TechRec 1072272 12-Jul-2013 TShenbagavalli ---
290 *AFIELDS(laCostBom, pcBomAlias)
291 lnIndex = AFIELDS(laCostBom, pcBomAlias)
292 *=== TechRec 1072272 12-Jul-2013 TShenbagavalli ===
293 *=== TAN 34778 06/16/03 AD
294
295 *--- TechRec 1072272 12-Jul-2013 TShenbagavalli ParBOMSku_2007 used in index instead ParBOMSku to fix index key issue. ---
296 lnIndex = lnIndex + 1
297 DIMENSION laCostBom[lnIndex, 18]
298
299 laCostBom[lnIndex, 1] = "ParBOMSku_2007"
300 laCostBom[lnIndex, 2] = "C"
301 laCostBom[lnIndex, 3] = "10"
302 laCostBom[lnIndex, 4] = 0
303 laCostBom[lnIndex, 5] = False
304 laCostBom[lnIndex, 6] = False
305 laCostBom[lnIndex, 7] = ""
306 laCostBom[lnIndex, 8] = ""
307 laCostBom[lnIndex, 9] = ""
308 laCostBom[lnIndex, 10] = ""
309 laCostBom[lnIndex, 11] = ""
310 laCostBom[lnIndex, 12] = ""
311 laCostBom[lnIndex, 13] = ""
312 laCostBom[lnIndex, 14] = ""
313 laCostBom[lnIndex, 15] = ""
314 laCostBom[lnIndex, 16] = ""
315 laCostBom[lnIndex, 17] = ""
316 laCostBom[lnIndex, 18] = ""
317 *=== TechRec 1072272 12-Jul-2013 TShenbagavalli ===
318
319 ******1082212
320 *--- TechRec 1082212 16-Dec-2014 AZhadanov ---
321 lnarr = ALEN(laCostBom,1)
322 lnarc = ALEN(laCostBom,2)
323
324 DIMENSION laCostBom(lnarr+1,lnarc)
325 ntrx = ASCAN(lacostbom,"TRXUSAGE")
326 lnrow = Asub(lacostbom,ntrx,1)
327 laCostBom(lnarr+1,1) = "ORIG_TRXUSAGE"
328 FOR lin = 2 TO lnarc
329 laCostBom(lnarr+1,lin) = laCostBom(lnrow,lin)
330 NEXT
331 *=== TechRec 1082212 16-Dec-2014 AZhadanov ===
332
333
334 CREATE CURSOR tmpCostBom FROM ARRAY laCostBom
335 *--- TAN 35242 10/31/02 AD
336 *--- TAN 35628 12/05/02 AD
337 *- Added ParBOMSku
338 *--- TechRec 1003118 26-Jan-2004 GS --- : undone 1000530
339 *--- 1023668 06-11-2007 SKG
340*!* index on Division+Style+Color_Code+iif(Dye_Ok ='Y', Lbl_Code, space(7))+Dimension+Cmp_Code+Cmp_Type+Str(Size_Bk)+ParBOMSku tag BOMKey
341 * *--- TechRec 1000530 15-Dec-2003 GS ---
342 * *--- We will use From_Key value to find the previous BOM :
343 *--- TechRec 1072272 12-Jul-2013 TShenbagavalli changed ParBOMSku to ParBOMSku_2007 in below index ---
344 INDEX ON Division+Style+Color_Code+Lbl_Code+Dimension+Cmp_Code+Cmp_Type+STR(Size_Bk)+ ParBOMSku_2007 TAG BOMKey
345 *=== 1023668 06-11-2007 SKG
346 * INDEX ON PKey tag PKey
347 * *=== TechRec 1000530 15-Dec-2003 GS ===
348 *=== TechRec 1003118 26-Jan-2004 GS ===
349 *=== TAN 35242 10/31/02 AD
350 Index on Division+Style+Color_Code+Lbl_Code+Dimension tag OurSKU
351 INDEX ON LevelPkey Tag LevelPkey
352 ENDIF
353
354 * create a snap shot of current prod bom for this stage in tmp cursor "tmpCostBom"
355 THIS.addCurrentBom(pcDetailAlias, pcBomAlias)
356 *--- TAN 34027 09/19/02 AD
357 *Thermo(lcMessage, 2, 5)
358 *=== TAN 34027 09/19/02 AD
359 * traverse up to the root for any item in the previous stage that is not see on this stage.
360 *--- TechRec 1038308 13-Mar-2009 vkrishnamurthy ---
361*!* THIS.addPrvStageBom(@laCurrQty, pcDetailAlias, pcBomAlias)
362 THIS.addPrvStageBom(@laCurrQty, pcDetailAlias, pcBomAlias,tcProdCnclDtl)
363 *=== TechRec 1038308 13-Mar-2009 vkrishnamurthy ===
364
365 *--- TAN 34027 09/19/02 AD
366 *Thermo(lcMessage, 3, 5)
367 *=== TAN 34027 09/19/02 AD
368
369 * look for later stages.
370 *--- TechRec 1038308 13-Mar-2009 vkrishnamurthy ---
371*!* THIS.addLaterStageBom(@laCurrQty, pcDetailAlias, pcBomAlias)
372 THIS.addLaterStageBom(@laCurrQty, pcDetailAlias, pcBomAlias,tcProdCnclDtl)
373 *=== TechRec 1038308 13-Mar-2009 vkrishnamurthy ===
374 *--- TAN 34027 09/19/02 AD
375 *Thermo(lcMessage, 4, 5)
376 *=== TAN 34027 09/19/02 AD
377
378 * add any item in base bom that is still not in temp cursor.
379* THIS.addMoreBom(@laCurrQty, pcDetailAlias)
380 *--- TAN 34027 09/19/02 AD
381 *Thermo(lcMessage, 5, 5)
382 *=== TAN 34027 09/19/02 AD
383
384 *--- TAN 34027 09/19/02 AD
385 *CURSORSETPROP("Buffering", 5, "tmpCostBom")
386 *=== TAN 34027 09/19/02 AD
387 ENDIF
388
389 THIS.popRecordSet()
390 THIS.popRecordSet()
391
392 RETURN llRetVal
393 ENDPROC
394 *------------------------------------------------------------------------------------------------
395 * create a snap shot of current prod bom for this stage in tmp cursor "tmpCostBom"
396 PROCEDURE addCurrentBom
397
398 LPARAMETER pcDetailAlias, pcBomAlias
399 LOCAL lcBucket, lnxx, lcTrx, laPoArray[MAX_BUCKETS_STRU, 2]
400 *--- TAN 32990 07/10/02 AD
401 LOCAL lnPKey, lnWIP_Adjust,lnorig_trxusage &&& 1082212
402 *=== TAN 32990 07/10/02 AD
403
404 THIS.pushRecordSet()
405 SELECT (pcDetailAlias)
406 lnPkey = pkey
407 *--- TAN 32990 07/10/02 AD
408 lnWIP_Adjust = IIF(Total_Qty = 0, 0, WIP_Total/Total_Qty)
409 *=== TAN 32990 07/10/02 AD
410
411 * get stage level produciton bom to the temp cursor.
412 * first, get production size breakdown.
413 *--- TAN 35242 10/31/02 AD
414*!* FOR lnxx = 1 TO goEnv.MaxBuckets
415*!* lcBucket = PADL(lnxx, 2, "0")
416*!* laPoArray[lnxx, 1] = EVAL("size" + lcBucket + "_qty") && size01_qty, etc.
417*!* laPoArray[lnxx, 2] = EVAL("wip" + lcBucket + "_qty") && wip01_qty, etc.
418*!* ENDFOR
419 LOCAL ARRAY laQtySize[24], laWIPSize[24]
420
421 STORE 0 TO laQtySize, laWIPSize
422 *--- TechRec 1003793 22-Mar-2004 GS ---
423 *SCATTER FIELDS LIKE Size*_Qty TO laQtySize
424 *SCATTER FIELDS LIKE WIP*_Qty TO laWIPSize
425 scatter fields ;
426 Size01_Qty,Size02_Qty,Size03_Qty,Size04_Qty,Size05_Qty,Size06_Qty,;
427 Size07_Qty,Size08_Qty,Size09_Qty,Size10_Qty,Size11_Qty,Size12_Qty,;
428 Size13_Qty,Size14_Qty,Size15_Qty,Size16_Qty,Size17_Qty,Size18_Qty,;
429 Size19_Qty,Size20_Qty,Size21_Qty,Size22_Qty,Size23_Qty,Size24_Qty ;
430 to laQtySize
431 scatter fields ;
432 Wip01_Qty,Wip02_Qty,Wip03_Qty,Wip04_Qty,Wip05_Qty,Wip06_Qty,;
433 Wip07_Qty,Wip08_Qty,Wip09_Qty,Wip10_Qty,Wip11_Qty,Wip12_Qty,;
434 Wip13_Qty,Wip14_Qty,Wip15_Qty,Wip16_Qty,Wip17_Qty,Wip18_Qty,;
435 Wip19_Qty,Wip20_Qty,Wip21_Qty,Wip22_Qty,Wip23_Qty,Wip24_Qty ;
436 to laWIPSize
437 *=== TechRec 1003793 22-Mar-2004 GS ====
438
439 *=== TAN 35242 10/31/02 AD
440
441 *--- TechRec 1003117 29-Jan-2004 GS ---
442 if Last_Stage = "Y"
443 ACopy(laQtySize, laWIPSize)
444 lnWIP_Adjust = 1 && ?
445 endif
446 *=== TechRec 1003117 29-Jan-2004 GS ===
447
448
449 SELECT (pcBomAlias)
450 THIS.pushRecordSet()
451
452 SCAN FOR fkey = lnPkey
453 SCATTER NAME loBomRec
454 lnorig_trxusage = trxusage &&& 1082212
455 SELECT tmpCostBom
456 * if consume type = "C", the bom trxusage must be adjust to its wip balance.
457 IF loBomRec.use_type = "C" && consume
458 *--- TAN 32990 07/10/02 AD
459 *--- TAN 33745 08/19/02 AD
460 *- For all syslevel > 0, not only prepack
461* IF !EMPTY(This.cPrePackCode) .AND. loBomRec.SysLevel > 0
462 *=== TAN 33745 08/19/02 AD
463 IF loBomRec.SysLevel > 0
464 loBomRec.trxusage = loBomRec.trxusage * lnWIP_Adjust
465 ELSE
466 loBomRec.trxusage = 0
467 FOR lnxx = 1 TO goEnv.MaxBuckets
468 *--- TAN 35242 10/31/02 AD
469 *IF laPoArray[lnxx, 1] > 0 && size01_qty.. etc.
470 IF laQtySize[lnxx] > 0 && size01_qty.. etc.
471 *lcBucket = PADL(lnxx, 2, "0")
472 lcBucket = TRANS(lnxx, '@L 99')
473 *=== TAN 35242 10/31/02 AD
474 lcTrx = "loBomRec.trx" + lcBucket + "_qty"
475 * trx / size * wip
476 *--- TAN 35242 10/31/02 AD
477 *loBomRec.trxusage = loBomRec.trxusage + EVAL(lcTrx) / laPoArray[lnxx,1] * laPoArray[lnxx,2]
478 loBomRec.trxusage = loBomRec.trxusage + EVAL(lcTrx) / laQtySize[lnxx] * laWIPSize[lnxx]
479 *=== TAN 35242 10/31/02 AD
480 *--- TR 1058669 02/17/12 AZ
481
482 ELSE &&& 1058669 AZ
483 lcBucket = TRANS(lnxx, '@L 99')
484 *=== TAN 35242 10/31/02 AD
485 lcTrx = "loBomRec.trx" + lcBucket + "_qty"
486 loBomRec.trxusage = loBomRec.trxusage + EVAL(lcTrx)
487 *=== TR 1058669 02/17/12 AZ
488 ENDIF
489 ENDFOR
490 ENDIF
491 *=== TAN 32990 07/10/02 AD
492 ENDIF
493 APPEND BLANK
494 GATHER NAME loBomRec
495
496 replace orig_trxusage WITH lnorig_trxusage &&& 1082212
497
498 *--- TechRec 1072272 12-Jul-2013 TShenbagavalli ---
499 REPLACE parbomsku_2007 WITH SYS(2007, parbomsku)
500 *=== TechRec 1072272 12-Jul-2013 TShenbagavalli ===
501
502 ENDSCAN
503
504 THIS.popRecordSet()
505 THIS.popRecordSet()
506 RETURN
507 ENDPROC
508
509 *------------------------------------------------------------------------------------------------
510 PROCEDURE addPrvStageBom
511 * 04/10/00 Start JT ATS3847, create tmp cursur of bom for costing
512 LPARAMETER paCurrQty, pcDetailAlias, pcBomAlias,tcProdCnclDtl
513 &&--- TechRec 1038308 13-Mar-2009 vkrishnamurthy === Added Parameter tcProdCnclDtl
514 EXTERNAL ARRAY paCurrQty
515 LOCAL lnParkey
516
517 THIS.pushRecordSet()
518
519 SELECT (pcDetailAlias)
520 THIS.pushRecordSet()
521 lnParkey = parkey && parkey of current record.
522 SET FILTER TO && may comes from poe, need to clear the filter.
523 LOCATE
524 * loop for the previous stage.
525 LOCATE FOR pkey = lnParkey
526 DO WHILE FOUND()
527 lnParkey = parkey && previous stage's parkey
528 *--
529 *--- TechRec 1038308 13-Mar-2009 vkrishnamurthy ---
530*!* THIS.startAddBomFromOtherStage(@paCurrQty, pcDetailAlias, pcBomAlias, pkey)
531 THIS.startAddBomFromOtherStage(@paCurrQty, pcDetailAlias, pcBomAlias, pkey,tcProdCnclDtl)
532 *=== TechRec 1038308 13-Mar-2009 vkrishnamurthy ===
533
534 *--
535 SELECT (pcDetailAlias)
536 LOCATE FOR pkey = lnParkey
537 ENDDO
538
539 THIS.popRecordSet() && pop for pcDetailAlias
540 THIS.popRecordSet() && pop for calling pgm
541 RETURN
542
543 ENDPROC
544 *-------------------------------------------------------------------------------
545
546 PROCEDURE addLaterStageBom
547 * 04/10/00 Start JT ATS3847, create tmp cursur of bom for costing
548 LPARAMETER paCurrQty, pcDetailAlias, pcBomAlias,tcProdCnclDtl
549 &&--- TechRec 1038308 13-Mar-2009 vkrishnamurthy ===Added parameter tcProdCnclDtl
550
551 EXTERNAL ARRAY paCurrQty
552 LOCAL lnPkey
553
554 THIS.pushRecordSet()
555
556 SELECT (pcDetailAlias)
557 THIS.pushRecordSet()
558 lnPkey = pkey && pkey of current stage.
559 SET FILTER TO && may comes from poe, need to clear the filter.
560 LOCATE
561 * loop for the later stage.
562 LOCATE FOR parkey = lnPkey
563 DO WHILE FOUND()
564 lnPkey = pkey && later stage's parkey
565 *--
566 *--- TechRec 1038308 13-Mar-2009 vkrishnamurthy --- Added Parameter tcProdCnclDtl
567*!* THIS.startAddBomFromOtherStage(@paCurrQty, pcDetailAlias, pcBomAlias, pkey)
568 THIS.startAddBomFromOtherStage(@paCurrQty, pcDetailAlias, pcBomAlias, pkey,tcProdCnclDtl)
569 *=== TechRec 1038308 13-Mar-2009 vkrishnamurthy ===
570 *--
571 SELECT (pcDetailAlias)
572 LOCATE FOR parkey = lnPkey
573 ENDDO
574
575 THIS.popRecordSet() && pop for pcDetailAlias
576 THIS.popRecordSet() && pop for calling pgm
577 RETURN
578
579 ENDPROC
580 *------------------------------------------------------------------------------------------------
581 PROCEDURE StartAddBomFromOtherStage
582 LPARAMETER paCurrQty, pcDetailAlias, pcBomAlias, pnCurrentStagePkey,tcProdCnclDtl
583 &&--- TechRec 1038308 13-Mar-2009 vkrishnamurthy === Added parameter tcProdCnclDtl
584 EXTERNAL ARRAY paCurrQty
585
586 LOCAL lnTrxUSage, lnxx, lcBucket, lcTrx, lnTrx, lcSize, ;
587 laWIPSize[MAX_BUCKETS_STRU], laPoSize[MAX_BUCKETS_STRU], paCancelQty[MAX_BUCKETS_STRU], lnOldSel, lcWip, lnWip && *--- 1025486 07-10-2007 SKG
588
589 LOCAL lntmpCostBomRecords &&--- TechRec 1037610 28-Jan-2009 asharma ===
590
591 * add those items not see at this stage, but in the other stage.
592 laWIPSize = 0 && laWIPSize is wip qty of previous stage.
593 laPoSize = 0 && laWIPSize is wip qty of previous stage.
594
595 *--- TAN 32990 07/10/02 AD
596 LOCAL lnTot_Size, lnTot_Qty, lnWIP_Adjust
597 STORE 0 TO lnTot_Size, lnTot_Qty, lnWIP_Adjust
598 *=== TAN 32990 07/10/02 AD
599
600 *--- TechRec 1050142 15-Oct-2010 jjanand ---
601 paCancelQty = 0
602 *=== TechRec 1050142 15-Oct-2010 jjanand ===
603
604 *--- TAN 35242 10/31/02 AD
605 *--- TechRec 1003793 22-Mar-2004 GS ---
606 *SCATTER FIELDS LIKE Size*_Qty TO laPoSize
607 *SCATTER FIELDS LIKE WIP*_qty TO laWIPSize
608 scatter fields ;
609 Size01_Qty,Size02_Qty,Size03_Qty,Size04_Qty,Size05_Qty,Size06_Qty,;
610 Size07_Qty,Size08_Qty,Size09_Qty,Size10_Qty,Size11_Qty,Size12_Qty,;
611 Size13_Qty,Size14_Qty,Size15_Qty,Size16_Qty,Size17_Qty,Size18_Qty,;
612 Size19_Qty,Size20_Qty,Size21_Qty,Size22_Qty,Size23_Qty,Size24_Qty ;
613 to laPoSize
614 scatter fields ;
615 Wip01_Qty,Wip02_Qty,Wip03_Qty,Wip04_Qty,Wip05_Qty,Wip06_Qty,;
616 Wip07_Qty,Wip08_Qty,Wip09_Qty,Wip10_Qty,Wip11_Qty,Wip12_Qty,;
617 Wip13_Qty,Wip14_Qty,Wip15_Qty,Wip16_Qty,Wip17_Qty,Wip18_Qty,;
618 Wip19_Qty,Wip20_Qty,Wip21_Qty,Wip22_Qty,Wip23_Qty,Wip24_Qty ;
619 to laWIPSize
620 *=== TechRec 1003793 22-Mar-2004 GS ====
621 *=== TAN 35242 10/31/02 AD
622 *--- 1025486 07-10-2007 SKG
623 *--- TR 1037183 11/19/08 AZ
624* IF vzzcordrd.cmpl_ok $ 'PC'
625 IF EVALUATE(pcDetailAlias+".cmpl_ok") $ 'PC'
626 *=== TR 1037183 11/19/08 AZ
627 lnOldSel = Select()
628 *--- TechRec 1038308 13-Mar-2009 vkrishnamurthy ---
629*!* SELECT vzzccncld
630
631**** 1045624
632 IF EMPTY(tcProdCnclDtl) AND USED("vzzccncld")
633 tcProdCnclDtl = "vzzccncld"
634 ENDIF
635
636 IF !EMPTY(tcProdCnclDtl)
637 *!* IF EMPTY(tcProdCnclDtl) AND USED("vzzccncld")
638 *!* SELECT vzzccncld
639 *!* ELSE
640 *!* SELECT(tcProdCnclDtl)
641 *!* ENDIF
642 *=== TechRec 1038308 13-Mar-2009 vkrishnamurthy ===
643 SELECT(tcProdCnclDtl)
644
645 THIS.pushRecordSet()
646
647 *--- TechRec 1038308 13-Mar-2009 vkrishnamurthy ---
648 *!* LOCATE FOR fkey = vzzcordrd.pkey
649 LOCATE FOR fkey = EVALUATE(pcDetailAlias+".Pkey")
650 *=== TechRec 1038308 13-Mar-2009 vkrishnamurthy ===
651 IF FOUND()
652 scatter fields ;
653 Cncl01_Qty,Cncl02_Qty,Cncl03_Qty,Cncl04_Qty,Cncl05_Qty,Cncl06_Qty,;
654 Cncl07_Qty,Cncl08_Qty,Cncl09_Qty,Cncl10_Qty,Cncl11_Qty,Cncl12_Qty,;
655 Cncl13_Qty,Cncl14_Qty,Cncl15_Qty,Cncl16_Qty,Cncl17_Qty,Cncl18_Qty,;
656 Cncl19_Qty,Cncl20_Qty,Cncl21_Qty,Cncl22_Qty,Cncl23_Qty,Cncl24_Qty ;
657 to paCancelQty
658 ENDIF
659
660 THIS.popRecordSet()
661 SELECT (lnOldSel)
662 ENDIF &&& 1045634 AZ
663 ENDIF
664 *=== 1025486 07-10-2007 SKG
665 * first, get production size/wip quantity from previous stage.
666 FOR lnxx = 1 TO goEnv.MaxBuckets
667 *--- TAN 35242 10/31/02 AD
668*!* lcBucket = PADL(lnxx, 2, "0")
669*!* laWIPSize[lnxx] = EVAL("wip" + lcBucket + "_qty")
670*!* laPoSize[lnxx] = EVAL("size" + lcBucket + "_qty")
671 *=== TAN 35242 10/31/02 AD
672 *--- TAN 32990 07/10/02 AD
673 lnTot_Size = lnTot_Size + laPoSize[lnxx]
674 lnTot_Qty = lnTot_Qty + paCurrQty[lnxx]
675 *=== TAN 32990 07/10/02 AD
676 ENDFOR
677
678 *--- TAN 32990 07/10/02 AD
679 lnWIP_Adjust = IIF(lnTot_Size = 0, 0, lnTot_Qty / lnTot_Size)
680 *=== TAN 32990 07/10/02 AD
681
682 * check if any bom of the previous stage is in the tmpCostBom.
683 SELECT (pcBomAlias)
684
685 *=== TechRec 1037610 28-Jan-2009 asharma ===
686 lntmpCostBomRecords=RECCOUNT('tmpCostBom')
687 *=== TechRec 1037610 28-Jan-2009 asharma ===
688
689 THIS.pushRecordSet()
690 SCAN FOR fkey = pnCurrentStagePkey && fkey pkey of zzcbommd and zzcrodrd
691 SCATTER MEMVAR
692 SELECT tmpCostBom
693 *--- TAN 35242 10/31/02 AD
694*!* LOCATE FOR division = m.division AND STYLE = m.style AND ;
695*!* color_code = m.color_code AND lbl_code = m.lbl_code AND ;
696*!* DIMENSION = m.dimension AND cmp_code = m.cmp_code AND ;
697*!* cmp_type = m.cmp_type AND size_bk = m.size_bk
698*!* IF !FOUND() && we must add this item to temp cursor if not found.
699 *--- TAN 35628 12/05/02 AD
700 *- Added ParBOMSku
701 *IF !SEEK(m.Division+m.Style+m.Color_Code+m.Lbl_Code+m.Dimension+m.Cmp_Code+m.Cmp_Type+STR(m.Size_Bk), 'tmpCostBom', 'BOMKey')
702 *--- TechRec 1003118 26-Jan-2004 GS --- : undone 1000530
703 *--- 1023668 06-11-2007 SKG
704*!* IF !Seek(m.Division+m.Style+m.Color_Code+iif(m.Dye_Ok ='Y', m.Lbl_Code, space(7))+;
705*!* m.Dimension+m.Cmp_Code+m.Cmp_Type+Str(m.Size_Bk)+m.ParBOMSku, 'tmpCostBom', 'BOMKey')
706 * *--- TechRec 1000530 15-Dec-2003 GS ---
707 * *--- Use From_Key value to find the previous BOM :
708
709 *=== TechRec 1037610 28-Jan-2009 asharma ===
710 *Note
711 *Cost was changing because when we add duplicate records in Production BOM
712 *and stage moves to non BOM stage it ignores the duplicate record
713 *which changes the cost.
714 *
715 *for the case when stage moves from BOM stage to non BOM stage
716 *we are collecting bOMs added from previous stages and when
717 *tmpCostBom is having zero record we simply add the record from
718 *vzzcbommd to tmpCostBom without checking the duplicates
719
720*!* IF !SEEK(m.Division+m.Style+m.Color_Code+m.Lbl_Code+m.Dimension+m.Cmp_Code+m.Cmp_Type+STR(m.Size_Bk)+m.ParBOMSku, 'tmpCostBom', 'BOMKey')
721 *--- TechRec 1072272 12-Jul-2013 TShenbagavalli changed m.ParBOMSku to SYS(2007, m.ParBOMSku) in below seek condition ---
722 IF lntmpCostBomRecords = 0 OR !SEEK(m.Division+m.Style+m.Color_Code+m.Lbl_Code+m.Dimension+m.Cmp_Code+m.Cmp_Type+STR(m.Size_Bk)+ SYS(2007,m.ParBOMSku), 'tmpCostBom', 'BOMKey')
723 *=== TechRec 1037610 28-Jan-2009 asharma ===
724
725 *=== 1023668 06-11-2007 SKG
726 * if m.From_Key = 0 or !Seek(m.From_Key, 'tmpCostBom', 'PKey')
727 * *=== TechRec 1000530 15-Dec-2003 GS ===
728 *=== TechRec 1003118 26-Jan-2004 GS ===
729 *=== TAN 35628 12/05/02 AD
730 *=== TAN 35242 10/31/02 AD
731 m.orig_trxusage = m.trxusage &&& 1082212
732 INSERT INTO tmpCostBom FROM MEMVAR
733 * calculate transaction usage., standard usage.
734 lnTrxUSage = 0
735 FOR lnxx = 1 TO goEnv.MaxBuckets
736 lcBucket = PADL(lnxx, 2, "0")
737 lcTrx = "trx" + lcBucket + "_qty" && trx01_qty etc..
738 lnTrx = EVAL(lcTrx) && transaction usage of previous stage.
739 *--- 1025486 07-10-2007 SKG
740 lcWip = "wip" + lcBucket + "_qty"
741 lnWip = EVAL(lcWip)
742 *--- 1025486 07-10-2007 SKG
743 IF lnTrx > 0 && there is transaction usage on the previous stage.
744 *--- TAN 31608 05/14/02 AD
745 *!* IF laWIPSize[lnxx] > 0
746 *!* lnTrx = lnTrx / laWIPSize[lnxx] * paCurrQty[lnxx]
747 *!* ELSE
748 *--- TAN 33745 08/19/02 AD
749 *- For all syslevel > 0, not only prepack
750 *--- TAN 32990 07/10/02 AD
751* IF !EMPTY(This.cPrePackCode) .AND. SysLevel > 0
752 *=== TAN 33745 08/19/02 AD
753 IF SysLevel > 0
754 lnTrx = lnTrx * lnWIP_Adjust
755 ELSE
756 *=== TAN 32990 07/10/02 AD
757
758 *--- TAN 38412 LH 5/28/03
759 *!*lnTrx = lnTrx / laPoSize[lnxx] * paCurrQty[lnxx]
760
761 *--- TAN 38649 09-Jul-2003 AD (typed by GS ) ---
762 *If laPoSize[lnxx] <> 0 AND paCurrQty[lnxx] <> 0
763 * lnTrx = lnTrx / laPoSize[lnxx] * paCurrQty[lnxx]
764 *EndIf
765 If laPoSize[lnxx] = 0
766 lnTrx = 0
767 ELSE
768 *--- 1025486 07-10-2007 SKG
769 *--- TechRec 1038308 13-Mar-2009 vkrishnamurthy ---
770*!* IF vzzcordrd.cmpl_ok $ 'PC' AND tmpCostBom.use_type='C' AND laPoSize[lnxx] <> lnWip
771 *--- TR 1054825 06/13/11 AZ removed division by 0 by adding laPoSize[lnxx] > paCancelQty[lnxx] condition
772 **** Also per Gena advise moved expression EVALUATE(pcDetailAlias+".cmpl_ok") $ 'PC' to the end (for the performance sake)
773* IF EVALUATE(pcDetailAlias+".cmpl_ok") $ 'PC' AND tmpCostBom.use_type='C' AND laPoSize[lnxx] <> lnWip
774 IF tmpCostBom.use_type='C' AND laPoSize[lnxx] <> lnWip AND laPoSize[lnxx] > paCancelQty[lnxx] AND EVALUATE(pcDetailAlias+".cmpl_ok") $ 'PC' &&& 1054825 AZ
775 *=== TR 1054825 06/13/11 AZ removed division by 0 by adding last condition
776 *=== TechRec 1038308 13-Mar-2009 vkrishnamurthy ===
777
778 lnTrx = (lnTrx / (laPoSize[lnxx] - paCancelQty[lnxx])) * paCurrQty[lnxx]
779 ELSE
780 *=== 1025486 07-10-2007 SKG
781* lnTrx = (lnTrx / laPoSize[lnxx]) * paCurrQty[lnxx] &&& 1045777 Commented out
782 ENDIF && *=== 1025486 07-10-2007 SKG
783 EndIf
784 *=== TAN 38649 09-Jul-2003 AD, GS ===
785
786 *=== TAN 38412 LH 5/28/03
787 ENDIF
788 *!* ENDIF
789 *--- TAN 31608 05/14/02 AD
790 lnTrxUSage = lnTrxUSage + lnTrx
791 REPLACE (lcTrx) WITH lnTrx IN tmpCostBom
792 ENDIF
793 ENDFOR
794
795 * total transaction usage, do not care about standard usage, we are not using it for costing.
796 REPLACE trxusage WITH lnTrxUSage IN tmpCostBom
797 ENDIF
798 ENDSCAN
799 THIS.popRecordSet() && pop for pcBomAlias
800 ENDPROC
801 *-------------------------------------------------------------------------------
802 PROCEDURE addAllOtherStageBom
803 * 04/10/00 Start JT ATS3847, create tmp cursur of bom for costing
804 LPARAMETER paCurrQty, pcDetailAlias, pcBomAlias
805
806 EXTERNAL ARRAY paCurrQty
807
808 LOCAL lnDtlPkey, lnTrxUSage, lnxx, lcBucket, lcTrx, lnTrx, lcSize, ;
809 lnPkey, lnOpen_seq, laWIPSize[MAX_BUCKETS_STRU], laPoSize[MAX_BUCKETS_STRU]
810
811 THIS.pushRecordSet()
812
813 SELECT (pcDetailAlias)
814 THIS.pushRecordSet()
815 lnPkey = pkey
816 lnOpen_seq = Open_seq
817
818 SET FILTER TO && may comes from poe, need to clear the filter.
819 * loop for all other stages.
820 SCAN FOR Open_seq = lnOpen_seq AND pkey # lnPkey
821 lnDtlPkey = pkey
822 * add those items not see at this stage, but in other stage.
823 laWIPSize = 0 && laWIPSize is wip qty of previous stage.
824 * first, get production wip quantity
825 *--- TAN 35242 10/31/02 AD
826 *--- TechRec 1003793 22-Mar-2004 GS ---
827 *SCATTER FIELDS LIKE Size*_Qty TO laPoSize
828 *SCATTER FIELDS LIKE WIP*_qty TO laWIPSize
829 scatter fields ;
830 Size01_Qty,Size02_Qty,Size03_Qty,Size04_Qty,Size05_Qty,Size06_Qty,;
831 Size07_Qty,Size08_Qty,Size09_Qty,Size10_Qty,Size11_Qty,Size12_Qty,;
832 Size13_Qty,Size14_Qty,Size15_Qty,Size16_Qty,Size17_Qty,Size18_Qty,;
833 Size19_Qty,Size20_Qty,Size21_Qty,Size22_Qty,Size23_Qty,Size24_Qty ;
834 to laPoSize
835 scatter fields ;
836 Wip01_Qty,Wip02_Qty,Wip03_Qty,Wip04_Qty,Wip05_Qty,Wip06_Qty,;
837 Wip07_Qty,Wip08_Qty,Wip09_Qty,Wip10_Qty,Wip11_Qty,Wip12_Qty,;
838 Wip13_Qty,Wip14_Qty,Wip15_Qty,Wip16_Qty,Wip17_Qty,Wip18_Qty,;
839 Wip19_Qty,Wip20_Qty,Wip21_Qty,Wip22_Qty,Wip23_Qty,Wip24_Qty ;
840 to laWIPSize
841 *=== TechRec 1003793 22-Mar-2004 GS ====
842
843*!* FOR lnxx = 1 TO goEnv.MaxBuckets
844*!* lcBucket = PADL(lnxx, 2, "0")
845*!* laWIPSize[lnxx] = EVAL("size" + lcBucket + "_qty")
846*!* laPoSize[lnxx] = EVAL("size" + lcBucket + "_qty")
847*!* ENDFOR
848 *=== TAN 35242 10/31/02 AD
849
850 * check if any bom of the other stage is in the tmpCostBom.
851 SELECT (pcBomAlias)
852 THIS.pushRecordSet()
853 SCAN FOR fkey = lnDtlPkey && fkey pkey of zzcbommd and zzcrodrd
854 SCATTER MEMVAR
855 SELECT tmpCostBom
856 *--- TAN 35242 10/31/02 AD
857*!* LOCATE FOR division = m.division AND STYLE = m.style AND ;
858*!* color_code = m.color_code AND lbl_code = m.lbl_code AND ;
859*!* DIMENSION = m.dimension AND cmp_code = m.cmp_code AND ;
860*!* cmp_type = m.cmp_type AND size_bk = m.size_bk
861*!* IF !FOUND() && we must add this item to temp cursor if not found.
862 *--- TAN 35628 12/05/02 AD
863 *- Added ParBOMSku
864 *IF !SEEK(m.Division+m.Style+m.Color_Code+m.Lbl_Code+m.Dimension+m.Cmp_Code+m.Cmp_Type+STR(m.Size_Bk), 'tmpCostBom', 'BOMKey')
865 *--- TechRec 1003118 26-Jan-2004 GS --- : undone 1000530
866 *--- 1023668 06-11-2007 SKG
867*!* IF !Seek(m.Division+m.Style+m.Color_Code+iif(m.Dye_Ok ='Y', m.Lbl_Code, space(7))+;
868*!* m.Dimension+m.Cmp_Code+m.Cmp_Type+Str(m.Size_Bk)+m.ParBOMSku, 'tmpCostBom', 'BOMKey')
869 * *--- TechRec 1000530 15-Dec-2003 GS ---
870 * *--- Use From_Key value to find the previous BOM :
871 *--- TechRec 1072272 12-Jul-2013 TShenbagavalli changed m.ParBOMSku to SYS(2007, m.ParBOMSku) in below seek condition---
872 IF !SEEK(m.Division+m.Style+m.Color_Code+m.Lbl_Code+m.Dimension+m.Cmp_Code+m.Cmp_Type+STR(m.Size_Bk)+ SYS(2007, m.ParBOMSku), 'tmpCostBom', 'BOMKey')
873 *=== 1023668 06-11-2007 SKG
874 * if m.From_Key = 0 or !Seek(m.From_Key, 'tmpCostBom', 'PKey')
875 * *=== TechRec 1000530 15-Dec-2003 GS ===
876 *=== TechRec 1003118 26-Jan-2004 GS ===
877 *=== TAN 35628 12/05/02 AD
878 *=== TAN 35242 10/31/02 AD
879 INSERT INTO tmpCostBom FROM MEMVAR
880 * calculate transaction usage., standard usage.
881 lnTrxUSage = 0
882 FOR lnxx = 1 TO goEnv.MaxBuckets
883 lcBucket = PADL(lnxx, 2, "0")
884 lcTrx = "trx" + lcBucket + "_qty" && trx01_qty etc..
885 lnTrx = EVAL(lcTrx) && transaction usage of previous stage.
886 IF lnTrx > 0 AND laWIPSize[lnxx] > 0 && there is transaction usage on the previous stage.
887 lnTrx = lnTrx / laWIPSize[lnxx] * paCurrQty[lnxx]
888 ELSE
889 lcSize = "size" + lcBucket + "_qty" && size01_qty etc..
890 lnTrx = EVAL(lcSize) * paCurrQty[lnxx] * (1 + wasteFactor)
891 ENDIF
892 lnTrxUSage = lnTrxUSage + lnTrx
893 REPLACE (lcTrx) WITH lnTrx IN tmpCostBom
894 ENDFOR
895 * total transaction usage, do not care about standard usage, we are not using it for costing.
896 REPLACE trxusage WITH lnTrxUSage IN tmpCostBom
897 ENDIF
898 ENDSCAN
899 THIS.popRecordSet() && pop for pcBomAlias
900 ENDSCAN
901
902 THIS.popRecordSet() && pop for pcDetailAlias
903 THIS.popRecordSet() && pop for calling pgm
904 RETURN
905
906 ENDPROC
907 *-------------------------------------------------------------------------------
908 * 04/07/00 JT 3847 - Costing module
909 PROCEDURE addMoreBom
910 LPARAMETER paCurrQty, pcDetailAlias
911
912 EXTERNAL ARRAY paCurrQty
913
914 LOCAL lnxx, lcBucket, llRetVal, lcTrx, lcSize, lcTable, ;
915 lcSqlString, lnRecNo, lnStdUsage, lnTrxUSage, lnTrx, ;
916 lcFilter, lnPrvStage, lnQty, lnCount
917
918 THIS.pushRecordSet()
919 SELECT (pcDetailAlias)
920 * find the base bom to copy from.
921 llRetVal = vl_GetBaseBOM(division, STYLE, color_code, lbl_code, DIMENSION, ;
922 prod_type, Vzzcordrh.contractor, "pkey",,,"TmpBomCur")
923
924 IF !EMPTY(llRetVal) && copy from base bom.
925 *--- 1035380 - PPK BOM 04/21/09 Ilya: Now TmpBomCur comes directly from vl_GetBaseBOM()
926*-Ilya--- pnOrgPKey = llRetVal
927*-Ilya--- llRetVal = .F.
928*-Ilya--- lcSqlString = "SELECT * FROM zzbbommd WHERE Fkey = ?pnOrgPkey"
929*-Ilya--- llRetVal = v_SQLPrep(lcSqlString, "TmpBomCur", "")
930 llRetVal = USED("TmpBomCur")
931 *=== 1035380 - PPK BOM 04/21/09 Ilya.
932
933 IF llRetVal
934 SELECT tmpCostBom
935 SCATTER MEMVAR && this is to initialize trx01_qty fields, which are not in TmpBomCur.
936 SELECT TmpBomCur
937 SCAN
938 SCATTER MEMVAR
939 SELECT tmpCostBom
940 *--- TAN 35242 10/31/02 AD
941*!* LOCATE FOR division = m.bd_div AND STYLE = m.bd_style AND ;
942*!* color_code = m.bd_color AND lbl_code = m.bd_lbl AND ;
943*!* DIMENSION = m.bd_dim AND cmp_code = m.cmp_code AND ;
944*!* cmp_type = m.cmp_type AND size_bk = m.size_bk
945*!* IF !FOUND() && need to add this item, if not already in tmp cursor
946 *--- TAN 35628 12/05/02 AD
947 *- Added ParBOMSku
948 *IF !SEEK(m.Division+m.Style+m.Color_Code+m.Lbl_Code+m.Dimension+m.Cmp_Code+m.Cmp_Type+STR(m.Size_Bk), 'tmpCostBom', 'BOMKey')
949 *--- TechRec 1003118 26-Jan-2004 GS --- : undone 1000530
950 *--- 1023668 06-11-2007 SKG
951*!* IF !Seek(m.Division+m.Style+m.Color_Code+iif(m.Dye_Ok ='Y', m.Lbl_Code, space(7))+;
952*!* m.Dimension+m.Cmp_Code+m.Cmp_Type+Str(m.Size_Bk)+m.ParBOMSku, 'tmpCostBom', 'BOMKey')
953 * *--- TechRec 1000530 15-Dec-2003 GS ---
954 * *--- Use From_Key value to find the previous BOM :
955 *--- TechRec 1072272 12-Jul-2013 TShenbagavalli changed m.ParBOMSku to SYS(2007, m.ParBOMSku) in below seek condition ---
956 IF !SEEK(m.Division+m.Style+m.Color_Code+m.Lbl_Code+m.Dimension+m.Cmp_Code+m.Cmp_Type+STR(m.Size_Bk)+ SYS(2007, m.ParBOMSku), 'tmpCostBom', 'BOMKey')
957 *=== 1023668 06-11-2007 SKG
958 * if m.From_Key = 0 or !Seek(m.From_Key, 'tmpCostBom', 'PKey')
959 * *=== TechRec 1000530 15-Dec-2003 GS ===
960 *=== TechRec 1003118 26-Jan-2004 GS ===
961 *=== TAN 35628 12/05/02 AD
962 *=== TAN 35242 10/31/02 AD
963 m.Master_Seq = m.Line_Seq && line_seq of vzzbbommd
964 m.Master_PKey = m.PKey && pkey of vzzbbommd
965
966 INSERT INTO tmpCostBom FROM MEMVAR
967 THIS.TimeStampDocument('tmpCostBom')
968 * calculate transaction usage., standard usage. average usage.
969 lnStdUsage = 0
970 lnTrxUSage = 0
971 lnQty = 0
972 lnCount = 0
973 FOR lnxx = 1 TO goEnv.MaxBuckets
974 lcBucket = TRANS(lnxx, "@L 99")
975 lcTrx = "trx" + lcBucket + "_qty" && trx01_qty etc..
976 lcSize = "size" + lcBucket + "_qty" && size01_qty etc..
977 lnTrx = EVAL(lcSize) * paCurrQty[lnxx] * (1 + wasteFactor)
978 *- accumulate standard usage.
979 lnStdUsage = lnStdUsage + EVAL(lcSize) * paCurrQty[lnxx] * (1 + wasteFactor)
980 lnTrxUSage = lnTrxUSage + lnTrx
981 REPLACE (lcTrx) WITH lnTrx IN tmpCostBom
982 * average usage..
983 IF EVAL(lcSize) > 0 AND paCurrQty[lnxx] > 0
984 lnQty = lnQty + EVAL(lcSize)
985 lnCount = lnCount + 1
986 ENDIF
987 ENDFOR
988 lnQty = IIF(lnCount > 0, lnQty / lnCount, Usage)
989 * get default master bom's header info., so we know what master bom does
990 * this produciton bom coming from.
991 * at this time, trxUsage = stdUsage.
992
993 *--- TechRec 1004691 28-Apr-2004 GS ---
994 select (pcDetailAlias)
995 scatter memvar fields PKey, FKey, Prod_Num, Open_Seq, Stage_Num, Prod_Type
996
997 *REPLACE master_div WITH m.division, master_style WITH m.style, ;
998 * master_color WITH m.color_code, master_lbl WITH m.lbl_code, ;
999 * master_dim WITH m.dimension, master_contractor WITH m.contractor, ;
1000 * master_pType WITH m.prod_type, fkey WITH &pcDetailAlias..pkey, ;
1001 * prodHdrFkey WITH &pcDetailAlias..fkey, prod_num WITH &pcDetailAlias..prod_num, ;
1002 * Open_seq WITH &pcDetailAlias..Open_seq, stage_num WITH &pcDetailAlias..stage_num, ;
1003 * prod_type WITH &pcDetailAlias..prod_type, division WITH bd_div, STYLE WITH bd_style, ;
1004 * color_code WITH bd_color, lbl_code WITH bd_lbl, DIMENSION WITH bd_dim, ;
1005 * use_type WITH 'C', stdUsage WITH lnStdUsage, trxusage WITH lnTrxUSage, ;
1006 * usage WITH lnQty IN tmpCostBom
1007
1008 REPLACE Master_Div WITH m.Division, Master_Style WITH m.Style, ;
1009 Master_Color WITH m.Color_Code, Master_Lbl WITH m.lbl_code, ;
1010 Master_Dim WITH m.dimension, Master_Contractor WITH m.Contractor, ;
1011 Master_pType WITH m.Prod_Type, fkey WITH m.PKey, ;
1012 ProdHdrFkey WITH m.FKey, Prod_Num WITH m.Prod_Num, ;
1013 Open_seq WITH m.Open_seq, Stage_Num WITH m.Stage_Num, ;
1014 Prod_Type WITH m.Prod_Type, Division WITH Bd_Div, Style WITH Bd_Style, ;
1015 Color_Code WITH Bd_Color, lbl_code WITH bd_lbl, Dimension WITH Bd_Dim, ;
1016 Use_Type WITH 'C', StdUsage WITH lnStdUsage, TrxUsage WITH lnTrxUsage, ;
1017 Usage WITH lnQty IN tmpCostBom
1018 *=== TechRec 1004691 28-Apr-2004 GS ===
1019 ENDIF
1020 ENDSCAN
1021 ENDIF
1022 ENDIF
1023
1024 THIS.popRecordSet()
1025 RETURN
1026 ENDPROC
1027 *--------------------------------------------------------------------------------------------------
1028 * 05/05/00 ATS3847, Costing, PO cost sheet
1029 PROCEDURE RecalCostNoBOM
1030 LPARAMETER pcCostAlias, pnPodtlPkey, pnqty, pcDetailAlias, paCost
1031
1032 EXTERNAL ARRAY paCost
1033
1034 IF EMPTY(pcDetailAlias)
1035 pcDetailAlias = "vzzcordrd"
1036 ENDIF
1037
1038 *--- TechRec 1026008 09-Aug-2007 GSternik ---
1039 This.cPO_Dtl_Alias = pcDetailAlias
1040 *=== TechRec 1026008 09-Aug-2007 GSternik ===
1041
1042 *--- TechRec 1007154 04-Oct-2004 GS ---
1043 * --- 1003958 03/05 CB - Make sure buffering is enabled before using CurVal():
1044 *--- TechRec 1067053 01-Mar-2013 jjanand === added = 'Y' to EVALUATE(pcDetailAlias + ".Last_Stage")
1045 This.lLast_Stage = IIF(INLIST(CURSORGETPROP("Buffering",pcDetailAlias), 3, 5), ;
1046 (CurVal("Last_Stage", pcDetailAlias) = 'Y'), EVALUATE(pcDetailAlias + ".Last_Stage")= 'Y')
1047 * === 1003958 end.
1048 *=== TechRec 1007154 04-Oct-2004 GS ===
1049
1050 WITH THIS
1051 .CostFromConstant(pcCostAlias, pnPodtlPkey, pnqty, @paCost) && get constant.
1052 .CostOfHSLookUp(pcCostAlias, pnPodtlPkey, pnqty) && get hs lookup cost
1053 .CostOfHSLookUp(pcCostAlias, pnPodtlPkey, pnqty,true ) && TR 1072967 26-SEP-13 Venuk. get Hs fixed Amount.
1054 *--- TechRec 1058999 13-Apr-2012 jisingh ---
1055 .CostOfMultiRoyalty(pcCostAlias, pnPodtlPkey, pnQty) && get multi royalty cost
1056 *=== TechRec 1058999 13-Apr-2012 jisingh ===
1057 .CostOfCommission(pcCostAlias, pnPodtlPkey, pnQty, Evaluate(pcDetailAlias + ".Agent")) && TAN 33059 Ilya get agent commission cost, GS -- Removed macro
1058 .CostByFormula(pcCostAlias, pnPodtlPkey, pnqty, @paCost) && get cost by formula
1059 ENDWITH
1060
1061 RETURN
1062
1063 ENDPROC
1064
1065 *---------------------------------------------------------------------------------------
1066 * 05/05/2000 ATS3847, calculate cost from constant
1067 PROCEDURE CostFromConstant
1068 LPARAMETER pcCostAlias, pnPodtlPkey, pnQty, paCost,tcProdCnclDtl
1069 &&--- TechRec 1038308 13-Mar-2009 vkrishnamurthy === Added Parameter tcProdCnclDtl
1070
1071 * --- 1003958 05/04 CB - Optimized recalcs.
1072 * NOTE: ANY CHANGES MADE TO THIS ROUTINE MUST BE DUPLICATED IN ITS OPTIMIZED _2 EQUIVALENT!
1073 WITH THIS
1074 IF .lOptimizedRecalc AND .lDynamicsPrepped
1075 .CostFromConstant_2(pcCostAlias, pnPODtlPKey, pnQty, @paCost) && Get cost by formula
1076 RETURN
1077 ENDIF
1078 ENDWITH
1079 * === 1003958 End.
1080
1081
1082
1083 EXTERNAL ARRAY paCost
1084
1085 LOCAL lnExtension, llRetVal, lcCategory, lnOldSelect
1086 local lnExRate &&--- TechRec 1007154 07-Oct-2004 GS ===
1087
1088 *THIS.pushRecordSet()
1089 lnOldSelect = Select()
1090
1091 SELECT (pcCostAlias)
1092 THIS.pushRecordSet()
1093 * --- TR 1045972 RLN 10/13/10
1094 *SCAN FOR fkey = pnPodtlPkey
1095 * Check For Fkey Index
1096 llTag = .F.
1097 FOR lnTag = 1 TO TAGCOUNT()
1098 lcExp = UPPER(ALLTRIM(TAG(lnTag)))
1099 llTag = lcExp == "FKEY"
1100 IF llTag
1101 EXIT
1102 ENDIF
1103 ENDFOR
1104
1105 IF llTag
1106 lcScanExp = "WHILE fkey = pnPodtlPkey"
1107 SET ORDER TO fkey
1108 =SEEK(pnPodtlPkey)
1109 ELSE
1110 lcScanExp = "FOR fkey = pnPodtlPkey"
1111 ENDIF
1112
1113 SCAN &lcScanExp
1114 * === TR 1045972
1115 *--- TR 1038235 9-FEB-2009 VKK
1116 IF VARTYPE(prv_cost_updt) = "C" AND prv_cost_updt = "Y"
1117 LOOP
1118 ENDIF
1119 *=== TR 1038235 9-FEB-2009 VKK
1120
1121 *--- TechRec 1004691 27-Apr-2004 GS ---
1122 *llRetVal = vl_dcatgr(category, "", "tcCatgr")
1123 *--- TechRec 1007154 07-Oct-2004 GS ---
1124 *-- Moved Down :
1125* lcCategory = Category
1126* llRetVal = Seek(lcCategory, This.cCatAlias)
1127 *=== TechRec 1007154 07-Oct-2004 GS ===
1128 *=== TechRec 1004691 27-Apr-2004 GS ===
1129
1130 *--- TAN 38028 03/21/03 AD
1131 * CB 5/23/03 (no TAN #) The following line had been removed, caused the cost sheet to lose costing
1132 * when constant was 0. Uncommented.
1133 *--- 1031261 04/08/08 SKG
1134*!* if AP_Cost = 'Y' and This.Set_AP_Cost(@pcCostAlias)
1135 *--- TechRec 1038308 16-Mar-2009 vkrishnamurthy ---
1136*!* if AP_Cost = 'Y' AND SUBSTR(PROGRAM(PROGRAM(-1)-2),24,14)<>"APPROVEVOUCHER" and This.Set_AP_Cost(@pcCostAlias)
1137
1138
1139*--- TR 1046287 10/22/10 AZ bypass calling set_ap_cost function when we came here from aprove voucher or from proration and ap_cost flag is Y
1140
1141* if AP_Cost = 'Y' AND SUBSTR(PROGRAM(PROGRAM(-1)-2),24,14)<>"APPROVEVOUCHER" and This.Set_AP_Cost(@pcCostAlias,tcProdCnclDtl)
1142 *=== TechRec 1038308 16-Mar-2009 vkrishnamurthy ===
1143
1144 *=== 1031261 04/08/08 SKG
1145* loop
1146* EndIf
1147
1148 LOCAL ix,nlevel
1149 IF AP_Cost = 'Y'
1150 nlevel = PROGRAM(-1)
1151 FOR ix = nlevel TO 1 STEP -1
1152 IF ATC("APPROVEVOUCHER",PROGRAM(ix)) > 0 OR ATC("PRORATEPRODUCTIONTREES",PROGRAM(ix)) > 0
1153 EXIT
1154 ENDIF
1155 NEXT
1156 IF ix <= 1
1157 This.Set_AP_Cost(@pcCostAlias,tcProdCnclDtl)
1158 ENDIF
1159 LOOP
1160 ENDIF
1161*=== TR 1046287 10/22/10 AZ
1162
1163 *--- TAN 38860 06-Jun-2003 GS ---
1164 *--- TR 1026247 8-Aug-2007 Goutam
1165 *IF !EMPTY(constant) && constant.
1166 *--- 1029808 01-09-2008 SKG
1167*!* IF !EMPTY(constant) OR (Category = .cMassUpdateCostCategory)
1168 IF !EMPTY(constant) OR (Category == .cMassUpdateCostCategory)
1169 *=== 1029808 01-09-2008 SKG
1170 *=== TR 1026247 8-Aug-2007 Goutam
1171
1172 *IF !EMPTY(constant) or (Empty(constant) and Empty(formula))
1173 *=== TAN 38860 06-Jun-2003 GS ===
1174 * ATS 4359, do not override import tracking with constant.
1175 * i.e. import tracking will use constant if it is prorated to 0.
1176 *IF tcCatgr.imp_tracking # "Y" OR extension = 0
1177
1178 * --- 1001996 11/03 CB If this was set by AP, don't overwrite cost.
1179 *IF EVALUATE(pcCostAlias + ".AP_Cost") <> "Y"
1180 IF AP_Cost # "Y"
1181 IF imp_cost # "Y" OR extension = 0
1182 lnCost = Constant
1183 REPLACE Category_Cost WITH Constant, Extension WITH Constant * pnQty IN (pcCostAlias)
1184 *--- TechRec 1003897 26-Mar-2004 GS ---
1185 if Imp_Cost # 'Y'
1186 replace Estm_Ext_Cost with Extension
1187
1188 *--- 1012294 KISHOR 2-AUG-2006
1189 IF This.lOptimizedRecalc AND THIS.lDynamicsPrepped
1190 replace modified WITH 'Y'
1191 ENDIF
1192 *=== 1012294 KISHOR 2-AUG-2006
1193
1194 endif
1195 *=== TechRec 1003897 26-Mar-2004 GS ===
1196 ENDIF
1197 ENDIF
1198 * === 1001996 11/03 CB End.
1199 *--- TechRec 1007154 07-Oct-2004 GS ---
1200 ELSE
1201 If This.lER_Lookup
1202 lcCategory = Category
1203 if Seek(lcCategory, This.cCatAlias)
1204 select (This.cCatAlias)
1205 lcCategory = AllTrim(Cost_Type)
1206 select (pcCostAlias)
1207 if lcCategory == This.cCN_ER_LOOKUP
1208 if This.lLast_Stage
1209 replace Constant with Category_Cost, ;
1210 Extension with 0, Estm_Ext_Cost with 0 in (pcCostAlias)
1211 else
1212 lnExRate = vl_ExRate("","EXH_RATE")
1213 If Empty(lnExRate) &&We don't know what will be return by vl call
1214 lnExRate = 0
1215 Endif
1216 replace Category_Cost WITH lnExRate, ;
1217 Extension with 0, Estm_Ext_Cost with 0 in (pcCostAlias)
1218 endif
1219 endif
1220 EndIf
1221 EndIf
1222 *=== TechRec 1007154 07-Oct-2004 GS ===
1223
1224 ENDIF
1225
1226 *--- TechRec 1004691 27-Apr-2004 GS ---
1227*!* *=== TAN 38028 03/21/03 AD
1228*!* * check if this is one of the 4 types required.
1229
1230*!* DO CASE
1231*!* CASE tcCatgr.cost_type = This.cCN_DUTY_VALUE
1232*!* paCost[DUTY_] = &pcCostAlias..category_cost
1233*!* CASE tcCatgr.cost_type = This.cCN_PROD_VALUE
1234*!* paCost[PRODUCTION_] = &pcCostAlias..category_cost
1235*!* CASE tcCatgr.cost_type = This.cCN_TOTAL_MATERIAL
1236*!* paCost[MATERIAL_] = &pcCostAlias..category_cost
1237*!* CASE tcCatgr.cost_type = This.cCN_TOTAL_COST
1238*!* paCost[TOTAL_COST_] = &pcCostAlias..category_cost
1239*!* * ATS 4752, remove dutiable cost category attribute
1240*!* *!* CASE tcCatgr.cost_type = CN_DUTIABLE_VALUE && ATS 4634, dutiable value
1241*!* *!* paCost[DUTIABLE_] = &pcCostAlias..category_cost
1242*!* *--- TAN 33059 Ilya:
1243*!* CASE tcCatgr.cost_type = This.cCN_COMMISSION
1244*!* paCost[COMMISSION_] = &pcCostAlias..category_cost
1245*!* *=== TAN 33059 Ilya
1246*!* ENDCASE
1247 *=== TechRec 1004691 27-Apr-2004 GS ===
1248 ENDSCAN
1249
1250 THIS.popRecordSet()
1251 *THIS.popRecordSet()
1252 Select(lnOldSelect)
1253 RETURN
1254
1255 ENDPROC
1256
1257* PL 3/28/02 blockout and use new MultiLevelCostFromBOM
1258*!* *-------------------------------------------------------------------------------------------------------------------------
1259*!* * 05/05/2000 ATS3847, calculate cost from bom
1260*!* PROCEDURE costfrombom
1261*!* LPARAMETER pcCostAlias, pnPodtlPkey, pnqty
1262*!* LOCAL lncost, lnExtension, lcCmp_type, lcCost_type, lcBOM_Dutiable, lnRecNo, llRetVal
1263*!* THIS.pushRecordSet()
1264*!* SELECT (pcCostAlias)
1265*!* SCAN FOR fkey = pnPodtlPkey
1266*!* ** ATS 4634, BOM Dutiable enhancement
1267*!* llRetVal = !EMPTY(category) AND vl_dcatgr(category, "", "tcCategory") && ATS 4634
1268*!* IF llRetVal
1269*!* lcCmp_type = tcCategory.cmp_type
1270*!* lcCost_type = tcCategory.cost_type
1271*!* lcBOM_Dutiable = tcCategory.BOM_Dutiable
1272*!* SELECT tmpCostBom && tmp bom reference for costing, no need to keep track current records.
1273*!* IF !EMPTY(lcCmp_type) AND lcCmp_type # RSV_ALL && from BOM
1274*!* CALCULATE SUM(trxusage * rm_cost) TO lnExtension FOR cmp_type = lcCmp_type AND cost_ok = "Y" ;
1275*!* AND (dutiable = lcBOM_Dutiable OR lcBOM_Dutiable = "B") && ATS 4634 dutiable bom
1276*!* lncost = lnExtension / MAX(pnqty, 1)
1277*!* REPLACE category_cost WITH lncost, extension WITH lnExtension IN (pcCostAlias)
1278*!* ENDIF
1279*!* USE IN tcCategory
1280*!* ENDIF
1281*!* ENDSCAN
1282*!* THIS.popRecordSet()
1283*!* RETURN
1284*!* ENDPROC
1285
1286* PL 3/28/02 blockout and use new MultiLevelCostFromBOM2
1287*!* *-------------------------------------------------------------------------------------------------------------------------
1288*!* * 05/05/00 ATS 3847, calculate cost from bom, catch all.
1289*!* * 10/25/00 ATS 4673, three possiable 'catch all', 1. dutiable catch all, 2 non-dutiable catch all,
1290*!* * 3. both
1291*!* PROCEDURE costfrombom2
1292*!* LPARAMETER pcCostAlias, pnPodtlPkey, pnqty
1293*!* LOCAL lncost, lnTotalBomCost, lnTotalDutiableBOM, lnTotalNonDutiableBom, ;
1294*!* lnExtension, lnExtension2, lcCmp_type, lnRecNo, llRetVal, lcBOM_Dutiable && ats 4673
1295*!* lnExtension = 0
1296*!* THIS.pushRecordSet()
1297*!* * 10/25/00 ATS 4673, get three type of bom costs.
1298*!* SELECT tmpCostBom
1299*!* CALCULATE SUM(trxusage * rm_cost) TO lnTotalBomCost FOR cost_ok = "Y"
1300*!* CALCULATE SUM(trxusage * rm_cost) TO lnTotalDutiableBOM FOR cost_ok = "Y" AND dutiable = 'Y'
1301*!* CALCULATE SUM(trxusage * rm_cost) TO lnTotalNonDutiableBom FOR cost_ok = "Y" AND dutiable = 'N'
1302*!* * now look for each type of cath all
1303*!* SELECT (pcCostAlias)
1304*!* SCAN FOR fkey = pnPodtlPkey
1305*!* lcCategory = category
1306*!* lcCmp_type = cmp_type
1307*!* lcBOM_Dutiable = BOM_Dutiable
1308*!* IF !EMPTY(lcCmp_type) AND RTRIM(lcCmp_type) == RSV_ALL && from BOM, catch all
1309*!* lnRecNo = RECNO()
1310*!* DO CASE
1311*!* CASE lcBOM_Dutiable = "Y"
1312*!* CALCULATE SUM(extension) TO lnExtension2 ;
1313*!* FOR !EMPTY(cmp_type) AND RTRIM(cmp_type) # RSV_ALL AND ;
1314*!* category # lcCategory AND BOM_Dutiable = "Y" AND fkey = pnPodtlPkey
1315*!* lnExtension = lnTotalDutiableBOM - lnExtension2
1316*!* CASE lcBOM_Dutiable = "N"
1317*!* CALCULATE SUM(extension) TO lnExtension2 ;
1318*!* FOR !EMPTY(cmp_type) AND RTRIM(cmp_type) # RSV_ALL AND ;
1319*!* category # lcCategory AND BOM_Dutiable = "N" AND fkey = pnPodtlPkey
1320*!* lnExtension = lnTotalNonDutiableBom - lnExtension2
1321*!* CASE lcBOM_Dutiable = "B"
1322*!* CALCULATE SUM(extension) TO lnExtension2 ;
1323*!* FOR !EMPTY(cmp_type) AND RTRIM(cmp_type) # RSV_ALL AND ;
1324*!* category # lcCategory AND fkey = pnPodtlPkey
1325*!* lnExtension = lnTotalBomCost - lnExtension2
1326*!* OTHER
1327*!* lnExtension = 0
1328*!* ENDCASE
1329*!* lncost = lnExtension / MAX(pnqty, 1)
1330*!* GO lnRecNo IN (pcCostAlias)
1331*!* REPLACE category_cost WITH lncost, extension WITH lnExtension IN (pcCostAlias)
1332*!* ENDIF
1333*!* ENDSCAN
1334*!* THIS.popRecordSet()
1335*!* RETURN
1336*!* ENDPROC
1337
1338 *-------------------------------------------------------------------------------------------------
1339 * 05/05/2000 ATS3847, cost by formula
1340 PROCEDURE CostByFormula
1341
1342 LPARAMETER pcCostAlias, pnPodtlPkey, pnqty, paCost, plSkipDuty
1343
1344 * --- 1003958 04/04 CB - Optimized Cost Recalc.
1345 * NOTE: ANY CHANGES MADE TO THIS ROUTINE MUST BE DUPLICATED IN ITS OPTIMIZED _2 EQUIVALENT!
1346 WITH THIS
1347 IF .lOptimizedRecalc AND .lDynamicsPrepped
1348 .CostByFormula_2(pcCostAlias, pnPODtlPKey, pnQty, plSkipDuty) && Get cost by formula
1349 RETURN
1350 ENDIF
1351 ENDWITH
1352 * === 1003958 End.
1353
1354 EXTERNAL ARRAY paCost
1355
1356 LOCAL lncost, lnExtension, lcProd, lcHSDuty, lnprodCost, llRetVal, ;
1357 lnHSLookupRec, lnDutyRec, lnTotalCostRec, lnHsLookupAmount, lnExRate, lcCost_Type
1358 *--- TechRec 1011441 30-Jun-2005 GS ---
1359 Local lnExtensionEstm
1360 *--- TechRec 1011441 30-Jun-2005 GS ---
1361 lnHsLookupAmount = 0
1362 THIS.pushRecordSet()
1363
1364 *---- 40860 CB 7/03 - Added plSkipDuty so as not to overwrite actual duty value with formula calculation.
1365 plSkipDuty = IIF(EMPTY(plSkipDuty), false, plSkipDuty)
1366 *==== 40860 CB.
1367
1368 SELECT (pcCostAlias)
1369 THIS.pushRecordSet()
1370
1371 *-- TR 1011441 MA 06/22/05
1372 local oCostEstm
1373 oCostEstm = CreateObject("CostEstm", .NULL.)
1374 *== TR 1011441 MA 06/22/05
1375
1376 * do formula
1377 * --- TR 1045972 RLN 10/13/10
1378 *SCAN FOR fkey = pnPodtlPkey
1379 llTag = .F.
1380 FOR lnTag = 1 TO TAGCOUNT()
1381 lcExp = UPPER(ALLTRIM(TAG(lnTag)))
1382 llTag = lcExp == "FKEY"
1383 IF llTag
1384 EXIT
1385 ENDIF
1386 ENDFOR
1387
1388 IF llTag
1389 lcScanExp = "WHILE fkey = pnPodtlPkey"
1390 SET ORDER TO fkey
1391 =SEEK(pnPodtlPkey)
1392 ELSE
1393 lcScanExp = "FOR fkey = pnPodtlPkey"
1394 ENDIF
1395 lnLastCost = 0
1396 lcLastKey = "-----------------"
1397
1398 SCAN &lcScanExp
1399 * === TR 1045972
1400 *---Tan34434 HH 09/26/02
1401
1402 *--- TR 1038235 9-FEB-2009 VKK
1403 IF VARTYPE(prv_cost_updt) = "C" AND prv_cost_updt = "Y"
1404 LOOP
1405 ENDIF
1406 *=== TR 1038235 9-FEB-2009 VKK
1407
1408 *--- TechRec 1004691 27-Apr-2004 GS --- Optimization
1409 lcCost_Type = Category
1410 select (This.cCatAlias)
1411 =Seek(lcCost_Type)
1412 lcCost_Type = AllTrim(Cost_Type)
1413 select (pcCostAlias)
1414 *IF EMPTY(formula) And vl_dcatgr(category, "", "tcCatgr")
1415 * If Allt(tcCatgr.Cost_Type)==This.cCN_ER_LOOKUP
1416 IF Empty(Formula)
1417 *--- TechRec 1007154 07-Oct-2004 GS ---
1418 * Moved everything to CostFromConstant
1419 *=== TechRec 1007154 07-Oct-2004 GS ===
1420
1421 ELSE
1422 *===Tan34434 HH
1423
1424 *IF !EMPTY(Formula) && AND formula # "IMPORT TRACKING" && formula, no import tracking
1425
1426 *llRetVal = vl_dcatgr(category, "", "tcCatgr")
1427 *--- TechRec 1004691 27-Apr-2004 GS ---
1428 * total material, prod value, hs lookup, duty, total cost. Must by this sequence.
1429 * very important.
1430 * ATS4734, import tracking now has formula/
1431 *--- TAN 33059 Ilya: Added CN_COMMISSION to the INLIST():
1432 *--- TAN 36566 02/07/03 AD
1433 *--- TAN 37481 03/14/03 CB
1434 *- Do not overwrite prorated shipment cost
1435*!* IF llRetVal AND (!INLIST(tcCatgr.cost_type,This.cCN_HS_LOOKUP,This.cCN_COMMISSION) or ; && harmonized duty lookup
1436*!* (tcCatgr.imp_tracking = "Y" AND extension = 0)) && import tracking
1437*!* IF llRetVal .AND. ;
1438*!* !INLIST(tcCatgr.cost_type,This.cCN_HS_LOOKUP,This.cCN_COMMISSION) .AND. ;
1439*!* !(tcCatgr.imp_tracking = "Y" .AND. Imp_Cost = 'Y' .AND. extension <> 0) && import tracking
1440
1441 *--- TechRec 1003897 29-Mar-2004 GS ---
1442*!* IF llRetVal .AND. ;
1443*!* !INLIST(tcCatgr.cost_type,This.cCN_HS_LOOKUP,This.cCN_COMMISSION) .AND. ;
1444*!* !(tcCatgr.imp_tracking = "Y" .AND. (Imp_Cost = 'Y' .OR. AP_Cost = 'Y') .AND. extension <> 0) && import tracking
1445
1446 *IF llRetVal and ;
1447 * !InList(tcCatgr.Cost_Type, This.cCN_HS_LOOKUP, This.cCN_COMMISSION) and ;
1448 * !((Imp_Cost = 'Y' or AP_Cost = 'Y') and Extension <> 0) && import tracking
1449 *=== TechRec 1003897 29-Mar-2004 GS ===
1450
1451 * ---- 40860 CB Recalculate, unless it's DUTY and plSkipDuty is true. If we sent
1452 * an actual duty value, don't want to overwrite with formula calculation.
1453 * IF NOT (tcCatgr.cost_type = This.cCN_DUTY_VALUE) OR NOT plSkipDuty
1454
1455 * --- 1005369 Fix broken code below:
1456* IF !Empty(lcCost_Type) and ;
1457* !InList(lcCost_Type, This.cCN_HS_LOOKUP, This.cCN_COMMISSION) and ;
1458* !((Imp_Cost = 'Y' or AP_Cost = 'Y') and Extension <> 0) && import tracking
1459
1460 IF UPPER(lcCost_Type) == This.cCN_HS_LOOKUP or UPPER(lcCost_Type) == This.cCN_COMMISSION or ;
1461 ((Imp_Cost = 'Y' or AP_Cost = 'Y') and Extension <> 0) ; && import tracking
1462 OR UPPER(lcCost_Type) == UPPER(This.cCN_MULTI_ROYALTY) ; &&--- TechRec 1058999 23-May-2012 jisingh ===
1463 OR UPPER(lcCost_Type) == UPPER(This.cCN_HS_FIXEDAMOUNT) && TR 1072967 26-SEP-13 Venuk
1464 * Do nothing.
1465 ELSE
1466 * === 1005369 end.
1467
1468 * ---- 40860 CB Recalculate, unless it's DUTY and plSkipDuty is true. If we sent
1469 * an actual duty value, don't want to overwrite with formula calculation.
1470 IF NOT (lcCost_Type = This.cCN_DUTY_VALUE) OR NOT plSkipDuty
1471 *=== TechRec 1004691 27-Apr-2004 GS ===
1472 *=== TAN 36566 02/07/03 AD
1473 *- TAN 29836 01/14/02 YIK
1474 *- Use new function evalCostFormula() to calculate cost.
1475 *- lnExtension = THIS.evalFormula(pcCostAlias, formula, pnPodtlPkey, category) && 11/17/00
1476 *- lncost = ROUND(lnExtension / MAX(pnqty, 1), round_to) && ATS 4691
1477 *--- TAN 1004047 03/10/04 AD
1478 *- Added Round_To
1479
1480 *-- TR 1011441 MA 06/22/05
1481 oCostEstm.nQty = pnQty
1482 * --- TR 1045972 RLN 03/15/10
1483 * lnCost = THIS.evalCostFormula(pcCostAlias, formula, pnPodtlPkey, category, round_to)
1484 IF formula + category = lcLastKey
1485 lnCost = lnLastCost
1486 ELSE
1487 lnCost = THIS.EvalCostFormula(pcCostAlias, Formula, pnPodtlPkey, Category, Round_To,,,oCostEstm)
1488 ENDIF
1489 lcLastKey = formula + category
1490 lnLastCost = lnCost
1491 * === TR 1045972
1492 *==TR 1011441 MA 06/22/05
1493
1494 *= TAN 29836 01/14/02 YIK
1495 *=== TAN 1004047 03/10/04 AD
1496
1497 lnExtension = lnCost * pnQty && restore extension after round to.
1498
1499 *-- TR 1011441 MA 06/22/05
1500 lnExtensionEstm = oCostEstm.nCostEstm * pnQty && restore esimate extension after round to.
1501 oCostEstm.nQty = .NULL.
1502 *==TR 1011441 MA 06/22/05
1503
1504
1505 * recording duty_value, pord_value, total_material and total_cost
1506
1507 *--- TechRec 1004691 27-Apr-2004 GS ---
1508*!* DO CASE
1509*!* * --- 1001996 11/03 CB If Production Value was set by AP, don't overwrite.
1510*!* CASE tcCatgr.cost_type = This.cCN_PROD_VALUE AND !(AP_Cost == 'Y')
1511*!* paCost[PRODUCTION_] = lncost
1512*!* CASE tcCatgr.cost_type = This.cCN_PROD_VALUE AND (AP_Cost == 'Y')
1513*!* paCost[PRODUCTION_] = Category_Cost
1514*!* * === 1001996 11/03 CB End.
1515*!* CASE tcCatgr.cost_type = This.cCN_TOTAL_MATERIAL
1516*!* paCost[MATERIAL_] = lncost
1517*!* CASE tcCatgr.cost_type = This.cCN_DUTY_VALUE
1518*!* paCost[DUTY_] = lncost && + lnHsLookupAmount 11/10/00
1519*!* CASE tcCatgr.cost_type = This.cCN_TOTAL_COST
1520*!* paCost[TOTAL_COST_] = lncost
1521*!* * ATS 4752, remove dutiable cost category attribute
1522*!* *!* CASE tcCatgr.cost_type = CN_DUTIABLE_VALUE && 10/20/00 ATS 4634, dutiable
1523*!* *!* paCost[DUTIABLE_] = lncost
1524
1525*!* *--- TAN 33059 Ilya:
1526*!* CASE tcCatgr.cost_type = This.cCN_COMMISSION
1527*!* paCost[COMMISSION_] = lncost
1528*!* *=== TAN 33059 Ilya:
1529
1530*!* ENDCASE
1531 *=== TechRec 1004691 27-Apr-2004 GS ===
1532
1533 * --- 1001996 11/03 CB If this was set by AP, don't overwrite cost.
1534 IF EVALUATE(pcCostAlias + ".AP_Cost") <> "Y"
1535 REPLACE Category_Cost WITH lnCost, Extension WITH lnExtension IN (pcCostAlias)
1536 *--- TechRec 1003897 26-Mar-2004 GS ---
1537 if Imp_Cost # 'Y'
1538 *-- TR 1011441 MA 06/22/05
1539 * replace Estm_Ext_Cost with Extension
1540 REPLACE Estm_Ext_Cost WITH lnExtensionEstm
1541 *==TR 1011441 MA 06/22/05
1542
1543 *--- 1012294 KISHOR 2-AUG-2006
1544 IF This.lOptimizedRecalc AND THIS.lDynamicsPrepped
1545 replace modified WITH 'Y'
1546 ENDIF
1547 *=== 1012294 KISHOR 2-AUG-2006
1548
1549 endif
1550 *=== TechRec 1003897 26-Mar-2004 GS ===
1551 ENDIF
1552 * === 1001996 11/03 CB End.
1553
1554 ENDIF
1555 * ==== 40860 Actual Duty don't overwrite TAN.
1556
1557 ENDIF
1558 ENDIF
1559 ENDSCAN
1560 THIS.popRecordSet()
1561 THIS.popRecordSet()
1562
1563 ENDPROC
1564 *-------------------------------------------------------------------------------------------------
1565 * 11/10/2000 ATS4748, cost of by formula
1566 PROCEDURE CostOfHSLookUp
1567
1568 LPARAMETER pcCostAlias, pnPodtlPkey, pnqty, plHsFixedAmount
1569
1570 *--- TR 1072967 26-SEP-13 Venuk. Added plHsFixedAmountparameter ====
1571 * --- 1003958 05/04 CB - Optimized recalcs.
1572 * NOTE: ANY CHANGES MADE TO THIS ROUTINE MUST BE DUPLICATED IN ITS OPTIMIZED _2 EQUIVALENT!
1573 WITH THIS
1574 IF .lOptimizedRecalc AND .lDynamicsPrepped
1575 .CostOfHSLookup_2(pcCostAlias, pnPODtlPKey, pnQty)
1576 .CostOfHSLookup_2(pcCostAlias, pnPODtlPKey, pnQty, true) && TR 1072967 26-SEP-13 Venuk for hs fixed amt
1577 RETURN
1578 ENDIF
1579 ENDWITH
1580 * === 1003958 End.
1581
1582 *--- TR 1059112 09/22/11 AZ
1583 Local lnExtensionEstm, oCostEstm
1584 oCostEstm = CreateObject("CostEstm", .NULL.)
1585 *=== TR 1059112 09/22/11 AZ
1586
1587
1588 LOCAL lncost, lnExtension, llRetVal, lnHS_Base, lcCategory
1589
1590 THIS.pushRecordSet()
1591 SELECT (pcCostAlias)
1592 THIS.pushRecordSet()
1593 *--- TechRec 1014674 03-Jan-2006 GS ---
1594 local lcDesign_Num
1595 if Type(pcCostAlias + ".DESIGN_NUM") = "C"
1596 lcDesign_Num = Design_Num
1597 else
1598 lcDesign_Num = ""
1599 endif
1600 *=== TechRec 1014674 03-Jan-2006 GS ===
1601
1602 * --- TR 1045972 RLN 10/13/10
1603 *SCAN FOR fkey = pnPodtlPkey
1604 llTag = .F.
1605 FOR lnTag = 1 TO TAGCOUNT()
1606 lcExp = UPPER(ALLTRIM(TAG(lnTag)))
1607 llTag = lcExp == "FKEY"
1608 IF llTag
1609 EXIT
1610 ENDIF
1611 ENDFOR
1612
1613 IF llTag
1614 lcScanExp = "WHILE fkey = pnPodtlPkey"
1615 SET ORDER TO fkey
1616 =SEEK(pnPodtlPkey)
1617 ELSE
1618 lcScanExp = "FOR fkey = pnPodtlPkey"
1619 ENDIF
1620
1621 SCAN &lcScanExp
1622 * === 1045972
1623
1624 *--- TR 1038235 9-FEB-2009 VKK
1625 IF VARTYPE(prv_cost_updt) = "C" AND prv_cost_updt = "Y"
1626 LOOP
1627 ENDIF
1628 *=== TR 1038235 9-FEB-2009 VKK
1629
1630 *--- TR 1059112 09/22/11 AZ
1631 oCostEstm.nQty = pnQty
1632 *=== TR 1059112 09/22/11 AZ
1633
1634
1635 *--- TechRec 1004691 27-Apr-2004 GS ---
1636 *llRetVal = vl_dcatgr(&pcCostAlias..category, "", "tmpCursor")
1637 *IF llRetVal AND tmpCursor.cost_type = This.cCN_HS_LOOKUP
1638 lcCategory = Category
1639 llRetVal = Seek(lcCategory, This.cCatAlias)
1640
1641 *--- TR 1072967 26-SEP-13 Venuk
1642 *IF llRetVal and Evaluate(This.cCatAlias + ".Cost_Type") = This.cCN_HS_LOOKUP
1643 IF llRetVal and ((Evaluate(This.cCatAlias + ".Cost_Type") = This.cCN_HS_LOOKUP and !plHsFixedAmount) ;
1644 OR Evaluate(This.cCatAlias + ".Cost_Type") = This.cCN_HS_FIXEDAMOUNT and plHsFixedAmount)
1645 *=== TR 1072967 26-SEP-13 Venuk
1646 *=== TechRec 1004691 27-Apr-2004 GS ===
1647
1648 DO CASE
1649 CASE !EMPTY(constant)
1650 lnHS_Base = constant
1651 CASE !EMPTY(formula)
1652 *- TAN 29836 01/14/02 YIK
1653 *- Use new function evalCostFormula() to calculate cost.
1654 *- lnExtension = THIS.evalFormula(pcCostAlias, formula, pnPodtlPkey, category) && 11/17/00
1655 *- lnHS_Base = ROUND(lnExtension / MAX(pnqty, 1), round_to) && ATS 4691
1656 *--- TAN 1004047 03/10/04 AD
1657 *- Added Round_To
1658 *--- TechRec 1059112 16-Aug-2012 AZhadanov ---
1659* lnHS_Base = THIS.EvalCostFormula(pcCostAlias, formula, pnPodtlPkey, category, round_to)
1660 lnHS_Base = THIS.EvalCostFormula(pcCostAlias, formula, pnPodtlPkey, category, round_to,,,oCostEstm)
1661 *=== TechRec 1059112 16-Aug-2012 AZhadanov ===
1662
1663 *= TAN 29836 01/14/02 YIK
1664 *=== TAN 1004047 03/10/04 AD
1665 lnExtension = lnHS_Base * pnqty && restore extension after round to.
1666 OTHER
1667 lnHS_Base = 0
1668 ENDCASE
1669
1670 *--- TechRec 1014674 03-Jan-2006 GS ---
1671 *lnCost = THIS.getHSDuty(Division, Style, Color_Code, ;
1672 Lbl_Code, Dimension, lnHS_Base, pnPodtlPkey)
1673 *--- TR 1072967 26-SEP-13 Venuk. Added empty param and plHsFixedAmount ===
1674 lnCost = THIS.getHSDuty(Division, Style, Color_Code, ;
1675 Lbl_Code, Dimension, lnHS_Base, pnPodtlPkey, ,lcDesign_Num, ,plHsFixedAmount)
1676 *=== TechRec 1014674 03-Jan-2006 GS ===
1677
1678 *--- TechRec 1059112 16-Aug-2012 AZhadanov ---
1679 *--- TR 1072967 26-SEP-13 Venuk. Added Added empty param and plHsFixedAmount ===
1680 lnCostEstm = THIS.getHSDuty(Division, Style, Color_Code, ;
1681 Lbl_Code, Dimension, oCostEstm.nCostEstm, pnPodtlPkey, ,lcDesign_Num, ,plHsFixedAmount)
1682 *=== TechRec 1059112 16-Aug-2012 AZhadanov ===
1683
1684 *--- TAN 1004047 03/10/04 AD
1685 *--- 1032759 04/22/2008 SKG
1686*!* lnCost = ROUND(lnCost, Round_To)
1687 lnCost = ROUND(lnCost, 5)
1688 *=== 1032759 04/22/2008 SKG
1689 *=== TAN 1004047 03/10/04 AD
1690
1691 *--- TechRec 1059112 16-Aug-2012 AZhadanov ---
1692 lnCostEstm = ROUND(lnCostEstm,5)
1693 *=== TechRec 1059112 16-Aug-2012 AZhadanov ===
1694
1695
1696 lnExtension = lnCost * pnQty
1697 lnExtensionEstm = lnCostEstm * pnQty &&& 1059112
1698
1699 * 37776 CB DUTY is now included on AP Vouchers. Don't replace this value if
1700 * AP_Cost has already been set.
1701 If AP_Cost <> 'Y'
1702 REPLACE Category_Cost WITH lnCost, Extension WITH lnExtension IN (pcCostAlias)
1703 *--- TechRec 1003897 26-Mar-2004 GS ---
1704 if Imp_Cost # 'Y'
1705 *--- TechRec 1059112 16-Aug-2012 AZhadanov ---
1706* replace Estm_Ext_Cost with Extension
1707 replace Estm_Ext_Cost with lnExtensionEstm &&& 1059112
1708 *=== TechRec 1059112 16-Aug-2012 AZhadanov ===
1709
1710 *--- 1012294 KISHOR 2-AUG-2006
1711 IF This.lOptimizedRecalc AND THIS.lDynamicsPrepped
1712 replace modified WITH 'Y'
1713 ENDIF
1714 *=== 1012294 KISHOR 2-AUG-2006
1715
1716 endif
1717 *=== TechRec 1003897 26-Mar-2004 GS ===
1718 EndIf
1719 ENDIF
1720 ENDSCAN
1721 THIS.popRecordSet()
1722 THIS.popRecordSet()
1723
1724 ENDPROC
1725
1726 *-------------------------------------------------------------------------------------------------------------------------
1727 * 05/05/2000 ATS3847, evalulate cost formula
1728 PROCEDURE EvalFormula
1729 LPARAMETERS pcCostAlias, pcFormula, pnPodtlPkey, pcCategory &&, pnRound_to && ATS 4691, round()
1730
1731 LOCAL lcString, lnxx, lcToken, lnPos, lcSelect, llRetVal, ;
1732 lnRecNo, lcDtlNo, lcMsgString, lntk, lncost
1733 DIMENSION laToken[1]
1734 THIS.pushRecordSet()
1735
1736 llRetVal = .T.
1737 lcString = pcFormula
1738 lcString = STRTRAN(lcString, '(', ' ( ') && insert blanks around '('
1739 lcString = STRTRAN(lcString, ')', ' ) ') && insert blanks around ')'
1740 lcString = STRTRAN(lcString, '/', ' / ') && insert blanks around '/'
1741 lcString = STRTRAN(lcString, '*', ' * ') && insert blanks around '*'
1742 lcString = STRTRAN(lcString, '-', ' - ') && insert blanks around '-'
1743 lcString = STRTRAN(lcString, '+', ' + ') && insert blanks around '+'
1744 lcString = lcString + " "
1745
1746 lcToken = ""
1747 lncost = 0
1748
1749 SELECT (pcCostAlias)
1750 * tokenize formula string into array, so that we can check for variable (category)
1751 StringToArray(lcString, @laToken, " ")
1752 FOR lnxx = 1 TO ALEN(laToken)
1753 lcToken = laToken[lnxx]
1754 *--- TAN 35242 10/31/02 AD
1755 *FOR lntk = 1 TO LEN(lcToken)
1756 * decide if this token is a variable filed.
1757 IF BETWEEN(SUBSTR(lcToken, 1, 1), "A", "Z")
1758 * --- 1003958 CB 04/04 Optimized cost recalc. Use index:
1759 IF THIS.lOptimizedRecalc AND THIS.lDynamicsPrepped
1760 =SEEK(PADR(lcToken,6) + STR(pnPodtlPkey), THIS.cCstAlias, 'CatFKey')
1761 ELSE
1762 LOCATE FOR category == PADR(lcToken,6) AND fkey = pnPodtlPkey
1763 ENDIF
1764 * === 1003958 End.
1765
1766 IF FOUND()
1767 laToken[lnxx] = STR(extension, 14, 5) && replace category with extension
1768 ENDIF
1769 ENDIF
1770 * EXIT
1771 *ENDFOR
1772 ENDFOR
1773
1774 * construct string from array
1775 lcString = ArrayToString(@laToken, " ")
1776
1777 lcError = ON("ERROR")
1778
1779 *--- TechRec 1049776 08-Dec-2010 asharma ---
1780 * llRetVal working fine in Dev Environment but not in EXE
1781*!* ON ERROR llRetVal = .F.
1782 llTempRetVal = llRetVal
1783 ON ERROR llTempRetVal = .F.
1784 *=== TechRec 1049776 08-Dec-2010 asharma ===
1785
1786 TRY &&--- TechRec 1074785 21-Nov-2013 asharma ===
1787 lncost = EVAL(lcString)
1788 *--- TechRec 1074785 21-Nov-2013 asharma ---
1789 CATCH
1790 llTempRetVal = .F.
1791 ENDTRY
1792 *=== TechRec 1074785 21-Nov-2013 asharma ===
1793
1794 ON ERROR &lcError && restore system error handler
1795
1796 *--- TechRec 1049776 08-Dec-2010 asharma ---
1797 llRetVal = llTempRetVal
1798 *=== TechRec 1049776 08-Dec-2010 asharma ===
1799
1800 IF !llRetVal
1801 lcMsgString = "Category " + pcCategory + "contains invalid formula: " + MESSAGE()
1802 ELSE
1803 IF lncost > 1000000000000 OR lncost < -1000000000000
1804 llRetVal = .F.
1805 lcMsgString ="Category " + pcCategory + "contains invalid formula: Divided by zero."
1806 ENDIF
1807 ENDIF
1808
1809 IF !llRetVal
1810 *--- TAN 34262 09/25/02 AD
1811 *- Do not display the message for rollup
1812 IF !This.lRollUpCost
1813 *--- TechRec 1045741 29-Sep-2010 jjanand ---
1814 *mb(lcMsgString + CHR(13) + "Formula: " + TRIM(pcFormula) + ;
1815 CHR(13) + "Resolved to: " + TRIM(lcString))
1816 lcMsgString = lcMsgString + CHR(13) + "Formula: " + TRIM(pcFormula) + ;
1817 CHR(13) + "Resolved to: " + TRIM(lcString)
1818 IF This.lscheduled
1819* IF This.lEnableDebugging &&& 1078623
1820 IF TYPE ("this.olog") = "O" &&& 1078623
1821 This.oLog.LogEntry(lcMsgString)
1822 ENDIF
1823 ELSE
1824 mb(lcMsgString)
1825 ENDIF
1826 *=== TechRec 1045741 29-Sep-2010 jjanand ===
1827
1828 *--- TechRec 1049776 08-Dec-2010 asharma ---
1829 IF THIS.lAutoCreateCostSheet
1830 This.cMessage = lcMsgString
1831 ENDIF
1832 *=== TechRec 1049776 08-Dec-2010 asharma ===
1833
1834 ENDIF
1835 *=== TAN 34262 09/25/02 AD
1836 lncost = 0
1837 ENDIF
1838
1839 THIS.popRecordSet()
1840
1841 RETURN lncost
1842
1843 ENDPROC
1844 *-------------------------------------------------------------------------------
1845 * 04/19/2000 ATS3783, ATS3847 Costing, get HS duty amount
1846 PROCEDURE GetHSDuty
1847
1848 LPARAMETERS pcDivision, pcStyle, pcColor_code, pcLbl_Code, pcDimension, ;
1849 pnValue, pnPoDtlKey, pcContractor;
1850 , pcDesign_Num ; &&--- TechRec 1014674 03-Jan-2006 GS ---
1851 , pcShipTo ; &&--- TR 1059508 03-02-2012 RKI/Neil pcShiptTo Added.
1852 , plHsFixedAmount &&--- TR 1072967 26-SEP-13 Venuk
1853
1854 LOCAL llRetVal, lcHS_Num, lcCountry, lnTotalDuty, lcWgt_UOM, ;
1855 lnGar_Wgt, lnGar_DutywgtAmt, lcToCountry, lcShipto
1856
1857 *--- TR 1051666 11-1-2011 VKK
1858 LOCAL lcToRegion
1859 lcToRegion = ""
1860 *=== TR 1051666 11-1-2011 VKK
1861
1862 * --- 1000766 09-SEP-2003 PV
1863
1864 LOCAL lnGar_Dutywgt, lnUOM_Factor, lcUOM_Factor
1865 lnUOM_Factor = 0
1866 lcUOM_Factor = ""
1867 lnGar_Dutywgt = 0
1868 lcHS_Num = ''
1869 lcWgt_UOM = ''
1870 lnGar_Wgt = 0
1871 lnGar_DutywgtAmt = 0
1872
1873 * === 1000766 09-SEP-2003 PV
1874
1875 lcCountry = ""
1876 lcToCountry = ""
1877 lcShipto = ""
1878 lnTotalDuty = 0
1879
1880 * --- 1000766 02-OCT-2003 PV/RRB/AD
1881 * --- 1000766 Resolve all style/color variables independently - RRB/AD.
1882*!* * get HS number from zzxscolr
1883*!* lnHS_Num = vl_scold(pcDivision, "HS_Num", "HS_Num", pcStyle, pcColor_code, ;
1884*!* pcLbl_Code, pcDimension)
1885
1886*!* IF EMPTY(lnHS_Num) && TAN 26826
1887*!* * get HS number from zzxsstylr
1888*!* * --- 1000766 09-SEP-2003 PV Added The Hs_num Alias
1889*!* lnHS_Num = vl_stylr(pcDivision, "HS_Num", "HS_Num", pcStyle)
1890*!* ENDIF
1891
1892 *--- TechRec 1007222 11-Nov-2004 GS ---
1893 *--- This was a bad thing, because if pcColor_code was blank on the subsequent
1894 *--- procedure call vl_scold(..) did not execute SQL but the "tcHS_Scolr" cursor
1895 *--- was not closed and contained Prev SH Number which was used for calculations!!!!!
1896
1897*!* =vl_scold(pcDivision, "", "tcHS_Scolr", pcStyle, pcColor_code, pcLbl_Code, pcDimension)
1898*!* =vl_stylr(pcDivision, "", "tcHS_Stylr", pcStyle)
1899
1900*!* * --- TR 1001494 UB - to make sure tcHS_Scolr & tcHS_Stylr are used
1901*!* * lcHS_Num = IIF(EMPTY(tcHS_Scolr.HS_Num), tcHS_Stylr.HS_Num, tcHS_Scolr.HS_Num)
1902*!* * lcWgt_UOM = IIF(EMPTY(tcHS_Scolr.Wgt_UOM), tcHS_Stylr.Wgt_UOM, tcHS_Scolr.Wgt_UOM)
1903*!* * lnGar_Wgt = IIF(EMPTY(tcHS_Scolr.Gar_Wgt), tcHS_Stylr.Gar_Wgt, tcHS_Scolr.Gar_Wgt)
1904
1905*!* IF USED("tcHS_Scolr") AND RECCOUNT("tcHS_Scolr") > 0
1906*!* lcHS_Num = tcHS_Scolr.HS_Num
1907*!* lcWgt_UOM = tcHS_Scolr.Wgt_UOM
1908*!* lnGar_Wgt = tcHS_Scolr.Gar_Wgt
1909*!* ENDIF
1910
1911*!* IF USED("tcHS_Stylr") AND RECCOUNT("tcHS_Stylr") > 0
1912*!* lcHS_Num = IIF(EMPTY(lcHS_Num), tcHS_Stylr.HS_Num, lcHS_Num)
1913*!* lcWgt_UOM = IIF(EMPTY(lcWgt_UOM), tcHS_Stylr.Wgt_UOM, lcWgt_UOM)
1914*!* lnGar_Wgt = IIF(EMPTY(lnGar_Wgt), tcHS_Stylr.Gar_Wgt, lnGar_Wgt)
1915*!* ENDIF
1916*!* * === TR 1001494 UB - to make sure tcHS_Scolr & tcHS_Stylr are used
1917*!* * === 1000766 02-OCT-2003 PV/RRB/AD
1918 local lnOldSelect
1919 lnOldSelect = Select()
1920
1921 v_SqlExec(;
1922 "select coalesce(NullIf(c.HS_Num, ''), s.HS_Num) as HS_Num,"+;
1923 " coalesce(NullIf(c.Wgt_UOM,''), s.Wgt_UOM) as Wgt_UOM,"+;
1924 " coalesce(NullIf(c.Gar_Wgt, 0), s.Gar_Wgt) as Gar_Wgt "+;
1925 " from zzxstylr s "+;
1926 " left join zzxscolr c "+;
1927 " on c.FKey = s.PKey "+;
1928 " and c.Color_Code = " + SqlFormatChar(pcColor_Code)+;
1929 " and c.Lbl_Code = " + SqlFormatChar(pcLbl_Code)+;
1930 " and c.Dimension = " + SqlFormatChar(pcDimension)+;
1931 " where s.Division = " + SqlFormatChar(pcDivision)+;
1932 " and s.Style = " + SqlFormatChar(pcStyle), "qHS_Number")
1933
1934 *--- TechRec 1014674 03-Jan-2006 GS ---
1935 if Used("qHS_Number") and Empty(qHS_Number.HS_Num) and !Empty(pcDesign_Num)
1936 v_SqlExec(;
1937 "select HS_Num,"+;
1938 SqlFormatChar(qHS_Number.Wgt_UOM) + " as Wgt_UOM,"+;
1939 SqlFormatNum(qHS_Number.Gar_Wgt, 3) + " as Gar_Wgt"+;
1940 " from zzxDzgnH d"+;
1941 " where d.Division = " + SqlFormatChar(pcDivision)+;
1942 " and d.Design_Num = " + SqlFormatChar(pcDesign_Num), "qHS_Number")
1943 endif
1944 *=== TechRec 1014674 03-Jan-2006 GS ===
1945
1946 if Used("qHS_Number") and RecCount("qHS_Number") > 0
1947 lcHS_Num = qHS_Number.HS_Num
1948 lcWgt_UOM = qHS_Number.Wgt_UOM
1949 lnGar_Wgt = qHS_Number.Gar_Wgt
1950 endif
1951
1952 Select (lnOldSelect)
1953
1954 *=== TechRec 1007222 11-Nov-2004 GS ===
1955
1956 * get Country for contractor from zzxlocar
1957 * decide which contracotr to use., vl lookup is okay in this case b/c
1958 * only one record per cost sheet will hit this point.
1959 IF TYPE("pcContractor") = "C" AND !EMPTY(pcContractor) && if contractor is passed, use it.
1960 lcCountry = vl_locar(pcContractor, "Country")
1961 ELSE
1962 IF !EMPTY(pnPoDtlKey)
1963 *--- TAN 1003995 03/08/04 AD
1964 *- Use "uncommitted" country from header view if exists
1965 IF USED('vzzcordrh') .AND. !EOF('vzzcordrh')
1966 lcCountry = vzzcordrh.country
1967 ELSE
1968 llRetVal = vl_cordrd(pnPoDtlKey, "", "tmpOrdcd")
1969 * 39796 Since we are not using location this can be removed
1970 * Removed by RRB/AD as part of 1000766
1971 *!* IF llRetVal AND tmpOrdcd.last_stage = "Y" && cann't use the location from last stage.
1972 *!* llRetVal = vl_cordrd(tmpOrdcd.parkey, "", "tmpOrdcd") && one stage up..
1973 *!* ENDIF
1974 *!*
1975 IF llRetVal
1976 * --- 39796 13-AUG-2003 PV
1977 lcCountry = vl_cordrh(tmpordcd.prod_num,"Country")
1978 * lcCountry = vl_locar(tmpOrdcd.Location, "Country")
1979 * === 39796 13-AUG-2003 PV
1980 ENDIF
1981 ENDIF
1982 *=== TAN 1003995 03/08/04 AD
1983 ENDIF
1984 ENDIF
1985
1986 IF !EMPTY(lcHS_Num) && ATS 4467, was error out b/c empty(lcHS_Num), 09/12/00
1987 *--- 1007898 12/06/04 Ilya: Resolutoin starts from detail level with to_country
1988 llRetVal = .F.
1989 *--- TR 1059508 03-02-2012 RKI/Neil ---*
1990 IF !EMPTY(pnPoDtlKey) OR NOT EMPTY(pcShipTo)
1991 lcShipto = ""
1992
1993 IF !EMPTY(pnPoDtlKey)
1994 IF USED('vzzcordrd') .AND. !EOF('vzzcordrd')
1995 SELECT vzzcordrd
1996 THIS.PushRecordSet()
1997 LOCATE FOR pkey = pnPoDtlKey
1998 IF FOUND()
1999 lcShipto = vzzcordrd.shipto
2000 ENDIF
2001 THIS.PopRecordSet()
2002 SELECT (lnOldSelect)
2003 ENDIF
2004 *=== TR 1059508 03-02-2012 RKI /Neil===*
2005 IF EMPTY(lcShipTo)
2006 lcShipTo = vl_cordrd(pnPoDtlKey, "shipto")
2007 ENDIF
2008 *--- TR 1059508 03-02-2012 RKI/Neil ---*
2009 ELSE &&NOT EMPTY(pcShipTo)
2010 * ShipTo was passed in
2011 lcShipTo = pcShipTo
2012
2013 ENDIF
2014 *=== TR 1059508 03-02-2012 RKI/Neil ===*
2015
2016 IF !EMPTY(lcShipTo)
2017 lcToCountry = vl_locar(lcShipTo, "Country")
2018 ENDIF
2019
2020 *--- TR 1051666 11-1-2011 VKK
2021 IF NOT EMPTY(lcToCountry)
2022 lcToRegion = vl_Cntyr(lcToCountry, "int_region_code")
2023 ENDIF
2024 *=== TR 1051666 11-1-2011 VKK
2025
2026 *--- TR 1051666 11-1-2011 VKK Added lcToRegtion
2027 llRetVal = vl_hsnod(lcHS_Num, "","hsnor_temp", lcCountry, lcToCountry, lcToRegion)
2028 ENDIF
2029 *=== 1007898 12/06/04 Ilya.
2030
2031 IF EMPTY(llRetVal)
2032 * get HM number record by hm_num + country
2033
2034 *--- TR 1046289 use VL call to make sure we use country properly. Find blank if country is empty
2035 *llRetVal = vl_hsnor(lcHS_Num, "","hsnor_temp", lcCountry)
2036 llRetVal = vl_hsnor_cntry(lcHS_Num, "","hsnor_temp", lcCountry)
2037 *=== TR 1046289
2038
2039 ENDIF
2040
2041 IF EMPTY(llRetVal) && not found, try country = " "
2042
2043 *--- TR 1046289 use VL call to make sure we use country properly. Find blank if country is empty
2044 *llRetVal = vl_hsnor(lcHS_Num, "","hsnor_temp", " ")
2045 llRetVal = vl_hsnor_cntry(lcHS_Num, "","hsnor_temp", " ")
2046 *=== TR 1046289
2047
2048 ENDIF
2049
2050 IF !EMPTY(llRetVal)
2051 * --- 1000766 09-SEP-2003 PV
2052 IF EMPTY(hsnor_temp.uom) OR EMPTY(lcWgt_UOM)
2053 * === 1000766 09-SEP-2003 PV
2054 IF !plHsFixedAmount &&--- TR 1072967 26-SEP-13 Venuk
2055 lnTotalDuty = (pnValue * hsnor_temp.duty_perc / 100) + hsnor_temp.duty_rate
2056 *--- TR 1072967 26-SEP-13 Venuk
2057 ELSE
2058 lnTotalDuty = pnValue + hsnor_temp.fixed_dollar
2059 ENDIF
2060 *=== TR 1072967 26-SEP-13 Venuk
2061 ELSE
2062 * --- 1000766 09-SEP-2003 PV
2063 lnGar_Dutywgt = lnGar_Wgt
2064
2065 IF lcWgt_UOM <> hsnor_temp.uom
2066 lnUOM_Factor = vl_suomc(hsnor_temp.uom,"uom_factor","",lcWgt_UOM)
2067 lnGar_Dutywgt = lnUOM_Factor * lnGar_Wgt
2068 ENDIF
2069
2070 IF hsnor_temp.duty_wgt <> 0 AND hsnor_temp.duty_rate <> 0
2071 lnGar_DutywgtAmt = (( lnGar_Dutywgt * hsnor_temp.duty_rate ) / hsnor_temp.duty_wgt )
2072 ELSE
2073 lnGar_DutywgtAmt = 0
2074 ENDIF
2075
2076 IF !plHsFixedAmount &&--- TR 1072967 26-SEP-13 Venuk
2077 lnTotalDuty = lnGar_DutywgtAmt + ( pnValue * hsnor_temp.duty_perc / 100)
2078 *--- TR 1072967 26-SEP-13 Venuk
2079 ELSE
2080 lnTotalDuty = lnGar_DutywgtAmt + pnValue + hsnor_temp.fixed_dollar
2081 ENDIF
2082 *=== TR 1072967 26-SEP-13 Venuk
2083 ENDIF
2084 * === 1000766 09-SEP-2003 PV
2085 ENDIF
2086 ENDIF
2087
2088 Select (lnOldSelect)
2089
2090 RETURN lnTotalDuty
2091 ENDPROC
2092
2093 *-----------------------------------------------------------------------------------
2094 * 06/08/00 Start JT ATS3903, Costing- Shipment proration of tree on the PO cost Sheet
2095 *
2096 PROCEDURE ProrateImp
2097 PARAMETER pnProd_num, pnOpen_seq, plimportonly, plNoMsg, pcDetailAlias, pcCostAlias
2098 LOCAL llRetVal, lnQty, lcProd_Type, llBeganTransaction, lcDetailAlias, lcBOMAlias, lnDutyExt, ;
2099 lcCostAlias, llDoNotCommit, lnReccount, lnYY, llNotNodata, lnRecNo, lnReccount, ;
2100 laCost[5], laAmount[1,11] && array to hold the explosion of udf
2101
2102 * --- 1003958 04/04 CB - Optimized recalcs.
2103 * NOTE: ANY CHANGES MADE TO THIS ROUTINE MUST BE DUPLICATED IN ITS OPTIMIZED _2 EQUIVALENT!
2104 WITH THIS
2105
2106
2107
2108
2109 IF .lOptimizedRecalc AND .lDynamicsPrepped
2110 IF .lEnableDebugging
2111 .oLog.LogEntry("ProrateImp() - redirecting.")
2112 ENDIF
2113
2114 RETURN .ProrateImp_2(pnProd_num, pnOpen_seq, plimportonly, plNoMsg, pcDetailAlias, pcCostAlias)
2115 ENDIF
2116
2117 IF .lEnableDebugging
2118 .oLog.LogEntry("ProrateImp() - original code.")
2119 ENDIF
2120 ENDWITH
2121 * === 1003958 End.
2122
2123
2124
2125 llNotNodata = .T.
2126 laCost = 0
2127 WITH THIS
2128 .pushRecordSet()
2129 * work alias passed, use them and do not commit here. (leave it to caller).
2130 IF !EMPTY(pcDetailAlias) AND !EMPTY(pcCostAlias)
2131 lcDetailAlias = pcDetailAlias
2132 lcCostAlias = pcCostAlias
2133 *--- TAN 34778 06/16/03 AD
2134 lcBOMAlias = 'Vzzcbommd'
2135 *=== TAN 34778 06/16/03 AD
2136 llDoNotCommit = .T. && do not commit
2137 llRetVal = .T.
2138 ELSE
2139 lcDetailAlias = "Vzzcordrd_tree"
2140 lcCostAlias = "Vzzccostd_tree"
2141 *--- TAN 34778 06/16/03 AD
2142 lcBOMAlias = 'Vzzcbommd_tree'
2143 *=== TAN 34778 06/16/03 AD
2144
2145 llRetVal = .OPENTABLE(lcDetailAlias, ,llNotNodata) && need data
2146 IF llRetVal
2147 llRetVal = .OPENTABLE(lcCostAlias, ,llNotNodata) && need data
2148 ENDIF
2149 *--- TAN 34778 06/16/03 AD
2150 IF llRetVal
2151 llRetVal = .OPENTABLE(lcBOMAlias, ,llNotNodata) && need data
2152 ENDIF
2153
2154 * --- 1003958 04/04 CB - Moved indexing to separate procedure:
2155 .IndexBOMAndCost(lcBOMAlias, lcCostAlias)
2156 * === 1003958 End.
2157 *--- TR 1048358 11/04/10 AZ
2158 SET ORDER TO tag costlevel &&& AZ 1048358 AZ
2159 *=== TR 1048358 11/04/10 AZ
2160
2161 *=== TAN 34778 06/16/03 AD
2162
2163 ENDIF
2164
2165 *--- TechRec 1026008 09-Aug-2007 GSternik ---
2166 .cPO_Dtl_Alias = lcDetailAlias
2167 *=== TechRec 1026008 09-Aug-2007 GSternik ===
2168
2169 IF llRetVal
2170 *--- TAN 30611 10/09/02 AD
2171 llRetVal = .GetShipmentCost(lcDetailAlias, pnOpen_seq)
2172 * prorate all shipments invloved in this tree.
2173 *- not used anymore
2174 *.prorateShipment(lcDetailAlias, pnOpen_seq, @laAmount) && prorate
2175 *=== TAN 30611 10/09/02 AD
2176 ENDIF
2177
2178 IF llRetVal
2179 SELECT (lcDetailAlias)
2180 .pushRecordSet()
2181 COUNT TO lnReccount
2182 *!* lnReccount = RECCOUNT("vzzcordrd")
2183 lnYY = 0
2184 SCAN FOR Open_seq = pnOpen_seq && loop through the whole tree.
2185 * If not no message, show thermostate bar.
2186 IF !plNoMsg
2187 lnRecNo = RECNO()
2188 IF lnRecNo > 0
2189 lnYY = lnRecNo
2190 ELSE
2191 lnYY = lnYY + 1 && to accomodate new records.
2192 ENDIF
2193 lcMessage = "Prorating import tracking cost for stage " + TRIM(stage)
2194 Thermo(lcMessage, lnYY, lnReccount)
2195 ENDIF
2196 * -- end thermostate bar.
2197
2198 IF last_stage = "Y"
2199 lnQty = total_qty
2200 ELSE
2201 lnQty = wip_total
2202 ENDIF
2203
2204 *--- TechRec 1004691 27-Apr-2004 GS ---
2205 * initialize 4 required cost categories. for zzcordrd
2206*!* laCost[DUTY_] = duty_amount
2207*!* laCost[PRODUCTION_] = prod_value
2208*!* laCost[MATERIAL_] = total_material
2209*!* laCost[TOTAL_COST_] = total_cost
2210*!* laCost[COMMISSION_] = comm_amount && TAN 33059 Ilya
2211 *=== TechRec 1004691 27-Apr-2004 GS ===
2212 * ATS 4752, remove dutiable cost category attribute
2213 *!* laCost[DUTIABLE_] = dutiable_cost && ATS 4634, dutiable bom
2214
2215 * get cost from import tracking
2216 *--- TAN 34778 06/16/03 AD
2217 if lnQty > 0 &&& 1048358
2218 LOCAL lnDetPkey, llMultiLevel
2219 lnDetPkey = pkey
2220 SELECT(lcCostAlias)
2221 LOCATE FOR Fkey = lnDetPkey .AND. SysLevel > 0
2222 llMultiLevel = FOUND(lcCostAlias)
2223 SELECT(lcDetailAlias)
2224 *=== TAN 34778 06/16/03 AD
2225
2226 *--- TechRec 1007154 04-Oct-2004 GS ---
2227 .lLast_Stage = (Last_Stage = 'Y')
2228 *=== TechRec 1007154 04-Oct-2004 GS ===
2229
2230 .CostFromImp(lcCostAlias, pkey, lnQty, prod_num, lcDetailAlias, @laAmount)
2231 IF !plImportOnly && 08/03/00 do not do constant/formula if import only.
2232 *--- TAN 34778 06/16/03 AD
2233 IF llMultiLevel
2234 .RecalCost(lcDetailAlias, lcBOMAlias, lcCostAlias, lnDetPkey)
2235 ELSE
2236 *=== TAN 34778 06/16/03 AD
2237 .CostFromConstant(lcCostAlias, pkey, lnQty, @laCost) && get cost by formula
2238 .CostOfHSLookUp(lcCostAlias, pkey, lnQty) && get hs lookup cost
2239 .CostOfHSLookUp(lcCostAlias, pkey, lnQty, true) && TR 1072967 26-SEP-13 Venuk. get hs fixed dollar
2240
2241 *--- TechRec 1058999 18-Apr-2012 jisingh ---
2242 .CostOfMultiRoyalty(lcCostAlias, pkey, lnQty) && get multi royalty cost
2243 *=== TechRec 1058999 18-Apr-2012 jisingh ===
2244 .CostOfCommission(lcCostAlias, pkey, lnqty, Agent) && TAN 33059 Ilya get agent commission cost, GS -- Removed macro from Agent
2245 .CostByFormula(lcCostAlias, pkey, lnQty, @laCost, true) && get cost by formula
2246 ENDIF
2247 ENDIF
2248 * only if this stage is ship_ok, we stamp the last_prorate
2249 * 06/16/00 stamp last prorated date regardless.
2250 * must time stamp last_mod first, then last_prorate.
2251 .TimeStampDocument(lcDetailAlias)
2252 REPLACE last_prorated WITH DATETIME() IN (lcDetailAlias)
2253
2254 IF !plImportOnly && 08/03/00 do not update these cost, if import only.
2255 lnCost = laCost[DUTY_]
2256
2257 * 38280 CB 6/03 Added ability to prorate Actual Duty Value back to Cost Sheet
2258 * Shipment proration has already occurred as normal, taking into account the HS Duty Value
2259 * of shipment goods. If User has entered an Actual Duty, override the cost on the
2260 * Cost Sheet for the Duty Category with the weighted cost,
2261 * and the Production Detail Line with the cost.
2262
2263 lnDutyExt = .GetActualDutyCost(PKey)
2264 IF lnDutyExt > 0
2265 lnCost = .CostFromActualDuty(lcCostAlias, PKey, lnQty, lcDetailAlias)
2266 * laCost[DUTY_] = lnDutyExt
2267 laCost[DUTY_] = lnCost
2268
2269 * Calculate Formulas again
2270
2271 *---- 40860 CB 7/03 - Added last parameter true so as not to overwrite
2272 * actual duty value with a formula calculation.
2273 .costbyFormula(lcCostAlias, pkey, lnQty, @laCost, true) && get cost by formula
2274 *==== 40860 CB.
2275 ENDIF
2276
2277 * recording duty_value, pord_value, total_material and total_cost
2278
2279 *--- TechRec 1004691 27-Apr-2004 GS ---
2280 *!* *--- TAN 33059 Ilya: Added comm_amount here:
2281 *!* REPLACE Duty_Amount WITH lnCost, prod_value WITH laCost[PRODUCTION_], ;
2282 *!* total_material WITH laCost[MATERIAL_], total_cost WITH laCost[TOTAL_COST_], ;
2283 *!* comm_amount WITH laCost[COMMISSION_] ;
2284 *!* IN (lcDetailAlias)
2285 *!* * ATS 4752, remove dutiable cost category attribute
2286 *!* *!* dutiable_cost WITH laCost[DUTIABLE_] IN (lcDetailAlias)
2287 *tnProdDtlPKey, tcCostAlias, tcProdDtlAlias
2288 This.UpdatePODetail(lcCostAlias, lcDetailAlias)
2289 *=== TechRec 1004691 27-Apr-2004 GS ===
2290
2291 ENDIF
2292 ENDIF &&& 1048358
2293 ENDSCAN
2294 .popRecordSet()
2295
2296 * time stamp last_mod of cost view.
2297 .TimeStampDocument(lcCostAlias, "ALL")
2298
2299 * start transaction for the entire tree of po_num and open_seq
2300 IF !llDoNotCommit && need to commit here.
2301 llBeganTransaction = .BeginTransaction()
2302 llRetVal = .TABLEUPDATE(lcDetailAlias) AND .TABLEUPDATE(lcCostAlias)
2303 IF llBeganTransaction
2304 IF llRetVal
2305 .EndTransaction()
2306 ELSE
2307 .RollbackTransaction()
2308 llRetVal = .F.
2309 ENDIF
2310 .TableClose(lcDetailAlias)
2311 .TableClose(lcCostAlias)
2312 .TableClose(lcBOMAlias)
2313 ENDIF
2314 ENDIF
2315 ENDIF
2316 .popRecordSet()
2317 ENDWITH
2318
2319 RETURN llRetVal
2320 ENDPROC
2321 *-------------------------------------------------------------------------------------------------------------------------
2322 *--- TAN 38280 06/06/03 CB
2323 * Returns amount user has entered for Actual Duty Value on Shipment's Additional Header, or 0 if nothing.
2324 PROCEDURE GetActualDutyCost
2325 LPARAMETERS tnPKey
2326
2327 LOCAL lnExtension, lnSelect
2328 lnExtension = 0
2329 lnSelect = SELECT()
2330 IF SEEK(tnPKey, 'tcShipCost', 'PKEY')
2331 lnExtension = EVAL('tcShipCost.Duty_Ext')
2332 ENDIF
2333 SELECT(lnSelect)
2334 RETURN lnExtension
2335 ENDPROC
2336 *=== TAN 38280 06/06/03 CB
2337
2338 *--- TAN 38280 06/06/03 CB
2339 * Finds the Duty Category on the Cost Sheet, and prorates the weighted Actual Duty Value to it.
2340 PROCEDURE CostFromActualDuty
2341 LPARAMETER pcCostAlias, pnPkey, pnqty, pcDetailAlias && pnPkey is the pkey of zzcordrd, pnQty is the balance.
2342
2343 LOCAL lncost, lnExtension, lnSelect, lvCost_Type, lcSQLString, lnTotalEstimatedDuty, lnVoucherAmt, ;
2344 llRetVal, lnEstimatedCost, lcCategory, lcActualDutyCategory
2345 lnCost = 0
2346 lnExtension = 0
2347 * --- 1005039 - 05/04 CB - Only want ACTDUT categories for calculation:
2348 lcActualDutyCategory = UPPER(ALLTRIM(goEnv.SV("ACTUAL_DUTY_CATEGORY", "ACTDUT")))
2349
2350 WITH THIS
2351 .pushRecordSet()
2352 SELECT (pcCostAlias)
2353 .pushRecordSet()
2354
2355 * --- 1001584 - 04/04 CB - Changes to Duty Proration. Prorating duty based on percentage of total
2356 * duty on entire shipment, rather than per unit.
2357 lnTotalEstimatedDuty = 0
2358 lcSQLString = ;
2359 "SELECT SUM(Estm_Ext_Cost) AS ShipDuty FROM zzccostd c " + ;
2360 " JOIN zzcordrd d ON d.PKey = c.FKey " + ;
2361 " JOIN zzdcatgr g ON g.Category = c.Category " + ;
2362 " WHERE d.Shp_Seq = " + SQLFormatNum(EVALUATE(pcDetailAlias + ".Shp_Seq")) + ;
2363 " AND g.Cost_Type = " + SQLFormatChar(This.cCN_DUTY_VALUE) + ;
2364 " AND g.AP_Category = 'Y'" + ;
2365 " GROUP BY c.Category"
2366 * === 1005039 End.
2367
2368 llRetVal = v_SQLExec(lcSQLString, "tcTmpShpCost")
2369 IF llRetVal AND USED("tcTmpShpCost") AND RECCOUNT("tcTmpShpCost") = 1
2370 lnTotalEstimatedDuty = tcTmpShpCost.ShipDuty
2371 ENDIF
2372 USE IN SELECT("tcTmpShpCost")
2373
2374 lnVoucherAmt = 0
2375 lcSQLString = ;
2376 "SELECT SUM(AP_Amt) AS VoucherAmt " + ;
2377 " FROM zzgapvcd " + ;
2378 " WHERE Line_Type = " + SQLFormatChar(UPPER(AP_LINE_TYPE_SHIPMENT)) + ;
2379 " AND Shp_Seq = " + SQLFormatNum(EVALUATE(pcDetailAlias + ".Shp_Seq")) + ;
2380 " AND Category = " + SQLFormatChar(lcActualDutyCategory) + ;
2381 " GROUP BY Shp_Seq"
2382 llRetVal = v_SQLExec(lcSQLString, "tcTmpVouchAmt")
2383 IF llRetVal AND USED("tcTmpVouchAmt") AND RECCOUNT("tcTmpVouchAmt") = 1
2384 lnVoucherAmt = tcTmpVouchAmt.VoucherAmt
2385 ENDIF
2386 USE IN SELECT("tcTmpVouchAmt")
2387
2388 SELECT(pcCostAlias)
2389 * === 1001584 End.
2390
2391 * Locate Cost Sheet Duty Category
2392 *--- 1003958 04/04 CB - Optimized scan
2393 IF NOT (.lOptimizedRecalc AND .lDynamicsPrepped)
2394 SCAN FOR fkey = pnPkey
2395 *--- TechRec 1004691 27-Apr-2004 GS ---
2396 *lvCost_Type = vl_dcatgr(Category, "cost_type")
2397 lcCategory = Category
2398 = Seek(lcCategory, This.cCatAlias)
2399 lvCost_Type = Evaluate(This.cCatAlias + ".Cost_Type")
2400 *=== TechRec 1004691 27-Apr-2004 GS ===
2401 IF !EMPTY(lvCost_Type) AND lvCost_Type = This.cCN_DUTY_VALUE && 38280 - Prorating back to DUTY on Cost Sheet.
2402 * --- 1001584 04/04 CB - Change to duty calculation
2403 lnEstimatedCost = EVALUATE(pcCostAlias + ".Estm_Ext_Cost")
2404 IF lnTotalEstimatedDuty <> 0 AND lnVoucherAmt <> 0
2405 lnExtension = lnEstimatedCost + ;
2406 ( (lnEstimatedCost / lnTotalEstimatedDuty) * (lnVoucherAmt - lnTotalEstimatedDuty) )
2407 ELSE
2408 * Old way...
2409 lnExtension = tcShipCost.Duty_Ext
2410 ENDIF
2411 * === 1001584 End.
2412
2413 lnCost = lnExtension / MAX(pnQty, 1)
2414
2415 REPLACE Category_Cost WITH lnCost, Extension WITH lnExtension, ;
2416 Imp_Cost WITH IIF(lnExtension = 0, 'N', 'Y') ;
2417 IN (pcCostAlias)
2418 *--- TechRec 1003897 26-Mar-2004 GS ---
2419 if Imp_Cost # 'Y'
2420 replace Estm_Ext_Cost with Extension
2421
2422 *--- 1012294 KISHOR 2-AUG-2006
2423 IF This.lOptimizedRecalc AND THIS.lDynamicsPrepped
2424 replace modified WITH 'Y'
2425 ENDIF
2426 *=== 1012294 KISHOR 2-AUG-2006
2427
2428 endif
2429 *=== TechRec 1003897 26-Mar-2004 GS ===
2430 ENDIF
2431 ENDSCAN
2432 ELSE
2433 SELECT (.cCstAlias)
2434 =SEEK(pnPKey, .cCstAlias, 'FKey')
2435 SCAN WHILE FKey = pnPkey
2436 IF FOUND(THIS.cCatAlias) AND EVALUATE(THIS.cCatAlias + ".Cost_Type") = THIS.cCN_DUTY_VALUE
2437 lnEstimatedCost = Estm_Ext_Cost
2438 IF lnTotalEstimatedDuty <> 0 AND lnVoucherAmt <> 0
2439 lnExtension = lnEstimatedCost + ;
2440 ( (lnEstimatedCost / lnTotalEstimatedDuty) * (lnVoucherAmt - lnTotalEstimatedDuty) )
2441 ELSE
2442 lnExtension = tcShipCost.Duty_Ext
2443 ENDIF
2444
2445 lnCost = lnExtension / MAX(pnQty, 1)
2446
2447 REPLACE ;
2448 Category_Cost WITH lnCost, ;
2449 Extension WITH lnExtension, ;
2450 Imp_Cost WITH IIF(lnExtension = 0, 'N', 'Y'), ;
2451 Estm_Ext_Cost WITH IIF(Imp_Cost <> 'Y', lnExtension, Estm_Ext_Cost), ;
2452 Modified WITH "Y" ;
2453 IN (.cCstAlias)
2454 ENDIF
2455 ENDSCAN
2456 ENDIF
2457 * === 1003958 End.
2458
2459 .popRecordSet()
2460 .popRecordSet()
2461 ENDWITH
2462 RETURN lnCost
2463 ENDPROC
2464 *=== TAN 38280 06/06/03 CB
2465
2466 * 05/12/2000 ATS3847, calculate cost from import tracking
2467 PROCEDURE CostFromImp
2468 LPARAMETER pcCostAlias, pnPkey, pnqty, pnProd_num, ;
2469 pcDetailAlias, paAmount, lvCost_Type && pnPkey is the pkey of zzcordrd, pnQty is the balance.
2470
2471 LOCAL lnBucket, lncost, lnExtension, lnSelect
2472 lnBucket = 0
2473 lncost = 0
2474
2475
2476 WITH THIS
2477 .pushRecordSet()
2478 SELECT (pcCostAlias)
2479 .pushRecordSet()
2480 *--- TAN 34778 06/14/03 AD
2481 *- !!! ASSUMPTION:
2482 *- Propation is from the process and ZZCCOSTD and ZZCBOMMD are on the server
2483 *- "Prorate Imp" from prod cost button may produce incorrect result
2484
2485 LOCAL lnMaxLevel, lcSQLStr, Q_TrxForCost, ;
2486 Q_TotTrxForCost, llM_Imp_Ok, Q_ParBomForCost, lnBOMFkey, lnBOMRatio
2487 lnMaxLevel = 0
2488 *- Traverse up the tree to find nearest BOM stage
2489
2490 *lcSQLStr = ;
2491 * "select pkey, total_qty from zzcordrd where prod_num = " + SQLFormatNum(pnProd_num) + " and tree_seq = " + ;
2492 * "(select max(tree_seq) from zzcordrd d1 where prod_num = " + SQLFormatNum(pnProd_num) + " and " + ;
2493 * "(select tree_seq from zzcordrd where pkey = " + SQLFormatNum(pnPkey) + " ) " + ;
2494 * "like rtrim(d1.tree_seq) + '%' and " + ;
2495 * "exists(select * from zzcbommd b where b.fkey = d1.pkey))"
2496 *--- GS Fix :
2497 lcSQLStr = ;
2498 "select pkey, total_qty from zzcordrd where prod_num = " + SQLFormatNum(pnProd_num) + " and tree_seq = " + ;
2499 "(select max(tree_seq) from zzcordrd d1 where prod_num = " + SQLFormatNum(pnProd_num) + " and " + ;
2500 "(select tree_seq from zzcordrd where pkey = " + SQLFormatNum(pnPkey) + " ) " + ;
2501 "like "+SqlFnConcat("RTrim(d1.tree_seq)+'%'") +" and " + ;
2502 "exists(select * from zzcbommd b where b.fkey = d1.pkey))"
2503
2504 v_SQLExec(lcSQLStr, 'Q_BOMFkey')
2505 lnBOMFkey = Q_BOMFkey.pkey
2506 lnBOMRatio = ROUND(pnqty/Q_BOMFkey.total_qty, 8)
2507 USE IN SELECT('Q_BOMFkey')
2508
2509 *--- TechRec 1005165 02-Jun-2004 AD, GS ---
2510 *lcSQLStr = ;
2511 * "select " + SQLfnIFnullEmpty("max(syslevel)", "N", "maxlevel") + " " + ;
2512 * "from zzccostd where fkey = " + SQLFormatNum(pnPkey)
2513 lcSQLStr = ;
2514 "select " + SQLfnIFnullEmpty("max(syslevel)", "N", "maxlevel") + " " + ;
2515 "from zzcbommd where fkey = " + SQLFormatNum(lnBOMFkey)
2516 *=== TechRec 1005165 02-Jun-2004 AD, GS ===
2517
2518 IF v_SQLExec(lcSQLStr, 'Q_ImpCostLevel')
2519 lnMaxLevel = Q_ImpCostLevel.maxlevel
2520 ENDIF
2521
2522 IF lnMaxLevel > 0
2523*!* lcSQLStr = ;
2524*!* "select b.fkey,b.costlevelpkey,b.parbomsku,c.category " + ;
2525*!* "from zzcbommd b " + ;
2526*!* "join zzccostd c on b.fkey = c.fkey and " + ;
2527*!* "b.costlevelpkey = c.costlevelpkey " + ;
2528*!* "join zzdcatgr g on c.category = g.category " + ;
2529*!* "where " + ;
2530*!* "c.fkey = " + SQLFormatNum(pnPkey) + " and " + ;
2531*!* "b.syslevel = " + SQLFormatNum(lnMaxLevel) + " and " + ;
2532*!* "c.syslevel = " + SQLFormatNum(lnMaxLevel) + " and " + ;
2533*!* "g.cost_type like 'SFCLBLUDF%' " + ;
2534*!* "group by b.fkey,b.costlevelpkey,b.parbomsku,c.category "
2535 *--- TechRec 1005165 02-Jun-2004 AD, GS ---
2536 *lcSQLStr = ;
2537 * "select b.fkey,b.costlevelpkey,b.parbomsku,c.category " + ; && need C.CostLevelPKey
2538 * "from zzcbommd b " + ;
2539 * "join zzccostd c on " + ;
2540 * "b.costlevelpkey = c.costlevelpkey " + ; replaced with BomLevelPKey
2541 * "join zzdcatgr g on c.category = g.category " + ;
2542 * "where " + ;
2543 * "c.fkey = " + SQLFormatNum(pnPkey) + " and " + ;
2544 * "b.fkey = " + SQLFormatNum(lnBOMFkey) + " and " + ;
2545 * "b.syslevel = " + SQLFormatNum(lnMaxLevel) + " and " + ;
2546 * "c.syslevel = " + SQLFormatNum(lnMaxLevel) + " and " + ;
2547 * "g.cost_type like 'SFCLBLUDF%' " + ;
2548 * "group by b.fkey,b.costlevelpkey,b.parbomsku,c.category "
2549
2550 *--- TR 1048358 11/04/10 AZ
2551
2552*!* lcSQLStr = ;
2553*!* "select distinct b.FKey,c.CostLevelPKey,b.ParBomSKU,c.Category" +;
2554*!* " from zzcbommd b" +;
2555*!* " join zzccostd c" +;
2556*!* " on c.division + c.style + c.color_code + c.lbl_code + c.dimension = b.parbomsku " +;
2557*!* " join zzdcatgr g"+;
2558*!* " on c.Category = g.Category" +;
2559*!* " where c.fkey = " + SQLFormatNum(pnPkey) +;
2560*!* " and b.fkey = " + SQLFormatNum(lnBOMFkey) +;
2561*!* " and b.syslevel = " + SQLFormatNum(lnMaxLevel) +;
2562*!* " and c.syslevel = " + SQLFormatNum(lnMaxLevel) +;
2563*!* " and g.cost_type like 'SFCLBLUDF%' "
2564 lcSQLStr = ;
2565 "select distinct b.FKey,c.CostLevelPKey,b.ParBomSKU,c.Category" +;
2566 " from zzcbommd b" +;
2567 " join zzccostd c" +;
2568 " on c.division + c.style + c.color_code + c.lbl_code + c.dimension = b.parbomsku " +;
2569 " join zzdcatgr g"+;
2570 " on c.Category = g.Category" +;
2571 " where c.fkey = " + SQLFormatNum(pnPkey) +;
2572 " and b.fkey = " + SQLFormatNum(lnBOMFkey) +;
2573 " and b.syslevel = 1 " +; &&& make level 1 is max
2574 " and c.syslevel = 1 " +; &&& make level 1 is max
2575 " and g.cost_type like 'SFCLBLUDF%' "
2576 *=== TR 1048358 11/04/10 AZ
2577
2578 *=== TechRec 1005165 11-Jun-2004 AD, GS ===
2579
2580 Q_ParBomForCost = SQLTableFromQuery(lcSQLStr)
2581 llM_Imp_Ok = !EMPTY(Q_ParBomForCost)
2582
2583 IF llM_Imp_Ok
2584 *--- TR 1048358 11/04/10 AZ
2585*!* lcSQLStr = ;
2586*!* "select b.fkey, b2.costlevelpkey, " + ;
2587*!* "sum(b.trxusage) as trxusage, b2.category " + ;
2588*!* "from zzcbommd b " + ;
2589*!* "join " + Q_ParBomForCost + " b2 " + ;
2590*!* "on b.fkey = b2.fkey and b.syslevel = " + SQLFormatNum(lnMaxLevel-1) + " and " + ;
2591*!* "b.division + b.style + b.color_code + b.lbl_code + b.dimension = b2.parbomsku " + ;
2592*!* "group by b.fkey, b2.costlevelpkey, b2.category "
2593
2594 lcSQLStr = ;
2595 "select b.fkey, b2.costlevelpkey, " + ;
2596 "sum(b.trxusage) as trxusage, b2.category " + ;
2597 "from zzcbommd b " + ;
2598 "join " + Q_ParBomForCost + " b2 " + ;
2599 "on b.fkey = b2.fkey and b.syslevel = 0 and " + ;
2600 "b.division + b.style + b.color_code + b.lbl_code + b.dimension = b2.parbomsku " + ;
2601 "group by b.fkey, b2.costlevelpkey, b2.category "
2602
2603 *=== TR 1048358 11/04/10 AZ
2604
2605
2606
2607 Q_TrxForCost = SQLTableFromQuery(lcSQLStr)
2608 llM_Imp_Ok = !EMPTY(Q_TrxForCost)
2609 ENDIF
2610
2611 IF llM_Imp_Ok
2612 lcSQLStr = ;
2613 "select sum(trxusage) as tot_trx, category " + ;
2614 "from " + Q_TrxForCost + " " + ;
2615 "group by category"
2616
2617 Q_TotTrxForCost = SQLTableFromQuery(lcSQLStr)
2618 llM_Imp_Ok = !EMPTY(Q_TotTrxForCost)
2619 ENDIF
2620
2621 IF llM_Imp_Ok
2622
2623 *--- TechRec 1005165 02-Jun-2004 AD, GS ---
2624 *Was: "select a.*, (1/(b.tot_trx/a.trxusage)) as trx_ratio " +
2625 lcSQLStr = ;
2626 "select a.*, 1/NullIf(b.Tot_Trx/NullIf(a.TrxUsage,0),0) as Trx_Ratio " + ;
2627 "from " + Q_TrxForCost + " a join " + Q_TotTrxForCost + " b " + ;
2628 "on a.Category = b.Category"
2629 *=== TechRec 1005165 02-Jun-2004 AD, GS ===
2630
2631 llM_Imp_Ok = v_SQLExec(lcSQLStr, 'Q_MultiImpRatio')
2632
2633 IF llM_Imp_Ok
2634
2635 v_SQLExec("DROP TABLE " + Q_ParBomForCost)
2636 v_SQLExec("DROP TABLE " + Q_TrxForCost)
2637 v_SQLExec("DROP TABLE " + Q_TotTrxForCost)
2638
2639 SELECT Q_MultiImpRatio
2640 INDEX ON STR(CostLevelPKey) + Category TAG CatgRatio
2641 ENDIF
2642 ENDIF
2643 ENDIF
2644 USE IN SELECT('Q_ImpCostLevel')
2645
2646 USE IN SELECT('tcCatGr_ShpUDF')
2647 SELECT (pcCostAlias)
2648 *=== TAN 34778 06/14/03 AD
2649
2650 *--- 1003958 04/04 CB - Optimized scan
2651 IF NOT (.lOptimizedRecalc AND .lDynamicsPrepped)
2652 SCAN FOR fkey = pnPkey AND syslevel < 2 &&&& AZ 1048358 added code to prorate only levels 0 and 1 (per Donna)
2653 lnBucket = .getUDFBucket(category)
2654 IF !EMPTY(lnBucket) && this is a category of import tracking cost.
2655 *--- TAN 36854 01/30/03 AD
2656 *!* lnExtension = .getImportCost(pnPkey, lnBucket, pnProd_num, ;
2657 *!* pcDetailAlias, @paAmount) && get cost of this category.
2658 *!* lncost = lnExtension / MAX(pnqty, 1)
2659
2660 *--- TechRec 1003897 23-Mar-2004 GS ---
2661 *lnExtension = .GetUDFCost(pnPkey, lnBucket)
2662 lnExtension = IIF(AP_COST = 'Y', Extension, .GetUDFCost(pnPkey, lnBucket))
2663 *=== TechRec 1003897 23-Mar-2004 GS ===
2664
2665 *--- TAN 34778 06/14/03 AD
2666 IF SysLevel > 0 .AND. (SysLevel < lnMaxLevel .OR. !llM_Imp_Ok)
2667*!* lnExtension = 0 &&&***** 1048358 AZ
2668 ENDIF
2669
2670* IF SysLevel = lnMaxLevel .AND. llM_Imp_Ok AND AP_COST < 'Y' &&& ***** 1048358 AZ
2671 IF SysLevel > 0 .AND. llM_Imp_Ok AND AP_COST < 'Y' &&& ***** 1048358 AZ
2672 IF SEEK(STR(CostLevelPKey) + Category, 'Q_MultiImpRatio', 'CatgRatio')
2673 *--- TechRec 1005165 02-Jun-2004 AD, GS ---
2674 *lnExtension = ROUND(lnExtension * Q_MultiImpRatio.trx_ratio, 5)
2675*--- TechRec 1072843 07-Apr-2014 AZhadanov ---
2676* lnExtension = ROUND(lnExtension * NVL(Q_MultiImpRatio.Trx_Ratio, 1), 5)
2677 lnExtension = ROUND(lnExtension * NVL(Q_MultiImpRatio.Trx_Ratio, 0), 5) &&& 1072843
2678*=== TechRec 1072843 07-Apr-2014 AZhadanov ---
2679 *--- TechRec 1005165 02-Jun-2004 AD, GS ---
2680 ELSE
2681 lnExtension = 0
2682 ENDIF
2683 ENDIF
2684
2685 *lnCost = lnExtension / MAX(pnQty, 1)
2686
2687 IF SysLevel = 0 OR (SYSLEVEL > 0 AND AP_COST = 'Y') &&& ***** 1048358 AZ Adde OR part
2688 lnCost = lnExtension / MAX(pnQty, 1)
2689 ENDIF
2690
2691 *--- TR 1048358 11/04/10 AZ
2692* IF SysLevel = lnMaxLevel .AND. llM_Imp_Ok
2693 IF SysLevel > 0 .AND. llM_Imp_Ok AND AP_COST < 'Y'
2694 *=== TR 1048358 11/04/10 AZ
2695 *--- TechRec 1007963 22-Nov-2004 GS, AZ --- done in TR # 1007803
2696 *lnCost = lnExtension / (MAX(Q_MultiImpRatio.TrxUsage, 1) * lnBOMRatio)
2697 lnCost = lnExtension / Max(Q_MultiImpRatio.TrxUsage * lnBOMRatio, 1)
2698 *=== TechRec 1007963 22-Nov-2004 GS, AZ ===
2699
2700 ENDIF
2701
2702 *=== TAN 34778 06/14/03 AD
2703
2704 *=== TAN 30611 10/14/02 AD
2705
2706 *=== TAN 36854 01/30/03 AD
2707 * 08/29/00, comment out the following line, make sure constant is calculate after this.
2708 *!* * ATS 4359, retain constant, cost, extension cost if no import tracking cost.
2709 *!* IF lnExtension # 0
2710 *--- TAN 36566 02/07/03 AD
2711 *- Added Imp_Cost
2712 *--- TAN 37481 03/14/03 CB
2713 *- Added AP_Cost
2714 REPLACE category_cost WITH lncost, extension WITH lnExtension, ;
2715 Imp_Cost WITH IIF(lnExtension = 0, 'N', 'Y') ;
2716 IN (pcCostAlias) && leave constant unchange. 08/15/00
2717 * ATS 4734, now import tracking has formula.
2718 *!* formula WITH "IMPORT TRACKING" IN (pcCostAlias) && leave constant unchange. 08/15/00
2719 *!* ENDIF
2720 *!* * end ATS 4359
2721 * 08/29/00, End comment out
2722 *--- TechRec 1003897 26-Mar-2004 GS ---
2723 if Imp_Cost # 'Y'
2724 replace Estm_Ext_Cost with Extension
2725
2726 *--- 1012294 KISHOR 2-AUG-2006
2727 IF This.lOptimizedRecalc AND THIS.lDynamicsPrepped
2728 replace modified WITH 'Y'
2729 ENDIF
2730 *=== 1012294 KISHOR 2-AUG-2006
2731
2732 endif
2733 *=== TechRec 1003897 26-Mar-2004 GS ===
2734 ENDIF
2735 ENDSCAN
2736 ELSE
2737 SELECT (.cCstAlias)
2738 =SEEK(pnPKey, .cCstAlias, 'FKey')
2739 SCAN WHILE FKey = pnPKey
2740 lnBucket = .getUDFBucket(category)
2741 IF !EMPTY(lnBucket) && this is a category of import tracking cost.
2742 lnExtension = IIF(AP_COST = 'Y', Extension, .GetUDFCost(pnPkey, lnBucket))
2743
2744 IF SysLevel > 0 .AND. (SysLevel < lnMaxLevel .OR. !llM_Imp_Ok)
2745 lnExtension = 0
2746 ENDIF
2747
2748 IF SysLevel = lnMaxLevel .AND. llM_Imp_Ok
2749 IF SEEK(STR(CostLevelPKey) + Category, 'Q_MultiImpRatio', 'CatgRatio')
2750 lnExtension = ROUND(lnExtension * Q_MultiImpRatio.trx_ratio, 5)
2751 ELSE
2752 lnExtension = 0
2753 ENDIF
2754 ENDIF
2755
2756 IF SysLevel = 0
2757 lnCost = lnExtension / MAX(pnQty, 1)
2758 ENDIF
2759
2760 IF SysLevel = lnMaxLevel .AND. llM_Imp_Ok
2761 lnCost = lnExtension / (MAX(Q_MultiImpRatio.TrxUsage, 1) * lnBOMRatio)
2762 ENDIF
2763
2764 REPLACE ;
2765 Category_Cost WITH lnCost, ;
2766 Extension WITH lnExtension, ;
2767 Imp_Cost WITH IIF(lnExtension = 0, 'N', 'Y'), ;
2768 Estm_Ext_Cost WITH IIF(Imp_Cost <> 'Y', lnExtension, Estm_Ext_Cost), ;
2769 Modified WITH "Y" ;
2770 IN (pcCostAlias)
2771 ENDIF
2772 ENDSCAN
2773 ENDIF
2774 * === 1003958 End.
2775
2776 *--- TAN 34778 06/14/03 AD
2777 USE IN SELECT('Q_MultiImpRatio')
2778 *=== TAN 34778 06/14/03 AD
2779 .popRecordSet()
2780 .popRecordSet()
2781 ENDWITH
2782 RETURN
2783
2784 ENDPROC
2785 *---------------------------------------------------------------------------------------
2786
2787*--- TAN 36854 01/30/03 AD
2788 PROCEDURE GetUDFCost
2789 LPARAMETERS tnPKey, tnBucket
2790
2791 LOCAL lnExtension, lnSelect
2792 lnExtension = 0
2793 lnSelect = SELECT()
2794 IF SEEK(tnPKey, 'tcShipCost', 'PKEY')
2795 lnExtension = EVAL('tcShipCost.UDF' + TRANS(tnBucket, '@L 99') + '_Ext')
2796 ENDIF
2797 SELECT(lnSelect)
2798 RETURN lnExtension
2799 ENDPROC
2800*=== TAN 36854 01/30/03 AD
2801
2802 * 06/08/00 Start JT ATS3903, Costing- Shipment proration
2803 * prorate all shipments invloved in this tree.
2804 *--- TAN 30611 10/14/02 AD
2805 *- Not used
2806 *=== TAN 30611 10/14/02 AD
2807 PROCEDURE ProrateShipment
2808 PARAMETER pcDetailAlias, pnOpen_seq, paAmount
2809
2810 LOCAL llRetVal, lcSqlString, lnxx, lcnxx, lcShpCost, lcby, lnRow, ;
2811 lnQty, lnWeight, lnCubic
2812
2813 *--- TR 1046473 3-May-2010 Goutam
2814 LOCAL lnProd_Value
2815 *=== TR 1046473 3-May-2010 Goutam
2816
2817 THIS.pushRecordSet()
2818 llRetVal = .F.
2819
2820 * get all shipment invloved in this tree.
2821 SELECT (pcDetailAlias)
2822 THIS.pushRecordSet()
2823 SET FILTER TO && may come from poe, which sets filter.
2824 SCAN FOR shipment_num > 0 AND Open_seq = pnOpen_seq
2825
2826 lnQty = total_qty
2827 lnWeight = Total_weight
2828 lnCubic = Total_cubic
2829
2830 *--- TR 1046473 3-May-2010 Goutam
2831 lnProd_Value = Prod_Value * wip_total
2832 *=== TR 1046473 3-May-2010 Goutam
2833
2834 lnRow = ALEN(paAmount, 1) && current # of rows
2835 IF !EMPTY(paAmount[lnRow, 11])
2836 lnRow = lnRow + 1
2837 DIMENSION paAmount[lnRow, 11] && increase on row.
2838 ENDIF
2839 paAmount[lnRow, 11] = shipment_num && shipment number in the 11th element of row.
2840 * total units, weight, and cubic
2841
2842 *--- TR 1046473 3-May-2010 Goutam. Added Sum(prod_value) as ttProd_Value
2843 lcSqlString = "Select sum(total_qty) as ttUnit, sum(total_cubic) as ttCubic, " + ;
2844 " sum(total_weight) as ttWeight, SUM(prod_value*wip_total) as ttProd_Value from zzcordrd where shipment_num = " + ;
2845 STR(shipment_num)
2846
2847 llRetVal = v_SQLPrep(lcSqlString, "tcResult", "")
2848
2849 IF llRetVal
2850 * get cursor for this shipment
2851 llRetVal = vl_shpmh(shipment_num, , "tcShpmh")
2852 IF llRetVal
2853 * explore 10 udf costs here.
2854 SELECT tcResult
2855 SELECT tcShpmh
2856
2857 FOR lnxx = 1 TO 10
2858 lcnxx = TRANS(lnxx, "@L 99")
2859 lnShpCost = EVAL("tcShpmh.udf" + lcnxx + "_fee") && total shipment cost
2860 lcby = EVAL("tcShpmh.udf" + lcnxx + "_by") && cost by.
2861
2862 paAmount[lnRow,lnxx] = 0 && initialize to 0, not .F,
2863 IF !EMPTY(lnShpCost)
2864 DO CASE
2865 *--- TR 1046473 3-May-2010 Goutam.
2866 CASE lcby = "P" AND !EMPTY(tcResult.ttProd_Value) && by total value
2867 paAmount[lnRow,lnxx] = lnShpCost / tcResult.ttProd_Value * lnProd_Value
2868 *=== TR 1046473 3-May-2010 Goutam.
2869
2870 CASE lcby = "C" AND !EMPTY(tcResult.ttCubic) && by cubic
2871 paAmount[lnRow,lnxx] = lnShpCost / tcResult.ttCubic * lnCubic
2872 CASE lcby = "W" AND !EMPTY(tcResult.ttWeight) && by weight
2873 paAmount[lnRow,lnxx] = lnShpCost / tcResult.ttWeight * lnWeight
2874 CASE !EMPTY(tcResult.ttUnit) && default is by units
2875 paAmount[lnRow,lnxx] = lnShpCost / tcResult.ttUnit * lnQty
2876 ENDCASE
2877 ENDIF
2878 ENDFOR
2879 ENDIF
2880 ENDIF
2881 ENDSCAN
2882 THIS.popRecordSet()
2883 THIS.popRecordSet()
2884
2885 RETURN
2886 ENDPROC
2887
2888 *---------------------------------------------------------------------------------------------------
2889 PROCEDURE GetImportCost
2890 * ATS# 3847, JT Cost Module
2891 * return udf cost.
2892 * parameter 1 = pkey of the current zzcordrd., parameter 2 = bucket # of the udf.
2893 * traverse up from the current zzcordrd to the earlier stage, added up call shipment cost.
2894 LPARAMETER pnPkey, pnBucket, pnProd_num, pcDetailAlias, paAmount
2895 LOCAL lnExtension, lnParkey, lnselec, lnRecNo, lcFilter, lnRecNo, ;
2896 lnamount, lnRatio, lnHoldQty, lnNetQty, lnKeyfield, ;
2897 lnShipNum, lnTotalQty, lnRow
2898
2899 WITH THIS
2900 .pushRecordSet()
2901
2902 lnExtension = 0
2903 lnParkey = pnPkey
2904 lnamount = 0
2905 * lnRatio is a ratio to allocate the prorated udf cost.
2906 * it starts with 1, then changed when we travers up to the root,
2907 * because the previous stage may be cancelled, or current stage may be
2908 * just one of a split lines of prevous stage.
2909 lnRatio = 1
2910 SELECT (pcDetailAlias)
2911 .pushRecordSet()
2912 SET FILTER TO && may comes from poe, which sets filter..
2913 LOCATE FOR pkey = lnParkey
2914 IF FOUND()
2915 * This is current record, get whatever prorated amount.
2916 * no need to check for cancelled or not.
2917 lnParkey = parkey
2918 lnHoldQty = total_qty && so when we move up, we know what was the qty.
2919 lnWipQty = wip_total
2920 lnShipNum = shipment_num
2921 IF !EMPTY(lnShipNum)
2922 IF cmpl_ok = "C"
2923 lnExtension = 0
2924 ELSE
2925 * get row number of this shipment in the prorated array.
2926 lnRow = AFindRow(@paAmount, lnShipNum, 11)
2927 *!* lnRow= ASUBSCRIPT(paAmount, ASCAN(paAmount, lnShipNum), 1)
2928 IF last_stage = "Y"
2929 lnExtension = paAmount[lnRow, pnBucket]
2930 ELSE
2931 lnExtension = paAmount[lnRow, pnBucket] / lnHoldQty * lnWipQty
2932 ENDIF
2933 ENDIF
2934 ENDIF
2935 * 08/09/00 even for current stage, I need a ratio for traversing up to the previous stage.
2936 DO CASE
2937 CASE cmpl_ok = "C"
2938 lnRatio = 0
2939 CASE last_stage # "Y"
2940 lnRatio = lnWipQty / lnHoldQty
2941 ENDCASE
2942
2943 * all previous stages need to check if po line is cancelled or not.
2944 * ratio of the prorated amount base on the net. (not wip balance, but total_qty - cancel qty).
2945 SELECT (pcDetailAlias)
2946 LOCATE FOR pkey = lnParkey
2947 DO WHILE FOUND()
2948 lnParkey = parkey
2949 lnKeyfield = pkey
2950 lnShipNum = shipment_num
2951 lnTotalQty = total_qty && prepare to move up..
2952 lnNetQty = .getNetQty(pcDetailAlias, lnKeyfield) && get net qty.
2953 IF lnNetQty > 0
2954 lnRatio = lnRatio * lnHoldQty / lnNetQty && the ratio is previous ratio * current / net
2955 ENDIF
2956 lnHoldQty = lnTotalQty && prepare to move up..
2957 IF !EMPTY(lnShipNum)
2958 * get row number of this shipment in the prorated array.
2959 lnRow = AFindRow(@paAmount, lnShipNum, 11)
2960 lnExtension = lnExtension + paAmount[lnRow, pnBucket] * lnRatio
2961 ENDIF
2962 LOCATE FOR pkey = lnParkey && search the way up..
2963 ENDDO
2964 ENDIF
2965
2966 .popRecordSet()
2967 .popRecordSet()
2968 ENDWITH
2969 RETURN lnExtension
2970 ENDPROC
2971
2972 *----------------------------------------------------------------------------------------
2973 * ATS# 3847, JT Cost Module, get net qty.
2974 * we do this b/c if po is cancelled, the cost is distribute to net qty.
2975 * otherwise, the cost is distribute to total_qty
2976 PROCEDURE GetNetQty
2977 LPARAMETER pcDetailAlias, pnPkey
2978 LOCAL lnNetQty
2979
2980 THIS.pushRecordSet()
2981
2982 SELECT(pcDetailAlias)
2983 THIS.pushRecordSet()
2984 IF cmpl_ok = "C" && this po detail is cancelled
2985 CALCULATE SUM(total_qty) TO lnNetQty FOR parkey = pnPkey
2986 ELSE
2987 lnNetQty = total_qty
2988 ENDIF
2989 THIS.popRecordSet()
2990 THIS.popRecordSet()
2991
2992 RETURN lnNetQty
2993 ENDPROC
2994 *-----------------------------------------------------------------------------------
2995 * 04/27/2000 ATS3847 Costing
2996 * find the bucket # of a udf category, if not a udf category, return 0
2997 PROCEDURE GetUDFBucket
2998 LPARAMETERS pnCategory
2999 LOCAL lvCost_Type, lnBucket
3000
3001 *--- TAN 34778 06/16/03 AD
3002 IF !USED('tcCatGr_ShpUDF')
3003 LOCAL lnSelect
3004 lnSelect = SELECT()
3005 IF v_SQLExec("SELECT * FROM zzdcatgr WHERE Cost_Type LIKE 'SFCLBLUDF%'", 'tcCatGr_ShpUDF')
3006 SELECT tcCatGr_ShpUDF
3007 INDEX ON Category TAG Category
3008 ENDIF
3009 SELECT(lnSelect)
3010 ENDIF
3011
3012 lnBucket = 0
3013 IF SEEK(pnCategory, 'tcCatGr_ShpUDF', 'Category')
3014 lnBucket = VAL(SUBSTR(tcCatGr_ShpUDF.Cost_Type, 10,2))
3015 ENDIF
3016 *=== TAN 34778 06/16/03 AD
3017*!* lnBucket = 0
3018*!* lvCost_Type = vl_dcatgr(pnCategory, "cost_type")
3019*!* IF !EMPTY(lvCost_Type)
3020*!* * 11/15/00, now cost_type contains the really field name.
3021*!* IF "SFCLBLUDF" $ lvCost_Type
3022*!* lnBucket = VAL(SUBSTR(lvCost_Type, 10,2))
3023*!* ENDIF
3024*!* ENDIF
3025
3026 *=== TAN 34778 06/16/03 AD
3027
3028 RETURN lnBucket
3029 ENDPROC
3030 *----------------------------------------------------------------------------------------
3031 * ATS 3903, Wraper to prorate import tracking cost by po#.
3032
3033 PROCEDURE ProrateImpByPO
3034 LPARAMETER pnProd_num, plimportonly, pcDetailAlias, pcCostAlias
3035 LOCAL laArray[1], lnxx, llNoMsg, llOldOptimizedRecalc
3036 WITH THIS
3037 * --- 1003958 Optimized Recalc 05/04 CB - avoid prepping cursors, etc if just doing one PO
3038 llOldOptimizedRecalc = .lOptimizedRecalc
3039 .lOptimizedRecalc = .F.
3040 * === 1003958 End.
3041
3042 * rewrite on 08/03/00
3043 .pushRecordSet()
3044 IF !EMPTY(pcDetailAlias)
3045 lcAlias = pcDetailAlias
3046 ELSE
3047 lcAlias = "vzzcordrd"
3048 ENDIF
3049 *--- TAN 34027 09/19/02 AD
3050 llNoMsg = .T.
3051 *=== TAN 34027 09/19/02 AD
3052 SELECT DISTINCT Open_seq FROM (lcAlias) WHERE prod_num = pnProd_num INTO ARRAY laArray
3053 FOR lnxx = 1 TO ALEN(laArray)
3054 IF !EMPTY(laArray[lnxx])
3055 .ProrateImp(pnProd_num, laArray[lnxx], plimportonly, llNoMsg, pcDetailAlias, pcCostAlias)
3056 *--- TechRec 1000730 24-Sep-2003 GS ---
3057 if 'SQL'$goEnv.sv('cServerType')
3058 *--- 1005111 - AG - 05/13/04
3059*!* v_SQLExec("execute dbo.bcsp_Invtr_Cost "+ ;
3060*!* sqlFormatNum(pnProd_Num) + ", " + sqlFormatNum(laArray[lnxx]) )
3061
3062 v_SQLExec("execute dbo.bcsp_Invtr_Cost "+ ;
3063 sqlFormatNum(pnProd_Num) + ", " + sqlFormatNum(laArray[lnxx]) + ;
3064 ", NULL" )
3065 *=== 1005111
3066 endif
3067 *=== TechRec 1000730 24-Sep-2003 GS ===
3068 ENDIF
3069 ENDFOR
3070 .popRecordSet()
3071
3072 * --- 1003958 Optimized Recalc 05/04 CB - Reset lOptimized flag:
3073 .lOptimizedRecalc = llOldOptimizedRecalc
3074 * === 1003958 End.
3075 ENDWITH
3076
3077 * code before 08/03/00
3078 *!* WITH THIS
3079 *!* LOCAL llRetVal, llNotNodata, llDeleteView, lcSqlString
3080 *!* llNotNodata = .T. && need data, not NODATA
3081 *!* llDeleteView = .T.
3082
3083 *!* WITH THIS
3084 *!* .pushRecordSet()
3085 *!* lcSqlString = "select distinct prod_num, open_seq from zzcordrd zzcordrd " + ;
3086 *!* " where prod_num = ?pnProdpnProd_num order by 1,2"
3087 *!* llRetVal = .CreateSQLView("Vzzcordrd_Temp2", lcSqlString)
3088
3089 *!* IF llRetVal
3090 *!* llRetVal = .OPENTABLE("Vzzcordrd_Temp2", ,llNotNodata) && need data
3091 *!* IF llRetVal
3092 *!* SELECT vzzcordrd_Temp2
3093 *!* SCAN && loop through the whole tree.
3094 *!* .ProrateImp(pnProd_num, open_Seq, plimportonly, plNoMsg)
3095 *!* ENDSCAN
3096 *!* .TableClose("Vzzcordrd_temp2", llDeleteView) && close and delete view
3097 *!* ENDIF
3098 *!* ENDIF
3099 *!* .popRecordSet()
3100 *!* ENDWITH
3101
3102 RETURN
3103 ENDPROC
3104 *----------------------------------------------------------------------------------------
3105 * ATS 3903, Wraper to prorate import tracking cost by shipment #.
3106 **** Not used ******
3107 PROCEDURE ProrateImpByShipment
3108 PARAMETER pnShipment_num, plimportonly, plNoMsg
3109 LOCAL llRetVal, llNotNodata, llDeleteView, lcSqlString
3110
3111 llNotNodata = .T. && need data, not NODATA
3112 llDeleteView = .T.
3113
3114 WITH THIS
3115 .pushRecordSet()
3116 lcSqlString = "select distinct prod_num, open_seq from zzcordrd zzcordrd " + ;
3117 " where Shipment_num = ?pnShipment_num order by 1,2"
3118
3119 llRetVal = .CreateSQLView("Vzzcordrd_Temp2", lcSqlString)
3120
3121 IF llRetVal
3122 llRetVal = .OPENTABLE("Vzzcordrd_Temp2", ,llNotNodata) && need data
3123 IF llRetVal
3124 SELECT vzzcordrd_Temp2
3125 SCAN && loop through the whole tree.
3126 .ProrateImp(vzzcordrd_Temp2.pnProd_num, vzzcordrd_Temp2.Open_seq, plimportonly)
3127 ENDSCAN
3128 .TableClose("Vzzcordrd_temp2", llDeleteView) && close and delete view
3129 ENDIF
3130 ENDIF
3131 .popRecordSet()
3132 ENDWITH
3133
3134 RETURN
3135 ENDPROC
3136 *----------------------------------------------------------------------------------------
3137 * ATS 4600. validate line_seq number
3138 PROCEDURE ValidateLineNumber
3139 LPARAMETER tcCategory, tcLine_seq
3140
3141 LOCAL llRetVal, lcMsg, lcCostType, lnOldSelect
3142
3143 lcMsg = ""
3144
3145 *--- TechRec 1004691 27-Apr-2004 GS ---
3146 *llRetVal = vl_dcatgr(tcCategory, "", "tmpCursor")
3147 *IF llRetVal
3148 llRetVal = Seek(tcCategory, This.cCatAlias)
3149
3150 IF llRetVal
3151 lnOldSelect = Select()
3152 select (This.cCatAlias)
3153 *=== TechRec 1004691 27-Apr-2004 GS ===
3154
3155 DO CASE
3156 *--- TechRec 1004691 27-Apr-2004 GS === Replaced tmpCursor use with catgr Table:
3157 CASE Cost_Type = This.cCN_TOTAL_MATERIAL AND tcLine_seq # 200
3158 lcMsg = "Total Material must have line number 200."
3159 * ATS 4752, remove dutiable value category
3160 *!* CASE tmpCursor.cost_type = CN_DUTIABLE_VALUE AND !BETWEEN(tcLine_seq, 201,299)
3161 *!* lcMsg = "Dutiable Value must have line number between 201 and 299."
3162 CASE Cost_Type = This.cCN_PROD_VALUE AND tcLine_seq # 300
3163 lcMsg = "Production Value must have line number 300."
3164 *---Tan34434 HH 09/26/02 line_seq for CN_ER_Value must be 100
3165 CASE Cost_Type = This.cCN_ER_LOOKUP AND tcLine_seq # 100
3166 lcMsg = "ER Lookup must have line number 100."
3167 *===Tan34434 HH 09/26/02
3168 CASE Cost_Type = This.cCN_HS_LOOKUP AND tcLine_seq # 400
3169 lcMsg = "HS Lookup Duty must have line number 400."
3170 CASE Cost_Type = This.cCN_DUTY_VALUE AND tcLine_seq # 500
3171 lcMsg = "Duty Value must have line number 500."
3172 *--- TAN 33059 Ilya: Added CN_COMMISSION check:
3173 CASE Cost_Type = This.cCN_COMMISSION AND tcLine_seq # 550
3174 lcMsg = "Commission must have line number 550."
3175 CASE Cost_Type = This.cCN_TOTAL_COST AND tcLine_seq # 600
3176 lcMsg = "Total Cost must have line number 600."
3177 CASE !EMPTY(Cmp_Type) AND !BETWEEN(tcLine_seq, 1,199) && bom category.
3178 lcMsg = "BOM category must have line number between 1 and 199."
3179 CASE Imp_Tracking = 'Y' AND !BETWEEN(tcLine_seq, 301,399) && import tracking
3180 lcMsg = "Import Tracking category must have line number between 301 and 399."
3181 CASE EMPTY(Cost_Type) AND MOD(tcLine_seq, 100) = 0
3182 lcMsg = "Line number 100, 200, 300, 400, 500, 600 are reserved"
3183 ENDCASE
3184 Select (lnOldSelect)
3185 ELSE
3186 lcMsg = "Invalid Category Code."
3187 ENDIF
3188
3189 IF !EMPTY(lcMsg)
3190 llRetVal = .F.
3191 ErrorBox(lcMsg)
3192 ENDIF
3193
3194 *--- TechRec 1004691 27-Apr-2004 GS ---
3195 *IF USED("tmpCursor")
3196 * USE IN tmpCursor
3197 *ENDIF
3198 *=== TechRec 1004691 27-Apr-2004 GS ===
3199
3200 RETURN llRetVal
3201 ENDPROC
3202
3203 *----------------------------------------------------------------------------------------
3204 * ATS 4600. get next line_seq number
3205 PROCEDURE GetNextCostLineNumber
3206 LPARAMETER tcAlias, tcCmp_type, tcImp_tracking, tnLine_seq
3207
3208 LOCAL lnNextSeq
3209 lnNextSeq = tnLine_seq
3210 WITH THIS
3211 .pushRecordSet()
3212 SELECT (tcAlias)
3213 .pushRecordSet()
3214 DO CASE
3215 CASE !EMPTY(tcCmp_type) AND !BETWEEN(tnLine_seq, 1,199) && bom category.
3216 CALCULATE MAX(line_seq) FOR line_seq > 100 AND line_seq < 200 TO lnNextSeq
3217 DO CASE
3218 CASE lnNextSeq = 0 && maybe first import tracking.
3219 lnNextSeq = 101
3220 CASE lnNextSeq < 199 && do not bump to 200, which is for 'Total Material'
3221 lnNextSeq = lnNextSeq + 1
3222 ENDCASE
3223 CASE tcImp_tracking = 'Y' AND !BETWEEN(tnLine_seq, 301,399) && import tracking
3224 CALCULATE MAX(line_seq) FOR line_seq > 300 AND line_seq < 400 TO lnNextSeq
3225 DO CASE
3226 CASE lnNextSeq = 0 && maybe first import tracking.
3227 lnNextSeq = 301
3228 CASE lnNextSeq < 399 && do not bump to 300, which is for 'HS Lookup'
3229 lnNextSeq = lnNextSeq + 1
3230 ENDCASE
3231 CASE tnLine_seq = 0
3232 CALCULATE MAX(line_seq) TO lnNextSeq
3233 * next number should not be 100,200,300,400,500. etc.
3234 IF MOD(lnNextSeq, 100) = 99
3235 lnNextSeq = lnNextSeq + 2
3236 ELSE
3237 lnNextSeq = lnNextSeq + 1
3238 ENDIF
3239 ENDCASE
3240 .popRecordSet()
3241 .popRecordSet()
3242 ENDWITH
3243 RETURN lnNextSeq
3244 ENDPROC
3245 *----------------------------------------------------------------------------------------
3246 * ATS 4600. validate formula
3247 PROCEDURE ValidateCostFormula
3248 LPARAMETER tcAlias, tcCategory, tcFormula, tnLine_seq
3249 LOCAL l_cEngStr, lcCategory, lnxx, lcFormula, lcProdValue, llRetVal, lnxx, ;
3250 lcString, lcToken, lnPos, lcSelect, lnRecNo, lcDtlNo, lcMsgString, lntk, ;
3251 laCategory[1], laToken[1], llImp_Tracking
3252 lnxx = 0
3253 WITH THIS
3254 .pushRecordSet()
3255 SELECT (tcAlias)
3256 .pushRecordSet()
3257 * if the category is of "prod value", do not include import tracking in the list.
3258
3259 *--- TechRec 1004691 27-Apr-2004 GS ---
3260 *lcProdValue = vl_dcatgr(tcCategory, "cost_type")
3261 *IF !EMPTY(lcProdValue) OR lcProdValue = ""
3262
3263 llRetVal = Seek(tcCategory, This.cCatAlias)
3264 lcProdValue = Evaluate(This.cCatAlias + ".Cost_Type")
3265 IF llRetVal
3266 *=== TechRec 1004691 27-Apr-2004 GS ===
3267 SCAN FOR !DELETED()
3268 * 09/28/00
3269 * need to include all non-formula categories or any category defined befor current one.
3270 *--- TechRec 1004691 27-Apr-2004 GS ---
3271 *llRetVal = vl_dcatgr(category, "", "tmpCursor")
3272 *IF !EMPTY(llRetVal)
3273 * IF line_seq < tnLine_seq OR EMPTY(&tcAlias..formula) OR ;
3274 * tmpCursor.imp_tracking = "Y" && ATS 4748 OR &tcAlias..formula = This.cCN_HS_LOOKUP
3275 * IF lcProdValue # This.cCN_PROD_VALUE OR tmpCursor.imp_tracking # "Y" && not import tracking
3276 * lnxx = lnxx + 1
3277 lcCategory = Category
3278 llRetVal = Seek(lcCategory, This.cCatAlias)
3279 IF llRetVal
3280 llImp_Tracking = (Evaluate(This.cCatAlias + ".Imp_Tracking") = 'Y')
3281 IF line_seq < tnLine_seq or Empty(Formula) or llImp_Tracking
3282 IF lcProdValue # This.cCN_PROD_VALUE or !llImp_Tracking && not import tracking
3283 *=== TechRec 1004691 27-Apr-2004 GS ===
3284 lnxx = lnxx + 1
3285 DIMENSION laCategory[lnxx]
3286 laCategory[lnxx] = category
3287 ENDIF
3288 ENDIF
3289 *--- TechRec 1004691 27-Apr-2004 GS ---
3290 *USE IN tmpCursor
3291 *=== TechRec 1004691 27-Apr-2004 GS ===
3292 ENDIF
3293 ENDSCAN
3294 ENDIF
3295 .popRecordSet()
3296 .popRecordSet()
3297 ENDWITH
3298
3299
3300 llRetVal = .T.
3301 lcString = tcFormula
3302 lcString = STRTRAN(lcString, '(', ' ( ') && replac '(' with blanks
3303 lcString = STRTRAN(lcString, ')', ' ) ') && replac '(' with blanks
3304 lcString = STRTRAN(lcString, '/', ' / ') && replac '(' with blanks
3305 lcString = STRTRAN(lcString, '*', ' * ') && replac '(' with blanks
3306 lcString = STRTRAN(lcString, '-', ' - ') && replac '(' with blanks
3307 lcString = STRTRAN(lcString, '+', ' + ') && replac '(' with blanks
3308 lcString = lcString + " "
3309
3310 lcToken = ""
3311
3312 * tokenize formula string into array., so that we can check for variable (category)
3313 StringToArray(lcString, @laToken, " ")
3314 FOR lnxx = 1 TO ALEN(laToken)
3315 lcToken = laToken[lnxx]
3316 *--- TAN 35242 10/31/02 AD
3317 *FOR lntk = 1 TO LEN(lcToken)
3318 * decide if this token is a variable filed.
3319 IF BETWEEN(SUBSTR(lcToken, 1, 1), "A", "Z")
3320 * have a token, valid. it.
3321 IF AFindElem(@laCategory, lcToken) = 0 && Search for category
3322 lcMsgString = "Invalid Formula: " + lcToken + " not a valid Category"
3323 llRetVal = .F.
3324 *EXIT
3325 ENDIF
3326 ENDIF
3327 *ENDFOR
3328 IF !llRetVal
3329 EXIT
3330 ENDIF
3331 ENDFOR
3332 * if category in formula is okay, check for mathmatical operation.
3333 IF llRetVal
3334 FOR lnxx = 1 TO ALEN(laToken)
3335 lcToken = laToken[lnxx]
3336 *--- TAN 35242 10/31/02 AD
3337 *FOR lntk = 1 TO LEN(lcToken)
3338 * decide if this token is a variable filed.
3339 IF BETWEEN(SUBSTR(lcToken, 1, 1), "A", "Z")
3340 laToken[lnxx] = "1" && replace category with 1
3341 *EXIT
3342 ENDIF
3343 *ENDFOR
3344 ENDFOR
3345
3346 * construct string from array
3347 lcString = ArrayToString(@laToken, " ")
3348
3349 lcError = ON("ERROR")
3350
3351 *--- TechRec 1049776 08-Dec-2010 asharma ---
3352 * llRetVal working fine in Dev Environment but not in EXE
3353*!* ON ERROR llRetVal = .F.
3354 llTempRetVal = llRetVal
3355 ON ERROR llTempRetVal = .F.
3356 *=== TechRec 1049776 08-Dec-2010 asharma ===
3357
3358 lnxx = EVAL(lcString)
3359 ON ERROR &lcError && restore system error handler
3360
3361 *--- TechRec 1049776 08-Dec-2010 asharma ---
3362 llRetVal = llTempRetVal
3363 *=== TechRec 1049776 08-Dec-2010 asharma ===
3364
3365 IF !llRetVal
3366 lcMsgString = "Invalid Formula: " + MESSAGE()
3367
3368 ELSE
3369 *--- TAN 33402 08/26/02 PL
3370*--- TAN 33402 08/26/02 PL - Cost Sheet Formula divide by "0" problem
3371*-- Blockout Check for "Divided by zero." only work when actual substitute
3372*-- all variables with value then could evaluate for this error.
3373*-- validation move to Costsheet Ref (zzdcosth.vcx)
3374*!* IF lnxx > 1000000000000 OR lnxx < -1000000000000
3375*!* llRetVal = .F.
3376*!* lcMsgString = "Invalid Formula: Divided by zero."
3377*!* ENDIF
3378*=== TAN 33402 08/26/02 PL
3379 ENDIF
3380 ENDIF
3381
3382 IF !llRetVal
3383 *--- TechRec 1045741 29-Sep-2010 jjanand ---
3384 *mb(lcMsgString)
3385 IF This.lscheduled
3386* IF This.lEnableDebugging &&& 1078623
3387 IF TYPE("this.olog") = 'O' &&& 1078623
3388
3389 This.oLog.LogEntry(lcMsgString)
3390 ENDIF
3391 ELSE
3392 mb(lcMsgString)
3393 ENDIF
3394 *=== TechRec 1045741 29-Sep-2010 jjanand ===
3395
3396 *--- TechRec 1049776 08-Dec-2010 asharma ---
3397 IF THIS.lAutoCreateCostSheet
3398 This.cMessage = lcMsgString
3399 ENDIF
3400 *=== TechRec 1049776 08-Dec-2010 asharma ===
3401
3402 ENDIF
3403
3404 RETURN llRetVal
3405
3406 ENDPROC
3407 *----------------------------------------------------------------------------------------
3408 * ATS 4600. check pattern of categories.
3409 PROCEDURE CheckCategoryPattern
3410 LPARAMETER tcAlias, tcUse_rm && tcBOM_Dutiable && ATS 4673
3411 LOCAL lcCostType, lnElement, llRetVal, lcCompType, lcUse_rm, lcBOM_Dutiable, ;
3412 lcCostDesc, lcString, lnxx, lcCurType, lnCurSeq, lcPrvType, lnPrvSeq, ;
3413 lnDuty_Yes, lnDuty_No, lnDuty_Both, lcCmpType_And_Dutiable
3414 DIMENSION laCostType[1], laCostSeq[1], laCmp_type[1], laCmpType_And_Dutiable[1], ;
3415 laDutiable[1], laCategory[1], laAttrSeq[6], laLine_seq[1] && TR 1020422 01/05/07 MP
3416 Local lcCmp_Type, lcCost_Type, lcDutiable, lcCategory, lcLine_seq && TR 1020422 01/05/07 MP
3417
3418
3419 llRetVal = .T.
3420 lnPrvSeq = 0
3421 lcPrvType = ""
3422 laAttrSeq = 0
3423 lcCostDesc = ""
3424 lcUse_rm = 'N'
3425 lcBOM_Dutiable = 'N' && ATS 4673
3426 *--- TAN 34776 11/04/02 AD
3427 *- Added CostLevelPKey
3428 *--- TAN 36254 12/30/02 AD
3429 *- Added SysLevel
3430 *--- 1032015 03/26/09 Ilya: Will use a character, in conjunction with syslevel
3431*-Ilya--- lcLine_seq = 0 && TR 1020422 01/05/07 MP
3432 lcLine_seq = ''
3433 *=== 1032015 03/26/09 Ilya.
3434 LOCAL lcCostLevelPkey, lcSysLevel
3435 lcCostLevelPkey = ''
3436 lcSysLevel = ''
3437 WITH THIS
3438 .pushRecordSet()
3439 SELECT (tcAlias)
3440 .pushRecordSet()
3441 * if use bom. then must include both dutiable and non-dutiable.
3442 IF !EMPTY(tcUse_rm)
3443 lcUse_rm = tcUse_rm
3444 ELSE
3445 *--- TechRec 1004691 28-Apr-2004 GS ---
3446 *lcUse_rm = vl_dtmplh(&tcAlias..template, "use_rm")
3447 lcUse_rm = vl_dtmplh(Template, "use_rm")
3448 *=== TechRec 1004691 28-Apr-2004 GS ===
3449 ENDIF
3450 IF lcUse_rm = 'Y'
3451 lcBOM_Dutiable = 'B'
3452 ENDIF
3453 SCAN
3454 *--- TechRec 1004691 27-Apr-2004 GS ---
3455 lcCategory = Category
3456 *=== TechRec 1004691 27-Apr-2004 GS ===
3457
3458 *--- 1032015 03/26/09 Ilya: Use character instead of Numeric
3459*-Ilya--- lcLine_seq = Line_seq && TR 1020422 01/05/07 MP
3460 lcLine_seq = STR(Line_seq)
3461 *=== 1032015 03/26/09 Ilya.
3462
3463 * 10/27/00, do not allow duplicate category.
3464 *--- TAN 34776 11/04/02 AD
3465 *- Added CostLevelPKey
3466 *--- TAN 36254 12/30/02 AD
3467 *- Added SysLevel
3468
3469 IF TYPE(tcAlias + '.CostLevelPkey') = 'N'
3470 *--- TechRec 1004691 28-Apr-2004 GS --- No macro!
3471 *lcCostLevelPkey = STR(&tcAlias..CostLevelPKey)
3472 *lcSysLevel = STR(&tcAlias..SysLevel)
3473 lcCostLevelPkey = STR(CostLevelPKey)
3474 lcSysLevel = STR(SysLevel)
3475 *=== TechRec 1004691 28-Apr-2004 GS ===
3476 ELSE
3477 lcCostLevelPkey = ''
3478 lcSysLevel = ''
3479 ENDIF
3480
3481 *--- TR 1020422 01/05/07 MP check dup line seq
3482 *--- 1032015 03/26/09 Ilya: Add cost pkey + syslevel
3483*-Ilya--- lnElement = ASCAN(laLine_seq, lcLine_seq)
3484 lnElement = ASCAN(laLine_seq, lcLine_seq + lcCostLevelPkey + lcSysLevel)
3485 *=== 1032015 03/26/09 Ilya.
3486
3487 IF lnElement = 0
3488 laLine_seq[alen(laLine_seq)] = Line_Seq
3489 DIMENSION laLine_seq[alen(laLine_seq) + 1]
3490 ELSE
3491 llRetVal = .F.
3492 lcLineDesc = ALLTRIM(STR(lcLine_seq))
3493 EXIT
3494 ENDIF
3495 *==== TR 1020422 01/05/07 MP
3496
3497 *lnElement = ASCAN(laCategory, &tcAlias..category) && check dup category
3498 *--- TechRec 1004691 27-Apr-2004 GS ---
3499 *lnElement = ASCAN(laCategory, &tcAlias..Category + lcCostLevelPkey + lcSysLevel) && check dup category
3500 lnElement = ASCAN(laCategory, lcCategory + lcCostLevelPkey + lcSysLevel) && check dup category
3501 *=== TechRec 1004691 27-Apr-2004 GS ===
3502
3503 *--- TAN 34776 11/04/02 AD
3504 IF lnElement = 0
3505 *--- TAN 34776 11/04/02 AD
3506 *- Added CostLevelPKey
3507 *laCategory[alen(laCategory)] = &tcAlias..category
3508 *--- TAN 36254 12/30/02 AD
3509 *- Added SysLevel
3510 *--- TechRec 1004691 27-Apr-2004 GS ---
3511 *laCategory[alen(laCategory)] = &tcAlias..category + lcCostLevelPkey + lcSysLevel
3512 laCategory[alen(laCategory)] = lcCategory + lcCostLevelPkey + lcSysLevel
3513 *=== TechRec 1004691 27-Apr-2004 GS ===
3514 DIMENSION laCategory[alen(laCategory) + 1]
3515 ELSE
3516 llRetVal = .F.
3517 lcCostDesc = lcCategory && &tcAlias..category --- TechRec 1004691 27-Apr-2004 GS ---
3518 EXIT
3519 ENDIF
3520 IF llRetVal
3521
3522 *--- TechRec 1004691 27-Apr-2004 GS ---
3523 *llRetVal = !EMPTY(&tcAlias..category) AND vl_dcatgr(&tcAlias..category, "", "tmpcatgr")
3524 llRetVal = !Empty(lcCategory) and Seek(lcCategory, This.cCatAlias)
3525
3526 IF llRetVal && 11/15/00 ?? AND !EMPTY(tmpCatgr.cost_type)
3527
3528 select (This.cCatAlias)
3529 lcCmp_Type = Cmp_Type
3530 lcCost_Type = Cost_Type
3531 lcDutiable = BOM_Dutiable
3532 select (tcAlias)
3533 *=== TechRec 1004691 27-Apr-2004 GS ===
3534 *!!!! 1004691 27-Apr-2004 GS : All further "tmpcatgr." replaced with "lc" !!!
3535
3536 * ATS 4673, need to check dutiable flag too.
3537 IF !EMPTY(lcCmp_Type)
3538 lcCmpType_And_Dutiable = lcCmp_Type + lcDutiable &&--- 1004691 27-Apr-2004 GS ---
3539 ELSE
3540 lcCmpType_And_Dutiable = lcCost_Type + lcDutiable &&--- 1004691 27-Apr-2004 GS ---
3541 ENDIF
3542 IF !EMPTY(lcCmpType_And_Dutiable)
3543 *--- TAN 34776 11/04/02 AD
3544 *--- TAN 36254 12/30/02 AD
3545 *- Added SysLevel
3546 lcCmpType_And_Dutiable = lcCmpType_And_Dutiable + lcCostLevelPkey + lcSysLevel
3547 *=== TAN 34776 11/04/02 AD
3548 lnElement = ASCAN(laCmpType_And_Dutiable, lcCmpType_And_Dutiable) && check if it is alreay in array.
3549 IF lnElement = 0 && if not found, push this cost_type into array.
3550 laCostType[alen(laCostType)] = lcCost_Type &&--- 1004691 27-Apr-2004 GS ---
3551 laCmpType_And_Dutiable[alen(laCmpType_And_Dutiable)] = lcCmpType_And_Dutiable
3552 laCostSeq[alen(laCostSeq)] = Line_Seq && remember the sequence # , 1004691 27-Apr-2004 GS - removed macro
3553 laCmp_type[alen(laCmp_type)] = Cmp_Type && remember the component type , 1004691 27-Apr-2004 GS - removed macro
3554 * ATS 4673
3555 * 11/15/00, 'ALL' is not in cost_type any more.
3556 IF lcCmp_Type = RSV_ALL &&--- 1004691 27-Apr-2004 GS ---
3557 laDutiable[alen(laDutiable)] = lcDutiable &&--- 1004691 27-Apr-2004 GS ---
3558 ELSE
3559 laDutiable[alen(laDutiable)] = " "
3560 ENDIF
3561 DIMENSION laCostType[alen(laCostType) + 1]
3562 DIMENSION laCmpType_And_Dutiable[alen(laCmpType_And_Dutiable) + 1] && ATS 4673
3563 DIMENSION laDutiable[alen(laDutiable) + 1] && ATS 4673
3564 DIMENSION laCostSeq[alen(laCostSeq) + 1]
3565 DIMENSION laCmp_type[alen(laCmp_type) + 1]
3566 ELSE
3567 llRetVal = .F.
3568 lcCostDesc = THIS.getCostType(Category, lcCmp_Type) &&--- 1004691 27-Apr-2004 GS ---
3569 EXIT
3570 ENDIF
3571 ENDIF
3572 ENDIF
3573
3574 *USE IN tmpCatgr &&--- 1004691 27-Apr-2004 GS ---
3575 ENDIF
3576 ENDSCAN
3577 .popRecordSet()
3578 .popRecordSet()
3579 ENDWITH
3580
3581 *--- TR 1020422 01/05/07 MP
3582 IF !llRetVal AND (!EMPTY(lcCostDesc) OR !EMPTY(lcLineDesc)) && error, construct error message
3583 IF !EMPTY(lcCostDesc)
3584 lcString = "Cannot enter a '" + TRIM(lcCostDesc) + "' Cost Category more then once."
3585 ELSE
3586 lcString = "Cannot enter a '"+lcLineDesc+"' Line more then once."
3587 ENDIF
3588 *=== TR 1020422 01/05/07 MP
3589 ELSE
3590 * further check. production value is mandatory,
3591 * and if bom = 'Y', cmp_type RSV_ALL is mandatory.
3592 DO CASE
3593 CASE ASCAN(laCmp_type, RSV_ALL) = 0 AND lcUse_rm = "Y"
3594 lcString = "Must enter a 'Dutiable Catch All' and 'Non-Dutiable Catch All' Categories."
3595 CASE ASCAN(laCostType, This.cCN_TOTAL_MATERIAL) = 0 AND lcUse_rm = "Y"
3596 lcString = "Must enter a 'Total Material' Cost Category."
3597 CASE ASCAN(laCostType, This.cCN_PROD_VALUE) = 0
3598 lcString = "Must enter a 'Production Value' Cost Category."
3599 CASE ASCAN(laCostType, This.cCN_TOTAL_COST) = 0
3600 lcString = "Must enter a 'Total Cost' Cost Category."
3601 ENDCASE
3602 ENDIF
3603 * ATS 4673, if bom required, further check if proper "Catch All" is entered.
3604 IF EMPTY(lcString) AND lcUse_rm = "Y"
3605 lnDuty_Yes = ASCAN(laDutiable, "Y")
3606 lnDuty_No = ASCAN(laDutiable, "N")
3607 lnDuty_Both = ASCAN(laDutiable, "B")
3608 DO CASE
3609 CASE lcBOM_Dutiable = 'Y' AND lnDuty_Yes = 0
3610 lcString = "Must enter a 'Dutiable Catch All' Category."
3611 CASE lcBOM_Dutiable = 'N' AND lnDuty_No = 0
3612 lcString = "Must enter a 'Non-Dutiable Catch All' Category."
3613 CASE lcBOM_Dutiable = 'B' AND (lnDuty_Both = 0 AND (lnDuty_Yes = 0 OR lnDuty_No = 0))
3614 lcString = "Must enter a 'Dutiable Catch All' and 'Non-Dutiable Catch All' Categories."
3615 ENDCASE
3616 ENDIF
3617 * End ATS 4637
3618 * further check the sequence of material cost, prod value, duty value, total cost.
3619 IF EMPTY(lcString)
3620
3621 FOR lnxx = 1 TO ALEN(laCostType) - 1
3622 lcCostType = laCostType[lnxx]
3623 lnCurSeq = laCostSeq[lnxx]
3624 *--- TAN 33059 Ilya: Added CN_COMMISSION to the list
3625 *--- TechRec 1004691 27-Apr-2004 GS --- Optimized :o)
3626 *IF INLIST(lcCostType, This.cCN_TOTAL_MATERIAL, This.cCN_PROD_VALUE, This.cCN_DUTY_VALUE, ;
3627 * This.cCN_HS_LOOKUP, This.cCN_TOTAL_COST, This.cCN_COMMISSION)
3628 *=== TechRec 1004691 27-Apr-2004 GS ===
3629 DO CASE
3630 CASE lcCostType = This.cCN_TOTAL_MATERIAL
3631 laAttrSeq[1] = lnCurSeq
3632 CASE lcCostType = This.cCN_PROD_VALUE
3633 laAttrSeq[2] = lnCurSeq
3634 CASE lcCostType = This.cCN_HS_LOOKUP
3635 laAttrSeq[3] = lnCurSeq
3636 CASE lcCostType = This.cCN_DUTY_VALUE
3637 laAttrSeq[4] = lnCurSeq
3638 CASE lcCostType = This.cCN_COMMISSION
3639 laAttrSeq[5] = lnCurSeq
3640 CASE lcCostType = This.cCN_TOTAL_COST
3641 laAttrSeq[6] = lnCurSeq
3642 OTHERWISE
3643 ENDCASE
3644 *--- TechRec 1004691 27-Apr-2004 GS ---
3645 *ENDIF
3646 *=== TechRec 1004691 27-Apr-2004 GS ===
3647 ENDFOR
3648 DO CASE
3649 CASE laAttrSeq[1] > laAttrSeq[2]
3650 lcString = "'Total Material' Cost Type must come before 'Production Value' Cost Type."
3651 CASE laAttrSeq[2] > laAttrSeq[3] AND laAttrSeq[3] > 0
3652 lcString = "'Production Value' Cost Type must come before 'Duty Value' Cost Type."
3653 CASE laAttrSeq[3] > laAttrSeq[6]
3654 lcString = "'Duty Value' Cost Type must come before 'Total Cost' Cost Type."
3655 CASE laAttrSeq[4] > laAttrSeq[6]
3656 lcString = "'HS Lookup' Cost Type must come before 'Total Cost' Cost Type."
3657 CASE laAttrSeq[5] > laAttrSeq[6]
3658 lcString = "'Agent Commisison' Cost Type must come before 'Total Cost' Cost Type."
3659 ENDCASE
3660 ENDIF
3661
3662 * further make sure all import trackings come after produciotn value.
3663 IF EMPTY(lcString)
3664 FOR lnxx = 1 TO ALEN(laCmp_type) - 1
3665 *---Tan34434 HH 09/26/02
3666 *IF EMPTY(laCmp_type[lnxx]) AND !EMPTY(laCostType[lnxx]) AND ;
3667 * !INLIST(laCostType[lnxx], This.cCN_TOTAL_MATERIAL, This.cCN_PROD_VALUE, This.cCN_DUTY_VALUE, ;
3668 * This.cCN_TOTAL_COST) && ATS 4752, CN_DUTIABLE_VALUE)
3669 IF EMPTY(laCmp_type[lnxx]) AND !EMPTY(laCostType[lnxx]) AND ;
3670 !INLIST(laCostType[lnxx], This.cCN_TOTAL_MATERIAL, This.cCN_PROD_VALUE, This.cCN_DUTY_VALUE, ;
3671 This.cCN_TOTAL_COST, This.cCN_ER_LOOKUP) && ATS 4752, CN_DUTIABLE_VALUE
3672 *===Tan34434 HH 09/26/02
3673 IF laCostSeq[lnxx] < laAttrSeq[2]
3674 lcString = "'Production Value' Cost Type must come before 'Import Tracking' Cost Type."
3675 ENDIF
3676 ENDIF
3677 ENDFOR
3678 ENDIF
3679
3680 IF !EMPTY(lcString)
3681 *--- TechRec 1045741 29-Sep-2010 jjanand ---
3682 *mb(lcString)
3683 IF This.lscheduled
3684 IF This.lEnableDebugging
3685 This.oLog.LogEntry(lcString)
3686 ENDIF
3687 ELSE
3688 mb(lcString)
3689 ENDIF
3690 *=== TechRec 1045741 29-Sep-2010 jjanand ===
3691 llRetVal = .F.
3692 ENDIF
3693
3694 RETURN llRetVal
3695
3696 ENDPROC
3697 *----------------------------------------------------------------------------------------
3698 * ATS 4693. get cost type.
3699 PROCEDURE GetCostType
3700 LPARAMETER tcCategory, tcCmp_type
3701
3702 LOCAL lcCost_type, lcDesc
3703 lcDesc = ""
3704
3705 DO CASE
3706 CASE tcCmp_type = RSV_ALL
3707 lcDesc = RSV_ALL
3708 CASE !EMPTY(tcCmp_type)
3709 lcDesc = vl_btypeh(tcCmp_type, "cmp_desc")
3710 OTHER
3711 *--- TechRec 1004691 27-Apr-2004 GS ---
3712 *lcCost_type = vl_dcatgr(tcCategory, "cost_type")
3713 =Seek(tcCategory, This.cCatAlias)
3714 lcCost_type = Evaluate(This.cCatAlias + ".Cost_Type")
3715 *=== TechRec 1004691 27-Apr-2004 GS ===
3716
3717 IF "SFCLBLUDF" $ lcCost_type
3718 lcDesc = UPPER(I(STRTRAN(RTRIM(lcCost_type) + LONG_OBJECTNAME_EXTENSION, "LBL")))
3719 ELSE
3720 lcDesc = lcCost_type
3721 ENDIF
3722 ENDCASE
3723
3724 RETURN lcDesc
3725
3726 ENDPROC
3727 *==========================================================================
3728
3729 Procedure GetCostByFormula && TAN 27161 RRB.
3730 LPARAMETERS pcFormula, pnRoundTo, pcTemplateAlias, pcCostField, pnCost, plDivideByZero
3731 LOCAL llRetVal, lcString, lnxx, lcToken, lnPos, lcError, lntk, llFound, lncost
3732 LOCAL ARRAY laToken[1]
3733 *
3734 * Parameters:
3735 * pnCost & plDivideByZero are output parameters, pass by reference
3736 * Source:
3737 * This method was based on the method m_GetCostByFormula in zzdcosth.vcx.
3738 * Notes:
3739 * Since this method will normally be called in a SCAN loop, it is important to
3740 * reset the record pointer of pcTemplateAlias back to its original position so that the
3741 * SCAN may continue normally. For an example of how this method is called,
3742 * see clsistpr.prg.
3743 *
3744 pnCost = 0
3745 plDivideByZero = false
3746 llRetVal = true
3747 lcToken = ""
3748 lncost = 0
3749
3750 lcString = pcFormula
3751 lcString = STRTRAN(lcString, '(', ' ( ') && replac '(' with blanks
3752 lcString = STRTRAN(lcString, ')', ' ) ') && replac '(' with blanks
3753 lcString = STRTRAN(lcString, '/', ' / ') && replac '(' with blanks
3754 lcString = STRTRAN(lcString, '*', ' * ') && replac '(' with blanks
3755 lcString = STRTRAN(lcString, '-', ' - ') && replac '(' with blanks
3756 lcString = STRTRAN(lcString, '+', ' + ') && replac '(' with blanks
3757 lcString = lcString + " "
3758
3759 WITH This
3760 .pushRecordSet()
3761 SELECT (pcTemplateAlias)
3762 .pushRecordSet()
3763
3764 * tokenize formula string into array, so that we can check for variable (category)
3765 StringToArray(lcString, @laToken, " ")
3766 FOR lnxx = 1 TO ALEN(laToken)
3767 lcToken = laToken[lnxx]
3768 *--- TAN 35242 10/31/02 AD
3769 *FOR lntk = 1 TO LEN(lcToken)
3770 * decide if this token is a variable field.
3771 IF BETWEEN(SUBSTR(lcToken, 1, 1), "A", "Z")
3772 SELECT (pcTemplateAlias)
3773 LOCATE FOR category == PADR(lcToken, 6)
3774 llFound = FOUND()
3775
3776 IF llFound
3777 *--- TechRec 1004691 28-Apr-2004 GS --- No Macros!
3778 *laToken[lnxx] = STR(&pcTemplateAlias..&pcCostField, 15, 5) && replace category with cost
3779 laToken[lnxx] = STR(Evaluate(pcTemplateAlias +'.'+pcCostField), 15, 5) && replace category with cost
3780 *=== TechRec 1004691 28-Apr-2004 GS ===
3781 ENDIF
3782 ENDIF
3783 *EXIT
3784 *ENDFOR
3785 ENDFOR
3786
3787 * construct string from array
3788 lcString = ArrayToString(@laToken, " ")
3789
3790 lcError = ON("ERROR")
3791
3792 *--- TechRec 1049776 08-Dec-2010 asharma ---
3793 * llRetVal working fine in Dev Environment but not in EXE
3794*!* ON ERROR llRetVal = false
3795 llTempRetVal = llRetVal
3796 ON ERROR llTempRetVal = .F.
3797 *=== TechRec 1049776 08-Dec-2010 asharma ===
3798
3799 TRY &&--- TechRec 1074785 21-Nov-2013 asharma ===
3800 lncost = EVALUATE(lcString) && Evaluate cost
3801 *--- TechRec 1074785 21-Nov-2013 asharma ---
3802 CATCH
3803 llTempRetVal = .F.
3804 ENDTRY
3805 *=== TechRec 1074785 21-Nov-2013 asharma ===
3806
3807 ON ERROR &lcError && restore system error handler
3808
3809 *--- TechRec 1049776 08-Dec-2010 asharma ---
3810 llRetVal = llTempRetVal
3811 *=== TechRec 1049776 08-Dec-2010 asharma ===
3812
3813 IF llRetVal
3814 IF "*" $ ALLTRIM(STR(lncost)) && Divide by 0 will result in numeric overflow
3815 plDivideByZero = true
3816 llRetVal = false
3817
3818 *--- TechRec 1049776 08-Dec-2010 asharma ---
3819 IF THIS.lAutoCreateCostSheet
3820 This.cMessage = "Division by Zero"
3821 ENDIF
3822 *=== TechRec 1049776 08-Dec-2010 asharma ===
3823
3824 ENDIF
3825 ENDIF
3826
3827 IF llRetVal
3828 pnCost = ROUND(lncost, pnRoundTo)
3829 ENDIF
3830
3831 .popRecordSet()
3832 .popRecordSet()
3833 ENDWITH
3834 RETURN llRetVal
3835 ENDFUNC
3836 *------------------ TAN 29836 01/15/02 YIK
3837 *- New function to calculate cost based on formula.
3838 *--- TAN 1004047 03/10/04 AD
3839 *- Added Round_To
3840 *=== TAN 1004047 03/10/04 AD
3841 PROCEDURE EvalCostFormula
3842 LPARAMETERS pcCostAlias, pcFormula, pnPodtlPkey, pcCategory, tnRound_To, tlShowMessage, tlForceShowMsg, poCostEstm &&-- TR 1011441 MA 06/22/05 added poCostEstm parameter
3843
3844 LOCAL lcString, lnxx, lcToken, lnPos, lcSelect, llRetVal, ;
3845 lnRecNo, lcDtlNo, lcMsgString, lntk, lncost
3846
3847 *-- TR 1011441 MA 06/22/05
3848 LOCAL llCostEstmObj
3849 llCostEstmObj = isObject(poCostEstm, .T.) and !isNull(poCostEstm.nQty) and poCostEstm.nQty > 0 && 1014307
3850 IF llCostEstmObj
3851 DIMENSION laTokenEstm[1]
3852 ENDIF
3853 *== TR 1011441 MA 06/22/05
3854
3855
3856 DIMENSION laToken[1]
3857 THIS.pushRecordSet()
3858
3859 llRetVal = .T.
3860 lcString = pcFormula
3861 lcString = STRTRAN(lcString, '(', ' ( ') && insert blanks around '('
3862 lcString = STRTRAN(lcString, ')', ' ) ') && insert blanks around ')'
3863 lcString = STRTRAN(lcString, '/', ' / ') && insert blanks around '/'
3864 lcString = STRTRAN(lcString, '*', ' * ') && insert blanks around '*'
3865 lcString = STRTRAN(lcString, '-', ' - ') && insert blanks around '-'
3866 lcString = STRTRAN(lcString, '+', ' + ') && insert blanks around '+'
3867 lcString = lcString + " "
3868
3869 lcToken = ""
3870 lncost = 0
3871
3872 SELECT (pcCostAlias)
3873 * tokenize formula string into array, so that we can check for variable (category)
3874 StringToArray(lcString, @laToken, " ")
3875
3876 *-- TR 1011441 MA 06/22/05
3877 IF llCostEstmObj
3878 =ACopy(laToken, laTokenEstm)
3879 ENDIF
3880 *=== TR 1011441 MA 06/22/05
3881
3882
3883 FOR lnxx = 1 TO ALEN(laToken)
3884 lcToken = laToken[lnxx]
3885 *--- TAN 35242 10/31/02 AD
3886 *FOR lntk = 1 TO LEN(lcToken)
3887 * decide if this token is a variable filed.
3888 IF BETWEEN(SUBSTR(lcToken, 1, 1), "A", "Z")
3889 * --- 1003958 CB 04/04 Optimized cost recalc. Use index:
3890 IF THIS.lOptimizedRecalc AND THIS.lDynamicsPrepped
3891 =SEEK(PADR(lcToken,6) + STR(pnPodtlPkey), THIS.cCstAlias, 'CatFKey')
3892 ELSE
3893*--- TR 1044856 09/14/10 AZ &&& 1046957
3894
3895* LOCATE FOR category == PADR(lcToken,6) AND fkey = pnPodtlPkey
3896**** 1044856 AZ
3897* ATAGINFO(larrindx)
3898
3899 if ATAGINFO(larrindx) > 0 AND ASCAN(larrindx,"CATGFKEY") > 0
3900
3901 =SEEK("B"+PADR(lcToken,6)+STR(pnPodtlPkey,9),pcCostAlias,"Catgfkey")
3902 else
3903 LOCATE FOR category == PADR(lcToken,6) AND fkey = pnPodtlPkey
3904 endif
3905*=== TR 1044856 09/14/10 AZ &&& 1046957
3906 ENDIF
3907 * === 1003958 End.
3908
3909 IF FOUND()
3910 laToken[lnxx] = STR(category_cost, 14, 5) && replace category with extension
3911
3912 *-- TR 1011441 MA 06/22/05
3913 IF llCostEstmObj
3914 laTokenEstm[lnxx] = STR(Estm_Ext_Cost/poCostEstm.nQTY, 14, 5) && replace category with extension
3915 ENDIF
3916 *=== TR 1011441 MA 06/22/05
3917
3918 ENDIF
3919 ENDIF
3920 *EXIT
3921 *ENDFOR
3922 ENDFOR
3923
3924 * construct string from array
3925 lcString = ArrayToString(@laToken, " ")
3926
3927 *-- TR 1011441 MA 06/22/05
3928 IF llCostEstmObj
3929 lcStringEstm = ArrayToString(@laTokenEstm, " ")
3930 ENDIF
3931 *=== TR 1011441 MA 06/22/05
3932
3933
3934 lcError = ON("ERROR")
3935
3936 *--- TechRec 1049776 08-Dec-2010 asharma ---
3937 * llRetVal working fine in Dev Environment but not in EXE
3938*!* ON ERROR llRetVal = .F.
3939 llTempRetVal = llRetVal
3940 ON ERROR llTempRetVal = .F.
3941 *=== TechRec 1049776 08-Dec-2010 asharma ===
3942
3943 TRY &&--- TechRec 1074785 21-Nov-2013 asharma ===
3944
3945 lncost = EVAL(lcString)
3946
3947 *-- TR 1011441 MA 06/22/05
3948 IF llCostEstmObj
3949 poCostEstm.nCostEstm = Evaluate(lcStringEstm)
3950 ENDIF
3951 *=== TR 1011441 MA 06/22/05
3952
3953 *--- TechRec 1074785 21-Nov-2013 asharma ---
3954 CATCH
3955 llTempRetVal = .F.
3956 ENDTRY
3957 *=== TechRec 1074785 21-Nov-2013 asharma ===
3958
3959 ON ERROR &lcError && restore system error handler
3960
3961 *--- TechRec 1049776 08-Dec-2010 asharma ---
3962 llRetVal = llTempRetVal
3963 *=== TechRec 1049776 08-Dec-2010 asharma ===
3964
3965 IF !llRetVal
3966 lcMsgString = "Category " + pcCategory + "contains invalid formula: " + MESSAGE()
3967 ELSE
3968 *-- TR 1011441 MA 06/22/05
3969 *IF lncost > 1000000000000 OR lncost < -1000000000000
3970 IF lnCost > 1000000000000 OR lnCost < -1000000000000 OR ;
3971 (llCostEstmObj AND (poCostEstm.nCostEstm > 1000000000000 OR poCostEstm.nCostEstm < -1000000000000))
3972 *=== TR 1011441 MA 06/22/05
3973 llRetVal = .F.
3974 lcMsgString ="Category " + pcCategory + "contains invalid formula: Divided by zero."
3975 ENDIF
3976 ENDIF
3977
3978 IF !llRetVal
3979 *--- TAN 34262 09/25/02 AD
3980 *- Do not display the message for rollup
3981*!* IF !This.lRollUpCost
3982*!* mb(lcMsgString + CHR(13) + "Formula: " + TRIM(pcFormula) + ;
3983*!* CHR(13) + "Resolved to: " + TRIM(lcString))
3984*!* ENDIF
3985 *=== TAN 34262 09/25/02 AD
3986
3987 *--- TR 1008559 VSS/SHAN 25-Jan-2005
3988 DO CASE
3989 CASE THIS.lAutoCreateCostSheet
3990 .cMessage = lcMsgString
3991
3992 CASE NOT THIS.lRollUpCost OR tlShowMessage OR tlForceShowMsg
3993 *--- TechRec 1045741 29-Sep-2010 jjanand ---
3994 *mb(lcMsgString + CHR(13) + "Formula: " + TRIM(pcFormula) + ;
3995 CHR(13) + "Resolved to: " + TRIM(lcString))
3996
3997 lcMsgString = lcMsgString + CHR(13) + "Formula: " + TRIM(pcFormula) + ;
3998 CHR(13) + "Resolved to: " + TRIM(lcString)
3999
4000 IF This.lscheduled
4001* IF This.lEnableDebugging &&& 1078623
4002 IF TYPE("this.olog") = "O" &&& 1078623
4003
4004 This.oLog.LogEntry(lcMsgString)
4005 ENDIF
4006 ELSE
4007 mb(lcMsgString)
4008 ENDIF
4009 *=== TechRec 1045741 29-Sep-2010 jjanand ===
4010 ENDCASE
4011 *=== TR 1008559 VSS/SHAN 25-Jan-2005
4012
4013 lncost = 0
4014
4015 *-- TR 1011441 MA 06/22/05
4016 IF llCostEstmObj
4017 poCostEstm.nCostEstm = 0
4018 ENDIF
4019 *=== TR 1011441 MA 06/22/05
4020
4021
4022 ENDIF
4023
4024 THIS.popRecordSet()
4025
4026 *--- TAN 1004047 03/10/04 AD
4027 IF VARTYPE(tnRound_To) = 'N'
4028 lnCost = ROUND(lnCost, tnRound_To)
4029
4030 *-- TR 1011441 MA 06/22/05
4031 IF llCostEstmObj
4032 poCostEstm.nCostEstm = ROUND(poCostEstm.nCostEstm, tnRound_To)
4033 ENDIF
4034 *=== TR 1011441 MA 06/22/05
4035 ENDIF
4036 *=== TAN 1004047 03/10/04 AD
4037 RETURN lncost
4038
4039 ENDPROC
4040
4041
4042 *---------------------------------------------------------------------------------------------------------------
4043
4044 *---------------------------------------------------------------------------------------------------------------
4045 * PL 03/01/02 29378 MPO (Multi-level BOM & Cost sheet)
4046 *---------------------------------------------------------------------------------------------------------------
4047 Procedure AddMultiCostSheet && 03/16
4048 Parameter pcProdHdr, pcProdDtl, pcProdCost, pcProdCostFrozen, pcProdBOM
4049 Local llRetVal, lnOldSelect, lnPrvProdDtlPkey, lnCostLevelPkey, lnOpen_Seq
4050 Local lcContractor, lnFKey, lnParKey && *--- TechRec 1004691 28-Apr-2004 GS ---
4051 llRetVal = .T.
4052 *--- TechRec 1026008 09-Aug-2007 GSternik ---
4053 If EoF(pcProdDtl)
4054 Return llRetVal
4055 EndIf
4056 *=== TechRec 1026008 09-Aug-2007 GSternik ===
4057
4058 lnOldSelect = Select()
4059
4060
4061 With This
4062 * Save the following alias: production header,detail,bom
4063 Select (pcProdHdr)
4064 .pushRecordSet()
4065 Select (pcProdDtl)
4066 .pushRecordSet()
4067 Select (pcProdCost)
4068 .pushRecordSet()
4069 Select (pcProdCostFrozen)
4070 .pushRecordSet()
4071 * Clear all PO Dtl filter
4072 Select (pcProdDtl)
4073 Set Filter To
4074 *--- TAN 36993 02/14/03 AD
4075 *- If prev has no cost sheet, copy from next if any, otherwise from std
4076 *SELECT(pcProdDtl) GS 1026008
4077 *.PushRecordSet() GS 1026008
4078
4079 LOCAL lnDtlPKey, lnNextCostFkey, lnShp_Seq
4080 *--- TechRec 1026008 09-Aug-2007 GSternik ---
4081 *-- Old BUG!!
4082 *lnShp_Seq = PKey && 1004691 27-Apr-2004 GS - removed macro
4083 lnShp_Seq = Shp_Seq
4084 *=== TechRec 1005421 07-Jul-2004 GS ===
4085
4086 lnDtlPKey = PKey && 1004691 27-Apr-2004 GS - removed macro
4087 *--- TAN 37823 09-Jul-2003 GS ---
4088 lnOpen_Seq = Open_Seq
4089 *=== TAN 37823 09-Jul-2003 GS ===
4090 lnNextCostFkey = 0
4091
4092 *--- TechRec 1026008 09-Aug-2007 GSternik ---
4093 Local lnStage_Num, lcTree_Seq, lnRecNo
4094
4095 lnRecNo = RecNo()
4096 lnStage_Num =Stage_Num
4097 lcTree_Seq = Trim(Tree_Seq)
4098
4099 Scan for Stage_Num > lnStage_Num and Tree_Seq = lcTree_Seq && Assume EXACT OFF!
4100 lnDtlPKey = PKey
4101 Select (pcProdCost)
4102 Locate For FKey = lnDtlPKey
4103
4104 If Found()
4105 lnNextCostFKey = lnDtlPKey
4106 Exit
4107 EndIf
4108 EndScan
4109
4110 Go lnRecNo
4111
4112 *SELECT(pcProdDtl)
4113 *.PopRecordSet()
4114 *=== TechRec 1026008 09-Aug-2007 GSternik ===
4115
4116 *--- TechRec 1004691 28-Apr-2004 GS --- added to remove macros
4117 lcContractor = Evaluate(pcProdHdr +".contractor")
4118 lnFKey = FKey
4119 lnParKey = ParKey
4120 *=== TechRec 1004691 28-Apr-2004 GS ===
4121
4122
4123 *--- TechRec 1026008 09-Aug-2007 GSternik ---
4124 IF !EMPTY(lnNextCostFkey) .AND. lnShp_Seq > 0
4125 *=== TechRec 1026008 09-Aug-2007 GSternik ===
4126
4127 *llRetVal= .AddCostSheetFromNext(&pcProdHdr..contractor, &pcProdDtl..stage_num, &pcProdDtl..pkey, ;
4128 * lnNextCostFkey, pcProdCost)
4129 llRetVal= .AddCostSheetFromNext(lcContractor, ;
4130 Stage_Num, Pkey, lnNextCostFkey, pcProdCost, , .T.)
4131 ELSE
4132 * if previous stage has cost sheet, use it as template, b/c something may be changed.
4133 Select (pcProdCost)
4134 *Locate For prodHdrFkey = &pcProdDtl..fkey AND fkey = &pcProdDtl..parkey
4135*--- TR 1044856 09/14/10 AZ &&& 1046957
4136**** 1044856
4137* ATAGINFO(larrindx)
4138
4139 if ATAGINFO(larrindx) > 0 AND ASCAN(larrindx,"SFKEYCOST") > 0
4140
4141 =SEEK ("B"+STR(lnFKey,9)+STR(lnParKey,9), "vzzccostd","SFKEYCOST")
4142 else
4143 Locate For prodHdrFkey = lnFKey AND fkey = lnParKey
4144 endif
4145
4146* Locate For prodHdrFkey = lnFKey AND fkey = lnParKey
4147*=== TR 1044856 09/14/10 AZ &&& 1046957
4148
4149 If Found()
4150
4151 SELECT(pcProdDtl)
4152 *llRetVal= .AddCostSheetFromPrv(&pcProdHdr..contractor, &pcProdDtl..stage_num, &pcProdDtl..pkey, ;
4153 * &pcProdDtl..parkey, pcProdCost)
4154 llRetVal= .AddCostSheetFromNext(lcContractor, Stage_Num, Pkey, ;
4155 ParKey, pcProdCost, , lnShp_Seq > 0)
4156 Else
4157 *!* *--- TAN 36993 02/14/03 AD
4158 *!* *- If prev has no cost sheet, copy from next if any, otherwise from std
4159 *!* SELECT(pcProdDtl)
4160 *!* .PushRecordSet()
4161 *!* LOCAL lnDtlPKey, lnNextCostFkey
4162 *!* lnDtlPKey = &pcProdDtl..pkey
4163 *!* lnNextCostFkey = 0
4164 *!* DO WHILE !EOF(pcProdDtl)
4165 *!* LOCATE FOR Parkey = lnDtlPKey
4166 *!* IF FOUND(pcProdDtl)
4167 *!* lnDtlPKey = &pcProdDtl..pkey
4168 *!* SELECT(pcProdCost)
4169 *!* LOCATE FOR FKey = lnDtlPKey
4170 *!* IF FOUND(pcProdCost)
4171 *!* lnNextCostFkey = lnDtlPKey
4172 *!* EXIT
4173 *!* ENDIF
4174 *!* SELECT(pcProdDtl)
4175 *!* ELSE
4176 *!* EXIT
4177 *!* ENDIF
4178 *!* ENDDO
4179 *!* SELECT(pcProdDtl)
4180 *!* .PopRecordSet()
4181 IF !EMPTY(lnNextCostFkey)
4182 SELECT(pcProdDtl)
4183 *llRetVal= .AddCostSheetFromNext(&pcProdHdr..contractor, &pcProdDtl..stage_num, &pcProdDtl..pkey, ;
4184 * lnNextCostFkey, pcProdCost)
4185 llRetVal= .AddCostSheetFromNext(lcContractor, Stage_Num, Pkey, ;
4186 lnNextCostFkey, pcProdCost, , lnShp_Seq > 0)
4187 ELSE
4188 *=== TAN 36993 02/14/03 AD
4189 * if previous stage has No cost sheet, locate base cost sheel template
4190 llRetVal= .AddMultiCostSheetFromBase(pcProdHdr, pcProdDtl, pcProdCost, pcProdCostFrozen, pcProdBOM)
4191 ENDIF
4192 Endif
4193 ENDIF
4194
4195 *--- TAN 37823 09-Jul-2003 GS ---
4196 select (pcProdCost)
4197*--- TR 1044856 09/14/10 AZ &&& 1046957
4198
4199***** 1044856 AZ
4200* ATAGINFO(larrindx)
4201* if ASCAN(larrindx,"COSTNFKEY") > 0
4202 if ATAGINFO(larrindx) > 0 AND ASCAN(larrindx,"COSTFKEY") > 0
4203
4204* =SEEK (lnDtlPKey, "vzzccostd","COSTFKEY")
4205 =SEEK ("B"+STR(lnDtlPKey,9), "vzzccostd","COSTFKEY")
4206 else
4207 locate for fKey = lnDtlPKey
4208 endif
4209
4210* locate for fKey = lnDtlPKey
4211*=== TR 1044856 09/14/10 AZ &&& 1046957
4212
4213 * 1003958 03/05 CB - Future potential optimization - replace SCAN FOR (below) with SEEK...SCAN WHILE.
4214 * When zzcordrh instantiates the costing object, it calls oBPOCost.IndexBOMAndCost, which puts an
4215 * index on Vzzccostd.FKey for SysLevel = 0. Not doing as part of this TR, as this is not involved in
4216 * the cost sheet calculation process.
4217 if Found()
4218 lnCostLevelPkey = CostLevelPKey
4219 replace CostLevelPKey with lnCostLevelPKey ;
4220 for SysLevel = 0 and Open_Seq = lnOpen_Seq ;
4221 and CostLevelPKey = 0 in (pcProdBOM)
4222 endif
4223 *=== TAN 37823 09-Jul-2003 GS ===
4224
4225 * recal bom cost
4226 .lNeedRecalCost= .T.
4227
4228 * Restore alias
4229 Select (pcProdCostFrozen)
4230 .popRecordSet()
4231 Select (pcProdCost)
4232 .popRecordSet()
4233 Select (pcProdDtl)
4234 .popRecordSet()
4235 Select (pcProdHdr)
4236 .popRecordSet()
4237 Endwith
4238
4239 Select(lnOldSelect)
4240 Return llRetVal
4241 Endproc
4242
4243 *---------------------------------------------------------------------------------------------------------------
4244 * create new production cost sheet from base.
4245 *---------------------------------------------------------------------------------------------------------------
4246 Procedure AddMultiCostSheetFromBase && 03/16
4247 Parameter pcProdHdr, pcProdDtl, pcProdCost, pcProdCostFrozen, pcProdBOM
4248 Local llRetVal, lnOldSelect, lnBaseCostSheetPkey, lnCurDetailPkey, lcProd_Type, ;
4249 lcSKUTypCntr, lcSKU, lnBOMLevel, lcContractor, lcSeason, lnRngPkey, lcShipto
4250 *--- TechRec 1059007 10-Feb-2012 jisingh Added lcShipto ===
4251
4252 llRetVal = .T.
4253 lnOldSelect = Select()
4254 With This
4255
4256 * Level 0 : as before cost sheet from production detail SKU
4257 * 4/9/02 - add BOMLevelPkey to both clsBOM & ClsCost use for grouping BOM items
4258 * during calculate Prod Cost Sheet that need BOM
4259 * Level 0 : use Prod Dtl PKEY (16th Parameter)
4260 * Level 1+: use Parent Prod BOM PKEY
4261 .nCostLevelpkey= 0 && 16/4
4262
4263 *--- TechRec 1002576 21-Jan-2004 GS --- Added llRetVal ceck to all calls
4264 *--- TechRec 1004691 27-Apr-2004 GS ---
4265 select (pcProdHdr)
4266 lcContractor = Contractor
4267 *--- TR 1027820 21-May-2008 CD ---
4268 *--- and use it in addCostSheetFromBase...
4269 lcSeason = Season
4270 *=== TR 1027820 21-May-2008 CD ===
4271
4272 *--- 1032015 04/14/09 Ilya:
4273 lcProd_Type = prod_type
4274 *=== 1032015 04/14/09 Ilya.
4275
4276 select (pcProdDtl)
4277 *--- Macro removed:
4278
4279 *--- TechRec 1059007 10-Feb-2012 jisingh ---
4280 lcShipto = shipto
4281 *=== TechRec 1059007 10-Feb-2012 jisingh ===
4282
4283 *--- 1032015 04/14/09 Ilya: For P Range Styles we might need to autocreate
4284 * the base cost sheet first
4285 IF .lPORangeimplosion
4286 lnRngPkey = vl_rangr(division,"pkey",,style,color_code,lbl_code,dimension,'P')
4287 IF lnRngPkey > 0
4288 = .CreateBaseCSFromRangeStyle(lnRngPkey,lcContractor,lcProd_Type,lcSeason)
4289 ENDIF
4290 ENDIF
4291
4292 *--- TR 1033971 11-Sep-2008 Goutam Added pcProdDtl in the below parameter list
4293 *--- TechRec 1059007 10-Feb-2012 jisingh Added lcShipto ===
4294 llRetVal =;
4295 .AddCostSheetFromBase(Division, Style, Color_Code,;
4296 Lbl_Code, Dimension, lcContractor, Prod_Type,;
4297 FKey, PKey, Prod_Num, Open_Seq, ;
4298 Stage_Num, 0, pcProdCost, pcProdCostFrozen, PKey, pcProdHdr, lcSeason, pcProdDtl, lcShipto) && same as bom syslevel= 0
4299 *=== TechRec 1004691 27-Apr-2004 GS ===
4300 * 16/4
4301
4302 *--- TechRec 1057126 13-Oct-2011 MA --- no cost from BOM if not cost sheet resolution
4303 IF llRetVal And .lNoPrdCstFrmBOM
4304 llRetVal = llRetVal and !.lNoBaseCostSheet
4305 ENDIF
4306 *=== TechRec 1057126 13-Oct-2011 MA ===
4307
4308 If llRetVal and .nCostLevelpkey> 0
4309 Select (pcProdBOM)
4310 .PushRecordSet()
4311 *--- TechRec 1004691 28-Apr-2004 GS ---
4312 *lcSKU= &pcProdDtl..division + &pcProdDtl..style + &pcProdDtl..color_code +;
4313 * &pcProdDtl..lbl_code + &pcProdDtl..dimension
4314 select (pcProdDtl)
4315 lcSKU= division + style + color_code + lbl_code + dimension
4316 *=== TechRec 1004691 28-Apr-2004 GS ===
4317 Replace all CostLevelPKey with .nCostLevelpkey For ParBOMSKU= lcSKU And ;
4318 SysLevel= 0 In (pcProdBOM)
4319 .PopRecordSet()
4320 Endif
4321
4322 *--- TAN 37127 02/05/03 AD
4323 *--- TAN 34747 10/29/02 AD
4324
4325 *.lMultiLevelBOM = SEEK(STR(&pcProdDtl..pkey) + STR(1), pcProdBOM, 'BOMMstPkey')
4326 *- Find multilevel BOM for current or prior stage
4327 select (pcProdDtl)
4328 LOCAL lnMultiLevelBOMFkey
4329 if llRetVal
4330 lnMultiLevelBOMFkey = .FindMultiLevelBOMFkey(pcProdDtl, pcProdBOM, PKey)
4331 endif
4332
4333 .lMultiLevelBOM = !EMPTY(lnMultiLevelBOMFkey)
4334 *=== TAN 34747 10/29/02 AD
4335 *--- TAN 37127 02/05/03 AD
4336
4337 * Multi-level BOM need to create Multi-level cost sheet
4338 * Level 1+: cost sheet for each distinct sub level BOM components (--only when .lMultiLevelBOM set)
4339 If llRetVal and .lMultiLevelBOM
4340 *--- TAN 37127 02/05/03 AD
4341 *lnCurDetailPkey= &pcProdDtl..pkey
4342 *=== TAN 37127 02/05/03 AD
4343
4344 *--- TechRec 1004691 27-Apr-2004 GS ---
4345 local lnProdDtlPKey, lnProdDtlFKey
4346 select (pcProdDtl)
4347 lnProdDtlPKey = PKey
4348 lnProdDtlFKey = FKey
4349 *=== TechRec 1004691 27-Apr-2004 GS ===
4350
4351 lcSKUTypCntr= ""
4352 Select (pcProdBOM)
4353 .PushRecordSet()
4354 Set Order to SKUTypCntr
4355
4356 lcMessage = "Creating Multi-level Cost Sheet "
4357 lnRec= 0
4358 lnMaxRec=Recc(pcProdBOM)
4359
4360 *--- TAN 37127 02/05/03 AD
4361 *Scan for fkey= lnCurDetailPkey
4362 SCAN FOR FKey= lnMultiLevelBOMFkey
4363 *=== TAN 37127 02/05/03 AD
4364 If Not (division + style + color_code + lbl_code + dimension + ;
4365 prod_type == lcSKUTypCntr)
4366 lcSKUTypCntr= division + style + color_code + lbl_code + dimension +;
4367 prod_type
4368
4369 lcSKU= division + style + color_code + lbl_code + dimension && 16/4
4370 .nCostLevelpkey= 0 && 16/4
4371 *--- TechRec 1004691 28-Apr-2004 GS --- reduces macro usage :
4372*!* lnBOMLevel= (&pcProdBOM..syslevel + 1) && 16/4
4373 lnBOMLevel = (SysLevel + 1) && 16/4
4374
4375 * 9/4/02 Level 1+: use Parent Prod BOM PKEY (16th Parameter)
4376 *--- TechRec 1002576 21-Jan-2004 GS --- Added llRetVal to all calls
4377*!* llRetVal = ;
4378*!* .AddCostSheetFromBase(&pcProdBOM..division, &pcProdBOM..style, &pcProdBOM..color_code,;
4379*!* &pcProdBOM..lbl_code, &pcProdBOM..dimension, &pcProdHdr..contractor, &pcProdBOM..prod_type,;
4380*!* &pcProdDtl..fkey, &pcProdDtl..pkey, &pcProdBOM..prod_num, &pcProdBOM..open_seq, ;
4381*!* &pcProdBOM..stage_num, (&pcProdBOM..syslevel + 1), pcProdCost, pcProdCostFrozen, ; && same as bom syslevel 1
4382*!* &pcProdBOM..pkey, pcProdHdr)
4383
4384 *--- TR 1033971 11-Sep-2008 Goutam Added pcProdDtl in the below parameter list
4385 *--- 1032015 4/10/2009 Ilya: Added lcSeason to parameter list (was missed in 1027820)
4386 *--- TechRec 1059007 10-Feb-2012 jisingh Added lcShipto ===
4387 llRetVal = ;
4388 .AddCostSheetFromBase(Division, Style, Color_Code,;
4389 Lbl_Code, Dimension, lcContractor, Prod_Type,;
4390 lnProdDtlFKey, lnProdDtlPKey, Prod_Num, Open_Seq, ;
4391 Stage_Num, (SysLevel + 1), pcProdCost, pcProdCostFrozen, PKey, pcProdHdr,lcSeason,pcProdDtl, lcShipto)
4392 *=== TechRec 1004691 28-Apr-2004 GS ===*=== TechRec 1004691 27-Apr-2004 GS === no macros!
4393 *--- TechRec 1002576 21-Jan-2004 GS ---
4394 if !llRetVal
4395 exit
4396 endif
4397 *=== TechRec 1002576 21-Jan-2004 GS ===
4398
4399 * 16/4
4400 If .nCostLevelpkey> 0
4401 Select (pcProdBOM)
4402 .PushRecordSet()
4403 Replace all CostLevelPKey with .nCostLevelPKey For ParBOMSKU= lcSKU And ;
4404 SysLevel= lnBOMLevel In (pcProdBOM)
4405 .PopRecordSet()
4406 Endif
4407
4408 lnRec= lnRec+ 1
4409 *--- TAN 34027 09/19/02 AD
4410 *Thermo(lcMessage, lnRec, lnMaxRec)
4411 *=== TAN 34027 09/19/02 AD
4412 Endif
4413 Endscan
4414 .PopRecordSet()
4415 Endif
4416 Endwith
4417
4418 Select(lnOldSelect)
4419 Return llRetVal
4420 Endproc
4421
4422 *---------------------------------------------------------------------------------------------------------------
4423 *
4424 *---------------------------------------------------------------------------------------------------------------
4425 * 9/4/02 add BOMLevelPkey - grouping BOM items that belong to same Parent level BOM for
4426 * calculate Prod Cost Sheet with BOM
4427 Procedure AddCostSheetFromBase
4428 *--- TR 1027820 21-May-2008 CD --- Added Season param...use it in vl_getBaseCostSheet.
4429 Parameters pcDivision, pcStyle, pcColor, pcLabel, pcDimension, pcContractor, pcProd_type, ;
4430 pnHdrPkey, pnDtlPkey, pnProd_num, pnOpen_seq, pnStage_num, pnSyslevel, pcProdCost, ;
4431 pcProdCostFrozen, pnBOMLevelPkey, tcProdHdr, pcSeason, tcProdDtl, pcShipto
4432 *--- TechRec 1059007 10-Feb-2012 jisingh Added pcShipto ===
4433 *--- TR 1033971 11-Sep-2008 Goutam Added tcProdDtl in above parameter list
4434
4435 Local llRetVal, lnOldSelect, lnBaseCostSheetPkey
4436 llRetVal = .T.
4437 lnOldSelect = Select()
4438 With This
4439 Endwith
4440 * find the base cost sheet to copy from.
4441 *--- TechRec 1059007 10-Feb-2012 jisingh Added pcShipto ===
4442 lnBaseCostSheetPkey= vl_GetBaseCostSheet(pcDivision, pcStyle, pcColor, pcLabel, ;
4443 pcDimension, pcProd_type, pcContractor, "pkey", "curBaseCost",,pcSeason, pcShipto) && GS Jan 01 2004 added alias
4444 If pnSyslevel= 0
4445 .lNoBaseCostSheet= Empty(lnBaseCostSheetPkey) && 5/15
4446 Endif
4447 If !Empty(lnBaseCostSheetPkey) && copy from base cost sheet.
4448
4449 *--- TechRec 1002576 31-Dec-2003 GS ---
4450 .cBaseCostCurrency = curBaseCost.Curr_Code
4451 .nBaseCostKey = lnBaseCostSheetPkey
4452 *=== TechRec 1002576 31-Dec-2003 GS ===
4453
4454 * Create a frozen cost sheet.
4455 llRetVal = llRetVal and .CreateFrozenCostSheet(pcDivision, pcStyle, pcColor, ;
4456 pcLabel, pcDimension, pcContractor, pcProd_type, pnHdrPkey, pnOpen_seq, pnDtlPkey, ;
4457 lnBaseCostSheetPkey, pnProd_num, pnSyslevel, pcProdCostFrozen,, pnBOMLevelPkey, tcProdHdr)
4458
4459 llRetVal = llRetVal and .AddCostSheet(pcDivision, pcStyle, pcColor, pcLabel, ;
4460 pcDimension, pcContractor, pcProd_type, pnHdrPkey, pnOpen_seq, pnStage_num, ;
4461 pnDtlPkey, lnBaseCostSheetPkey, pnProd_num, pnSyslevel, pcProdCost,, pnBOMLevelPkey, tcProdHdr)
4462
4463 *--- TR 1044774 NSD Get org curr and rate from the po detail, not the header
4464 SELECT (tcProdDtl)
4465 LOCAL lcOrgCurr,lcOrgRate
4466 lcOrgCurr = EVALUATE(tcProdDtl + ".org_curr")
4467 lcOrgRate = EVALUATE(tcProdDtl + ".org_rate")
4468 SELECT (pcProdCost)
4469 SCAN FOR fkey = pnDtlPkey
4470 replace org_curr WITH lcOrgCurr,org_rate WITH lcOrgRate
4471 ENDSCAN
4472 *=== TR 1044774 NSD Get org curr and rate from the po detail, not the header
4473
4474 *--- TechRec 1031906 28-May-2008 SKG ---
4475 *--- TR 1033971 11-Sep-2008 Goutam
4476 *REPLACE printCostOnPO WITH curBaseCost.printCostOnPO IN vzzcordrd
4477 REPLACE printCostOnPO WITH curBaseCost.printCostOnPO IN (tcProdDtl)
4478 *=== TechRec 1031906 28-May-2008 SKG ===
4479
4480 Endif
4481 Select(lnOldSelect)
4482 Return llRetVal
4483 Endproc
4484
4485 *---------------------------------------------------------------------------------------------------------------
4486 * create new production cost sheet.
4487 *---------------------------------------------------------------------------------------------------------------
4488 * old code in Production UI: m_addcostsheet
4489 * new parameters: pcProdCost (Vzzccostd), optional pnCostPkey(for get batch of pkeys latter)
4490 * 9/4/02 add BOMLevelPkey - grouping BOM items that belong to same Parent level BOM for
4491 * calculate Prod Cost Sheet with BOM
4492 Procedure AddCostSheet
4493 Parameters pcDivision, pcStyle, pcColor, pcLbl, pcDimension, pcContractor, pcProd_type, pnHdrPkey, ;
4494 pnOpen_seq, pnStage_num, pnDtlPkey, pnPkey, pnProd_num, pnSyslevel, pcProdCost, pnCostPkey, ;
4495 pnBOMLevelPkey, tcProdHdr && *--- TechRec 1002576 02-Jan-2004 GS --- added tcProHdr
4496 Local llRetVal, lnOldSelect, lcSqlString, lnPrvProdDtlPkey, lcPO_Curr_Code
4497 llRetVal = .T.
4498 lnOldSelect = Select()
4499 With This
4500
4501 * populate production cost sheet (vzzccostd) to memory.
4502 Select (pcProdCost)
4503 Scatter memvar memo
4504
4505 * initial these fields first, they not in prod cost sheet (vzzdcostd.)
4506 m.prod_num = pnProd_num
4507 m.Open_seq = pnOpen_seq
4508 m.stage_num = pnStage_num
4509 m.extension = 0
4510 *--- TechRec 1003897 26-Mar-2004 GS ---
4511 m.Estm_Ext_Cost = 0 && Just in case :o)
4512 *=== TechRec 1003897 26-Mar-2004 GS ===
4513
4514 * use template detail record.
4515 lcSqlString = "SELECT * FROM zzdcostd WHERE fkey = ?pnPkey order by line_seq"
4516 llRetVal= v_SQLPrep(lcSqlString, "TmpdCur", "")
4517 If llRetVal
4518 *--- TechRec 1002576 02-Jan-2004 GS ---
4519 local lnLine700
4520 lnLine700 = Int(Val(goEnv.sv("WHOSESALEPRICELINE", "700")))
4521
4522 m.Curr_Code = TmpdCur.Curr_Code
4523 if Empty(tcProdHdr) && just in case
4524 tcProdHdr = 'vzzcordrh'
4525 endif
4526 select (tcProdHdr)
4527 lcPO_Curr_Code = Curr_Code
4528 m.Payee_Curr = Payee_Curr
4529 m.Div_Curr = Div_Curr
4530 m.Co_Curr = Co_Curr
4531 m.Payee_Rate = Payee_Rate
4532 m.Div_Rate = Div_Rate
4533 m.Co_Rate = Co_Rate
4534 lnExchangeRate = GetPOExchangeRate(tcProdHdr, m.Curr_Code)
4535 *=== TechRec 1002576 23-Jan-2004 GS ===
4536
4537 *--- 1007898 12/06/04 Ilya: Multi-organization currency support
4538 m.org_curr = org_curr
4539 m.org_rate = org_rate
4540 *=== 1007898 12/06/04 Ilya.
4541
4542 Select TmpdCur
4543 Scan
4544 Scatter Memvar Memo
4545 m.Division = pcDivision
4546 m.Style = pcStyle
4547 m.Color_Code = pcColor && must do these because color in zzdcostd may be empty
4548 m.Lbl_Code = pcLbl
4549 m.Dimension = pcDimension
4550 m.Contractor = pcContractor
4551 m.Prod_Type = pcProd_type
4552 m.User_Id = g_cuser
4553 m.Last_Mod = Datetime()
4554 m.pKey = iif(Empty(pnCostPkey), v_NextPkey("zzccostd") ,pnCostPkey)
4555 m.fKey = pnDtlPkey
4556 m.ProdHdrFkey = pnHdrPkey
4557 m.SysLevel= pnSyslevel
4558 m.LevelPkey= iif(pnSysLevel> 0, pnPkey,0) && 03/18/02 same as base costsheet's pkey
4559 m.BomLevelPkey= iif(pnBOMLevelPkey> 0, pnBOMLevelPkey, 0) && 9/4
4560 m.CostLevelpkey= pnPkey && 16/4
4561 .nCostLevelPkey= pnPkey && 16/4
4562 m.Curr_Code = lcPO_Curr_Code
4563 *--- TechRec 1002576 02-Jan-2004 GS ---
4564 m.Constant = m.Constant * lnExchangeRate
4565 if Empty(m.Formula) or !Empty(m.Cmp_Type) ;
4566 or InList(m.Line_Seq, 400, 500, 550, lnLine700)
4567 m.Category_Cost = m.Category_Cost * lnExchangeRate
4568 endif
4569 *=== TechRec 1002576 23-Jan-2004 GS ===
4570 Insert into (pcProdCost) From Memvar
4571 Endscan
4572 Use In Select('TmpdCur')
4573 Endif
4574 Endwith
4575 Select(lnOldSelect)
4576 Return llRetVal
4577 Endproc
4578
4579 *---------------------------------------------------------------------------------------------------------------
4580 * create new production cost sheet use previous stage's cost sheet as template.
4581 *---------------------------------------------------------------------------------------------------------------
4582 * old code in Production UI: m_addcostsheetfromold
4583 * new parameters: pcProdCost (Vzzccostd), optional pnCostPkey (for get batch of pkeys latter)
4584 Procedure AddCostSheetFromPrv
4585 Parameters pcContractor, pnStage_Num, pnDtlPKey, pnParkey, pcProdCost, pnCostPkey
4586
4587 *--- TechRec 1026008 10-Aug-2007 GSternik ---
4588 *-- Removed. Must be the same as AddCostSheetFromNext
4589 Return AddCostSheetFromNext(@pcContractor, pnStage_Num, pnDtlPKey, pnParkey, @pcProdCost, pnCostPkey)
4590 *=== TechRec 1026008 10-Aug-2007 GSternik ===
4591
4592*!* Local llRetVal,lnOldSelect,lnRecNo
4593
4594*!* *--- TechRec 1007154 06-Oct-2004 GS ---
4595*!* local llNeed_ER_Lookup
4596*!* llNeed_ER_Lookup = This.lER_Lookup
4597*!* *=== TechRec 1007154 06-Oct-2004 GS ===
4598
4599*!* llRetVal = .T.
4600*!* lnOldSelect = Select()
4601*!* With This
4602*!* Select (pcProdCost)
4603*!* .pushRecordSet()
4604*!* Scan For fkey = pnParkey
4605*!* lnRecNo = recno()
4606*!* Scatter Memvar Memo
4607*!* m.contractor = pcContractor
4608*!* m.stage_num = pnStage_num
4609*!* m.pkey = iif(Empty(pnCostPkey), v_NextPkey("zzccostd") ,pnCostPkey)
4610*!* m.fkey = pnDtlPkey
4611*!* m.user_id = g_cuser
4612*!* m.last_mod = Datetime()
4613*!* *--- TechRec 1007154 28-Sep-2004 GS ---
4614*!* if llNeed_ER_Lookup and Seek(m.Category, .cCatAlias)
4615*!* select (.cCatAlias)
4616*!* if AllTrim(Cost_Type) == This.cCN_ER_LOOKUP && and (!This.lLast_Stage or RecNo() < 0)
4617*!* llNeed_ER_Lookup = .F.
4618*!* if Empty(m.Constant)
4619*!* m.Category_Cost = vl_ExRate("","EXH_RATE")
4620*!* If Empty(m.Category_Cost) && could be .F.
4621*!* m.Category_Cost = 0
4622*!* Endif
4623*!* else
4624*!* m.Category_Cost = m.Constant
4625*!* endif
4626*!* m.Extension = 0
4627*!* m.Estm_Ext_Cost = 0
4628*!* endif
4629*!* select (pcProdCost)
4630*!* Endif
4631*!* *=== TechRec 1007154 06-Oct-2004 GS ===
4632
4633*!* Append Blank
4634*!* Gather Memvar Memo
4635*!* Go lnRecNo
4636*!* Endscan
4637*!* .popRecordSet()
4638*!* Endwith
4639*!* Select(lnOldSelect)
4640*!* Return llRetVal
4641 Endproc
4642
4643 *--- TAN 36993 02/14/03 AD
4644 *--- TechRec 1026008 10-Aug-2007 GSternik --- Use this Program for all cases (Next/Prev)
4645 PROCEDURE AddCostSheetFromNext
4646 LPARAMETERS tcContractor, tnStage_Num, tnDtlPkey, tnSourceCostFkey, tcProdCost, tnCostPkey, tlHas_Imp_Cost
4647 LOCAL llRetVal,lnSelect,lnRecNo
4648
4649 *--- TechRec 1007154 06-Oct-2004 GS ---
4650 local llNeed_ER_Lookup
4651 llNeed_ER_Lookup = This.lER_Lookup
4652 *=== TechRec 1007154 06-Oct-2004 GS ===
4653
4654 llRetVal = .T.
4655 lnSelect = SELECT()
4656 WITH This
4657 SELECT(tcProdCost)
4658 .PushRecordSet()
4659
4660*!* *--- TechRec 1026008 09-Aug-2007 GSternik ---
4661*!* *-- AP_Cost category might already exists for the previously cancelled line:
4662*!* Local lnExistingCount, p
4663*!* Local Array laAP_Costs[1]
4664*!* lnExistingCount = 0
4665*!*
4666*!* Scan for FKey = tnDtlPkey
4667*!* replace User_ID with g_cUser, Last_Mod with DateTime(), AP_Cost with 'Y'
4668*!* lnExistingCount = lnExistingCount + 1
4669*!* Dimension laAP_Costs[lnExistingCount]
4670*!* laAP_Costs[lnExistingCount] = Category
4671*!* EndScan
4672*!* *=== TechRec 1026008 09-Aug-2007 GSternik ===
4673
4674 * 1003958 03/05 CB - Future potential optimization - replace SCAN FOR (below) with SEEK...SCAN WHILE.
4675 * When zzcordrh instantiates the costing object, it calls oBPOCost.IndexBOMAndCost, which puts an
4676 * index on Vzzccostd.FKey. Not doing as part of this TR, as this is not involved in the cost
4677 * sheet calculation process.
4678 SCAN FOR FKey = tnSourceCostFkey
4679*!* *--- TechRec 1026008 09-Aug-2007 GSternik ---
4680*!* If lnExistingCount > 0
4681*!* *-- Check if this Category record already exists:
4682*!* p = AScan(laAP_Costs, Category)
4683*!* If p > 0
4684*!* *-- Restore the Cancelled AP Cost
4685*!* =ADel(laAP_Costs, p)
4686*!* lnExistingCount = lnExistingCount - 1
4687*!* loop
4688*!* EndIf
4689*!*
4690*!* EndIf
4691*!* *=== TechRec 1026008 09-Aug-2007 GSternik ===
4692
4693 lnRecNo = RECNO()
4694 SCATTER MEMVAR MEMO
4695 m.Contractor = tcContractor
4696 *--- TechRec 1026008 10-Aug-2007 GSternik ---
4697 *m.PKey = v_NextPkey("zzccostd")
4698 m.PKey = iif(Empty(tnCostPkey), v_NextPkey("zzccostd"), tnCostPkey)
4699 *=== TechRec 1026008 10-Aug-2007 GSternik ===
4700 m.FKey = tnDtlPkey
4701 m.User_ID = g_cUser
4702 m.Last_Mod = DateTime()
4703
4704 If m.Stage_Num > tnStage_Num and !tlHas_Imp_Cost
4705 *-- Adding from the Next Stage
4706 *--- TechRec 1010876 24-May-2005 GS ---
4707 if m.AP_Cost = 'Y'
4708 m.AP_Cost = 'N'
4709 EndIf
4710 If m.Imp_Cost = 'Y'
4711 m.Imp_Cost = 'N'
4712 EndIf
4713 *=== TechRec 1010876 24-May-2005 GS ===
4714 EndIf
4715
4716 m.Stage_Num = tnStage_Num
4717
4718 *--- TechRec 1011555 20-Jun-2005 GS ---
4719 m.sc_RowLock = 'N' && sc_RowLock can be 'Y' only at Last_Stage. Since we adding from NEXT it is always 'N'
4720 *=== TechRec 1011555 20-Jun-2005 GS ===
4721
4722 *--- TechRec 1007154 28-Sep-2004 GS ---
4723 if llNeed_ER_Lookup and Seek(m.Category, .cCatAlias)
4724 select (.cCatAlias)
4725 if AllTrim(Cost_Type) == This.cCN_ER_LOOKUP && and (!This.lLast_Stage or RecNo() < 0)
4726 llNeed_ER_Lookup = .F.
4727 if Empty(m.Constant)
4728 m.Category_Cost = vl_ExRate("","EXH_RATE")
4729 If Empty(m.Category_Cost) && could be .F.
4730 m.Category_Cost = 0
4731 Endif
4732 else
4733 m.Category_Cost = m.Constant
4734 endif
4735 m.Extension = 0
4736 m.Estm_Ext_Cost = 0
4737 m.Constant = 0 &&& 1060710 AZ
4738 endif
4739 select (tcProdCost)
4740 Endif
4741 *=== TechRec 1007154 06-Oct-2004 GS ===
4742
4743 APPEND BLANK
4744 GATHER MEMVAR MEMO
4745 GO lnRecNo
4746 ENDSCAN
4747 .PopRecordSet()
4748 ENDWITH
4749 SELECT(lnSelect)
4750 RETURN llRetVal
4751 ENDPROC
4752 *=== TAN 36993 02/14/03 AD
4753
4754 *---------------------------------------------------------------------------------------------------------------
4755 * Create a frozen cost sheet.
4756 *---------------------------------------------------------------------------------------------------------------
4757 * old code in Production UI: m_createfrozencostsheet
4758 * new parameters: pcProdCostFrozen (Vzzccostf), optional pnCostPkey (for get batch of pkeys latter)
4759 * 9/4/02 add BOMLevelPkey - grouping BOM items that belong to same Parent level BOM for
4760 * calculate Prod Cost Sheet with BOM
4761 Procedure CreateFrozenCostSheet
4762 Parameters pcDivision, pcStyle, pcColor, pcLbl, pcDimension, pcContractor, pcProd_type, ;
4763 pnHdrPkey, pnOpen_seq, pnDtlPkey, pnPkey, pnProd_num, pnSyslevel, pcProdCostFrozen, ;
4764 pnCostPkey, pnBOMLevelPkey, tcProdHdr
4765 Local llRetVal,lnOldSelect,lnRecNo, lcSqlString, ;
4766 lcProdCurrCode, lnExchangeRate, lcCursor && TechRec 1002576 21-Jan-2004 GS ---
4767
4768 llRetVal = .T.
4769 lnOldSelect = Select()
4770 *--- TechRec 1002576 21-Jan-2004 GS ---
4771 if Empty(tcProdHdr) && just in case
4772 tcProdHdr = 'vzzcordrh'
4773 endif
4774 select (tcProdHdr)
4775 lcProdCurrCode = Curr_Code
4776 lnExchangeRate = 1
4777 lcCursor = "TmpdCur"
4778 *=== TechRec 1002576 21-Jan-2004 GS ===
4779
4780 With This
4781 * populate vzzccostf to memory.
4782 Select (pcProdCostFrozen) &&vzzccostf
4783 .pushRecordSet()
4784 * only create when no frozen prod costsheet; same open seq share frozen cost sheet.
4785 * --- 1003958 Recalc Optimization 05/05 - Following LOCATE is ok, one time, not in scan.
4786 Locate for (prod_num = pnProd_num AND Open_Seq = pnOpen_seq and ;
4787 Division= pcDivision and style= pcStyle and Color_Code= pcColor and ;
4788 Dimension= pcDimension ) && contractor, prod_type ???
4789 If Not Found()
4790 Scatter Memvar Memo Blank && Init memvar with blanks
4791 * initial these fields first, they cannot be found in frozen cost sheet (vzzdcostf.)
4792 m.prod_num = pnProd_num
4793 m.Open_seq = pnOpen_seq
4794 * use template detail record.
4795
4796 *--- TechRec 1002576 21-Jan-2004 GS ---
4797 *lcSqlString = "SELECT * FROM zzdcostd WHERE fkey = ?pnPkey order by line_seq"
4798 select (tcProdHdr)
4799 *-- Cost_Rate is a dummy field needed for Cost recalc
4800 lcSqlString = ;
4801 SqlFormatChar(Curr_Code ) + " as PO_Curr," +;
4802 "10000.000001 as Cost_Rate," +;
4803 SqlFormatChar(Payee_Curr) + " as Payee_Curr," +;
4804 SqlFormatChar(Div_Curr ) + " as Div_Curr," +;
4805 SqlFormatChar(Co_Curr ) + " as Co_Curr," +;
4806 SQLFormatChar(Org_curr) + " as Org_Curr," +;
4807 SqlFormatNum(Payee_Rate,7) + " as Payee_Rate," +;
4808 SqlFormatNum(Div_Rate,7 ) + " as Div_Rate," +;
4809 SqlFormatNum(Co_Rate,7 ) + " as Co_Rate," + ;
4810 SQLFormatNum(Org_Rate,7) + " as org_rate,"
4811
4812 lcSqlString = ;
4813 "select c.*," + lcSqlString + ;
4814 " g.Cost_Type"+;
4815 " from zzdcostd c"+;
4816 " join zzdcatgr g"+;
4817 " on c.Category = g.Category "+;
4818 " where c.fkey = ?pnPkey "+;
4819 " order by c.line_seq"
4820 *=== TechRec 1002576 21-Jan-2004 GS ===
4821 llRetVal= v_SQLPrep(lcSqlString, lcCursor, "")
4822 If llRetVal
4823 Select (lcCursor)
4824 *--- TechRec 1002576 21-Jan-2004 GS ---
4825 *-- !!! For NOW we assume that Cost sheet has only ONE currency !!!
4826 lnExchangeRate = GetPOExchangeRate(tcProdHdr, Curr_Code)
4827 if Empty(lnExchangeRate)
4828 llRetVal = .F.
4829 else
4830 if lnExchangeRate # 1.0
4831 lcCursor = This.ReCalculateFrozenCost(lcCursor, lnExchangeRate)
4832 endif
4833 select (lcCursor)
4834 *=== TechRec 1002576 21-Jan-2004 GS ===
4835 Scan
4836 Scatter Memvar Memo
4837 m.master_div = m.division
4838 m.master_style = m.style
4839 m.master_color = m.color_code
4840 m.master_lbl = m.lbl_code
4841 m.master_dim = m.dimension
4842 m.master_contractor = m.contractor
4843 m.master_pType = m.prod_type
4844 m.division = pcDivision
4845 m.style = pcStyle
4846 m.color_code = pcColor && must do these because color in zzdcostd may be empty
4847 m.lbl_code = pcLbl
4848 m.dimension = pcDimension
4849 m.contractor = pcContractor
4850 m.prod_type = pcProd_type
4851 m.user_id = g_cuser
4852 m.last_mod = Datetime()
4853 m.pkey = iif(Empty(pnCostPkey), v_NextPkey("zzccostf") ,pnCostPkey)
4854 m.fkey = pnDtlPkey
4855 m.prodHdrFkey = pnHdrPkey
4856 m.syslevel= pnSyslevel
4857 m.BOMLevelPkey= pnBOMLevelPkey && 9/4
4858 *--- TechRec 1002576 21-Jan-2004 GS ---
4859 m.Cost_Rate = lnExchangeRate
4860 m.Cost_Curr = m.Curr_Code
4861 m.Curr_Code = PO_Curr
4862
4863 *-- For NOW we assume that Cost sheet has only ONE currency!
4864 *select (tcProdHdr)
4865 *if !(lcOldCurrCode == m.Curr_Code)
4866 * lcOldCurrCode = m.Curr_Code
4867 * lnExchangeRate = GetPOExchangeRate(tcProdHdr, lcOldCurrCode)
4868 *endif
4869 *m.Constant = m.Constant * lnExchangeRate
4870 *=== TechRec 1002576 21-Jan-2004 GS ===
4871
4872 Insert into (pcProdCostFrozen) From Memvar
4873 Endscan
4874 Use
4875 endif
4876 Use In Select(lcCursor)
4877 Endif
4878 Endif
4879 .popRecordSet()
4880 Endwith
4881 Select(lnOldSelect)
4882 Return llRetVal
4883 Endproc
4884
4885 *--- TechRec 1002576 21-Jan-2004 GS ---
4886 Procedure RecalculateFrozenCost
4887 Parameters tcSource, lnRate
4888 local lcCursor, lnValue, lnLine700, lcMacro, i,;
4889 lnTally, lnLoopEnd, llWasError, lcOldOnError, llRetVal
4890
4891 lnLine700 = Int(Val(goEnv.sv("WHOSESALEPRICELINE", "700")))
4892
4893 lcCursor = 'tmpFrCost'
4894 =MakeCursorWritable(tcSource, lcCursor)
4895 select (lcCursor)
4896
4897 *--- First let's change constants and "special" types treated as constants
4898 lnTally = 0
4899 scan
4900 if Empty(Formula) or !Empty(Cmp_Type) ;
4901 or InList(Line_Seq, 400, 500, 550, lnLine700)
4902 replace Constant with Constant*lnRate,;
4903 Category_Cost with Category_Cost*lnRate,;
4904 Cost_Rate with lnRate
4905 *-- commented, see comments below :o(
4906 *lcMacro = "m." + AllTrim(Category) + " = Category_Cost"
4907 *&lcMacro
4908 lnTally = lnTally + 1
4909 else
4910 replace Cost_Rate with 0 && This is a Flag
4911 endif
4912 endScan
4913
4914 lnLoopEnd = RecCount() - lnTally && Worst Case :o)
4915
4916*----- This code does not work because Category might have special characters in name ($, !, @ etc.)
4917*--- I will fix it later! GS. (also in CLSACPPR.PRG)
4918*!* lcOldOnError = "On Error " + On("ERROR")
4919*!* on error llWasError = .T.
4920
4921*!* for i = 1 to lnLoopEnd && will be skipped if lnLoopEnd = 0
4922*!* lnTally = 0
4923*!* llWasError = .F.
4924*!* scan for Cost_Rate = 0
4925*!* lcMacro = "lnValue = " + Trim(Formula)
4926*!* select 0 && To prevent fields use
4927*!* &lcMacro
4928*!* if llWasError
4929*!* llWasError = .F.
4930*!* else
4931*!* lnTally = lnTally + 1
4932*!* replace Category_Cost with lnValue,;
4933*!* Cost_Rate with lnRate in (lcCursor)
4934*!* endif
4935*!* endScan
4936*!* if lnTally = 0 && Nothing was updated
4937*!* exit
4938*!* endif
4939*!* endFor
4940*!* &lcOldOnError
4941
4942 scan for Cost_Rate = 0
4943 lnValue = .EvaluateFrozenCostFormula(@llRetVal)
4944 if llRetVal
4945 lnTally = lnTally + 1
4946 replace Category_Cost with lnValue,;
4947 Cost_Rate with lnRate in (lcCursor)
4948 endif
4949 endScan
4950
4951 return lcCursor
4952 Endproc
4953
4954 *----- Temporary workaround
4955 PROCEDURE EvaluateFrozenCostFormula
4956 Parameter llRetVal && must be sent by ref!!!
4957
4958 local lcString, lnxx, lcToken, ;
4959 lcMsgString, lntk, lncost
4960 dimension laToken[1]
4961 This.PushRecordSet()
4962
4963 llRetVal = .T.
4964 lcString = Trim(Formula)
4965 lcString = StrTran(lcString, '(', ' ( ') && insert blanks around '('
4966 lcString = StrTran(lcString, ')', ' ) ') && insert blanks around ')'
4967 lcString = StrTran(lcString, '/', ' / ') && insert blanks around '/'
4968 lcString = StrTran(lcString, '*', ' * ') && insert blanks around '*'
4969 lcString = StrTran(lcString, '-', ' - ') && insert blanks around '-'
4970 lcString = StrTran(lcString, '+', ' + ') && insert blanks around '+'
4971 lcString = lcString + " "
4972
4973 lcToken = ""
4974 lncost = 0
4975
4976 * tokenize formula string into array, so that we can check for variable (category)
4977 StringToArray(lcString, @laToken, " ")
4978 FOR lnxx = 1 TO ALEN(laToken)
4979 lcToken = laToken[lnxx]
4980 if IsAlpha(lcToken)
4981 * --- 1003958 Recalc Optimization CreateFrozenCostSheet()-->RecalculateFrozenCost()--> (SCAN) -->
4982 * EvaluateFrozenCostSheetFormula(). LOCATE IN SCAN. Potential future optimization point.
4983 locate for Category == PadR(lcToken,6)
4984 if Found()
4985 laToken[lnxx] = Str(Category_Cost, 14, 5) && replace category with extension
4986 endif
4987 endif
4988 ENDFOR
4989
4990 * construct string from array
4991 lcString = ArrayToString(@laToken, " ")
4992
4993 lcError = ON("ERROR")
4994
4995 *--- TechRec 1049776 08-Dec-2010 asharma ---
4996 * llRetVal working fine in Dev Environment but not in EXE
4997*!* ON ERROR llRetVal = .F.
4998 llTempRetVal = llRetVal
4999 ON ERROR llTempRetVal = .F.
5000 *=== TechRec 1049776 08-Dec-2010 asharma ===
5001
5002 TRY &&--- TechRec 1074785 21-Nov-2013 asharma ===
5003
5004 lnCost = Evaluate(lcString)
5005
5006 *--- TechRec 1074785 21-Nov-2013 asharma ---
5007 CATCH
5008 llTempRetVal = .F.
5009 ENDTRY
5010 *=== TechRec 1074785 21-Nov-2013 asharma ===
5011
5012
5013 on error &lcError && restore system error handler
5014
5015 *--- TechRec 1049776 08-Dec-2010 asharma ---
5016 llRetVal = llTempRetVal
5017 *=== TechRec 1049776 08-Dec-2010 asharma ===
5018
5019 if !llRetVal
5020* lcMsgString = "Category " + pcCategory + "contains invalid formula: " + MESSAGE()
5021 else
5022 if lnCost > 1000000000000 OR lncost < -1000000000000
5023 llRetVal = .F.
5024 * lcMsgString ="Category " + pcCategory + "contains invalid formula: Divided by zero."
5025 endif
5026 endif
5027 This.popRecordSet()
5028
5029 return lnCost
5030
5031 ENDPROC
5032
5033 *=== TechRec 1002576 21-Jan-2004 GS ===
5034
5035 *---------------------------------------------------------------------------------------------------------------
5036 * Recalculate single PO Detail line costing
5037 *---------------------------------------------------------------------------------------------------------------
5038 * old code in Production UI: m_recalcost
5039 * new parameters: pcProdCostFrozen (Vzzccostf), optional pnCostPkey (for get batch of pkeys latter)
5040 Procedure RecalCost
5041 parameter pcProdDtl, pcProdBOM, pcProdCost, pnPkey, tcProdCnclDtl, pcProdHdr
5042
5043 *--- TR 1048651 8-Oct-2010 Goutam. Added above parameter pcProdHdr
5044 &&--- TechRec 1038308 13-Mar-2009 vkrishnamurthy === Added Parameter tcProdCnclDtl
5045 LOCAL llRetVal,lnOldSelect,lnRecNo, lcSqlString, lnQty, lcProdDtl, lcProdCost, ;
5046 llCursorsAlreadyPrepped, llRangeStyle
5047
5048
5049
5050 DIMENSION paCost[5]
5051 llRetVal = .T.
5052 lnOldSelect = Select()
5053
5054 * --- 1003958 05/04 CB - Initialize local names of cursors for calls.
5055 lcProdDtl = pcProdDtl
5056 lcProdCost = pcProdCost
5057 * === 1003958 end.
5058
5059 *--- TR 1048651 8-Oct-2010 Goutam.
5060 pcProdHdr = IIF(EMPTY(pcProdHdr), "", pcProdHdr)
5061 *=== TR 1048651 8-Oct-2010 Goutam
5062
5063
5064
5065 With This
5066 Select (pcProdCost)
5067 .PushRecordSet()
5068 * if no wip qty and not last step, delete cost records and sliently returned.
5069 select (pcProdDtl) &&*--- TechRec 1004691 27-Apr-2004 GS --- added select and removed macro
5070
5071 *--- TechRec 1026008 09-Aug-2007 GSternik ---
5072 *-- Do not delete AP_Cost record for the Approved vouchers:
5073
5074 *If Last_Stage <> "Y" AND ; &&.r_cLastStage # &pcProdDtl..stage
5075 * (Wip_Total = 0 OR Cmpl_Ok = "C")
5076 *Delete For fkey = pnPkey In (pcProdCost) &&vzzccostd
5077
5078 If Last_Stage <> "Y" AND Wip_Total = 0
5079
5080 Local llHasApprovedVoucher
5081
5082 If InList(Cmpl_OK, "C", "P") && Canceled Line
5083 llHasApprovedVoucher = This.Has_Approved_Voucher(Prod_Num, Prod_Line)
5084 EndIf
5085
5086 If llHasApprovedVoucher
5087 Select (pcProdCost)
5088 Scan For FKey = pnPkey and AP_Cost # 'Y'
5089 replace Extension with 0
5090 EndScan
5091 select (pcProdDtl)
5092 Else
5093 Delete For FKey = pnPkey in (pcProdCost)
5094 EndIf
5095 *=== TechRec 1026008 09-Aug-2007 GSternik ===
5096
5097 *--- TAN 34027 09/20/02 AD
5098 .popRecordSet()
5099 SELECT(lnOldSelect)
5100 *=== TAN 34027 09/20/02 AD
5101 Return llRetVal
5102 Endif
5103
5104 *--- TechRec 1007154 04-Oct-2004 GS ---
5105 This.lLast_Stage = (Last_Stage = 'Y')
5106 *=== TechRec 1007154 04-Oct-2004 GS ===
5107
5108 *--- TechRec 1005611 03-Jun-2004 GS ---
5109 if Sc_RowLock = 'Y'
5110 .popRecordSet()
5111 SELECT(lnOldSelect)
5112 Return llRetVal
5113 endif
5114 *=== TechRec 1005611 03-Jun-2004 GS ===
5115
5116
5117 * get total qty of this stage.
5118
5119 *lnQty = iif(&pcProdDtl..last_stage= "Y", &pcProdDtl..total_qty, &pcProdDtl..wip_total)
5120 lnQty = iif(This.lLast_Stage, Total_Qty, Wip_Total)
5121
5122 *--- TechRec 1026008 13-Aug-2007 GSternik ---
5123 *-- The big chunk of code was removed!
5124 *-- The AP Cost calculation changed (Set_AP_Cost method). See VSS for history.
5125 *--- TAN 1021719 01/23/07 AZ
5126 *
5127 * Code Removed. TechRec 1026008 10-Aug-2007 GSternik
5128 *
5129 *=== TAN 1021719 01/23/07 AZ
5130
5131
5132 *!* * PL 03/13/02 - MPO convert to prepack (default is 1)
5133 *!* lnQty = lnQty / .nPrepackQty
5134
5135 *--- TechRec 1004691 27-Apr-2004 GS ---
5136 *!* * initialize 4 required cost categories. for zzcordrd
5137 *!* paCost[1] = &pcProdDtl..duty_amount
5138 *!* paCost[2] = &pcProdDtl..prod_value
5139 *!* paCost[3] = &pcProdDtl..total_material
5140 *!* paCost[4] = &pcProdDtl..total_cost
5141 *!* paCost[5] = &pcProdDtl..comm_amount && TAN 33059 Ilya
5142 *=== TechRec 1004691 27-Apr-2004 GS ===
5143
5144 * --- 1003958 05/05 CB - Optimized Cost Recalc
5145 IF .lOptimizedRecalc
5146 llCursorsAlreadyPrepped = THIS.lDynamicsPrepped
5147 IF NOT llCursorsAlreadyPrepped
5148
5149 *--- TR 1048651 8-Oct-2010 Goutam
5150 *lcProdHdr = IIF(USED("Vzzcordrh"), "Vzzcordrh", "???")
5151 lcProdHdr = IIF(USED("Vzzcordrh"), "Vzzcordrh", IIF(USED(pcProdHdr), pcProdHdr, "???"))
5152 *=== TR 1048651 8-Oct-2010 Goutam
5153
5154 .PrepDynamicCursors(pcProdCost, pcProdDtl, lcProdHdr, , .T.)
5155 lcProdDtl = THIS.cDetAlias
5156 lcProdCost = THIS.cCstAlias
5157
5158 *--- TechRec 1067706 13-Mar-2013 AZhadanov ---
5159 this.cProdDetails = pcProdDtl
5160 this.cProdcost = pcProdCost
5161 *=== TechRec 1067706 13-Mar-2013 AZhadanov ===
5162
5163
5164 *--- 1012294 KISHOR 28-Jul-2006
5165 SELECT (lcProdDtl)
5166 LOCATE FOR pkey = pnPkey
5167 *=== 1012294 KISHOR 28-Jul-2006
5168
5169 ENDIF
5170 ENDIF
5171 * === 1003958 End.
5172
5173 * PL 4/25 - cleanup latter same routine already in m_CheckPrepack()
5174 * need to refresh prepack code every time
5175
5176 * --- 1003958 05/04 CB - Using local cursor names for external calls.
5177 .RefreshPrepack(lcProdDtl)
5178 * === 1003958 end.
5179
5180 * create temp cursor for bom.
5181 * --- 1003958 05/04 CB - Using local cursor names for external calls.
5182 *--- TechRec 1038308 13-Mar-2009 vkrishnamurthy ---
5183*!* .CreateCostBOM(pnPkey, lcProdDtl, pcProdBOM)
5184 .CreateCostBOM(pnPkey, lcProdDtl, pcProdBOM,tcProdCnclDtl)
5185 *=== TechRec 1038308 13-Mar-2009 vkrishnamurthy ===
5186
5187 * === 1003958 end.
5188
5189 * get category cost
5190 * but first, clear it all, this is necessary because we have use formula,
5191 * and better to start clean so the formula won't use the old value.
5192 * --- 1003958 05/04 CB - Using local cursor names for external calls.
5193
5194 *--- TechRec 1038308 13-Mar-2009 vkrishnamurthy ---
5195*!* .RecalCostBOM(lcProdCost, pnPkey, lnQty, lcProdDtl, @paCost)
5196 .RecalCostBOM(lcProdCost, pnPkey, lnQty, lcProdDtl, @paCost,tcProdCnclDtl)
5197 *=== TechRec 1038308 13-Mar-2009 vkrishnamurthy ===
5198
5199 * === 1003958 end.
5200
5201 *-- 32276 06/06/02 PL - Costing in Prod Ord roll-up from lowest level
5202 *-- cost from lowestest level to level 0 (ONLY WHEN ACTIVATE ZZXPARMR
5203 *-- SORT BUILDER ("ROLLUPCOST"); CUSTOM FOR AMEREX)
5204 *--- TAN 34262 09/25/02 AD
5205 *- Moved to Init(). USe This.lRollUp propery instead
5206 *!* lcParm_name= ""
5207 *!* lcParm_name= ALLT(vl_parmr("ROLLUPCOST","parm_name","","ROLL-UP COST"))
5208 *!* If Not empty(lcParm_name)
5209
5210 *--- 1035380 06/17/09 Ilya: Special treatment for the P Range Styles cost sheet calculation:
5211 * P Range Style cost sheet requires the cost rollup, so we will enforce it regardless
5212 * of the parameter setting
5213 IF .lPORangeimplosion
5214 llRangeStyle = vl_rangr(EVALUATE(lcProdDtl + ".division"),,, ;
5215 EVALUATE(lcProdDtl + ".style"), ;
5216 EVALUATE(lcProdDtl + ".color_code"), ;
5217 EVALUATE(lcProdDtl + ".lbl_code"), ;
5218 EVALUATE(lcProdDtl + ".dimension"),'P')
5219 ELSE
5220 llRangeStyle = .F.
5221 ENDIF
5222
5223 IF .lRollUpCost OR llRangeStyle
5224 *=== TAN 34262 09/25/02 AD
5225 * --- 1003958 05/04 CB - Using local cursor names for external calls.
5226 *--- 1035380 09/03/09 Ilya: Added llRangeStyle to the parameter list.
5227 * Rollup will be from 1st level only for range styles
5228 .RollUpCost(lcProdCost, pnPkey, @paCost, lcProdDtl, llRangeStyle)
5229 * === 1003958 end.
5230
5231
5232 *--- TechRec 1062160 09-Jan-2013 AZhadanov --- recalculate line 600 after rollup
5233 .RecalCostBOMFormula600(lcProdCost, pnPkey, lnQty, lcProdDtl, @paCost,tcProdCnclDtl)
5234 *=== TechRec 1062160 09-Jan-2013 AZhadanov ===
5235
5236 Endif
5237 *== 32276 06/06/02 PL - Costing in Prod Ord roll-up from lowest level
5238 *=== 1035380 06/17/09 Ilya.
5239
5240 *--- TechRec 1004691 27-Apr-2004 GS ---
5241 *!* * recording duty_value, pord_value, total_material and total_cost
5242 *!* REPLACE duty_amount WITH paCost[1], prod_value WITH paCost[2], ;
5243 *!* total_material WITH paCost[3], total_cost WITH paCost[4], ;
5244 *!* comm_amount WITH paCost[5] IN (pcProdDtl)
5245
5246 *!* *--- TAN 32850 10/04/02 AD
5247 *!* *- Replace prod detail cost even if it 0, confirmed by Jason and Joe
5248 *!* *IF !EMPTY(paCost[2])
5249 *!* REPLACE cost WITH paCost[2] IN (pcProdDtl)
5250 *!* *ENDIF
5251 *!* *=== TAN 32850 10/04/02 AD
5252
5253 * --- 1003958 05/04 CB - Using local cursor names for external calls.
5254 This.UpdatePODetail(lcProdCost, lcProdDtl)
5255 * === 1003958 end.
5256
5257 *replace Cost with Prod_Value in (pcProdDtl) && see 32850 commented above. Moved inside UpdatePODetail method
5258 *=== TechRec 1004691 27-Apr-2004 GS ===
5259
5260 * --- 1003958 05/05 CB - Optimized Cost Recalc
5261 IF .lOptimizedRecalc AND NOT llCursorsAlreadyPrepped
5262 .WriteBackToRealViews(pcProdCost, pcProdDtl, , .T.)
5263 .CloseDynamicCursors()
5264 ENDIF
5265 * === 1003958 End.
5266
5267 Select (pcProdCost)
5268 .popRecordSet()
5269 Endwith
5270 Select(lnOldSelect)
5271 Return llRetVal
5272 EndProc
5273
5274
5275 *======================================================================
5276 *--- TechRec 1026008 10-Aug-2007 GSternik ---
5277 Procedure Has_Approved_Voucher
5278 Parameters tnProd_Num, tnProd_Line
5279 Local llRetVal
5280
5281 *-- This can be optimized by caching the approved voucher data for entire PO:
5282 llRetVal = v_SqlPrep(;
5283 "select vh.PKey"+;
5284 " from zzgapvcd vd"+;
5285 " join zzgapvch vh"+;
5286 " on vd.FKey = vh.PKey"+;
5287 " where vh.Approved = 'Y'"+;
5288 " and vd.Prod_Num = " + Transform(tnProd_Num) + IIf(Empty(tnProd_Line), "",;
5289 " and vd.Prod_Line = "+ Transform(tnProd_Line)) +;
5290 " and vd.Line_Type = 'PROD ORD'")
5291
5292 Return llRetVal
5293 EndPRoc
5294
5295 *======================================================================
5296
5297 Procedure Set_AP_Cost
5298 *-- Sets AP Cost category applied including cancelled units.
5299 *-- Expects that PO Cost cursor(tcCostDtl) points to AP Cost category.
5300 *---------------------------------------------------------------------------------
5301 Parameters tcCostDtl ,tcProdCnclDtl,pnQty &&, tcTree_Seq , tcUpToSatge, taToArray 1062160 Added parameter pnQty
5302 &&--- TechRec 1038308 13-Mar-2009 vkrishnamurthy === Added parameter tcProdCnclDtl
5303
5304 Local lnAP_Units, lnAP_Cost, lnEst_Cost, lnOldRecNo, ;
5305 lnOldSelect, lcCategory, lnQty, lnOpen_Seq,;
5306 lnProdHdrFKey, lnFKey, lnParKey, lnQty,;
5307 lnNew_AP_Cost, lnNew_Est_Cost
5308
5309 *--- TechRec 1039635 01-May-2009 vkrishnamurthy ---
5310 LOCAL lnbomlevelpkey ,lnSysLevel ,lcAP_cost
5311 *=== TechRec 1039635 01-May-2009 vkrishnamurthy ===
5312
5313
5314
5315
5316 lnAP_Units = 0
5317 lnAP_Cost = 0.0
5318 lnEst_Cost = 0.0
5319
5320 lnFKey = 0
5321
5322 *--- TechRec 1062160 09-Jan-2013 AZhadanov ---
5323 IF EMPTY(PnQty)
5324 PnQty = 0
5325 ENDIF
5326 *=== TechRec 1062160 09-Jan-2013 AZhadanov ===
5327
5328
5329 If Empty(This.cPO_Dtl_Alias)
5330 This.cPO_Dtl_Alias = "vzzcOrdrD"
5331 EndIf
5332
5333 *-- We can get info from all vouchers using zzgapcvcD data
5334 * if !used("qVouchers") or qVouchers.Prod_Num # Prod_Num
5335 * *-- Getting Voucher Information
5336 * v_SqlExec()
5337 * EndIf
5338
5339 if Eof(This.cPO_Dtl_Alias) or Eof(tcCostDtl) && or ParKey < 0
5340 return .F.
5341 EndIf
5342
5343 lnOldSelect = Select()
5344
5345 Select (tcCostDtl)
5346 lnOldRecNo = RecNo()
5347 lcCategory = Category
5348 lnProdHdrFKey = ProdHdrFKey
5349
5350 *--- TechRec 1039635 01-May-2009 vkrishnamurthy ---
5351 lnbomlevelpkey = bomlevelpkey
5352 lnSysLevel = Syslevel
5353 lcAP_cost = ap_cost
5354 *=== TechRec 1039635 01-May-2009 vkrishnamurthy ===
5355
5356
5357 Select(This.cPO_Dtl_Alias)
5358 lnOpen_Seq = Open_Seq
5359 lcTree_Seq = Trim(Tree_Seq)
5360 This.PushRecordSet()
5361 Set Filter To
5362
5363 set Deleted Off
5364
5365 lnParKey = PKey
5366
5367 *-- First, Looking for the Previous Cost Trx:
5368 Do While .T. && lnFKey = 0
5369
5370 Select (tcCostDtl)
5371 *--- TechRec 1039635 01-May-2009 vkrishnamurthy ---
5372*!* Locate for FKey = lnParKey ;
5373*!* and RecNo() > 0 ;
5374*!* and Category = lcCategory ;
5375*!* and AP_Cost = 'Y'
5376
5377 Locate for FKey = lnParKey ;
5378 and RecNo() > 0 ;
5379 and Category = lcCategory ;
5380 and AP_Cost = 'Y' ;
5381 AND Syslevel = lnSyslevel ;
5382 AND bomlevelpkey = lnbomlevelpkey
5383 *=== TechRec 1039635 01-May-2009 vkrishnamurthy ===
5384
5385 if Found()
5386 lnFKey = lnParKey
5387 exit
5388 EndIf
5389
5390 Select(This.cPO_Dtl_Alias)
5391 lnParKey = ParKey
5392 If lnParKey <1
5393 exit
5394 EndIf
5395 Locate for PKey = lnParKey
5396 EndDo
5397
5398 If lnFKey = 0
5399 Select(This.cPO_Dtl_Alias)
5400 scan for FKey = lnProdHdrFKey ;
5401 and Open_Seq = lnOpen_Seq ;
5402 and Tree_Seq = lcTree_Seq && EXACT OFF expected
5403
5404 lnParKey = PKey
5405 Select (tcCostDtl)
5406 *--- TechRec 1039635 01-May-2009 vkrishnamurthy ---
5407*!* Locate for FKey = lnParKey ;
5408*!* and RecNo() > 0 ;
5409*!* and Category = lcCategory ;
5410*!* and AP_Cost = 'Y'
5411
5412 Locate for FKey = lnParKey ;
5413 and RecNo() > 0 ;
5414 and Category = lcCategory ;
5415 and AP_Cost = 'Y' ;
5416 AND Syslevel = lnSyslevel ;
5417 AND bomlevelpkey = lnbomlevelpkey
5418 *=== TechRec 1039635 01-May-2009 vkrishnamurthy ===
5419
5420 if Found()
5421 lnFKey = lnParKey
5422 exit
5423 EndIf
5424 EndScan
5425 EndIf
5426
5427
5428
5429 if lnFKey > 0
5430 *-- Getting old Values for PO WIP and AP Cost/Estimated Cost
5431
5432 *--- TechRec 1062160 09-Jan-2013 AZhadanov ---
5433 IF pnqty > 0
5434 lnAP_Units = pnqty
5435 else
5436
5437
5438
5439
5440 Select (This.cPO_Dtl_Alias)
5441
5442 *--- TechRec 1067706 13-Mar-2013 AZhadanov ---
5443 IF this.lOptimizedRecalc AND this.lDynamicsPrepped AND This.cPO_Dtl_Alias <> this.cProdDetails
5444 lnpkey = pkey
5445 SELECT(this.cProdDetails)
5446 LOCATE FOR pkey = lnpkey
5447 ENDIF
5448 *=== TechRec 1067706 13-Mar-2013 AZhadanov ===
5449
5450 lnAP_Units = iif(Last_Stage = 'Y', ;
5451 OldVal("Total_Qty"), OldVal("Wip_Total"))
5452 ENDIF
5453 *=== TechRec 1062160 09-Jan-2013 AZhadanov ===
5454
5455 if lnAP_Units = 0
5456 *-- This means that Approved AP Voucher detais were cancelled!
5457 *-- Need to look up in cancels!
5458
5459 *--- TechRec 1038308 13-Mar-2009 vkrishnamurthy ---
5460*!* if Used("vzzcCncld") and Seek(lnFKey, "vzzccncld", "FKey")
5461*!* lnAP_Units = OldVal("Cncl_Total", "vzzcCncld")
5462*!* ENDIF
5463
5464 IF EMPTY(tcProdCnclDtl)
5465 if Used("vzzcCncld") and Seek(lnFKey, "vzzccncld", "FKey")
5466 lnAP_Units = OldVal("Cncl_Total", "vzzcCncld")
5467 EndIf
5468 ELSE
5469 if Used(tcProdCnclDtl) and Seek(lnFKey, tcProdCnclDtl, "FKey")
5470 lnAP_Units = OldVal("Cncl_Total", "vzzcCncld")
5471 EndIf
5472 ENDIF
5473 *=== TechRec 1038308 13-Mar-2009 vkrishnamurthy ===
5474
5475 EndIf
5476
5477 Select (tcCostDtl)
5478 lnAP_Cost = OldVal("Extension")
5479 lnEst_Cost = OldVal("Estm_Ext_Cost")
5480 EndIf
5481
5482 set deleted on
5483
5484 Select(This.cPO_Dtl_Alias)
5485 This.PopRecordSet()
5486
5487 *--- TechRec 1062160 09-Jan-2013 AZhadanov ---
5488* lnQty = iif(Last_Stage = 'Y', Total_Qty, Wip_Total)
5489
5490 lnqty = PnQty
5491 IF lnqty = 0
5492 lnQty = iif(Last_Stage = 'Y', Total_Qty, Wip_Total)
5493 ENDIF
5494 *=== TechRec 1062160 09-Jan-2013 AZhadanov ===
5495
5496 Select (tcCostDtl)
5497 go lnOldRecNo
5498
5499
5500*--- TechRec 1067706 13-Mar-2013 AZhadanov ---
5501 lncpkey = pkey
5502 IF this.lOptimizedRecalc AND this.lDynamicsPrepped AND tcCostDtl <> this.cProdcost
5503
5504 SELECT (this.cProdcost)
5505 LOCATE FOR pkey = lncpkey
5506 IF FOUND()
5507 lnAP_Cost = OldVal("Extension")
5508 lnEst_Cost = OldVal("Estm_Ext_Cost")
5509 ENDIF
5510 Select (tcCostDtl)
5511 ENDIF
5512*=== TechRec 1067706 13-Mar-2013 AZhadanov ===
5513
5514
5515 If lnAP_Units > 0
5516 lnNew_AP_Cost = lnAP_Cost*lnQty /lnAP_Units
5517 lnNew_Est_Cost = lnEst_Cost*lnQty /lnAP_Units
5518
5519 *--- TR 1060000 03/28/12 AZ
5520 replace Extension with lnNew_AP_Cost,;
5521 Category_Cost with iif(lnNew_AP_Cost = 0, 0, lnNew_AP_Cost/lnQty)
5522
5523 *--- TechRec 1067706 13-Mar-2013 AZhadanov ---
5524 IF This.lOptimizedRecalc AND THIS.lDynamicsPrepped
5525 replace modified WITH 'Y'
5526 ENDIF
5527 *=== TechRec 1067706 13-Mar-2013 AZhadanov ===
5528
5529 *=== TR 1060000 03/28/12 AZ
5530
5531 Else
5532 *-- This can happen when the whole AP Voucher Line was cancelled and then uncancelled
5533 *--- TR 1060000 03/28/12 AZ Can be SPLIT LINE
5534 replace extension WITH category_cost * lnQty, Estm_Ext_Cost with category_cost * lnQty
5535 *=== TR 1060000 03/28/12 AZ
5536 *--- TechRec 1067706 13-Mar-2013 AZhadanov ---
5537 IF This.lOptimizedRecalc AND THIS.lDynamicsPrepped
5538 replace modified WITH 'Y'
5539 ENDIF
5540 *=== TechRec 1067706 13-Mar-2013 AZhadanov ===
5541
5542 lnNew_AP_Cost = Extension
5543 lnNew_Est_Cost = 0.0
5544 ENDIF
5545
5546 *--- TR 1060000 03/28/12 AZ Commented out
5547* replace Extension with lnNew_AP_Cost,;
5548* Category_Cost with iif(lnNew_AP_Cost = 0, 0, lnNew_AP_Cost/lnQty)
5549 *=== TR 1060000 03/28/12 AZ
5550
5551 if lnNew_Est_Cost >0
5552 replace Estm_Ext_Cost with lnNew_Est_Cost
5553 *--- TechRec 1067706 13-Mar-2013 AZhadanov ---
5554 IF This.lOptimizedRecalc AND THIS.lDynamicsPrepped
5555 replace modified WITH 'Y'
5556 ENDIF
5557 *=== TechRec 1067706 13-Mar-2013 AZhadanov ===
5558
5559 EndIf
5560
5561 select (lnOldSelect)
5562
5563 Return lnNew_AP_Cost>0
5564 EndProc
5565 *=== TechRec 1024510 10-Aug-2007 GSternik ===
5566
5567 *-- 32276 06/06/02 PL - Costing in Prod Ord roll-up from lowest level
5568 *-- cost from lowestest level to level 0 (ONLY WHEN ACTIVATE ZZXPARMR
5569 *-- SORT BUILDER ("ROLLUPCOST"); CUSTOM FOR AMEREX)
5570 *--- 1035380 09/03/09 Ilya: Added tlRangeStyle parameter.
5571 * Rollup for Range Styles will be from the 1st syslevel only.
5572 *======================================================================
5573 PROCEDURE RollUpCost
5574 PARAMETER pcProdCost, pnPkey, paCost, pcProdDtl, tlRangeStyle
5575 Local llRetVal,lnOldSelect, lnMaxLevel, lnExtension, lnCategory_cost,lnMaxLevel_imp &&& 1067071-1066288 AZ
5576 llRetVal = .T.
5577 lnOldSelect = Select()
5578 *--- TAN 35242 10/31/02 AD
5579 SELECT(pcProdDtl)
5580 lnWipTotal= IIF(Last_Stage = 'Y', Total_Qty, Wip_Total)
5581 *=== TAN 35242 10/31/02 AD
5582 With This
5583 *--- 1035380 - Cost Sheet Usage 08/18/09 Ilya: Look at the last available level in Cost Sheet, not in BOM
5584 * There are cases when last level BOM items don't have cost sheet associated with them.
5585*-Ilya--- Select Max(syslevel) as MaxLevel from tmpCostBom into cursor tcCostLevel
5586 SELECT MAX(syslevel) AS MaxLevel FROM (pcProdCost) WITH (BUFFERING = .T.) INTO CURSOR tcMaxCostLevel
5587 lnMaxLevel= IIF(Used('tcMaxCostLevel'), tcMaxCostLevel.MaxLevel, 0)
5588 USE IN SELECT('tcMaxCostLevel')
5589 *=== 1035380 - Cost Sheet Usage 08/18/09 Ilya.
5590
5591 If lnMaxLevel>0
5592 *--- 1035380 09/03/09 Ilya: For Range Styles always roll up from the 1st component level
5593 IF tlRangeStyle
5594 lnMaxLevel = 1
5595 ENDIF
5596 *=== 1035380 09/03/09 Ilya.
5597 lnMaxlevel_imp = lnMaxLevel &&& 1067071-1066288 AZ
5598
5599
5600*--- TechRec 1066288 14-Feb-2013 AZhadanov ---&&& 1067071-1066288 AZ
5601 IF lnMaxlevel > 1
5602 LOCAL ix,nlevel
5603 nlevel = PROGRAM(-1)
5604 FOR ix = nlevel TO 1 STEP -1
5605 IF ATC("PRORATEPRODUCTIONTREES",PROGRAM(ix)) > 0
5606 EXIT
5607 ENDIF
5608 NEXT
5609 IF ix > 1
5610 lnMaxlevel_imp = 1 &&& 1067071
5611 ENDIF
5612 ENDIF
5613
5614*=== TechRec 1066288 14-Feb-2013 AZhadanov === &&& 1067071-1066288 AZ
5615
5616 Select (pcProdCost)
5617 .PushRecordset()
5618 *--- TAN 35242 10/31/02 AD
5619 LOCAL lcTempTbl
5620 lcTempTbl = SYS(2015)
5621 *--- TechRec 1066288 14-Feb-2013 AZhadanov ---
5622 COPY TO (lcTempTbl) FIELDS LIKE FKey, SysLevel, Category, Extension, Constant,imp_cost &&& 1067071
5623 *=== TechRec 1066288 14-Feb-2013 AZhadanov ===
5624 SELECT 0
5625 USE (lcTempTbl) EXCL ALIAS Q_ProdCost
5626 *--- TAN 35851 01/03/03 AD
5627 *- Added constant: if sum of constant of the lowest level is not zero
5628 *- then replace level 0 constant with cost
5629 LOCAL lnConstantRollup
5630 *=== TAN 35851 01/03/03 AD
5631
5632
5633*--- TechRec 1066288 14-Feb-2013 AZhadanov --- ****** 1067071
5634 IF lnMaxLevel > lnMaxLevel_imp
5635 SELECT SUM(Extension) AS Extension, Category, FKey, SUM(Constant) AS Constant ;
5636 FROM Q_ProdCost ;
5637 GROUP BY Category ;
5638 WHERE FKey = pnPkey .AND. SysLevel = lnMaxLevel AND imp_cost <> 'Y';
5639 INTO CURSOR Q_RollUp
5640
5641 SELECT SUM(Extension) AS Extension, Category, FKey, SUM(Constant) AS Constant ;
5642 FROM Q_ProdCost ;
5643 GROUP BY Category ;
5644 WHERE FKey = pnPkey .AND. SysLevel = lnMaxLevel_imp AND imp_cost = 'Y' ;
5645 INTO CURSOR Q_RollUp_imp
5646 ELSE
5647 SELECT SUM(Extension) AS Extension, Category, FKey, SUM(Constant) AS Constant ;
5648 FROM Q_ProdCost ;
5649 GROUP BY Category ;
5650 WHERE FKey = pnPkey .AND. SysLevel = lnMaxLevel ;
5651 INTO CURSOR Q_RollUp
5652 ENDIF
5653
5654
5655
5656
5657*!* SELECT SUM(Extension) AS Extension, Category, FKey, SUM(Constant) AS Constant ;
5658*!* FROM Q_ProdCost ;
5659*!* GROUP BY Category ;
5660*!* WHERE FKey = pnPkey .AND. SysLevel = lnMaxLevel ;
5661*!* INTO CURSOR Q_RollUp
5662*=== TechRec 1066288 14-Feb-2013 AZhadanov === ****** 1067071
5663
5664 USE IN SELECT('Q_ProdCost')
5665 ERASE (lcTempTbl)
5666 SELECT Q_RollUp
5667 SCAN
5668 *--- TAN 35851 01/03/03 AD
5669*!* IF SEEK(Category+STR(FKey)+STR(0), pcProdCost, 'CatCostLvl')
5670*!* REPLACE ;
5671*!* Extension WITH Q_RollUp.Extension, ;
5672*!* Category_Cost WITH Q_RollUp.Extension / lnWipTotal ;
5673*!* IN (pcProdCost)
5674*!* ENDIF
5675 *--- TAN 34778 06/20/03 AD
5676 *lnConstantRollup = IIF(Q_RollUp.Constant > 0, Q_RollUp.Extension / lnWipTotal, 0)
5677 lnConstantRollup = IIF(Q_RollUp.Constant > 0 .AND. lnWipTotal > 0, Q_RollUp.Extension / lnWipTotal, 0)
5678 *=== TAN 34778 06/20/03 AD
5679*!* IF SEEK(Category+STR(FKey)+STR(0), pcProdCost, 'CatCostLvl')
5680*!* REPLACE ;
5681*!* Extension WITH Q_RollUp.Extension, ;
5682*!* Category_Cost WITH Q_RollUp.Extension / lnWipTotal, ;
5683*!* Constant WITH lnConstantRollup ;
5684*!* IN (pcProdCost)
5685*!* ENDIF
5686
5687 IF SEEK(Category+STR(FKey)+STR(0), pcProdCost, 'CatCostLvl')
5688 ****** GS ONLINE CHANGE! Aug 05, 2009 ***** TR 1041944 MP 08/05/09
5689 select (pcProdCost)
5690 IF (Imp_Cost # 'Y') AND (AP_Cost # 'Y')
5691 ******************************************
5692 REPLACE ;
5693 Extension WITH Q_RollUp.Extension, ;
5694 Category_Cost WITH Q_RollUp.Extension / IIF(lnWipTotal = 0, 1, lnWipTotal), ;
5695 Constant WITH lnConstantRollup ;
5696 IN (pcProdCost)
5697 ****** GS ONLINE CHANGE! Aug 05, 2009 ****
5698 endif
5699 ****************************************** TR 1041944 MP 08/05/09
5700
5701
5702 *--- TR 1024219 NSD 09-May-2007
5703 * Switching back to pcProdCost. pcCostAlias does not exist in this method.
5704 * If there is a problem w/ this, then we need to research and resolve once and for all.
5705 *--- TechRec 1003897 26-Mar-2004 GS ---
5706 *--- TR1012435 08/04/05 MP Fix (restored from TR1007219)
5707 if Evaluate(pcProdCost + ".Imp_Cost") # 'Y'
5708 *if Evaluate(pcCostAlias + ".Imp_Cost") # 'Y'
5709 *=== TR1012435 08/04/05 MP
5710 replace Estm_Ext_Cost with Q_RollUp.Extension in (pcProdCost)
5711 endif
5712 *=== TechRec 1003897 26-Mar-2004 GS ===
5713
5714 ENDIF
5715 *=== TAN 35851 01/03/03 AD
5716 ENDSCAN
5717 USE IN SELECT('Q_RollUp')
5718
5719
5720
5721*--- TechRec 1066288 14-Feb-2013 AZhadanov ---******* 1067071
5722 IF USED("Q_RollUp_imp")
5723 SELECT Q_RollUp_imp
5724 SCAN
5725 lnConstantRollup = IIF(Q_RollUp_imp.Constant > 0 .AND. lnWipTotal > 0, Q_RollUp_imp.Extension / lnWipTotal, 0)
5726 IF SEEK(Category+STR(FKey)+STR(0), pcProdCost, 'CatCostLvl')
5727 REPLACE ;
5728 Extension WITH Q_RollUp_imp.Extension, ;
5729 Category_Cost WITH Q_RollUp_imp.Extension / IIF(lnWipTotal = 0, 1, lnWipTotal), ;
5730 Constant WITH lnConstantRollup ;
5731 IN (pcProdCost)
5732
5733 if Evaluate(pcProdCost + ".Imp_Cost") # 'Y'
5734 replace Estm_Ext_Cost with Q_RollUp_imp.Extension in (pcProdCost)
5735 endif
5736
5737 ENDIF
5738 *=== TAN 35851 01/03/03 AD
5739 ENDSCAN
5740 USE IN SELECT('Q_RollUp_imp')
5741 ENDIF
5742*=== TechRec 1066288 14-Feb-2013 AZhadanov ===******* 1067071
5743
5744
5745
5746*!* Set order to CostCatg
5747*!* lnExtension= 0
5748*!* lnCategory_cost= 0
5749*!* lcCategory=""
5750*!*
5751*!* lnWipTotal= iif(&pcProdDtl..last_stage='Y', &pcProdDtl..total_qty, &pcProdDtl..wip_total) && 06/21 PL
5752
5753*!* Scan For syslevel= lnMaxLevel And fkey= pnPkey
5754*!* If ! (category == lcCategory)
5755*!* .UpdateRollUpCost(pcProdCost, pnPkey, @lnExtension, @lnCategory_cost, @lcCategory, ;
5756*!* lnWipTotal) && 06/21 PL
5757*!* lcCategory= category
5758*!* Endif
5759*!* lnExtension= lnExtension + extension
5760*!* lnCategory_cost= lnCategory_cost + category_cost
5761*!* Endscan
5762*!* If ! (category == lcCategory)
5763*!* .UpdateRollUpCost(pcProdCost, pnPkey, @lnExtension, @lnCategory_cost, @lcCategory, ;
5764*!* lnWipTotal, .t.) && 06/21 PL
5765*!* Endif
5766 *=== TAN 35242 10/31/02 AD
5767 Select (pcProdCost)
5768 .PopRecordset()
5769
5770 * Overwrite paCost[1..4] with .aMaxLevelCost[1..4]
5771*!* paCost[DUTY_]= IIF(paCost[DUTY_]<> .aMaxLevelCost[DUTY_], ;
5772*!* .aMaxLevelCost[DUTY_], paCost[DUTY_])
5773*!* paCost[PRODUCTION_]= IIF(paCost[PRODUCTION_]<> .aMaxLevelCost[PRODUCTION_], ;
5774*!* .aMaxLevelCost[PRODUCTION_], paCost[PRODUCTION_])
5775*!* paCost[MATERIAL_]= IIF(paCost[MATERIAL_]<> .aMaxLevelCost[MATERIAL_], ;
5776*!* .aMaxLevelCost[MATERIAL_], paCost[MATERIAL_])
5777*!* paCost[TOTAL_COST_]= IIF(paCost[TOTAL_COST_]<> .aMaxLevelCost[TOTAL_COST_], ;
5778*!* .aMaxLevelCost[TOTAL_COST_], paCost[TOTAL_COST_])
5779
5780 *--- TechRec 1004691 27-Apr-2004 GS ---
5781*!* paCost[DUTY_]= IIF(.aMaxLevelCost[DUTY_]>0 , ;
5782*!* .aMaxLevelCost[DUTY_], paCost[DUTY_])
5783*!* paCost[PRODUCTION_]= IIF(.aMaxLevelCost[PRODUCTION_]>0 , ;
5784*!* .aMaxLevelCost[PRODUCTION_], paCost[PRODUCTION_])
5785*!* paCost[MATERIAL_]= IIF(.aMaxLevelCost[MATERIAL_]>0, ;
5786*!* .aMaxLevelCost[MATERIAL_], paCost[MATERIAL_])
5787*!* paCost[TOTAL_COST_]= IIF(.aMaxLevelCost[TOTAL_COST_]>0, ;
5788*!* .aMaxLevelCost[TOTAL_COST_], paCost[TOTAL_COST_])
5789*!* paCost[COMMISSION_]= IIF(.aMaxLevelCost[COMMISSION_]>0, ;
5790*!* .aMaxLevelCost[COMMISSION_], paCost[COMMISSION_])
5791 *=== TechRec 1004691 27-Apr-2004 GS ===
5792
5793 Endif && lnMaxLevel>0
5794 Use in Select('tcRollup')
5795 Endwith
5796 Select(lnOldSelect)
5797 Return llRetVal
5798 Endproc
5799
5800 *==================================================================================
5801 *- NOT USED
5802 Procedure UpdateRollUpCost
5803 parameter pcProdCost, pnPkey, pnExtension, pnCategory_cost, pcCategory, pnWipTotal,; && 06/21 PL
5804 plSkipGoto
5805 Local llRetVal,lnOldSelect, lnRecno
5806 llRetVal = .T.
5807 lnOldSelect = Select()
5808 With This
5809 If pnExtension> 0
5810 Select (pcProdCost)
5811 lnRecno= Recno()
5812 Locate For syslevel=0 And fkey= pnPkey And category= pcCategory
5813 If Found()
5814 *--- 32276 06/21/02 PL - Costing in Prod Ord roll-up from lowest level
5815 *-- Per Amerex: The formula for calculating the cost roll-up of assorted/assorted
5816 *-- pre-packs should be the cost of each color multiplied by its total units and
5817 *-- then the sum of these sub-costs divided by the total units of the PPK order.
5818 *- Extension is ok, for category_cost (instead of accummulate from level 2 write
5819 *- back to level 0) take extension divide by Prod Detail WIP TOTAL
5820 *Replace extension with pnExtension, category_cost with pnCategory_cost IN (pcProdCost)
5821 Replace extension with pnExtension, category_cost with (pnExtension / pnWipTotal) ;
5822 In (pcProdCost)
5823 *--- TechRec 1003897 26-Mar-2004 GS ---
5824 if Imp_Cost # 'Y'
5825 replace Estm_Ext_Cost with Extension
5826
5827 *--- 1012294 KISHOR 2-AUG-2006
5828 IF This.lOptimizedRecalc AND THIS.lDynamicsPrepped
5829 replace modified WITH 'Y'
5830 ENDIF
5831 *=== 1012294 KISHOR 2-AUG-2006
5832 endif
5833 *=== TechRec 1003897 26-Mar-2004 GS ===
5834 *=== 32276 06/21/02 PL
5835 Endif
5836 If ! plSkipGoto
5837 Goto lnRecno
5838 Endif
5839 pnExtension= 0
5840 pnCategory_cost= 0
5841 pcCategory= category
5842 Endif
5843 Endwith
5844 Select(lnOldSelect)
5845 Return llRetVal
5846 Endproc
5847 *== 32276 06/06/02 PL - Costing in Prod Ord roll-up from lowest level
5848
5849 *---------------------------------------------------------------------------------------------------------------
5850 *
5851 *---------------------------------------------------------------------------------------------------------------
5852 Procedure RefreshPrepack
5853 Parameter pcProdDtl
5854 Local llRetVal,lnOldSelect
5855 llRetVal = .T.
5856 lnOldSelect = Select()
5857 With This
5858 .nPrepackQty= 1
5859 .cPrepackCode= ""
5860 If vl_parmr("POPPACK") && Parameter convert to Prepack
5861 *--- TechRec 1004691 28-Apr-2004 GS ---
5862 *--- Removed all further &pcProdDtl.. macro after this select
5863 Select (pcProdDtl)
5864 *=== TechRec 1004691 28-Apr-2004 GS ===
5865
5866 *--- 32509 06/19/02 PL Cost change to divide by prepack to calcutate cost
5867 .cProdDetailDivision= Division
5868 .cProdDetailSize_code= vl_stylr(Division, "size_code", "", Style)
5869 *=== 32509 06/19/02 PL
5870
5871 If vl_scold(Division, 'ppack_ok', 'tcScold', Style, Color_Code, ;
5872 Lbl_Code, Dimension) = "Y"
5873 If vl_ppakh(Division,,'tcPakh', tcScold.Size_Code, Dimension)
5874 .nPrepackQty= iif(recc('tcPakh')> 0, tcPakh.pack_qty, 1)
5875 .cPrepackCode= iif(recc('tcPakh')> 0, tcPakh.ppk_code, "")
5876 Use in Select('tcPakh')
5877 Endif
5878 Endif
5879 Endif
5880 Endwith
5881 Select(lnOldSelect)
5882 Return llRetVal
5883 Endproc
5884
5885 *---------------------------------------------------------------------------------------------------------------
5886 * Recalculate All Costing
5887 *---------------------------------------------------------------------------------------------------------------
5888 * old code in Production UI: m_recalcostall
5889 Procedure RecalCostAll
5890 parameter pcProdHdr, pcProdDtl, pcProdBOM, pcProdCost, tlNoImport,tcProdCnclDtl
5891 &&--- TechRec 1038308 13-Mar-2009 vkrishnamurthy === Added Parameter tcProdCnclDtl
5892 *--- TAN 35242 11/01/02 AD
5893 *- Added parameter tlNoImport -- called from PO b_BalHdrDtl()
5894 Local llRetVal,lnOldSelect,lnRecNo, lcSqlString, lnQty, lnProd_Num,;
5895 lnReccount, lcMessage, lnLastRec, lnPkey, lcStage, llProrateImp
5896 *--- TAN 35242 11/01/02 AD
5897 llProrateImp = EMPTY(tlNoImport)
5898 *=== TAN 35242 11/01/02 AD
5899
5900
5901 DIMENSION paCost[5]
5902 lnLastRec = 0
5903 llRetVal = .T.
5904 lnOldSelect = Select()
5905 With This
5906 Select (pcProdHdr) &&*--- TechRec 1004691 27-Apr-2004 GS ---
5907 If Use_Cost = "Y"
5908 lnProd_Num = Prod_num
5909
5910
5911
5912 Select (pcProdDtl)
5913 .pushRecordSet()
5914 Set Filter To
5915 Locate && just to get value of prod_num.
5916 count to lnReccount
5917 * do all import tracking once.
5918 *--- TAN 35242 11/01/02 AD
5919 IF llProrateImp
5920 .ProrateImpByPO(lnProd_Num, .T., pcProdDtl, pcProdCost)
5921 ENDIF
5922 *=== TAN 35242 11/01/02 AD
5923 * new we recalucate every detail line cost except import tracking.
5924
5925 SCAN
5926
5927 *--- 1012294 KISHOR 2-AUG-2006
5928 lnRecordPointer = RECNO()
5929 *=== 1012294 KISHOR 2-AUG-2006
5930
5931 *--- TechRec 1007803 22-Nov-2004 GS ---
5932 *lnPkey = vzzcordrd.pkey
5933 *lcStage = vzzcordrd.stage
5934 lnPkey = PKey
5935 lcStage = Stage
5936 *=== TechRec 1007803 22-Nov-2004 GS ===
5937
5938 * to make sure cost sheet is created.
5939 lnLastRec = lnLastRec + 1 && to accomodate new records.
5940 lcMessage = "Recalculate cost of stage " + TRIM(lcStage)
5941 Thermo(lcMessage, lnLastRec, lnReccount)
5942
5943 *--- TechRec 1007154 04-Oct-2004 GS ---
5944 This.lLast_Stage = (Last_Stage = 'Y')
5945 *=== TechRec 1007154 04-Oct-2004 GS ===
5946
5947 *--- TechRec 1038308 13-Mar-2009 vkrishnamurthy ---
5948*!* .RecalCost(pcProdDtl, pcProdBOM, pcProdCost, lnPkey) && recalculate this record.
5949
5950 *--- TR 1048651 8-Oct-2010 Goutam. Added parameter pcProdHdr
5951
5952 .RecalCost(pcProdDtl, pcProdBOM, pcProdCost, lnPkey, tcProdCnclDtl)
5953 *=== TechRec 1038308 13-Mar-2009 vkrishnamurthy ===
5954
5955
5956 *--- 1012294 KISHOR 2-AUG-2006
5957 GO lnRecordPointer IN (pcProdDtl)
5958 *=== 1012294 KISHOR 2-AUG-2006
5959
5960 Endscan
5961 .popRecordSet()
5962 .lSetLastProratedDate = .T. && remember to update last prorated date.
5963 Endif
5964 .lNeedRecalCost= .F. && turn of the recal-flag
5965
5966 Endwith
5967 Select(lnOldSelect)
5968 Return llRetVal
5969 ENDPROC
5970
5971
5972
5973 *--- TechRec 1062160 09-Jan-2013 AZhadanov ---
5974
5975 PROCEDURE RecalCostBOMFormula600
5976 LPARAMETER pcCostAlias, pnPodtlPkey, pnqty, pcDetailAlias, paCost,tcProdCnclDtl
5977 LOCAL lcOrder, lnSelect, llRangeStyle
5978 LOCAL lnPrepackRatio
5979 lnPrepackRatio = 1
5980
5981
5982 EXTERNAL ARRAY paCost
5983
5984 SELECT (pcCostAlias)
5985 LOCATE FOR syslevel = 0 AND line_seq = 600 AND !EMPTY(formula) AND fkey = pnPodtlPkey
5986 IF FOUND()
5987 .pushRecordSet()
5988 lnOrigQty= pnQty
5989
5990 *-- TR 1011441 MA 06/22/05
5991 oCostEstm = CreateObject("CostEstm",0)
5992 *== TR 1011441 MA 06/22/05
5993 lnSysLevel = 0
5994 lnCostLevelPkey = costlevelpkey
5995 lcCategory = Category
5996 select (This.cCatAlias)
5997 =Seek(lcCategory)
5998 lcCost_Type = Upper(AllTrim(Cost_Type)) && -- TechRec 1005555 01-Jun-2004 GS -- Uppercase, just in case...
5999 select (pcCostAlias)
6000 Set Order to CostLevel && 32276 06/06/02 PL &&& 1041085 AZ
6001
6002 IF lcCost_Type == This.cCN_HS_LOOKUP or lcCost_Type == This.cCN_COMMISSION or ;
6003 ((Imp_Cost = 'Y' or AP_Cost = 'Y') and Extension <> 0) ;&& import tracking
6004 OR lcCost_Type == This.cCN_HS_FIXEDAMOUNT && TR 1072967 26-SEP-13 Venuk
6005 * Do nothing.
6006 ELSE
6007 oCostEstm.nQty = pnQty
6008 * lncost = THIS.MultiLevelEvalCostFormula(pcCostAlias, formula, pnPodtlPkey, category,;
6009 * lnSysLevel, lnCostLevelPkey, round_to)
6010 lnCost = THIS.MultiLevelEvalCostFormula(pcCostAlias, Formula, pnPodtlPkey, Category,;
6011 lnSysLevel, lnCostLevelPkey, Round_To, oCostEstm)
6012 *== TR 1011441 MA 06/22/05
6013
6014 *= TAN 29836 01/14/02 YIK
6015 *=== TAN 1004047 03/10/04 AD
6016
6017 lnExtension = lnCost * pnQty && restore extension after round to.
6018
6019 *-- TR 1011441 MA 06/22/05
6020 lnExtensionEstm = oCostEstm.nCostEstm * pnQty
6021 *== TR 1011441 MA 06/22/05
6022
6023 * recording duty_value, pord_value, total_material and total_cost
6024 * PL 4/27 take 1st > 0 in any of 4 cost categories
6025 * recording duty_value, pord_value, total_material and total_cost (5/23)
6026 DO CASE
6027 *--- TAN 32280 08/12/02 PL - Rollup cost ratio by Prepack Any logic
6028 *!* CASE (paCost[PRODUCTION_] = 0 OR paCost[PRODUCTION_] <> lncost) AND tcCatgr.cost_type = This.cCN_PROD_VALUE
6029 *!* paCost[PRODUCTION_] = lncost
6030 *!* .aMaxLevelCost[PRODUCTION_]= .aMaxLevelCost[PRODUCTION_] + ;
6031 *!* IIF(.nMaxLevel= lnSysLevel, paCost[PRODUCTION_], 0) && PL 06/06/02
6032 *!* CASE (paCost[MATERIAL_] = 0 OR paCost[MATERIAL_] <> lncost) AND tcCatgr.cost_type = This.cCN_TOTAL_MATERIAL
6033 *!* paCost[MATERIAL_] = lncost
6034 *!* .aMaxLevelCost[MATERIAL_]= .aMaxLevelCost[MATERIAL_] + ;
6035 *!* IIF(.nMaxLevel= lnSysLevel, paCost[MATERIAL_], 0) && PL 06/06/02
6036 *!* CASE (paCost[DUTY_] = 0 OR paCost[DUTY_] <> lncost) AND tcCatgr.cost_type = This.cCN_DUTY_VALUE
6037 *!* paCost[DUTY_] = lncost && + lnHsLookupAmount 11/10/00
6038 *!* .aMaxLevelCost[DUTY_]= .aMaxLevelCost[DUTY_] + ;
6039 *!* IIF(.nMaxLevel= lnSysLevel, paCost[DUTY_], 0) && PL 06/06/02
6040 *!* CASE (paCost[TOTAL_COST_] = 0 OR paCost[TOTAL_COST_] <> lncost) AND tcCatgr.cost_type = This.cCN_TOTAL_COST
6041 *!* paCost[TOTAL_COST_] = lncost
6042 *!* .aMaxLevelCost[TOTAL_COST_]= .aMaxLevelCost[TOTAL_COST_] + ;
6043 *!* IIF(.nMaxLevel= lnSysLevel, paCost[TOTAL_COST_], 0) && PL 06/06/02
6044
6045 *--- TechRec 1004691 27-Apr-2004 GS --- Left without changes for now, just changed "tcCatgr." to "lc" ===:
6046 CASE lcCost_Type = This.cCN_PROD_VALUE
6047 paCost[PRODUCTION_] = lncost
6048 .aMaxLevelCost[PRODUCTION_]= .aMaxLevelCost[PRODUCTION_] + ;
6049 IIF(.nMaxLevel= lnSysLevel, paCost[PRODUCTION_] * lnPrepackRatio, 0) && PL 06/06/02
6050 CASE lcCost_Type = This.cCN_TOTAL_MATERIAL
6051 paCost[MATERIAL_] = lncost
6052 .aMaxLevelCost[MATERIAL_]= .aMaxLevelCost[MATERIAL_] + ;
6053 IIF(.nMaxLevel= lnSysLevel, paCost[MATERIAL_] * lnPrepackRatio, 0) && PL 06/06/02
6054 CASE lcCost_Type = This.cCN_DUTY_VALUE
6055 paCost[DUTY_] = lncost && + lnHsLookupAmount 11/10/00
6056 .aMaxLevelCost[DUTY_]= .aMaxLevelCost[DUTY_] + ;
6057 IIF(.nMaxLevel= lnSysLevel, paCost[DUTY_] * lnPrepackRatio, 0) && PL 06/06/02
6058 CASE lcCost_Type = This.cCN_TOTAL_COST
6059 paCost[TOTAL_COST_] = lncost
6060 .aMaxLevelCost[TOTAL_COST_]= .aMaxLevelCost[TOTAL_COST_] + ;
6061 IIF(.nMaxLevel= lnSysLevel, paCost[TOTAL_COST_] * lnPrepackRatio, 0) && PL 06/06/02
6062 *--- TAN 33059 Ilya: Include Commission cost
6063 CASE lcCost_Type = This.cCN_COMMISSION
6064 paCost[COMMISSION_] = lncost
6065 .aMaxLevelCost[COMMISSION_]= .aMaxLevelCost[COMMISSION_] + ;
6066 IIF(.nMaxLevel= lnSysLevel, paCost[COMMISSION_] * lnPrepackRatio, 0)
6067 *=== TAN 33059 Ilya
6068
6069 *=== TAN 32280 08/12/02 PL
6070 ENDCASE
6071
6072 *--- 1003958 05/04 - CB was failing in UDEV, added rounding:
6073 lnCost = ROUND(lnCost, 5)
6074 lnExtension = ROUND(lnExtension, 5)
6075 *=== 1003958 end.
6076
6077 *-- TR 1011441 MA 06/22/05
6078 lnExtensionEstm = ROUND(lnExtensionEstm, 5)
6079 *-- TR 1011441 MA 06/22/05
6080
6081 REPLACE category_cost WITH lnCost, extension WITH lnExtension IN (pcCostAlias)
6082 *--- TechRec 1003897 26-Mar-2004 GS ---
6083 if Imp_Cost # 'Y'
6084
6085 *-- TR 1011441 MA 06/22/05
6086 * replace Estm_Ext_Cost with Extension
6087 replace Estm_Ext_Cost with lnExtensionEstm
6088 *== TR 1011441 MA 06/22/05
6089
6090 *--- 1012294 KISHOR 2-AUG-2006
6091 IF This.lOptimizedRecalc AND THIS.lDynamicsPrepped
6092 replace modified WITH 'Y'
6093 ENDIF
6094 *=== 1012294 KISHOR 2-AUG-2006
6095
6096 endif
6097
6098 ENDIF
6099 ENDIF
6100
6101
6102 ENDPROC
6103
6104*=== TechRec 1062160 09-Jan-2013 AZhadanov ===
6105
6106
6107
6108 *-------------------------------------------------------------------------------------------------
6109 *-------------------------------------------------------------------------------------------------
6110 *-------------------------------------------------------------------------------------------------
6111 * PL 29378 3/28/02 Multi-level cost sheet cost of HS lookup
6112
6113 *--------------------------------------------------------------------------------------------------
6114 * 05/05/00 ATS3847, Costing, PO cost sheet
6115 PROCEDURE RecalCostBOM
6116 LPARAMETER pcCostAlias, pnPodtlPkey, pnqty, pcDetailAlias, paCost,tcProdCnclDtl
6117 &&--- TechRec 1038308 13-Mar-2009 vkrishnamurthy === Added Parameter tcProdCnclDtl
6118 LOCAL lcOrder, lnSelect, llRangeStyle
6119 EXTERNAL ARRAY paCost
6120
6121 IF EMPTY(pcDetailAlias)
6122 pcDetailAlias = "vzzcordrd"
6123 ENDIF
6124
6125 *--- TechRec 1026008 09-Aug-2007 GSternik ---
6126 This.cPO_Dtl_Alias = pcDetailAlias
6127 *=== TechRec 1026008 09-Aug-2007 GSternik ===
6128
6129 *--- TechRec 1007154 04-Oct-2004 GS ---
6130 * --- 1003958 03/05 CB - Make sure buffering is enabled before using CurVal():
6131 *--- TR 1072360 07-Aug-2013 BNarayanan added = 'Y' to EVALUATE(pcDetailAlias + ".Last_Stage")
6132 This.lLast_Stage = IIF(INLIST(CURSORGETPROP("Buffering",pcDetailAlias), 3, 5), ;
6133 (CurVal("Last_Stage", pcDetailAlias) = 'Y'), EVALUATE(pcDetailAlias + ".Last_Stage")= 'Y')
6134 * === 1003958 end.
6135 *=== TechRec 1007154 04-Oct-2004 GS ===
6136
6137 WITH THIS
6138 *.CostFromConstant(pcCostAlias, pnPodtlPkey, pnqty, @paCost) && get constant.
6139 *.costfrombom(pcCostAlias, pnPodtlPkey, pnqty) && get bom cost
6140 *.costfrombom2(pcCostAlias, pnPodtlPkey, pnqty) && bom catch all, do this after all other bom type.
6141 *.costbyFormula(pcCostAlias, pnPodtlPkey, pnqty, @paCost) && get cost by formula
6142 *.costOfHSLookUp(pcCostAlias, pnPodtlPkey, pnqty) && get hs lookup cost
6143
6144 *--- 1035380 05/22/09 Ilya: Special treatment for the P Range Styles cost sheet calculation:
6145 * order line quantity reflects # of range styles, not units inside of the range style
6146 * Therefore we will use BOMParts Usage to keep track of them - BOMs are components for
6147 * the range style. For regular styles and prepacks will set the usage to 0 and will not
6148 * use it during calculations later.
6149 IF .lPORangeimplosion
6150 llRangeStyle = vl_rangr(EVALUATE(pcDetailAlias + ".division"),,, ;
6151 EVALUATE(pcDetailAlias + ".style"), ;
6152 EVALUATE(pcDetailAlias + ".color_code"), ;
6153 EVALUATE(pcDetailAlias + ".lbl_code"), ;
6154 EVALUATE(pcDetailAlias + ".dimension"),'P')
6155 ELSE
6156 llRangeStyle = .F.
6157 ENDIF
6158 *=== 1035380 05/22/09 Ilya.
6159
6160 Store 0 to .nMaxLevel, .aMaxLevelCost && 32276 06/06/02 PL
6161 Local lnMaxBOMSKU, aBOMParts[1], llFoundBOM
6162 llFoundBOM= .GetBOMSkus(@aBOMParts, @lnMaxBOMSku,llRangeStyle)
6163 If llFoundBOM
6164*!* T H I S N E E D S I N V E S T I G A T I N '
6165*!* * --- 1003958 05/04 CB - The following routines seek and scan Cost Sheet in CostLevel Order.
6166*!* * "Set Order to..." was being executed in MultiLevelCostFromBOM, but nowhere else. Set
6167*!* * it here, and put back where it was when done:
6168*!* lnSelect = SELECT()
6169*!* SELECT (pcCostAlias)
6170*!* lcOrder = TAG()
6171*!* SET ORDER TO CostLevel
6172*!* SELECT (lnSelect)
6173*!* * === 1003958 end.
6174 *--- TechRec 1038308 16-Mar-2009 vkrishnamurthy ---
6175*!* .MultiLevelCostFromConstant(pcCostAlias, pnPodtlPkey, pnqty, @paCost,@aBOMParts, @lnMaxBOMSku) && get constant.
6176 .MultiLevelCostFromConstant(pcCostAlias, pnPodtlPkey, pnqty, @paCost,@aBOMParts, @lnMaxBOMSku,tcProdCnclDtl) && get constant.
6177 *=== TechRec 1038308 16-Mar-2009 vkrishnamurthy ===
6178
6179 .MultiLevelCostFromBOM(pcCostAlias, pnPodtlPkey, pnqty,@aBOMParts, @lnMaxBOMSku,pcDetailAlias ) && get bom cost &&& 1081975 Added parameter pcDetailAlias
6180 .MultiLevelCostFromBom2(pcCostAlias, pnPodtlPkey, pnqty,@aBOMParts, @lnMaxBOMSku) && bom catch all, do this after all other bom type.
6181 .MultiLevelCostOfHSLookUp(pcCostAlias, pnPodtlPkey, pnqty,@aBOMParts, @lnMaxBOMSku) && get hs lookup cost
6182 .MultiLevelCostOfHSLookUp(pcCostAlias, pnPodtlPkey, pnqty,@aBOMParts, @lnMaxBOMSku, true) &&TR 1072967 26-SEP-13 Venuk . get hs fixed amt
6183 *--- TechRec 1058999 13-Apr-2012 jisingh ---
6184 .MultiLevelCostOfMultiRoyalty(pcCostAlias, pnPodtlPkey, pnQty, @aBOMParts, @lnMaxBOMSku) && get multi royalty cost
6185 *=== TechRec 1058999 13-Apr-2012 jisingh ===
6186 .MultiLevelCostOfCommission(pcCostAlias, pnPodtlPkey, pnqty, Evaluate(pcDetailAlias + ".Agent"), @aBOMParts, @lnMaxBOMSku) && TAN 33059 Ilya get agent commission cost
6187 .MultiLevelCostByFormula(pcCostAlias, pnPodtlPkey, pnqty, @paCost,@aBOMParts, @lnMaxBOMSku) && get cost by formula
6188
6189*!* T H I S N E E D S I N V E S T I G A T I N '
6190*!* * --- 1003958 05/04 CB - Return the state as it was:
6191*!* lnSelect = SELECT()
6192*!* SELECT (pcCostAlias)
6193*!* SET ORDER TO (lcOrder)
6194*!* SELECT (lnSelect)
6195*!* * === 1003958 end.
6196 Else
6197 *--- PL 06/04/02 32339 Prod. Order Entry - Cost is not resolving from Cost Sheet for PO's with NO BOM
6198 *--- TechRec 1038308 13-Mar-2009 vkrishnamurthy ---
6199*!* .CostFromConstant(pcCostAlias, pnPodtlPkey, pnqty, @paCost) && get constant.
6200 .CostFromConstant(pcCostAlias, pnPodtlPkey, pnqty, @paCost,tcProdCnclDtl) && get constant.
6201 *=== TechRec 1038308 13-Mar-2009 vkrishnamurthy ---
6202 .CostOfHSLookUp(pcCostAlias, pnPodtlPkey, pnqty) && get hs lookup cost
6203 .CostOfHSLookUp(pcCostAlias, pnPodtlPkey, pnqty, true) && TR 1072967 26-SEP-13 Venuk. get hs fixed dollar
6204
6205 *--- TechRec 1058999 18-Apr-2012 jisingh ---
6206 .CostOfMultiRoyalty(pcCostAlias, pnPodtlPkey, pnQty) && get multi royalty cost
6207 *=== TechRec 1058999 18-Apr-2012 jisingh ===
6208 .CostOfCommission(pcCostAlias, pnPodtlPkey, pnqty, Evaluate(pcDetailAlias + ".Agent")) && TAN 33059 Ilya get agent commission cost
6209 .CostByFormula(pcCostAlias, pnPodtlPkey, pnqty, @paCost) && get cost by formula
6210 *=== PL 06/04/02 32339 Prod. Order Entry - Cost is not resolving from Cost Sheet for PO's with NO BOM
6211 Endif
6212 ENDWITH
6213 RETURN
6214 ENDPROC
6215
6216 *-------------------------------------------------------------------------------------------------------------------------
6217 * 9/4/02 use BOMLevelPkey to process cost sheet
6218 PROCEDURE GetBOMSkus
6219 LPARAMETER paBOMParts, pnMaxBOMSku, tlRangeStyle && both output parameters
6220 LOCAL llRetVal, lnOldSelect
6221 llRetval= .t.
6222 lnOldSelect= Select()
6223 With This
6224 * group of BOM SKUs use CostLevelPkey to process by SysLevel
6225 * Not all BOM SKUs will have Cost sheet associate to it
6226 *--- 1032015 03/27/09 Ilya: retrieve also TRX usage ratio for BOM level components
6227*-Ilya--- Select distinct syslevel,CostLevelPkey from tmpCostBom ;
6228*-Ilya--- order by syslevel,CostLevelPkey into array paBOMParts
6229 IF tlRangeStyle
6230 *--- 1035380 05/22/09 Ilya: For Range Styles will calculate component usage from BOM
6231 * Assumption is that BOM was created to match the P Range Style content
6232 * (driven by .lPORangeimplosion flag)
6233 *--- 1035380 - Cost Sheet Usage 08/18/09 Ilya:
6234 * Using MAX() funiction to accommodate GROUP BY. Trxusage or ratio is expected to
6235 * be the same within a group.
6236 * C2 cursor is a link to the parent style in the same BOM cursor. Usage is already
6237 * correctly calculated for that style in the BOM, so we will use it as is.
6238 * Later during cost sheet calculation this figure will be used as trxusage
6239 * If the link is not available - we will use trxusage/usage of the current line.
6240 * Parent style may be repeated several times (per size), so we rollup parent by style.
6241 * Using NVL() because syslevel = 0 level lines don't have parent.
6242 SELECT c1.syslevel, c1.CostLevelPkey, MAX(NVL(c2.trxusage,c1.trxusage/c1.usage)) ;
6243 FROM tmpCostBom c1 ;
6244 LEFT OUTER JOIN ;
6245 (SELECT syslevel, division, style, color_code, lbl_code, dimension, SUM(trxusage) AS trxusage ;
6246 FROM tmpCostBom c2 ;
6247 GROUP BY syslevel, division, style, color_code, lbl_code, dimension) c2 ;
6248 ON c2.syslevel = c1.syslevel - 1 ;
6249 AND c2.division = c1.master_div ;
6250 AND c2.style = c1.master_style ;
6251 AND c2.color_code = c1.master_color ;
6252 AND c2.lbl_code = c1.master_lbl ;
6253 AND c2.dimension = c1.master_dim ;
6254 GROUP BY c1.syslevel, c1.CostLevelPkey ;
6255 ORDER BY c1.syslevel, c1.CostLevelPkey ;
6256 INTO ARRAY paBOMParts
6257 ELSE
6258 SELECT syslevel, CostLevelPkey, 0 ;
6259 FROM tmpCostBom ;
6260 GROUP BY syslevel, CostLevelPkey ;
6261 ORDER BY syslevel, CostLevelPkey ;
6262 INTO ARRAY paBOMParts
6263 ENDIF
6264 *=== 1035380 - Cost Sheet Usage 08/18/09 Ilya.
6265 *=== 1035380 05/22/09 Ilya.
6266 *=== 1032015 03/27/09 Ilya.
6267 pnMaxBOMSku= Alen(paBOMParts,1 )
6268 Endwith
6269 llRetval= VarType(paBOMParts[1])= "N" && ONLY when there is some BOM item to work with (syslevel int)
6270 .nMaxLevel= IIF(llRetval And pnMaxBOMSku>0, paBOMParts[pnMaxBOMSku,1] ,0) && 32276 06/06/02 PL
6271 Return llRetval
6272 ENDPROC
6273
6274 *------------------------------------------------------------------------------------------------------------------------
6275 PROCEDURE ResolvePrePackComponentQty
6276 Parameters pcDivision, pcStyle, pcColor, pcLbl, pcDimension
6277
6278 LOCAL llRetVal, lnOldSelect, lcSize_code, lnPack_total
6279 llRetval= .t.
6280 lnOldSelect= Select()
6281 With This
6282 .nPrepackItemQty= 1
6283 If .nPrePackQty> 1
6284 lnPack_total= .nPrePackQty
6285 * Get Size_code from zzxstylr (Style Header) *
6286 lcSize_code = vl_stylr(pcDivision, "size_code", "", pcStyle)
6287
6288 If !Empty(lcSize_code)
6289 If Not (pcDimension == .cPrePackCode) && Don't call resolution when prepackcode = dimension
6290
6291 *--- 32509 06/19/02 PL Cost change to divide by prepack to calcutate cost
6292 *-- Use Production Detail Division,size_code instead of BOM components division,size_code
6293 *-- ie. as per Jason/Ron use Finish good division from prod dtl instead of bom div
6294 *-- Amerex will not setup prepack for RawMaterial division they only prep data for
6295 *-- finish good division.
6296 pcDivision= .cProdDetailDivision
6297 lcSize_code= .cProdDetailSize_code
6298 *=== 32509 06/19/02 PL
6299
6300 lnPack_total= vl_ppakd(pcDivision, "pack_total", , lcSize_code, .cPrePackCode, ;
6301 pcColor, pcLbl, pcDimension)
6302 Else
6303 lnPack_total= .nPrePackQty
6304 Endif
6305 lnPack_total= iif(Empty(lnPack_total), .nPrePackQty, lnPack_total)
6306 Endif
6307 .nPrepackItemQty= lnPack_total && Component default to header prepack qty
6308 Endif
6309 Endwith
6310 Select (lnOldSelect)
6311 Return llRetval
6312 ENDPROC
6313
6314
6315 *--------------------------------------------------------- ----------------------------------------------------------------
6316 * PL 29378 3/28/02 Multi-level cost sheet calculate cost from bom
6317 PROCEDURE MultiLevelCostFromBOM
6318 LPARAMETER pcCostAlias, pnPodtlPkey, pnqty, paBOMParts, pnMaxBOMSku,pcDetailAlias && 1081975 AZ added parameter pcDetailAlias
6319
6320 LOCAL lncost, lnExtension, lcCmp_type, lcCost_type, lcBOM_Dutiable, lnRecNo, llRetVal,;
6321 lnCnt, lnSysLevel, lnCostLevelPkey, lcSKU,lcwip_total &&& 1081975 AZ
6322
6323 *--- TechRec 1024615 29-May-2007 vkrishnamurthy ---
6324 LOCAL lnBomSkuCount , llOneSize ,lcBomstage , lcCondition &&& 1086753 AZ
6325 *=== TechRec 1024615 29-May-2007 vkrishnamurthy ===
6326
6327 llRetval= .t.
6328 lnOldSelect= Select()
6329 With This
6330
6331 *--- TAN 34778 06/16/03 AD
6332 USE IN SELECT("tcCategory")
6333 v_SQLExec("SELECT * FROM zzdcatgr", "tcCategory")
6334 SELECT tcCategory
6335 INDEX ON Category TAG Category
6336 *=== TAN 34778 06/16/03 AD
6337
6338 SELECT (pcCostAlias)
6339 .pushRecordSet()
6340 Set Order to CostLevel && 32276 06/06/02 PL
6341
6342 lnOrigQty= pnQty
6343 * calculate cost for same Prod Detail Fkey and BOM parent level pkey (CostLevelPkey)
6344 * 9/4/02 use CostLevelPkey in both zzcbommd and zzccostd to link proper cost sheet to BOM
6345 FOR lnCnt= 1 to pnMaxBOMSku
6346 lnSysLevel= paBOMParts[lnCnt, 1]
6347 lnCostLevelPkey= paBOMParts[lnCnt, 2]
6348
6349 lcSKU= ""
6350 pnQty= lnOrigQty
6351
6352
6353 *-- 32276 06/06/02 PL - Costing in Prod Ord roll-up from lowest level
6354 *SCAN FOR (fkey= pnPodtlPkey And syslevel= lnSysLevel And CostLevelPkey= lnCostLevelPkey)
6355 llFound= Seek(Str(pnPodtlPkey)+Str(lnSysLevel)+Str(lnCostLevelPkey), ;
6356 pcCostAlias, "CostLevel")
6357
6358 *--- 1032015 03/26/09 Ilya:
6359 IF llFound AND lnSysLevel > 0 AND paBOMParts[lnCnt, 3] > 0
6360 pnQty = paBOMParts[lnCnt, 3]
6361 ENDIF
6362 *=== 1032015 03/26/09 Ilya.
6363
6364 SCAN WHILE llFound And Str(fkey)+Str(syslevel)+Str(CostLevelPkey) = ;
6365 Str(pnPodtlPkey)+Str(lnSysLevel)+Str(lnCostLevelPkey)
6366 *== 32276 06/06/02 PL - Costing in Prod Ord roll-up from lowest level
6367
6368 * resolve to get prepack component qty Once and store in .nPrepackItemQty
6369 * (ie. multi color prepack 12AA-12 have 2 color NVY- 6 and BLK- 6).
6370 * converte pnQty using header Prepack and detail prepack (mix color prepack)
6371 If Not (division + style + color_code + lbl_code + dimension == lcSKU )
6372 lcSKU= division + style + color_code + lbl_code + dimension
6373 .ResolvePrePackComponentQty(division, style , color_code , lbl_code , dimension)
6374 pnqty= pnqty / .nPrepackQty * .nPrepackItemQty
6375 Endif
6376
6377 *--- TAN 34778 06/16/03 AD
6378 *llRetVal = !EMPTY(category) AND vl_dcatgr(category, "", "tcCategory") && ATS 4634
6379 llRetVal = !EMPTY(category) AND SEEK(category, "tcCategory", "Category")
6380 *=== TAN 34778 06/16/03 AD
6381
6382 IF llRetVal
6383 lcCmp_type = tcCategory.cmp_type
6384 lcCost_type = tcCategory.cost_type
6385 lcBOM_Dutiable = tcCategory.BOM_Dutiable
6386 *--- TechRec 1024615 29-May-2007 vkrishnamurthy ---
6387*--- TechRec 1073290 - 1074305 17-Apr-2014 AZhadanov --- Always use trxusage to calculte cost from bom
6388* llOneSize = (vl_btypeh(lcCmp_type,'one_size') = 'Y')
6389 llOneSize = .F.
6390*=== TechRec 1073290 - 1074305 17-Apr-2014 AZhadanov ---
6391
6392 *=== TechRec 1024615 29-May-2007 vkrishnamurthy ===
6393
6394*--- TechRec 1086753 04-Jun-2015 azhadanov ---
6395 lcBomstage = this.GetNearestBomStage(pcDetailAlias ,lcCmp_type,lnSysLevel) &&& 1086753
6396 lcCondition = IIF(EMPTY(lcBomstage)," AND 1=1 "," and use_type = lcBomstage ")
6397*=== TechRec 1086753 04-Jun-2015 azhadanov ---
6398
6399
6400 SELECT tmpCostBom && tmp bom reference for costing, no need to keep track current records.
6401 IF !EMPTY(lcCmp_type) AND lcCmp_type # RSV_ALL && from BOM
6402 *--- TAN 33584 08/07/02 AD
6403 *- Exclude Cost for components with Excl_Cost = 'Y'
6404 *--- TechRec 1024615 29-May-2007 vkrishnamurthy ---
6405*!* CALCULATE SUM(trxusage * rm_cost) TO lnExtension FOR cmp_type = lcCmp_type AND cost_ok = "Y" ;
6406*!* And (dutiable = lcBOM_Dutiable OR lcBOM_Dutiable = "B") ; && ATS 4634 dutiable bom
6407*!* And syslevel= lnSysLevel AND CostLevelPkey= lnCostLevelPkey; && SUM within a cost sheet (Multi-level costing)
6408*!* .AND. Excl_Cost <> 'Y'
6409*!* lncost = lnExtension / MAX(pnqty, 1)
6410 IF llOneSize
6411 *--- 1028790 12-17-2007 SKG
6412*!* COUNT TO lnBomSkuCount FOR cmp_type = lcCmp_type AND cost_ok = "Y" ;
6413*!* AND (dutiable = lcBOM_Dutiable OR lcBOM_Dutiable = "B") ;
6414*!* And syslevel= lnSysLevel AND CostLevelPkey= lnCostLevelPkey AND Excl_Cost <> 'Y'
6415*!*
6416*!* CALCULATE SUM(rm_cost) TO lnExtension FOR cmp_type = lcCmp_type AND cost_ok = "Y" ;
6417*!* AND (dutiable = lcBOM_Dutiable OR lcBOM_Dutiable = "B") ;
6418*!* And syslevel= lnSysLevel AND CostLevelPkey= lnCostLevelPkey AND Excl_Cost <> 'Y'
6419*!*
6420*!* lnBomSkuCount = IIF( lnBomSkuCount > 0 , lnBomSkuCount ,1)
6421*!* lncost = lnExtension /lnBomSkuCount
6422 .pushRecordSet()
6423 *--- TR 1035481 9/4/2008 AZ Added wastefactor like in cost reference
6424
6425*!* SELECT SUM(rm_cost)/IIF(COUNT(*) > 0,COUNT(*),1) as lncst ;
6426*!* FROM tmpCostBom ;
6427*!* WHERE cmp_type = lcCmp_type AND cost_ok = "Y" ;
6428*!* AND (dutiable = lcBOM_Dutiable OR lcBOM_Dutiable = "B") ;
6429*!* And syslevel= lnSysLevel AND CostLevelPkey= lnCostLevelPkey AND Excl_Cost <> 'Y' ;
6430*!* GROUP BY Division, Style, Color_code, Lbl_code, Dimension, Cmp_Code, Cmp_Type, Size_OK, Dutiable ;
6431*!* INTO CURSOR TmpCst
6432
6433* CALCULATE SUM(lncst) TO lncost
6434*--- TechRec 1060223 12-Jun-2012 AZhadanov --- Removed condition AND Excl_Cost <> 'Y' to be consitant with TR 1027969
6435 SELECT SUM(rm_cost*(1.+wastefactor) * usage) as lncst, COUNT(*) as cnt ; &&& 1037260 AZ Added * usage
6436 FROM tmpCostBom ;
6437 WHERE cmp_type = lcCmp_type AND cost_ok = "Y" ;
6438 AND (dutiable = lcBOM_Dutiable OR lcBOM_Dutiable = "B") ;
6439 And syslevel= lnSysLevel AND CostLevelPkey= lnCostLevelPkey ; &&& AND Excl_Cost <> 'Y' 1060223 AZ remove Excl_Cost <> 'Y'
6440 GROUP BY Division, Style, Color_code, Lbl_code, Dimension, Cmp_Code, Cmp_Type, Size_OK, Dutiable ;
6441 INTO CURSOR TmpCst
6442*=== TechRec 1060223 12-Jun-2012 AZhadanov --- Removed condition AND Excl_Cost <> 'Y' to be consitant with TR 1027969
6443 CALCULATE SUM(lncst/IIF(cnt=0, 1, cnt)) TO lncost
6444 *=== TR 1035481 9/4/2008 AZ Added wastefactor like in cost reference
6445
6446 USE IN SELECT("tmpCst")
6447 .popRecordSet()
6448 *=== 1028790 12-17-2007 SKG
6449 lnExtension = lnCost * pnqty
6450 ELSE
6451*--- TAN 1027969 02-Nov-07 AZ removed condition .AND. Excl_Cost <> 'Y'
6452
6453*--- TechRec 1075075 13-Aug-2014 AZhadanov --- Calculate cost per unit instead of extension
6454*!* CALCULATE SUM(trxusage * rm_cost) TO lnExtension FOR cmp_type = lcCmp_type AND cost_ok = "Y" ;
6455*!* And (dutiable = lcBOM_Dutiable OR lcBOM_Dutiable = "B") ; && ATS 4634 dutiable bom
6456*!* And syslevel= lnSysLevel AND CostLevelPkey= lnCostLevelPkey && SUM within a cost sheet (Multi-level costing)
6457*!* **** .AND. Excl_Cost <> 'Y'
6458
6459*--- TechRec 1086753 04-Jun-2015 azhadanov ---
6460*** 1082212 AZ put orig_trxusage instead of trxusage
6461 CALCULATE SUM(IIF(wip_total> 0,orig_trxusage*rm_cost/wip_total,0)) TO lncost FOR cmp_type = lcCmp_type AND cost_ok = "Y" ;
6462 And (dutiable = lcBOM_Dutiable OR lcBOM_Dutiable = "B") ; && ATS 4634 dutiable bom
6463 And syslevel= lnSysLevel AND CostLevelPkey= lnCostLevelPkey &lcCondition && SUM within a cost sheet (Multi-level costing)
6464**** .AND. Excl_Cost <> 'Y'
6465*=== TechRec 1086753 04-Jun-2015 azhadanov ---
6466
6467*** 1081975 use parameter instead of vzzcordrd.
6468*lnqty = IIF(vzzcordrd.wip_total > 0 ,vzzcordrd.wip_total,pnqty) &&& 1075075 AZ
6469lcwip_total = EVALUATE(pcDetailAlias+".wip_total") &&& 1081975
6470lnqty = IIF(lcwip_total > 0 ,lcwip_total,pnqty) &&& 1075075 AZ &&& 1081975
6471
6472
6473*=== TechRec 1075075 13-Aug-2014 AZhadanov --- Calculate cost per unit instead of extension
6474*=== TAN 1027969 02-Nov-07 AZ
6475*--- TR 1045777 18/05/10 AZ
6476* lncost = lnExtension / MAX(pnqty, 1)
6477 IF lnqty = 0 &&& 1075075
6478* lnqty = 0
6479 LOCATE FOR cmp_type = lcCmp_type AND cost_ok = "Y" ;
6480 And (dutiable = lcBOM_Dutiable OR lcBOM_Dutiable = "B") ;
6481 And syslevel= lnSysLevel AND CostLevelPkey= lnCostLevelPkey ;
6482 .AND. Excl_Cost <> 'Y' ;
6483 and trxusage > 0
6484 IF FOUND()
6485 *--- TR 1063136 08/08/12 ATHIRUNAVU Used This.lLast_Stage instead of vzzcordrd.last_stage ='Y'
6486 *-- as alias may not exists when this method calls from process
6487 *lnqty =IIF((wip_total > 0 and (use_type <> 'C' or vzzcordrd.last_stage = 'Y')) ,wip_total,pnqty) &&& 1045777
6488* lnqty =IIF((wip_total > 0 and (use_type <> 'C' or This.lLast_Stage)) ,wip_total,pnqty) &&& 1045777
6489 *--- TechRec 1068034 17-Apr-2013 AZhadanov ---
6490* lnqty =IIF((wip_total > 0 and (use_type <> 'C' or This.lLast_Stage)) ,wip_total,pnqty) &&& 1045777
6491 lnqty =IIF(wip_total > 0 ,wip_total,pnqty) &&& 1045777 &&& 1068034
6492 *=== TechRec 1068034 17-Apr-2013 AZhadanov ===
6493
6494 *=== TR 1063136 08/08/12 ATHIRUNAVU
6495 ENDIF
6496 ENDIF &&& 1075075
6497
6498* lncost = IIF(lnqty > 0,lnExtension/lnqty,0) &&& 1075075
6499 *--- TR 1048025 12/03/10 AZ
6500 lnExtension = lnCost * pnqty &&& 1048025 AZ
6501 *=== TR 1048025 12/03/10 AZ
6502
6503
6504*=== TR 1045777 18/05/10 AZ
6505 ENDIF
6506 *=== TechRec 1024615 29-May-2007 vkrishnamurthy ===
6507
6508 *--- 1003958 05/04 - CB was failing in UDEV, added rounding:
6509 lnExtension = ROUND(lnExtension, 5)
6510 lnCost = ROUND(lnCost, 5)
6511 * === 1003958 end.
6512
6513 *=== TAN 33584 08/07/02 AD
6514 REPLACE category_cost WITH lncost, extension WITH lnExtension IN (pcCostAlias)
6515 *--- TechRec 1003897 26-Mar-2004 GS ---
6516 *--- TR1012435 08/04/05 MP Fix (restored from TR1007219)
6517 *if Evaluate(pcProdCost + ".Imp_Cost") # 'Y'
6518 if Evaluate(pcCostAlias + ".Imp_Cost") # 'Y'
6519 *=== TR1012435 08/04/05 MP
6520 replace Estm_Ext_Cost with lnExtension in (pcCostAlias)
6521 endif
6522 *=== TechRec 1003897 26-Mar-2004 GS ===
6523
6524 *--- TechRec 1037610 12-Feb-2009 asharma ---
6525 IF This.lOptimizedRecalc AND THIS.lDynamicsPrepped
6526 replace modified WITH 'Y' in (pcCostAlias)
6527 ENDIF
6528 *=== TechRec 1037610 12-Feb-2009 asharma ===
6529
6530 ENDIF
6531 *--- TAN 34778 06/16/03 AD
6532 *USE IN tcCategory
6533 *=== TAN 34778 06/16/03 AD
6534 ENDIF
6535 ENDSCAN
6536 ENDFOR
6537 SELECT (pcCostAlias)
6538 .popRecordSet()
6539 Endwith
6540
6541 *--- TAN 34778 06/16/03 AD
6542 USE IN SELECT("tcCategory")
6543 *=== TAN 34778 06/16/03 AD
6544
6545 Select (lnOldSelect)
6546 RETURN
6547 ENDPROC
6548
6549 *-------------------------------------------------------------------------------------------------------------------------
6550 * PL 29378 3/28/02 Multi-level cost sheet calculate cost from bom catch all
6551 * calculate cost from bom, catch all.
6552 * three possiable 'catch all', 1. dutiable catch all, 2 non-dutiable catch all,
6553 * 3. both
6554 PROCEDURE MultiLevelCostFromBOM2
6555 LPARAMETER pcCostAlias, pnPodtlPkey, pnqty, paBOMParts, pnMaxBOMSku
6556 LOCAL lncost, lnTotalBomCost, lnTotalDutiableBOM, lnTotalNonDutiableBom, ;
6557 lnExtension, lnExtension2, lcCmp_type, lnRecNo, llRetVal, lcBOM_Dutiable, ; && ats 4673
6558 lnCnt, lnSysLevel, lnCostLevelPkey
6559
6560 *--- TechRec 1024615 30-May-2007 vkrishnamurthy ---
6561 LOCAL lcWhereCond
6562 *=== TechRec 1024615 30-May-2007 vkrishnamurthy ===
6563
6564 With This
6565 lnOrigQty= pnQty
6566 * calculate cost for same POPDtl fkey and BOM SKU
6567 * 9/4/02 use CostLevelPkey in both zzcbommd and zzccostd to link proper cost sheet to BOM
6568 FOR lnCnt= 1 to pnMaxBOMSku
6569 lnSysLevel= paBOMParts[lnCnt, 1]
6570 lnCostLevelPkey= paBOMParts[lnCnt, 2]
6571
6572 lcSKU= ""
6573 pnQty= lnOrigQty
6574
6575 lnExtension = 0
6576 * 10/25/00 ATS 4673, get three type of bom costs.
6577 SELECT tmpCostBom
6578 *--- TAN 33584 08/07/02 AD
6579 *- Exclude Cost for components with Excl_Cost = 'Y'
6580
6581 *--- TechRec 1024615 30-May-2007 vkrishnamurthy ---
6582*!* CALCULATE SUM(trxusage * rm_cost) TO lnTotalBomCost FOR cost_ok = "Y" And ;
6583*!* syslevel= lnSysLevel And CostLevelPkey= lnCostLevelPkey .AND. Excl_Cost <> 'Y'
6584*!* CALCULATE SUM(trxusage * rm_cost) TO lnTotalDutiableBOM FOR cost_ok = "Y" AND ;
6585*!* dutiable = 'Y' And syslevel= lnSysLevel And CostLevelPkey= lnCostLevelPkey .AND. Excl_Cost <> 'Y'
6586*!* CALCULATE SUM(trxusage * rm_cost) TO lnTotalNonDutiableBom FOR cost_ok = "Y" AND ;
6587*!* dutiable = 'N' And syslevel= lnSysLevel And CostLevelPkey= lnCostLevelPkey .AND. Excl_Cost <> 'Y'
6588
6589*--- TAN 1027969 02-Nov-07 AZ Removed condition And Excl_Cost <> 'Y
6590
6591* lcWhereCond = " cost_ok = 'Y' And Excl_Cost <> 'Y' " + " AND syslevel= " + SQLFormatNum(lnSysLevel) + ;
6592* " And CostLevelPkey= " + SQLFormatNum(lnCostLevelPkey)
6593
6594 lcWhereCond = " cost_ok = 'Y' " + " AND syslevel= " + SQLFormatNum(lnSysLevel) + ;
6595 " And CostLevelPkey= " + SQLFormatNum(lnCostLevelPkey)
6596*=== TAN 1027969 02-Nov-07 AZ Removed condition And Excl_Cost <> 'Y
6597 lnTotalBomCost = .GetBOMCostBySizeForPO(lcWhereCond, pnQty)
6598*--- TAN 1027969 02-Nov-07 AZ Removed condition And Excl_Cost <> 'Y
6599* lcWhereCond = " cost_ok = 'Y' And dutiable = 'Y' AND Excl_Cost <> 'Y' " + " AND syslevel= " + SQLFormatNum(lnSysLevel) + ;
6600* " And CostLevelPkey= " + SQLFormatNum(lnCostLevelPkey)
6601 lcWhereCond = " cost_ok = 'Y' And dutiable = 'Y' " + " AND syslevel= " + SQLFormatNum(lnSysLevel) + ;
6602 " And CostLevelPkey= " + SQLFormatNum(lnCostLevelPkey)
6603*=== TAN 1027969 02-Nov-07 AZ Removed condition And Excl_Cost <> 'Y
6604
6605 lnTotalDutiableBOM = .GetBOMCostBySizeForPO(lcWhereCond, pnQty)
6606
6607*--- TAN 1027969 02-Nov-07 AZ Removed condition And Excl_Cost <> 'Y
6608* lcWhereCond = " cost_ok = 'Y' And dutiable = 'N' AND Excl_Cost <> 'Y' " + " AND syslevel= " + SQLFormatNum(lnSysLevel) + ;
6609* " And CostLevelPkey= " + SQLFormatNum(lnCostLevelPkey)
6610 lcWhereCond = " cost_ok = 'Y' And dutiable = 'N' " + " AND syslevel= " + SQLFormatNum(lnSysLevel) + ;
6611 " And CostLevelPkey= " + SQLFormatNum(lnCostLevelPkey)
6612*=== TAN 1027969 02-Nov-07 AZ Removed condition And Excl_Cost <> 'Y
6613
6614 lnTotalNonDutiableBom = .GetBOMCostBySizeForPO(lcWhereCond, pnQty)
6615 *=== TechRec 1024615 30-May-2007 vkrishnamurthy ===
6616
6617 *=== TAN 33584 08/07/02 AD
6618 * now look for each type of cath all
6619 SELECT (pcCostAlias)
6620 THIS.pushRecordSet()
6621
6622 Set Order to CostLevel && 32276 06/06/02 PL &&& 1041085 AZ
6623
6624 *-- 32276 06/06/02 PL - Costing in Prod Ord roll-up from lowest level
6625 *SCAN FOR (fkey= pnPodtlPkey And syslevel= lnSysLevel And CostLevelPkey= lnCostLevelPkey)
6626 llFound= Seek(Str(pnPodtlPkey)+Str(lnSysLevel)+Str(lnCostLevelPkey), ;
6627 pcCostAlias, "CostLevel")
6628
6629 *--- 1032015 03/26/09 Ilya:
6630 IF llFound AND lnSysLevel > 0 AND paBOMParts[lnCnt, 3] > 0
6631 pnQty = paBOMParts[lnCnt, 3]
6632 ENDIF
6633 *=== 1032015 03/26/09 Ilya.
6634
6635 SCAN WHILE llFound And Str(fkey)+Str(syslevel)+Str(CostLevelPkey) = ;
6636 Str(pnPodtlPkey)+Str(lnSysLevel)+Str(lnCostLevelPkey)
6637 *== 32276 06/06/02 PL - Costing in Prod Ord roll-up from lowest level
6638
6639 * resolve to get prepack component qty Once and store in .nPrepackItemQty
6640 * (ie. multi color prepack 12AA-12 have 2 color NVY- 6 and BLK- 6).
6641 * converte pnQty using header Prepack and detail prepack (mix color prepack)
6642 If Not (division + style + color_code + lbl_code + dimension == lcSKU )
6643 lcSKU= division + style + color_code + lbl_code + dimension
6644 .ResolvePrePackComponentQty(division, style , color_code , lbl_code , dimension)
6645 pnqty= pnqty / .nPrepackQty * .nPrepackItemQty
6646 Endif
6647
6648 lcCategory = category
6649 lcCmp_type = cmp_type
6650 lcBOM_Dutiable = BOM_Dutiable
6651
6652 IF !EMPTY(lcCmp_type) AND RTRIM(lcCmp_type) == RSV_ALL && from BOM, catch all
6653 lnRecNo = RECNO()
6654 DO CASE
6655 CASE lcBOM_Dutiable = "Y"
6656 CALCULATE SUM(extension) TO lnExtension2 ;
6657 FOR !EMPTY(cmp_type) AND RTRIM(cmp_type) # RSV_ALL AND ;
6658 category # lcCategory AND BOM_Dutiable = "Y" AND fkey = pnPodtlPkey AND ;
6659 syslevel= lnSysLevel AND CostLevelPkey= lnCostLevelPkey
6660 lnExtension = lnTotalDutiableBOM - lnExtension2
6661 CASE lcBOM_Dutiable = "N"
6662 CALCULATE SUM(extension) TO lnExtension2 ;
6663 FOR !EMPTY(cmp_type) AND RTRIM(cmp_type) # RSV_ALL AND ;
6664 category # lcCategory AND BOM_Dutiable = "N" AND fkey = pnPodtlPkey AND ;
6665 syslevel= lnSysLevel AND CostLevelPkey= lnCostLevelPkey
6666 lnExtension = lnTotalNonDutiableBom - lnExtension2
6667 CASE lcBOM_Dutiable = "B"
6668 CALCULATE SUM(extension) TO lnExtension2 ;
6669 FOR !EMPTY(cmp_type) AND RTRIM(cmp_type) # RSV_ALL AND ;
6670 category # lcCategory AND fkey = pnPodtlPkey AND ;
6671 syslevel= lnSysLevel AND CostLevelPkey= lnCostLevelPkey
6672 lnExtension = lnTotalBomCost - lnExtension2
6673 OTHER
6674 lnExtension = 0
6675 ENDCASE
6676
6677 *--- TechRec 1024615 30-May-2007 vkrishnamurthy ---
6678 lnExtension = IIF(lnExtension >0,lnExtension , 0)
6679 *=== TechRec 1024615 30-May-2007 vkrishnamurthy ===
6680
6681 lncost = lnExtension / MAX(pnqty, 1)
6682
6683 *--- 1003958 05/04 - CB was failing in UDEV, added rounding:
6684 lnCost = ROUND(lnCost, 5)
6685 lnExtension = ROUND(lnExtension, 5)
6686 * === 1003958 end.
6687
6688 GO lnRecNo IN (pcCostAlias)
6689 REPLACE category_cost WITH lncost, extension WITH lnExtension IN (pcCostAlias)
6690 *--- TechRec 1003897 26-Mar-2004 GS ---
6691 if Imp_Cost # 'Y'
6692 replace Estm_Ext_Cost with Extension
6693
6694 *--- 1012294 KISHOR 2-AUG-2006
6695 IF This.lOptimizedRecalc AND THIS.lDynamicsPrepped
6696 replace modified WITH 'Y'
6697 ENDIF
6698 *=== 1012294 KISHOR 2-AUG-2006
6699 endif
6700 *=== TechRec 1003897 26-Mar-2004 GS ===
6701 ENDIF
6702 ENDSCAN
6703 ENDFOR
6704 SELECT (pcCostAlias)
6705 THIS.popRecordSet()
6706 ENDWITH
6707 RETURN
6708 ENDPROC
6709
6710
6711 *-------------------------------------------------------------------------------------------------------------------------
6712 * PL 29378 3/28/02 Multi-level cost sheet
6713 PROCEDURE MultiLevelCostFromConstant
6714 LPARAMETER pcCostAlias, pnPodtlPkey, pnQty, paCost, paBOMParts, pnMaxBOMSku,tcProdCnclDtl
6715 &&--- TechRec 1038308 16-Mar-2009 vkrishnamurthy === Added tcProdCnclDtl
6716 EXTERNAL ARRAY paCost
6717 LOCAL lnExtension, llRetVal, lcCost_Type, lcCategory
6718 local lnExRate &&--- TechRec 1007154 07-Oct-2004 GS ===
6719 llRetval= .t.
6720*--- TAN 1031633 03/25/08 AZ
6721 lcCost_Type = ''
6722*--- TAN 1031633 03/25/08 AZ
6723
6724 lnOldSelect= Select()
6725
6726 *--- TechRec 1004691 27-Apr-2004 GS --- Optimization.
6727*!* *--- TAN 34778 06/16/03 AD
6728*!* USE IN SELECT("tcCatgr")
6729*!* v_SQLExec("SELECT * FROM zzdcatgr", "tcCatgr")
6730*!* SELECT tcCatgr
6731*!* INDEX ON Category TAG Category
6732*!* *=== TAN 34778 06/16/03 AD
6733 *=== TechRec 1004691 27-Apr-2004 GS ===
6734
6735
6736 SELECT (pcCostAlias)
6737 THIS.pushRecordSet()
6738 Set Order to CostLevel && 32276 06/06/02 PL &&& 1041085 AZ
6739
6740 lnOrigQty= pnQty
6741
6742 * calculate cost for same POPDtl fkey and BOM SKU
6743 * 9/4/02 use CostLevelPkey in both zzcbommd and zzccostd to link proper cost sheet to BOM
6744 FOR lnCnt= 1 to pnMaxBOMSku
6745 lnSysLevel= paBOMParts[lnCnt, 1]
6746 lnCostLevelPkey= paBOMParts[lnCnt, 2]
6747
6748 lcSKU= ""
6749 pnQty= lnOrigQty
6750 *-- 32276 06/06/02 PL - Costing in Prod Ord roll-up from lowest level
6751 *SCAN FOR (fkey= pnPodtlPkey And syslevel= lnSysLevel And CostLevelPkey= lnCostLevelPkey)
6752 llFound= Seek(Str(pnPodtlPkey)+Str(lnSysLevel)+Str(lnCostLevelPkey), ;
6753 pcCostAlias, "CostLevel")
6754
6755 *--- 1032015 03/26/09 Ilya:
6756 IF llFound AND lnSysLevel > 0 AND paBOMParts[lnCnt, 3] > 0
6757 pnQty = paBOMParts[lnCnt, 3]
6758 ENDIF
6759 *=== 1032015 03/26/09 Ilya.
6760
6761 SCAN WHILE llFound And Str(fkey)+Str(SysLevel)+Str(CostLevelPkey) = ;
6762 Str(pnPodtlPkey)+Str(lnSysLevel)+Str(lnCostLevelPkey)
6763 *== 32276 06/06/02 PL - Costing in Prod Ord roll-up from lowest level
6764
6765 * resolve to get prepack component qty Once and store in .nPrepackItemQty
6766 * (ie. multi color prepack 12AA-12 have 2 color NVY- 6 and BLK- 6).
6767 * converte pnQty using header Prepack and detail prepack (mix color prepack)
6768 If Not (division + style + color_code + lbl_code + dimension == lcSKU )
6769 lcSKU= division + style + color_code + lbl_code + dimension
6770 .ResolvePrePackComponentQty(division, style , color_code , lbl_code , dimension)
6771 pnQty= pnQty / .nPrepackQty * .nPrepackItemQty
6772 Endif
6773
6774
6775 *--- TAN 34778 06/16/03 AD
6776 *llRetVal = vl_dcatgr(category, "", "tcCatgr")
6777
6778 *--- TechRec 1004691 27-Apr-2004 GS --- Optimization.
6779 *llRetVal = SEEK(category, "tcCatgr", "Category")
6780 *=== TAN 34778 06/16/03 AD
6781
6782 *--- TechRec 1026008 13-Aug-2007 GSternik ---
6783 *-- This is needed ONLY when Currency Exchange Rate category exists!
6784 if This.lER_Lookup
6785 lcCategory = Category
6786 Select (This.cCatAlias)
6787 llRetVal = Seek(lcCategory)
6788 lcCost_Type = Upper(Left(Cost_Type,9))
6789
6790 *--- TechRec 1007154 07-Oct-2004 GS ---
6791 lcCategory = AllTrim(Cost_Type)
6792 *=== TechRec 1007154 07-Oct-2004 GS ===
6793 EndIf && *--- TechRec 1026008 13-Aug-2007 GSternik ===
6794
6795 Select (pcCostAlias)
6796 *=== TechRec 1004691 27-Apr-2004 GS ===
6797
6798 *--- TechRec 1026008 13-Aug-2007 GSternik ---
6799 *--- TechRec 1038308 16-Mar-2009 vkrishnamurthy ---
6800*!* if AP_Cost = 'Y' and This.Set_AP_Cost(@pcCostAlias)
6801 *--- TechRec 1039635 04-May-2009 vkrishnamurthy ---
6802*!* if AP_Cost = 'Y' and This.Set_AP_Cost(@pcCostAlias,tcProdCnclDtl)
6803
6804*--- TR 1051285 04/12/11 AZ
6805*!* if AP_Cost = 'Y' and SUBSTR(PROGRAM(PROGRAM(-1)-4),24,14)<>"APPROVEVOUCHER" AND This.Set_AP_Cost(@pcCostAlias,tcProdCnclDtl)
6806*!* *=== TechRec 1039635 04-May-2009 vkrishnamurthy ===
6807*!*
6808*!* *=== TechRec 1038308 16-Mar-2009 vkrishnamurthy ===
6809*!* loop
6810*!* EndIf
6811 *=== TechRec 1026008 13-Aug-2007 GSternik ===
6812 LOCAL ix,nlevel
6813 IF AP_Cost = 'Y'
6814 nlevel = PROGRAM(-1)
6815 FOR ix = nlevel TO 1 STEP -1
6816 IF ATC("APPROVEVOUCHER",PROGRAM(ix)) > 0 OR ATC("PRORATEPRODUCTIONTREES",PROGRAM(ix)) > 0
6817 EXIT
6818 ENDIF
6819 NEXT
6820 IF ix <= 1
6821* This.Set_AP_Cost(@pcCostAlias,tcProdCnclDtl)
6822 *--- TechRec 1067706 27-Mar-2013 AZhadanov ---
6823 lnqty = 0
6824 IF lnOrigQty <> pnQty &&& Only if range style
6825 lnqty = pnQty
6826 ENDIF
6827 *=== TechRec 1067706 27-Mar-2013 AZhadanov ===
6828 This.Set_AP_Cost(@pcCostAlias,tcProdCnclDtl,lnqty ) &&& 1062160 added parameter pnqty &&& 1067706
6829 ENDIF
6830 LOOP
6831 ENDIF
6832*=== TR 1051285 04/12/11 AZ
6833
6834
6835
6836
6837 *--- TAN 38028 03/21/03 AD
6838 IF !EMPTY(constant) && constant.
6839
6840 *--- TAN 38860 06-Jun-2003 GS ---
6841
6842 *IF !EMPTY(constant) or (Empty(constant) and Empty(formula))
6843 *=== TAN 38860 06-Jun-2003 GS ===
6844 * ATS 4359, do not override import tracking with constant.
6845 * i.e. import tracking will use constant if it is prorated to 0.
6846 *IF tcCatgr.imp_tracking # "Y" OR extension = 0
6847 IF Imp_Cost # "Y" OR Extension = 0
6848 lnCost = Constant
6849 *--- TR 1083069 06-Jan-2015 SMeenraja Rounded the value, to avoid overflow error
6850*!* REPLACE category_cost WITH constant, extension WITH constant * pnqty IN (pcCostAlias)
6851 lnExtension = ROUND(constant * pnqty, 5)
6852 REPLACE category_cost WITH constant, extension WITH lnExtension IN (pcCostAlias)
6853 *=== TR 1083069 06-Jan-2015 SMeenraja Rounded the value, to avoid overflow error
6854 *--- TechRec 1003897 26-Mar-2004 GS ---
6855 if Imp_Cost # 'Y'
6856 replace Estm_Ext_Cost with Extension
6857
6858 *--- 1012294 KISHOR 2-AUG-2006
6859 IF This.lOptimizedRecalc AND THIS.lDynamicsPrepped
6860 replace modified WITH 'Y'
6861 ENDIF
6862 *=== 1012294 KISHOR 2-AUG-2006
6863
6864 endif
6865 *=== TechRec 1003897 26-Mar-2004 GS ===
6866 ENDIF
6867 *--- TAN 38860 06-Jun-2003 GS --- uncommented endif
6868
6869 *--- TechRec 1007154 07-Oct-2004 GS ---
6870 ELSE
6871 if This.lER_Lookup and lcCategory == This.cCN_ER_LOOKUP
6872 if This.lLast_Stage
6873 replace Constant with Category_Cost, ;
6874 Extension with 0, Estm_Ext_Cost with 0 in (pcCostAlias)
6875 else
6876 lnExRate = vl_ExRate("","EXH_RATE")
6877 If Empty(lnExRate) &&We don't know what will be return by vl call
6878 lnExRate = 0
6879 Endif
6880 replace Category_Cost WITH lnExRate, ;
6881 Extension with 0, Estm_Ext_Cost with 0 in (pcCostAlias)
6882 endif
6883 endif
6884 *=== TechRec 1007154 07-Oct-2004 GS ===
6885
6886 ENDIF
6887 *=== TAN 38028 03/21/03 AD
6888 *--- TechRec 1003897 23-Mar-2004 AD, GS ---
6889 *IF lnSysLevel = .nMaxLevel .AND. UPPER(LEFT(tcCatgr.Cost_Type,9)) = 'SFCLBLUDF'
6890
6891 *--- TechRec 1004691 27-Apr-2004 GS ---
6892 *IF lnSysLevel > 0 .AND. lnSysLevel = .nMaxLevel .AND. UPPER(LEFT(tcCatgr.Cost_Type,9)) = 'SFCLBLUDF'
6893 *=== TechRec 1003897 23-Mar-2004 AD, GS ===
6894 IF lnSysLevel > 0 and lnSysLevel = .nMaxLevel and lcCost_Type = 'SFCLBLUDF'
6895 *=== TechRec 1004691 27-Apr-2004 GS ===
6896 *--- TR 1083069 06-Jan-2015 SMeenraja Rounded the value, to avoid overflow error
6897*!* REPLACE extension WITH category_cost * pnqty IN (pcCostAlias)
6898 lnExtension = ROUND(category_cost * pnqty, 5)
6899 REPLACE extension WITH lnExtension IN (pcCostAlias)
6900 *=== TR 1083069 06-Jan-2015 SMeenraja Rounded the value, to avoid overflow error
6901 *--- TechRec 1003897 26-Mar-2004 GS ---
6902 if Imp_Cost # 'Y'
6903 replace Estm_Ext_Cost with Extension
6904
6905 *--- 1012294 KISHOR 2-AUG-2006
6906 IF This.lOptimizedRecalc AND THIS.lDynamicsPrepped
6907 replace modified WITH 'Y'
6908 ENDIF
6909 *=== 1012294 KISHOR 2-AUG-2006
6910 endif
6911 *=== TechRec 1003897 26-Mar-2004 GS ===
6912 ENDIF
6913 * check if this is one of the 4 types required.
6914
6915 *--- TechRec 1004691 27-Apr-2004 GS ---
6916*!* * 4/1/02 29378 - Multi level BOM/Costsheet
6917*!* * PL 4/27 take 1st > 0 in any of 4 cost categories (5/23)
6918*!* DO CASE
6919*!* CASE (paCost[DUTY_] = 0 OR paCost[DUTY_] <> &pcCostAlias..category_cost) AND tcCatgr.cost_type = This.cCN_DUTY_VALUE
6920*!* paCost[DUTY_] = &pcCostAlias..category_cost
6921*!* CASE (paCost[PRODUCTION_] = 0 OR paCost[PRODUCTION_] <> &pcCostAlias..category_cost) AND tcCatgr.cost_type = This.cCN_PROD_VALUE
6922*!* paCost[PRODUCTION_] = &pcCostAlias..category_cost
6923*!* CASE (paCost[MATERIAL_] = 0 OR paCost[MATERIAL_] <> &pcCostAlias..category_cost) AND tcCatgr.cost_type = This.cCN_TOTAL_MATERIAL
6924*!* paCost[MATERIAL_] = &pcCostAlias..category_cost
6925*!* CASE (paCost[TOTAL_COST_] = 0 OR paCost[TOTAL_COST_] <> &pcCostAlias..category_cost) AND tcCatgr.cost_type = This.cCN_TOTAL_COST
6926*!* paCost[TOTAL_COST_] = &pcCostAlias..category_cost
6927*!* *--- TAN 33059 Ilya: Commission cost
6928*!* CASE (paCost[COMMISSION_] = 0 OR paCost[COMMISSION_] <> &pcCostAlias..category_cost) AND tcCatgr.cost_type = This.cCN_COMMISSION
6929*!* paCost[COMMISSION_] = &pcCostAlias..category_cost
6930*!* ENDCASE
6931 *=== TechRec 1004691 27-Apr-2004 GS ===
6932
6933 ENDSCAN
6934 ENDFOR
6935
6936 *--- TechRec 1004691 27-Apr-2004 GS ---
6937 **--- TAN 34778 06/16/03 AD
6938 *USE IN SELECT('tcCatgr')
6939 **=== TAN 34778 06/16/03 AD
6940 *=== TechRec 1004691 27-Apr-2004 GS ===
6941
6942 SELECT (pcCostAlias)
6943 THIS.popRecordSet()
6944 Select (lnOldSelect)
6945 RETURN
6946
6947 ENDPROC
6948
6949 *-------------------------------------------------------------------------------------------------------------------------
6950 * PL 29378 3/28/02 Multi-level cost sheet cost by formula
6951 PROCEDURE MultiLevelCostByFormula
6952 LPARAMETER pcCostAlias, pnPodtlPkey, pnqty, paCost, paBOMParts, pnMaxBOMSku
6953 EXTERNAL ARRAY paCost
6954 LOCAL lncost, lnExtension, lcProd, lcHSDuty, lnprodCost, llRetVal, lcCost_Type,;
6955 lnHSLookupRec, lnDutyRec, lnTotalCostRec, lnHsLookupAmount, lnExRate, lcCategory
6956 local oCostEstm, lnExtensionEstm && -- TR 1011441 MA 06/22/05
6957
6958 lnHsLookupAmount = 0
6959 lnOldSelect= Select()
6960 With This
6961
6962 *--- TechRec 1004691 27-Apr-2004 GS --- Optimization.
6963 *--- TAN 34778 06/16/03 AD
6964 *USE IN SELECT("tcCatgr")
6965 *v_SQLExec("SELECT * FROM zzdcatgr", "tcCatgr")
6966 *SELECT tcCatgr
6967 *INDEX ON Category TAG Category
6968 *=== TAN 34778 06/16/03 AD
6969 *=== TechRec 1004691 27-Apr-2004 GS ===
6970
6971 SELECT (pcCostAlias)
6972 .pushRecordSet()
6973 Set Order to CostLevel && 32276 06/06/02 PL &&& 1041085 AZ
6974
6975 lnOrigQty= pnQty
6976
6977 *-- TR 1011441 MA 06/22/05
6978 oCostEstm = CreateObject("CostEstm",0)
6979 *== TR 1011441 MA 06/22/05
6980
6981 * calculate cost for same POPDtl fkey and BOM SKU
6982 * 9/4/02 use CostLevelPkey in both zzcbommd and zzccostd to link proper cost sheet to BOM
6983 FOR lnCnt= 1 to pnMaxBOMSku
6984 lnSysLevel= paBOMParts[lnCnt, 1]
6985 lnCostLevelPkey= paBOMParts[lnCnt, 2]
6986
6987 lcSKU= ""
6988 pnQty= lnOrigQty
6989
6990 * do formula
6991 *-- 32276 06/06/02 PL - Costing in Prod Ord roll-up from lowest level
6992 *SCAN FOR (fkey= pnPodtlPkey And syslevel= lnSysLevel And CostLevelPkey= lnCostLevelPkey)
6993 llFound= Seek(Str(pnPodtlPkey)+Str(lnSysLevel)+Str(lnCostLevelPkey), ;
6994 pcCostAlias, "CostLevel")
6995
6996 *--- 1032015 03/26/09 Ilya:
6997 IF llFound AND lnSysLevel > 0 AND paBOMParts[lnCnt, 3] > 0
6998 pnQty = paBOMParts[lnCnt, 3]
6999 ENDIF
7000 *=== 1032015 03/26/09 Ilya.
7001
7002 SCAN WHILE llFound And Str(fkey)+Str(syslevel)+Str(CostLevelPkey) = ;
7003 Str(pnPodtlPkey)+Str(lnSysLevel)+Str(lnCostLevelPkey)
7004 *== 32276 06/06/02 PL - Costing in Prod Ord roll-up from lowest level
7005
7006 * resolve to get prepack component qty Once and store in .nPrepackItemQty
7007 * (ie. multi color prepack 12AA-12 have 2 color NVY- 6 and BLK- 6).
7008 * converte pnQty using header Prepack and detail prepack (mix color prepack)
7009 lnPrepackRatio=1 &&& 1062160 AZ
7010 If Not (division + style + color_code + lbl_code + dimension == lcSKU )
7011 lcSKU= division + style + color_code + lbl_code + dimension
7012 .ResolvePrePackComponentQty(division, style , color_code , lbl_code , dimension)
7013 *--- TAN 32280 08/12/02 PL - Rollup cost ratio by Prepack Any logic
7014 lnPrepackRatio= (1 / .nPrepackQty * .nPrepackItemQty)
7015 pnqty= pnqty * lnPrepackRatio && && .nPrepackQty * .nPrepackItemQty
7016 *=== TAN 32280 08/12/02 PL
7017 Endif
7018
7019 *--- TechRec 1004691 27-Apr-2004 GS --- Optimization.
7020 lcCategory = Category
7021 select (This.cCatAlias)
7022 =Seek(lcCategory)
7023 lcCost_Type = Upper(AllTrim(Cost_Type)) && -- TechRec 1005555 01-Jun-2004 GS -- Uppercase, just in case...
7024 select (pcCostAlias)
7025
7026 *---Tan34434 HH 09/26/02
7027 *--- TAN 34778 06/16/03 AD
7028 *IF EMPTY(formula) And vl_dcatgr(category, "", "tcCatgr")
7029
7030 *IF EMPTY(formula) And SEEK(category, "tcCatgr", "Category") --1004691
7031 * If Allt(tcCatgr.Cost_Type)==This.cCN_ER_LOOKUP --1004691
7032 *=== TAN 34778 06/16/03 AD
7033
7034 *--- TechRec 1007154 07-Oct-2004 GS ---
7035 *--------------------------------------
7036 * Moved everything to MultiLevelCostFromConstant
7037 *--------------------------------------
7038 *IF EMPTY(formula) And !Empty(lcCost_Type)
7039 * If lcCost_Type == This.cCN_ER_LOOKUP
7040 **=== TechRec 1004691 27-Apr-2004 GS ===
7041
7042 * lnExRate = vl_ExRate("","EXH_RATE")
7043 * If Empty(lnExRate) &&We don't know what will be return by vl call
7044 * lnExRate = 0
7045 * Endif
7046 * REPLACE category_cost WITH lnExRate, ;
7047 * extension WITH lnExRate IN (pcCostAlias)
7048 * *--- TechRec 1003897 26-Mar-2004 GS ---
7049 * if Imp_Cost # 'Y'
7050 * replace Estm_Ext_Cost with Extension
7051 * endif
7052 * *=== TechRec 1003897 26-Mar-2004 GS ===
7053 * Endif
7054 *Endif
7055 *===Tan34434 HH
7056 *=== TechRec 1007154 07-Oct-2004 GS ===
7057
7058 IF !EMPTY(formula) && AND formula # "IMPORT TRACKING" && formula, no import tracking
7059 *--- TechRec 1004691 27-Apr-2004 GS --- Optimization.
7060 *--- TAN 34778 06/16/03 AD
7061 *llRetVal = vl_dcatgr(category, "", "tcCatgr")
7062 *llRetVal = SEEK(category, "tcCatgr", "Category")
7063 *=== TAN 34778 06/16/03 AD
7064
7065 * total material, prod value, hs lookup, duty, total cost. Must by this sequence.
7066 * very important.
7067 * ATS4734, import tracking now has formula/
7068 *--- TAN 33059 Ilya: Added CN_COMMISSION into INLIST()
7069 *--- TAN 36566 02/07/03 AD
7070 *--- TAN 37481 03/14/03 CB
7071 *- Do not overwrite prorated shipment cost
7072 *!* IF llRetVal AND (!INLIST(tcCatgr.cost_type,This.cCN_HS_LOOKUP,This.cCN_COMMISSION) or ; && harmonized duty lookup
7073 *!* (tcCatgr.imp_tracking = "Y" AND extension = 0)) && import tracking
7074*!* IF llRetVal .AND. ;
7075*!* !INLIST(tcCatgr.cost_type,This.cCN_HS_LOOKUP,This.cCN_COMMISSION) .AND. ;
7076*!* !(tcCatgr.imp_tracking = "Y" .AND. Imp_Cost = 'Y' .AND. extension <> 0) && import tracking
7077
7078 *--- TechRec 1003897 29-Mar-2004 GS --- imp_tracking flag should not be considered here:
7079*!* IF llRetVal .AND. ;
7080*!* !INLIST(tcCatgr.cost_type,This.cCN_HS_LOOKUP,This.cCN_COMMISSION) .AND. ;
7081*!* !(tcCatgr.imp_tracking = "Y" .AND. Imp_Cost = 'Y' .AND. AP_Cost = 'Y' .AND. extension <> 0) && import tracking
7082 *
7083 *--- TechRec 1004691 27-Apr-2004 GS ---
7084 *IF llRetVal and ;
7085 * !InList(tcCatgr.Cost_Type, This.cCN_HS_LOOKUP, This.cCN_COMMISSION) and ;
7086 * !(Imp_Cost = 'Y' and AP_Cost = 'Y' and Extension <> 0) && import tracking
7087 *=== TAN 36566 02/07/03 AD
7088 *=== TechRec 1003897 29-Mar-2004 GS ===
7089 *--- TechRec 1005555 01-Jun-2004 GS --- : The same as 1005369
7090 *IF !Empty(lcCost_Type) and ;
7091 * !InList(lcCost_Type, This.cCN_HS_LOOKUP, This.cCN_COMMISSION) and ;
7092 * !(Imp_Cost = 'Y' and AP_Cost = 'Y' and Extension <> 0) && import tracking
7093 IF lcCost_Type == This.cCN_HS_LOOKUP or lcCost_Type == This.cCN_COMMISSION or ;
7094 ((Imp_Cost = 'Y' or AP_Cost = 'Y') and Extension <> 0) ; && import tracking
7095 OR lcCost_Type == This.cCN_HS_FIXEDAMOUNT ; &&-- TR 1072967 26-SEP-13 Venuk
7096 OR UPPER(lcCost_Type) == UPPER(This.cCN_MULTI_ROYALTY) &&--- TechRec 1072525 AZ
7097 * Do nothing.
7098 ELSE
7099 *=== TechRec 1005555 01-Jun-2004 GS ===
7100 *=== TechRec 1004691 27-Apr-2004 GS ===
7101
7102
7103 *- TAN 29836 01/14/02 YIK
7104 *- Use new function evalCostFormula() to calculate cost.
7105 *- lnExtension = THIS.evalFormula(pcCostAlias, formula, pnPodtlPkey, category) && 11/17/00
7106 *- lncost = ROUND(lnExtension / MAX(pnqty, 1), round_to) && ATS 4691
7107 *--- TAN 1004047 03/10/04 AD
7108 *- Added Round_To
7109
7110 *-- TR 1011441 MA 06/22/05
7111 oCostEstm.nQty = pnQty
7112 * lncost = THIS.MultiLevelEvalCostFormula(pcCostAlias, formula, pnPodtlPkey, category,;
7113 * lnSysLevel, lnCostLevelPkey, round_to)
7114 lnCost = THIS.MultiLevelEvalCostFormula(pcCostAlias, Formula, pnPodtlPkey, Category,;
7115 lnSysLevel, lnCostLevelPkey, Round_To, oCostEstm)
7116 *== TR 1011441 MA 06/22/05
7117
7118 *= TAN 29836 01/14/02 YIK
7119 *=== TAN 1004047 03/10/04 AD
7120
7121 lnExtension = lnCost * pnQty && restore extension after round to.
7122
7123 *-- TR 1011441 MA 06/22/05
7124 lnExtensionEstm = oCostEstm.nCostEstm * pnQty
7125 *== TR 1011441 MA 06/22/05
7126
7127 * recording duty_value, pord_value, total_material and total_cost
7128 * PL 4/27 take 1st > 0 in any of 4 cost categories
7129 * recording duty_value, pord_value, total_material and total_cost (5/23)
7130 DO CASE
7131 *--- TAN 32280 08/12/02 PL - Rollup cost ratio by Prepack Any logic
7132 *!* CASE (paCost[PRODUCTION_] = 0 OR paCost[PRODUCTION_] <> lncost) AND tcCatgr.cost_type = This.cCN_PROD_VALUE
7133 *!* paCost[PRODUCTION_] = lncost
7134 *!* .aMaxLevelCost[PRODUCTION_]= .aMaxLevelCost[PRODUCTION_] + ;
7135 *!* IIF(.nMaxLevel= lnSysLevel, paCost[PRODUCTION_], 0) && PL 06/06/02
7136 *!* CASE (paCost[MATERIAL_] = 0 OR paCost[MATERIAL_] <> lncost) AND tcCatgr.cost_type = This.cCN_TOTAL_MATERIAL
7137 *!* paCost[MATERIAL_] = lncost
7138 *!* .aMaxLevelCost[MATERIAL_]= .aMaxLevelCost[MATERIAL_] + ;
7139 *!* IIF(.nMaxLevel= lnSysLevel, paCost[MATERIAL_], 0) && PL 06/06/02
7140 *!* CASE (paCost[DUTY_] = 0 OR paCost[DUTY_] <> lncost) AND tcCatgr.cost_type = This.cCN_DUTY_VALUE
7141 *!* paCost[DUTY_] = lncost && + lnHsLookupAmount 11/10/00
7142 *!* .aMaxLevelCost[DUTY_]= .aMaxLevelCost[DUTY_] + ;
7143 *!* IIF(.nMaxLevel= lnSysLevel, paCost[DUTY_], 0) && PL 06/06/02
7144 *!* CASE (paCost[TOTAL_COST_] = 0 OR paCost[TOTAL_COST_] <> lncost) AND tcCatgr.cost_type = This.cCN_TOTAL_COST
7145 *!* paCost[TOTAL_COST_] = lncost
7146 *!* .aMaxLevelCost[TOTAL_COST_]= .aMaxLevelCost[TOTAL_COST_] + ;
7147 *!* IIF(.nMaxLevel= lnSysLevel, paCost[TOTAL_COST_], 0) && PL 06/06/02
7148
7149 *--- TechRec 1004691 27-Apr-2004 GS --- Left without changes for now, just changed "tcCatgr." to "lc" ===:
7150 CASE lcCost_Type = This.cCN_PROD_VALUE
7151 paCost[PRODUCTION_] = lncost
7152 .aMaxLevelCost[PRODUCTION_]= .aMaxLevelCost[PRODUCTION_] + ;
7153 IIF(.nMaxLevel= lnSysLevel, paCost[PRODUCTION_] * lnPrepackRatio, 0) && PL 06/06/02
7154 CASE lcCost_Type = This.cCN_TOTAL_MATERIAL
7155 paCost[MATERIAL_] = lncost
7156 .aMaxLevelCost[MATERIAL_]= .aMaxLevelCost[MATERIAL_] + ;
7157 IIF(.nMaxLevel= lnSysLevel, paCost[MATERIAL_] * lnPrepackRatio, 0) && PL 06/06/02
7158 CASE lcCost_Type = This.cCN_DUTY_VALUE
7159 paCost[DUTY_] = lncost && + lnHsLookupAmount 11/10/00
7160 .aMaxLevelCost[DUTY_]= .aMaxLevelCost[DUTY_] + ;
7161 IIF(.nMaxLevel= lnSysLevel, paCost[DUTY_] * lnPrepackRatio, 0) && PL 06/06/02
7162 CASE lcCost_Type = This.cCN_TOTAL_COST
7163 paCost[TOTAL_COST_] = lncost
7164 .aMaxLevelCost[TOTAL_COST_]= .aMaxLevelCost[TOTAL_COST_] + ;
7165 IIF(.nMaxLevel= lnSysLevel, paCost[TOTAL_COST_] * lnPrepackRatio, 0) && PL 06/06/02
7166 *--- TAN 33059 Ilya: Include Commission cost
7167 CASE lcCost_Type = This.cCN_COMMISSION
7168 paCost[COMMISSION_] = lncost
7169 .aMaxLevelCost[COMMISSION_]= .aMaxLevelCost[COMMISSION_] + ;
7170 IIF(.nMaxLevel= lnSysLevel, paCost[COMMISSION_] * lnPrepackRatio, 0)
7171 *=== TAN 33059 Ilya
7172
7173 *=== TAN 32280 08/12/02 PL
7174 ENDCASE
7175
7176 *--- 1003958 05/04 - CB was failing in UDEV, added rounding:
7177 lnCost = ROUND(lnCost, 5)
7178 lnExtension = ROUND(lnExtension, 5)
7179 *=== 1003958 end.
7180
7181 *-- TR 1011441 MA 06/22/05
7182 lnExtensionEstm = ROUND(lnExtensionEstm, 5)
7183 *-- TR 1011441 MA 06/22/05
7184
7185 REPLACE category_cost WITH lnCost, extension WITH lnExtension IN (pcCostAlias)
7186 *--- TechRec 1003897 26-Mar-2004 GS ---
7187 if Imp_Cost # 'Y'
7188
7189 *-- TR 1011441 MA 06/22/05
7190 * replace Estm_Ext_Cost with Extension
7191 replace Estm_Ext_Cost with lnExtensionEstm
7192 *== TR 1011441 MA 06/22/05
7193
7194 *--- 1012294 KISHOR 2-AUG-2006
7195 IF This.lOptimizedRecalc AND THIS.lDynamicsPrepped
7196 replace modified WITH 'Y'
7197 ENDIF
7198 *=== 1012294 KISHOR 2-AUG-2006
7199
7200 endif
7201 *=== TechRec 1003897 26-Mar-2004 GS ===
7202
7203 ENDIF
7204 ENDIF
7205 ENDSCAN
7206 ENDFOR
7207
7208 *--- TechRec 1004691 27-Apr-2004 GS ---
7209 **--- TAN 34778 06/16/03 AD
7210 *USE IN SELECT('tcCatgr')
7211 **=== TAN 34778 06/16/03 AD
7212
7213 SELECT (pcCostAlias)
7214 .popRecordSet()
7215 ENDWITH
7216 Select (lnOldSelect)
7217 ENDPROC
7218
7219 *-------------------------------------------------------------------------------------------------
7220 * PL 29378 3/28/02 Multi-level cost sheet cost of HS lookup
7221 PROCEDURE MultiLevelCostOfHSLookUp
7222 LPARAMETER pcCostAlias, pnPodtlPkey, pnqty, paBOMParts, pnMaxBOMSku, plHsFixedAmount
7223 *--- TR 1072967 26-SEP-13 Venuk. Added plHsFixedAmountparameter ====
7224
7225 LOCAL lncost, lnExtension, llRetVal, lnHS_Base, lcCost_Type, lcCategory
7226
7227 *--- TR 1059112 09/22/11 AZ
7228 Local lnExtensionEstm, oCostEstm,lnCostEstm
7229 oCostEstm = CreateObject("CostEstm", .NULL.)
7230 *=== TR 1059112 09/22/11 AZ
7231
7232 lnOldSelect= Select()
7233
7234 WITH THIS
7235
7236 *--- TechRec 1004691 27-Apr-2004 GS ---
7237 **--- TAN 34778 06/16/03 AD
7238 *USE IN SELECT("tcCatgr")
7239 *v_SQLExec("SELECT * FROM zzdcatgr", "tcCatgr")
7240 *SELECT tcCatgr
7241 *INDEX ON Category TAG Category
7242 **=== TAN 34778 06/16/03 AD
7243 *=== TechRec 1004691 27-Apr-2004 GS ===
7244
7245 SELECT (pcCostAlias)
7246 .pushRecordSet()
7247 Set Order to CostLevel && 32276 06/06/02 PL &&& 1041085 AZ
7248
7249 *--- TechRec 1014674 03-Jan-2006 GS ---
7250 local lcDesign_Num, llDesign
7251 lcDesign_Num = ""
7252 llDesign = Type(pcCostAlias + ".DESIGN_NUM") = "C"
7253 *=== TechRec 1014674 03-Jan-2006 GS ===
7254
7255 lnOrigQty= pnQty
7256
7257 * calculate cost for same POPDtl fkey and BOM SKU
7258 * 9/4/02 use CostLevelPkey in both zzcbommd and zzccostd to link proper cost sheet to BOM
7259 FOR lnCnt= 1 to pnMaxBOMSku
7260 lnSysLevel= paBOMParts[lnCnt, 1]
7261 lnCostLevelPkey= paBOMParts[lnCnt, 2]
7262
7263 lcSKU= ""
7264 pnQty= lnOrigQty
7265
7266 *-- 32276 06/06/02 PL - Costing in Prod Ord roll-up from lowest level
7267 *SCAN FOR (fkey= pnPodtlPkey And syslevel= lnSysLevel And CostLevelPkey= lnCostLevelPkey)
7268 llFound= Seek(Str(pnPodtlPkey)+Str(lnSysLevel)+Str(lnCostLevelPkey), ;
7269 pcCostAlias, "CostLevel")
7270
7271 *--- 1032015 03/26/09 Ilya:
7272 IF llFound AND lnSysLevel > 0 AND paBOMParts[lnCnt, 3] > 0
7273 pnQty = paBOMParts[lnCnt, 3]
7274 ENDIF
7275 *=== 1032015 03/26/09 Ilya.
7276
7277 *--- TR 1059112 09/22/11 AZ
7278 oCostEstm.nQty = pnQty
7279 *=== TR 1059112 09/22/11 AZ
7280
7281
7282 SCAN WHILE llFound And Str(fkey)+Str(syslevel)+Str(CostLevelPkey) = ;
7283 Str(pnPodtlPkey)+Str(lnSysLevel)+Str(lnCostLevelPkey)
7284 *== 32276 06/06/02 PL - Costing in Prod Ord roll-up from lowest level
7285
7286 * resolve to get prepack component qty Once and store in .nPrepackItemQty
7287 * (ie. multi color prepack 12AA-12 have 2 color NVY- 6 and BLK- 6).
7288 * converte pnQty using header Prepack and detail prepack (mix color prepack)
7289 If Not (division + style + color_code + lbl_code + dimension == lcSKU )
7290 lcSKU= division + style + color_code + lbl_code + dimension
7291 .ResolvePrePackComponentQty(division, style , color_code , lbl_code , dimension)
7292 pnqty= pnqty / .nPrepackQty * .nPrepackItemQty
7293 *--- TechRec 1014674 03-Jan-2006 GS ---
7294 if llDesign
7295 lcDesign_Num = Design_Num
7296 endif
7297 *=== TechRec 1014674 03-Jan-2006 GS ===
7298 ENDIF
7299
7300 *--- TR 1059112 09/22/11 AZ
7301 oCostEstm.nQty = pnQty
7302 *=== TR 1059112 09/22/11 AZ
7303
7304
7305 *--- TAN 34778 06/16/03 AD
7306 *llRetVal = vl_dcatgr(&pcCostAlias..category, "", "tmpCursor")
7307
7308 *--- TechRec 1004691 27-Apr-2004 GS ---
7309 *llRetVal = SEEK(&pcCostAlias..category, 'tcCatGr', 'Category')
7310 lcCategory = Category
7311 select (This.cCatAlias)
7312 llRetVal = Seek(lcCategory)
7313 lcCost_Type = AllTrim(Cost_Type)
7314 select (pcCostAlias)
7315
7316 *IF llRetVal AND tmpCursor.cost_type = This.cCN_HS_LOOKUP
7317
7318 *IF llRetVal AND tcCatGr.cost_type = This.cCN_HS_LOOKUP
7319 *=== TAN 34778 06/16/03 AD
7320
7321 *--- TR 1072967 26-SEP-13 Venuk
7322* IF llRetVal and lcCost_Type = This.cCN_HS_LOOKUP
7323 IF llRetVal and ((lcCost_Type = This.cCN_HS_LOOKUP AND !plHsFixedAmount) ;
7324 OR (lcCost_Type = This.cCN_HS_FIXEDAMOUNT AND plHsFixedAmount))
7325 *--- TR 1072967 26-SEP-13 Venuk
7326
7327 *=== TechRec 1004691 27-Apr-2004 GS ===
7328
7329 DO CASE
7330 CASE !EMPTY(constant)
7331 lnHS_Base = constant
7332 CASE !EMPTY(formula)
7333 *- TAN 29836 01/14/02 YIK
7334 *- Use new function evalCostFormula() to calculate cost.
7335 *- lnExtension = THIS.evalFormula(pcCostAlias, formula, pnPodtlPkey, category) && 11/17/00
7336 *- lnHS_Base = ROUND(lnExtension / MAX(pnqty, 1), round_to) && ATS 4691
7337 *--- TAN 1004047 03/10/04 AD
7338 *- Added Round_To
7339 *--- TechRec 1059112 16-Aug-2012 AZhadanov ---
7340* lnHS_Base = THIS.MultiLevelEvalCostFormula(pcCostAlias, formula, pnPodtlPkey, category, ;
7341 lnSysLevel, lnCostLevelPkey, round_to)
7342 lnHS_Base = THIS.MultiLevelEvalCostFormula(pcCostAlias, formula, pnPodtlPkey, category, ;
7343 lnSysLevel, lnCostLevelPkey, round_to,oCostEstm) &&& 1059112
7344 *=== TechRec 1059112 16-Aug-2012 AZhadanov ===
7345
7346 *= TAN 29836 01/14/02 YIK
7347 *=== TAN 1004047 03/10/04 AD
7348 lnExtension = lnHS_Base * pnqty && restore extension after round to.
7349 lnExtensionEstm = oCostEstm.nCostEstm * pnQty &&& 1059112
7350 OTHER
7351 lnHS_Base = 0
7352 ENDCASE
7353 *--- TechRec 1014674 03-Jan-2006 GS ---
7354 *lncost = THIS.getHSDuty(division, STYLE, color_code, ;
7355 lbl_code, DIMENSION, lnHS_Base, pnPodtlPkey)
7356 *--- TR 1072967 26-SEP-13 Venuk.Added Empty param and plHsFixedAmount
7357 lnCost = THIS.getHSDuty(Division, Style, Color_Code, ;
7358 Lbl_Code, Dimension, lnHS_Base, pnPodtlPkey, , lcDesign_Num, ,plHsFixedAmount )
7359
7360 *=== TechRec 1014674 03-Jan-2006 GS ===
7361
7362 *--- TechRec 1059112 16-Aug-2012 AZhadanov ---
7363 *--- TR 1072967 26-SEP-13 Venuk.Added Empty param and plHsFixedAmount
7364 lnCostEstm = THIS.getHSDuty(Division, Style, Color_Code, ;
7365 Lbl_Code, Dimension, oCostEstm.nCostEstm, pnPodtlPkey, ,lcDesign_Num, , plHsFixedAmount)
7366 *=== TechRec 1059112 16-Aug-2012 AZhadanov ===
7367
7368 lnExtension = lncost * pnqty
7369 lnExtensionEstm = lnCostEstm * pnqty &&&& 1059112
7370
7371 *--- 1003958 05/04 - CB was failing in UDEV, added rounding:
7372 lnCost = ROUND(lnCost, 5)
7373 lnExtension = ROUND(lnExtension, 5)
7374 lnExtensionEstm= ROUND(lnExtensionEstm, 5) &&&& 1059112
7375 * === 1003958 end.
7376
7377 REPLACE category_cost WITH lncost, extension WITH lnExtension IN (pcCostAlias)
7378 *--- TechRec 1003897 26-Mar-2004 GS ---
7379 if Imp_Cost # 'Y'
7380 *--- TechRec 1059112 16-Aug-2012 AZhadanov ---
7381* replace Estm_Ext_Cost with Extension
7382 replace Estm_Ext_Cost with lnExtensionEstm &&& 1059112
7383 *=== TechRec 1059112 16-Aug-2012 AZhadanov ===
7384
7385 *--- 1012294 KISHOR 2-AUG-2006
7386 IF This.lOptimizedRecalc AND THIS.lDynamicsPrepped
7387 replace modified WITH 'Y'
7388 ENDIF
7389 *=== 1012294 KISHOR 2-AUG-2006
7390 endif
7391 *=== TechRec 1003897 26-Mar-2004 GS ===
7392 ENDIF
7393 ENDSCAN
7394 ENDFOR
7395
7396 *--- TechRec 1004691 27-Apr-2004 GS ---
7397 **--- TAN 34778 06/16/03 AD
7398 *USE IN SELECT('tcCatgr')
7399 **=== TAN 34778 06/16/03 AD
7400 *=== TechRec 1004691 27-Apr-2004 GS ===
7401
7402 SELECT (pcCostAlias)
7403 .popRecordSet()
7404 ENDWITH
7405 Select (lnOldSelect)
7406
7407 ENDPROC
7408
7409 *-------------------------------------------------------------------------------------------------
7410 * PL 29378 3/28/02 Multi-level cost sheet cost of HS lookup
7411 *--- TAN 1004047 03/10/04 AD
7412 *- Added Round_To
7413 *=== TAN 1004047 03/10/04 AD
7414 PROCEDURE MultiLevelEvalCostFormula
7415 LPARAMETERS pcCostAlias, pcFormula, pnPodtlPkey, pcCategory, ;&& ATS 4691, round()
7416 pnSysLevel, pnCostLevelPkey, tnRound_To, poCostEstm && -- TR 1011441 MA 06/22/05 added poCostEstm parameter
7417
7418 LOCAL lcString, lnxx, lcToken, lnPos, lcSelect, llRetVal, ;
7419 lnRecNo, lcDtlNo, lcMsgString, lntk, lncost, llRet &&*--- 1028505 12-05-07 SKG
7420 *--- 1028505 12-05-07 SKG
7421 llRet=.F.
7422 *=== 1028505 12-05-07 SKG
7423 *-- TR 1011441 MA 06/22/05
7424 LOCAL llCostEstmObj
7425 llCostEstmObj = isObject(poCostEstm, .T.) and !isNull(poCostEstm.nQty) and poCostEstm.nQty > 0 && 1014307
7426 IF llCostEstmObj
7427 DIMENSION laTokenEstm[1]
7428 ENDIF
7429 *=== TR 1011441 MA 06/22/05
7430
7431 DIMENSION laToken[1]
7432 THIS.pushRecordSet()
7433
7434 llRetVal = .T.
7435 lcString = pcFormula
7436 lcString = STRTRAN(lcString, '(', ' ( ') && insert blanks around '('
7437 lcString = STRTRAN(lcString, ')', ' ) ') && insert blanks around ')'
7438 lcString = STRTRAN(lcString, '/', ' / ') && insert blanks around '/'
7439 lcString = STRTRAN(lcString, '*', ' * ') && insert blanks around '*'
7440 lcString = STRTRAN(lcString, '-', ' - ') && insert blanks around '-'
7441 lcString = STRTRAN(lcString, '+', ' + ') && insert blanks around '+'
7442 lcString = lcString + " "
7443
7444 lcToken = ""
7445 lncost = 0
7446
7447 SELECT (pcCostAlias)
7448 * tokenize formula string into array, so that we can check for variable (category)
7449 StringToArray(lcString, @laToken, " ")
7450
7451 *-- TR 1011441 MA 06/22/05
7452 IF llCostEstmObj
7453 =ACopy(laToken, laTokenEstm)
7454 ENDIF
7455 *=== TR 1011441 MA 06/22/05
7456
7457 FOR lnxx = 1 TO ALEN(laToken)
7458 lcToken = laToken[lnxx]
7459 *--- TAN 35242 10/31/02 AD
7460 *FOR lntk = 1 TO LEN(lcToken)
7461 * decide if this token is a variable filed.
7462 IF BETWEEN(SUBSTR(lcToken, 1, 1), "A", "Z")
7463 *--- TAN 32708 06/21/02 AD
7464*!* LOCATE FOR category == PADR(lcToken,6) AND (fkey = pnPodtlPkey ;
7465*!* And syslevel= lnSysLevel And CostLevelPkey= lnCostLevelPkey)
7466*!* IF FOUND()
7467 *--- 1028505 12-05-07 SKG
7468*!* IF SEEK(PADR(lcToken,6)+STR(pnPodtlPkey) + STR(lnSysLevel) + STR(pnCostLevelPkey), pcCostAlias, 'CatCostLvl')
7469*!* *=== TAN 32708 06/21/02 AD
7470*!* IF FOUND()
7471 llRet = SEEK(PADR(lcToken,6)+STR(pnPodtlPkey) + STR(lnSysLevel) + STR(pnCostLevelPkey), pcCostAlias, 'CatCostLvl')
7472 IF !llRet
7473 llRet = SEEK(PADR(lcToken,6)+STR(pnPodtlPkey) + STR(lnSysLevel) + STR(0), pcCostAlias, 'CatCostLvl')
7474 ENDIF
7475 IF llRet
7476 *=== 1028505 12-05-07 SKG
7477 laToken[lnxx] = STR(category_cost, 14, 5) && replace category with extension
7478
7479 *-- TR 1011441 MA 06/22/05
7480 IF llCostEstmObj
7481 laTokenEstm[lnxx] = STR(Estm_Ext_Cost/poCostEstm.nQTY, 14, 5) && replace category with extension
7482 ENDIF
7483 *=== TR 1011441 MA 06/22/05
7484
7485
7486 ENDIF
7487*!* ENDIF &&1028505 12-05-07 SKG
7488 ENDIF
7489 *EXIT
7490 *ENDFOR
7491 ENDFOR
7492
7493 * construct string from array
7494 lcString = ArrayToString(@laToken, " ")
7495
7496 *--- TR 1011441 MA 06/22/05
7497 IF llCostEstmObj
7498 lcStringEstm = ArrayToString(@laTokenEstm, " ")
7499 ENDIF
7500 *=== TR 1011441 MA 06/22/05
7501
7502 lcError = ON("ERROR")
7503
7504 *--- TechRec 1049776 08-Dec-2010 asharma ---
7505 * llRetVal working fine in Dev Environment but not in EXE
7506*!* ON ERROR llRetVal = .F.
7507 llTempRetVal = llRetVal
7508 ON ERROR llTempRetVal = .F.
7509 *=== TechRec 1049776 08-Dec-2010 asharma ===
7510
7511 *--- TR 1045812 07/14/810 ATHIRUNAVU
7512 TRY
7513 *=== TR 1045812 07/14/810 ATHIRUNAVU
7514
7515 lncost = EVAL(lcString)
7516
7517 *-- TR 1011441 MA 06/22/05
7518 IF llCostEstmObj
7519 poCostEstm.nCostEstm = Evaluate(lcStringEstm)
7520 ENDIF
7521 *== TR 1011441 MA 06/22/05
7522
7523 *--- TR 1045812 07/14/810 ATHIRUNAVU
7524 CATCH
7525
7526 *--- TechRec 1049776 08-Dec-2010 asharma ---
7527 llTempRetVal = .F.
7528 *=== TechRec 1049776 08-Dec-2010 asharma ===
7529
7530 ENDTRY
7531 *=== TR 1045812 07/14/810 ATHIRUNAVU
7532
7533 ON ERROR &lcError && restore system error handler
7534
7535 *--- TechRec 1049776 08-Dec-2010 asharma ---
7536 llRetVal = llTempRetVal
7537 *=== TechRec 1049776 08-Dec-2010 asharma ===
7538
7539 IF !llRetVal
7540 lcMsgString = "Category " + pcCategory + "contains invalid formula: " + MESSAGE()
7541 ELSE
7542 *-- TR 1011441 MA 06/22/05
7543 *IF lncost > 1000000000000 OR lncost < -1000000000000
7544 IF lnCost > 1000000000000 OR lnCost < -1000000000000 OR ;
7545 (llCostEstmObj AND (poCostEstm.nCostEstm > 1000000000000 OR poCostEstm.nCostEstm < -1000000000000))
7546 *=== TR 1011441 MA 06/22/05
7547
7548 llRetVal = .F.
7549 lcMsgString ="Category " + pcCategory + "contains invalid formula: Divided by zero."
7550 ENDIF
7551 ENDIF
7552
7553 IF !llRetVal
7554 *--- TAN 34262 09/25/02 AD
7555 *- Do not display the message for rollup
7556 IF !This.lRollUpCost
7557 *--- TechRec 1045741 29-Sep-2010 jjanand ---
7558 *mb(lcMsgString + CHR(13) + "Formula: " + TRIM(pcFormula) + ;
7559 CHR(13) + "Resolved to: " + TRIM(lcString))
7560
7561 lcMsgString = lcMsgString + CHR(13) + "Formula: " + TRIM(pcFormula) + ;
7562 CHR(13) + "Resolved to: " + TRIM(lcString)
7563
7564 IF This.lscheduled
7565 IF This.lEnableDebugging
7566 This.oLog.LogEntry(lcMsgString)
7567 ENDIF
7568 ELSE
7569 mb(lcMsgString)
7570 ENDIF
7571 *=== TechRec 1045741 29-Sep-2010 jjanand ===
7572
7573 *--- TechRec 1049776 08-Dec-2010 asharma ---
7574 * something went wrong let the caller know
7575 IF THIS.lAutoCreateCostSheet
7576 This.cMessage = lcMsgString
7577 ENDIF
7578 *=== TechRec 1049776 08-Dec-2010 asharma ===
7579
7580 ENDIF
7581 *=== TAN 34262 09/25/02 AD
7582 lncost = 0
7583
7584 *-- TR 1011441 MA 06/22/05
7585 IF llCostEstmObj
7586 poCostEstm.nCostEstm = 0
7587 ENDIF
7588 *== TR 1011441 MA 06/22/05
7589
7590 ENDIF
7591
7592 THIS.popRecordSet()
7593
7594 *--- TAN 1004047 03/10/04 AD
7595 IF VARTYPE(tnRound_To) = 'N'
7596 lnCost = ROUND(lnCost, tnRound_To)
7597
7598 *-- TR 1011441 MA 06/22/05
7599 IF llCostEstmObj
7600 poCostEstm.nCostEstm = ROUND(poCostEstm.nCostEstm, tnRound_To)
7601 ENDIF
7602 *== TR 1011441 MA 06/22/05
7603
7604 ENDIF
7605 *=== TAN 1004047 03/10/04 AD
7606
7607 RETURN lncost
7608
7609 ENDPROC
7610
7611*====================================================================================================================
7612 *--- TAN 34747 10/28/02 AD
7613 *- Called from zzcordrh.BOM_MassRefresh().
7614 PROCEDURE RelinkMultiCostSheet
7615 LPARAMETER tcProdHdr, tcProdDtl, tcProdCost, tcProdCostFrozen, tcProdBOM, tnOpen_Seq
7616 LOCAL lnSelect, lcParBOMSku, lnCostLevelPKey, lnFKey, lnBOMLevelPKey
7617 lnSelect = SELECT()
7618 SELECT(tcProdBOM)
7619 This.PushRecordSet()
7620
7621 *--- TechRec 1009047 18-Mar-2005 GS ---
7622 Set Order To
7623 *=== TechRec 1009047 18-Mar-2005 GS ===
7624
7625 *- Clear local BOM Items
7626 REPLACE CostLevelPKey WITH 0 FOR Open_Seq = tnOpen_Seq .AND. Master_PKey = 0 IN (tcProdBOM)
7627 *- Update BOMLevelPKey in zzccostd and CostLevelPKey in zzcbommd
7628 SCAN FOR Open_Seq = tnOpen_Seq
7629 lcParBOMSku = ParBOMSku
7630 lnFKey = FKey
7631 lnBOMLevelPKey = BOMLevelPKey
7632 SELECT(tcProdCost)
7633 LOCATE FOR Division+Style+Color_Code+Lbl_Code+Dimension = lcParBOMSku .AND. FKey = lnFKey
7634 lnCostLevelPKey = IIF(FOUND(tcProdCost), CostLevelPKey, 0)
7635 *--- TAN 35704 12/13/02 AD
7636* IF EMPTY(CostLevelPKey)
7637 REPLACE FOR Division+Style+Color_Code+Lbl_Code+Dimension = lcParBOMSku .AND. FKey = lnFKey ;
7638 BOMLevelPKey WITH lnBOMLevelPKey IN (tcProdCost)
7639 *- Frozen Cost
7640 REPLACE FOR Division+Style+Color_Code+Lbl_Code+Dimension = lcParBOMSku .AND. FKey = lnFKey ;
7641 BOMLevelPKey WITH lnBOMLevelPKey IN (tcProdCostFrozen)
7642* ENDIF
7643 *=== TAN 35704 12/13/02 AD
7644 SELECT(tcProdBOM)
7645 REPLACE CostLevelPKey WITH lnCostLevelPKey IN (tcProdBOM)
7646 ENDSCAN
7647 This.PopRecordSet()
7648 SELECT(lnSelect)
7649 ENDPROC
7650 *=== TAN 34747 10/28/02 AD
7651
7652 *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*
7653
7654 *--- TAN 33059 Ilya
7655 PROCEDURE GetCommissionCost
7656 LPARAMETERS tnCommissionBase, tcContractor, tcAgent
7657 LOCAL lnRetVal, lnCommissionRate, lcAgent
7658
7659 * --- 1003958 05/04 CB - Optimized recalcs.
7660 * NOTE: ANY CHANGES MADE TO THIS ROUTINE MUST BE DUPLICATED IN ITS OPTIMIZED _2 EQUIVALENT!
7661 WITH THIS
7662 IF .lOptimizedRecalc AND .lDynamicsPrepped
7663 RETURN .GetCommissionCost_2(tnCommissionBase, tcContractor, tcAgent)
7664 ENDIF
7665 ENDWITH
7666 * === 1003958 End.
7667
7668 lnRetVal = 0
7669
7670 IF (!EMPTY(tcContractor) OR !EMPTY(tcAgent)) AND tnCommissionBase <> 0
7671 * Calculate cost only if Contractor is set up and is linked to Agent. Otherwise it's 0.
7672 * Get Agent
7673 IF EMPTY(tcAgent)
7674 lcAgent = vl_locar(tcContractor,"AGENT",,"C")
7675 ELSE
7676 lcAgent = ALLTRIM(tcAgent)
7677 ENDIF
7678 IF !EMPTY(lcAgent)
7679 * Get commission for this Agent
7680 lnCommissionRate = vl_agntr(lcAgent,"COMMPCT")
7681
7682 * Calculate rate
7683 lnRetVal = tnCommissionBase * lnCommissionRate / 100
7684 ENDIF
7685 ENDIF
7686
7687 RETURN lnRetVal
7688 ENDPROC
7689
7690 *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*
7691
7692 PROCEDURE CostOfCommission
7693 LPARAMETER tcCostAlias, tnPodtlPkey, tnqty, tcAgent
7694
7695 * --- 1003958 04/04 CB - Optimized Cost Recalc.
7696 * NOTE: ANY CHANGES MADE TO THIS ROUTINE MUST BE DUPLICATED IN ITS OPTIMIZED _2 EQUIVALENT!
7697 WITH THIS
7698 IF .lOptimizedRecalc AND .lDynamicsPrepped
7699 .CostOfCommission_2(tcCostAlias, tnPODtlPKey, tnQty, tcAgent) && Get agent commission cost
7700 RETURN
7701 ENDIF
7702 ENDWITH
7703 * === 1003958 End.
7704
7705 LOCAL lnCost, lnExtension, llRetVal, lnCommissionBase, lcCategory
7706
7707 *--- TR 1059112 09/22/11 AZ
7708 Local lnExtensionEstm, oCostEstm
7709 oCostEstm = CreateObject("CostEstm", .NULL.)
7710 *=== TR 1059112 09/22/11 AZ
7711
7712
7713 THIS.pushRecordSet()
7714 SELECT (tcCostAlias)
7715 THIS.pushRecordSet()
7716
7717* --- TR 1045972 RLN 03/15/10
7718* SCAN FOR fkey = tnPodtlPkey
7719 llTag = .F.
7720 FOR lnTag = 1 TO TAGCOUNT()
7721 lcExp = UPPER(ALLTRIM(TAG(lnTag)))
7722 llTag = lcExp == "FKEY"
7723 IF llTag
7724 EXIT
7725 ENDIF
7726 ENDFOR
7727
7728 IF llTag
7729 lcScanExp = "WHILE fkey = tnPodtlPkey"
7730 SET ORDER TO fkey
7731 =SEEK(tnPodtlPkey)
7732 ELSE
7733 lcScanExp = "FOR fkey = tnPodtlPkey"
7734 ENDIF
7735
7736 SCAN &lcScanExp
7737* === TR 1045972
7738 *--- TR 1038235 9-FEB-2009 VKK
7739 IF VARTYPE(prv_cost_updt) = "C" AND prv_cost_updt = "Y"
7740 LOOP
7741 ENDIF
7742 *=== TR 1038235 9-FEB-2009 VKK
7743 *--- TechRec 1004691 27-Apr-2004 GS ---
7744 *llRetVal = vl_dcatgr(&tcCostAlias..category, "", "tmpCursor")
7745 *IF llRetVal AND tmpCursor.cost_type = This.cCN_COMMISSION
7746
7747 *--- TR 1059112 09/22/11 AZ
7748 oCostEstm.nQty = tnqty
7749 *=== TR 1059112 09/22/11 AZ
7750
7751 lcCategory = Category
7752 select (This.cCatAlias)
7753 llRetVal = Seek(lcCategory)
7754 IF llRetVal and Cost_Type = This.cCN_COMMISSION
7755 select (tcCostAlias)
7756 *=== TechRec 1004691 27-Apr-2004 GS ===
7757
7758 DO CASE
7759 CASE !EMPTY(constant)
7760 lnCommissionBase = constant
7761 CASE !EMPTY(formula)
7762 *--- TAN 1004047 03/10/04 AD
7763 *- Added Round_To
7764 *--- TechRec 1059112 16-Aug-2012 AZhadanov ---
7765* lnCommissionBase = THIS.evalCostFormula(tcCostAlias, formula, tnPodtlPkey, category, round_to)
7766 lnCommissionBase = THIS.EvalCostFormula(tcCostAlias, Formula, tnPodtlPkey, Category, Round_To,,,oCostEstm)
7767 oCostEstm.nQty = .NULL.
7768 *=== TechRec 1059112 16-Aug-2012 AZhadanov ===
7769 *=== TAN 1004047 03/10/04 AD
7770 OTHER
7771 lnCommissionBase = 0
7772 ENDCASE
7773 lnCost = THIS.getCommissionCost(lnCommissionBase,contractor,tcAgent)
7774 lnExtension = lnCost * tnqty
7775
7776 *--- TR 1059112 09/22/11 AZ
7777 lnCost_estm = THIS.GetCommissionCost(oCostEstm.nCostEstm, Contractor, tcAgent)
7778 lnExtensionEstm = lnCost_estm * tnQty
7779 *=== TR 1059112 09/22/11 AZ
7780
7781 * 37776 AP Vouchers now include COMMISSION. Don't overwrite cost
7782 If AP_Cost <> 'Y'
7783 REPLACE Category_Cost WITH lnCost, ;
7784 Extension WITH lnExtension IN (tcCostAlias)
7785 *--- TechRec 1003897 26-Mar-2004 GS ---
7786 if Imp_Cost # 'Y'
7787 *--- TechRec 1059112 16-Aug-2012 AZhadanov ---
7788* replace Estm_Ext_Cost with Extension
7789 replace Estm_Ext_Cost with lnExtensionEstm &&& 1059112 AZ
7790 *=== TechRec 1059112 16-Aug-2012 AZhadanov ===
7791 *--- 1012294 KISHOR 2-AUG-2006
7792 IF This.lOptimizedRecalc AND THIS.lDynamicsPrepped
7793 replace modified WITH 'Y'
7794 ENDIF
7795 *=== 1012294 KISHOR 2-AUG-2006
7796 endif
7797 *=== TechRec 1003897 26-Mar-2004 GS ===
7798 EndIf
7799 ENDIF
7800 ENDSCAN
7801 THIS.popRecordSet()
7802 THIS.popRecordSet()
7803
7804 ENDPROC
7805
7806 *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*
7807
7808 PROCEDURE MultiLevelcostOfCommission
7809 LPARAMETER tcCostAlias, tnPodtlPkey, tnQty, tcAgent, taBOMParts, tnMaxBOMSku
7810
7811 LOCAL lncost, lnExtension, llRetVal, lnHS_Base, lnOrigQty, lnOldSelect, lnCnt
7812 LOCAL lnysLevel, lnCostLevelPkey, lcSKU, llFound, lcCost_Type, lcCategory
7813
7814 lnOldSelect = Select()
7815
7816 *--- TechRec 1004691 27-Apr-2004 GS ---
7817 **--- TAN 34778 06/16/03 AD
7818 *USE IN SELECT("tcCategory")
7819 *v_SQLExec("SELECT * FROM zzdcatgr", "tcCatgr")
7820 *SELECT tcCatgr
7821 *INDEX ON Category TAG Category
7822 *=== TAN 34778 06/16/03 AD
7823 *=== TechRec 1004691 27-Apr-2004 GS ===
7824
7825 *--- TR 1059112 09/22/11 AZ
7826 Local lnExtensionEstm, oCostEstm
7827 oCostEstm = CreateObject("CostEstm", .NULL.)
7828 *=== TR 1059112 09/22/11 AZ
7829
7830
7831 WITH THIS
7832 SELECT (tcCostAlias)
7833 .pushRecordSet()
7834 Set Order to CostLevel && 32276 06/06/02 PL &&& 1041085 AZ
7835
7836 lnOrigQty = tnQty
7837
7838 * calculate cost for same POPDtl fkey and BOM SKU
7839 * 9/4/02 use CostLevelPkey in both zzcbommd and zzccostd to link proper cost sheet to BOM
7840 FOR lnCnt = 1 to tnMaxBOMSku
7841 lnSysLevel = taBOMParts[lnCnt, 1]
7842 lnCostLevelPkey = taBOMParts[lnCnt, 2]
7843
7844 lcSKU = ""
7845 tnQty = lnOrigQty
7846
7847 llFound = Seek(Str(tnPodtlPkey)+Str(lnSysLevel)+Str(lnCostLevelPkey), ;
7848 tcCostAlias, "CostLevel")
7849
7850 *--- 1032015 03/26/09 Ilya:
7851 IF llFound AND lnSysLevel > 0 AND taBOMParts[lnCnt, 3] > 0
7852 tnQty = taBOMParts[lnCnt, 3]
7853 ENDIF
7854 *=== 1032015 03/26/09 Ilya.
7855
7856 *--- TR 1059112 09/22/11 AZ
7857 oCostEstm.nQty = tnqty
7858 *=== TR 1059112 09/22/11 AZ
7859
7860
7861 SCAN WHILE llFound And Str(fkey)+Str(syslevel)+Str(CostLevelPkey) = ;
7862 Str(tnPodtlPkey)+Str(lnSysLevel)+Str(lnCostLevelPkey)
7863 * resolve to get prepack component qty Once and store in .nPrepackItemQty
7864 * (ie. multi color prepack 12AA-12 have 2 color NVY- 6 and BLK- 6).
7865 * converte pnQty using header Prepack and detail prepack (mix color prepack)
7866 If Not (division + style + color_code + lbl_code + dimension == lcSKU )
7867 lcSKU= division + style + color_code + lbl_code + dimension
7868 .ResolvePrePackComponentQty(division, style , color_code , lbl_code , dimension)
7869 tnQty = tnQty / .nPrepackQty * .nPrepackItemQty
7870 Endif
7871
7872 *--- TAN 34778 06/16/03 AD
7873 *llRetVal = vl_dcatgr(&tcCostAlias..category, "", "tmpCursor")
7874
7875 *--- TechRec 1004691 27-Apr-2004 GS ---
7876 *llRetVal = SEEK(&tcCostAlias..category, "tcCatgr", "Category")
7877
7878 *IF llRetVal AND tmpCursor.cost_type = This.cCN_COMMISSION
7879 *IF llRetVal AND tcCatgr.cost_type = This.cCN_COMMISSION
7880 *=== TAN 34778 06/16/03 AD
7881 lcCategory = Category
7882 select (This.cCatAlias)
7883 llRetVal = Seek(lcCategory)
7884 lcCost_Type = AllTrim(Cost_Type)
7885 select (tcCostAlias)
7886 IF llRetVal and lcCost_Type = This.cCN_COMMISSION
7887 *=== TechRec 1004691 27-Apr-2004 GS ===
7888
7889 DO CASE
7890 CASE !EMPTY(Constant)
7891 lnCommissionBase = constant
7892 CASE !EMPTY(Formula)
7893 *--- TAN 1004047 03/10/04 AD
7894 *- Added Round_To
7895 *--- TechRec 1059112 16-Aug-2012 AZhadanov ---
7896* lnCommissionBase = THIS.MultiLevelEvalCostFormula(tcCostAlias, formula, tnPodtlPkey, category, ;
7897 lnSysLevel, lnCostLevelPkey, round_to)
7898 lnCommissionBase = THIS.MultiLevelEvalCostFormula(tcCostAlias, formula, tnPodtlPkey, category, ;
7899 lnSysLevel, lnCostLevelPkey, round_to,oCostEstm) &&& 1059112 AZ
7900 oCostEstm.nQty = .NULL. &&& 1059112 AZ
7901 *=== TechRec 1059112 16-Aug-2012 AZhadanov ===
7902 *=== TAN 1004047 03/10/04 AD
7903 OTHER
7904 lnCommissionBase = 0
7905 ENDCASE
7906 lnCost = THIS.getCommissionCost(lnCommissionBase,contractor,tcAgent)
7907 lnExtension = lnCost * tnqty
7908 *--- TR 1059112 09/22/11 AZ
7909 lnCost_estm = THIS.GetCommissionCost(oCostEstm.nCostEstm, Contractor, tcAgent)
7910 lnExtensionEstm = lnCost_estm * tnQty
7911 *=== TR 1059112 09/22/11 AZ
7912
7913 * 37776 AP Vouchers now include COMMISSION. Don't overwrite cost
7914 If AP_Cost <> 'Y'
7915
7916 *--- 1003958 05/04 - CB was failing in UDEV, added rounding:
7917 lnCost = ROUND(lnCost, 5)
7918 lnExtension = ROUND(lnExtension, 5)
7919 * === 1003958 end.
7920
7921 REPLACE category_cost WITH lncost, ;
7922 extension WITH lnExtension IN (tcCostAlias)
7923 *--- TechRec 1003897 26-Mar-2004 GS ---
7924 if Imp_Cost # 'Y'
7925 *--- TechRec 1059112 16-Aug-2012 AZhadanov ---
7926* replace Estm_Ext_Cost with Extension
7927 replace Estm_Ext_Cost with lnExtensionEstm
7928 *=== TechRec 1059112 16-Aug-2012 AZhadanov ===
7929 *--- 1012294 KISHOR 2-AUG-2006
7930 IF This.lOptimizedRecalc AND THIS.lDynamicsPrepped
7931 replace modified WITH 'Y'
7932 ENDIF
7933 *=== 1012294 KISHOR 2-AUG-2006
7934 endif
7935 *=== TechRec 1003897 26-Mar-2004 GS ===
7936 EndIf
7937 ENDIF
7938 ENDSCAN
7939 ENDFOR
7940
7941 *--- TechRec 1004691 27-Apr-2004 GS ---
7942 *USE IN SELECT("tcCatgr")
7943 *=== TechRec 1004691 27-Apr-2004 GS ===
7944
7945 SELECT (tcCostAlias)
7946 .popRecordSet()
7947 ENDWITH
7948 Select (lnOldSelect)
7949 ENDPROC
7950 *=== TAN 33059 Ilya
7951
7952
7953 PROCEDURE GetShipmentCost
7954 LPARAMETERS tcDetailAlias, tnOpen_Seq
7955
7956 LOCAL llRetVal, lcSqlString, lnSelect, lcProd_Num, lcOpen_Seq, ;
7957 lcAsFldExt, lnI, lcNum, lcBy, lnQty, lnShpRecd, ;
7958 lcAccum_Shp, lnUDFFee, lcUdfExt, lnShpQty, lnLineQty,;
7959 Q_Deliv, Q_ShpNum, Q_OrdShp, Q_AllShp &&-- Added by GS
7960 *Q_OrdShp, Q_AllShpOrd, Q_AllShpRec, Q_AllShpTree, Q_OrdShpTot, -- commented by GS
7961
7962 LOCAL lnDtlQty, lnDtlShpRatio &&--- TechRec 1005677 08-Jun-2004 GS ---
7963
7964 llRetVal = .T.
7965
7966 lnSelect = SELECT()
7967 USE IN SELECT('tcOrd_Shp')
7968 USE IN SELECT('tcShipCost')
7969
7970 WITH This
7971 SELECT(tcDetailAlias)
7972 .PushRecordSet()
7973 SET FILTER TO
7974 GO TOP
7975 lcProd_Num = SQLFormatNum(Prod_Num)
7976 lcOpen_Seq = SQLFormatNum(tnOpen_Seq)
7977
7978 *--- TechRec 1005677 08-Jun-2004 GS --- Code cleanup. See VSS by date :o)
7979
7980 lcAsFldExt = AsField('N(17,5)')
7981 *(------ GS: I've combined all the steps above in one SQL
7982 *--- TechRec 1003236 03-Feb-2004 GS --- This Query Was wrong. Fixed. Check VSS for differences.
7983 *--- TechRec 1003561 19-Feb-2004 GS --- Query from 1003236 was not working because the costsheet
7984 *--- might not exist on a shipment stage. Fixed. Check VSS for differences.
7985
7986 *--- TechRec 1003897 16-Mar-2004 GS --- Try # 5 + Excluded records with AP_Cost flag
7987
7988 *--- TechRec 1005677 08-Jun-2004 AD, GS --- Only WIP + Received matters for Cost.
7989
7990 *-- Step #1: Affected shipments
7991 lcSqlString = ;
7992 "select distinct Shipment_Num" +; && into Q_ShpNum
7993 " from zzcordrd" +;
7994 " where Prod_Num = " + lcProd_Num +;
7995 " and Open_Seq = " + lcOpen_Seq +;
7996 " and Shipment_Num > 0"
7997
7998 if llRetVal
7999 Q_ShpNum = SQLTableFromQuery(lcSqlString)
8000 llRetVal = !Empty(Q_ShpNum)
8001 endif
8002
8003 *-- Step #2: All Delivered items (by Shipment PO detail, and affected Cost_type ):
8004 *-- also this will "attach" affected shipment cost categories to all PO details with shipment.
8005 *-- This is needed because PO details with shipment looses all cost info if there is no WIP!
8006 if llRetVal
8007 lcSqlString = ;
8008 "select pd.PKey, pd.Shipment_Num, c.AP_Cost," +;
8009 " Sum(" +;
8010 " case tr.Last_Stage" +;
8011 " when 'Y' then tr.Total_Qty" +;
8012 " else tr.WIP_Total end) as ttRec," +;
8013 " Sum(case c.AP_Cost when 'Y' then c.Extension else 0 end) as Preserved_Ext," +;
8014 " Cost_Type" +;
8015 " from zzcordrd pd" +;
8016 " join zzcordrd tr" +;
8017 " on tr.Prod_Num = pd.Prod_Num" +;
8018 " and tr.Open_Seq = pd.Open_Seq" +;
8019 " and tr.Tree_Seq like " + SqlFnConcat("RTrim(pd.Tree_Seq)+'%'") +;
8020 " join zzccostd c" +;
8021 " on c.Fkey = tr.PKey" +;
8022 " and c.SysLevel = 0" +;
8023 " join zzdcatgr cat" +;
8024 " on cat.Category = c.Category" +;
8025 " where pd.Shipment_Num > 0" +;
8026 " and pd.Shipment_Num in (select Shipment_Num from " + Q_ShpNum + " )" +;
8027 " and (cat.Cost_Type like 'SFCLBLUDF___FEE%' or c.Line_Seq = 500)" +;
8028 " and (tr.wip_total > 0 or tr.last_stage = 'Y') " + ;
8029 " group by pd.PKey, pd.Shipment_Num, Cost_type, c.AP_Cost"
8030 &&" and c.AP_Cost < 'Y'"
8031
8032 Q_Deliv = SQLTableFromQuery(lcSqlString)
8033 llRetVal = !Empty(Q_Deliv)
8034 endif
8035
8036
8037 *-- Step #3: Current Production_Num/Open_Sequence shipped and delivered items:
8038 if llRetVal
8039 lcSqlString = ;
8040 "select pd.PKey," +;
8041 " dv.Shipment_Num," +;
8042 " pd.Stage_Num," +;
8043 " dv.Cost_Type," +;
8044 " Sum(case when pd.shipment_num = 0 then 0 else pd.Total_Cubic end) as Shp_Cubic," +;
8045 " Sum(case when pd.shipment_num = 0 then 0 else pd.Total_Weight end) as Shp_Weight," +;
8046 " Sum(ttRec) as Rec_Qty" +;
8047 " from " + Q_Deliv + " dv" +;
8048 " join zzcordrd pd" +;
8049 " on pd.PKey = dv.PKey" +;
8050 " where pd.Prod_Num = " + lcProd_Num +;
8051 " and pd.Open_Seq = " + lcOpen_Seq +;
8052 " and dv.AP_Cost < 'Y'" +;
8053 " group by pd.PKey," +;
8054 " dv.Shipment_Num," +;
8055 " pd.Stage_Num," +;
8056 " dv.Cost_Type"
8057
8058 Q_OrdShp = SQLTableFromQuery(lcSqlString)
8059 llRetVal = !Empty(Q_OrdShp)
8060 endif
8061
8062 *-- Step #4: All Shipped & Delivered items Part 2 :
8063 *--- TR 1046473 3-May-2010 Goutam. Added " Sum(case AP_Cost when 'Y' then 0 else pd.Prod_Value*pd.wip_total end) as ttProd_Value,"
8064 if llRetVal
8065 lcSqlString = ;
8066 "select dv.Shipment_Num," +;
8067 " dv.Cost_Type," +;
8068 " Sum(case AP_Cost when 'Y' then 0 else pd.Total_Cubic end) as ttCubic," +;
8069 " Sum(case AP_Cost when 'Y' then 0 else pd.Total_Weight end) as ttWeight," +;
8070 " Sum(case AP_Cost when 'Y' then 0 else pd.Prod_Value*pd.wip_total end) as ttProd_Value," +;
8071 " Sum(case AP_Cost when 'Y' then 0 else ttRec end) as ttRec," +;
8072 " Sum(Preserved_ext) as Preserved_Ext" +;
8073 " from " + Q_Deliv + " dv" +;
8074 " join zzcordrd pd" +;
8075 " on pd.PKey = dv.PKey" +;
8076 " group by dv.Shipment_Num, dv.Cost_type"
8077
8078 Q_AllShp = SQLTableFromQuery(lcSqlString)
8079 llRetVal = !Empty(Q_AllShp)
8080 endif
8081
8082 *-- Q_AllCat.Cost_Type
8083 *-- Q_ShpNum.Shipment_Num
8084 *-- Q_OrdShp.PKey, Q_OrdShp.Shipment_Num, Q_OrdShp.Stage_Num, Q_OrdShp.Shp_Qty, Q_OrdShp.Rec_Qty, Q_OrdShp.Cost_Type
8085 *-- Q_AllShp.Shipment_Num,Q_AllShp.ttUnit,Q_AllShp.ttCubic, Q_AllShp.ttWeight,Q_AllShp.ttRec,Q_AllShp.Cost_Type
8086
8087 *-- Step #5: Finaly, gather all info together:
8088 *--- TR 1046473 3-May-2010 Goutam. Added prod_value, tt.ttProd_Value in the select list
8089 if llRetVal
8090 lcSqlString = ;
8091 "select d.Pkey," +;
8092 " d.Prod_Num," +;
8093 " d.Open_Seq," +;
8094 " d.Stage_Num," +;
8095 " d.Tree_Seq," +;
8096 " s.Cost_Type," +;
8097 " d.Shp_Ok," +;
8098 " d.Shp_Seq," +;
8099 " (d.prod_value*d.wip_total) as prod_value, " + ;
8100 " sd.Shipment_Num," +;
8101 " sd.Stage_Num as Shp_Stage," +;
8102 " d.Total_Qty," +;
8103 " d.Wip_Total," +;
8104 " d.Last_Stage," +;
8105 " s.Shp_Cubic," +;
8106 " s.Shp_Weight," +;
8107 " Rec_Qty as Shp_Recd," +;
8108 " tt.ttCubic," +;
8109 " tt.ttWeight," +;
8110 " tt.ttRec," +;
8111 " tt.ttProd_Value, " + ;
8112 " Preserved_Ext," +;
8113 " h.Udf01_Fee, h.Udf01_By, " + lcAsFldExt + " AS Udf01_ext, " + ;
8114 " h.Udf02_Fee, h.Udf02_By, " + lcAsFldExt + " AS Udf02_ext, " + ;
8115 " h.Udf03_Fee, h.Udf03_By, " + lcAsFldExt + " AS Udf03_ext, " + ;
8116 " h.Udf04_Fee, h.Udf04_By, " + lcAsFldExt + " AS Udf04_ext, " + ;
8117 " h.Udf05_Fee, h.Udf05_By, " + lcAsFldExt + " AS Udf05_ext, " + ;
8118 " h.Udf06_Fee, h.Udf06_By, " + lcAsFldExt + " AS Udf06_ext, " + ;
8119 " h.Udf07_Fee, h.Udf07_By, " + lcAsFldExt + " AS Udf07_ext, " + ;
8120 " h.Udf08_Fee, h.Udf08_By, " + lcAsFldExt + " AS Udf08_ext, " + ;
8121 " h.Udf09_Fee, h.Udf09_By, " + lcAsFldExt + " AS Udf09_ext, " + ;
8122 " h.Udf10_Fee, h.Udf10_By, " + lcAsFldExt + " AS Udf10_ext, " + ;
8123 " h.Duty_Fee, h.Duty_By, " + lcAsFldExt + " AS Duty_ext " + ;
8124 " from zzcordrd sd" +;
8125 " join zzcordrd d" +;
8126 " on d.Prod_Num = sd.Prod_Num" +;
8127 " and d.Open_Seq = sd.Open_Seq" +;
8128 " and d.Tree_Seq like " + SqlFnConcat("RTrim(sd.tree_seq)+'%'") +;
8129 " join zzmshpmh h" +;
8130 " on h.Shipment_Num = sd.Shipment_Num" +;
8131 " join " + Q_OrdShp + " s" +;
8132 " on sd.PKey = s.PKey" +;
8133 " join " + Q_AllShp + " tt" +;
8134 " on tt.Shipment_Num = s.Shipment_Num" +;
8135 " and tt.Cost_Type = s.Cost_Type" +;
8136 " where sd.Prod_Num = " + lcProd_Num +;
8137 " and sd.Open_Seq = " + lcOpen_Seq +;
8138 " and (d.WIP_Total > 0 or d.Last_Stage = 'Y')"
8139
8140 *=== TechRec 1003236 03-Feb-2004 GS === (Removed)
8141
8142 *=== TechRec 1003561 19-Feb-2004 GS ===
8143
8144 llRetVal = v_SqlExec(lcSQLString, 'tcOrd_Shp')
8145 endif
8146
8147 *- Shipping trees are reconstructed, i.e. we have "phantom" record from prior shipment
8148 *- advanced down to WIP stage with the same pkey as later shipment.
8149 *- These trees are prorated accordingly to their shipments.
8150 *- If cost is acuumulated these records are summed up, otherwise we take only latest
8151 *- shipment
8152
8153 *Assert .F. message 'Click "Debug" to Debug '+Program()
8154
8155 IF llRetVal
8156 select tcOrd_Shp
8157 *--- TechRec 39918 15-Dec-2003 GS ---
8158 *--now we have SFCLBLUDF##_FEE values in Cost_Type column. We must match it to UDF##_FEE column value :o)
8159 scan
8160 *- Get extension of each shipment UDF field
8161 if Left(Cost_Type, 9) = "SFCLBLUDF"
8162 *--- TechRec 1003897 16-Mar-2004 GS ---
8163 *lnUdfFee = Evaluate(SubStr(Cost_Type,7))
8164 lnUdfFee = Evaluate(SubStr(Cost_Type,7)) - Preserved_Ext
8165 *=== TechRec 1003897 16-Mar-2004 GS ===
8166 lcNum = SubStr(Cost_Type,10,2)
8167 lcBy = Evaluate('Udf' + lcNum + "_By")
8168 lcUdfExt = 'Udf' + lcNum + '_Ext'
8169 else && Duty
8170 *--- TechRec 1003897 16-Mar-2004 GS ---
8171 *lnUdfFee = Duty_Fee
8172 lnUdfFee = Duty_Fee - Preserved_Ext
8173 *=== TechRec 1003897 16-Mar-2004 GS ===
8174 lcNum = "DD"
8175 lcBy = Duty_By
8176 lcUdfExt = "Duty_Ext"
8177 endif
8178 if !Empty(lnUdfFee)
8179 *--- TechRec 1005677 08-Jun-2004 AD, GS ---
8180
8181 lnDtlQty = IIF(tcOrd_Shp.Last_Stage = 'Y', tcOrd_Shp.Total_Qty, tcOrd_Shp.WIP_Total)
8182 DO CASE
8183 CASE tcOrd_Shp.ttRec = 0 .OR. tcOrd_Shp.Shp_Recd = 0
8184 lnDtlShpRatio = 0
8185 CASE lcBy = "C" and !Empty(tcOrd_Shp.ttCubic) && by cubic
8186 lnDtlShpRatio = (tcOrd_Shp.Shp_Cubic / tcOrd_Shp.ttCubic) * (lnDtlQty / tcOrd_Shp.Shp_Recd)
8187 CASE lcBy = "W" and !Empty(tcOrd_Shp.ttWeight) && by weight
8188 lnDtlShpRatio = (tcOrd_Shp.Shp_Weight / tcOrd_Shp.ttWeight) * (lnDtlQty / tcOrd_Shp.Shp_Recd)
8189
8190 *--- TR 1046473 3-May-2010 Goutam.
8191 CASE lcBy = "P" and !Empty(tcOrd_Shp.ttProd_Value) && by Prod Value
8192 lnDtlShpRatio = (tcOrd_Shp.prod_value / tcOrd_Shp.ttProd_Value) * (lnDtlQty / tcOrd_Shp.Shp_Recd)
8193 *=== TR 1046473 3-May-2010 Goutam.
8194
8195 OTHERWISE && units
8196 lnDtlShpRatio = lnDtlQty / tcOrd_Shp.ttRec
8197 ENDCASE
8198
8199 replace (lcUdfExt) with ;
8200 Round(lnUdfFee * lnDtlShpRatio, 5) in tcOrd_Shp
8201
8202 endif
8203 endScan
8204
8205*----- Old code inside if/endif (Scan/endscan)
8206*!* lnQty = IIF(tcOrd_Shp.Last_Stage = 'Y', tcOrd_Shp.Total_Qty, tcOrd_Shp.WIP_Total)
8207*!* lnShpRecd = Max(tcOrd_Shp.Shp_Qty, tcOrd_Shp.Shp_Recd) && ???????
8208*!* do Case
8209*!* case lnShpRecd = 0
8210*!* lnLineQty = 0
8211*!* case lcBy = "C" and !Empty(tcOrd_Shp.ttCubic) && by cubic
8212*!* lnShpQty = tcOrd_Shp.ttCubic
8213*!* lnLineQty = tcOrd_Shp.Shp_Cubic * lnQty /lnShpRecd
8214*!* case lcBy = "W" and !Empty(tcOrd_Shp.ttWeight) && by weight
8215*!* lnShpQty = tcOrd_Shp.ttWeight
8216*!* lnLineQty = tcOrd_Shp.Shp_Weight * lnQty /lnShpRecd
8217*!* otherwise && default is by units
8218*!* lnShpQty = tcOrd_Shp.ttUnit
8219*!* lnLineQty = tcOrd_Shp.Shp_Qty * lnQty /lnShpRecd
8220*!* endCase
8221*!* *--- TAN 34778 06/20/03 AD
8222*!* if tcOrd_Shp.Shp_Recd > tcOrd_Shp.Shp_Qty and tcOrd_Shp.Shp_Qty > 0
8223*!* lnLineQty = lnLineQty * (tcOrd_Shp.Shp_Recd/tcOrd_Shp.Shp_Qty)
8224*!* endif
8225*!* *=== TAN 34778 06/20/03 AD
8226*!* replace (lcUdfExt) with ;
8227*!* IIF(lnShpQty = 0, 0, Round(lnUdfFee/lnShpQty*lnLineQty, 5)) in tcOrd_Shp
8228 *=== TechRec 1005677 08-Jun-2004 AD, GS ===
8229
8230 *- New flag in production type to accumulate shipment costs from shipment on prior stage
8231 *--- TechRec 1004691 27-Apr-2004 GS ---
8232 *lcAccum_Shp = vl_ctype(&tcDetailAlias..Division, "Accum_Shp", "", &tcDetailAlias..Prod_Type)
8233 select (tcDetailAlias)
8234 lcAccum_Shp = vl_ctype(Division, "Accum_Shp", "", Prod_Type)
8235 *=== TechRec 1004691 27-Apr-2004 GS ===
8236 lcAccum_Shp = IIF(EMPTY(lcAccum_Shp), 'Y', lcAccum_Shp)
8237 IF lcAccum_Shp = 'Y'
8238 SELECT pkey, ;
8239 SUM(UDF01_Ext) AS UDF01_Ext, ;
8240 SUM(UDF02_Ext) AS UDF02_Ext, ;
8241 SUM(UDF03_Ext) AS UDF03_Ext, ;
8242 SUM(UDF04_Ext) AS UDF04_Ext, ;
8243 SUM(UDF05_Ext) AS UDF05_Ext, ;
8244 SUM(UDF06_Ext) AS UDF06_Ext, ;
8245 SUM(UDF07_Ext) AS UDF07_Ext, ;
8246 SUM(UDF08_Ext) AS UDF08_Ext, ;
8247 SUM(UDF09_Ext) AS UDF09_Ext, ;
8248 SUM(UDF10_Ext) AS UDF10_Ext, ;
8249 SUM(Duty_Ext) AS Duty_Ext ;
8250 FROM tcOrd_Shp GROUP BY pkey ;
8251 INTO CURSOR tcShipCost
8252 ELSE
8253 *--- TechRec 39918 15-Dec-2003 GS ---
8254*!* SELECT d.pkey, ;
8255*!* UDF01_Ext, UDF02_Ext, ;
8256*!* UDF03_Ext, UDF04_Ext, ;
8257*!* UDF05_Ext, UDF06_Ext, ;
8258*!* UDF07_Ext, UDF08_Ext, ;
8259*!* UDF09_Ext, UDF10_Ext, Duty_Ext ;
8260*!* FROM tcOrd_Shp d ;
8261*!* WHERE d.shp_stage IN ;
8262*!* (SELECT MAX(g.shp_stage) FROM tcOrd_Shp g WHERE g.pkey = d.pkey) ;
8263*!* INTO CURSOR tcShipCost
8264
8265 SELECT pkey, ;
8266 SUM(UDF01_Ext) AS UDF01_Ext, ;
8267 SUM(UDF02_Ext) AS UDF02_Ext, ;
8268 SUM(UDF03_Ext) AS UDF03_Ext, ;
8269 SUM(UDF04_Ext) AS UDF04_Ext, ;
8270 SUM(UDF05_Ext) AS UDF05_Ext, ;
8271 SUM(UDF06_Ext) AS UDF06_Ext, ;
8272 SUM(UDF07_Ext) AS UDF07_Ext, ;
8273 SUM(UDF08_Ext) AS UDF08_Ext, ;
8274 SUM(UDF09_Ext) AS UDF09_Ext, ;
8275 SUM(UDF10_Ext) AS UDF10_Ext, ;
8276 SUM(Duty_Ext) AS Duty_Ext ;
8277 FROM tcOrd_Shp d ;
8278 WHERE d.Shp_Stage IN (;
8279 SELECT MAX(g.Shp_Stage) FROM tcOrd_Shp g WHERE g.PKey = d.PKey) ;
8280 GROUP BY pkey ;
8281 INTO CURSOR tcShipCost
8282 ENDIF && lcAccum_Shp = 'Y'
8283
8284 SELECT tcShipCost
8285 INDEX ON Pkey TAG Pkey
8286 ENDIF
8287 USE IN SELECT('tcOrd_Shp')
8288
8289 if !Empty(Q_ShpNum)
8290 v_SQLExec("DROP TABLE " + Q_ShpNum)
8291 endif
8292
8293 if !Empty(Q_Deliv)
8294 v_SQLExec("DROP TABLE " + Q_Deliv)
8295 endif
8296
8297 if !Empty(Q_OrdShp)
8298 v_SQLExec("DROP TABLE " + Q_OrdShp)
8299 endif
8300
8301 if !Empty(Q_AllShp)
8302 v_SQLExec("DROP TABLE " + Q_AllShp)
8303 endif
8304
8305 SELECT(tcDetailAlias)
8306 .PopRecordSet()
8307 ENDWITH
8308
8309 SELECT(lnSelect)
8310 RETURN llRetVal
8311 ENDPROC
8312
8313 *--- TAN 37127 02/05/03 AD
8314 *- Find multilevel BOM for current or prior stage
8315 PROCEDURE FindMultiLevelBOMFkey
8316 LPARAMETERS tcDetailAlias, tcBOMAlias, tnProdDtlPkey
8317 LOCAL lnParkey, lnSelect, llFoundMulti, lnMultiLevelBOMFkey
8318
8319 lnSelect = SELECT()
8320 SELECT (tcBOMAlias)
8321 This.PushRecordSet()
8322 SET FILTER TO
8323 SELECT (tcDetailAlias)
8324 This.PushRecordSet()
8325 SET FILTER TO
8326 llFoundMulti = .F.
8327
8328 LOCATE FOR Pkey = tnProdDtlPkey
8329 IF FOUND(tcDetailAlias)
8330 IF SEEK(STR(tnProdDtlPkey), tcBOMAlias, 'BOMMstPkey')
8331 llFoundMulti = SEEK(STR(tnProdDtlPkey) + STR(1), tcBOMAlias, 'BOMMstPkey')
8332 ELSE
8333 lnParkey = parkey && parkey of current record.
8334 * loop for the previous stage.
8335 LOCATE FOR pkey = lnParkey
8336 DO WHILE FOUND()
8337 lnParkey = parkey && previous stage's parkey
8338 IF SEEK(STR(Pkey), tcBOMAlias, 'BOMMstPkey')
8339 llFoundMulti = SEEK(STR(Pkey) + STR(1), tcBOMAlias, 'BOMMstPkey')
8340 IF llFoundMulti
8341 EXIT
8342 ENDIF
8343 ENDIF
8344
8345 SELECT (tcDetailAlias)
8346 LOCATE FOR pkey = lnParkey
8347 ENDDO
8348 ENDIF
8349 ENDIF
8350
8351 lnMultiLevelBOMFkey = IIF(llFoundMulti, Evaluate(tcBOMAlias+".FKey"), 0)
8352
8353
8354 SELECT (tcDetailAlias)
8355 THIS.PopRecordSet()
8356 SELECT (tcBOMAlias)
8357 THIS.PopRecordSet()
8358 SELECT(lnSelect)
8359
8360 RETURN lnMultiLevelBOMFkey
8361 ENDPROC
8362 *=== TAN 37127 02/05/03 AD
8363
8364 PROCEDURE ProrateVoucher
8365 * --- TR 1055405 RLN 12/19/11 - Added tlNoStamp
8366 PARAMETER pcDetailAlias, pcCostAlias, pcHeaderAlias,pcBOMAlias, tlNoStamp
8367 &&--- TechRec 1039635 30-Apr-2009 vkrishnamurthy === Added pcBOMAlias
8368
8369 LOCAL llRetVal, lnQty, lcDetailAlias, lcCostAlias, laCost[5], llProdValue
8370
8371 * * CB 3/13/03 Commented out following code. Can't find these methods:
8372 * * Henry Han 9/20/2002
8373 * llRetVal = IIF(!.llNotNodata, DontNotUpdateNothing(.F.), ;
8374 * IIF(.llDontNotEver, DontNotUpdateOneTime(.F.), DontNotUpdateNever(.T.))
8375 * Return !(llRetVal = .F.) or .T.
8376
8377 *--- TechRec 1026008 09-Aug-2007 GSternik ---
8378 This.cPO_Dtl_Alias = pcDetailAlias
8379 *=== TechRec 1026008 09-Aug-2007 GSternik ===
8380
8381
8382
8383 * --- 1003958 05/04 CB - Optimized recalcs.
8384 * NOTE: ANY CHANGES MADE TO THIS ROUTINE MUST BE DUPLICATED IN ITS OPTIMIZED _2 EQUIVALENT!
8385 WITH THIS
8386 IF .lOptimizedRecalc AND .lDynamicsPrepped
8387 IF .lEnableDebugging
8388 .oLog.LogEntry("ProrateVoucher() - redirecting.")
8389 ENDIF
8390
8391 RETURN .ProrateVoucher_2(pcDetailAlias, pcCostAlias, pcHeaderAlias)
8392 ENDIF
8393
8394 IF .lEnableDebugging
8395 .oLog.LogEntry("ProrateVoucher() - original code.")
8396 ENDIF
8397 ENDWITH
8398 * === 1003958 End.
8399
8400 WITH THIS
8401 .pushRecordSet()
8402
8403 lcDetailAlias = pcDetailAlias
8404 lcCostAlias = pcCostAlias
8405 llRetVal = .T.
8406
8407 SELECT (lcDetailAlias)
8408 .pushRecordSet()
8409
8410 * Not Scanning through whole tree - only updating current stage record.
8411 IF last_stage = "Y"
8412 lnQty = total_qty
8413 ELSE
8414 lnQty = wip_total
8415 ENDIF
8416
8417 *--- TechRec 1039635 30-Apr-2009 vkrishnamurthy ---
8418 LOCAL lnDetPkey, llMultiLevel ,lcBOMAlias
8419 lnDetPkey = pkey
8420 SELECT(lcCostAlias)
8421 LOCATE FOR Fkey = lnDetPkey .AND. SysLevel > 0
8422 llMultiLevel = FOUND(lcCostAlias)
8423
8424 SELECT (lcDetailAlias)
8425 lcBOMAlias = pcBOMAlias
8426 *=== TechRec 1039635 30-Apr-2009 vkrishnamurthy ===
8427
8428
8429 *--- TechRec 1007154 04-Oct-2004 GS ---
8430 .lLast_Stage = (Last_Stage = 'Y')
8431 *=== TechRec 1007154 04-Oct-2004 GS ===
8432
8433 *--- TechRec 1004691 27-Apr-2004 GS --- Optimization
8434*!* * Initialize 5 required cost categories for zzcordrd
8435*!* laCost[DUTY_] = Duty_Amount
8436*!* laCost[PRODUCTION_] = Prod_Value
8437*!* laCost[MATERIAL_] = Total_Material
8438*!* laCost[TOTAL_COST_] = Total_Cost
8439*!* laCost[COMMISSION_] = Comm_Amount
8440 *=== TechRec 1004691 27-Apr-2004 GS ===
8441
8442 *--- TechRec 1039635 30-Apr-2009 vkrishnamurthy ---
8443*!* .CostFromConstant(lcCostAlias, pkey, lnQty, @laCost) && Get cost by formula
8444*!* .CostOfHSLookUp(lcCostAlias, pkey, lnQty) && Get hs lookup cost
8445*!* .CostOfCommission(lcCostAlias, pkey, lnqty, Agent) && Get agent commission cost &&&lcDetailAlias..agent
8446*!* .CostByFormula(lcCostAlias, pkey, lnQty, @laCost) && Get cost by formula
8447
8448 IF llMultiLevel
8449 .RecalCost(lcDetailAlias, lcBOMAlias, lcCostAlias, lnDetPkey)
8450 ELSE
8451 .CostFromConstant(lcCostAlias, pkey, lnQty, @laCost) && Get cost by formula
8452 .CostOfHSLookUp(lcCostAlias, pkey, lnQty) && Get hs lookup cost
8453 .CostOfHSLookUp(lcCostAlias, pkey, lnQty, true) && TR 1072967 26-SEP-13 Venuk. get hs fixed amount
8454 *--- TechRec 1058999 18-Apr-2012 jisingh ---
8455 .CostOfMultiRoyalty(lcCostAlias, pkey, lnQty) && get multi royalty cost
8456 *=== TechRec 1058999 18-Apr-2012 jisingh ===
8457 .CostOfCommission(lcCostAlias, pkey, lnqty, Agent) && Get agent commission cost &&&lcDetailAlias..agent
8458 .CostByFormula(lcCostAlias, pkey, lnQty, @laCost) && Get cost by formula
8459 ENDIF
8460 *=== TechRec 1039635 30-Apr-2009 vkrishnamurthy ===
8461
8462 * Time stamp Last_Mod first, then Last_Prorate.
8463 * --- TR 1055405 RLN 12/19/11 - It appears that when this happens within the loop of ApproveVouched, the same
8464 * docs are stamped each time and therefore they can be stamped at the end of A/V which speeds things up quite a bit
8465 IF !tlNoStamp
8466 * === TR 1055405
8467 .TimeStampDocument(lcDetailAlias)
8468 ENDIF && === TR 1055405
8469 *--- TechRec 1004691 27-Apr-2004 GS ---
8470*!* llProdValue = ( ALLTRIM(UPPER(vl_dcatgr(Vzzgapvcd.Category, 'Cost_Type'))) = ALLTRIM(This.cCN_PROD_VALUE) )
8471
8472*!* * recording Duty_Value, Prod_Value, Total_Material and Total_Cost
8473*!* REPLACE Cost WITH IIF(llProdValue, laCost[PRODUCTION_], Cost), duty_amount WITH laCost[DUTY_], prod_value WITH laCost[PRODUCTION_], ;
8474*!* total_material WITH laCost[MATERIAL_], total_cost WITH laCost[TOTAL_COST_], ;
8475*!* comm_amount WITH laCost[COMMISSION_] ;
8476*!* IN (lcDetailAlias)
8477
8478 This.UpdatePODetail(lcCostAlias, lcDetailAlias)
8479 *=== TechRec 1004691 27-Apr-2004 GS ===
8480
8481 .popRecordSet()
8482
8483 * Time stamp last_mod of cost view.
8484 * --- TR 1055405 RLN 12/19/11 - It appears that when this happens within the loop of ApproveVouched, the same
8485 * docs are stamped each time and therefore they can be stamped at the end of A/V which speeds things up quite a bit
8486 IF !tlNoStamp
8487 * === TR 1055405
8488 .TimeStampDocument(lcCostAlias, "ALL")
8489 ENDIF && === TR 1055405
8490 .popRecordSet()
8491 ENDWITH
8492
8493 RETURN llRetVal
8494 ENDPROC
8495
8496 *-----------------------------------------
8497
8498 *--- TechRec 1002576 31-Dec-2003 GS ---
8499 Procedure RequeryBaseCost &&--- GS
8500 Parameter tnKey
8501 local llRetVal, lcFKey, lnSelect
8502 *v_SQLExec("select * from zzdcostd where FKey = (select FKey from zzdcostd where pKey = "+SQLFormatNum(tnKey)))
8503 lnSelect = Select()
8504 llRetVal = v_SQLPrep(;
8505 "select *"+;
8506 " from zzdcosth h"+;
8507 " where h.PKey = " + SQLFormatNum(tnKey), "curBaseCost")
8508 if llRetVal
8509 select "curBaseCost"
8510 *.lMultiLevelBOM = (Multi_BOM = 'Y')
8511 This.cBaseCostCurrency = Curr_Code
8512 This.nBaseCostKey = tnKey
8513 *index on PKey tag PKey
8514 endif
8515 select (lnSelect)
8516 return llRetVal
8517 EndProc
8518
8519 *-----------------------------------------
8520
8521 *--- TechRec 1002576 31-Dec-2003 GS ---
8522 Procedure GetBaseCostCurrency
8523 Parameter tnMasterKey
8524 if Empty(tnMasterKey)
8525 return "" && shortcut
8526 endif
8527 if tnMasterKey # This.nBaseCostKey
8528 if !This.RequeryBaseCost(tnMasterKey)
8529 This.cBaseCostCurrency = ""
8530 endif
8531 endif
8532 return This.cBaseCostCurrency
8533 EndProc
8534 *=== TechRec 1002576 31-Dec-2003 GS ===
8535
8536 *-----------------------------------------
8537
8538 *--- TechRec 1002576 31-Dec-2003 GS ---
8539 Procedure ChangeCostExchangeRate
8540 *-- Returns count of changed values.
8541 Parameters tcCostDtl, tcCurr_Code, tnMultiplier
8542 * We have to do it for each Open_Seq!
8543 local lnSeq_Count, lnRetVal
8544 lnSeq_Count = 0
8545 local array laOpen_Seq_Curr(1)
8546 lnRetVal = 0
8547
8548 if !Empty(tnMultiplier) and !Empty(tcCurr_Code) and tnMultiplier # 1
8549 This.PushRecordSet()
8550
8551 select (tcCostDtl)
8552 scan for CostLevelPKey > 0
8553 if lnSeq_Count < Open_Seq
8554 lnSeq_Count = Open_Seq
8555 dimension laOpen_Seq_Curr(lnSeq_Count)
8556 endif
8557 if varType(laOpen_Seq_Curr[Open_Seq]) # 'C'
8558 laOpen_Seq_Curr[Open_Seq] = This.GetBaseCostCurrency(CostLevelPKey)
8559 endif
8560 if laOpen_Seq_Curr[Open_Seq] = tcCurr_Code and !Empty(Constant)
8561 replace Constant with Constant * tnMultiplier
8562 lnRetVal = lnRetVal + 1
8563 endif
8564 endScan
8565 This.PopRecordSet()
8566 endif
8567
8568 return lnRetVal
8569 EndProc
8570 *=== TechRec 1002576 31-Dec-2003 GS ===
8571
8572 *-----------------------------------------
8573
8574 *--- TechRec 1004691 27-Apr-2004 GS ---
8575
8576 Procedure UpdatePODetail
8577 Parameters tcCostAlias, tcProdDtlAlias
8578
8579 local llDuty_Amount, llProd_Value, llTotal_Material, llTotal_Cost, llComm_Amount
8580 local lnProdDtlPKey, Category_Cost, lcCategory, lnOldSelect, lnCategory_Cost, lcOrder
8581
8582 Store .T. to llDuty_Amount, llProd_Value, llTotal_Material, llTotal_Cost, llComm_Amount
8583
8584 *---TR 1056306 07-23-2013 RKI ---*
8585
8586 IF EMPTY(This.cHeaderAlias)
8587 This.nDiv_Rate = 1
8588 ELSE
8589 This.nDiv_Rate = IIF(EVALUATE(This.cHeaderAlias +'.Div_Rate') = 0, 1, EVALUATE(This.cHeaderAlias + '.Div_Rate'))
8590 ENDIF
8591 *===TR 1056306 07-23-2013 RKI ===*
8592
8593 *--- TechRec 1053716 19-May-2011 vkrishnamurthy ---
8594 LOCAL llAccounting_Cost
8595 llAccounting_Cost = .T.
8596 *=== TechRec 1053716 19-May-2011 vkrishnamurthy ===
8597
8598 lnOldSelect = Select()
8599
8600 select (tcProdDtlAlias)
8601 lnProdDtlPKey = PKey
8602
8603 *--- TechRec 1005611 03-Jun-2004 GS ---
8604 if Sc_RowLock = 'Y'
8605 return
8606 endif
8607 *=== TechRec 1005611 03-Jun-2004 GS ===
8608
8609 select (tcCostAlias)
8610 This.PushRecordSet()
8611
8612 * --- 1003958 05/04 CB - Optimized recalcs - use index on THIS.cCstAlias
8613 IF NOT THIS.lOptimizedRecalc OR NOT THIS.lDynamicsPrepped
8614 scan for FKey = lnProdDtlPKey and SysLevel = 0
8615 lcCategory = Category
8616 if Seek(lcCategory, This.cCatAlias) &&!Eof(This.cCatAlias)
8617 lnCategory_Cost = Category_Cost
8618 select (This.cCatAlias)
8619 Do Case
8620 case llTotal_Cost and Cost_Type = This.cCN_TOTAL_COST
8621 llTotal_Cost = .F.
8622 replace Total_Cost with lnCategory_Cost in (tcProdDtlAlias)
8623
8624 case llProd_Value and Cost_Type = This.cCN_PROD_VALUE
8625 llProd_Value = .F.
8626 replace Prod_Value with lnCategory_Cost,;
8627 Cost with lnCategory_Cost in (tcProdDtlAlias)
8628 *--- Prod detail cost always replaced. Confirmed by Jason and Joe, see 32850 10/04/02 by AD.
8629
8630 case llTotal_Material and Cost_Type = This.cCN_TOTAL_MATERIAL
8631 llTotal_Material = .F.
8632 replace Total_Material with lnCategory_Cost in (tcProdDtlAlias)
8633
8634 case llDuty_Amount and Cost_Type = This.cCN_DUTY_VALUE
8635 llDuty_Amount = .F.
8636 replace Duty_Amount with lnCategory_Cost in (tcProdDtlAlias)
8637
8638 case llComm_Amount and Cost_Type = This.cCN_COMMISSION
8639 llComm_Amount = .F.
8640 replace Comm_Amount with lnCategory_Cost in (tcProdDtlAlias)
8641
8642 *--- TechRec 1053716 19-May-2011 vkrishnamurthy ---
8643 case llAccounting_Cost AND ALLTRIM(Cost_Type) = UPPER(This.cCN_ACCOUNTING_COST)
8644 llAccounting_Cost = .F.
8645 *--- TR 1077600 19-AUG-2014 EBANDIERO - Fixed This.nDiv_Rate(tcProdDtlAlias) - added IN
8646 replace acct_cost with lnCategory_Cost/This.nDiv_Rate IN (tcProdDtlAlias) && TR 1056306 07-23-2013 RKI &&.nDiv_Rate Added.
8647 *=== TechRec 1053716 19-May-2011 vkrishnamurthy ===
8648
8649 EndCase
8650 endif
8651 endScan
8652 ELSE
8653 lcOrder = ALLTRIM(UPPER(ORDER()))
8654 SET ORDER TO TAG FKSysLvl
8655 SEEK lnProdDtlPKey
8656 SCAN WHILE FKey = lnProdDtlPKey AND SysLevel = 0
8657 IF FOUND(THIS.cCatAlias)
8658 lnCategory_Cost = Category_Cost
8659 SELECT (THIS.cCatAlias)
8660 DO CASE
8661 CASE llTotal_Cost AND Cost_Type = THIS.cCN_TOTAL_COST
8662 llTotal_Cost = .F.
8663 REPLACE Total_Cost WITH lnCategory_Cost IN (tcProdDtlAlias)
8664
8665 CASE llProd_Value AND Cost_Type = THIS.cCN_PROD_VALUE
8666 llProd_Value = .F.
8667
8668 *--- 1012294 KISHOR 28-JUL-2006
8669 *REPLACE Prod_Value WITH lnCategory_Cost,;
8670 Cost WITH lnCategory_Cost IN (tcProdDtlAlias)
8671 REPLACE Prod_Value WITH lnCategory_Cost,;
8672 Cost WITH lnCategory_Cost ;
8673 modified WITH 'Y' IN (tcProdDtlAlias)
8674 *=== 1012294 KISHOR 28-Jul-2006
8675
8676 CASE llTotal_Material AND Cost_Type = THIS.cCN_TOTAL_MATERIAL
8677 llTotal_Material = .F.
8678 REPLACE Total_Material WITH lnCategory_Cost IN (tcProdDtlAlias)
8679
8680 CASE llDuty_Amount AND Cost_Type = THIS.cCN_DUTY_VALUE
8681 llDuty_Amount = .F.
8682 REPLACE Duty_Amount WITH lnCategory_Cost IN (tcProdDtlAlias)
8683
8684 CASE llComm_Amount AND Cost_Type = THIS.cCN_COMMISSION
8685 llComm_Amount = .F.
8686 REPLACE Comm_Amount WITH lnCategory_Cost IN (tcProdDtlAlias)
8687
8688 *--- TechRec 1053716 19-May-2011 vkrishnamurthy ---
8689 case llAccounting_Cost AND ALLTRIM(Cost_Type) = UPPER(This.cCN_ACCOUNTING_COST)
8690 llAccounting_Cost = .F.
8691 replace acct_cost with lnCategory_Cost/This.nDiv_Rate in (tcProdDtlAlias) && TR 1056306 07-23-2013 RKI &&.nDiv_Rate Added.
8692 *=== TechRec 1053716 19-May-2011 vkrishnamurthy ===
8693 ENDCASE
8694 ENDIF
8695 ENDSCAN
8696 ENDIF
8697 * === 1003958 End.
8698
8699*--- Commented per Alex D. ---
8700*!* select (tcProdDtlAlias)
8701*!* if llTotal_Cost
8702*!* replace Total_Cost with 0
8703*!* endif
8704*!* if llProd_Value
8705*!* replace Prod_Value with 0
8706*!* endif
8707*!* if llTotal_Material
8708*!* replace Total_Material with 0
8709*!* endif
8710*!* if llDuty_Amount
8711*!* replace Duty_Amount with 0
8712*!* endif
8713*!* if llComm_Amount
8714*!* replace Comm_Amount with 0
8715*!* endif
8716*===
8717
8718 This.PopRecordSet()
8719 select (lnOldSelect)
8720
8721 EndProc
8722 *=== TechRec 1004691 27-Apr-2004 GS ===
8723
8724 *-----------------------------------------
8725
8726 *--- TechRec 1002576 31-Dec-2003 GS ---
8727 Procedure Destroy
8728 use in Select("curBaseCost")
8729
8730 * --- 1003958 04/04 CB - Close Log, Cursors.
8731 WITH THIS
8732 .CloseBaseCursors()
8733 IF .lEnableDebugging
8734 .olog.CloseLog()
8735 ENDIF
8736 ENDWITH
8737 * === 1003958 End.
8738
8739 return DoDefault()
8740 EndProc
8741 *=== TechRec 1002576 31-Dec-2003 GS ===
8742
8743 *-----------------------------------------
8744
8745 *--- TechRec 1005611 03-Jun-2004 GS ---
8746 *--- see clsBusin for the original code
8747 Procedure TimeStampDocument
8748 Parameters tcAlias, tcScope
8749 Local llRetval, llLockExists, llScope
8750
8751 llRetval = .F.
8752
8753 tcAlias = IIF(Empty(tcAlias), Alias(), tcAlias)
8754 tcScope = IIF(Empty(tcScope), "", tcScope)
8755
8756
8757 llLockExists = Type(tcAlias + ".Sc_RowLock") = 'C'
8758 llScope = !Empty(tcScope)
8759
8760 if llScope
8761 This.PushRecordSet()
8762 else
8763 if llLockExists
8764 tcScope = " next 1"
8765 endif
8766 endif
8767
8768 if !Eof(tcAlias) or llScope
8769 If (Type(tcAlias + ".User_Id") = 'U' or ;
8770 Type(tcAlias + ".Last_Mod") = 'U')
8771 Else
8772 if llLockExists
8773 replace User_Id with goEnv.envLogin.cUserName, ;
8774 Last_Mod with DateTime() for Sc_RowLock # 'Y' in (tcAlias) &tcScope
8775 else
8776 replace User_Id with goEnv.envLogin.cUserName, ;
8777 Last_Mod with DateTime() in (tcAlias) &tcScope
8778 endif
8779 EndIf
8780 llRetval = .T.
8781 endif
8782
8783 if llScope
8784 This.PopRecordSet()
8785 endif
8786
8787 return llRetval
8788 endProc
8789 *=== TechRec 1005611 03-Jun-2004 GS ===
8790
8791*======================================================================
8792
8793 *--- TR 1008559 25-Jan-2005 VSS/SHAN
8794 PROCEDURE GetCostFromBom
8795 LPARAMETERS tcStyleCostHeaderView, tcStyleCostDetailView, tcCurBOMHeader, tcCmp_type, tcBOM_Dutiable, tcCurr_Code
8796
8797 LOCAL lnSetDecimals, lnCost, lnPkey, lcSelect, lnRecno, lnCost2, lnExchangeRate, ;
8798 lnSelect, lnRecno, lcCurrCode, lcSQLExec
8799
8800 *--- TechRec 1024422 23-May-2007 vkrishnamurthy ---
8801 LOCAL lnBomSkuCount , llOneSize
8802 *=== TechRec 1024422 23-May-2007 vkrishnamurthy ===
8803
8804 lnSetDecimals = SET("DECIMALS")
8805 SET DECIMALS TO 5
8806
8807 lnCost = 0
8808 lnCost2 = 0
8809 lcCurrCode = ""
8810
8811 WITH THIS
8812 .PushRecordSet()
8813 lnSelect = SELECT()
8814
8815 SELECT (tcStyleCostDetailView)
8816 THIS.PushRecordSet()
8817
8818 SELECT (tcStyleCostHeaderView)
8819 .PushRecordSet()
8820
8821 IF NOT USED(tcCurBOMHeader) OR EOF(tcCurBOMHeader)
8822 lnPkey = vl_GetBaseBOM(division, style, color_code, lbl_code, dimension, prod_type, contractor, ;
8823 "pkey", tcCurBOMHeader, design_num)
8824 ELSE
8825 lnPkey = SysGetFieldValue(tcCurBOMHeader, 'pKey')
8826 ENDIF
8827
8828 lcCurrCode = SysGetFieldValue(tcCurBOMHeader, 'curr_code')
8829
8830 IF NOT EMPTY(lnPkey)
8831 lnExchangeRate = ;
8832 GetExchangeRate(lcCurrCode, IIF(EMPTY(tcCurr_Code), Curr_Code, tcCurr_Code))
8833 ENDIF
8834
8835 IF NOT EMPTY(lnPkey)
8836
8837 *--- TechRec 1024615 30-May-2007 vkrishnamurthy ---
8838*!* lcSQLExec = "SELECT * FROM zzbbommd WHERE fkey = " + SQLFormatNum(lnPkey)
8839 lcSQLExec = "SELECT bm.* ,ISNULL(ct.one_size,'N') as one_size FROM zzbbommd bm" + ;
8840 " LEFT JOIN ZZBTYPEH ct " +;
8841 " ON bm.cmp_type = ct.cmp_type " + ;
8842 " WHERE fkey = " + SQLFormatNum(lnPkey)
8843 *=== TechRec 1024615 30-May-2007 vkrishnamurthy ===
8844
8845 v_SQLExec(lcSQLExec, "tcBOMDet")
8846
8847 *--- TechRec 1024422 23-May-2007 vkrishnamurthy --- && Used for Else Part - for specific Cmp_type
8848 llOneSize = (vl_btypeh(tcCmp_type,'one_size') = 'Y')
8849 lnBomSkuCount = 1
8850 *=== TechRec 1024422 23-May-2007 vkrishnamurthy ===
8851
8852 SELECT tcBOMDet
8853 IF RTRIM(tcCmp_type) = RSV_ALL
8854
8855
8856 DO CASE
8857 CASE tcBOM_Dutiable = "Y"
8858 *--- TechRec 1024615 30-May-2007 vkrishnamurthy ---
8859*!* *--- TechRec 1024422 23-May-2007 vkrishnamurthy ---
8860*!* IF llOneSize
8861*!* COUNT TO lnBomSkuCount FOR cost_ok = "Y" AND dutiable = "Y"
8862*!* lnBomSkuCount = IIF( lnBomSkuCount > 0 , lnBomSkuCount ,1)
8863*!* ELSE
8864*!* lnBomSkuCount = 1
8865*!* ENDIF
8866*!* *=== TechRec 1024422 23-May-2007 vkrishnamurthy ===
8867 *=== TechRec 1024615 30-May-2007 vkrishnamurthy ===
8868
8869 *--- TechRec 1024615 30-May-2007 vkrishnamurthy ---
8870*!* * --- TR 1023921 HNISAR 07-MAY-2007
8871*!* CALCULATE SUM(INT(Extension*100000)/100000) TO lnCost FOR cost_ok = "Y" AND dutiable = "Y"
8872*!* CALCULATE SUM(Extension) TO lnCost FOR cost_ok = "Y" AND dutiable = "Y"
8873*!* * === TR 1023921 HNISAR 07-MAY-2007
8874*!*
8875*!* *--- TechRec 1024422 23-May-2007 vkrishnamurthy ---
8876*!* lnCost = lnCost / lnBomSkuCount
8877*!* *=== TechRec 1024422 23-May-2007 vkrishnamurthy ===
8878 lnCost = .GetBOMCostBySize(" cost_ok = 'Y' AND dutiable = 'Y' ")
8879 *=== TechRec 1024615 30-May-2007 vkrishnamurthy ===
8880
8881 lnCost = ROUND(lnExchangeRate*lnCost,5)
8882
8883 SELECT (tcStyleCostDetailView)
8884 CALCULATE SUM(category_cost) TO lnCost2 FOR ;
8885 NOT EMPTY(Cmp_type) AND RTRIM(Cmp_type) <> RSV_ALL AND BOM_Dutiable = "Y" and NOT DELETED()
8886 lnCost = lnCost - lnCost2
8887
8888 *--- TR 1025356 26-JUN-2007 VKK
8889 * the issue here is that the bom detail has dutibable = 'Y', but the cost categor referec
8890 * has bom_dutabiel = 'N' for some of the cost categories and so we get different.
8891 * we can make it direclty to 0 for now.
8892 lnCost = IIF(lnCost <> 0, 0, lnCost)
8893 *=== TR 1025356 26-JUN-2007 VKK
8894
8895
8896 CASE tcBOM_Dutiable = "N"
8897 *--- TechRec 1024615 30-May-2007 vkrishnamurthy ---
8898*!* *--- TechRec 1024422 23-May-2007 vkrishnamurthy ---
8899*!* IF llOneSize
8900*!* COUNT TO lnBomSkuCount FOR cost_ok = "Y" AND excl_cost <> 'Y' AND dutiable = "N"
8901*!* lnBomSkuCount = IIF( lnBomSkuCount > 0 , lnBomSkuCount ,1)
8902*!* ELSE
8903*!* lnBomSkuCount = 1
8904*!* ENDIF
8905*!* *=== TechRec 1024422 23-May-2007 vkrishnamurthy ===
8906 *=== TechRec 1024615 30-May-2007 vkrishnamurthy ===
8907
8908 *--- TechRec 1024615 30-May-2007 vkrishnamurthy ---
8909*!* * --- TR 1023921 HNISAR 07-MAY-2007
8910*!* *!* CALCULATE SUM(INT(Extension*100000)/100000) TO lnCost FOR cost_ok = "Y" AND dutiable = "N" AND excl_cost <> 'Y'
8911*!* CALCULATE SUM(Extension) TO lnCost FOR cost_ok = "Y" AND dutiable = "N" AND excl_cost <> 'Y'
8912*!* * === TR 1023921 HNISAR 07-MAY-2007
8913
8914*!* *--- TechRec 1024422 23-May-2007 vkrishnamurthy ---
8915*!* lnCost = lnCost / lnBomSkuCount
8916*!* *=== TechRec 1024422 23-May-2007 vkrishnamurthy ===
8917 lnCost = .GetBOMCostBySize(" cost_ok = 'Y' AND dutiable = 'N' AND Excl_cost <> 'Y' ")
8918 *=== TechRec 1024615 30-May-2007 vkrishnamurthy ===
8919 lnCost = ROUND(lnExchangeRate*lnCost,5)
8920
8921 SELECT (tcStyleCostDetailView)
8922 CALCULATE SUM(category_cost) TO lnCost2 FOR ;
8923 NOT EMPTY(Cmp_type) AND RTRIM(Cmp_type) <> RSV_ALL AND BOM_Dutiable = "N" and NOT DELETED()
8924 lnCost = lnCost - lnCost2
8925
8926 *--- TR 1025356 26-JUN-2007 VKK
8927 * the issue here is that the bom detail has dutibable = 'Y', but the cost categor referec
8928 * has bom_dutabiel = 'N' for some of the cost categories and so we get different.
8929 * we can make it direclty to 0 for now.
8930 lnCost = IIF(lnCost <> 0, 0, lnCost)
8931 *=== TR 1025356 26-JUN-2007 VKK
8932
8933
8934 CASE tcBOM_Dutiable = "B"
8935 *--- TechRec 1024615 30-May-2007 vkrishnamurthy ---
8936*!* *--- TechRec 1024422 23-May-2007 vkrishnamurthy ---
8937*!* IF llOneSize
8938*!* COUNT TO lnBomSkuCount FOR cost_ok = "Y" AND excl_cost <> 'Y'
8939*!* lnBomSkuCount = IIF( lnBomSkuCount > 0 , lnBomSkuCount ,1)
8940*!* ELSE
8941*!* lnBomSkuCount = 1
8942*!* ENDIF
8943*!* *=== TechRec 1024422 23-May-2007 vkrishnamurthy ===
8944 *=== TechRec 1024615 30-May-2007 vkrishnamurthy ===
8945
8946 *--- TechRec 1024615 30-May-2007 vkrishnamurthy ---
8947*!* * --- TR 1023921 HNISAR 07-MAY-2007
8948*!* *!* CALCULATE SUM(INT(Extension*100000)/100000) TO lnCost FOR cost_ok = "Y" AND excl_cost <> 'Y'
8949*!* CALCULATE SUM(Extension) TO lnCost FOR cost_ok = "Y" AND excl_cost <> 'Y'
8950*!* * === TR 1023921 HNISAR 07-MAY-2007
8951
8952*!* *--- TechRec 1024422 23-May-2007 vkrishnamurthy ---
8953*!* lnCost = lnCost / lnBomSkuCount
8954*!* *=== TechRec 1024422 23-May-2007 vkrishnamurthy ===
8955 lnCost = .GetBOMCostBySize(" cost_ok = 'Y' AND Excl_cost <> 'Y' ")
8956 *=== TechRec 1024615 30-May-2007 vkrishnamurthy ===
8957
8958 lnCost = ROUND(lnExchangeRate*lnCost,5)
8959
8960 SELECT (tcStyleCostDetailView)
8961 CALCULATE SUM(category_cost) TO lnCost2 FOR ;
8962 NOT EMPTY(Cmp_type) AND RTRIM(Cmp_type) <> RSV_ALL and NOT DELETED()
8963 lnCost = lnCost - lnCost2
8964
8965 *--- TR 1025356 26-JUN-2007 VKK
8966 * the issue here is that the bom detail has dutibable = 'Y', but the cost categor referec
8967 * has bom_dutabiel = 'N' for some of the cost categories and so we get different.
8968 * we can make it direclty to 0 for now.
8969 lnCost = IIF(lnCost <> 0, 0, lnCost)
8970 *=== TR 1025356 26-JUN-2007 VKK
8971
8972 ENDCASE
8973 ELSE
8974 DO CASE
8975 CASE tcBOM_Dutiable = 'Y'
8976
8977 *--- TechRec 1024422 23-May-2007 vkrishnamurthy ---
8978 IF llOneSize
8979 COUNT TO lnBomSkuCount FOR Cmp_type = tcCmp_type AND cost_ok = "Y" AND dutiable = 'Y' AND excl_cost <> 'Y'
8980 lnBomSkuCount = IIF( lnBomSkuCount > 0 , lnBomSkuCount ,1)
8981 ELSE
8982 lnBomSkuCount = 1
8983 ENDIF
8984 *=== TechRec 1024422 23-May-2007 vkrishnamurthy ===
8985
8986 * --- TR 1023921 HNISAR 07-MAY-2007
8987*!* CALCULATE SUM(INT(Extension*100000)/100000) TO lnCost FOR Cmp_type = tcCmp_type AND cost_ok = "Y" AND dutiable = 'Y' AND excl_cost <> 'Y'
8988 CALCULATE SUM(Extension) TO lnCost FOR Cmp_type = tcCmp_type AND cost_ok = "Y" AND dutiable = 'Y' AND excl_cost <> 'Y'
8989 * === TR 1023921 HNISAR 07-MAY-2007
8990
8991 CASE tcBOM_Dutiable = 'N'
8992
8993 *--- TechRec 1024422 23-May-2007 vkrishnamurthy ---
8994 IF llOneSize
8995 COUNT TO lnBomSkuCount FOR Cmp_type = tcCmp_type AND cost_ok = "Y" AND dutiable = 'N' AND excl_cost <> 'Y'
8996 lnBomSkuCount = IIF( lnBomSkuCount > 0 , lnBomSkuCount ,1)
8997 ELSE
8998 lnBomSkuCount = 1
8999 ENDIF
9000 *=== TechRec 1024422 23-May-2007 vkrishnamurthy ===
9001
9002 * --- TR 1023921 HNISAR 07-MAY-2007
9003*!* CALCULATE SUM(INT(Extension*100000)/100000) TO lnCost FOR Cmp_type = tcCmp_type AND cost_ok = "Y" AND dutiable = 'N' AND excl_cost <> 'Y'
9004 CALCULATE SUM(Extension) TO lnCost FOR Cmp_type = tcCmp_type AND cost_ok = "Y" AND dutiable = 'N' AND excl_cost <> 'Y'
9005 * === TR 1023921 HNISAR 07-MAY-2007
9006
9007 CASE tcBOM_Dutiable = 'B'
9008
9009 *--- TechRec 1024422 23-May-2007 vkrishnamurthy ---
9010 IF llOneSize
9011 COUNT TO lnBomSkuCount FOR Cmp_type = tcCmp_type AND cost_ok = "Y" AND excl_cost <> 'Y'
9012 lnBomSkuCount = IIF( lnBomSkuCount > 0 , lnBomSkuCount ,1)
9013 ELSE
9014 lnBomSkuCount = 1
9015 ENDIF
9016 *=== TechRec 1024422 23-May-2007 vkrishnamurthy ===
9017
9018 * --- TR 1023921 HNISAR 07-MAY-2007
9019*!* CALCULATE SUM(INT(Extension*100000)/100000) TO lnCost FOR Cmp_type = tcCmp_type AND cost_ok = "Y" AND excl_cost <> 'Y'
9020 CALCULATE SUM(Extension) TO lnCost FOR Cmp_type = tcCmp_type AND cost_ok = "Y" AND excl_cost <> 'Y'
9021 * === TR 1023921 HNISAR 07-MAY-2007
9022
9023 ENDCASE
9024
9025 *--- TechRec 1024422 23-May-2007 vkrishnamurthy ---
9026 lnCost = lnCost / lnBomSkuCount
9027 *=== TechRec 1024422 23-May-2007 vkrishnamurthy ===
9028
9029 lnCost = ROUND(lnExchangeRate*lnCost,5)
9030
9031 ENDIF
9032
9033 USE IN tcBOMDet
9034
9035 ENDIF
9036
9037 SET DECIMALS TO &lnSetDecimals
9038
9039 .PopRecordSet()
9040 .PopRecordSet()
9041 .PopRecordSet()
9042
9043 ENDWITH
9044
9045 SELECT(lnSelect)
9046 RETURN lnCost
9047
9048 ENDPROC
9049 *=== TR 1008559 25-Jan-2005 VSS/SHAN
9050
9051*======================================================================
9052
9053 *--- TR 1008559 25-Jan-2005 VSS/SHAN
9054 PROCEDURE RecalcStdCostSheet
9055 LPARAMETERS tcStyleCostHeaderView, tcStyleCostDetailView, tcCurCatgr, tlShowMessage, tlForceShowMsg
9056
9057 LOCAL lnSelect, llRetVal, lnHS_Base, lnCost, lnExRate, lnCommissionBase, ;
9058 lcRetailPrice, lcStyleCurrency, lnExchangeRate, lcFreezStd, lcFreezRet, lcFreezWhs, ;
9059 lcCurrCode, lcDivision, lcStyle, lcColorCode, lcLblCode, lcDimension, lcCostType, lcProdCtrl, ;
9060 lcCurBOMHeader, lnMRBase &&--- TechRec 1058999 13-Apr-2012 jisingh Added lnMRBase ===
9061
9062 local lcDesign_Num &&--- TechRec 1014674 03-Jan-2006 GS ---
9063
9064 LOCAL lHsFixedAmount &&--- TR 1072967 26-SEP-13 Venuk
9065
9066 LOCAL lcFrzTransStdCost, lcFrzTransWhsPrice, lcFrzTransRetailPrice &&--- TechRec 1078317 23-Jul-2014 TSV---
9067
9068 lnSelect = SELECT()
9069
9070 WITH THIS
9071 SELECT (tcStyleCostHeaderView)
9072
9073 lcCurrCode = SysGetFieldValue(tcStyleCostHeaderView, 'curr_code')
9074 lcDivision = SysGetFieldValue(tcStyleCostHeaderView, 'division')
9075 lcStyle = SysGetFieldValue(tcStyleCostHeaderView, 'style')
9076 lcColorCode = SysGetFieldValue(tcStyleCostHeaderView, 'color_code')
9077 lcLblCode = SysGetFieldValue(tcStyleCostHeaderView, 'lbl_code')
9078 lcDimension = SysGetFieldValue(tcStyleCostHeaderView, 'dimension')
9079 lcProdCtrl = GetUniqueFileName()
9080 lcCurBOMHeader = GetUniqueFileName()
9081
9082 IF vl_ccntr(division, "", lcProdCtrl)
9083 lcFreezStd = SysGetFieldValue(lcProdCtrl, 'freezstd')
9084 lcFreezRet = SysGetFieldValue(lcProdCtrl, 'freezret')
9085 lcFreezWhs = SysGetFieldValue(lcProdCtrl, 'freezwhs')
9086
9087 *--- TechRec 1078317 23-Jul-2014 TSV---
9088 lcFrzTransStdCost = SysGetFieldValue(lcProdCtrl, 'freeze_trans_std')
9089 lcFrzTransWhsPrice = SysGetFieldValue(lcProdCtrl, 'freeze_trans_whs')
9090 lcFrzTransRetailPrice = SysGetFieldValue(lcProdCtrl, 'freeze_trans_ret')
9091 *=== TechRec 1078317 23-Jul-2014 TSV===
9092
9093 USE IN (lcProdCtrl)
9094 ELSE
9095 lcFreezStd = ''
9096 lcFreezRet = ''
9097 lcFreezWhs = ''
9098
9099 *--- TechRec 1078317 23-Jul-2014 TSV---
9100 lcFrzTransStdCost = ''
9101 lcFrzTransWhsPrice = ''
9102 lcFrzTransRetailPrice = ''
9103 *=== TechRec 1078317 23-Jul-2014 TSV===
9104
9105 ENDIF
9106
9107 lcRetailPrice = goEnv.sv("CN_RETAIL_PRICE", "Retail Price")
9108
9109 SELECT (tcStyleCostDetailView)
9110 SCAN
9111
9112 lcCategory = SysGetFieldValue(tcStyleCostDetailView, 'category')
9113 llRetVal = SEEK(lcCategory, tcCurCatgr, 'category')
9114 lcCostType = SysGetFieldValue(tcCurCatgr, 'cost_type')
9115
9116 *--- TR 1072967 26-SEP-13 Venuk. Added UPPER(CN_HS_FIXEDAMOUNT) ===
9117 IF NOT INLIST(ALLTRIM(lcCostType), UPPER(CN_HS_LOOKUP), UPPER(CN_ER_LOOKUP), UPPER(CN_COMMISSION), UPPER(CN_HS_FIXEDAMOUNT))
9118 REPLACE category_cost WITH constant IN (tcStyleCostDetailView)
9119 ENDIF
9120
9121 lnCost = 0
9122
9123 IF NOT EMPTY(cmp_type) AND RTRIM(cmp_type) <> RSV_ALL
9124 lnCost = .getCostFromBom(tcStyleCostHeaderView, tcStyleCostDetailView, lcCurBOMHeader, cmp_type, bom_dutiable, lcCurrCode)
9125 REPLACE category_cost WITH lnCost IN (tcStyleCostDetailView)
9126 ENDIF
9127
9128 IF NOT EMPTY(cmp_type) AND RTRIM(cmp_type) == RSV_ALL
9129 lnCost = .getCostFromBom(tcStyleCostHeaderView, tcStyleCostDetailView, lcCurBOMHeader, cmp_type, bom_dutiable, lcCurrCode)
9130 REPLACE category_cost WITH lnCost IN (tcStyleCostDetailView)
9131 ENDIF
9132
9133 IF NOT EMPTY(formula)
9134 *--- TR 1072967 26-SEP-13 Venuk. Added UPPER(CN_HS_FIXEDAMOUNT) ===
9135 IF llRetVal AND NOT INLIST(ALLTRIM(lcCostType), ;
9136 UPPER(CN_HS_LOOKUP), UPPER(CN_ER_LOOKUP), UPPER(CN_COMMISSION), UPPER(CN_HS_FIXEDAMOUNT) )
9137 lnCost = .EvalCostFormula(tcStyleCostDetailView, formula, fkey, category, round_to, tlShowMessage, tlForceShowMsg)
9138 REPLACE category_cost WITH lncost IN (tcStyleCostDetailView)
9139 ENDIF
9140
9141 ENDIF
9142
9143 *--- TR 1072967 26-SEP-13 Venuk.
9144 *IF llRetVal AND lcCostType = UPPER(CN_HS_LOOKUP)
9145 lHsFixedAmount = (lcCostType = UPPER(CN_HS_FIXEDAMOUNT))
9146 IF llRetVal AND (lcCostType = UPPER(CN_HS_LOOKUP) OR lHsFixedAmount )
9147 *=== TR 1072967 26-SEP-13 Venuk.
9148 DO CASE
9149
9150 CASE NOT EMPTY(constant)
9151 lnHS_Base = constant
9152
9153 CASE NOT EMPTY(formula)
9154 lnHS_Base = .EvalCostFormula(tcStyleCostDetailView, formula, fkey, category, round_to, tlShowMessage, tlForceShowMsg)
9155
9156 OTHERWISE
9157 lnHS_Base = 0
9158
9159 ENDCASE
9160
9161 *--- TechRec 1014674 03-Jan-2006 GS ---
9162 *lnCost = .GetHSDuty(division, STYLE, color_code, lbl_code, DIMENSION, lnHS_Base,,contractor)
9163 local lcDesign_Num
9164 if Type (tcStyleCostHeaderView + ".Design_Num") = 'C'
9165 lcDesign_Num = SysGetFieldValue(tcStyleCostHeaderView, "DESIGN_NUM")
9166 else
9167 lcDesign_Num = ""
9168 endif
9169 *--- TR 1072967 26-SEP-13 Venuk. Added lHsFixedAmount ===
9170 lnCost = .getHSDuty(Division, Style, Color_Code, Lbl_Code, Dimension,;
9171 lnHS_Base, , Contractor, lcDesign_Num, ,lHsFixedAmount )
9172 *=== TechRec 1014674 03-Jan-2006 GS ===
9173 REPLACE Category_Cost WITH lnCost IN (tcStyleCostDetailView)
9174
9175 ENDIF
9176
9177 *--- TechRec 1058999 13-Apr-2012 jisingh ---
9178 IF llRetVal AND lcCostType = UPPER(.cCN_MULTI_ROYALTY)
9179 DO CASE
9180 CASE NOT EMPTY(constant)
9181 lnMRBase = constant
9182
9183 CASE NOT EMPTY(formula)
9184 lnMRBase = .EvalCostFormula(tcStyleCostDetailView, formula, fkey, category, round_to, tlShowMessage, tlForceShowMsg)
9185
9186 OTHERWISE
9187 lnMRBase = 0
9188 ENDCASE
9189 lnCost = .GetMultiRoyaltyDuty(division, style, color_code, lbl_code, dimension, lnMRBase)
9190 REPLACE Category_Cost WITH lnCost IN (tcStyleCostDetailView)
9191 ENDIF
9192 *=== TechRec 1058999 13-Apr-2012 jisingh ===
9193
9194 IF llRetVal AND lcCostType = UPPER(CN_COMMISSION)
9195
9196 DO CASE
9197
9198 CASE NOT EMPTY(constant)
9199 lnCommissionBase = constant
9200
9201 CASE NOT EMPTY(formula)
9202 lnCommissionBase = .EvalCostFormula(tcStyleCostDetailView, formula, fkey, category, round_to, tlShowMessage, tlForceShowMsg)
9203
9204 OTHERWISE
9205 lnCommissionBase = 0
9206
9207 ENDCASE
9208
9209 lnCost = .GetCommissionCost(lnCommissionBase,contractor,"")
9210 REPLACE category_cost WITH lncost IN (tcStyleCostDetailView)
9211
9212 ENDIF
9213
9214 IF llRetVal AND ALLTRIM(lcCostType) == UPPER(CN_ER_LOOKUP)
9215
9216 IF NOT EMPTY(constant)
9217 REPLACE category_cost WITH constant IN (tcStyleCostDetailView)
9218 ELSE
9219 lnExRate = vl_ExRate("","EXH_RATE")
9220
9221 IF EMPTY(lnExRate)
9222 lnExRate = 0
9223 ENDIF
9224
9225 REPLACE category_cost WITH lnExRate IN (tcStyleCostDetailView)
9226
9227 ENDIF
9228
9229 ENDIF
9230
9231 &&--- TechRec 1078317 24-Jul-2014 TSV added OR condition for lcFrzTransWhsPrice ===
9232 IF llRetVal AND ((lcCostType = UPPER(CN_WHOLESALE_PRICE) AND lcFreezWhs = "S") OR ;
9233 (lcCostType = .cTransWhsPrice AND lcFrzTransWhsPrice = 'S'))
9234
9235 DO CASE
9236
9237 CASE NOT EMPTY(formula)
9238 lnCost = .EvalCostFormula(tcStyleCostDetailView, formula, fkey, category, round_to, tlShowMessage, tlForceShowMsg)
9239 REPLACE category_cost WITH lnCost IN (tcStyleCostDetailView)
9240
9241 OTHERWISE
9242 lcStyleCurrency = vl_divsr(division, "Curr_Code")
9243 lnExchangeRate = GetExchangeRate(lcStyleCurrency, lcCurrCode)
9244 lnCost = vl_scold(lcDivision, "a_price",, lcStyle, lcColorCode, lcLblCode, lcDimension)
9245
9246 IF EMPTY(lnCost)
9247 lnCost = vl_Stylr(lcDivision,"a_price",,lcStyle)
9248 ENDIF
9249
9250 lnCost = IIF(EMPTY(lnCost), 0, lnCost*lnExchangeRate)
9251 REPLACE category_cost WITH lnCost, constant WITH lnCost IN (tcStyleCostDetailView)
9252 ENDCASE
9253
9254 ENDIF
9255
9256 &&--- TechRec 1078317 24-Jul-2014 TSV added OR condition for lcFrzTransStdCost ===
9257 IF llRetVal AND ((line_seq = 600 AND lcFreezStd = "S") OR ;
9258 (lcCostType = .cTransStdCost AND lcFrzTransStdCost = 'S'))
9259
9260 DO CASE
9261
9262 CASE NOT EMPTY(formula)
9263 lnCost = .EvalCostFormula(tcStyleCostDetailView, formula, fkey, category, round_to, tlShowMessage, tlForceShowMsg)
9264 REPLACE category_cost WITH lnCost IN (tcStyleCostDetailView)
9265
9266 OTHERWISE
9267 lcStyleCurrency = vl_divsr(division, "Curr_Code")
9268 lnExchangeRate = GetExchangeRate(lcStyleCurrency, lcCurrCode)
9269 lnCost = vl_scold(lcDivision, "std_cost",, lcStyle, lcColorCode, lcLblCode, lcDimension)
9270
9271 IF EMPTY(lnCost)
9272 lnCost = vl_Stylr(lcDivision, "std_cost",, lcStyle)
9273 ENDIF
9274
9275 lnCost = IIF(EMPTY(lnCost), 0, lnCost*lnExchangeRate)
9276 REPLACE category_cost WITH lnCost, constant WITH lnCost IN (tcStyleCostDetailView)
9277 ENDCASE
9278
9279 ENDIF
9280
9281 &&--- TechRec 1078317 24-Jul-2014 TSV added OR condition for lcFrzTransRetPrice ===
9282 IF llRetVal AND ((lcCostType = UPPER(lcRetailPrice) AND lcFreezRet = "S") OR ;
9283 (lcCostType = .cTransRetailPrice AND lcFrzTransRetailPrice = 'S'))
9284
9285 DO CASE
9286
9287 CASE NOT EMPTY(formula)
9288 lnCost = .EvalCostFormula(tcStyleCostDetailView, formula, fkey, category, round_to, tlShowMessage, tlForceShowMsg)
9289 REPLACE category_cost WITH lnCost IN (tcStyleCostDetailView)
9290
9291 OTHERWISE
9292 lcStyleCurrency = vl_divsr(division, "Curr_Code")
9293 lnExchangeRate = GetExchangeRate(lcStyleCurrency, lcCurrCode)
9294 lnCost = vl_scold(lcDevision, "ret_price",, lcStyle,lcColorCode, lcLblCode, lcDimension)
9295
9296 IF EMPTY(lnCost)
9297 lnCost = vl_Stylr(lcDivision, "ret_price",, lcStyle)
9298 ENDIF
9299
9300 lnCost = IIF(EMPTY(lnCost), 0, lnCost*lnExchangeRate)
9301 REPLACE category_cost WITH lnCost, constant WITH lnCost IN (tcStyleCostDetailView)
9302 ENDCASE
9303
9304 ENDIF
9305
9306 ENDSCAN
9307
9308 IF USED(lcCurBOMHeader)
9309 USE IN (lcCurBOMHeader)
9310 ENDIF
9311
9312 SELECT (lnSelect)
9313 RETURN llRetVal
9314 ENDWITH
9315
9316 ENDPROC
9317 *=== TR 1008559 25-Jan-2005 VSS/SHAN
9318
9319*======================================================================
9320
9321* ------------------------------------------------------------------
9322* O P T I M I Z E D R O U T I N E S (1003958) CB - May, 2004
9323* ==================================================================
9324
9325 PROCEDURE PrepBaseCursors
9326 LPARAMETERS poThermoObj
9327 * Brings zzdcatgr, zzxlocar, zzxlocar, zzxhsnor, and zzxsuomr for GetHSDuty(),
9328 * zzmagntr for GetCommissionCost()
9329 * down locally to replace vl's in scans and indexes.
9330 * These are assumed to be relatively small.
9331 LOCAL llRetVal, lnSelect, aTmpArray(1), lcPKeys, lcDivisions, lcStyles, lcColors, ;
9332 lcProd_Nums, lnSeconds, lnRecNo, llUpdateThermo
9333
9334 WITH THIS
9335 lnSeconds = SECONDS()
9336 IF .lEnableDebugging
9337 .oLog.LogMajorStage("Preparing cursors for local SEEKs.")
9338 ENDIF
9339
9340 llRetVal = true
9341 lnSelect = SELECT()
9342
9343 llUpdateThermo = TYPE('poThermoObj') = "O"
9344 IF llUpdateThermo
9345 poThermoObj.InitThermo(5)
9346 ENDIF
9347
9348 IF .lEnableDebugging
9349 .oLog.LogEntry("Preparing local reference tables and cursors...")
9350 ENDIF
9351
9352 *--- 1) Cost Category Reference:
9353 IF llUpdateThermo
9354 poThermoObj.UpdateThermoCaption(.GenerateRandomVerb() + " Cost Category Reference...")
9355 ENDIF
9356
9357 .cCatAlias = GetUniqueFileName()
9358 lcSQLString = "SELECT * FROM zzdcatgr"
9359 llRetVal = llRetVal AND v_SQLExec(lcSQLString, .cCatAlias)
9360 IF USED(.cCatAlias)
9361 SELECT (.cCatAlias)
9362 INDEX ON Category TAG Category
9363 ELSE
9364 llRetVal = .F.
9365 ENDIF
9366
9367 * --- 2) Location Reference:
9368 IF llUpdateThermo
9369 poThermoObj.AdvanceThermo(1)
9370 poThermoObj.UpdateThermoCaption(.GenerateRandomVerb() + " Location Reference...")
9371 ENDIF
9372
9373 .cLocAlias = GetUniqueFileName()
9374 lcSQLString = "SELECT * FROM zzxlocar WHERE Active_OK = 'Y'"
9375 llRetVal = llRetVal AND v_SQLExec(lcSQLString, .cLocAlias)
9376 IF USED(.cLocAlias)
9377 SELECT (.cLocAlias)
9378 INDEX ON Location TAG Location
9379 INDEX ON Location + Loc_Type TAG Loc_Type
9380 ELSE
9381 llRetVal = .F.
9382 ENDIF
9383
9384 * --- 3) Harmonize Sys No Reference:
9385 IF llUpdateThermo
9386 poThermoObj.AdvanceThermo(2)
9387 poThermoObj.UpdateThermoCaption(.GenerateRandomVerb() + " Harmonize Sys No. Reference...")
9388 ENDIF
9389
9390 .cHSNAlias = GetUniqueFileName()
9391 lcSQLString = "SELECT * FROM zzxhsnor"
9392 llRetVal = llRetVal AND v_SQLExec(lcSQLString, .cHSNAlias)
9393 IF USED(.cHSNAlias)
9394 SELECT (.cHSNAlias)
9395 INDEX ON HS_Num + Country TAG HS_Country
9396 INDEX ON HS_Num TAG HS_Num
9397 ELSE
9398 llRetVal = .F.
9399 ENDIF
9400
9401 * --- 4) Unit of Measurement Reference:
9402 IF llUpdateThermo
9403 poThermoObj.AdvanceThermo(3)
9404 poThermoObj.UpdateThermoCaption(.GenerateRandomVerb() + " Unit of Measurement Reference...")
9405 ENDIF
9406
9407 .cUOMAlias = GetUniqueFileName()
9408 lcSQLString = "SELECT h.UOM, d.UOM_Convert, d.UOM_Factor FROM zzxsuomr h JOIN zzxsuomd d ON h.pkey = d.fkey "
9409 llRetVal = llRetVal AND v_SQLExec(lcSQLString, .cUOMAlias)
9410 IF USED(.cUOMAlias)
9411 SELECT (.cUOMAlias)
9412 INDEX ON UOM + UOM_Convert TAG UOMConvert
9413 ENDIF
9414
9415 * --- 5) Agent Reference:
9416 IF llUpdateThermo
9417 poThermoObj.AdvanceThermo(4)
9418 poThermoObj.UpdateThermoCaption(.GenerateRandomVerb() + " Agent Reference...")
9419 ENDIF
9420
9421 .cAgnAlias = GetUniqueFileName()
9422 lcSQLString = "SELECT * FROM zzmagntr"
9423 llRetVal = llRetVal AND v_SQLExec(lcSQLString, .cAgnAlias)
9424 IF llRetVal AND USED(.cAgnAlias)
9425 SELECT (.cAgnAlias)
9426 INDEX ON Agent TAG Agent
9427 ENDIF
9428
9429 IF llUpdateThermo
9430 poThermoObj.AdvanceThermo(5)
9431 ENDIF
9432 ENDWITH
9433
9434 .cCstAlias = GetUniqueFileName()
9435 .cStyAlias = GetUniqueFileName()
9436 .cColAlias = GetUniqueFileName()
9437 .cDetAlias = GetUniqueFileName()
9438 .cHdrAlias = GetUniqueFileName()
9439
9440 RETURN llRetVal
9441 ENDPROC
9442
9443 PROCEDURE PrepDynamicCursors
9444 LPARAMETERS pcCostAlias, pcDetailAlias, pcHeaderAlias, poThermoObj, plCopyToLocalCursors
9445 * NEEDS TO BE CALLED BEFORE BEGINNING PROCESSING ON A LOCAL COST SHEET.
9446 * Puts all records from buffered Cost Sheet View into indexed cursor
9447 * upon which we'll do our calculations and write back at the end.
9448 * Opens Style, Color, Header, Detail Aliases for records involved.
9449 LOCAL llRetVal, lnSelect, aTmpArray(1), lcPKeys, lcDivisions, lcStyles, lcColors, ;
9450 lcProd_Nums, lnSeconds, lnRecNo, llUpdateThermo, lnLen
9451
9452 ASSERT NOT (pcHeaderAlias = "???") MESSAGE "Unknown scenario passed to PrepDynamicCursors()"
9453 WITH THIS
9454 lnSeconds = SECONDS()
9455 IF .lEnableDebugging
9456 .oLog.LogMajorStage("Preparing Cost, BOM, Style, Color, Header, Detail Aliases for local use.")
9457 ENDIF
9458
9459 llRetVal = true
9460 lnSelect = SELECT()
9461
9462 llUpdateThermo = TYPE('poThermoObj') = "O"
9463 IF llUpdateThermo
9464 poThermoObj.InitThermo(6)
9465 poThermoObj.UpdateThermoCaption(.GenerateRandomVerb() + " local Cost Sheet Cursor...")
9466 ENDIF
9467
9468 IF USED(pcCostAlias)
9469 SELECT (pcCostAlias)
9470 .PushRecordSet()
9471
9472 IF plCopyToLocalCursors
9473 AFIELDS("aTmpArray", pcCostAlias)
9474
9475 * Add a field for whether or not record has been modified (makes tableupdate() run faster).
9476 lnLen = ALEN(aTmpArray, 1) + 1
9477 IF VERSION(5) < 800
9478 DIMENSION aTmpArray(lnLen, 16)
9479 aTmpArray(lnLen, 1) = "Modified"
9480 aTmpArray(lnLen, 2) = "C"
9481 aTmpArray(lnLen, 3) = 1
9482 aTmpArray(lnLen, 4) = 0
9483 aTmpArray(lnLen, 5) = .F.
9484 aTmpArray(lnLen, 6) = .F.
9485 aTmpArray(lnLen, 7) = ""
9486 aTmpArray(lnLen, 8) = ""
9487 aTmpArray(lnLen, 9) = ""
9488 aTmpArray(lnLen, 10) = ""
9489 aTmpArray(lnLen, 11) = ""
9490 aTmpArray(lnLen, 12) = ""
9491 aTmpArray(lnLen, 13) = ""
9492 aTmpArray(lnLen, 14) = ""
9493 aTmpArray(lnLen, 15) = ""
9494 aTmpArray(lnLen, 16) = ""
9495 ELSE
9496 DIMENSION aTmpArray(lnLen, 18)
9497 aTmpArray(lnLen, 1) = "Modified"
9498 aTmpArray(lnLen, 2) = "C"
9499 aTmpArray(lnLen, 3) = 1
9500 aTmpArray(lnLen, 4) = 0
9501 aTmpArray(lnLen, 5) = .F.
9502 aTmpArray(lnLen, 6) = .F.
9503 aTmpArray(lnLen, 7) = ""
9504 aTmpArray(lnLen, 8) = ""
9505 aTmpArray(lnLen, 9) = ""
9506 aTmpArray(lnLen, 10) = ""
9507 aTmpArray(lnLen, 11) = ""
9508 aTmpArray(lnLen, 12) = ""
9509 aTmpArray(lnLen, 13) = ""
9510 aTmpArray(lnLen, 14) = ""
9511 aTmpArray(lnLen, 15) = ""
9512 aTmpArray(lnLen, 16) = ""
9513 aTmpArray(lnLen, 17) = 0
9514 aTmpArray(lnLen, 18) = 0
9515 ENDIF
9516
9517 CREATE CURSOR (.cCstAlias) FROM ARRAY aTmpArray
9518
9519 * Can't use APPEND FROM on buffered cursor - doesn't recognize changes...
9520 SELECT (pcCostAlias)
9521 SET FILTER TO
9522 SCAN
9523 SCATTER MEMVAR
9524 SELECT (.cCstAlias)
9525 APPEND BLANK
9526 GATHER MEMVAR
9527 ENDSCAN
9528 ELSE
9529 .cCstAlias = pcCostAlias
9530 ENDIF
9531
9532 SELECT (.cCstAlias)
9533 * NOTE: CatFKey must be FIRST INDEX for EvalCostFormula to utilize it:
9534 INDEX ON Category + STR(FKey) TAG CatFKey
9535
9536 INDEX ON PKey TAG PKey
9537 INDEX ON FKey FOR SysLevel = 0 TAG FKSysLvl
9538 INDEX ON STR(FKey) + STR(SysLevel) + Str(CostLevelPkey) TAG CostLevel
9539 INDEX ON Category + STR(FKey) + STR(SysLevel) + STR(CostLevelPkey) TAG CatCostLvl
9540 INDEX ON FKey TAG FKey
9541 SET ORDER TO TAG FKey && VERY IMPORTANT FOR SUB-ROUTINES. THEY SCAN IN THIS ORDER.
9542 SET RELATION TO Category INTO (.cCatAlias)
9543
9544 IF llUpdateThermo
9545 poThermoObj.AdvanceThermo(1)
9546 poThermoObj.UpdateThermoCaption(.GenerateRandomVerb() + " local Detail Cursor...")
9547 ENDIF
9548 .PopRecordSet()
9549 ELSE
9550 llRetVal = .F.
9551 ENDIF
9552
9553*!* * Because of the size of the following, we will scan detail alias,
9554*!* * building a list of the unique SKUs, then get only those records we need.
9555*!* * Don't want to pull all, as each one in PQA is taking anywhere from 2 to 7 seconds.
9556 IF USED(pcDetailAlias)
9557 IF .lEnableDebugging
9558 .oLog.LogEntry("Preparing to pull down Style Master, Color, Order Header and Detail...")
9559 ENDIF
9560
9561 SELECT (pcDetailAlias)
9562 .PushRecordSet()
9563
9564 IF plCopyToLocalCursors
9565 AFIELDS("aTmpArray", pcDetailAlias)
9566 * Add a field for whether or not record has been modified (makes tableupdate() run faster).
9567 lnLen = ALEN(aTmpArray, 1) + 1
9568 IF VERSION(5) < 800
9569 DIMENSION aTmpArray(lnLen, 16)
9570 aTmpArray(lnLen, 1) = "Modified"
9571 aTmpArray(lnLen, 2) = "C"
9572 aTmpArray(lnLen, 3) = 1
9573 aTmpArray(lnLen, 4) = 0
9574 aTmpArray(lnLen, 5) = .F.
9575 aTmpArray(lnLen, 6) = .F.
9576 aTmpArray(lnLen, 7) = ""
9577 aTmpArray(lnLen, 8) = ""
9578 aTmpArray(lnLen, 9) = ""
9579 aTmpArray(lnLen, 10) = ""
9580 aTmpArray(lnLen, 11) = ""
9581 aTmpArray(lnLen, 12) = ""
9582 aTmpArray(lnLen, 13) = ""
9583 aTmpArray(lnLen, 14) = ""
9584 aTmpArray(lnLen, 15) = ""
9585 aTmpArray(lnLen, 16) = ""
9586 ELSE
9587 DIMENSION aTmpArray(lnLen, 18)
9588 aTmpArray(lnLen, 1) = "Modified"
9589 aTmpArray(lnLen, 2) = "C"
9590 aTmpArray(lnLen, 3) = 1
9591 aTmpArray(lnLen, 4) = 0
9592 aTmpArray(lnLen, 5) = .F.
9593 aTmpArray(lnLen, 6) = .F.
9594 aTmpArray(lnLen, 7) = ""
9595 aTmpArray(lnLen, 8) = ""
9596 aTmpArray(lnLen, 9) = ""
9597 aTmpArray(lnLen, 10) = ""
9598 aTmpArray(lnLen, 11) = ""
9599 aTmpArray(lnLen, 12) = ""
9600 aTmpArray(lnLen, 13) = ""
9601 aTmpArray(lnLen, 14) = ""
9602 aTmpArray(lnLen, 15) = ""
9603 aTmpArray(lnLen, 16) = ""
9604 aTmpArray(lnLen, 17) = 0
9605 aTmpArray(lnLen, 18) = 0
9606 ENDIF
9607
9608 CREATE CURSOR (.cDetAlias) FROM ARRAY aTmpArray
9609
9610 SELECT (pcDetailAlias)
9611 SET FILTER TO
9612 SCAN
9613 SCATTER MEMVAR
9614 SELECT (.cDetAlias)
9615 APPEND BLANK
9616 GATHER MEMVAR
9617 ENDSCAN
9618 ELSE
9619 .cDetAlias = pcDetailAlias
9620 ENDIF
9621
9622 SELECT (.cDetAlias)
9623 INDEX ON PKey TAG PKey
9624 INDEX ON STR(Prod_Num) + STR(Open_Seq) TAG Prod_Seq
9625
9626 .PopRecordSet()
9627
9628 IF llUpdateThermo
9629 poThermoObj.AdvanceThermo(2)
9630 poThermoObj.UpdateThermoCaption(.GenerateRandomVerb() + " Detail Alias.")
9631 ENDIF
9632 ELSE
9633 llRetVal = .F.
9634 ENDIF
9635
9636 lcPKeys = ""
9637 lcProd_Nums = ""
9638 lcDivisions = ""
9639 lcStyles = ""
9640 lcColors = ""
9641*--- TAN 1029485 12/28/2007 AZ
9642* lnRecNo = RECNO()
9643 lnRecNo = IIF(!EOF(),RECNO(),-1) && 1029485
9644*=== TAN 1029485 12/28/2007 AZ
9645 SCAN
9646 lcPKeys = lcPKeys + IIF(EMPTY(lcPKeys), "", ", ") + SQLFormatNum(PKey)
9647
9648 IF NOT INLIST(lcProd_Nums, ALLTRIM(STR(Prod_Num)))
9649 lcProd_Nums = lcProd_Nums + IIF(EMPTY(lcProd_Nums), "", ", ") + SQLFormatNum(Prod_Num)
9650 ENDIF
9651
9652 IF NOT INLIST(lcDivisions, ALLTRIM(Division))
9653 lcDivisions = lcDivisions + IIF(EMPTY(lcDivisions), "", ", ") + SQLFormatChar(Division)
9654 ENDIF
9655
9656 IF NOT INLIST(lcStyles, ALLTRIM(Style))
9657 lcStyles = lcStyles + IIF(EMPTY(lcStyles), "", ", ") + SQLFormatChar(Style)
9658 ENDIF
9659
9660 IF NOT INLIST(lcColors, ALLTRIM(Color_Code))
9661 lcColors = lcColors + IIF(EMPTY(lcColors), "", ", ") + SQLFormatChar(Color_Code)
9662 ENDIF
9663 ENDSCAN
9664
9665*--- TAN 1029485 12/28/2007 AZ
9666 IF lnRecno > 0
9667 GOTO lnRecNo
9668 ENDIF
9669*=== TAN 1029485 12/28/2007 AZ
9670
9671 GO TOP IN (.cDetAlias)
9672
9673 IF llUpdateThermo
9674 poThermoObj.AdvanceThermo(3)
9675 poThermoObj.UpdateThermoCaption(.GenerateRandomVerb() + " Color cursor.")
9676 ENDIF
9677
9678 IF THIS.lEnableDebugging
9679 THIS.oLog.LogEntry("Pulling down Style Master, Order Header and Detail...")
9680 ENDIF
9681
9682 * Now we have all the info necessary to pull the data for our local lookups.
9683 * ZZXSCOLR:
9684 lcSQLString = "SELECT * FROM zzxscolr WHERE " + IIF(NOT EMPTY(lcDivisions), "Division IN (" + ;
9685 lcDivisions + ") AND ", "") + IIF(NOT EMPTY(lcStyles), "Style IN (" + ;
9686 lcStyles + ") AND ", "") + IIF(NOT EMPTY(lcColors), "Color_Code IN (" + ;
9687 lcColors + ")", "")
9688
9689 IF RIGHT(lcSQLString, 4) = "AND "
9690 lcSQLString = LEFT(lcSQLString, LEN(lcSQLString) - 4)
9691 ENDIF
9692
9693 IF RIGHT(lcSQLString, 6) = "WHERE "
9694 lcSQLString = LEFT(lcSQLString, LEN(lcSQLString) - 6)
9695 ENDIF
9696
9697 llRetVal = llRetVal AND v_SQLExec(lcSQLString, .cColAlias)
9698 IF USED(.cColAlias)
9699 SELECT (.cColAlias)
9700 INDEX ON Division + Style + Color_Code + Lbl_Code + Dimension TAG SKU
9701 ELSE
9702 llRetVal = .F.
9703 ENDIF
9704
9705 IF llUpdateThermo
9706 poThermoObj.AdvanceThermo(4)
9707 poThermoObj.UpdateThermoCaption(.GenerateRandomVerb() + " Style Master Reference...")
9708 ENDIF
9709
9710 * ZZXSTYLR:
9711 lcSQLString = "SELECT * FROM zzxstylr WHERE " + IIF(NOT EMPTY(lcDivisions), "Division IN (" + ;
9712 lcDivisions + ") AND ", "") + IIF(NOT EMPTY(lcStyles), "Style IN (" + ;
9713 lcStyles + ")", "")
9714
9715 IF RIGHT(lcSQLString, 4) = "AND "
9716 lcSQLString = LEFT(lcSQLString, LEN(lcSQLString) - 4)
9717 ENDIF
9718
9719 IF RIGHT(lcSQLString, 6) = "WHERE "
9720 lcSQLString = LEFT(lcSQLString, LEN(lcSQLString) - 6)
9721 ENDIF
9722
9723 llRetVal = llRetVal AND v_SQLExec(lcSQLString, .cStyAlias)
9724 IF USED(.cStyAlias)
9725 SELECT (.cStyAlias)
9726 INDEX ON Division + Style TAG SKU
9727 ELSE
9728 llRetVal = .F.
9729 ENDIF
9730
9731 IF llUpdateThermo
9732 poThermoObj.AdvanceThermo(5)
9733*!* poThermoObj.UpdateThermoCaption(.GenerateRandomVerb() + " local order detail cursor...")
9734 ENDIF
9735
9736*!* * ZZCORDRD:
9737*!* * This seems kinda redundant to me, but not changing functionality:
9738*!* lcSQLString = "SELECT * FROM zzcordrd WHERE " + IIF(NOT EMPTY(lcPKeys), "PKey IN (" + ;
9739*!* lcPKeys + ")", "")
9740
9741*!* IF RIGHT(lcSQLString, 6) = "WHERE "
9742*!* lcSQLString = LEFT(lcSQLString, LEN(lcSQLString) - 6)
9743*!* ENDIF
9744*!*
9745*!* llRetVal = llRetVal AND v_SQLExec(lcSQLString, "tc_zzcordrd")
9746*!* IF llRetVal AND USED("tc_zzcordrd")
9747*!* SELECT tc_zzcordrd
9748*!* INDEX ON PKey TAG PKey
9749*!* INDEX ON STR(Prod_Num) + STR(Open_Seq) TAG Prod_Seq
9750*!* ENDIF
9751
9752*!* IF llUpdateThermo
9753*!* poThermoObj.AdvanceThermo(9)
9754*!* poThermoObj.UpdateThermoCaption(.GenerateRandomVerb() + " local order header cursor...")
9755*!* ENDIF
9756
9757*!* * ZZCORDRH:
9758*!* lcSQLString = "SELECT * FROM zzcordrh WHERE " + IIF(NOT EMPTY(lcProd_Nums), "Prod_Num IN (" + ;
9759*!* lcProd_Nums + ")", "")
9760
9761*!* IF RIGHT(lcSQLString, 6) = "WHERE "
9762*!* lcSQLString = LEFT(lcSQLString, LEN(lcSQLString) - 6)
9763*!* ENDIF
9764*!*
9765*!* llRetVal = llRetVal AND v_SQLExec(lcSQLString, "tc_zzcordrh")
9766*!* IF llRetVal AND USED("tc_zzcordrh")
9767*!* SELECT tc_zzcordrh
9768*!* INDEX ON Prod_Num TAG Prod_Num
9769*!* ENDIF
9770
9771*!* IF llUpdateThermo
9772*!* poThermoObj.AdvanceThermo(10)
9773*!* poThermoObj.UpdateThermoCaption("Done preparing local cursors.")
9774*!* ENDIF
9775
9776 IF USED(pcHeaderAlias)
9777 SELECT (pcHeaderAlias)
9778 .PushRecordSet()
9779
9780 IF plCopyToLocalCursors
9781 AFIELDS("aTmpArray", pcHeaderAlias)
9782 CREATE CURSOR (.cHdrAlias) FROM ARRAY aTmpArray
9783
9784 SELECT (pcHeaderAlias)
9785 SCAN
9786 SCATTER MEMVAR
9787 SELECT (.cHdrAlias)
9788 APPEND BLANK
9789 GATHER MEMVAR
9790 ENDSCAN
9791 ELSE
9792 .cHdrAlias = pcHeaderAlias
9793 ENDIF
9794
9795 SELECT (.cHdrAlias)
9796 INDEX ON Prod_Num TAG Prod_Num
9797
9798 IF llUpdateThermo
9799 poThermoObj.AdvanceThermo(6)
9800 poThermoObj.UpdateThermoCaption("Done.")
9801 ENDIF
9802 .PopRecordSet()
9803 ELSE
9804 llRetVal = .F.
9805 ENDIF
9806
9807 IF THIS.lEnableDebugging
9808 THIS.oLog.LogEntry("Done. Total time to Prep Cursors: " + ALLTRIM(STR(SECONDS() - lnSeconds)) + " seconds.")
9809 ENDIF
9810
9811 .lDynamicsPrepped = .T. && Enable cost functions to use new versions.
9812 ENDWITH
9813
9814 SELECT (lnSelect)
9815 RETURN llRetVal
9816 ENDPROC
9817
9818*============================================================
9819
9820 PROCEDURE GenerateRandomVerb
9821 LOCAL laVerbs(1), lnNum, lnCount
9822 lnCount = 33
9823 DIMENSION laVerbs(lnCount)
9824 laVerbs( 1) = "Cogitating the"
9825 laVerbs( 2) = "Contemplating the"
9826 laVerbs( 3) = "Pulling the"
9827 laVerbs( 4) = "Yanking the"
9828 laVerbs( 5) = "Preparing the"
9829 laVerbs( 6) = "Customizing the"
9830 laVerbs( 7) = "Creating the"
9831 laVerbs( 8) = "Identifying the"
9832 laVerbs( 9) = "Generating the"
9833 laVerbs(10) = "Yelling at the"
9834 laVerbs(11) = "Popping the"
9835 laVerbs(12) = "Analyzing the"
9836 laVerbs(13) = "Calculating the"
9837 laVerbs(14) = "Clarifying the"
9838 laVerbs(15) = "Poking at the"
9839 laVerbs(16) = "Qualifying the"
9840 laVerbs(17) = "Philosophizing the nature of the"
9841 laVerbs(18) = "Evaluating the"
9842 laVerbs(19) = "Harmonizing the"
9843 laVerbs(20) = "Requesting the"
9844 laVerbs(21) = "Theorizing the"
9845 laVerbs(22) = "Subdividing the"
9846 laVerbs(23) = "Legitimizing the"
9847 laVerbs(24) = "Classifying the"
9848 laVerbs(25) = "Defining the"
9849 laVerbs(26) = "Coalescing the"
9850 laVerbs(27) = "Getting in touch with the"
9851 laVerbs(28) = "Simulating the"
9852 laVerbs(29) = "Irritating the"
9853 laVerbs(30) = "Organizing the"
9854 laVerbs(31) = "Quantifying the"
9855 laVerbs(32) = "Pontificating the"
9856 laVerbs(33) = "Waxing intellectually about the"
9857
9858 lnNum = 0
9859 DO WHILE NOT BETWEEN(lnNum, 1, lnCount)
9860 lnNum = RAND() * lnCount
9861 ENDDO
9862
9863 RETURN laVerbs(lnNum)
9864 ENDPROC
9865
9866 PROCEDURE CloseBaseCursors
9867 LOCAL llRetVal, lnSelect, lnSeconds
9868
9869 llRetVal = true
9870 lnSelect = SELECT()
9871 lnSeconds = SECONDS()
9872
9873 WITH THIS
9874 IF .lEnableDebugging
9875 .oLog.LogMajorStage("Closing base cursors.")
9876 ENDIF
9877
9878 * Close all the danged cursors created at the beginning:
9879 USE IN SELECT(.cCatAlias)
9880 USE IN SELECT(.cLocAlias)
9881 USE IN SELECT(.cHSNAlias)
9882 USE IN SELECT(.cUOMAlias)
9883 USE IN SELECT(.cAgnAlias)
9884
9885 * These are already closed in CloseDynamicCursors, but doesn't
9886 * hurt to be too careful:
9887 USE IN SELECT(.cCstAlias)
9888 USE IN SELECT(.cStyAlias)
9889 USE IN SELECT(.cColAlias)
9890 USE IN SELECT(.cDetAlias)
9891 USE IN SELECT(.cHdrAlias)
9892 ENDWITH
9893
9894 SELECT (lnSelect)
9895 RETURN llRetVal
9896 ENDPROC
9897
9898 PROCEDURE CloseDynamicCursors
9899 LOCAL llRetVal, lnSelect, lnSeconds
9900
9901 llRetVal = true
9902 lnSelect = SELECT()
9903 lnSeconds = SECONDS()
9904
9905 WITH THIS
9906 IF .lEnableDebugging
9907 .oLog.LogMajorStage("Closing dynamic cursors.")
9908 ENDIF
9909
9910 * Close all the danged cursors created at the beginning:
9911 USE IN SELECT(.cCstAlias)
9912 USE IN SELECT(.cStyAlias)
9913 USE IN SELECT(.cColAlias)
9914 USE IN SELECT(.cDetAlias)
9915 USE IN SELECT(.cHdrAlias)
9916
9917 .lDynamicsPrepped = .F. && Toggle back to require preparation for next run.
9918 ENDWITH
9919
9920 SELECT (lnSelect)
9921 RETURN llRetVal
9922 ENDPROC
9923
9924 PROCEDURE IndexBOMAndCost
9925 PARAMETERS pcBOMAlias, pcCostAlias
9926 LOCAL llRetVal, lnBuffer
9927
9928 pcBOMAlias = IIF(EMPTY(pcBOMAlias), IIF(USED("Vzzcbommd"), "Vzzcbommd", "Vzzcbommd_Tree"), pcBOMAlias)
9929 pcCostAlias = IIF(EMPTY(pcCostAlias), THIS.cCstAlias, pcCostAlias)
9930
9931 IF USED(pcBOMAlias)
9932 SELECT (pcBOMAlias)
9933 IF CURSORGETPROP('SourceType', pcBOMAlias) = DB_SRCREMOTEVIEW && Remote view
9934 lnBuffer = CURSORGETPROP('Buffering', pcBOMAlias)
9935 llRetVal = CURSORSETPROP("BUFFER", DB_BUFOPTRECORD, pcBOMAlias)
9936 ENDIF
9937 INDEX ON Division + Style + Color_Code + Lbl_Code + Dimension + ;
9938 Prod_Type TAG SKUTypCntr
9939 INDEX ON STR(FKey) + STR(SysLevel) + STR(Master_PKey) TAG BOMMstPkey
9940 INDEX ON STR(FKey) + STR(Line_Seq) TAG FKeySeq
9941 SET ORDER TO FKeySeq
9942
9943 IF CURSORGETPROP('SourceType', pcBOMAlias) = DB_SRCREMOTEVIEW && Remote view
9944 llRetVal = llRetVal AND CURSORSETPROP("BUFFER", lnBuffer, pcBOMAlias)
9945 ENDIF
9946 ENDIF
9947
9948 IF USED(pcCostAlias)
9949 SELECT (pcCostAlias)
9950 IF CURSORGETPROP('SourceType', pcCostAlias) = DB_SRCREMOTEVIEW && Remote view
9951 lnBuffer = CURSORGETPROP('Buffering', pcCostAlias)
9952 llRetVal = llRetVal AND CURSORSETPROP("BUFFER",DB_BUFOPTRECORD,pcCostAlias)
9953 ENDIF
9954 INDEX ON STR(SysLevel) + Category TAG CostCatg
9955 INDEX ON STR(FKey) + STR(SysLevel) + Str(CostLevelPkey) TAG CostLevel
9956 INDEX ON FKey FOR SysLevel > 0 TAG CostLevel2 && --- 1003958 CB Optimized costing
9957 INDEX ON Category + STR(FKey) + STR(SysLevel) + STR(CostLevelPkey) TAG CatCostLvl
9958 INDEX ON FKey FOR SysLevel = 0 TAG FKSysLvl
9959 INDEX ON FKey TAG FKey
9960 SET ORDER TO TAG FKey
9961
9962 IF CURSORGETPROP('SourceType', pcCostAlias) = DB_SRCREMOTEVIEW && Remote view
9963 llRetVal = llRetVal AND CURSORSETPROP("BUFFER", lnBuffer, pcCostAlias)
9964 ENDIF
9965 ENDIF
9966
9967 RETURN llRetVal
9968 ENDPROC
9969
9970 PROCEDURE WriteBackToRealViews
9971 LPARAMETERS pcCostSheetView, pcDetailView, poThermoObj, plSkipTimeStamp
9972 LOCAL llRetVal, lnSelect, lnSeconds, llUpdateThermo, i, lcUser_ID, ltLast_Mod
9973
9974 llRetVal = true
9975 lnSelect = SELECT()
9976 lnSeconds = SECONDS()
9977 i = 0
9978 llUpdateThermo = TYPE('poThermoObj') = "O"
9979 lcUser_ID = goEnv.EnvLogin.cUserName
9980 ltLast_Mod = DATETIME()
9981 plSkipTimeStamp = IIF(EMPTY(plSkipTimeStamp), .F., plSkipTimeStamp)
9982
9983 IF llUpdateThermo
9984 poThermoObj.InitThermo(RECCOUNT(pcCostSheetView) + RECCOUNT(pcDetailView))
9985 poThermoObj.UpdateThermoCaption("Writing back to Cost Sheet...")
9986 ENDIF
9987
9988 IF THIS.lEnableDebugging
9989 THIS.oLog.LogMajorStage("Writing records back to Cost Sheet and Order Detail.")
9990 ENDIF
9991
9992 WITH THIS
9993 SELECT (pcCostSheetView)
9994 SCAN
9995 lnPKey = PKey
9996 SELECT (.cCstAlias)
9997 IF SEEK(lnPKey, .cCstAlias, 'PKey')
9998 IF Modified = "Y" && For faster TableUpdate(), only modify record if value has changed.
9999 SCATTER MEMVAR
10000 IF NOT plSkipTimeStamp
10001 m.User_ID = lcUser_ID
10002 m.Last_Mod = ltLast_Mod
10003 ENDIF
10004 SELECT (pcCostSheetView)
10005 GATHER MEMVAR
10006 ENDIF
10007 ELSE
10008 ASSERT .F. MESSAGE "Record not found in local Cost Sheet Cursor!!!"
10009 ENDIF
10010
10011 IF llUpdateThermo
10012 i = i + 1
10013 poThermoObj.AdvanceThermo(i)
10014 ENDIF
10015 ENDSCAN
10016
10017 IF llUpdateThermo
10018 poThermoObj.UpdateThermoCaption("Writing back to Order Detail...")
10019 ENDIF
10020
10021 SELECT (pcDetailView)
10022 SCAN
10023 lnPKey = PKey
10024 SELECT (.cDetAlias)
10025 IF SEEK(lnPKey, .cDetAlias, 'PKey')
10026 IF Modified = "Y" && For faster TableUpdate(), only modify record if value has changed.
10027 SCATTER MEMVAR
10028 IF plSkipTimeStamp
10029 m.User_ID = lcUser_ID
10030 m.Last_Mod = ltLast_Mod
10031 ENDIF
10032 SELECT (pcDetailView)
10033 GATHER MEMVAR
10034 ENDIF
10035 ELSE
10036 ASSERT .F. MESSAGE "Record not found in local Detail Cursor!!!"
10037 ENDIF
10038
10039 IF llUpdateThermo
10040 i = i + 1
10041 poThermoObj.AdvanceThermo(i)
10042 ENDIF
10043 ENDSCAN
10044
10045 IF .lEnableDebugging
10046 .oLog.LogEntry("Done. Total time to write back to Cost Sheet: " + ALLTRIM(STR(SECONDS() - lnSeconds)) + " seconds.")
10047 ENDIF
10048 ENDWITH
10049
10050 SELECT (lnSelect)
10051 RETURN llRetVal
10052 ENDPROC
10053
10054 PROCEDURE CostFromConstant_2
10055 LPARAMETER pcCostAlias, pnPODtlPkey, pnQty, paCost
10056 LOCAL lnExtension, llSomethingChanged
10057
10058 llSomethingChanged = .F.
10059
10060 THIS.pushRecordSet()
10061 SELECT (THIS.cCstAlias)
10062 THIS.pushRecordSet()
10063
10064 SEEK pnPODtlPkey
10065 SCAN WHILE FKey = pnPODtlPkey
10066
10067 *--- TR 1038235 9-FEB-2009 VKK
10068 IF VARTYPE(prv_cost_updt) = "C" AND prv_cost_updt = "Y"
10069 LOOP
10070 ENDIF
10071 *=== TR 1038235 9-FEB-2009 VKK
10072
10073 IF !EMPTY(constant) && constant.
10074 IF AP_Cost <> "Y"
10075 IF Imp_Cost <> "Y" OR Extension = 0
10076 lnCost = Constant
10077 REPLACE ;
10078 Category_Cost WITH Constant, ;
10079 Extension WITH Constant * pnQty, ;
10080 Estm_Ext_Cost WITH IIF(Imp_Cost = "Y", Estm_Ext_Cost, Constant * pnQty), ;
10081 Modified WITH "Y"
10082 llSomethingChanged = .T.
10083 ENDIF
10084 ENDIF
10085 ENDIF
10086*--- TechRec 1067706 28-Mar-2013 AZhadanov ---
10087 LOCAL ix,nlevel
10088 IF AP_Cost = 'Y'
10089 nlevel = PROGRAM(-1)
10090 FOR ix = nlevel TO 1 STEP -1
10091 IF ATC("APPROVEVOUCHER",PROGRAM(ix)) > 0 OR ATC("PRORATEPRODUCTIONTREES",PROGRAM(ix)) > 0
10092 EXIT
10093 ENDIF
10094 NEXT
10095 IF ix <= 1
10096 This.Set_AP_Cost(@pcCostAlias,tcProdCnclDtl)
10097 ENDIF
10098 LOOP
10099 ENDIF
10100*=== TechRec 1067706 28-Mar-2013 AZhadanov ===
10101
10102
10103 ENDSCAN
10104
10105 THIS.popRecordSet()
10106 THIS.popRecordSet()
10107 RETURN llSomethingChanged
10108 ENDPROC
10109
10110 PROCEDURE CostOfHSLookUp_2
10111 LPARAMETER pcCostAlias, pnPODtlPkey, pnQty, plHsFixedAmount
10112 *--- TR 1072967 26-SEP-13 Venuk. Added plHsFixedAmountparameter ====
10113
10114 LOCAL lnCost, lnExtension, lnHS_Base, lnSelect, llSomethingChanged
10115
10116 llSomethingChanged = .F.
10117
10118 *--- TR 1059112 09/22/11 AZ
10119 Local lnExtensionEstm, oCostEstm
10120 oCostEstm = CreateObject("CostEstm", .NULL.)
10121 *=== TR 1059112 09/22/11 AZ
10122
10123
10124 lnSelect = SELECT()
10125 SELECT (THIS.cCstAlias)
10126 SEEK pnPODtlPkey
10127 SCAN WHILE FKey = pnPODtlPkey
10128
10129 *--- TR 1038235 9-FEB-2009 VKK
10130 IF VARTYPE(prv_cost_updt) = "C" AND prv_cost_updt = "Y"
10131 LOOP
10132 ENDIF
10133 *=== TR 1038235 9-FEB-2009 VKK
10134
10135 *--- TR 1059112 09/22/11 AZ
10136 oCostEstm.nQty = pnQty
10137 *=== TR 1059112 09/22/11 AZ
10138 IF FOUND(THIS.cCatAlias)
10139 SELECT(THIS.cCatAlias)
10140 *-- TR 1072967 26-SEP-13 Venuk
10141 *IF Cost_Type = This.cCN_HS_LOOKUP
10142 IF ((Cost_Type = This.cCN_HS_LOOKUP AND !plHsFixedAmount) ;
10143 OR (Cost_Type = This.cCN_HS_FIXEDAMOUNT AND plHsFixedAmount))
10144 *=== TR 1072967 26-SEP-13 Venuk
10145
10146 SELECT(THIS.cCstAlias)
10147 IF AP_Cost <> 'Y'
10148 SELECT (THIS.cCstAlias)
10149 DO CASE
10150 CASE !EMPTY(constant)
10151 lnHS_Base = constant
10152 CASE !EMPTY(formula)
10153 *--- TR 1059112 09/22/11 AZ
10154* lnHS_Base = THIS.EvalCostFormula(.cCstAlias, formula, pnPodtlPkey, category, round_to)
10155 lnHS_Base = THIS.EvalCostFormula(.cCstAlias, formula, pnPodtlPkey, category, round_to,,,oCostEstm)
10156 lnExtension = lnHS_Base * pnqty && restore extension after round to.
10157 lnExtensionEstm = oCostEstm.nCostEstm * pnQty && restore esimate extension after round to.
10158 oCostEstm.nQty = .NULL.
10159 *=== TR 1059112 09/22/11 AZ
10160 OTHER
10161 lnHS_Base = 0
10162 ENDCASE
10163
10164 *--- TR 1072967 26-SEP-13 Venuk. Added empty param and plHsFixedAmount
10165 lnCost = THIS.getHSDuty_2(Division, Style, Color_Code, ;
10166 Lbl_Code, Dimension, lnHS_Base, pnPodtlPkey, ,plHsFixedAmount )
10167
10168 *--- 1032759 04/22/2008 SKG
10169*!* lnCost = ROUND(lnCost, Round_To)
10170 lnCost = ROUND(lnCost, 5)
10171 *--- 1032759 04/22/2008 SKG
10172 lnExtension = lnCost * pnQty
10173
10174*--- TechRec 1059112 16-Aug-2012 AZhadanov ---
10175* REPLACE ;
10176* Category_Cost WITH lnCost, ;
10177* Extension WITH lnExtension, ;
10178* Estm_Ext_Cost WITH IIF(Imp_Cost <> 'Y', lnExtension, Estm_Ext_Cost), ;
10179* Modified WITH "Y"
10180
10181 REPLACE ;
10182 Category_Cost WITH lnCost, ;
10183 Extension WITH lnExtension, ;
10184 Estm_Ext_Cost WITH Estm_Ext_Cost, ;
10185 Modified WITH "Y"
10186*=== TechRec 1059112 16-Aug-2012 AZhadanov ===
10187
10188 llSomethingChanged = .T.
10189 ENDIF
10190 ENDIF
10191 ENDIF
10192 ENDSCAN
10193
10194 SELECT(lnSelect)
10195 RETURN llSomethingChanged
10196 ENDPROC
10197
10198 PROCEDURE CostOfCommission_2
10199 LPARAMETER tcCostAlias, tnPodtlPkey, tnqty, tcAgent
10200 LOCAL lnCost, lnExtension, lnCommissionBase, llSomethingChanged,lnSelect &&& 1059112 AZ
10201
10202 llSomethingChanged = .F.
10203
10204 lnSelect = SELECT() &&& 1059112 AZ
10205 *--- TR 1059112 09/22/11 AZ
10206 Local lnExtensionEstm, oCostEstm
10207 oCostEstm = CreateObject("CostEstm", .NULL.)
10208 *=== TR 1059112 09/22/11 AZ
10209
10210
10211 SELECT (THIS.cCstAlias)
10212 =SEEK(tnPodtlPkey, THIS.cCstAlias, 'FKey')
10213 SCAN WHILE FKey = tnPodtlPkey
10214 *--- TR 1038235 9-FEB-2009 VKK
10215 IF VARTYPE(prv_cost_updt) = "C" AND prv_cost_updt = "Y"
10216 LOOP
10217 ENDIF
10218 *=== TR 1038235 9-FEB-2009 VKK
10219
10220 *--- TR 1059112 09/22/11 AZ
10221 oCostEstm.nQty = tnqty
10222 *=== TR 1059112 09/22/11 AZ
10223
10224
10225 IF FOUND(THIS.cCatAlias)
10226 SELECT(THIS.cCatAlias)
10227 IF Cost_Type = THIS.cCN_COMMISSION
10228 SELECT (THIS.cCstAlias)
10229 IF AP_Cost <> 'Y'
10230 DO CASE
10231 CASE !EMPTY(Constant)
10232 lnCommissionBase = constant
10233 CASE !EMPTY(Formula)
10234 *--- TechRec 1059112 16-Aug-2012 AZhadanov ---
10235* lnCommissionBase = THIS.evalCostFormula(tcCostAlias, formula, tnPodtlPkey, category, round_to)
10236 lnCommissionBase = THIS.EvalCostFormula(THIS.cCstAlias, Formula, tnPodtlPkey, Category, Round_To,,,oCostEstm)
10237 oCostEstm.nQty = .NULL.
10238 *=== TechRec 1059112 16-Aug-2012 AZhadanov ===
10239 OTHERWISE
10240 lnCommissionBase = 0
10241 ENDCASE
10242
10243 lnCost = THIS.GetCommissionCost_2(lnCommissionBase, Contractor, tcAgent)
10244 lnExtension = lnCost * tnQty
10245
10246 *--- TR 1059112 09/22/11 AZ
10247 lnCost_estm = THIS.GetCommissionCost_2(oCostEstm.nCostEstm, Contractor, tcAgent)
10248 lnExtensionEstm = lnCost_estm * tnQty
10249 *=== TR 1059112 09/22/11 AZ
10250
10251
10252 *--- TR 1059112 09/22/11 AZ
10253* REPLACE ;
10254* Category_Cost WITH lnCost, ;
10255* Extension WITH lnExtension, ;
10256* Estm_Ext_Cost WITH IIF(Imp_Cost <> 'Y', lnExtension, Estm_Ext_Cost), ;
10257* Modified WITH "Y"
10258
10259 REPLACE ;
10260 Category_Cost WITH lnCost, ;
10261 Extension WITH lnExtension, ;
10262 Estm_Ext_Cost WITH lnExtensionEstm , ;
10263 Modified WITH "Y"
10264
10265 *=== TR 1059112 09/22/11 AZ
10266
10267 llSomethingChanged = .T.
10268 ENDIF
10269 ENDIF
10270 ENDIF
10271 ENDSCAN
10272 SELECT(lnSelect) &&& 1059112 AZ
10273 RETURN llSomethingChanged
10274 ENDPROC
10275
10276 PROCEDURE CostByFormula_2
10277 LPARAMETER pcCostAlias, pnPODtlPkey, pnQty, plSkipDuty
10278 LOCAL lnCost, lnExtension, lcProd, lcHSDuty, lnProdCost, llRetVal, ;
10279 lnHSLookupRec, lnDutyRec, lnTotalCostRec, lnHsLookupAmount, lnExRate, llSomethingChanged,lnSelect &&& 1059112 AZ
10280
10281 llSomethingChanged = .F.
10282 lnHsLookupAmount = 0
10283 plSkipDuty = IIF(EMPTY(plSkipDuty), false, plSkipDuty)
10284
10285 lnSelect = SELECT() &&& 1059112 AZ
10286 *--- TR 1055652 09/22/11 AZ
10287 Local lnExtensionEstm, oCostEstm
10288 oCostEstm = CreateObject("CostEstm", .NULL.)
10289 *=== TR 1055652 09/22/11 AZ
10290
10291
10292 *--- TR 1055652 09/22/11 AZ
10293 Local lnExtensionEstm, oCostEstm
10294 oCostEstm = CreateObject("CostEstm", .NULL.)
10295 *=== TR 1055652 09/22/11 AZ
10296
10297 SELECT (THIS.cCstAlias)
10298 SEEK pnPODtlPkey
10299 SCAN WHILE FKey = pnPODtlPkey
10300
10301 *--- TR 1038235 9-FEB-2009 VKK
10302 IF VARTYPE(prv_cost_updt) = "C" AND prv_cost_updt = "Y"
10303 LOOP
10304 ENDIF
10305 *=== TR 1038235 9-FEB-2009 VKK
10306
10307 llRetVal = FOUND(THIS.cCatAlias)
10308 IF llRetVal AND EMPTY(Formula)
10309 SELECT(THIS.cCatAlias)
10310 IF Cost_Type = THIS.cCN_ER_LOOKUP
10311 SELECT(THIS.cCstAlias)
10312 lnExRate = vl_ExRate("","EXH_RATE")
10313 IF EMPTY(lnExRate)
10314 lnExRate = 0
10315 ENDIF
10316
10317
10318 REPLACE ;
10319 Category_Cost WITH lnExRate, ;
10320 Extension WITH lnExRate, ;
10321 Estm_Ext_Cost WITH IIF(Imp_Cost <> 'Y', Extension, Estm_Ext_Cost), ;
10322 Modified WITH "Y"
10323
10324
10325 llSomethingChanged = .T.
10326 ENDIF
10327 ENDIF
10328
10329 *--- TR 1055652 09/22/11 AZ
10330 oCostEstm.nQty = pnQty
10331 *=== TR 1055652 09/22/11 AZ
10332
10333 SELECT(THIS.cCstAlias)
10334 IF llRetVal AND NOT EMPTY(Formula) AND NOT ((Imp_Cost = 'Y' OR AP_Cost = 'Y') AND Extension <> 0)
10335 SELECT(THIS.cCatAlias)
10336 *-- TR 1072967 26-SEP-13 Venuk. Added This.cCN_HS_FIXEDAMOUNT in list===
10337 IF NOT INLIST(Cost_Type, THIS.cCN_HS_LOOKUP, THIS.cCN_COMMISSION, This.cCN_HS_FIXEDAMOUNT ) AND ;
10338 (NOT (Cost_Type = THIS.cCN_DUTY_VALUE) OR NOT plSkipDuty)
10339
10340 SELECT(THIS.cCstAlias)
10341
10342 *--- TR 1055652 09/22/11 AZ
10343* lnCost = THIS.EvalCostFormula(.cCstAlias, Formula, pnPODtlPkey, Category, Round_To)
10344 lnCost = THIS.EvalCostFormula(.cCstAlias, Formula, pnPodtlPkey, Category, Round_To,,,oCostEstm)
10345 lnExtensionEstm = oCostEstm.nCostEstm * pnQty && restore esimate extension after round to.
10346 oCostEstm.nQty = .NULL.
10347 *=== TR 1055652 09/22/11 AZ
10348 lnExtension = lnCost * pnQty && restore extension after round to.
10349
10350 *--- TR 1055652 09/22/11 AZ
10351 REPLACE ;
10352 Category_Cost WITH lnCost, ;
10353 Extension WITH lnExtension, ;
10354 Estm_Ext_Cost WITH lnExtensionEstm , ;
10355 Modified WITH "Y"
10356
10357 *--- 1012294 KISHOR 28-Jul-2006
10358*!* REPLACE ;
10359*!* Category_Cost WITH lnCost, ;
10360*!* Extension WITH lnExtension, ;
10361*!* Estm_Ext_Cost WITH IIF(Imp_Cost <> 'Y', lnExtension, Estm_Ext_Cost), ;
10362*!* Modified WITH "Y"
10363 *REPLACE ;
10364 Category_Cost WITH lnCost, ;
10365 Extension WITH lnExtension, ;
10366 Estm_Ext_Cost WITH IIF(Imp_Cost <> 'Y', lnExtension, Estm_Ext_Cost)
10367 *=== 1012294 KISHOR 28-Jul-2006
10368
10369 *=== TR 1055652 09/22/11 AZ
10370
10371 llSomethingChanged = .T.
10372 ENDIF
10373 ENDIF
10374 ENDSCAN
10375 SELECT(lnSelect) &&& 1059112 AZ
10376 RETURN llSomethingChanged
10377 ENDPROC
10378
10379 PROCEDURE GetHSDuty_2
10380 LPARAMETERS pcDivision, pcStyle, pcColor_code, pcLbl_Code, pcDimension, ;
10381 pnValue, pnPoDtlKey, pcContractor, plHsFixedAmount
10382 *--- TR 1072967 26-SEP-13 Venuk. Added plHsFixedAmount ===
10383
10384 LOCAL llRetVal, lcHS_Num, lcCountry, lnTotalDuty, lcWgt_UOM, ;
10385 lnGar_Wgt, lnGar_DutywgtAmt, lnGar_Dutywgt, lnUOM_Factor, lcUOM_Factor, lnSelect
10386
10387 lnUOM_Factor = 0
10388 lcUOM_Factor = ""
10389 lnGar_Dutywgt = 0
10390 lcHS_Num = ''
10391 lcWgt_UOM = ''
10392 lnGar_Wgt = 0
10393 lnGar_DutywgtAmt = 0
10394 lcCountry = ""
10395 lnTotalDuty = 0
10396 lnSelect = SELECT()
10397
10398 =SEEK(pcDivision + pcStyle + pcColor_code + pcLbl_Code + pcDimension, THIS.cColAlias, 'SKU')
10399 =SEEK(pcDivision + pcStyle, THIS.cStyAlias, 'SKU')
10400
10401 SELECT (THIS.cColAlias)
10402 IF FOUND()
10403 lcHS_Num = HS_Num
10404 lcWgt_UOM = Wgt_UOM
10405 lnGar_Wgt = Gar_Wgt
10406 ENDIF
10407
10408 SELECT (THIS.cStyAlias)
10409 IF FOUND()
10410 lcHS_Num = IIF(EMPTY(lcHS_Num), HS_Num, lcHS_Num)
10411 lcWgt_UOM = IIF(EMPTY(lcWgt_UOM), Wgt_UOM, lcWgt_UOM)
10412 lnGar_Wgt = IIF(EMPTY(lnGar_Wgt), Gar_Wgt, lnGar_Wgt)
10413 ENDIF
10414
10415 * Get country for contractor from zzxlocar, decide which contractor to use.
10416 IF TYPE("pcContractor") = "C" AND !EMPTY(pcContractor) && if contractor is passed, use it.
10417 IF SEEK(pcContractor, THIS.cLocAlias, 'Location')
10418 SELECT(THIS.cLocAlias)
10419 lcCountry = Country
10420 ENDIF
10421 ELSE
10422 IF NOT EMPTY(pnPODtlKey)
10423 *- Use "uncommitted" country from header view if it exists:
10424 IF USED('vzzcordrh') AND NOT EOF('vzzcordrh')
10425 lcCountry = vzzcordrh.Country
10426 ELSE
10427 SELECT (THIS.cDetAlias)
10428* Unnecessary - loaded locally:
10429* IF SEEK(pnPODtlKey, THIS.cDetAlias, "PKey")
10430 IF SEEK(Prod_Num, THIS.cHdrAlias, "Prod_Num")
10431 SELECT (THIS.cHdrAlias)
10432 lcCountry = Country
10433 ENDIF
10434* ENDIF
10435 ENDIF
10436 ENDIF
10437 ENDIF
10438
10439 IF NOT EMPTY(lcHS_Num)
10440 * get HM number record by hm_num + country
10441 llRetVal = SEEK(lcHS_Num + lcCountry, THIS.cHSNAlias, "HS_Country")
10442
10443 IF NOT llRetVal && not found, try country = " "
10444 llRetVal = SEEK(lcHS_Num, THIS.cHSNAlias, "HS_Num")
10445 ENDIF
10446
10447 IF llRetVal
10448 SELECT (THIS.cHSNAlias)
10449 IF EMPTY(UOM) OR EMPTY(lcWgt_UOM)
10450 IF !plHsFixedAmount &&--- TR 1072967 26-SEP-13 Venuk
10451 lnTotalDuty = ;
10452 (pnValue * Duty_Perc / 100) + Duty_Rate
10453 *--- TR 1072967 26-SEP-13 Venuk
10454 ELSE
10455 lnTotalDuty = pnValue + fixed_dollar
10456 ENDIF
10457 *=== TR 1072967 26-SEP-13 Venuk
10458 ELSE
10459 lnGar_DutyWgt = lnGar_Wgt
10460
10461 IF lcWgt_UOM <> UOM
10462 =SEEK(UOM + lcWgt_UOM, THIS.cUOMAlias, "UOMConvert")
10463 SELECT(THIS.cUOMAlias)
10464 lnUOM_Factor = UOM_Factor
10465 lnGar_Dutywgt = lnUOM_Factor * lnGar_Wgt
10466 ENDIF
10467
10468 SELECT(THIS.cHSNAlias)
10469 IF Duty_Wgt <> 0 AND Duty_Rate <> 0
10470 lnGar_DutywgtAmt = ;
10471 (( lnGar_Dutywgt * Duty_Rate ) / Duty_Wgt )
10472 ELSE
10473 lnGar_DutywgtAmt = 0
10474 ENDIF
10475 IF !plHsFixedAmount &&--- TR 1072967 26-SEP-13 Venuk
10476 lnTotalDuty = lnGar_DutywgtAmt + ( pnValue * Duty_Perc / 100)
10477 *--- TR 1072967 26-SEP-13 Venuk
10478 ELSE
10479 lnTotalDuty = lnGar_DutywgtAmt + pnValue + fixed_dollar
10480 ENDIF
10481 *=== TR 1072967 26-SEP-13 Venuk
10482 ENDIF
10483 ENDIF
10484 ENDIF
10485
10486 SELECT (lnSelect)
10487 RETURN lnTotalDuty
10488 ENDPROC
10489
10490 PROCEDURE GetCommissionCost_2
10491 LPARAMETERS tnCommissionBase, tcContractor, tcAgent
10492 LOCAL lnRetVal, lnCommissionRate, lcAgent, lnSelect
10493
10494 lnRetVal = 0
10495 lnCommissionRate = 0
10496 lcAgent = ""
10497 lnSelect = SELECT()
10498
10499 IF (!EMPTY(tcContractor) OR !EMPTY(tcAgent)) AND tnCommissionBase <> 0
10500 * Calculate cost only if Contractor is set up and is linked to Agent. Otherwise it's 0.
10501 * Get Agent
10502 IF EMPTY(tcAgent)
10503 IF SEEK(tcContractor + "C", THIS.cLocAlias, "Loc_Type")
10504 SELECT (THIS.cLocAlias)
10505 lcAgent = Agent
10506 ENDIF
10507 ELSE
10508 lcAgent = ALLTRIM(tcAgent)
10509 ENDIF
10510
10511 IF !EMPTY(lcAgent)
10512 * Get commission for this Agent
10513 IF SEEK(lcAgent, THIS.cAgnAlias, "Agent")
10514 SELECT (THIS.cAgnAlias)
10515 lnCommissionRate = CommPct
10516 ENDIF
10517
10518 * Calculate rate:
10519 lnRetVal = tnCommissionBase * lnCommissionRate / 100
10520 ENDIF
10521 ENDIF
10522
10523 SELECT (lnSelect)
10524 RETURN lnRetVal
10525 ENDPROC
10526
10527 PROCEDURE ProrateImp_2
10528 PARAMETER pnProd_num, pnOpen_seq, plimportonly, plNoMsg, pcDetailAlias, pcCostAlias
10529 LOCAL llRetVal, lnQty, lcProd_Type, llBeganTransaction, lcBOMAlias, lnDutyExt, ;
10530 llDoNotCommit, lnReccount, lnYY, llLoadData, lnRecNo, lnReccount, lnSeconds, ;
10531 lnBuffer, laCost[5], laAmount[1,11], lnDetPkey, llMultiLevel, llSomethingChanged, ;
10532 llSomethingChanged1, llSomethingChanged2, llSomethingChanged3, llSomethingChanged4, llSomethingChanged5, llSomethingChanged6
10533 *--- TechRec 1058999 18-Apr-2012 jisingh Added llSomethingChanged5 ===
10534 *--- TR 1072967/1075630 26-SEP-13 Venuk Added llSomethingChanged6
10535
10536 llLoadData = .T.
10537 laCost = 0
10538 llRetVal = .T.
10539
10540 * ------------------------------------------------------------------------
10541 * Believe the only thing that wanted to commit originally was the Shipping
10542 * Proration Process, which now commits itself.
10543 llDoNotCommit = .T.
10544 * ========================================================================
10545
10546 WITH THIS
10547 lnSeconds = SECONDS()
10548
10549 *--- TechRec 1026008 09-Aug-2007 GSternik ---
10550 .cPO_Dtl_Alias = pcDetailAlias
10551 *=== TechRec 1026008 09-Aug-2007 GSternik ===
10552
10553* .pushRecordSet()
10554 lcBOMAlias = IIF(USED("Vzzcbommd"), "Vzzcbommd", "Vzzcbommd_Tree")
10555
10556
10557
10558 llRetVal = llRetVal AND .GetShipmentCost(.cDetAlias, pnOpen_seq)
10559
10560
10561 IF llRetVal
10562 SELECT (.cDetAlias)
10563 .pushRecordSet()
10564 COUNT TO lnReccount
10565 .popRecordSet()
10566 lnYY = 0
10567 SET ORDER TO Prod_Seq
10568 SEEK STR(pnProd_Num) + STR(pnOpen_Seq)
10569 SCAN WHILE Prod_Num = pnProd_Num AND Open_seq = pnOpen_seq && loop through the whole tree.
10570 lnDetPkey = pkey
10571 * If not no message, show thermostate bar.
10572 IF !plNoMsg
10573 lnRecNo = RECNO()
10574 IF lnRecNo > 0
10575 lnYY = lnRecNo
10576 ELSE
10577 lnYY = lnYY + 1 && to accomodate new records.
10578 ENDIF
10579 lcMessage = "Prorating import tracking cost for stage " + TRIM(stage)
10580 Thermo(lcMessage, lnYY, lnReccount)
10581 ENDIF
10582 * -- end thermostate bar.
10583
10584 lnQty = IIF(Last_Stage = "Y", Total_Qty, WIP_Total)
10585
10586 SELECT(.cCstAlias)
10587
10588 llMultiLevel = SEEK(lnDetPkey, .cCstAlias, 'CostLevel2')
10589
10590 SELECT(.cDetAlias)
10591
10592 .CostFromImp(.cCstAlias, lnDetPkey, lnQty, Prod_Num, .cDetAlias, @laAmount)
10593 IF !plimportonly && 08/03/00 do not do constant/formula if import only.
10594 IF llMultiLevel
10595
10596 .RecalCost(.cDetAlias, lcBOMAlias, .cCstAlias, lnDetPkey)
10597 * RecalCost(), even though it pushes and pops with the index on .cCstAlias
10598 * set to FKey, for some reason sets the order to CostLevel.
10599 * Set it back manually:
10600 SELECT (.cCstAlias)
10601 SET ORDER TO TAG FKey
10602 SELECT(.cDetAlias)
10603 ELSE
10604 SELECT (.cCstAlias)
10605 SEEK lnDetPkey
10606 IF FOUND() && Only need to run through process if one cost sheet record exists.
10607 SELECT(.cDetAlias)
10608 llSomethingChanged1 = .CostFromConstant_2(.cCstAlias, lnDetPkey, lnQty, @laCost)
10609 llSomethingChanged2 = .costOfHSLookUp_2(.cCstAlias, lnDetPkey, lnQty)
10610 llSomethingChanged6 = .costOfHSLookUp_2(.cCstAlias, lnDetPkey, lnQty, true) && TR 1072967/1075630 26-SEP-13 Venuk. get Hs fixed Amount.
10611 llSomethingChanged3 = .costOfCommission_2(.cCstAlias, lnDetPkey, lnqty, Agent)
10612 llSomethingChanged4 = .costbyFormula_2(.cCstAlias, lnDetPkey, lnQty, true)
10613 *--- TechRec 1058999 18-Apr-2012 jisingh ---
10614 llSomethingChanged5 = .CostOfMultiRoyalty(.cCstAlias, lnDetPkey, lnQty)
10615 *=== TechRec 1058999 18-Apr-2012 jisingh ===
10616 ENDIF
10617 ENDIF
10618 ENDIF
10619
10620 *--- TechRec 1058999 18-Apr-2012 jisingh Added OR llSomethingChanged5 ===
10621 *--- TR 1072967/1075630 26-SEP-13 Venuk. Added llSomethingChanged6
10622 llSomethingChanged = llSomethingChanged1 OR llSomethingChanged2 OR llSomethingChanged3 OR llSomethingChanged4 OR llSomethingChanged5 OR llSomethingChanged6
10623
10624 * NOTE: Timestamp is performed in WriteBackToRealViews(), called by calling program:
10625* .TimeStampDocument(.cDetAlias)
10626 IF llSomethingChanged
10627 REPLACE ;
10628 Last_Prorated WITH DATETIME(), ;
10629 Modified WITH 'Y' ;
10630 IN (.cDetAlias)
10631 ENDIF
10632
10633 IF !plimportonly
10634 lnCost = laCost[DUTY_]
10635
10636 * 38280 CB 6/03 Added ability to prorate Actual Duty Value back to Cost Sheet
10637 * Shipment proration has already occurred as normal, taking into account the HS Duty Value
10638 * of shipment goods. If User has entered an Actual Duty, override the cost on the
10639 * Cost Sheet for the Duty Category with the weighted cost,
10640 * and the Production Detail Line with the cost.
10641 lnDutyExt = .GetActualDutyCost(lnDetPKey)
10642 IF lnDutyExt > 0
10643 lnCost = .CostFromActualDuty(.cCstAlias, lnDetPKey, lnQty, .cDetAlias)
10644 laCost[DUTY_] = lnCost
10645
10646 * Calculate Formulas again
10647 .costbyFormula_2(.cCstAlias, lnDetPKey, lnQty, true) && get cost by formula
10648 ENDIF
10649
10650 IF llSomethingChanged
10651
10652 This.UpdatePODetail(.cCstAlias, .cDetAlias)
10653
10654 ENDIF
10655 ENDIF
10656
10657 ENDSCAN
10658
10659 * Time stamp is performed in WriteBackToRealViews(), called by calling program:
10660*!* * time stamp last_mod of cost view.
10661*!* .TimeStampDocument(.cCstAlias, ;
10662*!* "FOR Prod_Num = " + TRANSFORM(pnProd_Num) + " AND Open_Seq = " + TRANSFORM(pnOpen_Seq))
10663
10664 * start transaction for the entire tree of po_num and open_seq
10665 IF !llDoNotCommit && need to commit here.
10666 llBeganTransaction = .BeginTransaction()
10667 llRetVal = .TABLEUPDATE(.cDetAlias) AND .TABLEUPDATE(.cCstAlias)
10668 IF llBeganTransaction
10669 IF llRetVal
10670 .EndTransaction()
10671 ELSE
10672 .RollbackTransaction()
10673 llRetVal = .F.
10674 ENDIF
10675
10676 .TableClose(.cDetAlias)
10677 .TableClose(.cCstAlias)
10678 .TableClose(lcBOMAlias)
10679 ENDIF
10680 ENDIF
10681 ENDIF
10682
10683* .popRecordSet()
10684
10685 IF .lEnableDebugging
10686 .oLog.LogEntry("Done. Time to run: " + ALLTRIM(STR(SECONDS() - lnSeconds)) + " seconds.")
10687 ENDIF
10688 ENDWITH
10689
10690 RETURN llRetVal
10691 ENDPROC
10692
10693 PROCEDURE ProrateVoucher_2
10694 PARAMETER pcDetailAlias, pcCostAlias, pcHeaderAlias
10695 LOCAL llRetVal, lnQty
10696
10697
10698
10699 WITH THIS
10700 .pushRecordSet()
10701 SELECT (pcDetailAlias)
10702 .pushRecordSet()
10703
10704 *--- TechRec 1026008 09-Aug-2007 GSternik ---
10705 .cPO_Dtl_Alias = pcDetailAlias
10706 *=== TechRec 1026008 09-Aug-2007 GSternik ===
10707
10708 lnQty = IIF(Last_Stage = "Y", Total_Qty, WIP_Total)
10709 llRetVal = .T.
10710
10711
10712
10713 * Handled by caller (clsAPVch)
10714 *.PrepDynamicCursors(pcCostAlias, pcDetailAlias, pcHeaderAlias, , .T.)
10715
10716 .CostFromConstant_2(.cCstAlias, PKey, lnQty) && Get cost by constant
10717 .CostOfHSLookUp_2(.cCstAlias, PKey, lnQty) && Get hs lookup cost
10718 .CostOfHSLookUp_2(.cCstAlias, PKey, lnQty, true) && TR 1072967 26-SEP-13 Venuk
10719
10720 *--- TechRec 1058999 18-Apr-2012 jisingh ---
10721 .CostOfMultiRoyalty(.cCstAlias, PKey, lnQty) && get multi royalty cost
10722 *=== TechRec 1058999 18-Apr-2012 jisingh ===
10723 .CostOfCommission_2(.cCstAlias, PKey, lnQty, Agent) && Get agent commission cost
10724 .CostByFormula_2(.cCstAlias, PKey, lnQty) && Get cost by formula
10725
10726 .UpdatePODetail(.cCstAlias, .cDetAlias)
10727
10728 * NOTE: Time stamps are handled in WriteBackToRealViews()
10729 * Handled by caller (clsAPVch)
10730 *.WriteBackToRealViews(pcCostAlias, pcDetailAlias)
10731
10732 * Handled by caller (clsAPVch)
10733 *.CloseDynamicCursors()
10734
10735 .PopRecordSet()
10736 .PopRecordSet()
10737 ENDWITH
10738
10739 RETURN llRetVal
10740 ENDPROC
10741
10742*============================================================
10743*--- TechRec 1024615 30-May-2007 vkrishnamurthy ---
10744 && For Style Cost Sheet Calculation for Catch ALL
10745 PROCEDURE GetBOMCostBySize
10746 LPARAMETERS pcString
10747 LOCAL llRetVal, lnSelect ,lnCost ,lcSQLExec ,lcCursor , lcFieldStr
10748
10749 llRetVal = true
10750 lnSelect = SELECT()
10751
10752 lnCost = 0
10753 lcCursor = GetUniqueFileName()
10754
10755 lcFieldStr = " Sum(extension) as extension, count(*) as SkuCount, MAX(one_size) as one_size "
10756
10757 lcSQLExec = " SELECT " + lcFieldStr + ;
10758 " From tcBOMDet Group by cmp_type where " + pcString
10759
10760 llRetval = v_SQLExec(lcSQLExec, lcCursor,, true)
10761 llRetval = llRetval AND USED(lcCursor)
10762
10763 IF llRetval
10764 SELECT(lcCursor)
10765 SCAN
10766 lnCost = lnCost + IIF(One_size = 'Y' , extension/SkuCount, extension)
10767 ENDSCAN
10768 USE IN (lcCursor)
10769 ENDIF
10770
10771 SELECT (lnSelect)
10772 RETURN lnCost
10773 ENDPROC
10774*======================================================================
10775 && For PO Cost Sheet Calculation for Catch ALL
10776 PROCEDURE GetBOMCostBySizeForPO
10777 LPARAMETERS pcString , pnQty
10778 LOCAL llRetVal, lnSelect ,lnCost ,lcSQLExec ,lcCursor , lcFieldStr ,llOneSize,lnw_qty,lctrxs &&& 1068034 AZ &&& 1086753 AZ
10779
10780 llRetVal = true
10781 lnSelect = SELECT()
10782
10783 lnCost = 0
10784 lcCursor = GetUniqueFileName()
10785
10786 lctrxs = '' &&& 1086753
10787
10788 *--- TR 1025075 14-JUN-2007 VKK
10789 *lcFieldStr = " cmp_type, trxusage, sum(rm_cost) as rm_cost, count(*) as SkuCount "
10790*--- TechRec 1068034 25-Jun-2013 AZhadanov ---
10791 *lcFieldStr = " cmp_type, trxusage, sum(rm_cost) as rm_cost, count(*) as SkuCount "
10792*--- TechRec 1086753 19-Jun-2015 azhadanov ---
10793 FOR lnxx = 1 TO goEnv.MaxBuckets
10794 lcBucket = PADL(lnxx, 2, "0")
10795 lcTrx = "trx" + lcBucket + "_qty" && trx01_qty etc..
10796
10797 lctrxs = lctrxs+lctrx
10798 IF lnxx < goEnv.MaxBuckets
10799 lctrxs = lctrxs+"+"
10800 endif
10801 NEXT
10802 lctrxs = "("+lctrxs + ")"
10803
10804 lcFieldStr = " cmp_type, "+"SUM("+lctrxs+ "*rm_Cost) As Trx_Cost, SUM(rm_cost*(1.+wastefactor) * usage) as lncst, " + ;
10805 " SUM(IIF(trxusage = 0, 0, 1)) as TotSkuCount, count(*) as SkuCount ,SUM(wip_total) wip_total " &&& 1068034 AZ
10806
10807
10808
10809
10810* lcFieldStr = " cmp_type, SUM(Trxusage*rm_Cost) As Trx_Cost, SUM(rm_cost*(1.+wastefactor) * usage) as lncst, " + ;
10811 " SUM(IIF(trxusage = 0, 0, 1)) as TotSkuCount, count(*) as SkuCount ,SUM(wip_total) wip_total " &&& 1068034 AZ
10812*=== TechRec 1086753 19-Jun-2015 azhadanov ---
10813
10814*=== TechRec 1068034 25-Jun-2013 AZhadanov ---
10815 *=== TR 1025075 14-JUN-2007 VKK
10816 *--- 1028790 12-17-2007 SKG
10817*!* lcSQLExec = " SELECT " + lcFieldStr + ;
10818*!* " From tmpCostBOM " + ;
10819*!* " Group by cmp_type where " + pcString
10820 lcSQLExec = " SELECT " + lcFieldStr + ;
10821 " From tmpCostBOM " + ;
10822 " Group by Division, Style, Color_code, Lbl_code, Dimension, Cmp_Code, Cmp_Type, Size_OK, Dutiable where " + pcString
10823 *--- 1028790 12-17-2007 SKG
10824 llRetval = v_SQLExec(lcSQLExec, lcCursor,, true)
10825 llRetval = llRetval AND USED(lcCursor)
10826
10827 IF llRetval
10828 SELECT(lcCursor)
10829 SCAN
10830*--- TechRec 1073290 - 1074305 17-Apr-2014 AZhadanov --- Always calculte cost using trxusage
10831* llOneSize = (vl_btypeh(Cmp_type,'one_size') = 'Y')
10832 llOneSize = .F.
10833*=== TechRec 1073290 - 1074305 17-Apr-2014 AZhadanov --- Always calculte cost using trxusage
10834
10835 *--- TR 1025075 14-JUN-2007 VKK
10836 *--- TechRec 1075075 13-Aug-2014 AZhadanov ---
10837* lnw_qty = wip_total/skucount &&& 1068034 AZ
10838 lnw_qty = wip_total/IIF(TotSkuCount = 0,1,TotSkuCount) &&& 1075075 AZ TO prevent division by 0
10839*=== TechRec 1075075 13-Aug-2014 AZhadanov ===
10840
10841 *--- TR 1052358 02/09/11 AZ Remove division by 0
10842 *lnCost = lnCost + IIF(llOneSize ,pnQty*rm_cost/SkuCount, trxusage * rm_cost/SkuCount)
10843
10844* lnCost = lnCost + IIF(llOneSize ,pnQty*rm_cost/SkuCount, Trx_Cost/TotSkuCount)
10845* lnCost = lnCost + IIF(llOneSize ,pnQty*rm_cost/SkuCount, Trx_Cost/IIF(TotSkuCount = 0,1,TotSkuCount))
10846
10847*--- TechRec 1068034 17-Apr-2013 AZhadanov ---
10848 IF llOnesize
10849**** 1070222
10850* lncost =lncost+pnQty*rm_cost/SkuCount
10851 lncost =lncost+(pnQty*lncst/(IIF( SkuCount = 0,1, SkuCount)))
10852 ELSE
10853 IF lnw_qty > 0
10854 lnCost = lnCost+(pnqty/lnw_qty)* Trx_Cost/IIF(TotSkuCount = 0,1,TotSkuCount)
10855 ELSE
10856 lnCost = lnCost + Trx_Cost/IIF(TotSkuCount = 0,1,TotSkuCount)
10857 ENDIF
10858 ENDIF
10859
10860* lnCost = lnCost + IIF(llOneSize ,pnQty*rm_cost/SkuCount, Trx_Cost/TotSkuCount)
10861* lnCost = lnCost + IIF(llOneSize ,pnQty*rm_cost/SkuCount, Trx_Cost/IIF(TotSkuCount = 0,1,TotSkuCount))
10862*=== TechRec 1068034 17-Apr-2013 AZhadanov ===
10863
10864
10865 *=== TR 1052358 02/09/11 AZ
10866
10867 *=== TR 1025075 14-JUN-2007 VKK
10868
10869 ENDSCAN
10870 USE IN (lcCursor)
10871 ENDIF
10872
10873 SELECT (lnSelect)
10874 RETURN lnCost
10875 ENDPROC
10876
10877*=== TechRec 1024615 30-May-2007 vkrishnamurthy ===
10878* ----------------------------------------------------
10879* O P T I M I Z E D R O U T I N E S (1003958) End.
10880* ====================================================
10881
10882 *--- 1032015 03/10/09 Ilya:
10883 PROCEDURE CreateBaseCSFromRangeStyle
10884 LPARAMETERS tnRangeStylePkey, tcContractor, tcProd_type, tcSeason
10885 * Create blank multi-BOM Base Cost Sheet for the Range Style.
10886 * Assumption is that each range style's component has it's own cost sheet, which will be pulled in
10887 * when prod order for the range style is created.
10888 * All we need is to have a starting point on the range style level.
10889 *
10890 * This cost sheet will be created from the tcTemplate template.
10891 * If cost sheet for the range style is already created - will use it as is.
10892 * The template cannot have any formula or non-constant values - not supported by
10893 * below code. category_cost will be updated by the constant value only.
10894 LOCAL llRetVal, lnOldArea, lcRangeHCurs, llHaveCS, lcCSCheckStr, lcCatgrView, ;
10895 lcCosthView, lcCostdView, lcTmpldView, lnLineNum, loCostD, lnCOSTPkey, ;
10896 lcCosthCurr_Code, lcTemplate
10897
10898 lcTemplate = THIS.cPORangeCSTemplate
10899
10900 llRetVal = .T.
10901 IF EMPTY(tnRangeStylePkey) OR EMPTY(lcTemplate)
10902 llRetVal = .F.
10903 ENDIF
10904
10905 lnOldArea = SELECT()
10906
10907 * See if we have already Base Cost Sheet for this style
10908 lcCSCheckStr = "zzxrangh r " + ;
10909 "JOIN zzdcosth c ON c.division = r.division " + ;
10910 "AND c.style = r.rng_style " + ;
10911 "AND c.color_code = r.rng_color " + ;
10912 "AND c.lbl_code = r.rng_lbl " + ;
10913 "AND c.dimension = r.rng_pack " + ;
10914 "AND c.prod_type = " + SQLFormatChar(tcProd_type) + ;
10915 " AND c.contractor = " + SQLFormatChar(tcContractor) + ;
10916 " AND c.season = " + SQLFormatChar(tcSeason)
10917 llHaveCS = llRetVal AND vl_generic(lcCSCheckStr,"r.pkey = " + SQLFormatNum(tnRangeStylePkey))
10918
10919 IF llRetVal AND NOT llHaveCS
10920 * CS not found. Will create new cost sheet.
10921
10922 lcRangeHCurs = GetUniqueFilename()
10923 lcCosthView = GetUniqueFilename()
10924 lcCostdView = GetUniqueFilename()
10925 lcTmpldView = GetUniqueFilename()
10926 lcCatgrView = GetUniqueFilename()
10927
10928 LOCAL ARRAY aCSViews(2)
10929 aCSViews[1] = lcCosthView
10930 aCSViews[2] = lcCostdView
10931
10932 * Retrieve the range style info
10933 llRetVal = llRetVal AND vl_generic("zzxrangh","pkey = " + SQLFormatNum(tnRangeStylePkey),,lcRangeHCurs)
10934
10935 * Get Category
10936 * Costh view
10937 llRetVal = llRetVal AND THIS.CreateSqlView(lcCosthView,"SELECT * FROM zzdcosth WHERE 1=2")
10938 llRetVal = llRetVal AND THIS.OpenTable(lcCosthView)
10939
10940 IF llRetVal
10941 lnCOSTPkey = v_nextpkey("zzdcosth")
10942 lcCosthCurr_Code = vl_Divsr(EVALUATE(lcRangeHCurs + ".division"), 'Curr_Code')
10943 SELECT (lcCosthView)
10944 APPEND BLANK
10945 BLANK
10946
10947 REPLACE division WITH EVALUATE(lcRangeHCurs + ".division")
10948 REPLACE style WITH EVALUATE(lcRangeHCurs + ".rng_style")
10949 REPLACE color_code WITH EVALUATE(lcRangeHCurs + ".rng_color")
10950 REPLACE lbl_code WITH EVALUATE(lcRangeHCurs + ".rng_lbl")
10951 REPLACE dimension WITH EVALUATE(lcRangeHCurs + ".rng_pack")
10952 REPLACE contractor WITH tcContractor
10953 REPLACE prod_type WITH tcProd_type
10954 REPLACE season WITH tcSeason
10955 REPLACE active_ok WITH 'Y'
10956 REPLACE ent_user WITH goEnv.cUser
10957 REPLACE ent_date WITH DATETIME()
10958 REPLACE user_id WITH goEnv.cUser
10959 REPLACE last_mod WITH DATETIME()
10960 REPLACE curr_code WITH lcCosthCurr_Code
10961 REPLACE frozen WITH 'N'
10962 REPLACE template WITH lcTemplate
10963 REPLACE pkey WITH lnCOSTPkey
10964
10965 SCATTER MEMO NAME loCostD
10966 ENDIF
10967
10968 * Costd view
10969 llRetVal = llRetVal AND THIS.CreateSqlView(lcCostdView,"SELECT * FROM zzdcostd WHERE 1=2")
10970 llRetVal = llRetVal AND THIS.OpenTable(lcCostdView)
10971 llRetVal = llRetVal AND v_SqlExec("SELECT * FROM zzdtmpld WHERE template = " + ;
10972 SQLFormatChar(lcTemplate) + " order by line_seq",lcTmpldView)
10973
10974 IF llRetVal
10975 lnLineNum = 0
10976
10977 SELECT (lcTmpldView)
10978 SCAN
10979 SCATTER MEMO NAME loCostD ADDITIVE
10980 loCostD.user_id = goEnv.cUser
10981 loCostD.last_mod = DATETIME()
10982 loCostD.pkey = v_nextpkey("zzdcostd")
10983 loCostD.fkey = lnCOSTPkey
10984
10985 INSERT INTO (lcCostdView) FROM NAME loCostD
10986
10987 * Category_cost should be accurately calculated.
10988 * When creating a cost sheet in zzdcosth.vcx UI, category_cost is
10989 * recalculated using .m_recalcost() procedure. It cannot be easily
10990 * repeated here, as essentially it is a re-write of that code, therefore
10991 * we restrict the template to be a primitive one - constants only
10992 * Real-life expectation is that templates created for Range Style
10993 * will have a dummy records of 300 and 600 lines with 0 cost.
10994 * All real cost details will go from real underlying multibom cost sheets.
10995 REPLACE category_cost WITH constant IN (lcCostdView)
10996
10997 ENDSCAN
10998
10999 ENDIF && llRetVal
11000
11001 llRetVal = llRetVal AND THIS.TableUpdateWithTransaction(@aCSViews)
11002
11003 llRetVal = llRetVal AND update_COST_Rank_seq(lnCOSTPkey)
11004
11005 USE IN SELECT(lcRangeHCurs)
11006 USE IN SELECT(lcTmpldView)
11007 USE IN SELECT(lcCosthView)
11008 USE IN SELECT(lcCostdView)
11009
11010 ENDIF && NOT llHaveCS
11011
11012 SELECT (lnOldArea)
11013 RETURN llRetVal
11014 ENDPROC
11015
11016 *=== 1032015 03/10/09 Ilya.
11017
11018 *--- TechRec 1058999 13-Apr-2012 jisingh ---
11019*============================================================
11020
11021 PROCEDURE CostOfMultiRoyalty
11022 LPARAMETER pcCostAlias, pnPodtlPkey, pnQty
11023 LOCAL llRetVal, lnSelect, lnCost, lnExtension, lnMRBase, lcCategory
11024
11025 llRetVal = true
11026 lnSelect = SELECT()
11027
11028 WITH This
11029 .PushRecordSet()
11030 SELECT (pcCostAlias)
11031 .PushRecordSet()
11032
11033 llTag = .F.
11034 FOR lnTag = 1 TO TAGCOUNT()
11035 lcExp = UPPER(ALLTRIM(TAG(lnTag)))
11036 llTag = lcExp == "FKEY"
11037 IF llTag
11038 EXIT
11039 ENDIF
11040 ENDFOR
11041
11042 IF llTag
11043 lcScanExp = "WHILE fkey = pnPodtlPkey"
11044 SET ORDER TO fkey
11045 =SEEK(pnPodtlPkey)
11046 ELSE
11047 lcScanExp = "FOR fkey = pnPodtlPkey"
11048 ENDIF
11049
11050 SCAN &lcScanExp
11051 IF VARTYPE(prv_cost_updt) = "C" AND prv_cost_updt = "Y"
11052 LOOP
11053 ENDIF
11054
11055 lcCategory = Category
11056 llRetVal = SEEK(lcCategory, .cCatAlias)
11057 IF llRetVal AND EVALUATE(.cCatAlias + ".Cost_Type") = UPPER(.cCN_MULTI_ROYALTY)
11058 DO CASE
11059 CASE !EMPTY(constant)
11060 lnMRBase = constant
11061 CASE !EMPTY(formula)
11062 lnMRBase = .EvalCostFormula(pcCostAlias, formula, pnPodtlPkey, category, round_to)
11063 lnExtension = lnMRBase * pnQty && restore extension after round to.
11064 OTHER
11065 lnMRBase = 0
11066 ENDCASE
11067 lnCost = .GetMultiRoyaltyDuty(division, style, color_code, lbl_code, dimension, lnMRBase)
11068
11069 lnCost = ROUND(lnCost, 5)
11070 lnExtension = lnCost * pnQty
11071
11072 IF AP_Cost <> 'Y'
11073 REPLACE Category_Cost WITH lnCost, Extension WITH lnExtension IN (pcCostAlias)
11074 IF Imp_Cost # 'Y'
11075 REPLACE Estm_Ext_Cost WITH Extension
11076
11077 IF .lOptimizedRecalc AND .lDynamicsPrepped
11078 REPLACE modified WITH 'Y'
11079 ENDIF
11080 ENDIF
11081 ENDIF
11082 ENDIF
11083 ENDSCAN
11084 .PopRecordSet()
11085 .PopRecordSet()
11086 ENDWITH
11087
11088 SELECT (lnSelect)
11089 RETURN llRetVal
11090 ENDPROC
11091
11092*============================================================
11093
11094 PROCEDURE GetMultiRoyaltyDuty
11095 LPARAMETERS pcDiv, pcStyle, pcColor, pcLabel, pcDim, pnValue
11096 LOCAL llRetVal, lnSelect, lcAlias, lcSQLString, lnTotal
11097
11098 llRetVal = true
11099 lnSelect = SELECT()
11100 lcAlias = GetUniqueFileName()
11101 lnTotal = 0
11102
11103 WITH This
11104 lcSQLString = " SELECT COALESCE(dbo.bcfn_RoyaltyResolutionInt(" + ;
11105 SQLFormatChar(pcDiv) + "," + ;
11106 "''," + ;
11107 SQLFormatChar(pcStyle) + "," + ;
11108 "''," + ;
11109 SQLFormatTS(DATETIME()) + "," + ;
11110 "''," + ;
11111 "''," + ;
11112 SQLFormatChar(pcColor) + "," + ;
11113 SQLFormatChar(pcLabel) + "," + ;
11114 SQLFormatChar(pcDim) + "), 0) AS pkey"
11115
11116 llRetVal = llRetVal AND v_SQLExec(lcSQLString, lcAlias) AND USED(lcAlias)
11117
11118 IF llRetVal AND EVALUATE(lcAlias + ".pkey") > 0
11119
11120 *--- TR 1061892 28-Jun-2012 BNarayanan ---
11121 *lcSQLString = " SELECT formula_perc, roy_minuval FROM zzxroycd " + ;
11122 " WHERE roy_category = 'TOTAL' AND fkey = " + SQLFormatNum(EVALUATE(lcAlias + ".pkey"))
11123
11124 lcSQLString = " SELECT formula_perc, roy_minuval FROM zzxroycd " + ;
11125 " WHERE fkey = " + SQLFormatNum(EVALUATE(lcAlias + ".pkey")) + ;
11126 " AND roy_category in (select roy_category from zzxroyct where roy_tot_flg = 'Y') "
11127 *=== TR 1061892 28-Jun-2012 BNarayanan ===
11128
11129 IF v_SQLExec(lcSQLString, lcAlias) AND USED(lcAlias)
11130 lnTotal = pnValue * EVALUATE(lcAlias + ".formula_perc")
11131 lnTotal = MAX(lnTotal, EVALUATE(lcAlias + ".roy_minuval"))
11132 ENDIF
11133 ENDIF
11134 .TableClose(lcAlias)
11135 ENDWITH
11136
11137 SELECT (lnSelect)
11138 RETURN lnTotal
11139 ENDPROC
11140
11141*============================================================
11142
11143 PROCEDURE MultiLevelCostOfMultiRoyalty
11144 LPARAMETER pcCostAlias, pnPodtlPkey, pnQty, paBOMParts, pnMaxBOMSku
11145 LOCAL llRetVal, lnSelect, lnOrigQty, lnCost, lcSKU, lnExtension, ;
11146 lnMRBase, llFound, lcCost_Type, lcCategory, lnCnt
11147
11148 llRetVal = true
11149 lnSelect = SELECT()
11150 lnOrigQty = pnQty
11151
11152 WITH This
11153 SELECT (pcCostAlias)
11154 .PushRecordSet()
11155 SET ORDER TO CostLevel
11156
11157 FOR lnCnt = 1 TO pnMaxBOMSku
11158 lnSysLevel = paBOMParts[lnCnt, 1]
11159 lnCostLevelPkey = paBOMParts[lnCnt, 2]
11160
11161 lcSKU = ""
11162 pnQty = lnOrigQty
11163
11164 llFound = SEEK(STR(pnPodtlPkey)+STR(lnSysLevel)+STR(lnCostLevelPkey), pcCostAlias, "CostLevel")
11165
11166 IF llFound AND lnSysLevel > 0 AND paBOMParts[lnCnt, 3] > 0
11167 pnQty = paBOMParts[lnCnt, 3]
11168 ENDIF
11169
11170 SCAN WHILE llFound AND STR(fkey)+STR(syslevel)+STR(CostLevelPkey) = ;
11171 STR(pnPodtlPkey)+STR(lnSysLevel)+STR(lnCostLevelPkey)
11172
11173 IF NOT (division + style + color_code + lbl_code + dimension == lcSKU)
11174 lcSKU = division + style + color_code + lbl_code + dimension
11175 .ResolvePrePackComponentQty(division, style, color_code, lbl_code, dimension)
11176 pnQty = pnQty / .nPrepackQty * .nPrepackItemQty
11177 ENDIF
11178
11179 lcCategory = Category
11180 SELECT (.cCatAlias)
11181 llRetVal = SEEK(lcCategory)
11182 lcCost_Type = ALLTRIM(Cost_Type)
11183 SELECT (pcCostAlias)
11184
11185 IF llRetVal AND lcCost_Type = UPPER(.cCN_MULTI_ROYALTY)
11186 DO CASE
11187 CASE !EMPTY(constant)
11188 lnMRBase = constant
11189
11190 CASE !EMPTY(formula)
11191 lnMRBase = .MultiLevelEvalCostFormula(pcCostAlias, formula, pnPodtlPkey, category, ;
11192 lnSysLevel, lnCostLevelPkey, round_to)
11193 lnExtension = lnMRBase * pnQty && restore extension after round to.
11194
11195 OTHER
11196 lnMRBase = 0
11197 ENDCASE
11198 lnCost = .GetMultiRoyaltyDuty(division, style, color_code, lbl_code, dimension, lnMRBase)
11199 lnExtension = lnCost * pnQty
11200
11201 lnCost = ROUND(lnCost, 5)
11202 lnExtension = ROUND(lnExtension, 5)
11203
11204 REPLACE category_cost WITH lnCost, extension WITH lnExtension IN (pcCostAlias)
11205
11206 IF Imp_Cost # 'Y'
11207 REPLACE estm_ext_cost WITH Extension
11208
11209 IF .lOptimizedRecalc AND .lDynamicsPrepped
11210 REPLACE modified WITH 'Y'
11211 ENDIF
11212 ENDIF
11213 ENDIF
11214 ENDSCAN
11215 ENDFOR
11216
11217 SELECT (pcCostAlias)
11218 .PopRecordSet()
11219 ENDWITH
11220
11221 SELECT (lnSelect)
11222 RETURN llRetVal
11223 ENDPROC
11224 *=== TechRec 1058999 13-Apr-2012 jisingh ===
11225
11226
11227***** 1086753 AZ
11228*--- TechRec 1086753 04-Jun-2015 azhadanov ---
11229PROCEDURE GetNearestBomStage
11230LPARAMETERS pcDetailAlias,pcCmp_type,pcsyslevel
11231LOCAL lnSelect,lcReturn,lnstage_num,lnopen_seq
11232lnSelect = SELECT()
11233SELECT (pcDetailAlias)
11234lnstage_num = stage_num
11235lnopen_seq = open_seq
11236lcReturn = ''
11237IF USED("vzzcbomrf")
11238 SELECT vzzcbomrf
11239 this.pushrecordset()
11240 LOCATE FOR cmp_type = pcCmp_type AND syslevel = pcsyslevel AND open_seq = lnopen_seq
11241 IF FOUND()
11242 DO CASE
11243 CASE lnstage_num >=D_stage AND lnstage_num < R_STAGE
11244 lcReturn = 'D'
11245 CASE lnstage_num >=R_stage AND lnstage_num < C_STAGE
11246 lcReturn = 'R'
11247 OTHERWISE
11248 lcReturn = 'C'
11249 ENDCASE
11250 ENDIF
11251 this.poprecordset()
11252ENDIF
11253SELECT(lnSelect)
11254RETURN lcReturn
11255*=== TechRec 1086753 04-Jun-2015 azhadanov ---
11256
11257
11258ENDDEFINE
11259
11260*-- TR 1011441 MA 06/22/05
11261DEFINE CLASS CostEstm AS CUSTOM
11262 NAME = "CostEstm"
11263 nQty = 0
11264 nCostEstm = 0
11265
11266 PROCEDURE INIT
11267 PARAMETERS pQty
11268 THIS.nQty = pQty
11269 RETURN .T.
11270 ENDPROC
11271
11272ENDDEFINE
11273*=== TR 1011441 MA 06/22/05