· 7 years ago · Feb 20, 2019, 10:22 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 *--- TechRec STRY0102322 26-Nov-2018 MPerel/FH ---
8473 SELECT aux_sku1 as aux_sku , p.* FROM (pcLineSLNPrepack) p INTO CURSOR _tempCursor
8474 .MakeCursorWritable("_tempCursor", pcLineSLNPrepack)
8475 *=== TechRec STRY0102322 26-Nov-2018 MPerel/FH ===
8476 .TableClose("_tempCursor")
8477 If Used(pcLineSLNPrepack)
8478 Select (pcLineSLNPrepack)
8479 Index On ITM_Pkey Tag ITM_Pkey
8480 ENDIF
8481
8482 Endwith
8483
8484 *- STRY0102322 FH
8485 SELECT aux_sku1 as aux_sku , p.* FROM (pcLineSLNPrepack) p INTO CURSOR (pcLineSLNPrepack) readwrite
8486 If Used(pcLineSLNPrepack)
8487 Select (pcLineSLNPrepack)
8488 Index On ITM_Pkey Tag ITM_Pkey
8489 Endif
8490
8491 Select(lnOldSelect)
8492 Return llRetVal
8493 Endproc
8494
8495 *= 1003239
8496
8497 *--- TR 1003431 02/23/04 AM
8498 *=========================================================================================================
8499 * 1004006 3/16/04 YIK Add new parameter pcSkipPpkUpc
8500 Procedure CheckOutboundEAN
8501 Lparameters pcTransHeader, pcTransDetail, pcSQLTempTable, plNotOverwriteSizeDesc, pcSkipPpkUpc
8502 Local llRetVal, lnOldSelect
8503 llRetVal = .T.
8504 lnOldSelect = Select()
8505 With This
8506
8507 *--->Added Prod_ID from zzxdivsr because now EAN check is Division specific
8508 lcSqlString= "Select t.division, t.style, t.color_code," +;
8509 "t.lbl_code, t.dimension, t.sizebucket, s.size_desc, "+;
8510 "s.EAN " +;
8511 "From zzeupcnr s, " + pcSQLTempTable + " t, zzxdivsr d " +;
8512 "Where s.division= t.division and " +;
8513 "s.division= d.division and " +;
8514 "s.style= t.style and s.color_code= t.color_code and " +;
8515 "s.lbl_code= t.lbl_code and s.dimension= t.dimension and " +;
8516 "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') "
8517 * --- 34208 10-Sep-02 DB2 CHECKED JN (forked code)
8518
8519 *--- TechRec 1028770 09-Jan-2008 vkrishnamurthy ---
8520 lcSQLString = lcSQLString + " AND t.sku_upc <> 'Y' AND t.sku_upc <> 'X' " && TR 1073064 30-Aug-13 Venuk added AND t.sku_upc <> 'X'
8521 *=== TechRec 1028770 09-Jan-2008 vkrishnamurthy ===
8522
8523 llRetVal = v_SQLexec(lcSqlString, "__EAN")
8524 If llRetVal And This.CountTotalRecs ("__EAN")>0
8525 * Populate EAN,size_desc from result of server-side temp keys + join zzeupcnr
8526 Select __EAN
8527 Index On division+Style+color_code+Lbl_code+Dimension+Str(sizebucket) ;
8528 Tag OurSku
8529 llRetVal= .SetRelation("__EAN", "OurSKU", pcTransDetail, ;
8530 "Division+Style+color_code+lbl_code+dimension+Str(sizebucket)")
8531 If llRetVal
8532 If plNotOverwriteSizeDesc
8533 Replace All ean With __EAN.ean In (pcTransDetail)
8534 Else
8535 *- 1005734 07/08/04 YIK
8536 *- Added ..FOR !EOF("__EAN") to avoid blanking out of size desc.
8537 Replace All ean With __EAN.ean, size_desc With __EAN.size_desc ;
8538 FOR !Eof("__EAN") ;
8539 in (pcTransDetail)
8540 Endif
8541 Set Relation To
8542 .TableClose('__EAN')
8543
8544 *--- TAN 1005398 05/26/2004 AM
8545 *--- Fix Shared EAN Functionality.
8546 Endif
8547 Endif
8548 * 2nd. pass to get EAN with substitution of Blank lbl_code
8549 * for all unresolve EAN
8550 lcSqlString= "Select division, Prod_ID From zzxdivsr"
8551 llRetVal = v_SQLexec(lcSqlString, "__DivRef")
8552 llRetVal= llRetVal And .CheckOutboundEANForBlankLabel(;
8553 pcTransHeader, pcTransDetail, pcSQLTempTable, plNotOverwriteSizeDesc)
8554 If llRetVal
8555 Select __DivRef
8556 Index On division Tag Div
8557 llRetVal = .SetRelation("__DivRef", "Div", pcTransDetail,"Division")
8558 *=== TAN 1005398 05/26/2004 AM
8559
8560 * After 2nd pass all empty(EAN) will be invalid if control ref
8561 * sku_upc="U" or "B"
8562 lcErrs_Msg= "Missing EAN."
8563 *- 1004006 3/16/04 YIK
8564 *!* Replace All Errs_Msg_D with Errs_Msg_D + lcErrs_Msg + CRLF, Errs_Flg_D With "Y" ;
8565 *!* In (pcTransDetail) For (sku_upc="U" or sku_upc="B") And Empty(ean)
8566
8567 *--- TechRec 1028770 14-Jan-2008 vkrishnamurthy ---
8568 *OR sku_upc = "X"
8569 *=== TechRec 1028770 14-Jan-2008 vkrishnamurthy ===
8570
8571 *--- TR 1073064 30-Aug-13 Venuk.
8572 *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
8573 *Iif(pcSkipPpkUpc, 'and (SkipPpkUpc = "N" or Implosion <> "Y") ', '')
8574 lcForExpr = '(sku_upc="E" or sku_upc="Z" OR sku_upc = "R" OR sku_upc = "A" ) And Empty(ean) ' + ;
8575 ' And (__DivRef.Prod_Id = "E" OR __DivRef.Prod_Id = "B") ' + ;
8576 Iif(pcSkipPpkUpc, 'and (SkipPpkUpc = "N" or Implosion <> "Y") ', '')
8577 *=== TR 1073064 30-Aug-13 Venuk.
8578
8579 *--- TR 1064585 21-Dec-2012 Goutam
8580 IF (TYPE(pcTransHeader + ".template") = "C") AND UPPER(SUBSTR(pcTransHeader, 4, 3)) = "OIN"
8581
8582 GO TOP IN (pcTransDetail)
8583 *--- TR 1073064 30-Aug-13 Venuk. Changed ='U' to 'E' and 'X' to 'Z'
8584* lcForExpr = '(a.sku_upc="U" or a.sku_upc="B" OR a.sku_upc = "X") And Empty(a.ean) And __DivRef.Prod_Id = "E" ' + ;
8585* Iif(pcSkipPpkUpc, 'and (a.SkipPpkUpc = "N" or a.Implosion <> "Y") ', '')
8586
8587 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 ' + ;
8588 + '(__DivRef.Prod_Id = "E" OR __DivRef.Prod_Id = "B")' + Iif(pcSkipPpkUpc, 'and (a.SkipPpkUpc = "N" or a.Implosion <> "Y") ', '')
8589 *=== TR 1073064 30-Aug-13 Venuk.
8590
8591 lcSqlString = " UPDATE a SET Errs_Msg_D = Errs_Msg_D + lcErrs_Msg + CHR(13) + CHR(10), Errs_Flg_D = 'Y' " + ;
8592 " from (pcTransDetail) a join (pcTransHeader) b on b.pkey = a.fkey " + ;
8593 " join __DivRef d on d.division = a.division " + ;
8594 " WHERE " + lcForExpr + " AND UPPER(b.template) <> 'FORZANI 5010'"
8595
8596 &lcSqlString
8597
8598 *llRetVal= llRetVal and .SetRelation(pcTransHeader, "PKEY", pcTransDetail, "FKEY")
8599 *lcForExpr = lcForExpr + " AND !UPPER(&pcTransHeader..template) = 'FORZANI 5010'"
8600 *Replace All Errs_Msg_D With Errs_Msg_D + lcErrs_Msg + CRLF, Errs_Flg_D With "Y" ;
8601 In (pcTransDetail) For &lcForExpr
8602 *SET RELATION TO
8603 ELSE
8604 *=== TR 1064585 21-Dec-2012 Goutam
8605
8606 Replace All Errs_Msg_D With Errs_Msg_D + lcErrs_Msg + CRLF, Errs_Flg_D With "Y" ;
8607 In (pcTransDetail) For &lcForExpr
8608
8609 *--- TR 1064585 21-Dec-2012 Goutam
8610 ENDIF
8611 *=== TR 1064585 21-Dec-2012 Goutam
8612
8613 *--- TAN 1005398 05/26/2004 AM
8614 Set Relation To
8615 .TableClose('__DivRef')
8616 *=== TAN 1005398 05/26/2004 AM
8617 *= 1004006
8618 *--- TAN 1005398 05/26/2004 AM
8619 *--- Moved Endif Above
8620 Endif
8621 * Endif
8622 *--- TAN 1005398 05/26/2004 AM
8623
8624 Endwith
8625
8626 Select(lnOldSelect)
8627 Return llRetVal
8628 Endproc
8629
8630 *=========================================================================================================
8631
8632 Procedure CheckOutboundEANForBlankLabel
8633 Lparameters pcTransHeader, pcTransDetail, pcSQLTempTable, plNotOverwriteSizeDesc
8634 Local llRetVal, lnOldSelect
8635 llRetVal = .T.
8636 lnOldSelect = Select()
8637
8638 With This
8639 *--- TAN 1005398 05/26/2004 AM
8640 *--->Added Prod_ID from zzxdivsr because now UPC check is Division specific
8641 *--- TR 1073064 30-Aug-13 Venuk. Added d.Prod_ID = 'B' ===
8642 *--- TR 1073064/1065007 30-Aug-13 Venuk. Added d.Prod_ID = 'B' === Fix was missing from above TR only comment was available
8643 lcSQLString1= "Select t.division, t.style, t.color_code," +;
8644 "t.dimension, t.sizebucket, s.size_desc, "+;
8645 "s.EAN " +;
8646 "From zzeupcnr s, " + pcSQLTempTable + " t, zzxdivsr d " +;
8647 "Where s.division= t.division and " +;
8648 "s.division= d.division and " +;
8649 "s.style= t.style and s.color_code= t.color_code and " +;
8650 "s.lbl_code= '' and s.dimension= t.dimension and " +;
8651 "s.sizebucket= t.sizebucket and (d.Prod_ID = 'E' or d.Prod_ID = 'B')" && Blank lbl_code UPC
8652 * === 34208 10-Sep-02 JN DB2 CHECKED forked code
8653
8654 *--- TechRec 1028770 09-Jan-2008 vkrishnamurthy ---
8655 lcSQLString1 = lcSQLString1 + " AND t.sku_upc <> 'Y' AND t.sku_upc <> 'X' " && TR 1073064 30-Aug-13 Venuk added AND t.sku_upc <> 'X'
8656 *=== TechRec 1028770 09-Jan-2008 vkrishnamurthy ===
8657
8658 llRetVal= llRetVal And v_SQLexec(lcSQLString1, "TempEAN")
8659
8660 * Share UPC List (Blank lbl_code)
8661 lcSqlString= "Select distinct division, style, color_code," +;
8662 "dimension, sizebucket, size_desc, EAN "+;
8663 "From TempEAN group by 1,2,3,4,5,6,7 "
8664 llRetVal = llRetVal And v_SQLexec(lcSqlString, "__EAN",, true) &&local
8665
8666 *- 1005734 07/08/04 YIK
8667 *- added ..And This.CountTotalRecs ("__EAN")>0
8668 If llRetVal And This.CountTotalRecs ("__EAN")>0
8669 Select __EAN
8670 Index On division+Style+color_code+Dimension+Str(sizebucket) ;
8671 Tag OurSku
8672 llRetVal= .SetRelation("__EAN", "OurSKU", pcTransDetail, ;
8673 "Division+Style+color_code+dimension+Str(sizebucket)")
8674 If llRetVal
8675 * Populate EAN with share EAN List
8676 If plNotOverwriteSizeDesc
8677 Replace All ean With __EAN.ean In (pcTransDetail) For Empty(ean)
8678 Else
8679 *- 1005734 07/08/04 YIK
8680 *- Added ..FOR !EOF("__EAN") to avoid blanking out of size desc.
8681 Replace All ean With __EAN.ean, size_desc With __EAN.size_desc ;
8682 in (pcTransDetail) For Empty(ean) And !Eof("__EAN")
8683 Endif
8684 Set Relation To
8685 Endif
8686 Endif
8687 .TableClose('__EAN')
8688 .TableClose('TempEAN')
8689 Endwith
8690 Select(lnOldSelect)
8691 Return llRetVal
8692 Endproc
8693 *=============================================================================================================
8694 Procedure CheckOutboundSLNEAN
8695 Lparameters pcTransHeader, pcTransDetail, pcSLNPrePack, pcSQLTempTable, pcLocalSQLTempTable
8696 Local llRetVal, lnOldSelect
8697 llRetVal = .T.
8698 lnOldSelect = Select()
8699 With This
8700
8701 * 1st pass Populate EAN,size_desc using exact match on div,sty,col,lbl,dim
8702 *--->Added Prod_ID from zzxdivsr because now EAN check is Division specific
8703 lcSqlString= "Select t.division, t.style, t.color_code," +;
8704 "t.lbl_code, t.dimension, t.sizebucket, s.size_desc, "+;
8705 "t.PPK_style, t.PPK_color,t.PPK_label, t.PPK_dimension, "+;
8706 "s.EAN " +;
8707 "From zzeupcnr s, " + pcSQLTempTable + " t, zzxdivsr d " +;
8708 "Where s.division= t.division and " +;
8709 "s.division= d.division and " +;
8710 "s.style= t.style and s.color_code= t.color_code and " +;
8711 "s.lbl_code= t.lbl_code and s.dimension= t.dimension and " +;
8712 "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'
8713 * === TAN 34208 16-Oct-02 JN DB2 CHECKED
8714
8715 *--- TechRec 1028770 09-Jan-2008 vkrishnamurthy ---
8716 lcSQLString = lcSQLString + " AND t.sku_upc <> 'Y' and t.sku_upc <> 'X' " && TR 1073064 30-Aug-13 Venuk. Added t.sku_upc <> 'X''
8717 *=== TechRec 1028770 09-Jan-2008 vkrishnamurthy ===
8718
8719 llRetVal = v_SQLexec(lcSqlString, "__EAN")
8720 If llRetVal And This.CountTotalRecs ("__EAN")>0
8721 * Populate EAN,size_desc from result of server-side temp keys + join zzeupcnr
8722 Select __EAN
8723 Index On division+Style+color_code+Lbl_code+Dimension+Str(sizebucket) ;
8724 Tag OurSku
8725 llRetVal= .SetRelation("__EAN", "OurSKU", pcSLNPrePack, ;
8726 "Division+Style+color_code+lbl_code+dimension+Str(sizebucket)")
8727 If llRetVal
8728 *- 1005734 07/08/04 YIK
8729 *- Added ..FOR !EOF("__EAN") to avoid blanking out of size desc.
8730 Replace All ean With __EAN.ean, size_desc With __EAN.size_desc ;
8731 FOR !Eof("__EAN") ;
8732 in (pcSLNPrePack)
8733 Set Relation To
8734 .TableClose('__EAN')
8735
8736 *--- TAN 1005398 05/27/2004 AM
8737 Endif
8738 Endif
8739 *=== TAN 1005398 05/27/2004 AM
8740
8741 * 2nd. pass to get EAN with substitution of Blank lbl_code
8742 * for all unresolve EAN
8743 llRetVal= llRetVal And .CheckOutboundSLNEANForBlankLabel(;
8744 pcTransHeader, pcTransDetail, pcSLNPrePack, pcSQLTempTable)
8745
8746 * After 2nd pass all component in tcSLN with empty(EAN)
8747 * will be invalid if control ref set sku_upc="U" or "B"
8748 llRetVal= llRetVal And .ValidateOutboundSLNEAN(;
8749 pcTransHeader, pcTransDetail, pcSLNPrePack, ;
8750 pcSQLTempTable, pcLocalSQLTempTable)
8751
8752 *--- TAN 1005398 05/27/2004 AM
8753 * Endif
8754 * Endif
8755 *--- TAN 1005398 05/27/2004 AM
8756
8757 Endwith
8758
8759 Select(lnOldSelect)
8760 Return llRetVal
8761 Endproc
8762 *==============================================================================================================
8763
8764 Procedure CheckOutboundSLNEANForBlankLabel
8765 Lparameters pcTransHeader, pcTransDetail, pcSLNPrePack, pcSQLTempTable
8766 Local llRetVal, lnOldSelect
8767 llRetVal = .T.
8768 lnOldSelect = Select()
8769
8770 With This
8771 *--- TAN 1005398 05/26/2004 AM
8772 *--->Added Prod_ID from zzxdivsr because now EAN check is Division specific
8773 lcSQLString1= "Select t.division, t.style, t.color_code," +;
8774 "t.dimension, t.sizebucket, s.size_desc, "+;
8775 "t.PPK_style, t.PPK_color,t.PPK_label, t.PPK_dimension, "+;
8776 "s.EAN " +;
8777 "From zzeupcnr s, " + pcSQLTempTable + " t, zzxdivsr d " +;
8778 "Where s.division= t.division and " +;
8779 "s.division= d.division and " +;
8780 "s.style= t.style and s.color_code= t.color_code and " +;
8781 "s.lbl_code= '' and s.dimension= t.dimension and " +; && Blank lbl_code EAN
8782 "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'
8783 * --- TAN 34208 16-Oct-02 JN
8784
8785 *--- TechRec 1028770 09-Jan-2008 vkrishnamurthy ---
8786 lcSQLString1 = lcSQLString1 + " AND t.sku_upc <> 'Y' AND t.sku_upc <> 'X' " && TR 1073064 30-Aug-13 Venuk. Added t.sku_upc <> 'X'
8787 *=== TechRec 1028770 09-Jan-2008 vkrishnamurthy ===
8788
8789 llRetVal= llRetVal And v_SQLexec(lcSQLString1, "TempEAN")
8790
8791 * Share EAN List (Blank lbl_code)
8792 lcSqlString= "Select distinct division, style, color_code," +;
8793 "dimension, sizebucket, size_desc, EAN "+;
8794 "From TempEAN group by 1,2,3,4,5,6,7 "
8795 llRetVal = llRetVal And v_SQLexec(lcSqlString, "__EAN",, true) &&local
8796
8797 *- 06/11/04 1005734 YIK
8798 *- Added .. AND RECC("__EAN") > 0
8799 If llRetVal And Recc("__EAN") > 0
8800 Select __EAN
8801 Index On division+Style+color_code+Dimension+Str(sizebucket) ;
8802 Tag OurSku
8803 llRetVal= .SetRelation("__EAN", "OurSKU", pcSLNPrePack, ;
8804 "Division+Style+color_code+dimension+Str(sizebucket)")
8805 If llRetVal
8806 * Populate EAN with share EAN List
8807 *- 1005734 07/08/04 YIK
8808 *- Added ..FOR !EOF("__EAN") to avoid blanking out of size desc.
8809 Replace All ean With __EAN.ean, size_desc With __EAN.size_desc ;
8810 in (pcSLNPrePack) For Empty(ean) And !Eof("__EAN")
8811 Set Relation To
8812 Endif
8813 Endif
8814 .TableClose('__EAN')
8815 .TableClose('TempEAN')
8816 Endwith
8817 Select(lnOldSelect)
8818 Return llRetVal
8819 Endproc
8820
8821 *===========================================================================================================
8822 Procedure ValidateOutboundSLNEAN
8823 Lparameters pcTransHeader, pcTransDetail, pcSLNPrePack, pcSQLTempTable, pcLocalSQLTempTable
8824 Local llRetVal, lnOldSelect, lcSqlString, lcSQLString1
8825 Private pcLocalDivRef
8826 llRetVal = .T.
8827 lnOldSelect = Select()
8828 pcLocalDivRef = GetUniqueFileName()
8829
8830 * PrePackSKU order
8831 Select (pcTransDetail)
8832 Set Order To OurSku
8833
8834 With This
8835 * list of all missing EAN group by PrePackSKU
8836 *--- TAN 1005398 05/26/2004 AM
8837 *--->Added Prod_ID from zzxdivsr because now UPC check is Division specific
8838 *--->We Need Local Division Reference
8839 lcSqlString= "Select division,Prod_ID from zzxdivsr"
8840 llRetVal= llRetVal And v_SQLexec(lcSqlString,pcLocalDivRef)
8841
8842 lcSQLString1= "Select distinct t.division, t.style, t.color_code," +;
8843 "t.lbl_code, t.dimension, t.sizebucket, t.size_desc, "+;
8844 "t.PPK_style, t.PPK_color,t.PPK_label, t.PPK_dimension "+;
8845 "From " + pcLocalSQLTempTable + " s, " + pcSLNPrePack + " t, " + pcLocalDivRef + " d " +;
8846 "Where s.division= t.division and " +;
8847 "s.division= d.division and " +;
8848 "s.style= t.style and s.color_code= t.color_code and " +;
8849 "s.lbl_code= t.lbl_code and s.dimension= t.dimension and " +;
8850 "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'
8851 "order by t.division,t.PPK_style, t.PPK_color,t.PPK_label, t.PPK_dimension"
8852 llRetVal= llRetVal And v_SQLexec(lcSQLString1, "tcNoEAN",, true) &&local
8853
8854 .TableClose(pcLocalDivRef)
8855 *=== TR 1005398
8856
8857 * Consolidate all missing UPC components for same PrePackSKU together in lcErrs_Msg
8858 If llRetVal
8859 Select tcNoEAN
8860 Index On division + PPK_style + PPK_color + PPK_label + PPK_dimension ;
8861 Tag PPackSKU
8862 Do While llRetVal And !Eof('tcNoEAN')
8863 lcCurPPackSKU= division + PPK_style + PPK_color + PPK_label + PPK_dimension
8864 lcErrs_Msg= "Missing Prepack component EAN : "+ CRLF
8865 Scan While division + PPK_style + PPK_color + PPK_label + PPK_dimension == ;
8866 lcCurPPackSKU
8867 lcErrs_Msg= lcErrs_Msg + "Div:" + division + " Style: " + Style + ;
8868 " Color: " + color_code + "Label: " + Lbl_code + "Dm/Pk:" + Dimension +;
8869 " Size: " + Str(sizebucket) + CRLF
8870 Endscan
8871 * after accumulate all missing EAN components for same PrePackSKU
8872 * seek for all detail lines that use that PrePackSKU and append proper
8873 * error message/flag.
8874 Select (pcTransDetail)
8875 If Seek(lcCurPPackSKU, pcTransDetail, "OurSKU" )
8876 Scan While division+ Style+ color_code+ Lbl_code+ Dimension == lcCurPPackSKU
8877 Replace Errs_Msg_D With Errs_Msg_D + lcErrs_Msg, Errs_Flg_D With "Y" ;
8878 In (pcTransDetail)
8879 Endscan
8880 Endif
8881 Select tcNoEAN
8882 Enddo
8883 Endif
8884 .TableClose('tcNoEAN')
8885 Endwith
8886 Select(lnOldSelect)
8887 Return llRetVal
8888 Endproc
8889 *=============================================================================================================
8890 *=== TR 1003431 02/23/04 AM
8891
8892 *- 1006052 07/01/04 YIK
8893 Procedure PopulateSLNsForRangeP
8894 Lparameters pcCurRangeSKU, pcTransDetail
8895 Local lnOldSelect, llRetVal, lnCount, loRecord, lnOrigPkey, lnPkey
8896
8897 *- TR 1066415 FH
8898 LOCAL lnCancelQty, lnInvQty
8899 lnCancelQty = 0
8900 lnInvQty = 0
8901 *-TR 1066415 FH
8902
8903 lnOldSelect = Select()
8904 With This
8905 * Consolidate group of trans. detail for same range style
8906 If Seek(pcCurRangeSKU, pcTransDetail, "RangeSKU") && ..and sln_req = 'Y'
8907 Select (pcTransDetail)
8908 lnOrigPkey = Pkey
8909 *- specific for the 855 and 810 process!!!
8910 lnDetQty = Total_qty
8911
8912 &&TR 1066415 FH cancelqty/invqty exist
8913 IF TYPE(pcTransDetail + ".cancelqty") = "N"
8914 lnCancelQty = cancelqty
8915 endif
8916 IF TYPE(pcTransDetail + ".invoiceqty") = "N"
8917 lnInvQty = invoiceqty
8918 endif
8919 &&TR 1066415 FH cancelqty/invqty exist
8920
8921 Scatter Name loRecord
8922 *- remove the range style record
8923 If !(sln_req = 'Y') Or .T. && don't support sln_req for range style 'P'
8924 Delete
8925 Endif
8926
8927 *- Get all components for this range style
8928 *--- TR 1060800 24-May-2012 Goutam. Added join zzxrangh h on h.pkey = d.fkey
8929 lcSqlString = "select d.Division, d.Style, d.Color_code, d.Lbl_Code, d.Dimension, Size_Num as Size_Bk, " + ;
8930 "d.Size01_Qty*Sz01 + d.Size02_Qty*Sz02+ " + ;
8931 "d.Size03_Qty*Sz03 + d.Size04_Qty*Sz04+ " + ;
8932 "d.Size05_Qty*Sz05 + d.Size06_Qty*Sz06+ " + ;
8933 "d.Size07_Qty*Sz07 + d.Size08_Qty*Sz08+ " + ;
8934 "d.Size09_Qty*Sz09 + d.Size10_Qty*Sz10+ " + ;
8935 "d.Size11_Qty*Sz11 + d.Size12_Qty*Sz12+ " + ;
8936 "d.Size13_Qty*Sz13 + d.Size14_Qty*Sz14+ " + ;
8937 "d.Size15_Qty*Sz15 + d.Size16_Qty*Sz16+ " + ;
8938 "d.Size17_Qty*Sz17 + d.Size18_Qty*Sz18+ " + ;
8939 "d.Size19_Qty*Sz19 + d.Size20_Qty*Sz20+ " + ;
8940 "d.Size21_Qty*Sz21 + d.Size22_Qty*Sz22+ " + ;
8941 "d.Size23_Qty*Sz23 + d.Size24_Qty*Sz24 as Qty, " + ;
8942 "d.a_price, d.b_price, d.c_price, d.d_price, d.e_price " + ;
8943 " ,h.rng_qty " + ; &&*--- TR 1060800 24-May-2012 Goutam
8944 " ,h.rng_type " + ; &&*--- TR 1060800 24-May-2012 Goutam
8945 "from zzxrangd d " + ;
8946 "join zzxrangh h on h.pkey = d.fkey " + ; &&*--- TR 1060800 24-May-2012 Goutam
8947 "cross join zzxbuckt b " + ;
8948 "where d.Size01_Qty*Sz01 + d.Size02_Qty*Sz02+ " + ;
8949 "d.Size03_Qty*Sz03 + d.Size04_Qty*Sz04+ " + ;
8950 "d.Size05_Qty*Sz05 + d.Size06_Qty*Sz06+ " + ;
8951 "d.Size07_Qty*Sz07 + d.Size08_Qty*Sz08+ " + ;
8952 "d.Size09_Qty*Sz09 + d.Size10_Qty*Sz10+ " + ;
8953 "d.Size11_Qty*Sz11 + d.Size12_Qty*Sz12+ " + ;
8954 "d.Size13_Qty*Sz13 + d.Size14_Qty*Sz14+ " + ;
8955 "d.Size15_Qty*Sz15 + d.Size16_Qty*Sz16+ " + ;
8956 "d.Size17_Qty*Sz17 + d.Size18_Qty*Sz18+ " + ;
8957 "d.Size19_Qty*Sz19 + d.Size20_Qty*Sz20+ " + ;
8958 "d.Size21_Qty*Sz21 + d.Size22_Qty*Sz22+ " + ;
8959 "d.Size23_Qty*Sz23 + d.Size24_Qty*Sz24 > 0 " + ;
8960 " AND d.Division = " + SQLFormatChar(loRecord.division) + ; &&*--- TR 1060800 24-May-2012 Goutam. Added d.
8961 " AND d.rng_style = " + SQLFormatChar(loRecord.rng_style) + ; &&*--- TR 1060800 24-May-2012 Goutam. Added d.
8962 " AND d.rng_color = " + SQLFormatChar(loRecord.rng_color) + ; &&*--- TR 1060800 24-May-2012 Goutam. Added d.
8963 " AND d.rng_lbl = " + SQLFormatChar(loRecord.rng_lbl) + ; &&*--- TR 1060800 24-May-2012 Goutam. Added d.
8964 " AND d.rng_pack = " + SQLFormatChar(loRecord.rng_pack) &&*--- TR 1060800 24-May-2012 Goutam. Added d.
8965
8966 v_SQLexec(lcSqlString, "tcRangVert")
8967
8968 lnCount = Reccount("tcRangVert")
8969 Do Case
8970 Case Lower(pcTransDetail) = "tceoshtd"
8971 lcPkeySource = "ZZEOSHTD"
8972 lcProcess = "OSH"
8973 Case Lower(pcTransDetail) = "tceoprtd"
8974 lcPkeySource = "ZZEOPRTD"
8975 lcProcess = "OPR"
8976 Case Lower(pcTransDetail) = "tceointd"
8977 lcPkeySource = "ZZEOINTD"
8978 lcProcess = "OIN"
8979
8980 *--- TR 1017241 13-JUL-2006 Goutam
8981 Case Lower(pcTransDetail) = "tceoowtd"
8982 lcPkeySource = "ZZEOOWTD"
8983 lcProcess = "OOW"
8984 *=== TR 1017241 13-JUL-2006 Goutam
8985
8986 *--- TR 1044022 17-Feb-2010 JK
8987 Case Lower(pcTransDetail) = "tce3ploswtd"
8988 lcPkeySource = "ZZE3PLOSWTD"
8989 lcProcess = "OSW3P"
8990 *=== TR 1044022 17-Feb-2010 JK
8991
8992 *--- TR 1051461 31-DEC-2010 HNISAR
8993 Case Lower(pcTransDetail) = "tceorstd"
8994 lcPkeySource = "ZZEORSTD"
8995 lcProcess = "ORS"
8996 *=== TR 1051461 31-DEC-2010 HNISAR
8997
8998 Otherwise
8999 Endcase
9000
9001 lnPkey = v_NextPkey(lcPkeySource, lnCount)
9002 lnCount = lnCount - 1
9003 lnPkey = lnPkey - lnCount && Starting pKey
9004 Select tcRangVert
9005 Scan
9006 loRecord.Style = tcRangVert.Style
9007 loRecord.color_code = tcRangVert.color_code
9008 loRecord.Lbl_code = tcRangVert.Lbl_code
9009 loRecord.Dimension = tcRangVert.Dimension
9010 loRecord.sizebucket = tcRangVert.size_bk
9011 *--- TR 1035944 09/30/2008 TEJAS : Need to initialize UPC/SKU
9012 loRecord.upc = ''
9013 loRecord.sku = ''
9014 loRecord.ean = ''
9015 *=== TR 1035944 09/30/2008 TEJAS : Need to initialize UPC/SKU
9016 Do Case
9017 Case lcProcess = "OSH"
9018 *- 1052097 01/26/11 YIK
9019 *- Qty in the 856 flat file is always = 1. Need to consider number of range styles packed in a carton
9020 *- loRecord.Total_qty = tcRangVert.qty
9021
9022 *--- TR 1085613 30-Mar-2015 BNarayanan ---
9023 *loRecord.Total_qty = tcRangVert.qty*lnDetQty
9024 IF EMPTY(loRecord.ppk_action) AND tcRangVert.rng_type = 'P' AND loRecord.rngp_conv = 'R'
9025 loRecord.Total_qty = tcRangVert.qty*lnDetQty/tcRangVert.rng_qty
9026 ELSE
9027 loRecord.Total_qty = tcRangVert.qty*lnDetQty
9028 ENDIF
9029 *=== TR 1085613 30-Mar-2015 BNarayanan ===
9030
9031 &&TR 1066415 FH cancelqty/invqty exist
9032 IF TYPE(pcTransDetail + ".cancelqty") = "N"
9033 loRecord.cancelqty = tcRangVert.qty*lnCancelQty
9034 ENDIF
9035 IF TYPE(pcTransDetail + ".invoiceqty") = "N"
9036 loRecord.invoiceqty = tcRangVert.qty*lnInvQty
9037 endif
9038 &&TR 1066415 FH cancelqty/invqty exist
9039
9040 Case lcProcess = "OPR"
9041 loRecord.Total_qty = tcRangVert.qty*lnDetQty
9042
9043 *--- TR 1051461 31-DEC-2010 HNISAR
9044*!* Case lcProcess = "OIN"
9045 CASE INLIST(lcProcess ,"OIN","ORS")
9046 *=== TR 1051461 31-DEC-2010 HNISAR
9047
9048 *--- TR 1060800 24-May-2012 Goutam
9049 *loRecord.Total_qty = tcRangVert.qty*lnDetQty
9050 *--- TR 1063235 10-Aug-2012 Goutam
9051 *IF lcProcess = "OIN" AND EMPTY(loRecord.ppk_action) AND tcRangVert.rng_type = 'P' AND loRecord.rngp_conv = 'R' AND loRecord.Rng_impl = 'N'
9052 IF lcProcess = "OIN" AND EMPTY(loRecord.ppk_action) AND tcRangVert.rng_type = 'P' AND loRecord.rngp_conv = 'R'
9053 *=== TR 1063235 10-Aug-2012 Goutam
9054
9055 *--- TR 1063235 12-Sep-2012 Goutam
9056 *loRecord.Total_qty = lnDetQty/tcRangVert.rng_qty
9057 loRecord.Total_qty = tcRangVert.qty*lnDetQty/tcRangVert.rng_qty
9058 *=== TR 1063235 12-Sep-2012 Goutam
9059
9060 ELSE
9061 loRecord.Total_qty = tcRangVert.qty*lnDetQty
9062 ENDIF
9063 *=== TR 1060800 24-May-2012 Goutam
9064
9065 *--- TR 1017241 13-JUL-2006 Goutam
9066 Case lcProcess = "OOW"
9067 loRecord.Total_qty = tcRangVert.qty*lnDetQty
9068 *--- TR 1017241 13-JUL-2006 Goutam
9069
9070 *--- TR 1044022 17-Feb-2010 JK
9071 Case lcProcess = "OSW3P"
9072 loRecord.Total_qty = tcRangVert.qty*lnDetQty
9073 *--- TR 1044022 17-Feb-2010 JK
9074
9075 Otherwise
9076 Endcase
9077 loRecord.orig_qty= loRecord.Total_qty
9078 lcPrice_code= Iif(Empty(loRecord.price_code), 'a', loRecord.price_code)
9079 lnPrice= Eval("tcRangVert." + lcPrice_code + "_price")
9080 loRecord.price= lnPrice
9081 loRecord.org_price= lnPrice
9082 loRecord.Pkey = lnPkey
9083 lnPack_Total = loRecord.Total_qty
9084 lnPack_qty = loRecord.rng_qty
9085
9086 If !(Used("tmpStylr") And (tmpStylr.division= loRecord.division And tmpStylr.Style= loRecord.Style))
9087 vl_stylr(loRecord.division,, "tmpStylr", loRecord.Style)
9088 Endif
9089 loRecord.style_name = tmpStylr.style_name
9090 loRecord.po4_uom = tmpStylr.uom
9091 * in getsizedesc also compare for current temp cursor size_code
9092 loRecord.size_desc = This.GetSizeDesc(loRecord.division, tmpStylr.size_code, loRecord.sizebucket)
9093 If vl_colrr(loRecord.color_code,,"tmpcolrr")
9094 loRecord.color_name = tmpcolrr.color_name
9095 *- Only used in the 855
9096 *- 1008204 11/30/04 YIK
9097 *- Add loRecord.
9098 If Vartype(loRecord.nrf_color) <> "U"
9099 loRecord.nrf_color = tmpcolrr.nrf_color
9100 Endif
9101 Endif
9102 *- Only used in the 855
9103 *- 1008204 11/30/04 YIK
9104 *- Add loRecord.
9105 If Vartype(loRecord.nrf_size) <> "U" And ;
9106 vl_dimer(loRecord.division,,"tmpdimer", tmpStylr.size_code)
9107 lcFldName = "tmpdimer.nrf_sz" + Padl(Alltrim(Trans(loRecord.sizebucket, "99")), 2, '0')
9108 loRecord.nrf_size = Eval(lcFldName)
9109 Endif
9110
9111 If loRecord.sln_req = 'Y' And .F. && sln_req = 'Y' doesn't work for "P". itm_pkey is defined later...
9112 lnPPsize_qty = loRecord.Total_qty
9113 Select tcRangeSLN
9114 Append Blank
9115 Gather Name loRecord
9116 Replace ITM_Pkey With lnOrigPkey, ;
9117 PPSize_qty With lnPPsize_qty, ;
9118 Pack_total With lnPack_Total, ;
9119 pack_qty With lnPack_qty, ;
9120 PPK_style With loRecord.rng_style, ;
9121 PPK_color With loRecord.rng_color, ;
9122 PPK_label With loRecord.rng_lbl, ;
9123 PPK_dimension With loRecord.rng_pack
9124 Else
9125 Select (pcTransDetail)
9126 Append Blank
9127 Gather Name loRecord
9128 Endif
9129 lnPkey = lnPkey + 1
9130 Select tcRangVert
9131 Endscan
9132 Endif
9133 Endwith
9134 Endproc
9135 *= 1006052
9136
9137 *- 1006646 08/12/04 YIK
9138 *- Moved this routine from clsoinpr (810 process) and made it generic
9139 *- in order to handle Header discounts (SACs) for the 856 process as well.
9140 Procedure GetInboundHistory
9141 Parameters tcTransHeader, tcEDIControl
9142 Local llRetVal, lcSqlString
9143 llRetVal = .T.
9144 lnOldSelect = Select()
9145 *- 1005333 05/18/04 YIK
9146 *- add ..OR h.chk_hist = 'Y' to get SAC_HREF1..HREF3, SAC_HRATE1..HRATE3
9147 lcSqlString = ;
9148 " Select distinct ord_num From " + tcTransHeader + " h, " + ;
9149 tcEDIControl + " c " + ;
9150 " Where h.division= c.division and h.customer= c.customer and " + ;
9151 "( " + Iif(Upper(tcEDIControl) = 'ZZEOINCR', " c.merge_hhis= 'Y' OR ", "") + ;
9152 " h.chk_hist = 'Y') " + ;
9153 " Into Cursor __TmpCursor"
9154
9155 &lcSqlString
9156
9157 With This
9158 .cSQLTempTable=""
9159 If .GenerateSQLTempTable('__TmpCursor')
9160 If .PopulateSQLTempTable('__TmpCursor')
9161 If !Empty(.cSQLTempTable)
9162 *- 1007424 10/06/04 YIK
9163 *- Add h.prod_desc
9164 *- 1007299 10/12/04 YIK
9165 *- Added sales_cond
9166 *-- tr 1012389 NH : AUG-02-05 : Added column merch_type
9167 *--- TechRec 1035578 10-Oct-2008 T.Shenbagavalli added h.mfg_id ---
9168 *--- TR 1049812 9/6/10 CM --- Added h.oVnd_Key
9169 lcSqlString = "Select h.ord_num,h.promotion, h.batch_num, h.fob_code, h.mfg_id, " +;
9170 " h.po_purp, h.po_type,h.po_date, h.SAC_HREF1, h.SAC_HREF2, h.SAC_HREF3," +;
9171 " h.SAC_HRate1, h.SAC_HRate2, h.SAC_HRate3, h.prod_desc, h.sales_cond, h.merch_type," +;
9172 " h.oVnd_Key " + ;
9173 " From zzeipohh h, " + .cSQLTempTable + " t " +;
9174 " Where h.ord_num= t.ord_num"
9175
9176 llRetVal = v_SQLexec(lcSqlString, "__HHist")
9177 If llRetVal
9178 Select __HHist
9179 Index On ord_num Tag ord_num
9180 llRetVal= .SetRelation("__HHist", "ord_num", tcTransHeader, "ord_num")
9181 If llRetVal
9182 *- 1007189 10/06/04 YIK
9183 *- Add h.prod_desc
9184 *- 1007299 10/12/04 YIK
9185 *- Added sales_cond
9186
9187 Replace All promotion With __HHist.promotion, batch_num With __HHist.batch_num, ;
9188 fob_code With __HHist.fob_code, po_purp With __HHist.po_purp, ;
9189 po_type With __HHist.po_type, po_date With __HHist.po_date, ;
9190 SAC_HREF1 With __HHist.SAC_HREF1, SAC_HREF2 With __HHist.SAC_HREF2, ;
9191 SAC_HREF3 With __HHist.SAC_HREF3, SAC_HRate1 With __HHist.SAC_HRate1, ;
9192 SAC_HRate2 With __HHist.SAC_HRate2, SAC_HRate3 With __HHist.SAC_HRate3, ;
9193 prod_desc With __HHist.prod_desc, sales_cond With __HHist.sales_cond ;
9194 in (tcTransHeader)
9195
9196 *--- TechRec 1035578 10-Oct-2008 T.Shenbagavalli ---
9197 IF FieldExists("mfg_id", tcTransHeader)
9198 REPLACE ALL mfg_id with __HHist.mfg_id In (tcTransHeader)
9199 endif
9200 *=== TechRec 1035578 10-Oct-2008 T.Shenbagavalli ===
9201
9202 *-- tr 1012389 NH : AUG-02-05 : update transheader merch_type value
9203 *--- TR 1034402 01-Jul-2008 Partha : allow unconditional update ---
9204 *If Upper(Alltrim(tcEDIControl)) == "ZZEOSHCR"
9205 *=== TR 1034402 01-Jul-2008 Partha ===
9206 Replace All merch_type With __HHist.merch_type In (tcTransHeader)
9207 *--- TR 1034402 01-Jul-2008 Partha ---
9208 *ENDIF
9209 *=== TR 1034402 01-Jul-2008 Partha ===
9210
9211 * --- TR 1049812 9/6/10 CM
9212 If Vartype(oVnd_Key) == 'C'
9213 Replace All oVnd_Key With __HHist.oVnd_Key In (tcTransHeader)
9214 Endif
9215 * === TR 1049812 9/6/10 CM
9216
9217 Set Relation To
9218 Use In __HHist
9219 Endif
9220 Endif
9221
9222 * --- TR 1043960 5/25/10 CM
9223 * Pull merch_type from 860 History if orders were not originally
9224 * created via the 850
9225 If Upper(Alltrim(tcEDIControl)) == "ZZEOSHCR"
9226 lcSqlString = "Select h.ord_num, h.merch_type " + ;
9227 " From zzeipchh h, " + .cSQLTempTable + " t " +;
9228 " Where h.ord_num= t.ord_num"
9229
9230 llRetVal = v_SQLexec(lcSqlString, "__860Hist")
9231 If llRetVal
9232 Select __860Hist
9233 Index On ord_num Tag ord_num
9234 llRetVal= .SetRelation("__860Hist", "ord_num", tcTransHeader, "ord_num")
9235 If llRetVal
9236 Replace All merch_type With __860Hist.merch_type ;
9237 For Empty(merch_type) In (tcTransHeader)
9238 Endif
9239 Set Relation To
9240 Use In __860Hist
9241 Endif
9242 Endif
9243 * === TR 1043960 5/25/10 CM
9244
9245 Endif
9246 Endif
9247 Endif
9248 Endwith
9249 If Used("__TmpCursor")
9250 Use In __TmpCursor
9251 Endif
9252 Select(lnOldSelect)
9253 Return llRetVal
9254 Endproc
9255
9256 *- 1007309 09/28/04 YIK
9257 Procedure GetDetDiscount
9258 Lparameters pcTransDetail
9259 Local llRetVal, lnOldSelect, lcSQLSelect, lcCode
9260 llRetVal= .T.
9261 lnOldSelect = Select()
9262 Select Distinct Discount ;
9263 FROM &pcTransDetail ;
9264 WHERE Errs_Flg_D <> 'Y' And !Empty(Discount) ;
9265 INTO Cursor __TmpCurs
9266 If Recc("__TmpCurs") > 0
9267 lcSqlString = "SELECT * FROM zzxdiscr ORDER BY discount"
9268 llRetVal = v_SQLexec(lcSqlString, "_DiscCurs")
9269 If llRetVal
9270 Select __TmpCurs
9271 Scan
9272 lcCode = __TmpCurs.Discount
9273 Select _DiscCurs
9274 Locate For Discount = lcCode
9275 If Found()
9276 lnDiscPct = _DiscCurs.disc_perc
9277 Select (pcTransDetail)
9278 Replace disc_perc With lnDiscPct ;
9279 FOR Discount = lcCode
9280 Else
9281 Select (pcTransDetail)
9282 Replace Errs_Flg_D With 'Y', ;
9283 Errs_Msg_D With "Discount Rate for code " + Alltr(Discount) + ;
9284 " not found." ;
9285 FOR Discount = lcCode
9286 Endif
9287 Select __TmpCurs
9288 Endscan
9289 Endif
9290 Endif
9291 Select(lnOldSelect)
9292 Return llRetVal
9293 *== 1007309
9294 Endproc
9295
9296 *- 1013889 11/01/05 YIK
9297 Procedure CalcDiscAmt
9298 Parameters taDRef, tSAC_DRef, tSAC_DRate, tSAC_DAmt, tnCounter
9299 Local lnPos, lnCol
9300 If !Empty(tSAC_DRef)
9301 *- search for the current SAC_DRef
9302 lnPos = Ascan(taDRef, tSAC_DRef)
9303 If lnPos = 0 && new discount
9304 *- add it to the array. 3 rows tops. We declared it as [3,3]
9305 If tnCounter < 3
9306 tnCounter = tnCounter + 1
9307 taDRef[tnCounter, 1] = tSAC_DRef
9308 taDRef[tnCounter, 2] = tSAC_DRate
9309 taDRef[tnCounter, 3] = tSAC_DAmt
9310 Endif
9311 Else
9312 lnCol = (lnPos + 2)/3
9313 taDRef[lnCol, 3] = taDRef[lnCol, 3] + tSAC_DAmt
9314 Endif
9315 Endif
9316 Endproc
9317
9318 Procedure GetDiscAmt
9319 Lparameters tceipotd && transaction detail
9320 Local llRetVal, lnOldSelect, lnAmt1, lnAmt2, lnAmt3
9321 llRetVal = .T.
9322 lnOldSelect = Select()
9323 Select (tceipotd)
9324 *- 1014917 01/09/06 YIK
9325 llNewStoreDiscount = (Vartype(SAC_NSRef) == "C")
9326 Scan For SAC_DRate1 <> 0 Or (llNewStoreDiscount And SAC_NSRate <> 0) && the 2nd and 3d discounts are populated only if the 1st one is.
9327 lnAmt1 = 0
9328 lnNSAmt = 0
9329 lnAmt2 = 0
9330 lnAmt3 = 0
9331 If SAC_DRate1 <> 0
9332 *= 1014917
9333 *- 1014055 11/03/05 YIK
9334 *- Round to 4 decimals here
9335 lnAmt1 = Round(InvoiceQty*price*SAC_DRate1/100, 4)
9336 If SAC_DRate2 <> 0
9337 lnAmt2 = Round(InvoiceQty*price*SAC_DRate2/100, 4)
9338 If SAC_DRate3 <> 0
9339 lnAmt3 = Round(InvoiceQty*price*SAC_DRate3/100, 4)
9340 *= 1014055
9341 Endif
9342 Endif
9343 *- 1014917 01/09/06 YIK
9344 Endif
9345 If llNewStoreDiscount And SAC_NSRate <> 0
9346 lnNSAmt = Round(InvoiceQty*price*SAC_NSRate/100, 4)
9347 Replace SAC_NSAmt With lnNSAmt ;
9348 IN (tceipotd)
9349 Endif
9350 *= 1014917
9351
9352 Replace SAC_DAmt1 With lnAmt1, ;
9353 SAC_DAmt2 With lnAmt2, ;
9354 SAC_DAmt3 With lnAmt3 ;
9355 IN (tceipotd)
9356 Endscan
9357 Select (lnOldSelect)
9358 Return llRetVal
9359 Endproc
9360 *= 1013889 11/02/05 YIK
9361
9362 *- 1014711 02/15/06 YIK
9363 *- Split the source flat file (850.dat) into 850HDR.dat, 850DTL.dat etc.
9364 *- We are not going to use a definition file, just add 3 chr tag to the file name.
9365 *- Currently we assume the source and destination files are in the same EDI\Inbound\ folder.
9366 *- 1016069 03/15/06 YIK
9367 *- If the 2nd parameter tcRenameOnly set to .T., we'll skip splitting and will only rename it.
9368 Procedure SplitFlatFile
9369 Lparameters tcSource, tcRenameOnly
9370 Local llRetVal, lnOldSelect, lcEDIPath, lcSource, lnHandle, lnMaxBytes, lcBuffer, lcTag, lnTagPos, ;
9371 lnTagDelimPos
9372 *--- TR 1022750 04/16/07 NH
9373 Local lcUniqueSuff
9374 lcUniqueSuff = Sys(2015)
9375 *=== TR 1022750 04/16/07 NH
9376
9377 *--- TR 1057490 09-Dec-2011 BNarayanan Variable Declared
9378 LOCAL llEmptyFile
9379 llEmptyFile = .f.
9380 *=== TR 1057490 09-Dec-2011 BNarayanan
9381
9382 Declare laTags[1, 1]
9383 laTags = ""
9384 llRetVal = .T.
9385 lnOldSelect = Select()
9386 lcEDIPath = This.GetEDIFlatFileDirectory("Inbound")
9387 lcEDIPath = Iif(Right(Alltrim(lcEDIPath ), 1) = "\", Alltrim(lcEDIPath ), Alltrim(lcEDIPath ) + "\")
9388 lcSourceDat = Upper( lcEDIPath + Alltrim(tcSource) )
9389
9390 If File(lcSourceDat)
9391
9392 * --- TR 1042937 11/04/09 CM
9393 * If we've gotten to this point there's a flat file to
9394 * process, store it and use it later during our file rename.
9395 This.lDATExists = .T.
9396 * === TR 1042937 11/04/09 CM
9397
9398 *--- 1022750 02/20/07 YIK
9399 *lcSource = FORCEEXT(lcSourceDat, ".PRI") && rename .dat to .pri right away, new .dat may be on its way
9400 lcSource = Forceext(Alltrim(tcSource), ".PRI") && copy server side .dat to local .pri right away, new .dat may be on its way
9401
9402 *--- TR 1042937 11/04/09 CM --- If we just need to rename, then retain the original .pri file
9403 *lcSource = Stuff(lcSource,At(".",lcSource),0,lcUniqueSuff)
9404 lcSource = Iif(!tcRenameOnly, Stuff(lcSource,At(".",lcSource),0,lcUniqueSuff), Forceext(lcSourceDat, ".PRI"))
9405 *=== TR 1042937 11/04/09 CM
9406
9407 *=== 1022750 02/20/07 YIK
9408
9409 *--- TR 1031648 NSD 3/26/08
9410 IF tcRenameOnly
9411 Copy File (lcSourceDat) To (lcSource)
9412 ENDIF
9413 *=== TR 1031648 NSD 3/26/08
9414
9415 *--- TR 1015983 NH -- delete file when tcRenameOnly is not true
9416 *DELETE FILE (lcSourceDat)
9417 *- 1016069 03/15/06 YIK
9418 *- Added IF..ENDIF
9419 If !tcRenameOnly && need to split
9420 *--- TR 1015983 NH -- delete file when tcRenameOnly is not true
9421
9422 *--- TR 1031648 NSD 3/26/08
9423 *Delete File (lcSourceDat)
9424
9425 * Remove source
9426 IF FILE(lcSource)
9427 DELETE FILE (lcSource)
9428 ENDIF
9429
9430 RENAME (lcSourceDat) To (lcSource)
9431
9432 IF FILE(lcSourceDat)
9433 RETURN .F.
9434 ENDIF
9435 *=== TR 1031648 NSD 3/26/08
9436
9437 lnHandle = Fopen(lcSource)
9438 llRetVal = (lnHandle > 0)
9439 lnMaxBytes = 8192 && max bytes FGETS can read. It reads until CRLF is encountered inside the lnMaxBytes.
9440 lnPos = At(".", tcSource)
9441 llRetVal = llRetVal And (lnPos > 0)
9442
9443 *--- TR 1057490 09-Dec-2011 BNarayanan Check Empty File
9444 IF llRetVal AND Feof(lnHandle)
9445 llEmptyFile = .t.
9446 ENDIF
9447 *=== TR 1057490 09-Dec-2011 BNarayanan
9448 *- 1091225 06/28/16 YIK
9449 LOCAL lnSPlitHandle
9450 If llRetVal
9451 Do While !Feof(lnHandle)
9452 *- 1091225 06/29/16 YIK
9453 *- No need in CRLF. We remove it shortly anyway.
9454 *- lcBuffer = Fgets(lnHandle, lnMaxBytes) + CRLF && Store one line to string
9455 lcBuffer = Fgets(lnHandle, lnMaxBytes)
9456
9457 *- 1016069 03/22/06 YIK
9458 *- Tag may be 2 or 3 characters
9459 lcTag = Left(lcBuffer, 3)
9460 lnTagDelimPos = At("|", lcBuffer)
9461 lcTag = Left(lcBuffer, lnTagDelimPos - 1)
9462 *==
9463 *- 1017352 06/19/06 YIK - remove all pipes
9464 *- 1091225 09/29/16 YIK - we don't have CRLF anymore
9465 *- lcBufferData = Strtran(lcBuffer, CRLF)
9466 *- lcBufferData = Strtran(lcBufferData, "|", "")
9467 lcBufferData = Strtran(lcBuffer, "|", "")
9468 *===
9469 If Empty(lcBufferData) Or lcBufferData == lcTag && nothing except the tag
9470 Loop && skip empty line
9471 Endif
9472 *= 1017352 YIK
9473
9474 lnALen = Alen(laTags,1) && TR 1022750 NH
9475 If !Empty(laTags[1]) && at least one tag has been processed
9476 *- TR 1060311 FH - added 6 to Ascan parameter so we search for exact
9477 lnTagPos = Ascan(laTags, lcTag, 1, lnALen, 1, 6) && TR 1022750 NH - tag is stored as the 1st element of the array
9478 Else && the first record.
9479 lnTagPos = 0
9480 lnALen = 0
9481 Endif
9482 If lnTagPos = 0
9483 *- define the split file name
9484 *--- TR 1022750 NH
9485 *lcSplitFName = STUFF(tcSource, lnPos, 0, lcTag)
9486 lcSplitFName = Stuff(tcSource, lnPos, 0, lcTag + lcUniqueSuff )
9487 *lcSplitFile = lcEDIPath + ALLTRIM(lcSplitFName)
9488 *-- we only store the preocss+Tag + .dat file name
9489 lcSplitFile = Alltrim(Stuff(tcSource, lnPos, 0, lcTag))
9490 *--- make sure the local unique file is deleted.
9491 Delete File (lcSplitFName)
9492 *DECLARE laTags[lnALen + 1, 2] && add another row to the array
9493 *- 1091225 06/29/16 YIK
9494 *-- Declare laTags[lnALen + 1, 3] && add another row to the array
9495 lnSPlitHandle = FCREATE(lcSplitFName) && Read/Write
9496 lnALen = lnALen + 1
9497 Declare laTags[lnALen, 4] && add another row to the array
9498 *= 1091225
9499 *=== TR 1022740 NH
9500 laTags[lnALen, 1] = lcTag
9501 laTags[lnALen, 2] = lcSplitFile
9502 laTags[lnALen, 3] = lcSplitFName && TR 1022750 NH
9503 *- 1091225 06/29/16 YIK
9504 laTags[lnALen, 4] = lnSPlitHandle
9505
9506 Else
9507 lcSplitFName = laTags[lnTagPos + 2] && TR 1022750 NH
9508 *- 1091225 06/29/16 YIK
9509 lnSPlitHandle = laTags[lnTagPos + 3] && handle
9510
9511 Endif
9512 *- 1091225 06/28/2016 YIK
9513*--- Strtofile(lcBuffer, lcSplitFName, .T.) && append TR 1022750 NH
9514 FPUTS(lnSPlitHandle, lcBuffer)
9515
9516 Enddo
9517 Else
9518 Endif
9519 Fclose(lnHandle)
9520
9521 *- 1091225 06/28/2016 YIK
9522 FOR lnTagPos=1 TO ALEN(laTags, 1) && returns number of rows
9523 lnSPlitHandle = laTags[lnTagPos , 4]
9524 FFLUSH(lnSPlitHandle, .T.)
9525 FCLOSE(lnSPlitHandle)
9526 ENDFOR
9527 *=- 1091225
9528 *--- TR 1057490 09-Dec-2011 BNarayanan If added around
9529 IF NOT llEmptyFile
9530 *=== TR 1057490 09-Dec-2011 BNarayanan
9531 *- DELETE FILE (lcSource)
9532 *- 1022750 02/20/07 YIK/NH
9533 *- Copy LOCAL .pri and split files to server to be renamed later.
9534 lcServerFile = Forceext(lcSourceDat, ".PRI")
9535 Copy File (lcSource) To (lcServerFile)
9536 Delete File (lcSource)
9537 lnALen = Alen(laTags,1) && TR 1022750 NH
9538 For N = 1 To lnALen && TR 1022750 NH
9539 lcSplitFile = laTags[n, 2]
9540 lcServerSplitFile = lcEDIPath + lcSplitFile
9541 lcSplitFName = laTags[n, 3]
9542 This.CopyToFlatFileInBlock(lcSplitFName, lcServerSplitFile)
9543 Delete File (lcSplitFName)
9544
9545 Endfor
9546 *=== TR 1022570 NH
9547 *--- TR 1057490 09-Dec-2011 BNarayanan delete the empty file
9548 ELSE
9549 Delete File (lcSource)
9550 ENDIF
9551 *=== TR 1057490 09-Dec-2011 BNarayanan
9552 Endif
9553 Endif
9554 Select (lnOldSelect)
9555 Return llRetVal
9556 Endproc
9557
9558 *- 1014711 02/16/06 YIK
9559 *- Rename a file (1st parameter) to have a name and extension defined by rules
9560 *- specified by the definition string (2nd parameter)
9561 *- If the code for extension is not found - we keep the existing extension
9562 *- If the code for file extension = "_NULL" - we remove the extension.
9563 *- The extension code in a definition string currently starts with _ (underscore)
9564 *--- TechRec 1066835 13-Mar-2013 YKaganovsky ---
9565 *- Add parameter tcDirection
9566 Procedure RenFileDat
9567 Parameter tcSource, tcDefinitionString, tcDirection
9568
9569 Local llRetVal, lnHandle, lnSize, lcString, lnElements, llExtension, lnExtNum, lcFullSource, ;
9570 lcEDIPath, lcFullTarget
9571 llRetVal= .T.
9572
9573 *--- TechRec 1066835 13-Mar-2013 YKaganovsky ---
9574 *-lcEDIPath = This.GetEDIFlatFileDirectory("Inbound")
9575 tcDirection = IIF(EMPTY(tcDirection), "Inbound", tcDirection )
9576 lcEDIPath = This.GetEDIFlatFileDirectory(tcDirection)
9577 *=
9578
9579 lcEDIPath = Iif(Right(Alltrim(lcEDIPath ), 1) = "\", Alltrim(lcEDIPath ), Alltrim(lcEDIPath ) + "\")
9580 *--- TechRec 1066835 13-Mar-2013 YKaganovsky ---
9581 *- IF lcEDIPath is a part of tcSource - don't add the path again
9582 IF ATC("\", tcSource) = 0 && not found - need to add path
9583 lcFullSource = Upper( lcEDIPath + Alltrim(tcSource) )
9584 ELSE
9585 lcFullSource = tcSource
9586 ENDIF
9587 If !File(lcFullSource)
9588 Return
9589 Endif
9590
9591 * --- TR 1042937 11/04/09 CM
9592 *--- TechRec 1066835 13-Mar-2013 YKaganovsky ---
9593 *- added check for UPPER(tcDirection)= "INBOUND"
9594 If UPPER(tcDirection)= "INBOUND" AND !This.lDATExists
9595 Return
9596 Endif
9597 * === TR 1042937 11/04/09 CM
9598
9599 *- Default is to timestamp and rename to .gen
9600 lcString = Iif(Empty(tcDefinitionString), 'F,YYYY,MM,DD,HMS,_"gen"', tcDefinitionString)
9601 Declare laFormat[1]
9602 = StringToArray(lcString, @laFormat)
9603 lnElements = Alen(laFormat) && how many elements in the array
9604 llExtension = .T.
9605 lnFormats = lnElements
9606 lcExtensionCode = "NON"
9607 lnSize = lnElements
9608 For j = 1 To lnElements
9609 If Left(laFormat[j], 1) == "_" && FILE EXTENSION MARKER
9610 lnExtNum = j
9611 lnSize = j && elements after the extension don't count
9612 lnFormats = j - 1
9613 lcExtensionCode = Alltrim(laFormat[j])
9614 Exit
9615 Endif
9616 Endfor
9617 If lnFormats = 0 && the only element is extension format - no good.
9618 Return
9619 Endif
9620 Declare laFileNameFormat[lnFormats]
9621 Acopy(laFormat, laFileNameFormat,1 ,lnFormats) && copy only file name format codes.
9622 lcFileName = This.DefineFileName(tcSource, @laFileNameFormat)
9623 lcExtension = This.DefineExtension(tcSource, lcFileName, lcExtensionCode)
9624 lcTargetFile = lcFileName + Iif(lcExtension == "", "", "." + lcExtension)
9625 *--- TechRec 1066835 13-Mar-2013 YKaganovsky ---
9626 *-lcFullTarget = Upper( lcEDIPath + Alltrim(lcTargetFile) )
9627 *- IF lcEDIPath is a part of tcTargetFile - don't add the path again
9628 IF ATC("\", lcTargetFile) = 0 && not found - need to add path
9629 lcFullTarget = Upper( lcEDIPath + Alltrim(lcTargetFile) )
9630 ELSE
9631 lcFullTarget = lcTargetFile
9632 ENDIF
9633 *=
9634 *-- lcRunString = "!RENAME " + tcSource + " " + lcTargetFile
9635 *-- &lcRunString
9636 *- = FCLOSE(lnHandle) && nothing is open???
9637 Copy File (lcFullSource) To (lcFullTarget)
9638 Delete File (lcFullSource)
9639 ENDPROC
9640
9641 Function DefineFileName
9642 Lparameters tcSource, laFileNameFormat
9643 Local lcNameString, lnASize, j
9644 lnPos = At(".", tcSource)
9645 If lnPos > 1
9646 lcFSourceName = Left(tcSource, lnPos-1)
9647 Else
9648 lcFSourceName = tcSource
9649 Endif
9650 lcNameString = ""
9651 lnASize = Alen(laFileNameFormat)
9652 lcDateString = CurrentDateTimeAsString()
9653 For j = 1 To lnASize
9654 Do Case
9655 Case laFileNameFormat[j] = "YYYY" && the 4-digit year
9656 lcString = Substr(lcDateString, 1, 4)
9657 Case laFileNameFormat[j] = "YY" && the 2-digit year
9658 lcString = Substr(lcDateString, 3, 2)
9659 Case laFileNameFormat[j] = "MM" && the 2 digit numeric month (left padded by '0' for months 1 thru 9)
9660 lcString = Substr(lcDateString, 5, 2)
9661 Case laFileNameFormat[j] = "DD" && the 2-digit day of the month (left padded by '0' for days 1 thru 9),
9662 lcString = Substr(lcDateString, 7, 2)
9663 Case laFileNameFormat[j] = "HH" && the 2-digit hour (left padded by '0' for hours 1 thru 9)
9664 lcString = Substr(lcDateString, 9, 2)
9665 Case laFileNameFormat[j] = "HMS" && the 2-digit hour (left padded by '0' for hours 1 thru 9) +
9666 && the 2-digit minutes (left padded by '0' for minutes 1 thru 9) +
9667 && the 2-digit seconds (left padded by '0' for seconds 1 thru 9)
9668 lcString = Substr(lcDateString, 9, 6)
9669 Case laFileNameFormat[j] = "MA" && the alphabetic sequentially equivalent of a numeric month
9670 && (A thru L for months 1 thru 12)
9671 lcString = This.GetMonthAlphabetic(lcDateString)
9672 Case laFileNameFormat[j] = "MX" && the 3 character alpha abbreviation of the current month
9673 && (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG, SEP, OCT, NOV, DEC)
9674 lcString = This.GetMonth3Chars(lcDateString)
9675 Case laFileNameFormat[j] = "F" && the existing file name (to be included in the rename at the position
9676 && specified indicated when the parameters are passed)
9677 lcString = lcFSourceName
9678 Case ( Left(laFileNameFormat[j], 1) = '"' And Right(laFileNameFormat[j], 1) = '"' ) ;
9679 OR (Left(laFileNameFormat[j], 1) = "'" And Right(laFileNameFormat[j], 1) = "'" ) && passed value
9680 lnLen = Len(laFileNameFormat[j]) - 2
9681 lcString = Substr(laFileNameFormat[j], 2, lnLen) && put the code passed.
9682 Otherwise
9683 lcString = ""
9684 Endcase
9685 lcNameString = lcNameString + lcString
9686 Endfor
9687 Return lcNameString
9688
9689 Procedure GetMonthAlphabetic
9690 Lparameters tcDateString
9691 Local lnMonth, lcChar
9692 lnMonth = Substr(tcDateString, 5, 2)
9693 Do Case
9694 Case lnMonth = "01"
9695 lcChar = "A"
9696 Case lnMonth = "02"
9697 lcChar = "B"
9698 Case lnMonth = "03"
9699 lcChar = "C"
9700 Case lnMonth = "04"
9701 lcChar = "D"
9702 Case lnMonth = "05"
9703 lcChar = "E"
9704 Case lnMonth = "06"
9705 lcChar = "F"
9706 Case lnMonth = "07"
9707 lcChar = "G"
9708 Case lnMonth = "08"
9709 lcChar = "H"
9710 Case lnMonth = "09"
9711 lcChar = "I"
9712 Case lnMonth = "10"
9713 lcChar = "J"
9714 Case lnMonth = "11"
9715 lcChar = "K"
9716 Case lnMonth = "12"
9717 lcChar = "L"
9718 Otherwise
9719 Endcase
9720 Return lcChar
9721
9722 Procedure GetMonth3Chars
9723 Lparameters tcDateString
9724 Local lnMonth, lcChar
9725 lnMonth = Substr(tcDateString, 5, 2)
9726 Do Case
9727 Case lnMonth = "01"
9728 lcChar = "JAN"
9729 Case lnMonth = "02"
9730 lcChar = "FEB"
9731 Case lnMonth = "03"
9732 lcChar = "MAR"
9733 Case lnMonth = "04"
9734 lcChar = "APR"
9735 Case lnMonth = "05"
9736 lcChar = "MAY"
9737 Case lnMonth = "06"
9738 lcChar = "JUN"
9739 Case lnMonth = "07"
9740 lcChar = "JUL"
9741 Case lnMonth = "08"
9742 lcChar = "AUG"
9743 Case lnMonth = "09"
9744 lcChar = "SEP"
9745 Case lnMonth = "10"
9746 lcChar = "OCT"
9747 Case lnMonth = "11"
9748 lcChar = "NOV"
9749 Case lnMonth = "12"
9750 lcChar = "DEC"
9751 Otherwise
9752 Endcase
9753 Return lcChar
9754
9755 Procedure DefineExtension
9756 Parameters tcSource, tcFileName, tcExtensionCode
9757 lnPos = At(".", tcSource)
9758 If lnPos > 1
9759 lcSourceExtension = Substr(tcSource, lnPos+1)
9760 Else
9761 lcSourceExtension = ""
9762 Endif
9763 Do Case
9764 Case tcExtensionCode = "_NUL" && NO EXTENSION CODE
9765 lcSourceExtension = ""
9766 Case tcExtensionCode = "_NNN"
9767 lcSourceExtension = This.GetNextSequenceNum(tcFileName)
9768 Case ( Left(tcExtensionCode, 2) = '_"' And Right(tcExtensionCode, 1) = '"' ) ;
9769 OR (Left(tcExtensionCode, 2) = "_'" And Right(tcExtensionCode, 1) = "'" )
9770 lnLen = Len(tcExtensionCode) - 3
9771 lcSourceExtension = Substr(tcExtensionCode, 3, lnLen) && put the code passed.
9772 Case tcExtensionCode = "NON" && no extension format code was sent - keep the existing one
9773 Otherwise
9774 lcSourceExtension = tcExtensionCode
9775 Endcase
9776 Return lcSourceExtension
9777
9778 Procedure GetNextSequenceNum
9779 Lparameters tcFileName
9780 Local Array laFiles[1], laNames[1]
9781 Local lnFiles, lcExtension, lnNewExtension, lcNewExtension
9782 laFiles[1] = ''
9783 lnFiles = Adir(laFiles, tcFileName + ".*")
9784 If lnFiles = 0 && no files found
9785 lcNewExtension = '001'
9786 Else
9787 For j = 1 To lnFiles
9788 Declare laNames[j]
9789 laNames[j] = laFiles[j, 1] && copy file names only to array laNames
9790 Endfor
9791 = Asort(laNames) && ascending order.
9792 lcLast = laNames[lnFiles]
9793 lnPos = At(".", lcLast) && extract the extension part
9794 If lnPos > 1
9795 lcExtension = Substr(lcLast, lnPos+1)
9796 Else
9797 lcExtension = "000"
9798 Endif
9799 lnNewExtension = Eval(lcExtension) + 1
9800 lcNewExtension = Padl( Alltrim(Trans(lnNewExtension, "999")), 3, "0") && new extension, left-padded with "0"
9801 Endif
9802 Return lcNewExtension
9803 *= 1014711 02/16/06 YIK
9804 *--- TR 1017624 NH
9805 *------------------------------------------------------------------------------------------
9806
9807 Procedure LogOpen
9808 Lparameter pcJobID, pcJobDesc, plScheduled, pcFlatFileLog
9809 Local llRetVal
9810 llRetVal = (Vartype(This.oLog) == "O")
9811 llRetVal = llRetVal And DoDefault(pcJobID, pcJobDesc, plScheduled, pcFlatFileLog)
9812 Return llRetVal
9813 Endproc
9814
9815 *------------------------------------------------------------------------------------------
9816
9817 Procedure LogProgram
9818 Lparameters pcProgram, plDontLogMethod
9819 Local llRetVal
9820 llRetVal = (Vartype(This.oLog) == "O")
9821 llRetVal = llRetVal And DoDefault(pcProgram, plDontLogMethod)
9822 Return llRetVal
9823 Endproc
9824
9825 *------------------------------------------------------------------------------------------
9826
9827 Procedure logEntry
9828 Lparameters pcText, plSkipLine
9829 Local llRetVal
9830 llRetVal = (Vartype(This.oLog) == "O")
9831 llRetVal = llRetVal And DoDefault(pcText, plSkipLine)
9832 Return llRetVal
9833 Endproc
9834
9835 *------------------------------------------------------------------------------------------
9836
9837 Procedure LogResult
9838 Lparameters plSuccess, pcJobDesc
9839 Local llRetVal
9840 llRetVal = (Vartype(This.oLog) == "O")
9841 llRetVal = llRetVal And DoDefault(plSuccess, pcJobDesc)
9842 Return llRetVal
9843 Endproc
9844
9845 *------------------------------------------------------------------------------------------
9846
9847 Procedure LogClose
9848 Local llRetVal
9849 llRetVal = (Vartype(This.oLog) == "O")
9850 llRetVal = llRetVal And DoDefault()
9851 Return llRetVal
9852 Endproc
9853
9854 *------------------------------------------------------------------------------------------
9855
9856 Procedure LogMajorStage
9857 Lparameters pcText
9858 Local llRetVal
9859 llRetVal = (Vartype(This.oLog) == "O")
9860 llRetVal = llRetVal And DoDefault(pcText)
9861 Return llRetVal
9862 Endproc
9863
9864 *------------------------------------------------------------------------------------------
9865
9866 Procedure LogWarning
9867 Lparameters pcText
9868 Local lRetVal
9869 llRetVal = (Vartype(This.oLog) == "O")
9870 llRetVal = llRetVal And DoDefault(pcText)
9871 Return lRetVal
9872 Endproc
9873
9874 *------------------------------------------------------------------------------------------
9875
9876 Procedure RetrieveLogToFile
9877 Lparameters pcLogFile, pnHeaderPkey
9878 Local llRetVal
9879 llRetVal = (Vartype(This.oLog) == "O")
9880 llRetVal = llRetVal And DoDefault(pcLogFile, pnHeaderPkey)
9881 Return llRetVal
9882 Endproc
9883
9884 *------------------------------------------------------------------------------------------
9885
9886 *=== TR 1017624 NH
9887
9888 *--- TechRec 1030096 02/01/07 RCO/NH
9889 *CheckRemitNum Procedure should not return false if no customer sales reference causes 810 Process to fail; should update transaction header accordingly
9890 *Optimization done for the CheckRemitNum to increase efficiency when updating transaction header
9891
9892 *--- TechRec 1026592 11-Sep-2007 jjanand ---
9893 Procedure CheckRemitNum
9894 Lparameters pcEDIth, pcEDIcr
9895
9896 * TR 1048519 23-AUG-10 KISHOR Added ord_type
9897 Local llRetVal, lnOldSelect, lcErrs_Msg ,lcCustomer,lcStore,lcdepartment,lcDivision, lcOrd_type,;
9898 lcRemit_num, lcRemit_req, lcExp, llCustSales, llTagExists, lcOrder
9899
9900 llRetVal = .T.
9901 lnOldSelect = Select()
9902
9903 lcTmpCursor = GetUniqueFileName()
9904
9905 * TR 1048519 23-AUG-10 KISHOR Added h.ord_type
9906 lcSqlString = " SELECT DISTINCT h.customer,h.store,h.department,h.division,h.ord_type " +;
9907 " FROM " + pcEDIth + " h " +;
9908 " JOIN " + pcEDIcr + " c " +;
9909 " ON h.customer = c.customer " +;
9910 " AND h.division = c.division " +;
9911 " AND c.remit_req = 'Y' " +;
9912 " ORDER BY h.customer,h.Store,h.department,h.division,h.ord_type " +;
9913 " Into Cursor " + lcTmpCursor
9914
9915 llRetVal = llRetVal And v_SQLexec(lcSqlString, ,,.T.)
9916
9917 If llRetVal
9918
9919 SELECT (pcEDIth)
9920
9921 *record current controlling index file for a table before creating new index set it back after execution
9922 lcOrder = SET("Order")
9923 *-FH 1089190
9924 INDEX on customer+store+department+division+ord_type TAG CustSDDiv
9925 *-FH 1089190
9926 *CreateCursorIndex(pcEDIth,"CustSDDiv","customer+store+department+division+ord_type")
9927 Set Order To CustSDDiv
9928
9929 Select (lcTmpCursor)
9930
9931 Scan
9932
9933 lcCustomer = customer
9934 lcStore = Store
9935 lcdepartment= department
9936 lcDivision = division
9937 *--- TR 1048519 23-AUG-10 KISHOR Added ord_type
9938 lcOrd_type = ord_type
9939 lcExp = lcCustomer + lcStore + lcdepartment + lcDivision + lcOrd_type
9940
9941 llCustSales = vl_cslsr1(customer,Store,department,division,'tcXCslsr',False,False,ord_type)
9942 *=== TR 1048519 23-AUG-10 KISHOR Added ord_type
9943
9944 lcErrs_Msg = ""
9945
9946
9947 SELECT (pcEDIth)
9948 IF SEEK(lcExp,pcEDIth,"CustSDDiv")
9949 * TR 1048519 23-AUG-10 KISHOR Added ord_type
9950 SCAN WHILE lcExp =customer+Store+department+division+ord_type
9951 *--- TechRec 1031038 02/27/08 RCO
9952 *If remit num exists in customer sales reference and 810(o) control take from customer sales reference
9953 If llCustSales AND NOT Empty(tcXCslsr.remit_num)
9954 SELECT (pcEDIth)
9955 Replace remit_num With tcXCslsr.remit_num
9956 ENDIF
9957
9958 SELECT (pcEDIth)
9959 IF EMPTY(remit_num)
9960 *--- TechRec 1031038 02/27/08 RCO
9961 * Store in 810 transaction maintenance if Remit Num doesnt exist in 810(o) control
9962 lcErrs_Msg= EDI_REMIT_REQ_MSG + CRLF
9963 Replace Errs_Msg_H With Errs_Msg_H + lcErrs_Msg, Errs_flg_H With "Y"
9964 ENDIF
9965 ENDSCAN
9966 ENDIF
9967
9968 *!* Replace remit_num With tcXCslsr.remit_num;
9969 *!* For customer = lcCustomer And;
9970 *!* store = lcStore And;
9971 *!* department = lcdepartment And;
9972 *!* division = lcDivision And;
9973 *!* !Empty(tcXCslsr.remit_num);
9974 *!* In (pcEDIth)
9975
9976 *!* lcErrs_Msg= EDI_REMIT_REQ_MSG + CRLF
9977
9978 *!* Replace Errs_Msg_H With Errs_Msg_H + lcErrs_Msg, Errs_flg_H With "Y" ;
9979 *!* For customer = lcCustomer And;
9980 *!* store = lcStore And;
9981 *!* department = lcdepartment And;
9982 *!* division = lcDivision And;
9983 *!* EMPTY(remit_num) ;
9984 *!* In (pcEDIth)
9985
9986 ENDSCAN
9987
9988 SELECT (pcEDIth)
9989 SET ORDER TO &lcOrder
9990
9991 Endif
9992
9993 Select(lnOldSelect)
9994 Return llRetVal
9995 Endproc
9996 *=== TechRec 1026592 11-Sep-2007 jjanand ===
9997 *=== TechRec 1030096 02/01/07 RCO/NH
9998
9999*--- TR 1055192 09-22-2011 RKI ---*
10000FUNCTION Update_FactorOtherDetails
10001LPARAMETERS toSourceFactor,toSourceHeader
10002LOCAL llRetVal, lcSelect
10003llRetVal = True
10004lcSelect = SELECT()
10005IF TYPE('toSourceFactor')#'O' OR TYPE('toSourceHeader') # 'O'
10006 RETURN
10007ENDIF
10008
10009*Check Header level Trans_date is empty
10010IF EMPTY(toSourceHeader.fTran_date)
10011 toSourceFactor.fTran_Date = DATE()
10012ENDIF
10013IF EMPTY(toSourceHeader.facExpir_days)
10014 toSourceFactor.FacExPir_days = vl_factr(toSourceFactor.Factor,'Expir_Days')
10015ENDIF
10016
10017IF EMPTY(toSourceHeader.FacExpir_Basis)
10018 toSourceFactor.FacExpir_Basis = vl_factr(toSourceFactor.Factor,'Expir_basis')
10019ENDIF
10020
10021IF EMPTY(toSourceFactor.FExpn_date)
10022 DO CASE
10023 CASE toSourceFactor.FacExpir_basis='E'
10024 toSourceFactor.FExpn_date = GoDay(toSourceHeader.End_date,toSourceFactor.FacExpir_days)
10025 CASE toSourceFactor.FacExpir_Basis = 'A' AND !EMPTY(toSourceFactor.FTran_Date)
10026 toSourceFactor.FExpn_Date = GoDay(toSourceFactor.Ftran_Date,toSourceFactor.FacExpir_Days)
10027 ENDCASE
10028ELSE
10029 toSourceFactor.FacExpir_Basis='F'
10030Endif
10031SELECT (lcSelect)
10032RETURN llRetVal
10033ENDFUNC
10034*=== TR 1055192 09-22-2011 RKI ===*
10035
10036*--- TR 1055192 10-05-2011 RKI ---
10037FUNCTION Update_FactorDetailsToHeader
10038LPARAMETERS tnCurTranPkey,tcTargetFactor,tcTransHeader,tcOrderHeader
10039 LOCAL llRetVal, lFinalOrder, lcSelect
10040 llRetVal = True
10041 lFinalOrder = True
10042 lcSelect = SELECT()
10043
10044 IF TYPE('tcOrderHeader')#"C"
10045 lFinalOrder = False
10046 Endif
10047
10048 *--- TR 1055192 25-07-2011 RKI ---*
10049 * For factor transaction, update Factor table and factor info in Sales Order table.
10050 SELECT * FROM (tcTargetFactor) WITH (Buffering=.T.) where fkey = tnCurTranPkey INTO CURSOR _tcipotfh
10051 IF RECCOUNT("_tcipotfh") # 0 && Check Multi Factor Details.
10052 IF Reccount("_tciPOtfh") = 1 AND !lFinalOrder
10053 = Seek(tnCurTranPkey, (tcTargetfactor), "fkey")
10054 SCATTER NAME loeiPOtfh_factor Memo
10055 * factor details
10056 Replace factor WITH loeiPOtfh_factor.factor, ;
10057 fact_status WITH '', ;
10058 appv_num WITH loeiPOtfh_factor.appv_num, ;
10059 decl_rsn WITH '', ;
10060 facclient_num WITH '' ;
10061 In (tcTransHeader) FOR pkey = tnCurTranPkey
10062 IF lFinalOrder
10063 SELECT (tcTransHeader)
10064 SCATTER MEMVAR Fields appv_num,decl_rsn
10065 SELECT(tcOrderHeader)
10066 GATHER Memvar FIELDS appv_num,decl_rsn MEMO
10067
10068 Replace multifactor WITH 'N', fappv_amt WITH loeiPOtfh_factor.fappv_amt ,;
10069 fexpn_date with loeipotfh_factor.fexpn_date , ;
10070 facexpir_days with loeipotfh_factor.facexpir_days,;
10071 ftran_date with loeipotfh_factor.ftran_date,;
10072 facexpir_basis with loeipotfh_factor.facexpir_basis IN (tcOrderHeader)
10073 ELSE
10074 Replace ;
10075 facexpir_days with loeipotfh_factor.facexpir_days,;
10076 ftran_date with loeipotfh_factor.ftran_date,;
10077 facexpir_basis with loeipotfh_factor.facexpir_basis IN (tcTransHeader)
10078 ENDIF
10079 ELSE
10080 SELECT fkey,MIN(fexpn_date) as fexpn_date FROM (tcTargetFactor) WITH (Buffering=.T.) INTO CURSOR _tcExpndate where fkey = tnCurTranPkey GROUP BY fexpn_date
10081 ldfExpn_Date = fexpn_date
10082 SELECT fkey,SUM(fappv_amt) as fappv_amt FROM (tcTargetFactor) WITH (Buffering=.T.) INTO CURSOR _tcEfappv_amt where fkey = tnCurTranPkey GROUP BY fkey
10083 lnAppv_Amt=fappv_amt
10084 *Update Transaction Header table
10085
10086 UPDATE H SET ;
10087 Factor = 'MULTI', ;
10088 Appv_num = IIF( t.maxappv_num = t.minappv_num, t.maxappv_num, ;
10089 IIF(!EMPTY(t.maxappv_num) AND EMPTY(t.minappv_num), t.maxappv_num, ;
10090 IIF(t.maxappv_num # t.minappv_num, "MULTIPLE",''))), ;
10091 facclient_num= IIF(t.maxfacclient=t.minfacclient, t.maxfacclient,;
10092 IIF(!EMPTY(t.maxfacclient) AND EMPTY(t.minfacclient),t.maxfacclient,;
10093 IIF(t.maxfacclient # t.minfacclient, "MULTIPLE",''))) ,;
10094 Decl_Rsn = IIF(t.maxdecl_rsn = t.mindecl_rsn, t.maxdecl_rsn, ;
10095 IIF(!EMPTY(t.maxdecl_rsn) AND EMPTY(t.mindecl_rsn), t.maxdecl_rsn,;
10096 IIF(t.maxdecl_rsn # t.mindecl_rsn, "MULTIPLE",''))), ;
10097 ftran_date = t.ftran_date,;
10098 facexpir_days =0,;
10099 facexpir_basis='',;
10100 factor_ok='Y',;
10101 user_id =goenv.sv("cUser");
10102 From (tcTransHeader) h ;
10103 Join ( Select fkey,SUM(fappv_amt) as fappv_amt, MAX(ftran_date) ftran_date, ;
10104 MAX(facclient_num) as maxfacclient,;
10105 MIN(facclient_num) as minfacclient, MAX(appv_num) as maxappv_num,;
10106 MIN(appv_num) as minappv_num, MAX(decl_rsn) as maxdecl_rsn,;
10107 MIN(decl_rsn) as mindecl_rsn from (tcTargetFactor) with (buffering=.T.) group by fkey ;
10108 ) t ;
10109 on h.pkey = t.fkey ;
10110 Where h.pkey = tncurTranpkey
10111
10112 UPDATE H SET ;
10113 Fact_Status = IIF(!EMPTY(t1.fact_status),t2.fact_status,'') ;
10114 From (tcTransHeader) h ;
10115 join (tcTargetFactor) t1 ;
10116 on h.pkey = t1.fkey AND t1.fact_status='D';
10117 join (tcTargetFactor) t2;
10118 on h.pkey = t2.fkey AND t2.fact_status='S' ;
10119 Where h.pkey = tncurTranpkey
10120 IF lFinalOrder
10121 SELECT (tcTransHeader)
10122 SCATTER MEMVAR Fields appv_num,facclient_num,decl_rsn,ftran_Date,facexpir_days,facexpir_basis,factor_ok MEMO
10123 SELECT(tcOrderHeader)
10124 GATHER Memvar FIELDS appv_num,facclient_num,decl_rsn,ftran_Date,facexpir_days,facexpir_basis,factor_ok MEMO
10125
10126 *Update Order Header table
10127 Replace Multifactor WITH "Y", ;
10128 factor WITH "MULTI", ;
10129 fappv_amt With lnFappv_amt, ;
10130 autofact WITH 'N', ;
10131 sent_855f WITH '', ;
10132 fexpn_date WITH ldfExpn_date ;
10133 IN (tcOrderHeader)
10134 ENDIF
10135 ENDIF
10136 Endif
10137 SELECT (lcSelect)
10138 RETURN llRetVal
10139ENDFUNC
10140*=== TR 1055192 10-05-2011 RKI ===*
10141
10142 *--- TR 1035491 6-Nov-2008 Goutam
10143 Procedure DTLtoSLN
10144 Lparameters pcTransHeader, pcTransDetail, pcSLNPrePack, pcFinalSLN, pcEDITransaction
10145
10146 LOCAL llRetVal, lnOldSelect, lcInterface, lnTotalRow, lnPrice, lnIntPkey, lntotal_Qty, ;
10147 lnLastFkey , lcReplaceString, lnxx, lcSizeStr, lcSKU, lcUPC, lnDTL_SLN_Qty ,lnCurrentRecNo, lnTotalSLN_Qty
10148 *--- TR 1045922 28-JUN-2010 HNISAR * Added ,lnCurrentRecNo, lnTotalSLN_Qty
10149 *- 1041196 07/01/09 YIK
10150 *- Added LOCAL lndtl_sln_qty
10151
10152 *--- TechRec 1044701 16-Feb-2010 vkrishnamurthy ---
10153 LOCAL lcAssortment
10154
10155 llRetVal = .T.
10156 lcSizeStr = ""
10157 lnOldSelect = Select()
10158
10159 *--- TR 1037555 NH -
10160 LOCAL lcStyle_name
10161 lcStyle_name = ""
10162 *=== TR 1037555 NH
10163
10164 *--- 1045922 03/24/10 YIK
10165 IF ALLTRIM(pcEDITransaction) == 'OIN'
10166 SELECT (pcTransDetail)
10167 REPLACE ib_uom WITH 'EA' ;
10168 FOR SLNTODTL = 'I'
10169 ENDIF
10170 *=== 1045922 03/24/10 YIK
10171
10172 *--- TechRec 1095670 05-Jun-2016 jisingh ---
10173 *--- TR 1094662 14-Jun-2016 Partha --- Added one more template "Footlocker 4030"
10174 IF TYPE(pcTransHeader + ".template") = "C"
10175 lcSqlString = " UPDATE d SET ib_uom = 'EA' " + ;
10176 " FROM (pcTransDetail) d " + ;
10177 " JOIN (pcTransHeader) h " + ;
10178 " ON h.pkey = d.fkey " + ;
10179 " WHERE h.template = 'FRED MEYER 5010' OR UPPER(h.template) = 'FOOTLOCKER 4030'"
10180 &lcSqlString
10181 ENDIF
10182 *=== TechRec 1095670 05-Jun-2016 jisingh ===
10183
10184 *--- TechRec 1092421 04-May-2016 TSV---
10185 llGarWgtuom = Fieldexists("gar_wgt", (pcTransDetail)) AND Fieldexists("wgt_uom", (pcTransDetail))
10186
10187 *-TR 1108380 FH - If SLN cursor also have gar_wgt,wgt_uom then don't add it to field list.
10188 *- Adding it twice changes the name to gar_wgt_a, gar_wgt_b
10189 llGarWgtuom = llGarWgtuom AND (!Fieldexists("gar_wgt", (pcSLNPrePack)) AND Fieldexists("wgt_uom", (pcSLNPrePack)))
10190
10191 IF llGarWgtuom
10192 lc856FldLst = ",d.gar_wgt, d.wgt_uom"
10193 ELSE
10194 lc856FldLst = ""
10195 ENDIF
10196 *=== TechRec 1092421 04-May-2016 TSV===
10197
10198 IF NOT USED(pcFinalSLN) AND USED(pcSLNPrePack)
10199 Select Distinct h.customer, p.* ;
10200 From (pcTransHeader) h, (pcTransDetail) d, (pcSLNPrePack) p ;
10201 Where h.Pkey = d.Fkey And d.division= p.division And d.Style= p.PPK_style And ;
10202 d.color_code= p.PPK_color And d.Lbl_code= p.PPK_label And ;
10203 d.Dimension= p.PPK_dimension And .F. ;
10204 Order By 1,2,3,4,5,6,7 Into Cursor _CustSLNPrepack
10205
10206 *-- TR 1041844 02-Nov-2010 SK Added d.Assortment
10207 *--- TR 1051030 09-DEC-2010 HNISAR && Added d.aux_sku
10208 Select d.Pkey As ITM_Pkey, p.*, d.assortment ,d.aux_sku &lc856FldLst ; && TR 1092421 added &lc856FldLst
10209 From (pcTransHeader) h, (pcTransDetail) d, _CustSLNPrepack p ;
10210 Where h.Pkey = d.Fkey And d.division= p.division And d.Style= p.PPK_style And ;
10211 d.color_code= p.PPK_color And d.Lbl_code= p.PPK_label And ;
10212 d.Dimension= p.PPK_dimension And h.customer = p.customer AND .F. ;
10213 Into Cursor (pcFinalSLN) readwrite
10214
10215 *=== TechRec 1044701 16-Feb-2010 vkrishnamurthy ===
10216
10217 ENDIF
10218 IF NOT USED(pcFinalSLN) AND NOT USED(pcSLNPrePack)
10219 IF TYPE("tcRangeSLN.itm_pkey") = "U"
10220 Select Pkey As ITM_Pkey, * From tcRangeSLN Into Cursor __TempSLN
10221 ELSE
10222 Select * From tcRangeSLN Into Cursor __TempSLN
10223 ENDIF
10224 IF TYPE("__TempSLN.Customer") = "U"
10225 Select SPACE(7) As Customer, * From __TempSLN Into Cursor __TempSLN
10226 ENDIF
10227
10228 *--- TR 1051030 09-DEC-2010 HNISAR
10229 IF TYPE("__TempSLN.aux_sku") = "U"
10230 Select *,SPACE(50) AS aux_sku From __TempSLN Into Cursor __TempSLN
10231 ENDIF
10232 *=== TR 1051030 09-DEC-2010 HNISAR
10233
10234 *--- TechRec 1056973 17-Nov-2011 jisingh ---
10235 IF TYPE("__TempSLN.sfkey") = "U"
10236 Select *,pkey AS sfkey From __TempSLN Into Cursor __TempSLN
10237 ENDIF
10238 *=== TechRec 1056973 17-Nov-2011 jisingh ===
10239
10240 This.MakeCursorWritable("__TempSLN", pcFinalSLN)
10241 ENDIF
10242
10243 If Used(pcFinalSLN)
10244 *--- TR 1045922 18-MAR-2010 HNISAR
10245*!* Select d.pkey, d.fkey, h.ord_num, h.Customer, h.po_num, h.Store, d.coord_code, d.line_seq, d.sizebucket From ;
10246*!* (pcTransHeader) h, (pcTransDetail) d Where d.fkey = h.pkey And d.SLNtoDTL = 'Y' And h.errs_flg_h <> 'Y' ;
10247*!* INTO Cursor __TmpCursor
10248 LOCAL lcWhereString
10249 lcWhereString = IIF(ALLTRIM(pcEDITransaction) == 'OIN' ," d.SLNtoDTL = 'Y' ", " d.SLNtoDTL IN ('Y','I')")
10250
10251 *--- TechRec 1095670 05-Jun-2016 jisingh ---
10252 IF TYPE(pcTransHeader + ".template") = "C"
10253 lcWhereString = lcWhereString + " AND template <> 'FRED MEYER 5010' "
10254 ENDIF
10255 *=== TechRec 1095670 05-Jun-2016 jisingh ===
10256
10257 *--- 1052013 01/24/11 YIK
10258 *- added lcFieldlist, d.total_qty and template
10259 *--- TR 1048519 30-7-2011 VKK Fixed the issue reported by yuri. not part of this TR
10260 *lcFieldlist = IIF(VARTYPE(&pcTransHeader..template) = 'C', ", template " ,", ' ' AS template")
10261 lcFieldlist = IIF(TYPE(pcTransHeader+'.template') = 'C', ", template " ,", ' ' AS template")
10262
10263 lcFieldlist = lcFieldlist + lc856FldLst && TR 1092421 added lc856FldLst
10264
10265 *--- TR 1094662 13-Jun-2016 Partha ---
10266 lcWhereString = lcWhereString + IIF( ", template" $ lcFieldlist, ;
10267 " AND UPPER(LTRIM(RTRIM(template))) <> 'FOOTLOCKER 4030' " , "")
10268 *=== TR 1094662 13-Jun-2016 Partha ===
10269 *--- TechRec 1056973 17-Nov-2011 jisingh Added , d.pkey as sfkey ===
10270 *- TR 1078366 FH - changed h.ord_num -> d.ord_num, If our order is consolidated , we will be missing a lot of ord_nums.
10271 lcSqlString = " Select d.pkey, d.fkey, d.ord_num, h.Customer, h.po_num, h.Store, d.coord_code, d.line_seq, d.sizebucket " + ;
10272 " , d.total_qty, d.pkey as sfkey " + ;
10273 lcFieldlist + ;
10274 " From (pcTransHeader) h, (pcTransDetail) d Where d.fkey = h.pkey And " + lcWhereString + " And h.errs_flg_h <> 'Y' "+ ;
10275 " INTO Cursor __TmpCursor "
10276 *=
10277 &lcSqlString
10278
10279 *=== TR 1045922 18-MAR-2010 HNISAR
10280
10281 pcEDITransaction= Iif(Empty(pcEDITransaction), "OIN", pcEDITransaction)
10282 lcInterface= "ZZE" + pcEDITransaction + "ID"
10283
10284 Select __TmpCursor
10285 With This
10286 .cSQLTempTable=""
10287 If .GenerateSQLTempTable('__TmpCursor')
10288 If .PopulateSQLTempTable('__TmpCursor')
10289 If !Empty(.cSQLTempTable)
10290 *- 1041196 07/01/09 YIK
10291 *- Added dtl_sln_qty
10292
10293 *--- TR 1051030 20-DEC-2010 HNISAR
10294 * Removed and d.sizebucket= t.sizebucket from join condition
10295 * as it will not be creating correct SLN lines when SLN Lines are for Range Styles
10296 * and they created a single Range Style detail Records i.e different size bucket for same range detail line
10297 *- 1052013 01/24/11 YIK
10298 *- Modified the SQL - populate orig_qty from history, total_qty from carton detail
10299 *- removed lcJoinString, modifeid dtl_sln_qty calculation, since GAP has no ppk_action populated
10300
10301 *--- 1045922 18-MAR-2010 HNISAR
10302
10303*-- lcSQLString= "Select t.fkey HdrPkey, t.pkey DtlPkey, d.po1_upc, d.po1_sku, " + ;
10304*-- " d.assort_qty, d.total_qty, d.ib_UOM, d.org_Price, d.PO1_Price, d.Assortment, " + ;
10305*-- " case when d.assort_qty > 0 then d.total_qty/d.assort_qty else 1 end as dtl_sln_qty " + ;
10306*-- " from " + .cSQLTempTable + " t join " + ;
10307*-- " zzeipohh h join zzeipohd d on d.fkey = h.pkey " + ;
10308*-- " 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
10309*-- " and d.Line_Seq = t.Line_Seq " + ;
10310*-- "Where " + lcWhereString + ;
10311*-- "Order by d.fkey, d.pkey, t.fkey, t.pkey"
10312
10313 *=== 1045922 18-MAR-2010 HNISAR
10314 lcSQLString= "Select t.fkey HdrPkey, " + ; && #1
10315 " t.pkey DtlPkey, " + ; && #2
10316 " d.po1_upc, " + ; && #3
10317 " d.po1_sku, " + ; && #4
10318 " d.assort_qty, " + ; && #5
10319 " t.total_qty, " + ; && #6
10320 " d.ib_UOM, " + ; && #7
10321 " d.org_Price, " + ; && #8
10322 " d.PO1_Price, " + ; && #9
10323 " d.assortment, " + ; && #10
10324 " case when d.assort_qty > 0 then "+ ;
10325 " case when t.coord_code = 'GPB' THEN t.total_Qty " + ;
10326 " ELSE d.total_qty/d.assort_qty " + ;
10327 " End "+ ;
10328 " else 1 end as dtl_sln_qty " + ; && #11
10329 " , d.edipo4udf1 " + ; && #12
10330 " , d.edipo4udf2 " + ; && #13
10331 " , d.edipo4udf3 " + ; && #14
10332 " , t.template " + ; && #15
10333 " , d.ppk_action " + ; && #16
10334 " , d.total_qty as orig_qty " + ; && #17
10335 " , t.coord_code " + ; && #18
10336 " , d.sln01, d.line_seq " + ; &&--- TechRec 1056973 07-Dec-2011 jisingh ===
10337 " , d.sizebucket " + ; &&--- TechRec 1059747 27-Apr-2012 jisingh ===
10338 " from " + .cSQLTempTable + " t join " + ;
10339 " zzeipohh h join zzeipohd d on d.fkey = h.pkey " + ;
10340 " on h.ord_num = t.ord_num and d.sizebucket= t.sizebucket " + ;
10341 " and d.Line_Seq = t.Line_Seq " + ;
10342 " Where " + lcWhereString + ;
10343 " Order by d.fkey, d.pkey, t.fkey, t.pkey"
10344 *= 1052013
10345
10346 llRetVal = v_SQLExec(lcSQLString, "_SLNList")
10347 lnLineSeq = 0 &&--- TechRec 1056973 08-Dec-2011 jisingh ===
10348 lnSizeBucket = 0 &&--- TechRec 1059747 27-Apr-2012 jisingh ===
10349
10350 If llRetVal AND (RECCOUNT("_SLNList")>0)
10351 SELECT _SLNList
10352
10353 *-- TR 1041844 02-Nov-2010 SK Added assortment in INDEX
10354 *INDEX on hdrpkey+dtlpkey TAG hdrdtl
10355 *- 1052013 01/27/11 YIK
10356 *- Get rid of all ALLTRIMs. It causes asssortment 123@AAA to be equal to assortment 123
10357 *- INDEX on ALLTRIM(STR(hdrpkey))+allt(Assortment) TAG hdrdtl
10358 INDEX on STR(hdrpkey) + Assortment TAG hdrdtl
10359
10360 GO top
10361 DO WHILE NOT EOF()
10362 lnPrice = 0
10363 lnLastFkey = 0
10364 lntotal_Qty = 0
10365 *- TR 1041196 07/01/09 YIK
10366 lnDTL_SLN_Qty = 0
10367
10368 lnfkey = HdrPkey
10369 RELEASE aTempArray
10370
10371 *--- TechRec 1045922/ 1044701 28-Jun-2010 vkrishnamurthy/HNISAR ---
10372*!* Copy to array aTempArray WHILE HdrPkey = lnfkey
10373
10374 lcAssortment = Assortment
10375
10376 lnCurrentRecNo = IIF(!EOF(),RECNO(),0)
10377 *- 1052013 01/27/11 YIK
10378 *- Get rid of all ALLTRIMs. It causes asssortment 123@AAA to be equal to assortment 123
10379 *- CALCULATE SUM(total_qty) ,SUM(dtl_sln_qty) to ARRAY laTotal WHILE ALLTRIM(STR(HdrPkey)) = ALLTRIM(STR(lnfkey)) AND ALLTRIM(Assortment) = ALLTRIM(lcAssortment)
10380 *--- TechRec 1056973 08-Dec-2011 jisingh Added MIN(line_seq) ===
10381 *--- TechRec 1059747 27-Apr-2012 jisingh Added MIN(sizebucket) ===
10382 CALCULATE SUM(total_qty) ,SUM(dtl_sln_qty), MIN(line_seq), MIN(sizebucket) to ARRAY laTotal WHILE STR(HdrPkey) = STR(lnfkey) AND Assortment == lcAssortment
10383 lnTotalSLN_Qty = laTotal(1)
10384 lnPack_qty = laTotal(2)
10385 lnLineSeq = laTotal(3) &&--- TechRec 1056973 08-Dec-2011 jisingh ===
10386 lnSizeBucket = laTotal(4) &&--- TechRec 1059747 27-Apr-2012 jisingh ===
10387 *= 1054098
10388 IF lnCurrentRecNo > 0
10389 GOTO lnCurrentRecNo
10390 ENDIF
10391
10392 Copy to array aTempArray WHILE HdrPkey = lnfkey AND Assortment = lcAssortment
10393 *=== TechRec 1045922/ 1044701 28-Jun-2010 vkrishnamurthy/HNISAR ---
10394
10395
10396 lnTotalRow = ALEN(aTempArray,1)
10397 lnLastFkey = aTempArray[lnTotalRow,2]
10398 lnIntPkey = v_nextPkey(lcInterface, lnTotalRow) - lnTotalRow
10399 lcStyle_name = "" &&--- TR 1037555 NH, initialize style name with blank
10400 FOR lncount = 1 TO lnTotalRow
10401 lnIntPkey = lnIntPkey + 1
10402 IF SEEK(aTempArray[lncount,2], pcTransDetail, "Pkey")
10403 SELECT (pcTransDetail)
10404 SCATTER NAME loTranD MEMO
10405 loTranD.pkey = lnIntPkey
10406 lcStyle_name = IIF(EMPTY(lcStyle_name),loTranD.Style_name, lcStyle_name) &&--- TR 1037555 NH
10407 *- 1052584 08/30/11 YIK
10408 *- For MACYS - don't output SLN SKU
10409 IF ALLTRIM(aTempArray[lncount,15]) = 'MACYS'
10410 loTranD.sku = ''
10411 ENDIF
10412
10413 SELECT(pcFinalSLN)
10414 APPEND BLANK
10415 GATHER NAME loTranD MEMO
10416 replace itm_pkey WITH lnLastFkey ;
10417 IN (pcFinalSLN)
10418
10419 *--- 1045922, 28-JUN-2010 HNISAR
10420 *- 1054098 05/05/11 YIK
10421 IF lnTotalSLN_Qty > 0 && AND aTempArray[lncount,6] > 0
10422 *- replace pack_qty WITH aTempArray[lncount,5] * (aTempArray[lncount,6]/lnTotalSLN_Qty)
10423 Replace ppsize_qty with aTempArray[lncount,11], ;
10424 pack_qty WITH lnPack_qty
10425 ENDIF
10426 *=== 1045922 28-JUN-2010 HNISAR
10427 Replace Pack_total WITH pack_qty
10428 *= 1054098
10429
10430 *--- TechRec 1056973 07-Dec-2011 jisingh ---
10431 REPLACE sln01 WITH aTempArray[lncount,19]
10432 *=== TechRec 1056973 07-Dec-2011 jisingh ===
10433
10434 *- FH 1074465
10435 REPLACE sln_line_seq WITH aTempArray[lncount,20] && Line_seq from zzeipohd
10436 *- FH 1074465
10437
10438 lntotal_Qty = lntotal_Qty + aTempArray[lncount,6]
10439 *- 1041196 07/01/09 YIK
10440 *- Added lndtl_sln_qty
10441 lndtl_sln_qty = lndtl_sln_qty + aTempArray[lncount,11]
10442
10443 ENDIF
10444 IF lncount <> lnTotalRow
10445 DELETE IN (pcTransDetail)
10446 ELSE
10447 *--- TR 1037503 15-Dec-2008 Goutam
10448*!* lcSKU = ""
10449*!* lcUPC = ""
10450*!* DO CASE
10451*!* CASE EMPTY(aTempArray[lncount,4]) AND NOT EMPTY(aTempArray[lncount,3])
10452*!* lcUPC = ALLTRIM(aTempArray[lncount,10])
10453*!* CASE EMPTY(aTempArray[lncount,3]) AND NOT EMPTY(aTempArray[lncount,4])
10454*!* lcSKU = ALLTRIM(aTempArray[lncount,10])
10455*!* OTHERWISE
10456*!* lcUPC = ALLTRIM(aTempArray[lncount,10])
10457*!* lcSKU = ALLTRIM(aTempArray[lncount,10])
10458*!* ENDCASE
10459
10460 lcSKU = ALLTRIM(aTempArray[lncount,4])
10461 lcUPC = ALLTRIM(aTempArray[lncount,3])
10462 *--- TR 1037503 15-Dec-2008 Goutam
10463 *- TR 1041196 07/01/09 YIK
10464 *- Modified total_qty calculation to use lndtl_sln_qty
10465 *- instead of aTempArray[lncount,5] (assort_qty)
10466 *- 1052013 02/02/11 YIK
10467 *- GAP requires 856 detail qty to be in cases for 'Not full carton'
10468 *- for 'Full carton' it is always '1' and for GAP bulk - number of units.
10469 *- In any event it is total_qty/assort_qty.
10470 *- All other processes (810, 870) require qty in eaches.
10471*-- total_qty WITH IIF( ((ALLTRIM(aTempArray[lncount,15]) = "GAP") ; &&--- TechRec 1044701 27-Aug-2010 vkrishnamurthy ===
10472*-- OR EMPTY(aTempArray[lncount,16]) ) , ; &&--- TechRec 1044701 27-Aug-2010 vkrishnamurthy ===
10473*-- lntotal_Qty,; &&--- TechRec 1044701 27-Aug-2010 vkrishnamurthy ===
10474*-- IIF(lnDTL_SLN_Qty >0, CEILING(lntotal_Qty/lnDTL_SLN_Qty), 1)),
10475
10476*-- DO CASE
10477*-- CASE ALLTRIM(aTempArray[lncount,15]) = "GAP" ;
10478*-- AND ALLTRIM(pcEDITransaction) == 'OSH' ;
10479*-- AND ALLTRIM(aTempArray[lncount,18]) <> "GPB"
10480*-- lntotal_qty = CEILING(lntotal_Qty/lnDTL_SLN_Qty)
10481*-- OTHERWISE
10482*-- ENDCASE
10483 *- 07/01/11 YIK
10484 *- Modified the CASE to add non-GAP option to do the qty conversion.
10485 *- belongs(?) to TR 1052013, put in here in TR 1053523.
10486 *- Was used in TR 1053890... clear?
10487 DO CASE
10488 CASE ALLTRIM(aTempArray[lncount,15]) = "GAP"
10489 DO CASE
10490 CASE ALLTRIM(pcEDITransaction) == 'OSH' ;
10491 AND ALLTRIM(aTempArray[lncount,18]) <> "GPB"
10492 lntotal_qty = CEILING(lntotal_Qty/lnDTL_SLN_Qty)
10493 OTHERWISE
10494 ENDCASE
10495 *- TR 1060291 06/19/12 YIK
10496 *- For Charming Shoppes ppk_action = 'Q'/'M'
10497 CASE ALLTRIM(aTempArray[lncount,15]) = 'CHARMING SHOPPES 4030' AND NOT EMPTY(aTempArray[lncount,16]) &&for Charming ppk_action = 'Q'/'M'
10498 lntotal_qty = CEILING(lntotal_Qty/lnDTL_SLN_Qty)
10499 *=
10500
10501 *- TR 1083601 FH - taking out EMPTY(aTempArray[lncount,15]).
10502 CASE NOT EMPTY(aTempArray[lncount,16]) &&ppk_action
10503 lntotal_qty = CEILING(lntotal_Qty/lnDTL_SLN_Qty)
10504 OTHERWISE
10505 ENDCASE
10506
10507 *--- TR 1054438 27-05-2011 RKI ---*
10508 * If template ='GAP' bypass price replace
10509 IF ALLTRIM(aTempArray[lncount,15]) # "GAP"
10510 replace Price WITH aTempArray[lncount,9] ;
10511 IN (pcTransDetail)
10512 ENDIF
10513*!* replace Price WITH aTempArray[lncount,9], ;
10514*!* UPC WITH lcUPC, ;
10515*!* SKU WITH lcSKU, ;
10516*!* total_qty WITH lnTotal_qty, ;
10517*!* IB_UOM WITH aTempArray[lncount,7] , ;
10518*!* Style WITH "", ;
10519*!* Lbl_Code WITH "", ;
10520*!* Color_code WITH "", ;
10521*!* Dimension WITH "", ;
10522*!* size_desc WITH "", ;
10523*!* style_name WITH "", ;
10524*!* color_name WITH "" ;
10525*!* , style_name WITH lcStyle_name ; &&--- TR 1037555 NH
10526*!* , ppk_action WITH 'S' ; && TR 1052209 FH
10527*!* IN (pcTransDetail)
10528 replace UPC WITH lcUPC, ;
10529 SKU WITH lcSKU, ;
10530 total_qty WITH lnTotal_qty, ;
10531 IB_UOM WITH aTempArray[lncount,7] , ;
10532 Style WITH "", ;
10533 Lbl_Code WITH "", ;
10534 Color_code WITH "", ;
10535 Dimension WITH "", ;
10536 size_desc WITH "", ;
10537 style_name WITH "", ;
10538 color_name WITH "" ;
10539 , style_name WITH lcStyle_name ; &&--- TR 1037555 NH
10540 , ppk_action WITH 'S' ; && TR 1052209 FH
10541 , line_seq WITH lnLineSeq ; &&--- TechRec 1056973 08-Dec-2011 jisingh ===
10542 , sizebucket WITH lnSizeBucket ; &&--- TechRec 1059747 27-Apr-2012 jisingh ===
10543 IN (pcTransDetail)
10544 *=== TR 1054438 27-05-2011 RKI ===*
10545 ENDIF
10546 NEXT
10547 SELECT _SLNList
10548 ENDDO
10549 Endif
10550 Endif
10551 Endif
10552 Endif
10553
10554 .tableclose("_SLNList")
10555 .tableclose("__TmpCursor")
10556 .tableclose("__TempSLN")
10557 .cSQLTempTable = ""
10558 Endwith
10559 endif
10560
10561 Select(lnOldSelect)
10562 Return llRetVal
10563 Endproc
10564 *=== TR 1035491 6-Nov-2008 Goutam
10565
10566
10567 *--- TR 1036836 NSD 11/24/08
10568 * Bulk Insert Routines
10569 PROCEDURE GiveTempTableDefaults
10570 LPARAMETERS lcTmpTable
10571
10572 LOCAL lcSQL,lcField,lcDataType,lcFieldSize ,llRetVal,lcDefault
10573 llRetVal = .T.
10574
10575 =SQLCOLUMNS(g_nHandle,lcTmpTable,"FOXPRO","tcTmpFields")
10576 SELECT tcTmpFields
10577 SCAN
10578 lcField = ALLTRIM(tcTmpFields.field_name)
10579 lcDataType = UPPER(VFPToSQLDataType(tcTmpFields.field_type))
10580 lcFieldSize = This.GetDataFieldSize(tcTmpFields.field_type,;
10581 tcTmpFields.field_len,tcTmpFields.field_dec)
10582
10583 DO CASE
10584 CASE INLIST(lcDataType ,'C','M','CHAR','TEXT','BIT','VARCHAR','CLOB','VARG')
10585 lcDefault= SQLFormatChar("")
10586 CASE INLIST(lcDataType ,'I','N','MONEY','INT','INTEGER','BIGINT','SMALLINT','TINYINT','FLOAT','NUMERIC','REAL','SMALLMONEY')
10587 lcDefault= SQLFormatNum(0)
10588 CASE INLIST(lcDataType ,'T','D','DATETIME','SMALLDATETIME','TIMESTMP','DATE')
10589 lcDefault= SQLFormatTS(DATE(1900,1,1))
10590 ENDCASE
10591
10592
10593 lcSQL = ;
10594 "ALTER TABLE " + lcTmpTable + " ALTER COLUMN " + lcField + ;
10595 " " + lcDataType + " " + lcFieldSize + " NOT NULL "
10596 llRetVal = llRetVal AND v_sqlexec(lcSQL)
10597
10598 lcSQL = ;
10599 "ALTER TABLE " + lcTmpTable + " ADD CONSTRAINT " + lcField + ;
10600 "_" + getuniquefilename() + "_def DEFAULT "+lcDefault+" FOR " + lcField
10601 llRetVal = llRetVal AND v_sqlexec(lcSQL)
10602
10603 ENDSCAN
10604
10605
10606 RETURN llRetVal
10607
10608 ENDPROC
10609
10610 *--------------------------------------------------------------------------------------------
10611 PROCEDURE CloneTableWithDefaults
10612 LPARAMETERS tcTable, tcCloneTable, taExcludeAndReplaceDef, llExcludeMemo
10613
10614 LOCAL lcSql, llRetVal, lnOldSelect
10615 llRetVal = .t.
10616 lnOldSelect = SELECT()
10617 * --- TR 1038491 2/17/09 CM Added when 106 then ' [numeric] (' + ltrim(str(c.xPrec)) + ', ' + ltrim(str(c.xScale)) + ') DEFAULT ((0.0))'
10618 TEXT TO lcSql NOSHOW
10619 select ' [' + c.name + '] ' + case c.xtype when 56 then ' [int] DEFAULT ((0)) '
10620 when 175 then ' [char] (' + ltrim(str(c.length)) + ') DEFAULT ('''') '
10621 when 61 then ' [datetime] DEFAULT (''1900-01-01 00:00:00.000'')'
10622 when 108 then ' [numeric] (' + ltrim(str(c.xPrec)) + ', ' + ltrim(str(c.xScale)) + ') DEFAULT ((0.0))'
10623 when 106 then ' [numeric] (' + ltrim(str(c.xPrec)) + ', ' + ltrim(str(c.xScale)) + ') DEFAULT ((0.0))'
10624 when 35 then ' [text] default('''') '
10625 when 167 then ' [varchar] (' + ltrim(str(c.length)) + ') default ('''') '
10626 else '' end FieldDef
10627 ,c.name as fieldName, c.xtype, c.length, c.xPrec as Prec, c.xScale as Scale
10628 from tempdb..sysobjects t join tempdb..syscolumns c on t.id = c.id where t.name = 'ZZOORDRH'
10629 ENDTEXT
10630
10631 IF llExcludeMemo
10632 lcSQL = lcSQL + " AND c.xtype <> 35 "
10633 ENDIF
10634
10635 IF LEFT(tcTable,1) == "#" then
10636 lcSql = STRTRAN(lcSql,"ZZOORDRH", ALLTRIM(tcTable) + "%")
10637 ELSE
10638 lcSql = STRTRAN(lcSql,"ZZOORDRH", ALLTRIM(tcTable))
10639 lcSql = STRTRAN(lcSql, "tempdb..","")
10640 ENDIF
10641
10642 llRetVal = llRetVal and v_sqlExec(lcSql, 'TblSturcture')
10643 IF NOT llRetVal OR (USED('TblSturcture') AND RECCOUNT('TblSturcture') = 0)
10644 SELECT(lnOldSelect)
10645 RETURN llRetVal
10646 ENDIF
10647
10648 LOCAL lcAllFieldDef, lnIndex, lcFieldDef
10649 lcAllFieldDef = ""
10650 lcFieldDef = ""
10651 lnIndex = 0
10652 SELECT("TblSturcture")
10653 SCAN
10654 lcFieldDef = FieldDef
10655 FOR lnIndex = 1 TO ALEN(taExcludeAndReplaceDef,1)
10656 IF ALLTRIM(FieldName) = taExcludeAndReplaceDef[lnIndex,1]
10657 lcFieldDef = ""
10658 IF NOT EMPTY(taExcludeAndReplaceDef[lnIndex,2])
10659 lcFieldDef = taExcludeAndReplaceDef[lnIndex,2]
10660 ENDIF
10661 ENDIF
10662 ENDFOR
10663
10664 IF NOT empty(lcFieldDef)
10665 lcAllFieldDef = lcAllFieldDef + ALLTRIM(lcFieldDef) + ", "
10666 ENDIF
10667 ENDSCAN
10668 lcAllFieldDef = LEFT(lcAllFieldDef, LEN(lcAllFieldDef) - 2)
10669 lcSql = " CREATE TABLE [" + tcCloneTable + "]( " + lcAllFieldDef + " ) "
10670 llRetVal = llRetVal and v_sqlExec(lcSql)
10671 RETURN llRetVal
10672 ENDPROC
10673
10674
10675 * ---------------------------------------------------------------
10676 * This will create a pipe delimited file and then do a SQL bulk insert into a table.
10677 PROCEDURE BulkInsertFromCursor
10678 LPARAMETERS tcSource,tcTarget
10679
10680 WITH THIS
10681
10682 LOCAL llRetVal,lnSelect,lcSource,lcSQL,lcFile,lcDirectory
10683 llRetVal = .T.
10684 lnSelect = SELECT()
10685
10686 * --- TR 1027596 NSD 10/31/07
10687 * This is a lot cleaner to use the inbound directory since we already know we have modify acess.
10688 *lcDirectory = ADDBS(goEnv.sv("ALLOC_RESULTSAVE_BULKUNC",""))
10689 lcDirectory = This.GetEDIFlatFileDirectory("Inbound")
10690 lcDirectory = convertMapDrivePathToUnc(lcDirectory)
10691 * === TR 1027596 NSD 10/31/07
10692
10693 IF NOT DIRECTORY(lcDirectory)
10694 llRetVal = .F.
10695 .LogEntry("Could not locate Bulk Insert Save Location")
10696 ELSE
10697 lcFile = lcDirectory + GetUniqueFileName() + this.class + ".txt" &&*- 1060114 FH
10698
10699 IF EMPTY(tcSource)
10700 lcSource = ALIAS()
10701 ELSE
10702 lcSource = ALLTRIM(tcSource)
10703 ENDIF
10704
10705 IF NOT USED(lcSource)
10706 .LogEntry("Source Cursor is not found: " + lcSource)
10707 llRetVal = .F.
10708 ELSE
10709 SELECT (lcSource)
10710
10711 THIS.BulkInsert_CorrectDateFields(tcSource)
10712
10713 * Output File to Server
10714 .LogEntry("BULK_INSERT: Creating Delimited file " + lcFile)
10715 COPY TO (lcFile) TYPE DELIMITED WITH "" WITH CHARACTER "|"
10716
10717 IF NOT FILE(lcFile)
10718 llRetVal = .F.
10719 .LogEntry("BULK_INSERT: Failed to create delimited file. Consult Error log.")
10720 ELSE
10721 .LogEntry("BULK_INSERT: Successfully created delimited file")
10722 *- 1060114 FH - adds temp file path to array. The array is always full, we increment it's size only when we need to
10723 this.nCounter = this.nCounter + 1
10724 DIMENSION this.aBulkTables[this.nCounter]
10725 this.aBulkTables[this.nCounter] = lcFile
10726 *- 1060114 FH
10727 ENDIF
10728 *--- TR 1094295 07/13/16 ATHIRUNAVU
10729 lcSQLdateFormat=""
10730 lcSQLdateFormat=GetSqlCurrentDateFormat()
10731 *=== TR 1094295 07/13/16 ATHIRUNAVU
10732
10733 IF llRetVal
10734
10735 *-TR 1087774 FH - added support for different date formats
10736 lcSQL = ""
10737 lcDateFormat = getDateFormat(EDI_USER)
10738 DO case
10739 CASE INLIST(lcDateFormat, 'BRITISH','FRENCH','GERMAN','ITALIAN','DMY')
10740 lcSQL = " SET DATEFORMAT DMY "
10741 CASE INLIST(lcDateFormat, 'JAPAN','TAIWAN','ANSI','YMD')
10742 lcSQL = " SET DATEFORMAT YMD "
10743 OTHERWISE && otherwise leave lcSQL empty, assume it's MDY
10744 ENDCASE
10745 *-TR 1087774 FH -
10746
10747 * Call Bulk Insert
10748 .LogEntry("BULK_INSERT: Performing Bulk Insert")
10749 *--- TR 1073301 21-Nov-2013 Yuri/SMeenraja included CODEPAGE = 'ACP' to support extended characters
10750*!* lcSQL = "BULK INSERT " + tcTarget + ;
10751*!* " FROM '" + lcFile + "' WITH (FIELDTERMINATOR = '|') "
10752
10753 lcSQL = lcSQL + "BULK INSERT " + tcTarget + ; && FH 1087774 - added lcSQL before
10754 " FROM '" + lcFile + "' WITH (FIELDTERMINATOR = '|', CODEPAGE = 'ACP') "
10755
10756 llRetVal = v_sqlexec(lcSQL)
10757 ENDIF
10758 *--- TR 1094295 07/13/16 ATHIRUNAVU
10759 If !Empty(lcSQLdateFormat)
10760 lcSQL = " SET DATEFORMAT "+lcSQLdateFormat+" "
10761 llRetVal = llRetVal And v_sqlExec(lcSQL)
10762 Endif
10763 *=== TR 1094295 07/13/16 ATHIRUNAVU
10764
10765 * Clean up the file when completed. We may want to leave a debugging option
10766 IF FILE(lcFile)
10767 *DELETE FILE (lcFile)
10768 sysnoerror("DELETE FILE " + lcFile)
10769 ENDIF
10770 ENDIF
10771 ENDIF
10772
10773 ENDWITH
10774
10775 SELECT (lnSelect)
10776 RETURN llRetVal
10777
10778 ENDPROC
10779
10780 *-----------------------------------------------------
10781 PROCEDURE BulkInsert_CorrectDateFields
10782 LPARAMETERS tcCursor
10783
10784 LOCAL laFields[1],lnCount,lcField
10785 lnCount = AFIELDS(laFields,tcCursor)
10786
10787 FOR x = 1 TO lnCount
10788 IF INLIST(laFields[x,2],"T","D")
10789 lcField = laFields[x,1]
10790
10791 THIS.BulkInsert_CorrectDateFieldsOne(tcCursor,lcField)
10792
10793 ENDIF
10794 ENDFOR
10795
10796
10797 *----------------------------------------------------
10798 PROCEDURE BulkInsert_CorrectDateFieldsOne
10799 LPARAMETERS tcCursor,tcField
10800
10801 LOCAL lnMonth,lnYear,lnDay,ltCurVal
10802
10803 SELECT (tcCursor)
10804
10805
10806
10807 * --- TR 1037516 2/13/09 CM
10808 * Replace All on details may be endless, seek/scan added instead
10809 *lcMac = "replace ALL "+tcField+" WITH {1/1/1900} for ISNULL("+tcField+") OR EMPTY("+tcField+")"
10810
10811 *--- TR 1044101 17-DEC-2009 HNISAR
10812*!* INDEX ON tcField TAG datefiller
10813*!* SET ORDER TO datefiller
10814*!* IF SEEK("")
10815*!* SCAN WHILE tcField = ""
10816*!* lcMac = "replace "+tcField+" WITH {1/1/1900}"
10817*!* &lcMac
10818*!* ENDSCAN
10819*!* ENDIF
10820
10821
10822 * --- TR 1040686 Aug-04-09 BR
10823*!* INDEX ON CAST(&tcField as Char) TAG datefiller
10824*!* SET ORDER TO datefiller
10825*!* * --- TR 1040686 Aug-04-09 BR
10826*!*
10827*!* DO WHILE SEEK(" ")
10828*!* lcMac = "replace "+tcField+" WITH {1/1/1900}"
10829*!* &lcMac
10830*!* ENDDO
10831
10832 INDEX ON (&tcField) = {} TAG datefiller
10833 SET ORDER TO datefiller
10834
10835 lcMac = "update "+(tcCursor)+" set "+tcField+" = {1/1/1900} where "+tcField+" = {} OR ISNULL("+tcField+")"
10836 &lcMac
10837
10838 * --- TR 1040686 Aug-04-09 BR
10839 *=== TR 1044101 17-DEC-2009 HNISAR
10840
10841
10842 * === TR 1037516 2/13/09 CM
10843
10844 ENDPROC
10845 *=== TR 1036836 NSD 11/24/08
10846
10847 *-----------------------------------------------
10848 *--- TR 1039837 NSD
10849 PROCEDURE MergeFlatFiles
10850 LPARAMETERS tcSource,tcTargetFile
10851
10852 * 1- If tmp exists in Inbound, delete.
10853 * 2- retrieve list of files for inbound\batch
10854 * 3- for each dat file, ren to *.gen
10855 * 4- merge all dat files to tmp.
10856 * 5- merge tmp to target dat
10857 WITH THIS
10858
10859 LOCAL llRetVal,lnFCount,laDirectory[1],lcBatchDirectory,lcInboundDirectory,lcTempFile,x,lnHandle,lcFile, lcRename
10860 llRetVal = .T.
10861 lcInboundDirectory = ADDBS(THIS.GetEDIFlatFileDirectory("Inbound"))
10862 lcBatchDirectory = lcInboundDirectory + "Batch\"
10863 lcTempFile = FORCEEXT(lcInboundDirectory + tcTargetFile,"pri")
10864
10865 lnFCount = ADIR(laDirectory,lcBatchDirectory + tcSource)
10866 .Logentry(TRANSFORM(lnFcount) + " files found at " + lcBatchDirectory + tcSource)
10867 IF lnFCount > 0
10868 IF FILE(lcTempFile)
10869 DELETE FILE (lcTempFile)
10870 ENDIF
10871
10872 FOR x = 1 TO lnFCount
10873 .LogEntry("Processing File Batch File(" + TRANSFORM(x) + "): " + laDirectory[x,1])
10874 lcFile = lcBatchDirectory + laDirectory[x,1]
10875
10876 .CopyToFlatFileInBlock(lcFile,lcTempFile)
10877
10878
10879 lcRename = lcBatchDirectory + JUSTSTEM(lcFile) + "_" + TTOC(DATETIME(),1) + ".gen"
10880
10881 RENAME (lcFile) TO (lcRename)
10882
10883 ENDFOR
10884
10885 .CopyToFlatFileInBlock(lcTempFile,lcInboundDirectory+tcTargetFile)
10886
10887 ENDIF
10888
10889 ENDWITH
10890 ENDPROC
10891 *=== TR 1039837 NSD
10892
10893 *--- TR 1036614 10-Jun-2009 Goutam
10894 Procedure GetPOHistSLN
10895 Parameters pceTransHeader, pceTransDetail, pcItemSLN
10896
10897 Local llRetVal, lcSQLSelect
10898 llRetVal = .T.
10899 lnOldSelect = Select()
10900
10901 *- 06/18/12 1060291 YIK
10902 *- removed WHERE h.chk_hist = 'Y'
10903 Select s.itm_pkey, d.ord_num, d.line_seq, s.sizebucket ;
10904 From (pceTransDetail) d Join (pceTransHeader) h ;
10905 on h.Pkey = d.Fkey ;
10906 Join (pcItemSLN) s on d.pkey = s.itm_pkey ;
10907 Into Cursor __TmpCursor
10908
10909 With This
10910 If Recc("__TmpCursor")> 0
10911 .cSQLTempTable=""
10912 llRetVal= llRetVal And .GenerateSQLTempTable('__TmpCursor')
10913 llRetVal= llRetVal And .PopulateSQLTempTable('__TmpCursor') And !Empty(.cSQLTempTable)
10914
10915 *--- TechRec 1051779 07-Apr-2011 jisingh Added s.sln_qty ===
10916 *--- TechRec 1051779 07-Apr-2011 jisingh Added s.pkey ==
10917 *--- TechRec 1056973 30-Nov-2011 jisingh Added s.aux_sku ===
10918 *--- TechRec 1058970 02-Feb-2012 jisingh Added s.sln_sku as sku ===
10919 *- 1074465/1078006 FH add line_seq
10920
10921 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 " +;
10922 "From zzeipohs s, " + .cSQLTempTable + " t " +;
10923 "Where s.ord_num= t.ord_num and s.line_seq = t.line_seq and s.sizebucket= t.sizebucket"
10924 llRetVal= llRetVal And v_SQLexec(lcSqlString, "tcHistSLN")
10925 If Recc("tcHistSLN")> 0
10926 Select tcHistSLN
10927 Index On STR(itm_pkey) + upc Tag UPC_ITM
10928 *--- TechRec 1058970 02-Feb-2012 jisingh ---
10929 Index On STR(itm_pkey) + sku Tag SKU_ITM
10930 *=== TechRec 1058970 02-Feb-2012 jisingh ===
10931
10932
10933*- TR 1070393 FH - comment out
10934*!* llRetVal= llRetVal And .SetRelation("tcHistSLN", "UPC_ITM", pcItemSLN, "STR(itm_pkey) + upc")
10935*!* Select (pcItemSLN)
10936*!* *--- TechRec 1051779 07-Apr-2011 jisingh Added ppsize_qty WITH tcHistSLN.sln_qty ===
10937*!* *--- TechRec 1058970 02-Feb-2012 jisingh Added FOR !EMPTY(upc) ===
10938*!* *--- TR 1061829/1060291 09-Jul-12 SK Added condition !EOF("tcHistSLN") to avoid overwritting with unmatched SLN Details ===
10939*!* replace ALL SLN01 WITH tcHistSLN.SLN01, ppsize_qty WITH tcHistSLN.sln_qty, ;
10940*!* sfkey WITH tcHistSLN.pkey, aux_sku WITH IIF(EMPTY(aux_sku), tcHistSLN.aux_sku, aux_sku) ; &&--- TechRec 1056973 16-Nov-2011 jisingh ===
10941*!* FOR !EMPTY(upc) AND !EOF("tcHistSLN") IN (pcItemSLN)
10942
10943*!* *--- TechRec 1058970 02-Feb-2012 jisingh ---
10944*!* llRetVal= llRetVal And .SetRelation("tcHistSLN", "SKU_ITM", pcItemSLN, "STR(itm_pkey) + sku")
10945*!* Select (pcItemSLN)
10946*!*
10947*!* *-TR 1070393 FH - Adding Condtion EMPTY(UPC)
10948*!* *- We are getting scenarios where Same SKU are coming in in 850 for different sizebucket in SLN.
10949*!* *- So the relation on item_pkey + sku, will not suffice.
10950*!* *- We decided to add EMPTY(UPC), if we did the replace above for UPC then don't bother doing SKU replace
10951*!* *--- TR 1061829/1060291 09-Jul-12 SK Added condition !EOF("tcHistSLN") to avoid overwritting with unmatched SLN Details ===
10952*!* replace ALL SLN01 WITH tcHistSLN.SLN01, ppsize_qty WITH tcHistSLN.sln_qty, ;
10953*!* sfkey WITH tcHistSLN.pkey, aux_sku WITH IIF(EMPTY(aux_sku), tcHistSLN.aux_sku, aux_sku) ; &&--- TechRec 1056973 16-Nov-2011 jisingh ===
10954*!* FOR !EMPTY(sku) AND !EOF("tcHistSLN") AND EMPTY(UPC) IN (pcItemSLN)
10955 *=== TechRec 1058970 02-Feb-2012 jisingh ===
10956
10957 Select (pcItemSLN)
10958 SCAN
10959 *- TR 1082741 FH - added check for not empty UPC
10960 IF (!EMPTY(UPC)) AND SEEK(STR(itm_pkey) + upc, "tcHistSLN", "UPC_ITM")
10961 replace SLN01 WITH tcHistSLN.SLN01, ppsize_qty WITH tcHistSLN.sln_qty, ;
10962 sfkey WITH tcHistSLN.pkey, aux_sku WITH IIF(EMPTY(aux_sku), tcHistSLN.aux_sku, aux_sku), ; &&--- TechRec 1056973 16-Nov-2011 jisingh ===
10963 sln_line_seq with tcHistSLN.line_seq && 1074465/1078006 FH add line_seq
10964 ELSE
10965 IF SEEK(STR(itm_pkey) + sku, "tcHistSLN","SKU_ITM")
10966 replace SLN01 WITH tcHistSLN.SLN01, ppsize_qty WITH tcHistSLN.sln_qty, ;
10967 sfkey WITH tcHistSLN.pkey, aux_sku WITH IIF(EMPTY(aux_sku), tcHistSLN.aux_sku, aux_sku), ; &&--- TechRec 1056973 16-Nov-2011 jisingh ===
10968 sln_line_seq with tcHistSLN.line_seq && 1074465/1078006 FH add line_seq
10969 endif
10970 ENDIF
10971 ENDSCAN
10972*TR 1070393 FH - comment
10973 Endif
10974 *Set Relation To TR 1070393 FH
10975 Endif
10976 .TableClose("tcHistSLN")
10977 .TableClose("__TmpCursor")
10978 Endwith
10979 Select(lnOldSelect)
10980 Return llRetVal
10981 ENDPROC
10982 *=== TR 1036614 10-Jun-2009 Goutam
10983
10984*========================================================
10985*--- TechRec 1044701 10-Feb-2010 vkrishnamurthy ---
10986 Procedure GetContactEmail
10987 Lparameters tnPkey, tcTable
10988 Local lcRetVal, lnOldSelect
10989 lcRetVal = ""
10990 lnOldSelect = Select()
10991 If vl_commu(tcTable,'','TcCommu','e-mail',tnPkey)
10992 Select TcCommu
10993 lcRetVal = Alltrim(accessnum)
10994 Use In TcCommu
10995 Endif
10996 Select (lnOldSelect)
10997 Return lcRetVal
10998 Endproc
10999*=== TechRec 1044701 10-Feb-2010 vkrishnamurthy ===
11000*========================================================
11001
11002
11003 * --- TR 1044514 3/25/10 CM/NSD
11004 *-------------------------------------------------
11005 * 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.
11006 * In this case, Aux SKU is required
11007 PROCEDURE ValidateAuxSKUForVMIInvoices
11008 LPARAMETERS pcHeader, pcDetail, pceoinCR, plVMI
11009
11010 LOCAL llRetVal,lnSelect,lcORder
11011 llRetVal = .T.
11012 lnSelect = SELECT()
11013
11014 WITH THIS
11015
11016 SELECT d.pkey FROM (pcDetail) d JOIN (pcHeader) h ON h.pkey = d.fkey ;
11017 JOIN (pceoinCR) c ;
11018 ON h.customer = c.customer AND h.division = c.division ;
11019 WHERE NOT EMPTY(c.vmi_ord_source) AND c.template = 'AAFES 4010' AND h.source = c.vmi_ord_source ;
11020 AND h.errs_flg_h <> 'Y' AND d.errs_flg_d <> 'Y' ;
11021 INTO CURSOR tcVMIDtls READWRITE
11022
11023 SELECT tcVMIDtls
11024 SCAN
11025 IF SEEK(tcVMIDtls.pkey,pcDetail,"pkey")
11026 SELECT (pcDetail)
11027 IF EMPTY(aux_sku)
11028 Replace Errs_Flg_D With "Y", ;
11029 Errs_Msg_D With Errs_Msg_D + "Aux SKU Required for AAFES 4010 VMI Orders." + CRLF IN (pcDetail)
11030 ELSE
11031 replace upc WITH LEFT(aux_sku,12) IN (pcDetail)
11032 plVMI = .T.
11033 ENDIF
11034 ENDIF
11035 ENDSCAN
11036
11037 ENDWITH
11038
11039 SELECT (lnSelect)
11040 RETURN llRetVal
11041
11042 ENDPROC
11043
11044 PROCEDURE GroupAndSumDataForVMI
11045 LPARAMETERS pcSource, pcHeader, pcControl, pcFinalSLN
11046
11047 * --- TR 1049226 9/1/10 CM --- Added lcFkey
11048 LOCAL lcUpc, lcFkey, lnOldSelect, llHaveSLN
11049 STORE "" TO lcUpc, lcFkey
11050 lnOldSelect = SELECT()
11051 llHaveSLN = RECCOUNT(pcFinalSLN) > 0
11052
11053 * --- For VMI orders if we have SLNs and the same sln upc exists
11054 * across multiple prepacks or range styles then consolidate those
11055 * particular slns.
11056 * --- TR 1049226 9/1/10 CM --- Added p.itm_pkey to Group By
11057 IF llHaveSLN
11058 SELECT p.*, ;
11059 SUM(VAL(ppsize_qty)) as Slnppsize_qty, ;
11060 SUM(VAL(pack_total)) as Slnpack_total, ;
11061 SUM(VAL(pack_qty)) as Slnpack_qty, ;
11062 COUNT(*) as slndups ;
11063 FROM (pcFinalSLN) p ;
11064 JOIN (pcSource) d ;
11065 ON p.itm_pkey = d.pkey ;
11066 JOIN (pcHeader) h ;
11067 ON d.fkey = h.pkey ;
11068 JOIN (pcControl) c ;
11069 ON h.division = c.division ;
11070 AND h.customer = c.customer ;
11071 WHERE NOT EMPTY(p.upc) ;
11072 AND NOT EMPTY(c.vmi_ord_source) ;
11073 AND h.source = c.vmi_ord_source ;
11074 AND c.template = 'AAFES 4010' ;
11075 GROUP BY p.upc, p.itm_pkey ;
11076 HAVING COUNT(*) > 1 ;
11077 INTO CURSOR __SlnDups
11078
11079 SELECT __SlnDups
11080 SCAN
11081 lcUpc = upc
11082 lcFkey = itm_pkey
11083 SCATTER MEMVAR MEMO
11084 m.ppsize_qty = STR(m.Slnppsize_qty)
11085 m.pack_total = STR(m.Slnpack_total)
11086 m.pack_qty = STR(m.Slnpack_qty)
11087
11088 * --- TR 1049226 9/1/10 CM
11089 *DELETE FROM (pcFinalSLN) WHERE upc == lcUPC
11090 DELETE FROM (pcFinalSLN) WHERE upc == lcUPC AND itm_pkey = lcFkey
11091 * === TR 1049226 9/1/10 CM
11092
11093 INSERT INTO (pcFinalSLN) FROM MEMVAR
11094 ENDSCAN
11095 ENDIF
11096
11097 * --- Detail consolidation for VMI based on contract upc
11098 * --- TR 1049226 9/1/10 CM --- Added s.fkey to Group By
11099 SELECT s.* , ;
11100 SUM(VAL(total_qty)) as Caltotal_qty, ;
11101 SUM(VAL(OpenPickQty)) as CalOpenPickQty, ;
11102 SUM(VAL(CancelQty)) as CalCancelQty, ;
11103 SUM(VAL(InvoiceQty)) as CalInvoiceQty, ;
11104 COUNT(*) as tcDups ;
11105 FROM (pcSource) s ;
11106 JOIN (pcHeader) h ;
11107 ON s.fkey = h.pkey ;
11108 JOIN (pcControl) c ;
11109 ON h.division = c.division ;
11110 AND h.customer = c.customer ;
11111 WHERE NOT EMPTY(upc) ;
11112 AND NOT EMPTY(c.vmi_ord_source) ;
11113 AND h.source = c.vmi_ord_source ;
11114 AND c.template = 'AAFES 4010' ;
11115 GROUP BY s.upc, s.fkey ;
11116 HAVING COUNT(*) > 1 ;
11117 INTO CURSOR tcRollUp
11118
11119 SELECT s.pkey FROM (pcSource) s ;
11120 JOIN tcRollup r ;
11121 ON s.upc = r.upc ;
11122 INTO CURSOR __SlnKeys
11123
11124 SELECT tcRollUp
11125 SCAN
11126 lcUpc = upc
11127 lcFkey = fkey && TR 1049226 9/1/10 CM
11128 SCATTER MEMVAR MEMO
11129 m.total_qty = STR(m.Caltotal_qty)
11130 m.OpenPickQty = STR(m.CalOpenPickQty)
11131 m.CancelQty = STR(m.CalCancelQty)
11132 m.InvoiceQty = STR(m.CalInvoiceQty)
11133 m.size_desc = ""
11134
11135 * --- TR 1049226 9/1/10 CM
11136 *DELETE FROM (pcSource) WHERE upc == lcUPC
11137 DELETE FROM (pcSource) WHERE upc == lcUPC AND fkey = lcFkey
11138 * === TR 1049226 9/1/10 CM
11139
11140 INSERT INTO (pcSource) FROM MEMVAR
11141 ENDSCAN
11142
11143 * --- Already deleted details earlier on based on VMI
11144 * rollup, so we need to synch the remaining SLNs to their
11145 * matching contract upcs.
11146 UPDATE s ;
11147 SET s.itm_pkey = d.pkey ;
11148 FROM (pcFinalSLN) s ;
11149 JOIN (pcSource) d ;
11150 on s.itm_pkey <> d.pkey ;
11151 JOIN __SlnKeys p ;
11152 on d.pkey = p.pkey
11153
11154 IF USED("tcRollUp")
11155 USE IN tcRollUp
11156 ENDIF
11157
11158 IF USED("__SlnKeys")
11159 USE IN __SlnKeys
11160 ENDIF
11161
11162 IF USED("__SlnDups")
11163 USE IN __SlnDups
11164 ENDIF
11165
11166 SELECT (lnOldSelect)
11167
11168 ENDPROC
11169 *=================================================
11170 * === TR 1044514 3/25/10 CM/NSD
11171
11172 *--- TechRec 1051443 23-May-2011 jisingh ---
11173 PROCEDURE PopulateDataWhse
11174 LPARAMETERS pceTransHeader, pceTransDetail, pceControl, pcWhseHeader, pcWhseDetail
11175 LOCAL llRetVal, lnSelect, lcSqlString
11176
11177 llRetVal = true
11178 lnSelect = SELECT()
11179
11180 WITH This
11181 SELECT DISTINCT h.ord_num FROM (pceTransHeader) h ;
11182 JOIN (pceControl) c ON h.division = c.division AND h.customer = c.customer ;
11183 WHERE c.data_whse = 'Y' INTO CURSOR __TmpCursor
11184
11185 IF USED("__TmpCursor") AND RECCOUNT("__TmpCursor") > 0
11186 .cSQLTempTable = ""
11187 IF .GenerateSQLTempTable('__TmpCursor') AND ;
11188 .PopulateSQLTempTable('__TmpCursor') AND !EMPTY(.cSQLTempTable)
11189
11190 lcSqlString = "SELECT s.pkey, s.ord_num, s.line_seq, s.sizebucket, s.segment, s.element, s.qualifier, s.value " + ;
11191 "FROM zzedatawhse s, " + .cSQLTempTable + " t " + ;
11192 "WHERE s.ord_num = t.ord_num AND s.table_name = 'ZZOORDRH'"
11193
11194 llRetVal = llRetVal AND v_SQLExec(lcSqlString, "tcWhseHeader")
11195
11196 .MakeCursorWritable("tcWhseHeader", pcWhseHeader)
11197 ENDIF
11198 ENDIF
11199
11200
11201 *- 1060291 03/23/2012 YIK
11202 *- Added h.template, d.slntodtl
11203 SELECT DISTINCT h.ord_num, d.line_seq, d.sizebucket, d.pkey, h.template, d.slntodtl FROM (pceTransHeader) h ;
11204 JOIN (pceTransDetail) d ON h.pkey = d.fkey ;
11205 JOIN (pceControl) c ON h.division = c.division AND h.customer = c.customer ;
11206 WHERE c.data_whse = 'Y' INTO CURSOR __TmpCursor
11207
11208 IF USED("__TmpCursor") AND RECCOUNT("__TmpCursor") > 0
11209 .cSQLTempTable = ""
11210 IF .GenerateSQLTempTable('__TmpCursor') AND ;
11211 .PopulateSQLTempTable('__TmpCursor') AND !EMPTY(.cSQLTempTable)
11212
11213 *- 1060291 03/23/12 YIK
11214 *- Added IF for the 810 process to check ZZEIPOHS and SLNtoDTL,
11215 *- as it has to work for 810 process for Charming Shoppe or if SLNtoDTL = 'I' .
11216 *- TR 1064630 FH - added s.table_name = 'ZZOORDRD'
11217 IF UPPER(pceTransHeader) = 'TCEOINTH'
11218 lcSqlString = "SELECT s.pkey, s.ord_num, s.line_seq, s.sizebucket, s.segment, " + ;
11219 " s.element, s.qualifier, s.value, t.pkey AS fkey " + ;
11220 "FROM zzedatawhse s, " + .cSQLTempTable + " t " + ;
11221 "WHERE s.ord_num = t.ord_num AND s.line_seq = t.line_seq " + ;
11222 " AND s.sizebucket = t.sizebucket " + ;
11223 " AND ((s.table_name = 'ZZEIPOHS' AND (t.template = 'CHARMING SHOPPES 4030' OR t.slntodtl = 'I')) " + ;
11224 " OR (s.table_name = 'ZZOORDRD') )"
11225 ELSE
11226 lcSqlString = "SELECT s.pkey, s.ord_num, s.line_seq, s.sizebucket, s.segment, " + ;
11227 " s.element, s.qualifier, s.value, t.pkey AS fkey " + ;
11228 "FROM zzedatawhse s, " + .cSQLTempTable + " t " + ;
11229 "WHERE s.ord_num = t.ord_num AND s.line_seq = t.line_seq " + ;
11230 " AND s.sizebucket = t.sizebucket " + ;
11231 " AND s.table_name = 'ZZOORDRD' "
11232 ENDIF
11233 *= 1060291
11234
11235 llRetVal = llRetVal AND v_SQLExec(lcSqlString, "tcWhseDetail")
11236
11237 .MakeCursorWritable("tcWhseDetail", pcWhseDetail)
11238 ENDIF
11239 ENDIF
11240 .TableClose("tcWhseHeader")
11241 .TableClose("tcWhseDetail")
11242 .TableClose("__TmpCursor")
11243 ENDWITH
11244
11245 SELECT (lnSelect)
11246 RETURN llRetVal
11247 ENDFUNC
11248
11249 *=================================================
11250
11251 FUNCTION BuildDWhseString
11252 LPARAMETERS tcDetail, tcFinalEDID, tcEDIDIndexTag, tcFlatFileString, tlDelimited, tcDelimiter
11253 LOCAL llRetVal, lnSelect, lnDetPkey
11254
11255 llRetVal = true
11256 lnSelect = SELECT()
11257
11258 WITH This
11259 lnDetPkey = &tcDetail..pkey
11260 SELECT (tcFinalEDID)
11261 IF SEEK(lnDetPkey, tcFinalEDID, tcEDIDIndexTag)
11262 SCAN WHILE fkey = lnDetPkey
11263 tcFlatFileString = tcFlatFileString + "EDID" + tcDelimiter + .ConvertRecordToText(tcFinalEDID, tlDelimited, tcDelimiter)
11264 ENDSCAN
11265 ENDIF
11266 ENDWITH
11267
11268 SELECT (lnSelect)
11269 RETURN llRetVal
11270 ENDFUNC
11271 *=== TechRec 1051443 23-May-2011 jisingh ===
11272
11273
11274 *--- TR 1056928 10-Nov-2011 Partha ---
11275 * .GetPpkLineInfo()
11276
11277 PROCEDURE GetPpkLineInfo
11278 LPARAMETERS pcPpkSource
11279 LOCAL llRetVal, lnSelect, lcSqlString, lcOldSQLTempTable
11280
11281 llRetVal = true
11282 lnSelect = SELECT()
11283
11284 WITH This
11285 * distinct sku is from ppk componet but third_party_item value is still from main sku
11286 SELECT DISTINCT h.division,h.style,h.color_code,h.lbl_code,h.dimension ;
11287 INTO CURSOR __TmpCursor ;
11288 FROM (pcPpkSource) h
11289
11290 IF USED("__TmpCursor") AND RECCOUNT("__TmpCursor") > 0
11291 lcOldSQLTempTable = .cSQLTempTable
11292 .cSQLTempTable = ""
11293 IF .GenerateSQLTempTable('__TmpCursor') AND ;
11294 .PopulateSQLTempTable('__TmpCursor') AND !EMPTY(.cSQLTempTable)
11295
11296 lcSqlString = "SELECT t.*, " + ;
11297 " CASE WHEN d.third_party_item > ' ' THEN d.third_party_item " +;
11298 " WHEN h.third_party_item > '' THEN h.third_party_item ELSE d.style END ppk_3rdPartyitem " + ;
11299 " FROM zzxscolr d " + ;
11300 " JOIN zzxstylr h " +;
11301 " ON h.pkey = d.fkey " + ;
11302 " JOIN " + .cSQLTempTable + " t " + ;
11303 " ON d.division = t.division " + ;
11304 " AND d.style = t.style " + ;
11305 " AND d.color_code = t.color_code " + ;
11306 " AND d.lbl_code = t.lbl_code " + ;
11307 " AND d.dimension = t.dimension "
11308 llRetVal = llRetVal AND v_SQLExec(lcSqlString, "tcPpkLineinfo")
11309
11310 IF USED("tcPpkLineinfo") AND RECCOUNT("tcPpkLineinfo") >0
11311 UPDATE h ;
11312 SET h.ppk_3rdPartyitem = ppk.ppk_3rdPartyitem ;
11313 FROM (pcPpkSource) h ;
11314 JOIN tcPpkLineinfo ppk ;
11315 ON h.division = PPK.division ;
11316 AND h.style = ppk.style ;
11317 AND h.color_code = ppk.color_code ;
11318 AND h.lbl_code = ppk.lbl_code ;
11319 AND h.dimension = ppk.dimension
11320 ENDIF
11321
11322 lcSQLString = " DROP TABLE " + .cSQLTempTable
11323 llRetVal = llRetVal AND v_SQLExec(lcSqlString)
11324 .cSQLTempTable = lcOldSQLTempTable
11325
11326 ENDIF
11327 ENDIF
11328
11329
11330 .TableClose("tcPpkLineinfo")
11331 .TableClose("__TmpCursor")
11332 ENDWITH
11333
11334 SELECT (lnSelect)
11335 RETURN llRetVal
11336 ENDFUNC
11337
11338 *=================================================
11339
11340 *=== TR 1056928 10-Nov-2011 Partha ===
11341
11342 *--- TechRec 1056973 10-Nov-2011 jisingh ---
11343 FUNCTION PopulateDataWhseSLN
11344 LPARAMETERS pceTransHeader, pceTransDetail, pceControl, pcItemSLN, pcWhseSLN
11345 LOCAL llRetVal, lnSelect, lcSqlString, lcItemSLN
11346
11347 llRetVal = true
11348 lnSelect = SELECT()
11349 lcItemSLN = ""
11350
11351 WITH This
11352 IF USED(pcItemSLN) AND RECCOUNT(pcItemSLN) > 0
11353 .cSQLTempTable = ""
11354 IF .GenerateSQLTempTable(pcItemSLN) AND .PopulateSQLTempTable(pcItemSLN) AND !EMPTY(.cSQLTempTable)
11355 lcItemSLN = .cSQLTempTable
11356 ENDIF
11357 ENDIF
11358
11359 *--- TechRec 1058326 12-Dec-2011 jisingh ---
11360*!* SELECT DISTINCT h.ord_num, d.line_seq, d.sizebucket, d.pkey ;
11361*!* FROM (pceTransHeader) h ;
11362*!* JOIN (pceTransDetail) d ON h.pkey = d.fkey ;
11363*!* JOIN (pceControl) c ON h.division = c.division AND h.customer = c.customer ;
11364*!* WHERE c.data_whse = 'Y' INTO CURSOR __TmpCursor
11365
11366 SELECT DISTINCT h.ord_num, d.assortment, d1.line_seq, d.po1_line, d.sizebucket, d.pkey, d.fkey ;
11367 FROM (pceTransHeader) h ;
11368 JOIN (pceTransDetail) d ON h.pkey = d.fkey ;
11369 JOIN (SELECT ord_num, assortment, po1_line, MIN(line_seq) AS line_seq ;
11370 FROM (pceTransDetail) GROUP BY ord_num, assortment, po1_line)d1 ;
11371 ON d1.ord_num = d.ord_num AND d1.assortment = d.assortment AND d1.po1_line = d.po1_line ;
11372 JOIN (pceControl) c ON h.division = c.division AND h.customer = c.customer ;
11373 WHERE c.data_whse = 'Y' INTO CURSOR __TmpCursor
11374 *=== TechRec 1058326 12-Dec-2011 jisingh ===
11375
11376 IF !EMPTY(lcItemSLN) AND USED("__TmpCursor") AND RECCOUNT("__TmpCursor") > 0
11377 .cSQLTempTable = ""
11378 IF .GenerateSQLTempTable('__TmpCursor') AND .PopulateSQLTempTable('__TmpCursor') AND !EMPTY(.cSQLTempTable)
11379
11380 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
11381 "FROM " + lcItemSLN + " s, " + .cSQLTempTable + " t " + ;
11382 "WHERE s.itm_pkey = t.pkey "
11383
11384 llRetVal = llRetVal AND v_SQLExec(lcSqlString, "__TmpCursor")
11385
11386 IF llRetVal AND USED("__TmpCursor") AND RECCOUNT("__TmpCursor") > 0
11387 .cSQLTempTable = ""
11388 IF .GenerateSQLTempTable("__TmpCursor") AND .PopulateSQLTempTable("__TmpCursor") AND !EMPTY(.cSQLTempTable)
11389
11390*- FH 1074465
11391*!* lcSqlString = "SELECT s.pkey, s.ord_num, s.line_seq, s.sln_line, s.sizebucket, s.segment, " + ;
11392*!* " s.element, s.qualifier, s.value, MIN(t.aux_sku) AS aux_sku, t.pkey AS fkey " + ;
11393*!* "FROM zzedatawhse s, " + .cSQLTempTable + " t " + ;
11394*!* "WHERE s.ord_num = t.ord_num " + ;
11395*!* " AND s.line_seq = t.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 lcSqlString = "SELECT s.pkey, s.ord_num, s.line_seq, s.sln_line, s.sizebucket, s.segment, " + ;
11401 " s.element, s.qualifier, s.value, MIN(t.aux_sku) AS aux_sku, t.pkey AS fkey " + ;
11402 "FROM zzedatawhse s, " + .cSQLTempTable + " t " + ;
11403 "WHERE s.ord_num = t.ord_num " + ;
11404 " AND s.sln_line = t.sln01" + ;
11405 " AND s.line_seq = t.sln_line_seq " + ;
11406 " AND s.sizebucket = t.sizebucket " + ;
11407 " AND s.table_name = 'ZZEIPOHS' " + ;
11408 " GROUP BY s.pkey, s.ord_num, s.line_seq, s.sln_line, s.sizebucket, s.segment, " + ;
11409 " s.element, s.qualifier, s.value, t.pkey "
11410*- FH 1074465
11411
11412 llRetVal = llRetVal AND v_SQLExec(lcSqlString, "tcWhse")
11413
11414 .MakeCursorWritable("tcWhse", pcWhseSLN)
11415 ENDIF
11416 ENDIF
11417 ENDIF
11418 * update sfkey with pkey in SLN
11419 REPLACE ALL sfkey WITH itm_pkey IN (pcItemSLN)
11420 ENDIF
11421 .TableClose("tcWhse")
11422 .TableClose("__TmpCursor")
11423 ENDWITH
11424
11425 SELECT (lnSelect)
11426 RETURN llRetVal
11427 ENDFUNC
11428
11429 *============================================================
11430
11431 FUNCTION BuildEDISString
11432 LPARAMETERS tcSLN, tcEDIS, tcEDISIndexTag, tcFlatFileString, tlDelimited, tcDelimiter
11433 LOCAL llRetVal, lnSelect, lcFKey
11434
11435 llRetVal = true
11436 lnSelect = SELECT()
11437 *- 1060291 03/23/12 YIK
11438 *- If DtltoSLN, there's no zzeipohs record, so there's no SLN01
11439 llDtltoSLN = EMPTY(EVALUATE(tcSLN + ".sln01"))
11440
11441 WITH This
11442
11443 lcFKey = EVALUATE(tcSLN + ".sfkey") + IIF(llDtltoSLN, '', EVALUATE(tcSLN + ".sln01"))
11444
11445 SELECT (tcEDIS)
11446 IF SEEK(lcFKey, tcEDIS, tcEDISIndexTag)
11447 IF llDtltoSLN
11448 SCAN WHILE fkey = lcFKey
11449 tcFlatFileString = tcFlatFileString + "EDIS" + tcDelimiter + .ConvertRecordToText(tcEDIS, tlDelimited, tcDelimiter)
11450 ENDSCAN
11451 ELSE
11452 SCAN WHILE fkey+sln_line = lcFKey
11453 tcFlatFileString = tcFlatFileString + "EDIS" + tcDelimiter + .ConvertRecordToText(tcEDIS, tlDelimited, tcDelimiter)
11454 ENDSCAN
11455 ENDIF
11456 ENDIF
11457 ENDWITH
11458 *= 1060291 03/23/12 YIK
11459
11460 SELECT (lnSelect)
11461 RETURN llRetVal
11462 ENDFUNC
11463 *=== TechRec 1056973 10-Nov-2011 jisingh ===
11464
11465 *- 1060114 FH
11466 Procedure BulkDelete
11467 LOCAL lnCount, lnX ,lcFile
11468
11469 IF VARTYPE(this.aBulkTables) <> "C" && sometimes aBulkTables doesn't get initialized so it's .F. we exit, dont need to do anything
11470 return
11471 endif
11472 *- lets log all the files before we delete
11473 *-
11474 FOR lnX = 1 TO This.nCounter
11475 lcFile = this.aBulkTables[lnX]
11476 .LogEntry("Files : " + lcFile)
11477 IF File(lcFile)
11478 .LogEntry("Bulk Deleting : " + lcFile)
11479 sysnoerror("DELETE FILE " + lcFile)
11480 Endif
11481 IF FILE(lcFile)
11482 .LogEntry("Failed to initial delete : " + lcFile)
11483
11484 lnCnt = 0
11485 DO WHILE File(lcFile) AND lnCnt < 5
11486 .LogEntry("Bulk Deleting in while : " + lcFile)
11487 sysnoerror("DELETE FILE " + lcFile)
11488 INKEY(1) && wait, we can change, this right now it's 1 seconds * 5 so 5 secs
11489 lnCnt = lnCnt + 1
11490 ENDDO
11491 IF FILE(lcFile)
11492 .LogEntry("Failed to delete : " + lcFile)
11493 ENDIF
11494 endif
11495 ENDFOR
11496
11497 *reset
11498 DIMENSION This.aBulkTables[1]
11499 this.aBulkTables = .F.
11500 this.nCounter = 0
11501
11502 ENDPROC
11503
11504 *-1060114 FH
11505
11506*--- TechRec 1066835 06-Mar-2013 YKaganovsky ---
11507*- Check if Remote Server Reference has a record for category EDI and
11508*- if Workflow ( see property .cWorkflowName, ex. '810 BC PROCESS') exists
11509FUNCTION CanRunWorkflow
11510LOCAL llRetVal, lnAnsiNull,lnAnsiWarning, lcSQL, lcWkfPath
11511
11512WITH THIS
11513
11514 *--- TechRec 1075287 16-May-2014 asharma/smeenraja ---
11515 .cCanRunWorkflowErrorMessage = ""
11516 *=== TechRec 1075287 16-May-2014 asharma/smeenraja ===
11517
11518 IF goEnv.sv("TIE_SETUP","N") = 'Y' AND GoEnv.SV("BC_EDI_VERSION") = "5.2"
11519 v_sqlexec("Select * From zzxsalgh WHERE category = 'EDI'","tcSecur")
11520
11521 IF RECCOUNT("tcSecur") > 0
11522
11523 .EDI_servername = "[" + ALLTRIM(tcSecur.servername) + "]"
11524 .EDI_dbname = ALLTRIM(tcSecur.dbname) && the same as .cEDIDB
11525
11526 lnAnsiNull = SQLGetSessionProperty('ANSI_NULLS')
11527 lnAnsiWarning = SQLGetSessionProperty('ANSI_WARNINGS')
11528
11529 SQLSetSessionProperty('ANSI_NULLS',1)
11530 SQLSetSessionProperty('ANSI_WARNINGS',1)
11531
11532
11533
11534*!* lcSQL = "Select COUNT(*) as cnt from <tie_server>.<tie_dbname>sp_wfcomp " + ;
11535*!* " where wfcompname = '" + .cWorkflowName + "'"
11536 lcWkfPath = This.GetEDIFlatFileDirectory("Outbound") + .cProcessID + 'bc.dat'
11537 *- Remove \\ between dataset and Outbound. We have '\\BCFILESVR\VG\VG40\Login\PDEV\\EDI\Outbound\810bc.dat'
11538 lcWkfPath = STRTRAN(lcWkfPath, "\\", "\", 2)
11539
11540 lcSQL = "Select COUNT(*) as cnt from <tie_server>.<tie_dbname>SP_WFCOMP wc " + ;
11541 " JOIN <tie_server>.<tie_dbname>SP_WFITEM wi ON wc.wfcompski = wi.parentski " + ;
11542 " JOIN <tie_server>.<tie_dbname>SP_WFPARAMVAL wp ON wp.wfitemski = wi.itemski " + ;
11543 " where wfcompname = '" + .cWorkflowName + "' AND wp.PARAMNAME = 'Source' " + ;
11544 " AND wp.paramval = '" + lcWkfPath + "'"
11545
11546
11547 lcSQL = STRTRAN(lcSQL, "<tie_dbname>", .EDI_dbname )
11548 lcSQL = STRTRAN(lcSQL, "<tie_server>", .EDI_servername)
11549
11550 v_Sqlexec(lcSQL,"__Wkf")
11551
11552 SQLSetSessionProperty('ANSI_NULLS',lnAnsiNull )
11553 SQLSetSessionProperty('ANSI_WARNINGS',lnAnsiWarning)
11554
11555 llRetVal = __Wkf.cnt > 0
11556 IF !llRetVal
11557 *--- TechRec 1075287 16-May-2014 asharma/smeenraja ---
11558*!* .oLog.LogEntry("Workflow " + .cWorkflowName + " is not found.")
11559 .cCanRunWorkflowErrorMessage = "Workflow " + .cWorkflowName + " is not found."
11560 .oLog.LogEntry(.cCanRunWorkflowErrorMessage)
11561 *=== TechRec 1075287 16-May-2014 asharma/smeenraja ===
11562 ENDIF
11563
11564 ELSE
11565 *--- TechRec 1075287 16-May-2014 asharma/smeenraja ---
11566*!* .oLog.LogEntry("Remote Server Reference is missing a record for category EDI.",.T.)
11567 .cCanRunWorkflowErrorMessage = "Remote Server Reference is missing a record for category EDI."
11568 .oLog.LogEntry(.cCanRunWorkflowErrorMessage,.T.)
11569 *=== TechRec 1075287 16-May-2014 asharma/smeenraja ===
11570 llRetVal = .F.
11571
11572 ENDIF
11573 ENDIF
11574Endwith
11575RETURN llRetVal
11576ENDFUNC
11577
11578PROCEDURE IsTieInstalled
11579 LOCAL llRetval,lnSelect,lcBuffer,lnRetVal,lcPath
11580 llRetVal = .T.
11581 lnSelect = SELECT()
11582
11583*--- TechRec 1075287 16-May-2014 asharma/smeenraja ---
11584*!* WITH THIS
11585*!* llRetVal = !EMPTY(GETENV("E_CONNECT_RUNTIME"))
11586*!* IF !llRetVal
11587*!* .oLog.LogEntry("There is no environment variable 'E_CONNECT_RUNTIME'. EDI Translator Framework is not installed on this workstation.",.T.)
11588*!* ELSE
11589*!* lcPath = GetEnv("E_CONNECT_HOME")
11590*!* llRetVal = !EMPTY(lcPath)
11591*!*
11592*!* IF !llRetVal
11593*!* .oLog.LogEntry("There is no environment variable 'E_CONNECT_HOME'. EDI Translator Framework is not installed on this workstation.",.T.)
11594*!* ELSE
11595*!* .oLog.LogEntry("Confirmed EDI Translator Framework Exists.")
11596*!* lcPath = ADDBS(lcPath)
11597*!* IF NOT DIRECTORY(lcPath )
11598*!* llRetVal = .F.
11599*!* .oLog.LogEntry("Could not locate EDI Bin Directory at: " + lcPath,.T.)
11600*!* ELSE
11601*!* lcPath = STRTRAN(lcPath,"\Bin\","\Script\",1,-1,1)
11602*!* IF NOT DIRECTORY(lcPath)
11603*!* llRetVal = .F.
11604*!* .oLog.LogEntry("Could not locate EDI Script Directory at: " + lcPath,.T.)
11605*!* ELSE
11606*!* IF NOT FILE(lcPath + "wflaunch.bat")
11607*!* llRetVal = .F.
11608*!* .oLog.LogEntry("Could not locate wflaunch at " + lcPath,.T.)
11609*!* ELSE
11610*!* .oLog.LogEntry("Located wflaunch at " + lcPath)
11611*!* *- Set up property .cScriptDirectory that contains path to
11612*!* *- the wflaunch.bat
11613*!* .cScriptDirectory = lcPath
11614*!* ENDIF
11615*!* ENDIF
11616*!* ENDIF
11617*!* ENDIF
11618*!* ENDIF
11619*!* ENDWITH
11620 WITH THIS
11621
11622 .cTieInstallErrorMessage = ""
11623
11624 llRetVal = !EMPTY(GETENV("E_CONNECT_RUNTIME"))
11625 IF !llRetVal
11626 .cTieInstallErrorMessage = "There is no environment variable 'E_CONNECT_RUNTIME'. EDI Translator Framework is not installed on this workstation."
11627 ELSE
11628 lcPath = GetEnv("E_CONNECT_HOME")
11629 llRetVal = !EMPTY(lcPath)
11630
11631 IF !llRetVal
11632 .cTieInstallErrorMessage = "There is no environment variable 'E_CONNECT_HOME'. EDI Translator Framework is not installed on this workstation."
11633 ELSE
11634 .oLog.LogEntry("Confirmed EDI Translator Framework Exists.")
11635 lcPath = ADDBS(lcPath)
11636 IF NOT DIRECTORY(lcPath )
11637 llRetVal = .F.
11638 .cTieInstallErrorMessage = "Could not locate EDI Bin Directory at: " + lcPath
11639 ELSE
11640 lcPath = STRTRAN(lcPath,"\Bin\","\Script\",1,-1,1)
11641 IF NOT DIRECTORY(lcPath)
11642 llRetVal = .F.
11643 .cTieInstallErrorMessage = "Could not locate EDI Script Directory at: " + lcPath
11644 ELSE
11645 IF NOT FILE(lcPath + "wflaunch.bat")
11646 llRetVal = .F.
11647 .cTieInstallErrorMessage = "Could not locate wflaunch at " + lcPath
11648 ELSE
11649 .oLog.LogEntry("Located wflaunch at " + lcPath)
11650 *- Set up property .cScriptDirectory that contains path to
11651 *- the wflaunch.bat
11652 .cScriptDirectory = lcPath
11653 ENDIF
11654 ENDIF
11655 ENDIF
11656 ENDIF
11657 ENDIF
11658
11659 IF LEN(ALLTRIM(.cTieInstallErrorMessage)) > 0
11660 .oLog.LogEntry(.cTieInstallErrorMessage,.t.)
11661 ENDIF
11662
11663 ENDWITH
11664*=== TechRec 1075287 16-May-2014 asharma/smeenraja ===
11665
11666 SELECT(lnSelect)
11667 RETURN llRetVal
11668
11669ENDPROC
11670
11671PROCEDURE RunWorkflow
11672LPARAMETERS tcWKFList
11673LOCAL lcFile, lcWkfFile, lcWkfName, lcScriptDirectory, lcEDI_dbname, lcResultFile, lnMaestroIDl, ;
11674 llRetVal, lcEDIPath
11675
11676llRetVal = .T.
11677
11678WITH This
11679
11680 lcEDIPath = .GetEDIFlatFileDirectory("Outbound")
11681 lcWkfFile = lcEDIPath + .cProcessID + 'bc.dat' && create 810bc.dat
11682
11683 SELECT (tcWKFList)
11684 .nWorkflowProc = RECCOUNT()
11685 .nWorkflowSuccess = 0
11686 SCAN
11687 lcResultFile = ' '
11688 lcMaestroFile = ' '
11689 lcFile = TempFlatfile
11690 IF !FILE(lcFile)
11691 .oLog.LogEntry("Could not locate file " + lcFile)
11692 LOOP
11693 ENDIF
11694 *- file size for logging
11695 lnFSize = SizeArray(adir(SizeArray,TempFlatfile)+1)
11696 .oLog.LogEntry("Launching Workflow for file " + lcFile)
11697 .oLog.LogEntry("File size is " + STR(lnFSize/1000) + "Kb")
11698 Copy File (lcFile) To (lcWkfFile)
11699 IF !FILE(lcWkfFile)
11700 .oLog.LogEntry("File " + lcWkfFile + " could not be created from file " + lcFile + ".")
11701 llRetVal = .F.
11702 ELSE
11703 .oLog.LogEntry("Successfully copied " + lcFile + " to " + lcWkfFile)
11704 Delete File (lcFile)
11705 .oLog.LogEntry("Processing workflow for Trading Partner: " + Customer + "with Vendor ID: " + vnd_id)
11706 llRetVal = .LaunchWorkFlow(@lcResultFile, @lcMaestroFile)
11707 llRetVal = llRetVal AND .RenFileDat(lcWkfFile,,"Outbound")
11708 llRetVal = llRetVal AND .ProcessResults(lcResultFile,lcMaestroFile)
11709 ENDIF
11710 SELECT (tcWKFList)
11711 IF !llRetVal
11712 REPLACE cr_auto_wkf WITH 'N' && these records will be inserted into __tcFlatFileList
11713 ENDIF
11714
11715 ENDSCAN
11716ENDWITH
11717
11718ENDPROC
11719
11720PROCEDURE LaunchWorkFlow
11721LPARAMETERS tcResultFile, tcMaestroFile
11722
11723
11724LOCAL lcDOSMacro, lcCurrentDir,llRetVal,lnSelect
11725
11726llRetVal = .T.
11727
11728lnSelect = SELECT()
11729WITH THIS
11730
11731 .oLog.LogEntry("Starting Workflow " + .cWorkflowName)
11732
11733 lcCurrentDir = sys(5) + CURDIR()
11734 tcResultFile = lcCurrentDir + "edi_wf_" + getUniqueFileName() + ".txt"
11735 tcMaestroFile = lcCurrentDir + "edi_ms_" + getUniqueFileName() + ".txt"
11736 *Change Directory
11737 CHDIR (.cScriptDirectory)
11738 lcDOSMacro = "wflaunch -c "+ Allt(tcSecur.evisionsrvins)+" 2010 -n " + .cWorkflowName + ;
11739 " -q F -r " + tcResultFile + " -m " + tcMaestroFile
11740
11741 *Run Main Workflow process
11742 lcDOSMacro = "Run " + .cScriptDirectory + lcDOSMacro
11743*- .LogEntry("Workflow Command: " + lcDosMacro)
11744 &lcDOSMacro
11745
11746 *Change Directory to BC
11747 CHDIR (lcCurrentDir)
11748ENDWITH
11749RETURN llRetVal
11750ENDPROC
11751
11752PROCEDURE ProcessResults
11753LPARAMETERS tcResultFile,tcMaestroFile
11754
11755LOCAL llRetval,lnSelect,lcResultString,lcMaestroID,lcSQL,lcWhere, lnProcSki
11756llRetVal = .T.
11757lnSelect = SELECT()
11758lnProcSki = 0
11759
11760WITH THIS
11761 LOCAL lnAnsiNull,lnAnsiWarning
11762 lnAnsiNull = SQLGetSessionProperty('ANSI_NULLS')
11763 lnAnsiWarning = SQLGetSessionProperty('ANSI_WARNINGS')
11764
11765 SQLSetSessionProperty('ANSI_NULLS',1)
11766 SQLSetSessionProperty('ANSI_WARNINGS',1)
11767
11768 IF NOT FILE(tcResultFile)
11769 llRetVal = .F.
11770 .oLog.LogEntry("Unable to find result file: " + tcResultFile,.T.)
11771 .oLog.LogEntry("Please make sure that eVision services are running.")
11772 ENDIF
11773
11774
11775 IF llRetVal
11776 lcResultString = ALLTRIM(CHRTRAN(FILETOSTR(tcResultFile ),CHR(0)+CHR(13)+CHR(10),""))
11777
11778 IF NOT FILE(tcMaestroFile)
11779 .oLog.LogEntry("Unable to find maestro ID file: " + tcMaestroFile)
11780 lcMaestroID = ""
11781 ELSE
11782 lcMaestroID = ALLTRIM(CHRTRAN(FILETOSTR(tcMaestroFile),CHR(0)+CHR(13)+CHR(10),""))
11783 ENDIF
11784
11785 IF EMPTY(lcMaestroID)
11786 lcWhere = " 1 = 2 "
11787 ELSE
11788 lcWhere = "d.taskuki = '" + .cWorkflowName + "' AND d.systempid = " + lcMaestroID + " AND d.parentski = 0 "
11789 ENDIF
11790
11791 lcSQL = "select procski"+;
11792 " , datetm"+;
11793 " , d.parentski"+;
11794 " , Taskuki"+;
11795 " , exitcode"+;
11796 " , errflag"+;
11797 " , wrnflag"+;
11798 " , procstate"+;
11799 " , stoptime"+;
11800 " , wfcompski"+;
11801 " , wfcompname"+;
11802 " , '0' as successval"+;
11803 " , '98' as warnval"+;
11804 " , 0 as childski"+;
11805 " , Replace(Replace(Replace(Replace(( "+;
11806 "select audtinf_type + ': ' + RTRIM(audtinf_message) + '^' "+;
11807 " from <tie_server>.<tie_dbname>sp_audtinf a "+;
11808 " where a.procski = d.procski FOR XML PATH('')), '
', ''), '>', '>'), '<', '<'), '&', '&') as audtinf_message "+;
11809 " from <tie_server>.<tie_dbname>sp_procinf d "+;
11810 " left join <tie_server>.<tie_dbname>sp_wfcomp comp "+;
11811 " on comp.wfcompname = d.taskuki "+;
11812 " where " + lcWhere + ;
11813 " union all "+;
11814 "select cp.procski"+;
11815 " , cp.datetm"+;
11816 " , cp.parentski"+;
11817 " , cp.Taskuki"+;
11818 " , cp.exitcode"+;
11819 " , cp.errflag"+;
11820 " , cp.wrnflag"+;
11821 " , cp.procstate"+;
11822 " , cp.stoptime"+;
11823 " , pc.wfcompski"+;
11824 " , pc.wfcompname"+;
11825 " , it.successval"+;
11826 " , it.warnval"+;
11827 " , it.childski"+;
11828 " , Replace(Replace(Replace(Replace(( "+;
11829 "select audtinf_type + ': ' + RTRIM(audtinf_message) + '^' "+;
11830 " from <tie_server>.<tie_dbname>sp_audtinf a "+;
11831 " where a.procski = cp.procski FOR XML PATH('')), '
', ''), '>', '>'), '<', '<'), '&', '&') as audtinf_message "+;
11832 " from <tie_server>.<tie_dbname>sp_procinf d"+;
11833 " join <tie_server>.<tie_dbname>SP_WFCOMP pc "+;
11834 " on pc.WFCompName = d.TaskUKI"+;
11835 " join <tie_server>.<tie_dbname>sp_ProcInf cp "+;
11836 " on cp.ParentSki = d.ProcSki"+;
11837 " join <tie_server>.<tie_dbname>SP_WFCOMP cc "+;
11838 " on cc.WFCompName = cp.TaskUKI"+;
11839 " join <tie_server>.<tie_dbname>SP_WFItem it "+;
11840 " on it.ParentSki = pc.WFCompSki "+;
11841 " and it.ChildSki = cc.WFCompSki "+;
11842 " where " + lcWhere + ;
11843 " order by 1, 2"
11844
11845
11846 lcSQL = STRTRAN(lcSQL,"<tie_dbname>", .EDI_dbname )
11847 lcSQL = STRTRAN(lcSQL,"<tie_server>", .EDI_servername)
11848
11849 llRetVal = llRetVal AND v_sqlexec(lcSQL,"tcGetAudit")
11850
11851 IF llRetVal
11852 IF EMPTY(lcMaestroID) OR RECCOUNT("tcGetAudit") = 0
11853 * Work flow could not have passed if I did not find a record in the procInf
11854 llRetVal = .F.
11855 lcReturnDesc = vl_xlookp("WF_EDI_RETURN","lk_desc",,lcResultString)
11856
11857 .oLog.LogEntry("EDI Workflow Failed with error code " + lcResultString,.T.)
11858 .oLog.LogEntry(" " + IIF(EMPTY(lcReturnDesc),"Unknown Message",lcReturnDesc),.T.)
11859 ELSE
11860 * Found it. Record procski and use that table for error reporting
11861 IF llRetVal AND RECCOUNT("tcGetAudit") > 0
11862 SELECT tcGetAudit
11863 GO TOP && main workflow entry
11864 .oLog.LogEntry("---------- Workflow Audit Log: ----------")
11865 lnProcSki = tcGetAudit.procski
11866 .oLog.LogEntry("Procski for this Workflow is: " + TRANSFORM(lnProcSki))
11867 IF exitcode <> 0 OR errflag <> 0 OR wrnflag <> 0
11868 llRetVal = .F.
11869 .oLog.LogEntry("Workflow failed.",.T.)
11870 .oLog.LogEntry("Return Code..: " + TRANSFORM(exitcode))
11871 .oLog.LogEntry("Error Flag...: " + TRANSFORM(errflag))
11872 .oLog.LogEntry("Warning Flag.: " + TRANSFORM(wrnflag))
11873 ELSE
11874 .nWorkflowSuccess = .nWorkflowSuccess + 1
11875 .oLog.LogEntry("Workflow Launched Successfully.",.T.)
11876 .oLog.LogEntry("Return Code..: " + TRANSFORM(exitcode))
11877 ENDIF
11878
11879 .oLog.LogEntry("The following messages were found in the Audit Trail for this Workflow:")
11880
11881 DECLARE laStr[1]
11882 SELECT tcGetAudit
11883 SCAN FOR Parentski > 0 AND !ISNULL(AudtInf_Message) && components of the workflow
11884 lastr = ''
11885 StringToArray(audtinf_message, @laStr, "^")
11886 .oLog.LogArray(@laStr)
11887 ENDSCAN
11888 ENDIF
11889 ENDIF
11890 ENDIF
11891 ENDIF
11892
11893 SQLSetSessionProperty('ANSI_NULLS',lnAnsiNull )
11894 SQLSetSessionProperty('ANSI_WARNINGS',lnAnsiWarning)
11895
11896 IF FILE(tcResultFile)
11897 DELETE FILE (tcResultFile)
11898 ENDIF
11899 IF FILE(tcMaestroFile)
11900 DELETE FILE (tcMaestroFile)
11901 ENDIF
11902
11903ENDWITH
11904
11905SELECT(lnSelect)
11906
11907llRetVal = .T. && for now always return .T. We'll see if we ever need .F.
11908RETURN llRetVal
11909
11910ENDPROC
11911
11912*============================================================
11913
11914 *--- TR 1073762 27-Nov-2013 Partha ---
11915 PROCEDURE UpdatePhEmail
11916 PARAMETERS pcVerticalAddress
11917 LOCAL llRetVal, lnSelect, lcPkey, loAddr, lcSQLString
11918
11919 lnSelect = SELECT()
11920 llRetVal = true
11921
11922 WITH THIS
11923 .cSQLTempTable = ""
11924
11925 IF .GenerateSQLTempTable(pcVerticalAddress) ;
11926 AND .PopulateSQLTempTable(pcVerticalAddress) ;
11927 AND !EMPTY(.cSQLTempTable)
11928 *--- TechRec 1077213 03-Apr-2014 MANI. Added COALESCE() to left join tabel fields ===
11929 lcSQLString = " UPDATE h " + ;
11930 " SET h.accessnum = (CASE WHEN h.addr_type IN ('ST','OT') and stadr.phone > '' then stadr.phone "+ ; && *--- TR 1091146 17/3/2016 Gurinder
11931 " WHEN h.addr_type IN ('ST','OT') and h.accessnum > '' then accessnum "+; && *--- TR 1091146 17/3/2016 Gurinder
11932 " WHEN h.addr_type IN ('ST','OT') THEN COALESCE(stadr.phone,'') "+ ; && *--- TR 1091146 17/3/2016 Gurinder
11933 " WHEN h.addr_type = 'BT' THEN COALESCE(otadr.phone,'') " + ;
11934 " ELSE h.accessnum END ) ," + ;
11935 " h.email = (CASE WHEN h.addr_type IN ('ST','OT') THEN COALESCE(stadr.email,'') "+ ;
11936 " WHEN h.addr_type = 'BT' THEN COALESCE(otadr.email,'') " + ;
11937 " ELSE h.email END ) " + ;
11938 " FROM " + .cSQLTempTable + " h " + ;
11939 " LEFT JOIN zzoordad stadr " + ;
11940 " ON h.ord_num = stadr.ord_num " +;
11941 " LEFT JOIN zzootadr otadr " + ;
11942 " ON h.ord_num = otadr.ord_num " +;
11943 " AND otadr.addr_type = 'BT' " + ;
11944 " WHERE (stadr.ord_num is not null OR otadr.ord_num is not null) " + ;
11945 " AND h.addr_type IN ('ST','OT','BT') "
11946
11947 llRetVal = llRetVal AND v_SQLExec(lcSQLString)
11948
11949 lcSQLString = " Select h.* FROM " + .cSQLTempTable + " h " + ;
11950 " WHERE h.addr_type IN ('ST','OT','BT') "
11951
11952 llRetVal = llRetVal AND v_SQLExec(lcSQLString, "__tmpEmPhAdrs")
11953 IF llRetVal AND USED("__tmpEmPhAdrs") AND RECCOUNT("__tmpEmPhAdrs")>0
11954
11955 SELECT ("__tmpEmPhAdrs")
11956 INDEX ON ALLTRIM(STR(ord_num)) + addr_type TAG emphadr
11957 GOTO TOP
11958
11959 SELECT (pcVerticalAddress)
11960 GOTO TOP
11961 SCAN FOR INLIST(addr_type,'ST','OT','BT')
11962 IF SEEK( ALLTRIM(STR(ord_num))+ addr_type , "__tmpEmPhAdrs", "emphadr")
11963 SELECT ("__tmpEmPhAdrs")
11964 SCATTER FIELDS accessnum,email,addr_type NAME oAddr
11965 lcAccessNum = oAddr.accessnum
11966 lnChrsRet = AT("@", lcAccessNum)
11967 lnChrsRet = IIF(lnChrsRet = 0, LEN(lcAccessNum), lnChrsRet - 1)
11968 lcAccessNum = SUBSTR(lcAccessNum , 1, lnChrsRet)
11969 lcAccessNum = STRTRAN(STRTRAN(lcAccessNum , "/"), "-")
11970 oAddr.accessnum = lcAccessNum
11971
11972 SELECT (pcVerticalAddress)
11973 GATHER NAME oAddr
11974 .TimeStampDocument()
11975
11976 ENDIF
11977 ENDSCAN
11978
11979 ENDIF
11980 ENDIF
11981
11982 .TableClose("__tmpEmPhAdrs")
11983 ENDWITH
11984
11985 SELECT (lnSelect)
11986 RETURN llRetVal
11987 ENDPROC
11988 *=== TR 1073762 27-Nov-2013 Partha ===
11989
11990*============================================================
11991
11992
11993 *- TR 1073045/1076527 FH - similar to 1076026, method to insert into our flat file cursor.
11994 FUNCTION InsertIntoFlatFileCursor
11995 LPARAMETERS pcFlatFileList, pcTempFlatfile, pcOutBoundFlatFile
11996 LOCAL llRetVal, lnSelect, llFound, lnHandle , lnSize
11997
11998 llRetVal = .T.
11999 lnSelect = SELECT()
12000 llFound = .F.
12001
12002 WITH This
12003 SELECT (pcFlatFileList)
12004 SCAN
12005 IF ALLTRIM(TempFlatfile) = ALLTRIM(pcTempFlatfile)
12006 llFound = .T.
12007 EXIT && we get out of here, cursor already contains our Flat file
12008 ENDIF
12009 ENDSCAN
12010
12011 IF NOT llFound
12012 *- Let's check to see if temp file actually has data in it (size > 0)
12013 lnHandle = FOPEN(pcTempFlatfile)
12014 lnSize = FSEEK(lnHandle,0,2)
12015 IF lnSize > 0
12016 INSERT INTO (pcFlatFileList)(TempFlatfile,OutBoundFlatFile) VALUES (pcTempFlatfile, pcOutBoundFlatFile)
12017 ENDIF
12018 =FCLOSE(lnHandle)
12019 ENDIF
12020
12021 ENDWITH
12022
12023 SELECT (lnSelect)
12024 RETURN llRetVal
12025 ENDFUNC
12026*- TR 1073045/1076527 FH - similar to 1076026, method to insert into our flat file cursor.
12027
12028
12029*============================================================
12030 *--- TR 1065007 4-Feb-2014 Goutam
12031 PROCEDURE GetFromUOM
12032
12033 LOCAL llRetVal, lnSelect, lcCompCurs
12034
12035 lnSelect = SELECT()
12036 lcCompCurs = GetUniqueFileName()
12037
12038 WITH this
12039 llRetVal = vl_compr(,,lcCompCurs)
12040
12041 SELECT (lcCompCurs)
12042 .cFromUOMWeight = default_uom
12043 .cFromUOMVolume = uom_vol
12044 .cFromUOMDimens = uom_dimen
12045 ENDWITH
12046
12047 USE IN SELECT(lcCompCurs)
12048
12049 SELECT (lnSelect)
12050 RETURN llRetVal
12051 ENDPROC
12052
12053*============================================================
12054
12055 PROCEDURE ValidateOutboundUOM
12056 PARAMETERS pcTranHeader, pcControl, pcUOMFromType
12057
12058 LOCAL llRetVal, lnSelect, lcSQLString, lcContCurs, llEmptyWeightinCompany, llEmptyVolumeinCompany, llEmptyDimensinCompany
12059
12060 lnSelect = SELECT()
12061 llRetVal = true
12062 lcContCurs = GetUniqueFileName()
12063
12064 WITH THIS
12065 .cSQLTempTable = ""
12066
12067 llEmptyWeightinCompany = !EMPTY(.cWeightFieldForUOM) And EMPTY(.cFromUOMWeight)
12068 llEmptyVolumeinCompany = !EMPTY(.cVolumeFieldForUOM) And EMPTY(.cFromUOMVolume)
12069 llEmptyDimensinCompany = !EMPTY(.cDimensFieldForUOM) And EMPTY(.cFromUOMDimens)
12070
12071 DO CASE
12072 CASE pcUOMFromType = 'DIV'
12073 lcSQLString = "Select distinct division, customer from " + pcTranHeader
12074 CASE pcUOMFromType = 'LOC'
12075 lcSQLString = "Select distinct location from " + pcTranHeader
12076 CASE pcUOMFromType = 'DEST'
12077 lcSQLString = "Select distinct Catg_dest from " + pcTranHeader
12078 ENDCASE
12079
12080 llRetVal = llRetVal AND v_SqlExec(lcSQLString,lcContCurs,,true)
12081
12082 IF .GenerateSQLTempTable(lcContCurs) AND .PopulateSQLTempTable(lcContCurs) AND !EMPTY(.cSQLTempTable)
12083
12084 USE IN SELECT(lcContCurs)
12085
12086 DO CASE
12087 CASE pcUOMFromType = 'DIV'
12088 lcSQLString = ;
12089 "select coalesce(cr.pkey, 0) as pkey, cr.UOM_Recal, th.division, th.customer, cr.uom_dimen, cr.uom_weight, cr.uom_volume " + ;
12090 " from " + .cSQLTempTable + " th join " + pcControl + " cr " + ;
12091 " on th.customer = cr.customer and th.division = cr.division and cr.active_ok = 'Y' "
12092 CASE pcUOMFromType = 'LOC'
12093 lcSQLString = ;
12094 "select coalesce(lo.pkey, 0) as pkey, cr.UOM_Recal, th.location, lo.uom_dimen,lo.uom_weight,lo.uom_volume " + ;
12095 " from " + .cSQLTempTable + " th join " + pcControl + " cr on th.location = cr.ware_code And cr.active_ok = 'Y' " + ;
12096 " left join zzxlocar lo on lo.location = cr.ware_code and lo.loc_type = 'W' "
12097 CASE pcUOMFromType = 'DEST'
12098 lcSQLString = ;
12099 "select coalesce(cr.pkey, 0) as pkey, cr.UOM_Recal, th.Catg_dest, cr.uom_weight,cr.uom_volume " + ;
12100 " from " + .cSQLTempTable + " th join " + pcControl + " cr " + ;
12101 " on th.Catg_dest = cr.Catg_dest and cr.active_ok = 'Y' "
12102 ENDCASE
12103
12104 llRetVal = llRetVal AND v_SqlExec(lcSQLString, lcContCurs)
12105
12106 SELECT (lcContCurs)
12107 DO CASE
12108 CASE pcUOMFromType = 'DIV'
12109 INDEX on division+customer TAG division
12110 CASE pcUOMFromType = 'LOC'
12111 INDEX on location TAG location
12112 CASE pcUOMFromType = 'DEST'
12113 INDEX on Catg_dest TAG Catg_dest
12114 ENDCASE
12115
12116 DO CASE
12117 CASE pcUOMFromType = 'DIV'
12118 llRetVal = llRetVal And .SetRelation(lcContCurs, "division", pcTranHeader, "division+customer")
12119 CASE pcUOMFromType = 'LOC'
12120 llRetVal = llRetVal And .SetRelation(lcContCurs, "location", pcTranHeader, "location")
12121 CASE pcUOMFromType = 'DEST'
12122 llRetVal = llRetVal AND .SetRelation(lcContCurs, "Catg_dest", pcTranHeader, "Catg_dest")
12123 ENDCASE
12124
12125 IF llEmptyWeightinCompany OR llEmptyVolumeinCompany OR llEmptyDimensinCompany
12126
12127 lcErrs_Msg = "UOM code in Company Control is blank." + CRLF
12128
12129 IF pcUOMFromType = 'DEST'
12130 replace errs_flg WITH 'Y', errs_msg WITH errs_msg + lcErrs_Msg ;
12131 FOR !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') IN (pcTranHeader)
12132 ELSE
12133 replace errs_flg_h WITH 'Y', errs_msg_h WITH errs_msg_h + lcErrs_Msg ;
12134 FOR !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') IN (pcTranHeader)
12135 ENDIF
12136 SET RELATION TO
12137 ELSE
12138 IF !EMPTY(.cWeightFieldForUOM) AND !EMPTY(.cFromUOMWeight) AND !vl_suomr(.cFromUOMWeight)
12139 lcErrs_Msg = "Source Weight UOM [" + ALLTRIM(.cFromUOMWeight)+ "] 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_weight) 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_weight) IN (pcTranHeader)
12146 ENDIF
12147 ENDIF
12148 IF !EMPTY(.cVolumeFieldForUOM) AND !EMPTY(.cFromUOMVolume) AND !vl_suomr(.cFromUOMVolume)
12149 lcErrs_Msg = "Source Volume UOM [" + ALLTRIM(.cFromUOMVolume)+ "] 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_volume) 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_volume) IN (pcTranHeader)
12156 ENDIF
12157 ENDIF
12158 IF !EMPTY(.cDimensFieldForUOM) AND !EMPTY(.cFromUOMDimens) AND !vl_suomr(.cFromUOMDimens)
12159 lcErrs_Msg = "Source Dimension UOM [" + ALLTRIM(.cFromUOMDimens)+ "] code does not exists in UOM Reference." + CRLF
12160 IF pcUOMFromType = 'DEST'
12161 replace errs_flg WITH 'Y', errs_msg WITH errs_msg + lcErrs_Msg ;
12162 FOR !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') AND !EMPTY(&lcContCurs..uom_Dimen) IN (pcTranHeader)
12163 ELSE
12164 replace errs_flg_h WITH 'Y', errs_msg_h WITH errs_msg_h + lcErrs_Msg ;
12165 FOR !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') AND !EMPTY(&lcContCurs..uom_Dimen) IN (pcTranHeader)
12166 ENDIF
12167 ENDIF
12168
12169 IF !EMPTY(.cWeightFieldForUOM)
12170 lcErrs_Msg = "The default control reference UOM for weight 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_weight) 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_weight) IN (pcTranHeader)
12177 ENDIF
12178 ENDIF
12179 IF !EMPTY(.cVolumeFieldForUOM)
12180 lcErrs_Msg = "The default control reference UOM for volume 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_volume) 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_volume) IN (pcTranHeader)
12187 endif
12188 ENDIF
12189 IF !EMPTY(.cDimensFieldForUOM)
12190 lcErrs_Msg = "The default control reference UOM for dimension does not exists." + CRLF
12191 IF pcUOMFromType = 'DEST'
12192 replace errs_flg WITH 'Y', errs_msg WITH errs_msg + lcErrs_Msg ;
12193 FOR !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') AND EMPTY(&lcContCurs..uom_dimen) IN (pcTranHeader)
12194 ELSE
12195 replace errs_flg_h WITH 'Y', errs_msg_h WITH errs_msg_h + lcErrs_Msg ;
12196 FOR !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') AND EMPTY(&lcContCurs..uom_dimen) IN (pcTranHeader)
12197 ENDIF
12198 ENDIF
12199
12200 SET RELATION TO
12201 USE IN SELECT(lcContCurs)
12202
12203 DO CASE
12204 CASE pcUOMFromType = 'DIV'
12205 lcSQLString = ;
12206 "select th.division, th.customer, coalesce(cr.UOM_Recal, '') as UOM_Recal, cr.uom_weight, cr.uom_volume, cr.uom_Dimen " + ;
12207 " ,coalesce(d1.uom_convert, '') as uom_volume2 " + ;
12208 " ,coalesce(d2.uom_convert, '') as uom_weight2 " + ;
12209 " ,coalesce(d3.uom_convert, '') as uom_dimen2 " + ;
12210 " from " + .cSQLTempTable + " th join " + pcControl + " cr " + ;
12211 " on th.customer = cr.customer and th.division = cr.division and cr.active_ok = 'Y' " + ;
12212 " left join zzxsuomd d1 on d1.uom_convert = cr.uom_volume " + ;
12213 " and d1.uom = " + SqlFormatChar(.cFromUOMVolume) + ;
12214 " left join zzxsuomd d2 on d2.uom_convert = cr.uom_weight " + ;
12215 " and d2.uom = " + SqlFormatChar(.cFromUOMWeight) + ;
12216 " left join zzxsuomd d3 on d3.uom_convert = cr.uom_dimen " + ;
12217 " and d3.uom = " + SqlFormatChar(.cFromUOMDimens)
12218 CASE pcUOMFromType = 'LOC'
12219 lcSQLString = ;
12220 "select th.location, coalesce(cr.UOM_Recal, '') as UOM_Recal, lo.uom_weight, lo.uom_volume, lo.uom_dimen " + ;
12221 " ,coalesce(d1.uom_convert, '') as uom_volume2 " + ;
12222 " ,coalesce(d2.uom_convert, '') as uom_weight2 " + ;
12223 " ,coalesce(d3.uom_convert, '') as uom_dimen2 " + ;
12224 " from " + .cSQLTempTable + " th " + ;
12225 " join " + pcControl + " cr on th.location = cr.ware_code And cr.UOM_Recal = 'Y' And cr.active_ok = 'Y' " + ;
12226 " left join zzxlocar lo on lo.location = cr.ware_code and lo.loc_type = 'W' " + ;
12227 " left join zzxsuomd d1 on d1.uom_convert = lo.uom_volume " + ;
12228 " and d1.uom = " + SqlFormatChar(.cFromUOMVolume) + ;
12229 " left join zzxsuomd d2 on d2.uom_convert = lo.uom_weight " + ;
12230 " and d2.uom = " + SqlFormatChar(.cFromUOMWeight) + ;
12231 " left join zzxsuomd d3 on d3.uom_convert = lo.uom_dimen " + ;
12232 " and d3.uom = " + SqlFormatChar(.cFromUOMDimens)
12233 CASE pcUOMFromType = 'DEST'
12234 lcSQLString = ;
12235 "select th.Catg_dest, coalesce(cr.UOM_Recal, '') as UOM_Recal, cr.uom_weight, cr.uom_volume, cr.uom_Dimen " + ;
12236 " ,coalesce(d1.uom_convert, '') as uom_volume2 " + ;
12237 " ,coalesce(d2.uom_convert, '') as uom_weight2 " + ;
12238 " ,coalesce(d3.uom_convert, '') as uom_dimen2 " + ;
12239 " from " + .cSQLTempTable + " th join zzeosccr cr " + ;
12240 " on th.Catg_dest = cr.Catg_dest and cr.active_ok = 'Y' " + ;
12241 " left join zzxsuomd d1 on d1.uom_convert = cr.uom_volume " + ;
12242 " and d1.uom = " + SqlFormatChar(.cFromUOMVolume) + ;
12243 " left join zzxsuomd d2 on d2.uom_convert = cr.uom_weight " + ;
12244 " and d2.uom = " + SqlFormatChar(.cFromUOMWeight) + ;
12245 " left join zzxsuomd d3 on d3.uom_convert = cr.uom_dimen " + ;
12246 " and d3.uom = " + SqlFormatChar(.cFromUOMDimens)
12247 ENDCASE
12248
12249 llRetVal = llRetVal AND v_SqlExec(lcSQLString,lcContCurs)
12250
12251 SELECT (lcContCurs)
12252 DO CASE
12253 CASE pcUOMFromType = 'DIV'
12254 INDEX on division+customer TAG division
12255 llRetVal = llRetVal And .SetRelation(lcContCurs, "division", pcTranHeader, "division+customer")
12256 CASE pcUOMFromType = 'LOC'
12257 INDEX on location TAG location
12258 llRetVal = llRetVal And .SetRelation(lcContCurs, "location", pcTranHeader, "location")
12259 CASE pcUOMFromType = 'DEST'
12260 INDEX on Catg_dest TAG Catg_dest
12261 ENDCASE
12262
12263 IF !EMPTY(.cWeightFieldForUOM)
12264 lcErrs_Msg = "No UOM conversion factor found for weight header UOM " + ALLTRIM(.cFromUOMWeight) + " and detail UOM "
12265 IF pcUOMFromType = 'DEST'
12266 replace errs_flg WITH 'Y', errs_msg WITH errs_msg + lcErrs_Msg + &lcContCurs..uom_weight + "." + CRLF ;
12267 FOR !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') AND EMPTY(&lcContCurs..uom_weight2) IN (pcTranHeader)
12268 ELSE
12269 replace errs_flg_h WITH 'Y', errs_msg_h WITH errs_msg_h + lcErrs_Msg + &lcContCurs..uom_weight + "." + CRLF ;
12270 FOR !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') AND EMPTY(&lcContCurs..uom_weight2) IN (pcTranHeader)
12271 ENDIF
12272 ENDIF
12273 IF !EMPTY(.cVolumeFieldForUOM)
12274 lcErrs_Msg = "No UOM conversion factor found for volume header UOM " + ALLTRIM(.cFromUOMVolume) + " and detail UOM "
12275 IF pcUOMFromType = 'DEST'
12276 replace errs_flg WITH 'Y', errs_msg WITH errs_msg + lcErrs_Msg + &lcContCurs..uom_volume + "." + CRLF ;
12277 FOR !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') AND EMPTY(&lcContCurs..uom_volume2) IN (pcTranHeader)
12278 ELSE
12279 replace errs_flg_h WITH 'Y', errs_msg_h WITH errs_msg_h + lcErrs_Msg + &lcContCurs..uom_volume + "." + CRLF ;
12280 FOR !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') AND EMPTY(&lcContCurs..uom_volume2) IN (pcTranHeader)
12281 ENDIF
12282 ENDIF
12283 IF !EMPTY(.cDimensFieldForUOM)
12284 lcErrs_Msg = "No UOM conversion factor found for dimension header UOM " + ALLTRIM(.cFromUOMDimens) + " and detail UOM "
12285 IF pcUOMFromType = 'DEST'
12286 replace errs_flg WITH 'Y', errs_msg WITH errs_msg + lcErrs_Msg + &lcContCurs..uom_dimen + "." + CRLF ;
12287 FOR !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') AND EMPTY(&lcContCurs..uom_dimen2) IN (pcTranHeader)
12288 ELSE
12289 replace errs_flg_h WITH 'Y', errs_msg_h WITH errs_msg_h + lcErrs_Msg + &lcContCurs..uom_dimen + "." + CRLF ;
12290 FOR !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') AND EMPTY(&lcContCurs..uom_dimen2) IN (pcTranHeader)
12291 ENDIF
12292 ENDIF
12293
12294 SET RELATION TO
12295 USE IN SELECT(lcContCurs)
12296
12297 ENDIF
12298
12299 ENDIF
12300
12301 ENDWITH
12302
12303 USE IN SELECT(lcContCurs)
12304
12305 SELECT (lnSelect)
12306 RETURN llRetVal
12307 ENDPROC
12308*============================================================
12309 PROCEDURE UpdateHeaderUOM
12310 PARAMETERS pcTranHeader, pcControl, plUOMFromLocation
12311
12312 LOCAL llRetVal, lnSelect, lcDivision, lcCustomer, lcSeekString, lnConvValue, lcReplaceString, lcContCurs
12313
12314 lnSelect = SELECT()
12315 llRetVal = true
12316 lcContCurs = GetUniqueFileName()
12317
12318 WITH THIS
12319
12320 IF !plUOMFromLocation
12321 lcSQLString = "Select distinct division, customer from " + pcTranHeader
12322 ENDIF
12323
12324 llRetVal = llRetVal AND v_SqlExec(lcSQLString,lcContCurs,,true)
12325
12326 .cSQLTempTable = ""
12327 IF .GenerateSQLTempTable(lcContCurs) AND .PopulateSQLTempTable(lcContCurs) AND !EMPTY(.cSQLTempTable)
12328
12329 USE IN SELECT(lcContCurs)
12330 IF !plUOMFromLocation
12331 lcSQLString = ;
12332 "select th.division, th.customer, coalesce(cr.UOM_Recal, '') as UOM_Recal, cr.uom_weight, cr.uom_volume, cr.uom_Dimen " + ;
12333 " ,coalesce(d1.uom_convert, '') as uom_volume2 " + ;
12334 " ,coalesce(d2.uom_convert, '') as uom_weight2 " + ;
12335 " ,coalesce(d3.uom_convert, '') as uom_dimen2 " + ;
12336 " ,coalesce(d1.uom_factor, 1) as volume_factor " + ;
12337 " ,coalesce(d2.uom_factor, 1) as weight_factor " + ;
12338 " ,coalesce(d3.uom_factor, 1) as dimen_factor " + ;
12339 " from " + .cSQLTempTable + " th join " + pcControl + " cr " + ;
12340 " on th.customer = cr.customer and th.division = cr.division and cr.active_ok = 'Y' " + ;
12341 " left join zzxsuomd d1 on d1.uom_convert = cr.uom_volume " + ;
12342 " and d1.uom = " + SqlFormatChar(.cFromUOMVolume) + ;
12343 " left join zzxsuomd d2 on d2.uom_convert = cr.uom_weight " + ;
12344 " and d2.uom = " + SqlFormatChar(.cFromUOMWeight) + ;
12345 " left join zzxsuomd d3 on d3.uom_convert = cr.uom_dimen " + ;
12346 " and d3.uom = " + SqlFormatChar(.cFromUOMDimens)
12347 ENDIF
12348
12349 llRetVal = llRetVal AND v_SqlExec(lcSQLString,lcContCurs)
12350
12351 IF llRetVal
12352 SELECT (lcContCurs)
12353 IF !plUOMFromLocation
12354 INDEX on division+customer TAG division
12355 llRetVal = llRetVal And .SetRelation(lcContCurs, "division", pcTranHeader, "division+customer")
12356 ENDIF
12357
12358 IF !EMPTY(.cWeightFieldForUOM)
12359 lcReplaceString = "replace " + .cWeightFieldForUOM + " WITH (" + .cWeightFieldForUOM + "*&lcContCurs..weight_factor) " + ;
12360 " FOR " + .cWeightFieldForUOM + " > 0 AND !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') " + ;
12361 " AND !EMPTY(&lcContCurs..uom_weight2) and errs_flg_h <> 'Y' " + ;
12362 " IN (pcTranHeader)"
12363 &lcReplaceString
12364 ENDIF
12365 IF !EMPTY(.cVolumeFieldForUOM)
12366 lcReplaceString = "replace " + .cVolumeFieldForUOM + " WITH (" + .cVolumeFieldForUOM + "*&lcContCurs..volume_factor) " + ;
12367 " FOR " + .cVolumeFieldForUOM + " > 0 AND !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') " + ;
12368 " AND !EMPTY(&lcContCurs..uom_volume2) and errs_flg_h <> 'Y' " + ;
12369 " IN (pcTranHeader)"
12370 &lcReplaceString
12371 ENDIF
12372 IF !EMPTY(.cDimensFieldForUOM)
12373 lcReplaceString = "replace " + .cDimensFieldForUOM + " WITH (" + .cDimensFieldForUOM + "*&lcContCurs..dimen_factor) " + ;
12374 " FOR " + .cDimensFieldForUOM + " > 0 AND !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') " + ;
12375 " AND !EMPTY(&lcContCurs..uom_dimen2) and errs_flg_h <> 'Y' " + ;
12376 " IN (pcTranHeader)"
12377 &lcReplaceString
12378 ENDIF
12379 IF !EMPTY(.cDimens1FieldForUOM)
12380 lcReplaceString = "replace " + .cDimens1FieldForUOM + " WITH (" + .cDimens1FieldForUOM + "*&lcContCurs..dimen_factor) " + ;
12381 " FOR " + .cDimens1FieldForUOM + " > 0 AND !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') " + ;
12382 " AND !EMPTY(&lcContCurs..uom_dimen2) and errs_flg_h <> 'Y' " + ;
12383 " IN (pcTranHeader)"
12384 &lcReplaceString
12385 ENDIF
12386 IF !EMPTY(.cDimens2FieldForUOM)
12387 lcReplaceString = "replace " + .cDimens2FieldForUOM + " WITH (" + .cDimens2FieldForUOM + "*&lcContCurs..dimen_factor) " + ;
12388 " FOR " + .cDimens2FieldForUOM + " > 0 AND !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') " + ;
12389 " AND !EMPTY(&lcContCurs..uom_dimen2) and errs_flg_h <> 'Y' " + ;
12390 " IN (pcTranHeader)"
12391 &lcReplaceString
12392 ENDIF
12393
12394 IF !EMPTY(.cWeight2FieldForUOM)
12395 lcReplaceString = "replace " + .cWeight2FieldForUOM + " WITH (" + .cWeight2FieldForUOM + "*&lcContCurs..weight_factor) " + ;
12396 " FOR " + .cWeight2FieldForUOM + " > 0 AND !EOF(lcContCurs) AND (&lcContCurs..UOM_Recal = 'Y') " + ;
12397 " AND !EMPTY(&lcContCurs..uom_weight2) and errs_flg_h <> 'Y' " + ;
12398 " IN (pcTranHeader)"
12399 &lcReplaceString
12400 ENDIF
12401
12402 SET RELATION TO
12403 USE IN SELECT(lcContCurs)
12404 ENDIF
12405
12406 ENDIF
12407 ENDWITH
12408
12409 SELECT (lnSelect)
12410 RETURN llRetVal
12411 ENDPROC
12412*============================================================
12413 PROCEDURE ValidateInboundUOM
12414 LPARAMETERS pcTranHeader, pcHeaderTAG, pcControl, pcControlTAG
12415
12416 LOCAL llRetVal, lnSelect, lcErrs_Msg, lcSql, lcUOMCurs, lcToUOMWeight, lcToUOMVolume, lcToUOMDimension
12417
12418 lnSelect = SELECT()
12419 llRetVal = true
12420 lcUOMCurs = GetUniqueFileName()
12421
12422 WITH this
12423 lcToUOMWeight = .cFromUOMWeight
12424 lcToUOMVolume = .cFromUOMVolume
12425 lcToUOMDimension = .cFromUOMDimens
12426
12427 SELECT (pcTranHeader)
12428 IF (EMPTY(lcToUOMWeight) OR EMPTY(lcToUOMVolume))
12429
12430 lcErrs_Msg = "UOM code in Company Control is blank." + CRLF
12431 llRetVal = llRetVal And .SetRelation(pcControl, pcControlTAG, pcTranHeader, pcHeaderTAG)
12432 IF llRetVal
12433 replace errs_flg_h WITH 'Y', errs_msg_h WITH errs_msg_h + lcErrs_Msg ;
12434 FOR !EOF(pcControl) AND (&pcControl..UOM_Recal = 'Y') IN (pcTranHeader)
12435 ENDIF
12436 SET RELATION TO
12437 ELSE
12438 lcSql = "Select * from zzxsuomd where uom_convert = " + SqlFormatChar(lcToUOMWeight)
12439 llRetVal = llRetVal And v_SqlExec(lcSql, lcUOMCurs)
12440
12441 IF llRetVal AND RECCOUNT(lcUOMCurs) = 0
12442 lcErrs_Msg = "The convert weight UOM [" + lcToUOMWeight + "] in Company Control is not populated or does not exist in TO Reference." + CRLF
12443 llRetVal = llRetVal And .SetRelation(pcControl, pcControlTAG, pcTranHeader, pcHeaderTAG)
12444 IF llRetVal
12445 replace errs_flg_h WITH 'Y', errs_msg_h WITH errs_msg_h + lcErrs_Msg ;
12446 FOR !EOF(pcControl) AND (&pcControl..UOM_Recal = 'Y') IN (pcTranHeader)
12447 ENDIF
12448 SET RELATION TO
12449 USE IN SELECT(lcUOMCurs)
12450 ENDIF
12451 lcSql = "Select * from zzxsuomd where uom_convert = " + SqlFormatChar(lcToUOMVolume)
12452 llRetVal = llRetVal And v_SqlExec(lcSql, lcUOMCurs)
12453
12454 IF llRetVal AND RECCOUNT(lcUOMCurs) = 0
12455 lcErrs_Msg = "The convert volume UOM [" + lcToUOMVolume + "] in Company Control is not populated or does not exist in TO Reference." + CRLF
12456 llRetVal = llRetVal And .SetRelation(pcControl, pcControlTAG, pcTranHeader, pcHeaderTAG)
12457 IF llRetVal
12458 replace errs_flg_h WITH 'Y', errs_msg_h WITH errs_msg_h + lcErrs_Msg ;
12459 FOR !EOF(pcControl) AND (&pcControl..UOM_Recal = 'Y') IN (pcTranHeader)
12460 ENDIF
12461 SET RELATION TO
12462 USE IN SELECT(lcUOMCurs)
12463 ENDIF
12464
12465 IF llRetVal AND !EMPTY(.cTranDetail1Table)
12466 lcErrs_Msg = "From UOM code in inbound file is blank." + CRLF
12467 lcSql = "Select t.pkey from " + .cTranDetail1Table + " t " + ;
12468 " join " + pcTranHeader + " h on h.pkey = t.fkey " + ;
12469 " join " + pcControl + " c on c." + pcControlTAG + " = h." + pcHeaderTAG + ;
12470 " Where c.UOM_Recal = 'Y' and (EMPTY(t.uom_volume) or EMPTY(t.uom_weight))"
12471
12472 llRetVal = llRetVal And v_SqlExec(lcSql,lcUOMCurs,,true)
12473
12474 SELECT (lcUOMCurs)
12475 INDEX on pkey TAG pkey
12476 llRetVal = llRetVal And .SetRelation(lcUOMCurs, "pkey", .cTranDetail1Table, "pkey")
12477
12478 IF llRetVal
12479 replace errs_flg_cntr WITH 'Y', errs_msg_cntr WITH errs_msg_cntr + lcErrs_Msg ;
12480 FOR !EOF(lcUOMCurs) IN (.cTranDetail1Table)
12481 ENDIF
12482 SET RELATION TO
12483 USE IN SELECT(lcUOMCurs)
12484 ENDIF
12485 IF llRetVal AND !EMPTY(.cTranDetail2Table)
12486 lcErrs_Msg = "From UOM code in inbound file is blank." + CRLF
12487 lcSql = "Select t.pkey from " + .cTranDetail2Table + " t " + ;
12488 " join " + pcTranHeader + " h on h.pkey = t.fkey " + ;
12489 " join " + pcControl + " c on c." + pcControlTAG + " = h." + pcHeaderTAG + ;
12490 " Where c.UOM_Recal = 'Y' and (EMPTY(t.uom_volume) or EMPTY(t.uom_weight))"
12491
12492 llRetVal = llRetVal And v_SqlExec(lcSql,lcUOMCurs,,true)
12493
12494 SELECT (lcUOMCurs)
12495 INDEX on pkey TAG pkey
12496 llRetVal = llRetVal And .SetRelation(lcUOMCurs, "pkey", .cTranDetail2Table, "pkey")
12497
12498 IF llRetVal
12499 replace errs_flg_ctn WITH 'Y', errs_msg_ctn WITH errs_msg_ctn + lcErrs_Msg ;
12500 FOR !EOF(lcUOMCurs) IN (.cTranDetail2Table)
12501 ENDIF
12502 SET RELATION TO
12503
12504 USE IN SELECT(lcUOMCurs)
12505 ENDIF
12506
12507 IF llRetVal AND !EMPTY(.cTranDetail1Table)
12508 lcSql = "Select t.pkey, t.uom_volume, t.uom_weight from " + .cTranDetail1Table + " t " + ;
12509 " join " + pcTranHeader + " h on h.pkey = t.fkey " + ;
12510 " join " + pcControl + " c on c.pkey = h.Control_Key " + ;
12511 " Where c.UOM_Recal = 'Y' and (t.uom_volume > '' or t.uom_weight > '')"
12512
12513 llRetVal = llRetVal And v_SqlExec(lcSql,lcUOMCurs,,true)
12514 ENDIF
12515
12516 .cSQLTempTable = ""
12517 IF llRetVal AND !EMPTY(.cTranDetail1Table) AND .GenerateSQLTempTable(lcUOMCurs) AND .PopulateSQLTempTable(lcUOMCurs) AND !EMPTY(.cSQLTempTable)
12518
12519 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 " + ;
12520 " on d1.uom = t.uom_weight left join zzxsuomr d2 on d2.uom = t.uom_volume"
12521
12522 llRetVal = llRetVal And v_SqlExec(lcSql, "__UOMRef")
12523 SELECT __UOMRef
12524 INDEX on pkey TAG pkey
12525
12526 llRetVal = llRetVal AND .SetRelation("__UOMRef", "pkey", .cTranDetail1Table, "pkey")
12527
12528 SELECT (.cTranDetail1Table)
12529
12530 lcErrs_Msg = "] does not exist in UOM Reference."
12531 replace errs_flg_cntr WITH 'Y', errs_msg_cntr WITH errs_msg_cntr + "Inbound weight UOM [" + uom_weight + lcErrs_Msg + CRLF ;
12532 FOR !EOF("__UOMRef") AND EMPTY(__UOMRef.WUOM) IN (.cTranDetail1Table)
12533
12534 replace errs_flg_cntr WITH 'Y', errs_msg_cntr WITH errs_msg_cntr + "Inbound volume UOM [" + uom_volume + lcErrs_Msg + CRLF ;
12535 FOR !EOF("__UOMRef") AND EMPTY(__UOMRef.VUOM) IN (.cTranDetail1Table)
12536
12537 SET RELATION TO
12538 USE IN SELECT("__UOMRef")
12539
12540 lcSql = "select t.pkey, Coalesce(d.pkey, 0) RefPkey, t.uom_volume, t.uom_weight from " + .cSQLTempTable + " t left join zzxsuomd d " + ;
12541 " on d.uom = t.uom_volume " + ;
12542 " and d.uom_convert = " + SqlFormatChar(lcToUOMVolume)
12543
12544 llRetVal = llRetVal And v_SqlExec(lcSql, "__UOMRef")
12545 SELECT __UOMRef
12546 INDEX on pkey TAG pkey
12547
12548 llRetVal = llRetVal AND .SetRelation("__UOMRef", "pkey", .cTranDetail1Table, "pkey")
12549
12550 SELECT (.cTranDetail1Table)
12551
12552 lcErrs_Msg = "No Volume UOM Conversion factor found for header UOM ["
12553 replace errs_flg_cntr WITH 'Y', errs_msg_cntr WITH errs_msg_cntr + lcErrs_Msg + uom_volume + "] and detail UOM [" + lcToUOMVolume + "]." + CRLF ;
12554 FOR !EOF("__UOMRef") AND __UOMRef.RefPkey = 0 IN (.cTranDetail1Table)
12555 SET RELATION TO
12556 USE IN SELECT("__UOMRef")
12557
12558 lcSql = "Select t.pkey, Coalesce(d.pkey, 0) RefPkey from " + .cSQLTempTable + " t left join zzxsuomd d " + ;
12559 " on d.uom = t.uom_weight " + ;
12560 " and d.uom_convert = " + SqlFormatChar(lcToUOMWeight)
12561 llRetVal = llRetVal And v_SqlExec(lcSql, "__UOMRef")
12562 SELECT __UOMRef
12563 INDEX on pkey TAG pkey
12564
12565 llRetVal = llRetVal AND .SetRelation("__UOMRef", "pkey", .cTranDetail1Table, "pkey")
12566
12567 SELECT (.cTranDetail1Table)
12568 lcErrs_Msg = "No Weight UOM Conversion factor found for header UOM ["
12569 replace errs_flg_cntr WITH 'Y', errs_msg_cntr WITH errs_msg_cntr + lcErrs_Msg + uom_weight + "] and detail UOM [" + lcToUOMWeight + "]." + CRLF ;
12570 FOR !EOF("__UOMRef") AND __UOMRef.RefPkey = 0 IN (.cTranDetail1Table)
12571 SET RELATION TO
12572 USE IN SELECT("__UOMRef")
12573 ENDIF
12574
12575 IF llRetVal AND !EMPTY(.cTranDetail2Table)
12576 lcSql = "Select t.pkey, t.uom_volume, t.uom_weight from " + .cTranDetail2Table + " t " + ;
12577 " join " + pcTranHeader + " h on h.pkey = t.fkey " + ;
12578 " join " + pcControl + " c on c.pkey = h.Control_Key " + ;
12579 " Where c.UOM_Recal = 'Y' and (t.uom_volume > '' or t.uom_weight > '')"
12580
12581 llRetVal = llRetVal And v_SqlExec(lcSql,lcUOMCurs,,true)
12582 ENDIF
12583
12584 .cSQLTempTable = ""
12585 IF llRetVal AND !EMPTY(.cTranDetail2Table) AND .GenerateSQLTempTable(lcUOMCurs) AND .PopulateSQLTempTable(lcUOMCurs) AND !EMPTY(.cSQLTempTable)
12586
12587 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 " + ;
12588 " on d1.uom = t.uom_weight left join zzxsuomr d2 on d2.uom = t.uom_volume"
12589
12590 llRetVal = llRetVal And v_SqlExec(lcSql, "__UOMRef")
12591 SELECT __UOMRef
12592 INDEX on pkey TAG pkey
12593
12594 llRetVal = llRetVal AND .SetRelation("__UOMRef", "pkey", .cTranDetail2Table, "pkey")
12595
12596 SELECT (.cTranDetail2Table)
12597
12598 lcErrs_Msg = "] does not exist in UOM Reference."
12599 replace errs_flg_ctn WITH 'Y', errs_msg_ctn WITH errs_msg_ctn + "Inbound weight UOM [" + uom_weight + lcErrs_Msg + CRLF ;
12600 FOR !EOF("__UOMRef") AND EMPTY(__UOMRef.WUOM) IN (.cTranDetail2Table)
12601
12602 replace errs_flg_ctn WITH 'Y', errs_msg_ctn WITH errs_msg_ctn + "Inbound volume UOM [" + uom_volume + lcErrs_Msg + CRLF ;
12603 FOR !EOF("__UOMRef") AND EMPTY(__UOMRef.VUOM) IN (.cTranDetail2Table)
12604
12605 SET RELATION TO
12606 USE IN SELECT("__UOMRef")
12607
12608 lcSql = "select t.pkey, Coalesce(d.pkey, 0) RefPkey from " + .cSQLTempTable + " t left join zzxsuomd d " + ;
12609 " on d.uom = t.uom_volume " + ;
12610 " and d.uom_convert = " + SqlFormatChar(lcToUOMVolume)
12611
12612 llRetVal = llRetVal And v_SqlExec(lcSql, "__UOMRef")
12613 SELECT __UOMRef
12614 INDEX on pkey TAG pkey
12615
12616 llRetVal = llRetVal AND .SetRelation("__UOMRef", "pkey", .cTranDetail2Table, "pkey")
12617 SELECT (.cTranDetail2Table)
12618 lcErrs_Msg = "No Volume UOM Conversion factor found for header UOM ["
12619 replace errs_flg_ctn WITH 'Y', errs_msg_ctn WITH errs_msg_ctn + lcErrs_Msg + uom_volume + "] and detail UOM [" + lcToUOMVolume + "]." + CRLF ;
12620 FOR !EOF("__UOMRef") AND __UOMRef.RefPkey = 0 IN (.cTranDetail2Table)
12621 SET RELATION TO
12622 USE IN SELECT("__UOMRef")
12623
12624 lcSql = "Select t.pkey, Coalesce(d.pkey, 0) RefPkey from " + .cSQLTempTable + " t left join zzxsuomd d " + ;
12625 " on d.uom = t.uom_weight " + ;
12626 " and d.uom_convert = " + + SqlFormatChar(lcToUOMWeight)
12627 llRetVal = llRetVal And v_SqlExec(lcSql, "__UOMRef")
12628 SELECT __UOMRef
12629 INDEX on pkey TAG pkey
12630
12631 llRetVal = llRetVal AND .SetRelation("__UOMRef", "pkey", .cTranDetail2Table, "pkey")
12632 SELECT (.cTranDetail2Table)
12633 lcErrs_Msg = "No Weight UOM Conversion factor found for header UOM ["
12634 replace errs_flg_ctn WITH 'Y', errs_msg_ctn WITH errs_msg_ctn + lcErrs_Msg + uom_weight + "] and detail UOM [" + lcToUOMWeight + "]." + CRLF ;
12635 FOR !EOF("__UOMRef") AND __UOMRef.RefPkey = 0 IN (.cTranDetail2Table)
12636 SET RELATION TO
12637 USE IN SELECT("__UOMRef")
12638
12639 ENDIF
12640
12641 ENDIF
12642 ENDWITH
12643
12644 USE IN SELECT(lcUOMCurs)
12645
12646 SELECT (lnSelect)
12647 RETURN llRetVal
12648 ENDPROC
12649
12650 *=== TR 1065007 4-Feb-2014 Goutam
12651
12652*============================================================
12653
12654*--- TR 1081157 13-Oct-2014 Goutam
12655 FUNCTION CreateChargeHdr
12656 LPARAMETERS tcDtlSOCurs, tcTransHeader
12657 LOCAL llRetVal, lnSelect, l_nThermoCnt, lcSQLString
12658
12659 llRetVal = true
12660 lnSelect = SELECT()
12661
12662 WITH This
12663
12664 .cSQLTempTable = ""
12665 IF .GenerateSQLTempTable(tcDtlSOCurs) AND .PopulateSQLTempTable(tcDtlSOCurs) AND !EMPTY(.cSQLTempTable)
12666
12667 * create charge header cursor from temp pick detail cursor
12668 lcSQLSelect = ;
12669 "SELECT c.pkey,c.pick_num,c.ord_num,c.inv_num," + ;
12670 "c.chrg_type,r.chrgtype_desc chrg_desc,c.chrg_value chrg_amt,c.chrg_flag,c.notes " + ;
12671 "FROM zzxchrgs c " + ;
12672 "JOIN zzxchrtr r " + ;
12673 " ON c.chrg_type = r.chrg_type " + ;
12674 " AND r.chrg_hdrdtl = 'H' " + ;
12675 "JOIN " + .cSQLTempTable + " p " + ;
12676 " ON c.ord_num = p.ord_num " + ;
12677 " AND c.pick_num = p.pick_num " + ;
12678 " AND c.inv_num = p.inv_num "
12679
12680 llRetVal=llRetVal And v_SQLExec(lcSQLSelect, tcTransHeader)
12681
12682 v_SqlExecNoError("drop table " + .cSQLTempTable)
12683
12684 ENDIF
12685 ENDWITH
12686 SELECT (lnSelect)
12687 RETURN llRetVal
12688 ENDFUNC
12689
12690*=== TR 1081157 13-Oct-2014 Goutam
12691*============================================================
12692
12693
12694*- TR 1081638 FH - took from clsoowpr
12695FUNCTION ResolveZipCode
12696 LPARAMETERS tcAddress
12697 LOCAL llRetVal, lnSelect
12698
12699 llRetVal = true
12700 lnSelect = SELECT()
12701
12702 WITH This
12703 SELECT (tcAddress)
12704 REPLACE ALL zipcode WITH IIF(LEN(ALLTRIM(zipcode)) > 9 AND SUBSTR(zipcode,6,1) = "-", LEFT(zipcode,5) + SUBSTR(zipcode,7),zipcode)
12705 ENDWITH
12706
12707 SELECT (lnSelect)
12708 RETURN llRetVal
12709 ENDFUNC
12710*- TR 1081638 FH
12711
12712
12713 *--- TR 1086117 30-Jun-2015 Partha ---
12714
12715 ************************************************************************************
12716 * Validate Bill_num (BOL#)
12717 ***********************************************************************************
12718
12719 Procedure CheckBOL
12720 Lparameters tcTransHeader, tcControl
12721 Local llRetVal, lnOldSelect
12722 llRetVal = .T.
12723 lnOldSelect = Select()
12724
12725 This.oLog.LogEntry("Validating BOL Number...")
12726
12727 SELECT (tcTransHeader)
12728
12729 INDEX ON pkey TAG bt
12730 GO TOP
12731
12732 Select h.pkey, h.division,h.customer, c.use_bill, h.bill_num, h.track_no ;
12733 From (tcTransHeader) h, (tcControl) c ;
12734 Where h.division= c.division ;
12735 And h.customer= c.customer ;
12736 And ( (c.Use_Bill="Y" And h.bill_num = " ") ;
12737 OR (c.Use_Bill="T" And h.track_no = " ") ;
12738 OR (c.Use_Bill="E" And h.bill_num = " " And h.track_no = " ") ;
12739 OR (c.Use_Bill="B" And (h.bill_num = " " OR h.track_no = " ") ) ;
12740 ) ;
12741 Into Cursor _tmpCursor
12742
12743 Select _tmpCursor
12744 INDEX ON pkey TAG tbt
12745 SET RELATION TO pkey INTO (tcTransHeader)
12746 GO TOP IN (tcTransHeader)
12747 GO TOP
12748
12749 If This.lUserInterface
12750 This.InitThermo(This.CountTotalRecs ('_tmpCursor'))
12751 l_nThermoCnt = 0
12752 ENDIF
12753
12754
12755 SCAN
12756
12757 If This.lUserInterface
12758 l_nThermoCnt = l_nThermoCnt + 1
12759 This.AdvanceThermo(l_nThermoCnt)
12760 Endif
12761
12762 lcErr = ""
12763 DO CASE
12764 CASE Use_Bill="Y" And bill_num = " "
12765 lcErr = EDI_BOL_REQ_MSG
12766 CASE Use_Bill="T" And track_no = " "
12767 lcErr = EDI_TRACKNO_REQ_MSG
12768 CASE Use_Bill="E" And bill_num = " " And track_no = " "
12769 lcErr = EDI_BOL_OR_TRACKNO_REQ_MSG
12770 CASE Use_Bill="B" And (bill_num = " " OR track_no = " ")
12771 lcErr = EDI_BOL_AND_TRACKNO_REQ_MSG
12772 ENDCASE
12773
12774 Replace Errs_msg_h With Errs_msg_h + lcErr + CRLF, ;
12775 Errs_flg_h With "Y" In (tcTransHeader)
12776
12777 ENDSCAN
12778
12779 SET RELATION OFF INTO (tcTransHeader)
12780
12781 If Used('_tmpCursor')
12782 Use In _tmpCursor
12783 Endif
12784 If This.lUserInterface
12785 This.ResetThermo()
12786 ENDIF
12787
12788 Select(lnOldSelect)
12789
12790*!* This.ResultLogMsg(llRetVal)
12791
12792 Return llRetVal
12793 Endproc
12794
12795*============================================================
12796
12797 *=== TR 1086117 30-Jun-2015 Partha ===
12798
12799 *--- TR 1099603 18-Oct-2016 Partha ---
12800 Function IsAddlKey
12801 Lparameters tcEDITransaction, tcEiPOth
12802 Local llRetVal, lnOldSelect, lcControl, lcSQLSelect
12803 llRetVal = .T.
12804 lnOldSelect = Select()
12805
12806 WITH This
12807
12808 SELECT (tcEiPOth)
12809 llRetVal = llRetVal AND FieldExists("Edi_store")
12810
12811 tcEDITransaction= Iif(Empty(tcEDITransaction), "ipo", tcEDITransaction)
12812
12813 lcControl= "zze" + tcEDITransaction + "cr"
12814
12815 *- if process is 850 we should use c850Control table.
12816 IF UPPER(tcEDITransaction ) = 'IPO' AND NOT EMPTY(.c850Control)
12817 lcControl = .c850Control
12818 ENDIF
12819
12820 lcSQLSelect = "SELECT top 1 * FROM " + lcControl
12821 llRetVal=llRetVal And v_SQLExec(lcSQLSelect, "__curcon")
12822 IF llRetVal AND USED("__curcon")
12823 llRetVal = llRetVal AND FieldExists("Add_key_source")
12824 .TableClose("__curcon")
12825 ENDIF
12826 ENDWITH
12827
12828 Select(lnOldSelect)
12829 Return llRetVal
12830 Endfunc
12831
12832*============================================================
12833 *=== TR 1099603 18-Oct-2016 Partha ===
12834
12835
12836Enddefine