· 7 years ago · Feb 20, 2019, 10:08 PM
1**********************************************************************************
2* Program....: CLSEDI.PRG
3* Version....: 1.0
4* Author.....: Mike Xu
5* Date.......: December 8, 1997
6* Notice.....: Copyright (c) 1997 Garpac Corp, All Rights Reserved.
7* Compiler...: Visual FoxPro 05.00.00.0402 for Windows
8* Abstract...: Base EDI business class
9* Changes....:
10********************************************************************************
11* PL 01/10/02 30171 - Expand mfg id number to 8 digits.
12* When MFGID:6 digit UPC Max Seq:99999 UCC Max Seq:999999999
13* When MFGID:8 digit UPC Max Seq:999 UCC Max Seq:9999999
14*
15* PL 01/22/01- 4973 810(o) & 4975- JSSI Shared UPC - EDI 856(o) Process - Resolve share UPC
16*
17* PL 05/23/01 27632,27633,27634 810,856,870(o) implement UOM conversion from Stock/Base UOM to trading partner UOM
18* from 850(i) history detail (--capture during 850 process ib_uom, base_uom, uom_factor)
19********************************************************************************
20*
21* TAN 34208 10-Sep-02 JN DB2 CONVERTED forked code only
22*
23********************************************************************************
24#Include System.h
25#Include EDI.h
26#Define VFP_EMPTY_DATE_STRING "01/01/1900"
27#Define VFP_BLANK_DATE_STRING " "
28
29*--- TR 1015768 3-MAR-2006 VKK
30#Define VITRUAL_SHOWROOM_VEND_QUALIFIER "VS"
31*=== TR 1015768 3-MAR-2006 VKK
32
33*--- TR 1026592 12-SEP-2007 HNISAR
34#Define EDI_REMIT_REQ_MSG "Requires Remit number (Trading Partner's AP number). "
35*=== TR 1026592 12-SEP-2007 HNISAR
36
37*--- TR 1086117 23-Sep-2015 Partha ---
38#Define EDI_BOL_REQ_MSG "Require BOL code."
39#Define EDI_TRACKNO_REQ_MSG "Require Tracking Num."
40#Define EDI_BOL_OR_TRACKNO_REQ_MSG "Require either BOL or Tracking Number."
41#Define EDI_BOL_AND_TRACKNO_REQ_MSG "Require BOL And Tracking Number."
42*=== TR 1086117 23-Sep-2015 Partha ===
43
44Define Class BPOEDIBase As BaseBusiness
45 Name = "BPOEDIBase"
46
47 nInterface= 0
48 nTransaction= 0
49 nHistory=0
50
51 nTranHeader= 0
52 nTranDetail= 0
53 nTranComment= 0
54 nTranAddress= 0
55
56 nInterHeader= 0
57 nInterDetail= 0
58 nInterComment= 0
59 nInterAddress= 0
60
61 *--- TR 1010733 30-MAY-2005 VKK
62 cWHS_mfgid = ''
63 *=== TR 1010733 30-MAY-2005 VKK
64
65 *--- TR 1019199 NSD/RCO 6/12/07
66 lUPCNumOverMax = .F.
67 *=== TR 1019199 NSD/RCO 6/12/07
68
69 *--- TechRec 1027666 25-Oct-2007 T.Shenbagavalli ---
70 lResolveUPCSKU = .F.
71 *=== TechRec 1027666 25-Oct-2007 T.Shenbagavalli ===
72
73 * --- TR 1042937 11/04/09 CM
74 lDATExists = .F.
75 * === TR 1042937 11/04/09 CM
76
77 *--- TechRec 1049174 22-Dec-2010 jisingh ---
78 lUseSharedUPC = .F.
79 lRollingColor = .F.
80 *=== TechRec 1049174 22-Dec-2010 jisingh ===
81 *--- TR 1055763 11/04/11 JIJO -
82 cMfgID = ""
83
84 *- 1060114 FH
85 Dimension aBulkTables[1] && array to hold name of temp files
86 nCounter = 0 && counter for our array
87 *- 1060114 FH
88 *--- TechRec 1066835 06-Mar-2013 YKaganovsky ---
89 lRunWorkflow = .F.
90 EDI_servername = ''
91 EDI_dbname = ''
92 cWorkflowName = ''
93 cScriptDirectory = ''
94 nWorkflowSuccess = 0
95 nWorkflowProc = 0
96 cProcessID = ''
97 *=== TechRec 1066835 06-Mar-2013 YKaganovsky ===
98 *--- TR 1065007 4-Feb-2014 Goutam
99 cFromUOMWeight = ""
100 cFromUOMVolume = ""
101 cFromUOMDimens = ""
102 cWeightFieldForUOM = ""
103 cVolumeFieldForUOM = ""
104 cDimensFieldForUOM = ""
105 cDimens1FieldForUOM = ""
106 cDimens2FieldForUOM = ""
107 cWeight2FieldForUOM = ""
108 cTranDetail1Table = ""
109 cTranDetail2Table = ""
110 *=== TR 1065007 4-Feb-2014 Goutam
111 *--- TechRec 1075287 16-May-2014 asharma/smeenraja ---
112 cTieInstallErrorMessage = ""
113 cCanRunWorkflowErrorMessage = ""
114 *=== TechRec 1075287 16-May-2014 asharma/smeenraja ===
115
116 lAllowConsolDiv = .F. && TR 1086775/1081474 4-JUN-2015 Venuk.
117 *============================================================
118 *--- TR 1010733 30-MAY-2005 VKK
119 Function Init
120 Local llRetVal
121
122 llRetVal = true
123
124 With This
125 .cWHS_mfgid = Vl_Compr(, "mfgid")
126 Endwith
127
128 Return llRetVal
129
130 Endfunc
131
132 *=== TR 1010733 30-MAY-2005 VKK
133
134 ************************************************************************************
135 * ATS 1971 PL 08/07/98 - Make SOP, EDI850 and Factor maintenace call same validation
136 * When call any of the below Valid...():
137 * Return False = did not pass validation.
138 * Return True= pass validation
139 * All Valid routines assume that the key fields are required. So if any key field is empty,
140 * we return false without even looking in the server.
141 * tcErrorMsg is an output parameter passed by reference.
142 * Param 1: tcErrorMsg (required, Output Parameter)
143 * Param 2 - n: Key fields (required)
144 * Param n + 1: Cursor name (optional)
145 ************************************************************************************
146 * Validate EDI Control
147 ************************************************************************************
148 Function ValidEDIControl
149 Lparameter tcErrorMsg, tcDivision, tcTmpTable
150 Local llRetVal
151 llRetVal= !(Empty(tcDivision) Or !vl_ecntr(tcDivision, "", tcTmpTable))
152 tcErrorMsg = tcErrorMsg + Iif(llRetVal, "" , ;
153 "EDI Control Table is not set up for this division!")
154 Return llRetVal
155 Endfunc
156
157 ************************************************************************************
158 * Validate EDI850 Control
159 ************************************************************************************
160 Function ValidEDIiPOControl
161 *--- TR 1044017 19-JAN-2010 HNISAR Added tlFrom940
162 Lparameter tcErrorMsg, tcCustomer, tcDivision, tcTmpTable,tlFrom940
163 Local llRetVal
164
165 llRetVal= !(Empty(tcDivision) Or !vl_iPOcr(tcCustomer, "", tcTmpTable, tcDivision))
166 * PL 03/25/99- also check for active_ok="Y" otherwise, could be inactive
167 If Used(tcTmpTable) And llRetVal
168 llRetVal= Iif(&tcTmpTable..active_ok= "Y", .T., .F.)
169 *--- TR 1044017 19-JAN-2010 HNISAR
170 IF llRetVal AND VARTYPE(&tcTmpTable..is940rec) <> "U"
171 llRetVal= Iif((tlFrom940 AND &tcTmpTable..is940rec = "Y") OR (!tlFrom940 AND &tcTmpTable..is940rec <> "Y") , .T. , .F.)
172 ENDIF
173 *=== TR 1044017 19-JAN-2010 HNISAR
174 ENDIF
175
176 *--- TR 1044017 19-JAN-2010 HNISAR
177*!* tcErrorMsg = tcErrorMsg + Iif(llRetVal, "" , ;
178*!* "EDI 850 Control Table is not set up!")
179 Local lcProcess
180 lcProcess = "850"
181 IF tlFrom940
182 lcProcess = "940"
183 ENDIF
184 tcErrorMsg = tcErrorMsg + Iif(llRetVal, "" , ;
185 "EDI " + lcProcess + " Control Table is not set up!")
186 *=== TR 1044017 19-JAN-2010 HNISAR
187
188 Return llRetVal
189 Endfunc
190
191 ************************************************************************************
192 * Calculate UPC check digit
193 ************************************************************************************
194 Function UPCChkDigit
195 Lparameters pcUPCNum
196 Local lnCheckDigit, lcRetval, lnOdd, lnEven
197 * FINISH THIS!
198 Store 0 To lnOdd, lnEven
199 For N=1 To 11 Step 2
200 lnOdd = lnOdd + Val(Substr(pcUPCNum,N,1))
201 Endfor
202 For N=2 To 10 Step 2
203 lnEven = lnEven + Val(Substr(pcUPCNum,N,1))
204 Endfor
205 lnCheckDigit = 10 - Mod(((lnOdd*3) + lnEven),10)
206 If lnCheckDigit =10
207 lcRetval = "0"
208 Else
209 lcRetval = Alltrim(Str(lnCheckDigit))
210 Endif
211 Return lcRetval
212 Endfunc
213
214 ************************************************************************************
215 * Calculate UPC check digit
216 ************************************************************************************
217 Function UCCChkDigit
218 Lparameters pcUCCNum
219 Local lnCheckDigit, lcRetval, lnOdd, lnEven
220 *- JVF/YIK 1001285 9/29/03 Should have only ever looked at char 3 to 19.
221 pcUCCNum = Substr(Alltrim(pcUCCNum),3)
222 *=
223 Store 0 To lnOdd, lnEven
224 *- 1001547 10/14/03 YIK
225 *- Check digit is calcualted on 17 digits only.
226 *- For n=1 to 19 Step 2
227 For N=1 To 17 Step 2
228 lnOdd = lnOdd + Val(Substr(pcUCCNum,N,1))
229 Endfor
230 For N=2 To 17 Step 2
231 *= 1001547
232 lnEven = lnEven + Val(Substr(pcUCCNum,N,1))
233 Endfor
234 lnCheckDigit = 10 - Mod(((lnOdd*3) + lnEven),10)
235 If lnCheckDigit =10
236 lcRetval = "0"
237 Else
238 lcRetval = Alltrim(Str(lnCheckDigit))
239 Endif
240 Return lcRetval
241 Endfunc
242
243 ************************************************************************************
244 * Get Next UPC number
245 ************************************************************************************
246 Function GetNextUPCNum
247 Lparameter pcDivision, pnBatchOfNumbers,pclbl_Code
248 &&--- TechRec 1040220 10-Jun-2009 vkrishnamurthy === Added Parameter tclbl_Code
249
250 Local lcRetval, lcMfgId, lnUPCNum, llRetVal
251 llRetVal= .T.
252 lcRetval= ""
253 pnBatchOfNumbers= Iif(Empty(pnBatchOfNumbers), 1, pnBatchOfNumbers)
254 * Don't close "__Xcntrc" here, this get call a milion times in UPCGeneration
255 * Leave this open for optimize purpuse
256 *--- TechRec 1040220 10-Jun-2009 vkrishnamurthy ---
257*!* lcMfgId = This.GetMfgId(pcDivision, "__Xcntrc")
258
259 *--- TR 1055763 11/04/11 JIJO - Added IF condtion to use cMfgID instead of resolved one
260 IF NOT EMPTY(This.cMfgID)
261 lcMfgId = This.cMfgID
262 ELSE
263 lcMfgId = This.GetMfgId(pcDivision, "__Xcntrc",pclbl_Code,"__XCLBLR")
264 ENDIF
265 *=== TechRec 1040220 10-Jun-2009 vkrishnamurthy ===
266 *=== TR 1055763 11/04/11 JIJO ===
267
268 If !Empty(lcMfgId)
269 lnUPCNum = vl_mfgid(lcMfgId, "next_upc", "__xmfgid")
270 * PL 01/10/02 30171 - Expand mfg id number to 8 digits.
271 lcRetval= Iif(!Empty(lnUPCNum), This.FormatNextUPC( lcMfgId, lnUPCNum , ;
272 pnBatchOfNumbers), "")
273 *!* If !Empty(lnUPCNum)
274 *!* If lnUPCNum > 99999
275 *!* lnUPCNum = 0 && should remind users to change to a new mfgid
276 *!* Endif
277 *!* lnUPCNum = lnUPCNum + pnBatchOfNumbers && get block of upc_num
278 *!* llRetVal= v_SQLexec("Update zzemfgid Set next_upc = " + Str(lnUPCNum) + ;
279 *!* " Where mfgid = '" + lcMfgId + "'", "__xmfgid")
280 *!* If llRetVal
281 *!* lcRetval = lcRetval + PADL(lnUPCNum, 5, "0")
282 *!* Endif
283 *!* Endif
284 Endif
285 Return lcRetval
286 Endfunc
287
288
289 *--- TR 1073064 22-AUG-13 Venuk
290 Function GetNextEANNum
291 Lparameter pcDivision, pnBatchOfNumbers,pclbl_Code
292
293 Local lcRetval, lcMfgId, lnEANNum, llRetVal
294 llRetVal= .T.
295 lcRetval= ""
296 pnBatchOfNumbers= Iif(Empty(pnBatchOfNumbers), 1, pnBatchOfNumbers)
297 IF NOT EMPTY(This.cMfgID)
298 lcMfgId = This.cMfgID
299 ELSE
300 lcMfgId = This.GetMfgId(pcDivision, "__Xcntrc",pclbl_Code,"__XCLBLR")
301 ENDIF
302
303 If !Empty(lcMfgId)
304 lnEANNum= vl_mfgid(lcMfgId, "next_ean", "__xmfgid")
305 lcRetval= Iif(!Empty(lnEANNum), This.FormatNextEAN( lcMfgId, lnEANNum, ;
306 pnBatchOfNumbers), "")
307 Endif
308 Return lcRetval
309 ENDFUNC
310
311
312 Function GetNextEANNumbyMfgID
313 Lparameter pcMfgID, pnBatchOfNumbers
314 Local lcRetval, lnEANNum, llRetVal
315 llRetVal= .T.
316 lcRetval= ""
317 pnBatchOfNumbers= Iif(Empty(pnBatchOfNumbers), 1, pnBatchOfNumbers)
318 If !Empty(pcMfgID)
319 lnEANNum= vl_mfgid(pcMfgID, "next_ean", "__xmfgid")
320 lcRetval= Iif(!Empty(lnEANNum), This.FormatNextEAN( pcMfgID, lnEANNum, ;
321 pnBatchOfNumbers), "")
322 Endif
323 Return lcRetval
324 ENDFUNC
325
326
327 Function FormatNextEAN
328 Parameter tcMfgID, tnEANNum, tnBatchOfNumbers
329 Local lcEANNum, llRetVal, lcLenMfgID, lnMaxEANNum, lnLenEANNum
330 lcEANNum=""
331 llRetVal= .T.
332 tcMfgID= Allt(tcMfgID)
333 lcLenMfgID= Len(tcMfgID)
334
335 lnMaxEANNum = INT(VAL(PADL("", 12 - lcLenMfgID, "9")))
336 lnLenEANNum = 12 - lcLenMfgID
337
338 If tnEANNum + tnBatchOfNumbers > lnMaxEANNum
339 tnEANNum = 0 && Reset back to 0 when hit limit 999 or 99999
340
341 * Mark this property so that any child classes that call this will have this property available to them
342 * They can do what they wish with it.
343 This.lUPCNumOverMax = .T.
344
345 Endif
346 tnEANNum = tnEANNum + tnBatchOfNumbers
347 llRetVal= v_SQLexec("Update zzemfgid Set next_ean = " + Str(tnEANNum) + ;
348 " Where mfgid = '" + tcMfgID + "'", "tcmfgid")
349 If llRetVal
350 lcEANNum = tcMfgID + Padl(tnEANNum, lnLenEANNum, "0")
351 Endif
352 Return lcEANNum
353 ENDFUNC
354
355 Function EANChkDigit
356 Lparameters pcEANNum
357
358 Local lnCheckDigit, lcRetval, lnOdd, lnEven, lnTot
359
360 Store 0 To lnOdd, lnEven
361 For N=1 To 12 Step 2
362 lnOdd = lnOdd + Val(Substr(pcEANNum,N,1))
363 Endfor
364 For N=2 To 12 Step 2
365 lnEven = lnEven + Val(Substr(pcEANNum,N,1))
366 ENDFOR
367
368 lnTot = (lnEven *3) + lnOdd
369
370 IF MOD(lnTot ,10) != 0
371 lnCheckDigit = (INT(lnTot /10) + 1) * 10 - lnTot
372 ELSE
373 lnCheckDigit = 0
374 ENDIF
375
376 lcRetval = Alltrim(Str(lnCheckDigit))
377
378 Return lcRetval
379 ENDFUNC
380
381
382 *=== TR 1073064 22-AUG-13 Venuk
383 ************************************************************************************
384 * Get Next UPC number using MfgID
385 ************************************************************************************
386 Function GetNextUPCNumbyMfgID
387 Lparameter pcMfgID, pnBatchOfNumbers
388 Local lcRetval, lnUPCNum, llRetVal
389 llRetVal= .T.
390 lcRetval= ""
391 pnBatchOfNumbers= Iif(Empty(pnBatchOfNumbers), 1, pnBatchOfNumbers)
392 If !Empty(pcMfgID)
393 lnUPCNum = vl_mfgid(pcMfgID, "next_upc", "__xmfgid")
394 * PL 01/10/02 30171 - Expand mfg id number to 8 digits.
395 lcRetval= Iif(!Empty(lnUPCNum), This.FormatNextUPC( pcMfgID, lnUPCNum, ;
396 pnBatchOfNumbers), "")
397 *!* If !Empty(lnUPCNum)
398 *!* If lnUPCNum > 99999
399 *!* lnUPCNum = 0 && should remind users to change to a new mfgid
400 *!* Endif
401 *!* lnUPCNum = lnUPCNum + pnBatchOfNumbers && get block of upc_num
402 *!* llRetVal= v_SQLexec("Update zzemfgid Set next_upc = " + Str(lnUPCNum) + ;
403 *!* " Where mfgid = '" + pcMfgID + "'", "__xmfgid")
404 *!* If llRetVal
405 *!* lcRetval = pcMfgID + PADL(lnUPCNum, 5, "0")
406 *!* Endif
407 *!* Endif
408 Endif
409 Return lcRetval
410 Endfunc
411
412 ************************************************************************************
413 * Full block UPC seq format MFGID:"123456" SEQ:"99999" CHKDGT:"1"
414 * For partial block MFGID:"12345678" SEQ:"999" CHKDGT:1
415 * when user start using MFGID more than 6 position the UPC Seq range
416 * will get smaller.
417 * Notes: Manufacture ID Ref. already handle either 6 or 8 digits validation
418 ************************************************************************************
419 * PL 01/10/02 30171 - Expand mfg id number to 8 digits.
420 Function FormatNextUPC
421 Parameter tcMfgID, tnUPCNum, tnBatchOfNumbers
422 Local lcUPCNum, llRetVal, lcLenMfgID, lnMaxUPCNum, lnLenUPCNum
423 lcUPCNum=""
424 llRetVal= .T.
425 tcMfgID= Allt(tcMfgID)
426 lcLenMfgID= Len(tcMfgID)
427
428 *--- TechRec 1050514 01-Dec-2010 jisingh ---
429 *lnMaxUPCNum= Iif(lcLenMfgID=6, 99999, 999)
430 *lnLenUPCNum= Iif(lcLenMfgID=6, 5, 3)
431
432 lnMaxUPCNum = INT(VAL(PADL("", 11 - lcLenMfgID, "9")))
433 lnLenUPCNum = 11 - lcLenMfgID
434 *=== TechRec 1050514 01-Dec-2010 jisingh ===
435
436 If tnUPCNum + tnBatchOfNumbers > lnMaxUPCNum
437 tnUPCNum = 0 && Reset back to 0 when hit limit 999 or 99999
438
439 *--- TR 1019199 NSD/RCO 6/12/07
440 * Mark this property so that any child classes that call this will have this property available to them
441 * They can do what they wish with it.
442 This.lUPCNumOverMax = .T.
443 *=== TR 1019199 NSD/RCO 6/12/07
444
445 Endif
446 tnUPCNum = tnUPCNum + tnBatchOfNumbers
447 llRetVal= v_SQLexec("Update zzemfgid Set next_upc = " + Str(tnUPCNum) + ;
448 " Where mfgid = '" + tcMfgID + "'", "tcmfgid") && DB2 CHECKED JN
449 If llRetVal
450 lcUPCNum = tcMfgID + Padl(tnUPCNum, lnLenUPCNum, "0")
451 Endif
452 Return lcUPCNum
453 Endfunc
454
455 ************************************************************************************
456 * Get Next UCC128 number
457 * TAN 29529 Goods on Hangers - Added prefix parameter
458 ************************************************************************************
459 Function GetNextUCCNum
460 *--- TR 1074493 03-Dec-2013 Partha - added pcCustomer
461 Lparameter pcDivision, pcPrefix, plInnerPack, pcCustomer
462 Local lcRetval, lnUCC128, lcMfgId, llRetVal, lnMaxUCCNum, lnLenUCCNum, ;
463 lnLenMfgId, pcNextNumFieldName
464
465 *--- TR 1013361 04/Oct/2005 SK
466 Local lnField , lcSqlString, lcCursor,lnErrNum
467 llRetVal = .T.
468 *=== TR 1013361 04/Oct/2005 SK
469
470 *--- TR 1074493 03-Dec-2013 Partha ---
471 pcCustomer = IIF(EMPTY(pcCustomer), "", ALLTRIM(pcCustomer))
472 lcMfgId = vl_ycntrc(pcDivision, "ctnMfgId", , pcCustomer)
473 lcMfgId = IIF(EMPTY(lcMfgId), "", ALLTRIM(lcMfgId ))
474 *=== TR 1074493 03-Dec-2013 Partha ===
475
476 If Empty(pcPrefix)
477 pcPrefix = CARTON_DEFAULT_PREFIX
478 Endif
479
480 lcRetval= ""
481
482 *--- TR 1074493 03-Dec-2013 Partha ---
483 IF EMPTY(lcMfgId) && if not already resolved from zzycntrc
484 *=== TR 1074493 03-Dec-2013 Partha ===
485
486 lcMfgId = This.GetMfgId(pcDivision, "__Xcntrc")
487
488 *--- TR 1074493 03-Dec-2013 Partha ---
489 ENDIF
490 *=== TR 1074493 03-Dec-2013 Partha ===
491
492 lcMfgId = Allt(lcMfgId) && 30171
493 lnLenMfgId = Len(lcMfgId) && 30171
494
495 *---TAN 35003 HH 01/08/2003
496 If plInnerPack
497 pcNextNumFieldName = "next_pack"
498 Else
499 pcNextNumFieldName = "next_ucc"
500 Endif
501
502 If !Empty(lcMfgId)
503 * PL 01/10/02 30171 - Expand mfg id number to 8 digits.
504
505 *--- TechRec 1050514 01-Dec-2010 jisingh ---
506 *lnMaxUCCNum= Iif(lnLenMfgId= 6, 999999999, 9999999)
507 *lnLenUCCNum= Iif(lnLenMfgId= 6, 9, 7)
508
509 lnMaxUCCNum = INT(VAL(PADL("", 15 - lnLenMfgId, "9")))
510 lnLenUCCNum = 15 - lnLenMfgId
511 *=== TechRec 1050514 01-Dec-2010 jisingh ===
512
513 *--- TR 1013361 04/Oct/2005 SK
514 *!* lnUCC128 = vl_mfgid(lcMfgId,pcNextNumFieldName)
515 *!* If !Empty(lnUCC128)
516 *!* If lnUCC128 > lnMaxUCCNum && PL 01/10/02 30171- Expand mfgid to 8 digit
517 *!* lnUCC128 = 0
518 *!* Endif
519 *!* lnUCC128 = lnUCC128 + 1
520 *!* llRetVal = v_SQLexec("Update zzemfgid Set " + pcNextNumFieldName + " = " + Str(lnUCC128) + " Where mfgid = '" + lcMfgId + "'")
521 *!* && DB2 CHECKED JN
522 *!* If llRetVal
523 *!* lcRetval = pcPrefix + ALLT(lcMfgId) + PADL(lnUCC128, lnLenUCCNum, "0") && PL 01/10/02 30171- Expand mfgid to 8 digit
524 *!* lcRetval = lcRetval + This.UCCChkDigit(lcRetval)
525 *!* Endif
526 *!* ENDIF
527 *--- TR 1084541 02/04/15 ATHIRUNAVU Executed the stored procedure always
528 *If goEnv.SV('PROCESS_CONCURRENT_EDIPACKPROCESS', 'N') = 'Y'
529 lnField = Iif(plInnerPack,1,0)
530
531 lcSqlString = "bcsp_getmfgid " + SQLFormatChar(lcMfgId)+ "," + ;
532 SQLFormatNum(lnField) + " ,"+ ;
533 SQLFormatNum(lnMaxUCCNum)
534
535 lcCursor = GetUniqueFileName()
536 llRetVal= llRetVal And v_SQLexec(lcSqlString ,lcCursor)
537 llRetVal = llRetVal And Used(lcCursor)
538
539 If llRetVal
540 lnUCC128 = SysGetFieldValue(lcCursor,'UCC128')
541 lnErrNum = SysGetFieldValue(lcCursor,'ErrNum')
542 llRetVal = (lnErrNum = 0)
543 This.TableClose(lcCursor)
544 Endif
545*!* Else
546*!* lnUCC128 = vl_mfgid(lcMfgId,pcNextNumFieldName)
547
548*!* If lnUCC128 > lnMaxUCCNum && PL 01/10/02 30171- Expand mfgid to 8 digit
549*!* lnUCC128 = 0
550*!* Endif
551
552*!* lnUCC128 = lnUCC128 + 1
553*!* llRetVal = v_SQLexec("Update zzemfgid Set " + pcNextNumFieldName + " = " + Str(lnUCC128) + " Where mfgid = '" + lcMfgId + "'")
554*!* Endif
555 *=== TR 1084541 02/04/15 ATHIRUNAVU
556
557 If llRetVal And !Empty(lnUCC128)
558 lcRetval = pcPrefix + Allt(lcMfgId) + Padl(lnUCC128, lnLenUCCNum, "0") && PL 01/10/02 30171- Expand mfgid to 8 digit
559 lcRetval = lcRetval + This.UCCChkDigit(lcRetval)
560 Endif
561 *=== TR 1013361 04/Oct/2005 SK
562 Endif
563 Return lcRetval
564 Endfunc
565
566 * PL 10/05/98 ATS 2124- EDI- UPC defaults/ AutoGeneration move to Base control
567 ************************************************************************************
568 * Get Manufacture ID
569 ************************************************************************************
570 Function GetMfgId
571 Lparameter pcDivision, pcCursor,pclbl_Code,pclblcursor
572 &&--- TechRec 1040220 10-Jun-2009 vkrishnamurthy === Added Param pclbl_Code,pclblcursor
573 Local lcRetval
574 pcCursor= Iif(Empty(pcCursor), "__Xcntrc", pcCursor)
575
576 *--- TechRec 1040220 10-Jun-2009 vkrishnamurthy ---
577 pclblcursor= Iif(Empty(pclblcursor), "__XCLBLR", pclblcursor)
578 *=== TechRec 1040220 10-Jun-2009 vkrishnamurthy ===
579
580 *--- TechRec 1040220 10-Jun-2009 vkrishnamurthy ---
581 If !(Used(pclblcursor) And &pclblcursor..lbl_Code== pclbl_Code )
582 lcRetval = vl_clblr(pclbl_Code,"mfgid", pclblCursor)
583 Else
584 lcRetval = &pclblCursor..mfgid
585 Endif
586 *=== TechRec 1040220 10-Jun-2009 vkrishnamurthy ===
587
588 *--- TechRec 1040220 10-Jun-2009 vkrishnamurthy ---
589 IF EMPTY(lcRetval)
590 *=== TechRec 1040220 10-Jun-2009 vkrishnamurthy ===
591
592 * Only lookup if division diff. than previous pcCursor.division or never open up
593 * the temp cursor before
594 If !(Used(pcCursor) And &pcCursor..division== pcDivision )
595
596 *--- TR 1010733 30-MAY-2005 VKK
597 *lcRetval = vl_xcntr(pcDivision,"mfgid", pcCursor)
598
599 If Not Empty(pcDivision)
600 lcRetval = vl_xcntr(pcDivision,"mfgid", pcCursor)
601 Else
602 lcRetval = This.cWHS_mfgid
603 Endif
604 *=== TR 1010733 30-MAY-2005 VKK
605 Else
606 lcRetval = &pcCursor..mfgid
607 ENDIF
608 *--- TechRec 1040220 10-Jun-2009 vkrishnamurthy ---
609 ENDIF
610 *=== TechRec 1040220 10-Jun-2009 vkrishnamurthy ===
611
612 Return lcRetval
613 Endfunc
614
615 ************************************************************************************
616 * Get Size desction using division, size code and size bucket number
617 ************************************************************************************
618 Procedure GetSizeDesc
619 Lparameter pcDivision, pcSize_code, pcSizebucket
620 Local lnloop, lcSuffix, lcSizedesc, llRetVal
621 lcSizedesc= ""
622 If !(Used("tmpSizer") And (pcDivision= tmpSizer.division And ;
623 pcSize_code= tmpSizer.size_code))
624 llRetVal= vl_sizer(pcDivision,, "tmpSizer", pcSize_code)
625 Else
626 llRetVal= .T.
627 Endif
628 If llRetVal
629 lcSizedesc = Eval("tmpSizer.size" + Trans(pcSizebucket, "@L 99"))
630 Endif
631 Return lcSizedesc
632 Endproc
633
634 ************************************************************************************
635 * Get Catalog network description
636 ************************************************************************************
637 Procedure GetEDINetworkDesc
638 * Get EDI network description
639 Lparameters p_cSource, p_cOutput
640 Local l_nOldSele, l_nPkey
641 l_nOldSele = Select()
642
643 Select (p_cSource)
644 This.PushRecordset()
645 Scan
646 m.Pkey= Pkey
647 m.catg_dest= catg_dest
648 m.Dest_desc = vl_catdr(m.catg_dest, "Dest_desc")
649 Insert Into (p_cOutput) From Memvar
650 Endscan
651 This.PopRecordset()
652
653 Select (p_cOutput)
654 Index On Pkey Tag Pkey
655 Select (p_cSource)
656 Set Relation To Pkey Into (p_cOutput)
657 * Cleanup
658 Select (l_nOldSele)
659 Return
660 Endproc
661
662 * PL 01/26/99 -move From clsiPOpr reuse in 850 and 810
663 ***************************************************************************************
664 * create record in target alias from source alias and assign proper Pkey using
665 * tcTab (in bcsysnum). Optional Source header and array of duplicate fields
666 * Parameters:
667 * 1. Source table
668 * 2. Target table
669 * 3. Tag (in bcsysnum)
670 * 4. Header Alias (Optional)
671 * 5. array of dup fields (Optional)
672 * Notes: paramter 4 & 5 use for default value from header to detail but not overwrite
673 * Have to build and past by reference.
674 * 6. pass down pkey to use (optional-- use in batch get of pkeys and past it down)
675 * 7. pass down fkey to use (optional-- use in batch assign )
676 ***************************************************************************************
677 Procedure CreateRecordWithPkey
678 Lparameters tcSourceAlias, tcTargetAlias, tcTag, tcSourceHeaderAlias, taDuplicateFields,;
679 tnPkey, tnFkey
680 External Array taDuplicateFields
681 Local loRecordSet, llRetVal, lnOldSelect
682 llRetVal = .T.
683 lnOldSelect = Select()
684
685 tcSourceAlias = Iif(Empty(tcSourceAlias), Alias(), tcSourceAlias)
686 tcTargetAlias = Iif(Empty(tcTargetAlias), tcSourceAlias, tcTargetAlias)
687
688 Select (tcSourceAlias)
689 If Not Eof(tcSourceAlias)
690 Scatter Name loRecordSet Memo
691 If !Empty(tcTag)
692 loRecordSet.Pkey = v_NextPkey(tcTag)
693 * cannot get PKEY from server
694 If Empty(loRecordSet.Pkey)
695 llRetVal= .F.
696 Endif
697 Else
698 * use the pkey that past down
699 If !Empty(tnPkey)
700 loRecordSet.Pkey = tnPkey
701 Endif
702 * use the fkey that past down
703 If !Empty(tnFkey)
704 loRecordSet.Fkey = tnFkey
705 Endif
706
707 Endif
708
709 If llRetVal
710 Select (tcTargetAlias)
711
712 * make sure target fields all defaults with something not null
713 Scatter Memvar Memo Blank
714 Append Blank
715 Gather Memvar Memo
716
717 Gather Name loRecordSet Memo
718
719 * default fields from header to detail but not overwrite if data is
720 * present in detail field (using Array of duplicate fields)
721 If !Empty(tcSourceHeaderAlias) And !Empty(taDuplicateFields)
722 This.DefaultHeaderDataToDetail(tcSourceHeaderAlias, tcTargetAlias, @taDuplicateFields )
723 Endif
724
725 llRetVal= This.TimeStampDocument()
726 Endif
727 Endif
728
729 Select (lnOldSelect)
730 Return llRetVal
731 Endproc
732
733 * PL 01/26/99 -move From clsiPOpr reuse in 850 and 810
734 ***************************************************************************************
735 * Default duplicate fields (same field name in both header and detail like start_date)
736 * to all details when it still empty, not overwrite existing detail data
737 * Parameters:
738 * 1. Header table
739 * 2. Detail table
740 * 3. Array of fields name
741 ***************************************************************************************
742 Procedure DefaultHeaderDataToDetail
743 Lparameters tcHeaderAlias, tcDetailAlias, taDuplicateFields
744 External Array taDuplicateFields
745 Local llRetVal, lnCnt, lcReplaceStr
746 llRetVal = .T.
747 For lnCnt = 1 To Alen(taDuplicateFields)
748 If !Empty(taDuplicateFields[lnCnt])
749 lvHeaderData= Eval(tcHeaderAlias+"." + taDuplicateFields[lnCnt])
750 lvDetailData= Eval(tcDetailAlias+"." + taDuplicateFields[lnCnt])
751 *?phu--Requery date from server 01/10/1900- is not empty
752 If IsEmpty(lvDetailData) And !Empty(lvHeaderData)
753 lcReplaceStr= "REPLACE " + taDuplicateFields[lnCnt] + " WITH &tcHeaderAlias.." +;
754 + taDuplicateFields[lnCnt] + " In (tcDetailAlias)"
755 &lcReplaceStr
756 Endif
757 Endif
758 Endfor
759 Return llRetVal
760 Endproc
761
762 * PL 01/26/99 -move From clsiPOpr reuse in 850 and 810
763 ************************************************************************************
764 * Check All detail errors and write Header's error message
765 ************************************************************************************
766 Procedure MarkHeaderForDetailWithError
767 Lparameters pcEiPOth, pcEiPOtd
768 Local llRetVal, lnOldSelect
769 llRetVal = .T.
770 lnOldSelect = Select()
771
772 *--- TechRec 1072432 18-Sep-2013 jisingh Added And Not Deleted() ===
773 Select Distinct Fkey From (pcEiPOtd) Where !Empty(Errs_Msg_D) And Not Deleted() Into Cursor tcBadOrders
774 Select tcBadOrders
775 If This.lUserInterface
776 * Init Thermometer
777 This.InitThermo(Recc('tcBadOrders'))
778 l_nThermoCnt = 0
779 Endif
780 Scan
781 If This.lUserInterface
782 * Advance progress bar, if we're using one.
783 l_nThermoCnt = l_nThermoCnt + 1
784 This.AdvanceThermo(l_nThermoCnt)
785 Endif
786 Select (pcEiPOth)
787 Locate For Pkey = tcBadOrders.Fkey And Empty(Errs_Msg_H)
788 If Found()
789 Replace Errs_Msg_H With "Has errors in Details." + CRLF, Errs_flg_H With "Y";
790 In (pcEiPOth)
791 Endif
792 Endscan
793 Use In tcBadOrders
794
795 If This.lUserInterface
796 * Reset Thermometer
797 This.ResetThermo()
798 Endif
799 Select(lnOldSelect)
800 Return llRetVal
801 Endproc
802
803 ************************************************************************************
804 * Get Customer SKU using our Style,color,lbl,dm/pk,sizebucket
805 ************************************************************************************
806 Procedure GetSKU
807 Lparameter tcErrorMsg, tcCustomer, tcDivision, tcStyle, tcColor_code, tcLbl_code, ;
808 tcDimension, tnSizeBucket, tcTmpTable
809 Local lcSKU
810 lcSKU=""
811 lcSKU= vl_cstdr(tcCustomer,"cust_style",tcTmpTable,tcDivision,tcStyle,tcColor_code, ;
812 tcLbl_code,tcDimension,tnSizeBucket)
813 tcErrorMsg = tcErrorMsg + Iif(Empty(lcSKU), "Missing SKU code." ,"")
814 Return lcSKU
815 Endproc
816
817 ************************************************************************************
818 * Get Customer UPC using our Style,color,lbl,dm/pk,sizebucket
819 ************************************************************************************
820 Procedure GetUPC
821 Lparameter tcErrorMsg,tcDivision, tcStyle, tcColor_code, tcLbl_code, ;
822 tcDimension, tnSizeBucket, tcTmpTable
823 Local lcUPC
824 lcUPC=""
825 tcTmpTable= Iif(Empty(tcTmpTable), "__eUPCnr", tcTmpTable)
826 llRetVal= vl_upcsr(tcDivision,, tcTmpTable, tcStyle, tcColor_code, ;
827 tcLbl_code, tcDimension, tnSizeBucket)
828 If llRetVal
829 lcUPC= &tcTmpTable..upc_num + &tcTmpTable..chk_digit
830 Endif
831
832 tcErrorMsg = tcErrorMsg + Iif(Empty(lcUPC), "Missing UPC number." ,"")
833 Return lcUPC
834 Endproc
835
836 *--- TR 1003431 02/25/04 AM
837 ************************************************************************************
838 * Get Customer EAN using our Style,color,lbl,dm/pk,sizebucket
839 ************************************************************************************
840 Procedure GetEAN
841 Lparameter tcErrorMsg,tcDivision, tcStyle, tcColor_code, tcLbl_code, ;
842 tcDimension, tnSizeBucket, tcTmpTable
843 Local lcEAN
844 lcEAN=""
845 tcTmpTable= Iif(Empty(tcTmpTable), "__eEANnr", tcTmpTable)
846 llRetVal= vl_upcnum(tcDivision,, tcTmpTable, tcStyle, tcColor_code, ;
847 tcLbl_code, tcDimension, tnSizeBucket)
848 If llRetVal
849 lcEAN= &tcTmpTable..ean
850 Endif
851
852 tcErrorMsg = tcErrorMsg + Iif(Empty(lcEAN), "Missing EAN number." ,"")
853 Return lcEAN
854 Endproc
855 *=== TR 1003431 02/25/04 AM
856
857 ************************************************************************************
858 * Get 850 detail history
859 * remove tcCustomer
860 ************************************************************************************
861 Procedure GetiPOHistoryDetail
862 Parameter tnOrd_num, tcUPC, tcSKU, tcTmpTable
863 Local llRetVal, lcUPCString, lcSKUString,lcSqlString
864 lcUPCString= Iif(Empty(tcUPC),"", " And upc= ?tcUPC")
865 lcSKUString= Iif(Empty(tcSKU),"", " And sku= ?tcSKU")
866 lcSqlString= "Select * From zzeipohd Where ord_num= ?tnOrd_num " +;
867 lcUPCString + lcSKUString
868 llRetVal= v_SQLPrep(lcSqlString, tcTmpTable, "") && DB2 CHECKED JN
869 Return llRetVal
870 Endproc
871
872 ************************************************************************************
873 * Get 850 header history
874 ************************************************************************************
875 Procedure GetiPOHistoryHeader
876 Parameter tcCustomer, tnOrd_num, tcTmpTable
877 Local llRetVal, lcSqlString
878 lcSqlString= "Select * From zzeipohh Where Customer= ?tcCustomer And " + ;
879 "ord_num= ?tnOrd_num "
880 llRetVal= v_SQLPrep(lcSqlString, tcTmpTable, "")
881 Return llRetVal
882 Endproc
883
884 ************************************************************************************
885 * update work cursor to view (view used to be the same before it move to r/w cursor)
886 ***********************************************************************************
887 Procedure UpdateWorkTable
888 Lparameter tcSourceTable, tcTargetTable
889 Local llRetVal, lnOldSelect
890 llRetVal= .T.
891 lnOldSelect= Select()
892 Select (tcSourceTable)
893 Scan
894 Scatter Memvar Memo
895 Select (tcTargetTable)
896 Locate For Pkey= m.Pkey
897 If Found()
898 Gather Memvar Memo
899 Else
900 Append Blank In (tcTargetTable)
901 Gather Memvar Memo
902 Endif
903 Endscan
904
905 Select(lnOldSelect)
906 Return llRetVal
907 Endproc
908
909
910 Procedure UpdateWorkTableWithSeek
911 Lparameter tcSourceTable, tcTargetTable
912 Local llRetVal, lnOldSelect
913 llRetVal= .T.
914 lnOldSelect= Select()
915 Select (tcSourceTable)
916 Scan
917 Scatter Memvar Memo
918 Select (tcTargetTable)
919 If Seek(m.Pkey, tcTargetTable, "PKEY")
920 Gather Memvar Memo
921 Else
922 Append Blank In (tcTargetTable)
923 Gather Memvar Memo
924 Endif
925 Endscan
926 Select(lnOldSelect)
927 Return llRetVal
928 Endproc
929
930
931 ************************************************************************************
932 * Sync Fkeys of any detail,address,comment relationship with header Pkey
933 * using passing condition (could be doc_num, carton_num...)
934 * Notes: For this function to work optimum, should have fkey indes on tcDetailAlias
935 ***********************************************************************************
936 Procedure SyncHeaderDetailPFkey
937 Lparameter tcHeaderAlias, tcDetailAlias, tcCompareField
938 Local llRetVal, lnOldSelect, lcReplaceString, lnCurrentHeaderCkey, lnCurrentHeaderPkey
939 llRetVal= .T.
940 lcCompareField= tcHeaderAlias+ "." + tcCompareField
941 lcReplaceString= "Replace all fkey with lnCurrentHeaderPkey In (tcDetailAlias) "+;
942 " For " + tcCompareField + "= lnCurrentHeaderCkey"
943 lnOldSelect= Select()
944 Select (tcDetailAlias) && Save detail record pointer
945 This.PushRecordset()
946 Select (tcHeaderAlias) && save header record pointer
947 This.PushRecordset()
948 Scan
949 * resync all fkey using header Pkey
950 lnCurrentHeaderPkey= &tcHeaderAlias..Pkey
951 lnCurrentHeaderCkey= Eval(tcHeaderAlias + "." + tcCompareField)
952 &lcReplaceString
953 Endscan
954 This.PopRecordset() && restore header record pointer
955 Select (tcDetailAlias)
956 This.PopRecordset() && restore detail record pointer
957 Select(lnOldSelect)
958 Return llRetVal
959 Endproc
960
961
962 *>>>>> Start Load/Unload From/To Flatfile <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
963
964 * MetaData(zzeMdata):
965 * 1. process c(8) - 810, 850, 856, 832 ...
966 * 2. Template c(8) - "HEADER","DETAIL","COMMENT","ADDRESS"
967 * 3. Field Seq i(4) -
968 * 4. Field Name c(128) -
969 * 5. Field Len n(3) -
970
971 ************************************************************************************
972 * Open metadata for the process (810,850,856...)
973 ***********************************************************************************
974 Procedure GetTranslationDefinition
975 Parameter tcProcess, tcMetaDataAlias
976 Local llRetVal, lcSqlString
977 tcMetaDataAlias= Iif(Empty(tcMetaDataAlias), "tcEmData", tcMetaDataAlias)
978 lcSqlString = "SELECT * FROM zzemdata WHERE Process = ?tcProcess " + ;
979 "ORDER BY Template, Field_Seq"
980 llRetVal = v_SQLexec(lcSqlString, tcMetaDataAlias, "")
981 Return llRetVal
982 Endproc
983
984 ************************************************************************************
985 * Create all metadata work tables
986 * in tcMetaDataAlias Only contain one process
987 ***********************************************************************************
988 Procedure CreateMetaDataWorkTable
989 Lparameter tcMetaDataAlias, tcTemplate, tcTemplateWorkTable
990 Local llRetVal, lcSqlString , lnOldSelect, lnCnt
991 tcMetaDataAlias= Iif(Empty(tcMetaDataAlias), "tcEmData", tcMetaDataAlias)
992 llRetVal= .T.
993 lnOldSelect= Select()
994
995 Select (tcMetaDataAlias)
996 * Save MetaData record pointer
997 This.PushRecordset()
998 * Number of fields to create template (ie. "HEADER") work table
999 * (ie. number of fields to create header work table)
1000 lnRecNo = Recno()
1001 Count To lnFieldCnt For Template = tcTemplate
1002 Dimension laStructure[lnFieldCnt, 4]
1003 Go lnRecNo
1004 * Prep schema array for creat cursor statement
1005 Copy To Array laStructure ;
1006 Fields Field_Name, Field_Name, Field_Len, Field_Len ;
1007 For Template = tcTemplate
1008 * Alway Character datatype
1009 For lnCnt = 1 To lnFieldCnt
1010 laStructure[lnCnt, 2] = 'C'
1011 laStructure[lnCnt, 4] = 0
1012 Endfor
1013
1014 *--- TR 1063271 08/14/12 ATHIRUNAVU Increasing the length to 6 for tran_code
1015 If tcTemplate = 'VENDOR' and (goEnv.sv("TIE_SETUP","N") = 'Y') AND (goEnv.sv("BC_EDI_VERSION","") = "5.2")
1016 laStructure[2, 3] = 6
1017 ENDIF
1018 *=== TR 1063271 08/14/12 ATHIRUNAVU
1019
1020 * Restore MetaData record pointer
1021 This.PopRecordset()
1022
1023 *--- TechRec 1090110 16-Oct-2015 TSV---
1024 IF (goEnv.sv("TIE_SETUP","N") = 'Y') AND (INLIST(goEnv.sv("BC_EDI_VERSION",""), ".4","5.2")) AND ;
1025 ((ALLTRIM(EVAL(tcMetaDataAlias + ".process")) = "OSH" AND INLIST(tcTemplate, "SHIPMENT", "GRHDR", "ORDER"))OR ;
1026 (ALLTRIM(EVAL(tcMetaDataAlias + ".process")) = "OIN" AND INLIST(tcTemplate, "HEADER")))
1027
1028 lnIdx = ASCAN(laStructure, "CUST_SHIPPER")
1029
1030 IF lnIdx > 0
1031 lnIdx = CEILING(lnIdx/4)
1032 laStructure[lnIdx, 3] = 50
1033 ENDIF
1034
1035 ENDIF
1036 *=== TechRec 1090110 16-Oct-2015 TSV===
1037
1038 *--- TechRec 1092421 29-Mar-2016 TSV---
1039 lnIdx = ASCAN(laStructure, "MBILL_NUM")
1040
1041 lnMBillNum_len_856 = INT(VAL(goEnv.sv("MBILL_NUM_LENGTH_856","")))
1042 lnMBillNum_len_856 = IIF(lnMBillNum_len_856 = 0, 30, lnMBillNum_len_856 )
1043
1044 IF lnIdx > 0 AND (ALLT(EVAL(tcMetaDataAlias + ".process")) = "OSH") AND goEnv.sv("TIE_SETUP","N") = "Y"
1045
1046 lnIdx = CEILING(lnIdx/4) && next integer after dividing by 4 will give proper index as its four dimensional array
1047 laStructure[lnIdx, 3] = lnMBillNum_len_856
1048 ENDIF
1049 *=== TechRec 1092421 29-Mar-2016 TSV===
1050
1051 *--- TechRec 1076316 14-Apr-2014 jisingh ---
1052 lnIdx = ASCAN(laStructure, "PRO_NUM")
1053
1054 *--- TR 1082361 KISHORE 18-FEB-2015
1055 *IF lnIdx > 0 AND ALLT(EVAL(tcMetaDataAlias + ".process")) = "OSH" AND goEnv.sv("TIE_SETUP","N") = "Y" AND goEnv.sv("BC_EDI_VERSION","") = "5.2"
1056 lnPro_Num_len_856 = INT(VAL(goEnv.sv("PRO_NUM_LENGTH_856","")))
1057 lnPro_Num_len_856 = IIF(lnPro_Num_len_856=0,20,lnPro_Num_len_856)
1058
1059 *--- TR 1087148 11-6-2015 VKK as per smp/yuri notes no need to check for edi version, chk only for tiesetup
1060*!* IF lnIdx > 0 AND (ALLT(EVAL(tcMetaDataAlias + ".process")) = "OSH" OR ALLT(EVAL(tcMetaDataAlias + ".process")) = "GX_OSH") ;
1061*!* AND goEnv.sv("TIE_SETUP","N") = "Y" AND (goEnv.sv("BC_EDI_VERSION","") = "5.2" ;
1062*!* OR goEnv.sv("BC_EDI_VERSION","") = "4.4")
1063
1064 IF lnIdx > 0 AND (ALLT(EVAL(tcMetaDataAlias + ".process")) = "OSH" OR ALLT(EVAL(tcMetaDataAlias + ".process")) = "GX_OSH") ;
1065 AND goEnv.sv("TIE_SETUP","N") = "Y"
1066 *=== TR 1087148 11-6-2015 VKK
1067 *=== TR 1082361 KISHORE 18-FEB-2015
1068
1069 lnIdx = CEILING(lnIdx/4) && next integer after dividing by 4 will give proper index as its four dimensional array
1070 laStructure[lnIdx, 3] = lnPro_Num_len_856 && TR 1082361
1071 ENDIF
1072 *=== TechRec 1076316 14-Apr-2014 jisingh ===
1073
1074 *--- TechRec 1088278 02-Sept-2015 nsd ---
1075 lnIdx = ASCAN(laStructure, "STYLE_DESC")
1076 IF lnIdx > 0 AND ALLT(EVAL(tcMetaDataAlias + ".process")) = "OSC" AND goEnv.sv("TIE_SETUP","N") = "Y"
1077 lnIdx = CEILING(lnIdx/4) && next integer after dividing by 4 will give proper index as its four dimensional array
1078 laStructure[lnIdx, 2] = "M" && make it a memo
1079 ENDIF
1080 *=== TechRec 1088278 02-Sept-2015 nsd ===
1081
1082 *--- TechRec 1095578 07-Jun-2016 Anupam ---
1083 lnIdx = ASCAN(laStructure, "COLOR_CODE")
1084
1085 lnColor_Code_Length_940 = INT(VAL(goEnv.sv("COLOR_CODE_LENGTH_940","")))
1086 lnColor_Code_Length_940 = IIF(lnColor_Code_Length_940=0,5,lnColor_Code_Length_940)
1087
1088 IF lnIdx > 0 AND (ALLT(EVAL(tcMetaDataAlias + ".process")) = "OOW" AND goEnv.sv("TIE_SETUP","N") = "Y")
1089 lnIdx = CEILING(lnIdx/4) && next integer after dividing by 4 will give proper index as its four dimensional array
1090 laStructure[lnIdx, 3] = lnColor_Code_Length_940
1091 ENDIF
1092 *=== TechRec 1095578 07-Jun-2016 Anupam ===
1093
1094 *--- TechRec 1093599 23-Aug-2016 smullappilly ---
1095 lnIdx = ASCAN(laStructure, "STYLE")
1096
1097 IF lnIdx > 0 AND ( goEnv.sv("TIE_SETUP","N") = "Y" AND ;
1098 (ALLT(EVAL(tcMetaDataAlias + ".process")) = "OSC" OR ALLT(EVAL(tcMetaDataAlias + ".process")) = "OSH" OR ALLT(EVAL(tcMetaDataAlias + ".process")) = "OOW") )
1099
1100
1101 lnIdx = CEILING(lnIdx/4) && next integer after dividing by 4 will give proper index as its four dimensional array
1102 laStructure[lnIdx, 3] = 50
1103 ENDIF
1104 *=== TechRec 1093599 23-Aug-2016 smullappilly ===
1105
1106 *--- STRY0093933 03-Oct-2018 nnayak --- added condition for increasing width of style_name to 50
1107 lnIdx = ASCAN(laStructure, "STYLE_NAME")
1108 IF lnIdx > 0
1109 lnIdx = CEILING(lnIdx/4)
1110 laStructure[lnIdx,3] = 50
1111 ENDIF
1112
1113 lnIdx = ASCAN(laStructure, "TR_STYLE_NAME")
1114 IF lnIdx > 0
1115 lnIdx = CEILING(lnIdx/4)
1116 laStructure[lnIdx,3] = 50
1117 ENDIF
1118 *=== STRY0093933 03-Oct-2018 nnayak ===
1119
1120 * create template work table from schema array
1121 Create Cursor &tcTemplateWorkTable From Array laStructure
1122
1123 Select(lnOldSelect)
1124 Return llRetVal
1125 Endproc
1126
1127 ************************************************************************************
1128 * Open FlatFile return handle
1129 * parameter:
1130 * 1. Flatfile name + dir location
1131 * 2. True= Append to end of file, otherwise overwrite
1132 ***********************************************************************************
1133 Procedure OpenFlatFile
1134 Lparameter tcFlatFile, tlAppendToFile
1135 Local lnHandle
1136 lnHandle= -1 && fail to open
1137
1138 * Open/Create Flatfile
1139 If tlAppendToFile And File(tcFlatFile)
1140 lnHandle = Fopen(tcFlatFile,12)
1141 Endif
1142 If lnHandle < 0
1143 lnHandle = Fcreate(tcFlatFile)
1144 Endif
1145
1146 * move to EndofFile
1147 If lnHandle > 0
1148 Fseek(lnHandle, 0, 2)
1149 Endif
1150 Return lnHandle
1151 Endproc
1152
1153 ************************************************************************************
1154 * Open FlatFile return handle
1155 * parameter:
1156 * 1. Flatfile name + dir location
1157 * 2. True= Append to end of file, otherwise overwrite
1158 ***********************************************************************************
1159 Procedure CopyToFlatFile
1160 Lparameter tcSourceFlatfile, tcTargetFlatFile
1161 Local lnReadHandle, lnWriteHandle, lcFlatfileLine, llRetVal
1162 llRetVal= .F.
1163 lcFlatfileLine=""
1164 With This
1165 If File(tcSourceFlatfile)
1166 lnReadHandle= Fopen(tcSourceFlatfile)
1167 lnWriteHandle= .OpenFlatFile(tcTargetFlatFile, true)
1168 If lnReadHandle>0 And lnWriteHandle>0
1169 Do While !Feof(lnReadHandle)
1170 lcFlatfileLine= Fget(lnReadHandle,4090)
1171 Fput(lnWriteHandle, lcFlatfileLine)
1172 Enddo
1173 *--- TR 1011235 NH
1174 *!* Fclose(lnReadHandle)
1175 *!* Fclose(lnWriteHandle)
1176 *=== TR 1011235 NH
1177 llRetVal= .T.
1178 Endif
1179 *--- TR 1011235 NH
1180 Fclose(lnReadHandle)
1181 Fclose(lnWriteHandle)
1182 *=== TR 1011235 NH
1183 Endif
1184 Endwith
1185 Return llRetVal
1186 Endproc
1187
1188 ************************************************************************************
1189 * Block read of 256K and append to end of target
1190 ***********************************************************************************
1191 Procedure CopyToFlatFileInBlock
1192 Lparameter tcSourceFlatfile, tcTargetFlatFile
1193 Local lnReadHandle, lnWriteHandle, lcFlatfileBlock, llRetVal
1194 llRetVal= .F.
1195 lcFlatfileBlock=""
1196 lnBlock= 256 * 1024 && 256K block
1197 With This
1198 If File(tcSourceFlatfile)
1199 lnReadHandle= Fopen(tcSourceFlatfile)
1200 lnWriteHandle= .OpenFlatFile(tcTargetFlatFile, true)
1201 If lnReadHandle>0 And lnWriteHandle>0
1202 Do While !Feof(lnReadHandle)
1203 lcFlatfileBlock= Fread(lnReadHandle, lnBlock)
1204 Fwrite(lnWriteHandle, lcFlatfileBlock)
1205 Enddo
1206 *--- TR 1011235 NH
1207 *!* Fclose(lnReadHandle)
1208 *!* Fclose(lnWriteHandle)
1209 *=== TR 1011235 NH
1210 llRetVal= .T.
1211 Endif
1212 *--- TR 1011235 NH
1213 Fclose(lnReadHandle)
1214 Fclose(lnWriteHandle)
1215 *=== TR 1011235 NH
1216 Endif
1217 Endwith
1218 Return llRetVal
1219 Endproc
1220
1221 ************************************************************************************
1222 * Convert a metadata work record to text string
1223 *- 1009713 03/03/05 YIK Added parameters tlDelimited and tcDelimiter
1224 ***********************************************************************************
1225 Procedure ConvertRecordToText
1226 Lparameter tcTable, tlDelimited, tcDelimiter
1227 Local lnCnt, lcString, lcOldSele
1228 *- 1009713 03/03/05 YIK
1229 tlDelimited = Iif(Empty(tlDelimited), .F., tlDelimited)
1230 lcOldSele= Select()
1231 Select (tcTable)
1232 lcString = ""
1233 If !tlDelimited
1234 For lnCnt = 1 To Fcount(tcTable)
1235 lcString = lcString + Eval(Field(lnCnt, tcTable))
1236 Endfor
1237 Else
1238 For lnCnt = 1 To Fcount(tcTable)
1239 lcString = lcString + Iif(lnCnt = 1, "", tcDelimiter) + Alltrim(Eval(Field(lnCnt, tcTable)))
1240 Endfor
1241 Endif
1242 *= 1009713
1243 Select(lcOldSele)
1244 Return lcString + CRLF
1245 Endproc
1246
1247
1248 ************************************************************************************
1249 *
1250 ***********************************************************************************
1251 * PL ATS 3090- need to pass optional 4th. parameter for just one pkey from source
1252 * insteatd of the whole source cursor to copy to tartget
1253 Procedure ScatterGather
1254 Lparameter tcSource, tcTarget, tcReplaceString, tnPkey, tcForString,tlWithSeek
1255
1256 * TR 1041301 Add tlWithSeek
1257
1258 *PRIVATE ALL
1259 Local lcSelect, lcSetCentury, llHaveReplaceString, llHavePkey, llFoundRecord
1260 lcSelect = Select(0)
1261 lcSetCentury = Set('CENTURY')
1262 Set Century On
1263
1264 *--- TechRec 1086583 04-May-2015 vkrishnamurthy ---
1265 LOCAL lcSetDate
1266 lcSetDate = SET('DATE')
1267 SET DATE TO AMERICAN && Always EDI need to send in American Format
1268 *=== TechRec 1086583 04-May-2015 vkrishnamurthy ===
1269
1270 llHaveReplaceString= Iif(Empty(tcReplaceString), .F., .T.)
1271 llHavePkey= Iif(Empty(tnPkey), .F., .T.)
1272 tcForString = Iif(Empty(tcForString), " 1 = 1 ", tcForString)
1273 * PL 06/02/00 ATS 4080 -EDI- 850 process crash when update view comment
1274 * alway select target and SCATTER MEMVAR BLANK
1275 * Prevent: error cannot insert the value NULL into column '...
1276 * Sometime target table have more fields than source
1277 Select (tcTarget)
1278 Scatter Memvar Memo Blank
1279
1280 Select (tcSource)
1281 If llHavePkey
1282
1283 *--- TR 1041301 Seek on PKEY if present
1284 IF tlWithSeek
1285 llFoundRecord = SEEK(tnPkey,tcSource,"pkey")
1286 ELSE
1287 Locate For Pkey= tnPkey
1288 llFoundRecord = Found()
1289 ENDIF
1290 *=== TR 1041301 Seek on PKEY if present
1291
1292 IF llFoundRecord
1293 Scatter Memvar Memo && Source to memvar
1294 Select (tcTarget)
1295 Append Blank
1296 Gather Memvar Memo && replace fields from source to target
1297 If llHaveReplaceString
1298 &tcReplaceString
1299 Endif
1300 Endif
1301 Else
1302 Scan For &tcForString
1303 Scatter Memvar Memo
1304 Select (tcTarget)
1305 Append Blank
1306 Gather Memvar Memo
1307 * Sometime need to do some manipulate of data after copy records from source
1308 * to target (ie. for 832(o) need to replace upc_num with upc_num+chk_digit)
1309 If llHaveReplaceString
1310 &tcReplaceString
1311 Endif
1312 Select (tcSource)
1313 Endscan
1314 Endif
1315
1316 Set Century &lcSetCentury
1317 Select (lcSelect)
1318
1319 *--- TechRec 1086583 04-May-2015 vkrishnamurthy ---
1320 SET DATE TO &lcSetDate
1321 *=== TechRec 1086583 04-May-2015 vkrishnamurthy ===
1322 Endproc
1323
1324 ************************************************************************************
1325 * Populate data to Interface layer from Flat text file
1326 ***********************************************************************************
1327 *--- TR 1024757 NH : tcUniqueKeyColumns - param values can be - 'Doc_num' or 'pick_num'
1328 Procedure PopulateDataToInterfaceTable
1329 Lparameter tcTextAlias, tcWorkAlias, tcInterfaceAlias, tcTag, tcUniqueKeyColumn
1330 Local llRetVal, lnOldSelect, llMovetoInterface
1331 *--- TR 1024757 NH
1332 Local lcDupValues, lcUniqueKeyColumn
1333 lcDupValues = ""
1334 lcUniqueKeyColumn = tcUniqueKeyColumn
1335 *=== TR 1024757 NH
1336
1337 *-TR 1078010 FH - Let's set Date to AMERICAN (dates on flat file is mm/dd/yyyy), so when we load our dates have to be AMERICAN
1338 LOCAL lcOldDateFormat
1339 lcOldDateFormat = SET("DATE")
1340 SET DATE AMERICAN
1341 *-TR 1078010 FH
1342
1343 *--- TR 1092524 04-Jan-2016 BNarayanan ---
1344 LOCAL lcFileStr, lcFileConvStr
1345 STORE "" to lcFileStr, lcFileConvStr
1346 *=== TR 1092524 04-Jan-2016 BNarayanan ===
1347
1348 llRetVal= .T.
1349 llMovetoInterface= Iif(Empty(tcInterfaceAlias), .F., .T.)
1350 If File(tcTextAlias)
1351 lnOldSelect= Select()
1352 Select (tcWorkAlias)
1353
1354 *--- TR 1049856 BR
1355 *Append From (tcTextAlias) Deli With Char "|" &&Type SDF
1356 LOCAL lcTextAlias_Tmp, lcTextAlias_Stem
1357 lcTextAlias_Stem = JUSTSTEM(tcTextAlias)
1358 lcTextAlias_Tmp = STRTRAN(tcTextAlias, lcTextAlias_Stem, lcTextAlias_Stem + SYS(2015))
1359 *--- TR 1073301 21-Nov-2013 Yuri/SMeenraja Changed string conversion parameter value to 1
1360*!* STRTOFILE(STRCONV(FILETOSTR(tcTextAlias), 11),lcTextAlias_Tmp)
1361
1362 *--- TR 1092524 04-Jan-2016 BNarayanan ---
1363 *STRTOFILE(STRCONV(FILETOSTR(tcTextAlias), 1),lcTextAlias_Tmp)
1364 lcFileStr = FILETOSTR(tcTextAlias)
1365 lcFileConvStr = STRCONV(lcFileStr, 1)
1366
1367 IF OCCURS('?',lcFileConvStr) > OCCURS('?',lcFileStr)
1368 STRTOFILE(STRCONV(lcFileStr, 11),lcTextAlias_Tmp)
1369 ELSE
1370 STRTOFILE(lcFileConvStr,lcTextAlias_Tmp)
1371 ENDIF
1372 *=== TR 1092524 04-Jan-2016 BNarayanan ===
1373
1374 Append from (lcTextAlias_Tmp) Deli with char "|" &&Type SDF
1375 DELETE FILE (lcTextAlias_Tmp)
1376 *=== TR 1049856 BR
1377
1378 *--- TR 1024757 NH
1379 If Not Empty(lcUniqueKeyColumn) And VarType(lcUniqueKeyColumn) = "C"
1380 lcDups = Sys(2015)
1381 lcSql = "SELECT " + lcUniqueKeyColumn + ", COUNT(*) FROM " + tcWorkAlias + " GROUP BY " + lcUniqueKeyColumn + " HAVING COUNT(*) > 1 INTO CURSOR "+ lcDups
1382 &lcSql
1383 If Used(lcDups) And Reccount(lcDups) > 0
1384 Select(lcDups)
1385 Scan
1386 lcDupValues = lcDupValues + Trim(Transform(Evaluate(lcDups + "." + Trim(lcUniqueKeyColumn)))) + ", "
1387 Endscan
1388 lcDupValues = Left(lcDupValues, Len(lcDupValues) - 2) && remove the last ", "
1389 llRetVal = .F. && Making the Process fail.
1390 llMovetoInterface = .F.
1391 This.logEntry(" ")
1392 This.logEntry("=============== FATAL ERROR ===============")
1393 This.logEntry("Duplicate value in " + lcUniqueKeyColumn + " column of " + tcTextAlias + " flat file.")
1394 This.logEntry("List of duplicate values - " + lcDupValues)
1395 This.logEntry("=============== Process aborting... ===============")
1396 This.logEntry(" ")
1397 Endif
1398 If Used(lcDups)
1399 Use In Select(lcDups)
1400 Endif
1401 Endif
1402 *=== TR 1024757 NH
1403 If llMovetoInterface
1404 This.ScatterGather(tcWorkAlias, tcInterfaceAlias)
1405 Endif
1406 Select(lnOldSelect)
1407 ENDIF
1408
1409 *-TR 1078010 FH - set date back to what it was originally.
1410 SET DATE TO (lcOldDateFormat)
1411 *-TR 1078010 FH
1412
1413 Return llRetVal
1414 Endproc
1415
1416 ************************************************************************************
1417 * Assign Pkey to all records
1418 ***********************************************************************************
1419 Procedure GetPkeyForAllRecords
1420 Lparameter tcWorkAlias, tcTag
1421 Local llRetVal, lnOldSelect
1422 llRetVal= .T.
1423 lnOldSelect= Select()
1424 Select (tcWorkAlias)
1425 Scan For Empty(Pkey)
1426 lnPkey = v_NextPkey(tcTag)
1427 * cannot get PKEY from server
1428 *## Phu: recover latter after Gentran trainning
1429 *get batch of pkey latter
1430 If Empty(lnPkey)
1431 llRetVal= .F.
1432 Exit
1433 Else
1434 Replace Pkey With lnPkey In (tcWorkAlias)
1435 Endif
1436 Endscan
1437 Select(lnOldSelect)
1438 Return llRetVal
1439 Endproc
1440
1441 ************************************************************************************
1442 * Assign Pkey to all records
1443 ***********************************************************************************
1444 Procedure GetPkeyForAllRecordsInBatch
1445 Lparameter tcWorkAlias, tcTag, tnMax
1446 Local llRetVal, lnOldSelect, lcOldIndex && TR 1045060 JAN-22-2010 BR -ADDED lcOldIndex
1447 llRetVal= .T.
1448 lnOldSelect= Select()
1449
1450 *--- TR 1057492 10-Nov-11 SK Capturing ORDER is unwanted for this alias, need to be done for alias tcWorkAlias
1451*!* lcOldIndex = SET("ORDER") && TR 1045060 JAN-22-2010 BR
1452
1453 lnLast= v_NextPkey(tcTag, tnMax)
1454 If lnLast>0
1455 lnCnt= 0
1456 Select (tcWorkAlias)
1457
1458 *--- TR 1057492 10-Nov-11 SK Taking backup of current ORDER tag to lcOldIndex
1459 lcOldIndex = SET("ORDER") && TR 1045060 JAN-22-2010 BR
1460
1461 SET ORDER TO && TR 1045060 JAN-22-2010 BR
1462
1463 Scan For Empty(Pkey)
1464 lnCnt = lnCnt + 1
1465 lnCur = (lnLast - tnMax) + lnCnt && Detail pkey
1466 Replace Pkey With lnCur In (tcWorkAlias)
1467 Endscan
1468
1469 *--- TR 1057492 10-Nov-11 SK Resetting the ORDER from lcOldIndex
1470 SET ORDER TO &lcOldIndex && TR 1045060 JAN-22-2010 BR
1471 Else
1472 llRetVal= .F. && cannot get batch of pkeys to assign
1473 Endif
1474
1475 *--- TR 1057492 10-Nov-11 SK Moved code inside IF part
1476*!* SET ORDER TO &lcOldIndex && TR 1045060 JAN-22-2010 BR
1477
1478 Select(lnOldSelect)
1479 Return llRetVal
1480 Endproc
1481
1482 ************************************************************************************
1483 * group all records from metadata work tables to a flat text file
1484 ***********************************************************************************
1485 Procedure CreateFlatfileFromMetadataWorkTalbes
1486 Lparameter tcProcess, tcWorkVendor, tcWorkHeader, tcWorkDetail, tcWorkComment, tcWorkAddress,;
1487 pnHandle
1488 Local llRetVal, lnOldSelect, lnCurrentPkey, llHaveComment, llHaveAddress, lcPreviousCustomer,;
1489 lcPreviousDivision, lcMac, lcString
1490 llRetVal= .T.
1491 lcPreviousCustomer= ""
1492 lcPreviousDivision=""
1493 llHaveComment= (Recc(tcWorkComment)>0)
1494 llHaveAddress= (Recc(tcWorkAddress)>0)
1495 lnOldSelect= Select()
1496 With This
1497 Select (tcWorkHeader)
1498 Scan
1499 * reset lcString
1500 lcString= ""
1501 ***********************************************Populate data in vendor record
1502 ***********************************************On level break of customer,division
1503 * For GenTran find System template need VND- record
1504 * TradingPartnerID, EDI transaction set (810, 856..), Version (003060,004010...)
1505 If !(customer == lcPreviousCustomer And division == lcPreviousDivision)
1506 lcPreviousCustomer= customer
1507 lcPreviousDivision= division
1508 * Format vl_ call to proper control base on transaction (oIN, oSH...)
1509 * ie. for outbound 810: llRetVal= vl_iPOcr(Customer, "", "__Ecntrc", Division))
1510 lcMac= [vl_] + tcProcess + "cr" + [(Customer, "", "__Ecntrc", Division))]
1511 &lcMac
1512 If Used('__Ecntrc')
1513 Select (tcWorkVendor)
1514 Appen Blank
1515 Replace vnd_id With __Ecntrc.vnd_id,;
1516 vnd_tran With tcProcess,; && "OIN"(OB 810 invoice),"OSH" (OB 856 Adv.shpmt)
1517 vnd_vers With __Ecntrc.vnd_vers In (tcWorkVendor)
1518 Select (tcWorkHeader)
1519 Else
1520 llRetVal= .F.
1521 Exit && scan
1522 Endif
1523 * output Vendor string ("VND",TradingPartnerID,Transaction,Version)
1524 lcString = EDI_VENDOR_TAG + .ConvertRecordToText(tcWorkVendor)
1525 Endif
1526 ***********************************************End of level break (cust,div)
1527
1528 *********************************output header string "HDR"
1529 lcString = lcString + EDI_HEADER_TAG + .ConvertRecordToText(tcWorkHeader)
1530
1531 * use header.Pkey as the indication for the following tables
1532 * (DTL,CMT,ADR) as child's records of.
1533 lnCurrentPkey= &tcWorkHeader..Pkey
1534
1535 *********************************output comment string "CMT"
1536 If llHaveComment
1537 Select (tcWorkComment)
1538 Scan For Fkey = lnCurrentPkey
1539 lcString = lcString + EDI_COMMENT_TAG + .ConvertRecordToText(tcWorkComment)
1540 Endscan
1541 Endif
1542
1543 *********************************output Address string "ADR"
1544 If llHaveAddress
1545 Select (tcWorkAddress)
1546 Scan For Fkey = lnCurrentPkey
1547 lcString = lcString + EDI_ADDRESS_TAG + .ConvertRecordToText(tcWorkAddress)
1548 Endscan
1549 Endif
1550
1551 *********************************output detail string "DTL"
1552 Select (tcWorkDetail)
1553 Scan For Fkey = lnCurrentPkey
1554 lcString = lcString + EDI_DETAIL_TAG+ .ConvertRecordToText(tcWorkDetail)
1555 Endscan
1556
1557 ********************************* FUTURE: have some "SUM"- total record
1558 ********************************** write lcString to flat file
1559 If !Empty(lcString)
1560 If Fwrite(pnHandle, lcString) = 0
1561 lRetVal = .F.
1562 Endif
1563 Endif
1564 Endscan
1565 * close text file
1566 *FCLOSE(pnHandle)
1567 Endwith
1568
1569 Select(lnOldSelect)
1570 Return llRetVal
1571 Endproc
1572
1573 ************************************************************************************
1574 * LoadFromFlatFile
1575 * ie. for 850 inbound process:
1576 * LoadFromFlatFile(EDI_iPO_TRANSACTION,
1577 * lciPOHeaderFlatFile, lciPODetailFlatFile, lciPOCommentFlatFile, lciPOAddressFlatFile, ;
1578 * "VzzeiPOih_iPOproc", "VzzeiPOid_iPOproc", "VzzeiPOic_iPOproc", "VzzeiPOia_iPOproc",
1579 * "ZZEIPOIH", "ZZEIPOID", "ZZEIPOIC", "ZZEIPOIA")
1580 * ie. for 832 inbound process:
1581 * LoadFromFlatFile(EDI_iSC_TRANSACTION,
1582 * <SkipheaderFlatfile>,lciPODetailFlatFile,,,<SkipHeaderInterView>,"VzzeiSCir_iSCproc",,,
1583 * <SkipHeaderPkeyTag>,"ZZEISCIR")
1584 *
1585 * ATS 2587- EDI- 850 process to explode SDQ segments
1586 ***********************************************************************************
1587 Procedure LoadFromFlatFile
1588 Lparameters tcProcess, tcHeaderFlatFile, tcDetailFlatFile, tcCommentFlatFile, ;
1589 tcAddressFlatFile, tcSDQFlatFile, tcInterfaceHeader, tcInterfaceDetail, ;
1590 tcInterfaceComment, tcInterfaceAddress, tcHeaderPkeyTag, tcDetailPkeyTag, ;
1591 tcCommentPkeyTag, tcAddressPkeyTag
1592 Local llRetVal, lcSqlString
1593 llRetVal= .T.
1594
1595 With This
1596 * get Metadata for a process
1597 If .GetTranslationDefinition(tcProcess, "tcEmData")
1598 * Create Metadata work tables
1599 If !Empty(tcHeaderFlatFile)
1600 .CreateMetaDataWorkTable("tcEmData", "HEADER", "tcALLmwH")
1601 Endif
1602 If !Empty(tcDetailFlatFile)
1603 .CreateMetaDataWorkTable("tcEmData", "DETAIL", "tcALLmwD")
1604 Endif
1605 If !Empty(tcCommentFlatFile)
1606 .CreateMetaDataWorkTable("tcEmData", "COMMENT", "tcALLmwC")
1607 Endif
1608 If !Empty(tcAddressFlatFile)
1609 .CreateMetaDataWorkTable("tcEmData", "ADDRESS", "tcALLmwA")
1610 Endif
1611 * ATS 2587- EDI- 850 process to explode SDQ segments
1612 If !Empty(tcSDQFlatFile)
1613 .CreateMetaDataWorkTable("tcEmData", "SDQ", "tcALLmwS")
1614 Create Cursor tcStore (Store C(9), Pkey i(4))
1615 .CreateCursorStructure("tcALLmwD", "tcStore" , "tcSDQWrk")
1616 Endif
1617
1618 * Populate data to interface tables from text files
1619 If !Empty(tcHeaderFlatFile)
1620 .PopulateDataToInterfaceTable(tcHeaderFlatFile, "tcALLmwH", tcInterfaceHeader)
1621 Endif
1622 If !Empty(tcDetailFlatFile)
1623 .PopulateDataToInterfaceTable(tcDetailFlatFile, "tcALLmwD", tcInterfaceDetail)
1624 Endif
1625 If !Empty(tcCommentFlatFile)
1626 .PopulateDataToInterfaceTable(tcCommentFlatFile, "tcALLmwC", tcInterfaceComment)
1627 Endif
1628 If !Empty(tcAddressFlatFile)
1629 .PopulateDataToInterfaceTable(tcAddressFlatFile, "tcALLmwA", tcInterfaceAddress)
1630 Endif
1631
1632 * Assign pkeys for all interface tables
1633 If !Empty(tcHeaderFlatFile)
1634 .GetPkeyForAllRecords(tcInterfaceHeader, tcHeaderPkeyTag)
1635 Endif
1636 If !Empty(tcDetailFlatFile)
1637 .GetPkeyForAllRecords(tcInterfaceDetail, tcDetailPkeyTag)
1638 Endif
1639 If !Empty(tcCommentFlatFile)
1640 .GetPkeyForAllRecords(tcInterfaceComment, tcCommentPkeyTag)
1641 Endif
1642 If !Empty(tcAddressFlatFile)
1643 .GetPkeyForAllRecords(tcInterfaceAddress, tcAddressPkeyTag)
1644 Endif
1645 * Sync header Pkey to all child tables Fkey using doc_num
1646 * could just be detail only like 832 inbound
1647 If !Empty(tcHeaderFlatFile) And !Empty(tcDetailFlatFile)
1648 .SyncHeaderDetailPFkey(tcInterfaceHeader, tcInterfaceDetail, "doc_num")
1649 Endif
1650 If !Empty(tcHeaderFlatFile) And !Empty(tcCommentFlatFile)
1651 .SyncHeaderDetailPFkey(tcInterfaceHeader, tcInterfaceComment, "doc_num")
1652 Endif
1653 If !Empty(tcHeaderFlatFile) And !Empty(tcAddressFlatFile)
1654 .SyncHeaderDetailPFkey(tcInterfaceHeader, tcInterfaceAddress, "doc_num")
1655 Endif
1656
1657 * ATS 2587- EDI- 850 process to explode SDQ segments
1658 If !Empty(tcSDQFlatFile)
1659 *
1660 * get flatfile SDQ data into work tables
1661 .PopulateDataToInterfaceTable(tcSDQFlatFile, "tcALLmwS")
1662 *
1663 * have some SDQ to explode
1664 If Recc("tcALLmwS")>0
1665 *
1666 * Join all detail and SDQ together, before explode to tcSDQDet
1667 * (DTL + single store from SDQ segment store1,qty1, store2,qty2 ...)
1668 *--- TR 1003801 - BD - 03/30/04 - Add EAN in Where and Order by clause in SQL select below:
1669 Select d.*, s.store_01,s.qty_01,s.store_02,s.qty_02,s.store_03,s.qty_03,;
1670 s.store_04,s.qty_04,s.store_05,s.qty_05,s.store_06,s.qty_06,s.store_07,s.qty_07,;
1671 s.store_08,s.qty_08,s.store_09,s.qty_09,s.store_10,s.qty_10 ;
1672 From tcALLmwD d, tcALLmwS s Where s.doc_num= d.doc_num And ;
1673 s.upc= d.upc And s.sku= d.sku And s.ean = d.ean ;
1674 Into Cursor __SDQDet ;
1675 Order By s.doc_num, s.upc, s.sku, s.ean
1676 *=== TR 1003801 - BD - 03/30/04
1677
1678 * turn 10 pairs of SDQ store,qty from horizontal to vertical
1679 If Used("__SDQDet")
1680 .PreExplodeSQDOrders("__SDQDet", "tcSDQWrk")
1681 Endif
1682 *
1683 * should alway have something here to explode
1684 If Recc("tcSDQWrk")>0
1685 * order by doc_num, store, UPC,SKU for level break in explotion logic latter
1686 * Also need some indexes here for optimizing
1687 *--- TR 1003801 - BD - 03/30/04 - Add EAN in Order by clause in SQL select below:
1688 Select * From tcSDQWrk Into Cursor _SDQDet Order By doc_num, Store, upc, sku, ean
1689 *=== TR 1003801 - BD - 03/30/04
1690 .MakeCursorWritable("_SDQDet", "tcSDQDet")
1691 Select tcSDQDet
1692 Index On Pkey Tag Pkey
1693 Index On doc_num Tag doc_num
1694 *
1695 * Explode orders into Interface tables all will have same doc_num
1696 * already, adjust clsIPOpr to handle dulication in doc_num when
1697 * sync Pkey/fkey in transaction table
1698 .ExplodeSDQOrders("tcSDQDet", tcInterfaceHeader, tcInterfaceDetail, ;
1699 tcInterfaceComment, tcInterfaceAddress, tcHeaderPkeyTag, tcDetailPkeyTag, ;
1700 tcCommentPkeyTag, tcAddressPkeyTag, "tcALLmwH", "tcALLmwD", "tcALLmwC", "tcALLmwA")
1701 Endif
1702 Endif
1703 Endif
1704 Else
1705 llRetVal=.F.
1706 Endif
1707 Endwith
1708
1709 Local laTables[10]
1710 laTables[1] = "tcALLmwH"
1711 laTables[2] = "tcALLmwD"
1712 laTables[3] = "tcALLmwC"
1713 laTables[4] = "tcALLmwA"
1714 laTables[5] = "tcALLmwS"
1715 laTables[6] = "tcEmdata"
1716 laTables[7] = "__SDQDet"
1717 laTables[8] = "tcSDQDet"
1718 laTables[9] = "tcSDQWrk"
1719 laTables[10]= "tcStore"
1720 .TableClose(@laTables)
1721
1722 Return llRetVal
1723 Endproc
1724
1725 ************************************************************************************
1726 * Combine DTL and turn all SDQ (store1,qty1, store2, qty2...) to vertical
1727 ***********************************************************************************
1728 Procedure PreExplodeSQDOrders
1729 Parameter tcSDQWorkTable, tcSDQDetailTable
1730 Local lnOldSele, llRetVal, lcSqlString, lnSDQCount
1731 llRetVal= .T.
1732 lnOldSele= Select()
1733 Select (tcSDQWorkTable)
1734 Scan
1735 Scatt Memvar
1736 For lnSDQCount = 1 To MAX_SDQ_COUNT
1737 lcSDQCount= Trans(lnSDQCount , "@L 99")
1738 m.Store=Eval( "store_" + lcSDQCount)
1739 m.Total_qty= Eval( "qty_" + lcSDQCount)
1740 If !Empty(m.Store) And !Empty(m.Total_qty)
1741 Insert Into (tcSDQDetailTable) From Memvar
1742 Endif
1743 Endfor
1744 Endscan
1745 * Each SDQDetail records need dummy pkey (recno())
1746 Replace All Pkey With Recno() In (tcSDQDetailTable)
1747 Return llRetVal
1748 Endproc
1749
1750 ************************************************************************************
1751 * explode SDQ Orders from Temp Metadata work tables into Interface tables
1752 * notes: any data type refer to tcMetaWork... will have CHARACTER DATA TYPE
1753 * ONLY when it make to Interface table then will have proper data type
1754 ***********************************************************************************
1755 Procedure ExplodeSDQOrders
1756 * --- TR 1018184 RLN 12/14/06 add params: tcInterfaceSAC, tcSACPkeyTag
1757 Parameter tcSDQDetailTable, tcInterfaceHeader, tcInterfaceDetail, ;
1758 tcInterfaceComment, tcInterfaceAddress, tcHeaderPkeyTag, tcDetailPkeyTag, ;
1759 tcCommentPkeyTag, tcAddressPkeyTag, tcMetaWorkHeader, tcMetaWorkDetail, ;
1760 tcMetaWorkComment, tcMetaWorkAddress,;
1761 tcInterfaceSLN, tcSLNPkeyTag, tcInterfaceSAC, tcSACPkeyTag,; && Added in TechRec 1005163 14-May-2004 GS ---
1762 tcInterfaceHDR2, tcMetaWorkHDR2 && *--- TR 1088047 31-8-2015 VKK
1763 * --- TR 1018184 RLN 12/14/06 added: llFirstDetail
1764 Local lnOldSele, llRetVal, lcSqlString, lnSDQCount,lnCurrentDoc_num, lcCurrentDoc_num, ;
1765 lnOrdersHeaderToExplode,lnOrdersLineToExplode, lcDBFName, lnCurrentStart_date, llFirstDetail
1766 *--- TechRec 1005163 18-May-2004 GS ---
1767 Local lnCurrentEnd_Date, lnOldDtlPKey, lnNewDtlPKey, i, lnCnt, llSLN, lcSLN, lcPO1_Line, lcDoc_Num
1768 *=== TechRec 1005163 18-May-2004 GS ===
1769 * --- ND TR 1017049 5/15/06 Use SEEK/SCAN WHILE instead of SCAN FOR
1770 Local lcOrder
1771 * === ND TR 1017049 5/15/06 Use SEEK/SCAN WHILE instead of SCAN FOR
1772
1773 *--- TechReq 1028745 31-Jan-2008 GSternik ---
1774 Local llExt, lcInterfaceExtd, llChrg, lcInterfaceChrgD
1775 *=== TechRec 1028745 31-Jan-2008 GSternik ===
1776
1777 *-FH 1087774
1778 LOCAL lcOldDateFormat
1779 lcOldDateFormat = SET("DATE")
1780 SET DATE AMERICAN
1781 *-FH 1087774
1782
1783 llRetVal= .T.
1784 lnOldSele= Select()
1785
1786 * create temporary cursor to hold exploded orders before append to interface tables
1787 * should have same layout as interface tables
1788 Select (tcInterfaceHeader)
1789 Afields(laWorkHeader)
1790 * TAN 28970 - Walmart 850 - Store truncate to 9 position for
1791 * SDQ orders when expand EDI store to 13 position
1792 lnRow =Asub(laWorkHeader, Ascan(laWorkHeader, 'STORE'), 1)
1793 laWorkHeader[lnRow, 3]= 13 && expand store to 13 pos in SQD work header
1794 Create Cursor TargetWH From Array laWorkHeader
1795 Select (tcInterfaceDetail)
1796 Afields(laWorkDetail)
1797 Create Cursor TargetWD From Array laWorkDetail
1798 Select (tcInterfaceComment)
1799 Afields(laWorkComment)
1800 Create Cursor TargetWC From Array laWorkComment
1801
1802 *--- TR 1088047 31-8-2015 VKK
1803 LOCAL lnCurrentHDR2Lines ,lnLastHDR2Pkey ,lnCurrentHDR2Lines,lnTotalHDR2Lines
1804 STORE 0 TO lnCurrentHDR2Lines ,lnLastHDR2Pkey ,lnCurrentHDR2Lines,lnTotalHDR2Lines
1805 llHDR2 = !Empty(tcInterfaceHDR2) And Used(tcInterfaceHDR2) And Reccount(tcInterfaceHDR2) > 0
1806
1807 *--- TechRec 1093944 04-Mar-2016 TSV---
1808 llHDR2 = llHDR2 AND !Empty(tcMetaWorkHDR2) And Used(tcMetaWorkHDR2) And Reccount(tcMetaWorkHDR2) > 0
1809 *=== TechRec 1093944 04-Mar-2016 TSV===
1810
1811 IF llHDR2
1812 Select (tcInterfaceHDR2)
1813 Afields(laWorkHDR2)
1814 Create Cursor TargetWH2 From Array laWorkHDR2
1815 ENDIF
1816 *=== TR 1088047 31-8-2015 VKK
1817
1818 Select (tcInterfaceAddress)
1819 Afields(laWorkAddress)
1820 Create Cursor TargetWA From Array laWorkAddress
1821
1822 *--- TechRec 1005163 14-May-2004 GS ---
1823 llSLN = !Empty(tcInterfaceSLN) And Used(tcInterfaceSLN) And Reccount(tcInterfaceSLN) > 0
1824 If llSLN
1825 Select (tcInterfaceSLN)
1826 Afields(laWorkSLN)
1827 Create Cursor TargetSLN From Array laWorkSLN
1828 Endif
1829 *=== TechRec 1005163 14-May-2004 GS ===
1830
1831 *--- TechReq 1028745 31-Jan-2008 GSternik ---
1832 lcInterfaceExtd = "vzzeiPOie_iPOproc"
1833 If Used("qExtMData") and Used(lcInterfaceExtd) and RecCount(lcInterfaceExtd) > 0
1834 llExt = .T.
1835 Select (lcInterfaceExtd)
1836 =AFields(laWorkSLN)
1837 Create Cursor TargetExtd from array laWorkSLN
1838 EndIf
1839 *=== TechRec 1028745 31-Jan-2008 GSternik ===
1840
1841 *--- TechRec 1028745 05-Feb-2008 GSternik ---
1842 lcInterfaceChrgD = "vzzeiPOiR_iPOproc"
1843 If Used(lcInterfaceChrgD) and RecCount(lcInterfaceChrgD) > 0
1844 llChrg = .T.
1845 Select (lcInterfaceChrgD)
1846 =AFields(laWorkChrg)
1847 Create Cursor TargetChrg from array laWorkChrg
1848 EndIf
1849 *=== TechRec 1028745 05-Feb-2008 GSternik ===
1850 * --- TR 1018184
1851 llSAC = !Empty(tcInterfaceSAC) And Used(tcInterfaceSAC) And Reccount(tcInterfaceSAC) > 0
1852 If llSAC
1853 Select (tcInterfaceSAC)
1854 Afields(laWorkSAC)
1855 Create Cursor TargetSAC From Array laWorkSAC
1856 Endif
1857 * === TR 1018184
1858
1859 *--- TR 1044017 04-JAN-2010 HNISAR
1860 LOCAL llWhsData
1861 lcInterfaceWhse = "vzzeiPOiWhse_iPOproc"
1862 If Used(lcInterfaceWhse ) and RecCount(lcInterfaceWhse ) > 0
1863 llWhsData = .T.
1864 Select (lcInterfaceWhse )
1865 =AFields(laWorkWHSE)
1866 Create Cursor TargetWhse from array laWorkWHSE
1867 EndIf
1868 *=== TR 1044017 04-JAN-2010 HNISAR
1869
1870 With This
1871 * number of SDQ Orders (by doc_num) to explode
1872 Select doc_num, Pkey From (tcSDQDetailTable) Into Cursor tcSDQOrds Group By doc_num
1873
1874 Select tcSDQOrds
1875 Scan && group of SDQ orders (doc_num)
1876
1877 * The following _Wrk### will hold template orders to be expode to multiple base
1878 * on group by store,UPC,SKU in detail SDQ work table
1879 lcCurrentDoc_num= tcSDQOrds.doc_num
1880 Select * From (tcMetaWorkHeader) Into Cursor _WrkHdr Where doc_num= lcCurrentDoc_num
1881 Select * From (tcMetaWorkComment) Into Cursor _WrkCmt Where doc_num= lcCurrentDoc_num
1882 *--- TR 1088047 31-8-2015 VKK
1883 IF llHDR2
1884 Select * From (tcMetaWorkHDR2) Into Cursor _WrkHDR2 Where doc_num= lcCurrentDoc_num
1885 ENDIF
1886 *=== TR 1088047 31-8-2015 VKK
1887
1888 Select * From (tcMetaWorkAddress) Into Cursor _WrkAdr Where doc_num= lcCurrentDoc_num
1889 *--- TR 1003801 - BD - 03/30/04 - Add EAN in Order by clause in SQL select below:
1890 Select * From (tcSDQDetailTable) Into Cursor _WrkDtl Where doc_num= lcCurrentDoc_num ;
1891 Order By Store, upc, sku, ean
1892 *=== TR 1003801 - BD - 03/30/04
1893
1894 * Get current header image into Memvar (only one per doc_num)
1895 Select _WrkHdr
1896 Scatt Memvar Memo
1897 lnCurrentStart_date= m.start_date
1898 lnCurrentEnd_Date= m.end_date
1899
1900 * Get pkey for ALL headers (ZZEIPOIH- tag)
1901 Select Store From _WrkDtl Group By Store Into Cursor tcHdrCnt
1902 lnOrdersHeaderToExplode = Recc("tcHdrCnt")
1903 Use In tcHdrCnt
1904 lnLastHeaderPkey = v_NextPkey(tcHeaderPkeyTag, lnOrdersHeaderToExplode)
1905
1906 * Get pkey for ALL detail we're about to create (ZZEIPOID- tag)
1907 lnOrdersLineToExplode = Recc("_WrkDtl")
1908 lnLastDetailPkey = v_NextPkey(tcDetailPkeyTag, lnOrdersLineToExplode)
1909
1910 * Get pkey for ALL order comments we're about to create (ZZEIPOID- tag)
1911 lnTotalCommentLines = Recc("_WrkCmt")
1912 If lnTotalCommentLines>0
1913 lnLastCommentPkey = v_NextPkey(tcCommentPkeyTag, lnOrdersHeaderToExplode * lnTotalCommentLines)
1914 lnCurrentCommentLines = 0
1915 Endif
1916
1917 * Get pkey for ALL order comments we're about to create (ZZEIPOID- tag)
1918 *--- TR 1088047 31-8-2015 VKK
1919 IF llHDR2
1920 lnTotalHDR2Lines = Recc("_WrkHdr2")
1921 If lnTotalHDR2Lines >0
1922 lnLastHDR2Pkey = v_NextPkey("ZZEIP1IH", lnOrdersHeaderToExplode * lnTotalHDR2Lines )
1923 lnCurrentHDR2Lines = 0
1924 ENDIF
1925 ENDIF
1926 *=== TR 1088047 31-8-2015 VKK
1927
1928 * Get pkey for ALL order address we're about to create (ZZEIPOIA- tag)
1929 lnTotalAddressLines = Recc("_WrkAdr")
1930 If lnTotalAddressLines>0
1931 lnLastAddressPkey = v_NextPkey(tcAddressPkeyTag, lnOrdersHeaderToExplode * lnTotalAddressLines)
1932 lnCurrentAddressLines = 0
1933 Endif
1934
1935 lnHdrCnt = 0
1936 lnDtlCnt = 0
1937 lnOrd_qty = 0
1938 lcPreviousStore = ""
1939 Select _WrkDtl
1940
1941 Scan
1942 * restore header start/end_date back (SDQ explotion order all start/end-date same
1943 * as the template header
1944 m.start_date= lnCurrentStart_date
1945 m.end_date= lnCurrentEnd_Date
1946
1947 * start of store level break*********************************************************
1948 * Each time store change create order header
1949 If !(Store == lcPreviousStore)
1950 lnHdrCnt = lnHdrCnt + 1
1951 *
1952 * Calc next pkey b/c we got all of them at once
1953 lnCurrentHeaderPkey = (lnLastHeaderPkey - lnOrdersHeaderToExplode) + lnHdrCnt
1954 m.Pkey = lnCurrentHeaderPkey && header pkey
1955 m.Store = _WrkDtl.Store && assign header store with explode store
1956
1957 lnLine_seq = 0 && reset lnLine_seq
1958 * replace ord_qty for current order header
1959 * before insert a new order header
1960 * For order header does not need to accumulate as in Multi-store
1961 * will be recalculate before stuff to live tables
1962 *IF lnOrd_qty > 0
1963 * REPLACE ord_qty WITH lnOrd_qty IN TargetWH
1964 * lnOrd_qty = 0 && reset header order quantity
1965 *ENDIF
1966 Select TargetWH
1967 Append Blank
1968 Gather Memvar Memo
1969 * --- TR 1018184 RLN 12/14/06
1970 llFirstDetail = .T.
1971 * Exchange store with EDI_Store
1972 *--- 1022877 27-MAR-07 KISHOR (added EDI_Center)- VK 4/13/07
1973 *Replace EDI_Store with Store, store with "" in TargetWH
1974 Replace EDI_Store With Store, ;
1975 store With "", ;
1976 edi_center With Iif(!Empty(_WrkDtl.edi_center), _WrkDtl.edi_center,_WrkHdr.edi_center) ;
1977 in TargetWH
1978 *=== 1022877 27-MAR-07 KISHOR
1979
1980 * Explode order comments *****************************************************
1981 If lnTotalCommentLines>0
1982 * use current comment lines for pkey calculation smallest pkey 1st
1983 Select _WrkCmt
1984 Scan
1985 Scatt Memvar Memo
1986 lnCurrentCommentLines = lnCurrentCommentLines + 1
1987 m.Pkey = (lnLastCommentPkey - (lnOrdersHeaderToExplode * lnTotalCommentLines)) + ;
1988 lnCurrentCommentLines
1989 m.Fkey = lnCurrentHeaderPkey
1990 Select TargetWC
1991 Append Blank
1992 Gather Memvar Memo
1993 Endscan
1994 Endif
1995 * End of Explode order comments ***********************************************
1996
1997 *--- TR 1088047 31-8-2015 VKK
1998 * Explode order HDR2 *****************************************************
1999 IF llHDR2
2000 If lnTotalHDR2Lines>0
2001 * use current comment lines for pkey calculation smallest pkey 1st
2002 Select _WrkHDR2
2003 Scan
2004 Scatt Memvar Memo
2005 lnCurrentHDR2Lines = lnCurrentHDR2Lines + 1
2006 m.Pkey = (lnLastHDR2Pkey - (lnOrdersHeaderToExplode * lnTotalHDR2Lines)) + ;
2007 lnCurrentHDR2Lines
2008 m.Fkey = lnCurrentHeaderPkey
2009 Select TargetWH2
2010 Append Blank
2011 Gather Memvar Memo
2012
2013 Endscan
2014 ENDIF
2015 ENDIF
2016 * End of Explode order HDR2***********************************************
2017
2018 *=== TR 1088047 31-8-2015 VKK
2019
2020 * Explode order Addresses *****************************************************
2021 If lnTotalAddressLines>0
2022 * use current Address lines for pkey calculation smallest pkey 1st
2023 Select _WrkAdr
2024 Scan
2025 Scatt Memvar Memo
2026 lnCurrentAddressLines = lnCurrentAddressLines + 1
2027 m.Pkey = (lnLastAddressPkey - (lnOrdersHeaderToExplode * lnTotalAddressLines)) + ;
2028 lnCurrentAddressLines
2029 m.Fkey = lnCurrentHeaderPkey
2030 Select TargetWA
2031 Append Blank
2032 Gather Memvar Memo
2033 Endscan
2034 Endif
2035 * End of Explode order Addresses ************************************************
2036
2037 * keep track of Previous Store
2038 lcPreviousStore = m.Store
2039 Endif && End of store level break****************************************************
2040
2041 *Create order detail using template _WrkDtl (combine of DTL+SDQ)
2042 Select _WrkDtl
2043 lnDtlCnt = lnDtlCnt + 1
2044 Scatter Memvar Memo
2045
2046 m.Fkey = lnCurrentHeaderPkey && Sync detail fkey with header pkey
2047 m.Pkey = (lnLastDetailPkey - lnOrdersLineToExplode) + lnDtlCnt && Detail pkey
2048 *- 04/06/11 1053523 YIK
2049 *- assign po1_upc for SDQ orders here
2050 m.po1_upc = m.upc
2051 m.po1_sku = m.sku
2052 *=
2053
2054 *--- TechRec 1059747 27-Apr-2012 jisingh ---
2055 m.store = _WrkDtl.Store
2056 *=== TechRec 1059747 27-Apr-2012 jisingh ===
2057
2058 lnLine_seq = lnLine_seq + 1 && incr. lnLine_seq
2059 m.line_seq = lnLine_seq && next line_seq
2060 *lnOrd_qty = lnOrd_qty + val(Total_qty) && accum total_qty to ord_qty
2061 Select TargetWD
2062 Append Blank
2063 Gather Memvar Memo
2064
2065 *--- TechRec 1005163 14-May-2004 GS ---
2066 * --- TR 1018184 RLN 12/14/06
2067 *IF llSLN
2068 *--- TechReq 1028745 31-Jan-2008 GSternik ---
2069 *If llSLN Or llSAC
2070 *--- TechRec 1057047 11-Oct-2011 MANI. Added OR llWhsData ===
2071 If llSLN Or llSAC or llExt or llChrg OR llWhsData
2072 *=== TechRec 1028745 31-Jan-2008 GSternik ===
2073 lnNewDtlPKey = m.Pkey
2074 lcPO1_Line = PO1_Line
2075 lcDoc_Num = Doc_Num
2076 Select (tcInterfaceDetail)
2077 * --- ND TR 1017049 5/15/06 Use SEEK instead of locate
2078 *locate for PO1_Line = lcPO1_Line and Doc_Num = lcDoc_Num
2079 If Not Seek(Str(lcDoc_Num) + lcPO1_Line,tcInterfaceDetail,"PO1_Line")
2080 *--- TR 1017624 NH
2081 *.oLog.LogEntry("No DOC_NUM, PO1_Line found for: " + TRANSFORM(lcDoc_num) + " | " + lcPO1_Line)
2082 .logEntry("No DOC_NUM, PO1_Line found for: " + Transform(lcDoc_Num) + " | " + lcPO1_Line)
2083 *=== TR 1017624 NH
2084 Endif
2085 * === ND TR 1017049 5/15/06 Use SEEK instead of locate
2086 lnOldDtlPKey = Pkey
2087 * --- TR 1018184 RLN 12/14/06
2088 * --- TR 1023998 ROGER
2089 lnOldHdrPKey = Fkey
2090
2091 If llSLN
2092 * === TR 1018184
2093 Select (tcInterfaceSLN)
2094 lnCnt = 0
2095
2096 * --- ND TR 1017049 5/15/06 Use SEEK/SCAN WHILE instead of SCAN FOR
2097 If Seek(lnOldDtlPKey,tcInterfaceSLN,"fkey")
2098 lcOrder = Set("Order")
2099 Set Order To Tag Fkey
2100 *scan for FKey = lnOldDtlPKey
2101 Scan While Fkey = lnOldDtlPKey
2102 Scatter Memvar Memo
2103 Select TargetSLN
2104 Append Blank
2105 Gather Memvar Memo
2106 lnCnt = lnCnt + 1
2107 Replace Fkey With lnNewDtlPKey
2108 Endscan
2109 Set Order To &lcOrder
2110 Endif
2111 * === ND TR 1017049 5/15/06 Use SEEK/SCAN WHILE instead of SCAN FOR
2112 If lnCnt > 0
2113 m.Pkey = v_NextPkey(tcSLNPkeyTag, lnCnt) + 1
2114 Select TargetSLN
2115 For i = 1 To lnCnt
2116 Replace Pkey With m.Pkey - i
2117 Skip -1
2118 Endfor
2119 Endif
2120 EndIf
2121
2122 *--- TechReq 1028745 31-Jan-2008 GSternik ---
2123 If llChrg
2124 Select (lcInterfaceChrgD)
2125 lnCnt = 0
2126 If Seek(lnOldDtlPKey, lcInterfaceChrgD, "FKey")
2127 lcOrder = Set("Order")
2128 Set Order To Tag FKey
2129 Scan While FKey = lnOldDtlPKey
2130 Scatter Memvar Memo
2131 Select TargetChrg
2132 Append Blank
2133 Gather Memvar Memo
2134 lnCnt = lnCnt + 1
2135 Replace FKey With lnNewDtlPKey
2136 EndScan
2137 Set Order To &lcOrder
2138 Endif
2139
2140 If lnCnt > 0
2141 m.Pkey = v_NextPkey("ZZXCHRDS", lnCnt) + 1
2142 Select TargetChrg
2143 For i = 1 To lnCnt
2144 Replace PKey With m.PKey - i
2145 Skip -1
2146 Endfor
2147 Endif
2148 EndIf
2149
2150
2151 If llExt
2152 Select (lcInterfaceExtd)
2153 lnCnt = 0
2154 If Seek(lnOldDtlPKey,lcInterfaceExtd,"DtlFKey")
2155 lcOrder = Set("Order")
2156 Set Order To Tag DtlFKey
2157 Scan while DtlFKey = lnOldDtlPKey
2158 Scatter Memvar Memo
2159 Select TargetExtd
2160 Append Blank
2161 Gather Memvar Memo
2162 lnCnt = lnCnt + 1
2163 Replace DtlFKey With lnNewDtlPKey, HdrFKey WITH lnCurrentHeaderPkey &&--- TR 1038136 NH
2164 EndScan
2165 Set Order To &lcOrder
2166 Endif
2167
2168 If lnCnt > 0
2169 m.PKey = v_NextPkey("ZZZUDFDT", lnCnt) + 1
2170 Select TargetExtd
2171 For i = 1 To lnCnt
2172 Replace PKey With m.PKey - i
2173 Skip -1
2174 EndFor
2175 Endif
2176 EndIf
2177 *=== TechRec 1028745 31-Jan-2008 GSternik ===
2178
2179 * --- TR 1018184 RLN 12/14/06
2180 If llSAC
2181 Select (tcInterfaceSAC)
2182 lnCnt = 0
2183 If Seek(lnOldDtlPKey, tcInterfaceSAC, "dfkey")
2184 lcOrder = Set("Order")
2185 Set Order To Tag dfkey
2186 *scan for FKey = lnOldDtlPKey
2187 Scan While dfkey = lnOldDtlPKey
2188 lnOldHdrPKey = hfkey
2189 Scatter Memvar Memo
2190 Select TargetSAC
2191 Append Blank
2192 Gather Memvar Memo
2193 lnCnt = lnCnt + 1
2194 Replace dfkey With lnNewDtlPKey, ;
2195 hfkey With lnCurrentHeaderPkey
2196 Endscan
2197 Set Order To &lcOrder
2198 * --- TR 1023998 ROGER
2199 Endif
2200
2201 If llFirstDetail
2202 lcSeek = Alltrim(Str(lnOldHdrPKey)) + "0"
2203 If Seek(lcSeek, tcInterfaceSAC, "h_dfkey")
2204 lcOrder = Set("Order")
2205 Set Order To Tag hfkey
2206 Scan While hfkey = lnOldHdrPKey And dfkey = 0
2207 Scatter Memvar Memo
2208 Select TargetSAC
2209 Append Blank
2210 Gather Memvar Memo
2211 lnCnt = lnCnt + 1
2212 Replace dfkey With 0, ;
2213 hfkey With lnCurrentHeaderPkey
2214 Endscan
2215 Set Order To &lcOrder
2216 Endif
2217 Endif
2218 *llFirstDetail = .F. 1071666 FH - moving it down- if we have both SAC and datawhse, sac will llFirstDetail to .F. but we will need it for datawhse
2219 * --- TR 1023998 ROGER
2220 *ENDIF
2221
2222 If lnCnt > 0
2223 m.Pkey = v_NextPkey(tcSACPkeyTag, lnCnt) + 1
2224 Select TargetSAC
2225 For i = 1 To lnCnt
2226 Replace Pkey With m.Pkey - i
2227 Skip -1
2228 Endfor
2229 Endif
2230 Endif
2231 * === TR 1018184
2232
2233 *--- TR 1044017 04-JAN-2010 HNISAR
2234 If llWhsData
2235 Select (lcInterfaceWhse)
2236 lnCnt = 0
2237 *--- TechRec 1054619 08-Jun-2011 MANI. ---
2238
2239*!* If Seek(lnOldDtlPKey,lcInterfaceWhse,"dFKey")
2240*!* lcOrder = Set("Order")
2241*!* Set Order To Tag hfkey
2242*!* Scan While hfkey = lnOldHdrPKey And dfkey = 0
2243*!* Scatter Memvar Memo
2244*!* Select TargetWhse
2245*!* Append Blank
2246*!* Gather Memvar Memo
2247*!* lnCnt = lnCnt + 1
2248*!* Replace dfkey With lnNewDtlPKey, ;
2249*!* hfkey With lnCurrentHeaderPkey
2250*!* Endscan
2251*!* Set Order To &lcOrder
2252*!* Endif
2253
2254 If Seek(lnOldDtlPKey,lcInterfaceWhse,"dFKey")
2255 lcOrder = Set("Order")
2256 Set Order To Tag dfkey
2257 Scan While dfkey = lnOldDtlPKey
2258 lnOldHdrPKey = hfkey
2259 Scatter Memvar Memo
2260 *--- TechRec 1059747 27-Apr-2012 jisingh ---
2261 m.store = _WrkDtl.Store
2262 *=== TechRec 1059747 27-Apr-2012 jisingh ===
2263 Select TargetWhse
2264 Append Blank
2265 Gather Memvar Memo
2266 lnCnt = lnCnt + 1
2267 Replace dfkey With lnNewDtlPKey, ;
2268 hfkey With lnCurrentHeaderPkey
2269 Endscan
2270 Set Order To &lcOrder
2271 ENDIF
2272
2273 IF llFirstDetail
2274 lcSeek = Alltrim(Str(lnOldHdrPKey)) + "0"
2275 If SEEK(lcSeek, lcInterfaceWhse, "h_dfkey")
2276 lcOrder = SET("Order")
2277 SET ORDER TO TAG hfkey
2278 SCAN WHILE hfkey = lnOldHdrPKey And dfkey = 0
2279 SCATTER MEMVAR MEMO
2280 SELECT TargetWhse
2281 APPEND BLANK
2282 GATHER MEMVAR MEMO
2283 lnCnt = lnCnt + 1
2284 REPLACE dfkey WITH 0, ;
2285 hfkey WITH lnCurrentHeaderPkey
2286 ENDSCAN
2287 SET ORDER TO &lcOrder
2288 ENDIF
2289 ENDIF
2290 *llFirstDetail = False 1071666 FH moved below
2291 *=== TechRec 1054619 08-Jun-2011 MANI. ===
2292
2293 If lnCnt > 0
2294 m.PKey = v_NextPkey("ZZEIPOIWHSE", lnCnt) + 1
2295 Select TargetWhse
2296 For i = 1 To lnCnt
2297 Replace PKey With m.PKey - i
2298 Skip -1
2299 EndFor
2300 Endif
2301 ENDIF
2302 *=== TR 1044017 04-JAN-2010 HNISAR
2303 llFirstDetail = False && 1071666 FH
2304 Endif
2305 *=== TechRec 1005163 14-May-2004 GS ===
2306 Endscan
2307
2308 * replace ord_qty for current order header
2309 *IF lnOrd_qty > 0
2310 * REPLACE ord_qty WITH lnOrd_qty IN TargetWH
2311 *ENDIF
2312
2313 * Delete Template order
2314
2315 lnCurrentDoc_num=Val(lcCurrentDoc_num)
2316
2317 * --- TR 1022896 NSD 2007-05-10
2318 * Using SCAN/DELETE WHILE. Turns from hours to seconds for large record sets.
2319 *Delete For doc_num=lnCurrentDoc_num In (tcInterfaceHeader)
2320 Select (tcInterfaceHeader)
2321 If Seek(lnCurrentDoc_num,tcInterfaceHeader,"doc_num")
2322 lcOrder = Set("Order")
2323 Set Order To doc_num
2324 Delete While doc_num = lnCurrentDoc_num
2325 lcOrder = Set("Order")
2326 Endif
2327
2328 *Delete For doc_num=lnCurrentDoc_num In (tcInterfaceDetail)
2329 Select (tcInterfaceDetail)
2330 If Seek(lnCurrentDoc_num,tcInterfaceDetail,"doc_num")
2331 lcOrder = Set("Order")
2332 Set Order To doc_num
2333 Delete While doc_num = lnCurrentDoc_num
2334 lcOrder = Set("Order")
2335 Endif
2336
2337 *Delete For doc_num=lnCurrentDoc_num In (tcInterfaceComment)
2338 Select (tcInterfaceComment)
2339 If Seek(lnCurrentDoc_num,tcInterfaceComment,"doc_num")
2340 lcOrder = Set("Order")
2341 Set Order To doc_num
2342 Delete While doc_num = lnCurrentDoc_num
2343 lcOrder = Set("Order")
2344 Endif
2345
2346 *--- TR 1088047 31-8-2015 VKK
2347 IF llHDR2
2348 Select (tcInterfaceHDR2)
2349 If Seek(lnCurrentDoc_num,tcInterfaceHDR2,"doc_num")
2350 lcOrder = Set("Order")
2351 Set Order To doc_num
2352 Delete While doc_num = lnCurrentDoc_num
2353 lcOrder = Set("Order")
2354 ENDIF
2355 ENDIF
2356 *=== TR 1088047 31-8-2015 VKK
2357
2358 *Delete For doc_num=lnCurrentDoc_num In (tcInterfaceAddress)
2359 Select (tcInterfaceAddress) && 1073523 FH
2360 If Seek(lnCurrentDoc_num,tcInterfaceAddress,"doc_num") && 1073523 FH
2361 lcOrder = Set("Order")
2362 Set Order To doc_num
2363 Delete While doc_num = lnCurrentDoc_num
2364 lcOrder = Set("Order")
2365 Endif
2366 * === TR 1022896 NSD 2007-05-10
2367
2368
2369 *--- TechRec 1005163 19-May-2004 GS ---
2370 *-- this is strange... If one DOC detail has SDQ(Stores) and another does not -- the "another" one will be deleted!
2371 *-- I follow the same logic for SLN's
2372 *- 1005734 07/07/04 YIK
2373 *- Added IF
2374 If llSLN
2375 * --- TR 1022896 NSD 2007-05-10
2376 * Using SCAN/DELETE WHILE. Turns from hours to seconds for large record sets.
2377 *delete for doc_num=lnCurrentDoc_num In (tcInterfaceSLN) &&SLN_Line = lcPO1_Line and Doc_Num = lcDoc_Num
2378 Select (tcInterfaceSLN)
2379 If Seek(lnCurrentDoc_num,tcInterfaceSLN,"doc_num")
2380 lcOrder = Set("Order")
2381 Set Order To Doc_Num
2382 Delete While Doc_Num = lnCurrentDoc_num
2383 set order to &lcOrder
2384 Endif
2385 * === TR 1022896 NSD 2007-05-10
2386 Endif
2387 *= 1005734
2388
2389 *--- TechReq 1028745 31-Jan-2008 GSternik ---
2390 If llExt
2391 Select (lcInterfaceExtd)
2392 If Seek(lnCurrentDoc_Num, lcInterfaceExtd, "Doc_Num")
2393 lcOrder = Set("Order")
2394 set order to Doc_Num
2395 Delete While Doc_Num = lnCurrentDoc_num
2396 set order to &lcOrder
2397 Endif
2398 Endif
2399
2400 If llChrg
2401 Select(lcInterfaceChrgD)
2402 If Seek(lnCurrentDoc_Num, lcInterfaceChrgD, "Doc_Num")
2403 lcOrder = Set("Order")
2404 set order to Doc_Num
2405 Delete While Doc_Num = lnCurrentDoc_num
2406 set order to &lcOrder
2407 EndIf
2408 EndIf
2409 *=== TechRec 1028745 05-Feb-2008 GSternik ===
2410
2411 * --- TR 1018184 RLN 12/14/06
2412 If llSAC
2413
2414 * --- TR 1022896 NSD 2007-05-10
2415 * Using SCAN/DELETE WHILE. Turns from hours to seconds for large record sets.
2416 *DELETE FOR doc_num=lnCurrentDoc_num IN (tcInterfaceSAC) &&SAC_Line = lcPO1_Line and Doc_Num = lcDoc_Num
2417 Select (tcInterfaceSAC)
2418 If Seek(lnCurrentDoc_num,tcInterfaceSAC,"doc_num")
2419 lcOrder = Set("Order")
2420 Set Order To doc_num
2421 Delete While doc_num = lnCurrentDoc_num
2422 set order to &lcOrder
2423 Endif
2424 * === TR 1022896 NSD 2007-05-10
2425
2426 Endif
2427 * === TR 1018184
2428
2429 *--- TR 1044017 04-JAN-2010 HNISAR
2430 If llWhsData
2431 Select (lcInterfaceWhse )
2432 If Seek(lnCurrentDoc_num,lcInterfaceWhse ,"doc_num")
2433 lcOrder = Set("Order")
2434 Set Order To doc_num
2435 Delete While doc_num = lnCurrentDoc_num
2436 set order to &lcOrder
2437 Endif
2438
2439 ENDIF
2440 *=== TR 1044017 04-JAN-2010 HNISAR
2441
2442 *=== TechRec 1005163 19-May-2004 GS ===
2443 Endscan && all doc_num,store,upc,sku
2444
2445 * Append all exploded orders into Interfact tables
2446 Select TargetWH
2447 lcDBFName = Dbf()
2448 Select (tcInterfaceHeader)
2449 Append From (lcDBFName)
2450 Select TargetWD
2451 lcDBFName = Dbf()
2452 Select (tcInterfaceDetail)
2453 Append From (lcDBFName)
2454 Select TargetWC
2455 lcDBFName = Dbf()
2456 Select (tcInterfaceComment)
2457 Append From (lcDBFName)
2458
2459 *--- TR 1088047 31-8-2015 VKK
2460 IF llHDR2
2461 Select TargetWH2
2462 lcDBFName = Dbf()
2463 Select (tcInterfaceHDR2)
2464 Append From (lcDBFName)
2465 ENDIF
2466 *=== TR 1088047 31-8-2015 VKK
2467
2468 Select TargetWA
2469 lcDBFName = Dbf()
2470 Select (tcInterfaceAddress)
2471 Append From (lcDBFName)
2472 *--- TechRec 1005163 14-May-2004 GS ---
2473 If llSLN
2474 Select (tcInterfaceSLN)
2475 Append From Dbf("TargetSLN")
2476 Endif
2477 *=== TechRec 1005163 14-May-2004 GS ===
2478 *--- TechReq 1028745 31-Jan-2008 GSternik ---
2479 If llExt
2480 Select (lcInterfaceExtd)
2481 Append from Dbf("TargetExtd")
2482 EndIf
2483
2484 If llChrg
2485 Select (lcInterfaceChrgD)
2486 Append from Dbf("TargetChrg")
2487 EndIf
2488 *=== TechRec 1028745 05-Feb-2008 GSternik ===
2489
2490 * --- TR 1018184 RLN 12/14/06
2491 If llSAC
2492 Select (tcInterfaceSAC)
2493 Append From (Dbf("TargetSAC"))
2494 Endif
2495
2496 *--- TR 1044017 04-JAN-2010 HNISAR
2497 If llWhsData
2498 Select (lcInterfaceWhse)
2499 Append From (Dbf("TargetWhse"))
2500 ENDIF
2501 *=== TR 1044017 04-JAN-2010 HNISAR
2502
2503 * === TR 1018184
2504 * PL ATS 06/01/00 4067 - EDI- 850 get wrong End Date/Priority date in some condition
2505 * clearout ALL MEMVAR by all previous scatter
2506 Select _WrkHdr
2507 Scatter Memvar Memo Blank
2508 Select _WrkDtl
2509 Scatter Memvar Memo Blank
2510 Select _WrkCmt
2511 Scatter Memvar Memo Blank
2512 Select _WrkAdr
2513 Scatter Memvar Memo Blank
2514
2515 * cleanup temp tables
2516 *-- TR 1044017 04-JAN-2010 HNISAR Changed Ubound from 12 to 13
2517 Local laTables[13]
2518 laTables[1] = "TargetWH"
2519 laTables[2] = "TargetWD"
2520 laTables[3] = "TargetWC"
2521 laTables[4] = "TargetWA"
2522 laTables[5] = "_WrkHdr"
2523 laTables[6] = "_WrkDtl"
2524 laTables[7] = "_WrkCmt"
2525 laTables[8] = "_WrkAdr"
2526 laTables[9] = "TargetSLN" &&*--- TechRec 1005163 14-May-2004 GS ---
2527 laTables[10]= "TargetExtd" &&*--- TechReq 1028745 31-Jan-2008 GSternik ---
2528 laTables[11]= "TargetChrg" &&*--- TechReq 1028745 31-Jan-2008 GSternik ---
2529 laTables[12]= "TargetSAC" &&*--- TechReq 1028745 31-Jan-2008 GSternik --- Left by 1018184
2530 laTables[13]= "TargetWhse" &&*--- TR 1044017 04-JAN-2010 HNISAR
2531 .TableClose(@laTables)
2532 Endwith
2533
2534 *-FH 1087774
2535 SET DATE TO (lcOldDateFormat)
2536 *-FH 1087774
2537
2538 Select (lnOldSele)
2539 Return llRetVal
2540 Endproc
2541
2542 ************************************************************************************
2543 * UnloadToFlatFile
2544 * in zzemData: process="ALL", template="VENDOR", fields:vnd_id,vnd_tran,vnd_vers
2545 * will apply to all outbound creation
2546 * need VND,vnd_id,vnd_tran,vnd_vers for Gentran to map to Import System Template
2547 * so that it could find Translation Mapping Objects for the data that follow.
2548 ***********************************************************************************
2549 Procedure UnLoadToFlatFile
2550 Lparameters tcProcess, tcFlatFile, tcInterfaceHeader, tcInterfaceDetail, ;
2551 tcInterfaceComment, tcInterfaceAddress
2552 Local llRetVal, lcSqlString
2553 llRetVal= .F.
2554 With This
2555 * get Metadata for vendor table
2556 If .GetTranslationDefinition(EDI_ALL_TRANSACTION, "tcEmVend")
2557 * get Metadata for a process
2558 If .GetTranslationDefinition(tcProcess, "tcEmData")
2559 * Create Metadata work tables
2560 .CreateMetaDataWorkTable("tcEmVend", "VENDOR", "tciPOmwV")
2561 .CreateMetaDataWorkTable("tcEmData", "HEADER", "tciPOmwH")
2562 .CreateMetaDataWorkTable("tcEmData", "DETAIL", "tciPOmwD")
2563 .CreateMetaDataWorkTable("tcEmData", "COMMENT", "tciPOmwC")
2564 .CreateMetaDataWorkTable("tcEmData", "ADDRESS", "tciPOmwA")
2565 * Open Flatfile and append to it
2566
2567 * remove previous tmp text file
2568 *lcTempFlatfile= tcFlatFile+ ".tmp"
2569 lcTempFlatfile= Strtran(Upper(tcFlatFile), ".DAT", ".TMP")
2570 Delete File (lcTempFlatfile)
2571
2572 lnHandle= .OpenFlatFile(lcTempFlatfile, true)
2573 If lnHandle> 0
2574 * Populate data to metadata work tables from interface tables
2575 .ScatterGather(tcInterfaceHeader, "tciPOmwH")
2576 .ScatterGather(tcInterfaceDetail, "tciPOmwD")
2577 .ScatterGather(tcInterfaceComment, "tciPOmwC")
2578 .ScatterGather(tcInterfaceAddress, "tciPOmwA")
2579 * Mash/group all records to a single flatfile
2580 * If get here will return true if successfully create flatfile
2581 llRetVal= .CreateFlatfileFromMetadataWorkTalbes(tcProcess, "tciPOmwV",;
2582 "tciPOmwH", "tciPOmwD", "tciPOmwC", "tciPOmwA", lnHandle) &&
2583 Fclose(lnHandle)
2584 * append to 810.dat form 810.dat.tmp
2585 If llRetVal
2586 *llRetVal=.CopyToFlatFile(lcTempFlatfile, tcFlatFile)
2587 * use 64K block append to .dat file from .tmp instead of
2588 * line by line append with CopytoFlatFile
2589 llRetVal=.CopyToFlatFileInBlock(lcTempFlatfile, tcFlatFile)
2590 Endif
2591 Endif
2592 Endif
2593 Endif
2594 Endwith
2595 * remove previous tmp text file
2596 *lcTempFlatfile= tcFlatfile+ ".tmp"
2597 *delete file (lcTempFlatfile)
2598 Return llRetVal
2599 Endproc
2600
2601 *>>>>> END Load/Unload From/To Flatfile <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
2602
2603 ************************************************************************************
2604 * Put all header on hold (auto_proc="N"), set errs_flg_H="Y" and errs_msg_H will be
2605 * "Control Flag set to Not Automaticly Process into Live table"
2606 ************************************************************************************
2607 Procedure HoldAllNoneAutoProcHeader
2608 Lparameters tcEiPOth, tcProcess, tlNotWriteErrorFlag
2609 Local llRetVal, lnOldSelect, lcPreviousCustomer, lcPreviousDivision, lcAuto_proc
2610 llRetVal = .T.
2611 lnOldSelect = Select()
2612
2613 * ONLY no error headers and try to hold them if nessesary
2614 Select Pkey,division,customer,auto_proc From (tcEiPOth) Where Empty(Errs_Msg_H) ;
2615 Order By customer,division Into Cursor tcGoodOrders
2616 Select tcGoodOrders
2617
2618 If This.lUserInterface
2619 This.InitThermo(Recc('tcGoodOrders'))
2620 l_nThermoCnt = 0
2621 Endif
2622 lcPreviousCustomer=""
2623 lcPreviousDivision=""
2624 lcAuto_proc=""
2625 Scan
2626 If This.lUserInterface
2627 l_nThermoCnt = l_nThermoCnt + 1
2628 This.AdvanceThermo(l_nThermoCnt)
2629 Endif
2630
2631 * ONLY look to zzeipocr if customer or division change
2632 If !(customer == lcPreviousCustomer And division == lcPreviousDivision)
2633 lcPreviousCustomer= customer
2634 lcPreviousDivision= division
2635 * Format vl_ call to proper control base on transaction (oIN, oSH...)
2636 * ie. for outbound 810: llRetVal= vl_iPOcr(Customer, "", "__Ecntrc", Division))
2637 * PL 01/07/00 ATS 3415- VFP6- EDI CreateFlatfileFromMetadataWorkTalbes crash with Syntax error
2638 lcMac= [vl_] + tcProcess + "cr" + [(Customer, "", "__Ecntrc", Division)]
2639 &lcMac
2640 If Used('__Ecntrc')
2641 lcAuto_proc= __Ecntrc.auto_proc
2642 Use In __Ecntrc
2643 Else
2644 lcAuto_proc= ""
2645 Endif
2646 Endif
2647
2648 * Locate for good header and hold it if !(auto_proc=="Y")
2649 Select (tcEiPOth)
2650 Locate For Pkey = tcGoodOrders.Pkey
2651 If Found()
2652 If (Empty(tcGoodOrders.auto_proc) And !(lcAuto_proc = "Y")) ; && 1st time use control
2653 Or tcGoodOrders.auto_proc="N" && still hold orders until goto Trans-UI and change to "Y"
2654 Replace Errs_Msg_H With Errs_Msg_H + EDI_AUTOPROCESS_MSG + CRLF, auto_proc With "N" In (tcEiPOth) && stamp with "N" for 1st time
2655 * Default is to record error msg to header (in 850)
2656 If Not tlNotWriteErrorFlag
2657 Replace Errs_flg_H With "Y" In (tcEiPOth)
2658 Endif
2659 Else
2660 * Stamp with "Y" for 1st time comparing with control ref
2661 If Empty(tcGoodOrders.auto_proc)
2662 Replace auto_proc With "Y" In (tcEiPOth)
2663 Endif
2664 Endif
2665 Endif
2666 Endscan
2667 Use In tcGoodOrders
2668
2669 If This.lUserInterface
2670 This.ResetThermo()
2671 Endif
2672 Select(lnOldSelect)
2673 Return llRetVal
2674 Endproc
2675
2676 Procedure InitThermoPlus
2677 Parameters pnMaxThermoCount
2678 If This.lUserInterface
2679 This.InitThermo(pnMaxThermoCount)
2680 Endif
2681 Endproc
2682
2683 Procedure AdvanceThermoPlus
2684 Parameters pnThermoCnt
2685 If This.lUserInterface
2686 pnThermoCnt= pnThermoCnt + 1
2687 This.AdvanceThermo(pnThermoCnt)
2688 Endif
2689 Endproc
2690
2691 Procedure ResetThermoPlus
2692 If This.lUserInterface
2693 This.ResetThermo()
2694 Endif
2695 Endproc
2696
2697 Procedure InitThermoWithCaption
2698 Parameters pnThermoCnt, pnMaxThermoCnt, pcCaption
2699 If This.lUserInterface
2700 This.UpdateThermoCaption(pcCaption)
2701 This.InitThermo(pnMaxThermoCnt)
2702 pnThermoCnt = 0
2703 Endif
2704 Endproc
2705
2706 Procedure AdvanceThermoTotalWithCaptionPlus
2707 Parameters pcCaption, pcLogFile
2708 If This.lUserInterface
2709 .AdvanceThermoTotal(1)
2710 .UpdateThermoCaption(pcCaption)
2711 Endif
2712 If !Empty(pcLogFile)
2713 UdateLog(pcLogFile, pcCaption)
2714 Endif
2715 Endproc
2716
2717 Procedure ResetFrmProgressBar
2718 If This.lUserInterface
2719 This.m_close()
2720 Endif
2721 Endproc
2722
2723 Procedure CreateFrmProgressBar
2724 Parameters pnTotalThermoCnt, pcCaptionInit, pcCaptionTotal
2725 With This
2726 .CreateFormProgressBar(!.lUserInterface)
2727 .UpdateThermoCaption(pcCaptionInit)
2728 Inkey(.1, "H") && need some delay for activex object create 1st time
2729 .InitProgressBarTotal(pnTotalThermoCnt, pcCaptionTotal)
2730 Endwith
2731 Endproc
2732
2733 ************************************************************************************
2734 *
2735 ***********************************************************************************
2736 Procedure UseIPOHistoryHeaderFields
2737 Parameter tcCustomer, tcOrd_num, tcTargetTable
2738 Local llRetVal
2739 llRetVal= .T.
2740 * locate 850 history header when keys contain is change
2741 If !(Used("__iPOhh") And (tcCustomer=__iPOhh.customer And tcOrd_num= __iPOhh.ord_num))
2742 llRetVal= This.GetiPOHistoryHeader(tcCustomer, tcOrd_num, "__iPOhh")
2743 Endif
2744 * replace target header if additional fields that we don't store in live header
2745 If llRetVal And Used("__iPOhh")
2746 Replace promotion With __iPOhh.promotion, appointment With __iPOhh.appointment, ;
2747 batch_num With __iPOhh.batch_num, fob_code With __iPOhh.fob_code, ;
2748 duns_num With __iPOhh.duns_num, remit_num With __iPOhh.remit_num, ;
2749 po_purp With __iPOhh.po_purp, po_type With __iPOhh.po_type, ;
2750 po_date With __iPOhh.po_date, doc_num With __iPOhh.doc_num ;
2751 EDI_Store With __iPOhh.EDI_Store, edi_center With __iPOhh.edi_center ;
2752 In (tcTargetTable)
2753 Endif
2754 * Force return TRUE, it is ok not to find any 850 history header
2755 llRetVal= .T.
2756 Return llRetVal
2757 Endproc
2758
2759 ************************************************************************************
2760 * Notes: tcUPC (upc+chk_digit)
2761 ***********************************************************************************
2762 * PL Remove Bin_num off this function. This will ONLY get call in Outbound process
2763 * like 810, 856 to merge fields we don't store in live order table that come in
2764 * in 850 and endup in history detail (--Related topic will be UseIPOHistoryHeaderFields)
2765 *
2766 Procedure UseIPOHistoryDetailFields
2767 Parameter tcOrd_num, tcUPC, tcSKU, tcTargetTable
2768 Local llRetVal
2769 llRetVal= .T.
2770 * locate 850 history detail when keys contain is change
2771 If !(Used("__iPOhh") And (tcOrd_num=__iPOhd.ord_num And tcUPC= __iPOhd.upc And ;
2772 tcSKU= __iPOhd.sku))
2773 llRetVal= This.GetiPOHistoryDetail(tcOrd_num, tcUPC , tcSKU, "__iPOhd")
2774 Endif
2775 * replace target detail if additional fields that we don't store in live header
2776 If llRetVal And Used("__iPOhd")
2777 Replace po1_SKU With __iPOhd.po1_SKU, po1_UPC With __iPOhd.po1_UPC, ;
2778 po401 With __iPOhd.po401, po402 With __iPOhd.po402, po403 With __iPOhd.po403,;
2779 ib_uom With __iPOhd.ib_uom In (tcTargetTable)
2780 Endif
2781 * Force return TRUE, it is ok not to find any 850 history header
2782 llRetVal= .T.
2783 Return llRetVal
2784 Endproc
2785
2786 ************************************************************************************
2787 * UnLock process
2788 ***********************************************************************************
2789 Procedure UnLockProcess
2790 Parameter tcProcess
2791 Local llRetVal, lcSyslockTablePath
2792 lcSyslockTablePath = Addbs(goEnv.envLoginTablePath.Value)
2793 llRetVal= v_SysUnLock( lcSyslockTablePath+"SYSLOCK", tcProcess, goEnv.EnvLogin.cCompany)
2794 Return llRetVal
2795 Endproc
2796
2797 ************************************************************************************
2798 * Lock process
2799 ***********************************************************************************
2800 Procedure LockProcess
2801 Parameter tcProcess
2802 Local llRetVal, lcSyslockTablePath
2803 lcSyslockTablePath = Addbs(goEnv.envLoginTablePath.Value)
2804 llRetVal= v_SysLock(lcSyslockTablePath+"SYSLOCK", tcProcess, goEnv.EnvLogin.cCompany)
2805 Return llRetVal
2806 Endproc
2807
2808 ************************************************************************************
2809 * Create Vertical addresses
2810 ************************************************************************************
2811 * 4911- Laf148 EDI 810(o) Factor process support CIT
2812 * Add Billto,Shipto AccessNum
2813 * TAN 27142- pcAddressTag - add 5th parameter to access proper bcsysnum sy_table, sy_number
2814 * TAN 31010 YIK 3/7/02 - add 6th parameter
2815 *- 1008687 12/30/04 YIK - added 7th parameter
2816 * --- TR 1038493 2/19/09 CM - added 8th parameter pcDivisionAccessNum
2817 Procedure CreateVerticalAddress
2818 Parameters pcHorizontalAddress, pcInterAddress, pcBillToAccessNum, pcShipToAccessNum, ;
2819 pcAddressTag, pcShipFromAccessNum, pcRemitToAccessNum, pcDivisionAccessNum ,pcAddrType && 1008687 12/30/04 YIK
2820 &&--- TechRec 1044701 10-Feb-2010 vkrishnamurthy === Added param pcAddrType
2821
2822 Local llOKtoContinue, lnOldSelect
2823 llOKtoContinue = .F.
2824 pcAddressTag= Iif(Empty(pcAddressTag), "ZZEOSHIA" , Upper(pcAddressTag))
2825 lnOldSelect = Select()
2826 With This
2827 If Recc(pcHorizontalAddress)>0
2828 *- 1000903 10/07/03 YIK
2829 lcOneTime = goEnv.SV("EDI_ADDRESS_TYPE_ONETIME", "OT")
2830 *=
2831 * "BT"- Billto address
2832 If .CreateAddress(pcAddressTag, EDI_ADDRESS_TYPE_BILLTO, pcHorizontalAddress, pcInterAddress, ;
2833 pcBillToAccessNum,,,,pcAddrType)
2834 &&--- TechRec 1044701 10-Feb-2010 vkrishnamurthy === Added pcAddrType
2835 * "ST"- Billto address
2836 If .CreateAddress(pcAddressTag, EDI_ADDRESS_TYPE_SHIPTO, pcHorizontalAddress, pcInterAddress, ;
2837 , pcShipToAccessNum,,,pcAddrType )
2838 &&--- TechRec 1044701 10-Feb-2010 vkrishnamurthy === Added pcAddrType
2839 * "MR"- MarkFor address
2840 If .CreateAddress(pcAddressTag, EDI_ADDRESS_TYPE_MARKFOR, pcHorizontalAddress, pcInterAddress,,,,,pcAddrType )
2841 &&--- TechRec 1044701 10-Feb-2010 vkrishnamurthy === Added pcAddrType
2842 * "RE"- RemitTo address
2843 *- 1008687 12/30/04 YIK Add AccessNum
2844 If .CreateAddress(pcAddressTag, EDI_ADDRESS_TYPE_REMITTO, pcHorizontalAddress, pcInterAddress, ;
2845 ,,pcRemitToAccessNum,,pcAddrType )
2846 &&--- TechRec 1044701 10-Feb-2010 vkrishnamurthy === Added pcAddrType
2847 * "SF"- ShipFrom address
2848 *- 3/7/02 YIK TAN 31010
2849 *- Add pcShipFromAccessNum
2850 If .CreateAddress(pcAddressTag, EDI_ADDRESS_TYPE_SHIPFROM , pcHorizontalAddress, pcInterAddress, ;
2851 ,,pcShipFromAccessNum,,pcAddrType )
2852 &&--- TechRec 1044701 10-Feb-2010 vkrishnamurthy === Added pcAddrType
2853 *- 1000903 10/07/03 YIK
2854 *- Add onetime address
2855 If .CreateAddress(pcAddressTag, lcOneTime, pcHorizontalAddress, pcInterAddress,,,,,pcAddrType )
2856 &&--- TechRec 1044701 10-Feb-2010 vkrishnamurthy === Aded pcAddrType
2857 *- 1009880 03/30/05 YIK
2858 *- Add division (seller) address
2859 * --- TR 1038493 2/19/09 Added pcDivisionAccessNum
2860 If .CreateAddress(pcAddressTag, "DV", pcHorizontalAddress, pcInterAddress, ;
2861 ,,,pcDivisionAccessNum,pcAddrType )
2862 &&--- TechRec 1044701 10-Feb-2010 vkrishnamurthy === Added pcAddrType
2863 llOKtoContinue = .T.
2864 Endif
2865 *=
2866 Endif
2867 *=
2868 Endif
2869 Endif
2870 Endif
2871 Endif
2872 Endif
2873 Endif
2874 Endwith
2875 Select(lnOldSelect)
2876 Return llOKtoContinue
2877 Endproc
2878
2879
2880 ************************************************************************************
2881 * Create address like BT,ST,MR,RE,SF record base on passing parameters
2882 ************************************************************************************
2883 * 4911- Laf148 EDI 810(o) Factor process support CIT
2884 * Add Billto,Shipto AccessNum
2885 * --- TR 1038493 2/19/09 CM --- Added pcDivisionAccessNum as 8th parameter(Division AccessNum)
2886 Procedure CreateAddress
2887 Parameter pcPkeyTag, pcAddressType, pcHorizontalAddress, pcInterAddress, ;
2888 pcBillToAccessNum, pcShipToAccessNum, pcShipFromAccessNum, pcDivisionAccessNum,pcAddrType
2889 &&--- TechRec 1044701 10-Feb-2010 vkrishnamurthy === added Param pcAddrType
2890 Local lcMac, llOKtoContinue, lcPkey, lcOneTime
2891 llOKtoContinue= .T.
2892
2893 *--- TechRec 1044701 10-Feb-2010 vkrishnamurthy ---
2894 LOCAL loAddr
2895 *=== TechRec 1044701 10-Feb-2010 vkrishnamurthy ===
2896
2897 lcPrefix= "&pcHorizontalAddress.."
2898 *- 1000903 10/07/03 YIK
2899 lcOneTime = goEnv.SV("EDI_ADDRESS_TYPE_ONETIME", "OT")
2900 Do Case
2901 Case pcAddressType= EDI_ADDRESS_TYPE_BILLTO
2902 lcPrefix= lcPrefix+ "B_"
2903 Case pcAddressType= EDI_ADDRESS_TYPE_SHIPTO
2904 lcPrefix= lcPrefix+ "S_"
2905 Case pcAddressType= EDI_ADDRESS_TYPE_MARKFOR
2906 lcPrefix= lcPrefix+ "M_"
2907 Case pcAddressType= EDI_ADDRESS_TYPE_REMITTO
2908 lcPrefix= lcPrefix+ "R_"
2909 Case pcAddressType= EDI_ADDRESS_TYPE_SHIPFROM
2910 lcPrefix= lcPrefix+ "L_"
2911 *- 1000903 10/07/03 YIK
2912 *- add one-time address. It doesn't have access#
2913 Case pcAddressType= lcOneTime
2914 lcPrefix= lcPrefix+ "O_"
2915 *=
2916 *- 1009880 03/30/05 YIK
2917 *- Add division (seller) address
2918 Case pcAddressType= "DV"
2919 lcPrefix= lcPrefix+ "D_"
2920 *==
2921
2922 *--- TR 1049272 26-Oct-2010 Goutam
2923 Case pcAddressType= "MU"
2924 lcPrefix= lcPrefix+ "L_"
2925 *=== TR 1049272 26-Oct-2010 Goutam
2926
2927 Other
2928 lcPrefix= ""
2929 Endcase
2930 * passing invalid address type, return with error
2931 If Empty(lcPrefix)
2932 llOKtoContinue= .F.
2933 Endif
2934
2935 If llOKtoContinue
2936 lcMac="Replace Addr_type with '"+ pcAddressType + "'," +;
2937 "cust_name with " + lcPrefix + "name, "+;
2938 "address1 with " + lcPrefix + "addr1, "+;
2939 "address2 with " + lcPrefix + "addr2, " +;
2940 "city with " + lcPrefix + "city, " +;
2941 "state with " + lcPrefix + "state, " +;
2942 "zipcode with " + lcPrefix + "zipcode, " +;
2943 "country with " + lcPrefix + "country, " +;
2944 "pkey with lcPkey In (pcInterAddress)"
2945
2946 *--- TR 1049272 26-Oct-2010 Goutam. Moved following code below
2947*!* *--- TechRec 1044701 10-Feb-2010 vkrishnamurthy ---
2948*!* IF NOT empty(pcAddrType) AND USED(pcAddrType)
2949*!* SELECT (pcAddrType)
2950*!*
2951*!* LOCATE FOR Addr_type == pcAddressType
2952*!*
2953*!* IF FOUND()
2954*!* SCATTER NAME loAddr
2955*!* Replace Unlocode WITH loAddr.Unlocode ,;
2956*!* email WITH loAddr.email ,;
2957*!* iso_code_char WITH loAddr.iso_code_char ,;
2958*!* iso_code_2 WITH loAddr.iso_code_2 ,;
2959*!* iso_code_num WITH loAddr.iso_code_num IN (pcInterAddress)
2960*!* ENDIF
2961*!*
2962*!* ENDIF
2963*!* *=== TechRec 1044701 10-Feb-2010 vkrishnamurthy ===
2964 *=== TR 1049272 26-Oct-2010 Goutam
2965
2966 lcPkey= v_NextPkey(pcPkeyTag)
2967 If !Empty(lcPkey)
2968 Select (pcInterAddress)
2969 Append Blank
2970 Gather Memvar Memo
2971 &lcMac
2972
2973 *--- TR 1049272 26-Oct-2010 Goutam. taken from above
2974 IF NOT empty(pcAddrType) AND USED(pcAddrType)
2975 SELECT (pcAddrType)
2976
2977 LOCATE FOR Addr_type == pcAddressType
2978
2979 IF FOUND()
2980 SCATTER NAME loAddr
2981 Replace Unlocode WITH loAddr.Unlocode ,;
2982 email WITH loAddr.email ,;
2983 iso_code_char WITH loAddr.iso_code_char ,;
2984 iso_code_2 WITH loAddr.iso_code_2 ,;
2985 iso_code_num WITH loAddr.iso_code_num IN (pcInterAddress)
2986 ENDIF
2987
2988 ENDIF
2989 *=== TR 1049272 26-Oct-2010 Goutam
2990
2991 * 4911- Laf148 EDI 810(o) Factor process support CIT
2992 * add AccessNumber to BillTo addresses
2993 Do Case
2994 Case pcAddressType= EDI_ADDRESS_TYPE_BILLTO And !Empty(pcBillToAccessNum)
2995 lcMac="Replace AccessNum with '"+ pcBillToAccessNum + "' In (pcInterAddress)"
2996 &lcMac
2997 Case pcAddressType= EDI_ADDRESS_TYPE_SHIPTO And !Empty(pcShipToAccessNum)
2998 lcMac="Replace AccessNum with '"+ pcShipToAccessNum + "' In (pcInterAddress)"
2999 &lcMac
3000 *- TAN 31010 YIK 3/7/02
3001 Case pcAddressType= EDI_ADDRESS_TYPE_SHIPFROM And !Empty(pcShipFromAccessNum)
3002 lcMac="Replace AccessNum with '"+ pcShipFromAccessNum + "' In (pcInterAddress)"
3003 &lcMac
3004 *- 1008687 12/30/04 YIK
3005 Case pcAddressType= EDI_ADDRESS_TYPE_REMITTO And !Empty(pcRemitToAccessNum)
3006 lcMac="Replace AccessNum with '"+ pcRemitToAccessNum + "' In (pcInterAddress)"
3007 &lcMac
3008 *=
3009
3010 * --- TR 1038493 2/19/09 CM
3011 Case pcAddressType= "DV" AND !EMPTY(pcDivisionAccessNum)
3012 lcMac="Replace AccessNum with '"+ pcDivisionAccessNum + "' In (pcInterAddress)"
3013 &lcMac
3014 * === TR 1038493 2/19/09 CM
3015
3016 *--- TR 1049272 26-Oct-2010 Goutam
3017 Case pcAddressType= "MU" And !Empty(pcShipFromAccessNum)
3018 lcMac="Replace AccessNum with '"+ pcShipFromAccessNum + "' In (pcInterAddress)"
3019 &lcMac
3020 *=== TR 1049272 26-Oct-2010 Goutam
3021
3022 Endcase
3023
3024 This.TimeStampDocument()
3025 Else
3026 llOKtoContinue= .F.
3027 Endif
3028 Endif
3029
3030 Return llOKtoContinue
3031 Endproc
3032
3033 ************************************************************************************
3034 * find customer using trading partner qual/id
3035 ************************************************************************************
3036 *--- TR 1023601 1-Mar-2007 Goutam
3037 *!* Procedure GetCustomerUsingTradingPartnerID
3038
3039 *!* *--- TR 1015768 3-MAR-2006 VKK pcVnd_Qual_Resolved, pcVnd_Id_Resolved
3040 *!* *--- TR 1017383 24-JUL-2006 Goutam. Added two parameters pcVnd_key, pcVnd_Key_Resolved in following the list.
3041 *!* *--- TR 1021957 1-Mar-2007 Goutam. Added four parameters pcOur_Id, pcOur_Id_Resolved, pcOur_Qual, ;
3042 *!* pcOur_Qual_Resolved in the following list.
3043 *!*
3044 *!* Parameter pcErrorMsg, pcVnd_qual, pcVnd_id, pcEDITransaction, plNoCheckForDivision, ;
3045 *!* pcVnd_Qual_Resolved, pcVnd_Id_Resolved, pcVnd_key, pcVnd_Key_Resolved, ;
3046 *!* pcOur_Id, pcOur_Id_Resolved, pcOur_Qual, pcOur_Qual_Resolved
3047 *!*
3048 *!* *- YIK 03/12/02 TAN 31113
3049 *!* *- Added parameter plNoCheckForDivision because division may not exist in BC Control table. Ex. 816
3050 *!* Local lcCustomer, lcSQLString, llRetVal, lcControl
3051 *!*
3052 *!* LOCAL lcVnd_key1, lcVnd_key2 &&--- TR 1017383 3-AUG-2006 Goutam
3053 *!*
3054 *!* *--- TR 1021957 1-Mar-2007 Goutam
3055 *!* LOCAL ll_5Key, ll_3Key, ll_2Key, lcOur_Id1, lcOur_Id2
3056 *!* LOCAL lnRank1, lnRank2
3057
3058 *!* pcOur_Id_Resolved = ""
3059 *!* pcOur_Qual_Resolved = ""
3060 *!*
3061 *!* ll_5Key = VARTYPE(pcVnd_key) = "C" AND VARTYPE(pcOur_Id) = "C"
3062 *!* ll_3Key = VARTYPE(pcVnd_key) = "C" AND VARTYPE(pcOur_Id) = "L"
3063 *!* ll_2Key = VARTYPE(pcVnd_key) = "L" AND VARTYPE(pcOur_Id) = "L"
3064 *!*
3065 *!* *=== TR 1021957 1-Mar-2007 Goutam
3066
3067 *!* *--- TR 1015768 3-MAR-2006 VKK
3068 *!* STORE "" TO lcCustomer, pcVnd_Qual_Resolved, pcVnd_id_Resolved
3069 *!* *=== TR 1015768 3-MAR-2006 VKK
3070 *!*
3071 *!* pcVnd_Key_Resolved = "" &&--- TR 1017383 24-JUL-2006 Goutam
3072 *!*
3073 *!* pcEDITransaction= iif(Empty(pcEDITransaction), "ipo", pcEDITransaction)
3074 *!* lcControl= "zze" + pcEDITransaction + "cr"
3075
3076 *!* * PL 08/01/00- 4226- EDI 850 Process doesn't check Active/Inactive flag on 850 Control Ref.
3077 *!* * if return more than one disctinct customer- error "Ambiquous Trading Partner Qualifier/ID."
3078 *!* *
3079 *!* * either get "Abiquous Trading Partner Qualifier/ID" or
3080 *!* * "Invalid Trading Partner Qualifier/ID." or return proper lcCustomer
3081 *!* *- YIK 12/21/01 26717 Add check for Active_ok, add division to the list of fields selected
3082 *!* *- otherwise only 1 record is ALWAYS returned.
3083 *!* *- lcSQLString = "Select distinct customer FROM " + lcControl + " Where vnd_qual='" + pcVnd_qual + ;
3084 *!* *- "' And vnd_id= '" + pcVnd_id + "'"
3085 *!* *- YIK 03/12/02 TAN 31113
3086 *!* *- don't check for division if plNoCheckForDivision is .T. because division may not exist in BC Control table. Ex. 816
3087 *!* *!* lcSQLString = "Select distinct customer, division FROM " + lcControl + " Where vnd_qual='" + pcVnd_qual + ;
3088 *!* *!* "' And vnd_id= '" + pcVnd_id + "' AND Active_Ok = 'Y'"
3089
3090 *!* *!* lcSQLString = "Select distinct customer" + IIF(plNoCheckForDivision, "", ", division") + ;
3091 *!* *!* " FROM " + lcControl + " Where vnd_qual='" + pcVnd_qual + "' And vnd_id= '" + pcVnd_id + "' AND Active_Ok = 'Y'"
3092
3093
3094 *!* *--- TR 1021957 1-Mar-2007 Goutam
3095 *!*
3096 *!* *!* *- TAN 28352 05/06/02 YIK
3097 *!* *!* *- Don't check for division. We return unique customer only.
3098
3099 *!* *!* IF VARTYPE(pcVnd_key) = "L" &&--- TR 1017383 24-JUL-2006 Goutam
3100 *!* *!* lcSQLString = "Select distinct customer FROM " + lcControl + " Where vnd_qual='" + pcVnd_qual + ;
3101 *!* *!* "' And vnd_id= '" + pcVnd_id + "' AND Active_Ok = 'Y'"
3102 *!* *!* *--- TR 1017383 24-JUL-2006 Goutam
3103 *!* *!* ELSE
3104 *!* *!* *--- TR 1021925 1/29/07 BR -- ADDED: order by customer, vnd_key desc
3105 *!* *!* lcSQLString = "Select distinct customer, vnd_key FROM " + lcControl + " Where vnd_qual = '" + pcVnd_qual + ;
3106 *!* *!* "' And vnd_id = '" + pcVnd_id + "' And (vnd_key = '" + pcVnd_key + "' OR vnd_key = ' ') AND Active_Ok = 'Y' order by customer, vnd_key desc"
3107 *!* *!* ENDIF
3108 *!* *!* *=== TR 1017383 24-JUL-2006 Goutam
3109
3110 *!* *!* *= YIK
3111 *!* *!* llRetVal= v_SQLexec(lcSQLString, "tcPartID")
3112
3113 *!* *!* * error trap for multiple internal CUSTOMER code sharing same TradingPartnerID
3114 *!* *!*
3115 *!* *!* *--- TR 1021957 1-Mar-2007 Goutam
3116
3117 *!* *!* IF VARTYPE(pcVnd_key) = "L" &&--- TR 1017383 3-AUG-2006 Goutam
3118 *!* *!* IF llRetVal and ( Used('tcPartID') and Recc('tcPartID')>1 )
3119 *!* *!* pcErrorMsg = pcErrorMsg + "Ambiquous Trading Partner Qualifier/ ID." + CRLF
3120 *!* *!* ENDIF
3121 *!* *!* *--- TR 1017383 3-AUG-2006 Goutam
3122 *!* *!* ELSE
3123 *!* *!* IF llRetVal AND (USED('tcPartID') AND RECCOUNT('tcPartID') > 2 )
3124 *!* *!* pcErrorMsg = pcErrorMsg + "Ambiquous Trading Partner Qualifier/ ID." + CRLF
3125 *!* *!* ENDIF
3126 *!* *!* IF llRetVal AND (USED('tcPartID') AND RECCOUNT('tcPartID') = 2 )
3127 *!* *!* GO TOP IN tcPartID
3128 *!* *!* lcVnd_key1 = tcPartID.vnd_key
3129 *!* *!* SKIP IN tcPartID
3130 *!* *!* lcVnd_key2 = tcPartID.vnd_key
3131 *!* *!* IF (lcVnd_key1 = lcVnd_key2)
3132 *!* *!* pcErrorMsg = pcErrorMsg + "Ambiquous Trading Partner Qualifier/ ID." + CRLF
3133 *!* *!* ENDIF
3134 *!* *!* IF NOT EMPTY(lcVnd_key1) AND EMPTY(lcVnd_key2)
3135 *!* *!* GO TOP IN tcPartID
3136 *!* *!* lcCustomer = tcPartID.customer
3137 *!* *!* ENDIF
3138 *!* *!* ENDIF
3139 *!* *!* ENDIF
3140 *!* *!* *=== TR 1017383 3-AUG-2006 Goutam
3141
3142 *!* IF ll_5Key
3143 *!* lcSQLString = "SELECT TOP 2 * FROM (" + ;
3144 *!* "Select distinct 1 Rank, customer FROM " + lcControl + ;
3145 *!* " Where vnd_qual = '" + pcVnd_qual + ;
3146 *!* "' AND vnd_id = '" + pcVnd_id + ;
3147 *!* "' AND our_qual = '" + pcOur_qual + ;
3148 *!* "' AND our_id = '" + pcOur_Id + ;
3149 *!* "' AND vnd_key = '" + pcVnd_key + ;
3150 *!* "' AND Active_Ok = 'Y' " + ;
3151 *!* " UNION " + ;
3152 *!* "Select distinct 2 Rank, customer FROM " + lcControl + ;
3153 *!* " Where vnd_qual = '" + pcVnd_qual + ;
3154 *!* "' AND vnd_id = '" + pcVnd_id + ;
3155 *!* "' AND our_qual = '" + pcOur_qual + ;
3156 *!* "' AND our_id = '" + pcOur_Id + ;
3157 *!* "' AND (vnd_key = '" + pcVnd_key + "' OR vnd_key = '') " + ;
3158 *!* " AND Active_Ok = 'Y' " + ;
3159 *!* " UNION " + ;
3160 *!* "Select distinct 3 Rank, customer FROM " + lcControl + ;
3161 *!* " Where vnd_qual = '" + pcVnd_qual + ;
3162 *!* "' AND vnd_id = '" + pcVnd_id + ;
3163 *!* "' AND our_qual = '" + pcOur_qual + ;
3164 *!* "' AND vnd_key = '" + pcVnd_key + ;
3165 *!* "' AND (our_id = '" + pcOur_Id + "' OR our_id = '') " + ;
3166 *!* " AND Active_Ok = 'Y' " + ;
3167 *!* " UNION " + ;
3168 *!* "Select distinct 4 Rank, customer FROM " + lcControl + ;
3169 *!* " Where vnd_qual = '" + pcVnd_qual + ;
3170 *!* "' AND vnd_id = '" + pcVnd_id + ;
3171 *!* "' AND our_id = '" + pcOur_Id + ;
3172 *!* "' AND vnd_key = '" + pcVnd_key + ;
3173 *!* "' AND (our_qual = '" + pcOur_qual + "' OR our_qual = '') " + ;
3174 *!* " AND Active_Ok = 'Y' " + ;
3175 *!* " UNION " + ;
3176 *!* "Select distinct 5 Rank, customer FROM " + lcControl + ;
3177 *!* " Where vnd_qual = '" + pcVnd_qual + ;
3178 *!* "' AND vnd_id = '" + pcVnd_id + ;
3179 *!* "' AND our_qual = '" + pcOur_qual + ;
3180 *!* "' AND (our_id = '" + pcOur_Id + "' OR our_id = '') " + ;
3181 *!* " AND (vnd_key = '" + pcVnd_key + "' OR vnd_key = '') " + ;
3182 *!* " AND Active_Ok = 'Y' " + ;
3183 *!* " UNION " + ;
3184 *!* "Select distinct 6 Rank, customer FROM " + lcControl + ;
3185 *!* " Where vnd_qual = '" + pcVnd_qual + ;
3186 *!* "' AND vnd_id = '" + pcVnd_id + ;
3187 *!* "' AND our_id = '" + pcOur_Id + ;
3188 *!* "' AND (our_qual = '" + pcOur_qual + "' OR our_qual = '') " + ;
3189 *!* " AND (vnd_key = '" + pcVnd_key + "' OR vnd_key = '') " + ;
3190 *!* " AND Active_Ok = 'Y'" + ;
3191 *!* " UNION " + ;
3192 *!* "Select distinct 7 Rank, customer FROM " + lcControl + ;
3193 *!* " Where vnd_qual = '" + pcVnd_qual + ;
3194 *!* "' AND vnd_id = '" + pcVnd_id + ;
3195 *!* "' AND vnd_key = '" + pcVnd_key + ;
3196 *!* "' AND (our_qual = '" + pcOur_qual + "' OR our_qual = '') " + ;
3197 *!* " AND (our_id = '" + pcOur_Id + "' OR our_id = '') " + ;
3198 *!* " AND Active_Ok = 'Y') t " + ;
3199 *!* " ORDER BY Rank ASC, Customer DESC"
3200
3201 *!* llRetVal= v_SQLexec(lcSQLString, "tcPartID")
3202 *!* ENDIF
3203 *!*
3204 *!* IF ll_3Key
3205 *!* lcSQLString = "Select distinct 1 Rank, customer FROM " + lcControl + ;
3206 *!* " Where vnd_qual = '" + pcVnd_qual + ;
3207 *!* "' AND vnd_id = '" + pcVnd_id + ;
3208 *!* "' AND vnd_key = '" + pcVnd_key + ;
3209 *!* "' AND Active_Ok = 'Y'" + ;
3210 *!* " UNION " + ;
3211 *!* "Select distinct 2 Rank, customer FROM " + lcControl + ;
3212 *!* " Where vnd_qual = '" + pcVnd_qual + ;
3213 *!* "' AND vnd_id = '" + pcVnd_id + ;
3214 *!* "' AND vnd_key = ' '" + ;
3215 *!* " AND Active_Ok = 'Y'"
3216
3217 *!* llRetVal= v_SQLexec(lcSQLString, "tcPartID")
3218
3219 *!* ENDIF
3220
3221 *!* IF ll_2Key
3222 *!* lcSQLString = "Select distinct 1 Rank, customer FROM " + lcControl + ;
3223 *!* " Where vnd_qual='" + pcVnd_qual + ;
3224 *!* "' AND vnd_id= '" + pcVnd_id + ;
3225 *!* "' AND Active_Ok = 'Y'"
3226 *!*
3227 *!* llRetVal= v_SQLexec(lcSQLString, "tcPartID")
3228
3229 *!* ENDIF
3230
3231 *!* IF (llRetVal AND USED('tcPartID') AND RECCOUNT('tcPartID') = 0)
3232 *!* pcErrorMsg = pcErrorMsg + "Invalid Trading partner Qualifier/ID." + CRLF
3233 *!* ENDIF
3234
3235 *!* IF (llRetVal AND USED('tcPartID') AND RECCOUNT('tcPartID') > 1)
3236 *!* GO TOP IN tcPartID
3237 *!* lnRank1 = tcPartID.Rank
3238 *!* SKIP IN tcPartID
3239 *!* lnRank2 = tcPartID.Rank
3240 *!* IF lnRank1 = lnRank2
3241 *!* pcErrorMsg = pcErrorMsg + "Ambiquous Trading Partner Qualifier/ ID." + CRLF
3242 *!* ELSE
3243 *!* GO TOP IN tcPartID
3244 *!* lcCustomer= tcPartID.customer
3245 *!* ENDIF
3246 *!* ENDIF
3247
3248 *!* *=== TR 1021957 1-Mar-2007 Goutam
3249 *!*
3250 *!* IF llRetVal and ( Used('tcPartID') and Recc('tcPartID')=1 )
3251 *!* lcCustomer= tcPartID.customer
3252 *!* ENDIF
3253 *!*
3254 *!* *--- TR 1015768 3-MAR-2006 VKK
3255 *!* * If cusomter cannot be resolved. Now try for further resolution only for Vitural show room
3256 *!* * Vend Qualfifier. Do this only if the last query has no record.
3257 *!* IF llRetVal AND USED("tcPartID") AND pcVnd_Qual = VITRUAL_SHOWROOM_VEND_QUALIFIER AND ;
3258 *!* EMPTY(lcCustomer)
3259 *!*
3260 *!* *--- TR 1021957 1-Mar-2007 Goutam
3261 *!*
3262 *!* *!* IF VARTYPE(pcVnd_key) = "L" &&--- TR 1017383 24-JUL-2006 Goutam
3263 *!* *!* lcSQLString = "SELECT customer, vnd_qual, vnd_id " + ;
3264 *!* *!* " FROM " + lcControl + ;
3265 *!* *!* " WHERE customer = " + SQLFormatChar(ALLTRIM(pcVnd_Id)) + ;
3266 *!* *!* " AND active_ok = 'Y'"
3267 *!* *!* *--- TR 1017383 24-JUL-2006 Goutam
3268 *!* *!* ELSE
3269 *!* *!* lcSQLString = "SELECT customer, vnd_qual, vnd_id, vnd_key " + ;
3270 *!* *!* " FROM " + lcControl + ;
3271 *!* *!* " WHERE customer = " + SQLFormatChar(ALLTRIM(pcVnd_Id)) + ;
3272 *!* *!* " AND active_ok = 'Y'"
3273 *!* *!* ENDIF
3274 *!* *!* *=== TR 1017383 24-JUL-2006 Goutam
3275
3276 *!* DO CASE
3277 *!* CASE ll_5Key
3278 *!* lcSQLString = "SELECT customer, vnd_qual, vnd_id, vnd_key, our_Id, our_Qual " + ;
3279 *!* " FROM " + lcControl + ;
3280 *!* " WHERE customer = " + SQLFormatChar(ALLTRIM(pcVnd_Id)) + ;
3281 *!* " AND active_ok = 'Y'"
3282 *!* CASE ll_3Key
3283 *!* lcSQLString = "SELECT customer, vnd_qual, vnd_id, vnd_key " + ;
3284 *!* " FROM " + lcControl + ;
3285 *!* " WHERE customer = " + SQLFormatChar(ALLTRIM(pcVnd_Id)) + ;
3286 *!* " AND active_ok = 'Y'"
3287 *!* CASE ll_2Key
3288 *!* lcSQLString = "SELECT customer, vnd_qual, vnd_id " + ;
3289 *!* " FROM " + lcControl + ;
3290 *!* " WHERE customer = " + SQLFormatChar(ALLTRIM(pcVnd_Id)) + ;
3291 *!* " AND active_ok = 'Y'"
3292 *!* ENDCASE
3293 *!* *=== TR 1021957 1-Mar-2007 Goutam
3294
3295 *!* llRetVal= v_SQLexec(lcSQLString, "tcPartID")
3296
3297 *!* IF llRetVal AND USED("tcPartID") AND RECCOUNT("tcPartID") > 0
3298 *!* lcCustomer = tcPartID.customer
3299 *!* pcVnd_Qual_Resolved = tcPartId.Vnd_Qual
3300 *!* pcVnd_Id_Resolved = tcPartId.Vnd_Id
3301 *!*
3302 *!* *--- TR 1017383 24-JUL-2006 Goutam
3303 *!* IF VARTYPE(pcVnd_key) = "C"
3304 *!* pcVnd_Key_Resolved = tcPartId.Vnd_key
3305 *!* ENDIF
3306 *!* *=== TR 1017383 24-JUL-2006 Goutam
3307 *!*
3308 *!* *--- TR 1021957 1-Mar-2007 Goutam
3309 *!* IF VARTYPE(pcOur_Id) = "C"
3310 *!* pcOur_Id_Resolved = tcPartId.pcOur_Id
3311 *!* pcOur_Qual_Resolved = tcPartId.pcOur_Qual
3312 *!* ENDIF
3313 *!* *=== TR 1021957 1-Mar-2007 Goutam
3314
3315 *!* ELSE
3316 *!* *--- TR 1017383 24-JUL-2006 Goutam
3317 *!* *STORE "" TO lcCustomer, pcVnd_Qual_Resolved, pcVnd_id_Resolved
3318 *!*
3319 *!* *--- TR 1021957 1-Mar-2007 Goutam
3320 *!* *STORE "" TO lcCustomer, pcVnd_Qual_Resolved, pcVnd_id_Resolved, pcVnd_key_Resolved
3321 *!* STORE "" TO lcCustomer, pcVnd_Qual_Resolved, pcVnd_id_Resolved, pcVnd_key_Resolved, ;
3322 *!* pcOur_Id_Resolved, pcOur_Qual_Resolved
3323 *!* *=== TR 1021957 1-Mar-2007 Goutam
3324 *!*
3325 *!* *=== TR 1017383 24-JUL-2006 Goutam
3326 *!*
3327 *!* ENDIF
3328 *!*
3329 *!* ENDIF
3330 *!* *=== TR 1015768 3-MAR-2006 VKK
3331 *!*
3332 *!* *--- TR 1021957 19-Mar-2007 Goutam. Commented following line from code for duplicate msg.
3333 *!* *pcErrorMsg = pcErrorMsg + IIF(Empty(lcCustomer), "Invalid Trading Partner Qualifier/ ID.", "")
3334 *!*
3335 *!* RETURN lcCustomer
3336 *!* EndProc
3337
3338 *!* ************************************************************************************
3339 *!* * Find/Validate customer (move from clsiPOpr) need to reuse in clsiPDpr
3340 *!* ************************************************************************************
3341 *!* * Abstract:
3342 *!* * 1. Select Distinct customer from work header.
3343 *!* * 2. Find customer using trading partner ID
3344 *!* ************************************************************************************
3345 *!* Procedure FindCustomerUsingTradingPartnerID
3346 *!* Lparameters pcEiPOth, pcEDITransaction
3347
3348 *!* *--- TR 1015768 3-MAR-2006 VKK Added lcVnd_Qual, lcVnd_Id
3349 *!* Local llRetVal, lnOldSelect, lcErrs_Msg, lcCustomer, lcVnd_Qual, lcVnd_Id
3350 *!* LOCAL lcVnd_key &&--- TR 1017383 24-JUL-2006 Goutam
3351 *!*
3352 *!* *--- TR 1021957 1-Mar-2007 Goutam
3353 *!* LOCAL lcOur_Qual, lcOur_Id, ll_5Key, ll_3Key, ll_2Key
3354 *!* *=== TR 1021957 1-Mar-2007 Goutam
3355
3356 *!* llRetVal = .T.
3357 *!* lnOldSelect = Select()
3358 *!*
3359 *!* *--- TR 1021957 1-Mar-2007 Goutam
3360
3361 *!* *!* *--- TR 1017383 24-JUL-2006 Goutam
3362 *!* *!* *Select Distinct vnd_qual, vnd_id From (pcEiPOth) Into Cursor VendList
3363 *!* *!* IF TYPE(pcEiPOth + ".vnd_key") = "C"
3364 *!* *!* Select Distinct vnd_qual, vnd_id, vnd_key From (pcEiPOth) Into Cursor VendList
3365 *!* *!* ELSE
3366 *!* *!* Select Distinct vnd_qual, vnd_id From (pcEiPOth) Into Cursor VendList
3367 *!* *!* ENDIF
3368 *!* *!* *=== TR 1017383 24-JUL-2006 Goutam
3369 *!*
3370 *!* ll_5Key = TYPE(pcEiPOth + ".vnd_key") = "C" AND TYPE(pcEiPOth + ".our_id") = "C"
3371
3372 *!* *--- TR 1023429 11-Mar-2007 Goutam
3373 *!* *l_3Key = TYPE(pcEiPOth + ".vnd_key") = "C" AND TYPE(pcEiPOth + ".our_id") = "L"
3374 *!* *l_2Key = TYPE(pcEiPOth + ".vnd_key") = "L" AND TYPE(pcEiPOth + ".our_id") = "L"
3375 *!* ll_3Key = TYPE(pcEiPOth + ".vnd_key") = "C" AND INLIST(TYPE(pcEiPOth + ".our_id"), "L", "U")
3376 *!* *=== TR 1023429 11-Mar-2007 Goutam
3377 *!*
3378 *!* DO CASE
3379 *!* CASE ll_5Key
3380 *!* Select Distinct vnd_qual, vnd_id, vnd_key, our_qual, our_id ;
3381 *!* From (pcEiPOth) ;
3382 *!* Into Cursor VendList
3383 *!* CASE ll_3Key
3384 *!* Select Distinct vnd_qual, vnd_id, vnd_key, .F. AS our_qual, .F. AS our_id ;
3385 *!* From (pcEiPOth) ;
3386 *!* Into Cursor VendList
3387 *!* OTHERWISE && Deleted CASE ll_2Key and added OTHERWISE TR 1023429 11-Mar-2007 Goutam
3388 *!* Select Distinct vnd_qual, vnd_id , .F. AS vnd_key, .F. AS our_qual, .F. AS our_id ;
3389 *!* From (pcEiPOth) ;
3390 *!* Into Cursor VendList
3391 *!* ENDCASE
3392 *!* *=== TR 1021957 1-Mar-2007 Goutam
3393 *!*
3394 *!* Select VendList
3395 *!* * Init Thermometer
3396 *!* If This.lUserInterface
3397 *!* This.UpdateThermoCaption("Resolving Customer code using Trading Partner Qualifier and ID...")
3398 *!* This.InitThermo(RECC('VendList'))
3399 *!* l_nThermoCnt = 0
3400 *!* Endif
3401 *!* Scan
3402 *!* If This.lUserInterface
3403 *!* l_nThermoCnt = l_nThermoCnt + 1
3404 *!* This.AdvanceThermo(l_nThermoCnt)
3405 *!* Endif
3406 *!* lcErrs_Msg = ""
3407 *!* *--- TR 1015768 3-MAR-2006 VKK
3408 *!* *lcCustomer = This.GetCustomerUsingTradingPartnerID(@lcErrs_Msg, VendList.vnd_qual, VendList.vnd_id, pcEDITransaction)
3409 *!* lcVnd_Qual = ""
3410 *!* lcVnd_Id = ""
3411 *!*
3412 *!* *--- TR 1017383 24-JUL-2006 Goutam
3413 *!* lcVnd_key = ""
3414 *!* *lcCustomer = This.GetCustomerUsingTradingPartnerID(@lcErrs_Msg, VendList.vnd_qual, VendList.vnd_id, ;
3415 *!* pcEDITransaction, false, @lcVnd_Qual, @lcVnd_Id)
3416
3417 *!* *--- TR 1021957 1-Mar-2007 Goutam
3418 *!* lcOur_Qual = ""
3419 *!* lcOur_Id = ""
3420 *!*
3421 *!* *!* IF TYPE(pcEiPOth + ".vnd_key") = "C"
3422 *!* *!* lcCustomer = This.GetCustomerUsingTradingPartnerID(@lcErrs_Msg, VendList.vnd_qual, VendList.vnd_id, ;
3423 *!* *!* pcEDITransaction, false, @lcVnd_Qual, @lcVnd_Id, VendList.vnd_key, @lcVnd_key)
3424 *!* *!* ELSE
3425 *!* *!* lcCustomer = This.GetCustomerUsingTradingPartnerID(@lcErrs_Msg, VendList.vnd_qual, VendList.vnd_id, ;
3426 *!* *!* pcEDITransaction, false, @lcVnd_Qual, @lcVnd_Id)
3427 *!* *!* ENDIF
3428
3429 *!* lcCustomer = This.GetCustomerUsingTradingPartnerID(@lcErrs_Msg, VendList.vnd_qual, VendList.vnd_id, ;
3430 *!* pcEDITransaction, false, @lcVnd_Qual, @lcVnd_Id, ;
3431 *!* VendList.vnd_key, @lcVnd_key, ;
3432 *!* VendList.our_id, @lcOur_Id, VendList.Our_Qual, @lcOur_Qual)
3433 *!* *=== TR 1021957 1-Mar-2007 Goutam
3434 *!*
3435 *!* *=== TR 1017383 24-JUL-2006 Goutam
3436 *!*
3437 *!* *=== TR 1015768 3-MAR-2006 VKK
3438 *!*
3439 *!* If Empty(lcCustomer)
3440 *!* *llRetVal = .F. && should still return true event when empty customer
3441 *!* lcErrs_Msg= lcErrs_Msg + CRLF
3442 *!*
3443 *!* *--- TR 1021957 1-Mar-2007 Goutam
3444 *!*
3445 *!* *!* IF TYPE(pcEiPOth + ".vnd_key") = "C" &&--- TR 1017383 24-JUL-2006 Goutam
3446 *!* *!* Replace Errs_Msg_H With Errs_Msg_H + lcErrs_Msg, Errs_flg_H With "Y" ;
3447 *!* *!* For vnd_qual = VendList.vnd_qual And vnd_id = VendList.vnd_id ;
3448 *!* *!* AND vnd_key = VendList.vnd_key ;
3449 *!* *!* In (pcEiPOth)
3450 *!* *!* *--- TR 1017383 24-JUL-2006 Goutam
3451 *!* *!* ELSE
3452 *!* *!* Replace Errs_Msg_H With Errs_Msg_H + lcErrs_Msg, Errs_flg_H With "Y" ;
3453 *!* *!* For vnd_qual= VendList.vnd_qual And vnd_id= VendList.vnd_id ;
3454 *!* *!* In (pcEiPOth)
3455 *!* *!* ENDIF
3456 *!* *!* *=== TR 1017383 24-JUL-2006 Goutam
3457
3458 *!* DO CASE
3459 *!* CASE ll_5Key
3460 *!* Replace Errs_Msg_H With Errs_Msg_H + lcErrs_Msg, Errs_flg_H With "Y" ;
3461 *!* For vnd_qual = VendList.vnd_qual AND vnd_id = VendList.vnd_id ;
3462 *!* AND our_qual = VendList.our_qual AND our_id = VendList.our_id ;
3463 *!* AND vnd_key = VendList.vnd_key ;
3464 *!* In (pcEiPOth)
3465 *!* CASE ll_3Key
3466 *!* Replace Errs_Msg_H With Errs_Msg_H + lcErrs_Msg, Errs_flg_H With "Y" ;
3467 *!* For vnd_qual = VendList.vnd_qual AND vnd_id = VendList.vnd_id ;
3468 *!* AND vnd_key = VendList.vnd_key ;
3469 *!* In (pcEiPOth)
3470 *!* OTHERWISE && Deleted CASE ll_2Key and added OTHERWISE TR 1023429 11-Mar-2007 Goutam
3471 *!* Replace Errs_Msg_H With Errs_Msg_H + lcErrs_Msg, Errs_flg_H With "Y" ;
3472 *!* For vnd_qual= VendList.vnd_qual AND vnd_id= VendList.vnd_id ;
3473 *!* In (pcEiPOth)
3474 *!* ENDCASE
3475 *!*
3476 *!* *=== TR 1021957 1-Mar-2007 Goutam
3477 *!*
3478 *!* Else
3479 *!* * replace all vnd_id/qual with same customer code that it return
3480
3481 *!* *--- TR 1021957 1-Mar-2007 Goutam
3482 *!*
3483 *!* *!* *--- TR 1015768 3-MAR-2006 VKK Replace vnd_Qual, Vnd_Id , customer with resolved values.
3484 *!* *!* *Replace customer With lcCustomer For vnd_qual= VendList.vnd_qual And vnd_id= VendList.vnd_id ;
3485 *!* *!* In (pcEiPOth)
3486 *!* *!* IF TYPE(pcEiPOth + ".vnd_key") = "C" &&--- TR 1017383 24-JUL-2006 Goutam
3487 *!* *!* Replace customer With lcCustomer, ;
3488 *!* *!* vnd_Qual WITH IIF(EMPTY(lcvnd_Qual), vnd_Qual, lcVnd_Qual), ;
3489 *!* *!* vnd_Id WITH IIF(EMPTY(lcvnd_Id), vnd_Id, lcVnd_Id), ;
3490 *!* *!* vnd_key WITH IIF(EMPTY(lcvnd_key), vnd_key, lcVnd_key) ;
3491 *!* *!* FOR vnd_qual = VendList.vnd_qual ;
3492 *!* *!* AND vnd_id = VendList.vnd_id ;
3493 *!* *!* AND vnd_key = VendList.vnd_key ;
3494 *!* *!* IN (pcEiPOth)
3495 *!* *!* *--- TR 1017383 24-JUL-2006 Goutam
3496 *!* *!* ELSE
3497 *!* *!* Replace customer With lcCustomer, ;
3498 *!* *!* vnd_Qual WITH IIF(EMPTY(lcvnd_Qual), vnd_Qual, lcVnd_Qual), ;
3499 *!* *!* vnd_Id WITH IIF(EMPTY(lcvnd_Id), vnd_Id, lcVnd_Id) ;
3500 *!* *!* FOR vnd_qual = VendList.vnd_qual ;
3501 *!* *!* AND vnd_id = VendList.vnd_id ;
3502 *!* *!* IN (pcEiPOth)
3503 *!* *!* ENDIF
3504 *!* *!*
3505 *!* *!* *===TR 1015768 3-MAR-2006 VKK
3506
3507 *!* DO CASE
3508 *!* CASE ll_5Key
3509 *!* Replace customer With lcCustomer, ;
3510 *!* vnd_Qual WITH IIF(EMPTY(lcvnd_Qual), vnd_Qual, lcVnd_Qual), ;
3511 *!* vnd_Id WITH IIF(EMPTY(lcvnd_Id), vnd_Id, lcVnd_Id), ;
3512 *!* vnd_key WITH IIF(EMPTY(lcvnd_key), vnd_key, lcVnd_key) ;
3513 *!* our_Qual WITH IIF(EMPTY(lcOur_Qual), our_Qual, lcOur_Qual), ;
3514 *!* our_Id WITH IIF(EMPTY(lcOur_Id), our_Id, lcOur_Id) ;
3515 *!* FOR vnd_qual = VendList.vnd_qual ;
3516 *!* AND vnd_id = VendList.vnd_id ;
3517 *!* AND vnd_key = VendList.vnd_key ;
3518 *!* AND our_qual = VendList.our_qual ;
3519 *!* AND our_id = VendList.our_id ;
3520 *!* IN (pcEiPOth)
3521 *!* CASE ll_3Key
3522 *!* Replace customer With lcCustomer, ;
3523 *!* vnd_Qual WITH IIF(EMPTY(lcvnd_Qual), vnd_Qual, lcVnd_Qual), ;
3524 *!* vnd_Id WITH IIF(EMPTY(lcvnd_Id), vnd_Id, lcVnd_Id), ;
3525 *!* vnd_key WITH IIF(EMPTY(lcvnd_key), vnd_key, lcVnd_key) ;
3526 *!* FOR vnd_qual = VendList.vnd_qual ;
3527 *!* AND vnd_id = VendList.vnd_id ;
3528 *!* AND vnd_key = VendList.vnd_key ;
3529 *!* IN (pcEiPOth)
3530 *!* OTHERWISE && Deleted CASE ll_2Key and added OTHERWISE TR 1023429 11-Mar-2007 Goutam
3531 *!* Replace customer With lcCustomer, ;
3532 *!* vnd_Qual WITH IIF(EMPTY(lcvnd_Qual), vnd_Qual, lcVnd_Qual), ;
3533 *!* vnd_Id WITH IIF(EMPTY(lcvnd_Id), vnd_Id, lcVnd_Id) ;
3534 *!* FOR vnd_qual = VendList.vnd_qual ;
3535 *!* AND vnd_id = VendList.vnd_id ;
3536 *!* IN (pcEiPOth)
3537 *!* ENDCASE
3538 *!*
3539 *!* *=== TR 1021957 1-Mar-2007 Goutam
3540 *!*
3541 *!* Endif
3542 *!* Endscan
3543 *!* Use in VendList
3544
3545 *!* If This.lUserInterface
3546 *!* This.ResetThermo()
3547 *!* Endif
3548 *!* Select(lnOldSelect)
3549 *!* Return llRetVal
3550 *!* Endproc
3551
3552
3553 Procedure GetCustomerUsingTradingPartnerID
3554 *--- TechRec 1090303 08-Jan-2016 jisingh Added pnCtrlKey_Resolved ===
3555 Parameter pcErrorMsg, pcVnd_qual, pcVnd_id, pcEDITransaction, plNoCheckForDivision, ;
3556 pcVnd_Qual_Resolved, pcVnd_Id_Resolved, pcVnd_key, pcVnd_Key_Resolved, ;
3557 pcOur_Id, pcOur_Id_Resolved, pcOur_Qual, pcOur_Qual_Resolved, pcWhereStr, pcEdi_store, pl_AddlKey, pnCtrlKey_Resolved
3558 *--- 1045965 09-MAR-2010 HNISAR && Added pcWhereStr
3559 *--- TR 1096028 30-Jun-2016 Partha Added pcEdi_store, pl_AddlKey ===
3560
3561 *--- TR 1096028 30-Jun-2016 Partha - Added lnCount, ll_AddlKey ===
3562 Local lcCustomer, lcSqlString, llRetVal, lcControl, lnCount, ll_AddlKey
3563 *--- TechRec 1090303 11-Jan-2016 jisingh Added llCtrlKey ===
3564 Local lcVnd_key1, lcVnd_key2, llCtrlKey
3565
3566 Local ll_5Key, lcOur_Id1, lcOur_Id2
3567 Local lnRank1, lnRank2
3568
3569 pcOur_Id_Resolved = ""
3570 pcOur_Qual_Resolved = ""
3571
3572 ll_5Key = Vartype(pcVnd_key) = "C" And Vartype(pcOur_Id) = "C"
3573 llCtrlKey = Vartype(pnCtrlKey_Resolved) = "N" &&--- TechRec 1090303 11-Jan-2016 jisingh ===
3574
3575 Store "" To lcCustomer, pcVnd_Qual_Resolved, pcVnd_Id_Resolved
3576
3577 pcVnd_Key_Resolved = ""
3578
3579 pcEDITransaction= Iif(Empty(pcEDITransaction), "ipo", pcEDITransaction)
3580
3581 *--- TR 1045965 09-MAR-2010 HNISAR
3582 pcWhereStr = Iif(Empty(pcWhereStr), "", pcWhereStr)
3583 *=== TR 1045965 09-MAR-2010 HNISAR
3584
3585 lcControl= "zze" + pcEDITransaction + "cr"
3586
3587 * TR 1065953 FH - if process is 850 we should use c850Control table.
3588 IF UPPER(pcEDITransaction ) = 'IPO' AND NOT EMPTY(THIS.c850Control)
3589 lcControl = THIS.c850Control
3590 ENDIF
3591
3592 *--- TR 1096028 01-Jul-2016 Partha ---
3593 *--- TR 1099116 26-Sep-2016 Partha ---
3594*!* ll_AddlKey = VARTYPE(lcControl + ".Add_key_source") = "C" AND VARTYPE(pcEdi_store) = "C"
3595 *--- TR 1099603 18-Oct-2016 Partha ---
3596*!* ll_AddlKey = TYPE(lcControl + ".Add_key_source") = "C" AND TYPE(pcEdi_store) = "C"
3597 ll_AddlKey = pl_AddlKey
3598 *=== TR 1099603 18-Oct-2016 Partha ===
3599 *=== TR 1099116 26-Sep-2016 Partha ===
3600 *=== TR 1096028 01-Jul-2016 Partha ===
3601
3602 * PL 08/01/00- 4226- EDI 850 Process doesn't check Active/Inactive flag on 850 Control Ref.
3603 * if return more than one disctinct customer- error "Ambiquous Trading Partner Qualifier/ID."
3604 *
3605 * either get "Abiquous Trading Partner Qualifier/ID" or
3606 * "Invalid Trading Partner Qualifier/ID." or return proper lcCustomer
3607 *- YIK 12/21/01 26717 Add check for Active_ok, add division to the list of fields selected
3608 *- otherwise only 1 record is ALWAYS returned.
3609 *- lcSQLString = "Select distinct customer FROM " + lcControl + " Where vnd_qual='" + pcVnd_qual + ;
3610 *- "' And vnd_id= '" + pcVnd_id + "'"
3611 *- YIK 03/12/02 TAN 31113
3612 *- don't check for division if plNoCheckForDivision is .T. because division may not exist in BC Control table. Ex. 816
3613
3614 If ll_5Key
3615 *--- TR 1086359 04/16/15 ATHIRUNAVU Modified the SQL to use SQLformatChar
3616 *--- TR 1096028 30-Jun-2016 Partha Added add_key_source in select lists of all unions Conditionally ===
3617 *--- TR 1096028 29-Jul-2016 Partha Modified "SELECT TOP 2 * " To "SELECT * " Based on ll_AddlKey ===
3618 *--- TechRec 1090303 11-Jan-2016 jisingh Removed distinct & Added MAX(pkey) AS pkey from/to all SELECT ===
3619 lcSqlString = IIF(ll_AddlKey, "SELECT CUSTOMER,add_key_source, MAX(rank) rank, MAX(pkey) AS pkey ", "SELECT TOP 2 * " ) + " FROM (" + ;
3620 "Select 1 Rank, customer, MAX(pkey) AS pkey " + IIF(ll_AddlKey, ",add_key_source", "") + " FROM " + lcControl + ;
3621 " Where vnd_qual = " + SQLFormatChar(pcVnd_qual) + ;
3622 " AND vnd_id = " + SQLFormatChar(pcVnd_id) + ;
3623 " AND our_qual =" + SQLFormatChar(pcOur_Qual) + ;
3624 " AND our_id = " + SQLFormatChar(pcOur_Id) + ;
3625 " AND vnd_key = " + SQLFormatChar(pcVnd_key) + ;
3626 " AND Active_Ok = 'Y' " + ;
3627 pcWhereStr +; &&*--- TR 1045965 09-MAR-2010 HNISAR
3628 " GROUP BY customer " + IIF(ll_AddlKey, ",add_key_source ", "") + ; &&--- TechRec 1090303 11-Jan-2016 jisingh ===
3629 " UNION " + ;
3630 "Select 2 Rank, customer, MAX(pkey) AS pkey " + IIF(ll_AddlKey, ",add_key_source", "") + " FROM " + lcControl + ;
3631 " Where vnd_qual = " + SQLFormatChar(pcVnd_qual) + ;
3632 " AND vnd_id = " + SQLFormatChar(pcVnd_id) + ;
3633 " AND our_qual =" + SQLFormatChar(pcOur_Qual) + ;
3634 " AND our_id = " + SQLFormatChar(pcOur_Id) + ;
3635 " AND vnd_key = '' " + ;
3636 " AND Active_Ok = 'Y' " + ;
3637 pcWhereStr +; &&*--- TR 1045965 09-MAR-2010 HNISAR
3638 " GROUP BY customer " + IIF(ll_AddlKey, ",add_key_source ", "") + ; &&--- TechRec 1090303 11-Jan-2016 jisingh ===
3639 " UNION " + ;
3640 "Select 3 Rank, customer, MAX(pkey) AS pkey " + IIF(ll_AddlKey, ",add_key_source", "") + " FROM " + lcControl + ;
3641 " Where vnd_qual = " + SQLFormatChar(pcVnd_qual) + ;
3642 " AND vnd_id = " + SQLFormatChar(pcVnd_id) + ;
3643 " AND our_id = ''" + ;
3644 " AND our_qual = ''" + ;
3645 " AND vnd_key = " + SQLFormatChar(pcVnd_key) + ;
3646 " AND Active_Ok = 'Y' " + ;
3647 pcWhereStr +; &&*--- TR 1045965 09-MAR-2010 HNISAR
3648 " GROUP BY customer " + IIF(ll_AddlKey, ",add_key_source ", "") + ; &&--- TechRec 1090303 11-Jan-2016 jisingh ===
3649 " UNION " + ;
3650 "Select 4 Rank, customer, MAX(pkey) AS pkey " + IIF(ll_AddlKey, ",add_key_source", "") + " FROM " + lcControl + ;
3651 " Where vnd_qual = " + SQLFormatChar(pcVnd_qual) + ;
3652 " AND vnd_id = " + SQLFormatChar(pcVnd_id) + ;
3653 " AND our_id = ''" + ;
3654 " AND our_qual = ''" + ;
3655 " AND vnd_key = ''" + ;
3656 pcWhereStr +; &&*--- TR 1045965 09-MAR-2010 HNISAR
3657 " AND Active_Ok = 'Y' " + ;
3658 " GROUP BY customer " + IIF(ll_AddlKey, ",add_key_source ", "") + ; &&--- TechRec 1090303 11-Jan-2016 jisingh ===
3659 " ) t " + ;
3660 IIF(ll_AddlKey, "GROUP BY customer, add_key_source ", "") + ;
3661 " ORDER BY Rank ASC, Customer DESC"
3662 Else
3663 *--- TR 1086359 04/16/15 ATHIRUNAVU Modified the SQL to use SQLformatChar
3664 *--- TR 1096028 30-Jun-2016 Partha Added add_key_source in select list Conditionally ===
3665 *--- TechRec 1090303 11-Jan-2016 jisingh Removed distinct & Added MAX(pkey) AS pkey from/to SELECT ===
3666 lcSqlString = "Select 1 Rank, customer, MAX(pkey) AS pkey " + IIF(ll_AddlKey, ",add_key_source", "") + " FROM " + lcControl + ;
3667 " Where vnd_qual = " + SQLFormatChar(pcVnd_qual) + ;
3668 " AND vnd_id = " + SQLFormatChar(pcVnd_id) + ;
3669 " AND Active_Ok = 'Y'" +;
3670 pcWhereStr + ; &&*--- TR 1045965 09-MAR-2010 HNISAR
3671 " GROUP BY customer " + IIF(ll_AddlKey, ",add_key_source ", "") &&--- TechRec 1090303 11-Jan-2016 jisingh ===
3672 Endif
3673
3674 llRetVal= v_SQLexec(lcSqlString, "tcPartID")
3675
3676 If (llRetVal And Used('tcPartID') And Reccount('tcPartID') = 0)
3677 pcErrorMsg = pcErrorMsg + "Invalid Trading partner Qualifier/ID." + CRLF
3678 Endif
3679
3680 If (llRetVal And Used('tcPartID') And Reccount('tcPartID') > 1)
3681 Go Top In tcPartID
3682 lnRank1 = tcPartID.Rank
3683 Skip In tcPartID
3684 lnRank2 = tcPartID.Rank
3685 If lnRank1 = lnRank2
3686
3687 *--- TR 1096028 01-Jul-2016 Partha ---
3688 IF ll_AddlKey
3689 GO TOP
3690 LOCATE FOR NOT EMPTY(tcPartID.Add_key_source)
3691 ll_AddlKey = ll_AddlKey AND FOUND()
3692 pl_AddlKey = ll_AddlKey
3693 GO TOP
3694 ENDIF
3695
3696 IF NOT (ll_AddlKey)
3697 *=== TR 1096028 01-Jul-2016 Partha ===
3698
3699 pcErrorMsg = pcErrorMsg + "Ambiguous Trading Partner Qualifier/ ID." + CRLF &&*--- TR 1045965 01-MAR-2010 HNISAR corrected spelling for Ambiguous
3700
3701 *--- TR 1096028 01-Jul-2016 Partha ---
3702 ELSE
3703
3704 * When we are getting "Ambiguous trading partner..." error,
3705 * try to resolve customer using additional key source
3706 SELECT tcPartID
3707 lnCount =0
3708 SCAN FOR !EMPTY(ALLTRIM(add_key_source))
3709 DO CASE && may be in future we will have more values for add_key_source.
3710 CASE UPPER(ALLTRIM(add_key_source)) = "EDI_STORE"
3711 lcSQLString = "SELECT CASE WHEN EXISTS ( " + ;
3712 " SELECT 1 FROM zzxstorr " + ;
3713 " WHERE customer= " + SQLFormatChar(customer) + ;
3714 " AND edi_store= " + SQLFormatChar(pcEdi_store) + ;
3715 " ) THEN 'Y' ELSE 'N' END AS cExists "
3716 IF v_SQLExec(lcSQLString, '__tcCustore') AND USED('__tcCustore') AND __tcCustore.cExists='Y'
3717 lcCustomer= tcPartID.customer
3718 lnCount = lnCount + 1
3719 *-STRY0039490 FH
3720 IF llCtrlKey
3721 pnCtrlKey_Resolved = tcPartID.pkey
3722 ENDIF
3723 *-STRY0039490 FH
3724 ENDIF
3725 IF USED('__tcCustore')
3726 USE IN ('__tcCustore')
3727 ENDIF
3728 * Handle Other cases here
3729
3730 * Already multiple found, no more server call
3731 IF lnCount >1
3732 lcCustomer = ""
3733 *-STRY0039490 FH
3734 IF llCtrlKey
3735 Store 0 To pnCtrlKey_Resolved
3736 ENDIF
3737 *-STRY0039490 FH
3738 EXIT
3739 ENDIF
3740 ENDCASE
3741
3742 ENDSCAN
3743
3744 DO CASE
3745 CASE lnCount =1
3746 * lcCustomer is the resolved Customer
3747 CASE lnCount >1
3748 pcErrorMsg = pcErrorMsg + "Ambiguous Trading partner Qualifier/ID/EDI_store."
3749 CASE lnCount =0
3750 pcErrorMsg = pcErrorMsg + "Ambiguous Trading partner Qualifier/ID. EDI_store is not found."
3751 ENDCASE
3752
3753 ENDIF
3754 *=== TR 1096028 30-Jun-2016 Partha ===
3755
3756 Else
3757 Go Top In tcPartID
3758 lcCustomer= tcPartID.customer
3759 *--- TechRec 1090303 11-Jan-2016 jisingh ---
3760 IF llCtrlKey
3761 pnCtrlKey_Resolved = tcPartID.pkey
3762 ENDIF
3763 *=== TechRec 1090303 11-Jan-2016 jisingh ===
3764 Endif
3765 Endif
3766
3767 If llRetVal And ( Used('tcPartID') And Recc('tcPartID')=1 )
3768 lcCustomer= tcPartID.customer
3769 *--- TechRec 1090303 11-Jan-2016 jisingh ---
3770 IF llCtrlKey
3771 pnCtrlKey_Resolved = tcPartID.pkey
3772 ENDIF
3773 *=== TechRec 1090303 11-Jan-2016 jisingh ===
3774 Endif
3775
3776 * If cusomter cannot be resolved. Now try for further resolution only for Vitural show room
3777 * Vend Qualfifier. Do this only if the last query has no record.
3778 If llRetVal And Used("tcPartID") And pcVnd_qual = VITRUAL_SHOWROOM_VEND_QUALIFIER And ;
3779 EMPTY(lcCustomer)
3780
3781 If ll_5Key
3782 *--- TechRec 1090303 11-Jan-2016 jisingh Added pkey ===
3783 lcSqlString = "SELECT customer, vnd_qual, vnd_id, vnd_key, our_Id, our_Qual, pkey " + ;
3784 " FROM " + lcControl + ;
3785 " WHERE customer = " + SQLFormatChar(Alltrim(pcVnd_id)) + ;
3786 " AND active_ok = 'Y'"
3787 Else
3788 *--- TechRec 1090303 11-Jan-2016 jisingh Added pkey ===
3789 lcSqlString = "SELECT customer, vnd_qual, vnd_id, pkey " + ;
3790 " FROM " + lcControl + ;
3791 " WHERE customer = " + SQLFormatChar(Alltrim(pcVnd_id)) + ;
3792 " AND active_ok = 'Y'"
3793 Endif
3794
3795 llRetVal= v_SQLexec(lcSqlString, "tcPartID")
3796
3797 If llRetVal And Used("tcPartID") And Reccount("tcPartID") > 0
3798 lcCustomer = tcPartID.customer
3799 pcVnd_Qual_Resolved = tcPartID.Vnd_Qual
3800 pcVnd_Id_Resolved = tcPartID.vnd_id
3801
3802 *--- TechRec 1090303 11-Jan-2016 jisingh ---
3803 IF llCtrlKey
3804 pnCtrlKey_Resolved = tcPartID.pkey
3805 ENDIF
3806 *=== TechRec 1090303 11-Jan-2016 jisingh ===
3807
3808 If Vartype(pcVnd_key) = "C"
3809 pcVnd_Key_Resolved = tcPartID.Vnd_key
3810 Endif
3811
3812 If Vartype(pcOur_Id) = "C"
3813 *---TR 1030703 FEB-28-08 BR
3814 *pcOur_Id_Resolved = tcPartID.pcOur_Id
3815 *pcOur_Qual_Resolved = tcPartID.pcOur_Qual
3816 pcOur_Id_Resolved = tcPartID.Our_Id
3817 pcOur_Qual_Resolved = tcPartID.Our_Qual
3818 *===TR 1030703 FEB-28-08 BR
3819 Endif
3820
3821 Else
3822 Store "" To lcCustomer, pcVnd_Qual_Resolved, pcVnd_Id_Resolved, pcVnd_Key_Resolved, ;
3823 pcOur_Id_Resolved, pcOur_Qual_Resolved
3824
3825 *--- TechRec 1090303 11-Jan-2016 jisingh ---
3826 IF llCtrlKey
3827 Store 0 To pnCtrlKey_Resolved
3828 ENDIF
3829 *=== TechRec 1090303 11-Jan-2016 jisingh ===
3830 Endif
3831
3832 Endif
3833
3834 Return lcCustomer
3835 Endproc
3836
3837
3838 ************************************************************************************
3839 * Find/Validate customer (move from clsiPOpr) need to reuse in clsiPDpr
3840 ************************************************************************************
3841 * Abstract:
3842 * 1. Select Distinct customer from work header.
3843 * 2. Find customer using trading partner ID
3844 ************************************************************************************
3845 Procedure FindCustomerUsingTradingPartnerID
3846 Lparameters pcEiPOth, pcEDITransaction, pcWhereStr
3847 *--- TR 1045965 09-MAR-2010 HNISAR * ADDED pcWhereStr
3848
3849 *--- TR 1096028 01-Jul-2016 Partha - Added ll_AddlKey ===
3850 *--- TR 1099603 18-Oct-2016 Partha - Added ll_OrigAddlKey ===
3851 Local llRetVal, lnOldSelect, lcErrs_Msg, lcCustomer, lcVnd_Qual, lcVnd_Id, ll_AddlKey, ll_OrigAddlKey
3852 *--- TechRec 1090303 11-Jan-2016 jisingh Added lnCtrlKey, llCtrlKey ===
3853 Local lcVnd_key, lnCtrlKey, llCtrlKey
3854
3855 Local lcOur_Qual, lcOur_Id, ll_5Key, lcErrMsgFld, lcErrFlgFld
3856
3857 llRetVal = .T.
3858 lnOldSelect = Select()
3859
3860 ll_5Key = Type(pcEiPOth + ".vnd_key") = "C" And Type(pcEiPOth + ".our_id") = "C"
3861 llCtrlKey = Type(pcEiPOth + ".control_pkey") = "N" &&--- TechRec 1090303 11-Jan-2016 jisingh ===
3862
3863 *--- TR 1096028 01-Jul-2016 Partha ---
3864
3865 *--- TR 1099603 18-Oct-2016 Partha ---
3866 * At this level it only determines if required fields exists in the control and transaction table
3867 * In GetCustomerUsingTradingPartnerID method it will be finally resolved in row level of control table.
3868 *
3869
3870*!* ll_AddlKey = Type(pcEiPOth + ".Edi_store") = "C"
3871
3872 ll_AddlKey = This.IsAddlKey(pcEDITransaction, pcEiPOth)
3873 ll_OrigAddlKey = ll_AddlKey
3874 *=== TR 1099603 18-Oct-2016 Partha ===
3875
3876 *=== TR 1096028 01-Jul-2016 Partha ===
3877
3878 If ll_5Key
3879 *--- TR 1031442 17-Jun-2008 Goutam. added WHERE EMPTY(Customer) in the following sql.
3880
3881 *--- TR 1096028 30-Jun-2016 Partha Added Edi_store conditionally ===
3882*!* Select Distinct Vnd_Qual, vnd_id, Vnd_key, our_qual, our_id ;
3883*!* From (pcEiPOth) WHERE EMPTY(Customer);
3884*!* Into Cursor VendList
3885 lcSQLString = " Select Distinct Vnd_Qual, vnd_id, Vnd_key, our_qual, our_id " + IIF(ll_AddlKey, ",Edi_store " , ", .F. AS Edi_store ") + ;
3886 "From " +pcEiPOth+ " WHERE EMPTY(Customer) " + ;
3887 "Into Cursor VendList "
3888
3889
3890 *=== TR 1096028 01-Jul-2016 Partha ===
3891 Else
3892 *--- TR 1031442 17-Jun-2008 Goutam. added WHERE EMPTY(Customer) in the following sql.
3893 *--- TR 1096028 30-Jun-2016 Partha Added .F. AS Edi_store ===
3894*!* Select Distinct Vnd_Qual, vnd_id , .F. As Vnd_key, .F. As our_qual, .F. As our_id ;
3895*!* From (pcEiPOth) WHERE EMPTY(Customer);
3896*!* Into Cursor VendList
3897
3898 lcSQLString = " Select Distinct Vnd_Qual, vnd_id , .F. As Vnd_key, .F. As our_qual, .F. As our_id " + ;
3899 IIF(ll_AddlKey, ",Edi_store " , ", .F. AS Edi_store ") + ;
3900 " From " + pcEiPOth + " WHERE EMPTY(Customer) " + ;
3901 " Into Cursor VendList "
3902
3903 *=== TR 1096028 01-Jul-2016 Partha ===
3904 ENDIF
3905
3906
3907 &lcSQLString && TR 1096028 01-Jul-2016 Partha
3908
3909 Select VendList
3910 * Init Thermometer
3911 If This.lUserInterface
3912 This.UpdateThermoCaption("Resolving Customer code using Trading Partner Qualifier and ID...")
3913 This.InitThermo(Recc('VendList'))
3914 l_nThermoCnt = 0
3915 Endif
3916 Scan
3917 If This.lUserInterface
3918 l_nThermoCnt = l_nThermoCnt + 1
3919 This.AdvanceThermo(l_nThermoCnt)
3920 Endif
3921 lcErrs_Msg = ""
3922 lcVnd_Qual = ""
3923 lcVnd_Id = ""
3924 lcVnd_key = ""
3925 lcOur_Qual = ""
3926 lcOur_Id = ""
3927 lnCtrlKey = 0 &&--- TechRec 1090303 11-Jan-2016 jisingh ===
3928
3929 *--- TR 1096028 30-Jun-2016 Partha Added VendList.Edi_store, @ll_AddlKey ===
3930 *--- TechRec 1090303 11-Jan-2016 jisingh Added @lnCtrl_Key ===
3931 lcCustomer = This.GetCustomerUsingTradingPartnerID(@lcErrs_Msg, VendList.Vnd_Qual, VendList.vnd_id, ;
3932 pcEDITransaction, false, @lcVnd_Qual, @lcVnd_Id, ;
3933 VendList.Vnd_key, @lcVnd_key, ;
3934 VendList.our_id, @lcOur_Id, VendList.our_qual, @lcOur_Qual,pcWhereStr, VendList.Edi_store, @ll_AddlKey,@lnCtrlKey ;
3935 ) &&*--- TR 1045965 09-MAR-2010 HNISAR * ADDED pcWhereStr
3936
3937 If Empty(lcCustomer)
3938 lcErrs_Msg= lcErrs_Msg + CRLF
3939
3940 If Type("&pcEiPOth..errs_msg_h") <> "U"
3941 lcErrMsgFld = "Errs_Msg_H"
3942 lcErrFlgFld = "Errs_Flg_H"
3943 Else
3944 lcErrMsgFld = "Errs_Msg"
3945 lcErrFlgFld = "Errs_Flg"
3946 Endif
3947
3948 If ll_5Key
3949 *- TR 1065953 FH - add for empty(customer)
3950 Replace (lcErrMsgFld) With Evaluate(lcErrMsgFld) + lcErrs_Msg, (lcErrFlgFld) With "Y" ;
3951 For Vnd_Qual = VendList.Vnd_Qual And vnd_id = VendList.vnd_id ;
3952 AND our_qual = VendList.our_qual And our_id = VendList.our_id ;
3953 AND Vnd_key = VendList.Vnd_key ;
3954 AND EMPTY(customer) ;
3955 In (pcEiPOth)
3956 ELSE
3957 *- TR 1065953 FH - add for empty(customer)
3958 Replace (lcErrMsgFld) With Evaluate(lcErrMsgFld) + lcErrs_Msg, (lcErrFlgFld) With "Y" ;
3959 For Vnd_Qual= VendList.Vnd_Qual And vnd_id= VendList.vnd_id ;
3960 AND EMPTY(customer) ;
3961 In (pcEiPOth)
3962
3963 Endif
3964 Else
3965 * replace all vnd_id/qual with same customer code that it return
3966 If ll_5Key
3967 *--- TR 1096028 01-Aug-2016 Partha ---
3968 IF ll_AddlKey
3969
3970 Replace customer With lcCustomer, ;
3971 Vnd_Qual With Iif(Empty(lcVnd_Qual), Vnd_Qual, lcVnd_Qual), ;
3972 vnd_id With Iif(Empty(lcVnd_Id), vnd_id, lcVnd_Id), ;
3973 Vnd_key With Iif(Empty(lcVnd_key), Vnd_key, lcVnd_key) ;
3974 our_qual With Iif(Empty(lcOur_Qual), our_qual, lcOur_Qual), ;
3975 our_id With Iif(Empty(lcOur_Id), our_id, lcOur_Id) ;
3976 FOR Vnd_Qual = VendList.Vnd_Qual ;
3977 AND vnd_id = VendList.vnd_id ;
3978 AND Vnd_key = VendList.Vnd_key ;
3979 AND our_qual = VendList.our_qual ;
3980 AND our_id = VendList.our_id ;
3981 AND edi_store = VendList.Edi_store ;
3982 IN (pcEiPOth)
3983
3984 *--- TechRec 1090303 11-Jan-2016 jisingh ---
3985 IF llCtrlKey
3986 Replace control_pkey With lnCtrlKey ;
3987 FOR vnd_qual = VendList.Vnd_Qual ;
3988 AND vnd_id = VendList.vnd_id ;
3989 AND vnd_key = VendList.Vnd_key ;
3990 AND our_qual = VendList.our_qual ;
3991 AND our_id = VendList.our_id ;
3992 AND edi_store = VendList.Edi_store ;
3993 IN (pcEiPOth)
3994 ENDIF
3995 *=== TechRec 1090303 11-Jan-2016 jisingh ===
3996 ELSE
3997 *=== TR 1096028 01-Aug-2016 Partha ===
3998
3999 Replace customer With lcCustomer, ;
4000 Vnd_Qual With Iif(Empty(lcVnd_Qual), Vnd_Qual, lcVnd_Qual), ;
4001 vnd_id With Iif(Empty(lcVnd_Id), vnd_id, lcVnd_Id), ;
4002 Vnd_key With Iif(Empty(lcVnd_key), Vnd_key, lcVnd_key) ;
4003 our_qual With Iif(Empty(lcOur_Qual), our_qual, lcOur_Qual), ;
4004 our_id With Iif(Empty(lcOur_Id), our_id, lcOur_Id) ;
4005 FOR Vnd_Qual = VendList.Vnd_Qual ;
4006 AND vnd_id = VendList.vnd_id ;
4007 AND Vnd_key = VendList.Vnd_key ;
4008 AND our_qual = VendList.our_qual ;
4009 AND our_id = VendList.our_id ;
4010 IN (pcEiPOth)
4011
4012 *--- TechRec 1090303 11-Jan-2016 jisingh ---
4013 IF llCtrlKey
4014 Replace control_pkey With lnCtrlKey ;
4015 FOR vnd_qual = VendList.Vnd_Qual ;
4016 AND vnd_id = VendList.vnd_id ;
4017 AND vnd_key = VendList.Vnd_key ;
4018 AND our_qual = VendList.our_qual ;
4019 AND our_id = VendList.our_id ;
4020 IN (pcEiPOth)
4021 ENDIF
4022 *=== TechRec 1090303 11-Jan-2016 jisingh ===
4023
4024 *--- TR 1096028 01-Aug-2016 Partha ---
4025 ENDIF
4026 *=== TR 1096028 01-Aug-2016 Partha ===
4027 Else
4028 Replace customer With lcCustomer, ;
4029 Vnd_Qual With Iif(Empty(lcVnd_Qual), Vnd_Qual, lcVnd_Qual), ;
4030 vnd_id With Iif(Empty(lcVnd_Id), vnd_id, lcVnd_Id) ;
4031 FOR Vnd_Qual = VendList.Vnd_Qual ;
4032 AND vnd_id = VendList.vnd_id ;
4033 IN (pcEiPOth)
4034
4035 *--- TechRec 1090303 11-Jan-2016 jisingh ---
4036 IF llCtrlKey
4037 Replace control_pkey With lnCtrlKey ;
4038 FOR vnd_qual = VendList.Vnd_Qual ;
4039 AND vnd_id = VendList.vnd_id ;
4040 IN (pcEiPOth)
4041 ENDIF
4042 *=== TechRec 1090303 11-Jan-2016 jisingh ===
4043 Endif
4044 ENDIF
4045
4046 ll_AddlKey = ll_OrigAddlKey && TR 1099603 18-Oct-2016 Partha - restore back
4047
4048 Endscan
4049 Use In VendList
4050
4051 If This.lUserInterface
4052 This.ResetThermo()
4053 Endif
4054 Select(lnOldSelect)
4055 Return llRetVal
4056 Endproc
4057 *=== TR 1023601 1-Mar-2007 Goutam
4058
4059 ************************************************************************************
4060 * Validate customer (move from clsiPOpr) need to reuse in clsiPDpr
4061 ************************************************************************************
4062 * Abstract: ONLY for !Empty(customer)- Using Trading Partner ID to get customer code
4063 * 1. Select Distinct customer from work header.
4064 * 2. Check for valid customer. If faile the check update all headers for the same
4065 * customer with "Invalid Customer code." and Errs_Flg with "Y"
4066 * Return: True= All pass validation
4067 * False= If one of them fail the check
4068 ************************************************************************************
4069 Procedure CheckCustomer
4070 Lparameters pcEiPOth, pcEDITransaction
4071 Local llRetVal, lnOldSelect, lcErrs_Msg
4072 llRetVal = .T.
4073 lnOldSelect = Select()
4074
4075 * Check All customer including blank - PL 02/18/99
4076 * FindCustomerUsingTradingPartnerID() could not crossref trading partner id with
4077 * internal customer code
4078 Select Distinct customer From (pcEiPOth) Into Cursor CustList
4079 Select CustList
4080 * Init Thermometer
4081 If This.lUserInterface
4082 This.UpdateThermoCaption("Validating Customer(s)...")
4083 This.InitThermo(Recc('CustList'))
4084 l_nThermoCnt = 0
4085 Endif
4086 Scan
4087 If This.lUserInterface
4088 * Advance progress bar, if we're using one.
4089 l_nThermoCnt = l_nThermoCnt + 1
4090 This.AdvanceThermo(l_nThermoCnt)
4091 Endif
4092 lcErrs_Msg = ""
4093 If Not This.oBPOSalesOrder.ValidCustomer(@lcErrs_Msg, CustList.customer)
4094 *llRetVal = .F. && PL 04/13/00
4095 lcErrs_Msg= lcErrs_Msg + CRLF
4096 Replace Errs_Msg_H With Errs_Msg_H + lcErrs_Msg, Errs_flg_H With "Y" ;
4097 For customer= CustList.customer ;
4098 In (pcEiPOth)
4099 Endif
4100 Endscan
4101 Use In CustList
4102
4103 If This.lUserInterface
4104 * Reset Thermometer
4105 This.ResetThermo()
4106 Endif
4107 Select(lnOldSelect)
4108 Return llRetVal
4109 Endproc
4110
4111 ************************************************************************************
4112 * return VND,TradingPartnerID,EDITransaction,EDIVersion as a string for createFlatfile
4113 * Parameters:
4114 * 1. EDI Transaction (OSC, OIN, ORS...)
4115 * 2. control table (previously open)
4116 * 3. work vendor table (Previously created with nodata)
4117 * 4. return strings(output parameter)
4118 *- 1009713 Added parameters tlDelimited, tcDelimiter
4119 ************************************************************************************
4120 Procedure GetVendorString
4121 Lparameters tcProcess, tcControlTable, tcVendorTable, tcString, tlDelimited, tcDelimiter
4122 Local llRetVal, lnOldSelect
4123 llRetVal = .T.
4124 lnOldSelect = Select()
4125 If Used(tcControlTable)
4126 Select (tcVendorTable)
4127 Appen Blank
4128 Replace vnd_id With &tcControlTable..vnd_id, vnd_tran With tcProcess,;
4129 vnd_vers With &tcControlTable..vnd_vers In (tcVendorTable)
4130 * output Vendor string ("VND",TradingPartnerID,Transaction,Version)
4131 *- 1009713 03/04/05 YIK
4132 *--- TR 1014219 2005-11-15 NH
4133 tcString = tcString + EDI_VENDOR_TAG + ;
4134 IIF(tlDelimited,tcDelimiter,"") + .ConvertRecordToText(tcVendorTable, tlDelimited, tcDelimiter)
4135 *=== TR 1014219 2005-11-15 NH
4136 Else
4137 llRetVal= .F.
4138 Endif
4139
4140 Select(lnOldSelect)
4141 Return llRetVal
4142 Endproc
4143
4144
4145 ************************************************************************************
4146 Procedure GetEDIFlatFileDirectory
4147 Lparameters tcDirection
4148 Local lcCompanyAppr, lcEDIPath, lcEDIPath
4149 lcEDIPath = GetCompanyDirectoryPath()
4150 *lcCompanyAppr= Right(goenv.envdata.cdatasource,4)
4151 If Upper(tcDirection)="OUTBOUND"
4152 lcEDIPath= lcEDIPath + "\EDI\Outbound\"
4153 Else
4154 lcEDIPath= lcEDIPath + "\EDI\Inbound\"
4155 Endif
4156 Return lcEDIPath
4157 Endproc
4158
4159 ************************************************************************************
4160 * Validate EDI 816(iOR) Control
4161 ************************************************************************************
4162 Function ValidEDIiORControl
4163 Lparameter tcErrorMsg, tcCustomer, tcTmpTable
4164 Local llRetVal
4165 llRetVal= !(!vl_iORcr(tcCustomer, "", tcTmpTable))
4166 * PL 03/25/99- also check for active_ok="Y" otherwise, could be inactive
4167 If Used(tcTmpTable) And llRetVal
4168 llRetVal= Iif(&tcTmpTable..active_ok= "Y", .T., .F.)
4169 Endif
4170 tcErrorMsg = tcErrorMsg + Iif(llRetVal, "" , ;
4171 "EDI 816 Control Table is not set up!")
4172 Return llRetVal
4173 Endfunc
4174
4175 ************************************************************************************
4176 * SetRelation:
4177 * 1. will take put a tcHeaderAlias in index order of tcheaderIndexOrder
4178 * 2. Set reation from detail into header using tcDetailRelation
4179 * *NOTES: DO NOT ATTEMPT TO SAVE AND RESTORE CURRENT WORKAREA
4180 * when return from here detail alias will be the CURRENT WORKAREA with
4181 * proper relation to header
4182 ************************************************************************************
4183 Procedure SetRelation
4184 Parameters tcHeaderAlias, tcHeaderIndexOrder, tcDetailAlias, tcDetailRelation
4185 Local llRetVal, lcMac
4186 llRetVal= .F.
4187 Select (tcHeaderAlias)
4188 Set Order To tcHeaderIndexOrder
4189 Select (tcDetailAlias)
4190 lcMac= "Set Relation to " + tcDetailRelation + " Into " + tcHeaderAlias
4191 &lcMac
4192 llRetVal= .T.
4193 Return llRetVal
4194 Endproc
4195
4196 ************************************************************************************
4197 * move error transaction records to views for tableupdate (send them to server)
4198 ************************************************************************************
4199 Procedure MoveTransactionInError
4200 Lparameters pcCursHeader, pcCursDetail, pcCursComment, pcCursAddress, ;
4201 pcTranHeader, pcTranDetail, pcTranComment, pcTranAddress, pcCursSAC, pcTranSAC
4202 Local llRetVal, lnOldSelect
4203 llRetVal = .T.
4204 lnOldSelect = Select()
4205 If Used(pcCursHeader)
4206 Select (pcTranHeader)
4207 Append From Dbf(pcCursHeader)
4208 .nTransaction= Recc(pcTranHeader)
4209 Use In (pcCursHeader)
4210 Endif
4211
4212 If Used(pcCursDetail)
4213 Select (pcTranDetail)
4214 Append From Dbf(pcCursDetail)
4215 Use In (pcCursDetail)
4216 Endif
4217
4218 If Used(pcCursComment)
4219 Select (pcTranComment)
4220 Append From Dbf(pcCursComment)
4221 Use In (pcCursComment)
4222 Endif
4223
4224 If Used(pcCursAddress)
4225 Select (pcTranAddress)
4226 Append From Dbf(pcCursAddress)
4227 Use In (pcCursAddress)
4228 Endif
4229
4230 If !Empty(pcCursSAC) And Used(pcCursSAC)
4231 Select (pcTranSAC)
4232 Append From Dbf(pcCursSAC)
4233 Use In (pcCursSAC)
4234 Endif
4235
4236 Select(lnOldSelect)
4237 Return llRetVal
4238 Endproc
4239
4240 ************************************************************************************
4241 * populate color description base on distinct color_code
4242 ***********************************************************************************
4243 Procedure PopulateColorDescription
4244 Lparameters pcHeader, pcDetail, pcControl
4245 Local llRetVal, lnOldSelect, lcColor_name
4246 llRetVal = .T.
4247 lnOldSelect = Select()
4248
4249 * Only for trans detail record that have no error
4250 Select Distinct color_code From (pcDetail) Where !(Errs_Flg_D= "Y") ;
4251 Into Cursor _eoinTD
4252
4253 Select _eoinTD
4254 If This.lUserInterface
4255 This.InitThermo(Recc('_eoinTD'))
4256 l_nThermoCnt = 0
4257 Endif
4258 lcColor_name=""
4259 Scan
4260 If This.lUserInterface
4261 l_nThermoCnt = l_nThermoCnt + 1
4262 This.AdvanceThermo(l_nThermoCnt)
4263 Endif
4264 lcColor_name= vl_colrr(_eoinTD.color_code, "color_name", "_Colrr")
4265 If !Empty(lcColor_name)
4266 Replace color_name With lcColor_name In (pcDetail) ;
4267 For color_code= _eoinTD.color_code ;
4268 And !(Errs_Flg_D= "Y") &&Empty(Errs_Msg_H)
4269 Endif
4270 Endscan
4271
4272 Use In _eoinTD
4273 If Used('_Colrr')
4274 Use In _Colrr
4275 Endif
4276
4277 If This.lUserInterface
4278 This.ResetThermo()
4279 Endif
4280 Select(lnOldSelect)
4281 Return llRetVal
4282 Endproc
4283
4284 ************************************************************************************
4285 * Populate style detail infos (ZZXSCOLR) like inr,mst_qty, UOM.
4286 ***********************************************************************************
4287 Procedure PopulateStyColLblDimInfo
4288 * TR 1086188 KISHORE 14-MAY-2015 added pcFieldList
4289 Lparameters pcHeader, pcDetail, pcControl, pcFieldList
4290 Local llRetVal, lnOldSelect, lcCurStyleDiv
4291 llRetVal = .T.
4292 lnOldSelect = Select()
4293 Select Distinct division,Style,color_code,Lbl_code,Dimension From (pcDetail) ;
4294 Where !(Errs_Flg_D= "Y") Into Cursor __TmpCursor
4295 With This
4296 .cSQLTempTable=""
4297 If .GenerateSQLTempTable('__TmpCursor')
4298 If .PopulateSQLTempTable('__TmpCursor')
4299 If !Empty(.cSQLTempTable)
4300 lcSqlString= "Select s.* " +;
4301 " from zzxscolr s, " + .cSQLTempTable + " t " +;
4302 "Where s.division= t.division and s.style= t.style and " +;
4303 "s.color_code= t.color_code and s.lbl_code= t.lbl_code and "+;
4304 "s.dimension=t.dimension"
4305 llRetVal = v_SQLexec(lcSqlString, "_Scolr")
4306 If llRetVal
4307 Select _Scolr
4308 Index On division+Style+color_code+Lbl_code+Dimension Tag OurSku
4309 llRetVal= .SetRelation("_Scolr", "OurSku", pcDetail, ;
4310 "division+style+color_code+lbl_code+dimension")
4311 If llRetVal
4312 Replace All inner_pack With _Scolr.inr_qty, ;
4313 outer_pack With _Scolr.mst_qty,;
4314 po4_uom With _Scolr.uom,;
4315 ret_price With _Scolr.ret_price ; && 12/05/01 TAN 29176
4316 In (pcDetail);
4317 For !Empty(_Scolr.Style)
4318
4319 *--- TR 1086188 KISHORE 14-MAY-2015
4320
4321*!* *--- TR 1082600 11-Dec-2014 Gouatm.
4322*!*
4323*!* *--- TR 1084080/1082088 19-Jan-2015 Goutam
4324*!* *If (Vartype(&pcDetail..gar_wgt) <> 'U') AND (Vartype(&pcDetail..wgt_uom) <> 'U')
4325*!* If (type("&pcDetail..gar_wgt") <> 'U') AND (type("&pcDetail..wgt_uom") <> 'U')
4326*!* *--- TR 1084080/1082088 19-Jan-2015 Goutam
4327*!*
4328*!* Replace All gar_wgt With _Scolr.gar_wgt, ;
4329*!* wgt_uom With _Scolr.wgt_uom ;
4330*!* In (pcDetail);
4331*!* For !Empty(_Scolr.Style)
4332*!* ENDIF
4333*!* *=== TR 1082600 11-Dec-2014 Gouatm.
4334
4335 * process additional comma separated list of fields
4336 IF NOT EMPTY(pcFieldList)
4337 DIMENSION laFieldList[1]
4338 lcReplace = ''
4339
4340 =StringToArray(pcFieldList, @laFieldList)
4341 lnLen = ALEN(laFieldList,1)
4342
4343 FOR lnCnt = 1 TO lnLen
4344 lcField = ALLTRIM(laFieldList[lnCnt])
4345 IF VARTYPE(pcDetail + '.' + lcField) <> 'U'
4346 IF EMPTY(lcReplace)
4347 lcReplace = lcField + ' WITH _Scolr.' + lcField
4348 ELSE
4349 lcReplace = lcReplace + ', ' + lcField + ' WITH _Scolr.' + lcField
4350 ENDIF
4351 ENDIF
4352 ENDFOR
4353 IF NOT EMPTY(lcReplace)
4354 lcCmd = 'REPLACE ALL ' + lcReplace + ' IN (pcDetail) FOR NOT EMPTY(_Scolr.style)'
4355 &lcCmd
4356 ENDIF
4357 ENDIF
4358 *=== TR 1086188 KISHORE 14-MAY-2015
4359
4360 Set Relation To
4361 Use In _Scolr
4362 Endif
4363 Endif
4364 Endif
4365 Endif
4366 Endif
4367 Endwith
4368 If Used('__TmpCursor')
4369 Use In __TmpCursor
4370 Endif
4371 If Used('_Scolr')
4372 Use In _Scolr
4373 Endif
4374 Select(lnOldSelect)
4375 Return llRetVal
4376 Endproc
4377
4378 ************************************************************************************
4379 * populate style description and size description
4380 ***********************************************************************************
4381 Procedure PopulateStyleSizeInfo
4382 Lparameters pcHeader, pcDetail, pcControl
4383 Local llRetVal, lnOldSelect, lcCurStyleDiv
4384 llRetVal = .T.
4385 lnOldSelect = Select()
4386
4387 * detail transaction in style+ division order
4388 Select (pcDetail)
4389 Set Order To StyleDiv
4390 *--- TR 1031397 TT : Error out any records with size bucket = 0
4391 replace Errs_Flg_D WITH 'Y', ;
4392 Errs_msg_D WITH Errs_msg_D + CRLF + 'Size bucket value is Zero.' + CRLF ;
4393 FOR sizebucket = 0 IN (pcDetail)
4394 *=== TR 1031397 TT : Error out any records with size bucket = 0
4395 * Only for trans detail record that have no error
4396 Select Distinct division, Style From (pcDetail) Where !(Errs_Flg_D= "Y") ;
4397 Into Cursor _eoinTD
4398 Select _eoinTD
4399 If This.lUserInterface
4400 This.InitThermo(Recc('_eoinTD'))
4401 l_nThermoCnt = 0
4402 Endif
4403 Scan
4404 If This.lUserInterface
4405 l_nThermoCnt = l_nThermoCnt + 1
4406 This.AdvanceThermo(l_nThermoCnt)
4407 Endif
4408
4409 * Get zzxStylr once per div,style
4410 llRetVal= vl_stylr(_eoinTD.division,, "_Stylr", _eoinTD.Style)
4411
4412 * Get zzxSizer once per div,style
4413 If llRetVal
4414 If !(Used("_Sizer") And (_eoinTD.division= _Sizer.division And ;
4415 _Stylr.size_code= _Sizer.size_code))
4416 llRetVal= vl_sizer(_eoinTD.division,, "_Sizer", _Stylr.size_code)
4417 Endif
4418 If llRetVal
4419 * replace style_name, size_desc for all detail line without error
4420 * while same Style+division
4421 lcCurStyleDiv= _eoinTD.Style+ _eoinTD.division
4422 Select (pcDetail)
4423 Scan For (Style+division) = lcCurStyleDiv And !(Errs_Flg_D= "Y")
4424 *--- TR 1027827 22-Jan-2008 T.Shenbagavalli Added IIF( EMPTY(style_name),_Stylr.style_name, style_name); ---
4425 Replace style_name With IIF( EMPTY(style_name),_Stylr.style_name, style_name),;
4426 size_desc With (Eval("_Sizer.size" + Trans(sizebucket, "@L 99"))) In (pcDetail)
4427 Endscan
4428 Endif
4429 Endif
4430 Endscan
4431
4432 Use In _eoinTD
4433 If Used('_Stylr')
4434 Use In _Stylr
4435 Endif
4436 If Used('_Sizer')
4437 Use In _Sizer
4438 Endif
4439
4440 If This.lUserInterface
4441 This.ResetThermo()
4442 Endif
4443 Select(lnOldSelect)
4444 Return llRetVal
4445 Endproc
4446
4447 ************************************************************************************
4448 * Server-Side temp cursor(distinct customer,division) and join to zzxstorr to
4449 * populate all edi_store.
4450 ************************************************************************************
4451 Procedure PopulateEDI_Store
4452 Lparameters pcHeader, pcControl
4453 Local llRetVal, lnOldSelect
4454 llRetVal= .T.
4455 lnOldSelect= Select()
4456 * group get edi_store by cust,store
4457 Select Distinct customer, Store From (pcHeader) Where !(Errs_flg_H= "Y") ;
4458 Into Cursor __TmpCursor
4459 Select __TmpCursor
4460 With This
4461 .cSQLTempTable=""
4462 If .GenerateSQLTempTable('__TmpCursor')
4463 If .PopulateSQLTempTable('__TmpCursor')
4464 If !Empty(.cSQLTempTable)
4465 lcSqlString= "Select s.customer, s.store, s.edi_store " +;
4466 " from zzxstorr s, " + .cSQLTempTable + " t " +;
4467 "Where s.customer= t.customer and s.store= t.store"
4468 llRetVal = v_SQLexec(lcSqlString, "_Storr")
4469 If llRetVal
4470 Select _Storr
4471 Index On customer+Store Tag CustStore
4472 llRetVal= .SetRelation("_Storr", "CustStore", pcHeader, ;
4473 "customer+store")
4474 If llRetVal
4475 Replace All EDI_Store With _Storr.EDI_Store In (pcHeader) ;
4476 For !Empty(_Storr.customer)
4477 Set Relation To
4478 Use In _Storr
4479 Endif
4480 Endif
4481 Endif
4482 Endif
4483 Endif
4484 Endwith
4485 If Used("__TmpCursor")
4486 Use In __TmpCursor
4487 Endif
4488 Select(lnOldSelect)
4489 Return llRetVal
4490 Endproc
4491
4492
4493 ************************************************************************************
4494 * Server-Side temp cursor(distinct center_code) and join to zzxdistr to
4495 * populate all edi_center.
4496 ************************************************************************************
4497 Procedure PopulateEDI_center
4498 Lparameters pcHeader, pcControl
4499 Local llRetVal, lnOldSelect
4500 llRetVal= .T.
4501 lnOldSelect= Select()
4502 * group get edi_center by cust,center_code
4503 Select Distinct customer, center_code From (pcHeader) ;
4504 Where !(Errs_flg_H= "Y") And center_code<> "" ;
4505 Into Cursor __TmpCursor
4506 Select __TmpCursor
4507 With This
4508 .cSQLTempTable=""
4509 If .GenerateSQLTempTable('__TmpCursor')
4510 If .PopulateSQLTempTable('__TmpCursor')
4511 If !Empty(.cSQLTempTable)
4512 lcSqlString= "Select s.customer, s.center_code , s.edi_center " +;
4513 " from zzxdistr s, " + .cSQLTempTable + " t " +;
4514 "Where s.customer= t.customer and s.center_code= t.center_code"
4515 llRetVal = v_SQLexec(lcSqlString, "_Distr")
4516 If llRetVal
4517 Select _Distr
4518 Index On customer+center_code Tag CustDist
4519 llRetVal= .SetRelation("_Distr", "CustDist", pcHeader, ;
4520 "customer+center_code")
4521 If llRetVal
4522 Replace All edi_center With _Distr.edi_center In (pcHeader) ;
4523 For !Empty(_Distr.customer)
4524 Set Relation To
4525 Use In _Distr
4526 Endif
4527 Endif
4528 Endif
4529 Endif
4530 Endif
4531 Endwith
4532 If Used("__TmpCursor")
4533 Use In __TmpCursor
4534 Endif
4535 Select(lnOldSelect)
4536 Return llRetVal
4537 Endproc
4538
4539
4540 ************************************************************************************
4541 * Create Vertical addresses for 810 process
4542 ************************************************************************************
4543 Procedure CloseTempAddressCursors
4544 Local llRetVal, lnOldSelect
4545 llRetVal= .T.
4546 lnOldSelect = Select()
4547 If Used("tmpxDivs")
4548 Use In tmpxDivs
4549 Endif
4550 If Used("tmpxFact")
4551 Use In tmpxFact
4552 Endif
4553 If Used("tmpxOnet")
4554 Use In tmpxOnet
4555 Endif
4556 If Used("tmpxShip")
4557 Use In tmpxShip
4558 Endif
4559 If Used("tmpxBill")
4560 Use In tmpxBill
4561 Endif
4562 If Used("tmpxMark")
4563 Use In tmpxMark
4564 Endif
4565 Select(lnOldSelect)
4566 Return llRetVal
4567 Endproc
4568
4569
4570 ************************************************************************************
4571 * 13th. pcInterHist- "Interface" - move records from transaction to interface
4572 * "Transaction" - move records from interface to history
4573 * 14th. pcCondition- process into interface: [! &pcSourceHeader..Errs_flg_H="Y"]
4574 * process into history: [&pcSourceHeader..auto_proc="Y"]
4575 * 15th. pcPkeyTag- "ZZEOINH"
4576 * Notes: when move records from "Tran"- to "Inter" or "Inter" to "Hist"
4577 * don't get new pkey/fkey
4578 * pcPkeyTag- NOT USE
4579 ************************************************************************************
4580 * ?phuOPT- 16 parameter - plNoLog suppress thermo/log call once per order
4581 Procedure MoveRecords
4582 Lparameters pcSourceHeader, pcSourceDetail, pcSourceComment, pcSourceAddress, ;
4583 pcTargetHeader, pcTargetDetail, pcTargetComment, pcTargetAddress,;
4584 pnMaxHeader, pnMaxDetail, pnMaxComment, pnMaxAddress, ;
4585 pcInterHist, pcCondition, pcPkeyTag, plNoLog,;
4586 pcSourceSLN, pcTargetSLN,; &&--- TechRec 1005163 14-May-2004 GS --- added params # 17 & 18
4587 pcSourceHdrNotes, pcSourceDtlNotes, pcTargetHdrNotes, pcTargetDtlNotes, ; && TR 1011340 NH
4588 pcTargetHdrNotesTableName, pcTargetDtlNotesTableName, ; && TR 1011340 NH
4589 pcSourceSAC, pcTargetSAC &&--- TechRec 1018184
4590
4591
4592 Local llOKtoContinue, lnOldSelect, llSAC
4593
4594 llOKtoContinue = .T.
4595 lnOldSelect = Select()
4596 *--- TR 1011340 NH
4597 Local llHdrNotes, llDtlNotes, lcHdrNotesPKeySrc, lcDtlNotesPKeySrc, loDtlNotes, loHdrNotes,;
4598 lnHdrNotesMaxPkey, lnHdrNotesPkey, lnDtlNotesMaxPkey, lnDtlNotesPkey
4599
4600 llHdrNotes = !Empty(pcSourceHdrNotes) And Used(pcSourceHdrNotes) And Reccount(pcSourceHdrNotes)>0;
4601 and !Empty(pcTargetHdrNotes) And Used(pcTargetHdrNotes) And !Empty(pcTargetHdrNotesTableName)
4602
4603 If llHdrNotes
4604 Select (pcTargetHdrNotes)
4605 Set Order To && this is very important for mass PKey generation
4606 Endif
4607
4608 llDtlNotes = !Empty(pcSourceDtlNotes) And Used(pcSourceDtlNotes) And Reccount(pcSourceDtlNotes)>0;
4609 and !Empty(pcTargetDtlNotes) And Used(pcTargetDtlNotes) And !Empty(pcTargetDtlNotesTableName)
4610
4611 If llDtlNotes
4612 Select (pcTargetDtlNotes)
4613 Set Order To && this is very important for mass PKey generation
4614 Endif
4615
4616 *=== TR 1011340 NH
4617
4618 *--- TechRec 1005163 14-May-2004 GS ---
4619 Local lnOldDtlPKey, lnNewDtlPKey, llSLN, lcSlnPKeySrc, lnCnt, i
4620 llSLN = !Empty(pcSourceSLN) And Used(pcSourceSLN) And Reccount(pcSourceSLN)>0;
4621 and !Empty(pcTargetSLN) And Used(pcTargetSLN)
4622 If llSLN
4623 lcSlnPKeySrc = DBGetProp(pcTargetSLN,'view','tables')
4624 Select (pcTargetSLN)
4625 Set Order To && this is very important for mass PKey generation
4626 Endif
4627 *=== TechRec 1005163 14-May-2004 GS ===
4628
4629 *--- TechReq 1028745 31-Jan-2008 GSternik ---
4630 *-- No more parameters allowed... Let's calculate the cursor names :o)
4631 Local llExt, lcSourceExtD, llChrg, lcSourceChrg, lcTargetChrg
4632 lcSourceExtD = StrTran(pcSourceHeader, "h_", "e_", 1, 1, 1) && Case insensitive
4633 *-- Extender Target is not needed!
4634 If "e_"$lcSourceExtD and Used("qExtMData") and Used(lcSourceExtD) and RecCount(lcSourceExtD) > 0
4635 llExt = .T.
4636 EndIf
4637 lcSourceChrg = StrTran(pcSourceHeader, "h_", "r_", 1, 1, 1) && Case insensitive
4638 If "r_"$lcSourceChrg and Used(lcSourceChrg) and RecCount(lcSourceChrg) > 0
4639 llChrg = .T.
4640 lcTargetChrg = StrTran(pcTargetHeader, "h_", "r_", 1, 1, 1) && Case insensitive
4641 EndIf
4642 *=== TechRec 1028745 31-Jan-2008 GSternik ===
4643
4644 * --- TR 1018184
4645 llSAC = !Empty(pcSourceSAC) And Used(pcSourceSAC) And Reccount(pcSourceSAC) > 0 ;
4646 and !Empty(pcTargetSAC) And Used(pcTargetSAC)
4647 If llSAC
4648 lcSacPKeySrc = DBGetProp(pcTargetSAC,'view','tables')
4649 Select (pcTargetSAC)
4650 Set Order To && this is very important for mass PKey generation
4651 Endif
4652 * === TR 1018184
4653 *--- TR 1055192 26-07-2011 RKI ---*
4654 LOCAL llcfhData,lcSourceCfh, lcTargateCfh
4655 lcSourceCfh = "vzzeiPOifh_iPOproc"
4656 lcTargateCfh = "vzzeiPOtfh_iPOproc"
4657 If Used(lcSourceCfh ) and RecCount(lcSourceCfh ) > 0
4658 llcfhData = .T.
4659 EndIf
4660 *=== TR 1055192 26-07-2011 RKI ===*
4661
4662 *--- TR 1044017 04-JAN-2010 HNISAR
4663 LOCAL llWhsData,lcSourceWhse, lcTargateWhse
4664 lcSourceWhse = "vzzeiPOiWhse_iPOproc"
4665 lcTargateWhse = "vzzeiPOtWhse_iPOproc"
4666 If Used(lcSourceWhse ) and RecCount(lcSourceWhse ) > 0
4667 llWhsData = .T.
4668 EndIf
4669 *=== TR 1044017 04-JAN-2010 HNISAR
4670
4671 *--- TR 1088047 31-8-2015 VKK
4672 LOCAL pcsourceHdr2,pcTargetHDR2 , llHDR2
4673 pcsourceHdr2 = "VzzeiP1ih_iPOproc"
4674 pcTargetHDR2 = "VzzeiP1th_iPOproc"
4675 llHDR2 = Used(pcsourceHdr2 ) and RecCount(pcsourceHdr2 ) > 0 And USED(pcTargetHDR2 )
4676 *=== TR 1088047 31-8-2015 VKK
4677
4678 If !plNoLog
4679 * clearout Memvar/Memo base on target tables
4680 Select (pcTargetHeader)
4681 Scatter Memvar Memo Blank
4682 Select (pcTargetDetail)
4683 Scatter Memvar Memo Blank
4684 Select (pcTargetComment)
4685 Scatter Memvar Memo Blank
4686 Select (pcTargetAddress)
4687 Scatter Memvar Memo Blank
4688
4689 *--- TR 1088047 31-8-2015 VKK
4690 IF llHDR2
4691 Select (pcTargetHDR2)
4692 Scatter Memvar Memo Blank
4693 ENDIF
4694 *=== TR 1088047 31-8-2015 VKK
4695
4696 * prep howmany records will be moving from source to target
4697 Select (pcSourceHeader)
4698 If pnMaxHeader>0
4699 *!* If pcInterHist= "History"
4700 *!* .nHistory= pnMaxHeader
4701 *!* Else
4702 *!* .nInterface= pnMaxHeader
4703 *!* Endif
4704 * reuse to move records from both direction outbound (810,856- "Interface","History"
4705 * and inbound (850-"Transaction")
4706 Do Case
4707 Case pcInterHist= "History"
4708 .nHistory= pnMaxHeader
4709 Case pcInterHist= "Interface"
4710 .nInterface= pnMaxHeader
4711 Case pcInterHist= "Transaction"
4712 .nTransaction= pnMaxHeader
4713 Endcase
4714 Endif
4715
4716 * PL 05/15/00 - only 850(i) can record to log not 810, 856
4717 If Not Type('vcLogName')= "C"
4718 vcLogName= ""
4719 Endif
4720 Endif
4721
4722 *<<<<<<<<<<moving DETAIL records from source to target>>>>>>>>>>>>>
4723 If !plNoLog
4724 .AdvanceThermoTotalWithCaptionPlus("Creating detail records...", ;
4725 vcLogName)
4726 l_nThermoCnt = 0
4727 .InitThermoWithCaption(@l_nThermoCnt, Recc(pcSourceDetail), ;
4728 "Creating " + pcInterHist + " detail records...")
4729 Endif
4730 *--- TechRec 1005163 14-May-2004 GS ---
4731 If llSLN
4732 Select (pcSourceSLN)
4733 Set Order To Tag Fkey
4734 Endif
4735
4736 * --- TR 1018184
4737 If llSAC
4738 Select (pcSourceSAC)
4739 Set Order To dfkey
4740 Endif
4741
4742 *--- TR 1011340 NH
4743 If llDtlNotes
4744 Select (pcSourceDtlNotes)
4745 Set Order To Tag Fkey
4746 Endif
4747 *=== TR 1011340 NH
4748
4749 *--- TR 1044017 04-JAN-2010 HNISAR
4750 If llWhsData
4751 Select (lcSourceWhse)
4752 Set Order To dfkey
4753 Endif
4754 *=== TR 1044017 04-JAN-2010 HNISAR
4755
4756 *--- TR 1055192 26-07-2011 RKI ---*
4757 IF llcfhData
4758 SELECT (lcSourceCfh)
4759 SET ORDER TO fkey
4760 ENDIF
4761 *=== TR 1055192 26-07-2011 RKI ===*
4762
4763 * --- TR 1038135 1/16/09 --- Needed for 850 Performance
4764 CREATE CURSOR CurDtlNotePkey(pkey i)
4765 INDEX ON pkey TAG pkey
4766 * === TR 1038135 1/16/09
4767
4768 *=== TechRec 1005163 14-May-2004 GS ===
4769 If llOKtoContinue And .SetRelation(pcSourceHeader, "PKey", pcSourceDetail, "FKey")
4770 * --- TR 1018184 RLN 12/14/06
4771 lnLastHdr = -1
4772 Select (pcSourceDetail)
4773 Scan For &pcCondition && [&pcSourceHeader..auto_proc= "Y"]
4774 * --- TR 1018184 RLN 12/14/06
4775 lnHeaderPkey = FKey
4776 This.AdvanceThermoPlus(@l_nThermoCnt)
4777 *--- TechRec 1005163 14-May-2004 GS ---
4778 *llOKtoContinue= This.CreateRecordWithPkey(pcSourceDetail, pcTargetDetail)
4779 lnOldDtlPKey = Pkey
4780 *- 1013175 09/29/05 YIK
4781 *- We don't need lnNewDtlPKey. detail Pkey is not being changed when moving, so
4782 *- there's no need to overwrite the pcTargetSLN.fkey
4783 *-lnNewDtlPKey = Evaluate(pcTargetDetail + ".PKey") && TR 1011340 NH
4784
4785 llOKtoContinue= This.CreateRecordWithPkey(pcSourceDetail, pcTargetDetail)
4786 If llSLN And llOKtoContinue
4787 *!* lnNewDtlPKey = Evaluate(pcTargetDetail + ".PKey") && TR 1011340 NH
4788
4789 If Seek (lnOldDtlPKey, pcSourceSLN)
4790 lnCnt = 0
4791 Select (pcSourceSLN)
4792 Scan While Fkey = lnOldDtlPKey
4793 Scatter Memvar Memo
4794 Select (pcTargetSLN)
4795 Append Blank
4796 Gather Memvar Memo
4797 lnCnt = lnCnt + 1
4798 *- 1013175 09/29/05 YIK
4799 *- We don't need lnNewDtlPKey. detail Pkey is not being changed when moving, so
4800 *- there's no need to overwrite the pcTargetSLN.fkey
4801 *- replace Fkey with lnNewDtlPKey
4802
4803 Endscan
4804
4805*- TR 1063600 YIK/FH- Why are we reassigning sln pkey?, when we aren't assigning any new pkey for HDR, DTL, everything else?
4806*!* m.Pkey = v_NextPkey(lcSlnPKeySrc, lnCnt) + 1
4807*!* Select (pcTargetSLN)
4808*!* For i = 1 To lnCnt
4809*!* Replace Pkey With m.Pkey - i
4810*!* Skip -1
4811*!* ENDFOR
4812*- TR 1063600 YIK/FH- Why are we reassigning sln pkey?, when we aren't assigning any new pkey for HDR, DTL, everything else?
4813
4814
4815 *-- 1010273 YIK 03/23/05
4816 Select (pcSourceSLN)
4817 If Seek(lnOldDtlPKey)
4818 Delete While Fkey = lnOldDtlPKey
4819 Endif
4820 *- delete in (pcSourceSLN) for FKey = lnOldDtlPKey
4821 *==
4822
4823 Endif
4824 Endif
4825
4826 *--- TechReq 1028745 31-Jan-2008 GSternik ---
4827 if llExt and llOkToContinue
4828 *-- Somehow this code moves record in (pcSourceDetail)
4829 *lnOldRecNo = RecNo(pcSourceDetail) && the relation was not properly closed!
4830 *-- Moving Extender Data: No New records, Just change 3 Key values:
4831 select qExtMData
4832 Set order to tag Udf_Grp_I && Str(UdfFKey)+Str(Grp_I_Key) tag Udf_Grp_I
4833
4834 Select (lcSourceExtD)
4835 Set order to tag DtlFKey
4836
4837 *Do while Seek (lnOldDtlPKey, lcSourceExtD) -- needed if we going to change DtlFKey
4838 =Seek(lnOldDtlPKey)
4839 *-- We do not move any Data from Extender Intrface view to Transaction view,
4840 *-- because they BOTH based on ZZZUDFDT! Just changing the group reference:
4841 Scan while DtlFKey = lnOldDtlPKey
4842 if Seek(Str(UdfFKey)+Str(GrpFKey), "qExtMData")
4843 replace GrpFKey with qExtMData.Grp_T_Key
4844 EndIf
4845 EndScan
4846 *Go lnOldRecNo in (pcSourceDetail)
4847 Endif
4848
4849 *-- Moving Charges data:
4850 If llChrg and llOKtoContinue
4851 Set order to tag FKey in (lcSourceChrg)
4852 If Seek (lnOldDtlPKey, lcSourceChrg)
4853 lnCnt = 0
4854 Select (lcSourceChrg)
4855 Scan While FKey = lnOldDtlPKey
4856 Scatter Memvar Memo
4857 Select (lcTargetChrg)
4858 Append Blank
4859 Blank
4860 Gather Memvar Memo
4861 Replace HdrFKey with lnHeaderPKey
4862 lnCnt = lnCnt + 1
4863 *- We don't need lnNewDtlPKey. detail Pkey is not being changed when moving, so
4864 *- there's no need to overwrite the FKEy in lcTargetChrg
4865 EndScan
4866 m.PKey = v_NextPkey("ZZXCHRDS", lnCnt) + 1
4867 Select (lcTargetChrg)
4868 For i = 1 To lnCnt
4869 Replace Pkey With m.Pkey - i
4870 Skip -1
4871 Endfor
4872
4873 Select (lcSourceChrg)
4874 If Seek(lnOldDtlPKey)
4875 Delete While FKey = lnOldDtlPKey
4876 EndIf
4877 Endif
4878 Endif
4879 *=== TechRec 1028745 05-Feb-2008 GSternik ===
4880
4881 * --- TR 1018184
4882 If llSAC And llOKtoContinue
4883 Select (pcSourceSAC)
4884 If lnHeaderPkey <> lnLastHdr
4885 Set Order To hfkey
4886 If Seek (lnHeaderPkey, pcSourceSAC)
4887 Scan While hfkey = lnHeaderPkey
4888 Scatter Memvar Memo
4889 Select (pcTargetSAC)
4890 Append Blank
4891 Gather Memvar Memo
4892 Endscan
4893 Select (pcSourceSAC)
4894 If Seek(lnHeaderPkey)
4895 Delete While hfkey = lnHeaderPkey
4896 Endif
4897 Endif
4898 Endif
4899 Endif
4900 * === TR 1018184
4901
4902 *--- TR 1044017 04-JAN-2010 HNISAR
4903 If llWhsData And llOKtoContinue
4904 Select (lcSourceWhse)
4905 If lnHeaderPkey <> lnLastHdr
4906 Set Order To hfkey
4907 If Seek (lnHeaderPkey, lcSourceWhse)
4908 Scan While hfkey = lnHeaderPkey
4909 Scatter Memvar Memo
4910 Select (lcTargateWhse)
4911 Append Blank
4912 Gather Memvar Memo
4913 Endscan
4914 Select (lcSourceWhse)
4915 If Seek(lnHeaderPkey)
4916 Delete While hfkey = lnHeaderPkey
4917 Endif
4918 Endif
4919 Endif
4920 Endif
4921 *=== TR 1044017 04-JAN-2010 HNISAR
4922
4923 *--- TR 1011340 NH
4924 If llDtlNotes And llOKtoContinue
4925 If Seek(lnOldDtlPKey,pcSourceDtlNotes,"fkey")
4926 Select(pcSourceDtlNotes)
4927 Scan While Fkey = lnOldDtlPKey
4928 Scatter Name loDtlNotes Memo
4929 loDtlNotes.table_name = pcTargetDtlNotesTableName
4930 Select(pcTargetDtlNotes)
4931 Append Blank
4932 Gather Name loDtlNotes Memo
4933 Endscan
4934 Select (pcSourceDtlNotes)
4935 If Seek(lnOldDtlPKey,pcSourceDtlNotes,"fkey")
4936
4937 * --- TR 1038135 1/16/09 CM
4938 * Using Delete while on buffered views drastically slows down 850
4939 * especially when there are thousands of records. Created a new table
4940 * and inserting pkeys from my source table.
4941 *Delete While Fkey = lnOldDtlPKey
4942 SCAN WHILE fkey = lnOldDtlPkey
4943 SELECT(pcSourceDtlNotes)
4944 INSERT INTO CurDtlNotePkey Values(EVALUATE(pcSourceDtlNotes + ".pkey"))
4945 ENDSCAN
4946 * === TR 1038135 1/16/09 CM
4947
4948 Endif
4949 Endif
4950 Endif
4951 *=== TR 1011340 NH
4952
4953 *=== TechRec 1005163 14-May-2004 GS ===
4954 Delete In (pcSourceDetail)
4955
4956 *--- TR 1055192 26-07-2011 ---*
4957 If llcfhData And llOKtoContinue
4958
4959 Select (lcSourcecfh)
4960 Set Order To fkey
4961 If Seek (lnHeaderPkey, lcSourcecfh)
4962 lnseq_no = 0
4963 Scan While fkey = lnHeaderPkey
4964 SELECT (pcSourceHeader)
4965 SCATTER NAME loSourceHeader Memo
4966 SELECT (lcSourcecFh)
4967 Scatter NAME loSourceFactor Memo
4968 This.Update_FactorOtherDetails(@loSourceFactor,loSourceHeader)
4969 Select (lcTargatecfh)
4970 Append Blank
4971 Gather NAME loSourceFactor Memo
4972 replace factor_seq WITH lnSeq_no &&, facexpir_basis WITH 'A'
4973 lnseq_no= lnseq_no +1
4974 SELECT (lcSourcecfh)
4975 Endscan
4976 Select (lcSourcecfh)
4977 This.Update_FactorDetailsToHeader(lnHeaderPkey,lcTargatecfh,pcSourceHeader)
4978 If Seek(lnHeaderPkey)
4979 Delete While fkey = lnHeaderPkey
4980 Endif
4981 ENDIF
4982 ENDIF
4983 SELECT (pcSourceDetail)
4984 *=== TR 1055192 26-07-2011 RKI ===*
4985
4986 Endscan
4987
4988 * --- TR 1038135 1/16/09 CM
4989 * Now it's time to find the notes pkeys that we inserted into our local cursor
4990 * and based on those delete the records from our source notes table
4991 SELECT CurDtlNotePkey
4992 SCAN
4993 IF SEEK(CurDtlNotePkey.pkey,pcSourceDtlNotes,"pkey")
4994 SELECT (pcSourceDtlNotes)
4995 DELETE IN (pcSourceDtlNotes)
4996 ENDIF
4997 ENDSCAN
4998 * === TR 1038135 1/16/09 CM
4999
5000 Set Relation To
5001 Else
5002 llOKtoContinue= .F. && Cannot set relation into header don't continue
5003 Endif
5004
5005 *--- TR 1011340 NH
5006 If !plNoLog
5007 .AdvanceThermoTotalWithCaptionPlus("Creating Header Notes records...", ;
5008 vcLogName)
5009 Endif
5010
5011 If llOKtoContinue And llHdrNotes && TR 1011473 NH : added conditions
5012 If .SetRelation(pcSourceHeader,"Pkey",pcSourceHdrNotes,"fkey")
5013 Select(pcSourceHdrNotes)
5014 Scan For &pcCondition
5015 Scatter Name loHdrNotes Memo
5016 loHdrNotes.table_name = pcTargetHdrNotesTableName
5017 Select (pcTargetHdrNotes)
5018 Append Blank
5019 Gather Name loHdrNotes Memo
5020 Delete In (pcSourceHdrNotes)
5021 Endscan
5022 Endif
5023 Endif
5024 *=== TR 1011340 NH
5025
5026 *<<<<<<<<<<moving COMMENT records from source to target>>>>>>>>>>>>>
5027 If !plNoLog
5028 .AdvanceThermoTotalWithCaptionPlus("Creating comment records...", ;
5029 vcLogName)
5030 Endif
5031 If llOKtoContinue &&And pnMaxComment> 0
5032 If .SetRelation(pcSourceHeader, "Pkey", pcSourceComment, "fkey")
5033 Select (pcSourceComment)
5034 Scan For &pcCondition
5035 llOKtoContinue= This.CreateRecordWithPkey(pcSourceComment, pcTargetComment)
5036 If !llOKtoContinue
5037 Exit
5038 Endif
5039 Delete In (pcSourceComment)
5040 Endscan
5041 Set Relation To
5042 Else
5043 llOKtoContinue= .F. && Cannot set relation into header don't continue
5044 Endif
5045 Endif
5046
5047 *--- TR 1088047 31-8-2015 VKK
5048 *<<<<<<<<<<moving HDR2 records from source to target>>>>>>>>>>>>>
5049 If !plNoLog AND llHDR2
5050 .AdvanceThermoTotalWithCaptionPlus("Creating HDR2 records...", ;
5051 vcLogName)
5052 Endif
5053 If llOKtoContinue AND llHDR2
5054 If .SetRelation(pcSourceHeader, "Pkey", pcSourceHDR2, "fkey")
5055 Select (pcSourceHDR2)
5056 Scan For &pcCondition
5057 llOKtoContinue= This.CreateRecordWithPkey(pcSourceHDR2, pcTargetHDR2)
5058 If !llOKtoContinue
5059 Exit
5060 Endif
5061 Delete In (pcSourceHDR2)
5062 Endscan
5063 Set Relation To
5064 Else
5065 llOKtoContinue= .F. && Cannot set relation into header don't continue
5066 Endif
5067 ENDIF
5068 *=== TR 1088047 31-8-2015 VKK
5069
5070 *<<<<<<<<<<moving ADDRESS records from source to target>>>>>>>>>>>>>
5071 If !plNoLog
5072 .AdvanceThermoTotalWithCaptionPlus("Creating address records...", ;
5073 vcLogName)
5074 Endif
5075 If llOKtoContinue &&And pnMaxAddress>0
5076 If .SetRelation(pcSourceHeader, "Pkey", pcSourceAddress, "fkey")
5077 l_nThermoCnt = 0
5078 .InitThermoWithCaption(@l_nThermoCnt, Recc(pcSourceAddress), ;
5079 "Creating " + pcInterHist + " address records...")
5080 Select (pcSourceAddress)
5081 Scan For &pcCondition
5082 .AdvanceThermoPlus(@l_nThermoCnt)
5083 llOKtoContinue= This.CreateRecordWithPkey(pcSourceAddress, pcTargetAddress)
5084 If !llOKtoContinue
5085 Exit
5086 Endif
5087 Delete In (pcSourceAddress)
5088 Endscan
5089 Set Relation To
5090 Else
5091 llOKtoContinue= .F. && Cannot set relation into header don't continue
5092 Endif
5093 Endif
5094
5095 *<<<<<<<<<<moving header records from source to target>>>>>>>>>>>>>
5096 If !plNoLog
5097 .AdvanceThermoTotalWithCaptionPlus("Creating header records...", ;
5098 vcLogName)
5099 Endif
5100 If llOKtoContinue
5101 If !plNoLog
5102 l_nThermoCnt = 0
5103 .InitThermoWithCaption(@l_nThermoCnt, Recc(pcSourceHeader), ;
5104 "Creating " + pcInterHist + " header records...")
5105 Endif
5106 Select (pcSourceHeader)
5107 Scan For &pcCondition
5108 If !plNoLog
5109 .AdvanceThermoPlus(@l_nThermoCnt)
5110 Endif
5111 llOKtoContinue= This.CreateRecordWithPkey(pcSourceHeader, pcTargetHeader)
5112 If !llOKtoContinue
5113 Exit
5114 Endif
5115 Delete In (pcSourceHeader)
5116 If !plNoLog
5117 .ResetThermoPlus()
5118 Endif
5119 Endscan
5120 Endif
5121
5122 *--- TechRec 1056973 02-Dec-2011 jisingh ---
5123 *--- TechRec 1058326 13-Dec-2011 jisingh ---
5124*!* IF llOKtoContinue AND "IPO" $ UPPER(pcTargetHeader)
5125*!* IF .SetRelation(pcTargetSLN, "SLN_Line", lcTargateWhse, "Str(Doc_Num)+EDI_Line+SLN_Line")
5126*!* SELECT (lcTargateWhse)
5127*!* REPLACE ALL sfkey WITH EVALUATE(pcTargetSLN+ ".pkey")
5128*!* ENDIF
5129*!* SET RELATION TO
5130*!* ENDIF
5131*!*
5132*!* IF llOKtoContinue AND "IPO" $ UPPER(pcTargetHeader)
5133*!* IF .SetRelation(pcTargetDetail, "PO1_Line", lcTargateWhse, "Str(Doc_Num)+ edi_line")
5134*!* SELECT (lcTargateWhse)
5135*!* REPLACE ALL dfkey WITH EVALUATE(pcTargetDetail+ ".pkey")
5136*!* ENDIF
5137*!* SET RELATION TO
5138*!* ENDIF
5139
5140 *-1059065 FH
5141
5142*- TR 1063600 YIK/FH- Shoulnd't need this now, because we commented getting new pkey for SLN above
5143*!* IF llOKtoContinue AND "IPO" $ UPPER(pcTargetHeader)
5144*!* IF .SetRelation(pcTargetSLN, "SLN_Line", lcTargateWhse, "Str(Doc_Num)+EDI_Line+SLN_Line")
5145*!* SELECT (lcTargateWhse)
5146*!* REPLACE ALL sfkey WITH EVALUATE(pcTargetSLN+ ".pkey") FOR NOT EOF(pcTargetSLN)
5147*!* ENDIF
5148*!* SET RELATION TO
5149*!* ENDIF
5150*- TR 1063600 YIK/FH- Shoulnd't need this now, because we commented getting new pkey for SLN above
5151
5152*!* IF llOKtoContinue AND "IPO" $ UPPER(pcTargetHeader)
5153*!* IF .SetRelation(pcTargetDetail, "PO1_Line", lcTargateWhse, "Str(Doc_Num)+ edi_line")
5154*!* SELECT (lcTargateWhse)
5155*!* REPLACE ALL dfkey WITH EVALUATE(pcTargetDetail+ ".pkey") FOR EMPTY(sfkey) AND NOT EOF(pcTargetDetail) && EDID
5156*!* ENDIF
5157*!* SET RELATION TO
5158
5159*!* IF .SetRelation(pcTargetDetail, "PO1_Line", lcTargateWhse, "Str(Doc_Num)+edi_line+sln_line")
5160*!* SELECT (lcTargateWhse)
5161*!* REPLACE ALL dfkey WITH EVALUATE(pcTargetDetail+ ".pkey") FOR !EMPTY(sfkey) AND NOT EOF(pcTargetDetail) && EDIS
5162*!* ENDIF
5163*!* SET RELATION TO
5164*!* ENDIF
5165*!*
5166 *-1059065 FH
5167 *=== TechRec 1058326 13-Dec-2011 jisingh ===
5168 *=== TechRec 1056973 02-Dec-2011 jisingh ===
5169
5170 Select(lnOldSelect)
5171 Return llOKtoContinue
5172 Endproc
5173
5174 ************************************************************************************
5175 * call from local cursor (NOT BUFFER VIEWS)
5176 ************************************************************************************
5177 Procedure CountTransactionAndInterface
5178 Parameters pcTranHeader, pcTranDetail, pcTranComment, pcTranAddress
5179 Local llRetVal , lnOldSelect, ltDatetime
5180 llRetVal= .T.
5181
5182 Select Count(*) As MaxHdr From (pcTranHeader) Into Cursor _HdrCnt ;
5183 Where (Errs_flg_H<> "Y")
5184 If Used("_HdrCnt") And _HdrCnt.MaxHdr>0
5185 .nTranHeader= _HdrCnt.MaxHdr
5186 .nInterHeader= .nInterHeader + _HdrCnt.MaxHdr
5187 Endif
5188
5189 Select Count(*) As MaxDtl From (pcTranHeader) h, (pcTranDetail) d ;
5190 into Cursor _DtlCnt ;
5191 Where (h.Errs_flg_H<> "Y" And h.Pkey= d.Fkey)
5192 If Used("_DtlCnt") And _DtlCnt.MaxDtl>0
5193 .nTranDetail= _DtlCnt.MaxDtl
5194 .nInterDetail= .nInterDetail + _DtlCnt.MaxDtl
5195 Endif
5196
5197 Select Count(*) As MaxCmt From (pcTranHeader) h, (pcTranComment) d ;
5198 into Cursor _CmtCnt ;
5199 Where (h.Errs_flg_H<> "Y" And h.Pkey= d.Fkey)
5200 If Used("_CmtCnt") And _CmtCnt.MaxCmt>0
5201 .nTranComment= _CmtCnt.MaxCmt
5202 .nInterComment= .nInterComment + _CmtCnt.MaxCmt
5203 Use In _CmtCnt
5204 Endif
5205
5206 Select Count(*) As MaxAdr From (pcTranHeader) h, (pcTranAddress) d ;
5207 into Cursor _AdrCnt ;
5208 Where (h.Errs_flg_H<> "Y" And h.Pkey= d.Fkey)
5209 If Used("_AdrCnt") And _AdrCnt.MaxAdr>0
5210 .nTranAddress= _AdrCnt.MaxAdr
5211 .nInterAddress= .nInterAddress + _AdrCnt.MaxAdr
5212 Endif
5213
5214 If Used("_HdrCnt")
5215 Use In _HdrCnt
5216 Endif
5217 If Used("_DtlCnt")
5218 Use In _DtlCnt
5219 Endif
5220 If Used("_CmtCnt")
5221 Use In _CmtCnt
5222 Endif
5223 If Used("_AdrCnt")
5224 Use In _AdrCnt
5225 Endif
5226
5227 Return llRetVal
5228 Endproc
5229
5230 *******************************************************************************************
5231 * Validate UPC,SKU [SSC]
5232 *******************************************************************************************
5233 * 1. create Server-Side Cursor of distinct customer,division,style,color,lbl_code,dimension,
5234 * sizebucket.
5235 * 2. join server temp table with zzxcstdr to get a list of matching SKU,size_bucket
5236 * 3. replace all (SetRelation) cust,div,sty,col,lbl,dim,sizebk with SKU,size_bucket from step 2
5237 * 4. join server temp table with zzeupcnr to get a list of matching UPC,size_bucket
5238 * 5. replace all (SetRelation) div,sty,col,lbl,dim,sizebk with UPC,size_bucket from step 4
5239 ******************************************************************************************
5240 * PL 01/22/01- 4973 810(o) & 4975- JSSI Shared UPC - EDI 856(o) Process - Resolve share UPC
5241 * YIK 07/09/03 - Add 3d parameter
5242 Procedure CheckUPCSKU
5243 Lparameters pcTransHeader, pcTransDetail, pcSkipPpkUpc
5244 Local llRetVal, lnOldSelect, lcWhere, lcWhere1, lcSql && Added lcSQL, lcWhere1 for TR 1012634 16/Aug/2005 SK
5245 llRetVal = .T.
5246 lnOldSelect = Select()
5247 *- 40085 6/12/03 YIK
5248 *- Select only those that have SkipPpkUPC = 'N'
5249 *- 40935 7/9/03 YIK
5250 *- Adjust where expression based on pcSkipPpkUpc parameter.
5251 *- 1004006 3/15/04 YIK
5252 *- Added ..or d.Implosion <> "Y" to make sure that only UPCs for Prepack are not populated.
5253
5254 *--- TechRec 1029436 25-Mar-2008 vkrishnamurthy ---
5255 LOCAL lcIs_upcskuStr , lcSQLString
5256 *=== TechRec 1029436 25-Mar-2008 vkrishnamurthy ===
5257
5258 lcWhere = 'h.Pkey = d.Fkey and h.sku_upc<> "N" ' + ;
5259 IIf(pcSkipPpkUpc, 'and (d.SkipPpkUpc = "N" or d.Implosion <> "Y") ', "")
5260
5261 *--- TechRec 1028770 09-Jan-2008 vkrishnamurthy ---
5262*!* Select distinct d.customer, d.division, d.style, d.color_code, d.Lbl_code, d.dimension,;
5263*!* d.sizebucket From (pcTransHeader) h, (pcTransDetail) d ;
5264*!* Where &lcWhere ;
5265*!* Order by 1,2,3,4,5,6,7 Into Cursor __TmpCursor
5266
5267 *--- TechRec 1029436 25-Mar-2008 vkrishnamurthy ---
5268*!* Select distinct d.customer, d.division, d.style, d.color_code, d.Lbl_code, d.dimension,;
5269*!* d.sizebucket ,h.sku_upc From (pcTransHeader) h, (pcTransDetail) d ;
5270*!* Where &lcWhere ;
5271*!* Order by 1,2,3,4,5,6,7 ,8 Into Cursor __TmpCursor
5272
5273 SELECT (pcTransDetail)
5274 lcIs_upcskuStr = IIF ( VARTYPE (Is_upcsku) = 'C', " Is_upcsku", " ' ' as Is_upcsku")
5275
5276 lcSQLString = "Select Distinct d.customer, d.division, d.Style, d.color_code, d.Lbl_code, " + ;
5277 "d.Dimension, d.sizebucket,h.sku_upc, " + lcIs_upcskuStr + ;
5278 " From (pcTransHeader) h, (pcTransDetail) d " + ;
5279 " Where " + lcWhere + ;
5280 "Order By 1,2,3,4,5,6,7 Into Cursor __TmpCursor"
5281
5282 &lcSQLString
5283 *=== TechRec 1029436 25-Mar-2008 vkrishnamurthy ===
5284
5285 *=== TechRec 1028770 09-Jan-2008 vkrishnamurthy ===
5286
5287
5288 *= 40935 YIK
5289
5290 With This
5291 .cSQLTempTable=""
5292 If .GenerateSQLTempTable('__TmpCursor')
5293 If .PopulateSQLTempTable('__TmpCursor')
5294 If !Empty(.cSQLTempTable)
5295 * PL 01/22/01- 4973 810(o) & 4975- JSSI Shared UPC - EDI 856(o) Process - Resolve share UPC
5296 * move code to CheckOutboundSKU & CheckOutboundUPC
5297 *- 1004006 3/16/04 YIK
5298 *- Sent new parameter pcSkipPpkUpc to properly set up error flag
5299 llRetVal= llRetVal And .CheckOutboundSKU(pcTransHeader, pcTransDetail, ;
5300 .cSQLTempTable, pcSkipPpkUpc)
5301 llRetVal= llRetVal And .CheckOutboundUPC(pcTransHeader, pcTransDetail, ;
5302 .cSQLTempTable,, pcSkipPpkUpc)
5303 *--- TR 1003431 02/23/04 AM Adding EAN Aware Functionality
5304 llRetVal= llRetVal And .CheckOutboundEAN(pcTransHeader, pcTransDetail, ;
5305 .cSQLTempTable,,pcSkipPpkUpc)
5306 *=== TR 1003431 02/23/04 AM
5307 Endif
5308 Endif
5309 Endif
5310
5311 *--- TR 1012634 16/Aug/2005 SK Added SKU resolution for store and department
5312 *- To ensure optimum performance for the existing logic (resolution by Customer+BCSKU)
5313 lcWhere1 = lcWhere + " and h.customer = c.customer and h.division = c.division"
5314
5315 *--- TR 1031442 17-Jun-2008 Goutam. Changed to zzeipocr_expl from zzeipocr in the following sql.
5316 lcSql = "SELECT a.* FROM zzeipocr_expl a JOIN " + .cSQLTempTable + " b ON " + ;
5317 " a.customer = b.customer AND a.division = b.division"
5318
5319 llRetVal = llRetVal And v_SQLexec(lcSql,"tcEipocr")
5320
5321 *--- TechRec 1028770 19-Mar-2008 vkrishnamurthy ---
5322*!* Select Distinct d.customer, d.division, d.Style, d.color_code, d.Lbl_code, d.Dimension,;
5323*!* d.sizebucket, h.Store From (pcTransHeader) h, (pcTransDetail) d, tcEipocr C ;
5324*!* Where &lcWhere1 And C.sku_resolv = "S" ;
5325*!* Order By 1,2,3,4,5,6,7, 8 Into Cursor S__TmpCursor
5326
5327 *---TR 1037936 JAN-07-08 BR - CHANGED: local SQL to use lcSQLString, added + lcIs_upcskuStr +.
5328 lcSQLString = "Select Distinct d.customer, d.division, d.Style, d.color_code, d.Lbl_code, d.Dimension, " +;
5329 "d.sizebucket, h.Store ,h.sku_upc, " + lcIs_upcskuStr + " From (pcTransHeader) h, (pcTransDetail) d, tcEipocr C " +;
5330 "Where " + lcWhere1 + " And C.sku_resolv = 'S' " +;
5331 "Order By 1,2,3,4,5,6,7, 8 ,9 Into Cursor S__TmpCursor"
5332
5333 &lcSQLString
5334 *===TR 1037936 JAN-07-08 BR
5335
5336 *=== TechRec 1028770 19-Mar-2008 vkrishnamurthy ===
5337
5338 .cSQLTempTable=""
5339 If .GenerateSQLTempTable('S__TmpCursor')
5340 If .PopulateSQLTempTable('S__TmpCursor')
5341 If !Empty(.cSQLTempTable)
5342 llRetVal= llRetVal And .CheckOutboundSKU(pcTransHeader, pcTransDetail, ;
5343 .cSQLTempTable, pcSkipPpkUpc, "S")
5344 Endif
5345 Endif
5346 Endif
5347
5348 *--- TechRec 1028770 19-Mar-2008 vkrishnamurthy ---
5349*!* Select Distinct d.customer, d.division, d.Style, d.color_code, d.Lbl_code, d.Dimension,;
5350*!* d.sizebucket, h.department From (pcTransHeader) h, (pcTransDetail) d, tcEipocr C ;
5351*!* Where &lcWhere1 And C.sku_resolv = "D" ;
5352*!* Order By 1,2,3,4,5,6,7, 8 Into Cursor D__TmpCursor
5353
5354 *---TR 1037936 JAN-07-08 BR - CHANGED: local SQL to use lcSQLString, added + lcIs_upcskuStr +.
5355 lcSQLString = "Select Distinct d.customer, d.division, d.Style, d.color_code, d.Lbl_code, d.Dimension, " +;
5356 "d.sizebucket, h.department ,h.sku_upc, " + lcIs_upcskuStr + " From (pcTransHeader) h, (pcTransDetail) d, tcEipocr C " +;
5357 "Where " + lcWhere1 + " And C.sku_resolv = 'D' " +;
5358 "Order By 1,2,3,4,5,6,7, 8,9 Into Cursor D__TmpCursor"
5359
5360 &lcSQLString
5361 *===TR 1037936 JAN-07-08 BR
5362
5363 *=== TechRec 1028770 19-Mar-2008 vkrishnamurthy ===
5364
5365 .cSQLTempTable=""
5366 If .GenerateSQLTempTable('D__TmpCursor')
5367 If .PopulateSQLTempTable('D__TmpCursor')
5368 If !Empty(.cSQLTempTable)
5369 llRetVal= llRetVal And .CheckOutboundSKU(pcTransHeader, pcTransDetail, ;
5370 .cSQLTempTable, pcSkipPpkUpc, "D")
5371 Endif
5372 Endif
5373 Endif
5374 *=== TR 1012634 16/Aug/2005 SK
5375 Endwith
5376
5377 Select(lnOldSelect)
5378 Return llRetVal
5379 Endproc
5380
5381 ******************************************************************************************
5382 * PL 01/22/01- 4973 810(o) & 4975- JSSI Shared UPC - EDI 856(o) Process - Resolve share UPC
5383 * 1004006 3/16/04 YIK Add new parameter pcSkipPpkUpc
5384 ******************************************************************************************
5385 Procedure CheckOutboundSKU
5386 *--- TR 1012634 16/Aug/2005 SK Added parameter pcSkuResolv
5387 Lparameters pcTransHeader, pcTransDetail, pcSQLTempTable, pcSkipPpkUpc, pcSkuResolv
5388 Local llRetVal, lnOldSelect, lcForExpr, lcFilter && Added lcFilter for TR 1012634 16/Aug/2005 SK
5389 llRetVal = .T.
5390 lnOldSelect = Select()
5391 With This
5392 *--- TR 1012634 16/Aug/2005 SK
5393 *lcSQLString= "Select t.customer, t.division, t.style, t.color_code," +;
5394 "t.lbl_code, t.dimension, t.sizebucket, s.size_desc, s.cust_style " +;
5395 "From zzxcstdr s, " + pcSQLTempTable + " t " +;
5396 "Where s.division= t.division and s.customer=t.customer and " +;
5397 "s.style= t.style and s.color_code= t.color_code and " +;
5398 "s.lbl_code= t.lbl_code and s.dimension= t.dimension and " +;
5399 "s.size_bk= t.sizebucket"
5400
5401 If Not Empty(pcSkuResolv)
5402 Do Case
5403 Case pcSkuResolv = "S"
5404 lcFilter = " AND s.cust_store = t.store "
5405 Case pcSkuResolv = "D"
5406 lcFilter = " AND s.udf_dept = t.department "
5407 Endcase
5408
5409 Else
5410 *lcFilter = " " && TR 1037936 JAN-07-08 BR - REMOVED
5411 ENDIF
5412
5413 *--- TechRec 1029436 25-Mar-2008 vkrishnamurthy ---
5414 *- added t.is_upcsku
5415 *=== TechRec 1029436 25-Mar-2008 vkrishnamurthy ===
5416
5417 *---TR 1037936 JAN-07-08 BR
5418 IF EMPTY(pcSkuResolv)
5419 *--- TechRec 1043592 22-Dec-2009 JK Added s.aux_sku ====
5420 *--- TechRec 1056973 17-Nov-2011 jisingh Added s.pkey as sfkey ===
5421 *--- TR 1073064 30-Aug-13 Venuk.Added AND t.sku_upc <> 'Z'===
5422 lcSQLString= "Select distinct 1 Rank, t.customer, t.division, t.style, t.color_code," +;
5423 "t.lbl_code, t.dimension, t.sizebucket, s.size_desc, s.cust_style, " +;
5424 "s.cust_store, s.udf_dept , t.is_upcsku, s.aux_sku, s.pkey as sfkey " + ;
5425 "From zzxcstdr s, " + pcSQLTempTable + " t " +;
5426 "Where s.division= t.division and s.customer=t.customer and " +;
5427 "s.style= t.style and s.color_code= t.color_code and " +;
5428 "s.lbl_code= t.lbl_code and s.dimension= t.dimension and " +;
5429 "s.size_bk= t.sizebucket and s.udf_dept = ' ' and s.cust_store = ' '" +;
5430 " AND t.sku_upc <> 'X' AND t.sku_upc <> 'Z' " + ; &&TR 1059449 FH- added t.sku_upc<> 'X'
5431 " UNION " +;
5432 "Select distinct 2 Rank, t.customer, t.division, t.style, t.color_code," +;
5433 "t.lbl_code, t.dimension, t.sizebucket, s.size_desc, s.cust_style, " +;
5434 "s.cust_store, s.udf_dept , t.is_upcsku, s.aux_sku, s.pkey as sfkey " + ;
5435 "From zzxcstdr s, " + pcSQLTempTable + " t " +;
5436 "Where s.division= t.division and s.customer=t.customer and " +;
5437 "s.style= t.style and s.color_code= t.color_code and " +;
5438 "s.lbl_code= t.lbl_code and s.dimension= t.dimension and " +;
5439 "s.size_bk= t.sizebucket and (s.udf_dept <> ' ' or s.cust_store <> ' ')" +;
5440 " AND t.sku_upc <> 'X' AND t.sku_upc <> 'Z' " &&TR 1059449 FH- added t.sku_upc<> 'X'
5441 ELSE
5442 *===TR 1037936 JAN-07-08 BR
5443 *--- TechRec 1043592 22-Dec-2009 JK Added s.aux_sku ====
5444 *--- TechRec 1056973 17-Nov-2011 jisingh Added s.pkey as sfkey ===
5445 lcSqlString= "Select t.customer, t.division, t.style, t.color_code," +;
5446 "t.lbl_code, t.dimension, t.sizebucket, s.size_desc, s.cust_style, " +;
5447 "s.cust_store, s.udf_dept, t.is_upcsku, s.aux_sku, s.pkey as sfkey " + ;
5448 "From zzxcstdr s, " + pcSQLTempTable + " t " +;
5449 "Where s.division= t.division and s.customer=t.customer and " +;
5450 "s.style= t.style and s.color_code= t.color_code and " +;
5451 "s.lbl_code= t.lbl_code and s.dimension= t.dimension and " +;
5452 "s.size_bk= t.sizebucket" + lcFilter + " AND t.sku_upc <> 'X' " &&TR 1059449 FH- added t.sku_upc<> 'X'
5453
5454 ENDIF && TR 1037936 JAN-07-08 BR
5455
5456 *=== TR 1012634 16/Aug/2005 SK
5457
5458
5459 *TR 1059449 FH - commented out
5460 *--- TechRec 1028770 09-Jan-2008 vkrishnamurthy ---
5461 *lcSQLString = lcSQLString + " AND t.sku_upc <> 'X' "
5462 *=== TechRec 1028770 09-Jan-2008 vkrishnamurthy ===
5463 *TR 1059449 FH - commented out
5464
5465
5466 llRetVal = v_SQLexec(lcSqlString, "__SKU")
5467 If llRetVal
5468 * Populate SKU,size_desc from result of server-side temp keys + join zzxcstdr
5469 Select __SKU
5470
5471 *--- TR 1012634 16/Aug/2005 SK
5472 Index On customer+division+Style+color_code+Lbl_code+Dimension+Str(sizebucket) ;
5473 Tag OurSku
5474
5475 llRetVal= .SetRelation("__SKU", "OurSKU", pcTransDetail, ;
5476 "Customer+Division+Style+color_code+lbl_code+dimension+Str(sizebucket)")
5477
5478 If Not Empty(pcSkuResolv) && use pkey/fkey as realtion
5479 Select (pcTransHeader)
5480 Set Order To Pkey
5481 Select (pcTransDetail)
5482 Set Relation To Fkey Into &pcTransHeader Additive
5483 Endif
5484 *=== TR 1012634 16/Aug/2005 SK
5485
5486 If llRetVal
5487 *- 1005734 07/08/04 YIK
5488 *- Added ..FOR !EOF("__SKU") to avoid blanking out of size desc.
5489
5490 *--- TR 1012634 19/Aug/2005 SK
5491 *!* Replace All sku with __SKU.cust_style, size_desc with __SKU.size_desc ;
5492 *!* FOR !EOF("__SKU") ;
5493 *!* in (pcTransDetail)
5494
5495 If Not Empty(pcSkuResolv)
5496
5497 Do Case
5498 Case pcSkuResolv = "S"
5499 *--- TechRec 1029436 25-Mar-2008 vkrishnamurthy ---
5500*!* Replace All sku with __SKU.cust_style, size_desc with __SKU.size_desc ;
5501*!* FOR !EOF("__SKU") AND &pcTransHeader..store=__SKU.cust_store ;
5502*!* in (pcTransDetail)
5503 *--- TechRec 1043592 22-Dec-2009 JK Added aux_sku with __SKU.aux_sku ====
5504 Replace All sku with __SKU.cust_style, size_desc with __SKU.size_desc, aux_sku with IIF(!EMPTY(__SKU.aux_sku), __SKU.aux_sku, aux_sku) ; &&--- TechRec 1056973 16-Nov-2011 jisingh Added IIF ===
5505 FOR !EOF("__SKU") AND &pcTransHeader..store=__SKU.cust_store AND __SKU.Is_UPCSKU <> "C";
5506 in (pcTransDetail)
5507
5508 *--- TechRec 1043592 22-Dec-2009 JK Added aux_sku with '' ====
5509 Replace All UPC with __SKU.cust_style, size_desc with __SKU.size_desc, SKU WITH '', aux_sku with '' ;
5510 FOR !EOF("__SKU") AND &pcTransHeader..store=__SKU.cust_store AND __SKU.Is_UPCSKU == "C" ;
5511 in (pcTransDetail)
5512 *=== TechRec 1029436 25-Mar-2008 vkrishnamurthy ===
5513
5514
5515 Case pcSkuResolv = "D"
5516 *--- TechRec 1029436 25-Mar-2008 vkrishnamurthy ---
5517*!* Replace All sku with __SKU.cust_style, size_desc with __SKU.size_desc ;
5518*!* FOR !EOF("__SKU") AND &pcTransHeader..department=__SKU.udf_dept;
5519*!* in (pcTransDetail)
5520 *--- TechRec 1043592 22-Dec-2009 JK Added aux_sku with __SKU.aux_sku ====
5521 Replace All sku with __SKU.cust_style, size_desc with __SKU.size_desc, aux_sku With IIF(!EMPTY(__SKU.aux_sku), __SKU.aux_sku, aux_sku) ; &&--- TechRec 1056973 16-Nov-2011 jisingh Added IIF ===
5522 FOR !EOF("__SKU") AND &pcTransHeader..department=__SKU.udf_dept AND __SKU.Is_UPCSKU <> "C" ;
5523 in (pcTransDetail)
5524
5525 *--- TechRec 1043592 22-Dec-2009 JK Added aux_sku with '' ====
5526 Replace All UPC with __SKU.cust_style, size_desc with __SKU.size_desc, SKU WITH '', aux_sku with '' ;
5527 FOR !EOF("__SKU") AND &pcTransHeader..department=__SKU.udf_dept AND __SKU.Is_UPCSKU == "C";
5528 in (pcTransDetail)
5529 *=== TechRec 1029436 25-Mar-2008 vkrishnamurthy ===
5530
5531 Endcase
5532
5533 Else
5534
5535 *--- TechRec 1029436 25-Mar-2008 vkrishnamurthy ---
5536 *- Remember, that UPCs originally resolved from cuatomer style reference have Is_UPCsku = 'C'
5537*!* Replace All sku with __SKU.cust_style, size_desc with __SKU.size_desc ;
5538*!* FOR !EOF("__SKU") ;
5539*!* in (pcTransDetail)
5540 SELECT(pcTransDetail)
5541 SCAN FOR ! Eof ("__SKU")
5542 IF __SKU.Is_UPCSKU = 'C'
5543 *--- TR 1066462 26-Jun-2013 SK Removed aux_sku with '' ===
5544 *--- TechRec 1043592 22-Dec-2009 JK Added aux_sku with '' ====
5545 Replace UPC With __SKU.cust_style, size_desc With __SKU.size_desc, SKU WITH '' ;
5546 in (pcTransDetail)
5547 ELSE
5548 *--- TechRec 1043592 22-Dec-2009 JK Added aux_sku with __SKU.aux_sku ====
5549 Replace sku With __SKU.cust_style, size_desc With __SKU.size_desc, aux_sku With IIF(!EMPTY(__SKU.aux_sku), __SKU.aux_sku, aux_sku) ; &&--- TechRec 1056973 16-Nov-2011 jisingh Added IIF ===
5550 in (pcTransDetail)
5551 ENDIF
5552 ENDSCAN
5553 *=== TechRec 1029436 25-Mar-2008 vkrishnamurthy ===
5554
5555 Endif
5556 Set Relation To
5557 Use In __SKU
5558
5559 * Validate SKU
5560 lcErrs_Msg= "Missing SKU code."
5561 *- 1004006 3/16/04 YIK
5562 *!* Replace All Errs_Msg_D with Errs_Msg_D + lcErrs_Msg + CRLF, Errs_Flg_D With "Y" ;
5563 *!* In (pcTransDetail) For (sku_upc="S" or sku_upc="B") And Empty(sku)
5564
5565 *--- TechRec 1028770 13-Jan-2008 vkrishnamurthy ---
5566*!* lcForExpr = '(sku_upc="S" or sku_upc="B") And Empty(sku) ' + ;
5567*!* IIf(pcSkipPpkUpc, 'and (SkipPpkUpc = "N" or Implosion <> "Y") ', '')
5568 *--- TR 1073064 30-Aug-13 Venuk. Added or sku_upc="A"
5569 lcForExpr = '(sku_upc="S" or sku_upc="B" or sku_upc="Y" or sku_upc="A" ) And Empty(sku) ' + ;
5570 IIf(pcSkipPpkUpc, 'and (SkipPpkUpc = "N" or Implosion <> "Y") ', '')
5571 *=== TechRec 1028770 13-Jan-2008 vkrishnamurthy ===
5572
5573 *--- TR 1064585 21-Dec-2012 Goutam
5574 IF (TYPE(pcTransHeader + ".template") = "C") AND UPPER(SUBSTR(pcTransHeader, 4, 3)) = "OIN"
5575
5576 llRetVal= llRetVal and .SetRelation(pcTransHeader, "PKEY", pcTransDetail, "FKEY")
5577 lcForExpr = lcForExpr + " AND !UPPER(&pcTransHeader..template) = 'FORZANI 5010'"
5578 Replace All Errs_Msg_D With Errs_Msg_D + lcErrs_Msg + CRLF, Errs_Flg_D With "Y" ;
5579 In (pcTransDetail) For &lcForExpr
5580 SET RELATION TO
5581 ELSE
5582 *=== TR 1064585 21-Dec-2012 Goutam
5583 *--- TechRec 1088397 31-Aug-2015 asharma ---
5584 IF (TYPE(pcTransHeader + ".template") = "C") AND UPPER(SUBSTR(pcTransHeader, 4, 3)) = "OSH"
5585
5586 llRetVal= llRetVal and .SetRelation(pcTransHeader, "PKEY", pcTransDetail, "FKEY")
5587 lcForExpr = lcForExpr + " AND !UPPER(&pcTransHeader..template) = 'CHARMING SHOPPES 4030'"
5588 Replace All Errs_Msg_D With Errs_Msg_D + lcErrs_Msg + CRLF, Errs_Flg_D With "Y" ;
5589 In (pcTransDetail) For &lcForExpr
5590 SET RELATION TO
5591
5592 ELSE
5593 *=== TechRec 1088397 31-Aug-2015 asharma ===
5594
5595 Replace All Errs_Msg_D With Errs_Msg_D + lcErrs_Msg + CRLF, Errs_Flg_D With "Y" ;
5596 In (pcTransDetail) For &lcForExpr
5597
5598 *--- TechRec 1088397 31-Aug-2015 asharma ---
5599 ENDIF
5600 *=== TechRec 1088397 31-Aug-2015 asharma ===
5601
5602 *--- TR 1064585 21-Dec-2012 Goutam
5603 ENDIF
5604 *=== TR 1064585 21-Dec-2012 Goutam
5605
5606 *= 1004006
5607 Endif
5608 Endif
5609 Endwith
5610
5611 Select(lnOldSelect)
5612 Return llRetVal
5613 Endproc
5614
5615 ******************************************************************************************
5616 * PL 01/22/01- 4973 810(o) & 4975- JSSI Shared UPC - EDI 856(o) Process - Resolve share UPC
5617 * 1004006 3/16/04 YIK Add new parameter pcSkipPpkUpc
5618 ******************************************************************************************
5619 Procedure CheckOutboundUPC
5620 Lparameters pcTransHeader, pcTransDetail, pcSQLTempTable, plNotOverwriteSizeDesc, pcSkipPpkUpc
5621 Local llRetVal, lnOldSelect, lcForExpr
5622 llRetVal = .T.
5623 lnOldSelect = Select()
5624 With This
5625
5626 * 1st pass Validate/Getting UPC using exact match on div,sty,col,lbl,dim
5627 * --- 34208 10-Sep-02 DB2 CHECKED JN (forked code)
5628 *!* lcSQLString= "Select t.division, t.style, t.color_code," +;
5629 *!* "t.lbl_code, t.dimension, t.sizebucket, s.size_desc, "+;
5630 *!* "s.upc_num+s.chk_digit UPC " +;
5631 *!* "From zzeupcnr s, " + pcSQLTempTable + " t " +;
5632 *!* "Where s.division= t.division and " +;
5633 *!* "s.style= t.style and s.color_code= t.color_code and " +;
5634 *!* "s.lbl_code= t.lbl_code and s.dimension= t.dimension and " +;
5635 *!* "s.sizebucket= t.sizebucket"
5636 *--- TR 1003431 02/24/04 AM
5637 *--->Added Prod_ID from zzxdivsr because now upc check is Division specific
5638 lcSqlString= "Select t.division, t.style, t.color_code," +;
5639 "t.lbl_code, t.dimension, t.sizebucket, s.size_desc, "+;
5640 SQLfnConcat("s.upc_num+s.chk_digit","UPC ") +;
5641 "From zzeupcnr s, " + pcSQLTempTable + " t, zzxdivsr d " +;
5642 "Where s.division= t.division and " +;
5643 "s.division=d.division and " +;
5644 "s.style= t.style and s.color_code= t.color_code and " +;
5645 "s.lbl_code= t.lbl_code and s.dimension= t.dimension and " +;
5646 "s.sizebucket= t.sizebucket and ( d.Prod_Id = 'U' or d.Prod_Id = 'B' )" &&TR 1073064 30-Aug-13 Venuk. Added d.prod_id='B'
5647 *=== TR 1003431 02/24/04 AM
5648
5649 *--- TechRec 1028770 09-Jan-2008 vkrishnamurthy ---
5650 lcSQLString = lcSQLString + " AND ( t.sku_upc <> 'Y' AND t.sku_upc <> 'Z' ) " && TR 1073064 30-Aug-13 Venuk.Added AND t.sku_upc <> 'Z'
5651 *=== TechRec 1028770 09-Jan-2008 vkrishnamurthy ===
5652
5653 * --- 34208 10-Sep-02 DB2 CHECKED JN (forked code)
5654 llRetVal = v_SQLexec(lcSqlString, "__UPC")
5655 *--- TR 1003431 02/24/04 AM
5656 *--->Added Prod_ID from zzxdivsr because now upc check is Division specific
5657 If llRetVal And This.CountTotalRecs ("__UPC")>0
5658 *=== TR 1003431 02/24/04 AM
5659 * Populate UPC,size_desc from result of server-side temp keys + join zzeupcnr
5660 Select __UPC
5661 Index On division+Style+color_code+Lbl_code+Dimension+Str(sizebucket) ;
5662 Tag OurSku
5663 llRetVal= .SetRelation("__UPC", "OurSKU", pcTransDetail, ;
5664 "Division+Style+color_code+lbl_code+dimension+Str(sizebucket)")
5665 If llRetVal
5666 If plNotOverwriteSizeDesc
5667 Replace All upc With __UPC.upc In (pcTransDetail)
5668 Else
5669 *- 1005734 07/08/04 YIK
5670 *- Added ..FOR !EOF("__UPC") to avoid blanking out of size desc.
5671 * --- TR 1041569 7/23/09 CM --- Added check for empty upc
5672 Replace All upc With __UPC.upc, size_desc With __UPC.size_desc ;
5673 FOR !Eof("__UPC") AND Empty(upc) ;
5674 in (pcTransDetail)
5675 Endif
5676 Set Relation To
5677 .TableClose('__UPC')
5678
5679 *--- TAN 1005398 05/26/2004 AM
5680 *--- Fix Shared UPC Functionality.
5681 Endif
5682 Endif
5683 * 2nd. pass to get UPC with substitution of Blank lbl_code
5684 * for all unresolve UPC
5685 lcSqlString= "Select division, Prod_ID From zzxdivsr"
5686 llRetVal = v_SQLexec(lcSqlString, "__DivRef")
5687 llRetVal= llRetVal And .CheckOutboundUPCForBlankLabel(;
5688 pcTransHeader, pcTransDetail, pcSQLTempTable, plNotOverwriteSizeDesc)
5689
5690 If llRetVal
5691 Select __DivRef
5692 Index On division Tag Div
5693 llRetVal= .SetRelation("__DivRef", "Div", pcTransDetail,"Division")
5694 *=== TAN 1005398 05/26/2004 AM
5695
5696 * After 2nd pass all empty(UPC) will be invalid if control ref
5697 * sku_upc="U" or "B"
5698 lcErrs_Msg= "Missing UPC."
5699 *- 1004006 3/16/04 YIK
5700 *!* Replace All Errs_Msg_D with Errs_Msg_D + lcErrs_Msg + CRLF, Errs_Flg_D With "Y" ;
5701 *!* In (pcTransDetail) For (sku_upc="U" or sku_upc="B") And Empty(upc)
5702
5703 *--- TechRec 1028770 13-Jan-2008 vkrishnamurthy ---
5704*!* lcForExpr = '(sku_upc="U" or sku_upc="B") And Empty(upc) And __DivRef.Prod_Id = "U" ' + ; && TR 1005398 Added Prod_Id Criteria
5705*!* IIf(pcSkipPpkUpc, 'and (SkipPpkUpc = "N" or Implosion <> "Y") ', '')
5706
5707 *--- TR 1073064 30-Aug-13 Venuk.
5708* lcForExpr = '(sku_upc="U" or sku_upc="B" or sku_upc="X" ) And Empty(upc) And __DivRef.Prod_Id = "U" ' + ; && TR 1005398 Added Prod_Id Criteria
5709* IIf(pcSkipPpkUpc, 'and (SkipPpkUpc = "N" or Implosion <> "Y") ', '')
5710
5711 lcForExpr = '(sku_upc="U" or sku_upc="B" or sku_upc="X" or sku_upc="R" or sku_upc="A" ) And Empty(upc) ' + ;
5712 ' And ( __DivRef.Prod_Id = "U" OR __DivRef.Prod_Id = "B") ' + ;
5713 IIf(pcSkipPpkUpc, 'and (SkipPpkUpc = "N" or Implosion <> "Y") ', '')
5714 *=== TR 1073064 30-Aug-13 Venuk.
5715
5716
5717 *=== TechRec 1028770 13-Jan-2008 vkrishnamurthy ===
5718
5719 *--- TR 1064585 21-Dec-2012 Goutam
5720 IF (TYPE(pcTransHeader + ".template") = "C") AND UPPER(SUBSTR(pcTransHeader, 4, 3)) = "OIN"
5721
5722 GO TOP IN (pcTransDetail)
5723 *--- TR 1073064 30-Aug-13 Venuk.
5724 *lcForExpr = '(a.sku_upc="U" or a.sku_upc="B" or a.sku_upc="X" ) And Empty(a.upc) And __DivRef.Prod_Id = "U" ' + ;
5725 *IIf(pcSkipPpkUpc, 'and (a.SkipPpkUpc = "N" or a.Implosion <> "Y") ', '')
5726
5727 lcForExpr = '(a.sku_upc="U" or a.sku_upc="B" or a.sku_upc="X" or a.sku_upc="R" or a.sku_upc="A" ) And Empty(a.upc) ' + ;
5728 ' And ( __DivRef.Prod_Id = "U" OR __DivRef.Prod_Id = "B") ' + ;
5729 IIf(pcSkipPpkUpc, 'and (a.SkipPpkUpc = "N" or a.Implosion <> "Y") ', '')
5730 *=== TR 1073064 30-Aug-13 Venuk.
5731
5732 lcSqlString = "UPDATE a SET Errs_Msg_D = Errs_Msg_D + lcErrs_Msg + CHR(13) + CHR(10), Errs_Flg_D = 'Y' " + ;
5733 " from (pcTransDetail) a join (pcTransHeader) b on b.pkey = a.fkey " + ;
5734 " join __DivRef d on d.division = a.division " + ;
5735 " WHERE " + lcForExpr + " AND UPPER(b.template) <> 'FORZANI 5010'"
5736
5737 &lcSqlString
5738 ELSE
5739 *=== TR 1064585 21-Dec-2012 Goutam
5740
5741 Replace All Errs_Msg_D With Errs_Msg_D + lcErrs_Msg + CRLF, Errs_Flg_D With "Y" ;
5742 In (pcTransDetail) For &lcForExpr
5743
5744 *--- TR 1064585 21-Dec-2012 Goutam
5745 ENDIF
5746 *=== TR 1064585 21-Dec-2012 Goutam
5747
5748 *--- TAN 1005398 05/26/2004 AM
5749 Set Relation To
5750 .TableClose('__DivRef')
5751 *=== TAN 1005398 05/26/2004 AM
5752 *= 1004006
5753 *--- TAN 1005398 05/26/2004 AM
5754 *--- Moved the Endif Above
5755 Endif
5756 * Endif
5757 *--- TAN 1005398 05/26/2004 AM
5758 Endwith
5759
5760 Select(lnOldSelect)
5761 Return llRetVal
5762 Endproc
5763
5764
5765 ******************************************************************************************
5766 * PL 01/22/01- 4973 810(o) & 4975- JSSI Shared UPC - EDI 856(o) Process - Resolve share UPC
5767 ******************************************************************************************
5768 * Validate/Getting UPC using exact match on div,sty,col,lbl (substitute with BLANK),dim
5769 *
5770 Procedure CheckOutboundUPCForBlankLabel
5771 Lparameters pcTransHeader, pcTransDetail, pcSQLTempTable, plNotOverwriteSizeDesc
5772 Local llRetVal, lnOldSelect
5773 llRetVal = .T.
5774 lnOldSelect = Select()
5775
5776 With This
5777 * --- 34208 10-Sep-02 JN DB2 CHECKED forked code
5778 *!* lcSQLString1= "Select t.division, t.style, t.color_code," +;
5779 *!* "t.dimension, t.sizebucket, s.size_desc, "+;
5780 *!* "s.upc_num+s.chk_digit UPC " +;
5781 *!* "From zzeupcnr s, " + pcSQLTempTable + " t " +;
5782 *!* "Where s.division= t.division and " +;
5783 *!* "s.style= t.style and s.color_code= t.color_code and " +;
5784 *!* "s.lbl_code= '' and s.dimension= t.dimension and " +; && Blank lbl_code UPC
5785 *!* "s.sizebucket= t.sizebucket "
5786 *--- TAN 1005398 05/26/2004 AM
5787 *--->Added Prod_ID from zzxdivsr because now UPC check is Division specific
5788 *--- TR 1073064 30-Aug-13 Venuk Added or d.Prod_ID = 'B') ---
5789 lcSQLString1= "Select t.division, t.style, t.color_code," +;
5790 "t.dimension, t.sizebucket, s.size_desc, "+;
5791 SQLfnConcat("s.upc_num+s.chk_digit","UPC ") +;
5792 "From zzeupcnr s, " + pcSQLTempTable + " t, zzxdivsr d " +;
5793 "Where s.division= t.division and " +;
5794 "s.division= d.division and " +;
5795 "s.style= t.style and s.color_code= t.color_code and " +;
5796 "s.lbl_code= '' and s.dimension= t.dimension and " +;
5797 "s.sizebucket= t.sizebucket and ( d.Prod_ID = 'U' or d.Prod_ID = 'B') " && Blank lbl_code UPC
5798 * === 34208 10-Sep-02 JN DB2 CHECKED forked code
5799
5800 *--- TechRec 1028770 09-Jan-2008 vkrishnamurthy ---
5801 lcSQLString1 = lcSQLString1 + " AND t.sku_upc <> 'Y' AND t.sku_upc <> 'Z' " && TR 1073064 30-Aug-13 Venuk.Added AND t.sku_upc <> 'Z'
5802 *=== TechRec 1028770 09-Jan-2008 vkrishnamurthy ===
5803
5804 llRetVal= llRetVal And v_SQLexec(lcSQLString1, "TempUPC")
5805
5806 * Share UPC List (Blank lbl_code)
5807 lcSqlString= "Select distinct division, style, color_code," +;
5808 "dimension, sizebucket, size_desc, UPC "+;
5809 "From TempUPC group by 1,2,3,4,5,6 "
5810 llRetVal = llRetVal And v_SQLexec(lcSqlString, "__UPC",, true) &&local
5811
5812 If llRetVal
5813 Select __UPC
5814 Index On division+Style+color_code+Dimension+Str(sizebucket) ;
5815 Tag OurSku
5816 llRetVal= .SetRelation("__UPC", "OurSKU", pcTransDetail, ;
5817 "Division+Style+color_code+dimension+Str(sizebucket)")
5818 If llRetVal
5819 * Populate UPC with share UPC List
5820 If plNotOverwriteSizeDesc
5821 Replace All upc With __UPC.upc In (pcTransDetail) For Empty(upc)
5822 Else
5823 *- 1005734 07/08/04 YIK
5824 *- Added ..FOR !EOF("__UPC") to avoid blanking out of size desc.
5825 Replace All upc With __UPC.upc, size_desc With __UPC.size_desc ;
5826 For Empty(upc) And !Eof("__UPC") ;
5827 in (pcTransDetail)
5828 Endif
5829 Set Relation To
5830 Endif
5831 Endif
5832 .TableClose('__UPC')
5833 .TableClose('TempUPC')
5834 Endwith
5835 Select(lnOldSelect)
5836 Return llRetVal
5837 Endproc
5838
5839
5840 * PL 11/28/00 4563 move from clsoinpr (--810) for reuse in clsoifpr (--810 factor)
5841 ************************************************************************************
5842 * Prepare terms in MEMVAR
5843 ***********************************************************************************
5844 * PL 09/04/01 26617 -Terms Discount is based on Gross, should be based on Net
5845 * like elsewhere in System. change 2nd. parameter to tnNetAmount form tnMerch_amt
5846 * YIK 04/05/02 31243 - Add parameter to extract due days directly from term master - zzxtermr.extra_days
5847 Procedure PrepareTermsInfo
5848 Parameter tcShipHeader, tnNetAmount, tcterm_basis, tnTerm_rate, ;
5849 tcTerm_desc, tcTerm_type, tnTerm_dom, tdDsc_duedate, tnDsc_duedays,;
5850 tdNet_duedate, tnNet_duedays, tnTermDscAmt, tnTerm_duedays
5851
5852 Local llRetVal, lnOldSelect, ldDue_date, lnDue_days
5853 llRetVal = .T.
5854 lnOldSelect = Select()
5855
5856 * Get Terms Reference
5857 If vl_termr(&tcShipHeader..terms,, "_Termr")
5858
5859 *
5860 tcterm_basis= "3" && based on invoice date
5861 tnTerm_rate= _Termr.term_rate
5862 tcTerm_desc= Upper(_Termr.term_desc)
5863 *- YIK 04/05/02 31243
5864 tnTerm_duedays = _Termr.extra_days
5865 *=
5866 *-- Phu & Jason 08/15/01 - TAN 28479-
5867 *-- Terms Net and Disc DueDate/DueDays calculation
5868 * From 4GL logic 08/15/01:
5869 *!* due_date (As is) = v_DueDate(terms, ship_date,asofdate,0)
5870 *!* due_days (As is) = due_date - ship_date
5871 *!* net_due_days = iif(term_rate>0, 0, due_days)
5872 *!* net_due_date = if(term_rate)>0, due_date)
5873 *!* disc_due_days= iif(Term_date>0, due_days, 0)
5874 *!* disc_due_date= if(term_rate)>0, due_date)
5875
5876
5877 *-TR 1059996 FH - added check for empty date
5878 if(NOT &tcShipHeader..ship_date = {01/01/1900} ) OR (NOT &tcShipHeader..asof_date = {01/01/1900})
5879 ldDue_date = v_DueDate(&tcShipHeader..terms, &tcShipHeader..ship_date, ;
5880 &tcShipHeader..asof_date, 0)
5881 lnDue_days = ldDue_date - &tcShipHeader..ship_date
5882 ELSE
5883 ldDue_date = {01/01/1900}
5884 lnDue_days = 0
5885 endif
5886 *-TR 1059996 FH -
5887
5888 If Empty(tnTerm_rate)
5889 *- No Terms Rate
5890 tnTermDscAmt = 0
5891 tdDsc_duedate = {}
5892 tnDsc_duedays = 0
5893 tdNet_duedate = ldDue_date
5894 tnNet_duedays = lnDue_days
5895 Else
5896 *- Have Terms Rate
5897 tnTermDscAmt = ROUNDIT(_Termr.term_rate * tnNetAmount / 100)
5898 tdDsc_duedate = ldDue_date
5899 tnDsc_duedays = lnDue_days
5900 tdNet_duedate = ldDue_date
5901 tnNet_duedays = 0
5902 Endif
5903
5904 If _Termr.term_type = "E"
5905 * PL 12/20/01 29728 - Add to the process term type 12 -810 EDI
5906 * Per Jason/4gl code 12= 8/10 EOM
5907 If ('10 EOM' $ tcTerm_desc Or '10EOM' $ tcTerm_desc) And tnTerm_rate= 8
5908 tcTerm_type = "12" && EOM terms ('12' = 8 / 10 EOM)
5909 Else
5910 tcTerm_type = "02"
5911 Endif
5912 tnTerm_dom = _Termr.fix_due_day
5913 Else
5914 * PL 12/20/01 29728 - Add to the process term type 12 -810 EDI
5915 * Per Jason/4gl code "05" - discount not applicable
5916 If tnTerm_rate> 0
5917 tcTerm_type = "01" && basic terms
5918 Else
5919 tcTerm_type = "05" && discount not applicable
5920 Endif
5921 tnTerm_dom = 0
5922 Endif
5923 Endif
5924
5925 If Used('_Termr')
5926 Use In _Termr
5927 Endif
5928 If Used('tcxtermr')
5929 Use In tcxtermr
5930 Endif
5931
5932 Select(lnOldSelect)
5933 Return llRetVal
5934
5935 Endproc
5936
5937 ************************************************************************************
5938 * calculate OpenPick, Cancel, Invoice qtys for vertical order (by size buckets)
5939 ***********************************************************************************
5940 * PL 12/11/00 - 4855- Franco - add open,pick,cancel,invoice qtys to 810(o) flatfile
5941 * move GetOriginalSKUQty from clsOSHpr (-- 856(o) ) to here for reuse in 810(o)
5942 ************************************************************************************
5943 Procedure GetOriginalSKUQty
5944 Lparameters pcTranHeader, pcTranDetail, pcTranControl
5945 Local llRetVal, lcSqlString, lnOldSelect
5946 llRetVal= .T.
5947 lnOldSelect= Select()
5948
5949 Select Distinct d.ord_num, d.line_seq, d.sizebucket ;
5950 From (pcTranHeader) h, (pcTranDetail) d, (pcTranControl) C ;
5951 Where h.division= C.division And h.customer= C.customer And ;
5952 !(h.Errs_flg_H= "Y") And ; &&Empty(h.Errs_Msg_H)
5953 h.Pkey= d.Fkey And ;
5954 C.origitemqty= "Y" ;
5955 Order By d.ord_num, d.line_seq, d.sizebucket Into Cursor __TmpCursor
5956
5957 * PL 01/08/01 ATS 4911 Laf148 EDI 810(o) Factor process support CIT
5958 * reuse by calling with difference control keys --normal 810 division,customer
5959 * and 810 factor will be just factor
5960 llRetVal= This.CalcOriginalSKUQty(pcTranHeader, pcTranDetail, "__TmpCursor")
5961
5962 *!* With This
5963 *!* .cSQLTempTable=""
5964 *!* If .GenerateSQLTempTable('__TmpCursor')
5965 *!* If .PopulateSQLTempTable('__TmpCursor')
5966 *!* If !Empty(.cSQLTempTable)
5967 *!* * generate server-side vertical order
5968 *!* * Order detail
5969 *!* lcStartStr= " select ord_num,line_seq,line_status,"
5970 *!* lcEndStr= " from zzoordrd where ord_num in (select ord_num from " + .cSQLTempTable +")"
5971 *!* lcVertSizeStr= ""
5972 *!* For l_n = 1 TO goEnv.MaxBuckets
5973 *!* lcVertSizeStr= lcVertSizeStr + lcStartStr + ;
5974 *!* "size" + TRANS(l_n, "@L 99") + "_qty size_qty," +;
5975 *!* Ltrim(Str(l_n)) + " bk" + lcEndStr + " Union "
5976 *!* Endfor
5977 *!* * Ship detail
5978 *!* lcStartStr= " select ord_num,line_seq,line_status,"
5979 *!* lcEndStr= " from zzoshprd where ord_num in (select ord_num from " + .cSQLTempTable +")"
5980 *!* lcVertSizeStr= lcVertSizeStr
5981 *!* For l_n = 1 TO goEnv.MaxBuckets
5982 *!* lcVertSizeStr= lcVertSizeStr + lcStartStr + ;
5983 *!* "size" + TRANS(l_n, "@L 99") + "_qty size_qty," +;
5984 *!* Ltrim(Str(l_n)) + " bk" + lcEndStr + ;
5985 *!* Iif(l_n= goEnv.MaxBuckets,"" , " Union ")
5986 *!* Endfor
5987 *!* llRetVal = v_SQLExec(lcVertSizeStr, "_OrgQty")
5988 *!* lcSQLString= "Select ord_num,line_seq,bk,line_status,sum(size_qty) size_qty "+;
5989 *!* "From _OrgQty where line_status='I' group by 1,2,3 "
5990 *!* llRetVal = v_SQLExec(lcSQLString, "_InvQty",,.T.)
5991 *!* lcSQLString= "Select ord_num,line_seq,bk,line_status,sum(size_qty) size_qty "+;
5992 *!* "From _OrgQty where line_status='C' group by 1,2,3 "
5993 *!* llRetVal = v_SQLExec(lcSQLString, "_CncQty",,.T.)
5994 *!* lcSQLString= "Select ord_num,line_seq,bk,line_status,sum(size_qty) size_qty "+;
5995 *!* "From _OrgQty where line_status='O' or line_status='P' "+;
5996 *!* " group by 1,2,3 "
5997 *!* llRetVal = v_SQLExec(lcSQLString, "_OpnQty",,.T.)
5998 *!* * update invoice qty for order line bucket
5999 *!* Select _InvQty
6000 *!* index on Str(ord_num)+Str(line_seq)+Str(bk) tag OrdBucket
6001 *!* Set order to OrdBucket
6002 *!* Select (pcTranDetail)
6003 *!* Set Relation to Str(ord_num)+Str(line_seq)+Str(sizebucket) Into _InvQty
6004 *!* Scan for _InvQty.size_qty>0
6005 *!* Replace InvoiceQty with InvoiceQty + _InvQty.size_qty in (pcTranDetail)
6006 *!* endscan
6007 *!* Use in _InvQty
6008 *!* * update open pick qty for order line bucket
6009 *!* Select _OpnQty
6010 *!* index on Str(ord_num)+Str(line_seq)+Str(bk) tag OrdBucket
6011 *!* Set order to OrdBucket
6012 *!* Select (pcTranDetail)
6013 *!* Set Relation to Str(ord_num)+Str(line_seq)+Str(sizebucket) Into _OpnQty
6014 *!* Scan for _OpnQty.size_qty>0
6015 *!* Replace OpenPickQty with OpenPickQty + _OpnQty.size_qty in (pcTranDetail)
6016 *!* endscan
6017 *!* Use in _OpnQty
6018 *!* * update cancel qty for order line bucket
6019 *!* Select _CncQty
6020 *!* index on Str(ord_num)+Str(line_seq)+Str(bk) tag OrdBucket
6021 *!* Set order to OrdBucket
6022 *!* Select (pcTranDetail)
6023 *!* Set Relation to Str(ord_num)+Str(line_seq)+Str(sizebucket) Into _CncQty
6024 *!* Scan for _CncQty.size_qty>0
6025 *!* Replace CancelQty with CancelQty + _CncQty.size_qty in (pcTranDetail)
6026 *!* endscan
6027 *!* Use in _CncQty
6028
6029 *!* Set Relation to
6030 *!* * Translate to item status
6031 *!* Local lcItemStatus
6032 *!* lcItemStatus= ""
6033 *!* Select (pcTranDetail)
6034 *!* Scan For (OpenPickQty>0 or CancelQty>0 or InvoiceQty>0)
6035 *!* lcItemStatus= This.GetItemStatus(&pcTranDetail..Sub_style, ;
6036 *!* &pcTranDetail..OpenPickQty, &pcTranDetail..CancelQty, &pcTranDetail..InvoiceQty)
6037 *!* If !Empty(lcItemStatus)
6038 *!* Replace Item_status with lcItemStatus In (pcTranDetail)
6039 *!* Endif
6040 *!* Endscan
6041 *!*
6042 *!* Endif
6043 *!* Endif
6044 *!* Endif
6045 *!* Endwith
6046 *!* If Used('__TmpCursor')
6047 *!* Use In __TmpCursor
6048 *!* Endif
6049 *!* If Used('_OrgQty')
6050 *!* Use In _OrgQty
6051 *!* Endif
6052
6053 Select(lnOldSelect)
6054 Return llRetVal
6055 Endproc
6056
6057 ************************************************************************************
6058 * calculate OpenPick, Cancel, Invoice qtys for vertical order (by size buckets)
6059 *- 1006475 08/02/04 YIK. Replace "Union" with "Union ALL" to see all reecords.
6060 ************************************************************************************
6061 Procedure CalcOriginalSKUQty
6062 Lparameters pcTranHeader, pcTranDetail, pcTempCursor
6063 Local llRetVal, lcSqlString, lnOldSelect
6064 llRetVal= .T.
6065 lnOldSelect= Select()
6066
6067 With This
6068 .cSQLTempTable=""
6069 If .GenerateSQLTempTable(pcTempCursor)
6070 If .PopulateSQLTempTable(pcTempCursor)
6071 If !Empty(.cSQLTempTable)
6072
6073 * generate server-side vertical order
6074 * Order detail
6075 lcStartStr= " select ord_num,line_seq,line_status,"
6076 lcEndStr= " from zzoordrd where ord_num in (select ord_num from " + .cSQLTempTable +")"
6077 lcVertSizeStr= ""
6078 For l_n = 1 To goEnv.MaxBuckets
6079 lcVertSizeStr= lcVertSizeStr + lcStartStr + ;
6080 "size" + Trans(l_n, "@L 99") + "_qty size_qty," +;
6081 Ltrim(Str(l_n)) + " bk" + lcEndStr + " Union ALL"
6082 Endfor
6083 * Ship detail
6084 lcStartStr= " select ord_num,line_seq,line_status,"
6085 lcEndStr= " from zzoshprd where ord_num in (select ord_num from " + .cSQLTempTable +")"
6086 lcVertSizeStr= lcVertSizeStr
6087 For l_n = 1 To goEnv.MaxBuckets
6088 lcVertSizeStr= lcVertSizeStr + lcStartStr + ;
6089 "size" + Trans(l_n, "@L 99") + "_qty size_qty," +;
6090 Ltrim(Str(l_n)) + " bk" + lcEndStr + ;
6091 Iif(l_n= goEnv.MaxBuckets,"" , " Union ALL")
6092 Endfor
6093 llRetVal = v_SQLexec(lcVertSizeStr, "_OrgQty")
6094
6095 lcSqlString= "Select ord_num,line_seq,bk,line_status,sum(size_qty) size_qty "+;
6096 "From _OrgQty where line_status='I' group by 1,2,3 "
6097 llRetVal = v_SQLexec(lcSqlString, "_InvQty",,.T.)
6098
6099 lcSqlString= "Select ord_num,line_seq,bk,line_status,sum(size_qty) size_qty "+;
6100 "From _OrgQty where line_status='C' group by 1,2,3 "
6101 llRetVal = v_SQLexec(lcSqlString, "_CncQty",,.T.)
6102
6103 lcSqlString= "Select ord_num,line_seq,bk,line_status,sum(size_qty) size_qty "+;
6104 "From _OrgQty where line_status='O' or line_status='P' "+;
6105 " group by 1,2,3 "
6106 llRetVal = v_SQLexec(lcSqlString, "_OpnQty",,.T.)
6107
6108 * update invoice qty for order line bucket
6109 Select _InvQty
6110 Index On Str(ord_num)+Str(line_seq)+Str(bk) Tag OrdBucket
6111 Set Order To OrdBucket
6112 Select (pcTranDetail)
6113 Set Relation To Str(ord_num)+Str(line_seq)+Str(sizebucket) Into _InvQty
6114 Scan For _InvQty.size_qty>0
6115 Replace InvoiceQty With InvoiceQty + _InvQty.size_qty In (pcTranDetail)
6116 Endscan
6117 Use In _InvQty
6118
6119 * update open pick qty for order line bucket
6120 Select _OpnQty
6121 Index On Str(ord_num)+Str(line_seq)+Str(bk) Tag OrdBucket
6122 Set Order To OrdBucket
6123 Select (pcTranDetail)
6124 Set Relation To Str(ord_num)+Str(line_seq)+Str(sizebucket) Into _OpnQty
6125 Scan For _OpnQty.size_qty>0
6126 Replace OpenPickQty With OpenPickQty + _OpnQty.size_qty In (pcTranDetail)
6127 Endscan
6128 Use In _OpnQty
6129
6130 * update cancel qty for order line bucket
6131 Select _CncQty
6132 Index On Str(ord_num)+Str(line_seq)+Str(bk) Tag OrdBucket
6133 Set Order To OrdBucket
6134 Select (pcTranDetail)
6135 Set Relation To Str(ord_num)+Str(line_seq)+Str(sizebucket) Into _CncQty
6136 Scan For _CncQty.size_qty>0
6137 Replace CancelQty With CancelQty + _CncQty.size_qty In (pcTranDetail)
6138 Endscan
6139 Use In _CncQty
6140
6141 Set Relation To
6142
6143 * Translate to item status
6144 Local lcItemStatus
6145 lcItemStatus= ""
6146 Select (pcTranDetail)
6147 Scan For (OpenPickQty>0 Or CancelQty>0 Or InvoiceQty>0)
6148 lcItemStatus= This.GetItemStatus(&pcTranDetail..Sub_style, ;
6149 &pcTranDetail..OpenPickQty, &pcTranDetail..CancelQty, &pcTranDetail..InvoiceQty)
6150 If !Empty(lcItemStatus)
6151 Replace Item_status With lcItemStatus In (pcTranDetail)
6152 Endif
6153 Endscan
6154
6155 Endif
6156 Endif
6157 Endif
6158 .TableClose(pcTempCursor)
6159 .TableClose('_OrgQty')
6160 Endwith
6161
6162 Select(lnOldSelect)
6163 Return llRetVal
6164 Endproc
6165
6166 ************************************************************************************
6167 * return the following 2 position status: CS, CC, CP, BP
6168 * #DEFINE EDI_ORDER_COMPLETE_WITH_SUB "CS"
6169 * #DEFINE EDI_ORDER_COMPLETE "CC"
6170 * #DEFINE EDI_ORDER_PARTIAL_NO_BACKORDER "CP"
6171 * #DEFINE EDI_ORDER_PARTIAL_BACKORDER "BP"
6172 *- 1007299 10/11/04 YIK
6173 *- Add status 'IC' - item cancelled
6174 ************************************************************************************
6175 * PL 12/11/00 - 4855- Franco - add open,pick,cancel,invoice qtys to 810(o) flatfile
6176 * move GetItemStatus from clsOSHpr (-- 856(o) ) to here for reuse in 810(o)
6177 ************************************************************************************
6178 Procedure GetItemStatus
6179 Parameters tcSub_style, tnOpenPickQty, tnCancelQty, tnInvoiceQty
6180 Local lcRetval
6181 lcRetval= ""
6182 Do Case
6183 * No Open,Pick or Cancel
6184 Case (tnOpenPickQty + tnCancelQty)= 0
6185 If Empty(tcSub_style) && Ship complete
6186 lcRetval= EDI_ORDER_COMPLETE
6187 Else && Ship complete with style sub
6188 lcRetval= EDI_ORDER_COMPLETE_WITH_SUB
6189 Endif
6190 * Some No Open,No Pick and Some Cancel
6191 *- 1007299 10/11/04 YIK
6192 *- Also consider qty invoiced!
6193 *!* Case (tnOpenPickQty=0) And (tnCancelQty> 0)
6194 *!* lcRetval= EDI_ORDER_PARTIAL_NO_BACKORDER
6195 Case (tnOpenPickQty=0) And (tnCancelQty> 0) And tnInvoiceQty > 0
6196 lcRetval= EDI_ORDER_PARTIAL_NO_BACKORDER
6197 Case (tnOpenPickQty=0) And (tnCancelQty> 0) And tnInvoiceQty = 0
6198 lcRetval= "IC" && item cancelled
6199 *=
6200 Case (tnOpenPickQty=0) And (tnCancelQty> 0)
6201 lcRetval= EDI_ORDER_PARTIAL_NO_BACKORDER
6202
6203 * Some Open,Pick with No cancel
6204 Case (tnOpenPickQty>0)
6205 lcRetval= EDI_ORDER_PARTIAL_BACKORDER
6206 Endcase
6207 Return lcRetval
6208 Endproc
6209
6210
6211 Procedure PrepareEmptyDateForGentran
6212 Parameters tcString
6213 * convert "01/01/1900" to 10 blanks (--GENTRAN)
6214 tcString= Strtran(tcString, VFP_EMPTY_DATE_STRING, VFP_BLANK_DATE_STRING)
6215 * or convert " / / " to 10 blanks (--GENTRAN)
6216 tcString= Strtran(tcString, " / / ", VFP_BLANK_DATE_STRING)
6217
6218 *--- TR 1064542 10/11/12 ATHIRUNAVU
6219 * or convert "/ /" to 10 blanks (--GENTRAN)
6220 tcString= Strtran(tcString, "/ /", "")
6221 *=== TR 1064542 10/11/12 ATHIRUNAVU
6222
6223 Return
6224 Endproc
6225
6226 * PL ATS 4911 Laf148 EDI 810(o) Factor process support CIT
6227 * move from clsoinpr to reuse in clsoifpr
6228 ************************************************************************************
6229 *
6230 ************************************************************************************
6231 Procedure ExplodeDetailSizeToVertical
6232 Parameters tcSourceDetailHorizontal, tcTempTransDetail
6233 Local llRetVal, lcSQLSelect, loDetail, lnloop, lnSizeQty
6234 llRetVal = .T.
6235 lnOldSelect = Select()
6236
6237 * use Memvar schema of 2 table is not match
6238 Select (tcTempTransDetail)
6239 Scatter Memvar
6240 Select (tcSourceDetailHorizontal)
6241 Scan
6242 Scatt Memvar Memo
6243 * Notes: Future enhancement should consider range style as well
6244 * Original SKU substitution
6245
6246 *--- TR 1091569 04-Jul-2016 Partha ---
6247*!* If sub_code="O" And !Empty(Sub_style)
6248 If (sub_code="O" OR sub_code="A") And !Empty(Sub_style)
6249 *=== TR 1091569 04-Jul-2016 Partha ===
6250
6251 m.Style= Sub_style
6252 m.color_code= sub_color
6253 m.Lbl_code= sub_lbl
6254 m.Dimension= sub_dimens
6255 Endif
6256 * Explode to vertical size
6257 For lnloop= 1 To goEnv.MaxBuckets
6258 lnSizeQty = Eval("size" + Trans(lnloop, "@L 99") + "_qty")
6259 If lnSizeQty > 0
6260 * Prepare Size Bucket Information
6261 m.sizebucket = lnloop
6262 m.Total_qty = lnSizeQty
6263 Select (tcTempTransDetail)
6264 Append Blank
6265 Gather Memvar Memo
6266 Endif
6267 Endfor
6268 Endscan
6269
6270 Select(lnOldSelect)
6271 Return llRetVal
6272 Endproc
6273
6274
6275 ************************************************************************************
6276 *
6277 ***********************************************************************************
6278 Procedure GetPrepackInfos
6279 Lparameters pcHeader, pcDetail, pcSLNPrePack
6280 Local llRetVal, lnOldSelect, lcCurStyleDiv
6281 *--- 33006 07/16/02 PL 856 Trans Maint.-Failed message: Missing prepack component for Customer Style.
6282 * NOTES: 810(o) and 856(o) WILL NOT OUTPUT/VALID SLN RECORDS.
6283 * UNCONDITIONALLY TURN OFF FOR ALL OUTBOUND (810, 856)
6284 * this parameter will turn off this ability to MAP SLN segments for ALL trading partner
6285 * going outbound.
6286 Local llNOSLN
6287 llNOSLN= vl_parmr("NOSLN")
6288 *--- TR 1012959 NH 2005-09-02
6289 *--- TR 1017624 NH - Checking for log object
6290 *this.olog.logEntry("NOSLN is " + IIF(llNOSLN," true. ", " false. "))
6291 This.logEntry("NOSLN is " + Iif(llNOSLN," true. ", " false. "))
6292 *=== TR 1017624 NH
6293 *=== TR 1012959 NH 2005-09-02
6294
6295 If llNOSLN
6296 Return llNOSLN
6297 Endif
6298 *=== 33006 07/16/02 PL
6299
6300 llRetVal = .T.
6301 lnOldSelect = Select()
6302 *- 36191 12/26/02 YIK - add sln_req and explode only thet styles with sln_req = 'Y'
6303 *--- TR 1012959 NH 2005-09-02
6304 *--- prevent prepack explosion when the style is a range style
6305 *--- added filter condition EMPTY(rng_style)
6306 *--- this way if there are some range style and some prepacks style then only prepack
6307 *--- styles will be get sln explosion.
6308 *--- Notes not all headers have rng_type field. So, check for rng_type field first then
6309 *--- put rng_type in the error condition
6310 Local lnFldCount,lnFldIndex, llRng_typeFld
6311 *--- check if the "RNG_TYPE" field exists in pcDetail
6312 Select(pcDetail)
6313 llRng_typeFld = (Vartype(RNG_TYPE) == "C")
6314 If llRng_typeFld
6315 && rng_type field exists in pcHeader
6316 *--- TechRec 1037642 05-Jan-2009 T.Shenbagavalli removed sln_req = 'y' from where condition ---
6317*!* Select Distinct division,Style,color_code,Lbl_code,Dimension, sln_req From (pcDetail) ;
6318*!* Where !(Errs_Flg_D= "Y") And sln_req = 'Y' And Empty(RNG_TYPE) Into Cursor __TmpCursor
6319 Select Distinct division,Style,color_code,Lbl_code,Dimension, sln_req From (pcDetail) ;
6320 Where !(Errs_Flg_D= "Y") And Empty(RNG_TYPE) Into Cursor __TmpCursor
6321 *=== TechRec 1037642 05-Jan-2009 T.Shenbagavalli ===
6322 else
6323 *--- TechRec 1037642 05-Jan-2009 T.Shenbagavalli removed sln_req = 'y' from where condition ---
6324*!* Select Distinct division,Style,color_code,Lbl_code,Dimension, sln_req From (pcDetail) ;
6325*!* Where !(Errs_Flg_D= "Y") And sln_req = 'Y' Into Cursor __TmpCursor
6326 Select Distinct division,Style,color_code,Lbl_code,Dimension, sln_req From (pcDetail) ;
6327 Where !(Errs_Flg_D= "Y") Into Cursor __TmpCursor
6328 *=== TechRec 1037642 05-Jan-2009 T.Shenbagavalli ===
6329 Endif
6330 *=== TR 1012959 NH 2005-09-02
6331
6332 With This
6333 .cSQLTempTable=""
6334 If .GenerateSQLTempTable('__TmpCursor')
6335 If .PopulateSQLTempTable('__TmpCursor')
6336 *--- TR 1012959 NH 2005-09-02
6337 *--- TR 1017624 NH - Checking for log object
6338 *.olog.logEntry(".cSQLTempTable property is " + IIF(Empty(.cSQLTempTable),"", "not") + " empty.")
6339 .logEntry(".cSQLTempTable property is " + Iif(Empty(.cSQLTempTable),"", "not") + " empty.")
6340 *=== TR 1017624 NH
6341 *=== TR 1012959 NH 2005-09-02
6342 If !Empty(.cSQLTempTable)
6343 * Only PrePack header,details components (zzxppakh/ppakd)
6344 *--- TR 1003431 02/20/04 AM Added EAN
6345 *--- TechRec 1037642 05-Jan-2009 T.Shenbagavalli added t.sln_req in select list ---
6346 lcSqlString= "Select ph.ppk_desc, ph.pack_qty, ph.mulcllb_ok, pd.*, " +;
6347 "s.style, s.style as PPK_Style, s.color_code as PPK_Color, "+;
6348 "s.lbl_code as PPK_Label,s.dimension as PPK_Dimension, " + ;
6349 "s.third_party_item ppk_3rdpartyitem, " + ; && TR 1056928 20-Oct-2011 Partha
6350 "s.gar_wgt,s.wgt_uom," + "'" + SPACE(20) + "' as customer_style, " + "'" + SPACE(15) + "' as cust_color, " + ; && TR 1092421 20-03-2016 Shenba
6351 "'" + SPACE(30) + "' as cust_Desc, " + "'" + SPACE(15) + "' as cust_size," + ; && TR 1092421 20-03-2016 Shenba
6352 "'" + Space(12) + "' as UPC," + "'" + Space(27) + "' as SKU, " +;
6353 "9999999999 as Edipo4udf1,9999999999 as Edipo4udf2,9999999999 as Edipo4udf3, "+ ; && TR 1050497 01-Nov-2010 RKI EdiPoUdf1, EdiPoUdf2 and EdiPoUdf3 Added.
6354 "'" + Space(14) + "' as EAN, t.sln_req " +;
6355 "from zzxppakh ph, zzxppakd pd, zzxscolr s, " + .cSQLTempTable + " t " +;
6356 "Where (s.ppack_ok= 'Y') and s.division= t.division and "+;
6357 "s.style= t.style and s.color_code= t.color_code and "+;
6358 "s.lbl_code= t.lbl_code and s.dimension=t.dimension and " +;
6359 "s.division= ph.division and s.size_code= ph.size_code and "+;
6360 "s.dimension= ph.ppk_code and ph.pkey= pd.fkey and ph.Active_ok = 'Y' " +;
6361 " Order by pd.division, s.style"
6362 *--- TR 1046757 12-AUG-2010 MANI. Added ph.Active_ok = 'Y' = 'Y' ===
6363 *=== TR 1003431 02/20/04 AM
6364
6365 *--- TechRec 1037642 05-Jan-2009 T.Shenbagavalli ---
6366 *llRetVal= llRetVal And v_SQLexec(lcSqlString, "_SLNPPack")
6367 llRetVal= llRetVal And v_SQLexec(lcSqlString, "_SLNPPack1")
6368
6369 IF llRetVal AND USED('_SLNPPack1') AND RECCOUNT('_SLNPPack1') > 0
6370
6371
6372 SELECT (pcDetail)
6373 IF FieldExists('pack_qty') AND FieldExists('pack_total')
6374
6375 UPDATE d SET d.pack_qty = p.pack_qty, d.pack_Total = p.pack_total ;
6376 FROM (pcDetail) d JOIN _SLNPPAck1 p ;
6377 ON d.division = p.division and ;
6378 d.style = p.style and ;
6379 d.color_code = p.ppk_color and ;
6380 d.lbl_code = p.ppk_label and ;
6381 d.dimension = p.ppk_dimension
6382
6383 ENDIF
6384 ENDIF
6385
6386 SELECT * FROM _SLNPPack1 WHERE sln_req = 'Y' INTO CURSOR _SLNPPack READWRITE
6387 *=== TechRec 1037642 05-Jan-2009 T.Shenbagavalli ===
6388
6389 *--- TR 1012959 NH 2005-09-02
6390 *--- TR 1017624 NH
6391 *.olog.logEntry("_SLNPPack cursor created " + IIF(llRetVal," successfully.", " ...failed."))
6392 .logEntry("_SLNPPack cursor created " + Iif(llRetVal," successfully.", " ...failed."))
6393 *=== TR 1017624 NH
6394 If llRetVal And Used('_SLNPPack')
6395 *--- TR 1017624 NH
6396 *.olog.logEntry("_SLNPPack cursor has " + ALLTRIM(STR(RECCOUNT('_SLNPPack'))) + " records.")
6397 .logEntry("_SLNPPack cursor has " + Alltrim(Str(Reccount('_SLNPPack'))) + " records.")
6398 *=== TR 1017624 NH
6399 Endif
6400
6401 *=== TR 1012959 NH 2005-09-02
6402
6403 * Prepare vertical prepack temporaty table
6404 * same as PPackH/d + PPsize_qty (from pack01..24_qty >0)
6405 * Empty structure
6406 *- 1015040 02/06/06 YIK
6407 *- Increase size_desc to 10
6408 *-- lcSQLString= "Select *, 999999 as PPSize_qty , 999 as Sizebucket ,"+;
6409 *-- "'" + SPACE(5) + "' AS Size_Desc" +;
6410 *-- " From _SLNPPack where 0=1"
6411 *--- TR 1036614 10-Jun-2009 Goutam. Added "'" + Space(10) + "' as SLN01 " in the folloing list
6412 *--- TechRec 1056973 10-Nov-2011 jisingh Added , pkey as sfkey ===
6413 lcSqlString= "Select *, 999999 as PPSize_qty , 999 as Sizebucket , pkey as sfkey, "+;
6414 "'" + Space(10) + "' AS Size_Desc," +;
6415 "'" + Space(10) + "' AS SLN01 " +;
6416 " , 9999 AS sln_line_seq " +; && FH 1074465
6417 " From _SLNPPack where 0=1"
6418
6419 llRetVal= llRetVal And v_SQLexec(lcSqlString, "_SLNSKUVert",,.T.)
6420 *--- TR 1012959 NH 2005-09-02
6421 llRetVal= llRetVal And .MakeCursorWritable("_SLNSKUVert", pcSLNPrePack)
6422 *--- TR 1017624 NH
6423 *.olog.logEntry("Make _SLNSKUVert cursor writable completed " + IIF(llRetVal," successfully.", " failed."))
6424 .logEntry("Make _SLNSKUVert cursor writable completed " + Iif(llRetVal," successfully.", " failed."))
6425 *=== TR 1017624 NH
6426 llRetVal= llRetVal And .SLNPrePackExplosion("_SLNPPack", pcSLNPrePack)
6427
6428 .GetPpkLineInfo(pcSLNPrePack) && TR 1056928 10-Nov-2011 Partha
6429
6430 *--- TR 1017624 NH
6431 *.olog.logEntry("SLN prepack explosion completed " + IIF(llRetVal," successfully.", " failed."))
6432 .logEntry("SLN prepack explosion completed " + Iif(llRetVal," successfully.", " failed."))
6433 *=== TR 1017624 NH
6434 *=== TR 1012959 NH 2005-09-02
6435 Endif
6436 Endif
6437 Endif
6438 .TableClose('__TmpCursor')
6439 .TableClose('_SLNSKUVert')
6440 .TableClose('_SLNPPack')
6441 Endwith
6442
6443 * index for optimizing
6444 If Used(pcSLNPrePack)
6445 Select (pcSLNPrePack)
6446 Index On division+PPK_style+PPK_color+PPK_label+PPK_dimension Tag PPackSKU
6447 Index On division+Style+color_code+Lbl_code+Dimension+Str(sizebucket) Tag CompSKU
6448 Endif
6449
6450 Select(lnOldSelect)
6451 Return llRetVal
6452 Endproc
6453
6454
6455 ************************************************************************************
6456 *
6457 ***********************************************************************************
6458 Procedure SLNPrePackExplosion
6459 Lparameters pcSource, pcTarget
6460 Local llRetVal, lnOldSele, lcSizeBucket, lcSizeName, ;
6461 lcDivStyle, lnSourceCnt, lnSofar, lnSizeQty, lnSizePosition, llMultiColorLabel
6462 lnOldSele= Select()
6463 lcDivStyle= ""
6464 lnSourceCnt= Reccount(pcSource)
6465 llRetVal= .T.
6466
6467 Dime laSizeString[goEnv.MaxBuckets],laPPSizeString[goEnv.MaxBuckets]
6468 For lnSizePosition = 1 To goEnv.MaxBuckets
6469 laSizeString[lnSizePosition]= "size" + Padl(lnSizePosition, 2, '0')
6470 laPPSizeString[lnSizePosition]= "pack" + Padl(lnSizePosition, 2, '0') + "_qty"
6471 Endfor
6472
6473 Select (pcSource)
6474 Scan
6475 * For efficiency, only run once per Div + Style
6476 If !(lcDivStyle == division + PPK_style)
6477 lcDivStyle = division + PPK_style
6478 If !v_GetSizeHeadings(division, PPK_style, "__xSizer")
6479 llRetVal = .F.
6480 Exit
6481 Endif
6482 Endif
6483
6484 Select (pcSource)
6485 Scatter Name loSource Memo
6486
6487 llMultiColorLabel= (mulcllb_ok= "Y")
6488 *--- 35516 11/26/02 YIK - If prepack color or label have a value "ALL" - use detail values instead
6489 *!* loSource.color_code= iif(llMultiColorLabel, loSource.color_code, loSource.PPK_color)
6490 *!* loSource.Lbl_code= iif(llMultiColorLabel, loSource.Lbl_code, loSource.PPK_label)
6491 loSource.color_code= Iif(llMultiColorLabel And !(loSource.color_code = 'ALL'), ;
6492 loSource.color_code, loSource.PPK_color)
6493
6494
6495 *--- TR 1082088 KISHORE 10-NOV-2014
6496 *loSource.Lbl_code= Iif(llMultiColorLabel And !(loSource.Lbl_code = 'ALL'), ;
6497 loSource.Lbl_code, loSource.PPK_label)
6498
6499 IF goenv.sv("VALIDATE_PPK_COMPONENT_LABEL_STYLE_MASTER", "N") = "Y"
6500 IF (llMultiColorLabel And loSource.Lbl_code = 'ALL') or !llMultiColorLabel
6501 *If the open stock style/color with loSource.PPK_label is valid in the style master (vl_scold) then the component label = loSource.PPK_label, i.e.
6502 IF vl_scold(division,,,style,loSource.color_code,PPK_label,dimension)
6503 loSource.Lbl_code = loSource.PPK_label
6504 ELSE && no labeled item in the style master
6505 loSource.Lbl_code = ""
6506 ENDIF
6507 ELSE && llMultiColorLabel And !(loSource.Lbl_code = 'ALL')
6508 *- component label is the same as component label on ppk reference, i.e.
6509 loSource.Lbl_code = loSource.Lbl_code &&, which is redundant.
6510 ENDIF
6511 ELSE
6512 loSource.Lbl_code= Iif(llMultiColorLabel And !(loSource.Lbl_code = 'ALL'), ;
6513 loSource.Lbl_code, loSource.PPK_label)
6514 ENDIF
6515 *=== TR 1082088 KISHORE 10-NOV-2014
6516
6517 *=== 35516
6518
6519 For lnSizePosition= 1 To goEnv.MaxBuckets
6520 lnSizeQty = Eval(laPPSizeString[lnSizePosition]) && zzxpackd.pack01..24_qty bucket qtys
6521 If lnSizeQty> 0 && Only want buckets with activity!
6522 lcSizeName = Trim(Eval("__xSizer." + laSizeString[lnSizePosition])) && zzxsizer bucket Names
6523 Select (pcTarget)
6524 Append Blank
6525 Gather Name loSource
6526 Replace sizebucket With lnSizePosition, ;
6527 size_desc With lcSizeName, ;
6528 PPSize_qty With lnSizeQty In (pcTarget)
6529 Endif
6530 Endfor
6531
6532 ENDSCAN
6533
6534 This.TableClose("__xSizer")
6535 Select (pcSource)
6536 Select (lnOldSele)
6537 Return llRetVal
6538 Endproc
6539
6540 ************************************************************************************
6541 *
6542 ***********************************************************************************
6543 Procedure CheckSLNUPCSKU
6544 Lparameters pcTransHeader, pcTransDetail, pcSLNPrePack, pcFinalSLNPrepack, ;
6545 pcLineSLNPrepack
6546 Local llRetVal, lnOldSelect
6547 llRetVal = .T.
6548 lnOldSelect = Select()
6549 With This
6550
6551 *- 1052584 02/17/11 YIK
6552 *- Added template to list of fileds, h.sku_upc
6553 IF TYPE(pcTransHeader + ".template") = "C" && template exists
6554
6555 * Prepare SLNPrepack per customer require for customer style & UPC validation
6556 * eventhought UPC does not require customer since, could potential have "B"oth
6557 * UPC and SKU validation for all EXPLODED COMPONENTS. Therefore, need to split
6558 * UCP by customer (--Batch validate UPC without customer).
6559 * Creating cursor pcFinalSLNPrepack
6560 *--- TechRec 1043592 22-Dec-2009 JK Added d.aux_sku ====
6561 *-TR 1099354 FH - removed aux_sku
6562
6563 *--- TR 1099875 31-Oct-2016 BNarayanan added SPACE(50) as aux_sku ===
6564 Select Distinct h.customer, h.template, h.sku_upc, SPACE(50) as aux_sku1, p.* ;
6565 From (pcTransHeader) h, (pcTransDetail) d, (pcSLNPrePack) p ;
6566 Where h.Pkey = d.Fkey And d.division= p.division And d.Style= p.PPK_style And ;
6567 d.color_code= p.PPK_color And d.Lbl_code= p.PPK_label And ;
6568 d.Dimension= p.PPK_dimension And h.sku_upc<> "N" AND d.sln_req = 'Y' ; && TR 1064075 FH added d.sln_req = 'Y'
6569 Order By 1,2,3,4,5,6,7 Into Cursor _CustSLNPrepack
6570 ELSE
6571 *--- TR 1099875 31-Oct-2016 BNarayanan added SPACE(50) as aux_sku ===
6572 Select Distinct h.customer, ' ' as template, h.sku_upc, SPACE(50) as aux_sku1, p.* ;
6573 From (pcTransHeader) h, (pcTransDetail) d, (pcSLNPrePack) p ;
6574 Where h.Pkey = d.Fkey And d.division= p.division And d.Style= p.PPK_style And ;
6575 d.color_code= p.PPK_color And d.Lbl_code= p.PPK_label And ;
6576 d.Dimension= p.PPK_dimension And h.sku_upc<> "N" ;
6577 Order By 1,2,3,4,5,6,7 Into Cursor _CustSLNPrepack
6578 ENDIF
6579 *= 1052584
6580 .MakeCursorWritable("_CustSLNPrepack", pcFinalSLNPrepack)
6581 .TableClose("_CustSLNPrepack")
6582 * index for optimizing
6583 If Used(pcFinalSLNPrepack)
6584 Select (pcFinalSLNPrepack)
6585 Index On customer+division+PPK_style+PPK_color+PPK_label+PPK_dimension Tag CustSKU
6586 Index On customer+division+Style+color_code+Lbl_code+Dimension+Str(sizebucket) Tag CustSKU
6587 Endif
6588
6589 * Find ALL Component SKUs for Prepack SLN explosion.
6590 * Populate SKU into pcFinalSLNPrepack
6591
6592 *--- TechRec 1028770 14-Jan-2008 vkrishnamurthy ---
6593 * Added OR h.sku_upc = "Y"
6594 *=== TechRec 1028770 14-Jan-2008 vkrishnamurthy ===
6595
6596 *--- TechRec 1028770 19-Mar-2008 vkrishnamurthy ---
6597*!* Select Distinct h.customer, p.division, p.Style, p.color_code, p.Lbl_code, p.Dimension,;
6598*!* p.sizebucket, p.PPK_style, p.PPK_color, p.PPK_label, p.PPK_dimension ;
6599*!* From (pcTransHeader) h, (pcTransDetail) d, (pcSLNPrePack) p ;
6600*!* Where h.Pkey = d.Fkey And d.division= p.division And d.Style= p.PPK_style And ;
6601*!* d.color_code= p.PPK_color And d.Lbl_code= p.PPK_label And ;
6602*!* d.Dimension= p.PPK_dimension And ;
6603*!* (h.sku_upc= "S" Or h.sku_upc= "B" OR h.sku_upc = "Y" ) ; && require component SKUs
6604*!* Order By 1,2,3,4,5,6,7 Into Cursor __TmpCursor
6605
6606 *- 1052584 08/23/11 YIK
6607 *- Changed the Select to be only from pcFinalSLNPrepack (since I added sku_upc to it above).
6608*-- Select Distinct h.customer, p.division, p.Style, p.color_code, p.Lbl_code, p.Dimension,;
6609*-- p.sizebucket, p.PPK_style, p.PPK_color, p.PPK_label, p.PPK_dimension, h.sku_upc ;
6610*-- From (pcTransHeader) h, (pcTransDetail) d, (pcSLNPrePack) p ;
6611*-- Where h.Pkey = d.Fkey And d.division= p.division And d.Style= p.PPK_style And ;
6612*-- d.color_code= p.PPK_color And d.Lbl_code= p.PPK_label And ;
6613*-- d.Dimension= p.PPK_dimension And ;
6614*-- (h.sku_upc= "S" Or h.sku_upc= "B" OR h.sku_upc = "Y" ) ; && require component SKUs
6615*-- Order By 1,2,3,4,5,6,7 Into Cursor __TmpCursor
6616
6617 *--- TR 1073064 30-Aug-13 Venuk Added sku_upc = "A" ===
6618 Select customer, division, Style, color_code, Lbl_code, Dimension,;
6619 sizebucket, PPK_style, PPK_color, PPK_label, PPK_dimension, sku_upc ;
6620 From (pcFinalSLNPrepack) ;
6621 Where (sku_upc= "S" Or sku_upc= "B" OR sku_upc = "Y" OR sku_upc = "A" ) ; && require component SKUs
6622 and template <> 'MACYS' ; && don't output SLN SKU for MACYS where upc_sku = 'S'
6623 Order By 1,2,3,4,5,6,7 Into Cursor __TmpCursor
6624 *=== TechRec 1052584
6625
6626 .cSQLTempTable=""
6627 If .GenerateSQLTempTable('__TmpCursor')
6628 If .PopulateSQLTempTable('__TmpCursor')
6629 If !Empty(.cSQLTempTable)
6630 llRetVal= llRetVal And .CheckOutboundSLNSKU(pcTransHeader, pcTransDetail, ;
6631 pcFinalSLNPrepack, .cSQLTempTable, '__TmpCursor')
6632 Endif
6633 Endif
6634 Endif
6635 .TableClose('__TmpCursor')
6636
6637 * Find ALL Component UPCs for Prepack SLN explosion
6638 * Populate UPC into pcFinalSLNPrepack
6639 *--- TechRec 1028770 14-Jan-2008 vkrishnamurthy ---
6640 * OR h.sku_upc = "X"
6641 *=== TechRec 1028770 14-Jan-2008 vkrishnamurthy ===
6642
6643 *--- TechRec 1028770 19-Mar-2008 vkrishnamurthy ---
6644*!* Select Distinct p.division, p.Style, p.color_code, p.Lbl_code, p.Dimension,;
6645*!* p.sizebucket, p.PPK_style, p.PPK_color, p.PPK_label, p.PPK_dimension ;
6646*!* From (pcTransHeader) h, (pcTransDetail) d, (pcSLNPrePack) p ;
6647*!* Where h.Pkey = d.Fkey And d.division= p.division And d.Style= p.PPK_style And ;
6648*!* d.color_code= p.PPK_color And d.Lbl_code= p.PPK_label And ;
6649*!* d.Dimension= p.PPK_dimension And ;
6650*!* (h.sku_upc= "U" Or h.sku_upc= "B" OR h.sku_upc = "X") ; && require component UPCs
6651*!* Order By 1,2,3,4,5,6 Into Cursor __TmpCursor
6652
6653 *- 1052584 08/23/11 YIK
6654 *- Changed the Select to be only from pcFinalSLNPrepack (since I added sku_upc to it above).
6655*-- Select Distinct p.division, p.Style, p.color_code, p.Lbl_code, p.Dimension,;
6656*-- p.sizebucket, p.PPK_style, p.PPK_color, p.PPK_label, p.PPK_dimension ,h.sku_upc ;
6657*-- From (pcTransHeader) h, (pcTransDetail) d, (pcSLNPrePack) p ;
6658*-- Where h.Pkey = d.Fkey And d.division= p.division And d.Style= p.PPK_style And ;
6659*-- d.color_code= p.PPK_color And d.Lbl_code= p.PPK_label And ;
6660*-- d.Dimension= p.PPK_dimension And ;
6661*-- (h.sku_upc= "U" Or h.sku_upc= "B" OR h.sku_upc = "X" OR p.template = 'MACYS') ; && MACYS require component UPCs
6662*-- Order By 1,2,3,4,5,6 Into Cursor __TmpCursor
6663
6664 Select distinct division, Style, color_code, Lbl_code, Dimension,;
6665 sizebucket, PPK_style, PPK_color, PPK_label, PPK_dimension, sku_upc ;
6666 From (pcFinalSLNPrepack) ;
6667 Where sku_upc= "U" OR sku_upc= "B" OR sku_upc = "X" OR template = 'MACYS' ; && MACYS require component UPCs
6668 OR sku_upc = "R" OR sku_upc = "A"; && TR 1073064 30-Aug-13 Venuk.
6669 OR template = 'CHARMING SHOPPES 4030' ; &&--- TechRec 1058762 20-Feb-2012 jisingh CHARMING SHOPPES require component UPCs ===
6670 Order By 1,2,3,4,5,6 Into Cursor __TmpCursor
6671
6672 *=== TechRec 1028770 19-Mar-2008 vkrishnamurthy ===
6673
6674 .cSQLTempTable=""
6675 If .GenerateSQLTempTable('__TmpCursor')
6676 If .PopulateSQLTempTable('__TmpCursor')
6677 If !Empty(.cSQLTempTable)
6678 llRetVal= llRetVal And .CheckOutboundSLNUPC(pcTransHeader, pcTransDetail, ;
6679 pcFinalSLNPrepack, .cSQLTempTable, '__TmpCursor')
6680 *--- TR 1003431 02/23/04 AM
6681 * llRetVal= llRetVal And .CheckOutboundSLNEAN(pcTransHeader, pcTransDetail, ; && TR 1073064 30-Aug-13 Venuk. Commented
6682 * pcFinalSLNPrepack, .cSQLTempTable, '__TmpCursor') && TR 1073064 30-Aug-13 Venuk. Commented
6683 *=== TR 1003431 02/23/04 AM
6684 Endif
6685 Endif
6686 Endif
6687 .TableClose('__TmpCursor')
6688
6689 *--- TR 1073064 30-Aug-13 Venuk.
6690 Select distinct division, Style, color_code, Lbl_code, Dimension,;
6691 sizebucket, PPK_style, PPK_color, PPK_label, PPK_dimension, sku_upc ;
6692 From (pcFinalSLNPrepack) ;
6693 WHERE sku_upc = "E" OR sku_upc = "A" OR sku_upc= "Z" OR sku_upc= "R";
6694 Order By 1,2,3,4,5,6 Into Cursor __TmpCursor
6695
6696 .cSQLTempTable=""
6697 If .GenerateSQLTempTable('__TmpCursor')
6698 If .PopulateSQLTempTable('__TmpCursor')
6699 If !Empty(.cSQLTempTable)
6700 llRetVal= llRetVal And .CheckOutboundSLNEAN(pcTransHeader, pcTransDetail, ;
6701 pcFinalSLNPrepack, .cSQLTempTable, '__TmpCursor')
6702 Endif
6703 Endif
6704 Endif
6705 .TableClose('__TmpCursor')
6706 *=== TR 1073064 30-Aug-13 Venuk.
6707 Endwith
6708
6709 * Per Order detail line SLNPrepack
6710 * Creating pcLineSLNPrepack from previous result of pcFinalSLNPrepack and detail pkey
6711 * for latter link to output base on detail pkey+customer in flatfile output
6712 *- 1001898 11/04/03 YIK
6713 *- Added ..and h.customer = p.customer, otherwise if the same prepack sent to
6714 *- two different customers, the join creates duplicated SLNs
6715 *--- TR 1035491 13-Nov-2008 Goutam. Made the following cursor readwrite
6716 *- TR 1099354 FH - added d.aux_sku
6717
6718 *--- TR 1099875 31-Oct-2016 BNarayanan added IIF(EMPTY(p.aux_sku1),d.aux_sku,p.aux_sku1) as aux_sku ===
6719 Select d.Pkey As ITM_Pkey, IIF(EMPTY(p.aux_sku1),d.aux_sku,p.aux_sku1) as aux_sku, p.* ;
6720 From (pcTransHeader) h, (pcTransDetail) d, (pcFinalSLNPrepack) p ;
6721 Where h.Pkey = d.Fkey And d.division= p.division And d.Style= p.PPK_style And ;
6722 d.color_code= p.PPK_color And d.Lbl_code= p.PPK_label And ;
6723 d.Dimension= p.PPK_dimension And h.customer = p.customer ;
6724 Into Cursor (pcLineSLNPrepack) readwrite
6725 If Used(pcLineSLNPrepack)
6726 Select (pcLineSLNPrepack)
6727 Index On ITM_Pkey Tag ITM_Pkey
6728 Endif
6729
6730 Select(lnOldSelect)
6731 Return llRetVal
6732 Endproc
6733 ******************************************************************************************
6734 *
6735 ******************************************************************************************
6736 Procedure CheckOutboundSLNSKU
6737 Lparameters pcTransHeader, pcTransDetail, pcFinalSLNPrepack, pcSQLTempTable, pcLocalSQLTempTable
6738 Local llRetVal, lnOldSelect
6739 llRetVal = .T.
6740 lnOldSelect = Select()
6741 With This
6742 *--- TechRec 1043592 22-Dec-2009 JK Added s.aux_sku ===
6743 *--- TechRec 1056973 17-Nov-2011 jisingh Added s.pkey as sfkey ===
6744 lcSqlString= "Select t.customer, t.division, t.style, t.color_code," +;
6745 "t.lbl_code, t.dimension, t.sizebucket, s.size_desc, s.cust_style, s.aux_sku, s.pkey as sfkey " +;
6746 "From zzxcstdr s, " + pcSQLTempTable + " t " +;
6747 "Where s.division= t.division and s.customer=t.customer and " +;
6748 "s.style= t.style and s.color_code= t.color_code and " +;
6749 "s.lbl_code= t.lbl_code and s.dimension= t.dimension and " +;
6750 "s.size_bk= t.sizebucket"
6751
6752 *--- TechRec 1028770 09-Jan-2008 vkrishnamurthy ---
6753 lcSQLString = lcSQLString + " AND t.sku_upc <> 'X' AND t.sku_upc <> 'Z' " &&TR 1073064 30-Aug-13 Venuk Added t.sku_upc <> 'Z'
6754 *=== TechRec 1028770 09-Jan-2008 vkrishnamurthy ===
6755
6756 llRetVal = v_SQLexec(lcSqlString, "__SKU")
6757 If llRetVal
6758 * Populate SKU,size_desc from result of server-side temp keys + join zzxcstdr
6759 Select __SKU
6760 Index On customer+division+Style+color_code+Lbl_code+Dimension+Str(sizebucket) ;
6761 Tag CustSKU
6762 llRetVal= .SetRelation("__SKU", "CustSKU", pcFinalSLNPrepack, ;
6763 "Customer+Division+Style+color_code+lbl_code+dimension+Str(sizebucket)")
6764 If llRetVal
6765 *- 1005734 07/08/04 YIK
6766 *- Added ..FOR !EOF("__SKU") to avoid blanking out of size desc.
6767 *--- TechRec 1043592 22-Dec-2009 JK Added aux_sku with __SKU.aux_sku ====
6768 *--- 1099875 31-Oct-2016 BNarayanan aux_sku changed as aux_sku1 ===
6769 Replace All sku With __SKU.cust_style, size_desc With __SKU.size_desc, ;
6770 aux_sku1 With __SKU.aux_sku ; &&--- TechRec 1056973 16-Nov-2011 jisingh Added IIF === TR 1064083 FH - removed condition for aux_sku
6771 FOR !Eof("__SKU") ;
6772 in (pcFinalSLNPrepack)
6773 Set Relation To
6774 Use In __SKU
6775
6776 * all populate all SKU component
6777 * will be invalid if control ref set sku_upc="S" or "B"
6778 llRetVal= llRetVal And .ValidateOutboundSLNSKU(;
6779 pcTransHeader, pcTransDetail, pcFinalSLNPrepack, ;
6780 pcSQLTempTable, pcLocalSQLTempTable)
6781
6782 Endif
6783 Endif
6784 Endwith
6785
6786 Select(lnOldSelect)
6787 Return llRetVal
6788 Endproc
6789
6790 ******************************************************************************************
6791 *
6792 ******************************************************************************************
6793 Procedure CheckOutboundSLNUPC
6794 Lparameters pcTransHeader, pcTransDetail, pcSLNPrePack, pcSQLTempTable, pcLocalSQLTempTable
6795 Local llRetVal, lnOldSelect
6796 llRetVal = .T.
6797 lnOldSelect = Select()
6798 With This
6799
6800 * 1st pass Populate UPC,size_desc using exact match on div,sty,col,lbl,dim
6801
6802 * --- TAN 34208 16-Oct-02 JN
6803 * Replace + concatenate operand with SQLfnConcat for DB2 compatibility
6804 *!* lcSQLString= "Select t.division, t.style, t.color_code," +;
6805 *!* "t.lbl_code, t.dimension, t.sizebucket, s.size_desc, "+;
6806 *!* "t.PPK_style, t.PPK_color,t.PPK_label, t.PPK_dimension, "+;
6807 *!* "s.upc_num+s.chk_digit UPC " +;
6808 *!* "From zzeupcnr s, " + pcSQLTempTable + " t " +;
6809 *!* "Where s.division= t.division and " +;
6810 *!* "s.style= t.style and s.color_code= t.color_code and " +;
6811 *!* "s.lbl_code= t.lbl_code and s.dimension= t.dimension and " +;
6812 *!* "s.sizebucket= t.sizebucket"
6813 *--- TR 1003431 02/24/04 AM
6814 *--->Added Prod_ID from zzxdivsr because now EAN check is Division specific
6815 *--- TechRec 1049174 22-Dec-2010 jisingh ---
6816*!* lcSqlString= "Select t.division, t.style, t.color_code," +;
6817*!* "t.lbl_code, t.dimension, t.sizebucket, s.size_desc, "+;
6818*!* "t.PPK_style, t.PPK_color,t.PPK_label, t.PPK_dimension, "+;
6819*!* SQLfnConcat("s.upc_num+s.chk_digit","UPC ") +;
6820*!* "From zzeupcnr s, " + pcSQLTempTable + " t, zzxdivsr d " +;
6821*!* "Where s.division= t.division and " +;
6822*!* "s.division= d.division and " +;
6823*!* "s.style= t.style and s.color_code= t.color_code and " +;
6824*!* "s.lbl_code= t.lbl_code and s.dimension= t.dimension and " +;
6825*!* "s.sizebucket= t.sizebucket and d.Prod_Id = 'U' "
6826
6827 lcSqlString= "Select t.division, t.style, s.rolling_color AS color_code," +;
6828 "t.lbl_code, t.dimension, t.sizebucket, s.size_desc, "+;
6829 "t.PPK_style, t.PPK_color,t.PPK_label, t.PPK_dimension, "+;
6830 SQLfnConcat("s.upc_num+s.chk_digit","UPC ") +;
6831 "From " + IIF(.lUseSharedUPC, "zveupcnr", "zzeupcnr") + " s, " + pcSQLTempTable + " t, zzxdivsr d " +;
6832 "Where s.division= t.division and " +;
6833 "s.division= d.division and " +;
6834 "s.style= t.style and " + IIF(.lRollingColor, "s.rolling_color", "s.color_code") + " = t.color_code and " +;
6835 "s.lbl_code= t.lbl_code and s.dimension= t.dimension and " +;
6836 "s.sizebucket= t.sizebucket and (d.Prod_Id = 'U' or d.Prod_Id = 'B') " &&TR 1073064 30-Aug-13 Venuk. Added d.Prod_Id = 'B'
6837 *=== TechRec 1049174 22-Dec-2010 jisingh ===
6838 * === TAN 34208 16-Oct-02 JN DB2 CHECKED
6839
6840 *--- TechRec 1028770 09-Jan-2008 vkrishnamurthy ---
6841 lcSQLString = lcSQLString + " AND t.sku_upc <> 'Y' AND t.sku_upc <> 'Z' " &&TR 1073064 30-Aug-13 Venuk. Added t.sku_upc <> 'Z'
6842 *=== TechRec 1028770 09-Jan-2008 vkrishnamurthy ===
6843
6844 llRetVal = v_SQLexec(lcSqlString, "__UPC")
6845 *--- TR 1003431 02/24/04 AM
6846 If llRetVal And This.CountTotalRecs ("__UPC")>0
6847 *=== TR 1003431 02/24/04 AM
6848 * Populate UPC,size_desc from result of server-side temp keys + join zzeupcnr
6849 Select __UPC
6850 Index On division+Style+color_code+Lbl_code+Dimension+Str(sizebucket) ;
6851 Tag OurSku
6852 llRetVal= .SetRelation("__UPC", "OurSKU", pcSLNPrePack, ;
6853 "Division+Style+color_code+lbl_code+dimension+Str(sizebucket)")
6854 If llRetVal
6855 *- 1005734 07/08/04 YIK
6856 *- Added ..FOR !EOF("__UPC") to avoid blanking out of size desc.
6857 Replace All upc With __UPC.upc, size_desc With __UPC.size_desc ;
6858 FOR !Eof("__UPC") ;
6859 in (pcSLNPrePack)
6860 Set Relation To
6861 .TableClose('__UPC')
6862
6863 *--- TAN 1005398 05/27/2004 AM
6864 Endif
6865 Endif
6866 *=== TAN 1005398 05/27/2004 AM
6867 * 2nd. pass to get UPC with substitution of Blank lbl_code
6868 * for all unresolve UPC
6869 llRetVal= llRetVal And .CheckOutboundSLNUPCForBlankLabel(;
6870 pcTransHeader, pcTransDetail, pcSLNPrePack, pcSQLTempTable)
6871
6872 * After 2nd pass all component in tcSLN with empty(UPC)
6873 * will be invalid if control ref set sku_upc="U" or "B"
6874 llRetVal= llRetVal And .ValidateOutboundSLNUPC(;
6875 pcTransHeader, pcTransDetail, pcSLNPrePack, ;
6876 pcSQLTempTable, pcLocalSQLTempTable)
6877
6878 *--- TAN 1005398 05/27/2004 AM
6879 * Endif
6880 * Endif
6881 *--- TAN 1005398 05/27/2004 AM
6882 Endwith
6883
6884 Select(lnOldSelect)
6885 Return llRetVal
6886 Endproc
6887
6888
6889 ******************************************************************************************
6890 *
6891 ******************************************************************************************
6892 * Validate/Getting UPC using exact match on div,sty,col,lbl (substitute with BLANK),dim
6893 *
6894 Procedure CheckOutboundSLNUPCForBlankLabel
6895 Lparameters pcTransHeader, pcTransDetail, pcSLNPrePack, pcSQLTempTable
6896 Local llRetVal, lnOldSelect
6897 llRetVal = .T.
6898 lnOldSelect = Select()
6899
6900 With This
6901 * --- TAN 34208 16-Oct-02 JN
6902 * Replace + concatenate operand with SQLfnConcat for DB2 compatibility
6903 *!* lcSQLString1= "Select t.division, t.style, t.color_code," +;
6904 *!* "t.dimension, t.sizebucket, s.size_desc, "+;
6905 *!* "t.PPK_style, t.PPK_color,t.PPK_label, t.PPK_dimension, "+;
6906 *!* "s.upc_num+s.chk_digit UPC " +;
6907 *!* "From zzeupcnr s, " + pcSQLTempTable + " t " +;
6908 *!* "Where s.division= t.division and " +;
6909 *!* "s.style= t.style and s.color_code= t.color_code and " +;
6910 *!* "s.lbl_code= '' and s.dimension= t.dimension and " +; && Blank lbl_code UPC
6911 *!* "s.sizebucket= t.sizebucket "
6912 *--- TAN 1005398 05/26/2004 AM
6913 *--->Added Prod_ID from zzxdivsr because now UPC check is Division specific
6914 lcSQLString1= "Select t.division, t.style, t.color_code," +;
6915 "t.dimension, t.sizebucket, s.size_desc, "+;
6916 "t.PPK_style, t.PPK_color,t.PPK_label, t.PPK_dimension, "+;
6917 SQLfnConcat("s.upc_num+s.chk_digit","UPC ") +;
6918 "From zzeupcnr s, " + pcSQLTempTable + " t, zzxdivsr d " +;
6919 "Where s.division= t.division and " +;
6920 "s.division= d.division and " +;
6921 "s.style= t.style and s.color_code= t.color_code and " +;
6922 "s.lbl_code= '' and s.dimension= t.dimension and " +; && Blank lbl_code UPC
6923 "s.sizebucket= t.sizebucket and (d.Prod_ID = 'U' or d.Prod_ID = 'B') " && TR 1073064 30-Aug-13 Venuk Added d.Prod_ID = 'B'
6924 * --- TAN 34208 16-Oct-02 JN
6925
6926 *--- TechRec 1028770 09-Jan-2008 vkrishnamurthy ---
6927 lcSQLString1 = lcSQLString1 + " AND t.sku_upc <> 'Y' AND t.sku_upc <> 'Z' " && TR 1073064 30-Aug-13 Venuk. Added t.sku_upc <> 'Z'
6928 *=== TechRec 1028770 09-Jan-2008 vkrishnamurthy ===
6929
6930 llRetVal= llRetVal And v_SQLexec(lcSQLString1, "TempUPC")
6931
6932 * Share UPC List (Blank lbl_code)
6933 lcSqlString= "Select distinct division, style, color_code," +;
6934 "dimension, sizebucket, size_desc, UPC "+;
6935 "From TempUPC group by 1,2,3,4,5,6,7 "
6936 llRetVal = llRetVal And v_SQLexec(lcSqlString, "__UPC",, true) &&local
6937
6938 If llRetVal
6939 Select __UPC
6940 Index On division+Style+color_code+Dimension+Str(sizebucket) ;
6941 Tag OurSku
6942 llRetVal= .SetRelation("__UPC", "OurSKU", pcSLNPrePack, ;
6943 "Division+Style+color_code+dimension+Str(sizebucket)")
6944 If llRetVal
6945 * Populate UPC with share UPC List
6946 *- 1005734 07/08/04 YIK
6947 *- Added ..FOR !EOF("OurSKU") to avoid blanking out of size desc.
6948 Replace All upc With __UPC.upc, size_desc With __UPC.size_desc ;
6949 in (pcSLNPrePack) For Empty(upc) And !Eof("__UPC")
6950 Set Relation To
6951 Endif
6952 Endif
6953 .TableClose('__UPC')
6954 .TableClose('TempUPC')
6955 Endwith
6956 Select(lnOldSelect)
6957 Return llRetVal
6958 Endproc
6959
6960 ******************************************************************************************
6961 *
6962 ******************************************************************************************
6963 Procedure ValidateOutboundSLNUPC
6964 Lparameters pcTransHeader, pcTransDetail, pcSLNPrePack, pcSQLTempTable, pcLocalSQLTempTable
6965 Local llRetVal, lnOldSelect, lcSqlString, lcSQLString1
6966 Private pcLocalDivRef
6967 llRetVal = .T.
6968 lnOldSelect = Select()
6969 pcLocalDivRef = GetUniqueFileName()
6970
6971
6972 * PrePackSKU order
6973 Select (pcTransDetail)
6974 Set Order To OurSku
6975
6976 With This
6977 * list of all missing UPC group by PrePackSKU
6978 *--- TAN 1005398 05/26/2004 AM
6979 *--- We need Local Division Reference.
6980 lcSqlString= "Select division,Prod_ID from zzxdivsr"
6981 llRetVal= llRetVal And v_SQLexec(lcSqlString,pcLocalDivRef)
6982
6983 *--->Added Prod_ID from zzxdivsr because now UPC check is Division specific
6984 lcSQLString1= "Select distinct t.division, t.style, t.color_code," +;
6985 "t.lbl_code, t.dimension, t.sizebucket, t.size_desc, "+;
6986 "t.PPK_style, t.PPK_color,t.PPK_label, t.PPK_dimension "+;
6987 "From " + pcLocalSQLTempTable + " s, " + pcSLNPrePack + " t, " + pcLocalDivRef + " d " +;
6988 "Where s.division= t.division and " +;
6989 "s.division= d.division and " +;
6990 "s.style= t.style and s.color_code= t.color_code and " +;
6991 "s.lbl_code= t.lbl_code and s.dimension= t.dimension and " +;
6992 "s.sizebucket= t.sizebucket and t.upc='' and (d.Prod_ID = 'U' OR d.Prod_ID = 'B') " + ; && TR 1073064 Venuk Added.d.Prod_ID = 'B'
6993 "order by t.division,t.PPK_style, t.PPK_color,t.PPK_label, t.PPK_dimension"
6994 llRetVal= llRetVal And v_SQLexec(lcSQLString1, "tcNoUPC",, true) &&local
6995 .TableClose(pcLocalDivRef)
6996 *--- TR 1005398
6997
6998 * Consolidate all missing UPC components for same PrePackSKU together in lcErrs_Msg
6999 If llRetVal
7000 Select tcNoUPC
7001 Index On division + PPK_style + PPK_color + PPK_label + PPK_dimension ;
7002 Tag PPackSKU
7003 Do While llRetVal And !Eof('tcNoUPC')
7004 lcCurPPackSKU= division + PPK_style + PPK_color + PPK_label + PPK_dimension
7005 lcErrs_Msg= "Missing Prepack component UPC : "+ CRLF
7006 Scan While division + PPK_style + PPK_color + PPK_label + PPK_dimension == ;
7007 lcCurPPackSKU
7008 lcErrs_Msg= lcErrs_Msg + "Div:" + division + " Style: " + Style + ;
7009 " Color: " + color_code + "Label: " + Lbl_code + "Dm/Pk:" + Dimension +;
7010 " Size: " + Str(sizebucket) + CRLF
7011 Endscan
7012 * after accumulate all missing UPC components for same PrePackSKU
7013 * seek for all detail lines that use that PrePackSKU and append proper
7014 * error message/flag.
7015 Select (pcTransDetail)
7016 If Seek(lcCurPPackSKU, pcTransDetail, "OurSKU" )
7017 Scan While division+ Style+ color_code+ Lbl_code+ Dimension == lcCurPPackSKU
7018 Replace Errs_Msg_D With Errs_Msg_D + lcErrs_Msg, Errs_Flg_D With "Y" ;
7019 In (pcTransDetail)
7020 Endscan
7021 Endif
7022 Select tcNoUPC
7023 Enddo
7024 Endif
7025 .TableClose('tcNoUPC')
7026 Endwith
7027 Select(lnOldSelect)
7028 Return llRetVal
7029 Endproc
7030
7031 ******************************************************************************************
7032 *
7033 ******************************************************************************************
7034 Procedure ValidateOutboundSLNSKU
7035 Lparameters pcTransHeader, pcTransDetail, pcSLNPrePack, pcSQLTempTable, pcLocalSQLTempTable
7036 Local llRetVal, lnOldSelect
7037 llRetVal = .T.
7038 lnOldSelect = Select()
7039
7040 * PrePackSKU order
7041 Select (pcTransDetail)
7042 Set Order To OurSku
7043
7044 With This
7045 * list of all missing SKU group by PrePackSKU
7046 lcSQLString1= "Select distinct t.customer,t.division, t.style, t.color_code," +;
7047 "t.lbl_code, t.dimension, t.sizebucket, t.size_desc, "+;
7048 "t.PPK_style, t.PPK_color,t.PPK_label, t.PPK_dimension "+;
7049 "From " + pcLocalSQLTempTable + " s, " + pcSLNPrePack + " t " +;
7050 "Where s.division= t.division and " +;
7051 "s.style= t.style and s.color_code= t.color_code and " +;
7052 "s.lbl_code= t.lbl_code and s.dimension= t.dimension and " +;
7053 "s.sizebucket= t.sizebucket and t.sku='' " +;
7054 "order by t.customer,t.division,t.PPK_style, t.PPK_color,t.PPK_label, t.PPK_dimension"
7055 llRetVal= llRetVal And v_SQLexec(lcSQLString1, "_NoSKU",, true) &&local
7056
7057 * Consolidate all missing SKU components for same PrePackSKU together in lcErrs_Msg
7058 If llRetVal
7059 Select _NoSKU
7060 Index On customer + division + PPK_style + PPK_color + PPK_label + PPK_dimension ;
7061 Tag PPackSKU
7062 Do While llRetVal And !Eof('_NoSKU')
7063 lcCurPPackSKU= customer + division + PPK_style + PPK_color + PPK_label + PPK_dimension
7064 lcErrs_Msg= "Missing Prepack component for Customer Style: "+ CRLF
7065 Scan While customer + division + PPK_style + PPK_color + PPK_label + PPK_dimension == ;
7066 lcCurPPackSKU
7067 lcErrs_Msg= lcErrs_Msg + "Cust:" + customer + "Div:" + division + ;
7068 " Style: " + Style + " Color: " + color_code + "Label: " + Lbl_code +;
7069 "Dm/Pk:" + Dimension + " Size: " + Str(sizebucket) + CRLF
7070 Endscan
7071 * after accumulate all missing SKU components for same PrePackSKU
7072 * seek for all detail lines that use that PrePackSKU and append proper
7073 * error message/flag.
7074 Select (pcTransDetail)
7075 If Seek(lcCurPPackSKU, pcTransDetail, "CustSKU" )
7076 Scan While customer + division+ Style+ color_code+ Lbl_code+ Dimension == lcCurPPackSKU
7077 Replace Errs_Msg_D With Errs_Msg_D + lcErrs_Msg, Errs_Flg_D With "Y" ;
7078 In (pcTransDetail)
7079 Endscan
7080 Endif
7081 Select _NoSKU
7082 Enddo
7083 Endif
7084 .TableClose('_NoSKU')
7085 Endwith
7086 Select(lnOldSelect)
7087 Return llRetVal
7088 Endproc
7089
7090 * PL 05/23/01 27632,27633,27634 810,856,870(o) implement UOM conversion from Stock/Base UOM to trading partner UOM
7091 ************************************************************************************
7092 * ServerSide Join of order,line,sizebucket into 850 history detail to get UOM infos
7093 * to give back to trading partner (--Send diff UOM than internal stock/base UOM).
7094 * Condition to convert: inbound UOM <> base UOM and there is a convertion ratio
7095 * then convert Qty, Price back to original UOM from trading partner
7096 * same thing happen to when want to partial ack qtys (OpenPickQty, CancelQty, InvoiceQty)
7097 * need same conversion (--Internal UOM diff than external)
7098 *
7099 * Also need to overwrite po4_uom (--default from zzxscolr.uom) with history ib_uom
7100 * total_qty * uom_factor and price / uom_factor
7101 * Notes: only want the conversion to happen once (uom_convert='Y' did convert)
7102 ************************************************************************************
7103 Procedure OutboundUOMConversion
7104 Parameters tceoinTH, tceoinTD, tceoinCR, tlNoPartialFields
7105 Local llRetVal, lcSQLSelect
7106 llRetVal = .T.
7107 lnOldSelect = Select()
7108
7109 * all detail that need to convert from Base UOM back to Trading Partner UOM
7110 * from 850(i) history detail
7111 Select d.Pkey, d.ord_num, d.line_seq, d.sizebucket ;
7112 From (tceoinTH) h, (tceoinTD) d, (tceoinCR) C ;
7113 Where h.Pkey= d.Fkey And ;
7114 h.division= C.division And h.customer= C.customer And ;
7115 C.convert_uom= "Y" ;
7116 Into Cursor __TmpCursor
7117
7118 With This
7119 If Recc("__TmpCursor")> 0
7120 .cSQLTempTable=""
7121 llRetVal= llRetVal And .GenerateSQLTempTable('__TmpCursor')
7122 llRetVal= llRetVal And .PopulateSQLTempTable('__TmpCursor') And !Empty(.cSQLTempTable)
7123 lcSqlString= "Select t.pkey, t.ord_num, d.ib_uom, d.base_uom, d.uom_factor " +;
7124 "From zzeipohd d, " + .cSQLTempTable + " t " +;
7125 "Where d.ord_num= t.ord_num and d.line_seq= t.line_seq and d.sizebucket= t.sizebucket"
7126 llRetVal= llRetVal And v_SQLexec(lcSqlString, "tcHistDtl")
7127
7128 If Recc("tcHistDtl")> 0
7129 Select tcHistDtl
7130 Index On Pkey Tag Pkey
7131 llRetVal= llRetVal And .SetRelation("tcHistDtl", "pkey", tceoinTD, "pkey")
7132 Select (tceoinTD)
7133 Scan For tcHistDtl.Pkey> 0 And &tceoinTD..uom_convert<> "Y"
7134 If tcHistDtl.ib_uom<> tcHistDtl.base_uom And tcHistDtl.uom_factor> 0
7135 Replace uom_convert With "Y", ib_uom With tcHistDtl.ib_uom, ;
7136 base_uom With tcHistDtl.base_uom, uom_factor With tcHistDtl.uom_factor, ;
7137 Total_qty With Total_qty * tcHistDtl.uom_factor, ;
7138 price With price / tcHistDtl.uom_factor, ;
7139 org_price With org_price / tcHistDtl.uom_factor, ;
7140 po4_uom With tcHistDtl.ib_uom In (tceoinTD)
7141
7142 * Only 810, 856 have partial ack fields not 870
7143 If Not tlNoPartialFields
7144 Replace orig_qty With orig_qty * tcHistDtl.uom_factor, ;
7145 OpenPickQty With OpenPickQty * tcHistDtl.uom_factor, ;
7146 CancelQty With CancelQty * tcHistDtl.uom_factor, ;
7147 InvoiceQty With InvoiceQty * tcHistDtl.uom_factor In (tceoinTD)
7148 Endif
7149
7150 Endif
7151 Endscan
7152 Endif
7153 Set Relation To
7154 Endif
7155 .TableClose("tcHistDtl")
7156 .TableClose("__TmpCursor")
7157 Endwith
7158
7159 Select(lnOldSelect)
7160 Return llRetVal
7161 Endproc
7162
7163 ************************************************************************************
7164 * populate shipper informations
7165 ***********************************************************************************
7166 Procedure PopulateShipperInfos
7167 Lparameters pcHeader
7168 Local llRetVal, lnOldSelect, lcShip_name
7169 llRetVal = .T.
7170 lnOldSelect = Select()
7171 With This
7172 Select Distinct shipper From (pcHeader) Where !(Errs_flg_H= "Y") Into Cursor tcTemp
7173 Select tcTemp
7174 lcShip_name=""
7175 Scan
7176 lcShip_name= vl_shipr(tcTemp.shipper,, "_Shipr")
7177 If !Empty(lcShip_name)
7178 Replace SCAC_code With _Shipr.SCAC_code,;
7179 shipr_name With _Shipr.ship_name,;
7180 Trans_type With _Shipr.edishptype In (pcHeader) ;
7181 For shipper= tcTemp.shipper
7182 Endif
7183 Endscan
7184 .TableClose("tcTemp")
7185 .TableClose("_Shipr")
7186 Endwith
7187 Select(lnOldSelect)
7188 Return llRetVal
7189 Endproc
7190
7191
7192 ************************************************************************************
7193 * PL & YIK 12/12/01 29858 - BOL Assignment should produce VICS Standard 17-Digit
7194 * BOL Number. See specs in TAR/Hassan.
7195 ***********************************************************************************
7196 Procedure PopulateVICSBOL
7197 Lparameters pcHeader
7198 Local llRetVal, lnOldSelect
7199 llRetVal = .T.
7200 lnOldSelect = Select()
7201
7202 With This
7203 .InitThermo(1)
7204 .UpdateThermoCaption('Populating VICS BOL...')
7205 lnMax= Recc(pcHeader)
7206 lnCnt= 0
7207 Select (pcHeader)
7208 Scan For !(Errs_flg_H= "Y")
7209
7210 *--- TR 1026614 Goutam 20-Sep-2007
7211 lnCnt = lnCnt + 1
7212 .AdvanceThermo(lnCnt/lnMax)
7213
7214 *- TR 1055804 FH - Added OR EMPTY(&pcHeader..bill_num)
7215 IF NOT EMPTY(VICSBol) OR EMPTY(&pcHeader..bill_num)
7216 LOOP
7217 ENDIF
7218 *=== TR 1026614 Goutam 20-Sep-2007
7219
7220 lcVICSBOL= VICSBol(&pcHeader..division, &pcHeader..bill_num)
7221 Replace VICSBol With lcVICSBOL In (pcHeader)
7222
7223 *--- TR 1026614 Goutam 20-Sep-2007
7224 *lnCnt = lnCnt + 1
7225 *.AdvanceThermo(lnCnt/lnMax)
7226 *=== TR 1026614 Goutam 20-Sep-2007
7227
7228 Endscan
7229 Endwith
7230
7231 Select(lnOldSelect)
7232 Return llRetVal
7233 Endproc
7234
7235 ************************************************************************************
7236 * YIK 04/16/02 TAN 28352 - Get Factor terms code and/or ITD segment values from zzetermx
7237 * based on Factor and BC terms code
7238 ************************************************************************************
7239 Procedure GetFactorTerms
7240 Lparameters tc850WorkHeader, tnITD_DueDays, tnITD_DiscPct, tnITD_DiscDays, tcFTerms_code, tcITD_TmType,;
7241 tdITD_EOMCutOf, tdITD_EOMFxDue
7242
7243 Local lcFactor, lcTerms, llRetVal, lnOldSelect
7244
7245 llRetVal = .T.
7246 lnOldSelect = Select()
7247
7248 lcFactor = &tc850WorkHeader..Factor
7249 lcTerms = &tc850WorkHeader..terms
7250 If This.vl_termX(lcFactor, , "_TermX", lcTerms)
7251 tnITD_DueDays = _TermX.ITD_DueDays
7252 tnITD_DiscPct = _TermX.ITD_DiscPct
7253 tnITD_DiscDays = _TermX.ITD_DiscDays
7254 tcFTerms_code = _TermX.Fact_Terms
7255 tcITD_TmType = _TermX.ITD_TmType
7256 Endif
7257 If Used('_TermX')
7258 Use In _TermX
7259 Endif
7260 Select(lnOldSelect)
7261 Return llRetVal
7262 Endproc
7263
7264 ************************************************************************************
7265 * YIK 04/16/02 TAN 28352 - Get Factor terms code and/or ITD segment values from zzetermx
7266 ************************************************************************************
7267 Procedure vl_termX
7268 Parameters p_cKeyField1, p_cGetField, p_cCursor, p_cKeyField2
7269 Local l_cSQLString, l_vRetVal
7270
7271 *- 1002392 12/04/03 YIK
7272 *!* l_cSQLString = "SELECT * FROM zzetermx WHERE Factor = ?p_cKeyField1" + ;
7273 *!* " AND Terms = ?p_cKeyField2"
7274
7275 l_cSQLString = SQLTranslateTopN(;
7276 "SELECT TOP 1 * FROM zzetermx WHERE ( Factor = ?p_cKeyField1 OR Factor = '')" + ;
7277 " AND Terms = ?p_cKeyField2" + ;
7278 " ORDER BY Factor DESC" )
7279 *=
7280 l_vRetVal = v_SQLPrep(l_cSQLString, p_cCursor, p_cGetField)
7281 Return l_vRetVal
7282 Endproc
7283
7284 ************************************************************************************
7285 * 34940 10/30/02 YIK - Consolidate transaction by consolidated invoice#.
7286 ************************************************************************************
7287 Procedure ConsolidateTransaction
7288 Lparameters pcTransHeader, pcTransDetail, pcTransAddress, pceoincr, tcSDQ && 2/22/05 YIK Added tcSDQ
7289 Local llRetVal, lnOldSelect, llConsolidate, lcCustomer, lcDivision, ;
7290 lnConsol_num, loConsolH, loConsolD, lnh_pkey, ;
7291 lntotal_qty, lnorig_qty, lnopenpickqty, lncancelqty, lninvoiceqty, lnPkey, lcHdrFile, lcDetFile, ;
7292 lcDRef1, lcDRef2, lcDRef3, lnDAmt1, lnDAmt2, lnDAmt3, laDRef, lnCounter &&-1013889 YIK
7293
7294 *--- TR 1015795 5-Apr-2006 Goutam
7295 Local lnTotalStore
7296 lnTotalStore = 0
7297 *=== TR 1015795 5-Apr-2006 Goutam
7298
7299 *- 1013889 10/31/05 YIK
7300 *- Declare array of discounts. The 1st colummn is SAC_DRef, the 2nd is SAC_DRate, the 3d is SAC_DAmt
7301 Declare laDRef[3,3]
7302 laDRef = ' '
7303 lnCounter = 0
7304
7305 *---1018538 AUG-22-06 BR
7306 *---1028032 OCT-25-07 BR -- ADDED: WHERE consol_num > 0
7307
7308 *-TR 1056069 FH - added join with zzeoincr for consol_inv > N
7309 *Select Distinct customer, division, consol_num From (pcTransHeader) h Into Cursor _QMULT
7310
7311 *--- TR 1086775/1081474 4-JUN-2015 Venuk.
7312 llConsInvDiv = goEnv.SV('810_ALLOW_CONSOLIDATION_ACROSS_DIVISION', 'N') = 'Y'
7313 IF (( this.lAllowConsolDiv AND !llConsInvDiv) OR !this.lAllowConsolDiv )
7314 lcConsolCondition= "c.consol_inv >'N'"
7315 ELSE
7316 lcConsolCondition= "c.consol_inv ='S'"
7317 ENDIF
7318 *=== TR 1086775/1081474 19-NOV-14 Venuk
7319
7320 *--- TR 1086775/1081474 19-NOV-14 Venuk. Replaced c.consol_inv >'N with lcConsolCondition ===
7321 Select Distinct h.customer, h.division, h.consol_num ;
7322 From (pcTransHeader) h ;
7323 JOIN (pceoincr) c ;
7324 ON c.customer = h.customer ;
7325 AND c.division = h.division ;
7326 WHERE &lcConsolCondition ;
7327 Into Cursor _QMULT
7328 *-TR 1056069 FH - added join with zzeoincr for consol_inv > N
7329
7330 Select customer, consol_num, Count(*) From _QMULT Where consol_num > 0 Group By customer, consol_num Having Count(*) > 1 ;
7331 INTO Cursor _QDUP &&TR: 1018992 05-SEPT-06 BR
7332 Scan
7333 m.customer = _QDUP.customer
7334 m.consol_num = _QDUP.consol_num
7335 *--- TR 1086775/1081474 19-NOV-14 Venuk. Added IIF condition ===
7336 Replace Errs_Msg_H With Errs_Msg_H + "Invoice consolidation across divisions is not allowed." + CRLF, Errs_flg_H With "Y";
7337 In (pcTransHeader) ;
7338 FOR customer = m.customer And IIF((this.lAllowConsolDiv AND !llConsInvDiv) OR !this.lAllowConsolDiv ,consol_num = m.consol_num, 1=0) && TR 1110145 FH - 1=0
7339 Endscan
7340 If Used("_QMULT")
7341 Use In _QMULT
7342 Endif
7343 If Used("_QDUP")
7344 Use In _QDUP
7345 Endif
7346 *===1018538 AUG-22-06 BR
7347
7348 *- 1008582 2/22/05 YIK
7349 *- Create temp table with a structure of SDQ cursor
7350 tcSDQ = Iif(Empty(tcSDQ), "tcSDQ", tcSDQ)
7351 Select h.consol_num, h.EDI_Store, d.upc, d.sku, d.ean, h.Pkey As Pkey, d.Pkey As Fkey, d.Total_qty ;
7352 FROM (pcTransHeader) h, (pcTransDetail) d ;
7353 WHERE .F. ;
7354 INTO Cursor __SDQ
7355 This.MakeCursorWritable("__SDQ", tcSDQ)
7356 *== 1008582
7357
7358 *--- OR 1015795 5-Apr-2006 Goutam Added MAX(r.consol_inv) as r.consol_inv in select statement and ;
7359 *--- r.consol_inv = 'S' in where atatement of following SQL
7360 Select h.customer, h.division, h.consol_num, Max(r.consol_inv) As consol_inv, Count(inv_num) As Cnt ;
7361 FROM (pcTransHeader) h, (pceoincr) r ;
7362 WHERE ;
7363 h.division= r.division And h.customer= r.customer And ;
7364 (r.consol_inv = 'Y' Or r.consol_inv = 'S') And h.consol_num > 0 ;
7365 AND Errs_flg_H <> "Y" ; && 1018538 AUG-22-06 BR
7366 Group By h.customer, h.division, h.consol_num ;
7367 Into Cursor _eoinCnt
7368 llConsolidate = (_Tally > 0) && if found invoices needed to be consolidated
7369 If llConsolidate
7370 .AdvanceThermoTotalWithCaptionPlus("Consolidating invoices")
7371 Endif
7372 *--- 37722 3/4/03 YIK
7373 Do Case
7374 Case Lower(pcTransHeader) = "tceointh"
7375 lcHdrFile = "ZZEOINTH"
7376 lcDetFile = "ZZEOINTD"
7377 Case Lower(pcTransHeader) = "tceoifth"
7378 lcHdrFile = "ZZEOIFTH"
7379 lcDetFile = "ZZEOIFTD"
7380 Otherwise
7381 Endcase
7382 *=== 37722 YIK
7383 *--- TR 1001689 11/13/03 AM (---Added Tax_Amt---)
7384 *--- TR 1086775/1081474 19-NOV-14 Venuk
7385 IF this.lAllowConsolDiv AND llConsInvDiv
7386 If Used("_eoinCnt")
7387 Use In _eoinCnt
7388 ENDIF
7389
7390 Select h.customer, h.division, MIN(h.consol_num) as consol_num , Max(r.consol_inv) As consol_inv, Count(inv_num) As Cnt ;
7391 FROM (pcTransHeader) h, (pceoincr) r ;
7392 WHERE ;
7393 h.division= r.division And h.customer= r.customer And ;
7394 (r.consol_inv = 'Y' Or r.consol_inv = 'S') And h.consol_num > 0 ;
7395 AND Errs_flg_H <> "Y" ;
7396 Group By h.customer , h.consol_num ;
7397 UNION ALL ;
7398 Select h.customer, h.division, h.consol_num, Max(r.consol_inv) As consol_inv, Count(inv_num) As Cnt ;
7399 FROM (pcTransHeader) h, (pceoincr) r ;
7400 WHERE ;
7401 h.division= r.division And h.customer= r.customer And ;
7402 (r.consol_inv = 'Y' Or r.consol_inv = 'S') And h.consol_num > 0 ;
7403 AND Errs_flg_H <> "Y" ;
7404 Group By h.customer, h.division, h.consol_num ;
7405 Into Cursor _eoinCnt
7406 GO top
7407 ENDIF
7408 *=== TR 1086775//1081474 19-NOV-14 Venuk
7409
7410 Scan
7411 lcCustomer = customer
7412 lcDivision = division
7413 lnConsol_num = consol_num
7414
7415 *--- TR 1086775/1081474 19-NOV-14 Venuk. division = lcDivision replaced with IIF(_eoinCnt.consol_inv = 'Y', 1=1 , division = lcDivision)===
7416 Select Sum(ord_qty) As ord_qty, ;
7417 SUM(weight) As weight, ;
7418 SUM(carton) As carton, ;
7419 SUM(frgt_amt) As frgt_amt,;
7420 SUM(disc_amt) As disc_amt, ;
7421 SUM(misc_amt) As misc_amt, ;
7422 SUM(tax_amt) As tax_amt, ;
7423 SUM(inv_amt) As inv_amt, ;
7424 SUM(merch_amt) As merch_amt, ;
7425 SUM(termdscamt) As termdscamt ;
7426 FROM (pcTransHeader) ;
7427 WHERE customer = lcCustomer And ;
7428 IIF(this.lAllowConsolDiv AND llConsInvDiv AND (_eoinCnt.consol_inv = 'Y' OR _eoinCnt.consol_inv = 'S') , 1=1 , division = lcDivision) And consol_num = lnConsol_num ;
7429 INTO Cursor _tceTotH
7430 *=== TR 1001689 11/13/03 AM
7431 *- select all the details for this consolidated invoice
7432 *--- TR 1029588 NH 01/07/08 - added range style in distinct condition
7433 *--- TR 1030633 NH 02/11/08 - removed : ,Rng_bk
7434 *- TR 1059880 FH - added price and assortment
7435 *- TR 1071252 FH - added customer and division to WHERE clause
7436 Select Distinct Style, color_code, Lbl_code, Dimension, sizebucket ;
7437 , rng_style, rng_color, rng_lbl, rng_pack, price, assortment ;
7438 FROM (pcTransDetail) d, (pcTransHeader) h ;
7439 WHERE h.consol_num = lnConsol_num And ;
7440 h.customer = lcCustomer AND ;
7441 IIF(this.lAllowConsolDiv AND llConsInvDiv And (_eoinCnt.consol_inv = 'Y' OR _eoinCnt.consol_inv = 'S'), 1=1 , h.division = lcDivision) And ;
7442 d.Fkey = h.Pkey ;
7443 INTO Cursor _tceDet
7444 *=== TR 1029588 NH 01/07/08
7445 *- 1008582 02/22/05 YIK
7446 *- Added edi_store
7447 *--- TR 1086775/1081474 19-NOV-14 Venuk. division = lcDivision replaced with IIF((_eoinCnt.consol_inv = 'Y' OR _eoinCnt.consol_inv = 'S'), 1=1 , division = lcDivision) ===
7448 Select Pkey, EDI_Store From (pcTransHeader) ;
7449 WHERE customer = lcCustomer And ;
7450 IIF(this.lAllowConsolDiv AND llConsInvDiv AND (_eoinCnt.consol_inv = 'Y' OR _eoinCnt.consol_inv = 'S'), 1=1 , division = lcDivision) And consol_num = lnConsol_num ;
7451 INTO Cursor _tceHPKey
7452
7453 * --- TR 1015795 4-May-2006 Goutam
7454 If _eoinCnt.consol_inv = "S"
7455 Select Distinct(Store) As Store From (pcTransHeader) ;
7456 WHERE customer = lcCustomer And division = lcDivision And consol_num = lnConsol_num ;
7457 INTO Cursor _tceStoreDet
7458
7459 lnTotalStore = Reccount("_tceStoreDet")
7460 Endif
7461 * === TR 1015795 4-May-2006 Goutam
7462
7463 *- Add new consolidated header to trans. maint. header table
7464 Select (pcTransHeader)
7465 *--- TR 1086775/1081474 19-NOV-14 Venuk. division = lcDivision replaced with IIF(_eoinCnt.consol_inv = 'Y', 1=1 , division = lcDivision) ===
7466 Locate For consol_num = lnConsol_num AND customer = lcCustomer ;
7467 AND IIF(this.lAllowConsolDiv AND llConsInvDiv AND (_eoinCnt.consol_inv = 'Y' OR _eoinCnt.consol_inv = 'S'), 1=1 , division = lcDivision) && TR 1071252 FH
7468 lnh_pkey = Pkey
7469 Scatter Name loConsolH Memo
7470 *--- TR 1086775/1081474 19-NOV-14 Venuk. division = lcDivision replaced with IIF((_eoinCnt.consol_inv = 'Y' OR _eoinCnt.consol_inv = 'S') , division = lcDivision) ===
7471 Delete For consol_num = lnConsol_num AND customer = lcCustomer ;
7472 AND IIF(this.lAllowConsolDiv AND llConsInvDiv AND (_eoinCnt.consol_inv = 'Y' OR _eoinCnt.consol_inv = 'S'), 1=1 , division = lcDivision) && TR 1071252 FH
7473 Select _tceTotH
7474 loConsolH.ord_qty = ord_qty
7475 loConsolH.weight = weight
7476 loConsolH.carton = carton
7477 loConsolH.frgt_amt = frgt_amt
7478 loConsolH.disc_amt = disc_amt
7479 loConsolH.misc_amt = misc_amt
7480 loConsolH.tax_amt = tax_amt && TR 1001689 AM 11/19/03
7481 loConsolH.inv_amt = inv_amt
7482 loConsolH.merch_amt = merch_amt
7483
7484 If (_eoinCnt.consol_inv = "Y") Or (lnTotalStore > 1) && ---1015795 5-Apr-2006 Goutam
7485 loConsolH.Store = ""
7486 *- 1010418 04/11/05 YIK
7487 loConsolH.EDI_Store = ""
7488 Endif && ---1015795 5-Apr-2006 Goutam
7489
7490 loConsolH.termdscamt = termdscamt
7491 *- 37722 YIK
7492 *-loConsolH.pkey = v_NextPkey("ZZEOINTH")
7493 loConsolH.Pkey = v_NextPkey(lcHdrFile)
7494 *= 37722
7495 loConsolH.inv_num = lnConsol_num
7496 Select (pcTransHeader)
7497 Append Blank
7498 Gather Name loConsolH Memo
7499 *- Process Addresses
7500 If !Empty(pcTransAddress)
7501 Select (pcTransAddress)
7502 Replace Fkey With loConsolH.Pkey For Fkey = lnh_pkey
7503 Select _tceHPKey
7504 Scan
7505 Delete For Pkey = _tceHPKey.Pkey In (pcTransAddress)
7506 Endscan
7507 Endif
7508 *- process details
7509 Select _tceDet
7510 Scan
7511 lcStyle = _tceDet.Style
7512 lcColor = _tceDet.color_code
7513 lcLabel = _tceDet.Lbl_code
7514 lcDimension = _tceDet.Dimension
7515 lcSizeBucket = _tceDet.sizebucket
7516 *--- TR 1029588 NH 01/07/08
7517 lcRng_style = _tceDet.Rng_style
7518 lcRng_color = _tceDet.Rng_color
7519 lcRng_lbl = _tceDet.Rng_lbl
7520 lcRng_pack = _tceDet.Rng_pack
7521 *lcRng_bk = _tceDet.rng_bk &&--- TR 1030633 NH 02/11/08
7522 *=== TR 1029588 NH 01/07/08
7523
7524 *- TR 1059880 FH
7525 lnPrice = _tceDet.price
7526 lcAssortment = _tceDet.assortment
7527 *-TR 1059880 FH
7528
7529 *- 1013889 10/31/05 YIK
7530 *- reset the array of discounts for each new detail
7531 Declare laDRef[3,3]
7532 laDRef = ' '
7533 lnCounter = 0
7534 *- 1014917 01/09/06 YIK
7535 *- Initialize consolidated new store discount amount
7536 Local lnNewStoreDiscount, lcNS_Ref, lnNS_Rate
7537 lnNewStoreDiscount = 0
7538 lcNS_Ref = ''
7539 lnNS_Rate = 0
7540 *= 1014917
7541
7542 *- 1008582 2/22/05 YIK
7543 *- Added SCATTER and h.Edi_Store to create SDQs. Consol_num is lnConsol_num
7544
7545 *--- TR 1015795 5-Apr-2006 Goutam Added ORDER BY h.Edi_Store in following SQL
7546 *--- TR 1029588 NH 01/07/08
7547 *--- TR 1030633 NH 02/11/08 : Removed code from Sql : AND rng_bk = lcRng_bk
7548 *-TR 1059880 FH- adding price and assortment
7549 Select h.EDI_Store, d.* ;
7550 FROM (pcTransDetail) d ;
7551 JOIN _tceHPKey h On d.Fkey = h.Pkey ;
7552 WHERE Style = lcStyle And color_code = lcColor And Lbl_code = lcLabel And ;
7553 dimension = lcDimension And sizebucket = lcSizeBucket ;
7554 AND rng_style = lcRng_style AND rng_color = lcRng_color AND rng_lbl = lcRng_lbl ;
7555 and rng_pack = lcRng_pack ;
7556 AND price = lnPrice ;
7557 AND assortment = lcAssortment ;
7558 ORDER By h.EDI_Store ;
7559 INTO Cursor _tceConsolDet
7560 *=== TR 1029588 NH 01/07/08
7561 Scatter Name loConsolD Memo
7562 loConsolD.Pkey = v_NextPkey(lcDetFile)
7563
7564 *--- 04/15/2016 YIK LOCAL ONLY 1094519
7565 loConsolD.Fkey = loConsolH.Pkey
7566
7567 If (_eoinCnt.consol_inv = "Y") Or (lnTotalStore > 1) && ---1015795 5-Apr-2006 Goutam
7568 Select (tcSDQ)
7569 *- need to get h.consol_num, Edi_Store, upc, sku, ean, h.pkey as pkey, d.pkey as fkey, total_qty
7570 Scatter Name loSDQ Blank
7571 loSDQ.Total_qty = 0
7572 *= 1008582
7573 Endif && ---1015795 5-Apr-2006 Goutam
7574
7575 Store 0 To lntotal_qty, lnorig_qty, lnopenpickqty, lncancelqty, lninvoiceqty
7576 Select _tceConsolDet
7577 Scan
7578
7579 *-FH 1099130
7580 LOCAL lnRecNo , lcEDI_Store, lcOrd_Line, lnSACD_qty
7581 lnRecNo = Recno()
7582 lcEDI_Store = EDI_store
7583
7584 SCAN FOR EDI_STORE = lcEDI_Store
7585 lcOrd_Line = PADL(ord_num, 10) + PADL(line_seq, 4)
7586 lcSizebucket = ALLTRIM(STR(sizeBucket))
7587 lnSACD_qty = Total_qty
7588
7589 IF USED("tceointsac1")
7590 SELECT tceointsac1
7591 LOCATE FOR PADL(ord_num, 10) + PADL(line_seq, 4) = lcOrd_Line AND size_bucket = lcSizebucket
7592 IF FOUND()
7593 REPLACE line_seq WITH loConsolD.line_seq, ;
7594 ord_num WITH loConsold.ord_num, ;
7595 hfKey WITH loConsolD.Fkey ;
7596 dfkey WITH loConsolD.Pkey, ;
7597 SAC_Qty WITH IIF(SAC_Qty = 0, lnSACD_qty, SAC_Qty)
7598 ENDIF
7599
7600 LOCATE FOR ord_num = _tceConsolDet.ord_num AND line_seq = 0
7601 IF FOUND() AND hfKey <> loConsolD.Fkey
7602 REPLACE hfKey WITH loConsolD.Fkey, ;
7603 inv_num WITH loConsolH.inv_num, ;
7604 dfkey WITH 0 FOR ord_num = _tceConsolDet.ord_num AND line_seq = 0
7605 ENDIF
7606 ENDIF
7607 *=== TR 1094519 15-Apr-2016 BNarayanan ===
7608 ENDSCAN
7609
7610 SELECT _tceConsolDet
7611 Go lnRecNo
7612 *-FH 1099130
7613
7614 If (_eoinCnt.consol_inv = "Y") Or (lnTotalStore > 1) && ---1015795 5-Apr-2006 Goutam
7615 *- 1008582 02/22/05 YIK
7616 loSDQ.Fkey = loConsolD.Pkey
7617 loSDQ.Pkey = loConsolH.Pkey
7618
7619 *--- 1015795 5-Apr-2006 Goutam
7620 *loSDQ.total_qty = total_qty
7621 If _eoinCnt.consol_inv = "Y"
7622 loSDQ.Total_qty = Total_qty
7623 Endif
7624 *=== 1015795 5-Apr-2006 Goutam
7625
7626 *- 04/18/16 YIK LOAL ONLY 1094519 ---
7627 *lnSACD_qty = Total_qty TR 1099130 FH
7628
7629 loSDQ.consol_num = lnConsol_num
7630 loSDQ.EDI_Store = EDI_Store
7631 *---1015795 5-Apr-2006 Goutam
7632 If _eoinCnt.consol_inv = "S"
7633
7634 Sum Total_qty, ;
7635 orig_qty, ;
7636 OpenPickQty, ;
7637 CancelQty, ;
7638 InvoiceQty ;
7639 WHILE EDI_Store = loSDQ.EDI_Store ;
7640 TO ;
7641 lnSDQStoreTotalQty, ;
7642 lnSDQStoreOrigQty, ;
7643 lnSDQStoreopenpickqty, ;
7644 lnSDQStorecancelqty, ;
7645 lnSDQStoreinvoiceqty
7646
7647 loSDQ.Total_qty = lnSDQStoreTotalQty
7648 Skip - 1
7649 Endif
7650 *===1015795 5-Apr-2006 Goutam
7651
7652 Select (tcSDQ)
7653 Append Blank
7654 Gather Name loSDQ
7655 Select _tceConsolDet
7656 *== 1008582
7657 Endif && ---1015795 5-Apr-2006 Goutam
7658
7659 *---1015795 5-Apr-2006 Goutam
7660 *lntotal_qty = lntotal_qty + total_qty
7661 If (_eoinCnt.consol_inv = "S") And (lnTotalStore > 1)
7662 lntotal_qty = lntotal_qty + lnSDQStoreTotalQty
7663 lnorig_qty = lnorig_qty + lnSDQStoreOrigQty
7664 lnopenpickqty = lnopenpickqty + lnSDQStoreopenpickqty
7665 lncancelqty = lncancelqty + lnSDQStorecancelqty
7666 lninvoiceqty = lninvoiceqty + lnSDQStoreinvoiceqty
7667 Else
7668 lntotal_qty = lntotal_qty + Total_qty
7669 lnorig_qty = lnorig_qty + orig_qty
7670 lnopenpickqty = lnopenpickqty + OpenPickQty
7671 lncancelqty = lncancelqty + CancelQty
7672 lninvoiceqty = lninvoiceqty + InvoiceQty
7673 Endif
7674 *!* lntotal_qty = lntotal_qty + total_qty
7675 *!* lnorig_qty = lnorig_qty + orig_qty
7676 *!* lnopenpickqty = lnopenpickqty + openpickqty
7677 *!* lncancelqty = lncancelqty + cancelqty
7678 *!* lninvoiceqty = lninvoiceqty + invoiceqty
7679 *===1015795 5-Apr-2006 Goutam
7680
7681 lnPkey = Pkey
7682
7683 *- TR 1035813 09/16/08 YIK
7684 *- match view of discounts to the consolidated invoice detail to be created
7685*- 1099130 FH comment
7686*!* lcOrd_Line = PADL(ord_num, 10) + PADL(line_seq, 4)
7687 *--- TR 1094519 15-Apr-2016 BNarayanan ---
7688 *IF USED("VzzoordSACD_Proc") && IF llSACD
7689 *SELECT VzzoordSACD_Proc
7690 *- Can't use SEEK since we'd need an index by ord_num and line_seq
7691 *- and the REPLACE would change the index fields!
7692 *LOCATE FOR PADL(ord_num, 10) + PADL(line_seq, 4) = lcOrd_Line
7693 *IF FOUND()
7694 *REPLACE line_seq WITH loConsolD.line_seq, ;
7695 *ord_num WITH loConsold.ord_num
7696 *ENDIF
7697 *ENDIF
7698
7699*!* lcSizebucket = ALLTRIM(STR(sizeBucket))
7700
7701*!* IF USED("tceointsac1")
7702*!* SELECT tceointsac1
7703*!* LOCATE FOR PADL(ord_num, 10) + PADL(line_seq, 4) = lcOrd_Line AND size_bucket = lcSizebucket
7704*!* IF FOUND()
7705*!* REPLACE line_seq WITH loConsolD.line_seq, ;
7706*!* ord_num WITH loConsold.ord_num, ;
7707*!* hfKey WITH loConsolD.Fkey ;
7708*!* dfkey WITH loConsolD.Pkey, ;
7709*!* SAC_Qty WITH IIF(SAC_Qty = 0, lnSACD_qty, SAC_Qty)
7710*!* ENDIF
7711
7712*!* LOCATE FOR ord_num = _tceConsolDet.ord_num AND line_seq = 0
7713*!* IF FOUND() AND hfKey <> loConsolD.Fkey
7714*!* REPLACE hfKey WITH loConsolD.Fkey, ;
7715*!* inv_num WITH loConsolH.inv_num, ;
7716*!* dfkey WITH 0 FOR ord_num = _tceConsolDet.ord_num AND line_seq = 0
7717*!* ENDIF
7718*!* ENDIF
7719*!* *=== TR 1094519 15-Apr-2016 BNarayanan ===
7720
7721*!* SELECT _tceConsolDet
7722*-1099130 FH comment
7723
7724 *== 1035813
7725
7726 *- 1014660 12/14/05 YIK
7727 *- Added IF..ENDIF. SAC_ fields exist only in the 810 tables.
7728 If lcDetFile = "ZZEOINTD"
7729
7730 *- 1013889 10/31/05 YIK
7731 *- Create array of SAC_DRef, _DRate and calcuclate their corresponding _DAmt
7732 This.CalcDiscAmt(@laDRef, SAC_DRef1, SAC_DRate1, SAC_DAmt1, @lnCounter)
7733 This.CalcDiscAmt(@laDRef, SAC_DRef2, SAC_DRate2, SAC_DAmt2, @lnCounter)
7734 This.CalcDiscAmt(@laDRef, SAC_DRef3, SAC_DRate3, SAC_DAmt3, @lnCounter)
7735 *- 1014917 01/09/06 YIK
7736 *- Calculate consolidated New Store discount
7737 *- If only some of individual details have New Store SAC string
7738 *- populate it to the consolidated detail
7739 lnNewStoreDiscount = lnNewStoreDiscount + SAC_NSAmt
7740 lcNS_Ref = Iif(Empty(lcNS_Ref), SAC_NSRef, lcNS_Ref)
7741 lnNS_Rate = Iif(lnNS_Rate = 0, SAC_NSRate, lnNS_Rate)
7742 *=
7743 Endif
7744
7745 Select (pcTransDetail)
7746 Delete For Pkey = lnPkey
7747 Endscan
7748 loConsolD.Total_qty = lntotal_qty
7749 loConsolD.orig_qty = lnorig_qty
7750 loConsolD.OpenPickQty = lnopenpickqty
7751 loConsolD.CancelQty = lncancelqty
7752 loConsolD.InvoiceQty = lninvoiceqty
7753 *- 1013889 10/31/05 YIK
7754 If !Empty(laDRef[1, 1])
7755 loConsolD.SAC_DRef1 = laDRef[1, 1]
7756 loConsolD.SAC_DRate1 = Iif(Empty(laDRef[1, 2]), 0, laDRef[1, 2])
7757 *- 1014055 11/03/05 YIK
7758 *- Round to 2 decimals here
7759 loConsolD.SAC_DAmt1 = Iif(Empty(laDRef[1, 3]), 0, Round(laDRef[1, 3], 2))
7760 If !Empty(laDRef[2, 1])
7761 loConsolD.SAC_DRef2 = laDRef[2, 1]
7762 loConsolD.SAC_DRate2 = Iif(Empty(laDRef[2, 2]), 0, laDRef[2, 2])
7763 loConsolD.SAC_DAmt2 = Iif(Empty(laDRef[2, 3]), 0, Round(laDRef[2, 3], 2))
7764 If !Empty(laDRef[3, 1])
7765 loConsolD.SAC_DRef3 = laDRef[3, 1]
7766 loConsolD.SAC_DRate3 = Iif(Empty(laDRef[3, 2]), 0, laDRef[3, 2])
7767 loConsolD.SAC_DAmt3 = Iif(Empty(laDRef[3, 3]), 0, Round(laDRef[3, 3], 2))
7768 *= 1014055
7769 Endif
7770 Endif
7771 Endif
7772 *- 1014917 01/09/06 YIK
7773 loConsolD.SAC_NSAmt = lnNewStoreDiscount
7774 loConsolD.SAC_NSRef = lcNS_Ref
7775 loConsolD.SAC_NSRate = lnNS_Rate
7776 *= 1014917
7777
7778 *- 1008582 02/22/05 YIK
7779 *- Move the assignment higher
7780 *- loConsolD.pkey = v_NextPkey(lcDetFile)
7781 loConsolD.Fkey = loConsolH.Pkey
7782 Select (pcTransDetail)
7783 Append Blank
7784 Gather Name loConsolD Memo
7785 Endscan
7786 Endscan && through _eoinCnt
7787
7788 *- cleanup
7789 If Used("_eoinCnt")
7790 Use In _eoinCnt
7791 Endif
7792 If Used("_tceTotH")
7793 Use In _tceTotH
7794 Endif
7795 If Used("_tceDet")
7796 Use In _tceDet
7797 Endif
7798 If Used("_tceConsolDet")
7799 Use In _tceConsolDet
7800 Endif
7801 If Used("_tceHPKey")
7802 Use In _tceHPKey
7803 Endif
7804 *--- TR 1015795 5-Apr-2006 Goutam
7805 If Used("_tceStoreDet")
7806 Use In _tceStoreDet
7807 Endif
7808 *=== TR 1015795 5-Apr-2006 Goutam
7809
7810 Endproc
7811
7812 *- 39744 5/22/03 YIK - Retrieve values from PO history detail table
7813 Procedure GetPOHistDetail
7814 Parameters pceTransHeader, pceTransDetail, plGetSAC
7815 Local llRetVal, lcSQLSelect, llPO4_Required, lcReplaceStr
7816 llRetVal = .T.
7817 lnOldSelect = Select()
7818 llPO4_Required = goEnv.SV('PO4_REQUIRED', 'N') = 'Y'
7819 *-IF llPO4_Required
7820 * all details from 850(i) history detail
7821
7822 *--- TR 1060800 24-May-2012 Goutam. Removed Or h.chk_hist = 'Y' from where clause
7823 *--- TR 1063235 10-Aug-2012 Goutam. Removed WHERE llPO4_Required. This is no more required as per Yuri as all clients are using 850 history detail
7824 Select d.Pkey, d.ord_num, d.line_seq, d.sizebucket ;
7825 From (pceTransDetail) d Join (pceTransHeader) h ;
7826 on h.Pkey = d.Fkey ;
7827 Into Cursor __TmpCursor
7828
7829 With This
7830 If Recc("__TmpCursor")> 0
7831 .cSQLTempTable=""
7832 llRetVal= llRetVal And .GenerateSQLTempTable('__TmpCursor')
7833 llRetVal= llRetVal And .PopulateSQLTempTable('__TmpCursor') And !Empty(.cSQLTempTable)
7834 lcSqlString= "Select t.pkey, t.ord_num, d.* " +;
7835 "From zzeipohd d, " + .cSQLTempTable + " t " +;
7836 "Where d.ord_num= t.ord_num and d.line_seq= t.line_seq and d.sizebucket= t.sizebucket"
7837 llRetVal= llRetVal And v_SQLexec(lcSqlString, "tcHistDtl")
7838
7839 If Recc("tcHistDtl")> 0
7840 Select tcHistDtl
7841 Index On Pkey Tag Pkey
7842 llRetVal= llRetVal And .SetRelation("tcHistDtl", "pkey", pceTransDetail, "pkey")
7843 Select (pceTransDetail)
7844 *- 36262 6/19/03 YIK
7845 *- Add ib_uom, ppk_action and ppk_qty
7846 *- 1005533 06/02/04 YIK
7847 *- SAC fields exist only in 810 transaction maintenance.
7848 *- Replace them conditionally, based on a new parameter plGetSAC
7849 *!* Replace EDIPO4UDF1 with tcHistDtl.EDIPO4UDF1, ;
7850 *!* EDIPO4UDF2 with tcHistDtl.EDIPO4UDF2, ;
7851 *!* EDIPO4UDF3 with tcHistDtl.EDIPO4UDF3, ;
7852 *!* Ppk_action with tcHistDtl.Ppk_action, ;
7853 *!* ib_uom with tcHistDtl.ib_uom, ;
7854 *!* Ppk_qty with tcHistDtl.Ppk_qty, ;
7855 *!* SAC_DREF1 with tcHistDtl.SAC_DREF1, SAC_DREF2 with tcHistDtl.SAC_DREF2, ;
7856 *!* SAC_DREF3 with tcHistDtl.SAC_DREF3, SAC_DRate1 with tcHistDtl.SAC_DRate1, ;
7857 *!* SAC_DRate2 with tcHistDtl.SAC_DRate2, SAC_DRate3 with tcHistDtl.SAC_DRate3 ;
7858 *!* for tcHistDtl.Pkey> 0
7859
7860 *- 1007309 09/28/04 YIK
7861 *- Added "..PO1_Line with tcHistDtl.PO1_Line"
7862 *--- TechRec 1027666 25-Oct-2007 T.Shenbagavalli added is_skuupc ---
7863 *--- TechRec 1027827 21-Jan-2008 T.Shenbagavalli added style_name ---
7864 *--- TR 1063591 08/27/12 ATHIRUNAVU Added condition for style_name update
7865 lcReplaceStr = "Replace EDIPO4UDF1 with tcHistDtl.EDIPO4UDF1, " + ;
7866 "EDIPO4UDF2 with tcHistDtl.EDIPO4UDF2, " + ;
7867 "EDIPO4UDF3 with tcHistDtl.EDIPO4UDF3, " + ;
7868 "Ppk_action with tcHistDtl.Ppk_action, " + ;
7869 "ib_uom with tcHistDtl.ib_uom, " + ;
7870 "Ppk_qty with tcHistDtl.Ppk_qty, " + ;
7871 "PO1_Line with tcHistDtl.PO1_Line, " + ;
7872 "IS_UPCSKU with tcHistDtl.IS_UPCSKU, " + ;
7873 "Style_Name with IIF(EMPTY(style_name), tcHistDtl.Style_Name, style_name) "
7874
7875 If plGetSAC
7876 lcReplaceStr = lcReplaceStr + ", " + ;
7877 "SAC_DREF1 with tcHistDtl.SAC_DREF1, SAC_DREF2 with tcHistDtl.SAC_DREF2, " + ;
7878 "SAC_DREF3 with tcHistDtl.SAC_DREF3, SAC_DRate1 with tcHistDtl.SAC_DRate1, " + ;
7879 "SAC_DRate2 with tcHistDtl.SAC_DRate2, SAC_DRate3 with tcHistDtl.SAC_DRate3 "
7880 *- 1014917 01/09/06 YIK
7881 If Vartype(SAC_NSRef) == 'C'
7882 lcReplaceStr = lcReplaceStr + ", " + ;
7883 "SAC_NSREF with tcHistDtl.SAC_NSREF, SAC_NSRate with tcHistDtl.SAC_NSRate "
7884 Endif
7885 *=
7886 Endif
7887 *- 1018444 08/21/06 YIK
7888 *- Added add_ref1
7889 If Vartype(add_ref1) == 'C'
7890 lcReplaceStr = lcReplaceStr + ", " + ;
7891 "add_ref1 WITH tcHistDtl.add_ref1 "
7892 Endif
7893 *= 1018444
7894
7895 *--- TR 1035491 6-Nov-2008 Goutam
7896 If Vartype(SLNtoDTL) == 'C'
7897 lcReplaceStr = lcReplaceStr + ", " + ;
7898 "SLNtoDTL with tcHistDtl.SLNtoDTL "
7899 Endif
7900 *=== TR 1035491 6-Nov-2008 Goutam
7901
7902 *--- TR 1038226 28-Jan-2009 Partha ---
7903 If Vartype(PO1_UPC) == 'C'
7904 lcReplaceStr = lcReplaceStr + ", " + ;
7905 "PO1_UPC with IIF(tcHistDtl.implosion <> 'Y',tcHistDtl.PO1_UPC, '')" && TR 1064149 FH
7906 Endif
7907 If Vartype(PO1_SKU) == 'C'
7908 lcReplaceStr = lcReplaceStr + ", " + ;
7909 "PO1_SKU with IIF(tcHistDtl.implosion <> 'Y',tcHistDtl.PO1_SKU, '')" && TR 1064149 FH
7910 Endif
7911 *=== TR 1038226 28-Jan-2009 Partha ===
7912
7913 *--- TR 1046270 29-Apr-2010 Goutam
7914 If Vartype(EDI_CARTON_GROUP) == 'C'
7915 lcReplaceStr = lcReplaceStr + ", " + ;
7916 "EDI_CARTON_GROUP with tcHistDtl.EDI_CARTON_GROUP "
7917 Endif
7918 If Vartype(EDI_CARTON_CLS) == 'C'
7919 lcReplaceStr = lcReplaceStr + ", " + ;
7920 "EDI_CARTON_CLS with tcHistDtl.EDI_CARTON_CLS "
7921 Endif
7922 *=== TR 1046270 29-Apr-2010 Goutam
7923
7924 *--- TechRec 1056973 09-Nov-2011 jisingh ---
7925 If Vartype(AUX_SKU) == 'C'
7926 lcReplaceStr = lcReplaceStr + ", " + ;
7927 "aux_sku with IIF(EMPTY(aux_sku), tcHistDtl.aux_sku, aux_sku) "
7928 Endif
7929 *=== TechRec 1056973 09-Nov-2011 jisingh ===
7930
7931 *--- TR 1060800 24-May-2012 Goutam.
7932 If Vartype(RNG_IMPL) == 'C'
7933 lcReplaceStr = lcReplaceStr + ", " + ;
7934 "Rng_Impl with tcHistDtl.Rng_Impl "
7935 Endif
7936 If Vartype(RNGP_CONV) == 'C'
7937 lcReplaceStr = lcReplaceStr + ", " + ;
7938 "Rngp_conv with tcHistDtl.Rngp_conv "
7939 Endif
7940 *=== TR 1060800 24-May-2012 Goutam
7941
7942 lcReplaceStr = lcReplaceStr + " for tcHistDtl.Pkey> 0 "
7943 &lcReplaceStr
7944 *= 1005533 06/02/04 YIK
7945 Endif
7946 Set Relation To
7947 Endif
7948 .TableClose("tcHistDtl")
7949 .TableClose("__TmpCursor")
7950 Endwith
7951 *-ENDIF
7952 Select(lnOldSelect)
7953 Return llRetVal
7954 Endproc
7955 *=== 39744 YIK 5/22/03
7956
7957 *- 36262 6/19/03 YIK
7958 Procedure PrepackConversionOut
7959 Lparameters pcTransDetail, pcTransSDQ && TR 1045015 Jan-26-2010 BR Added: pcTransSDQ
7960 Local llRetVal, lnOldSelect
7961 LOCAL lnDtlPkey, lnPPKQty,lcOrder && TR 1045015 Jan-26-2010 BR
7962
7963 llRetVal = .T.
7964 lnOldSelect = Select()
7965
7966 * --- TR 1048126 8/23/10 CM
7967 LOCAL lcSQLString, lcErrs_Msg, lnPkey, lnPpkQty
7968
7969 SELECT DISTINCT division, style, color_code, lbl_code, dimension, ppk_action, pkey ;
7970 FROM (pcTransDetail) ;
7971 WHERE rng_type = 'P' ;
7972 AND !EMPTY(ppk_action) ;
7973 AND ppk_qty = -1 ;
7974 INTO CURSOR __TmpCursor
7975
7976 IF USED("__TmpCursor") AND RECCOUNT("__TmpCursor") > 0
7977 WITH THIS
7978 .cSQLTempTable=""
7979 IF .GenerateSQLTempTable('__TmpCursor')
7980 IF .PopulateSQLTempTable('__TmpCursor')
7981 IF !EMPTY(.cSQLTempTable)
7982 lcSQLString = "SELECT t.*, ISNULL(ph.pack_qty, 0) AS pack_qty " + ;
7983 "FROM " + .cSQLTempTable + " t " + ;
7984 "JOIN zzxscolr s " + ;
7985 "ON t.division = s.division " + ;
7986 "AND t.style = s.style and t.color_code = s.color_code " + ;
7987 "AND t.lbl_code = s.lbl_code and t.dimension = s.dimension " + ;
7988 "JOIN zzxstylr h " + ;
7989 "ON s.fkey = h.pkey " + ;
7990 "LEFT OUTER JOIN zzxppakh ph " + ;
7991 "ON s.division = ph.division and h.size_code = ph.size_code " + ;
7992 "AND s.dimension = ph.ppk_code " + ;
7993 "WHERE s.ppack_ok = 'Y' "
7994
7995 llRetVal= llRetVal And v_SqlExec(lcSQLString, "_PPK_Qty")
7996 IF llRetVal
7997 .LogEntry("Validating prepack style.")
7998 lcErrs_Msg = "No valid prepack code found"
7999 ENDIF
8000 IF USED("_PPK_Qty")
8001 SELECT ("_PPK_Qty")
8002 INDEX ON pkey TAG pkey
8003 SCAN
8004 lnPkey = pkey
8005 lnPpkQty = pack_qty
8006 IF SEEK(lnPkey, pcTransDetail, "pkey")
8007 IF !EMPTY(lnPpkQty)
8008 SELECT (pcTransDetail)
8009 REPLACE ppk_qty WITH lnPpkQty
8010 ELSE
8011 SELECT (pcTransDetail)
8012 REPLACE Errs_Msg_D WITH Errs_Msg_D + lcErrs_Msg + CRLF, ;
8013 Errs_Flg_D WITH "Y"
8014 ENDIF
8015 ENDIF
8016 ENDSCAN
8017 ENDIF
8018 ENDIF
8019 ENDIF
8020 ENDIF
8021 ENDWITH
8022 ENDIF
8023 * === TR 1048126 8/23/10 CM
8024
8025 Select (pcTransDetail)
8026 *- Don't really have to update ppk_action, just for debugging purposes
8027 *- 1001044 9/12/03 YIK
8028 *- Also update orig_qty
8029
8030 *- 1052584 02/22/11 YIK
8031 *- Don't do conversion for SLNtoDTL = 'Y'
8032 *- because: 1. We do it in DTLtoSLN()
8033 *- 2. ppk_qty in this case can't be used for conversion.
8034 *- 3. In some cases we call conversion before DTLtoSLN() (810), in some - after (856)
8035
8036 *- 1060291 04/11/12 YIK
8037 *- Don't do conversion for the 810 if SLNtoDTL = 'I' and
8038 *- ppk_action either 'M' or 'D' because they would cause output
8039 *- with qty and price in different uom (one in cases, another in eaches)
8040 *- thereofre added Added .. AND lcTransaction <> 'OIN' to conversion for ppk_action 'M' or 'D'
8041 lcTransaction = UPPER(SUBSTR(pcTransDetail, 4,3)) && for tceointd -> OIN, for tceOSHTD -> OSH
8042
8043 *--- TR 1064843 10/23/12 ATHIRUNAVU Added SLNTODLT condition and used in below 3 replaces
8044 lcSLNToDLTCond = IIF(TYPE("SLNtoDTL") ="C", " AND SLNtoDTL < 'Y'", "")
8045
8046 *--- TR 1064843 10/23/12 ATHIRUNAVU Added &lcSLNToDLTCond
8047 Replace ;
8048 Total_qty With Total_qty/ppk_qty, ;
8049 orig_qty With orig_qty/ppk_qty, ;
8050 ppk_action With 'Q' ; && 'Q'uantity converted.
8051 For Errs_Flg_D <> "Y" And ppk_action = 'M' AND lcTransaction <> 'OIN' &lcSLNToDLTCond.;
8052 In (pcTransDetail)
8053
8054 *- 1053186 04/06/11 YIK
8055 *- round price to 2 decimals to account for conversion on the way in.
8056 *- when price is not divisible exactly.
8057 *--- TR 1064843 10/23/12 ATHIRUNAVU Added &lcSLNToDLTCond
8058 Replace ;
8059 price With ROUND(price*ppk_qty, 2), ;
8060 org_price With ROUND(org_price*ppk_qty, 2), ;
8061 ppk_action With 'P' ; && 'P'rice converted
8062 For Errs_Flg_D <> "Y" And ppk_action = 'D' AND lcTransaction <> 'OIN' &lcSLNToDLTCond.;
8063 In (pcTransDetail)
8064 *= 1060291 YIK
8065
8066 *- 1001044 9/12/03 YIK
8067 *- Also update orig_qty
8068 *--- TR 1064843 10/23/12 ATHIRUNAVU Added &lcSLNToDLTCond
8069 Replace ;
8070 price With ROUND(price*ppk_qty, 2), ;
8071 org_price With ROUND(org_price*ppk_qty, 2), ;
8072 Total_qty With Total_qty/ppk_qty, ;
8073 orig_qty With orig_qty/ppk_qty, ;
8074 ppk_action With 'B' ; && "B'oth
8075 For Errs_Flg_D <> "Y" And ppk_action = 'X' &lcSLNToDLTCond. ;
8076 In (pcTransDetail)
8077
8078 *= 1052584
8079 *---1045015 Jan-26-2010 BR - Need conversion for SDQs
8080 IF !EMPTY(pcTransSDQ)
8081 IF USED(pcTransSDQ) AND RECCOUNT(pcTransSDQ) > 0
8082 SELECT (pcTransSDQ)
8083 lcOrder = ORDER()
8084
8085 SELECT (pcTransDetail)
8086 SCAN
8087 lnDtlPkey = pkey
8088 lnPPKQty = ppk_qty
8089 SELECT (pcTransSDQ)
8090 SET ORDER TO fkey
8091 IF SEEK(lnDtlPkey, pcTransSDQ, "FKEY")
8092 SCAN WHILE fkey = lnDtlPkey
8093 REPLACE total_qty WITH IIF(lnPPKQty > 0,total_qty/lnPPKQty,total_qty) IN (pcTransSDQ)
8094 ENDSCAN
8095 ENDIF
8096 ENDSCAN
8097
8098 SET ORDER TO (lcOrder)
8099 ENDIF
8100 ENDIF
8101 *===1045015 Jan-26-2010 BR
8102
8103 * --- TR 1048126 8/23/10 CM
8104 USE IN SELECT('__TmpCursor')
8105 USE IN SELECT('_PPK_Qty')
8106 * === TR 1048126 8/23/10 CM
8107
8108 Select(lnOldSelect)
8109 Return llRetVal
8110
8111 *- 41139 8/8/03 YIK
8112 Procedure GetCustomerTerms
8113 *--- TR 1070143 04/09/13 ATHIRUNAVU Added new parameter tcTerm_Desc
8114 Lparameters tcWorkHeader, tnITD_DueDays, tnITD_DiscPct, tnITD_DiscDays, tcITD_Terms, tcITD_TmType,;
8115 tcITD_Basis, tdITD_EOMCutOf, tdITD_EOMFxDue, tcTerm_desc
8116
8117 Local lcCustomer, lcTerms, llRetVal, lnOldSelect
8118
8119 llRetVal = .T.
8120 lnOldSelect = Select()
8121
8122 lcCustomer = &tcWorkHeader..customer
8123 lcTerms = &tcWorkHeader..terms
8124 If vl_ctrmX(lcCustomer, , "_TermX", lcTerms)
8125 tnITD_DueDays = _TermX.ITD_DueDays
8126 tnITD_DiscPct = _TermX.ITD_DiscPct
8127 tnITD_DiscDays = _TermX.ITD_DiscDays
8128 tcITD_Terms = _TermX.ITD_Terms
8129 tcITD_TmType = _TermX.ITD_TmType
8130 tcITD_Basis = _TermX.ITD_Basis
8131
8132 *--- TR 1070143 04/09/13 ATHIRUNAVU
8133 tcTerm_desc = _TermX.desc_code
8134 *=== TR 1070143 04/09/13 ATHIRUNAVU
8135 Endif
8136 If Used('_TermX')
8137 Use In _TermX
8138 Endif
8139 Select(lnOldSelect)
8140 Return llRetVal
8141 Endproc
8142
8143 *- 1001378 11/18/03 YIK
8144 Procedure PrepackExplosion
8145 Lparameters pceTransDetail, pcFinalSLN
8146 Local llRetVal, lnOldSelect, lnPrepacks, lntotal_qty, lnorig_qty, lnopenpickqty, ;
8147 lncancelqty, lninvoiceqty, lnMax, lnLast, lnCnt, lnCurrpkey, lnsize_qty, ;
8148 lnorig_qty, llSDQExists
8149 llRetVal= .T.
8150 lnOldSelect= Select()
8151 If Used(pcFinalSLN) And This.CountTotalRecs (pcFinalSLN)> 0
8152 *- Assign pkey in a batch
8153 *- 1006052 07/20/04 YIK
8154 *- Added ..AND d.errs_flg_d <> "Y" to prevent components with
8155 *- missing upc/sku to be exploded
8156 Select Count(*) ;
8157 FROM (pcFinalSLN) s ;
8158 JOIN (pceTransDetail) d On s.ITM_Pkey = d.Pkey ;
8159 WHERE d.Implosion = 'Y' And d.Errs_Flg_D <> "Y" ;
8160 INTO Array laCnt
8161 lnMax = laCnt[1]
8162 If lnMax > 0
8163 lnLast= v_NextPkey("ZZEOINTD", lnMax)
8164 *- 1006052 07/20/04 YIK
8165 Else
8166 Return .T.
8167 *=
8168 Endif
8169 *- 1008582 02/23/05 YIK
8170 llSDQExists = Used("tcSDQ")
8171 If llSDQExists
8172 Select * From tcSDQ Where .F. Into Cursor __tmpSDQ
8173 This.MakeCursorWritable("__tmpSDQ", "__SDQ")
8174 Endif
8175 lnCnt= 0
8176 Select (pceTransDetail)
8177 Scan For Implosion = 'Y' And Errs_Flg_D <> "Y" && TR 1042862 10/2/09 CM --- Added Errs_Flg_D <> "Y"
8178 Scatter Name loDTL Memo
8179 lntotal_qty = loDTL.Total_qty
8180 lnorig_qty = loDTL.orig_qty
8181 lnopenpickqty= loDTL.OpenPickQty
8182 lncancelqty = loDTL.CancelQty
8183 lninvoiceqty = loDTL.InvoiceQty
8184 Replace Implosion With "X"
8185 lnCurrpkey = loDTL.Pkey
8186
8187 Select (pcFinalSLN)
8188 Scan For ITM_Pkey = lnCurrpkey
8189 lnsize_qty = &pcFinalSLN..PPSize_qty
8190 lnPack_qty = &pcFinalSLN..pack_qty
8191 *- 1004414 05/13/04 YIK
8192 *- EXCLUDE ratio! It may cause rounding issues.
8193 *- lnRatio = lnsize_qty/lnPack_qty
8194
8195 lnCnt = lnCnt + 1
8196
8197 loDTL.Pkey = (lnLast - lnMax) + lnCnt && Detail pkey
8198 loDTL.color_code = &pcFinalSLN..color_code
8199 loDTL.Lbl_code = &pcFinalSLN..Lbl_code
8200 loDTL.Dimension = &pcFinalSLN..Dimension
8201 loDTL.sizebucket = &pcFinalSLN..sizebucket
8202 loDTL.size_desc = &pcFinalSLN..size_desc
8203 loDTL.upc = &pcFinalSLN..upc
8204 loDTL.ean = &pcFinalSLN..ean && TR 1073064 30-Aug-13 Venuk.
8205 loDTL.sku = &pcFinalSLN..sku
8206 loDTL.Total_qty = lntotal_qty*lnsize_qty/lnPack_qty
8207 loDTL.orig_qty = lnorig_qty*lnsize_qty/lnPack_qty
8208 loDTL.OpenPickQty= lnopenpickqty*lnsize_qty/lnPack_qty
8209 loDTL.CancelQty = lncancelqty*lnsize_qty/lnPack_qty
8210 loDTL.InvoiceQty = lninvoiceqty*lnsize_qty/lnPack_qty
8211 loDTL.Implosion = "K" &&OK, done
8212
8213 *--- TR 1063035 27-Jul-2012 BNarayanan update Auxillary SKU if empty
8214 IF EMPTY(loDTL.aux_sku)
8215 loDTL.aux_sku= &pcFinalSLN..aux_sku
8216 ENDIF
8217 *=== TR 1063035 27-Jul-2012 BNarayanan
8218
8219 *- 1008582 02/23/05 YIK
8220 *- Insert SDQs for all new details and update SDQ fkey to match detail's pkey
8221 If llSDQExists
8222 Select tcSDQ
8223 Scan For Fkey = lnCurrpkey
8224 Scatter Name loSDQ
8225 loSDQ.Total_qty = loDTL.Total_qty
8226 loSDQ.Fkey = loDTL.Pkey
8227 Select __SDQ
8228 Append Blank
8229 Gather Name loSDQ
8230 Endscan
8231 Endif
8232 *= 1008582
8233 Select (pceTransDetail)
8234 *- 1002942 01/19/04 YIK
8235 *- "X"s are the ones that don't have corresponding SLNs
8236 *- (maybe they were errored out) and thus cannot be deleted
8237 If Implosion = 'X'
8238 Replace Implosion With "Z"
8239 Endif
8240 *=
8241 Append Blank
8242 Gather Name loDTL
8243 Select (pcFinalSLN)
8244 Endscan
8245 *- 1008582 02/23/05 YIK
8246 If llSDQExists
8247 Select tcSDQ
8248 Delete For Fkey = lnCurrpkey
8249 Endif
8250 *= 1008582
8251
8252 Select (pceTransDetail)
8253 Go Top
8254 Endscan
8255 Select (pceTransDetail)
8256 *- 1002942 01/19/04 YIK
8257 *- DELETE FOR Implosion = 'X'
8258 Delete For Implosion = 'Z'
8259 Endif
8260 *- 1008582 02/23/05 YIK
8261 If Used("__SDQ")
8262 .ScatterGather("__SDQ", "tcSDQ")
8263 Use In __SDQ
8264 Endif
8265
8266 Select(lnOldSelect)
8267 Return llRetVal
8268 Endproc
8269 *= 1001378
8270
8271 *- 1003239 02/02/04 YIK
8272 Procedure MergeRangeSLNsToSLNs
8273 Lparameters tcRangeSLN, tcSLN
8274 Local llRetVal, lnOldSelect
8275 llRetVal= .T.
8276 lnOldSelect= Select()
8277
8278 If Recc(tcRangeSLN) > 0
8279 If Used(tcSLN)
8280 *- 6/28/04 YIK
8281 This.BuildWritableCursor(tcSLN)
8282 *=
8283 Select tcSLN
8284 This.ScatterGather(tcRangeSLN, tcSLN)
8285 Else
8286 Select * From (tcRangeSLN) Into Cursor __TempSLN
8287 *- 6/28/04 YIK
8288 *- MakeCursorWritable("__TempSLN", tcSLN)
8289 This.MakeCursorWritable("__TempSLN", tcSLN)
8290 *=
8291 Endif
8292 Endif
8293 Select(lnOldSelect)
8294 Return llRetVal
8295
8296 Procedure CheckRangeSLNUPCSKU
8297 Lparameters pcTransHeader, pcTransDetail, pcSLNPrePack, pcLineSLNPrepack
8298 Local llRetVal, lnOldSelect
8299 llRetVal = .T.
8300 lnOldSelect = Select()
8301 With This
8302 *--- TR 1015050 01/27/06 NH : removing cross join that results in not enough disk space
8303 *!* Select distinct h.customer, p.* ;
8304 *!* From (pcTransHeader) h, (pcTransDetail) d, (pcSLNPrePack) p ;
8305 *!* Where h.Pkey = d.Fkey and d.division= p.division and d.style= p.PPK_style and ;
8306 *!* d.color_code= p.PPK_color and d.Lbl_code= p.PPK_label and ;
8307 *!* d.dimension= p.PPK_dimension and h.sku_upc<> "N" ;
8308 *!* Order by 1,2,3,4,5,6,7 Into Cursor _CustSLNPrepack
8309 *--- TechRec 1047631 12-Nov-2010 jisingh Added d.aux_sku, ===
8310ASSERT .f.
8311 *- 1052584 02/17/11 YIK
8312 *- Added template to list of fileds, h.sku_upc
8313 *--- TechRec STRY0102322 18-Oct-2018 MPerel --- changed d.aux_sku to SPACE(50) as aux_sku1 (per Natalya)
8314 IF TYPE(pcTransHeader + ".template") = "C" && template exists
8315
8316 Select Distinct h.customer, h.template, h.sku_upc, SPACE(50) as aux_sku1, p.* ;
8317 From (pcTransHeader) h, (pcTransDetail) d, (pcSLNPrePack) p ;
8318 Where h.Pkey = d.Fkey And d.Pkey = p.ITM_Pkey And h.sku_upc<> "N" ;
8319 Order By 1,2,3,4,5,6,7 Into Cursor _CustSLNPrepack
8320 ELSE
8321 Select Distinct h.customer, ' ' as template, h.sku_upc, SPACE(50) as aux_sku1, p.* ;
8322 From (pcTransHeader) h, (pcTransDetail) d, (pcSLNPrePack) p ;
8323 Where h.Pkey = d.Fkey And d.Pkey = p.ITM_Pkey And h.sku_upc<> "N" ;
8324 Order By 1,2,3,4,5,6,7 Into Cursor _CustSLNPrepack
8325 ENDIF
8326 *= 1052584
8327
8328 .MakeCursorWritable("_CustSLNPrepack", pcLineSLNPrepack)
8329 .TableClose("_CustSLNPrepack")
8330
8331 *--- TechRec 1056973 17-Nov-2011 jisingh ---
8332 IF USED("tcSLN") AND .CountTotalRecs("tcSLN") = 0
8333 SELECT *,pkey AS sfkey FROM (pcLineSLNPrepack) INTO CURSOR _CustSLNPrepack
8334 .MakeCursorWritable("_CustSLNPrepack", pcLineSLNPrepack)
8335 .TableClose("_CustSLNPrepack")
8336 ENDIF
8337 *=== TechRec 1056973 17-Nov-2011 jisingh ===
8338
8339 * index for optimizing
8340 If Used(pcLineSLNPrepack)
8341 Select (pcLineSLNPrepack)
8342 Index On customer+division+PPK_style+PPK_color+PPK_label+PPK_dimension Tag CustSKU
8343 Index On customer+division+Style+color_code+Lbl_code+Dimension+Str(sizebucket) Tag CustSKU
8344 Endif
8345
8346 * Find ALL Component SKUs for Prepack SLN explosion.
8347 * Populate SKU into pcLineSLNPrepack
8348 *--- TR 1015050 01/27/06 NH
8349 *!* Select distinct h.customer, p.division, p.style, p.color_code, p.Lbl_code, p.dimension,;
8350 *!* p.sizebucket, p.PPK_style, p.PPK_color, p.PPK_label, p.PPK_dimension ;
8351 *!* From (pcTransHeader) h, (pcTransDetail) d, (pcSLNPrePack) p ;
8352 *!* Where h.Pkey = d.Fkey and d.division= p.division and d.style= p.PPK_style and ;
8353 *!* d.color_code= p.PPK_color and d.Lbl_code= p.PPK_label and ;
8354 *!* d.dimension= p.PPK_dimension and ;
8355 *!* (h.sku_upc= "S" or h.sku_upc= "B" ) ; && require component SKUs
8356 *!* Order by 1,2,3,4,5,6,7 Into Cursor __TmpCursor
8357
8358 *--- TechRec 1028770 14-Jan-2008 vkrishnamurthy ---
8359 *OR h.sku_upc = "Y"
8360 *=== TechRec 1028770 14-Jan-2008 vkrishnamurthy ===
8361
8362 *--- TechRec 1028770 19-Mar-2008 vkrishnamurthy ---
8363*!* Select Distinct h.customer, p.division, p.Style, p.color_code, p.Lbl_code, p.Dimension,;
8364*!* p.sizebucket, p.PPK_style, p.PPK_color, p.PPK_label, p.PPK_dimension ;
8365*!* From (pcTransHeader) h, (pcTransDetail) d, (pcSLNPrePack) p ;
8366*!* Where h.Pkey = d.Fkey And d.Pkey = p.ITM_Pkey And ;
8367*!* (h.sku_upc= "S" Or h.sku_upc= "B" OR h.sku_upc = "Y") ; && require component SKUs
8368*!* Order By 1,2,3,4,5,6,7 Into Cursor __TmpCursor
8369
8370 *- 1052584 08/23/11 YIK
8371 *- Changed the Select to be only from pcLineSLNPrepack (since I added sku_upc to it above).
8372*-- Select Distinct h.customer, p.division, p.Style, p.color_code, p.Lbl_code, p.Dimension,;
8373*-- p.sizebucket, p.PPK_style, p.PPK_color, p.PPK_label, p.PPK_dimension,h.sku_upc ;
8374*-- From (pcTransHeader) h, (pcTransDetail) d, (pcSLNPrePack) p ;
8375*-- Where h.Pkey = d.Fkey And d.Pkey = p.ITM_Pkey And ;
8376*-- (h.sku_upc= "S" Or h.sku_upc= "B" OR h.sku_upc = "Y") ; && require component SKUs
8377*-- Order By 1,2,3,4,5,6,7 Into Cursor __TmpCursor
8378 *--- TR 1073064 30-Aug-13 Venuk.Added sku_upc = "A" ===
8379 Select customer, division, Style, color_code, Lbl_code, Dimension,;
8380 sizebucket, PPK_style, PPK_color, PPK_label, PPK_dimension, sku_upc ;
8381 From (pcLineSLNPrepack) ;
8382 Where (sku_upc= "S" Or sku_upc= "B" OR sku_upc = "Y" OR sku_upc = "A" ) ; && require component SKUs
8383 and template <> 'MACYS' ; && don't output SLN SKU for MACYS where upc_sku = 'S'
8384 Order By 1,2,3,4,5,6,7 Into Cursor __TmpCursor
8385 *=== TechRec 1052584
8386
8387
8388 .cSQLTempTable=""
8389 If .GenerateSQLTempTable('__TmpCursor')
8390 If .PopulateSQLTempTable('__TmpCursor')
8391 If !Empty(.cSQLTempTable)
8392 llRetVal= llRetVal And .CheckOutboundSLNSKU(pcTransHeader, pcTransDetail, ;
8393 pcLineSLNPrepack, .cSQLTempTable, '__TmpCursor')
8394 Endif
8395 Endif
8396 Endif
8397 .TableClose('__TmpCursor')
8398
8399 * Find ALL Component UPCs for Prepack SLN explosion
8400 * Populate UPC into pcLineSLNPrepack
8401 *--- TR 1015050 01/27/06 NH
8402 *!* Select distinct p.division, p.style, p.color_code, p.Lbl_code, p.dimension,;
8403 *!* p.sizebucket, p.PPK_style, p.PPK_color, p.PPK_label, p.PPK_dimension ;
8404 *!* From (pcTransHeader) h, (pcTransDetail) d, (pcSLNPrePack) p ;
8405 *!* Where h.Pkey = d.Fkey and d.division= p.division and d.style= p.PPK_style and ;
8406 *!* d.color_code= p.PPK_color and d.Lbl_code= p.PPK_label and ;
8407 *!* d.dimension= p.PPK_dimension and ;
8408 *!* (h.sku_upc= "U" or h.sku_upc= "B" ) ; && require component UPCs
8409 *!* Order by 1,2,3,4,5,6 Into Cursor __TmpCursor
8410
8411 *--- TechRec 1028770 14-Jan-2008 vkrishnamurthy ---
8412 *OR h.sku_upc = "X"
8413 *=== TechRec 1028770 14-Jan-2008 vkrishnamurthy ===
8414
8415 *--- TechRec 1028770 19-Mar-2008 vkrishnamurthy ---
8416*!* Select Distinct p.division, p.Style, p.color_code, p.Lbl_code, p.Dimension,;
8417*!* p.sizebucket, p.PPK_style, p.PPK_color, p.PPK_label, p.PPK_dimension ;
8418*!* From (pcTransHeader) h, (pcTransDetail) d, (pcSLNPrePack) p ;
8419*!* Where h.Pkey = d.Fkey And d.Pkey = p.ITM_Pkey And ;
8420*!* (h.sku_upc= "U" Or h.sku_upc= "B" OR h.sku_upc = "X") ; && require component UPCs
8421*!* Order By 1,2,3,4,5,6 Into Cursor __TmpCursor
8422
8423 *- 1052584 08/23/11 YIK
8424 *- Changed the Select to be only from pcLineSLNPrepack (since I added sku_upc to it above).
8425*-- Select Distinct p.division, p.Style, p.color_code, p.Lbl_code, p.Dimension,;
8426*-- p.sizebucket, p.PPK_style, p.PPK_color, p.PPK_label, p.PPK_dimension,h.sku_upc ;
8427*-- From (pcTransHeader) h, (pcTransDetail) d, (pcSLNPrePack) p ;
8428*-- Where h.Pkey = d.Fkey And d.Pkey = p.ITM_Pkey And ;
8429*-- (h.sku_upc= "U" Or h.sku_upc= "B" OR h.sku_upc = "X") ; && require component UPCs
8430*-- Order By 1,2,3,4,5,6 Into Cursor __TmpCursor
8431 *--- TR 1073064 30-Aug-13 Venuk. Added sku_upc = "A" OR sku_upc = "R"===
8432 Select distinct division, Style, color_code, Lbl_code, Dimension,;
8433 sizebucket, PPK_style, PPK_color, PPK_label, PPK_dimension, sku_upc ;
8434 From (pcLineSLNPrepack) ;
8435 Where sku_upc= "U" OR sku_upc= "B" OR sku_upc = "X" OR sku_upc = "A" OR sku_upc = "R" OR template = 'MACYS' ; && MACYS require component UPCs
8436 Order By 1,2,3,4,5,6 Into Cursor __TmpCursor
8437 *= 1052584
8438
8439 .cSQLTempTable=""
8440 If .GenerateSQLTempTable('__TmpCursor')
8441 If .PopulateSQLTempTable('__TmpCursor')
8442 If !Empty(.cSQLTempTable)
8443 llRetVal= llRetVal And .CheckOutboundSLNUPC(pcTransHeader, pcTransDetail, ;
8444 pcLineSLNPrepack, .cSQLTempTable, '__TmpCursor')
8445 *--- TR 1003431 02/24/03 AM
8446 *llRetVal= llRetVal And .CheckOutboundSLNEAN(pcTransHeader, pcTransDetail, ; &&TR 1073064 30-Aug-13 Venuk. Commented
8447 * pcLineSLNPrepack, .cSQLTempTable, '__TmpCursor') &&TR 1073064 30-Aug-13 Venuk. Commented
8448 *=== TR 1003431 02/24/03 AM
8449 Endif
8450 Endif
8451 Endif
8452 .TableClose('__TmpCursor')
8453 *--- TR 1073064 30-Aug-13 Venuk.
8454
8455 Select distinct division, Style, color_code, Lbl_code, Dimension,;
8456 sizebucket, PPK_style, PPK_color, PPK_label, PPK_dimension, sku_upc ;
8457 From (pcLineSLNPrepack) ;
8458 Where sku_upc= "E" OR sku_upc= "R" OR sku_upc= "A" OR sku_upc = "Z" ;
8459 Order By 1,2,3,4,5,6 Into Cursor __TmpCursor
8460
8461 .cSQLTempTable=""
8462 If .GenerateSQLTempTable('__TmpCursor')
8463 If .PopulateSQLTempTable('__TmpCursor')
8464 If !Empty(.cSQLTempTable)
8465 llRetVal= llRetVal And .CheckOutboundSLNEAN(pcTransHeader, pcTransDetail, ;
8466 pcLineSLNPrepack, .cSQLTempTable, '__TmpCursor')
8467 Endif
8468 Endif
8469 Endif
8470 .TableClose('__TmpCursor')
8471 *===TR 1073064 30-Aug-13 Venuk.
8472 Endwith
8473
8474 *- STRY0102322 FH
8475 SELECT aux_sku1 as aux_sku , p.* FROM (pcLineSLNPrepack) p INTO CURSOR (pcLineSLNPrepack) readwrite
8476 If Used(pcLineSLNPrepack)
8477 Select (pcLineSLNPrepack)
8478 Index On ITM_Pkey Tag ITM_Pkey
8479 Endif
8480
8481 Select(lnOldSelect)
8482 Return llRetVal
8483 Endproc
8484
8485 *= 1003239
8486
8487 *--- TR 1003431 02/23/04 AM
8488 *=========================================================================================================
8489 * 1004006 3/16/04 YIK Add new parameter pcSkipPpkUpc
8490 Procedure CheckOutboundEAN
8491 Lparameters pcTransHeader, pcTransDetail, pcSQLTempTable, plNotOverwriteSizeDesc, pcSkipPpkUpc
8492 Local llRetVal, lnOldSelect
8493 llRetVal = .T.
8494 lnOldSelect = Select()
8495 With This
8496
8497 *--->Added Prod_ID from zzxdivsr because now EAN check is Division specific
8498 lcSqlString= "Select t.division, t.style, t.color_code," +;
8499 "t.lbl_code, t.dimension, t.sizebucket, s.size_desc, "+;
8500 "s.EAN " +;
8501 "From zzeupcnr s, " + pcSQLTempTable + " t, zzxdivsr d " +;
8502 "Where s.division= t.division and " +;
8503 "s.division= d.division and " +;
8504 "s.style= t.style and s.color_code= t.color_code and " +;
8505 "s.lbl_code= t.lbl_code and s.dimension= t.dimension and " +;
8506 "s.sizebucket= t.sizebucket and ( d.Prod_Id = 'E' or d.Prod_ID = 'B') " && TR 1073064 30-Aug-13 Venuk. Added or d.Prod_ID = 'B') "
8507 * --- 34208 10-Sep-02 DB2 CHECKED JN (forked code)
8508
8509 *--- TechRec 1028770 09-Jan-2008 vkrishnamurthy ---
8510 lcSQLString = lcSQLString + " AND t.sku_upc <> 'Y' AND t.sku_upc <> 'X' " && TR 1073064 30-Aug-13 Venuk added AND t.sku_upc <> 'X'
8511 *=== TechRec 1028770 09-Jan-2008 vkrishnamurthy ===
8512
8513 llRetVal = v_SQLexec(lcSqlString, "__EAN")
8514 If llRetVal And This.CountTotalRecs ("__EAN")>0
8515 * Populate EAN,size_desc from result of server-side temp keys + join zzeupcnr
8516 Select __EAN
8517 Index On division+Style+color_code+Lbl_code+Dimension+Str(sizebucket) ;
8518 Tag OurSku
8519 llRetVal= .SetRelation("__EAN", "OurSKU", pcTransDetail, ;
8520 "Division+Style+color_code+lbl_code+dimension+Str(sizebucket)")
8521 If llRetVal
8522 If plNotOverwriteSizeDesc
8523 Replace All ean With __EAN.ean In (pcTransDetail)
8524 Else
8525 *- 1005734 07/08/04 YIK
8526 *- Added ..FOR !EOF("__EAN") to avoid blanking out of size desc.
8527 Replace All ean With __EAN.ean, size_desc With __EAN.size_desc ;
8528 FOR !Eof("__EAN") ;
8529 in (pcTransDetail)
8530 Endif
8531 Set Relation To
8532 .TableClose('__EAN')
8533
8534 *--- TAN 1005398 05/26/2004 AM
8535 *--- Fix Shared EAN Functionality.
8536 Endif
8537 Endif
8538 * 2nd. pass to get EAN with substitution of Blank lbl_code
8539 * for all unresolve EAN
8540 lcSqlString= "Select division, Prod_ID From zzxdivsr"
8541 llRetVal = v_SQLexec(lcSqlString, "__DivRef")
8542 llRetVal= llRetVal And .CheckOutboundEANForBlankLabel(;
8543 pcTransHeader, pcTransDetail, pcSQLTempTable, plNotOverwriteSizeDesc)
8544 If llRetVal
8545 Select __DivRef
8546 Index On division Tag Div
8547 llRetVal = .SetRelation("__DivRef", "Div", pcTransDetail,"Division")
8548 *=== TAN 1005398 05/26/2004 AM
8549
8550 * After 2nd pass all empty(EAN) will be invalid if control ref
8551 * sku_upc="U" or "B"
8552 lcErrs_Msg= "Missing EAN."
8553 *- 1004006 3/16/04 YIK
8554 *!* Replace All Errs_Msg_D with Errs_Msg_D + lcErrs_Msg + CRLF, Errs_Flg_D With "Y" ;
8555 *!* In (pcTransDetail) For (sku_upc="U" or sku_upc="B") And Empty(ean)
8556
8557 *--- TechRec 1028770 14-Jan-2008 vkrishnamurthy ---
8558 *OR sku_upc = "X"
8559 *=== TechRec 1028770 14-Jan-2008 vkrishnamurthy ===
8560
8561 *--- TR 1073064 30-Aug-13 Venuk.
8562 *lcForExpr = '(sku_upc="U" or sku_upc="B" OR sku_upc = "X") And Empty(ean) And __DivRef.Prod_Id = "E" ' + ; && TR 1005398 Added Prod_ID on the Criteria
8563 *Iif(pcSkipPpkUpc, 'and (SkipPpkUpc = "N" or Implosion <> "Y") ', '')
8564 lcForExpr = '(sku_upc="E" or sku_upc="Z" OR sku_upc = "R" OR sku_upc = "A" ) And Empty(ean) ' + ;
8565 ' And (__DivRef.Prod_Id = "E" OR __DivRef.Prod_Id = "B") ' + ;
8566 Iif(pcSkipPpkUpc, 'and (SkipPpkUpc = "N" or Implosion <> "Y") ', '')
8567 *=== TR 1073064 30-Aug-13 Venuk.
8568
8569 *--- TR 1064585 21-Dec-2012 Goutam
8570 IF (TYPE(pcTransHeader + ".template") = "C") AND UPPER(SUBSTR(pcTransHeader, 4, 3)) = "OIN"
8571
8572 GO TOP IN (pcTransDetail)
8573 *--- TR 1073064 30-Aug-13 Venuk. Changed ='U' to 'E' and 'X' to 'Z'
8574* lcForExpr = '(a.sku_upc="U" or a.sku_upc="B" OR a.sku_upc = "X") And Empty(a.ean) And __DivRef.Prod_Id = "E" ' + ;
8575* Iif(pcSkipPpkUpc, 'and (a.SkipPpkUpc = "N" or a.Implosion <> "Y") ', '')
8576
8577 lcForExpr = '(a.sku_upc="E" or a.sku_upc="Z" OR a.sku_upc = "R" OR a.sku_upc = "A") And Empty(a.ean) And ' + ;
8578 + '(__DivRef.Prod_Id = "E" OR __DivRef.Prod_Id = "B")' + Iif(pcSkipPpkUpc, 'and (a.SkipPpkUpc = "N" or a.Implosion <> "Y") ', '')
8579 *=== TR 1073064 30-Aug-13 Venuk.
8580
8581 lcSqlString = " UPDATE a SET Errs_Msg_D = Errs_Msg_D + lcErrs_Msg + CHR(13) + CHR(10), Errs_Flg_D = 'Y' " + ;
8582 " from (pcTransDetail) a join (pcTransHeader) b on b.pkey = a.fkey " + ;
8583 " join __DivRef d on d.division = a.division " + ;
8584 " WHERE " + lcForExpr + " AND UPPER(b.template) <> 'FORZANI 5010'"
8585
8586 &lcSqlString
8587
8588 *llRetVal= llRetVal and .SetRelation(pcTransHeader, "PKEY", pcTransDetail, "FKEY")
8589 *lcForExpr = lcForExpr + " AND !UPPER(&pcTransHeader..template) = 'FORZANI 5010'"
8590 *Replace All Errs_Msg_D With Errs_Msg_D + lcErrs_Msg + CRLF, Errs_Flg_D With "Y" ;
8591 In (pcTransDetail) For &lcForExpr
8592 *SET RELATION TO
8593 ELSE
8594 *=== TR 1064585 21-Dec-2012 Goutam
8595
8596 Replace All Errs_Msg_D With Errs_Msg_D + lcErrs_Msg + CRLF, Errs_Flg_D With "Y" ;
8597 In (pcTransDetail) For &lcForExpr
8598
8599 *--- TR 1064585 21-Dec-2012 Goutam
8600 ENDIF
8601 *=== TR 1064585 21-Dec-2012 Goutam
8602
8603 *--- TAN 1005398 05/26/2004 AM
8604 Set Relation To
8605 .TableClose('__DivRef')
8606 *=== TAN 1005398 05/26/2004 AM
8607 *= 1004006
8608 *--- TAN 1005398 05/26/2004 AM
8609 *--- Moved Endif Above
8610 Endif
8611 * Endif
8612 *--- TAN 1005398 05/26/2004 AM
8613
8614 Endwith
8615
8616 Select(lnOldSelect)
8617 Return llRetVal
8618 Endproc
8619
8620 *=========================================================================================================
8621
8622 Procedure CheckOutboundEANForBlankLabel
8623 Lparameters pcTransHeader, pcTransDetail, pcSQLTempTable, plNotOverwriteSizeDesc
8624 Local llRetVal, lnOldSelect
8625 llRetVal = .T.
8626 lnOldSelect = Select()
8627
8628 With This
8629 *--- TAN 1005398 05/26/2004 AM
8630 *--->Added Prod_ID from zzxdivsr because now UPC check is Division specific
8631 *--- TR 1073064 30-Aug-13 Venuk. Added d.Prod_ID = 'B' ===
8632 *--- TR 1073064/1065007 30-Aug-13 Venuk. Added d.Prod_ID = 'B' === Fix was missing from above TR only comment was available
8633 lcSQLString1= "Select t.division, t.style, t.color_code," +;
8634 "t.dimension, t.sizebucket, s.size_desc, "+;
8635 "s.EAN " +;
8636 "From zzeupcnr s, " + pcSQLTempTable + " t, zzxdivsr d " +;
8637 "Where s.division= t.division and " +;
8638 "s.division= d.division and " +;
8639 "s.style= t.style and s.color_code= t.color_code and " +;
8640 "s.lbl_code= '' and s.dimension= t.dimension and " +;
8641 "s.sizebucket= t.sizebucket and (d.Prod_ID = 'E' or d.Prod_ID = 'B')" && Blank lbl_code UPC
8642 * === 34208 10-Sep-02 JN DB2 CHECKED forked code
8643
8644 *--- TechRec 1028770 09-Jan-2008 vkrishnamurthy ---
8645 lcSQLString1 = lcSQLString1 + " AND t.sku_upc <> 'Y' AND t.sku_upc <> 'X' " && TR 1073064 30-Aug-13 Venuk added AND t.sku_upc <> 'X'
8646 *=== TechRec 1028770 09-Jan-2008 vkrishnamurthy ===
8647
8648 llRetVal= llRetVal And v_SQLexec(lcSQLString1, "TempEAN")
8649
8650 * Share UPC List (Blank lbl_code)
8651 lcSqlString= "Select distinct division, style, color_code," +;
8652 "dimension, sizebucket, size_desc, EAN "+;
8653 "From TempEAN group by 1,2,3,4,5,6,7 "
8654 llRetVal = llRetVal And v_SQLexec(lcSqlString, "__EAN",, true) &&local
8655
8656 *- 1005734 07/08/04 YIK
8657 *- added ..And This.CountTotalRecs ("__EAN")>0
8658 If llRetVal And This.CountTotalRecs ("__EAN")>0
8659 Select __EAN
8660 Index On division+Style+color_code+Dimension+Str(sizebucket) ;
8661 Tag OurSku
8662 llRetVal= .SetRelation("__EAN", "OurSKU", pcTransDetail, ;
8663 "Division+Style+color_code+dimension+Str(sizebucket)")
8664 If llRetVal
8665 * Populate EAN with share EAN List
8666 If plNotOverwriteSizeDesc
8667 Replace All ean With __EAN.ean In (pcTransDetail) For Empty(ean)
8668 Else
8669 *- 1005734 07/08/04 YIK
8670 *- Added ..FOR !EOF("__EAN") to avoid blanking out of size desc.
8671 Replace All ean With __EAN.ean, size_desc With __EAN.size_desc ;
8672 in (pcTransDetail) For Empty(ean) And !Eof("__EAN")
8673 Endif
8674 Set Relation To
8675 Endif
8676 Endif
8677 .TableClose('__EAN')
8678 .TableClose('TempEAN')
8679 Endwith
8680 Select(lnOldSelect)
8681 Return llRetVal
8682 Endproc
8683 *=============================================================================================================
8684 Procedure CheckOutboundSLNEAN
8685 Lparameters pcTransHeader, pcTransDetail, pcSLNPrePack, pcSQLTempTable, pcLocalSQLTempTable
8686 Local llRetVal, lnOldSelect
8687 llRetVal = .T.
8688 lnOldSelect = Select()
8689 With This
8690
8691 * 1st pass Populate EAN,size_desc using exact match on div,sty,col,lbl,dim
8692 *--->Added Prod_ID from zzxdivsr because now EAN check is Division specific
8693 lcSqlString= "Select t.division, t.style, t.color_code," +;
8694 "t.lbl_code, t.dimension, t.sizebucket, s.size_desc, "+;
8695 "t.PPK_style, t.PPK_color,t.PPK_label, t.PPK_dimension, "+;
8696 "s.EAN " +;
8697 "From zzeupcnr s, " + pcSQLTempTable + " t, zzxdivsr d " +;
8698 "Where s.division= t.division and " +;
8699 "s.division= d.division and " +;
8700 "s.style= t.style and s.color_code= t.color_code and " +;
8701 "s.lbl_code= t.lbl_code and s.dimension= t.dimension and " +;
8702 "s.sizebucket= t.sizebucket and (d.Prod_ID = 'E' or d.Prod_ID = 'B') " && TR 1073064 30-Aug-13 Venuk. Added d.Prod_ID = 'B'
8703 * === TAN 34208 16-Oct-02 JN DB2 CHECKED
8704
8705 *--- TechRec 1028770 09-Jan-2008 vkrishnamurthy ---
8706 lcSQLString = lcSQLString + " AND t.sku_upc <> 'Y' and t.sku_upc <> 'X' " && TR 1073064 30-Aug-13 Venuk. Added t.sku_upc <> 'X''
8707 *=== TechRec 1028770 09-Jan-2008 vkrishnamurthy ===
8708
8709 llRetVal = v_SQLexec(lcSqlString, "__EAN")
8710 If llRetVal And This.CountTotalRecs ("__EAN")>0
8711 * Populate EAN,size_desc from result of server-side temp keys + join zzeupcnr
8712 Select __EAN
8713 Index On division+Style+color_code+Lbl_code+Dimension+Str(sizebucket) ;
8714 Tag OurSku
8715 llRetVal= .SetRelation("__EAN", "OurSKU", pcSLNPrePack, ;
8716 "Division+Style+color_code+lbl_code+dimension+Str(sizebucket)")
8717 If llRetVal
8718 *- 1005734 07/08/04 YIK
8719 *- Added ..FOR !EOF("__EAN") to avoid blanking out of size desc.
8720 Replace All ean With __EAN.ean, size_desc With __EAN.size_desc ;
8721 FOR !Eof("__EAN") ;
8722 in (pcSLNPrePack)
8723 Set Relation To
8724 .TableClose('__EAN')
8725
8726 *--- TAN 1005398 05/27/2004 AM
8727 Endif
8728 Endif
8729 *=== TAN 1005398 05/27/2004 AM
8730
8731 * 2nd. pass to get EAN with substitution of Blank lbl_code
8732 * for all unresolve EAN
8733 llRetVal= llRetVal And .CheckOutboundSLNEANForBlankLabel(;
8734 pcTransHeader, pcTransDetail, pcSLNPrePack, pcSQLTempTable)
8735
8736 * After 2nd pass all component in tcSLN with empty(EAN)
8737 * will be invalid if control ref set sku_upc="U" or "B"
8738 llRetVal= llRetVal And .ValidateOutboundSLNEAN(;
8739 pcTransHeader, pcTransDetail, pcSLNPrePack, ;
8740 pcSQLTempTable, pcLocalSQLTempTable)
8741
8742 *--- TAN 1005398 05/27/2004 AM
8743 * Endif
8744 * Endif
8745 *--- TAN 1005398 05/27/2004 AM
8746
8747 Endwith
8748
8749 Select(lnOldSelect)
8750 Return llRetVal
8751 Endproc
8752 *==============================================================================================================
8753
8754 Procedure CheckOutboundSLNEANForBlankLabel
8755 Lparameters pcTransHeader, pcTransDetail, pcSLNPrePack, pcSQLTempTable
8756 Local llRetVal, lnOldSelect
8757 llRetVal = .T.
8758 lnOldSelect = Select()
8759
8760 With This
8761 *--- TAN 1005398 05/26/2004 AM
8762 *--->Added Prod_ID from zzxdivsr because now EAN check is Division specific
8763 lcSQLString1= "Select t.division, t.style, t.color_code," +;
8764 "t.dimension, t.sizebucket, s.size_desc, "+;
8765 "t.PPK_style, t.PPK_color,t.PPK_label, t.PPK_dimension, "+;
8766 "s.EAN " +;
8767 "From zzeupcnr s, " + pcSQLTempTable + " t, zzxdivsr d " +;
8768 "Where s.division= t.division and " +;
8769 "s.division= d.division and " +;
8770 "s.style= t.style and s.color_code= t.color_code and " +;
8771 "s.lbl_code= '' and s.dimension= t.dimension and " +; && Blank lbl_code EAN
8772 "s.sizebucket= t.sizebucket and (d.Prod_ID = 'E' OR d.Prod_ID = 'B') " && TR 1073064 30-Aug-13 Venuk. Added d.Prod_ID = 'B'
8773 * --- TAN 34208 16-Oct-02 JN
8774
8775 *--- TechRec 1028770 09-Jan-2008 vkrishnamurthy ---
8776 lcSQLString1 = lcSQLString1 + " AND t.sku_upc <> 'Y' AND t.sku_upc <> 'X' " && TR 1073064 30-Aug-13 Venuk. Added t.sku_upc <> 'X'
8777 *=== TechRec 1028770 09-Jan-2008 vkrishnamurthy ===
8778
8779 llRetVal= llRetVal And v_SQLexec(lcSQLString1, "TempEAN")
8780
8781 * Share EAN List (Blank lbl_code)
8782 lcSqlString= "Select distinct division, style, color_code," +;
8783 "dimension, sizebucket, size_desc, EAN "+;
8784 "From TempEAN group by 1,2,3,4,5,6,7 "
8785 llRetVal = llRetVal And v_SQLexec(lcSqlString, "__EAN",, true) &&local
8786
8787 *- 06/11/04 1005734 YIK
8788 *- Added .. AND RECC("__EAN") > 0
8789 If llRetVal And Recc("__EAN") > 0
8790 Select __EAN
8791 Index On division+Style+color_code+Dimension+Str(sizebucket) ;
8792 Tag OurSku
8793 llRetVal= .SetRelation("__EAN", "OurSKU", pcSLNPrePack, ;
8794 "Division+Style+color_code+dimension+Str(sizebucket)")
8795 If llRetVal
8796 * Populate EAN with share EAN List
8797 *- 1005734 07/08/04 YIK
8798 *- Added ..FOR !EOF("__EAN") to avoid blanking out of size desc.
8799 Replace All ean With __EAN.ean, size_desc With __EAN.size_desc ;
8800 in (pcSLNPrePack) For Empty(ean) And !Eof("__EAN")
8801 Set Relation To
8802 Endif
8803 Endif
8804 .TableClose('__EAN')
8805 .TableClose('TempEAN')
8806 Endwith
8807 Select(lnOldSelect)
8808 Return llRetVal
8809 Endproc
8810
8811 *===========================================================================================================
8812 Procedure ValidateOutboundSLNEAN
8813 Lparameters pcTransHeader, pcTransDetail, pcSLNPrePack, pcSQLTempTable, pcLocalSQLTempTable
8814 Local llRetVal, lnOldSelect, lcSqlString, lcSQLString1
8815 Private pcLocalDivRef
8816 llRetVal = .T.
8817 lnOldSelect = Select()
8818 pcLocalDivRef = GetUniqueFileName()
8819
8820 * PrePackSKU order
8821 Select (pcTransDetail)
8822 Set Order To OurSku
8823
8824 With This
8825 * list of all missing EAN group by PrePackSKU
8826 *--- TAN 1005398 05/26/2004 AM
8827 *--->Added Prod_ID from zzxdivsr because now UPC check is Division specific
8828 *--->We Need Local Division Reference
8829 lcSqlString= "Select division,Prod_ID from zzxdivsr"
8830 llRetVal= llRetVal And v_SQLexec(lcSqlString,pcLocalDivRef)
8831
8832 lcSQLString1= "Select distinct t.division, t.style, t.color_code," +;
8833 "t.lbl_code, t.dimension, t.sizebucket, t.size_desc, "+;
8834 "t.PPK_style, t.PPK_color,t.PPK_label, t.PPK_dimension "+;
8835 "From " + pcLocalSQLTempTable + " s, " + pcSLNPrePack + " t, " + pcLocalDivRef + " d " +;
8836 "Where s.division= t.division and " +;
8837 "s.division= d.division and " +;
8838 "s.style= t.style and s.color_code= t.color_code and " +;
8839 "s.lbl_code= t.lbl_code and s.dimension= t.dimension and " +;
8840 "s.sizebucket= t.sizebucket and t.ean ='' and (d.Prod_ID = 'E' or d.Prod_ID = 'B') " + ; && TR 1073064 Venuk. Added d.Prod_ID = 'B'
8841 "order by t.division,t.PPK_style, t.PPK_color,t.PPK_label, t.PPK_dimension"
8842 llRetVal= llRetVal And v_SQLexec(lcSQLString1, "tcNoEAN",, true) &&local
8843
8844 .TableClose(pcLocalDivRef)
8845 *=== TR 1005398
8846
8847 * Consolidate all missing UPC components for same PrePackSKU together in lcErrs_Msg
8848 If llRetVal
8849 Select tcNoEAN
8850 Index On division + PPK_style + PPK_color + PPK_label + PPK_dimension ;
8851 Tag PPackSKU
8852 Do While llRetVal And !Eof('tcNoEAN')
8853 lcCurPPackSKU= division + PPK_style + PPK_color + PPK_label + PPK_dimension
8854 lcErrs_Msg= "Missing Prepack component EAN : "+ CRLF
8855 Scan While division + PPK_style + PPK_color + PPK_label + PPK_dimension == ;
8856 lcCurPPackSKU
8857 lcErrs_Msg= lcErrs_Msg + "Div:" + division + " Style: " + Style + ;
8858 " Color: " + color_code + "Label: " + Lbl_code + "Dm/Pk:" + Dimension +;
8859 " Size: " + Str(sizebucket) + CRLF
8860 Endscan
8861 * after accumulate all missing EAN components for same PrePackSKU
8862 * seek for all detail lines that use that PrePackSKU and append proper
8863 * error message/flag.
8864 Select (pcTransDetail)
8865 If Seek(lcCurPPackSKU, pcTransDetail, "OurSKU" )
8866 Scan While division+ Style+ color_code+ Lbl_code+ Dimension == lcCurPPackSKU
8867 Replace Errs_Msg_D With Errs_Msg_D + lcErrs_Msg, Errs_Flg_D With "Y" ;
8868 In (pcTransDetail)
8869 Endscan
8870 Endif
8871 Select tcNoEAN
8872 Enddo
8873 Endif
8874 .TableClose('tcNoEAN')
8875 Endwith
8876 Select(lnOldSelect)
8877 Return llRetVal
8878 Endproc
8879 *=============================================================================================================
8880 *=== TR 1003431 02/23/04 AM
8881
8882 *- 1006052 07/01/04 YIK
8883 Procedure PopulateSLNsForRangeP
8884 Lparameters pcCurRangeSKU, pcTransDetail
8885 Local lnOldSelect, llRetVal, lnCount, loRecord, lnOrigPkey, lnPkey
8886
8887 *- TR 1066415 FH
8888 LOCAL lnCancelQty, lnInvQty
8889 lnCancelQty = 0
8890 lnInvQty = 0
8891 *-TR 1066415 FH
8892
8893 lnOldSelect = Select()
8894 With This
8895 * Consolidate group of trans. detail for same range style
8896 If Seek(pcCurRangeSKU, pcTransDetail, "RangeSKU") && ..and sln_req = 'Y'
8897 Select (pcTransDetail)
8898 lnOrigPkey = Pkey
8899 *- specific for the 855 and 810 process!!!
8900 lnDetQty = Total_qty
8901
8902 &&TR 1066415 FH cancelqty/invqty exist
8903 IF TYPE(pcTransDetail + ".cancelqty") = "N"
8904 lnCancelQty = cancelqty
8905 endif
8906 IF TYPE(pcTransDetail + ".invoiceqty") = "N"
8907 lnInvQty = invoiceqty
8908 endif
8909 &&TR 1066415 FH cancelqty/invqty exist
8910
8911 Scatter Name loRecord
8912 *- remove the range style record
8913 If !(sln_req = 'Y') Or .T. && don't support sln_req for range style 'P'
8914 Delete
8915 Endif
8916
8917 *- Get all components for this range style
8918 *--- TR 1060800 24-May-2012 Goutam. Added join zzxrangh h on h.pkey = d.fkey
8919 lcSqlString = "select d.Division, d.Style, d.Color_code, d.Lbl_Code, d.Dimension, Size_Num as Size_Bk, " + ;
8920 "d.Size01_Qty*Sz01 + d.Size02_Qty*Sz02+ " + ;
8921 "d.Size03_Qty*Sz03 + d.Size04_Qty*Sz04+ " + ;
8922 "d.Size05_Qty*Sz05 + d.Size06_Qty*Sz06+ " + ;
8923 "d.Size07_Qty*Sz07 + d.Size08_Qty*Sz08+ " + ;
8924 "d.Size09_Qty*Sz09 + d.Size10_Qty*Sz10+ " + ;
8925 "d.Size11_Qty*Sz11 + d.Size12_Qty*Sz12+ " + ;
8926 "d.Size13_Qty*Sz13 + d.Size14_Qty*Sz14+ " + ;
8927 "d.Size15_Qty*Sz15 + d.Size16_Qty*Sz16+ " + ;
8928 "d.Size17_Qty*Sz17 + d.Size18_Qty*Sz18+ " + ;
8929 "d.Size19_Qty*Sz19 + d.Size20_Qty*Sz20+ " + ;
8930 "d.Size21_Qty*Sz21 + d.Size22_Qty*Sz22+ " + ;
8931 "d.Size23_Qty*Sz23 + d.Size24_Qty*Sz24 as Qty, " + ;
8932 "d.a_price, d.b_price, d.c_price, d.d_price, d.e_price " + ;
8933 " ,h.rng_qty " + ; &&*--- TR 1060800 24-May-2012 Goutam
8934 " ,h.rng_type " + ; &&*--- TR 1060800 24-May-2012 Goutam
8935 "from zzxrangd d " + ;
8936 "join zzxrangh h on h.pkey = d.fkey " + ; &&*--- TR 1060800 24-May-2012 Goutam
8937 "cross join zzxbuckt b " + ;
8938 "where d.Size01_Qty*Sz01 + d.Size02_Qty*Sz02+ " + ;
8939 "d.Size03_Qty*Sz03 + d.Size04_Qty*Sz04+ " + ;
8940 "d.Size05_Qty*Sz05 + d.Size06_Qty*Sz06+ " + ;
8941 "d.Size07_Qty*Sz07 + d.Size08_Qty*Sz08+ " + ;
8942 "d.Size09_Qty*Sz09 + d.Size10_Qty*Sz10+ " + ;
8943 "d.Size11_Qty*Sz11 + d.Size12_Qty*Sz12+ " + ;
8944 "d.Size13_Qty*Sz13 + d.Size14_Qty*Sz14+ " + ;
8945 "d.Size15_Qty*Sz15 + d.Size16_Qty*Sz16+ " + ;
8946 "d.Size17_Qty*Sz17 + d.Size18_Qty*Sz18+ " + ;
8947 "d.Size19_Qty*Sz19 + d.Size20_Qty*Sz20+ " + ;
8948 "d.Size21_Qty*Sz21 + d.Size22_Qty*Sz22+ " + ;
8949 "d.Size23_Qty*Sz23 + d.Size24_Qty*Sz24 > 0 " + ;
8950 " AND d.Division = " + SQLFormatChar(loRecord.division) + ; &&*--- TR 1060800 24-May-2012 Goutam. Added d.
8951 " AND d.rng_style = " + SQLFormatChar(loRecord.rng_style) + ; &&*--- TR 1060800 24-May-2012 Goutam. Added d.
8952 " AND d.rng_color = " + SQLFormatChar(loRecord.rng_color) + ; &&*--- TR 1060800 24-May-2012 Goutam. Added d.
8953 " AND d.rng_lbl = " + SQLFormatChar(loRecord.rng_lbl) + ; &&*--- TR 1060800 24-May-2012 Goutam. Added d.
8954 " AND d.rng_pack = " + SQLFormatChar(loRecord.rng_pack) &&*--- TR 1060800 24-May-2012 Goutam. Added d.
8955
8956 v_SQLexec(lcSqlString, "tcRangVert")
8957
8958 lnCount = Reccount("tcRangVert")
8959 Do Case
8960 Case Lower(pcTransDetail) = "tceoshtd"
8961 lcPkeySource = "ZZEOSHTD"
8962 lcProcess = "OSH"
8963 Case Lower(pcTransDetail) = "tceoprtd"
8964 lcPkeySource = "ZZEOPRTD"
8965 lcProcess = "OPR"
8966 Case Lower(pcTransDetail) = "tceointd"
8967 lcPkeySource = "ZZEOINTD"
8968 lcProcess = "OIN"
8969
8970 *--- TR 1017241 13-JUL-2006 Goutam
8971 Case Lower(pcTransDetail) = "tceoowtd"
8972 lcPkeySource = "ZZEOOWTD"
8973 lcProcess = "OOW"
8974 *=== TR 1017241 13-JUL-2006 Goutam
8975
8976 *--- TR 1044022 17-Feb-2010 JK
8977 Case Lower(pcTransDetail) = "tce3ploswtd"
8978 lcPkeySource = "ZZE3PLOSWTD"
8979 lcProcess = "OSW3P"
8980 *=== TR 1044022 17-Feb-2010 JK
8981
8982 *--- TR 1051461 31-DEC-2010 HNISAR
8983 Case Lower(pcTransDetail) = "tceorstd"
8984 lcPkeySource = "ZZEORSTD"
8985 lcProcess = "ORS"
8986 *=== TR 1051461 31-DEC-2010 HNISAR
8987
8988 Otherwise
8989 Endcase
8990
8991 lnPkey = v_NextPkey(lcPkeySource, lnCount)
8992 lnCount = lnCount - 1
8993 lnPkey = lnPkey - lnCount && Starting pKey
8994 Select tcRangVert
8995 Scan
8996 loRecord.Style = tcRangVert.Style
8997 loRecord.color_code = tcRangVert.color_code
8998 loRecord.Lbl_code = tcRangVert.Lbl_code
8999 loRecord.Dimension = tcRangVert.Dimension
9000 loRecord.sizebucket = tcRangVert.size_bk
9001 *--- TR 1035944 09/30/2008 TEJAS : Need to initialize UPC/SKU
9002 loRecord.upc = ''
9003 loRecord.sku = ''
9004 loRecord.ean = ''
9005 *=== TR 1035944 09/30/2008 TEJAS : Need to initialize UPC/SKU
9006 Do Case
9007 Case lcProcess = "OSH"
9008 *- 1052097 01/26/11 YIK
9009 *- Qty in the 856 flat file is always = 1. Need to consider number of range styles packed in a carton
9010 *- loRecord.Total_qty = tcRangVert.qty
9011
9012 *--- TR 1085613 30-Mar-2015 BNarayanan ---
9013 *loRecord.Total_qty = tcRangVert.qty*lnDetQty
9014 IF EMPTY(loRecord.ppk_action) AND tcRangVert.rng_type = 'P' AND loRecord.rngp_conv = 'R'
9015 loRecord.Total_qty = tcRangVert.qty*lnDetQty/tcRangVert.rng_qty
9016 ELSE
9017 loRecord.Total_qty = tcRangVert.qty*lnDetQty
9018 ENDIF
9019 *=== TR 1085613 30-Mar-2015 BNarayanan ===
9020
9021 &&TR 1066415 FH cancelqty/invqty exist
9022 IF TYPE(pcTransDetail + ".cancelqty") = "N"
9023 loRecord.cancelqty = tcRangVert.qty*lnCancelQty
9024 ENDIF
9025 IF TYPE(pcTransDetail + ".invoiceqty") = "N"
9026 loRecord.invoiceqty = tcRangVert.qty*lnInvQty
9027 endif
9028 &&TR 1066415 FH cancelqty/invqty exist
9029
9030 Case lcProcess = "OPR"
9031 loRecord.Total_qty = tcRangVert.qty*lnDetQty
9032
9033 *--- TR 1051461 31-DEC-2010 HNISAR
9034*!* Case lcProcess = "OIN"
9035 CASE INLIST(lcProcess ,"OIN","ORS")
9036 *=== TR 1051461 31-DEC-2010 HNISAR
9037
9038 *--- TR 1060800 24-May-2012 Goutam
9039 *loRecord.Total_qty = tcRangVert.qty*lnDetQty
9040 *--- TR 1063235 10-Aug-2012 Goutam
9041 *IF lcProcess = "OIN" AND EMPTY(loRecord.ppk_action) AND tcRangVert.rng_type = 'P' AND loRecord.rngp_conv = 'R' AND loRecord.Rng_impl = 'N'
9042 IF lcProcess = "OIN" AND EMPTY(loRecord.ppk_action) AND tcRangVert.rng_type = 'P' AND loRecord.rngp_conv = 'R'
9043 *=== TR 1063235 10-Aug-2012 Goutam
9044
9045 *--- TR 1063235 12-Sep-2012 Goutam
9046 *loRecord.Total_qty = lnDetQty/tcRangVert.rng_qty
9047 loRecord.Total_qty = tcRangVert.qty*lnDetQty/tcRangVert.rng_qty
9048 *=== TR 1063235 12-Sep-2012 Goutam
9049
9050 ELSE
9051 loRecord.Total_qty = tcRangVert.qty*lnDetQty
9052 ENDIF
9053 *=== TR 1060800 24-May-2012 Goutam
9054
9055 *--- TR 1017241 13-JUL-2006 Goutam
9056 Case lcProcess = "OOW"
9057 loRecord.Total_qty = tcRangVert.qty*lnDetQty
9058 *--- TR 1017241 13-JUL-2006 Goutam
9059
9060 *--- TR 1044022 17-Feb-2010 JK
9061 Case lcProcess = "OSW3P"
9062 loRecord.Total_qty = tcRangVert.qty*lnDetQty
9063 *--- TR 1044022 17-Feb-2010 JK
9064
9065 Otherwise
9066 Endcase
9067 loRecord.orig_qty= loRecord.Total_qty
9068 lcPrice_code= Iif(Empty(loRecord.price_code), 'a', loRecord.price_code)
9069 lnPrice= Eval("tcRangVert." + lcPrice_code + "_price")
9070 loRecord.price= lnPrice
9071 loRecord.org_price= lnPrice
9072 loRecord.Pkey = lnPkey
9073 lnPack_Total = loRecord.Total_qty
9074 lnPack_qty = loRecord.rng_qty
9075
9076 If !(Used("tmpStylr") And (tmpStylr.division= loRecord.division And tmpStylr.Style= loRecord.Style))
9077 vl_stylr(loRecord.division,, "tmpStylr", loRecord.Style)
9078 Endif
9079 loRecord.style_name = tmpStylr.style_name
9080 loRecord.po4_uom = tmpStylr.uom
9081 * in getsizedesc also compare for current temp cursor size_code
9082 loRecord.size_desc = This.GetSizeDesc(loRecord.division, tmpStylr.size_code, loRecord.sizebucket)
9083 If vl_colrr(loRecord.color_code,,"tmpcolrr")
9084 loRecord.color_name = tmpcolrr.color_name
9085 *- Only used in the 855
9086 *- 1008204 11/30/04 YIK
9087 *- Add loRecord.
9088 If Vartype(loRecord.nrf_color) <> "U"
9089 loRecord.nrf_color = tmpcolrr.nrf_color
9090 Endif
9091 Endif
9092 *- Only used in the 855
9093 *- 1008204 11/30/04 YIK
9094 *- Add loRecord.
9095 If Vartype(loRecord.nrf_size) <> "U" And ;
9096 vl_dimer(loRecord.division,,"tmpdimer", tmpStylr.size_code)
9097 lcFldName = "tmpdimer.nrf_sz" + Padl(Alltrim(Trans(loRecord.sizebucket, "99")), 2, '0')
9098 loRecord.nrf_size = Eval(lcFldName)
9099 Endif
9100
9101 If loRecord.sln_req = 'Y' And .F. && sln_req = 'Y' doesn't work for "P". itm_pkey is defined later...
9102 lnPPsize_qty = loRecord.Total_qty
9103 Select tcRangeSLN
9104 Append Blank
9105 Gather Name loRecord
9106 Replace ITM_Pkey With lnOrigPkey, ;
9107 PPSize_qty With lnPPsize_qty, ;
9108 Pack_total With lnPack_Total, ;
9109 pack_qty With lnPack_qty, ;
9110 PPK_style With loRecord.rng_style, ;
9111 PPK_color With loRecord.rng_color, ;
9112 PPK_label With loRecord.rng_lbl, ;
9113 PPK_dimension With loRecord.rng_pack
9114 Else
9115 Select (pcTransDetail)
9116 Append Blank
9117 Gather Name loRecord
9118 Endif
9119 lnPkey = lnPkey + 1
9120 Select tcRangVert
9121 Endscan
9122 Endif
9123 Endwith
9124 Endproc
9125 *= 1006052
9126
9127 *- 1006646 08/12/04 YIK
9128 *- Moved this routine from clsoinpr (810 process) and made it generic
9129 *- in order to handle Header discounts (SACs) for the 856 process as well.
9130 Procedure GetInboundHistory
9131 Parameters tcTransHeader, tcEDIControl
9132 Local llRetVal, lcSqlString
9133 llRetVal = .T.
9134 lnOldSelect = Select()
9135 *- 1005333 05/18/04 YIK
9136 *- add ..OR h.chk_hist = 'Y' to get SAC_HREF1..HREF3, SAC_HRATE1..HRATE3
9137 lcSqlString = ;
9138 " Select distinct ord_num From " + tcTransHeader + " h, " + ;
9139 tcEDIControl + " c " + ;
9140 " Where h.division= c.division and h.customer= c.customer and " + ;
9141 "( " + Iif(Upper(tcEDIControl) = 'ZZEOINCR', " c.merge_hhis= 'Y' OR ", "") + ;
9142 " h.chk_hist = 'Y') " + ;
9143 " Into Cursor __TmpCursor"
9144
9145 &lcSqlString
9146
9147 With This
9148 .cSQLTempTable=""
9149 If .GenerateSQLTempTable('__TmpCursor')
9150 If .PopulateSQLTempTable('__TmpCursor')
9151 If !Empty(.cSQLTempTable)
9152 *- 1007424 10/06/04 YIK
9153 *- Add h.prod_desc
9154 *- 1007299 10/12/04 YIK
9155 *- Added sales_cond
9156 *-- tr 1012389 NH : AUG-02-05 : Added column merch_type
9157 *--- TechRec 1035578 10-Oct-2008 T.Shenbagavalli added h.mfg_id ---
9158 *--- TR 1049812 9/6/10 CM --- Added h.oVnd_Key
9159 lcSqlString = "Select h.ord_num,h.promotion, h.batch_num, h.fob_code, h.mfg_id, " +;
9160 " h.po_purp, h.po_type,h.po_date, h.SAC_HREF1, h.SAC_HREF2, h.SAC_HREF3," +;
9161 " h.SAC_HRate1, h.SAC_HRate2, h.SAC_HRate3, h.prod_desc, h.sales_cond, h.merch_type," +;
9162 " h.oVnd_Key " + ;
9163 " From zzeipohh h, " + .cSQLTempTable + " t " +;
9164 " Where h.ord_num= t.ord_num"
9165
9166 llRetVal = v_SQLexec(lcSqlString, "__HHist")
9167 If llRetVal
9168 Select __HHist
9169 Index On ord_num Tag ord_num
9170 llRetVal= .SetRelation("__HHist", "ord_num", tcTransHeader, "ord_num")
9171 If llRetVal
9172 *- 1007189 10/06/04 YIK
9173 *- Add h.prod_desc
9174 *- 1007299 10/12/04 YIK
9175 *- Added sales_cond
9176
9177 Replace All promotion With __HHist.promotion, batch_num With __HHist.batch_num, ;
9178 fob_code With __HHist.fob_code, po_purp With __HHist.po_purp, ;
9179 po_type With __HHist.po_type, po_date With __HHist.po_date, ;
9180 SAC_HREF1 With __HHist.SAC_HREF1, SAC_HREF2 With __HHist.SAC_HREF2, ;
9181 SAC_HREF3 With __HHist.SAC_HREF3, SAC_HRate1 With __HHist.SAC_HRate1, ;
9182 SAC_HRate2 With __HHist.SAC_HRate2, SAC_HRate3 With __HHist.SAC_HRate3, ;
9183 prod_desc With __HHist.prod_desc, sales_cond With __HHist.sales_cond ;
9184 in (tcTransHeader)
9185
9186 *--- TechRec 1035578 10-Oct-2008 T.Shenbagavalli ---
9187 IF FieldExists("mfg_id", tcTransHeader)
9188 REPLACE ALL mfg_id with __HHist.mfg_id In (tcTransHeader)
9189 endif
9190 *=== TechRec 1035578 10-Oct-2008 T.Shenbagavalli ===
9191
9192 *-- tr 1012389 NH : AUG-02-05 : update transheader merch_type value
9193 *--- TR 1034402 01-Jul-2008 Partha : allow unconditional update ---
9194 *If Upper(Alltrim(tcEDIControl)) == "ZZEOSHCR"
9195 *=== TR 1034402 01-Jul-2008 Partha ===
9196 Replace All merch_type With __HHist.merch_type In (tcTransHeader)
9197 *--- TR 1034402 01-Jul-2008 Partha ---
9198 *ENDIF
9199 *=== TR 1034402 01-Jul-2008 Partha ===
9200
9201 * --- TR 1049812 9/6/10 CM
9202 If Vartype(oVnd_Key) == 'C'
9203 Replace All oVnd_Key With __HHist.oVnd_Key In (tcTransHeader)
9204 Endif
9205 * === TR 1049812 9/6/10 CM
9206
9207 Set Relation To
9208 Use In __HHist
9209 Endif
9210 Endif
9211
9212 * --- TR 1043960 5/25/10 CM
9213 * Pull merch_type from 860 History if orders were not originally
9214 * created via the 850
9215 If Upper(Alltrim(tcEDIControl)) == "ZZEOSHCR"
9216 lcSqlString = "Select h.ord_num, h.merch_type " + ;
9217 " From zzeipchh h, " + .cSQLTempTable + " t " +;
9218 " Where h.ord_num= t.ord_num"
9219
9220 llRetVal = v_SQLexec(lcSqlString, "__860Hist")
9221 If llRetVal
9222 Select __860Hist
9223 Index On ord_num Tag ord_num
9224 llRetVal= .SetRelation("__860Hist", "ord_num", tcTransHeader, "ord_num")
9225 If llRetVal
9226 Replace All merch_type With __860Hist.merch_type ;
9227 For Empty(merch_type) In (tcTransHeader)
9228 Endif
9229 Set Relation To
9230 Use In __860Hist
9231 Endif
9232 Endif
9233 * === TR 1043960 5/25/10 CM
9234
9235 Endif
9236 Endif
9237 Endif
9238 Endwith
9239 If Used("__TmpCursor")
9240 Use In __TmpCursor
9241 Endif
9242 Select(lnOldSelect)
9243 Return llRetVal
9244 Endproc
9245
9246 *- 1007309 09/28/04 YIK
9247 Procedure GetDetDiscount
9248 Lparameters pcTransDetail
9249 Local llRetVal, lnOldSelect, lcSQLSelect, lcCode
9250 llRetVal= .T.
9251 lnOldSelect = Select()
9252 Select Distinct Discount ;
9253 FROM &pcTransDetail ;
9254 WHERE Errs_Flg_D <> 'Y' And !Empty(Discount) ;
9255 INTO Cursor __TmpCurs
9256 If Recc("__TmpCurs") > 0
9257 lcSqlString = "SELECT * FROM zzxdiscr ORDER BY discount"
9258 llRetVal = v_SQLexec(lcSqlString, "_DiscCurs")
9259 If llRetVal
9260 Select __TmpCurs
9261 Scan
9262 lcCode = __TmpCurs.Discount
9263 Select _DiscCurs
9264 Locate For Discount = lcCode
9265 If Found()
9266 lnDiscPct = _DiscCurs.disc_perc
9267 Select (pcTransDetail)
9268 Replace disc_perc With lnDiscPct ;
9269 FOR Discount = lcCode
9270 Else
9271 Select (pcTransDetail)
9272 Replace Errs_Flg_D With 'Y', ;
9273 Errs_Msg_D With "Discount Rate for code " + Alltr(Discount) + ;
9274 " not found." ;
9275 FOR Discount = lcCode
9276 Endif
9277 Select __TmpCurs
9278 Endscan
9279 Endif
9280 Endif
9281 Select(lnOldSelect)
9282 Return llRetVal
9283 *== 1007309
9284 Endproc
9285
9286 *- 1013889 11/01/05 YIK
9287 Procedure CalcDiscAmt
9288 Parameters taDRef, tSAC_DRef, tSAC_DRate, tSAC_DAmt, tnCounter
9289 Local lnPos, lnCol
9290 If !Empty(tSAC_DRef)
9291 *- search for the current SAC_DRef
9292 lnPos = Ascan(taDRef, tSAC_DRef)
9293 If lnPos = 0 && new discount
9294 *- add it to the array. 3 rows tops. We declared it as [3,3]
9295 If tnCounter < 3
9296 tnCounter = tnCounter + 1
9297 taDRef[tnCounter, 1] = tSAC_DRef
9298 taDRef[tnCounter, 2] = tSAC_DRate
9299 taDRef[tnCounter, 3] = tSAC_DAmt
9300 Endif
9301 Else
9302 lnCol = (lnPos + 2)/3
9303 taDRef[lnCol, 3] = taDRef[lnCol, 3] + tSAC_DAmt
9304 Endif
9305 Endif
9306 Endproc
9307
9308 Procedure GetDiscAmt
9309 Lparameters tceipotd && transaction detail
9310 Local llRetVal, lnOldSelect, lnAmt1, lnAmt2, lnAmt3
9311 llRetVal = .T.
9312 lnOldSelect = Select()
9313 Select (tceipotd)
9314 *- 1014917 01/09/06 YIK
9315 llNewStoreDiscount = (Vartype(SAC_NSRef) == "C")
9316 Scan For SAC_DRate1 <> 0 Or (llNewStoreDiscount And SAC_NSRate <> 0) && the 2nd and 3d discounts are populated only if the 1st one is.
9317 lnAmt1 = 0
9318 lnNSAmt = 0
9319 lnAmt2 = 0
9320 lnAmt3 = 0
9321 If SAC_DRate1 <> 0
9322 *= 1014917
9323 *- 1014055 11/03/05 YIK
9324 *- Round to 4 decimals here
9325 lnAmt1 = Round(InvoiceQty*price*SAC_DRate1/100, 4)
9326 If SAC_DRate2 <> 0
9327 lnAmt2 = Round(InvoiceQty*price*SAC_DRate2/100, 4)
9328 If SAC_DRate3 <> 0
9329 lnAmt3 = Round(InvoiceQty*price*SAC_DRate3/100, 4)
9330 *= 1014055
9331 Endif
9332 Endif
9333 *- 1014917 01/09/06 YIK
9334 Endif
9335 If llNewStoreDiscount And SAC_NSRate <> 0
9336 lnNSAmt = Round(InvoiceQty*price*SAC_NSRate/100, 4)
9337 Replace SAC_NSAmt With lnNSAmt ;
9338 IN (tceipotd)
9339 Endif
9340 *= 1014917
9341
9342 Replace SAC_DAmt1 With lnAmt1, ;
9343 SAC_DAmt2 With lnAmt2, ;
9344 SAC_DAmt3 With lnAmt3 ;
9345 IN (tceipotd)
9346 Endscan
9347 Select (lnOldSelect)
9348 Return llRetVal
9349 Endproc
9350 *= 1013889 11/02/05 YIK
9351
9352 *- 1014711 02/15/06 YIK
9353 *- Split the source flat file (850.dat) into 850HDR.dat, 850DTL.dat etc.
9354 *- We are not going to use a definition file, just add 3 chr tag to the file name.
9355 *- Currently we assume the source and destination files are in the same EDI\Inbound\ folder.
9356 *- 1016069 03/15/06 YIK
9357 *- If the 2nd parameter tcRenameOnly set to .T., we'll skip splitting and will only rename it.
9358 Procedure SplitFlatFile
9359 Lparameters tcSource, tcRenameOnly
9360 Local llRetVal, lnOldSelect, lcEDIPath, lcSource, lnHandle, lnMaxBytes, lcBuffer, lcTag, lnTagPos, ;
9361 lnTagDelimPos
9362 *--- TR 1022750 04/16/07 NH
9363 Local lcUniqueSuff
9364 lcUniqueSuff = Sys(2015)
9365 *=== TR 1022750 04/16/07 NH
9366
9367 *--- TR 1057490 09-Dec-2011 BNarayanan Variable Declared
9368 LOCAL llEmptyFile
9369 llEmptyFile = .f.
9370 *=== TR 1057490 09-Dec-2011 BNarayanan
9371
9372 Declare laTags[1, 1]
9373 laTags = ""
9374 llRetVal = .T.
9375 lnOldSelect = Select()
9376 lcEDIPath = This.GetEDIFlatFileDirectory("Inbound")
9377 lcEDIPath = Iif(Right(Alltrim(lcEDIPath ), 1) = "\", Alltrim(lcEDIPath ), Alltrim(lcEDIPath ) + "\")
9378 lcSourceDat = Upper( lcEDIPath + Alltrim(tcSource) )
9379
9380 If File(lcSourceDat)
9381
9382 * --- TR 1042937 11/04/09 CM
9383 * If we've gotten to this point there's a flat file to
9384 * process, store it and use it later during our file rename.
9385 This.lDATExists = .T.
9386 * === TR 1042937 11/04/09 CM
9387
9388 *--- 1022750 02/20/07 YIK
9389 *lcSource = FORCEEXT(lcSourceDat, ".PRI") && rename .dat to .pri right away, new .dat may be on its way
9390 lcSource = Forceext(Alltrim(tcSource), ".PRI") && copy server side .dat to local .pri right away, new .dat may be on its way
9391
9392 *--- TR 1042937 11/04/09 CM --- If we just need to rename, then retain the original .pri file
9393 *lcSource = Stuff(lcSource,At(".",lcSource),0,lcUniqueSuff)
9394 lcSource = Iif(!tcRenameOnly, Stuff(lcSource,At(".",lcSource),0,lcUniqueSuff), Forceext(lcSourceDat, ".PRI"))
9395 *=== TR 1042937 11/04/09 CM
9396
9397 *=== 1022750 02/20/07 YIK
9398
9399 *--- TR 1031648 NSD 3/26/08
9400 IF tcRenameOnly
9401 Copy File (lcSourceDat) To (lcSource)
9402 ENDIF
9403 *=== TR 1031648 NSD 3/26/08
9404
9405 *--- TR 1015983 NH -- delete file when tcRenameOnly is not true
9406 *DELETE FILE (lcSourceDat)
9407 *- 1016069 03/15/06 YIK
9408 *- Added IF..ENDIF
9409 If !tcRenameOnly && need to split
9410 *--- TR 1015983 NH -- delete file when tcRenameOnly is not true
9411
9412 *--- TR 1031648 NSD 3/26/08
9413 *Delete File (lcSourceDat)
9414
9415 * Remove source
9416 IF FILE(lcSource)
9417 DELETE FILE (lcSource)
9418 ENDIF
9419
9420 RENAME (lcSourceDat) To (lcSource)
9421
9422 IF FILE(lcSourceDat)
9423 RETURN .F.
9424 ENDIF
9425 *=== TR 1031648 NSD 3/26/08
9426
9427 lnHandle = Fopen(lcSource)
9428 llRetVal = (lnHandle > 0)
9429 lnMaxBytes = 8192 && max bytes FGETS can read. It reads until CRLF is encountered inside the lnMaxBytes.
9430 lnPos = At(".", tcSource)
9431 llRetVal = llRetVal And (lnPos > 0)
9432
9433 *--- TR 1057490 09-Dec-2011 BNarayanan Check Empty File
9434 IF llRetVal AND Feof(lnHandle)
9435 llEmptyFile = .t.
9436 ENDIF
9437 *=== TR 1057490 09-Dec-2011 BNarayanan
9438 *- 1091225 06/28/16 YIK
9439 LOCAL lnSPlitHandle
9440 If llRetVal
9441 Do While !Feof(lnHandle)
9442 *- 1091225 06/29/16 YIK
9443 *- No need in CRLF. We remove it shortly anyway.
9444 *- lcBuffer = Fgets(lnHandle, lnMaxBytes) + CRLF && Store one line to string
9445 lcBuffer = Fgets(lnHandle, lnMaxBytes)
9446
9447 *- 1016069 03/22/06 YIK
9448 *- Tag may be 2 or 3 characters
9449 lcTag = Left(lcBuffer, 3)
9450 lnTagDelimPos = At("|", lcBuffer)
9451 lcTag = Left(lcBuffer, lnTagDelimPos - 1)
9452 *==
9453 *- 1017352 06/19/06 YIK - remove all pipes
9454 *- 1091225 09/29/16 YIK - we don't have CRLF anymore
9455 *- lcBufferData = Strtran(lcBuffer, CRLF)
9456 *- lcBufferData = Strtran(lcBufferData, "|", "")
9457 lcBufferData = Strtran(lcBuffer, "|", "")
9458 *===
9459 If Empty(lcBufferData) Or lcBufferData == lcTag && nothing except the tag
9460 Loop && skip empty line
9461 Endif
9462 *= 1017352 YIK
9463
9464 lnALen = Alen(laTags,1) && TR 1022750 NH
9465 If !Empty(laTags[1]) && at least one tag has been processed
9466 *- TR 1060311 FH - added 6 to Ascan parameter so we search for exact
9467 lnTagPos = Ascan(laTags, lcTag, 1, lnALen, 1, 6) && TR 1022750 NH - tag is stored as the 1st element of the array
9468 Else && the first record.
9469 lnTagPos = 0
9470 lnALen = 0
9471 Endif
9472 If lnTagPos = 0
9473 *- define the split file name
9474 *--- TR 1022750 NH
9475 *lcSplitFName = STUFF(tcSource, lnPos, 0, lcTag)
9476 lcSplitFName = Stuff(tcSource, lnPos, 0, lcTag + lcUniqueSuff )
9477 *lcSplitFile = lcEDIPath + ALLTRIM(lcSplitFName)
9478 *-- we only store the preocss+Tag + .dat file name
9479 lcSplitFile = Alltrim(Stuff(tcSource, lnPos, 0, lcTag))
9480 *--- make sure the local unique file is deleted.
9481 Delete File (lcSplitFName)
9482 *DECLARE laTags[lnALen + 1, 2] && add another row to the array
9483 *- 1091225 06/29/16 YIK
9484 *-- Declare laTags[lnALen + 1, 3] && add another row to the array
9485 lnSPlitHandle = FCREATE(lcSplitFName) && Read/Write
9486 lnALen = lnALen + 1
9487 Declare laTags[lnALen, 4] && add another row to the array
9488 *= 1091225
9489 *=== TR 1022740 NH
9490 laTags[lnALen, 1] = lcTag
9491 laTags[lnALen, 2] = lcSplitFile
9492 laTags[lnALen, 3] = lcSplitFName && TR 1022750 NH
9493 *- 1091225 06/29/16 YIK
9494 laTags[lnALen, 4] = lnSPlitHandle
9495
9496 Else
9497 lcSplitFName = laTags[lnTagPos + 2] && TR 1022750 NH
9498 *- 1091225 06/29/16 YIK
9499 lnSPlitHandle = laTags[lnTagPos + 3] && handle
9500
9501 Endif
9502 *- 1091225 06/28/2016 YIK
9503*--- Strtofile(lcBuffer, lcSplitFName, .T.) && append TR 1022750 NH
9504 FPUTS(lnSPlitHandle, lcBuffer)
9505
9506 Enddo
9507 Else
9508 Endif
9509 Fclose(lnHandle)
9510
9511 *- 1091225 06/28/2016 YIK
9512 FOR lnTagPos=1 TO ALEN(laTags, 1) && returns number of rows
9513 lnSPlitHandle = laTags[lnTagPos , 4]
9514 FFLUSH(lnSPlitHandle, .T.)
9515 FCLOSE(lnSPlitHandle)
9516 ENDFOR
9517 *=- 1091225
9518 *--- TR 1057490 09-Dec-2011 BNarayanan If added around
9519 IF NOT llEmptyFile
9520 *=== TR 1057490 09-Dec-2011 BNarayanan
9521 *- DELETE FILE (lcSource)
9522 *- 1022750 02/20/07 YIK/NH
9523 *- Copy LOCAL .pri and split files to server to be renamed later.
9524 lcServerFile = Forceext(lcSourceDat, ".PRI")
9525 Copy File (lcSource) To (lcServerFile)
9526 Delete File (lcSource)
9527 lnALen = Alen(laTags,1) && TR 1022750 NH
9528 For N = 1 To lnALen && TR 1022750 NH
9529 lcSplitFile = laTags[n, 2]
9530 lcServerSplitFile = lcEDIPath + lcSplitFile
9531 lcSplitFName = laTags[n, 3]
9532 This.CopyToFlatFileInBlock(lcSplitFName, lcServerSplitFile)
9533 Delete File (lcSplitFName)
9534
9535 Endfor
9536 *=== TR 1022570 NH
9537 *--- TR 1057490 09-Dec-2011 BNarayanan delete the empty file
9538 ELSE
9539 Delete File (lcSource)
9540 ENDIF
9541 *=== TR 1057490 09-Dec-2011 BNarayanan
9542 Endif
9543 Endif
9544 Select (lnOldSelect)
9545 Return llRetVal
9546 Endproc
9547
9548 *- 1014711 02/16/06 YIK
9549 *- Rename a file (1st parameter) to have a name and extension defined by rules
9550 *- specified by the definition string (2nd parameter)
9551 *- If the code for extension is not found - we keep the existing extension
9552 *- If the code for file extension = "_NULL" - we remove the extension.
9553 *- The extension code in a definition string currently starts with _ (underscore)
9554 *--- TechRec 1066835 13-Mar-2013 YKaganovsky ---
9555 *- Add parameter tcDirection
9556 Procedure RenFileDat
9557 Parameter tcSource, tcDefinitionString, tcDirection
9558
9559 Local llRetVal, lnHandle, lnSize, lcString, lnElements, llExtension, lnExtNum, lcFullSource, ;
9560 lcEDIPath, lcFullTarget
9561 llRetVal= .T.
9562
9563 *--- TechRec 1066835 13-Mar-2013 YKaganovsky ---
9564 *-lcEDIPath = This.GetEDIFlatFileDirectory("Inbound")
9565 tcDirection = IIF(EMPTY(tcDirection), "Inbound", tcDirection )
9566 lcEDIPath = This.GetEDIFlatFileDirectory(tcDirection)
9567 *=
9568
9569 lcEDIPath = Iif(Right(Alltrim(lcEDIPath ), 1) = "\", Alltrim(lcEDIPath ), Alltrim(lcEDIPath ) + "\")
9570 *--- TechRec 1066835 13-Mar-2013 YKaganovsky ---
9571 *- IF lcEDIPath is a part of tcSource - don't add the path again
9572 IF ATC("\", tcSource) = 0 && not found - need to add path
9573 lcFullSource = Upper( lcEDIPath + Alltrim(tcSource) )
9574 ELSE
9575 lcFullSource = tcSource
9576 ENDIF
9577 If !File(lcFullSource)
9578 Return
9579 Endif
9580
9581 * --- TR 1042937 11/04/09 CM
9582 *--- TechRec 1066835 13-Mar-2013 YKaganovsky ---
9583 *- added check for UPPER(tcDirection)= "INBOUND"
9584 If UPPER(tcDirection)= "INBOUND" AND !This.lDATExists
9585 Return
9586 Endif
9587 * === TR 1042937 11/04/09 CM
9588
9589 *- Default is to timestamp and rename to .gen
9590 lcString = Iif(Empty(tcDefinitionString), 'F,YYYY,MM,DD,HMS,_"gen"', tcDefinitionString)
9591 Declare laFormat[1]
9592 = StringToArray(lcString, @laFormat)
9593 lnElements = Alen(laFormat) && how many elements in the array
9594 llExtension = .T.
9595 lnFormats = lnElements
9596 lcExtensionCode = "NON"
9597 lnSize = lnElements
9598 For j = 1 To lnElements
9599 If Left(laFormat[j], 1) == "_" && FILE EXTENSION MARKER
9600 lnExtNum = j
9601 lnSize = j && elements after the extension don't count
9602 lnFormats = j - 1
9603 lcExtensionCode = Alltrim(laFormat[j])
9604 Exit
9605 Endif
9606 Endfor
9607 If lnFormats = 0 && the only element is extension format - no good.
9608 Return
9609 Endif
9610 Declare laFileNameFormat[lnFormats]
9611 Acopy(laFormat, laFileNameFormat,1 ,lnFormats) && copy only file name format codes.
9612 lcFileName = This.DefineFileName(tcSource, @laFileNameFormat)
9613 lcExtension = This.DefineExtension(tcSource, lcFileName, lcExtensionCode)
9614 lcTargetFile = lcFileName + Iif(lcExtension == "", "", "." + lcExtension)
9615 *--- TechRec 1066835 13-Mar-2013 YKaganovsky ---
9616 *-lcFullTarget = Upper( lcEDIPath + Alltrim(lcTargetFile) )
9617 *- IF lcEDIPath is a part of tcTargetFile - don't add the path again
9618 IF ATC("\", lcTargetFile) = 0 && not found - need to add path
9619 lcFullTarget = Upper( lcEDIPath + Alltrim(lcTargetFile) )
9620 ELSE
9621 lcFullTarget = lcTargetFile
9622 ENDIF
9623 *=
9624 *-- lcRunString = "!RENAME " + tcSource + " " + lcTargetFile
9625 *-- &lcRunString
9626 *- = FCLOSE(lnHandle) && nothing is open???
9627 Copy File (lcFullSource) To (lcFullTarget)
9628 Delete File (lcFullSource)
9629 ENDPROC
9630
9631 Function DefineFileName
9632 Lparameters tcSource, laFileNameFormat
9633 Local lcNameString, lnASize, j
9634 lnPos = At(".", tcSource)
9635 If lnPos > 1
9636 lcFSourceName = Left(tcSource, lnPos-1)
9637 Else
9638 lcFSourceName = tcSource
9639 Endif
9640 lcNameString = ""
9641 lnASize = Alen(laFileNameFormat)
9642 lcDateString = CurrentDateTimeAsString()
9643 For j = 1 To lnASize
9644 Do Case
9645 Case laFileNameFormat[j] = "YYYY" && the 4-digit year
9646 lcString = Substr(lcDateString, 1, 4)
9647 Case laFileNameFormat[j] = "YY" && the 2-digit year
9648 lcString = Substr(lcDateString, 3, 2)
9649 Case laFileNameFormat[j] = "MM" && the 2 digit numeric month (left padded by '0' for months 1 thru 9)
9650 lcString = Substr(lcDateString, 5, 2)
9651 Case laFileNameFormat[j] = "DD" && the 2-digit day of the month (left padded by '0' for days 1 thru 9),
9652 lcString = Substr(lcDateString, 7, 2)
9653 Case laFileNameFormat[j] = "HH" && the 2-digit hour (left padded by '0' for hours 1 thru 9)
9654 lcString = Substr(lcDateString, 9, 2)
9655 Case laFileNameFormat[j] = "HMS" && the 2-digit hour (left padded by '0' for hours 1 thru 9) +
9656 && the 2-digit minutes (left padded by '0' for minutes 1 thru 9) +
9657 && the 2-digit seconds (left padded by '0' for seconds 1 thru 9)
9658 lcString = Substr(lcDateString, 9, 6)
9659 Case laFileNameFormat[j] = "MA" && the alphabetic sequentially equivalent of a numeric month
9660 && (A thru L for months 1 thru 12)
9661 lcString = This.GetMonthAlphabetic(lcDateString)
9662 Case laFileNameFormat[j] = "MX" && the 3 character alpha abbreviation of the current month
9663 && (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG, SEP, OCT, NOV, DEC)
9664 lcString = This.GetMonth3Chars(lcDateString)
9665 Case laFileNameFormat[j] = "F" && the existing file name (to be included in the rename at the position
9666 && specified indicated when the parameters are passed)
9667 lcString = lcFSourceName
9668 Case ( Left(laFileNameFormat[j], 1) = '"' And Right(laFileNameFormat[j], 1) = '"' ) ;
9669 OR (Left(laFileNameFormat[j], 1) = "'" And Right(laFileNameFormat[j], 1) = "'" ) && passed value
9670 lnLen = Len(laFileNameFormat[j]) - 2
9671 lcString = Substr(laFileNameFormat[j], 2, lnLen) && put the code passed.
9672 Otherwise
9673 lcString = ""
9674 Endcase
9675 lcNameString = lcNameString + lcString
9676 Endfor
9677 Return lcNameString
9678
9679 Procedure GetMonthAlphabetic
9680 Lparameters tcDateString
9681 Local lnMonth, lcChar
9682 lnMonth = Substr(tcDateString, 5, 2)
9683 Do Case
9684 Case lnMonth = "01"
9685 lcChar = "A"
9686 Case lnMonth = "02"
9687 lcChar = "B"
9688 Case lnMonth = "03"
9689 lcChar = "C"
9690 Case lnMonth = "04"
9691 lcChar = "D"
9692 Case lnMonth = "05"
9693 lcChar = "E"
9694 Case lnMonth = "06"
9695 lcChar = "F"
9696 Case lnMonth = "07"
9697 lcChar = "G"
9698 Case lnMonth = "08"
9699 lcChar = "H"
9700 Case lnMonth = "09"
9701 lcChar = "I"
9702 Case lnMonth = "10"
9703 lcChar = "J"
9704 Case lnMonth = "11"
9705 lcChar = "K"
9706 Case lnMonth = "12"
9707 lcChar = "L"
9708 Otherwise
9709 Endcase
9710 Return lcChar
9711
9712 Procedure GetMonth3Chars
9713 Lparameters tcDateString
9714 Local lnMonth, lcChar
9715 lnMonth = Substr(tcDateString, 5, 2)
9716 Do Case
9717 Case lnMonth = "01"
9718 lcChar = "JAN"
9719 Case lnMonth = "02"
9720 lcChar = "FEB"
9721 Case lnMonth = "03"
9722 lcChar = "MAR"
9723 Case lnMonth = "04"
9724 lcChar = "APR"
9725 Case lnMonth = "05"
9726 lcChar = "MAY"
9727 Case lnMonth = "06"
9728 lcChar = "JUN"
9729 Case lnMonth = "07"
9730 lcChar = "JUL"
9731 Case lnMonth = "08"
9732 lcChar = "AUG"
9733 Case lnMonth = "09"
9734 lcChar = "SEP"
9735 Case lnMonth = "10"
9736 lcChar = "OCT"
9737 Case lnMonth = "11"
9738 lcChar = "NOV"
9739 Case lnMonth = "12"
9740 lcChar = "DEC"
9741 Otherwise
9742 Endcase
9743 Return lcChar
9744
9745 Procedure DefineExtension
9746 Parameters tcSource, tcFileName, tcExtensionCode
9747 lnPos = At(".", tcSource)
9748 If lnPos > 1
9749 lcSourceExtension = Substr(tcSource, lnPos+1)
9750 Else
9751 lcSourceExtension = ""
9752 Endif
9753 Do Case
9754 Case tcExtensionCode = "_NUL" && NO EXTENSION CODE
9755 lcSourceExtension = ""
9756 Case tcExtensionCode = "_NNN"
9757 lcSourceExtension = This.GetNextSequenceNum(tcFileName)
9758 Case ( Left(tcExtensionCode, 2) = '_"' And Right(tcExtensionCode, 1) = '"' ) ;
9759 OR (Left(tcExtensionCode, 2) = "_'" And Right(tcExtensionCode, 1) = "'" )
9760 lnLen = Len(tcExtensionCode) - 3
9761 lcSourceExtension = Substr(tcExtensionCode, 3, lnLen) && put the code passed.
9762 Case tcExtensionCode = "NON" && no extension format code was sent - keep the existing one
9763 Otherwise
9764 lcSourceExtension = tcExtensionCode
9765 Endcase
9766 Return lcSourceExtension
9767
9768 Procedure GetNextSequenceNum
9769 Lparameters tcFileName
9770 Local Array laFiles[1], laNames[1]
9771 Local lnFiles, lcExtension, lnNewExtension, lcNewExtension
9772 laFiles[1] = ''
9773 lnFiles = Adir(laFiles, tcFileName + ".*")
9774 If lnFiles = 0 && no files found
9775 lcNewExtension = '001'
9776 Else
9777 For j = 1 To lnFiles
9778 Declare laNames[j]
9779 laNames[j] = laFiles[j, 1] && copy file names only to array laNames
9780 Endfor
9781 = Asort(laNames) && ascending order.
9782 lcLast = laNames[lnFiles]
9783 lnPos = At(".", lcLast) && extract the extension part
9784 If lnPos > 1
9785 lcExtension = Substr(lcLast, lnPos+1)
9786 Else
9787 lcExtension = "000"
9788 Endif
9789 lnNewExtension = Eval(lcExtension) + 1
9790 lcNewExtension = Padl( Alltrim(Trans(lnNewExtension, "999")), 3, "0") && new extension, left-padded with "0"
9791 Endif
9792 Return lcNewExtension
9793 *= 1014711 02/16/06 YIK
9794 *--- TR 1017624 NH
9795 *------------------------------------------------------------------------------------------
9796
9797 Procedure LogOpen
9798 Lparameter pcJobID, pcJobDesc, plScheduled, pcFlatFileLog
9799 Local llRetVal
9800 llRetVal = (Vartype(This.oLog) == "O")
9801 llRetVal = llRetVal And DoDefault(pcJobID, pcJobDesc, plScheduled, pcFlatFileLog)
9802 Return llRetVal
9803 Endproc
9804
9805 *------------------------------------------------------------------------------------------
9806
9807 Procedure LogProgram
9808 Lparameters pcProgram, plDontLogMethod
9809 Local llRetVal
9810 llRetVal = (Vartype(This.oLog) == "O")
9811 llRetVal = llRetVal And DoDefault(pcProgram, plDontLogMethod)
9812 Return llRetVal
9813 Endproc
9814
9815 *------------------------------------------------------------------------------------------
9816
9817 Procedure logEntry
9818 Lparameters pcText, plSkipLine
9819 Local llRetVal
9820 llRetVal = (Vartype(This.oLog) == "O")
9821 llRetVal = llRetVal And DoDefault(pcText, plSkipLine)
9822 Return llRetVal
9823 Endproc
9824
9825 *------------------------------------------------------------------------------------------
9826
9827 Procedure LogResult
9828 Lparameters plSuccess, pcJobDesc
9829 Local llRetVal
9830 llRetVal = (Vartype(This.oLog) == "O")
9831 llRetVal = llRetVal And DoDefault(plSuccess, pcJobDesc)
9832 Return llRetVal
9833 Endproc
9834
9835 *------------------------------------------------------------------------------------------
9836
9837 Procedure LogClose
9838 Local llRetVal
9839 llRetVal = (Vartype(This.oLog) == "O")
9840 llRetVal = llRetVal And DoDefault()
9841 Return llRetVal
9842 Endproc
9843
9844 *------------------------------------------------------------------------------------------
9845
9846 Procedure LogMajorStage
9847 Lparameters pcText
9848 Local llRetVal
9849 llRetVal = (Vartype(This.oLog) == "O")
9850 llRetVal = llRetVal And DoDefault(pcText)
9851 Return llRetVal
9852 Endproc
9853
9854 *------------------------------------------------------------------------------------------
9855
9856 Procedure LogWarning
9857 Lparameters pcText
9858 Local lRetVal
9859 llRetVal = (Vartype(This.oLog) == "O")
9860 llRetVal = llRetVal And DoDefault(pcText)
9861 Return lRetVal
9862 Endproc
9863
9864 *------------------------------------------------------------------------------------------
9865
9866 Procedure RetrieveLogToFile
9867 Lparameters pcLogFile, pnHeaderPkey
9868 Local llRetVal
9869 llRetVal = (Vartype(This.oLog) == "O")
9870 llRetVal = llRetVal And DoDefault(pcLogFile, pnHeaderPkey)
9871 Return llRetVal
9872 Endproc
9873
9874 *------------------------------------------------------------------------------------------
9875
9876 *=== TR 1017624 NH
9877
9878 *--- TechRec 1030096 02/01/07 RCO/NH
9879 *CheckRemitNum Procedure should not return false if no customer sales reference causes 810 Process to fail; should update transaction header accordingly
9880 *Optimization done for the CheckRemitNum to increase efficiency when updating transaction header
9881
9882 *--- TechRec 1026592 11-Sep-2007 jjanand ---
9883 Procedure CheckRemitNum
9884 Lparameters pcEDIth, pcEDIcr
9885
9886 * TR 1048519 23-AUG-10 KISHOR Added ord_type
9887 Local llRetVal, lnOldSelect, lcErrs_Msg ,lcCustomer,lcStore,lcdepartment,lcDivision, lcOrd_type,;
9888 lcRemit_num, lcRemit_req, lcExp, llCustSales, llTagExists, lcOrder
9889
9890 llRetVal = .T.
9891 lnOldSelect = Select()
9892
9893 lcTmpCursor = GetUniqueFileName()
9894
9895 * TR 1048519 23-AUG-10 KISHOR Added h.ord_type
9896 lcSqlString = " SELECT DISTINCT h.customer,h.store,h.department,h.division,h.ord_type " +;
9897 " FROM " + pcEDIth + " h " +;
9898 " JOIN " + pcEDIcr + " c " +;
9899 " ON h.customer = c.customer " +;
9900 " AND h.division = c.division " +;
9901 " AND c.remit_req = 'Y' " +;
9902 " ORDER BY h.customer,h.Store,h.department,h.division,h.ord_type " +;
9903 " Into Cursor " + lcTmpCursor
9904
9905 llRetVal = llRetVal And v_SQLexec(lcSqlString, ,,.T.)
9906
9907 If llRetVal
9908
9909 SELECT (pcEDIth)
9910
9911 *record current controlling index file for a table before creating new index set it back after execution
9912 lcOrder = SET("Order")
9913 *-FH 1089190
9914 INDEX on customer+store+department+division+ord_type TAG CustSDDiv
9915 *-FH 1089190
9916 *CreateCursorIndex(pcEDIth,"CustSDDiv","customer+store+department+division+ord_type")
9917 Set Order To CustSDDiv
9918
9919 Select (lcTmpCursor)
9920
9921 Scan
9922
9923 lcCustomer = customer
9924 lcStore = Store
9925 lcdepartment= department
9926 lcDivision = division
9927 *--- TR 1048519 23-AUG-10 KISHOR Added ord_type
9928 lcOrd_type = ord_type
9929 lcExp = lcCustomer + lcStore + lcdepartment + lcDivision + lcOrd_type
9930
9931 llCustSales = vl_cslsr1(customer,Store,department,division,'tcXCslsr',False,False,ord_type)
9932 *=== TR 1048519 23-AUG-10 KISHOR Added ord_type
9933
9934 lcErrs_Msg = ""
9935
9936
9937 SELECT (pcEDIth)
9938 IF SEEK(lcExp,pcEDIth,"CustSDDiv")
9939 * TR 1048519 23-AUG-10 KISHOR Added ord_type
9940 SCAN WHILE lcExp =customer+Store+department+division+ord_type
9941 *--- TechRec 1031038 02/27/08 RCO
9942 *If remit num exists in customer sales reference and 810(o) control take from customer sales reference
9943 If llCustSales AND NOT Empty(tcXCslsr.remit_num)
9944 SELECT (pcEDIth)
9945 Replace remit_num With tcXCslsr.remit_num
9946 ENDIF
9947
9948 SELECT (pcEDIth)
9949 IF EMPTY(remit_num)
9950 *--- TechRec 1031038 02/27/08 RCO
9951 * Store in 810 transaction maintenance if Remit Num doesnt exist in 810(o) control
9952 lcErrs_Msg= EDI_REMIT_REQ_MSG + CRLF
9953 Replace Errs_Msg_H With Errs_Msg_H + lcErrs_Msg, Errs_flg_H With "Y"
9954 ENDIF
9955 ENDSCAN
9956 ENDIF
9957
9958 *!* Replace remit_num With tcXCslsr.remit_num;
9959 *!* For customer = lcCustomer And;
9960 *!* store = lcStore And;
9961 *!* department = lcdepartment And;
9962 *!* division = lcDivision And;
9963 *!* !Empty(tcXCslsr.remit_num);
9964 *!* In (pcEDIth)
9965
9966 *!* lcErrs_Msg= EDI_REMIT_REQ_MSG + CRLF
9967
9968 *!* Replace Errs_Msg_H With Errs_Msg_H + lcErrs_Msg, Errs_flg_H With "Y" ;
9969 *!* For customer = lcCustomer And;
9970 *!* store = lcStore And;
9971 *!* department = lcdepartment And;
9972 *!* division = lcDivision And;
9973 *!* EMPTY(remit_num) ;
9974 *!* In (pcEDIth)
9975
9976 ENDSCAN
9977
9978 SELECT (pcEDIth)
9979 SET ORDER TO &lcOrder
9980
9981 Endif
9982
9983 Select(lnOldSelect)
9984 Return llRetVal
9985 Endproc
9986 *=== TechRec 1026592 11-Sep-2007 jjanand ===
9987 *=== TechRec 1030096 02/01/07 RCO/NH
9988
9989*--- TR 1055192 09-22-2011 RKI ---*
9990FUNCTION Update_FactorOtherDetails
9991LPARAMETERS toSourceFactor,toSourceHeader
9992LOCAL llRetVal, lcSelect
9993llRetVal = True
9994lcSelect = SELECT()
9995IF TYPE('toSourceFactor')#'O' OR TYPE('toSourceHeader') # 'O'
9996 RETURN
9997ENDIF
9998
9999*Check Header level Trans_date is empty
10000IF EMPTY(toSourceHeader.fTran_date)
10001 toSourceFactor.fTran_Date = DATE()
10002ENDIF
10003IF EMPTY(toSourceHeader.facExpir_days)
10004 toSourceFactor.FacExPir_days = vl_factr(toSourceFactor.Factor,'Expir_Days')
10005ENDIF
10006
10007IF EMPTY(toSourceHeader.FacExpir_Basis)
10008 toSourceFactor.FacExpir_Basis = vl_factr(toSourceFactor.Factor,'Expir_basis')
10009ENDIF
10010
10011IF EMPTY(toSourceFactor.FExpn_date)
10012 DO CASE
10013 CASE toSourceFactor.FacExpir_basis='E'
10014 toSourceFactor.FExpn_date = GoDay(toSourceHeader.End_date,toSourceFactor.FacExpir_days)
10015 CASE toSourceFactor.FacExpir_Basis = 'A' AND !EMPTY(toSourceFactor.FTran_Date)
10016 toSourceFactor.FExpn_Date = GoDay(toSourceFactor.Ftran_Date,toSourceFactor.FacExpir_Days)
10017 ENDCASE
10018ELSE
10019 toSourceFactor.FacExpir_Basis='F'
10020Endif
10021SELECT (lcSelect)
10022RETURN llRetVal
10023ENDFUNC
10024*=== TR 1055192 09-22-2011 RKI ===*
10025
10026*--- TR 1055192 10-05-2011 RKI ---
10027FUNCTION Update_FactorDetailsToHeader
10028LPARAMETERS tnCurTranPkey,tcTargetFactor,tcTransHeader,tcOrderHeader
10029 LOCAL llRetVal, lFinalOrder, lcSelect
10030 llRetVal = True
10031 lFinalOrder = True
10032 lcSelect = SELECT()
10033
10034 IF TYPE('tcOrderHeader')#"C"
10035 lFinalOrder = False
10036 Endif
10037
10038 *--- TR 1055192 25-07-2011 RKI ---*
10039 * For factor transaction, update Factor table and factor info in Sales Order table.
10040 SELECT * FROM (tcTargetFactor) WITH (Buffering=.T.) where fkey = tnCurTranPkey INTO CURSOR _tcipotfh
10041 IF RECCOUNT("_tcipotfh") # 0 && Check Multi Factor Details.
10042 IF Reccount("_tciPOtfh") = 1 AND !lFinalOrder
10043 = Seek(tnCurTranPkey, (tcTargetfactor), "fkey")
10044 SCATTER NAME loeiPOtfh_factor Memo
10045 * factor details
10046 Replace factor WITH loeiPOtfh_factor.factor, ;
10047 fact_status WITH '', ;
10048 appv_num WITH loeiPOtfh_factor.appv_num, ;
10049 decl_rsn WITH '', ;
10050 facclient_num WITH '' ;
10051 In (tcTransHeader) FOR pkey = tnCurTranPkey
10052 IF lFinalOrder
10053 SELECT (tcTransHeader)
10054 SCATTER MEMVAR Fields appv_num,decl_rsn
10055 SELECT(tcOrderHeader)
10056 GATHER Memvar FIELDS appv_num,decl_rsn MEMO
10057
10058 Replace multifactor WITH 'N', fappv_amt WITH loeiPOtfh_factor.fappv_amt ,;
10059 fexpn_date with loeipotfh_factor.fexpn_date , ;
10060 facexpir_days with loeipotfh_factor.facexpir_days,;
10061 ftran_date with loeipotfh_factor.ftran_date,;
10062 facexpir_basis with loeipotfh_factor.facexpir_basis IN (tcOrderHeader)
10063 ELSE
10064 Replace ;
10065 facexpir_days with loeipotfh_factor.facexpir_days,;
10066 ftran_date with loeipotfh_factor.ftran_date,;
10067 facexpir_basis with loeipotfh_factor.facexpir_basis IN (tcTransHeader)
10068 ENDIF
10069 ELSE
10070 SELECT fkey,MIN(fexpn_date) as fexpn_date FROM (tcTargetFactor) WITH (Buffering=.T.) INTO CURSOR _tcExpndate where fkey = tnCurTranPkey GROUP BY fexpn_date
10071 ldfExpn_Date = fexpn_date
10072 SELECT fkey,SUM(fappv_amt) as fappv_amt FROM (tcTargetFactor) WITH (Buffering=.T.) INTO CURSOR _tcEfappv_amt where fkey = tnCurTranPkey GROUP BY fkey
10073 lnAppv_Amt=fappv_amt
10074 *Update Transaction Header table
10075
10076 UPDATE H SET ;
10077 Factor = 'MULTI', ;
10078 Appv_num = IIF( t.maxappv_num = t.minappv_num, t.maxappv_num, ;
10079 IIF(!EMPTY(t.maxappv_num) AND EMPTY(t.minappv_num), t.maxappv_num, ;
10080 IIF(t.maxappv_num # t.minappv_num, "MULTIPLE",''))), ;
10081 facclient_num= IIF(t.maxfacclient=t.minfacclient, t.maxfacclient,;
10082 IIF(!EMPTY(t.maxfacclient) AND EMPTY(t.minfacclient),t.maxfacclient,;
10083 IIF(t.maxfacclient # t.minfacclient, "MULTIPLE",''))) ,;
10084 Decl_Rsn = IIF(t.maxdecl_rsn = t.mindecl_rsn, t.maxdecl_rsn, ;
10085 IIF(!EMPTY(t.maxdecl_rsn) AND EMPTY(t.mindecl_rsn), t.maxdecl_rsn,;
10086 IIF(t.maxdecl_rsn # t.mindecl_rsn, "MULTIPLE",''))), ;
10087 ftran_date = t.ftran_date,;
10088 facexpir_days =0,;
10089 facexpir_basis='',;
10090 factor_ok='Y',;
10091 user_id =goenv.sv("cUser");
10092 From (tcTransHeader) h ;
10093 Join ( Select fkey,SUM(fappv_amt) as fappv_amt, MAX(ftran_date) ftran_date, ;
10094 MAX(facclient_num) as maxfacclient,;
10095 MIN(facclient_num) as minfacclient, MAX(appv_num) as maxappv_num,;
10096 MIN(appv_num) as minappv_num, MAX(decl_rsn) as maxdecl_rsn,;
10097 MIN(decl_rsn) as mindecl_rsn from (tcTargetFactor) with (buffering=.T.) group by fkey ;
10098 ) t ;
10099 on h.pkey = t.fkey ;
10100 Where h.pkey = tncurTranpkey
10101
10102 UPDATE H SET ;
10103 Fact_Status = IIF(!EMPTY(t1.fact_status),t2.fact_status,'') ;
10104 From (tcTransHeader) h ;
10105 join (tcTargetFactor) t1 ;
10106 on h.pkey = t1.fkey AND t1.fact_status='D';
10107 join (tcTargetFactor) t2;
10108 on h.pkey = t2.fkey AND t2.fact_status='S' ;
10109 Where h.pkey = tncurTranpkey
10110 IF lFinalOrder
10111 SELECT (tcTransHeader)
10112 SCATTER MEMVAR Fields appv_num,facclient_num,decl_rsn,ftran_Date,facexpir_days,facexpir_basis,factor_ok MEMO
10113 SELECT(tcOrderHeader)
10114 GATHER Memvar FIELDS appv_num,facclient_num,decl_rsn,ftran_Date,facexpir_days,facexpir_basis,factor_ok MEMO
10115
10116 *Update Order Header table
10117 Replace Multifactor WITH "Y", ;
10118 factor WITH "MULTI", ;
10119 fappv_amt With lnFappv_amt, ;
10120 autofact WITH 'N', ;
10121 sent_855f WITH '', ;
10122 fexpn_date WITH ldfExpn_date ;
10123 IN (tcOrderHeader)
10124 ENDIF
10125 ENDIF
10126 Endif
10127 SELECT (lcSelect)
10128 RETURN llRetVal
10129ENDFUNC
10130*=== TR 1055192 10-05-2011 RKI ===*
10131
10132 *--- TR 1035491 6-Nov-2008 Goutam
10133 Procedure DTLtoSLN
10134 Lparameters pcTransHeader, pcTransDetail, pcSLNPrePack, pcFinalSLN, pcEDITransaction
10135
10136 LOCAL llRetVal, lnOldSelect, lcInterface, lnTotalRow, lnPrice, lnIntPkey, lntotal_Qty, ;
10137 lnLastFkey , lcReplaceString, lnxx, lcSizeStr, lcSKU, lcUPC, lnDTL_SLN_Qty ,lnCurrentRecNo, lnTotalSLN_Qty
10138 *--- TR 1045922 28-JUN-2010 HNISAR * Added ,lnCurrentRecNo, lnTotalSLN_Qty
10139 *- 1041196 07/01/09 YIK
10140 *- Added LOCAL lndtl_sln_qty
10141
10142 *--- TechRec 1044701 16-Feb-2010 vkrishnamurthy ---
10143 LOCAL lcAssortment
10144
10145 llRetVal = .T.
10146 lcSizeStr = ""
10147 lnOldSelect = Select()
10148
10149 *--- TR 1037555 NH -
10150 LOCAL lcStyle_name
10151 lcStyle_name = ""
10152 *=== TR 1037555 NH
10153
10154 *--- 1045922 03/24/10 YIK
10155 IF ALLTRIM(pcEDITransaction) == 'OIN'
10156 SELECT (pcTransDetail)
10157 REPLACE ib_uom WITH 'EA' ;
10158 FOR SLNTODTL = 'I'
10159 ENDIF
10160 *=== 1045922 03/24/10 YIK
10161
10162 *--- TechRec 1095670 05-Jun-2016 jisingh ---
10163 *--- TR 1094662 14-Jun-2016 Partha --- Added one more template "Footlocker 4030"
10164 IF TYPE(pcTransHeader + ".template") = "C"
10165 lcSqlString = " UPDATE d SET ib_uom = 'EA' " + ;
10166 " FROM (pcTransDetail) d " + ;
10167 " JOIN (pcTransHeader) h " + ;
10168 " ON h.pkey = d.fkey " + ;
10169 " WHERE h.template = 'FRED MEYER 5010' OR UPPER(h.template) = 'FOOTLOCKER 4030'"
10170 &lcSqlString
10171 ENDIF
10172 *=== TechRec 1095670 05-Jun-2016 jisingh ===
10173
10174 *--- TechRec 1092421 04-May-2016 TSV---
10175 llGarWgtuom = Fieldexists("gar_wgt", (pcTransDetail)) AND Fieldexists("wgt_uom", (pcTransDetail))
10176
10177 *-TR 1108380 FH - If SLN cursor also have gar_wgt,wgt_uom then don't add it to field list.
10178 *- Adding it twice changes the name to gar_wgt_a, gar_wgt_b
10179 llGarWgtuom = llGarWgtuom AND (!Fieldexists("gar_wgt", (pcSLNPrePack)) AND Fieldexists("wgt_uom", (pcSLNPrePack)))
10180
10181 IF llGarWgtuom
10182 lc856FldLst = ",d.gar_wgt, d.wgt_uom"
10183 ELSE
10184 lc856FldLst = ""
10185 ENDIF
10186 *=== TechRec 1092421 04-May-2016 TSV===
10187
10188 IF NOT USED(pcFinalSLN) AND USED(pcSLNPrePack)
10189 Select Distinct h.customer, p.* ;
10190 From (pcTransHeader) h, (pcTransDetail) d, (pcSLNPrePack) p ;
10191 Where h.Pkey = d.Fkey And d.division= p.division And d.Style= p.PPK_style And ;
10192 d.color_code= p.PPK_color And d.Lbl_code= p.PPK_label And ;
10193 d.Dimension= p.PPK_dimension And .F. ;
10194 Order By 1,2,3,4,5,6,7 Into Cursor _CustSLNPrepack
10195
10196 *-- TR 1041844 02-Nov-2010 SK Added d.Assortment
10197 *--- TR 1051030 09-DEC-2010 HNISAR && Added d.aux_sku
10198 Select d.Pkey As ITM_Pkey, p.*, d.assortment ,d.aux_sku &lc856FldLst ; && TR 1092421 added &lc856FldLst
10199 From (pcTransHeader) h, (pcTransDetail) d, _CustSLNPrepack p ;
10200 Where h.Pkey = d.Fkey And d.division= p.division And d.Style= p.PPK_style And ;
10201 d.color_code= p.PPK_color And d.Lbl_code= p.PPK_label And ;
10202 d.Dimension= p.PPK_dimension And h.customer = p.customer AND .F. ;
10203 Into Cursor (pcFinalSLN) readwrite
10204
10205 *=== TechRec 1044701 16-Feb-2010 vkrishnamurthy ===
10206
10207 ENDIF
10208 IF NOT USED(pcFinalSLN) AND NOT USED(pcSLNPrePack)
10209 IF TYPE("tcRangeSLN.itm_pkey") = "U"
10210 Select Pkey As ITM_Pkey, * From tcRangeSLN Into Cursor __TempSLN
10211 ELSE
10212 Select * From tcRangeSLN Into Cursor __TempSLN
10213 ENDIF
10214 IF TYPE("__TempSLN.Customer") = "U"
10215 Select SPACE(7) As Customer, * From __TempSLN Into Cursor __TempSLN
10216 ENDIF
10217
10218 *--- TR 1051030 09-DEC-2010 HNISAR
10219 IF TYPE("__TempSLN.aux_sku") = "U"
10220 Select *,SPACE(50) AS aux_sku From __TempSLN Into Cursor __TempSLN
10221 ENDIF
10222 *=== TR 1051030 09-DEC-2010 HNISAR
10223
10224 *--- TechRec 1056973 17-Nov-2011 jisingh ---
10225 IF TYPE("__TempSLN.sfkey") = "U"
10226 Select *,pkey AS sfkey From __TempSLN Into Cursor __TempSLN
10227 ENDIF
10228 *=== TechRec 1056973 17-Nov-2011 jisingh ===
10229
10230 This.MakeCursorWritable("__TempSLN", pcFinalSLN)
10231 ENDIF
10232
10233 If Used(pcFinalSLN)
10234 *--- TR 1045922 18-MAR-2010 HNISAR
10235*!* Select d.pkey, d.fkey, h.ord_num, h.Customer, h.po_num, h.Store, d.coord_code, d.line_seq, d.sizebucket From ;
10236*!* (pcTransHeader) h, (pcTransDetail) d Where d.fkey = h.pkey And d.SLNtoDTL = 'Y' And h.errs_flg_h <> 'Y' ;
10237*!* INTO Cursor __TmpCursor
10238 LOCAL lcWhereString
10239 lcWhereString = IIF(ALLTRIM(pcEDITransaction) == 'OIN' ," d.SLNtoDTL = 'Y' ", " d.SLNtoDTL IN ('Y','I')")
10240
10241 *--- TechRec 1095670 05-Jun-2016 jisingh ---
10242 IF TYPE(pcTransHeader + ".template") = "C"
10243 lcWhereString = lcWhereString + " AND template <> 'FRED MEYER 5010' "
10244 ENDIF
10245 *=== TechRec 1095670 05-Jun-2016 jisingh ===
10246
10247 *--- 1052013 01/24/11 YIK
10248 *- added lcFieldlist, d.total_qty and template
10249 *--- TR 1048519 30-7-2011 VKK Fixed the issue reported by yuri. not part of this TR
10250 *lcFieldlist = IIF(VARTYPE(&pcTransHeader..template) = 'C', ", template " ,", ' ' AS template")
10251 lcFieldlist = IIF(TYPE(pcTransHeader+'.template') = 'C', ", template " ,", ' ' AS template")
10252
10253 lcFieldlist = lcFieldlist + lc856FldLst && TR 1092421 added lc856FldLst
10254
10255 *--- TR 1094662 13-Jun-2016 Partha ---
10256 lcWhereString = lcWhereString + IIF( ", template" $ lcFieldlist, ;
10257 " AND UPPER(LTRIM(RTRIM(template))) <> 'FOOTLOCKER 4030' " , "")
10258 *=== TR 1094662 13-Jun-2016 Partha ===
10259 *--- TechRec 1056973 17-Nov-2011 jisingh Added , d.pkey as sfkey ===
10260 *- TR 1078366 FH - changed h.ord_num -> d.ord_num, If our order is consolidated , we will be missing a lot of ord_nums.
10261 lcSqlString = " Select d.pkey, d.fkey, d.ord_num, h.Customer, h.po_num, h.Store, d.coord_code, d.line_seq, d.sizebucket " + ;
10262 " , d.total_qty, d.pkey as sfkey " + ;
10263 lcFieldlist + ;
10264 " From (pcTransHeader) h, (pcTransDetail) d Where d.fkey = h.pkey And " + lcWhereString + " And h.errs_flg_h <> 'Y' "+ ;
10265 " INTO Cursor __TmpCursor "
10266 *=
10267 &lcSqlString
10268
10269 *=== TR 1045922 18-MAR-2010 HNISAR
10270
10271 pcEDITransaction= Iif(Empty(pcEDITransaction), "OIN", pcEDITransaction)
10272 lcInterface= "ZZE" + pcEDITransaction + "ID"
10273
10274 Select __TmpCursor
10275 With This
10276 .cSQLTempTable=""
10277 If .GenerateSQLTempTable('__TmpCursor')
10278 If .PopulateSQLTempTable('__TmpCursor')
10279 If !Empty(.cSQLTempTable)
10280 *- 1041196 07/01/09 YIK
10281 *- Added dtl_sln_qty
10282
10283 *--- TR 1051030 20-DEC-2010 HNISAR
10284 * Removed and d.sizebucket= t.sizebucket from join condition
10285 * as it will not be creating correct SLN lines when SLN Lines are for Range Styles
10286 * and they created a single Range Style detail Records i.e different size bucket for same range detail line
10287 *- 1052013 01/24/11 YIK
10288 *- Modified the SQL - populate orig_qty from history, total_qty from carton detail
10289 *- removed lcJoinString, modifeid dtl_sln_qty calculation, since GAP has no ppk_action populated
10290
10291 *--- 1045922 18-MAR-2010 HNISAR
10292
10293*-- lcSQLString= "Select t.fkey HdrPkey, t.pkey DtlPkey, d.po1_upc, d.po1_sku, " + ;
10294*-- " d.assort_qty, d.total_qty, d.ib_UOM, d.org_Price, d.PO1_Price, d.Assortment, " + ;
10295*-- " case when d.assort_qty > 0 then d.total_qty/d.assort_qty else 1 end as dtl_sln_qty " + ;
10296*-- " from " + .cSQLTempTable + " t join " + ;
10297*-- " zzeipohh h join zzeipohd d on d.fkey = h.pkey " + ;
10298*-- " on h.ord_num = t.ord_num and d.sizebucket= t.sizebucket " + ; && *--- TR 1051604 7-1-2011 VKK Restore size bucket jin which was removed by 1051030
10299*-- " and d.Line_Seq = t.Line_Seq " + ;
10300*-- "Where " + lcWhereString + ;
10301*-- "Order by d.fkey, d.pkey, t.fkey, t.pkey"
10302
10303 *=== 1045922 18-MAR-2010 HNISAR
10304 lcSQLString= "Select t.fkey HdrPkey, " + ; && #1
10305 " t.pkey DtlPkey, " + ; && #2
10306 " d.po1_upc, " + ; && #3
10307 " d.po1_sku, " + ; && #4
10308 " d.assort_qty, " + ; && #5
10309 " t.total_qty, " + ; && #6
10310 " d.ib_UOM, " + ; && #7
10311 " d.org_Price, " + ; && #8
10312 " d.PO1_Price, " + ; && #9
10313 " d.assortment, " + ; && #10
10314 " case when d.assort_qty > 0 then "+ ;
10315 " case when t.coord_code = 'GPB' THEN t.total_Qty " + ;
10316 " ELSE d.total_qty/d.assort_qty " + ;
10317 " End "+ ;
10318 " else 1 end as dtl_sln_qty " + ; && #11
10319 " , d.edipo4udf1 " + ; && #12
10320 " , d.edipo4udf2 " + ; && #13
10321 " , d.edipo4udf3 " + ; && #14
10322 " , t.template " + ; && #15
10323 " , d.ppk_action " + ; && #16
10324 " , d.total_qty as orig_qty " + ; && #17
10325 " , t.coord_code " + ; && #18
10326 " , d.sln01, d.line_seq " + ; &&--- TechRec 1056973 07-Dec-2011 jisingh ===
10327 " , d.sizebucket " + ; &&--- TechRec 1059747 27-Apr-2012 jisingh ===
10328 " from " + .cSQLTempTable + " t join " + ;
10329 " zzeipohh h join zzeipohd d on d.fkey = h.pkey " + ;
10330 " on h.ord_num = t.ord_num and d.sizebucket= t.sizebucket " + ;
10331 " and d.Line_Seq = t.Line_Seq " + ;
10332 " Where " + lcWhereString + ;
10333 " Order by d.fkey, d.pkey, t.fkey, t.pkey"
10334 *= 1052013
10335
10336 llRetVal = v_SQLExec(lcSQLString, "_SLNList")
10337 lnLineSeq = 0 &&--- TechRec 1056973 08-Dec-2011 jisingh ===
10338 lnSizeBucket = 0 &&--- TechRec 1059747 27-Apr-2012 jisingh ===
10339
10340 If llRetVal AND (RECCOUNT("_SLNList")>0)
10341 SELECT _SLNList
10342
10343 *-- TR 1041844 02-Nov-2010 SK Added assortment in INDEX
10344 *INDEX on hdrpkey+dtlpkey TAG hdrdtl
10345 *- 1052013 01/27/11 YIK
10346 *- Get rid of all ALLTRIMs. It causes asssortment 123@AAA to be equal to assortment 123
10347 *- INDEX on ALLTRIM(STR(hdrpkey))+allt(Assortment) TAG hdrdtl
10348 INDEX on STR(hdrpkey) + Assortment TAG hdrdtl
10349
10350 GO top
10351 DO WHILE NOT EOF()
10352 lnPrice = 0
10353 lnLastFkey = 0
10354 lntotal_Qty = 0
10355 *- TR 1041196 07/01/09 YIK
10356 lnDTL_SLN_Qty = 0
10357
10358 lnfkey = HdrPkey
10359 RELEASE aTempArray
10360
10361 *--- TechRec 1045922/ 1044701 28-Jun-2010 vkrishnamurthy/HNISAR ---
10362*!* Copy to array aTempArray WHILE HdrPkey = lnfkey
10363
10364 lcAssortment = Assortment
10365
10366 lnCurrentRecNo = IIF(!EOF(),RECNO(),0)
10367 *- 1052013 01/27/11 YIK
10368 *- Get rid of all ALLTRIMs. It causes asssortment 123@AAA to be equal to assortment 123
10369 *- CALCULATE SUM(total_qty) ,SUM(dtl_sln_qty) to ARRAY laTotal WHILE ALLTRIM(STR(HdrPkey)) = ALLTRIM(STR(lnfkey)) AND ALLTRIM(Assortment) = ALLTRIM(lcAssortment)
10370 *--- TechRec 1056973 08-Dec-2011 jisingh Added MIN(line_seq) ===
10371 *--- TechRec 1059747 27-Apr-2012 jisingh Added MIN(sizebucket) ===
10372 CALCULATE SUM(total_qty) ,SUM(dtl_sln_qty), MIN(line_seq), MIN(sizebucket) to ARRAY laTotal WHILE STR(HdrPkey) = STR(lnfkey) AND Assortment == lcAssortment
10373 lnTotalSLN_Qty = laTotal(1)
10374 lnPack_qty = laTotal(2)
10375 lnLineSeq = laTotal(3) &&--- TechRec 1056973 08-Dec-2011 jisingh ===
10376 lnSizeBucket = laTotal(4) &&--- TechRec 1059747 27-Apr-2012 jisingh ===
10377 *= 1054098
10378 IF lnCurrentRecNo > 0
10379 GOTO lnCurrentRecNo
10380 ENDIF
10381
10382 Copy to array aTempArray WHILE HdrPkey = lnfkey AND Assortment = lcAssortment
10383 *=== TechRec 1045922/ 1044701 28-Jun-2010 vkrishnamurthy/HNISAR ---
10384
10385
10386 lnTotalRow = ALEN(aTempArray,1)
10387 lnLastFkey = aTempArray[lnTotalRow,2]
10388 lnIntPkey = v_nextPkey(lcInterface, lnTotalRow) - lnTotalRow
10389 lcStyle_name = "" &&--- TR 1037555 NH, initialize style name with blank
10390 FOR lncount = 1 TO lnTotalRow
10391 lnIntPkey = lnIntPkey + 1
10392 IF SEEK(aTempArray[lncount,2], pcTransDetail, "Pkey")
10393 SELECT (pcTransDetail)
10394 SCATTER NAME loTranD MEMO
10395 loTranD.pkey = lnIntPkey
10396 lcStyle_name = IIF(EMPTY(lcStyle_name),loTranD.Style_name, lcStyle_name) &&--- TR 1037555 NH
10397 *- 1052584 08/30/11 YIK
10398 *- For MACYS - don't output SLN SKU
10399 IF ALLTRIM(aTempArray[lncount,15]) = 'MACYS'
10400 loTranD.sku = ''
10401 ENDIF
10402
10403 SELECT(pcFinalSLN)
10404 APPEND BLANK
10405 GATHER NAME loTranD MEMO
10406 replace itm_pkey WITH lnLastFkey ;
10407 IN (pcFinalSLN)
10408
10409 *--- 1045922, 28-JUN-2010 HNISAR
10410 *- 1054098 05/05/11 YIK
10411 IF lnTotalSLN_Qty > 0 && AND aTempArray[lncount,6] > 0
10412 *- replace pack_qty WITH aTempArray[lncount,5] * (aTempArray[lncount,6]/lnTotalSLN_Qty)
10413 Replace ppsize_qty with aTempArray[lncount,11], ;
10414 pack_qty WITH lnPack_qty
10415 ENDIF
10416 *=== 1045922 28-JUN-2010 HNISAR
10417 Replace Pack_total WITH pack_qty
10418 *= 1054098
10419
10420 *--- TechRec 1056973 07-Dec-2011 jisingh ---
10421 REPLACE sln01 WITH aTempArray[lncount,19]
10422 *=== TechRec 1056973 07-Dec-2011 jisingh ===
10423
10424 *- FH 1074465
10425 REPLACE sln_line_seq WITH aTempArray[lncount,20] && Line_seq from zzeipohd
10426 *- FH 1074465
10427
10428 lntotal_Qty = lntotal_Qty + aTempArray[lncount,6]
10429 *- 1041196 07/01/09 YIK
10430 *- Added lndtl_sln_qty
10431 lndtl_sln_qty = lndtl_sln_qty + aTempArray[lncount,11]
10432
10433 ENDIF
10434 IF lncount <> lnTotalRow
10435 DELETE IN (pcTransDetail)
10436 ELSE
10437 *--- TR 1037503 15-Dec-2008 Goutam
10438*!* lcSKU = ""
10439*!* lcUPC = ""
10440*!* DO CASE
10441*!* CASE EMPTY(aTempArray[lncount,4]) AND NOT EMPTY(aTempArray[lncount,3])
10442*!* lcUPC = ALLTRIM(aTempArray[lncount,10])
10443*!* CASE EMPTY(aTempArray[lncount,3]) AND NOT EMPTY(aTempArray[lncount,4])
10444*!* lcSKU = ALLTRIM(aTempArray[lncount,10])
10445*!* OTHERWISE
10446*!* lcUPC = ALLTRIM(aTempArray[lncount,10])
10447*!* lcSKU = ALLTRIM(aTempArray[lncount,10])
10448*!* ENDCASE
10449
10450 lcSKU = ALLTRIM(aTempArray[lncount,4])
10451 lcUPC = ALLTRIM(aTempArray[lncount,3])
10452 *--- TR 1037503 15-Dec-2008 Goutam
10453 *- TR 1041196 07/01/09 YIK
10454 *- Modified total_qty calculation to use lndtl_sln_qty
10455 *- instead of aTempArray[lncount,5] (assort_qty)
10456 *- 1052013 02/02/11 YIK
10457 *- GAP requires 856 detail qty to be in cases for 'Not full carton'
10458 *- for 'Full carton' it is always '1' and for GAP bulk - number of units.
10459 *- In any event it is total_qty/assort_qty.
10460 *- All other processes (810, 870) require qty in eaches.
10461*-- total_qty WITH IIF( ((ALLTRIM(aTempArray[lncount,15]) = "GAP") ; &&--- TechRec 1044701 27-Aug-2010 vkrishnamurthy ===
10462*-- OR EMPTY(aTempArray[lncount,16]) ) , ; &&--- TechRec 1044701 27-Aug-2010 vkrishnamurthy ===
10463*-- lntotal_Qty,; &&--- TechRec 1044701 27-Aug-2010 vkrishnamurthy ===
10464*-- IIF(lnDTL_SLN_Qty >0, CEILING(lntotal_Qty/lnDTL_SLN_Qty), 1)),
10465
10466*-- DO CASE
10467*-- CASE ALLTRIM(aTempArray[lncount,15]) = "GAP" ;
10468*-- AND ALLTRIM(pcEDITransaction) == 'OSH' ;
10469*-- AND ALLTRIM(aTempArray[lncount,18]) <> "GPB"
10470*-- lntotal_qty = CEILING(lntotal_Qty/lnDTL_SLN_Qty)
10471*-- OTHERWISE
10472*-- ENDCASE
10473 *- 07/01/11 YIK
10474 *- Modified the CASE to add non-GAP option to do the qty conversion.
10475 *- belongs(?) to TR 1052013, put in here in TR 1053523.
10476 *- Was used in TR 1053890... clear?
10477 DO CASE
10478 CASE ALLTRIM(aTempArray[lncount,15]) = "GAP"
10479 DO CASE
10480 CASE ALLTRIM(pcEDITransaction) == 'OSH' ;
10481 AND ALLTRIM(aTempArray[lncount,18]) <> "GPB"
10482 lntotal_qty = CEILING(lntotal_Qty/lnDTL_SLN_Qty)
10483 OTHERWISE
10484 ENDCASE
10485 *- TR 1060291 06/19/12 YIK
10486 *- For Charming Shoppes ppk_action = 'Q'/'M'
10487 CASE ALLTRIM(aTempArray[lncount,15]) = 'CHARMING SHOPPES 4030' AND NOT EMPTY(aTempArray[lncount,16]) &&for Charming ppk_action = 'Q'/'M'
10488 lntotal_qty = CEILING(lntotal_Qty/lnDTL_SLN_Qty)
10489 *=
10490
10491 *- TR 1083601 FH - taking out EMPTY(aTempArray[lncount,15]).
10492 CASE NOT EMPTY(aTempArray[lncount,16]) &&ppk_action
10493 lntotal_qty = CEILING(lntotal_Qty/lnDTL_SLN_Qty)
10494 OTHERWISE
10495 ENDCASE
10496
10497 *--- TR 1054438 27-05-2011 RKI ---*
10498 * If template ='GAP' bypass price replace
10499 IF ALLTRIM(aTempArray[lncount,15]) # "GAP"
10500 replace Price WITH aTempArray[lncount,9] ;
10501 IN (pcTransDetail)
10502 ENDIF
10503*!* replace Price WITH aTempArray[lncount,9], ;
10504*!* UPC WITH lcUPC, ;
10505*!* SKU WITH lcSKU, ;
10506*!* total_qty WITH lnTotal_qty, ;
10507*!* IB_UOM WITH aTempArray[lncount,7] , ;
10508*!* Style WITH "", ;
10509*!* Lbl_Code WITH "", ;
10510*!* Color_code WITH "", ;
10511*!* Dimension WITH "", ;
10512*!* size_desc WITH "", ;
10513*!* style_name WITH "", ;
10514*!* color_name WITH "" ;
10515*!* , style_name WITH lcStyle_name ; &&--- TR 1037555 NH
10516*!* , ppk_action WITH 'S' ; && TR 1052209 FH
10517*!* IN (pcTransDetail)
10518 replace UPC WITH lcUPC, ;
10519 SKU WITH lcSKU, ;
10520 total_qty WITH lnTotal_qty, ;
10521 IB_UOM WITH aTempArray[lncount,7] , ;
10522 Style WITH "", ;
10523 Lbl_Code WITH "", ;
10524 Color_code WITH "", ;
10525 Dimension WITH "", ;
10526 size_desc WITH "", ;
10527 style_name WITH "", ;
10528 color_name WITH "" ;
10529 , style_name WITH lcStyle_name ; &&--- TR 1037555 NH
10530 , ppk_action WITH 'S' ; && TR 1052209 FH
10531 , line_seq WITH lnLineSeq ; &&--- TechRec 1056973 08-Dec-2011 jisingh ===
10532 , sizebucket WITH lnSizeBucket ; &&--- TechRec 1059747 27-Apr-2012 jisingh ===
10533 IN (pcTransDetail)
10534 *=== TR 1054438 27-05-2011 RKI ===*
10535 ENDIF
10536 NEXT
10537 SELECT _SLNList
10538 ENDDO
10539 Endif
10540 Endif
10541 Endif
10542 Endif
10543
10544 .tableclose("_SLNList")
10545 .tableclose("__TmpCursor")
10546 .tableclose("__TempSLN")
10547 .cSQLTempTable = ""
10548 Endwith
10549 endif
10550
10551 Select(lnOldSelect)
10552 Return llRetVal
10553 Endproc
10554 *=== TR 1035491 6-Nov-2008 Goutam
10555
10556
10557 *--- TR 1036836 NSD 11/24/08
10558 * Bulk Insert Routines
10559 PROCEDURE GiveTempTableDefaults
10560 LPARAMETERS lcTmpTable
10561
10562 LOCAL lcSQL,lcField,lcDataType,lcFieldSize ,llRetVal,lcDefault
10563 llRetVal = .T.
10564
10565 =SQLCOLUMNS(g_nHandle,lcTmpTable,"FOXPRO","tcTmpFields")
10566 SELECT tcTmpFields
10567 SCAN
10568 lcField = ALLTRIM(tcTmpFields.field_name)
10569 lcDataType = UPPER(VFPToSQLDataType(tcTmpFields.field_type))
10570 lcFieldSize = This.GetDataFieldSize(tcTmpFields.field_type,;
10571 tcTmpFields.field_len,tcTmpFields.field_dec)
10572
10573 DO CASE
10574 CASE INLIST(lcDataType ,'C','M','CHAR','TEXT','BIT','VARCHAR','CLOB','VARG')
10575 lcDefault= SQLFormatChar("")
10576 CASE INLIST(lcDataType ,'I','N','MONEY','INT','INTEGER','BIGINT','SMALLINT','TINYINT','FLOAT','NUMERIC','REAL','SMALLMONEY')
10577 lcDefault= SQLFormatNum(0)
10578 CASE INLIST(lcDataType ,'T','D','DATETIME','SMALLDATETIME','TIMESTMP','DATE')
10579 lcDefault= SQLFormatTS(DATE(1900,1,1))
10580 ENDCASE
10581
10582
10583 lcSQL = ;
10584 "ALTER TABLE " + lcTmpTable + " ALTER COLUMN " + lcField + ;
10585 " " + lcDataType + " " + lcFieldSize + " NOT NULL "
10586 llRetVal = llRetVal AND v_sqlexec(lcSQL)
10587
10588 lcSQL = ;
10589 "ALTER TABLE " + lcTmpTable + " ADD CONSTRAINT " + lcField + ;
10590 "_" + getuniquefilename() + "_def DEFAULT "+lcDefault+" FOR " + lcField
10591 llRetVal = llRetVal AND v_sqlexec(lcSQL)
10592
10593 ENDSCAN
10594
10595
10596 RETURN llRetVal
10597
10598 ENDPROC
10599
10600 *--------------------------------------------------------------------------------------------
10601 PROCEDURE CloneTableWithDefaults
10602 LPARAMETERS tcTable, tcCloneTable, taExcludeAndReplaceDef, llExcludeMemo
10603
10604 LOCAL lcSql, llRetVal, lnOldSelect
10605 llRetVal = .t.
10606 lnOldSelect = SELECT()
10607 * --- TR 1038491 2/17/09 CM Added when 106 then ' [numeric] (' + ltrim(str(c.xPrec)) + ', ' + ltrim(str(c.xScale)) + ') DEFAULT ((0.0))'
10608 TEXT TO lcSql NOSHOW
10609 select ' [' + c.name + '] ' + case c.xtype when 56 then ' [int] DEFAULT ((0)) '
10610 when 175 then ' [char] (' + ltrim(str(c.length)) + ') DEFAULT ('''') '
10611 when 61 then ' [datetime] DEFAULT (''1900-01-01 00:00:00.000'')'
10612 when 108 then ' [numeric] (' + ltrim(str(c.xPrec)) + ', ' + ltrim(str(c.xScale)) + ') DEFAULT ((0.0))'
10613 when 106 then ' [numeric] (' + ltrim(str(c.xPrec)) + ', ' + ltrim(str(c.xScale)) + ') DEFAULT ((0.0))'
10614 when 35 then ' [text] default('''') '
10615 when 167 then ' [varchar] (' + ltrim(str(c.length)) + ') default ('''') '
10616 else '' end FieldDef
10617 ,c.name as fieldName, c.xtype, c.length, c.xPrec as Prec, c.xScale as Scale
10618 from tempdb..sysobjects t join tempdb..syscolumns c on t.id = c.id where t.name = 'ZZOORDRH'
10619 ENDTEXT
10620
10621 IF llExcludeMemo
10622 lcSQL = lcSQL + " AND c.xtype <> 35 "
10623 ENDIF
10624
10625 IF LEFT(tcTable,1) == "#" then
10626 lcSql = STRTRAN(lcSql,"ZZOORDRH", ALLTRIM(tcTable) + "%")
10627 ELSE
10628 lcSql = STRTRAN(lcSql,"ZZOORDRH", ALLTRIM(tcTable))
10629 lcSql = STRTRAN(lcSql, "tempdb..","")
10630 ENDIF
10631
10632 llRetVal = llRetVal and v_sqlExec(lcSql, 'TblSturcture')
10633 IF NOT llRetVal OR (USED('TblSturcture') AND RECCOUNT('TblSturcture') = 0)
10634 SELECT(lnOldSelect)
10635 RETURN llRetVal
10636 ENDIF
10637
10638 LOCAL lcAllFieldDef, lnIndex, lcFieldDef
10639 lcAllFieldDef = ""
10640 lcFieldDef = ""
10641 lnIndex = 0
10642 SELECT("TblSturcture")
10643 SCAN
10644 lcFieldDef = FieldDef
10645 FOR lnIndex = 1 TO ALEN(taExcludeAndReplaceDef,1)
10646 IF ALLTRIM(FieldName) = taExcludeAndReplaceDef[lnIndex,1]
10647 lcFieldDef = ""
10648 IF NOT EMPTY(taExcludeAndReplaceDef[lnIndex,2])
10649 lcFieldDef = taExcludeAndReplaceDef[lnIndex,2]
10650 ENDIF
10651 ENDIF
10652 ENDFOR
10653
10654 IF NOT empty(lcFieldDef)
10655 lcAllFieldDef = lcAllFieldDef + ALLTRIM(lcFieldDef) + ", "
10656 ENDIF
10657 ENDSCAN
10658 lcAllFieldDef = LEFT(lcAllFieldDef, LEN(lcAllFieldDef) - 2)
10659 lcSql = " CREATE TABLE [" + tcCloneTable + "]( " + lcAllFieldDef + " ) "
10660 llRetVal = llRetVal and v_sqlExec(lcSql)
10661 RETURN llRetVal
10662 ENDPROC
10663
10664
10665 * ---------------------------------------------------------------
10666 * This will create a pipe delimited file and then do a SQL bulk insert into a table.
10667 PROCEDURE BulkInsertFromCursor
10668 LPARAMETERS tcSource,tcTarget
10669
10670 WITH THIS
10671
10672 LOCAL llRetVal,lnSelect,lcSource,lcSQL,lcFile,lcDirectory
10673 llRetVal = .T.
10674 lnSelect = SELECT()
10675
10676 * --- TR 1027596 NSD 10/31/07
10677 * This is a lot cleaner to use the inbound directory since we already know we have modify acess.
10678 *lcDirectory = ADDBS(goEnv.sv("ALLOC_RESULTSAVE_BULKUNC",""))
10679 lcDirectory = This.GetEDIFlatFileDirectory("Inbound")
10680 lcDirectory = convertMapDrivePathToUnc(lcDirectory)
10681 * === TR 1027596 NSD 10/31/07
10682
10683 IF NOT DIRECTORY(lcDirectory)
10684 llRetVal = .F.
10685 .LogEntry("Could not locate Bulk Insert Save Location")
10686 ELSE
10687 lcFile = lcDirectory + GetUniqueFileName() + this.class + ".txt" &&*- 1060114 FH
10688
10689 IF EMPTY(tcSource)
10690 lcSource = ALIAS()
10691 ELSE
10692 lcSource = ALLTRIM(tcSource)
10693 ENDIF
10694
10695 IF NOT USED(lcSource)
10696 .LogEntry("Source Cursor is not found: " + lcSource)
10697 llRetVal = .F.
10698 ELSE
10699 SELECT (lcSource)
10700
10701 THIS.BulkInsert_CorrectDateFields(tcSource)
10702
10703 * Output File to Server
10704 .LogEntry("BULK_INSERT: Creating Delimited file " + lcFile)
10705 COPY TO (lcFile) TYPE DELIMITED WITH "" WITH CHARACTER "|"
10706
10707 IF NOT FILE(lcFile)
10708 llRetVal = .F.
10709 .LogEntry("BULK_INSERT: Failed to create delimited file. Consult Error log.")
10710 ELSE
10711 .LogEntry("BULK_INSERT: Successfully created delimited file")
10712 *- 1060114 FH - adds temp file path to array. The array is always full, we increment it's size only when we need to
10713 this.nCounter = this.nCounter + 1
10714 DIMENSION this.aBulkTables[this.nCounter]
10715 this.aBulkTables[this.nCounter] = lcFile
10716 *- 1060114 FH
10717 ENDIF
10718 *--- TR 1094295 07/13/16 ATHIRUNAVU
10719 lcSQLdateFormat=""
10720 lcSQLdateFormat=GetSqlCurrentDateFormat()
10721 *=== TR 1094295 07/13/16 ATHIRUNAVU
10722
10723 IF llRetVal
10724
10725 *-TR 1087774 FH - added support for different date formats
10726 lcSQL = ""
10727 lcDateFormat = getDateFormat(EDI_USER)
10728 DO case
10729 CASE INLIST(lcDateFormat, 'BRITISH','FRENCH','GERMAN','ITALIAN','DMY')
10730 lcSQL = " SET DATEFORMAT DMY "
10731 CASE INLIST(lcDateFormat, 'JAPAN','TAIWAN','ANSI','YMD')
10732 lcSQL = " SET DATEFORMAT YMD "
10733 OTHERWISE && otherwise leave lcSQL empty, assume it's MDY
10734 ENDCASE
10735 *-TR 1087774 FH -
10736
10737 * Call Bulk Insert
10738 .LogEntry("BULK_INSERT: Performing Bulk Insert")
10739 *--- TR 1073301 21-Nov-2013 Yuri/SMeenraja included CODEPAGE = 'ACP' to support extended characters
10740*!* lcSQL = "BULK INSERT " + tcTarget + ;
10741*!* " FROM '" + lcFile + "' WITH (FIELDTERMINATOR = '|') "
10742
10743 lcSQL = lcSQL + "BULK INSERT " + tcTarget + ; && FH 1087774 - added lcSQL before
10744 " FROM '" + lcFile + "' WITH (FIELDTERMINATOR = '|', CODEPAGE = 'ACP') "
10745
10746 llRetVal = v_sqlexec(lcSQL)
10747 ENDIF
10748 *--- TR 1094295 07/13/16 ATHIRUNAVU
10749 If !Empty(lcSQLdateFormat)
10750 lcSQL = " SET DATEFORMAT "+lcSQLdateFormat+" "
10751 llRetVal = llRetVal And v_sqlExec(lcSQL)
10752 Endif
10753 *=== TR 1094295 07/13/16 ATHIRUNAVU
10754
10755 * Clean up the file when completed. We may want to leave a debugging option
10756 IF FILE(lcFile)
10757 *DELETE FILE (lcFile)
10758 sysnoerror("DELETE FILE " + lcFile)
10759 ENDIF
10760 ENDIF
10761 ENDIF
10762
10763 ENDWITH
10764
10765 SELECT (lnSelect)
10766 RETURN llRetVal
10767
10768 ENDPROC
10769
10770 *-----------------------------------------------------
10771 PROCEDURE BulkInsert_CorrectDateFields
10772 LPARAMETERS tcCursor
10773
10774 LOCAL laFields[1],lnCount,lcField
10775 lnCount = AFIELDS(laFields,tcCursor)
10776
10777 FOR x = 1 TO lnCount
10778 IF INLIST(laFields[x,2],"T","D")
10779 lcField = laFields[x,1]
10780
10781 THIS.BulkInsert_CorrectDateFieldsOne(tcCursor,lcField)
10782
10783 ENDIF
10784 ENDFOR
10785
10786
10787 *----------------------------------------------------
10788 PROCEDURE BulkInsert_CorrectDateFieldsOne
10789 LPARAMETERS tcCursor,tcField
10790
10791 LOCAL lnMonth,lnYear,lnDay,ltCurVal
10792
10793 SELECT (tcCursor)
10794
10795
10796
10797 * --- TR 1037516 2/13/09 CM
10798 * Replace All on details may be endless, seek/scan added instead
10799 *lcMac = "replace ALL "+tcField+" WITH {1/1/1900} for ISNULL("+tcField+") OR EMPTY("+tcField+")"
10800
10801 *--- TR 1044101 17-DEC-2009 HNISAR
10802*!* INDEX ON tcField TAG datefiller
10803*!* SET ORDER TO datefiller
10804*!* IF SEEK("")
10805*!* SCAN WHILE tcField = ""
10806*!* lcMac = "replace "+tcField+" WITH {1/1/1900}"
10807*!* &lcMac
10808*!* ENDSCAN
10809*!* ENDIF
10810
10811
10812 * --- TR 1040686 Aug-04-09 BR
10813*!* INDEX ON CAST(&tcField as Char) TAG datefiller
10814*!* SET ORDER TO datefiller
10815*!* * --- TR 1040686 Aug-04-09 BR
10816*!*
10817*!* DO WHILE SEEK(" ")
10818*!* lcMac = "replace "+tcField+" WITH {1/1/1900}"
10819*!* &lcMac
10820*!* ENDDO
10821
10822 INDEX ON (&tcField) = {} TAG datefiller
10823 SET ORDER TO datefiller
10824
10825 lcMac = "update "+(tcCursor)+" set "+tcField+" = {1/1/1900} where "+tcField+" = {} OR ISNULL("+tcField+")"
10826 &lcMac
10827
10828 * --- TR 1040686 Aug-04-09 BR
10829 *=== TR 1044101 17-DEC-2009 HNISAR
10830
10831
10832 * === TR 1037516 2/13/09 CM
10833
10834 ENDPROC
10835 *=== TR 1036836 NSD 11/24/08
10836
10837 *-----------------------------------------------
10838 *--- TR 1039837 NSD
10839 PROCEDURE MergeFlatFiles
10840 LPARAMETERS tcSource,tcTargetFile
10841
10842 * 1- If tmp exists in Inbound, delete.
10843 * 2- retrieve list of files for inbound\batch
10844 * 3- for each dat file, ren to *.gen
10845 * 4- merge all dat files to tmp.
10846 * 5- merge tmp to target dat
10847 WITH THIS
10848
10849 LOCAL llRetVal,lnFCount,laDirectory[1],lcBatchDirectory,lcInboundDirectory,lcTempFile,x,lnHandle,lcFile, lcRename
10850 llRetVal = .T.
10851 lcInboundDirectory = ADDBS(THIS.GetEDIFlatFileDirectory("Inbound"))
10852 lcBatchDirectory = lcInboundDirectory + "Batch\"
10853 lcTempFile = FORCEEXT(lcInboundDirectory + tcTargetFile,"pri")
10854
10855 lnFCount = ADIR(laDirectory,lcBatchDirectory + tcSource)
10856 .Logentry(TRANSFORM(lnFcount) + " files found at " + lcBatchDirectory + tcSource)
10857 IF lnFCount > 0
10858 IF FILE(lcTempFile)
10859 DELETE FILE (lcTempFile)
10860 ENDIF
10861
10862 FOR x = 1 TO lnFCount
10863 .LogEntry("Processing File Batch File(" + TRANSFORM(x) + "): " + laDirectory[x,1])
10864 lcFile = lcBatchDirectory + laDirectory[x,1]
10865
10866 .CopyToFlatFileInBlock(lcFile,lcTempFile)
10867
10868
10869 lcRename = lcBatchDirectory + JUSTSTEM(lcFile) + "_" + TTOC(DATETIME(),1) + ".gen"
10870
10871 RENAME (lcFile) TO (lcRename)
10872
10873 ENDFOR
10874
10875 .CopyToFlatFileInBlock(lcTempFile,lcInboundDirectory+tcTargetFile)
10876
10877 ENDIF
10878
10879 ENDWITH
10880 ENDPROC
10881 *=== TR 1039837 NSD
10882
10883 *--- TR 1036614 10-Jun-2009 Goutam
10884 Procedure GetPOHistSLN
10885 Parameters pceTransHeader, pceTransDetail, pcItemSLN
10886
10887 Local llRetVal, lcSQLSelect
10888 llRetVal = .T.
10889 lnOldSelect = Select()
10890
10891 *- 06/18/12 1060291 YIK
10892 *- removed WHERE h.chk_hist = 'Y'
10893 Select s.itm_pkey, d.ord_num, d.line_seq, s.sizebucket ;
10894 From (pceTransDetail) d Join (pceTransHeader) h ;
10895 on h.Pkey = d.Fkey ;
10896 Join (pcItemSLN) s on d.pkey = s.itm_pkey ;
10897 Into Cursor __TmpCursor
10898
10899 With This
10900 If Recc("__TmpCursor")> 0
10901 .cSQLTempTable=""
10902 llRetVal= llRetVal And .GenerateSQLTempTable('__TmpCursor')
10903 llRetVal= llRetVal And .PopulateSQLTempTable('__TmpCursor') And !Empty(.cSQLTempTable)
10904
10905 *--- TechRec 1051779 07-Apr-2011 jisingh Added s.sln_qty ===
10906 *--- TechRec 1051779 07-Apr-2011 jisingh Added s.pkey ==
10907 *--- TechRec 1056973 30-Nov-2011 jisingh Added s.aux_sku ===
10908 *--- TechRec 1058970 02-Feb-2012 jisingh Added s.sln_sku as sku ===
10909 *- 1074465/1078006 FH add line_seq
10910
10911 lcSqlString= "Select t.itm_pkey, s.sln_upc as upc, s.SLN01, s.sln_qty, s.pkey, s.aux_sku, s.sln_sku as sku , s.line_seq " +;
10912 "From zzeipohs s, " + .cSQLTempTable + " t " +;
10913 "Where s.ord_num= t.ord_num and s.line_seq = t.line_seq and s.sizebucket= t.sizebucket"
10914 llRetVal= llRetVal And v_SQLexec(lcSqlString, "tcHistSLN")
10915 If Recc("tcHistSLN")> 0
10916 Select tcHistSLN
10917 Index On STR(itm_pkey) + upc Tag UPC_ITM
10918 *--- TechRec 1058970 02-Feb-2012 jisingh ---
10919 Index On STR(itm_pkey) + sku Tag SKU_ITM
10920 *=== TechRec 1058970 02-Feb-2012 jisingh ===
10921
10922
10923*- TR 1070393 FH - comment out
10924*!* llRetVal= llRetVal And .SetRelation("tcHistSLN", "UPC_ITM", pcItemSLN, "STR(itm_pkey) + upc")
10925*!* Select (pcItemSLN)
10926*!* *--- TechRec 1051779 07-Apr-2011 jisingh Added ppsize_qty WITH tcHistSLN.sln_qty ===
10927*!* *--- TechRec 1058970 02-Feb-2012 jisingh Added FOR !EMPTY(upc) ===
10928*!* *--- TR 1061829/1060291 09-Jul-12 SK Added condition !EOF("tcHistSLN") to avoid overwritting with unmatched SLN Details ===
10929*!* replace ALL SLN01 WITH tcHistSLN.SLN01, ppsize_qty WITH tcHistSLN.sln_qty, ;
10930*!* sfkey WITH tcHistSLN.pkey, aux_sku WITH IIF(EMPTY(aux_sku), tcHistSLN.aux_sku, aux_sku) ; &&--- TechRec 1056973 16-Nov-2011 jisingh ===
10931*!* FOR !EMPTY(upc) AND !EOF("tcHistSLN") IN (pcItemSLN)
10932
10933*!* *--- TechRec 1058970 02-Feb-2012 jisingh ---
10934*!* llRetVal= llRetVal And .SetRelation("tcHistSLN", "SKU_ITM", pcItemSLN, "STR(itm_pkey) + sku")
10935*!* Select (pcItemSLN)
10936*!*
10937*!* *-TR 1070393 FH - Adding Condtion EMPTY(UPC)
10938*!* *- We are getting scenarios where Same SKU are coming in in 850 for different sizebucket in SLN.
10939*!* *- So the relation on item_pkey + sku, will not suffice.
10940*!* *- We decided to add EMPTY(UPC), if we did the replace above for UPC then don't bother doing SKU replace
10941*!* *--- TR 1061829/1060291 09-Jul-12 SK Added condition !EOF("tcHistSLN") to avoid overwritting with unmatched SLN Details ===
10942*!* replace ALL SLN01 WITH tcHistSLN.SLN01, ppsize_qty WITH tcHistSLN.sln_qty, ;
10943*!* sfkey WITH tcHistSLN.pkey, aux_sku WITH IIF(EMPTY(aux_sku), tcHistSLN.aux_sku, aux_sku) ; &&--- TechRec 1056973 16-Nov-2011 jisingh ===
10944*!* FOR !EMPTY(sku) AND !EOF("tcHistSLN") AND EMPTY(UPC) IN (pcItemSLN)
10945 *=== TechRec 1058970 02-Feb-2012 jisingh ===
10946
10947 Select (pcItemSLN)
10948 SCAN
10949 *- TR 1082741 FH - added check for not empty UPC
10950 IF (!EMPTY(UPC)) AND SEEK(STR(itm_pkey) + upc, "tcHistSLN", "UPC_ITM")
10951 replace SLN01 WITH tcHistSLN.SLN01, ppsize_qty WITH tcHistSLN.sln_qty, ;
10952 sfkey WITH tcHistSLN.pkey, aux_sku WITH IIF(EMPTY(aux_sku), tcHistSLN.aux_sku, aux_sku), ; &&--- TechRec 1056973 16-Nov-2011 jisingh ===
10953 sln_line_seq with tcHistSLN.line_seq && 1074465/1078006 FH add line_seq
10954 ELSE
10955 IF SEEK(STR(itm_pkey) + sku, "tcHistSLN","SKU_ITM")
10956 replace SLN01 WITH tcHistSLN.SLN01, ppsize_qty WITH tcHistSLN.sln_qty, ;
10957 sfkey WITH tcHistSLN.pkey, aux_sku WITH IIF(EMPTY(aux_sku), tcHistSLN.aux_sku, aux_sku), ; &&--- TechRec 1056973 16-Nov-2011 jisingh ===
10958 sln_line_seq with tcHistSLN.line_seq && 1074465/1078006 FH add line_seq
10959 endif
10960 ENDIF
10961 ENDSCAN
10962*TR 1070393 FH - comment
10963 Endif
10964 *Set Relation To TR 1070393 FH
10965 Endif
10966 .TableClose("tcHistSLN")
10967 .TableClose("__TmpCursor")
10968 Endwith
10969 Select(lnOldSelect)
10970 Return llRetVal
10971 ENDPROC
10972 *=== TR 1036614 10-Jun-2009 Goutam
10973
10974*========================================================
10975*--- TechRec 1044701 10-Feb-2010 vkrishnamurthy ---
10976 Procedure GetContactEmail
10977 Lparameters tnPkey, tcTable
10978 Local lcRetVal, lnOldSelect
10979 lcRetVal = ""
10980 lnOldSelect = Select()
10981 If vl_commu(tcTable,'','TcCommu','e-mail',tnPkey)
10982 Select TcCommu
10983 lcRetVal = Alltrim(accessnum)
10984 Use In TcCommu
10985 Endif
10986 Select (lnOldSelect)
10987 Return lcRetVal
10988 Endproc
10989*=== TechRec 1044701 10-Feb-2010 vkrishnamurthy ===
10990*========================================================
10991
10992
10993 * --- TR 1044514 3/25/10 CM/NSD
10994 *-------------------------------------------------
10995 * For orders with a template = AAFES 4010 and the ord source matches vmi_ord_source on control, then stamp upc with aux_sku for details and SLNs.
10996 * In this case, Aux SKU is required
10997 PROCEDURE ValidateAuxSKUForVMIInvoices
10998 LPARAMETERS pcHeader, pcDetail, pceoinCR, plVMI
10999
11000 LOCAL llRetVal,lnSelect,lcORder
11001 llRetVal = .T.
11002 lnSelect = SELECT()
11003
11004 WITH THIS
11005
11006 SELECT d.pkey FROM (pcDetail) d JOIN (pcHeader) h ON h.pkey = d.fkey ;
11007 JOIN (pceoinCR) c ;
11008 ON h.customer = c.customer AND h.division = c.division ;
11009 WHERE NOT EMPTY(c.vmi_ord_source) AND c.template = 'AAFES 4010' AND h.source = c.vmi_ord_source ;
11010 AND h.errs_flg_h <> 'Y' AND d.errs_flg_d <> 'Y' ;
11011 INTO CURSOR tcVMIDtls READWRITE
11012
11013 SELECT tcVMIDtls
11014 SCAN
11015 IF SEEK(tcVMIDtls.pkey,pcDetail,"pkey")
11016 SELECT (pcDetail)
11017 IF EMPTY(aux_sku)
11018 Replace Errs_Flg_D With "Y", ;
11019 Errs_Msg_D With Errs_Msg_D + "Aux SKU Required for AAFES 4010 VMI Orders." + CRLF IN (pcDetail)
11020 ELSE
11021 replace upc WITH LEFT(aux_sku,12) IN (pcDetail)
11022 plVMI = .T.
11023 ENDIF
11024 ENDIF
11025 ENDSCAN
11026
11027 ENDWITH
11028
11029 SELECT (lnSelect)
11030 RETURN llRetVal
11031
11032 ENDPROC
11033
11034 PROCEDURE GroupAndSumDataForVMI
11035 LPARAMETERS pcSource, pcHeader, pcControl, pcFinalSLN
11036
11037 * --- TR 1049226 9/1/10 CM --- Added lcFkey
11038 LOCAL lcUpc, lcFkey, lnOldSelect, llHaveSLN
11039 STORE "" TO lcUpc, lcFkey
11040 lnOldSelect = SELECT()
11041 llHaveSLN = RECCOUNT(pcFinalSLN) > 0
11042
11043 * --- For VMI orders if we have SLNs and the same sln upc exists
11044 * across multiple prepacks or range styles then consolidate those
11045 * particular slns.
11046 * --- TR 1049226 9/1/10 CM --- Added p.itm_pkey to Group By
11047 IF llHaveSLN
11048 SELECT p.*, ;
11049 SUM(VAL(ppsize_qty)) as Slnppsize_qty, ;
11050 SUM(VAL(pack_total)) as Slnpack_total, ;
11051 SUM(VAL(pack_qty)) as Slnpack_qty, ;
11052 COUNT(*) as slndups ;
11053 FROM (pcFinalSLN) p ;
11054 JOIN (pcSource) d ;
11055 ON p.itm_pkey = d.pkey ;
11056 JOIN (pcHeader) h ;
11057 ON d.fkey = h.pkey ;
11058 JOIN (pcControl) c ;
11059 ON h.division = c.division ;
11060 AND h.customer = c.customer ;
11061 WHERE NOT EMPTY(p.upc) ;
11062 AND NOT EMPTY(c.vmi_ord_source) ;
11063 AND h.source = c.vmi_ord_source ;
11064 AND c.template = 'AAFES 4010' ;
11065 GROUP BY p.upc, p.itm_pkey ;
11066 HAVING COUNT(*) > 1 ;
11067 INTO CURSOR __SlnDups
11068
11069 SELECT __SlnDups
11070 SCAN
11071 lcUpc = upc
11072 lcFkey = itm_pkey
11073 SCATTER MEMVAR MEMO
11074 m.ppsize_qty = STR(m.Slnppsize_qty)
11075 m.pack_total = STR(m.Slnpack_total)
11076 m.pack_qty = STR(m.Slnpack_qty)
11077
11078 * --- TR 1049226 9/1/10 CM
11079 *DELETE FROM (pcFinalSLN) WHERE upc == lcUPC
11080 DELETE FROM (pcFinalSLN) WHERE upc == lcUPC AND itm_pkey = lcFkey
11081 * === TR 1049226 9/1/10 CM
11082
11083 INSERT INTO (pcFinalSLN) FROM MEMVAR
11084 ENDSCAN
11085 ENDIF
11086
11087 * --- Detail consolidation for VMI based on contract upc
11088 * --- TR 1049226 9/1/10 CM --- Added s.fkey to Group By
11089 SELECT s.* , ;
11090 SUM(VAL(total_qty)) as Caltotal_qty, ;
11091 SUM(VAL(OpenPickQty)) as CalOpenPickQty, ;
11092 SUM(VAL(CancelQty)) as CalCancelQty, ;
11093 SUM(VAL(InvoiceQty)) as CalInvoiceQty, ;
11094 COUNT(*) as tcDups ;
11095 FROM (pcSource) s ;
11096 JOIN (pcHeader) h ;
11097 ON s.fkey = h.pkey ;
11098 JOIN (pcControl) c ;
11099 ON h.division = c.division ;
11100 AND h.customer = c.customer ;
11101 WHERE NOT EMPTY(upc) ;
11102 AND NOT EMPTY(c.vmi_ord_source) ;
11103 AND h.source = c.vmi_ord_source ;
11104 AND c.template = 'AAFES 4010' ;
11105 GROUP BY s.upc, s.fkey ;
11106 HAVING COUNT(*) > 1 ;
11107 INTO CURSOR tcRollUp
11108
11109 SELECT s.pkey FROM (pcSource) s ;
11110 JOIN tcRollup r ;
11111 ON s.upc = r.upc ;
11112 INTO CURSOR __SlnKeys
11113
11114 SELECT tcRollUp
11115 SCAN
11116 lcUpc = upc
11117 lcFkey = fkey && TR 1049226 9/1/10 CM
11118 SCATTER MEMVAR MEMO
11119 m.total_qty = STR(m.Caltotal_qty)
11120 m.OpenPickQty = STR(m.CalOpenPickQty)
11121 m.CancelQty = STR(m.CalCancelQty)
11122 m.InvoiceQty = STR(m.CalInvoiceQty)
11123 m.size_desc = ""
11124
11125 * --- TR 1049226 9/1/10 CM
11126 *DELETE FROM (pcSource) WHERE upc == lcUPC
11127 DELETE FROM (pcSource) WHERE upc == lcUPC AND fkey = lcFkey
11128 * === TR 1049226 9/1/10 CM
11129
11130 INSERT INTO (pcSource) FROM MEMVAR
11131 ENDSCAN
11132
11133 * --- Already deleted details earlier on based on VMI
11134 * rollup, so we need to synch the remaining SLNs to their
11135 * matching contract upcs.
11136 UPDATE s ;
11137 SET s.itm_pkey = d.pkey ;
11138 FROM (pcFinalSLN) s ;
11139 JOIN (pcSource) d ;
11140 on s.itm_pkey <> d.pkey ;
11141 JOIN __SlnKeys p ;
11142 on d.pkey = p.pkey
11143
11144 IF USED("tcRollUp")
11145 USE IN tcRollUp
11146 ENDIF
11147
11148 IF USED("__SlnKeys")
11149 USE IN __SlnKeys
11150 ENDIF
11151
11152 IF USED("__SlnDups")
11153 USE IN __SlnDups
11154 ENDIF
11155
11156 SELECT (lnOldSelect)
11157
11158 ENDPROC
11159 *=================================================
11160 * === TR 1044514 3/25/10 CM/NSD
11161
11162 *--- TechRec 1051443 23-May-2011 jisingh ---
11163 PROCEDURE PopulateDataWhse
11164 LPARAMETERS pceTransHeader, pceTransDetail, pceControl, pcWhseHeader, pcWhseDetail
11165 LOCAL llRetVal, lnSelect, lcSqlString
11166
11167 llRetVal = true
11168 lnSelect = SELECT()
11169
11170 WITH This
11171 SELECT DISTINCT h.ord_num FROM (pceTransHeader) h ;
11172 JOIN (pceControl) c ON h.division = c.division AND h.customer = c.customer ;
11173 WHERE c.data_whse = 'Y' INTO CURSOR __TmpCursor
11174
11175 IF USED("__TmpCursor") AND RECCOUNT("__TmpCursor") > 0
11176 .cSQLTempTable = ""
11177 IF .GenerateSQLTempTable('__TmpCursor') AND ;
11178 .PopulateSQLTempTable('__TmpCursor') AND !EMPTY(.cSQLTempTable)
11179
11180 lcSqlString = "SELECT s.pkey, s.ord_num, s.line_seq, s.sizebucket, s.segment, s.element, s.qualifier, s.value " + ;
11181 "FROM zzedatawhse s, " + .cSQLTempTable + " t " + ;
11182 "WHERE s.ord_num = t.ord_num AND s.table_name = 'ZZOORDRH'"
11183
11184 llRetVal = llRetVal AND v_SQLExec(lcSqlString, "tcWhseHeader")
11185
11186 .MakeCursorWritable("tcWhseHeader", pcWhseHeader)
11187 ENDIF
11188 ENDIF
11189
11190
11191 *- 1060291 03/23/2012 YIK
11192 *- Added h.template, d.slntodtl
11193 SELECT DISTINCT h.ord_num, d.line_seq, d.sizebucket, d.pkey, h.template, d.slntodtl FROM (pceTransHeader) h ;
11194 JOIN (pceTransDetail) d ON h.pkey = d.fkey ;
11195 JOIN (pceControl) c ON h.division = c.division AND h.customer = c.customer ;
11196 WHERE c.data_whse = 'Y' INTO CURSOR __TmpCursor
11197
11198 IF USED("__TmpCursor") AND RECCOUNT("__TmpCursor") > 0
11199 .cSQLTempTable = ""
11200 IF .GenerateSQLTempTable('__TmpCursor') AND ;
11201 .PopulateSQLTempTable('__TmpCursor') AND !EMPTY(.cSQLTempTable)
11202
11203 *- 1060291 03/23/12 YIK
11204 *- Added IF for the 810 process to check ZZEIPOHS and SLNtoDTL,
11205 *- as it has to work for 810 process for Charming Shoppe or if SLNtoDTL = 'I' .
11206 *- TR 1064630 FH - added s.table_name = 'ZZOORDRD'
11207 IF UPPER(pceTransHeader) = 'TCEOINTH'
11208 lcSqlString = "SELECT s.pkey, s.ord_num, s.line_seq, s.sizebucket, s.segment, " + ;
11209 " s.element, s.qualifier, s.value, t.pkey AS fkey " + ;
11210 "FROM zzedatawhse s, " + .cSQLTempTable + " t " + ;
11211 "WHERE s.ord_num = t.ord_num AND s.line_seq = t.line_seq " + ;
11212 " AND s.sizebucket = t.sizebucket " + ;
11213 " AND ((s.table_name = 'ZZEIPOHS' AND (t.template = 'CHARMING SHOPPES 4030' OR t.slntodtl = 'I')) " + ;
11214 " OR (s.table_name = 'ZZOORDRD') )"
11215 ELSE
11216 lcSqlString = "SELECT s.pkey, s.ord_num, s.line_seq, s.sizebucket, s.segment, " + ;
11217 " s.element, s.qualifier, s.value, t.pkey AS fkey " + ;
11218 "FROM zzedatawhse s, " + .cSQLTempTable + " t " + ;
11219 "WHERE s.ord_num = t.ord_num AND s.line_seq = t.line_seq " + ;
11220 " AND s.sizebucket = t.sizebucket " + ;
11221 " AND s.table_name = 'ZZOORDRD' "
11222 ENDIF
11223 *= 1060291
11224
11225 llRetVal = llRetVal AND v_SQLExec(lcSqlString, "tcWhseDetail")
11226
11227 .MakeCursorWritable("tcWhseDetail", pcWhseDetail)
11228 ENDIF
11229 ENDIF
11230 .TableClose("tcWhseHeader")
11231 .TableClose("tcWhseDetail")
11232 .TableClose("__TmpCursor")
11233 ENDWITH
11234
11235 SELECT (lnSelect)
11236 RETURN llRetVal
11237 ENDFUNC
11238
11239 *=================================================
11240
11241 FUNCTION BuildDWhseString
11242 LPARAMETERS tcDetail, tcFinalEDID, tcEDIDIndexTag, tcFlatFileString, tlDelimited, tcDelimiter
11243 LOCAL llRetVal, lnSelect, lnDetPkey
11244
11245 llRetVal = true
11246 lnSelect = SELECT()
11247
11248 WITH This
11249 lnDetPkey = &tcDetail..pkey
11250 SELECT (tcFinalEDID)
11251 IF SEEK(lnDetPkey, tcFinalEDID, tcEDIDIndexTag)
11252 SCAN WHILE fkey = lnDetPkey
11253 tcFlatFileString = tcFlatFileString + "EDID" + tcDelimiter + .ConvertRecordToText(tcFinalEDID, tlDelimited, tcDelimiter)
11254 ENDSCAN
11255 ENDIF
11256 ENDWITH
11257
11258 SELECT (lnSelect)
11259 RETURN llRetVal
11260 ENDFUNC
11261 *=== TechRec 1051443 23-May-2011 jisingh ===
11262
11263
11264 *--- TR 1056928 10-Nov-2011 Partha ---
11265 * .GetPpkLineInfo()
11266
11267 PROCEDURE GetPpkLineInfo
11268 LPARAMETERS pcPpkSource
11269 LOCAL llRetVal, lnSelect, lcSqlString, lcOldSQLTempTable
11270
11271 llRetVal = true
11272 lnSelect = SELECT()
11273
11274 WITH This
11275 * distinct sku is from ppk componet but third_party_item value is still from main sku
11276 SELECT DISTINCT h.division,h.style,h.color_code,h.lbl_code,h.dimension ;
11277 INTO CURSOR __TmpCursor ;
11278 FROM (pcPpkSource) h
11279
11280 IF USED("__TmpCursor") AND RECCOUNT("__TmpCursor") > 0
11281 lcOldSQLTempTable = .cSQLTempTable
11282 .cSQLTempTable = ""
11283 IF .GenerateSQLTempTable('__TmpCursor') AND ;
11284 .PopulateSQLTempTable('__TmpCursor') AND !EMPTY(.cSQLTempTable)
11285
11286 lcSqlString = "SELECT t.*, " + ;
11287 " CASE WHEN d.third_party_item > ' ' THEN d.third_party_item " +;
11288 " WHEN h.third_party_item > '' THEN h.third_party_item ELSE d.style END ppk_3rdPartyitem " + ;
11289 " FROM zzxscolr d " + ;
11290 " JOIN zzxstylr h " +;
11291 " ON h.pkey = d.fkey " + ;
11292 " JOIN " + .cSQLTempTable + " t " + ;
11293 " ON d.division = t.division " + ;
11294 " AND d.style = t.style " + ;
11295 " AND d.color_code = t.color_code " + ;
11296 " AND d.lbl_code = t.lbl_code " + ;
11297 " AND d.dimension = t.dimension "
11298 llRetVal = llRetVal AND v_SQLExec(lcSqlString, "tcPpkLineinfo")
11299
11300 IF USED("tcPpkLineinfo") AND RECCOUNT("tcPpkLineinfo") >0
11301 UPDATE h ;
11302 SET h.ppk_3rdPartyitem = ppk.ppk_3rdPartyitem ;
11303 FROM (pcPpkSource) h ;
11304 JOIN tcPpkLineinfo ppk ;
11305 ON h.division = PPK.division ;
11306 AND h.style = ppk.style ;
11307 AND h.color_code = ppk.color_code ;
11308 AND h.lbl_code = ppk.lbl_code ;
11309 AND h.dimension = ppk.dimension
11310 ENDIF
11311
11312 lcSQLString = " DROP TABLE " + .cSQLTempTable
11313 llRetVal = llRetVal AND v_SQLExec(lcSqlString)
11314 .cSQLTempTable = lcOldSQLTempTable
11315
11316 ENDIF
11317 ENDIF
11318
11319
11320 .TableClose("tcPpkLineinfo")
11321 .TableClose("__TmpCursor")
11322 ENDWITH
11323
11324 SELECT (lnSelect)
11325 RETURN llRetVal
11326 ENDFUNC
11327
11328 *=================================================
11329
11330 *=== TR 1056928 10-Nov-2011 Partha ===
11331
11332 *--- TechRec 1056973 10-Nov-2011 jisingh ---
11333 FUNCTION PopulateDataWhseSLN
11334 LPARAMETERS pceTransHeader, pceTransDetail, pceControl, pcItemSLN, pcWhseSLN
11335 LOCAL llRetVal, lnSelect, lcSqlString, lcItemSLN
11336
11337 llRetVal = true
11338 lnSelect = SELECT()
11339 lcItemSLN = ""
11340
11341 WITH This
11342 IF USED(pcItemSLN) AND RECCOUNT(pcItemSLN) > 0
11343 .cSQLTempTable = ""
11344 IF .GenerateSQLTempTable(pcItemSLN) AND .PopulateSQLTempTable(pcItemSLN) AND !EMPTY(.cSQLTempTable)
11345 lcItemSLN = .cSQLTempTable
11346 ENDIF
11347 ENDIF
11348
11349 *--- TechRec 1058326 12-Dec-2011 jisingh ---
11350*!* SELECT DISTINCT h.ord_num, d.line_seq, d.sizebucket, d.pkey ;
11351*!* FROM (pceTransHeader) h ;
11352*!* JOIN (pceTransDetail) d ON h.pkey = d.fkey ;
11353*!* JOIN (pceControl) c ON h.division = c.division AND h.customer = c.customer ;
11354*!* WHERE c.data_whse = 'Y' INTO CURSOR __TmpCursor
11355
11356 SELECT DISTINCT h.ord_num, d.assortment, d1.line_seq, d.po1_line, d.sizebucket, d.pkey, d.fkey ;
11357 FROM (pceTransHeader) h ;
11358 JOIN (pceTransDetail) d ON h.pkey = d.fkey ;
11359 JOIN (SELECT ord_num, assortment, po1_line, MIN(line_seq) AS line_seq ;
11360 FROM (pceTransDetail) GROUP BY ord_num, assortment, po1_line)d1 ;
11361 ON d1.ord_num = d.ord_num AND d1.assortment = d.assortment AND d1.po1_line = d.po1_line ;
11362 JOIN (pceControl) c ON h.division = c.division AND h.customer = c.customer ;
11363 WHERE c.data_whse = 'Y' INTO CURSOR __TmpCursor
11364 *=== TechRec 1058326 12-Dec-2011 jisingh ===
11365
11366 IF !EMPTY(lcItemSLN) AND USED("__TmpCursor") AND RECCOUNT("__TmpCursor") > 0
11367 .cSQLTempTable = ""
11368 IF .GenerateSQLTempTable('__TmpCursor') AND .PopulateSQLTempTable('__TmpCursor') AND !EMPTY(.cSQLTempTable)
11369
11370 lcSqlString = "SELECT s.itm_pkey AS pkey, s.sfkey, s.aux_sku, t.ord_num, t.line_seq, s.sizebucket ,s.sln01 , s.sln_line_seq " + ; &&FH 1074465 sln01,sln_line_seq
11371 "FROM " + lcItemSLN + " s, " + .cSQLTempTable + " t " + ;
11372 "WHERE s.itm_pkey = t.pkey "
11373
11374 llRetVal = llRetVal AND v_SQLExec(lcSqlString, "__TmpCursor")
11375
11376 IF llRetVal AND USED("__TmpCursor") AND RECCOUNT("__TmpCursor") > 0
11377 .cSQLTempTable = ""
11378 IF .GenerateSQLTempTable("__TmpCursor") AND .PopulateSQLTempTable("__TmpCursor") AND !EMPTY(.cSQLTempTable)
11379
11380*- FH 1074465
11381*!* lcSqlString = "SELECT s.pkey, s.ord_num, s.line_seq, s.sln_line, s.sizebucket, s.segment, " + ;
11382*!* " s.element, s.qualifier, s.value, MIN(t.aux_sku) AS aux_sku, t.pkey AS fkey " + ;
11383*!* "FROM zzedatawhse s, " + .cSQLTempTable + " t " + ;
11384*!* "WHERE s.ord_num = t.ord_num " + ;
11385*!* " AND s.line_seq = t.line_seq " + ;
11386*!* " AND s.sizebucket = t.sizebucket " + ;
11387*!* " AND s.table_name = 'ZZEIPOHS' " + ;
11388*!* " GROUP BY s.pkey, s.ord_num, s.line_seq, s.sln_line, s.sizebucket, s.segment, " + ;
11389*!* " s.element, s.qualifier, s.value, t.pkey "
11390 lcSqlString = "SELECT s.pkey, s.ord_num, s.line_seq, s.sln_line, s.sizebucket, s.segment, " + ;
11391 " s.element, s.qualifier, s.value, MIN(t.aux_sku) AS aux_sku, t.pkey AS fkey " + ;
11392 "FROM zzedatawhse s, " + .cSQLTempTable + " t " + ;
11393 "WHERE s.ord_num = t.ord_num " + ;
11394 " AND s.sln_line = t.sln01" + ;
11395 " AND s.line_seq = t.sln_line_seq " + ;
11396 " AND s.sizebucket = t.sizebucket " + ;
11397 " AND s.table_name = 'ZZEIPOHS' " + ;
11398 " GROUP BY s.pkey, s.ord_num, s.line_seq, s.sln_line, s.sizebucket, s.segment, " + ;
11399 " s.element, s.qualifier, s.value, t.pkey "
11400*- FH 1074465
11401
11402 llRetVal = llRetVal AND v_SQLExec(lcSqlString, "tcWhse")
11403
11404 .MakeCursorWritable("tcWhse", pcWhseSLN)
11405 ENDIF
11406 ENDIF
11407 ENDIF
11408 * update sfkey with pkey in SLN
11409 REPLACE ALL sfkey WITH itm_pkey IN (pcItemSLN)
11410 ENDIF
11411 .TableClose("tcWhse")
11412 .TableClose("__TmpCursor")
11413 ENDWITH
11414
11415 SELECT (lnSelect)
11416 RETURN llRetVal
11417 ENDFUNC
11418
11419 *============================================================
11420
11421 FUNCTION BuildEDISString
11422 LPARAMETERS tcSLN, tcEDIS, tcEDISIndexTag, tcFlatFileString, tlDelimited, tcDelimiter
11423 LOCAL llRetVal, lnSelect, lcFKey
11424
11425 llRetVal = true
11426 lnSelect = SELECT()
11427 *- 1060291 03/23/12 YIK
11428 *- If DtltoSLN, there's no zzeipohs record, so there's no SLN01
11429 llDtltoSLN = EMPTY(EVALUATE(tcSLN + ".sln01"))
11430
11431 WITH This
11432
11433 lcFKey = EVALUATE(tcSLN + ".sfkey") + IIF(llDtltoSLN, '', EVALUATE(tcSLN + ".sln01"))
11434
11435 SELECT (tcEDIS)
11436 IF SEEK(lcFKey, tcEDIS, tcEDISIndexTag)
11437 IF llDtltoSLN
11438 SCAN WHILE fkey = lcFKey
11439 tcFlatFileString = tcFlatFileString + "EDIS" + tcDelimiter + .ConvertRecordToText(tcEDIS, tlDelimited, tcDelimiter)
11440 ENDSCAN
11441 ELSE
11442 SCAN WHILE fkey+sln_line = lcFKey
11443 tcFlatFileString = tcFlatFileString + "EDIS" + tcDelimiter + .ConvertRecordToText(tcEDIS, tlDelimited, tcDelimiter)
11444 ENDSCAN
11445 ENDIF
11446 ENDIF
11447 ENDWITH
11448 *= 1060291 03/23/12 YIK
11449
11450 SELECT (lnSelect)
11451 RETURN llRetVal
11452 ENDFUNC
11453 *=== TechRec 1056973 10-Nov-2011 jisingh ===
11454
11455 *- 1060114 FH
11456 Procedure BulkDelete
11457 LOCAL lnCount, lnX ,lcFile
11458
11459 IF VARTYPE(this.aBulkTables) <> "C" && sometimes aBulkTables doesn't get initialized so it's .F. we exit, dont need to do anything
11460 return
11461 endif
11462 *- lets log all the files before we delete
11463 *-
11464 FOR lnX = 1 TO This.nCounter
11465 lcFile = this.aBulkTables[lnX]
11466 .LogEntry("Files : " + lcFile)
11467 IF File(lcFile)
11468 .LogEntry("Bulk Deleting : " + lcFile)
11469 sysnoerror("DELETE FILE " + lcFile)
11470 Endif
11471 IF FILE(lcFile)
11472 .LogEntry("Failed to initial delete : " + lcFile)
11473
11474 lnCnt = 0
11475 DO WHILE File(lcFile) AND lnCnt < 5
11476 .LogEntry("Bulk Deleting in while : " + lcFile)
11477 sysnoerror("DELETE FILE " + lcFile)
11478 INKEY(1) && wait, we can change, this right now it's 1 seconds * 5 so 5 secs
11479 lnCnt = lnCnt + 1
11480 ENDDO
11481 IF FILE(lcFile)
11482 .LogEntry("Failed to delete : " + lcFile)
11483 ENDIF
11484 endif
11485 ENDFOR
11486
11487 *reset
11488 DIMENSION This.aBulkTables[1]
11489 this.aBulkTables = .F.
11490 this.nCounter = 0
11491
11492 ENDPROC
11493
11494 *-1060114 FH
11495
11496*--- TechRec 1066835 06-Mar-2013 YKaganovsky ---
11497*- Check if Remote Server Reference has a record for category EDI and
11498*- if Workflow ( see property .cWorkflowName, ex. '810 BC PROCESS') exists
11499FUNCTION CanRunWorkflow
11500LOCAL llRetVal, lnAnsiNull,lnAnsiWarning, lcSQL, lcWkfPath
11501
11502WITH THIS
11503
11504 *--- TechRec 1075287 16-May-2014 asharma/smeenraja ---
11505 .cCanRunWorkflowErrorMessage = ""
11506 *=== TechRec 1075287 16-May-2014 asharma/smeenraja ===
11507
11508 IF goEnv.sv("TIE_SETUP","N") = 'Y' AND GoEnv.SV("BC_EDI_VERSION") = "5.2"
11509 v_sqlexec("Select * From zzxsalgh WHERE category = 'EDI'","tcSecur")
11510
11511 IF RECCOUNT("tcSecur") > 0
11512
11513 .EDI_servername = "[" + ALLTRIM(tcSecur.servername) + "]"
11514 .EDI_dbname = ALLTRIM(tcSecur.dbname) && the same as .cEDIDB
11515
11516 lnAnsiNull = SQLGetSessionProperty('ANSI_NULLS')
11517 lnAnsiWarning = SQLGetSessionProperty('ANSI_WARNINGS')
11518
11519 SQLSetSessionProperty('ANSI_NULLS',1)
11520 SQLSetSessionProperty('ANSI_WARNINGS',1)
11521
11522
11523
11524*!* lcSQL = "Select COUNT(*) as cnt from <tie_server>.<tie_dbname>sp_wfcomp " + ;
11525*!* " where wfcompname = '" + .cWorkflowName + "'"
11526 lcWkfPath = This.GetEDIFlatFileDirectory("Outbound") + .cProcessID + 'bc.dat'
11527 *- Remove \\ between dataset and Outbound. We have '\\BCFILESVR\VG\VG40\Login\PDEV\\EDI\Outbound\810bc.dat'
11528 lcWkfPath = STRTRAN(lcWkfPath, "\\", "\", 2)
11529
11530 lcSQL = "Select COUNT(*) as cnt from <tie_server>.<tie_dbname>SP_WFCOMP wc " + ;
11531 " JOIN <tie_server>.<tie_dbname>SP_WFITEM wi ON wc.wfcompski = wi.parentski " + ;
11532 " JOIN <tie_server>.<tie_dbname>SP_WFPARAMVAL wp ON wp.wfitemski = wi.itemski " + ;
11533 " where wfcompname = '" + .cWorkflowName + "' AND wp.PARAMNAME = 'Source' " + ;
11534 " AND wp.paramval = '" + lcWkfPath + "'"
11535
11536
11537 lcSQL = STRTRAN(lcSQL, "<tie_dbname>", .EDI_dbname )
11538 lcSQL = STRTRAN(lcSQL, "<tie_server>", .EDI_servername)
11539
11540 v_Sqlexec(lcSQL,"__Wkf")
11541
11542 SQLSetSessionProperty('ANSI_NULLS',lnAnsiNull )
11543 SQLSetSessionProperty('ANSI_WARNINGS',lnAnsiWarning)
11544
11545 llRetVal = __Wkf.cnt > 0
11546 IF !llRetVal
11547 *--- TechRec 1075287 16-May-2014 asharma/smeenraja ---
11548*!* .oLog.LogEntry("Workflow " + .cWorkflowName + " is not found.")
11549 .cCanRunWorkflowErrorMessage = "Workflow " + .cWorkflowName + " is not found."
11550 .oLog.LogEntry(.cCanRunWorkflowErrorMessage)
11551 *=== TechRec 1075287 16-May-2014 asharma/smeenraja ===
11552 ENDIF
11553
11554 ELSE
11555 *--- TechRec 1075287 16-May-2014 asharma/smeenraja ---
11556*!* .oLog.LogEntry("Remote Server Reference is missing a record for category EDI.",.T.)
11557 .cCanRunWorkflowErrorMessage = "Remote Server Reference is missing a record for category EDI."
11558 .oLog.LogEntry(.cCanRunWorkflowErrorMessage,.T.)
11559 *=== TechRec 1075287 16-May-2014 asharma/smeenraja ===
11560 llRetVal = .F.
11561
11562 ENDIF
11563 ENDIF
11564Endwith
11565RETURN llRetVal
11566ENDFUNC
11567
11568PROCEDURE IsTieInstalled
11569 LOCAL llRetval,lnSelect,lcBuffer,lnRetVal,lcPath
11570 llRetVal = .T.
11571 lnSelect = SELECT()
11572
11573*--- TechRec 1075287 16-May-2014 asharma/smeenraja ---
11574*!* WITH THIS
11575*!* llRetVal = !EMPTY(GETENV("E_CONNECT_RUNTIME"))
11576*!* IF !llRetVal
11577*!* .oLog.LogEntry("There is no environment variable 'E_CONNECT_RUNTIME'. EDI Translator Framework is not installed on this workstation.",.T.)
11578*!* ELSE
11579*!* lcPath = GetEnv("E_CONNECT_HOME")
11580*!* llRetVal = !EMPTY(lcPath)
11581*!*
11582*!* IF !llRetVal
11583*!* .oLog.LogEntry("There is no environment variable 'E_CONNECT_HOME'. EDI Translator Framework is not installed on this workstation.",.T.)
11584*!* ELSE
11585*!* .oLog.LogEntry("Confirmed EDI Translator Framework Exists.")
11586*!* lcPath = ADDBS(lcPath)
11587*!* IF NOT DIRECTORY(lcPath )
11588*!* llRetVal = .F.
11589*!* .oLog.LogEntry("Could not locate EDI Bin Directory at: " + lcPath,.T.)
11590*!* ELSE
11591*!* lcPath = STRTRAN(lcPath,"\Bin\","\Script\",1,-1,1)
11592*!* IF NOT DIRECTORY(lcPath)
11593*!* llRetVal = .F.
11594*!* .oLog.LogEntry("Could not locate EDI Script Directory at: " + lcPath,.T.)
11595*!* ELSE
11596*!* IF NOT FILE(lcPath + "wflaunch.bat")
11597*!* llRetVal = .F.
11598*!* .oLog.LogEntry("Could not locate wflaunch at " + lcPath,.T.)
11599*!* ELSE
11600*!* .oLog.LogEntry("Located wflaunch at " + lcPath)
11601*!* *- Set up property .cScriptDirectory that contains path to
11602*!* *- the wflaunch.bat
11603*!* .cScriptDirectory = lcPath
11604*!* ENDIF
11605*!* ENDIF
11606*!* ENDIF
11607*!* ENDIF
11608*!* ENDIF
11609*!* ENDWITH
11610 WITH THIS
11611
11612 .cTieInstallErrorMessage = ""
11613
11614 llRetVal = !EMPTY(GETENV("E_CONNECT_RUNTIME"))
11615 IF !llRetVal
11616 .cTieInstallErrorMessage = "There is no environment variable 'E_CONNECT_RUNTIME'. EDI Translator Framework is not installed on this workstation."
11617 ELSE
11618 lcPath = GetEnv("E_CONNECT_HOME")
11619 llRetVal = !EMPTY(lcPath)
11620
11621 IF !llRetVal
11622 .cTieInstallErrorMessage = "There is no environment variable 'E_CONNECT_HOME'. EDI Translator Framework is not installed on this workstation."
11623 ELSE
11624 .oLog.LogEntry("Confirmed EDI Translator Framework Exists.")
11625 lcPath = ADDBS(lcPath)
11626 IF NOT DIRECTORY(lcPath )
11627 llRetVal = .F.
11628 .cTieInstallErrorMessage = "Could not locate EDI Bin Directory at: " + lcPath
11629 ELSE
11630 lcPath = STRTRAN(lcPath,"\Bin\","\Script\",1,-1,1)
11631 IF NOT DIRECTORY(lcPath)
11632 llRetVal = .F.
11633 .cTieInstallErrorMessage = "Could not locate EDI Script Directory at: " + lcPath
11634 ELSE
11635 IF NOT FILE(lcPath + "wflaunch.bat")
11636 llRetVal = .F.
11637 .cTieInstallErrorMessage = "Could not locate wflaunch at " + lcPath
11638 ELSE
11639 .oLog.LogEntry("Located wflaunch at " + lcPath)
11640 *- Set up property .cScriptDirectory that contains path to
11641 *- the wflaunch.bat
11642 .cScriptDirectory = lcPath
11643 ENDIF
11644 ENDIF
11645 ENDIF
11646 ENDIF
11647 ENDIF
11648
11649 IF LEN(ALLTRIM(.cTieInstallErrorMessage)) > 0
11650 .oLog.LogEntry(.cTieInstallErrorMessage,.t.)
11651 ENDIF
11652
11653 ENDWITH
11654*=== TechRec 1075287 16-May-2014 asharma/smeenraja ===
11655
11656 SELECT(lnSelect)
11657 RETURN llRetVal
11658
11659ENDPROC
11660
11661PROCEDURE RunWorkflow
11662LPARAMETERS tcWKFList
11663LOCAL lcFile, lcWkfFile, lcWkfName, lcScriptDirectory, lcEDI_dbname, lcResultFile, lnMaestroIDl, ;
11664 llRetVal, lcEDIPath
11665
11666llRetVal = .T.
11667
11668WITH This
11669
11670 lcEDIPath = .GetEDIFlatFileDirectory("Outbound")
11671 lcWkfFile = lcEDIPath + .cProcessID + 'bc.dat' && create 810bc.dat
11672
11673 SELECT (tcWKFList)
11674 .nWorkflowProc = RECCOUNT()
11675 .nWorkflowSuccess = 0
11676 SCAN
11677 lcResultFile = ' '
11678 lcMaestroFile = ' '
11679 lcFile = TempFlatfile
11680 IF !FILE(lcFile)
11681 .oLog.LogEntry("Could not locate file " + lcFile)
11682 LOOP
11683 ENDIF
11684 *- file size for logging
11685 lnFSize = SizeArray(adir(SizeArray,TempFlatfile)+1)
11686 .oLog.LogEntry("Launching Workflow for file " + lcFile)
11687 .oLog.LogEntry("File size is " + STR(lnFSize/1000) + "Kb")
11688 Copy File (lcFile) To (lcWkfFile)
11689 IF !FILE(lcWkfFile)
11690 .oLog.LogEntry("File " + lcWkfFile + " could not be created from file " + lcFile + ".")
11691 llRetVal = .F.
11692 ELSE
11693 .oLog.LogEntry("Successfully copied " + lcFile + " to " + lcWkfFile)
11694 Delete File (lcFile)
11695 .oLog.LogEntry("Processing workflow for Trading Partner: " + Customer + "with Vendor ID: " + vnd_id)
11696 llRetVal = .LaunchWorkFlow(@lcResultFile, @lcMaestroFile)
11697 llRetVal = llRetVal AND .RenFileDat(lcWkfFile,,"Outbound")
11698 llRetVal = llRetVal AND .ProcessResults(lcResultFile,lcMaestroFile)
11699 ENDIF
11700 SELECT (tcWKFList)
11701 IF !llRetVal
11702 REPLACE cr_auto_wkf WITH 'N' && these records will be inserted into __tcFlatFileList
11703 ENDIF
11704
11705 ENDSCAN
11706ENDWITH
11707
11708ENDPROC
11709
11710PROCEDURE LaunchWorkFlow
11711LPARAMETERS tcResultFile, tcMaestroFile
11712
11713
11714LOCAL lcDOSMacro, lcCurrentDir,llRetVal,lnSelect
11715
11716llRetVal = .T.
11717
11718lnSelect = SELECT()
11719WITH THIS
11720
11721 .oLog.LogEntry("Starting Workflow " + .cWorkflowName)
11722
11723 lcCurrentDir = sys(5) + CURDIR()
11724 tcResultFile = lcCurrentDir + "edi_wf_" + getUniqueFileName() + ".txt"
11725 tcMaestroFile = lcCurrentDir + "edi_ms_" + getUniqueFileName() + ".txt"
11726 *Change Directory
11727 CHDIR (.cScriptDirectory)
11728 lcDOSMacro = "wflaunch -c "+ Allt(tcSecur.evisionsrvins)+" 2010 -n " + .cWorkflowName + ;
11729 " -q F -r " + tcResultFile + " -m " + tcMaestroFile
11730
11731 *Run Main Workflow process
11732 lcDOSMacro = "Run " + .cScriptDirectory + lcDOSMacro
11733*- .LogEntry("Workflow Command: " + lcDosMacro)
11734 &lcDOSMacro
11735
11736 *Change Directory to BC
11737 CHDIR (lcCurrentDir)
11738ENDWITH
11739RETURN llRetVal
11740ENDPROC
11741
11742PROCEDURE ProcessResults
11743LPARAMETERS tcResultFile,tcMaestroFile
11744
11745LOCAL llRetval,lnSelect,lcResultString,lcMaestroID,lcSQL,lcWhere, lnProcSki
11746llRetVal = .T.
11747lnSelect = SELECT()
11748lnProcSki = 0
11749
11750WITH THIS
11751 LOCAL lnAnsiNull,lnAnsiWarning
11752 lnAnsiNull = SQLGetSessionProperty('ANSI_NULLS')
11753 lnAnsiWarning = SQLGetSessionProperty('ANSI_WARNINGS')
11754
11755 SQLSetSessionProperty('ANSI_NULLS',1)
11756 SQLSetSessionProperty('ANSI_WARNINGS',1)
11757
11758 IF NOT FILE(tcResultFile)
11759 llRetVal = .F.
11760 .oLog.LogEntry("Unable to find result file: " + tcResultFile,.T.)
11761 .oLog.LogEntry("Please make sure that eVision services are running.")
11762 ENDIF
11763
11764
11765 IF llRetVal
11766 lcResultString = ALLTRIM(CHRTRAN(FILETOSTR(tcResultFile ),CHR(0)+CHR(13)+CHR(10),""))
11767
11768 IF NOT FILE(tcMaestroFile)
11769 .oLog.LogEntry("Unable to find maestro ID file: " + tcMaestroFile)
11770 lcMaestroID = ""
11771 ELSE
11772 lcMaestroID = ALLTRIM(CHRTRAN(FILETOSTR(tcMaestroFile),CHR(0)+CHR(13)+CHR(10),""))
11773 ENDIF
11774
11775 IF EMPTY(lcMaestroID)
11776 lcWhere = " 1 = 2 "
11777 ELSE
11778 lcWhere = "d.taskuki = '" + .cWorkflowName + "' AND d.systempid = " + lcMaestroID + " AND d.parentski = 0 "
11779 ENDIF
11780
11781 lcSQL = "select procski"+;
11782 " , datetm"+;
11783 " , d.parentski"+;
11784 " , Taskuki"+;
11785 " , exitcode"+;
11786 " , errflag"+;
11787 " , wrnflag"+;
11788 " , procstate"+;
11789 " , stoptime"+;
11790 " , wfcompski"+;
11791 " , wfcompname"+;
11792 " , '0' as successval"+;
11793 " , '98' as warnval"+;
11794 " , 0 as childski"+;
11795 " , Replace(Replace(Replace(Replace(( "+;
11796 "select audtinf_type + ': ' + RTRIM(audtinf_message) + '^' "+;
11797 " from <tie_server>.<tie_dbname>sp_audtinf a "+;
11798 " where a.procski = d.procski FOR XML PATH('')), '
', ''), '>', '>'), '<', '<'), '&', '&') as audtinf_message "+;
11799 " from <tie_server>.<tie_dbname>sp_procinf d "+;
11800 " left join <tie_server>.<tie_dbname>sp_wfcomp comp "+;
11801 " on comp.wfcompname = d.taskuki "+;
11802 " where " + lcWhere + ;
11803 " union all "+;
11804 "select cp.procski"+;
11805 " , cp.datetm"+;
11806 " , cp.parentski"+;
11807 " , cp.Taskuki"+;
11808 " , cp.exitcode"+;
11809 " , cp.errflag"+;
11810 " , cp.wrnflag"+;
11811 " , cp.procstate"+;
11812 " , cp.stoptime"+;
11813 " , pc.wfcompski"+;
11814 " , pc.wfcompname"+;
11815 " , it.successval"+;
11816 " , it.warnval"+;
11817 " , it.childski"+;
11818 " , Replace(Replace(Replace(Replace(( "+;
11819 "select audtinf_type + ': ' + RTRIM(audtinf_message) + '^' "+;
11820 " from <tie_server>.<tie_dbname>sp_audtinf a "+;
11821 " where a.procski = cp.procski FOR XML PATH('')), '
', ''), '>', '>'), '<', '<'), '&', '&') as audtinf_message "+;
11822 " from <tie_server>.<tie_dbname>sp_procinf d"+;
11823 " join <tie_server>.<tie_dbname>SP_WFCOMP pc "+;
11824 " on pc.WFCompName = d.TaskUKI"+;
11825 " join <tie_server>.<tie_dbname>sp_ProcInf cp "+;
11826 " on cp.ParentSki = d.ProcSki"+;
11827 " join <tie_server>.<tie_dbname>SP_WFCOMP cc "+;
11828 " on cc.WFCompName = cp.TaskUKI"+;
11829 " join <tie_server>.<tie_dbname>SP_WFItem it "+;
11830 " on it.ParentSki = pc.WFCompSki "+;
11831 " and it.ChildSki = cc.WFCompSki "+;
11832 " where " + lcWhere + ;
11833 " order by 1, 2"
11834
11835
11836 lcSQL = STRTRAN(lcSQL,"<tie_dbname>", .EDI_dbname )
11837 lcSQL = STRTRAN(lcSQL,"<tie_server>", .EDI_servername)
11838
11839 llRetVal = llRetVal AND v_sqlexec(lcSQL,"tcGetAudit")
11840
11841 IF llRetVal
11842 IF EMPTY(lcMaestroID) OR RECCOUNT("tcGetAudit") = 0
11843 * Work flow could not have passed if I did not find a record in the procInf
11844 llRetVal = .F.
11845 lcReturnDesc = vl_xlookp("WF_EDI_RETURN","lk_desc",,lcResultString)
11846
11847 .oLog.LogEntry("EDI Workflow Failed with error code " + lcResultString,.T.)
11848 .oLog.LogEntry(" " + IIF(EMPTY(lcReturnDesc),"Unknown Message",lcReturnDesc),.T.)
11849 ELSE
11850 * Found it. Record procski and use that table for error reporting
11851 IF llRetVal AND RECCOUNT("tcGetAudit") > 0
11852 SELECT tcGetAudit
11853 GO TOP && main workflow entry
11854 .oLog.LogEntry("---------- Workflow Audit Log: ----------")
11855 lnProcSki = tcGetAudit.procski
11856 .oLog.LogEntry("Procski for this Workflow is: " + TRANSFORM(lnProcSki))
11857 IF exitcode <> 0 OR errflag <> 0 OR wrnflag <> 0
11858 llRetVal = .F.
11859 .oLog.LogEntry("Workflow failed.",.T.)
11860 .oLog.LogEntry("Return Code..: " + TRANSFORM(exitcode))
11861 .oLog.LogEntry("Error Flag...: " + TRANSFORM(errflag))
11862 .oLog.LogEntry("Warning Flag.: " + TRANSFORM(wrnflag))
11863 ELSE
11864 .nWorkflowSuccess = .nWorkflowSuccess + 1
11865 .oLog.LogEntry("Workflow Launched Successfully.",.T.)
11866 .oLog.LogEntry("Return Code..: " + TRANSFORM(exitcode))
11867 ENDIF
11868
11869 .oLog.LogEntry("The following messages were found in the Audit Trail for this Workflow:")
11870
11871 DECLARE laStr[1]
11872 SELECT tcGetAudit
11873 SCAN FOR Parentski > 0 AND !ISNULL(AudtInf_Message) && components of the workflow
11874 lastr = ''
11875 StringToArray(audtinf_message, @laStr, "^")
11876 .oLog.LogArray(@laStr)
11877 ENDSCAN
11878 ENDIF
11879 ENDIF
11880 ENDIF
11881 ENDIF
11882
11883 SQLSetSessionProperty('ANSI_NULLS',lnAnsiNull )
11884 SQLSetSessionProperty('ANSI_WARNINGS',lnAnsiWarning)
11885
11886 IF FILE(tcResultFile)
11887 DELETE FILE (tcResultFile)
11888 ENDIF
11889 IF FILE(tcMaestroFile)
11890 DELETE FILE (tcMaestroFile)
11891 ENDIF
11892
11893ENDWITH
11894
11895SELECT(lnSelect)
11896
11897llRetVal = .T. && for now always return .T. We'll see if we ever need .F.
11898RETURN llRetVal
11899
11900ENDPROC
11901
11902*============================================================
11903
11904 *--- TR 1073762 27-Nov-2013 Partha ---
11905 PROCEDURE UpdatePhEmail
11906 PARAMETERS pcVerticalAddress
11907 LOCAL llRetVal, lnSelect, lcPkey, loAddr, lcSQLString
11908
11909 lnSelect = SELECT()
11910 llRetVal = true
11911
11912 WITH THIS
11913 .cSQLTempTable = ""
11914
11915 IF .GenerateSQLTempTable(pcVerticalAddress) ;
11916 AND .PopulateSQLTempTable(pcVerticalAddress) ;
11917 AND !EMPTY(.cSQLTempTable)
11918 *--- TechRec 1077213 03-Apr-2014 MANI. Added COALESCE() to left join tabel fields ===
11919 lcSQLString = " UPDATE h " + ;
11920 " SET h.accessnum = (CASE WHEN h.addr_type IN ('ST','OT') and stadr.phone > '' then stadr.phone "+ ; && *--- TR 1091146 17/3/2016 Gurinder
11921 " WHEN h.addr_type IN ('ST','OT') and h.accessnum > '' then accessnum "+; && *--- TR 1091146 17/3/2016 Gurinder
11922 " WHEN h.addr_type IN ('ST','OT') THEN COALESCE(stadr.phone,'') "+ ; && *--- TR 1091146 17/3/2016 Gurinder
11923 " WHEN h.addr_type = 'BT' THEN COALESCE(otadr.phone,'') " + ;
11924 " ELSE h.accessnum END ) ," + ;
11925 " h.email = (CASE WHEN h.addr_type IN ('ST','OT') THEN COALESCE(stadr.email,'') "+ ;
11926 " WHEN h.addr_type = 'BT' THEN COALESCE(otadr.email,'') " + ;
11927 " ELSE h.email END ) " + ;
11928 " FROM " + .cSQLTempTable + " h " + ;
11929 " LEFT JOIN zzoordad stadr " + ;
11930 " ON h.ord_num = stadr.ord_num " +;
11931 " LEFT JOIN zzootadr otadr " + ;
11932 " ON h.ord_num = otadr.ord_num " +;
11933 " AND otadr.addr_type = 'BT' " + ;
11934 " WHERE (stadr.ord_num is not null OR otadr.ord_num is not null) " + ;
11935 " AND h.addr_type IN ('ST','OT','BT') "
11936
11937 llRetVal = llRetVal AND v_SQLExec(lcSQLString)
11938
11939 lcSQLString = " Select h.* FROM " + .cSQLTempTable + " h " + ;
11940 " WHERE h.addr_type IN ('ST','OT','BT') "
11941
11942 llRetVal = llRetVal AND v_SQLExec(lcSQLString, "__tmpEmPhAdrs")
11943 IF llRetVal AND USED("__tmpEmPhAdrs") AND RECCOUNT("__tmpEmPhAdrs")>0
11944
11945 SELECT ("__tmpEmPhAdrs")
11946 INDEX ON ALLTRIM(STR(ord_num)) + addr_type TAG emphadr
11947 GOTO TOP
11948
11949 SELECT (pcVerticalAddress)
11950 GOTO TOP
11951 SCAN FOR INLIST(addr_type,'ST','OT','BT')
11952 IF SEEK( ALLTRIM(STR(ord_num))+ addr_type , "__tmpEmPhAdrs", "emphadr")
11953 SELECT ("__tmpEmPhAdrs")
11954 SCATTER FIELDS accessnum,email,addr_type NAME oAddr
11955 lcAccessNum = oAddr.accessnum
11956 lnChrsRet = AT("@", lcAccessNum)
11957 lnChrsRet = IIF(lnChrsRet = 0, LEN(lcAccessNum), lnChrsRet - 1)
11958 lcAccessNum = SUBSTR(lcAccessNum , 1, lnChrsRet)
11959 lcAccessNum = STRTRAN(STRTRAN(lcAccessNum , "/"), "-")
11960 oAddr.accessnum = lcAccessNum
11961
11962 SELECT (pcVerticalAddress)
11963 GATHER NAME oAddr
11964 .TimeStampDocument()
11965
11966 ENDIF
11967 ENDSCAN
11968
11969 ENDIF
11970 ENDIF
11971
11972 .TableClose("__tmpEmPhAdrs")
11973 ENDWITH
11974
11975 SELECT (lnSelect)
11976 RETURN llRetVal
11977 ENDPROC
11978 *=== TR 1073762 27-Nov-2013 Partha ===
11979
11980*============================================================
11981
11982
11983 *- TR 1073045/1076527 FH - similar to 1076026, method to insert into our flat file cursor.
11984 FUNCTION InsertIntoFlatFileCursor
11985 LPARAMETERS pcFlatFileList, pcTempFlatfile, pcOutBoundFlatFile
11986 LOCAL llRetVal, lnSelect, llFound, lnHandle , lnSize
11987
11988 llRetVal = .T.
11989 lnSelect = SELECT()
11990 llFound = .F.
11991
11992 WITH This
11993 SELECT (pcFlatFileList)
11994 SCAN
11995 IF ALLTRIM(TempFlatfile) = ALLTRIM(pcTempFlatfile)
11996 llFound = .T.
11997 EXIT && we get out of here, cursor already contains our Flat file
11998 ENDIF
11999 ENDSCAN
12000
12001 IF NOT llFound
12002 *- Let's check to see if temp file actually has data in it (size > 0)
12003 lnHandle = FOPEN(pcTempFlatfile)
12004 lnSize = FSEEK(lnHandle,0,2)
12005 IF lnSize > 0
12006 INSERT INTO (pcFlatFileList)(TempFlatfile,OutBoundFlatFile) VALUES (pcTempFlatfile, pcOutBoundFlatFile)
12007 ENDIF
12008 =FCLOSE(lnHandle)
12009 ENDIF
12010
12011 ENDWITH
12012
12013 SELECT (lnSelect)
12014 RETURN llRetVal
12015 ENDFUNC
12016*- TR 1073045/1076527 FH - similar to 1076026, method to insert into our flat file cursor.
12017
12018
12019*============================================================
12020 *--- TR 1065007 4-Feb-2014 Goutam
12021 PROCEDURE GetFromUOM
12022
12023 LOCAL llRetVal, lnSelect, lcCompCurs
12024
12025 lnSelect = SELECT()
12026 lcCompCurs = GetUniqueFileName()
12027
12028 WITH this
12029 llRetVal = vl_compr(,,lcCompCurs)
12030
12031 SELECT (lcCompCurs)
12032 .cFromUOMWeight = default_uom
12033 .cFromUOMVolume = uom_vol
12034 .cFromUOMDimens = uom_dimen
12035 ENDWITH
12036
12037 USE IN SELECT(lcCompCurs)
12038
12039 SELECT (lnSelect)
12040 RETURN llRetVal
12041 ENDPROC
12042
12043*============================================================
12044
12045 PROCEDURE ValidateOutboundUOM
12046 PARAMETERS pcTranHeader, pcControl, pcUOMFromType
12047
12048 LOCAL llRetVal, lnSelect, lcSQLString, lcContCurs, llEmptyWeightinCompany, llEmptyVolumeinCompany, llEmptyDimensinCompany
12049
12050 lnSelect = SELECT()
12051 llRetVal = true
12052 lcContCurs = GetUniqueFileName()
12053
12054 WITH THIS
12055 .cSQLTempTable = ""
12056
12057 llEmptyWeightinCompany = !EMPTY(.cWeightFieldForUOM) And EMPTY(.cFromUOMWeight)
12058 llEmptyVolumeinCompany = !EMPTY(.cVolumeFieldForUOM) And EMPTY(.cFromUOMVolume)
12059 llEmptyDimensinCompany = !EMPTY(.cDimensFieldForUOM) And EMPTY(.cFromUOMDimens)
12060
12061 DO CASE
12062 CASE pcUOMFromType = 'DIV'
12063 lcSQLString = "Select distinct division, customer from " + pcTranHeader
12064 CASE pcUOMFromType = 'LOC'
12065 lcSQLString = "Select distinct location from " + pcTranHeader
12066 CASE pcUOMFromType = 'DEST'
12067 lcSQLString = "Select distinct Catg_dest from " + pcTranHeader
12068 ENDCASE
12069
12070 llRetVal = llRetVal AND v_SqlExec(lcSQLString,lcContCurs,,true)
12071
12072 IF .GenerateSQLTempTable(lcContCurs) AND .PopulateSQLTempTable(lcContCurs) AND !EMPTY(.cSQLTempTable)
12073
12074 USE IN SELECT(lcContCurs)
12075
12076 DO CASE
12077 CASE pcUOMFromType = 'DIV'
12078 lcSQLString = ;
12079 "select coalesce(cr.pkey, 0) as pkey, cr.UOM_Recal, th.division, th.customer, cr.uom_dimen, cr.uom_weight, cr.uom_volume " + ;
12080 " from " + .cSQLTempTable + " th join " + pcControl + " cr " + ;
12081 " on th.customer = cr.customer and th.division = cr.division and cr.active_ok = 'Y' "
12082 CASE pcUOMFromType = 'LOC'
12083 lcSQLString = ;
12084 "select coalesce(lo.pkey, 0) as pkey, cr.UOM_Recal, th.location, lo.uom_dimen,lo.uom_weight,lo.uom_volume " + ;
12085 " from " + .cSQLTempTable + " th join " + pcControl + " cr on th.location = cr.ware_code And cr.active_ok = 'Y' " + ;
12086 " left join zzxlocar lo on lo.location = cr.ware_code and lo.loc_type = 'W' "
12087 CASE pcUOMFromType = 'DEST'
12088 lcSQLString = ;
12089 "select coalesce(cr.pkey, 0) as pkey, cr.UOM_Recal, th.Catg_dest, cr.uom_weight,cr.uom_volume " + ;
12090 " from " + .cSQLTempTable + " th join " + pcControl + " cr " + ;
12091 " on th.Catg_dest = cr.Catg_dest and cr.active_ok = 'Y' "
12092 ENDCASE
12093
12094 llRetVal = llRetVal AND v_SqlExec(lcSQLString, lcContCurs)
12095
12096 SELECT (lcContCurs)
12097 DO CASE
12098 CASE pcUOMFromType = 'DIV'
12099 INDEX on division+customer TAG division
12100 CASE pcUOMFromType = 'LOC'
12101 INDEX on location TAG location
12102 CASE pcUOMFromType = 'DEST'
12103 INDEX on Catg_dest TAG Catg_dest
12104 ENDCASE
12105
12106 DO CASE
12107 CASE pcUOMFromType = 'DIV'
12108 llRetVal = llRetVal And .SetRelation(lcContCurs, "division", pcTranHeader, "division+customer")
12109 CASE pcUOMFromType = 'LOC'
12110 llRetVal = llRetVal And .SetRelation(lcContCurs, "location", pcTranHeader, "location")
12111 CASE pcUOMFromType = 'DEST'
12112 llRetVal = llRetVal AND .SetRelation(lcContCurs, "Catg_dest", pcTranHeader, "Catg_dest")
12113 ENDCASE
12114
12115 IF llEmptyWeightinCompany OR llEmptyVolumeinCompany OR llEmptyDimensinCompany
12116
12117 lcErrs_Msg = "UOM code in Company Control is blank." + CRLF
12118
12119 IF pcUOMFromType = 'DEST'
12120 replace errs_flg WITH 'Y', errs_msg WITH errs_msg + lcErrs_Msg ;
12121 FOR !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') IN (pcTranHeader)
12122 ELSE
12123 replace errs_flg_h WITH 'Y', errs_msg_h WITH errs_msg_h + lcErrs_Msg ;
12124 FOR !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') IN (pcTranHeader)
12125 ENDIF
12126 SET RELATION TO
12127 ELSE
12128 IF !EMPTY(.cWeightFieldForUOM) AND !EMPTY(.cFromUOMWeight) AND !vl_suomr(.cFromUOMWeight)
12129 lcErrs_Msg = "Source Weight UOM [" + ALLTRIM(.cFromUOMWeight)+ "] code does not exists in UOM Reference." + CRLF
12130 IF pcUOMFromType = 'DEST'
12131 replace errs_flg WITH 'Y', errs_msg WITH errs_msg + lcErrs_Msg ;
12132 FOR !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') AND !EMPTY(&lcContCurs..uom_weight) IN (pcTranHeader)
12133 ELSE
12134 replace errs_flg_h WITH 'Y', errs_msg_h WITH errs_msg_h + lcErrs_Msg ;
12135 FOR !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') AND !EMPTY(&lcContCurs..uom_weight) IN (pcTranHeader)
12136 ENDIF
12137 ENDIF
12138 IF !EMPTY(.cVolumeFieldForUOM) AND !EMPTY(.cFromUOMVolume) AND !vl_suomr(.cFromUOMVolume)
12139 lcErrs_Msg = "Source Volume UOM [" + ALLTRIM(.cFromUOMVolume)+ "] code does not exists in UOM Reference." + CRLF
12140 IF pcUOMFromType = 'DEST'
12141 replace errs_flg WITH 'Y', errs_msg WITH errs_msg + lcErrs_Msg ;
12142 FOR !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') AND !EMPTY(&lcContCurs..uom_volume) IN (pcTranHeader)
12143 ELSE
12144 replace errs_flg_h WITH 'Y', errs_msg_h WITH errs_msg_h + lcErrs_Msg ;
12145 FOR !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') AND !EMPTY(&lcContCurs..uom_volume) IN (pcTranHeader)
12146 ENDIF
12147 ENDIF
12148 IF !EMPTY(.cDimensFieldForUOM) AND !EMPTY(.cFromUOMDimens) AND !vl_suomr(.cFromUOMDimens)
12149 lcErrs_Msg = "Source Dimension UOM [" + ALLTRIM(.cFromUOMDimens)+ "] code does not exists in UOM Reference." + CRLF
12150 IF pcUOMFromType = 'DEST'
12151 replace errs_flg WITH 'Y', errs_msg WITH errs_msg + lcErrs_Msg ;
12152 FOR !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') AND !EMPTY(&lcContCurs..uom_Dimen) IN (pcTranHeader)
12153 ELSE
12154 replace errs_flg_h WITH 'Y', errs_msg_h WITH errs_msg_h + lcErrs_Msg ;
12155 FOR !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') AND !EMPTY(&lcContCurs..uom_Dimen) IN (pcTranHeader)
12156 ENDIF
12157 ENDIF
12158
12159 IF !EMPTY(.cWeightFieldForUOM)
12160 lcErrs_Msg = "The default control reference UOM for weight does not exists." + CRLF
12161 IF pcUOMFromType = 'DEST'
12162 replace errs_flg WITH 'Y', errs_msg WITH errs_msg + lcErrs_Msg ;
12163 FOR !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') AND EMPTY(&lcContCurs..uom_weight) IN (pcTranHeader)
12164 ELSE
12165 replace errs_flg_h WITH 'Y', errs_msg_h WITH errs_msg_h + lcErrs_Msg ;
12166 FOR !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') AND EMPTY(&lcContCurs..uom_weight) IN (pcTranHeader)
12167 ENDIF
12168 ENDIF
12169 IF !EMPTY(.cVolumeFieldForUOM)
12170 lcErrs_Msg = "The default control reference UOM for volume does not exists." + CRLF
12171 IF pcUOMFromType = 'DEST'
12172 replace errs_flg WITH 'Y', errs_msg WITH errs_msg + lcErrs_Msg ;
12173 FOR !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') AND EMPTY(&lcContCurs..uom_volume) IN (pcTranHeader)
12174 ELSE
12175 replace errs_flg_h WITH 'Y', errs_msg_h WITH errs_msg_h + lcErrs_Msg ;
12176 FOR !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') AND EMPTY(&lcContCurs..uom_volume) IN (pcTranHeader)
12177 endif
12178 ENDIF
12179 IF !EMPTY(.cDimensFieldForUOM)
12180 lcErrs_Msg = "The default control reference UOM for dimension does not exists." + CRLF
12181 IF pcUOMFromType = 'DEST'
12182 replace errs_flg WITH 'Y', errs_msg WITH errs_msg + lcErrs_Msg ;
12183 FOR !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') AND EMPTY(&lcContCurs..uom_dimen) IN (pcTranHeader)
12184 ELSE
12185 replace errs_flg_h WITH 'Y', errs_msg_h WITH errs_msg_h + lcErrs_Msg ;
12186 FOR !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') AND EMPTY(&lcContCurs..uom_dimen) IN (pcTranHeader)
12187 ENDIF
12188 ENDIF
12189
12190 SET RELATION TO
12191 USE IN SELECT(lcContCurs)
12192
12193 DO CASE
12194 CASE pcUOMFromType = 'DIV'
12195 lcSQLString = ;
12196 "select th.division, th.customer, coalesce(cr.UOM_Recal, '') as UOM_Recal, cr.uom_weight, cr.uom_volume, cr.uom_Dimen " + ;
12197 " ,coalesce(d1.uom_convert, '') as uom_volume2 " + ;
12198 " ,coalesce(d2.uom_convert, '') as uom_weight2 " + ;
12199 " ,coalesce(d3.uom_convert, '') as uom_dimen2 " + ;
12200 " from " + .cSQLTempTable + " th join " + pcControl + " cr " + ;
12201 " on th.customer = cr.customer and th.division = cr.division and cr.active_ok = 'Y' " + ;
12202 " left join zzxsuomd d1 on d1.uom_convert = cr.uom_volume " + ;
12203 " and d1.uom = " + SqlFormatChar(.cFromUOMVolume) + ;
12204 " left join zzxsuomd d2 on d2.uom_convert = cr.uom_weight " + ;
12205 " and d2.uom = " + SqlFormatChar(.cFromUOMWeight) + ;
12206 " left join zzxsuomd d3 on d3.uom_convert = cr.uom_dimen " + ;
12207 " and d3.uom = " + SqlFormatChar(.cFromUOMDimens)
12208 CASE pcUOMFromType = 'LOC'
12209 lcSQLString = ;
12210 "select th.location, coalesce(cr.UOM_Recal, '') as UOM_Recal, lo.uom_weight, lo.uom_volume, lo.uom_dimen " + ;
12211 " ,coalesce(d1.uom_convert, '') as uom_volume2 " + ;
12212 " ,coalesce(d2.uom_convert, '') as uom_weight2 " + ;
12213 " ,coalesce(d3.uom_convert, '') as uom_dimen2 " + ;
12214 " from " + .cSQLTempTable + " th " + ;
12215 " join " + pcControl + " cr on th.location = cr.ware_code And cr.UOM_Recal = 'Y' And cr.active_ok = 'Y' " + ;
12216 " left join zzxlocar lo on lo.location = cr.ware_code and lo.loc_type = 'W' " + ;
12217 " left join zzxsuomd d1 on d1.uom_convert = lo.uom_volume " + ;
12218 " and d1.uom = " + SqlFormatChar(.cFromUOMVolume) + ;
12219 " left join zzxsuomd d2 on d2.uom_convert = lo.uom_weight " + ;
12220 " and d2.uom = " + SqlFormatChar(.cFromUOMWeight) + ;
12221 " left join zzxsuomd d3 on d3.uom_convert = lo.uom_dimen " + ;
12222 " and d3.uom = " + SqlFormatChar(.cFromUOMDimens)
12223 CASE pcUOMFromType = 'DEST'
12224 lcSQLString = ;
12225 "select th.Catg_dest, coalesce(cr.UOM_Recal, '') as UOM_Recal, cr.uom_weight, cr.uom_volume, cr.uom_Dimen " + ;
12226 " ,coalesce(d1.uom_convert, '') as uom_volume2 " + ;
12227 " ,coalesce(d2.uom_convert, '') as uom_weight2 " + ;
12228 " ,coalesce(d3.uom_convert, '') as uom_dimen2 " + ;
12229 " from " + .cSQLTempTable + " th join zzeosccr cr " + ;
12230 " on th.Catg_dest = cr.Catg_dest and cr.active_ok = 'Y' " + ;
12231 " left join zzxsuomd d1 on d1.uom_convert = cr.uom_volume " + ;
12232 " and d1.uom = " + SqlFormatChar(.cFromUOMVolume) + ;
12233 " left join zzxsuomd d2 on d2.uom_convert = cr.uom_weight " + ;
12234 " and d2.uom = " + SqlFormatChar(.cFromUOMWeight) + ;
12235 " left join zzxsuomd d3 on d3.uom_convert = cr.uom_dimen " + ;
12236 " and d3.uom = " + SqlFormatChar(.cFromUOMDimens)
12237 ENDCASE
12238
12239 llRetVal = llRetVal AND v_SqlExec(lcSQLString,lcContCurs)
12240
12241 SELECT (lcContCurs)
12242 DO CASE
12243 CASE pcUOMFromType = 'DIV'
12244 INDEX on division+customer TAG division
12245 llRetVal = llRetVal And .SetRelation(lcContCurs, "division", pcTranHeader, "division+customer")
12246 CASE pcUOMFromType = 'LOC'
12247 INDEX on location TAG location
12248 llRetVal = llRetVal And .SetRelation(lcContCurs, "location", pcTranHeader, "location")
12249 CASE pcUOMFromType = 'DEST'
12250 INDEX on Catg_dest TAG Catg_dest
12251 ENDCASE
12252
12253 IF !EMPTY(.cWeightFieldForUOM)
12254 lcErrs_Msg = "No UOM conversion factor found for weight header UOM " + ALLTRIM(.cFromUOMWeight) + " and detail UOM "
12255 IF pcUOMFromType = 'DEST'
12256 replace errs_flg WITH 'Y', errs_msg WITH errs_msg + lcErrs_Msg + &lcContCurs..uom_weight + "." + CRLF ;
12257 FOR !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') AND EMPTY(&lcContCurs..uom_weight2) IN (pcTranHeader)
12258 ELSE
12259 replace errs_flg_h WITH 'Y', errs_msg_h WITH errs_msg_h + lcErrs_Msg + &lcContCurs..uom_weight + "." + CRLF ;
12260 FOR !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') AND EMPTY(&lcContCurs..uom_weight2) IN (pcTranHeader)
12261 ENDIF
12262 ENDIF
12263 IF !EMPTY(.cVolumeFieldForUOM)
12264 lcErrs_Msg = "No UOM conversion factor found for volume header UOM " + ALLTRIM(.cFromUOMVolume) + " and detail UOM "
12265 IF pcUOMFromType = 'DEST'
12266 replace errs_flg WITH 'Y', errs_msg WITH errs_msg + lcErrs_Msg + &lcContCurs..uom_volume + "." + CRLF ;
12267 FOR !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') AND EMPTY(&lcContCurs..uom_volume2) IN (pcTranHeader)
12268 ELSE
12269 replace errs_flg_h WITH 'Y', errs_msg_h WITH errs_msg_h + lcErrs_Msg + &lcContCurs..uom_volume + "." + CRLF ;
12270 FOR !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') AND EMPTY(&lcContCurs..uom_volume2) IN (pcTranHeader)
12271 ENDIF
12272 ENDIF
12273 IF !EMPTY(.cDimensFieldForUOM)
12274 lcErrs_Msg = "No UOM conversion factor found for dimension header UOM " + ALLTRIM(.cFromUOMDimens) + " and detail UOM "
12275 IF pcUOMFromType = 'DEST'
12276 replace errs_flg WITH 'Y', errs_msg WITH errs_msg + lcErrs_Msg + &lcContCurs..uom_dimen + "." + CRLF ;
12277 FOR !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') AND EMPTY(&lcContCurs..uom_dimen2) IN (pcTranHeader)
12278 ELSE
12279 replace errs_flg_h WITH 'Y', errs_msg_h WITH errs_msg_h + lcErrs_Msg + &lcContCurs..uom_dimen + "." + CRLF ;
12280 FOR !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') AND EMPTY(&lcContCurs..uom_dimen2) IN (pcTranHeader)
12281 ENDIF
12282 ENDIF
12283
12284 SET RELATION TO
12285 USE IN SELECT(lcContCurs)
12286
12287 ENDIF
12288
12289 ENDIF
12290
12291 ENDWITH
12292
12293 USE IN SELECT(lcContCurs)
12294
12295 SELECT (lnSelect)
12296 RETURN llRetVal
12297 ENDPROC
12298*============================================================
12299 PROCEDURE UpdateHeaderUOM
12300 PARAMETERS pcTranHeader, pcControl, plUOMFromLocation
12301
12302 LOCAL llRetVal, lnSelect, lcDivision, lcCustomer, lcSeekString, lnConvValue, lcReplaceString, lcContCurs
12303
12304 lnSelect = SELECT()
12305 llRetVal = true
12306 lcContCurs = GetUniqueFileName()
12307
12308 WITH THIS
12309
12310 IF !plUOMFromLocation
12311 lcSQLString = "Select distinct division, customer from " + pcTranHeader
12312 ENDIF
12313
12314 llRetVal = llRetVal AND v_SqlExec(lcSQLString,lcContCurs,,true)
12315
12316 .cSQLTempTable = ""
12317 IF .GenerateSQLTempTable(lcContCurs) AND .PopulateSQLTempTable(lcContCurs) AND !EMPTY(.cSQLTempTable)
12318
12319 USE IN SELECT(lcContCurs)
12320 IF !plUOMFromLocation
12321 lcSQLString = ;
12322 "select th.division, th.customer, coalesce(cr.UOM_Recal, '') as UOM_Recal, cr.uom_weight, cr.uom_volume, cr.uom_Dimen " + ;
12323 " ,coalesce(d1.uom_convert, '') as uom_volume2 " + ;
12324 " ,coalesce(d2.uom_convert, '') as uom_weight2 " + ;
12325 " ,coalesce(d3.uom_convert, '') as uom_dimen2 " + ;
12326 " ,coalesce(d1.uom_factor, 1) as volume_factor " + ;
12327 " ,coalesce(d2.uom_factor, 1) as weight_factor " + ;
12328 " ,coalesce(d3.uom_factor, 1) as dimen_factor " + ;
12329 " from " + .cSQLTempTable + " th join " + pcControl + " cr " + ;
12330 " on th.customer = cr.customer and th.division = cr.division and cr.active_ok = 'Y' " + ;
12331 " left join zzxsuomd d1 on d1.uom_convert = cr.uom_volume " + ;
12332 " and d1.uom = " + SqlFormatChar(.cFromUOMVolume) + ;
12333 " left join zzxsuomd d2 on d2.uom_convert = cr.uom_weight " + ;
12334 " and d2.uom = " + SqlFormatChar(.cFromUOMWeight) + ;
12335 " left join zzxsuomd d3 on d3.uom_convert = cr.uom_dimen " + ;
12336 " and d3.uom = " + SqlFormatChar(.cFromUOMDimens)
12337 ENDIF
12338
12339 llRetVal = llRetVal AND v_SqlExec(lcSQLString,lcContCurs)
12340
12341 IF llRetVal
12342 SELECT (lcContCurs)
12343 IF !plUOMFromLocation
12344 INDEX on division+customer TAG division
12345 llRetVal = llRetVal And .SetRelation(lcContCurs, "division", pcTranHeader, "division+customer")
12346 ENDIF
12347
12348 IF !EMPTY(.cWeightFieldForUOM)
12349 lcReplaceString = "replace " + .cWeightFieldForUOM + " WITH (" + .cWeightFieldForUOM + "*&lcContCurs..weight_factor) " + ;
12350 " FOR " + .cWeightFieldForUOM + " > 0 AND !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') " + ;
12351 " AND !EMPTY(&lcContCurs..uom_weight2) and errs_flg_h <> 'Y' " + ;
12352 " IN (pcTranHeader)"
12353 &lcReplaceString
12354 ENDIF
12355 IF !EMPTY(.cVolumeFieldForUOM)
12356 lcReplaceString = "replace " + .cVolumeFieldForUOM + " WITH (" + .cVolumeFieldForUOM + "*&lcContCurs..volume_factor) " + ;
12357 " FOR " + .cVolumeFieldForUOM + " > 0 AND !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') " + ;
12358 " AND !EMPTY(&lcContCurs..uom_volume2) and errs_flg_h <> 'Y' " + ;
12359 " IN (pcTranHeader)"
12360 &lcReplaceString
12361 ENDIF
12362 IF !EMPTY(.cDimensFieldForUOM)
12363 lcReplaceString = "replace " + .cDimensFieldForUOM + " WITH (" + .cDimensFieldForUOM + "*&lcContCurs..dimen_factor) " + ;
12364 " FOR " + .cDimensFieldForUOM + " > 0 AND !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') " + ;
12365 " AND !EMPTY(&lcContCurs..uom_dimen2) and errs_flg_h <> 'Y' " + ;
12366 " IN (pcTranHeader)"
12367 &lcReplaceString
12368 ENDIF
12369 IF !EMPTY(.cDimens1FieldForUOM)
12370 lcReplaceString = "replace " + .cDimens1FieldForUOM + " WITH (" + .cDimens1FieldForUOM + "*&lcContCurs..dimen_factor) " + ;
12371 " FOR " + .cDimens1FieldForUOM + " > 0 AND !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') " + ;
12372 " AND !EMPTY(&lcContCurs..uom_dimen2) and errs_flg_h <> 'Y' " + ;
12373 " IN (pcTranHeader)"
12374 &lcReplaceString
12375 ENDIF
12376 IF !EMPTY(.cDimens2FieldForUOM)
12377 lcReplaceString = "replace " + .cDimens2FieldForUOM + " WITH (" + .cDimens2FieldForUOM + "*&lcContCurs..dimen_factor) " + ;
12378 " FOR " + .cDimens2FieldForUOM + " > 0 AND !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') " + ;
12379 " AND !EMPTY(&lcContCurs..uom_dimen2) and errs_flg_h <> 'Y' " + ;
12380 " IN (pcTranHeader)"
12381 &lcReplaceString
12382 ENDIF
12383
12384 IF !EMPTY(.cWeight2FieldForUOM)
12385 lcReplaceString = "replace " + .cWeight2FieldForUOM + " WITH (" + .cWeight2FieldForUOM + "*&lcContCurs..weight_factor) " + ;
12386 " FOR " + .cWeight2FieldForUOM + " > 0 AND !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') " + ;
12387 " AND !EMPTY(&lcContCurs..uom_weight2) and errs_flg_h <> 'Y' " + ;
12388 " IN (pcTranHeader)"
12389 &lcReplaceString
12390 ENDIF
12391
12392 SET RELATION TO
12393 USE IN SELECT(lcContCurs)
12394 ENDIF
12395
12396 ENDIF
12397 ENDWITH
12398
12399 SELECT (lnSelect)
12400 RETURN llRetVal
12401 ENDPROC
12402*============================================================
12403 PROCEDURE ValidateInboundUOM
12404 LPARAMETERS pcTranHeader, pcHeaderTAG, pcControl, pcControlTAG
12405
12406 LOCAL llRetVal, lnSelect, lcErrs_Msg, lcSql, lcUOMCurs, lcToUOMWeight, lcToUOMVolume, lcToUOMDimension
12407
12408 lnSelect = SELECT()
12409 llRetVal = true
12410 lcUOMCurs = GetUniqueFileName()
12411
12412 WITH this
12413 lcToUOMWeight = .cFromUOMWeight
12414 lcToUOMVolume = .cFromUOMVolume
12415 lcToUOMDimension = .cFromUOMDimens
12416
12417 SELECT (pcTranHeader)
12418 IF (EMPTY(lcToUOMWeight) OR EMPTY(lcToUOMVolume))
12419
12420 lcErrs_Msg = "UOM code in Company Control is blank." + CRLF
12421 llRetVal = llRetVal And .SetRelation(pcControl, pcControlTAG, pcTranHeader, pcHeaderTAG)
12422 IF llRetVal
12423 replace errs_flg_h WITH 'Y', errs_msg_h WITH errs_msg_h + lcErrs_Msg ;
12424 FOR !EOF(pcControl) AND (&pcControl..UOM_Recal = 'Y') IN (pcTranHeader)
12425 ENDIF
12426 SET RELATION TO
12427 ELSE
12428 lcSql = "Select * from zzxsuomd where uom_convert = " + SqlFormatChar(lcToUOMWeight)
12429 llRetVal = llRetVal And v_SqlExec(lcSql, lcUOMCurs)
12430
12431 IF llRetVal AND RECCOUNT(lcUOMCurs) = 0
12432 lcErrs_Msg = "The convert weight UOM [" + lcToUOMWeight + "] in Company Control is not populated or does not exist in TO Reference." + CRLF
12433 llRetVal = llRetVal And .SetRelation(pcControl, pcControlTAG, pcTranHeader, pcHeaderTAG)
12434 IF llRetVal
12435 replace errs_flg_h WITH 'Y', errs_msg_h WITH errs_msg_h + lcErrs_Msg ;
12436 FOR !EOF(pcControl) AND (&pcControl..UOM_Recal = 'Y') IN (pcTranHeader)
12437 ENDIF
12438 SET RELATION TO
12439 USE IN SELECT(lcUOMCurs)
12440 ENDIF
12441 lcSql = "Select * from zzxsuomd where uom_convert = " + SqlFormatChar(lcToUOMVolume)
12442 llRetVal = llRetVal And v_SqlExec(lcSql, lcUOMCurs)
12443
12444 IF llRetVal AND RECCOUNT(lcUOMCurs) = 0
12445 lcErrs_Msg = "The convert volume UOM [" + lcToUOMVolume + "] in Company Control is not populated or does not exist in TO Reference." + CRLF
12446 llRetVal = llRetVal And .SetRelation(pcControl, pcControlTAG, pcTranHeader, pcHeaderTAG)
12447 IF llRetVal
12448 replace errs_flg_h WITH 'Y', errs_msg_h WITH errs_msg_h + lcErrs_Msg ;
12449 FOR !EOF(pcControl) AND (&pcControl..UOM_Recal = 'Y') IN (pcTranHeader)
12450 ENDIF
12451 SET RELATION TO
12452 USE IN SELECT(lcUOMCurs)
12453 ENDIF
12454
12455 IF llRetVal AND !EMPTY(.cTranDetail1Table)
12456 lcErrs_Msg = "From UOM code in inbound file is blank." + CRLF
12457 lcSql = "Select t.pkey from " + .cTranDetail1Table + " t " + ;
12458 " join " + pcTranHeader + " h on h.pkey = t.fkey " + ;
12459 " join " + pcControl + " c on c." + pcControlTAG + " = h." + pcHeaderTAG + ;
12460 " Where c.UOM_Recal = 'Y' and (EMPTY(t.uom_volume) or EMPTY(t.uom_weight))"
12461
12462 llRetVal = llRetVal And v_SqlExec(lcSql,lcUOMCurs,,true)
12463
12464 SELECT (lcUOMCurs)
12465 INDEX on pkey TAG pkey
12466 llRetVal = llRetVal And .SetRelation(lcUOMCurs, "pkey", .cTranDetail1Table, "pkey")
12467
12468 IF llRetVal
12469 replace errs_flg_cntr WITH 'Y', errs_msg_cntr WITH errs_msg_cntr + lcErrs_Msg ;
12470 FOR !EOF(lcUOMCurs) IN (.cTranDetail1Table)
12471 ENDIF
12472 SET RELATION TO
12473 USE IN SELECT(lcUOMCurs)
12474 ENDIF
12475 IF llRetVal AND !EMPTY(.cTranDetail2Table)
12476 lcErrs_Msg = "From UOM code in inbound file is blank." + CRLF
12477 lcSql = "Select t.pkey from " + .cTranDetail2Table + " t " + ;
12478 " join " + pcTranHeader + " h on h.pkey = t.fkey " + ;
12479 " join " + pcControl + " c on c." + pcControlTAG + " = h." + pcHeaderTAG + ;
12480 " Where c.UOM_Recal = 'Y' and (EMPTY(t.uom_volume) or EMPTY(t.uom_weight))"
12481
12482 llRetVal = llRetVal And v_SqlExec(lcSql,lcUOMCurs,,true)
12483
12484 SELECT (lcUOMCurs)
12485 INDEX on pkey TAG pkey
12486 llRetVal = llRetVal And .SetRelation(lcUOMCurs, "pkey", .cTranDetail2Table, "pkey")
12487
12488 IF llRetVal
12489 replace errs_flg_ctn WITH 'Y', errs_msg_ctn WITH errs_msg_ctn + lcErrs_Msg ;
12490 FOR !EOF(lcUOMCurs) IN (.cTranDetail2Table)
12491 ENDIF
12492 SET RELATION TO
12493
12494 USE IN SELECT(lcUOMCurs)
12495 ENDIF
12496
12497 IF llRetVal AND !EMPTY(.cTranDetail1Table)
12498 lcSql = "Select t.pkey, t.uom_volume, t.uom_weight from " + .cTranDetail1Table + " t " + ;
12499 " join " + pcTranHeader + " h on h.pkey = t.fkey " + ;
12500 " join " + pcControl + " c on c.pkey = h.Control_Key " + ;
12501 " Where c.UOM_Recal = 'Y' and (t.uom_volume > '' or t.uom_weight > '')"
12502
12503 llRetVal = llRetVal And v_SqlExec(lcSql,lcUOMCurs,,true)
12504 ENDIF
12505
12506 .cSQLTempTable = ""
12507 IF llRetVal AND !EMPTY(.cTranDetail1Table) AND .GenerateSQLTempTable(lcUOMCurs) AND .PopulateSQLTempTable(lcUOMCurs) AND !EMPTY(.cSQLTempTable)
12508
12509 lcSql = "select t.pkey, t.uom_volume, t.uom_weight, Coalesce(d1.uom, '') WUOM, Coalesce(d2.uom, '') VUOM from " + .cSQLTempTable + " t left join zzxsuomr d1 " + ;
12510 " on d1.uom = t.uom_weight left join zzxsuomr d2 on d2.uom = t.uom_volume"
12511
12512 llRetVal = llRetVal And v_SqlExec(lcSql, "__UOMRef")
12513 SELECT __UOMRef
12514 INDEX on pkey TAG pkey
12515
12516 llRetVal = llRetVal AND .SetRelation("__UOMRef", "pkey", .cTranDetail1Table, "pkey")
12517
12518 SELECT (.cTranDetail1Table)
12519
12520 lcErrs_Msg = "] does not exist in UOM Reference."
12521 replace errs_flg_cntr WITH 'Y', errs_msg_cntr WITH errs_msg_cntr + "Inbound weight UOM [" + uom_weight + lcErrs_Msg + CRLF ;
12522 FOR !EOF("__UOMRef") AND EMPTY(__UOMRef.WUOM) IN (.cTranDetail1Table)
12523
12524 replace errs_flg_cntr WITH 'Y', errs_msg_cntr WITH errs_msg_cntr + "Inbound volume UOM [" + uom_volume + lcErrs_Msg + CRLF ;
12525 FOR !EOF("__UOMRef") AND EMPTY(__UOMRef.VUOM) IN (.cTranDetail1Table)
12526
12527 SET RELATION TO
12528 USE IN SELECT("__UOMRef")
12529
12530 lcSql = "select t.pkey, Coalesce(d.pkey, 0) RefPkey, t.uom_volume, t.uom_weight from " + .cSQLTempTable + " t left join zzxsuomd d " + ;
12531 " on d.uom = t.uom_volume " + ;
12532 " and d.uom_convert = " + SqlFormatChar(lcToUOMVolume)
12533
12534 llRetVal = llRetVal And v_SqlExec(lcSql, "__UOMRef")
12535 SELECT __UOMRef
12536 INDEX on pkey TAG pkey
12537
12538 llRetVal = llRetVal AND .SetRelation("__UOMRef", "pkey", .cTranDetail1Table, "pkey")
12539
12540 SELECT (.cTranDetail1Table)
12541
12542 lcErrs_Msg = "No Volume UOM Conversion factor found for header UOM ["
12543 replace errs_flg_cntr WITH 'Y', errs_msg_cntr WITH errs_msg_cntr + lcErrs_Msg + uom_volume + "] and detail UOM [" + lcToUOMVolume + "]." + CRLF ;
12544 FOR !EOF("__UOMRef") AND __UOMRef.RefPkey = 0 IN (.cTranDetail1Table)
12545 SET RELATION TO
12546 USE IN SELECT("__UOMRef")
12547
12548 lcSql = "Select t.pkey, Coalesce(d.pkey, 0) RefPkey from " + .cSQLTempTable + " t left join zzxsuomd d " + ;
12549 " on d.uom = t.uom_weight " + ;
12550 " and d.uom_convert = " + SqlFormatChar(lcToUOMWeight)
12551 llRetVal = llRetVal And v_SqlExec(lcSql, "__UOMRef")
12552 SELECT __UOMRef
12553 INDEX on pkey TAG pkey
12554
12555 llRetVal = llRetVal AND .SetRelation("__UOMRef", "pkey", .cTranDetail1Table, "pkey")
12556
12557 SELECT (.cTranDetail1Table)
12558 lcErrs_Msg = "No Weight UOM Conversion factor found for header UOM ["
12559 replace errs_flg_cntr WITH 'Y', errs_msg_cntr WITH errs_msg_cntr + lcErrs_Msg + uom_weight + "] and detail UOM [" + lcToUOMWeight + "]." + CRLF ;
12560 FOR !EOF("__UOMRef") AND __UOMRef.RefPkey = 0 IN (.cTranDetail1Table)
12561 SET RELATION TO
12562 USE IN SELECT("__UOMRef")
12563 ENDIF
12564
12565 IF llRetVal AND !EMPTY(.cTranDetail2Table)
12566 lcSql = "Select t.pkey, t.uom_volume, t.uom_weight from " + .cTranDetail2Table + " t " + ;
12567 " join " + pcTranHeader + " h on h.pkey = t.fkey " + ;
12568 " join " + pcControl + " c on c.pkey = h.Control_Key " + ;
12569 " Where c.UOM_Recal = 'Y' and (t.uom_volume > '' or t.uom_weight > '')"
12570
12571 llRetVal = llRetVal And v_SqlExec(lcSql,lcUOMCurs,,true)
12572 ENDIF
12573
12574 .cSQLTempTable = ""
12575 IF llRetVal AND !EMPTY(.cTranDetail2Table) AND .GenerateSQLTempTable(lcUOMCurs) AND .PopulateSQLTempTable(lcUOMCurs) AND !EMPTY(.cSQLTempTable)
12576
12577 lcSql = "select t.pkey, t.uom_volume, t.uom_weight, Coalesce(d1.uom, '') WUOM, Coalesce(d2.uom, '') VUOM from " + .cSQLTempTable + " t left join zzxsuomr d1 " + ;
12578 " on d1.uom = t.uom_weight left join zzxsuomr d2 on d2.uom = t.uom_volume"
12579
12580 llRetVal = llRetVal And v_SqlExec(lcSql, "__UOMRef")
12581 SELECT __UOMRef
12582 INDEX on pkey TAG pkey
12583
12584 llRetVal = llRetVal AND .SetRelation("__UOMRef", "pkey", .cTranDetail2Table, "pkey")
12585
12586 SELECT (.cTranDetail2Table)
12587
12588 lcErrs_Msg = "] does not exist in UOM Reference."
12589 replace errs_flg_ctn WITH 'Y', errs_msg_ctn WITH errs_msg_ctn + "Inbound weight UOM [" + uom_weight + lcErrs_Msg + CRLF ;
12590 FOR !EOF("__UOMRef") AND EMPTY(__UOMRef.WUOM) IN (.cTranDetail2Table)
12591
12592 replace errs_flg_ctn WITH 'Y', errs_msg_ctn WITH errs_msg_ctn + "Inbound volume UOM [" + uom_volume + lcErrs_Msg + CRLF ;
12593 FOR !EOF("__UOMRef") AND EMPTY(__UOMRef.VUOM) IN (.cTranDetail2Table)
12594
12595 SET RELATION TO
12596 USE IN SELECT("__UOMRef")
12597
12598 lcSql = "select t.pkey, Coalesce(d.pkey, 0) RefPkey from " + .cSQLTempTable + " t left join zzxsuomd d " + ;
12599 " on d.uom = t.uom_volume " + ;
12600 " and d.uom_convert = " + SqlFormatChar(lcToUOMVolume)
12601
12602 llRetVal = llRetVal And v_SqlExec(lcSql, "__UOMRef")
12603 SELECT __UOMRef
12604 INDEX on pkey TAG pkey
12605
12606 llRetVal = llRetVal AND .SetRelation("__UOMRef", "pkey", .cTranDetail2Table, "pkey")
12607 SELECT (.cTranDetail2Table)
12608 lcErrs_Msg = "No Volume UOM Conversion factor found for header UOM ["
12609 replace errs_flg_ctn WITH 'Y', errs_msg_ctn WITH errs_msg_ctn + lcErrs_Msg + uom_volume + "] and detail UOM [" + lcToUOMVolume + "]." + CRLF ;
12610 FOR !EOF("__UOMRef") AND __UOMRef.RefPkey = 0 IN (.cTranDetail2Table)
12611 SET RELATION TO
12612 USE IN SELECT("__UOMRef")
12613
12614 lcSql = "Select t.pkey, Coalesce(d.pkey, 0) RefPkey from " + .cSQLTempTable + " t left join zzxsuomd d " + ;
12615 " on d.uom = t.uom_weight " + ;
12616 " and d.uom_convert = " + + SqlFormatChar(lcToUOMWeight)
12617 llRetVal = llRetVal And v_SqlExec(lcSql, "__UOMRef")
12618 SELECT __UOMRef
12619 INDEX on pkey TAG pkey
12620
12621 llRetVal = llRetVal AND .SetRelation("__UOMRef", "pkey", .cTranDetail2Table, "pkey")
12622 SELECT (.cTranDetail2Table)
12623 lcErrs_Msg = "No Weight UOM Conversion factor found for header UOM ["
12624 replace errs_flg_ctn WITH 'Y', errs_msg_ctn WITH errs_msg_ctn + lcErrs_Msg + uom_weight + "] and detail UOM [" + lcToUOMWeight + "]." + CRLF ;
12625 FOR !EOF("__UOMRef") AND __UOMRef.RefPkey = 0 IN (.cTranDetail2Table)
12626 SET RELATION TO
12627 USE IN SELECT("__UOMRef")
12628
12629 ENDIF
12630
12631 ENDIF
12632 ENDWITH
12633
12634 USE IN SELECT(lcUOMCurs)
12635
12636 SELECT (lnSelect)
12637 RETURN llRetVal
12638 ENDPROC
12639
12640 *=== TR 1065007 4-Feb-2014 Goutam
12641
12642*============================================================
12643
12644*--- TR 1081157 13-Oct-2014 Goutam
12645 FUNCTION CreateChargeHdr
12646 LPARAMETERS tcDtlSOCurs, tcTransHeader
12647 LOCAL llRetVal, lnSelect, l_nThermoCnt, lcSQLString
12648
12649 llRetVal = true
12650 lnSelect = SELECT()
12651
12652 WITH This
12653
12654 .cSQLTempTable = ""
12655 IF .GenerateSQLTempTable(tcDtlSOCurs) AND .PopulateSQLTempTable(tcDtlSOCurs) AND !EMPTY(.cSQLTempTable)
12656
12657 * create charge header cursor from temp pick detail cursor
12658 lcSQLSelect = ;
12659 "SELECT c.pkey,c.pick_num,c.ord_num,c.inv_num," + ;
12660 "c.chrg_type,r.chrgtype_desc chrg_desc,c.chrg_value chrg_amt,c.chrg_flag,c.notes " + ;
12661 "FROM zzxchrgs c " + ;
12662 "JOIN zzxchrtr r " + ;
12663 " ON c.chrg_type = r.chrg_type " + ;
12664 " AND r.chrg_hdrdtl = 'H' " + ;
12665 "JOIN " + .cSQLTempTable + " p " + ;
12666 " ON c.ord_num = p.ord_num " + ;
12667 " AND c.pick_num = p.pick_num " + ;
12668 " AND c.inv_num = p.inv_num "
12669
12670 llRetVal=llRetVal And v_SQLExec(lcSQLSelect, tcTransHeader)
12671
12672 v_SqlExecNoError("drop table " + .cSQLTempTable)
12673
12674 ENDIF
12675 ENDWITH
12676 SELECT (lnSelect)
12677 RETURN llRetVal
12678 ENDFUNC
12679
12680*=== TR 1081157 13-Oct-2014 Goutam
12681*============================================================
12682
12683
12684*- TR 1081638 FH - took from clsoowpr
12685FUNCTION ResolveZipCode
12686 LPARAMETERS tcAddress
12687 LOCAL llRetVal, lnSelect
12688
12689 llRetVal = true
12690 lnSelect = SELECT()
12691
12692 WITH This
12693 SELECT (tcAddress)
12694 REPLACE ALL zipcode WITH IIF(LEN(ALLTRIM(zipcode)) > 9 AND SUBSTR(zipcode,6,1) = "-", LEFT(zipcode,5) + SUBSTR(zipcode,7),zipcode)
12695 ENDWITH
12696
12697 SELECT (lnSelect)
12698 RETURN llRetVal
12699 ENDFUNC
12700*- TR 1081638 FH
12701
12702
12703 *--- TR 1086117 30-Jun-2015 Partha ---
12704
12705 ************************************************************************************
12706 * Validate Bill_num (BOL#)
12707 ***********************************************************************************
12708
12709 Procedure CheckBOL
12710 Lparameters tcTransHeader, tcControl
12711 Local llRetVal, lnOldSelect
12712 llRetVal = .T.
12713 lnOldSelect = Select()
12714
12715 This.oLog.LogEntry("Validating BOL Number...")
12716
12717 SELECT (tcTransHeader)
12718
12719 INDEX ON pkey TAG bt
12720 GO TOP
12721
12722 Select h.pkey, h.division,h.customer, c.use_bill, h.bill_num, h.track_no ;
12723 From (tcTransHeader) h, (tcControl) c ;
12724 Where h.division= c.division ;
12725 And h.customer= c.customer ;
12726 And ( (c.Use_Bill="Y" And h.bill_num = " ") ;
12727 OR (c.Use_Bill="T" And h.track_no = " ") ;
12728 OR (c.Use_Bill="E" And h.bill_num = " " And h.track_no = " ") ;
12729 OR (c.Use_Bill="B" And (h.bill_num = " " OR h.track_no = " ") ) ;
12730 ) ;
12731 Into Cursor _tmpCursor
12732
12733 Select _tmpCursor
12734 INDEX ON pkey TAG tbt
12735 SET RELATION TO pkey INTO (tcTransHeader)
12736 GO TOP IN (tcTransHeader)
12737 GO TOP
12738
12739 If This.lUserInterface
12740 This.InitThermo(This.CountTotalRecs ('_tmpCursor'))
12741 l_nThermoCnt = 0
12742 ENDIF
12743
12744
12745 SCAN
12746
12747 If This.lUserInterface
12748 l_nThermoCnt = l_nThermoCnt + 1
12749 This.AdvanceThermo(l_nThermoCnt)
12750 Endif
12751
12752 lcErr = ""
12753 DO CASE
12754 CASE Use_Bill="Y" And bill_num = " "
12755 lcErr = EDI_BOL_REQ_MSG
12756 CASE Use_Bill="T" And track_no = " "
12757 lcErr = EDI_TRACKNO_REQ_MSG
12758 CASE Use_Bill="E" And bill_num = " " And track_no = " "
12759 lcErr = EDI_BOL_OR_TRACKNO_REQ_MSG
12760 CASE Use_Bill="B" And (bill_num = " " OR track_no = " ")
12761 lcErr = EDI_BOL_AND_TRACKNO_REQ_MSG
12762 ENDCASE
12763
12764 Replace Errs_msg_h With Errs_msg_h + lcErr + CRLF, ;
12765 Errs_flg_h With "Y" In (tcTransHeader)
12766
12767 ENDSCAN
12768
12769 SET RELATION OFF INTO (tcTransHeader)
12770
12771 If Used('_tmpCursor')
12772 Use In _tmpCursor
12773 Endif
12774 If This.lUserInterface
12775 This.ResetThermo()
12776 ENDIF
12777
12778 Select(lnOldSelect)
12779
12780*!* This.ResultLogMsg(llRetVal)
12781
12782 Return llRetVal
12783 Endproc
12784
12785*============================================================
12786
12787 *=== TR 1086117 30-Jun-2015 Partha ===
12788
12789 *--- TR 1099603 18-Oct-2016 Partha ---
12790 Function IsAddlKey
12791 Lparameters tcEDITransaction, tcEiPOth
12792 Local llRetVal, lnOldSelect, lcControl, lcSQLSelect
12793 llRetVal = .T.
12794 lnOldSelect = Select()
12795
12796 WITH This
12797
12798 SELECT (tcEiPOth)
12799 llRetVal = llRetVal AND FieldExists("Edi_store")
12800
12801 tcEDITransaction= Iif(Empty(tcEDITransaction), "ipo", tcEDITransaction)
12802
12803 lcControl= "zze" + tcEDITransaction + "cr"
12804
12805 *- if process is 850 we should use c850Control table.
12806 IF UPPER(tcEDITransaction ) = 'IPO' AND NOT EMPTY(.c850Control)
12807 lcControl = .c850Control
12808 ENDIF
12809
12810 lcSQLSelect = "SELECT top 1 * FROM " + lcControl
12811 llRetVal=llRetVal And v_SQLExec(lcSQLSelect, "__curcon")
12812 IF llRetVal AND USED("__curcon")
12813 llRetVal = llRetVal AND FieldExists("Add_key_source")
12814 .TableClose("__curcon")
12815 ENDIF
12816 ENDWITH
12817
12818 Select(lnOldSelect)
12819 Return llRetVal
12820 Endfunc
12821
12822*============================================================
12823 *=== TR 1099603 18-Oct-2016 Partha ===
12824
12825
12826Enddefine