· 9 years ago · Dec 22, 2016, 06:20 PM
1**********************************************************************************************
2* Program....: CLSAPVCH.PRG
3* Version....: 1.0
4* Author.....: Chris The GREAT
5* Date.......: November 7, 2002
6* Notice.....: Copyright (c) 2002 CGS Inc., All Rights Reserved.
7* Compiler...: Visual FoxPro 6.0 SP5
8* Abstract...: Accounts Payable Base Business Object Class
9***********************************************************************************************
10#INCLUDE SYSTEM.h
11
12DEFINE CLASS BPOAccountsPayableBase AS BaseBusiness
13 * Properties of the class go here. For arrays, use Dim command.
14 Name = "BPOAccountsPayableBase"
15 cHeaderAlias = "Vzzgapvch"
16 cDetailAlias = "Vzzgapvcd"
17 cTmpAlias = ''
18 oBPOCost = NULL
19 lAutoApprove = .F.
20
21 * --- TR 1022799 HNISAR 22-MAR-2007
22 cFltrStrPrevDeltFrmAllStages =''
23 * === TR 1022799 HNISAR 22-MAR-2007
24
25 *--- TechRec 1031091 01-May-2008 vkrishnamurthy ---
26 cAP_Line_Type_Prod_CBK = "CBK PROD"
27 *=== TechRec 1031091 01-May-2008 vkrishnamurthy ===
28
29 *--- TechRec 1031878 26-May-2008 vkrishnamurthy ---
30 cAPPendingStatus = "PND RCPT"
31 cAPUnBalancedStatus = "UNBALANCED"
32 cHdrTermsFlag = ''
33 cDtlCatgFlag = ''
34 cPrdStageCond = ''
35 cShpTermsFlag = ''
36 *=== TechRec 1031878 26-May-2008 vkrishnamurthy ===
37
38 *--- TechRec 1033740 19-Jun-2008 vkrishnamurthy ---
39 lApAmtReqd = False
40 lCBKNegativeOK = False
41 *=== TechRec 1033740 19-Jun-2008 vkrishnamurthy ===
42
43 *--- TR 1034316 19-JAN-2009 VKK
44 cAPLineTypeRoyalty = "ROYALTY"
45 *=== TR 1034316 19-JAN-2009 VKK
46
47 * --- TR 1041155 18-Aug-2009 Surinder Singh ---
48 lAllowZeroInvoiceAmt = false
49 * === TR 1041155 18-Aug-2009 Surinder Singh ===
50
51 *--- TechRec 1039635 14-Apr-2009 vkrishnamurthy ---
52 lExplodeVchForRangeStyle = False
53 OProdDetail = Null
54 *=== TechRec 1039635 14-Apr-2009 vkrishnamurthy ===
55
56 FUNCTION Init
57 LOCAL llRetVal, lcAutoApprove
58
59 *--- TechRec 1033740 19-Jun-2008 vkrishnamurthy ---
60 LOCAL lcCursor
61 lcCursor = GetUniqueFileName()
62 *=== TechRec 1033740 19-Jun-2008 vkrishnamurthy ===
63
64 This.cTmpAlias = GetUniqueFileName()
65
66 llRetVal = DoDefault()
67
68 * Create Cost Object:
69 This.oBPOCost = NEWOBJECT("CostBPOBase", "ClsCost.prg")
70 If Type("This.oBPOCost") <> "O" OR IsNull(This.oBPOCost)
71 ErrorBox("Couldn't Create COST OP Business Object." + CRLF + ;
72 MSG_MUST_CONTACT_SYSADMIN)
73 llRetVal = false
74 EndIf
75
76 * --- 1003625 CB 03/05
77 *--- TechRec 1033740 19-Jun-2008 vkrishnamurthy ---
78*!* lcAutoApprove = vl_gAPCtr('Auto_Appv')
79
80 IF llRetVal
81 vl_gAPCtr(,lcCursor)
82
83 SELECT(lcCursor)
84 lcAutoApprove = Auto_Appv
85
86 This.lApAmtReqd = (Ap_Amt_Reqd = 'Y')
87 This.lCBKNegativeOK = (CBK_Negative_OK = 'Y')
88
89 ENDIF
90 *=== TechRec 1033740 19-Jun-2008 vkrishnamurthy ===
91
92 IF TYPE('lcAutoApprove') = "C" AND lcAutoApprove = "Y"
93 THIS.lAutoApprove = .T.
94 ELSE
95 THIS.lAutoApprove = .F.
96 ENDIF
97
98 *--- TR 1031878 28-MAY-2008 VKK
99 * Modified in all methods the occuring of vzzgapvcd/h into .cdetailalias and .cheaderalias
100 *=== TR 1031878 28-MAY-2008 VKK
101
102 *--- TechRec 1033740 19-Jun-2008 vkrishnamurthy ---
103 This.TableClose(lcCursor)
104 *=== TechRec 1033740 19-Jun-2008 vkrishnamurthy ===
105
106 *--- TechRec 1039635 14-Apr-2009 vkrishnamurthy ---
107 This.lExplodeVchForRangeStyle = (goEnv.sv("AP_VOUCHER_EXPLODE_P_RANGE_STYLE","N") = 'Y')
108 *=== TechRec 1039635 14-Apr-2009 vkrishnamurthy ===
109
110 *--- TR 1041155 18-Aug-2009 Surinder Singh ---
111 THIS.lAllowZeroInvoiceAmt = (goEnv.SV("ALLOW_ZERO_INVOICEAMT","N") == "Y" )
112 *=== TR 1041155 18-Aug-2009 Surinder Singh ===
113
114 RETURN llRetVal
115 ENDFUNC
116
117*==================================================
118
119 FUNCTION Destroy
120
121 WITH This
122 .TableClose(.cTmpAlias)
123 DoDefault()
124 ENDWITH
125 RETURN true
126 ENDFUNC
127
128*==================================================
129
130FUNCTION GetCostInfo
131 LPARAMETERS plSkipDefaults
132 * Gets cost and quantity information based on the Voucher's line type.
133
134 Local lcType, lcCategory, lcSQLString, lnCost, lnQty, lcLocation, lnShp_Seq, ;
135 lnPrevBilled, lnPrevQty, lnExtension
136 *--- TechRec 1039635 20-Apr-2009 vkrishnamurthy ---
137 LOCAL lcComponentSKU,lcWhereStr
138 *=== TechRec 1039635 20-Apr-2009 vkrishnamurthy ===
139
140 plSkipDefaults = IIF(EMPTY(plSkipDefaults), .F., plSkipDefaults)
141 With This
142 * Figure out where to get Cost Category from:
143 lcType = Alltrim(Evaluate(.cDetailAlias + ".Line_Type"))
144 lcCategory = Alltrim(Evaluate(.cDetailAlias + ".Category"))
145 lcLocation = Evaluate(.cHeaderAlias + ".Location")
146 lnShp_Seq = Evaluate(.cDetailAlias + ".Shp_Seq")
147
148 *--- TechRec 1039635 20-Apr-2009 vkrishnamurthy ---
149 lcComponentSKU = Evaluate(.cDetailAlias + ".cmp_style") + ;
150 Evaluate(.cDetailAlias + ".cmp_color") + ;
151 Evaluate(.cDetailAlias + ".cmp_Lbl") + ;
152 Evaluate(.cDetailAlias + ".cmp_dim")
153
154 lcWhereStr = " AND Style = " + SQLFormatChar(Evaluate(.cDetailAlias + ".cmp_style")) + ;
155 " AND color_code = " + SQLFormatChar(Evaluate(.cDetailAlias + ".cmp_color")) + ;
156 " AND lbl_code = " + SQLFormatChar(Evaluate(.cDetailAlias + ".cmp_lbl")) + ;
157 " AND dimension = " + SQLFormatChar(Evaluate(.cDetailAlias + ".cmp_dim")) + ;
158 " AND SysLevel= 1"
159 *=== TechRec 1039635 20-Apr-2009 vkrishnamurthy ===
160
161
162 .GetPreviousAmounts(@lnPrevBilled, @lnPrevQty)
163
164 * Formula to determine which cost sheets exist for a given production detail record:
165 * SELECT DISTINCT g.Category, g.Code_Desc FROM zzcordrd d JOIN zzccostd c ON d.Pkey = c.Fkey JOIN zzdcatgr g ON c.Category = g.Category WHERE d.tree_seq LIKE Tree_Seq AND d.Last_Stage = 'Y' AND g.AP_Category = 'Y'
166
167 *--- TechRec 1031091 01-May-2008 vkrishnamurthy ---
168*!* If lcType == AP_LINE_TYPE_PROD_ORD && Production Order
169 If lcType == AP_LINE_TYPE_PROD_ORD OR lcType == .cAP_Line_Type_Prod_CBK && Production Order
170 *=== TechRec 1031091 01-May-2008 vkrishnamurthy ===
171 * See if a cost sheet exists for this production record:
172 * (Cost sheet's fkey is Production Order Detail's pkey)
173 If Empty(lcCategory) && UI Prevents user from entering Category if no cost information exists
174 lnCost = vl_cordrd2(Evaluate(.cDetailAlias + ".Prod_Num"), 'Cost',, Evaluate(.cDetailAlias + ".Prod_Line"))
175 lnCost = IIF(Type('lnCost') == 'N', lnCost, 0) && If not found, set to 0
176 lnQty = vl_cordrd2(Evaluate(.cDetailAlias + ".Prod_Num"), 'Total_Qty',, Evaluate(.cDetailAlias + ".Prod_Line"))
177 lnQty = IIF(Type('lnQty') == 'N', lnQty, 0) && If not found, set to 0
178 Replace ;
179 Cost With lnCost, ;
180 UI_Ext_Cost With Round(lnCost * lnQty, 2), ;
181 UI_Prev_Billed With lnPrevBilled, ;
182 UI_Prev_Qty With lnPrevQty ;
183 in (.cDetailAlias)
184
185 Else && Category entered
186 * Find cost info based on Category entered.
187 .TableClose(.cTmpAlias)
188 *--- TechRec 1039635 20-Apr-2009 vkrishnamurthy ---
189*!* vl_ccostd2(Evaluate(.cDetailAlias + ".Trx_PKey"),, .cTmpAlias, lcCategory)
190 IF This.lExplodeVchForRangeStyle AND NOT EMPTY(lcComponentSKU)
191 vl_ccostd2(Evaluate(.cDetailAlias + ".Trx_PKey"),, .cTmpAlias, lcCategory,lcWhereStr)
192 ELSE
193 *--- TechRec 1065856 31-Dec-2012 AZhadanov ---
194 lcWherestr = " AND syslevel = 0 "
195 vl_ccostd2(Evaluate(.cDetailAlias + ".Trx_PKey"),, .cTmpAlias, lcCategory,lcWhereStr) &&& 1065856
196* vl_ccostd2(Evaluate(.cDetailAlias + ".Trx_PKey"),, .cTmpAlias, lcCategory)
197 *=== TechRec 1065856 31-Dec-2012 AZhadanov ===
198 ENDIF
199 *=== TechRec 1039635 20-Apr-2009 vkrishnamurthy ===
200 If Used(.cTmpAlias) AND NOT EOF(.cTmpAlias)
201 * --- 1004673 04/04 CB - Use Estm_Ext_Cost field, rather than Extension to determine cost,
202 * in case user has already partially paid on this category:
203* lnExtension = Evaluate(.cTmpAlias + ".Extension")
204 lnExtension = Evaluate(.cTmpAlias + ".Estm_Ext_Cost")
205 * === 1004673 End.
206
207* lnCost = Evaluate(.cTmpAlias + ".Category_Cost")
208 * Recalculate cost based on Extension / Qty:
209 lnQty = Evaluate(.cDetailAlias + ".Trx_Qty")
210 lnCost = IIF(lnQty <> 0, lnExtension / lnQty, 0)
211 Replace ;
212 Cost With lnCost, ;
213 UI_Ext_Cost With Round(lnExtension, 2), ;
214 UI_Prev_Billed With lnPrevBilled, ;
215 UI_Prev_Qty With lnPrevQty ;
216 in (.cDetailAlias)
217 EndIf
218 EndIf
219
220 Else && Shipment
221 * Find Qty and Cost Information based on Category (Quantities are always 1):
222 * Cost and Ext_Cost are: Sum(zzccostd.Extension) for all production lines
223 * with this category.
224 If Empty(lcCategory)
225 * Didn't find proper record (validation ensures it won't ever happen,
226 * but just to be safe)...
227 lnCost = 0
228 Else && Category entered
229 lnCost = .CalculateShipmentExtendedCost(lnShp_Seq, lcCategory, @lnPrevBilled, @lnPrevQty)
230 EndIf
231
232 * --- 1004904 - Per JD, Trx_Qty and AP_Qty on a shipment should now be 0. Also changed AP_Amt from
233 * defaulting to only lnCost to lnCost - lnPrevBilled:
234 Replace ;
235 AP_Amt WITH IIF(AP_Amt = 0 AND lcType = AP_LINE_TYPE_SHIPMENT, lnCost - lnPrevBilled, AP_Amt), ;
236 Trx_Qty With 0, ;
237 Cmpl_Qty With 1, ;
238 AP_Qty With 0, ;
239 Cost With lnCost, ;
240 UI_Ext_Cost With Round(lnCost, 2), ;
241 UI_Prev_Billed With lnPrevBilled, ;
242 UI_Prev_Qty With lnPrevQty ;
243 in (This.cDetailAlias)
244 * === 1004904 End.
245
246 * Code after implementing Stage (next version) will look like the following.
247 * Remember, there is a flag - zzctypeh.accum_shp that determines whether
248 * to accumulate the cost from the previous shipping line(s) or not (don't
249 * currently need to worry about this because we're just getting Last_Stage records.
250*!* SELECT Category, Shp_Seq, SUM(Extension) FROM
251*!* (SELECT Category, s.Shp_Seq, Max(Extension)
252*!* FROM zzccostd d JOIN zzcordrd c on d.FKey = c.PKey
253*!* JOIN zzcordrd s on s.FKey = c.FKey AND
254*!* RTRIM(c.Tree_Seq) LIKE RTRIM(s.Tree_Seq) + '%'
255*!* JOIN zzctypeh ty ON s.Prod_Type = ty.Prod_Type
256*!* WHERE c.Last_Stage = 'Y' AND s.Shp_Seq > 0
257*!* AND s.PKey <> c.PKey AND Accum_Shp = 'Y'
258*!* GROUP by Category, S.Shp_Seq
259*!* UNION ALL
260*!* SELECT Category, s.Shp_Seq, Sum(Extension)
261*!* FROM zzccostd d JOIN zzcordrd c on d.FKey = c.PKey
262*!* JOIN zzcordrd s on s.FKey = c.FKey AND
263*!* RTRIM(c.Tree_Seq) LIKE RTRIM(s.Tree_Seq) + '%'
264*!* JOIN zzctypeh ty ON s.Prod_Type = ty.Prod_Type
265*!* WHERE c.Last_Stage = 'Y' AND s.Shp_Seq > 0
266*!* AND s.PKey <> c.PKey AND Accum_Shp = 'N'
267*!* GROUP by Category, s.Shp_Seq) AS tcAlias
268*!* GROUP by Category, Shp_Seq
269 EndIf
270
271 * --- 1003625 03/04 CB - Added Skip Defaults so as not to override values entered on
272 * mass population screen:
273 IF NOT plSkipDefaults
274 .SetDefaultAmountAndQuantity() && 37481 - Default AP_Qty and AP_Amt
275 ENDIF
276 * === 1003625 End.
277
278 EndWith
279ENDFUNC
280
281*==================================================
282
283FUNCTION GetSKUInfo
284 * Gets Stage, Division, Color, Label, Dimension, and Transaction Qty for this detail record.
285 Local lnProd_Num, lnProd_Line, lcType, lnPKey, lcCategory
286
287 * Get SKU Information from order detail
288 lnProd_Num = Evaluate(This.cDetailAlias + ".Prod_Num")
289 lnProd_Line = Evaluate(This.cDetailAlias + ".Prod_Line")
290 lcType = Alltrim(Evaluate(This.cDetailAlias + ".Line_Type"))
291 lnPKey = Evaluate(This.cDetailAlias + ".Trx_PKey")
292
293 *--- TechRec 1039635 23-Apr-2009 vkrishnamurthy ---
294 LOCAL lnSelect
295 lnSelect = SELECT()
296 *=== TechRec 1039635 23-Apr-2009 vkrishnamurthy ===
297
298 WITH This
299 .TableClose(.cTmpAlias)
300 vl_cordrd(lnPKey, , .cTmpAlias)
301
302 If Used(.cTmpAlias) AND NOT EOF(.cTmpAlias)
303 *--- TechRec 1039635 23-Apr-2009 vkrishnamurthy ---
304 SELECT(.cTmpAlias)
305 Scatter Name .OProdDetail
306 *=== TechRec 1039635 23-Apr-2009 vkrishnamurthy ===
307
308 Replace ;
309 Stage With Evaluate(.cTmpAlias + ".Stage"), ;
310 Stage_Num With Evaluate(.cTmpAlias + ".Stage_Num"), ;
311 Division With Evaluate(.cTmpAlias + ".Division"), ;
312 Style With Evaluate(.cTmpAlias + ".Style"), ;
313 Color_Code With Evaluate(.cTmpAlias + ".Color_Code"), ;
314 Lbl_Code With Evaluate(.cTmpAlias + ".Lbl_Code"), ;
315 Dimension With Evaluate(.cTmpAlias + ".Dimension"), ;
316 Trx_Qty With Evaluate(.cTmpAlias + ".Total_Qty") ;
317 in (.cDetailAlias)
318
319 *--- TR 1038235 12-FEB-2009 VKK
320 REPLACE Trx_Qty WITH IIF(Evaluate(.cTmpAlias + ".Last_Stage") = "Y", Evaluate(.cTmpAlias + ".Total_Qty"), ;
321 Evaluate(.cTmpAlias + ".Wip_Total")) ;
322 IN (.cDetailAlias)
323 *=== TR 1038235 12-FEB-2009 VKK
324
325 *--- TR 1048474 12-NOV-10 KISHOR
326 REPLACE ;
327 trans_date WITH EVALUATE(.cTmpAlias + ".trans_date"), ;
328 lot WITH EVALUATE(.cTmpAlias + ".lot"), ;
329 roll_num WITH EVALUATE(.cTmpAlias + ".roll_num") ;
330 IN (.cDetailAlias)
331 *=== TR 1048474 12-NOV-10 KISHOR
332
333 *--- TR 1072309 KISHORE 23-JUL-2013
334 lnVndr_conversion = 0
335 lnTrx_qty = EVALUATE(.cDetailAlias + '.trx_qty')
336 IF EVALUATE(.cDetailAlias + '.prod_line') > 0 AND lnTrx_qty # 0
337 lnVndr_conversion = EVALUATE(.cTmpAlias + '.vndr_conversion')
338 IF NVL(lnVndr_conversion,0) > 0
339 REPLACE trx_qty WITH ROUND(lnTrx_qty/lnVndr_conversion, 5) IN (.cDetailAlias)
340 ENDIF
341 ENDIF
342 *=== TR 1072309 KISHORE 23-JUL-2013
343
344 EndIf
345 ENDWITH
346 *--- TechRec 1039635 23-Apr-2009 vkrishnamurthy ---
347 SELECT(lnSelect)
348 *=== TechRec 1039635 23-Apr-2009 vkrishnamurthy ===
349
350ENDFUNC
351
352*==================================================
353
354FUNCTION SumColumns
355 PARAMETERS p_nTrxQty, p_nExtCost, p_nPrevBilled, p_nCost, p_nPrevQty, p_nAP_Amt, p_nAP_Qty
356 Local lcSQLString, lnSelect, lnRecNo, lnCount
357
358 *--- 1005999 08/04 CB - added p_nAP_Qty, beautified:
359 lnSelect = Select()
360 p_nTrxQty = 0
361 p_nCost = 0
362 p_nExtCost = 0
363 p_nPrevBilled = 0
364 p_nPrevQty = 0
365 p_nAP_Amt = 0
366 p_nAP_Qty = 0
367 *=== 1005999 end.
368
369 WITH This
370 lnRecNo = RecNo(.cDetailAlias)
371 lnCount = 0
372
373 If NOT (EOF(.cDetailAlias) OR lnRecNo = 0 OR lnRecNo > RecCount(.cDetailAlias))
374 Select (.cDetailAlias)
375 Scan
376 *--- 1005999 08/04 CB - added p_nAP_Qty, beautified:
377 lnCount = lnCount + 1
378 p_nCost = p_nCost + Evaluate(.cDetailAlias + ".Cost")
379 p_nTrxQty = p_nTrxQty + Evaluate(.cDetailAlias + ".Trx_Qty")
380 p_nExtCost = p_nExtCost + Evaluate(.cDetailAlias + ".UI_Ext_Cost")
381 p_nPrevBilled = p_nPrevBilled + Evaluate(.cDetailAlias + ".UI_Prev_Billed")
382 p_nPrevQty = p_nPrevQty + Evaluate(.cDetailAlias + ".UI_Prev_Qty")
383 p_nAP_Amt = p_nAP_Amt + Evaluate(.cDetailAlias + ".AP_Amt")
384 p_nAP_Qty = p_nAP_Qty + Evaluate(.cDetailAlias + ".AP_Qty")
385 *=== 1005999 end.
386 EndScan
387 Go (lnRecNo) in .cDetailAlias
388 EndIf
389
390 Select (lnSelect)
391 ENDWITH
392ENDFUNC
393
394*==================================================
395
396FUNCTION UpdateVoucherUIs
397 LPARAMETERS plProrate
398 LOCAL lcView, llRetVal, llSendUpdates, lnWorkArea, lcFilter, llBalanced, lcHeaderView, ;
399 lcUnBalanced, llUpdateStatus, lcNewStatus
400
401 * Update this voucher's detail lines
402
403 llRetVal = true
404 lcView = This.cDetailAlias
405 lcHeaderView = This.cHeaderAlias
406 lcUnBalanced = goEnv.sv("AP_STATUS_UNBALANCED", AP_STATUS_OPEN)
407 IF NOT USED(lcView) OR RECCOUNT(lcView) = 0
408 RETURN llRetVal
409 ENDIF
410
411 lnSelect = Select()
412 lnPKey = Evaluate(lcView + ".PKey")
413
414 WITH This
415 IF CURSORGETPROP('SourceType', lcView) = DB_SRCREMOTEVIEW && Remote view
416 llSendUpdates = CURSORGETPROP('SendUpdates', lcView)
417 CURSORSETPROP('SendUpdates', false, lcView)
418
419 llBalanced = .CalculateUIFields(lcFilter) && Massage the data
420 *--- TechRec 1031878 27-May-2008 vkrishnamurthy ---
421*!* llUpdateStatus = false
422*!* If llBalanced
423*!* * Balanced - need to set?
424*!* If (Alltrim(Evaluate(lcHeaderView + ".AP_Status")) = AP_STATUS_OPEN OR ;
425*!* Alltrim(Evaluate(lcHeaderView + ".AP_Status")) = lcUnBalanced)
426*!* llUpdateStatus = true
427*!* lcNewStatus = AP_STATUS_BALANCED
428*!* EndIf
429*!* Else
430*!* * Not balanced - set it to unbalanced?
431*!* *--- 1026577 08-23-2007 SKG
432*!* *!* If Alltrim(Evaluate(lcHeaderView + ".AP_Status")) = AP_STATUS_BALANCED
433*!* If Alltrim(Evaluate(lcHeaderView + ".AP_Status")) = AP_STATUS_BALANCED OR ;
434*!* Alltrim(Evaluate(lcHeaderView + ".AP_Status")) = AP_STATUS_OPEN
435*!* *=== 1026577 08-23-2007 SKG
436*!* llUpdateStatus = true
437*!* lcNewStatus = lcUnBalanced
438*!* EndIf
439*!* EndIf
440
441 llUpdateStatus = false
442 If llBalanced
443 * Balanced - need to set?
444 If (Alltrim(Evaluate(lcHeaderView + ".AP_Status")) = AP_STATUS_OPEN OR ;
445 Alltrim(Evaluate(lcHeaderView + ".AP_Status")) = lcUnBalanced OR ;
446 Alltrim(Evaluate(lcHeaderView + ".AP_Status")) = .cAPPendingStatus )
447 llUpdateStatus = true
448 EndIf
449 Else
450 If Alltrim(Evaluate(lcHeaderView + ".AP_Status")) = AP_STATUS_BALANCED OR ;
451 Alltrim(Evaluate(lcHeaderView + ".AP_Status")) = AP_STATUS_OPEN OR ;
452 Alltrim(Evaluate(lcHeaderView + ".AP_Status")) = .cAPPendingStatus
453 llUpdateStatus = true
454 EndIf
455 EndIf
456
457 lcNewStatus = .GetHeaderStatus()
458 *=== TechRec 1031878 27-May-2008 vkrishnamurthy ===
459
460 If llUpdateStatus AND CURSORGETPROP('SourceType', lcHeaderView) = DB_SRCREMOTEVIEW && Remote view
461 * Update AP_Status to show that this Voucher is now BALANCED/UNBALANCED:
462
463 * We only want to set Status to BALANCED if lAutoApprove is false (let it happen
464 * through the save - see m_balhdrdtl):
465 * --- 1005999 07/04 CB - Fixed bug - wasn't setting status to UNBALANCED if auto approve was on
466 *--- TechRec 1031878 27-May-2008 vkrishnamurthy ---
467*!* IF NOT .lAutoApprove OR lcNewStatus = lcUnBalanced
468 IF NOT .lAutoApprove OR lcNewStatus = lcUnBalanced OR lcNewStatus = .cAPPendingStatus
469 *=== TechRec 1031878 27-May-2008 vkrishnamurthy ===
470 * === 1005999 end.
471 SELECT (.cHeaderAlias)
472 REPLACE AP_Status WITH lcNewStatus IN (lcHeaderView)
473
474 *--- TechRec 1031878 27-May-2008 vkrishnamurthy ---
475 IF llBalanced
476 *--- TechRec 1036315 20-Oct-2008 T.Shenbagavalli chaged datetime() to date() ---
477 REPLACE APPV_Date WITH DATE() IN (lcHeaderView)
478 ENDIF
479 *=== TechRec 1031878 27-May-2008 vkrishnamurthy ===
480
481 lnWorkArea = SELECT()
482 SELECT (lcHeaderView)
483* llRetVal = .TableUpdate(lcHeaderView) &&& 1041776 AZ
484
485 SELECT (lnWorkArea)
486 ENDIF
487 ENDIF
488
489 lnWorkArea = SELECT()
490 SELECT (lcView)
491 .PushRecordSet()
492 llRetVal = .TableUpdate(lcView)
493 .PopRecordSet()
494 SELECT (lnWorkArea)
495
496 CURSORSETPROP('SendUpdates', llSendUpdates, lcView)
497 ENDIF
498 ENDWITH
499 RETURN llRetVal
500ENDFUNC
501
502*==================================================
503
504FUNCTION CalculateUIFields
505 LPARAMETERS pcFilter
506 LOCAL lcFilter, lnPrevBilled, lnPrevQty, lnExtCost, llAllBalanced, lcType, ;
507 lnTolr_Pct, lnTolr_Amt, lnAPTestVal, lnAPWithTolPct, lnAPWithTolAmt, lnAPHighEnd, lnAPLowEnd
508
509 *--- TechRec 1031878 26-May-2008 vkrishnamurthy ---
510 LOCAL lnGITRecvdcost, lnGITRecvdQty ,lcPrdStageCond ,lnorigExtCost, llExcessApQty, llCurrentBalanced
511 lnGITRecvdcost = 0
512 lnGITRecvdQty = 0
513 lnorigExtCost = 0
514 llExcessApQty = true
515 llCurrentBalanced = true
516 *=== TechRec 1031878 26-May-2008 vkrishnamurthy ===
517
518
519 lcFilter = IIF(EMPTY(pcFilter), "", " FOR " + pcFilter)
520 llAllBalanced = true
521
522 WITH This
523 *--- TechRec 1031878 28-May-2008 vkrishnamurthy ---
524 .cHdrTermsFlag = .GetHeaderTermsPOFlag()
525 *=== TechRec 1031878 28-May-2008 vkrishnamurthy ===
526
527 .PushRecordSet() && to restore current alias
528 SELECT (.cDetailAlias)
529 .PushRecordSet() && to restore new alias' record pointer
530
531 SCAN &lcFilter
532
533 *--- TechRec 1031091 05-May-2008 vkrishnamurthy ---
534 *--- TR 1034316 19-JAN-2009 VKK Added cAPLineTypeRoyalty condition
535 IF NOT ALLTRIM(Line_Type) == This.cAP_Line_Type_Prod_CBK AND ;
536 NOT ALLTRIM(Line_Type) == This.cAPLineTypeRoyalty
537 *=== TechRec 1031091 05-May-2008 vkrishnamurthy ===
538
539 * --- 1003625 CB 03/04 - Get Tolerance rate and percent.
540 * If AP_Amt +- Tolerance Rate AND Percent falls within ExtendedCost - PrevBilled,
541 * consider the voucher line balanced.
542 lnTolr_Pct = 0
543 lnTolr_Amt = 0
544 IF SEEK(SysgetFieldvalue(This.cDetailAlias,"Category"), "tc_zzdcatgr", "Category")
545 lnTolr_Pct = tc_zzdcatgr.Tolr_Pct
546 lnTolr_Amt = tc_zzdcatgr.Tolr_Amt
547 ENDIF
548 * === 1003625 End.
549
550 .GetPreviousAmounts(@lnPrevBilled, @lnPrevQty)
551
552 *--- TechRec 1031878 27-May-2008 vkrishnamurthy ---
553 .cDtlCatgFlag = .GetDetailCatgPOFlag()
554
555 .cShpTermsFlag = .GetShpTermsPOFlag(SysgetFieldValue(.cDetailalias, "Prod_num"),SysgetFieldValue(.cDetailalias, "Division"))
556
557 lcPrdStageCond = 'R' && default Recv stage
558 IF .cHdrTermsFlag = 'I' OR .cDtlCatgFlag = 'I' OR .cShpTermsFlag = 'I'
559 lcPrdStageCond = 'I'
560 ENDIF
561
562 IF EMPTY(.cHdrTermsFlag) AND Empty(.cDtlCatgFlag) AND EMPTY(.cShpTermsFlag)
563 lcPrdStageCond = ''
564 ENDIF
565
566 IF SysgetFieldValue(.cDetailalias,"Line_Type") <> AP_LINE_TYPE_PROD_ORD
567 lcPrdStageCond = ''
568 ENDIF
569
570 .cPrdStageCond = lcPrdStageCond
571
572 IF NOT Empty(lcPrdStageCond) AND SysgetFieldValue(.cDetailalias,"Line_Type") = AP_LINE_TYPE_PROD_ORD
573* --- TR 1048606 RLN 08/02/10
574* .GetProductionValues(SysgetFieldValue(.cDetailalias, "Prod_Num"),;
575* SysgetFieldValue(.cDetailalias, "TRX_PKEY"),lcPrdStageCond,@lnGITRecvdcost, @lnGITRecvdQty)
576 .GetProductionValues(SysgetFieldValue(.cDetailalias, "Prod_Num"),;
577 SysgetFieldValue(.cDetailalias, "TRX_PKEY"),lcPrdStageCond,@lnGITRecvdcost, @lnGITRecvdQty, ;
578 SysgetFieldValue(.cDetailalias, "CMP_STYLE"), SysgetFieldValue(.cDetailalias, "CMP_COLOR"), ;
579 SysgetFieldValue(.cDetailalias, "CMP_LBL"), SysgetFieldValue(.cDetailalias, "CMP_DIM"))
580 ENDIF
581 *=== TechRec 1031878 26-May-2008 vkrishnamurthy ===
582
583 lnAP_Amt = SysgetFieldvalue(This.cDetailAlias,"AP_Amt")
584
585 * Calculate extended cost differently for Shipments vs. Production Orders:
586 lcType = Alltrim(SysgetFieldvalue(This.cDetailAlias,"Line_Type"))
587 Do Case
588 Case lcType = AP_LINE_TYPE_PROD_ORD
589 lnExtCost = Round(SysgetFieldvalue(This.cDetailAlias,"Cost") * SysgetFieldvalue(This.cDetailAlias,"Trx_Qty"), 2)
590 Case lcType = AP_LINE_TYPE_SHIPMENT && Shipment
591 lnExtCost = .CalculateShipmentExtendedCost(SysgetFieldvalue(This.cDetailAlias,"Shp_Seq"), SysgetFieldvalue(This.cDetailAlias,"Category"), @lnPrevBilled, @lnPrevQty)
592 Otherwise
593 lnExtCost = 0 && It'll never happen...
594 EndCase
595
596 *--- TechRec 1031878 28-May-2008 vkrishnamurthy ---
597 lnorigExtCost = lnExtCost
598 *=== TechRec 1031878 28-May-2008 vkrishnamurthy ===
599
600 * See if this transaction is balanced:
601 * --- 1003625 CB 03/04 - Added Tolerance Checking.
602 IF lnTolr_Pct = 0 AND lnTolr_Amt = 0
603 * Original way - must balance exactly:
604 If lnExtCost - lnPrevBilled <> lnAP_Amt
605 llAllBalanced = false
606 *--- TechRec 1036315/1031878 23-Oct-2008 T.Shenbagavalli ---
607 llCurrentBalanced = llAllBalanced
608 *=== TechRec 1036315/1031878 23-Oct-2008 T.Shenbagavalli ===
609 EndIf
610
611 *--- TechRec 1031878 27-May-2008 vkrishnamurthy ---
612 IF NOT EMPTY(.cPrdStageCond) AND lcType = AP_LINE_TYPE_PROD_ORD
613 *--- TechRec 1034685 18-Aug-2008 vkrishnamurthy ---
614*!* llAllBalanced = (SysgetFieldValue(.cDetailalias,"ap_qty") = lnGITRecvdQty) AND ;
615*!* (SysgetFieldValue(.cDetailalias,"ap_amt") = lnGITRecvdcost)
616
617 llAllBalanced = (SysgetFieldValue(.cDetailalias,"ap_qty") + lnPrevQty <= lnGITRecvdQty) AND ;
618 (SysgetFieldValue(.cDetailalias,"ap_amt") + lnPrevBilled <= lnGITRecvdcost)
619
620 *=== TechRec 1034685 18-Aug-2008 vkrishnamurthy ===
621 llCurrentBalanced = llAllBalanced
622 llExcessApQty = (SysgetFieldValue(.cDetailalias,"ap_qty") > lnGITRecvdQty)
623 ENDIF
624 *=== TechRec 1031878 27-May-2008 vkrishnamurthy ===
625
626 ELSE
627 * New way - check tolerance pct and amount. If one is zero, treat it as if it didn't exist.
628 * If both are filled in, see if lnAP_Amt is within acceptable Tolerance Rate and/or Pct:
629 lnAPTestVal = lnPrevBilled + lnAP_Amt
630
631 *--- TechRec 1031878 27-May-2008 vkrishnamurthy ---
632 IF NOT EMPTY(.cPrdStageCond)
633 *--- TR 1031878 29-MAY-2008 VKK
634 *lnAPTestVal = lnGITRecvdcost
635
636 *--- TechRec 1034685 18-Aug-2008 vkrishnamurthy ---
637*!* lnAPTestVal = lnAp_Amt
638 lnAPTestVal = lnAp_Amt + lnPrevBilled
639 *=== TechRec 1034685 18-Aug-2008 vkrishnamurthy ===
640
641 llExcessApQty = (SysgetFieldValue(.cDetailalias,"ap_qty") > lnGITRecvdQty)
642 *=== TR 1031878 29-MAY-2008 VKK
643
644 *--- TechRec 1034685 19-Aug-2008 vkrishnamurthy ---
645*!* lnExtCost = lnGITRecvdcost
646 lnExtCost = (lnGITRecvdcost/lnGITRecvdQty) * (SysgetFieldValue(.cDetailalias,"ap_qty") + lnPrevQty)
647
648 *--- TR 1038235 6-MAR-2009 VKK Result value must not Exceed lnGITRecdCost
649 lnExtCost = MIN(lnExtCost, lnGITRecvdcost)
650 *=== TR 1038235 6-MAR-2009 VKK
651
652 *=== TechRec 1034685 19-Aug-2008 vkrishnamurthy ===
653 ENDIF
654 *=== TechRec 1031878 27-May-2008 vkrishnamurthy ===
655
656 DO CASE
657 CASE lnTolr_Pct = 0
658 * Use AMT as the high end:
659 lnAPHighEnd = lnExtCost + lnTolr_Amt
660 lnAPLowEnd = lnExtCost - lnTolr_Amt && 1005999
661 CASE lnTolr_Amt = 0
662 * Use PCT as the high end:
663 lnAPHighEnd = lnExtCost * (1 + (lnTolr_Pct / 100) )
664 lnAPLowEnd = lnExtCost * (1 - (lnTolr_Pct / 100) ) && 1008695 changed incorrect variable name && 1005999
665 OTHERWISE
666 * Both amt and pct are filled in. Since the cost must pass both of these tests,
667 * the lesser of these two values defines the high end of our range:
668 lnAPWithTolPct = lnExtCost * (1 + (lnTolr_Pct / 100) )
669 lnAPWithTolAmt = lnExtCost + lnTolr_Amt
670 lnAPHighEnd = MIN(lnAPWithTolPct, lnAPWithTolAmt)
671
672 *--- 1005999 CB - Calculate the low end of AP:
673 lnAPWithTolPct = lnExtCost * (1 - (lnTolr_Pct / 100) )
674 lnAPWithTolAmt = lnExtCost - lnTolr_Amt
675 lnAPLowEnd = MAX(lnAPWithTolPct, lnAPWithTolAmt)
676 *=== 1005999 end.
677 ENDCASE
678
679 *--- 1005999 07/04 CB - Added lnAPLowEnd to make tolerance go UP and DOWN:
680 * IF NOT BETWEEN(lnAPTestVal, lnExtCost, lnAPHighEnd)
681 *--- TechRec 1031878 27-May-2008 vkrishnamurthy ---
682*!* IF NOT BETWEEN(lnAPTestVal, lnAPLowEnd, lnAPHighEnd)
683 IF NOT BETWEEN(lnAPTestVal, lnAPLowEnd, lnAPHighEnd) OR ( NOT EMPTY(.cPrdStageCond) AND lnGITRecvdQty = 0)
684 *=== TechRec 1031878 27-May-2008 vkrishnamurthy ===
685 llAllBalanced = false
686 *--- TechRec 1031878 27-May-2008 vkrishnamurthy ---
687 llCurrentBalanced = llAllBalanced
688 *=== TechRec 1031878 27-May-2008 vkrishnamurthy ---
689 ENDIF
690 *=== 1005999 end.
691 ENDIF
692 * === 1003625 End.
693
694 *--- TechRec 1031091 05-May-2008 vkrishnamurthy ---
695 ELSE
696 lnPrevBilled = 0
697 lnPrevQty = 0
698 lnExtCost = 0
699 ENDIF
700 *=== TechRec 1031091 05-May-2008 vkrishnamurthy ===
701 *--- TechRec 1031878 28-May-2008 vkrishnamurthy ---
702*!* REPLACE UI_Prev_Billed WITH lnPrevBilled, ;
703*!* UI_Prev_Qty WITH lnPrevQty, ;
704*!* UI_Ext_Cost WITH Round(lnExtCost, 2) ;
705*!* IN (This.cDetailAlias)
706
707 REPLACE UI_Prev_Billed WITH lnPrevBilled, ;
708 UI_Prev_Qty WITH lnPrevQty, ;
709 UI_Ext_Cost WITH Round(lnorigExtCost, 2), ;
710 GIT_Rcvdcost WITH lnGITRecvdcost ,;
711 GIT_Rcvdqty WITH lnGITRecvdqty, ;
712 AP_status WITH IIF(llCurrentBalanced , AP_STATUS_BALANCED, ;
713 IIF(NOT EMPTY(.cPrdStageCond) AND llExcessApQty, .cAPPendingStatus ,.cAPUnBalancedStatus )) ;
714 IN (This.cDetailAlias)
715 *=== TechRec 1031878 28-May-2008 vkrishnamurthy ===
716 ENDSCAN
717
718 *--- TechRec 1031091 02-May-2008 vkrishnamurthy ---
719 llAllBalanced = llAllBalanced AND .ValidateInvoiceAmount()
720 *=== TechRec 1031091 02-May-2008 vkrishnamurthy ===
721
722 .PopRecordSet()
723 .PopRecordSet()
724 ENDWITH
725 RETURN llAllBalanced
726ENDFUNC
727
728*============================================================
729
730FUNCTION UpdateStatustoBalanced
731 LParameters pcNewStatus
732 pcNewStatus = IIF(Empty(pcNewStatus), AP_STATUS_BALANCED, pcNewStatus)
733
734 WITH This
735 .PushRecordSet() && to restore current alias
736 SELECT (This.cDetailAlias)
737 .PushRecordSet() && to restore new alias' record pointer
738
739 REPLACE AP_Status WITH pcNewStatus ;
740 IN (This.cHeaderAlias)
741
742 .PopRecordSet()
743 .PopRecordSet()
744 ENDWITH
745 RETURN
746ENDFUNC
747
748*============================================================
749
750FUNCTION CalculateShipmentExtendedCost
751 LPARAMETERS pnShp_Seq, pcCategory, pnPrevBilled, pnPrevQty
752 LOCAL lnRetVal, lnSelect, lcActualDutyCategory, lnPrevQty, lnPrevAmt, lnShp_Seq, lcCategory, ;
753 lnFKey, lnPrevCost
754
755 lnRetVal = 0
756 lnSelect = SELECT()
757 lcActualDutyCategory = goEnv.SV("ACTUAL_DUTY_CATEGORY", "ACTDUT")
758
759 IF pcCategory = lcActualDutyCategory
760 * Find the Duty Amount entered on the PO.
761*!* lcSQLString = ;
762*!* "SELECT SUM(Duty_Amount*Total_Qty) AS nCost " + ;
763*!* " FROM zzcordrd " + ;
764*!* " WHERE Shipment_Num = " + SQLFormatNum(pnShp_Seq) + ;
765*!* " GROUP BY Shipment_Num"
766 *--- TR 1011201 31-MAY-2005 VKK Added Syslevel column
767 lcSQLString = ;
768 "SELECT SUM(c.Extension) as nCost FROM zzccostd c " + ;
769 " JOIN zzcordrd d ON d.PKey = c.FKey " + ;
770 " JOIN zzdcatgr g ON g.Category = c.Category " + ;
771 " WHERE d.Shp_Seq = " + SQLFormatNum(pnShp_Seq) + ;
772 " AND g.AP_Category = 'Y'" + ;
773 " AND g.Cost_Type = " + SQLFormatChar(UPPER(CN_DUTY_VALUE)) + ;
774 " AND c.syslevel = 0 " + ;
775 " GROUP BY c.Category"
776 ELSE
777 * Sum the Category entered.
778 *--- TR 1011201 31-MAY-2005 VKK Added Syslevel column
779 lcSQLString = ;
780 "SELECT c.Category, Sum(Extension) as nCost " + ;
781 " FROM zzcordrd d " + ;
782 " JOIN zzccostd c ON c.FKey = d.PKey " + ;
783 " WHERE d.Shp_Seq = " + SQLFormatNum(pnShp_Seq) + ;
784 " AND c.Category = " + SQLFormatChar(pcCategory) + ;
785 " AND c.syslevel = 0 " + ;
786 " GROUP BY c.Category "
787 ENDIF
788
789 WITH This
790 .TableClose(.cTmpAlias)
791 v_SQLExec(lcSQLString, .cTmpAlias)
792
793 lnRetVal = IIf(Used(.cTmpAlias) AND NOT EOF(.cTmpAlias), ;
794 Evaluate(.cTmpAlias + ".nCost"), 0)
795
796 * --- 1003625 03/04 CB - Need to subtract any amounts entered at the PO line level
797 * for this shipment from the cost, as they are preserved amounts, which will
798 * be subtracted from the shipment's cost before proration. We are displaying
799 * here the amount to be dispersed among the remaining NON-preserved PO lines.
800 * Need to check both on the server and locally.
801 .PushRecordSet() && to restore current alias
802 SELECT (.cDetailAlias)
803 .PushRecordSet() && to restore new alias' record pointer
804
805 lnShp_Seq = Shp_Seq
806 lcCategory = Category
807 lnFKey = FKey
808 lnPrevQty = 0
809 lnPrevAmt = 0
810 lnPrevCost = 0 && 1004736
811 lcPKeys = ""
812
813 * 1) Look locally (can't use SQL on buffered view with brand new records).
814 SELECT (This.cDetailalias)
815 SCAN FOR Shp_Seq = lnShp_Seq AND Category = lcCategory AND Line_Type = AP_LINE_TYPE_PROD_ORD
816 lnPrevCost = lnPrevCost + UI_Ext_Cost && 1004736
817 lnPrevAmt = lnPrevAmt + AP_Amt
818 lnPrevQty = lnPrevQty + AP_Qty
819 lcPKeys = lcPKeys + IIF(EMPTY(lcPKeys), "", ", ") + ALLTRIM(STR(PKey))
820 ENDSCAN
821
822 * 2) Look on server:
823
824 lcSQLString = ;
825 "SELECT SUM(AP_Amt) as Prev_Billed, SUM(AP_Qty) as Prev_Qty, SUM(UI_Ext_Cost) AS Prev_Cost " + ;
826 " FROM zzgapvcd " + ;
827 " WHERE Shp_Seq = " + SQLFormatNum(lnShp_Seq) + ;
828 " AND Category = " + SQLFormatChar(lcCategory) + ;
829 " AND Line_Type = " + SQLFormatChar(AP_LINE_TYPE_PROD_ORD) + ;
830 " AND FKey <> " + SQLFormatNum(lnFKey) + ;
831 " GROUP BY Shp_Seq, Category"
832
833 * --- TR 1005369 - CB - 05/04 - Group by wrong, changed in above statement.
834 * " GROUP BY Prod_Num, Prod_Line, Shp_Seq, Category"
835 * === NO 1005369 TR end.
836
837* IIF(EMPTY(lcPKeys), "", " AND PKey NOT IN (" + lcPKeys + ")") +
838
839 llRetVal = v_SQLExec(lcSQLString, "tcTmpPOPrevs")
840 IF llRetVal AND USED("tcTmpPOPrevs") AND RECCOUNT("tcTmpPOPrevs") = 1
841 lnPrevCost = lnPrevCost + tcTmpPOPrevs.Prev_Cost && 1004736
842 lnPrevQty = lnPrevQty + tcTmpPOPrevs.Prev_Qty
843 lnPrevAmt = lnPrevAmt + tcTmpPOPrevs.Prev_Billed
844 ENDIF
845 USE IN SELECT("tcTmpPOPrevs")
846
847 *--- 1004736 04/04 CB - On shipment lines, subtract the sum of the previous COSTs, (not previous
848 * AMOUNTs) from the Extended Cost to determined Extended Cost of remaining items to be prorated.
849* lnRetVal = lnRetVal - lnPrevAmt
850 lnRetVal = lnRetVal - lnPrevCost
851 * === 1004736 End.
852
853 * --- QUICK FIX CB
854* pnPrevBilled = pnPrevBilled + lnPrevAmt
855* pnPrevQty = pnPrevQty + lnPrevQty
856 * === End.
857
858 .PopRecordSet()
859 .PopRecordSet()
860
861 * The coup de grace: If any Prod Lines on this shipment have previously been Preserved,
862 * flag the shipment as preserved to give let the user know:
863 IF lnPrevAmt <> 0
864 REPLACE Preserved WITH "Y" IN (this.cDetailAlias)
865 ENDIF
866 * === 1003625 End.
867 ENDWITH
868
869 SELECT (lnSelect)
870 RETURN lnRetVal
871ENDFUNC
872
873*============================================================
874
875FUNCTION GetPreviousAmounts
876 LPARAMETERS pnPrevBilled, pnPrevQty
877 LOCAL llRetVal, lnSelect, lcTmpCursor, lcSQLString, lcImpTracking
878
879 *--- TechRec 1039635 20-Apr-2009 vkrishnamurthy ---
880 LOCAL lcRangeStyleString
881 lcRangeStyleString = ''
882 *=== TechRec 1039635 20-Apr-2009 vkrishnamurthy ===
883
884 llRetVal = true
885 lnSelect = SELECT()
886
887 pnPrevBilled = 0
888 pnPrevQty = 0
889
890 * --- 1003625 CB Major overhaul.
891 * - Replaced get and scan below with server-side aggregate SUM for
892 * Prod Line / Prod Category.
893 * - If the line type is Prod Ord with a Shipment Category, need to
894 * look for shipments entered against that category as well.
895 * - If the line type is Shipment, need to look for vouchers entered at the
896 * Prod Ord level against this Shipment Number as well.
897 IF SEEK(SysgetFieldvalue(This.cDetailAlias,"Category"), "tc_zzdcatgr", "Category")
898 lcImpTracking = tc_zzdcatgr.Imp_Tracking = 'Y'
899 ELSE
900 lcImpTracking = "N"
901 ENDIF
902
903 * Changed original logic extensively.
904 * 1)Using SUM, rather than SCAN
905 * 2) Changed the key (removed Division and Location).
906 * 3) ALWAYS getting this info. If it's a Prod Line, that's our final answer. If
907 * it's a Shipment Line, we need to subtract this amount from the Shipment cost.
908
909 *!* O R I G I N A L L O G I C:
910 *!* ========================================================
911 *!* WITH This
912 *!* lcTmpCursor = GetUniqueFileName()
913 *!* llRetVal = vl_APVcd(;
914 *!* Evaluate(.cDetailAlias + ".Location"), ;
915 *!* Evaluate(.cDetailAlias + ".Prod_Num"), ;
916 *!* Evaluate(.cDetailAlias + ".Prod_Line"), ;
917 *!* Evaluate(.cDetailAlias + ".Shp_Seq"), ;
918 *!* Evaluate(.cDetailAlias + ".Division"), ;
919 *!* Evaluate(.cDetailAlias + ".Category"), ;
920 *!* Evaluate(.cDetailAlias + ".PKey"), ;
921 *!* lcTmpCursor )
922 *!* If Used(lcTmpCursor)
923 *!* Select (lcTmpCursor)
924 *!* Scan
925 *!* pnPrevBilled = pnPrevBilled + Evaluate(lcTmpCursor + ".Prev_Billed")
926 *!* pnPrevQty = pnPrevQty + Evaluate(lcTmpCursor + ".Prev_Qty")
927 *!* EndScan
928 *!* Use in (lcTmpCursor)
929 *!* EndIf
930 *!* ENDWITH
931 *!* ========================================================
932
933
934 * --- TR 1022799 HNISAR 22-MAr-2007
935
936*!* lcSQLString = ;
937*!* "SELECT SUM(AP_Amt) as Prev_Billed, SUM(AP_Qty) as Prev_Qty " + ;
938*!* " FROM zzgapvcd " + ;
939*!* " WHERE Shp_Seq = " + SQLFormatNum(Vzzgapvcd.Shp_Seq) + ;
940*!* " AND Category = " + SQLFormatChar(Vzzgapvcd.Category) + ;
941*!* IIF(Vzzgapvcd.Line_Type = AP_LINE_TYPE_SHIPMENT, "", ;
942*!* " AND Prod_Num = " + SQLFormatNum(Vzzgapvcd.Prod_Num) + ;
943*!* " AND Prod_Line = " + SQLFormatNum(Vzzgapvcd.Prod_Line)) + ;
944*!* " AND PKey <> " + SQLFormatNum(Vzzgapvcd.PKey) + ;
945*!* " GROUP BY " + ;
946*!* IIF(Vzzgapvcd.Line_Type = AP_LINE_TYPE_SHIPMENT, "", "Prod_Num, Prod_Line, ") + ;
947*!* "Shp_Seq, Category"
948
949
950 WITH THIS
951
952 llRetVal = .GetProductionLines ( SysgetFieldvalue(This.cDetailAlias,"Prod_Num"), SysgetFieldvalue(This.cDetailAlias,"TRX_PKEY"))
953
954 *--- TechRec 1039635 20-Apr-2009 vkrishnamurthy ---
955 IF .lExplodeVchForRangeStyle
956 lcRangeStyleString = " AND Cmp_style = " + SQLFormatChar(SysgetFieldvalue(This.cDetailAlias,"Cmp_style"))+ ;
957 " AND Cmp_color = " + SQLFormatChar(SysgetFieldvalue(This.cDetailAlias,"Cmp_color")) + ;
958 " AND Cmp_lbl = " + SQLFormatChar(SysgetFieldvalue(This.cDetailAlias,"Cmp_lbl")) + ;
959 " AND Cmp_dim = " + SQLFormatChar(SysgetFieldvalue(This.cDetailAlias,"Cmp_dim"))
960 ENDIF
961 *=== TechRec 1039635 20-Apr-2009 vkrishnamurthy ===
962
963
964 *--- TechRec 1031091 05-May-2008 vkrishnamurthy ---
965*!* lcSQLString = ;
966*!* "SELECT SUM(AP_Amt) as Prev_Billed, SUM(AP_Qty) as Prev_Qty " + ;
967*!* " FROM zzgapvcd " + ;
968*!* " WHERE Shp_Seq = " + SQLFormatNum(Vzzgapvcd.Shp_Seq) + ;
969*!* " AND Category = " + SQLFormatChar(Vzzgapvcd.Category) + ;
970*!* " " + .cFltrStrPrevDeltFrmAllStages +;
971*!* " AND PKey <> " + SQLFormatNum(Vzzgapvcd.PKey) +;
972*!* " GROUP BY " + ;
973*!* IIF(Vzzgapvcd.Line_Type = AP_LINE_TYPE_SHIPMENT, "", "Prod_Num, ") + ;
974*!* "Shp_Seq, Category"
975
976
977 *--- TechRec 1034239 27-Jun-2008 vkrishnamurthy --- conditionaly include shp_seq join VKK
978*!* lcSQLString = ;
979*!* "SELECT SUM(AP_Amt) as Prev_Billed, SUM(AP_Qty) as Prev_Qty " + ;
980*!* " FROM zzgapvcd " + ;
981*!* " WHERE Shp_Seq = " + SQLFormatNum(SysgetFieldValue(This.CdetailAlias, "Shp_Seq")) + ;
982*!* " AND Category = " + SQLFormatChar(SysgetFieldValue(This.CdetailAlias, "Category")) + ;
983*!* " " + .cFltrStrPrevDeltFrmAllStages +;
984*!* " AND PKey <> " + SQLFormatNum(SysgetFieldValue(This.CdetailAlias, "PKey")) +;
985*!* " AND Line_Type <> " + SQLFormatChar(This.cAP_Line_Type_Prod_CBK) + ;
986*!* " GROUP BY " + ;
987*!* IIF(SysgetFieldValue(This.CdetailAlias, "Line_Type") = AP_LINE_TYPE_SHIPMENT, "", "Prod_Num, ") + ;
988*!* "Shp_Seq, Category"
989
990 *--- TechRec 1039635 15-Apr-2009 vkrishnamurthy ---
991*!* lcSQLString = ;
992*!* "SELECT SUM(AP_Amt) as Prev_Billed, SUM(AP_Qty) as Prev_Qty " + ;
993*!* " FROM zzgapvcd " + ;
994*!* " WHERE 1 = 1 " + ;
995*!* IIF(SysgetFieldvalue(This.cDetailAlias,"Line_Type")= AP_LINE_TYPE_PROD_ORD , " " , " AND Shp_Seq = " +SQLFormatNum(SysgetFieldvalue(This.cDetailAlias,"Shp_Seq")))+ ;
996*!* " AND Category = " + SQLFormatChar(SysgetFieldvalue(This.cDetailAlias,"Category")) + ;
997*!* " " + .cFltrStrPrevDeltFrmAllStages +;
998*!* " AND PKey <> " + SQLFormatNum(SysgetFieldvalue(This.cDetailAlias,"PKey")) +;
999*!* " AND Line_Type <> " + SQLFormatChar(This.cAP_Line_Type_Prod_CBK) + ;
1000*!* " GROUP BY " + ;
1001*!* IIF(SysgetFieldvalue(This.cDetailAlias,"Line_Type")= AP_LINE_TYPE_SHIPMENT, "Shp_Seq,", "Prod_Num, ") + ;
1002*!* " Category"
1003
1004 lcSQLString = ;
1005 "SELECT SUM(AP_Amt) as Prev_Billed, SUM(AP_Qty) as Prev_Qty " + ;
1006 " FROM zzgapvcd " + ;
1007 " WHERE 1 = 1 " + ;
1008 IIF(SysgetFieldvalue(This.cDetailAlias,"Line_Type")= AP_LINE_TYPE_PROD_ORD , " " , " AND Shp_Seq = " +SQLFormatNum(SysgetFieldvalue(This.cDetailAlias,"Shp_Seq")))+ ;
1009 " AND Category = " + SQLFormatChar(SysgetFieldvalue(This.cDetailAlias,"Category")) + ;
1010 lcRangeStyleString + ;
1011 " " + .cFltrStrPrevDeltFrmAllStages +;
1012 " AND PKey <> " + SQLFormatNum(SysgetFieldvalue(This.cDetailAlias,"PKey")) +;
1013 " AND Line_Type <> " + SQLFormatChar(This.cAP_Line_Type_Prod_CBK) + ;
1014 " GROUP BY " + ;
1015 IIF(SysgetFieldvalue(This.cDetailAlias,"Line_Type")= AP_LINE_TYPE_SHIPMENT, "Shp_Seq,", "Prod_Num, ") + ;
1016 " Category"
1017
1018 *=== TechRec 1039635 15-Apr-2009 vkrishnamurthy ===
1019
1020 *=== TechRec 1034239 27-Jun-2008 vkrishnamurthy ===
1021
1022
1023 *=== TechRec 1031091 05-May-2008 vkrishnamurthy ===
1024
1025 ENDWITH
1026
1027 * === TR 1022799 HNISAR 22-MAr-2007
1028 llRetVal = v_SQLExec(lcSQLString, "tcTmpPOPrevs")
1029 IF llRetVal AND USED("tcTmpPOPrevs") AND RECCOUNT("tcTmpPOPrevs") = 1
1030 pnPrevBilled = tcTmpPOPrevs.Prev_Billed
1031 pnPrevQty = tcTmpPOPrevs.Prev_Qty
1032 ENDIF
1033 USE IN SELECT("tcTmpPOPrevs")
1034
1035 SELECT (lnSelect)
1036 RETURN llRetVal
1037ENDFUNC
1038
1039*============================================================
1040
1041FUNCTION SetDefaultAmountAndQuantity
1042 * 37481 2/28/03 CB
1043 * Sets the default AP Quantity / AP Amount when a
1044 * new detail record is being entered.
1045
1046 LOCAL llRetVal, lnSelect, lnAP_Qty, lnAP_Amt
1047
1048 llRetVal = true
1049 lnSelect = SELECT()
1050
1051 WITH This
1052
1053 Select (.cDetailAlias)
1054 lnAP_Qty = Trx_Qty - UI_Prev_Qty
1055 lnAP_Amt = UI_Ext_Cost - UI_Prev_Billed
1056
1057 * --- 1003625 03/04 CB - Added preserved flag. If item is PRESERVED, don't overwrite, not if
1058 * AP_Amt is empty, in case user has gone back and entered a different category:
1059* If Empty(AP_Amt) AND lnAP_Amt >= 0
1060* Replace ;
1061* AP_Amt With lnAP_Amt ;
1062* in (.cDetailAlias)
1063* EndIf
1064*
1065* If Empty(AP_Qty) AND lnAP_Qty >= 0
1066* Replace ;
1067* AP_Qty With lnAP_Qty ;
1068* in (.cDetailAlias)
1069* EndIf
1070
1071 *--- TR 1034239 27-JUN-2008 VKK Need to replace ap_amt/qty if prev billed > 0
1072 *If EMPTY(SysgetFieldValue(.cDetailAlias, "AP_Amt")) OR SysgetFieldValue(.cDetailAlias, "Preserved") <> "Y"
1073 If EMPTY(SysgetFieldValue(.cDetailAlias, "AP_Amt")) OR ;
1074 SysgetFieldValue(.cDetailAlias, "Preserved") <> "Y" OR ;
1075 NOT EMPTY(SysgetFieldValue(.cDetailAlias, "UI_Prev_Billed"))
1076 *=== TR 1034239 27-JUN-2008 VKK
1077
1078 *--- TR 1038235 22-Oct-2008 VKK handled -ve qty./amt
1079 Replace ;
1080 AP_Amt With IIF(lnAP_Amt <=0, 0 , lnAP_Amt), ; && TR 1038235
1081 AP_Qty With IIF(lnAP_Qty <=0, 0, lnAP_Qty ) ; && TR 1038235
1082 in (.cDetailAlias)
1083 EndIf
1084 * === 1003625 End.
1085
1086 ENDWITH
1087
1088 SELECT (lnSelect)
1089 RETURN llRetVal
1090ENDFUNC
1091
1092FUNCTION CreateVoucherTempTables
1093 LParameters tcProdHeaderName, tcProdDetailName, tcShipmentName, ;
1094 tcCostSheetName, tcBOMName, tcTempShipmentHolderName
1095 Local lcSQLString, lcTree_Seq, lcFilename, lcProdOrdDPKeys, lcProdOrdHPKeys, ;
1096 lcCostAndBOMKeys, lcShipmentNums, llRetVal, lnSelect
1097
1098 *--- TR 1038235 22-Oct-2008 VKK
1099 LOCAL lcTmpCurordrd, lcTmpCurordrh, lcTmpCurshpmh
1100 STORE "" TO lcTmpCurordrd, lcTmpCurordrh, lcTmpCurshpmh
1101 *=== TR 1038235 22-Oct-2008 VKK
1102
1103 LOCAL lcWhere &&& 1049037 AZ
1104
1105 * First, get a list of all current stage zzcordrd PKey's that the zzcordrd record
1106 * entered on the voucher has branched off to (just the leaves).
1107 * Also getting list of Shipment Numbers on this voucher.
1108
1109 llRetVal = true
1110 lcFilename = GetUniqueFilename()
1111 lcProdOrdDPKeys = ''
1112 lcProdOrdHPKeys = ''
1113 lcShipmentNums = ''
1114 lnSelect = Select()
1115
1116 With This
1117 Select (.cDetailAlias)
1118 Scan
1119 Do Case
1120 *--- TechRec 1031091 01-May-2008 vkrishnamurthy ---
1121*!* Case Alltrim(Line_Type) == AP_LINE_TYPE_PROD_ORD
1122 Case (Alltrim(Line_Type) == AP_LINE_TYPE_PROD_ORD OR Alltrim(Line_Type) == .cAP_Line_Type_Prod_CBK)
1123 *=== TechRec 1031091 01-May-2008 vkrishnamurthy ===
1124 lcTree_Seq = Alltrim(vl_cordrd(Evaluate(.cDetailAlias + ".Trx_PKey"), 'Tree_Seq')) + "%"
1125 lcSQLString = ;
1126 "SELECT PKey, FKey, prod_num,open_seq " + ; &&& 1049037 AZ add prod_num and open_seq
1127 " FROM zzcordrd l " + ;
1128 " WHERE l.Prod_Num = " + SQLFormatNum(Evaluate(.cDetailAlias + ".Prod_Num")) + ;
1129 " AND l.Tree_Seq LIKE " + SQLFormatChar(lcTree_Seq) + ;
1130 " AND NOT EXISTS " + ;
1131 " (SELECT ParKey FROM zzcordrd p WHERE p.ParKey = l.PKey) "
1132 v_SQLExec(lcSQLString, lcFileName) && Local Cursor
1133 If Used(lcFileName)
1134 Select (lcFileName)
1135 Scan
1136 lcProdOrdDPKeys = lcProdOrdDPKeys + Alltrim(Str(Evaluate(lcFileName + ".PKey"))) + ','
1137 lcProdOrdHPKeys = lcProdOrdHPKeys + Alltrim(Str(Evaluate(lcFileName + ".FKey"))) + ','
1138 EndScan
1139 EndIf
1140
1141 IF SysgetFieldvalue(This.cDetailAlias,"Shp_Seq") > 0
1142 lcShipmentNums = lcShipmentNums + Alltrim(Str(Evaluate(.cDetailAlias + ".Shp_Seq"))) + ','
1143 ENDIF
1144
1145 Case Alltrim(Line_Type) == AP_LINE_TYPE_SHIPMENT
1146 lcShipmentNums = lcShipmentNums + Alltrim(Str(Evaluate(.cDetailAlias + ".Shp_Seq"))) + ','
1147
1148 Otherwise && ??? Next TAN incorporates more!
1149 EndCase
1150 EndScan
1151
1152 lnLen = Len(lcShipmentNums)
1153 If lnLen > 0
1154 * Chop off last comma:
1155 lcShipmentNums = " WHERE Shipment_Num in (" + Left(lcShipmentNums, lnLen - 1) + ')'
1156 Else
1157 * Empty - no Prod Ords on this voucher. Return all rows so CreateSQLView
1158 * doesn't report error.
1159 lcShipmentNums = ' WHERE 1=0 '
1160 EndIf
1161
1162 lnLen = Len(lcProdOrdDPKeys)
1163 If lnLen > 0
1164 * Set this one before chopping off comma from lcProdOrdDPKeys
1165 lcCostAndBOMKeys = " WHERE FKey in (" + Left(lcProdOrdDPKeys, lnLen - 1) + ')'
1166
1167 * Chop off last comma:
1168 lcProdOrdDPKeys = " WHERE PKey in (" + Left(lcProdOrdDPKeys, lnLen - 1) + ')'
1169
1170 * Get length of HEADER PKeys (NOTE - this may be different than that of DETAIL:
1171 lnLen = Len(lcProdOrdHPKeys)
1172 lcProdOrdHPKeys = " WHERE PKey in (" + Left(lcProdOrdHPKeys, lnLen - 1) + ')'
1173 Else
1174 * Empty - no Prod Ords on this voucher. Return all rows so CreateSQLView
1175 * doesn't report error.
1176 lcProdOrdDPKeys = ' WHERE 1=0 '
1177 lcProdOrdHPKeys = ' WHERE 1=0 '
1178 lcCostAndBOMKeys = ' WHERE 1=0 '
1179 EndIf
1180
1181 If Used(lcFileName)
1182 Use in (lcFileName)
1183 EndIf
1184
1185 * Select All Production Detail Records into Temp Cursor:
1186 * "SELECT PKey, FKey, Cost, Total_Qty, Prod_Value "
1187
1188*--- TR 1049037 01/05/11 AZ
1189****
1190lcSQLString = " SELECT distinct prod_num,open_seq from zzcordrd " + lcProdOrdDPKeys
1191=v_sqlexec(lcSQLString,lcFileName)
1192
1193IF USED(lcFileName) AND RECCOUNT(lcFileName) > 0
1194 SELECT (lcFileName)
1195 lcWhere = ''
1196 SCAN
1197 lcWhere = lcWhere+ "(prod_num = " +SqlFormatNum(prod_num)+" and open_seq = "+SqlFormatNum(open_seq)+" ) OR "
1198 ENDSCAN
1199 IF !EMPTY(lcwhere) AND RIGHT(lcwhere,3) = "OR "
1200 lcWhere = " WHERE "+lcWhere+" (1=2)"
1201 ENDIF
1202 lcSQLString = ;
1203 "SELECT * FROM zzcordrd " + lcWhere
1204ELSE
1205 lcSQLString = ;
1206 "SELECT * FROM zzcordrd " + lcProdOrdDPKeys
1207ENDIF
1208*=== TR 1049037 01/05/11 AZ
1209
1210
1211 *--- TR 1038235 22-Oct-2008 VKK
1212* lcSqlString = "SELECT * FROM zzcordrd " + lcProdOrdDPKeys &&& 1049037 AZ
1213 lcTmpCurordrd = SQLTableFromQuery(lcSqlString)
1214 llRetVal = llRetVal AND !EMPTY(lcTmpCurordrd)
1215
1216 lcSqlString = "SELECT * FROM zzcordrh " + lcProdOrdHPKeys
1217 lcTmpCurordrh = SQLTableFromQuery(lcSqlString)
1218 llRetVal = llRetVal AND !EMPTY(lcTmpCurordrh)
1219
1220 lcSqlString = "SELECT * FROM zzmshpmh " + lcShipmentNums
1221 lcTmpCurshpmh = SQLTableFromQuery(lcSqlString)
1222 llRetVal = llRetVal AND !EMPTY(lcTmpCurshpmh)
1223 *=== TR 1038235 22-Oct-2008 VKK
1224
1225
1226 *--- TR 1038235 22-Oct-2008 VKK
1227 *lcSQLString = ;
1228 "SELECT * FROM zzcordrd " + lcProdOrdDPKeys
1229 lcSQLString = ;
1230 "SELECT * FROM zzcordrd d Where EXISTS(Select Null From " + lcTmpCurordrd + " temp Where temp.pkey = d.pkey)"
1231 *=== TR 1038235 22-Oct-2008 VKK
1232
1233 llRetVal = llRetVal AND .CreateSQLView(tcProdDetailName, lcSQLString, , 'NoOrderBy')
1234 llRetVal = llRetVal AND .OpenTable(tcProdDetailName,,true)
1235
1236 * Select All Production Header Records into Temp Cursor:
1237 *--- TR 1038235 22-Oct-2008 VKK
1238* lcSQLString = ;
1239 "SELECT * FROM zzcordrh " + lcProdOrdHPKeys
1240 lcSQLString = ;
1241 "SELECT * FROM zzcordrh h Where EXISTS(Select Null From " + lcTmpCurordrh + " temp Where temp.pkey = h.pkey)"
1242 *=== TR 1038235 22-Oct-2008 VKK
1243
1244 llRetVal = llRetVal AND .CreateSQLView(tcProdHeaderName, lcSQLString, , 'NoOrderBy')
1245 llRetVal = llRetVal AND .OpenTable(tcProdHeaderName,,true)
1246
1247 * Select All Shipment Records into Temp Cursor:
1248 *--- TR 1038235 22-Oct-2008 VKK
1249 *lcSQLString = ;
1250 "SELECT * FROM zzmshpmh " + lcShipmentNums
1251 lcSQLString = ;
1252 "SELECT * FROM zzmshpmh m Where EXISTS(Select Null From " + lcTmpCurshpmh + " temp Where temp.pkey = m.pkey)"
1253 *=== TR 1038235 22-Oct-2008 VKK
1254
1255 llRetVal = llRetVal AND .CreateSQLView(tcShipmentName, lcSQLString, , 'NoOrderBy')
1256 llRetVal = llRetVal AND .OpenTable(tcShipmentName,,true)
1257
1258 * Select All Related Cost Sheet Records into Temp Cursor:
1259 *--- TechRec 1031091 07-May-2008 vkrishnamurthy ---
1260*!* lcSQLString = ;
1261*!* "SELECT * FROM zzccostd " + lcCostAndBOMKeys
1262 *--- TR 1031878 10-JUN-2008 VKK removed the condition and add it as field
1263 *--- TR 1038235 22-Oct-2008 VKK
1264 *replace + lcCostAndBOMKeys WITH " join lcTmpCurcostd + " temp on c.fkey = temp.pkey "
1265 *in the following select statement.
1266 lcSQLString = ;
1267 "SELECT C.*, case when r.prv_cost_updt IS NULL OR r.prv_cost_updt = 'N' THEN 'N' ELSE 'Y' END as prv_cost_updt " + ;
1268 " FROM zzccostd c " + ;
1269 " JOIN ZZDCATGR r " + ;
1270 " on c.Category = r.category " + ;
1271 " WHERE EXISTS(Select Null From " + lcTmpCurordrd + " temp Where c.fkey = temp.pkey) "
1272 &&+ lcCostAndBOMKeys
1273 *=== TR 1031878 10-JUN-2008 VKK
1274 *=== TechRec 1031091 07-May-2008 vkrishnamurthy ===
1275
1276 llRetVal = llRetVal AND .CreateSQLView(tcCostSheetName, lcSQLString, , 'NoOrderBy')
1277
1278 *--- TR 1034703 7/17/2008 AZ Set view property when view has join. I set only 1 table for update
1279 llRetVal = llRetVal AND DBSetProp(tcCostSheetName, "View", "Tables", "zzccostd") &&& 1034703 AZ
1280 *=== TR 1034703 7/17/2008 AZ Set view property when view has join. I set only 1 table for update
1281
1282 llRetVal = llRetVal AND .OpenTable(tcCostSheetName,,true)
1283
1284 *--- TR 1038235 22-Oct-2008 VKK
1285 IF llRetVal
1286 lcUpdatableFields = CURSORGETPROP("UpdateNameList",tcCostSheetName)
1287 lcUpdatableFields = STRTRAN(lcUpdatableFields, ", prv_cost_updt ZZDCATGR.prv_cost_updt", "")
1288 CURSORSETPROP("UpdateNameList" ,lcUpdatableFields, tcCostSheetName)
1289 ENDIF
1290 *=== TR 1038235 22-Oct-2008 VKK
1291
1292
1293
1294**** 1046957 AZ
1295*--- TR 1046957 12/16/10 AZ
1296
1297 SELECT (tcCostSheetName)
1298 CURSORSETPROP("Buffering",3, tcCostSheetName)
1299*=SEEK("B"+PADR(lcToken,6)+STR(pnPodtlPkey,9),pcCostAlias,"Catgfkey")
1300 INDEX on IIF(DELETED(),"A","B")+CATEGORY+STR(FKEY,9) TAG Catgfkey
1301*=SEEK ("B"+STR(lnFKey,9)+STR(lnParKey,9), "vzzccostd","SFKEYCOST")
1302 INDEX on IIF(DELETED(),"A","B")+STR(prodHdrFkey,9)+STR(fkey,9) TAG SFKEYCOST
1303*=SEEK ("B"+STR(lnDtlPKey,9), "vzzccostd","COSTFKEY")
1304 INDEX on IIF(DELETED(),"A","B")+ STR(FKEY,9) TAG COSTFKEY
1305 INDEX on PKEY TAG PKEY &&& 1051285 AZ
1306 CURSORSETPROP("Buffering",5, tcCostSheetName)
1307
1308*=== TR 1046957 12/16/10 AZ
1309
1310 * Select All BOM Records into Temp Cursor:
1311 *--- TR 1038235 22-Oct-2008 VKK
1312 *lcSQLString = ;
1313 "SELECT * FROM zzcbommd " + lcCostAndBOMKeys
1314 lcSQLString = ;
1315 "SELECT * FROM zzcbommd b Where EXISTS(Select Null From " + lcTmpCurordrd + " temp Where b.fkey = temp.pkey) "
1316 *=== TR 1038235 22-Oct-2008 VKK
1317
1318 llRetVal = llRetVal AND .CreateSQLView(tcBOMName, lcSQLString, , 'NoOrderBy')
1319 llRetVal = llRetVal AND .OpenTable(tcBOMName,,true)
1320
1321 *--- TechRec 1039635 30-Apr-2009 vkrishnamurthy ---
1322 .oBPOCost.IndexBOMAndCost(tcBOMName, tcCostSheetName)
1323 *=== TechRec 1039635 30-Apr-2009 vkrishnamurthy ===
1324
1325
1326 * Create Holding Cursor to store shipment information.
1327 * This way, each zzmshpmh.UDF0X_Fee is only
1328 * touched once with a "...SET UDF0X_Fee += nAmount" call:
1329 Create Cursor (tcTempShipmentHolderName) ( Ship_No N(10), Cost_Type C(9), Cost_By C(1), Amount N(14,2), UpdLastMod C(1) )
1330
1331 *--- TR 1038235 9-FEB-2009 VKK
1332 INDEX ON ALLTRIM(STR(ship_No)) + Cost_Type + Cost_By TAG Ukey
1333
1334 * Create Temporary Cursors
1335 llRetVal = llRetVal AND .CreateLocalCursors(lcTmpCurordrd, "__Prod_Local", ;
1336 lcTmpCurshpmh, "__Ship_Local", ;
1337 lcTmpCurordrh, "__ProdH_Local", ;
1338 "", "__Vouch_Local" )
1339 *=== TR 1038235 9-FEB-2009 VKK
1340
1341 *--- TR 1038235 22-Oct-2008 VKK
1342 .DropTempTables(lcTmpCurordrd, lcTmpCurordrh, lcTmpCurshpmh)
1343 *=== TR 1038235 22-Oct-2008 VKK
1344
1345 EndWith
1346
1347 *-----------------------------------------------------------------------------
1348 * We now have all of the views we need to begin working on.
1349 * We will update these in processing (This.ApproveVoucher()) before
1350 * framework's transaction handling kicks in, register them with the
1351 * form, let the framework update them to the server, then un-register
1352 * them from the form.
1353 * Tmp_Vzzcordrh
1354 * Tmp_Vzzcordrh
1355 * Tmp_Vzzmshpmh
1356 * Tmp_Shipment
1357 * Tmp_Vzzccostd
1358 * Tmp_BOMM
1359 * Tmp_Shipment_Holder, which is a temporary cursor that accumulates shipment info.
1360 *-----------------------------------------------------------------------------
1361
1362 Select (lnSelect)
1363 Return llRetVal
1364
1365ENDFUNC
1366
1367FUNCTION ApproveVoucher
1368 LPARAMETERS pcApproveOrUnapprove, tcProdHeaderName, tcProdDetailName, ;
1369 tcShipmentName, tcCostSheetName, tcBOMName, tcTempShipmentHolderName,polog &&& 1051285 AZ added polog
1370
1371 *--- TR 1039635 19-APR-2009 VKK Added llRangleStyle, lcOrigAddlSQLString
1372 LOCAL llRetVal, lnSelect, lcUser_ID, ltLast_Mod, lcType, lcUse_Cost, ;
1373 lcSQLString, lnQty, lnCCCost, lnAddlCost, lcCost_Type, lcCost_By, ;
1374 lcCBName, lcShpt_Code, lcTree_Seq, lnPKey, lnAddlExtension, lcActualDutyValue, ;
1375 lcProrateFName, llActualDuty, lcAP_Cost, lcAddlSQLString, llRangeStyle, lcOrigAddlSQLString
1376
1377
1378 LOCAL lnaptrx_pkey, lnap_qty, lnap_amt, lnap_pkey &&& 1056525
1379
1380
1381 *--- TR 1038235 9-FEB-2009 VKK
1382 LOCAL lcShipmentList
1383 lcShipmentList = ""
1384 *=== TR 1038235 9-FEB-2009 VKK
1385
1386
1387
1388
1389*--- TR 1051285 04/12/11 AZ
1390IF TYPE("polog") <> "O"
1391 this.lIncludeLog = .t.
1392 this.instantiatelogging()
1393 this.olOG.OpenLog("APPROVEVOUCHER", I("APPROVEVOUCHER"), .f.)
1394ELSE
1395 this.olOG = polog
1396ENDIF
1397
1398this.oLog.LogProgram("clsapvch.prg")
1399*=== TR 1051285 04/12/11 AZ
1400
1401 * Updates Shipment Fees and Production Costs.
1402 llRetVal = true
1403 lnSelect = SELECT()
1404 pcApproveOrUnapprove = IIF(EMPTY(pcApproveOrUnapprove), "APPROVE", pcApproveOrUnapprove)
1405 lcActualDutyValue = UPPER(ALLTRIM(goEnv.SV("ACTUAL_DUTY_COST_TYPE", "Actual Duty Value")))
1406
1407 *--- TR 1051285 04/12/11 AZ
1408 this.olog.LogEntry("Voucher "+EVALUATE(this.cHeaderAlias+".ap_inv ")+pcApproveOrUnapprove)
1409 *=== TR 1051285 04/12/11 AZ
1410
1411 *--- TechRec 1034308 23-Jul-2008 MPerel --- posting to prod. order correct user id, not only 'CGSADMIN'
1412 *lcUser_ID = goEnv.SV('cUserId', 'CGSADMIN')
1413 lcUser_ID = goEnv.cUser
1414 *=== TechRec 1034308 23-Jul-2008 MPerel ===
1415 ltLast_Mod = DATETIME()
1416
1417 * --- 1003625 CB 03/04 Bring zzmshpth down locally.
1418 * Bring zzmshpth down locally for optimization:
1419 llRetVal = v_SQLExec("SELECT * FROM zzmshpth", "tc_zzmshpth")
1420 IF llRetVal AND USED("tc_zzmshpth")
1421 SELECT tc_zzmshpth
1422 INDEX ON Shpt_Code TAG Shpt_Code
1423 ENDIF
1424 * === 1003625 End.
1425
1426 SELECT (This.cDetailAlias)
1427 WITH THIS
1428 SCAN
1429
1430 *--- TR 1051285 04/12/11 AZ
1431
1432 this.oLog.LogEntry("Process detail Line "+ ALLTRIM(STR(EVALUATE(This.cDetailAlias+".line_seq")))+;
1433 " prod_num = "+ALLTRIM(STR(EVALUATE(This.cDetailAlias+".prod_num ")))+" shipment = "+ALLTRIM(STR(EVALUATE(This.cDetailAlias+".shp_seq")))+;
1434 " category = "+EVALUATE(This.cDetailAlias+".category"))
1435 *=== TR 1051285 04/12/11 AZ
1436
1437 * --- 1003625 We now have shipment categories on production lines. See if this is
1438 * a shipping category. We're doing ground work here for both SHIPMENT lines and
1439 * PROD ORD lines with shipment categories.
1440
1441 *--- TR 1039635 19-APR-2009 VKK
1442 llRangeStyle = This.lExplodeVchForRangeStyle AND NOT EMPTY(cmp_style + cmp_color + cmp_Lbl + cmp_dim)
1443 *=== TR 1039635 19-APR-2009 VKK
1444
1445 lcCost_Type = ""
1446 llActualDuty = .F.
1447 lcType = ALLTRIM(SysgetFieldvalue(This.cDetailAlias,"Line_Type"))
1448
1449 IF SEEK(SysgetFieldvalue(This.cDetailAlias,"Category"), "tc_zzdcatgr", "Category") AND tc_zzdcatgr.Imp_Tracking = 'Y'
1450 * Locate Category in zzgcatgr (remember Imp_Tracking and AP_Category are 'Y')
1451 lcCost_Type = ALLTRIM(UPPER(tc_zzdcatgr.Cost_Type))
1452
1453 IF lcCost_Type <> 'COMMISSION'
1454 IF lcCost_Type = lcActualDutyValue
1455 llActualDuty = .T.
1456 lcCost_Type = "DUTY_FEE"
1457 ELSE
1458 * Look at zzgcatgr.cost_type, should look like: SFCLBLUDF02_FEE
1459 * chop off last nine chars and increment that fieldname on zzccostd
1460 lcCost_Type = RIGHT(lcCost_Type, 9)
1461 ENDIF
1462
1463 lcCBName = STRTRAN(lcCost_Type, "FEE", "BY")
1464
1465 * --- 1003625 03/04 CB - make sure the Shp_Seq has been filled in:
1466 IF SysgetFieldvalue(This.cDetailAlias,"Shp_Seq") = 0
1467 * Per Kristen (from TB), one prod dtl line will only be attached to one shipment.
1468 * Fill in the shipment number here, as Vzzgapvcd.Shp_Seq is used when Prorating
1469 * the voucher back to the Shipment Additional Header Category:
1470 LOCAL lnShp_Seq
1471 *--- TR 1038235 9-FEB-2009 VKK
1472 *lnShp_Seq = vl_FindGenericPKey("zzcordrd", SysgetFieldvalue(This.cDetailAlias,"Trx_PKey"), "Shp_Seq")
1473 llFound = SEEK(SysgetFieldvalue(This.cDetailAlias,"Trx_PKey"), "__Prod_Local", "PKEY")
1474
1475 IF llFound
1476 lnShp_Seq = __Prod_Local.Shp_Seq
1477 ENDIF
1478
1479 *=== TR 1038235 9-FEB-2009 VKK
1480
1481 IF TYPE("lnShp_Seq") = "N" AND lnShp_Seq > 0
1482 *--- TechRec 1049469 14-Sep-2010 MPerel --- misspelled cDetialAlias
1483 *REPLACE Shp_Seq WITH lnShp_Seq IN (This.cDetialAlias)
1484 REPLACE Shp_Seq WITH lnShp_Seq IN (This.cDetailAlias)
1485 *=== TechRec 1049469 14-Sep-2010 MPerel ===
1486 ENDIF
1487 ENDIF
1488
1489 * Locate the shipment type in zzmshpmh:
1490 *--- TR 1038235 9-FEB-2009 VKK
1491 *--- TR 1038235 9-FEB-2009 VKK
1492 *lcShpt_Code = vl_ShpmH(SysgetFieldvalue(This.cDetailAlias,"Shp_Seq"), 'Shpt_Code')
1493 llFound = SEEK(SysgetFieldvalue(This.cDetailAlias,"Shp_Seq"), "__Ship_Local", "Ship")
1494
1495 IF llFound
1496 lcShpt_Code = __Ship_Local.shpt_Code
1497 ENDIF
1498 *=== TR 1038235 9-FEB-2009 VKK
1499
1500
1501 IF TYPE('lcShpt_Code') == 'C' AND NOT EMPTY(ALLTRIM(lcShpt_Code)) ;
1502 AND SEEK(lcShpt_Code, "tc_zzmshpth", "Shpt_Code")
1503 * Located the UDFxx_By field in zzmshpth:
1504 lcCost_By = EVALUATE("tc_zzmshpth." + lcCBName)
1505 ELSE
1506 * No find. Default lcCost_By to 'U' if one of above two lookups failed:
1507 lcCost_By = 'U'
1508 ENDIF
1509
1510 * Update the temporary cursor tcTempShipmentHolderName:
1511 SELECT (tcTempShipmentHolderName)
1512 *--- TR 1038235 9-FEB-2009 VKK
1513*!* LOCATE FOR Ship_No = SysgetFieldvalue(This.cDetailAlias,"Shp_Seq") AND ;
1514*!* Cost_Type = lcCost_Type AND ;
1515*!* Cost_By = lcCost_By
1516 =SEEK(ALLTRIM(STR(SysgetFieldvalue(This.cDetailAlias,"Shp_Seq"))) + lcCost_Type + lcCost_By, tcTempShipmentHolderName, "UKey")
1517 *=== TR 1038235 9-FEB-2009 VKK
1518
1519 IF NOT FOUND()
1520 APPEND BLANK
1521 REPLACE ;
1522 Ship_No WITH SysgetFieldvalue(This.cDetailAlias,"Shp_Seq"), ;
1523 Cost_Type WITH lcCost_Type, ;
1524 Cost_By WITH lcCost_By, ;
1525 Amount WITH 0
1526 ENDIF
1527
1528 *--- TechRec 1031091 01-May-2008 vkrishnamurthy ---
1529*!* REPLACE ;
1530*!* Amount WITH ;
1531*!* IIF (pcApproveOrUnapprove == "APPROVE", ;
1532*!* Amount + Vzzgapvcd.AP_Amt, Amount - Vzzgapvcd.AP_Amt), ;
1533*!* UpdLastMod WITH ;
1534*!* IIF(UpdLastMod = "Y" AND lcType = AP_LINE_TYPE_PROD_ORD, ;
1535*!* "N", UpdLastMod)
1536
1537 REPLACE ;
1538 Amount WITH ;
1539 IIF (pcApproveOrUnapprove == "APPROVE", ;
1540 Amount + SysgetFieldvalue(This.cDetailAlias,"AP_Amt"), Amount - SysgetFieldvalue(This.cDetailAlias,"AP_Amt")), ;
1541 UpdLastMod WITH ;
1542 IIF(UpdLastMod = "Y" AND (lcType = AP_LINE_TYPE_PROD_ORD OR lcType = .cAP_Line_Type_Prod_CBK), ;
1543 "N", UpdLastMod)
1544 *=== TechRec 1031091 01-May-2008 vkrishnamurthy ===
1545 ENDIF
1546 ENDIF
1547
1548 *--- TR 1038235 9-FEB-2009 VKK Commented and moved to bottom
1549*!* ltLPTest = {1/1/1900 12:00:00}
1550*!* IF SysgetFieldvalue(This.cDetailAlias,"Shp_Seq")> 0
1551*!* lcSQLString = ;
1552*!* "UPDATE ZZCORDRD SET " + ;
1553*!* " Last_Prorated = " + SQLFormatTS(ltLPTest) + ;
1554*!* " WHERE Shp_Seq = " + SQLFormatNum(SysgetFieldvalue(This.cDetailAlias,"Shp_Seq")) + ;
1555*!* " AND sc_rowlock < 'Y' " &&& 1023462 AZ
1556*!* llRetVal = llRetVal AND v_SQLExec(lcSQLString)
1557*!* ENDIF
1558
1559 IF NOT (SQLFormatNum(SysgetFieldvalue(This.cDetailAlias,"Shp_Seq")) + "," $ lcShipmentList) AND ;
1560 SysgetFieldvalue(This.cDetailAlias,"Shp_Seq")> 0
1561 lcShipmentList = lcShipmentList + SQLFormatNum(SysgetFieldvalue(This.cDetailAlias,"Shp_Seq")) + ","
1562 ENDIF
1563
1564 *=== TR 1038235 9-FEB-2009 VKK
1565
1566
1567 * === 1003625 End.
1568 *--- TechRec 1031091 01-May-2008 vkrishnamurthy ---
1569*!* IF lcType == AP_LINE_TYPE_PROD_ORD && PROD ORD
1570 IF lcType == AP_LINE_TYPE_PROD_ORD OR lcType = .cAP_Line_Type_Prod_CBK && PROD ORD
1571 *=== TechRec 1031091 01-May-2008 vkrishnamurthy ===
1572 * Update the Production Detail Line's Cost.
1573 * 37481 CB - Write the cost to the maximum stage(s) of the tree, not
1574 * necessarily the line originally entered on the voucher.
1575
1576 * We are going to get each of the pkeys from the MAX stage, then:
1577 * 1) Update the cost on the Prod Detail (or Cost Sheet if it exists).
1578 * 2) If Cost Sheet exists, call clsCost.RecalCost(), which requires the PKey
1579 * of the Prod Detail to recalc the Cost Sheet, and update the Production.
1580
1581 *--- TR 1038235 9-FEB-2009 VKK
1582 *lcTree_Seq = ALLTRIM(vl_cordrd(SysgetFieldvalue(This.cDetailAlias,"Trx_PKey"), 'Tree_Seq')) + "%"
1583 llFound = SEEK(SysgetFieldvalue(This.cDetailAlias,"Trx_PKey"), "__Prod_Local", "PKEY")
1584 lcTree_Seq = ALLTRIM(__Prod_Local.Tree_Seq) + "%"
1585 *=== TR 1038235 9-FEB-2009 VKK
1586
1587 * --- 1008695 02/05 CB - commented out this code temporarily. It is C5'ing at
1588 * Tommy Bahama. Suspect it is due to VFP 6's SQL engine. They will be upgrading
1589 * to BC5 (VFP8) soon, at which time we'll try uncommenting it and see if
1590 * they still get the error. If they do, we need to reengineer this to
1591 * be handled on server, not client.
1592 * 1008695 correction - left code in. Decided to put the C5 issue into a separate TR.
1593 *--- TR 1038235 9-FEB-2009 VKK Query on Indexed cursor
1594*!* lcSQLString = ;
1595*!* "SELECT PKey, FKey, Cost, Total_Qty, Prod_Value, Last_stage " + ; &&& 1019659 03-Nov-2006 SK
1596*!* " FROM " + tcProdDetailName + " l " + ;
1597*!* " WHERE l.Prod_Num = " + SQLFormatNum(SysgetFieldvalue(This.cDetailAlias,"Prod_Num")) + ;
1598*!* " AND l.Tree_Seq LIKE " + SQLFormatChar(lcTree_Seq) + ;
1599*!* " AND NOT EXISTS " + ;
1600*!* " (SELECT ParKey FROM " + tcProdDetailName + " p WHERE p.ParKey = l.PKey) "
1601
1602 lcSQLString = ;
1603 "SELECT PKey, FKey, Cost, Total_Qty, Prod_Value, Last_stage " + ; &&& 1019659 03-Nov-2006 SK
1604 " FROM __Prod_Local l " + ;
1605 " WHERE l.Prod_Num = " + SQLFormatNum(SysgetFieldvalue(This.cDetailAlias,"Prod_Num")) + ;
1606 " AND l.Tree_Seq LIKE " + SQLFormatChar(lcTree_Seq) + ;
1607 " AND NOT EXISTS " + ;
1608 " (SELECT ParKey FROM __Prod_Local p WHERE p.ParKey = l.PKey) "
1609 *=== TR 1038235 9-FEB-2009 VKK
1610
1611*!* lcSQLString = "SELECT PKey, FKey, Cost, Total_Qty, Prod_Value FROM " + tcProdDetailName
1612 * === 1008695 end.
1613
1614 llRetVal = llRetVal AND v_SQLExec(lcSQLString, 'tcTmpCursor',, true)
1615
1616 * Scan the list of 'Current Stage' PKeys that this record has led to:
1617 IF llRetVal AND USED('tcTmpCursor')
1618 SELECT tcTmpCursor
1619 SCAN
1620 lnPKey = tcTmpCursor.PKey && PKey of Production Detail
1621 lnQty = tcTmpCursor.Total_Qty
1622 lnAddlCost = IIF(lnQty > 0, (SysgetFieldvalue(This.cDetailAlias,"AP_Amt") / lnQty), 0) * ;
1623 IIF(pcApproveOrUnapprove == "APPROVE", 1, -1) && Approve/Unapprove: Add|Subtract
1624
1625 *--- TR 1056525 12/08/11 AZ
1626 lnaptrx_pkey = Evaluate(This.cDetailAlias + ".Trx_PKey")
1627 lnap_qty = Evaluate(This.cDetailAlias + ".ap_qty")
1628 lnap_amt = Evaluate(This.cDetailAlias + ".ap_amt")
1629 lnap_pkey = Evaluate(This.cDetailAlias + ".pkey")
1630
1631 *=== TR 1056525 12/08/11 AZ
1632
1633 * Locate zzcordrh header record to see whether or not it uses cost.
1634 *--- TR 1038235 9-FEB-2009 VKK
1635 *lcUse_Cost = vl_FindGenericPKey('zzcordrh', tcTmpCursor.FKey, 'Use_Cost')
1636 llFound = SEEK(tcTmpCursor.FKey, "__ProdH_Local", "PKEY")
1637 lcUse_Cost = __ProdH_Local.Use_Cost
1638 *=== TR 1038235 9-FEB-2009 VKK
1639
1640
1641 IF TYPE('lcUse_Cost') = 'C' AND lcUse_Cost <> "Y" AND lnaptrx_pkey > 0 &&& 1056525
1642 * Not using cost sheet - just update production detail:
1643 * Three fields to update - Cost, Prod_Value, Total_Cost
1644 * Cost Calculation: zzcordrd.Cost += (Vzzgapvcd.AP_Amt/zzcordrd.Total_Qty)
1645 *--- TR 1056525 12/08/11 AZ
1646
1647
1648 lcSQLString = "SELECT SUM(d.ap_qty) as ap_qty,SUM(d.ap_amt) as ap_amt from zzgapvcd d "+;
1649 " Join zzgapvch h on h.pkey = d.fkey "+;
1650 " where d.trx_pkey = "+sqlformatnum(lnaptrx_pkey) +;
1651 " and d.pkey <> "+ sqlformatnum(lnap_pkey) +;
1652 " and h.approved = 'Y' "
1653
1654 v_sqlexec(lcSQLString,"cTempDtl")
1655
1656
1657 *--- TR 1059469 02/13/12 AZ
1658* IF RECCOUNT("cTempDtl") > 0 AND cTempDtl.ap_qty > 0
1659 IF !ISNULL(cTempDtl.ap_qty) AND cTempDtl.ap_qty > 0 &&& 1059469
1660 *=== TR 1059469 02/13/12 AZ
1661 IF pcApproveOrUnapprove == "APPROVE"
1662 lnap_cost = (cTempDtl.ap_amt+lnap_amt)/(cTempDtl.ap_qty+lnap_qty)
1663 ELSE
1664 lnap_cost = cTempDtl.ap_amt/cTempDtl.ap_qty
1665 ENDIF
1666 ELSE
1667 IF pcApproveOrUnapprove == "APPROVE"
1668 lnap_cost = lnap_amt/lnap_qty
1669 ELSE
1670 *--- TR 1059469 02/13/12 AZ
1671 lcSQLString = "SELECT parkey from zzcordrd where pkey = "+sqlformatnum(lnaptrx_pkey)
1672 v_sqlexec(lcSQLString,"tctemp1")
1673 lncost = 0
1674 IF tctemp1.parkey > 0
1675 lnparkey = tctemp1.parkey
1676 lcSQLString = "SELECT cost from zzcordrd where pkey = "+sqlformatnum(lnparkey)
1677 v_sqlexec(lcSQLString,"tctemp1")
1678
1679 lncost = tctemp1.cost
1680 ENDIF
1681 USE IN SELECT ("tctemp1")
1682
1683
1684 lnap_cost = IIF(lncost > 0,lncost,Evaluate(This.cDetailAlias + ".cost") )
1685 *=== TR 1059469 02/13/12 AZ
1686* lnap_cost = lncost
1687 ENDIF
1688 ENDIF
1689
1690 lnAddlCost = lnap_cost
1691
1692 USE IN SELECT("cTempDtl") &&& 1059469 AZ
1693
1694* lnAddlCost = tcTmpCursor.Cost + lnAddlCost
1695 *=== TR 1056525 12/08/11 AZ
1696
1697 lcSQLString = "UPDATE " + tcProdDetailName + " set cost = " + SQLFormatNum(lnAddlCost, 5)
1698
1699 IF tcTmpCursor.Cost # tcTmpCursor.Prod_Value
1700 lcSQLString = lcSQLString + ;
1701 ", Prod_Value = " + SQLFormatNum(lnAddlCost, 5) + ;
1702 ", Total_Cost = " + SQLFormatNum(lnAddlCost, 5)
1703 ENDIF
1704
1705 * AP_Approved flag locks zzcordrd record.
1706 * Also, stamp User_ID and Last_Mod:
1707 lcSQLString = lcSQLString + ;
1708 ", AP_Approved = " + IIF(pcApproveOrUnapprove = "APPROVE", "'Y'", "''") + ;
1709 ", User_ID = " + SQLFormatChar(lcUser_ID) + ;
1710 ", Last_Mod = DATETIME()" + ;
1711 " WHERE PKey = " + SQLFormatNum(lnPKey)
1712 llRetVal = llRetVal AND v_SQLExec(lcSQLString,,,true)
1713
1714 * Stamp Production Header with this change:
1715 lcSQLString = ;
1716 "UPDATE " + tcProdHeaderName + " set User_ID = " + SQLFormatChar(lcUser_ID) + ;
1717 ", Last_Mod = DATETIME()" + ;
1718 " WHERE PKey = " + SQLFormatNum(Evaluate(tcProdDetailName + ".FKey"))
1719 llRetVal = llRetVal AND v_SQLExec(lcSQLString,,, true)
1720
1721 Else && Cost Sheet - Update the Category Cost, Recalc Prod Detail.
1722 * --- 1001996 CB - When clsCost gets ahold of this record, it looks at AP_Cost to
1723 * see if we have manually set the cost here. If so, it ignores the
1724 * record and moves on. Therefore, if we are UNApproving AND this
1725 * Prod_Num/Line_Seq has appeared on any other Vouchers (Prev_Billed > 0),
1726 * retain the AP_Cost flag on the Cost Sheet. If it has not appeared,
1727 * set it back to blank, and let clsCost fill it in with its default
1728 * value. IF we are APPROVING the voucher, completely overwrite the
1729 * cost, and set AP_Cost to 'Y'.
1730
1731 * --- 1003625 AP_Cost is also 'Y' if it is a shipment category, or the amount was
1732 * preserved by the user (default value was overridden). Added to IF statement.
1733
1734 lcAP_Cost = SysgetFieldvalue(This.cDetailAlias,"Preserved")
1735
1736 * --- 1003625 CB 03/04 Extension was being overwritten by this amount, rather than
1737 * accumulating it to the CS:
1738* lnAddlExtension = lnAddlCost * Vzzgapvcd.Trx_Qty
1739 * === 1003625 End.
1740
1741 * --- 1003625 CB 03/04 - If user filled in Actual Duty, we need to update
1742 * the Duty Value on the cost sheet. Added to 'Category = ' part of
1743 * SQL statement below:
1744
1745 * --- 1003625 CB 03/04 - Added Imp_Cost to the mix:
1746 * Also replaced line below with new Extension calculation:
1747 * ", Extension = " + SQLFormatNum(lnAddlExtension, 5) +
1748
1749 * Actual Duty must be handled differently. We need to join into zzdcatgr
1750 * to find the records whose Cost_Type = 'DUTY VALUE'.
1751 IF llActualDuty
1752 lcAddlSQLString = ;
1753 " WHERE PKey IN " + ;
1754 "(SELECT c.PKey FROM " + tcCostSheetName + " c " + ;
1755 " JOIN tc_zzdcatgr g on g.Category = c.Category " + ;
1756 " WHERE c.FKey = " + SQLFormatNum(lnPKey) + ;
1757 " and g.Cost_Type = " + SQLFormatChar(UPPER(CN_DUTY_VALUE)) + ")"
1758 ELSE
1759 lcAddlSQLString = ;
1760 " WHERE FKey = " + SQLFormatNum(lnPKey) + ;
1761 " AND Category = " + SQLFormatChar(IIF(TYPE('lcCost_Type') = "C" AND ;
1762 lcCost_Type = lcActualDutyValue, UPPER(CN_DUTY_VALUE), ;
1763 SysgetFieldvalue(This.cDetailAlias,"Category")))
1764 ENDIF
1765
1766 *--- TR 1031878 10-JUN-2008 VKK take only records with prevent cost udpate with false
1767 lcAddlSQLString = lcAddlSQLString + " AND prv_cost_updt = 'N' "
1768 *=== TR 1031878 10-JUN-2008 VKK
1769
1770 *--- TR 1039635 19-APR-2009 VKK
1771 lcOrigAddlSQLString = lcAddlSQLString
1772
1773 IF llRangeStyle
1774 SELECT (.cDetailalias)
1775 lcAddlSQLString = lcAddlSQLString + ;
1776 " AND sysLevel = 1 " + ;
1777 " AND Style = " + SQLFormatChar(cmp_Style) + ;
1778 " AND Color_code = " + SQLFormatChar(cmp_Color) + ;
1779 " AND Lbl_code = " + SQLFormatChar(cmp_Lbl) + ;
1780 " AND Dimension = " + SQLFormatChar(cmp_Dim)
1781 ENDIF
1782 *=== TR 1039635 19-APR-2009 VKK
1783
1784
1785 * --- 1003625 CB - End.
1786*---TR 1006010 Uday 09/24/04
1787*---TR 1006010 Uday - >Cleaned the unnecesosry code Not required
1788*!* * Remember original setting of Imp_Cost for accumulation/overwrition.
1789*!* lcSQLString = "SELECT Imp_Cost AS OrigImp FROM " + tcCostSheetName
1790*!* lcSQLString = lcSQLString + lcAddlSQLString
1791*!* llRetVal = llRetVal AND v_SQLExec(lcSQLString, "tcImpCost",, true)
1792*!* IF llRetVal AND USED("tcImpCost") AND RECCOUNT("tcImpCost") > 0
1793*!* lcOrigImpCost = tcImpCost.OrigImp
1794*!* ELSE
1795*!* lcOrigImpCost = ""
1796*!* ENDIF
1797*!* USE IN SELECT("tcImpCost")
1798*!* *!* lcSQLString = ;
1799*!* *!* "UPDATE " + tcCostSheetName + " SET " + ;
1800*!* *!* " Imp_Cost = 'Y'" + ;
1801*!* *!* ", User_ID = " + SQLFormatChar(lcUser_ID) + ;
1802*!* *!* ", Last_Mod = DATETIME()"
1803*!* LOCAL lcAPCost
1804*!* lcAPCost = "''"
1805*!* IF pcApproveOrUnapprove <> "APPROVE"
1806*!* * This voucher is being unapproved. If no other approved vouchers
1807*!* * have been applied against this line in the cost sheet, set AP_Cost
1808*!* * back to blank, otherwise keep it at "Y".
1809*!* lcSQLString = ;
1810*!* "SELECT COUNT(*) AS Cnt" + ;
1811*!* " FROM zzgapvcd d " + ;
1812*!* " JOIN zzgapvch h ON d.FKey = h.PKey " + ;
1813*!* " WHERE h.Approved = 'Y'" + ;
1814*!* " AND d.Category = " + SQLFormatChar(Vzzgapvcd.Category) + ;
1815*!* " AND d.Prod_Num = " + SQLFormatNum(Vzzgapvcd.Prod_Num) + ;
1816*!* " AND d.Prod_Line = " + SQLFormatNum(Vzzgapvcd.Prod_Line) + ;
1817*!* " AND d.PKey <> " + SQLFormatNum(Vzzgapvcd.PKey)
1818*!* IF v_SQLExec(lcSQLString, "tcCountApps") AND USED("tcCountApps") AND tcCountApps.Cnt > 0
1819*!* lcAPCost = "'Y'"
1820*!* ENDIF
1821*!* USE IN SELECT("tcCountApps")
1822*!* ENDIF
1823
1824*!* lcSQLString = ;
1825*!* "UPDATE " + tcCostSheetName + " SET " + ;
1826*!* " Imp_Cost = " + IIF(pcApproveOrUnapprove = "APPROVE", "'Y'", lcAPCost) + ;
1827*!* ", AP_Cost = " + IIF(pcApproveOrUnapprove = "APPROVE", "'Y'", lcAPCost) + ;
1828*!* ", User_ID = " + SQLFormatChar(lcUser_ID) + ;
1829*!* ", Last_Mod = DATETIME()"
1830*!* lcSQLString = lcSQLString + lcAddlSQLString
1831*!* llRetVal = llRetVal AND v_SQLExec(lcSQLString,,, true)
1832
1833*!* * --- QUICK FIX BEFORE OPTIMIZATION ----- CB 03/04
1834*!* lcSQLString = "SELECT PKey FROM " + tcCostSheetName + lcAddlSQLString
1835*!* llRetVal = llRetVal AND v_SQLExec(lcSQLString, "tcCSPKey",,.T.)
1836*!* IF USED("tcCSPKey") AND RECCOUNT("tcCSPKey") > 0
1837*!* lnCSPKey = tcCSPKey.PKey
1838*!* SELECT (tcCostSheetName)
1839*!* LOCATE FOR PKey = lnCSPKey
1840*!* IF FOUND()
1841*!* REPLACE ;
1842*!* Extension WITH ;
1843*!* IIF(lcOrigImpCost = 'Y', ;
1844*!* Extension + Vzzgapvcd.AP_Amt, ;
1845*!* Vzzgapvcd.AP_Amt), ;
1846*!* Category_Cost WITH Extension / tcTmpCursor.Total_Qty, ;
1847*!* AP_Cost WITH lcAP_Cost ;
1848*!* IN (tcCostSheetName)
1849*!* ENDIF
1850*!* ENDIF
1851*!* USE IN SELECT("tcCSPKey")
1852 * === QUICK FIX END.
1853*===TR 1006010 - >Cleaned the unnecesosry code Not required
1854*---Uday in case there are multiple voucher against same category , production number and prod line
1855
1856*--- TR 1038235 9-FEB-2009 VKK Moved block to new method calcaulteAPamt
1857*!* lcSQLString = " SELECT h.approved, " + ;
1858*!* "h.ap_inv, " + ;
1859*!* "d.Ap_Amt, " + ;
1860*!* "p.pkey prod_pkey, " + ;
1861*!* "d.trx_pkey " + ;
1862*!* " FROM zzgapvcd d " + ;
1863*!* " JOIN zzgapvch h ON d.FKey = h.PKey " +;
1864*!* " JOIN zzcordrd p ON d.trx_pkey = p.PKey " +;
1865*!* " JOIN zzcordrd t ON t.pkey = " + SQLFormatNum(SysgetFieldvalue(This.cDetailAlias,"trx_pkey")) + ;
1866*!* " WHERE d.Category = " + SQLFormatChar(SysgetFieldvalue(This.cDetailAlias,"Category")) + ;
1867*!* " AND d.Prod_Num = " + SQLFormatNum (SysgetFieldvalue(This.cDetailAlias,"Prod_Num"))
1868*!* * === TR 1012726 09/21/05 MA
1869*!* *===TR 1013835 MA 10/23/05 in case of split PO cannot rely on open_seq
1870*!* * ========================================================
1871*!* llRetval = llRetVal AND v_SQLExec(lcSQLString, tcAPApps )
1872
1873
1874*!* IF llRetval
1875*!* Select (tcAPApps)
1876
1877*!* * how many records for prod num prod line, categ in voucher table
1878*!* lnCount = RECCOUNT()
1879
1880
1881*!* * can be approved only , not approved only , appr and not appr
1882*!* *--- TR 1014568 MA 12/14/05
1883*!* * IF lnCount > 1 && multiple records for prod num prod line, categ in voucher table
1884*!* IF lnCount > 0 && multiple records for prod num prod line, categ in voucher table
1885*!* *=== TR 1014568 MA 12/14/05
1886
1887*!* * ========================================================
1888*!* * --- TR 1012726 09/21/05 MA
1889*!* * how many recs approved
1890*!* * COUNT TO lnApproved FOR approved = 'Y'
1891*!*
1892*!* * sum for approved
1893*!* * CALCULATE SUM(AP_Amt) to lnAmount FOR approved = 'Y'
1894
1895*!* * sum total for appr and not appr
1896*!* * CALCULATE SUM(AP_Amt) to lnExtAmount
1897
1898*!* *---- TR 1013835 MA 10/23/05 in case of split PO cannot rely on open_seq
1899*!* * how many recs approved
1900*!* * ---- TR 1013928 MA 10/27/05
1901*!* * COUNT TO lnApproved FOR approved = 'Y'
1902
1903*!* COUNT TO lnApproved FOR approved = 'Y' AND prod_pkey = SysgetFieldvalue(This.cDetailAlias,"trx_pkey")
1904*!* * === TR 1013928 MA 10/27/05
1905*!* * sum for approved
1906
1907*!* * CALCULATE SUM(AP_Amt) to lnAmount FOR approved = 'Y' AND open_seqp = open_seqt
1908*!* CALCULATE SUM(AP_Amt) to lnAmount FOR approved = 'Y' AND prod_pkey = SysgetFieldvalue(This.cDetailAlias,"trx_pkey")
1909
1910*!* * CALCULATE SUM(AP_Amt) to lnExtAmount FOR open_seqp = open_seqt
1911
1912*!* * sum total for appr and not appr
1913*!* CALCULATE SUM(AP_Amt) to lnExtAmount FOR prod_pkey = trx_pkey
1914*!* * === TR 1012726 09/21/05 MA
1915
1916*!* *=== TR 1013835 MA 10/23/05 in case of split PO cannot rely on open_seq
1917*!* * ========================================================
1918*!* * what for it was called
1919*!* IF pcApproveOrUnapprove = "APPROVE"
1920*!* lnAmount = lnAmount + SysgetFieldvalue(This.cDetailAlias,"AP_Amt")
1921*!* lcAPCost = "'Y'"
1922*!* ELSE
1923*!* *SET STEP ON
1924*!* lnAmount = lnAmount - SysgetFieldvalue(This.cDetailAlias,"AP_Amt")
1925*!* lcAPCost = IIF(lnApproved > 1, "'Y'","'N'")
1926*!*
1927*!* IF lnAmount = 0 AND lcAPCost = "''"
1928*!* lnAmount = lnExtAmount
1929*!* ENDIF
1930*!*
1931*!* ENDIF
1932*!* ELSE && lnCount > 1
1933*!* * lnCount < 2
1934*!* * no records for prod num prod line, categ in voucher table
1935*!* * one record for prod num prod line, categ in voucher table
1936
1937*!* * if no records it is right
1938*!* * if 1 rec
1939*!* *SET STEP ON
1940*!* lnAmount = SysgetFieldvalue(This.cDetailAlias,"AP_Amt")
1941*!* lcAPCost = IIF(pcApproveOrUnapprove = "APPROVE", "'Y'","'N'")
1942*!* ENDIF && lnCount > 1
1943*!* ENDIF
1944*!* USE IN (tcAPApps)
1945
1946 Local tcAPApps, lnApproved, lnCount, lnAmount, lnExtAmount, lcAPCost, lcApCostPrev && ***1020821 01-Dec-2006 SK
1947 tcAPApps = GetUniqueFileName()
1948 Store 0 to lnApproved, lnCount, lnAmount, lnExtAmount
1949 lcAPCost = "''"
1950 lcApCostPrev = "''"
1951 lnOldSelect = Select()
1952
1953 *--- TR 1051285 04/12/11 AZ
1954
1955 this.oLog.LogEntry("Updating production cost")
1956 *=== TR 1051285 04/12/11 AZ
1957
1958 llRetVal = llRetVal AND .CalCulateAPAmount(@lcAPCost, @lnAmount, pcApproveOrUnapprove,llRangeStyle )
1959
1960*=== TR 1038235 9-FEB-2009 VKK Moved block to new method calcaulteAPamt
1961
1962* ========================================================
1963* --- TR 1012726 09/21/05 MA
1964 *--- 1020821 01-Dec-2006 SK
1965 *--- TR 1052855 10/17/11 AZ
1966* llRetVal = v_SQLExec("SELECT AP_COST FROM " + tcCostSheetName + lcAddlSQLString,"tcCst",, true)
1967 llRetVal = v_SQLExec("SELECT AP_COST FROM " + tcCostSheetName + lcAddlSQLString+" order by syslevel","tcCst",, true) &&& 1052855 AZ
1968 *=== TR 1052855 10/17/11 AZ
1969 lcApCostPrev = tcCst.AP_COST
1970 USE IN SELECT("tcCst")
1971 *=== 1020821 01-Dec-2006 SK
1972
1973 *--- TechRec 1039419 23-Apr-2009 asharma ---
1974 LOCAL lcArPeriod
1975 lcArPeriod = SQLFormatChar(SysgetFieldvalue(This.cHeaderAlias,"ar_period"))
1976 *=== TechRec 1039419 23-Apr-2009 asharma ===
1977
1978 * ZZCCOSTD
1979 * if extension is 0 replace with estm. extension
1980 Select (lnOldSelect)
1981 *--- TechRec 1039419 23-Apr-2009 asharma ---
1982 * added AR_Period in the update statement
1983 lcSQLString = ;
1984 "UPDATE " + tcCostSheetName + " SET " + ;
1985 " Imp_Cost = " + IIF(pcApproveOrUnapprove = "APPROVE", "'Y'", lcAPCost) + ;
1986 ", AP_Cost = " + IIF(pcApproveOrUnapprove = "APPROVE", "'Y'", lcAPCost) + ;
1987 ", AR_Period = " + IIF(pcApproveOrUnapprove = "APPROVE", lcArPeriod, "''") + ;
1988 ", User_ID = " + SQLFormatChar(lcUser_ID) + ;
1989 ", Last_Mod = DATETIME()"
1990 lcSQLString = lcSQLString + lcAddlSQLString
1991 llRetVal = llRetVal AND v_SQLExec(lcSQLString,,, true)
1992
1993 * --- QUICK FIX BEFORE OPTIMIZATION ----- CB 03/04
1994 *--- TR 1052855 10/17/11 AZ
1995* lcSQLString = "SELECT PKey FROM " + tcCostSheetName + lcAddlSQLString
1996 lcSQLString = "SELECT PKey,syslevel,extension FROM " + tcCostSheetName + lcAddlSQLString+" order by syslevel" &&& 1052855 AZ
1997 *=== TR 1052855 10/17/11 AZ
1998 llRetVal = llRetVal AND v_SQLExec(lcSQLString, "tcCSPKey",,.T.)
1999 IF USED("tcCSPKey") AND RECCOUNT("tcCSPKey") > 0
2000 lnCSPKey = tcCSPKey.PKey
2001 SELECT (tcCostSheetName)
2002 *=== TR 1051285 04/12/11 AZ
2003* LOCATE FOR PKey = lnCSPKey
2004 =SEEK(lnCsPkey,tcCostSheetName,"PKEY") &&& 1051285 AZ
2005 *=== TR 1051285 04/12/11 AZ
2006 IF FOUND()
2007 lcAPCost = STRTRAN(lcAPCost, "'", "")
2008*!* REPLACE ;
2009*!* Extension WITH ;
2010*!* IIF(lcOrigImpCost = 'Y', ;
2011*!* Extension + Vzzgapvcd.AP_Amt, ;
2012*!* Vzzgapvcd.AP_Amt), ;
2013*!* Category_Cost WITH Extension / tcTmpCursor.Total_Qty, ;
2014*!* AP_Cost WITH lcAP_Cost ;
2015*!* IN (tcCostSheetName)
2016*--- 1019659 03-Nov-2006 SK
2017
2018*!* REPLACE ;
2019*!* Extension WITH lnAmount;
2020*!* Category_Cost WITH Extension / tcTmpCursor.Total_Qty, ;
2021*!* AP_Cost WITH lcAPCost ;
2022*!* IN (tcCostSheetName)
2023 IF &tcCostSheetName..AP_Cost='Y' and tcTmpCursor.Last_stage='Y' AND lcApCostPrev='Y' && 1020821 01-Dec-2006 SK
2024 IF pcApproveOrUnapprove = "APPROVE" &&&*--- 1031923 04/14/2008 SKG
2025 REPLACE ;
2026 Extension WITH Extension + SysgetFieldvalue(This.cDetailAlias,"AP_Amt") && *--- 1020821 01-Dec-2006 SK
2027 *--- 1031923 04/14/2008 SKG
2028 ELSE
2029 REPLACE ;
2030 Extension WITH Extension - SysgetFieldvalue(This.cDetailAlias,"AP_Amt")
2031 *--- TR 1059469 02/13/12 AZ
2032 IF Extension < 0 &&& 1072792 AZ removed =
2033 replace Extension WITH ESTM_EXT_COST
2034 ENDIF
2035 *=== TR 1059469 02/13/12 AZ
2036
2037 ENDIF
2038 *=== 1031923 04/14/2008 SKG
2039 ELSE
2040 REPLACE ;
2041 Extension WITH lnAmount
2042
2043 *--- TR 1059469 02/13/12 AZ
2044 IF Extension < 0 &&& 1072792 AZ removed =
2045 replace Extension WITH ESTM_EXT_COST
2046 ENDIF
2047 *=== TR 1059469 02/13/12 AZ
2048
2049 ENDIF
2050 *--- TechRec 1039635 24-Apr-2009 vkrishnamurthy ---
2051*!* REPLACE Category_Cost WITH Extension / tcTmpCursor.Total_Qty, ;
2052*!* AP_Cost WITH lcAPCost ;
2053*!* IN (tcCostSheetName)
2054
2055 REPLACE Category_Cost WITH Extension / IIF(NOT llRangeStyle,tcTmpCursor.Total_Qty,SysgetFieldvalue(This.cDetailAlias,"Trx_Qty")) , ;
2056 AP_Cost WITH lcAPCost ;
2057 IN (tcCostSheetName)
2058
2059 *=== TechRec 1039635 24-Apr-2009 vkrishnamurthy ===
2060
2061*=== 1019659 03-Nov-2006 SK
2062 ENDIF
2063 ENDIF
2064
2065 *--- TR 1052855 10/17/11 AZ
2066
2067 LOCAL lnExtension_0,lnCntlevel1,lnSumExt_1,lnExtension_l1,lnCategoryCost_l1
2068 IF USED("tcCSPKey") AND RECCOUNT("tcCSPKey") >1 AND !llRangeStyle
2069 lnExtension_0 = EVALUATE(tcCostSheetName+".extension")
2070 lcSQLString = "Select COUNT(*) as CNT,SUM(extension) as total_ext from tcCSPKey where syslevel =1"
2071 llRetVal = llRetVal AND v_SQLExec(lcSQLString, "tcLevel1",,.T.)
2072 lnCntlevel1 = tcLevel1.CNT
2073 lnSumExt_1 = tcLevel1.total_ext
2074 IF lnCntlevel1 > 0 AND lnSumExt_1 > 0 &&& 1067568 Added 'AND lnSumExt_1'
2075 SELECT tcCSPKey
2076 SCAN FOR syslevel = 1
2077 lnExtension_l1 = lnExtension_0 * tcCSPKey.extension/lnSumExt_1
2078 lnCategoryCost_l1 = lnExtension_l1 / tcTmpCursor.Total_Qty
2079
2080 lnCSPKey = tcCSPKey.PKey
2081
2082 SELECT (tcCostSheetName)
2083 =SEEK(lnCsPkey,tcCostSheetName,"PKEY") &&& 1051285 AZ
2084 IF FOUND()
2085 Replace extension WITH lnExtension_l1,category_cost WITH lnCategoryCost_l1
2086 ENDIF
2087 ENDSCAN
2088
2089 ENDIF
2090 ENDIF
2091
2092 USE IN SELECT("tcLevel1")
2093
2094 *=== TR 1052855 10/17/11 AZ
2095
2096
2097 USE IN SELECT("tcCSPKey")
2098 * === QUICK FIX END.
2099
2100*!* *===TR 1006010 Uday
2101
2102 * Stamp Production Header with this change:
2103 lcSQLString = ;
2104 "UPDATE " + tcProdHeaderName + " set User_ID = " + SQLFormatChar(lcUser_ID) + ;
2105 ", Last_Mod = DATETIME()" + ;
2106 " WHERE PKey = " + SQLFormatNum(Evaluate(tcProdDetailName + ".FKey"))
2107 llRetVal = llRetVal AND v_SQLExec(lcSQLString,,, true)
2108
2109 * Recalculate the Cost Sheet:
2110 * --- 1003625 Optimization note: only need to call clsCost.ProrateVoucher ONCE
2111 * for each Prod_Num/Category. Change this logic when we get a chance:
2112
2113 * --- 1004736 04/04 CB - We're scanning Vzzgapvcd, not Vzzcordrd.
2114 * Locate correct record in temporary detail cursor:
2115 SELECT (tcProdDetailName)
2116 LOCATE FOR PKey = tcTmpCursor.PKey
2117 IF NOT FOUND()
2118 llRetVal = .F.
2119 ENDIF
2120 * === 1004736 End.
2121
2122
2123 IF llRetVal
2124 * --- 1003958 03/05 CB
2125 * --- Prep the cursors for optimized recalc if flag set and not already prepped:
2126 IF .oBPOCost.lOptimizedRecalc AND NOT .oBPOCost.lDynamicsPrepped
2127 .oBPOCost.PrepDynamicCursors(tcCostSheetName, tcProdDetailName, tcProdHeaderName, THIS, .T.)
2128 .oBPOCost.IndexBOMAndCost()
2129 ENDIF
2130 * === 1003958 end.
2131
2132*--- TAN 1029485 12/28/2007 AZ
2133 IF .oBPOCost.lOptimizedRecalc AND .oBPOCost.lDynamicsPrepped AND USED(.oBPOCost.cCstAlias)
2134*--- TR 1030681 02/20/08 MP
2135*!* lcSQLString = ;
2136*!* "UPDATE " + .oBPOCost.cCstAlias + " SET " + ;
2137*!* " Imp_Cost = " + IIF(pcApproveOrUnapprove = "APPROVE", "'Y'", SQLFormatChar(lcAPCost)) + ;
2138*!* ", AP_Cost = " + IIF(pcApproveOrUnapprove = "APPROVE", "'Y'", SQLFormatChar(lcAPCost)) + ;
2139*!* ", User_ID = " + SQLFormatChar(lcUser_ID) + ;
2140*!* ", Last_Mod = DATETIME()"
2141
2142
2143*--- TR 1031098/1038235 02/28/09 MP
2144
2145*!* lcSQLString = ;
2146*!* "UPDATE " + .oBPOCost.cCstAlias + " SET " + ;
2147*!* " Imp_Cost = " + IIF(pcApproveOrUnapprove = "APPROVE", "'Y'", SQLFormatChar(lcAPCost)) + ;
2148*!* ", AP_Cost = " + IIF(pcApproveOrUnapprove = "APPROVE", "'Y'", SQLFormatChar(lcAPCost)) + ;
2149*!* ", User_ID = " + SQLFormatChar(lcUser_ID) + ;
2150*!* ", Last_Mod = DATETIME()"
2151 lcAPCost = IIF(pcApproveOrUnapprove = "APPROVE", "'Y'","'N'")
2152 lcSQLString = ;
2153 "UPDATE " + .oBPOCost.cCstAlias + " SET " + ;
2154 " Imp_Cost = " + lcAPCost + ;
2155 ", AP_Cost = " + lcAPCost + ;
2156 ", User_ID = " + SQLFormatChar(lcUser_ID) + ;
2157 ", Last_Mod = DATETIME()"
2158*=== TR 1031098/1038235 02/28/09 MP
2159
2160*=== TR 1031098 02/28/09 MP
2161
2162*=== TR 1030681 02/20/08 MP
2163 lcSQLString = lcSQLString + lcAddlSQLString
2164 llRetVal = llRetVal AND v_SQLExec(lcSQLString,,, true)
2165 ENDIF
2166*=== TAN 1029485 12/28/2007 AZ
2167
2168 *--- TR 1039635 19-APR-2009 VKK
2169 IF llRangeStyle
2170 llRetVal = llRetVal ANd .UpdateRangeStyleCategory(tcProdDetailName, tcCostSheetName, tcProdHeaderName, ;
2171 lcOrigAddlSQLString, pcApproveOrUnapprove)
2172 ENDIF
2173 *=== TR 1039635 19-APR-2009 VKK
2174
2175 *--- TechRec 1039635 30-Apr-2009 vkrishnamurthy --- Added 1 new Parameters
2176*!* .oBPOCost.ProrateVoucher(tcProdDetailName, tcCostSheetName, tcProdHeaderName)
2177 * --- TR 1055405 RLN 12/19/11 - Pass in True to Prorate so that TimeStampDoc will not fire within
2178 *.oBPOCost.ProrateVoucher(tcProdDetailName, tcCostSheetName, tcProdHeaderName,tcBOMName)
2179 .oBPOCost.ProrateVoucher(tcProdDetailName, tcCostSheetName, tcProdHeaderName,tcBOMName, .T.)
2180 *--- TechRec 1078639 16-May-2014 jjanand ---
2181 *oBPOCost.cHeaderAlias = tcProdHeaderName && TR 1056306 07-30-2013 RKI
2182 .oBPOCost.cHeaderAlias = tcProdHeaderName
2183 *=== TechRec 1078639 16-May-2014 jjanand ===
2184 .oBPOCost.ProrateVoucher(tcProdDetailName, tcCostSheetName, tcProdHeaderName,tcBOMName, .T.)
2185 *=== TechRec 1039635 30-Apr-2009 vkrishnamurthy ===
2186 ENDIF
2187
2188*!* SELECT tc_UpdateCS
2189*!* LOCATE FOR Prod_Num = XXX AND Open_Seq = XXX AND Category = XXX
2190*!* IF NOT FOUND()
2191*!* APPEND BLANK
2192*!* REPLACE ;
2193*!* Prod_Num WITH XXX, ;
2194*!* Open_Seq WITH XXX, ;
2195*!* Category WITH XXX ;
2196*!* IN tcUpdateCS
2197*!* ENDIF
2198 * === 1003625 End.
2199
2200 *EndIf && Cost Sheet exists for this category
2201 ENDIF && Cost Sheet or Prod Ord
2202 ENDSCAN
2203
2204 USE IN tcTmpCursor
2205 ENDIF && Cursor of PKeys exists
2206 ENDIF && Production line.
2207 ENDSCAN && Vzzgapvcd
2208 * --- TR 1055405 RLN 12/19/11 - Now Fire TimeStampDoc for the 2 tables here:
2209 .oBPOCost.TimeStampDocument(tcProdDetailName)
2210 .oBPOCost.TimeStampDocument(tcCostSheetName, "ALL")
2211
2212 * --- 1003958 Optimized recalc - write records back to real cost sheet cursor:
2213 IF .oBPOCost.lOptimizedRecalc AND USED(.oBPOCost.cDetAlias) AND USED(.oBPOCost.cCstAlias) &&& 1056525 AZ
2214 .oBPOCost.WriteBackToRealViews(tcCostSheetName, tcProdDetailName, , false)
2215 *--- TAN 1029485 12/28/2007 AZ
2216 .oBPOCost.CloseDynamicCursors() && 1029485
2217 *=== TAN 1029485 12/28/2007 AZ
2218 ENDIF
2219 * === 1003958 end.
2220
2221 *--- TR 1038235 22-Oct-2008 VKK
2222 IF NOT EMPTY(lcShipmentList)
2223 lcShipmentList = RemoveLastDelimiter(lcShipmentList)
2224 ltLPTest = {1/1/1900 12:00:00}
2225
2226 lcSQLString = ;
2227 "UPDATE ZZCORDRD SET " + ;
2228 " Last_Prorated = " + SQLFormatTS(ltLPTest) + ;
2229 " WHERE Shp_Seq IN(" + lcShipmentList + ")" + ;
2230 " AND sc_rowlock < 'Y' " &&& 1023462 AZ
2231
2232 llRetVal = llRetVal AND v_SQLExec(lcSQLString)
2233
2234 ENDIF
2235 *=== TR 1038235 22-Oct-2008 VKK
2236
2237 ENDWITH
2238
2239 USE IN SELECT('tc_zzmshpth')
2240
2241 this.oLog.LogEntry("Updating shipment header: "+lcCost_Type) &&& 151285
2242
2243 * Now update shipment lines with values in cursor tcTempShipmentHolderName:
2244 SELECT (tcTempShipmentHolderName)
2245 SCAN
2246 * Update Shipment Table (Amount and Cost By):
2247 lcCost_Type = Evaluate(tcTempShipmentHolderName + ".Cost_Type")
2248 lcCost_By = Evaluate(tcTempShipmentHolderName + ".Cost_By")
2249 lcCBName = StrTran(lcCost_Type, "FEE", "BY")
2250
2251 * --- 1003625 Update Prorated_xx flags to "N" to tell shipping
2252 * proration to take care of it:
2253 IF lcCost_Type = "DUTY_FEE"
2254 lcProrateFName = "Prorated_Duty"
2255 ELSE
2256 * Convert UDFXX_FEE ==> Prorated_XX
2257 lcProrateFName = "Prorated" + SUBSTR(lcCost_Type, 4, 2)
2258 ENDIF
2259 * === 1003625 End.
2260
2261 * --- 1003625 CB Per meeting in Joe's office, where I even sat on the floor!,
2262 * took the following line out of the UPDATE statement temporarily:
2263 * ", " + lcProrateFName + " = 'N' " + ;
2264 * === 1003625 End.
2265
2266 lcSQLString = ;
2267 "UPDATE " + tcShipmentName + " SET " + lcCost_Type + " = " + lcCost_Type + ;
2268 " + " + SQLFormatNum(Evaluate(tcTempShipmentHolderName + ".Amount"), 5) + ;
2269 ", User_ID = " + SQLFormatChar(lcUser_ID) + ;
2270 ", Last_Mod = DATETIME()" + ;
2271 " WHERE Shipment_Num = " + SQLFormatNum(Evaluate(tcTempShipmentHolderName + ".Ship_No"))
2272 llRetVal = llRetVal AND v_SQLExec(lcSQLString,,, true)
2273
2274 * Only change cost by field if empty:
2275 lcSQLString = ;
2276 "UPDATE " + tcShipmentName + " SET " + lcCBName + " = " + SQLFormatChar(lcCost_By) + ;
2277 ", User_ID = " + SQLFormatChar(lcUser_ID) + ;
2278 ", Last_Mod = DATETIME() " + ;
2279 " WHERE Shipment_Num = " + SQLFormatNum(Evaluate(tcTempShipmentHolderName + ".Ship_No")) + ;
2280 " AND " + lcCBName + " = ''"
2281 llRetVal = llRetVal AND v_SQLExec(lcSQLString,,, true)
2282
2283 * --- 1003625 CB 03/04 - We have now added shipment categories on production lines. When the
2284 * production line went through the above scan, it called out to clsCost, which updated
2285 * the Last_Mod on the production detail line using SQL passthrough. The following code
2286 * timestamps it again, causing contention for some reason un-knowable to human mortals.
2287 * Therefore, we only want to call this code for pure shipment lines:
2288 IF EVALUATE(tcTempShipmentHolderName + ".UpdLastMod") = "Y"
2289 TimeStampProductionShipment(SysgetFieldvalue(This.cDetailAlias,"Shp_Seq"))
2290 ENDIF
2291 * === 1003625 End.
2292 ENDSCAN
2293
2294 *--- TR 1051285 04/12/11 AZ
2295 IF TYPE("polog") <> "O"
2296 this.oLog.CloseLog() &&& 1049037 AZ
2297 ENDIF
2298 *=== TR 1051285 04/12/11 AZ
2299
2300 SELECT (lnSelect)
2301 RETURN llRetVal
2302
2303ENDFUNC
2304
2305*-----------------------------------------------------------------------------
2306* --- TR 1022799 HNISAR 22-MAR-2007
2307FUNCTION GetProductionLines
2308
2309 LParameters tnProd_Num ,tnProdDetailKey
2310 Local lcSQLString, lcProductionDetlView, lcProdOrdrdLineNums, lnProdOrdCurPKey , ;
2311 llRetVal, lnSelect,lnLen
2312
2313 llRetVal = true
2314 lcProductionDetlView = GetUniqueFilename()
2315 lcProdOrdrdLineNums = ''
2316 lnSelect = Select()
2317 lnProdOrdCurPKey = tnProdDetailKey
2318
2319 With This
2320 IF SysgetFieldvalue(This.cDetailAlias,"Line_Type") = AP_LINE_TYPE_PROD_ORD Then
2321
2322 .cFltrStrPrevDeltFrmAllStages = ""
2323
2324 lcSQLString = "SELECT PKey, ParKey ,Prod_Line" + ;
2325 " FROM zzcordrd l " + ;
2326 " WHERE l.Prod_Num = " + SQLFormatNum(tnProd_Num )
2327
2328 llRetVal = llRetVal AND v_SQLExec(lcSQLString, lcProductionDetlView )
2329
2330 If Used(lcProductionDetlView)
2331
2332 DO While True
2333
2334 Select (lcProductionDetlView)
2335 *GO TOP
2336 LOCATE FOR PKEY = lnProdOrdCurPKey
2337
2338 IF EOF()
2339 EXIT
2340 ENDIF
2341
2342 *--- TechRec 1026008 13-Aug-2007 GSternik ---
2343 *lcProdOrdrdLineNums = lcProdOrdrdLineNums + Alltrim(Str(Evaluate(lcProductionDetlView + ".Prod_Line"))) + ','
2344 lcProdOrdrdLineNums = lcProdOrdrdLineNums + ;
2345 Alltrim(Str(Prod_Line)) + ','
2346 *=== TechRec 1026008 13-Aug-2007 GSternik ===
2347
2348 IF ParKey = -1
2349 EXIT
2350 ELSE
2351 lnProdOrdCurPKey = ParKey
2352 ENDIF
2353
2354 ENDDO
2355
2356 EndIf
2357
2358 lnLen = Len(lcProdOrdrdLineNums)
2359
2360 If lnLen > 0
2361 lcProdOrdrdLineNums = RemoveLastDelimiter(lcProdOrdrdLineNums)
2362 EndIf
2363
2364 .TableClose(lcProductionDetlView)
2365
2366 ELSE
2367 lcProdOrdrdLineNums = SQLFormatNum(SysgetFieldvalue(This.cDetailAlias,"Prod_Line"))
2368 ENDIF
2369
2370
2371 *-- GS: This is strange: if there is no any line the fiter SQL below will get all of them...
2372
2373 .cFltrStrPrevDeltFrmAllStages = " AND Prod_Num = " + SQLFormatNum(SysgetFieldvalue(This.cDetailAlias,"Prod_Num")) + ;
2374 IIF(EMPTY(lcProdOrdrdLineNums),""," AND Prod_Line in (" + lcProdOrdrdLineNums + ")" )
2375
2376 ENDWITH
2377
2378 SELECT (lnSelect)
2379 RETURN llRetVal
2380
2381ENDFUNC
2382* === TR 1022799 HNISAR 22-MAR-2007
2383
2384*--- 1025627 07-23-2007 SKG
2385FUNCTION GetPreviousAction
2386
2387LOCAL llRetVal, lnOldSelect, llVal
2388lnOldSelect = Select()
2389llRetVal = .F.
2390
2391llVal = v_SQLExec("SELECT approved from zzgapvch where pkey = " + SQLFormatNum(SysgetFieldvalue(This.cHeaderAlias,"pkey")),"tcAppr")
2392IF tcAppr.approved = 'Y'
2393 llRetval = .T.
2394ENDIF
2395this.TableClose("tcAppr")
2396
2397SELECT (lnOldSelect)
2398RETURN llRetval
2399
2400ENDFUNC
2401*=== 1025627 07-23-2007 SKG
2402
2403*--- TechRec 1031091 03-May-2008 vkrishnamurthy ---
2404*============================================================
2405 FUNCTION ValidateInvoiceAmount
2406 LOCAL llRetVal, lnSelect ,lnAp_amt ,lnTotAp_Amt
2407
2408 llRetVal = true
2409 lnSelect = SELECT()
2410
2411 lnAp_amt = 0
2412 lnTotAp_Amt = 0
2413
2414 SELECT (This.cHeaderAlias)
2415 lnAp_amt = Ap_amt
2416
2417 *--- TR 1044105 09-DEC-2009 HNISAR
2418 * Commented If Condn.
2419*!* IF lnAp_amt <> 0
2420 *=== TR 1044105 09-DEC-2009 HNISAR
2421
2422 SELECT (This.cDetailAlias)
2423 This.PushRecordSet()
2424 CALCULATE SUM(ap_amt) TO lnTotAp_Amt
2425 This.PopRecordSet()
2426
2427 *--- TR 1044105 09-DEC-2009 HNISAR
2428*!* ENDIF
2429 *=== TR 1044105 09-DEC-2009 HNISAR
2430
2431 llRetVal = ( lnAp_amt = lnTotAp_Amt )
2432
2433 SELECT (lnSelect)
2434 RETURN llRetVal
2435 ENDFUNC
2436*============================================================
2437 FUNCTION ValidateForBlankFldValue
2438 LPARAMETERS pcField
2439 LOCAL llRetVal, lnSelect
2440
2441 llRetVal = true
2442 lnSelect = SELECT()
2443
2444 SELECT (This.cDetailAlias)
2445 This.PushRecordSet()
2446 *--- TechRec 1036315 21-Oct-2008 T.Shenbagavalli if condition added ---
2447 IF ALLTRIM(UPPER(pcField)) = "DIVISION"
2448 LOCATE FOR EMPTY(&pcField) AND Line_Type <> AP_LINE_TYPE_SHIPMENT
2449 ELSE
2450 *=== TechRec 1036315 21-Oct-2008 T.Shenbagavalli ===
2451 LOCATE FOR EMPTY(&pcField)
2452 *--- TechRec 1036315 21-Oct-2008 T.Shenbagavalli ---
2453 ENDIF
2454 *=== TechRec 1036315 21-Oct-2008 T.Shenbagavalli ===
2455
2456 IF FOUND()
2457 llRetVal = False
2458 ENDIF
2459
2460 This.PopRecordSet()
2461
2462 SELECT (lnSelect)
2463 RETURN llRetVal
2464 ENDFUNC
2465
2466*============================================================
2467*=== TechRec 1031091 03-May-2008 vkrishnamurthy ===
2468
2469*--- TechRec 1031878 26-May-2008 vkrishnamurthy ---
2470*============================================================
2471 FUNCTION GetHeaderTermsPOFlag
2472 LOCAL llRetVal, lnSelect , lcTerms ,lcAPv_Rcpt_Reqd
2473
2474 llRetVal = true
2475 lnSelect = SELECT()
2476
2477 lcAPv_Rcpt_Reqd = ''
2478
2479 WITH This
2480 SELECT (.cHeaderAlias)
2481 lcTerms = Terms
2482
2483 IF NOT EMPTY(lcTerms)
2484 lcAPv_Rcpt_Reqd = vl_cterm(lcTerms,"APV_Rcpt_Reqd")
2485 ENDIF
2486 ENDWITH
2487
2488 SELECT (lnSelect)
2489 RETURN lcAPv_Rcpt_Reqd
2490 ENDFUNC
2491
2492*============================================================
2493 FUNCTION GetDetailCatgPOFlag
2494 LOCAL llRetVal, lnSelect , lcCategory ,lcAPv_Rcpt_Reqd
2495
2496 llRetVal = true
2497 lnSelect = SELECT()
2498
2499 lcAPv_Rcpt_Reqd = ''
2500 WITH This
2501 SELECT (.cDetailAlias)
2502 lcCategory = Category
2503 IF SEEK(Category, "tc_zzdcatgr", "Category")
2504 lcAPv_Rcpt_Reqd = tc_zzdcatgr.APv_Rcpt_Reqd
2505 ENDIF
2506 ENDWITH
2507
2508 SELECT (lnSelect)
2509 RETURN lcAPv_Rcpt_Reqd
2510 ENDFUNC
2511
2512*============================================================
2513 FUNCTION GetProductionActulas
2514 LPARAMETERS tnProd_num, tnPkey,tcPrdCond,pnGITRecvdcost,pnGITRecvdQty
2515
2516 LOCAL llRetVal, lnSelect ,lcSQLString, lcProductionDetlView ,lnProdOrdCurPKey
2517
2518 llRetVal = true
2519 lnSelect = SELECT()
2520
2521 lcProductionDetlView = GetUniqueFilename()
2522 lnProdOrdCurPKey = tnPkey
2523
2524 pnGITRecvdcost = 0
2525 pnGITRecvdQty = 0
2526
2527 WITH This
2528 lcSQLString = "SELECT PKey, ParKey ,total_qty,wip_total , cost , last_stage, shp_ok " + ;
2529 " FROM zzcordrd l " + ;
2530 " WHERE l.Prod_Num = " + SQLFormatNum(tnProd_Num )
2531
2532 llRetVal = llRetVal AND v_SQLExec(lcSQLString, lcProductionDetlView )
2533
2534 If Used(lcProductionDetlView)
2535 DO While True
2536 Select (lcProductionDetlView)
2537 LOCATE FOR PKEY = lnProdOrdCurPKey
2538
2539 IF EOF()
2540 EXIT
2541 ENDIF
2542
2543 IF Last_Stage = 'Y'
2544 pnGITRecvdQty = pnGITRecvdQty + Total_qty
2545 pnGITRecvdcost= pnGITRecvdcost + (Total_qty * Cost)
2546 ENDIF
2547
2548 IF tcPrdCond = "I" AND shp_ok = 'Y'
2549 pnGITRecvdQty = pnGITRecvdQty + Wip_total
2550 pnGITRecvdcost= pnGITRecvdcost + (Wip_total* Cost)
2551 ENDIF
2552
2553 IF ParKey = -1
2554 EXIT
2555 ELSE
2556 lnProdOrdCurPKey = ParKey
2557 ENDIF
2558 ENDDO
2559 .TableClose(lcProductionDetlView)
2560 ENDIF
2561
2562 ENDWITH
2563
2564 SELECT (lnSelect)
2565 RETURN llRetVal
2566 ENDFUNC
2567
2568*============================================================
2569 FUNCTION GetHeaderStatus
2570 LOCAL llRetVal, lnSelect ,lcStatus ,llPending,llUnBalanced
2571
2572 llRetVal = true
2573 lnSelect = SELECT()
2574
2575 WITH This
2576 .PushRecordSet() && to restore current alias
2577 SELECT (This.cDetailAlias)
2578 .PushRecordSet() && to restore new alias' record pointer
2579
2580 LOCATE FOR ap_status = .cAPPendingStatus
2581 IF FOUND()
2582 llPending = .T.
2583 ENDIF
2584
2585 LOCATE FOR ap_status = .cAPUnBalancedStatus
2586 IF FOUND()
2587 llUnBalanced = .T.
2588 ENDIF
2589
2590 .PopRecordSet()
2591 .PopRecordSet()
2592
2593 lcStatus = IIF(llPending , .cAPPendingStatus , IIF(llUnBalanced,.cAPUnBalancedStatus, AP_STATUS_BALANCED))
2594 ENDWITH
2595
2596 SELECT (lnSelect)
2597 RETURN lcStatus
2598 ENDFUNC
2599*============================================================
2600 FUNCTION GetShpTermsPOFlag
2601 LPARAMETERS tnProd_Num ,tcDivision
2602 LOCAL llRetVal, lnSelect ,lcSQLString , lcTemp ,lcAPV_Rcpt_Reqd
2603
2604 llRetVal = true
2605 lnSelect = SELECT()
2606
2607 lcTemp = GetUniqueFileName()
2608
2609 lcAPV_Rcpt_Reqd = ''
2610
2611 WITH This
2612 lcSQLString = " Select t.APV_Rcpt_Reqd from ZZCORDRH H " + ;
2613 " Join ZZPSHPTR t on H.Terms_Ship = t.terms " + ;
2614 " Where H.Prod_num = " + SQlFormatNum(tnProd_num) + ;
2615 " AND H.Division = " + SQlFormatChar(tcDivision)
2616
2617 llRetVal = V_SqlExec(lcSQLString ,lcTemp )
2618
2619 IF llRetVal AND USED(lcTemp)
2620 SELECT(lcTemp)
2621 lcAPV_Rcpt_Reqd = APV_Rcpt_Reqd
2622 ENDIF
2623
2624 .TableClose(lcTemp)
2625 ENDWITH
2626
2627 SELECT (lnSelect)
2628 RETURN lcAPV_Rcpt_Reqd
2629 ENDFUNC
2630
2631*============================================================
2632 *--- TR 1031878 28-MAY-2008 VKK
2633 FUNCTION GetProductionValues
2634 * --- TR 1048606 RLN 08/02/10
2635 *LPARAMETERS tnProd_num, tnPkey,tcPrdCond,pnGITRecvdcost, pnGITRecvdQty
2636 LPARAMETERS tnProd_num, tnPkey,tcPrdCond,pnGITRecvdcost,pnGITRecvdQty, tcCmpStyle, tcCmpColor, tcCmpLbl, tcCmpDim
2637 LOCAL llRetVal, lnSelect ,lcSQLString, lcProductionDetlView ,lnProdOrdCurPKey, lcTree_Seq
2638* --- TR 1048606 RLN 08/02/10
2639 LOCAL lcCategory, lcLineType, lnProdNum, lnProdLine, lnRangePkey, lnPOQty
2640
2641 llRetVal = true
2642 lnSelect = SELECT()
2643
2644 lcProductionDetlView = GetUniqueFilename()
2645 lnProdOrdCurPKey = tnPkey
2646
2647 pnGITRecvdcost = 0
2648 pnGITRecvdQty = 0
2649 lnPOQty = 0
2650 WITH This
2651 lcSQLString = "SELECT PKey, ParKey ,total_qty,wip_total , cost , last_stage, shp_ok, tree_Seq " + ;
2652 " FROM zzcordrd l " + ;
2653 " WHERE l.Prod_Num = " + SQLFormatNum(tnProd_Num )
2654
2655 llRetVal = llRetVal AND v_SQLExec(lcSQLString, lcProductionDetlView )
2656
2657 If Used(lcProductionDetlView)
2658 Select (lcProductionDetlView)
2659 LOCATE FOR PKEY = lnProdOrdCurPKey
2660
2661 IF NOT EOF()
2662 lcTree_Seq = ALLTRIM(Tree_Seq)
2663
2664 *SCAN FOR lcTree_Seq $ ALLTRIM(Tree_Seq)
2665 SCAN FOR AT(lcTree_Seq , ALLTRIM(Tree_Seq)) == 1
2666 IF Last_Stage = 'Y'
2667 pnGITRecvdQty = pnGITRecvdQty + Total_qty
2668 pnGITRecvdcost= pnGITRecvdcost + ROUND((Total_qty * SysgetFieldValue(.cDetailalias,"Cost")), 2)
2669 * --- TR 1048606 RLN 08/02/10
2670 lnPOQty = lnPOQty + Total_qty
2671 ENDIF
2672
2673 IF tcPrdCond = "I" AND shp_ok = 'Y'
2674 pnGITRecvdQty = pnGITRecvdQty + Wip_total
2675 pnGITRecvdcost= pnGITRecvdcost + ROUND((Wip_total* SysgetFieldValue(.cDetailalias,"Cost")), 2)
2676 * --- TR 1048606 RLN 08/02/10
2677 lnPOQty = lnPOQty + Wip_total
2678 ENDIF
2679 ENDSCAN
2680 ENDIF
2681 .TableClose(lcProductionDetlView)
2682 ENDIF
2683 * --- TR 1048606 RLN 08/02/10
2684 IF !EMPTY(tcCmpStyle)
2685 lcCategory = SysgetFieldValue(.cDetailalias, "Category")
2686 lcLineType = SysgetFieldValue(.cDetailalias, "Line_type")
2687 lnProdNum = SysgetFieldValue(.cDetailalias, "Prod_num")
2688 lnProdLine = SysgetFieldValue(.cDetailalias, "Prod_line")
2689 IF !EMPTY(lcCategory) AND lcLineType = AP_LINE_TYPE_PROD_ORD
2690 lnRangePkey = 0
2691 .CheckForRangeStyle(lnProdNum, lnProdLine, @lnRangePkey)
2692 pnGITRecvdQty = .GetComponentTrxQty(lnRangePkey, lnPOQty)
2693 ENDIF
2694 ENDIF
2695 * === TR 1048606
2696 ENDWITH
2697
2698 SELECT (lnSelect)
2699 RETURN llRetVal
2700 ENDFUNC
2701*============================================================
2702*=== TechRec 1031878 26-May-2008 vkrishnamurthy ===
2703 *--- TR 1038235 22-Oct-2008 VKK
2704 FUNCTION DropTempTables
2705 LPARAMETERS tcTmpCurordrd, tcTmpCurordrh, tcTmpCurshpmh
2706 LOCAL llRetVal, lnSelect, lcSQLString
2707
2708 llRetVal = true
2709 lnSelect = SELECT()
2710
2711 IF NOT EMPTY(tcTmpCurordrd)
2712 lcSQLString = "DROP TABLE " + tcTmpCurordrd
2713 llRetVal = llRetVal AND V_SQLExec(lcSQLString)
2714 ENDIF
2715 IF NOT EMPTY(tcTmpCurordrh)
2716 lcSQLString = "DROP TABLE " + tcTmpCurordrh
2717 llRetVal = llRetVal AND V_SQLExec(lcSQLString)
2718 ENDIF
2719 IF NOT EMPTY(tcTmpCurshpmh)
2720 lcSQLString = "DROP TABLE " + tcTmpCurshpmh
2721 llRetVal = llRetVal AND V_SQLExec(lcSQLString)
2722 ENDIF
2723
2724 SELECT (lnSelect)
2725 RETURN llRetVal
2726
2727 ENDFUNC
2728 *=== TR 1038235 22-Oct-2008 VKK
2729*------------------------------------------
2730*--- TR 1038235 22-Oct-2008 VKK
2731
2732*============================================================
2733
2734 FUNCTION CreateLocalCursors
2735 LPARAMETERS tcPrdTempTable, tcPrdLocal, ;
2736 tcShpTempTable, tcShpLocal, ;
2737 tcPrdHTempTable, tcPrdHLocal ,;
2738 tcVouchTempTable, tcVouchLocal
2739
2740 LOCAL llRetVal, lnSelect, lcSQLString
2741
2742 llRetVal = true
2743 lnSelect = SELECT()
2744
2745 WITH This
2746 lcSQLString = " SELECT * FROM " + tcPrdTempTable
2747 llRetVal = llRetVal AND V_SQLExec(lcSQLString, tcPrdLocal)
2748 SELECT (tcPrdLocal)
2749 INDEX On Pkey TAG Pkey
2750 INDEX ON prod_Num TAG Prod_Num
2751
2752 lcSQLString = " SELECT * FROM " + tcShpTempTable
2753 llRetVal = llRetVal AND V_SQLExec(lcSQLString, tcShpLocal)
2754 SELECT (tcShpLocal)
2755 INDEX On Pkey TAG Pkey
2756 INDEX On Shipment_Num TAG ship
2757
2758 lcSQLString = " SELECT * FROM " + tcPrdHTempTable
2759 llRetVal = llRetVal AND V_SQLExec(lcSQLString, tcPrdHLocal)
2760 SELECT (tcPrdHLocal)
2761 INDEX On Pkey TAG Pkey
2762 INDEX ON prod_Num TAG Prod_Num
2763
2764 &&--- TechRec 1039635 30-Aug-2010 vkrishnamurthy === Added d.cmp_style,d.cmp_color,d.cmp_lbl,d.cmp_dim
2765 lcSQLString = " SELECT h.approved, " + ;
2766 " h.ap_inv, " + ;
2767 " d.Ap_amt, " + ;
2768 " d.trx_pkey, " + ;
2769 " d.trx_pkey as Prod_Pkey, " + ;
2770 " d.Category, " + ;
2771 " d.Prod_num ," + ;
2772 " d.cmp_style ," + ;
2773 " d.cmp_color ," + ;
2774 " d.cmp_lbl ," + ;
2775 " d.cmp_dim " + ;
2776 " FROM zzgapvch h " + ;
2777 " JOIN zzgapvcd d " + ;
2778 " ON h.pkey = d.fkey " + ;
2779 " WHERE EXISTS( Select 1 " + ;
2780 " FROM zzgapvcd d1 " + ;
2781 " WHERE d1.ap_inv = " + SQLFormatChar(SysgetFieldvalue(This.cHeaderAlias,"AP_Inv")) + ;
2782 " AND d1.prod_num = d.prod_num " + ;
2783 " AND d1.category = d.category) "
2784
2785 llRetVal = llRetVal AND V_SQLExec(lcSQLString, tcVouchLocal)
2786 SELECT (tcVouchLocal)
2787 INDEX On STR(Prod_Num) + Category TAG prod_Num
2788
2789 ENDWITH
2790
2791 SELECT (lnSelect)
2792 RETURN llRetVal
2793 ENDFUNC
2794
2795*============================================================
2796
2797 FUNCTION CalCulateAPAmount
2798 LPARAMETERS pcAPCost, pnAmount, pcApproveOrUnapprove,plRangeStyle
2799 &&--- TechRec 1039635 30-Aug-2010 vkrishnamurthy === Added plRangeStyle as Parameter
2800
2801 LOCAL llRetVal, lnSelect
2802
2803 Local tcAPApps, lnApproved, lnCount, lnAmount, lnExtAmount, lcAPCost, lcApCostPrev
2804
2805 llRetVal = true
2806 lnSelect = SELECT()
2807
2808 *--- TechRec 1039635 24-Apr-2009 vkrishnamurthy ---
2809 LOCAL lcRangeComponentFilter
2810 lcRangeComponentFilter = ''
2811 *=== TechRec 1039635 24-Apr-2009 vkrishnamurthy ===
2812
2813
2814 WITH This
2815 *--- TechRec 1039635 24-Apr-2009 vkrishnamurthy ---
2816 IF plRangeStyle
2817
2818 lcRangeComponentFilter = " AND d.cmp_style = " + SQLFormatChar(SysgetFieldvalue(This.cDetailAlias,"cmp_style")) + ;
2819 " AND d.cmp_color = " + SQLFormatChar (SysgetFieldvalue(This.cDetailAlias,"cmp_color")) + ;
2820 " AND d.cmp_lbl = " + SQLFormatChar(SysgetFieldvalue(This.cDetailAlias,"cmp_lbl")) + ;
2821 " AND d.cmp_dim = " + SQLFormatChar(SysgetFieldvalue(This.cDetailAlias,"cmp_dim"))
2822
2823 ELSE
2824 lcRangeComponentFilter = ""
2825 ENDIF
2826 *=== TechRec 1039635 24-Apr-2009 vkrishnamurthy ===
2827
2828 tcAPApps = GetUniqueFileName()
2829 Store 0 to lnApproved, lnCount, lnAmount, lnExtAmount
2830 lcAPCost = "''"
2831
2832 *--- TechRec 1039635 24-Apr-2009 vkrishnamurthy ---
2833*!* lcSQLString = " SELECT * " + ;
2834*!* " FROM __Vouch_Local d " + ;
2835*!* " WHERE d.Prod_Num = " + SQLFormatNum (SysgetFieldvalue(This.cDetailAlias,"Prod_Num")) + ;
2836*!* " AND d.Category = " + SQLFormatChar(SysgetFieldvalue(This.cDetailAlias,"Category"))
2837
2838 lcSQLString = " SELECT * " + ;
2839 " FROM __Vouch_Local d " + ;
2840 " WHERE d.Prod_Num = " + SQLFormatNum (SysgetFieldvalue(This.cDetailAlias,"Prod_Num")) + ;
2841 " AND d.Category = " + SQLFormatChar(SysgetFieldvalue(This.cDetailAlias,"Category")) +;
2842 lcRangeComponentFilter
2843
2844 *=== TechRec 1039635 24-Apr-2009 vkrishnamurthy ===
2845
2846
2847
2848* ========================================================
2849 llRetval = llRetVal AND v_SQLExec(lcSQLString, tcAPApps, , true) && Local VFP
2850
2851 IF llRetval
2852 Select (tcAPApps)
2853
2854 * how many records for prod num prod line, categ in voucher table
2855 lnCount = RECCOUNT()
2856
2857 * can be approved only , not approved only , appr and not appr
2858 IF lnCount > 0 && multiple records for prod num prod line, categ in voucher table
2859
2860 COUNT TO lnApproved FOR approved = 'Y' AND prod_pkey = SysgetFieldvalue(This.cDetailAlias,"trx_pkey")
2861 CALCULATE SUM(AP_Amt) to lnAmount FOR approved = 'Y' AND prod_pkey = SysgetFieldvalue(This.cDetailAlias,"trx_pkey")
2862 * sum total for appr and not appr
2863 CALCULATE SUM(AP_Amt) to lnExtAmount FOR prod_pkey = trx_pkey
2864
2865 * what for it was called
2866 IF pcApproveOrUnapprove = "APPROVE"
2867 lnAmount = lnAmount + SysgetFieldvalue(This.cDetailAlias,"AP_Amt")
2868 lcAPCost = "'Y'"
2869 ELSE
2870
2871 lnAmount = lnAmount - SysgetFieldvalue(This.cDetailAlias,"AP_Amt")
2872 lcAPCost = IIF(lnApproved > 1, "'Y'","'N'")
2873
2874 IF lnAmount = 0 AND lcAPCost = "''"
2875 lnAmount = lnExtAmount
2876 ENDIF
2877
2878 ENDIF
2879 ELSE && lnCount > 1
2880 * lnCount < 2
2881 * no records for prod num prod line, categ in voucher table
2882 * one record for prod num prod line, categ in voucher table
2883
2884 * if no records it is right
2885 * if 1 rec
2886 lnAmount = SysgetFieldvalue(This.cDetailAlias,"AP_Amt")
2887 lcAPCost = IIF(pcApproveOrUnapprove = "APPROVE", "'Y'","'N'")
2888 ENDIF && lnCount > 1
2889 ENDIF
2890 USE IN (tcAPApps)
2891
2892 *--- TR 1039635 1-9-2010 VKK
2893 pcAPCost = lcAPCost
2894 pnAmount = lnAmount
2895 *=== TR 1039635 1-9-2010 VKK
2896
2897 ENDWITH
2898
2899
2900 *--- TR 1048452 09/29/10 AZ
2901 pnAmount = lnAmount
2902 pcAPCost = lcAPCost
2903 *=== TR 1048452 09/29/10 AZ
2904
2905 SELECT (lnSelect)
2906 RETURN llRetVal
2907 ENDFUNC
2908*=== TR 1038235 22-Oct-2008 VKK
2909
2910*--- TR 1043344 07/13/10 AZ
2911*******************************************************
2912 FUNCTION ValidateForBlankCategory
2913
2914 LOCAL llRetVal, lnSelect
2915
2916 LOCAL lnProd_num,lcCategory,lcUse_cost
2917
2918 llRetVal = true
2919 lnSelect = SELECT()
2920
2921 SELECT (This.cDetailAlias)
2922 This.PushRecordSet()
2923 SCAN FOR Line_Type = AP_LINE_TYPE_PROD_ORD
2924 lnProd_num = prod_num
2925 lcCategory = category
2926 lcUse_cost = vl_cordrh(lnProd_num,"USE_COST")
2927 IF lcUse_cost = 'Y' AND EMPTY(lcCategory)
2928 llRetVal = .F.
2929 EXIT
2930 ENDIF
2931 ENDSCAN
2932 SELECT (This.cDetailAlias)
2933 This.PopRecordSet()
2934
2935 SELECT (lnSelect)
2936 RETURN llRetVal
2937 ENDFUNC
2938*=== TR 1043344 07/13/10 AZ
2939
2940*--- TR 1039635 19-APR-2009 VKK
2941*============================================================
2942
2943 FUNCTION UpdateRangeStyleCategory
2944 LPARAMETERS tcProdDetailName, tcCostSheetName, tcProdHeaderName, tcOrigAddlSQLString, pcApproveOrUnapprove
2945 LOCAL llRetVal, lnSelect, llApprove, llActualized, lcSQLString, lcTempCur, lnCategory_Cost, lnExtension,;
2946 lcApproveCondition,lcCursor ,lnConstantRollup ,lnWipTotal
2947
2948 llRetVal = true
2949 lnSelect = SELECT()
2950 lcTempCur = GetUniqueFileName()
2951 lcCursor = GetUniqueFileName()
2952
2953 lnCategory_Cost = 0
2954 lnExtension = 0
2955 lnWipTotal = 0
2956
2957 WITH This
2958 llApprove = (pcApproveOrUnapprove = "APPROVE")
2959
2960 lcApproveCondition = " AND ap_cost <> 'Y'"
2961
2962 * rangle style must be approved only if all components are approved
2963 * even if one compare is not appproved or unapproved then rangel must be unapproved
2964 llRetVal = llRetVal AND .RetrieveBufferedDataToCursor(tcCostSheetName, lcTempCur)
2965
2966 lcSQLString = " SELECT * FROM " + lcTempCur + tcOrigAddlSQLString + lcApproveCondition + " AND sysLevel = 1"
2967
2968
2969 llRetVal = llRetVal AND v_SQLExec(lcSQLString,lcCursor ,,true)
2970
2971 llActualized = llRetVal AND (RECCOUNT(lcCursor) = 0 )
2972
2973
2974 IF llActualized
2975
2976 SELECT(tcProdDetailName)
2977 lnWipTotal= IIF(Last_Stage = 'Y', Total_Qty, Wip_Total)
2978
2979
2980 lcSumString = "SELECT category, SUM(constant) as Constant, ;
2981 SUM(Extension) as Extension " + ;
2982 " FROM " + lcTempCur + ;
2983 " GROUP BY Category " + ;
2984 tcOrigAddlSQLString + " AND sysLevel = 1"
2985
2986 llRetVal = llRetVal AND v_SQLExec(lcSumString ,lcTempCur,,true)
2987
2988 IF llRetVal
2989 SELECT (lcTempCur)
2990 lnCategory_Cost = Extension / IIF(lnWipTotal = 0, 1, lnWipTotal)
2991 lnExtension = Extension
2992 lnConstantRollup = IIF(Constant > 0 .AND. lnWipTotal > 0, Extension / lnWipTotal, 0)
2993 ENDIF
2994
2995
2996 lcSQLString = " UPDATE " + tcCostsheetName + ;
2997 " SET Imp_Cost = " + IIF(llApprove, "'Y'", "'N'") + ;
2998 " , AP_Cost = " + IIF(llApprove, "'Y'", "'N'") + ;
2999 " , User_ID = " + SQLFormatChar(goEnv.cUser) + ;
3000 " , Last_Mod = DATETIME()" + ;
3001 " , Category_Cost = " + SQLFormatNum(lnCategory_Cost,5) + ; &&& 1079675 AZ
3002 " , Extension = " + SQLFormatNum(lnExtension, 5) + ;
3003 " ,Constant = " + SQLFormatNum(lnConstantRollup)+ ;
3004 " " + tcOrigAddlSQLString + ;
3005 " AND sysLevel = 0 "
3006
3007 llRetVal = llRetVal AND v_SQLExec(lcSQLString,,,true)
3008 ELSE
3009 IF NOT llApprove
3010 * when unapproved reset back to old estm_Ext_cost value.
3011 lcSQLString = " UPDATE " + tcCostsheetName + ;
3012 " SET Imp_Cost = 'N'" + ;
3013 " , AP_Cost = 'N'" + ;
3014 " , User_ID = " + SQLFormatChar(goEnv.cUser) + ;
3015 " , Last_Mod = DATETIME()" + ;
3016 " , Category_Cost = estm_ext_cost/" + SQLFormatNum(tcTmpCursor.Total_Qty) + ;
3017 " , Extension = estm_ext_cost " + ;
3018 " " + tcOrigAddlSQLString + ;
3019 " AND sysLevel = 0 "
3020
3021 llRetVal = llRetVal AND v_SQLExec(lcSQLString,,,true)
3022 ENDIF
3023
3024 ENDIF
3025
3026 .TableClose(lcTempCur)
3027 .TableClose(lcCursor)
3028 ENDWITH
3029
3030 SELECT (lnSelect)
3031 RETURN llRetVal
3032 ENDFUNC
3033
3034*============================================================
3035*--- TechRec 1039635 23-Apr-2009 vkrishnamurthy ---
3036 FUNCTION SetComponentTrxQty
3037 LPARAMETERS tnPkey
3038 LOCAL llRetVal, lnSelect ,lcSQLString ,lcCursor ,lcStyle, lcColor_code, lclbl_code, lcDimension,lnQty ,lnPOQty
3039
3040 llRetVal = true
3041 lnSelect = SELECT()
3042 lcCursor = GetUniqueFileName()
3043 lnQty = 0
3044 lnPOQty = 0
3045 WITH This
3046 SELECT(.cDetailAlias)
3047 lcStyle = Cmp_Style
3048 lcColor_code= Cmp_Color
3049 lclbl_code = Cmp_lbl
3050 lcDimension = Cmp_Dim
3051 lcSQLString = " SELECT Total_qty " + ;
3052 " FROM ZZXRANGD " + ;
3053 " WHERE Fkey = " + SQLFormatNum(tnPkey) + ;
3054 " AND Style = " + SQLFormatChar(lcStyle) + ;
3055 " AND color_code = " + SQLFormatChar(lcColor_code)+ ;
3056 " AND lbl_code = " + SQLFormatChar(lclbl_code)+;
3057 " AND dimension = " + SQLFormatChar(lcDimension)
3058
3059 llRetVal = llRetVal AND V_SqlExec(lcSQLString,lcCursor)
3060ASSERT .f.
3061 IF llRetVal AND USED(lcCursor)
3062 SELECT(lcCursor)
3063 lnQty = Total_Qty
3064 IF IsObject(.OProdDetail, true)
3065 lnPOQty = .OProdDetail.Total_qty
3066 ENDIF
3067 Replace trx_qty WITH lnPOQty*lnQty IN (.cDetailAlias)
3068 ENDIF
3069 .TableClose(lcCursor)
3070 ENDWITH
3071
3072 SELECT (lnSelect)
3073 RETURN lnQty
3074 ENDFUNC
3075*============================================================
3076 FUNCTION GetComponentTrxQty
3077 LPARAMETERS tnPkey, tnTrxQty
3078 LOCAL llRetVal, lnSelect ,lcSQLString ,lcCursor ,lcStyle, lcColor_code, lclbl_code, lcDimension, lnQty
3079
3080 llRetVal = true
3081 lnSelect = SELECT()
3082 lcCursor = GetUniqueFileName()
3083 lnQty = 0
3084 tnTrxQty = IIF(EMPTY(tnTrxQty), 1, tnTrxQty)
3085
3086 WITH This
3087 SELECT(.cDetailAlias)
3088 lcStyle = Cmp_Style
3089 lcColor_code= Cmp_Color
3090 lclbl_code = Cmp_lbl
3091 lcDimension = Cmp_Dim
3092 lcSQLString = " SELECT Total_qty " + ;
3093 " FROM ZZXRANGD " + ;
3094 " WHERE Fkey = " + SQLFormatNum(tnPkey) + ;
3095 " AND Style = " + SQLFormatChar(lcStyle) + ;
3096 " AND color_code = " + SQLFormatChar(lcColor_code)+ ;
3097 " AND lbl_code = " + SQLFormatChar(lclbl_code)+;
3098 " AND dimension = " + SQLFormatChar(lcDimension)
3099
3100 llRetVal = llRetVal AND V_SqlExec(lcSQLString,lcCursor)
3101
3102 IF llRetVal AND USED(lcCursor)
3103 SELECT(lcCursor)
3104 lnQty = Total_Qty * tnTrxQty
3105 ENDIF
3106 .TableClose(lcCursor)
3107 ENDWITH
3108
3109 SELECT (lnSelect)
3110 RETURN lnQty
3111 ENDFUNC
3112*============================================================
3113 FUNCTION GetComponentStyle
3114 LPARAMETERS pnPkey
3115
3116 LOCAL lnSelect, llRetVal ,lcSqlString , lcCursor ,lcCmp_Style, lcCmp_Color, lcCmp_lbl, lcCmp_Dim
3117
3118 llRetVal = True
3119 lnSelect = SELECT()
3120 lcCursor = GetUniqueFileName()
3121
3122 lcSqlString = " Select * from ZZXRANGD where Fkey =" + SQLFormatNum(pnPkey)
3123
3124 llRetVal = llRetVal AND V_SQLExec(lcSqlString,lcCursor)
3125
3126 IF llRetVal AND USED(lcCursor)
3127 SELECT(lcCursor)
3128 lcCmp_Style = Style
3129 lcCmp_Color = Color_code
3130 lcCmp_lbl = lbl_code
3131 lcCmp_Dim = dimension
3132
3133 Replace cmp_style WITH lcCmp_Style , ;
3134 cmp_color WITH lcCmp_Color , ;
3135 cmp_lbl WITH lcCmp_lbl , ;
3136 cmp_dim WITH lcCmp_Dim IN Vzzgapvcd
3137
3138 This.TableClose(lcCursor)
3139
3140 ENDIF
3141
3142 SELECT(lnSelect)
3143 RETURN llRetVal
3144 ENDFUNC
3145*============================================================
3146 FUNCTION Checkforrangestyle
3147 LPARAMETERS pnProd_Num,pnProd_Line ,pnPkey
3148 && pnPkey - Pass by Reference
3149
3150 LOCAL llRetVal , lnSelect ,lcSQLString,lcCursor
3151
3152 lnSelect = SELECT()
3153 lcCursor = GetUniqueFileName()
3154
3155 lcSQLString = " Select rh.Pkey from ZZCORDRD D " + ;
3156 " Join ZZXRANGH rh " + ;
3157 " ON rh.division = d.division " +;
3158 " AND rh.rng_style = d.style " + ;
3159 " AND rh.rng_color = d.color_code " + ;
3160 " AND rh.rng_lbl = d.lbl_code " + ;
3161 " AND rh.rng_pack = d.dimension " + ;
3162 " AND rh.rng_type = 'P' " + ;
3163 " WHERE d.prod_num = " + SQLFormatNum(pnProd_Num) + ;
3164 " AND d.prod_line = " + SQLFormatNum(pnProd_Line)
3165
3166 llRetVal = V_sqlExec(lcSQLString , lcCursor)
3167
3168 IF llRetVal AND USED(lcCursor) AND RECCOUNT(lcCursor) > 0
3169 SELECT(lcCursor)
3170 pnPkey = Pkey
3171 llRetVal = True
3172 ELSE
3173 llRetVal = False
3174 ENDIF
3175
3176 This.TableClose(lcCursor)
3177
3178 SELECT(lnSelect)
3179 RETURN llRetVal
3180 ENDFUNC
3181*============================================================
3182*=== TechRec 1039635 23-Apr-2009 vkrishnamurthy ===
3183*=== TR 1039635 19-APR-2009 VKK
3184*============================================================
3185
3186
3187ENDDEFINE