· 8 years ago · Jan 05, 2018, 05:42 PM
1*****************************************************************************************
2* Program....: CLSPICKP.PRG
3* Date.......: 11/11/97
4* Abstract...: Pick Processing Business Object Class
5* Updates:
6* 11/18/97 skip carton update to pick header, ASN will resolve correct number of cartons.
7* 04/03/98 Modified to get form name from for_desc in zzxformr Frank Longo
8* 04/09/98 * call vl_formr() once and use temp cursor to get form_desc
9* 07/08/98 * Frank Longo - Add InfoBox Successfully completed ATS# 1890
10* 07/08/98 * Frank Longo - Modifications to all MB() ATS# 1876
11* 10/28/99 * Frank Longo - Resolve estimated carton if carton = 0 ATS# 3139
12* 01/13/00 PL ATS 3439- Pick Process - Routing Resolution bug
13*****************************************************************************************
14#INCLUDE SYSTEM.h
15
16DEFINE CLASS BPOPickProcess AS BOSalesOP
17 NAME = "BPOPickProcess"
18 lErrorState = .F.
19 cCaption = ""
20 cSQLFilterString = ""
21 *---TR 1008293 VK/DSK 1/3/2005
22 lIncludeLog=.t.
23 oRouting = NULL
24 *===TR 1008293 VK/DSK 1/3/2005
25
26 cParamFilter = "" && --- TR 1015923 23-Mar-2006 Goutam
27
28 *--- TR 1029331 20-DEC-2007 VKK
29 lPickProcessSkipRout = false
30 *=== TR 1029331 20-DEC-2007 VKK
31
32 *--- TR 1029193 24-Jan-2008 FGCJr
33 lPickProcessShipToZipCode = false
34 *=== TR 1029193 24-Jan-2008 FGCJr
35
36 *--- TechRec 1035699 04-Sep-2008 MA ===
37 cJobID = "PICKPROCESS"
38
39 *--- TR 1042761 10-Dec-2009 Partha ---
40 lEnableDutyFieldInSOE = false
41 *=== TR 1042761 10-Dec-2009 Partha ===
42
43 * --- TR 1043545 RLN 04/30/10
44 lUnlockBridge = .F.
45
46 *--- TR 1055858 08-Aug-2011 Partha ---
47 lLogStartedFromBatch = .f.
48 cQPicks = ""
49 *=== TR 1055858 08-Aug-2011 Partha ===
50
51 *--- TR 1054796 08-Sep-2011 Partha ---
52 lPickProcessStampDateOnce = true
53 *=== TR 1054796 08-Sep-2011 Partha ===
54
55 *--- 1057009
56 cForcedPickForm = ""
57 *=== 1057009
58
59
60
61 PROCEDURE INIT
62 *---TR 1008293 VK/DSK 1/3/2005
63 LOCAL llRetVal && 1008293
64 llRetVal = TRUE
65 *===TR 1008293 VK/DSK 1/3/2005
66
67 *--- TR 1042761 11-Dec-2009 Partha ---
68*!* DODEFAULT()
69 llRetVal = DODEFAULT()
70 *=== TR 1042761 11-Dec-2009 Partha ===
71
72 * JT ATS 4937 do not have these field in zzoordrh. so create it here.
73 CREATE CURSOR tcShip_to (Ship_to C(10), ;
74 shipper1 c(3), ;
75 shipper2 c(3), ;
76 shipper3 c(3), ;
77 shipper4 c(3), ;
78 shipper5 c(3), ;
79 wgt1_lmt i(4), ;
80 wgt2_lmt i(4), ;
81 wgt3_lmt i(4), ;
82 wgt4_lmt i(4), ;
83 crt1_lmt i(4), ;
84 crt2_lmt i(4), ;
85 crt3_lmt i(4), ;
86 crt4_lmt i(4), ;
87 cub1_lmt i(4), ;
88 cub2_lmt i(4), ;
89 cub3_lmt i(4), ;
90 cub4_lmt i(4))
91
92 * ---TR 1008293 VK/DSK 1/3/2005
93 SET PROCEDURE TO clsrtrpr ADDITIVE
94 THIS.oRouting = CREATEOBJECT("BPOROUTINGRESOLUTIONPROCESS")
95 llRetVal = llRetVal AND IsObject(THIS.oRouting, true)
96 * ===TR 1008293 VK/DSK 1/3/2005
97
98 *--- TR 1029331 20-DEC-2007 VKK
99 This.lPickProcessSkipRout = (goEnv.Sv("PICK_PROCESS_SKIP_ROUT", "N") == "Y")
100 *=== TR 1029331 20-DEC-2007 VKK
101
102 *--- TR 1042761 10-Dec-2009 Partha ---
103 This.lEnableDutyFieldInSOE = (goEnv.sv("ENABLE_DUTY_FIELD_IN_SOE","N") = 'Y')
104 *=== TR 1042761 10-Dec-2009 Partha ===
105
106 *--- TR 1054796 08-Sep-2011 Partha ---
107 This.lPickProcessStampDateOnce = (goEnv.Sv("PICK_PROCESS_STAMP_DATE_ONCE", "N") == "Y")
108 *=== TR 1054796 08-Sep-2011 Partha ===
109
110 *--- TR 1042761 11-Dec-2009 Partha ---
111 RETURN llRetVal
112 *=== TR 1042761 11-Dec-2009 Partha ===
113
114 ENDPROC
115
116************************************************************************************
117* Process Pick Tickets
118* Parameter: 1- passing additional filter criteria to select pick header or
119* If not passing anything then process all unprocess pick header
120* 2- plNoScreenUI (may call this process from Allocation which will skip prompting
121* for printDialogWithFormID() * Load proper form and print testpage
122************************************************************************************
123PROCEDURE ProcessPickTicket
124 LPARAMETERS pcSQLFilterString, plNoScreenUI
125 LOCAL lcSQLSelectString, llRetVal, lcFRX_Name, llBeganTransaction, lcDefaultSQLOrderString, ;
126 lcSecureFilter, lcSecureDetailFilter,lcJobDesc &&TechRec 1035699 04-Sep-2008 MA Added lcJobDesc
127 LOCAL Array laTables[3,2], laTablesDetail[1,2] &&35467
128
129 *--- TR 1036006 9/22/2008 AZ
130 pcSQLFilterString = IIF(EMPTY(pcSQLFilterString),"",pcSQLFilterString)
131 *=== TR 1036006 9/22/2008 AZ
132
133
134 *--- TR NSD 1060416
135 pcSQLFilterString = STRTRAN(pcSQLFilterString,"(C.","(R.")
136 *=== TR NSD 1060416
137
138
139 *--- TR 1055858 08-Aug-2011 Partha ---
140 LOCAL lcWaveBatchFilter
141 lcWaveBatchFilter = ""
142 This.lLogStartedFromBatch = IsObject(This.oLog, .T.) AND This.oLog.nHeaderPKey <> 0
143 IF This.lLogStartedFromBatch AND NOT EMPTY(This.cQPicks)
144 lcWaveBatchFilter = IIF(EMPTY(pcSQLFilterString), "", " AND ") + ;
145 " EXISTS(Select null From " + This.cQPicks + " Where pick_num = H.pick_num ) "
146 ENDIF
147 pcSQLFilterString = pcSQLFilterString + lcWaveBatchFilter
148 *=== TR 1055858 08-Aug-2011 Partha ===
149
150 *--- TR 1008293 Mar/11/2005 SK
151 LOCAL lcFilterCriteria
152 lcFilterCriteria=pcSqlFilterString
153 *=== TR 1008293 Mar/11/2005 SK
154
155 llRetVal = .T.
156
157 * path to SysLock directory on server (same place as Login.DBF)
158 lcSyslockTablePath = AddBS(goEnv.envLoginTablePath.VALUE)
159 IF !v_SysLock( lcSyslockTablePath+"SYSLOCK", "PICKPROCESS", goEnv.cCompany)
160 *!* ATS 1612 * Removed the following message
161 *!* MB('Another Pick Process is already running at this time.', D_NSTOPSIGN)
162 This.lProcessLocked = .T.
163 RETURN .F.
164 ENDIF
165* --- TR 1043545 RLN 04/30/10
166 * Check for Pick Bridge
167 IF goEnv.SV("LOCK_PICK_PROC_FROM_BRIDGE", "N") = "Y"
168 IF !v_SysLock( lcSyslockTablePath+"SYSLOCK", "OBRPKPROCESS", goEnv.cCompany)
169 This.lProcessLocked = .T.
170 * Pass in True so it does not unlock the Bridge as well
171 THIS.UnlockProcedure()
172 RETURN .F.
173 ENDIF
174 This.lUnlockBridge = .T.
175 ENDIF
176* === TR 1043545
177
178 *--- TechRec 1035699 04-Sep-2008 MA ---
179 WITH this
180
181 IF NOT .lLogStartedFromBatch && TR 1055858 08-Aug-2011 Partha
182
183 .oLog.OpenLog(.cJobId, I(.cJobId), .lScheduled)
184
185 ENDIF && TR 1055858 08-Aug-2011 Partha
186
187
188 .oLog.LogProgram("clspickp.prg")
189 .oLog.LogEntry("Filter Criteria: " + pcSQLFilterString)
190 .oLog.LogEntry("Getting Report Data From Control Table")
191 ENDWITH
192 *--- TechRec 1035699 04-Sep-2008 MA ===
193
194 *--- TR 1036155 - MP - 10/02/08 - Fix problem 'Unable to create email' when Subject is blank
195 IF EMPTY(This.cCaption)
196 This.cCaption='Pick Process'
197 ENDIF
198 *=== TR 1036155
199
200 *--- TR 1057009 - Allow user to specify a pick form from process
201 IF NOT THIS.GetFormFromParamBro()
202 THIS.UnlockProcedure()
203 RETURN .F.
204 ENDIF
205 *=== TR 1057009 - Allow user to specify a pick form from process
206
207
208 * 12/15/97 - add PrintDialogwithformid upfront
209 IF !plNoScreenUI
210 lcFRX_Name = THIS.GetFRXFromControlTable("PICK_FORM", "ZZOCntrc")
211 * ATS# 2881 For the time being eliminate EXPORT BUTTON In Printing
212 LOCAL llNoExportOption
213 llNoExportOption = .T.
214
215 IF !THIS.PrintDialogWithFRXName(lcFRX_Name, THIS.cCaption,llNoExportOption)
216 THIS.cMessage = 'No Pick-Form setup in Sales Order Control Reference.'
217 THIS.UnlockProcedure()
218
219 *--- TechRec 1035699 04-Sep-2008 MA ===
220 This.oLog.LogEntry("No Pick-Form setup in Sales Order Control Reference.")
221
222 RETURN .F.
223 ENDIF
224 * 12/16/97 - "CANCEL" in PrintDialogWithFRXName form
225 IF THIS.cPrintDialogResponse = "CANCEL"
226 THIS.cMessage = MSG_DONT_PRINT && Don't print msg on exit
227
228 *--- TechRec 1035699 04-Sep-2008 MA ===
229 This.oLog.LogEntry(THIS.cMessage)
230
231 THIS.UnlockProcedure()
232 RETURN .F.
233 ENDIF
234 ENDIF
235
236 * ---- create ProgressBar Form, display 1st label, need some delay. ------------
237 *!* ATS 4388
238 THIS.CreateFormProgressBar(plNoScreenUI)
239 THIS.UpdateThermoCaption("Selecting pick records to process...")
240
241
242 INKEY(.1, "H") && need some delay for activex object create 1st time
243 * -------------------------------------------------------------------------------
244
245 * cannot use this need view, tableupdate
246 * This.TimeStampDocument("SYSLOCK")
247
248 * additional filter criteria
249 pcSQLFilterString = IIF(EMPTY(pcSQLFilterString), "", " And " + pcSQLFilterString )
250
251
252 *--- TR 1029193 24-Jan-2008 FGCJr
253 This.lPickProcessShipToZipCode = "DAD.S_ZIPCODE" $ UPPER(pcSQLFilterString)
254 *=== TR 1029193 24-Jan-2008 FGCJr
255
256
257 WITH THIS
258 *---TAN 35467 HH 11/27/02 Salesman level security
259 laTables[1, 1] = "zzoordrh"
260 laTables[1, 2] = "h"
261 laTables[2, 1] = "zzoordrd"
262 laTables[2, 2] = "d"
263 *--- TAN 39837 13-AUG-2003 UBH
264 laTables[3, 1] = "ZZXCUSTR"
265 laTables[3, 2] = "R"
266 *=== TAN 39837 13-AUG-2003 UBH
267
268 lcSecureFilter = ColumnSecurityFilter(@laTables)
269 lcSecureFilter = IIF(EMPTY(lcSecureFilter), "", " AND " + lcSecureFilter)
270
271 laTablesDetail[1, 1] = "zzoordrd"
272 laTablesDetail[1, 2] = ""
273 lcSecureDetailFilter = ColumnSecurityFilter(@laTablesDetail)
274 lcSecureDetailFilter = IIF(EMPTY(lcSecureDetailFilter), "", " AND " + lcSecureDetailFilter)
275 *===TAN 35467 HH 11/27/02
276
277 .lNoDataFound = .F.
278 lcDefaultSQLOrderString = "division, location, pick_num "
279 * create pick header view
280 * ATS 2201- PL SOP SQLServer
281 * lcSQLSelectString = "Select Distinct h.* From zzoordrh h, zzoordrd d where h.pkey = d.fkey And " +;
282 * "h.ord_status = 'P' And h.ack_prn Not In ('P','R') " + pcSQLFilterString
283
284 This.cSQLFilterString = " And h.pick_num> 0 And h.ord_status = 'P' And h.ack_prn Not In ('P','R') " + ;
285 pcSQLFilterString + lcSecureFilter
286
287 THIS.oRouting.cSQLFilterString = THIS.cSQLFilterString
288
289 *--- 1007612 11/11/04 Ilya: Duty Resolution process
290
291 *--- TR 1042761 10-Dec-2009 Partha ---
292*!* IF (goEnv.SV("RESOLVE_DUTY_PICK","N") == "Y")
293 IF (goEnv.SV("RESOLVE_DUTY_PICK","N") == "Y") AND !(.lEnableDutyFieldInSOE)
294 *=== TR 1042761 10-Dec-2009 Partha ===
295
296 LOCAL loDutyResProcess, lcOldThermoCaption, lcOldThermoCaptionTotal
297 IF ATC("rrxgenib.",SET("PROCEDURE")) = 0
298 SET PROCEDURE TO rrxgenib ADDITIVE
299 ENDIF
300 IF ATC("rrosdrpr.",SET("PROCEDURE")) = 0
301 SET PROCEDURE TO rrosdrpr ADDITIVE
302 ENDIF
303
304 *--- TR 1009928 NH - if it is scheduled then do not use progress bar
305 *--- there need to be a getStatusCaption and getStatusTotal function instead of
306 *--- using oFrmProgressBar object directly
307 IF IsObject(THIS.oFrmProgressBar) AND !IsNull(THIS.oFrmProgressBar)
308 lcOldThermoCaption = THIS.oFrmProgressBar.lblStatus.Caption
309 lcOldThermoCaptionTotal = THIS.oFrmProgressBar.lblStatusTotal.Caption
310 THIS.UpdateThermoCaption("Duty resolution process...")
311
312 *--- TechRec 1035699 04-Sep-2008 MA ===
313 This.oLog.LogMajorStage("Sales Duty Resolution Process...")
314
315 ENDIF
316 *=== TR 1009928 NH
317
318 loDutyResProcess = CREATEOBJECT("rrosdrpr")
319 IF TYPE("loDutyResProcess") = 'O' AND NOT ISNULL(loDutyResProcess)
320 loDutyResProcess.lScheduled = .T.
321 loDutyResProcess.oLog = .oLog
322 loDutyResProcess.oFrmProgressBar = .oFrmProgressBar
323
324 *--- TechRec 1035699 04-Sep-2008 MA ---
325 loDutyResProcess.cProcessDescription = "Sales Duty Resolution Process"
326 lcJobDesc = This.oLog.cJobDesc
327 This.oLog.cJobDesc = "Sales Duty Resolution Process"
328 *=== TechRec 1035699 04-Sep-2008 MA ===
329
330 llRetVal = loDutyResProcess.MainProcess( ;
331 IIF(UPPER(LEFT(ALLTRIM(This.cSQLFilterString),3)) = 'AND','(1=1) ','') + ;
332 This.cSQLFilterString)
333
334 *--- TechRec 1035699 04-Sep-2008 MA ===
335 This.oLog.cJobDesc = lcJobDesc
336
337 loDutyResProcess.AdvanceThermo(0)
338 loDutyResProcess = .NULL.
339 IF NOT llRetVal
340 .lErrorState = .T.
341 .cMessage = "Sales Duty Resolution Process failed. Cannot continue."
342
343 *--- TechRec 1035699 04-Sep-2008 MA ===
344 This.oLog.LogEntry(.cMessage)
345
346 ENDIF
347 ELSE
348 .lErrorState = .T.
349 llRetVal = .F.
350 .cMessage = "Failed to initialize Sales Duty Resolution Process. Cannot continue."
351
352 *--- TechRec 1035699 04-Sep-2008 MA ===
353 This.oLog.LogEntry(.cMessage)
354
355 ENDIF
356
357 THIS.UpdateThermoCaption(lcOldThermoCaption)
358 THIS.UpdateThermoTotalCaption(lcOldThermoCaptionTotal)
359
360 *--- TechRec 1035699 04-Sep-2008 MA ===
361 This.oLog.LogMajorStage("Selecting and resolve pick data to process")
362
363 IF NOT llRetVal
364 IF IsObject(THIS.oFrmOutput)
365 THIS.oFrmOutput.m_close()
366 ENDIF
367 THIS.m_close()
368 THIS.UnlockProcedure()
369 RETURN .F.
370 ENDIF
371 ENDIF
372 *=== 1007612 11/11/04 Ilya.
373
374 *--- TAN 39837 13-AUG-2003 UBH
375 *!* lcSQLSelectString = "SELECT * FROM zzoordrh WHERE pkey IN( SELECT d.fkey FROM zzoordrd d, zzoordrh h " + ;
376 *!* "WHERE d.fkey = h.pkey " + This.cSQLFilterString + ")"
377 *--- TechRec 1026167 06-Aug-2007 jjanand ---
378*!* lcSQLSelectString = "SELECT * FROM zzoordrh WHERE pkey IN( SELECT d.fkey FROM zzoordrd d, zzoordrh h " + ;
379 " left outer join zzxcustr R ON (H.Customer=R.Customer) " +;
380 "WHERE d.fkey = h.pkey " + This.cSQLFilterString + ")"
381
382 *--- TR 1029193 28-DEC-2007 FGCJr - added the IF condition and the ELSE part
383
384 *--- TechRec 1035699 04-Sep-2008 MA ===
385 This.oLog.LogEntry("Creating and open views for work tables...")
386
387 *--- TechRec 1073552/1077549 23-Sep-2013 vkrishnamurthy ---, 04/01/14 MP
388 lcSqlString ="SELECT * FROM ZZOORDRH WHERE 1 = 0"
389 v_SqlExec(lcSQLString,"tcCursor")
390 lcFieldList = CreateFieldListFromCursor("tcCursor","h.")
391 lcFieldList = RemoveFieldsFromList(lcFieldList, "h.FIFTYONE_ORD_NUM,h.BM_UDF1,h.ARVBY_DATE,h.BM_GIFT_RCPT,h.BM_RTL_STORE")
392 *=== TechRec 1073552 23-Sep-2013 vkrishnamurthy
393
394 && TechRec 1073552/1077549 23-Sep-2013 vkrishnamurthy - Added lcFieldList in the below lcSQLSelectString, 04/01/14 MP
395 IF NOT .lPickProcessShipToZipCode
396 lcSQLSelectString = " SELECT "+ lcFieldList + ", r.cust_type " + ;
397 " FROM zzoordrh h " + ;
398 " LEFT JOIN zzxcustr r " + ;
399 " ON h.Customer = r.Customer " + ;
400 " WHERE h.pkey IN( SELECT d.fkey FROM zzoordrd d, zzoordrh h " + ;
401 " left outer join zzxcustr R ON (H.Customer=R.Customer) " +;
402 " WHERE d.fkey = h.pkey " + This.cSQLFilterString + ")"
403
404 ELSE
405 lcSQLSelectString = " SELECT "+ lcFieldList + ", r.cust_type, dad.s_zipcode " + ;
406 " FROM zzoordrh h " + ;
407 " LEFT JOIN zzxcustr r " + ;
408 " ON h.Customer = r.Customer " + ;
409 " LEFT JOIN zzordad2 dad " + ;
410 " ON h.Ord_num = dad.Ord_num AND " + ;
411 " h.Pick_num = dad.Pick_num AND " + ;
412 " h.Inv_num = dad.Inv_num AND " + ;
413 " h.Cncl_num = dad.Cncl_num " + ;
414 " WHERE h.pkey IN( SELECT d.fkey FROM zzoordrd d, zzoordrh h " + ;
415 " left outer join zzxcustr R ON (H.Customer=R.Customer) " +;
416 " left outer join zzordad2 DAD ON (h.Ord_num = dad.Ord_num AND " +;
417 " h.Pick_num = dad.Pick_num AND " + ;
418 " h.Inv_num = dad.Inv_num AND " + ;
419 " h.Cncl_num = dad.Cncl_num) " + ;
420 " WHERE d.fkey = h.pkey " + This.cSQLFilterString + ")"
421 ENDI
422 *=== TR 1029193 28-DEC-2007 FGCJr ===
423
424 *--- TechRec 1026167 21-Aug-2007 vkrishnamurthy ---
425 ***As the SQL view is not getting created when zzxcustr location has any values - Giving Ambigious column
426 *** hence added alias h.
427 lcDefaultSQLOrderString = " h.division, h.location, h.pick_num "
428 *=== TechRec 1026167 21-Aug-2007 vkrishnamurthy ===
429
430 *=== TechRec 1026167 06-Aug-2007 jjanand ===
431 *=== TAN 39837 13-AUG-2003 UBH
432 *===TAN 35467 HH 11/27/02
433
434 .CreateSQLView("Vzzopckrh",lcSQLSelectString,, lcDefaultSQLOrderString )
435
436 * create pick detail view (all details match pkey/fkey of header)
437 * ATS 2201- PL SOP SQLServer. Cannot subquere base on view.
438 * lcSQLSelectString = "Select * From zzoordrd where fkey in (Select pkey from Vzzopckrh)"
439
440 *--- TR 1029193 28-DEC-2007 FGCJr - added the IF condition and the ELSE part
441 IF NOT .lPickProcessShipToZipCode
442 lcSQLSelectString = "SELECT * FROM zzoordrd WHERE fkey IN( SELECT h.pkey FROM zzoordrd d, zzoordrh h " + ;
443 " left outer join zzxcustr R ON (H.Customer=R.Customer) " +; && 1015758 AZ
444 "WHERE d.fkey = h.pkey And h.pick_num> 0 And h.ord_status = 'P' And h.ack_prn Not In ('P','R') " + ;
445 pcSQLFilterString + lcSecureFilter + ") " + lcSecureDetailFilter &&TAN35467
446 ELSE
447 lcSQLSelectString = "SELECT * FROM zzoordrd WHERE fkey IN( SELECT h.pkey FROM zzoordrd d, zzoordrh h " + ;
448 " left outer join zzxcustr R ON (H.Customer=R.Customer) " +;
449 " LEFT JOIN zzordad2 dad " + ;
450 " ON h.Ord_num = dad.Ord_num AND " + ;
451 " h.Pick_num = dad.Pick_num AND " + ;
452 " h.Inv_num = dad.Inv_num AND " + ;
453 " h.Cncl_num = dad.Cncl_num " + ;
454 " WHERE d.fkey = h.pkey And h.pick_num> 0 And h.ord_status = 'P' And h.ack_prn Not In ('P','R') " + ;
455 pcSQLFilterString + lcSecureFilter + ") " + lcSecureDetailFilter
456 ENDI
457 *=== TR 1029193 28-DEC-2007 FGCJr ===
458
459
460 .CreateSQLView("Vzzopckrd",lcSQLSelectString)
461 * Open all views
462 IF !(.OPENTABLE("Vzzopckrh",,.T.) AND ;
463 .OPENTABLE("Vzzopckrd",,.T.))
464 .lErrorState = .T.
465 llRetVal = .F.
466 .cMessage = MSG_FILTER_ERROR + CRLF + MSG_TRY_AGAIN_NOW
467
468 *--- TechRec 1035699 04-Sep-2008 MA ===
469 This.oLog.LogEntry(.cMessage)
470
471 ELSE
472 *--- PHU 01/05/04 1002782- PICK PROCESS - ERROR 1- TCPICKWK.DBF DOES NOT EXIST
473 *-----CURRENT CODE
474 *!* * create temp pick work header same as order header + ship_to C(5)
475 *!* * use in routing resolution
476 *!* .CreateCursorStructure("Vzzopckrh", "tcShip_to" , "tcOpckwH")
477 *!* * create temp pick work detail same as order detail
478 *!* SELECT * FROM Vzzopckrd INTO CURSOR tcOpckwD
479
480 *--- Need to get this field list from some where , sparw only have max of 255 for value
481
482 *--- TechRec 1026167 06-Aug-2007 jjanand --- Added Cust_type
483 lcPickHdrFlds= "ord_num,next_line,cncl_num,pick_num,inv_num,reg_num,mani_num,bill_num,pro_num,consol_num,"+;
484 "division,season,customer,store,department,po_num,start_date,end_date,ord_date,pick_date,ship_date,"+;
485 "conf_type,ord_type,slsperson1,slsperson2,comm1,comm2,terms,hold_code,hold_rsn,discount,priority,"+;
486 "pri_date,factor_ok,factor,carton,weight,frgt_amt,insu_amt,disc_amt,misc_amt,location,shipper,"+;
487 "ship_dc,center_code,consol_code,xtra_date,asof_date,num_days,ord_qty,source,price_code,"+;
488 "customer_rep,credit_rep,claims_rep,supplier_num,ent_date,ent_user,notes,udford1c,udford3d,"+;
489 "udford4i,ord_status,appv_num,ftran_date,decl_rsn,fact_status,ord_volume,shpst_code,load_id,"+;
490 "stop_seq,rrc,allowance1,allowance2,ovrUDPerc,ovrPUDPerc,FacExpir_Days,FacExpir_Basis,FacClient_Num,"+;
491 "value_add1,value_add2,Wave_Num,fexpn_date,SHP_IN_ALL,DESIGNCODE,DZSPOSCODE,DZSIZECODE,DZNMDROPID,"+;
492 "PO_DESC,CST_REGION,EDIBILL_TO,ALTPO,TRANS_DATE,UDFORD2C,EWD,PACK_TYPE,SWC_NUM,SLSPERSON3,"+;
493 "SLSPERSON4,COMM3,COMM4,TAX_AMT,FAPPV_AMT,TAX_EMPT,pkey,ack_prn,user_id,Cust_type" && TR 1006308 LH 7/27/04 add user_id
494 *=== TechRec 1026167 06-Aug-2007 jjanand ===
495
496 *--- TR 1029193 28-DEC-2007 FGCJr - add S_Zipcode
497 IF .lPickProcessShipToZipCode
498 lcPickHdrFlds = lcPickHdrFlds + ",S_Zipcode"
499 ENDI
500 *--- TR 1029193 28-DEC-2007 FGCJr ===
501
502 lcMac= "SELECT " + lcPickHdrFlds + " FROM Vzzopckrh INTO CURSOR tcHdrFld"
503 &lcMac
504
505 .CreateCursorStructure("tcHdrFld", "tcShip_to" , "tcOpckwH")
506
507 *--- TechRec 1042254 26-Aug-2009 asharma --- added start_date as dtlStartDate,end_date as dtlEndDate
508 lcPickDtlFlds= "ord_num,line_seq,line_status,pick_num,inv_num,division,style,color_code,lbl_code,dimension,"+;
509 "coord_code,price,org_price,total_qty,size01_qty,size02_qty,size03_qty,size04_qty,size05_qty,"+;
510 "size06_qty,size07_qty,size08_qty,size09_qty,size10_qty,size11_qty,size12_qty,size13_qty,size14_qty,"+;
511 "size15_qty,size16_qty,size17_qty,size18_qty,size19_qty,size20_qty,size21_qty,size22_qty,size23_qty,"+;
512 "size24_qty,location,lot,discount,comm1,comm2,start_date,end_date,hold_code,hold_rsn,priority,pri_date,"+;
513 "alc_date,nsr_code,factor,sub_code,sub_style,sub_color,sub_lbl,sub_dimens,rng_style,rng_color,rng_lbl,"+;
514 "rng_pack,cncl_type,cncl_rsn,notes,appv_num,ftran_date,decl_rsn,fact_status,factor_ok,cncl_date,man_app,"+;
515 "value_add1,value_add2,retail1,retail2,FacExpir_Days,FacExpir_Basis,FacClient_Num,fbatch_num,udfoordd1c,"+;
516 "udfoordd2c,AvgWgtCost,Royalty,Roy_Cls,Wave_Num,fexpn_date,lc_trx_type,lc_trx_num,UDFPRICE1D,UDFPRICE2D,"+;
517 "EDIPO4UDF1,EDIPO4UDF2,EDIPO4UDF3,SLSPERSON1,SLSPERSON2,SLSPERSON3,SLSPERSON4,COMM3,COMM4,TAX_EMPT,pkey,fkey,"+;
518 "start_date as dtlStartDate,end_date as dtlEndDate"
519
520 lcMac= "SELECT " + lcPickDtlFlds + " FROM Vzzopckrd INTO CURSOR tcOpckwD"
521 &lcMac
522 *=== PHU 01/05/04 1002782
523
524 *--- TechRec 1040748 16-Jul-2009 MPerel --- create index and turn SCAN FOR to SEEK SCAN WHILE
525 SELECT tcOpckwD
526 INDEX ON fkey TAG fkey
527 *=== TechRec 1040748 16-Jul-2009 MPerel ===
528
529 IF RECC('Vzzopckrh') = 0
530 .lNoDataFound = .T.
531 .cMessage = 'There are no Pick Tickets to process.'
532
533 *--- TechRec 1035699 04-Sep-2008 MA ===
534 This.oLog.LogEntry(.cMessage)
535 ELSE
536 * start pick process
537 .InitProgressBarTotal(6, "Total pick process.")
538
539 *--- TechRec 1031637 23-Apr-2008 T.Shenbagavalli ---
540 IF (goEnv.SV("AUTO-CANCEL_BACKORDER_PROCESS_AND_RESOLUTION","N") == "Y")
541
542 This.oLog.LogEntry("Auto Canceling Orders...")
543
544 .AutoCancelOrder(pcSQLFilterString + lcSecureFilter)
545
546 ENDIF
547 *=== TechRec 1031637 23-Apr-2008 T.Shenbagavalli ===
548
549 *--- TR 1057009
550 IF NOT EMPTY(.cForcedPickForm)
551 PRIVATE pcReprint_Form
552 pcReprint_Form = .cForcedPickForm
553 ENDIF
554 *=== TR 1057009
555
556 * ATS# 2713 Ask Printer before Updating order in case user
557 * cancells print job. Frank Longo 07/08/1999
558 llRetVal= .CreateGenericPrinterCursor('Vzzopckrh','tcprinter','O','PICK_FORM', plNoScreenUI)
559
560 IF llRetVal
561 * Don't have to lock all pick headers like 4GL
562 * in Unpick mode of Sale O/E have to disable SAVE when PickProcess
563 * is active. Prevent people try to delete pick that process in this
564 * batch.
565 * create/resolve pick work
566 .AdvanceThermoTotal(1)
567 .UpdateThermoCaption("Resolving Weight, Shipper, ShipThru, ShipTo...")
568
569 *--- TechRec 1035699 04-Sep-2008 MA ===
570 This.oLog.LogEntry("Resolving Weight, Shipper, ShipThru, ShipTo...")
571
572 IF .CreateAndResolvePick("Vzzopckrh","Vzzopckrd","tcOpckwH","tcOpckwD")
573 * resolve routing for all empty(shipper)
574 .AdvanceThermoTotal(1)
575 .UpdateThermoCaption("Resolving Routing...")
576
577 *--- TechRec 1035699 04-Sep-2008 MA ===
578 This.oLog.LogEntry("Resolving Routing...")
579
580 *---TR 1008293 VK/DSK 2/3/2005
581 *--- TR 1057987 11/21/11 ATHIRUNAVU Added s_zipcode
582 lcFldList = " pkey,customer,division,department,location," + ;
583 " ship_to,carton,weight,ord_volume as volume," +;
584 " center_code,consol_code,ship_dc,space(3) as shipper,mani_num,space(3) as status, SPACE(10) as s_zipcode "
585
586 lcMac = "SELECT " + lcFldList + " From tcOpckwH INTO CURSOR tcRout"
587 &lcMac
588 llRetVal = .GenerateSQLTempTable("tcRout") AND .PopulateSQLTempTable("tcRout")
589 THIS.oRouting.oLog = THIS.oLog
590 THIS.oRouting.lScheduled = THIS.lScheduled
591
592 *--- TechRec 1035699 04-Sep-2008 MA ---
593 lcJobDesc = This.oLog.cJobDesc
594 This.oLog.cJobDesc = "Resolve Routing Process"
595 *=== TechRec 1035699 04-Sep-2008 MA ===
596
597 llRetVal= llRetVal AND .oRouting.Resolve_Route_Shipper(.cSQLTempTable,.t.,lcFilterCriteria)
598
599 *--- TechRec 1035699 04-Sep-2008 MA ===
600 This.oLog.cJobDesc = lcJobDesc
601
602 *===TR 1008293 VK/DSK 2/3/2005
603
604*!* IF .ResolveRouting("tcOpckwH")
605*!* * Update pick header with ack_prn,weight,cartont,shipper...
606*!* .AdvanceThermoTotal(1)
607*!* .UpdateThermoCaption("Updating Pick header...")
608*--- TAN 1013803 10/21/05 AZ Uncommented next line
609*--- TAN 1014175 10/21/05 AZ
610**** .UpdatePick("tcOpckwH", "Vzzopckrh")
611*--- TAN 1014175 10/21/05 AZ
612*=== TAN 1013803 10/21/05 AZ Uncommented next line
613*!* * Start Transaction
614*!* llBeganTransaction = .BeginTransaction()
615*!* * Tableupdate pick header
616*!* IF .TABLEUPDATE("Vzzopckrh")
617*!* * Commit Transaction
618*!* IF llBeganTransaction
619*!* .EndTransaction()
620*!* ENDIF
621*!* * PickTicket,Registers and reports
622
623 *--- TechRec 1035699 04-Sep-2008 MA ===
624 This.oLog.LogMajorStage("Prepare work tables for Pick Tickets print...")
625
626 IF !.PrintPickTicketsAndReports("Vzzopckrh", "tcOpckwH", "tcOpckwD", plNoScreenUI)
627 llRetVal = .F.
628*!* .cMessage = "Unable to access output device."
629 ELSE
630 .UpdateThermoCaption("Pick process successfully completed.")
631
632 *--- TechRec 1035699 04-Sep-2008 MA ===
633 This.oLog.LogEntry("Pick process successfully completed.")
634 ENDIF
635*!* ELSE
636*!* llRetVal = .F.
637*!* IF llBeganTransaction
638*!* .RollbackTransaction()
639*!* ENDIF
640*!* ENDIF
641*!* ENDIF
642 ENDIF
643 ELSE
644 .cMessage = MSG_DONT_PRINT
645
646 *--- TR 1061338 17-May-12 SK Updating message for the schedule mode
647 IF plNoScreenUI
648 .CMessage = "No PICK Form has been set up in Sales Order Control / Location Reference."
649 .oLog.LogEntry("No PICK Form has been set up in Sales Order Control / Location Reference.")
650 ENDIF
651 *=== TR 1061338 17-May-12 SK
652
653 ENDIF
654
655
656 ENDIF
657 ENDIF
658 ENDWITH
659
660 * ATS 1663 PL 06/03/98 Invoice & Pick Processing - bug
661 * At begining of process alway create pick header/detail views
662 * need to cleanup by closing those views
663 *!* If Used("Vzzopckrh")
664 *!* Use In Vzzopckrh
665 *!* Endif
666 *!* If Used("Vzzopckrd")
667 *!* Use In Vzzopckrd
668 *!* Endif
669 * ATS 2201- Pl Drop all temp views
670 THIS.TableClose("Vzzopckrh", true)
671 THIS.TableClose("Vzzopckrd", true)
672
673
674 * 02/25/98 - release both oFrmOutput and oFrmProgressBar
675 IF IsObject(THIS.oFrmOutput)
676 THIS.oFrmOutput.m_close()
677 ENDIF
678 THIS.m_close()
679 THIS.UnlockProcedure()
680
681 *--- TechRec 1035699 04-Sep-2008 MA ===
682 *--- TAN 1040791 6/17/2009 AZ
683 this.oLog.LogResult(llRetVal)
684
685 *--- TR 1055858 08-Aug-2011 Partha ---
686 IF this.lLogStartedFromBatch
687 this.oLog.nWarning = 0
688
689 *--- Must be false for wave batch. Cannot assume picks are not already processed.
690 this.lNoDataFound = .F.
691
692 ELSE
693 *=== TR 1055858 08-Aug-2011 Partha ===
694
695 this.oLog.CloseLog()
696
697 ENDIF && TR 1055858 08-Aug-2011 Partha
698
699
700 *=== TAN 1040791 6/17/2009 AZ
701
702* This.oLog.CloseLog()
703
704 *--- TR 1055858 10-Aug-2011 Partha ---
705 IF llRetVal AND This.lLogStartedFromBatch AND EMPTY(This.cMessage)
706 This.cMessage = "Pick ticket process successfully completed"
707 ENDIF
708 *=== TR 1055858 10-Aug-2011 Partha ===
709
710 RETURN llRetVal
711ENDPROC
712
713************************************************************************************
714* Formular: weight = weight + (total_qty/ Scolr.inr_qty) * Scolr.inr_wgt
715* Calculate total weight for pick header using detail total_qty
716* inr_qty and inr_wgt from zzxscolr.
717************************************************************************************
718PROCEDURE ResolveWeight
719 LPARAMETERS tcHeaderTable, tcDetailTable
720 LOCAL lnOldSelect, lnWeight
721 lnOldSelect = SELECT()
722 lnWeight = 0
723
724 * --- TR 1004686 04/23/04 JN
725 * C5 error. Remove all macro substutions
726 LOCAL lnHeaderPkey
727 SELECT (tcHeaderTable)
728 lnHeaderPkey = pkey
729
730 SELECT (tcDetailTable)
731*!* SCAN FOR fkey = &tcHeaderTable..pkey
732 SCAN FOR fkey = lnHeaderPkey
733 * === TR 1004686 04/23/04 JN
734*!* * got tcXscolr
735*!* *--SAS 02/16/99 ATS 2411. Amend vl_scolr() calls to include Dimen/Pack.
736*!* IF vl_scold(division, "", "tcXscolr", STYLE, color_code, lbl_code, DIMENSION)
737*!* *--<
738*!* * reset inr_qty to 1 if empty otherwise use it value
739*!* lnInr_qty = IIF(EMPTY(tcXscolr.inr_qty), 1, tcXscolr.inr_qty)
740*!* * Accumulate total weight for this pick header
741*!* lnWeight = lnWeight + (Total_qty/lnInr_qty) * tcXscolr.Inr_wgt
742 * ATS# 3188 Get gar_weight from zzxscolr not zzxstylr (F. Longo)
743*!* lnWeight = lnWeight + Total_qty * vl_stylr(division, 'gar_wgt', '', STYLE)
744 lnWeight = lnWeight + Total_qty * vl_scold(division, "gar_wgt", "", STYLE, color_code, lbl_code, DIMENSION)
745*!* EXIT
746*!* ENDIF
747 ENDSCAN
748 * close tcXscolr
749 IF USED('tcXscolr')
750 USE IN tcXscolr
751 ENDIF
752
753*!* lnWeight = ROUND(lnWeight, 0) && TAN 28547 Ask if this is required
754 SELECT (lnOldSelect)
755 RETURN lnWeight
756ENDPROC
757
758*===========================================
759
760PROCEDURE ResolveVolume && ATS 4558
761 LPARAMETERS tcHeaderTable, tcDetailTable
762 LOCAL lnOldSelect, lnVolume
763 lnOldSelect = SELECT()
764 lnVolume = 0
765
766 * --- TR 1004686 04/23/04 JN
767 * C5 error. Remove all macro substutions
768 LOCAL lnHeaderPkey
769 SELECT (tcHeaderTable)
770 lnHeaderPkey = pkey
771
772 SELECT (tcDetailTable)
773*!* SCAN FOR fkey = &tcHeaderTable..pkey
774 SCAN FOR fkey = lnHeaderPkey
775 * === TR 1004686 04/23/04 JN
776 lnVolume = lnVolume + (Total_qty * vl_scold(division, "cubic", "", STYLE, color_code, lbl_code, DIMENSION))
777 ENDSCAN
778
779 * 32811 06/26/02 PL - Pick Tickets listed in notes have no volume.
780 * Blockout round() change ord_volume to have 3 decimal
781 *lnVolume = ROUND(lnVolume, 0) && TAN 28547
782 SELECT (lnOldSelect)
783 RETURN lnVolume
784ENDPROC
785
786************************************************************************************
787* Formula: detailcarton = (total_qty/Scolr.mst_qty)
788* not INT(detailcarton) add 1 to detailcarton ( this allows for overage or less than 1 carton)
789* lncarton = lncarton + detailcarton
790* Calculate total cartons for pick header using detail total_qty/mst_qty from zzxscolr.
791************************************************************************************
792PROCEDURE ResolveCarton
793 LPARAMETERS tcHeaderTable, tcDetailTable
794 LOCAL lnOldSelect, lnCarton, lnDetailCarton
795 lnOldSelect = SELECT()
796 lnCarton = 0
797 lnDetailCarton = 0
798
799 * --- TR 1004686 04/23/04 JN
800 * C5 error. Remove all macro substutions
801 LOCAL lnHeaderPkey
802 SELECT (tcHeaderTable)
803 lnHeaderPkey = pkey
804
805 SELECT (tcDetailTable)
806*!* SCAN FOR fkey = &tcHeaderTable..pkey
807 SCAN FOR fkey = lnHeaderPkey
808 * === TR 1004686 04/23/04 JN
809 * got tcXscolr
810 IF vl_scold(division, "", "tcXscolr", STYLE, color_code, lbl_code, DIMENSION)
811 * Accumulate total cartons for this pick header
812 lnDetailCarton = 0
813 IF tcXscolr.Mst_Qty >0
814 lnDetailCarton = (Total_qty/tcXscolr.Mst_Qty)
815 IF INT(lnDetailCarton ) <> lnDetailCarton
816 lnDetailCarton = lnDetailCarton + 1
817 ENDIF
818 ENDIF
819 lnCarton = lnCarton + INT(lnDetailCarton)
820 ENDIF
821 ENDSCAN
822 * close tcXscolr
823 IF USED('tcXscolr')
824 USE IN tcXscolr
825 ENDIF
826 SELECT (lnOldSelect)
827 RETURN lnCarton
828ENDPROC
829
830************************************************************************************
831* Resolve Shipper
832************************************************************************************
833PROCEDURE ResolveShipper
834 LPARAMETERS tcHeaderTable
835 LOCAL lnSelect
836 LOCAL lcShipper
837 lcShipper = ""
838 * --- TR 1004686 04/23/04 JN
839 * C5 error. Remove all macro substutions
840 lnSelect = SELECT()
841 select (tcHeaderTable)
842 DO CASE
843*!* CASE (&tcHeaderTable..wgt1_lmt>0 OR &tcHeaderTable..crt1_lmt>0 OR &tcHeaderTable..cub1_lmt>0) AND ;
844*!* !(&tcHeaderTable..wgt1_lmt>0 AND &tcHeaderTable..weight> &tcHeaderTable..wgt1_lmt) AND ;
845*!* !(&tcHeaderTable..cub1_lmt>0 AND &tcHeaderTable..ord_volume> &tcHeaderTable..cub1_lmt) AND ;
846*!* !(&tcHeaderTable..crt1_lmt>0 AND &tcHeaderTable..carton> &tcHeaderTable..crt1_lmt)
847*!* lcShipper = &tcHeaderTable..shipper1
848 CASE (wgt1_lmt>0 OR crt1_lmt>0 OR cub1_lmt>0) AND ;
849 !(wgt1_lmt>0 AND weight>wgt1_lmt) AND ;
850 !(cub1_lmt>0 AND ord_volume>cub1_lmt) AND ;
851 !(crt1_lmt>0 AND carton>crt1_lmt)
852 lcShipper = shipper1
853
854*!* CASE (&tcHeaderTable..wgt2_lmt>0 OR &tcHeaderTable..crt2_lmt>0 OR &tcHeaderTable..cub2_lmt>0) AND ;
855*!* !(&tcHeaderTable..wgt2_lmt>0 AND &tcHeaderTable..weight> &tcHeaderTable..wgt2_lmt) AND ;
856*!* !(&tcHeaderTable..cub2_lmt>0 AND &tcHeaderTable..ord_volume> &tcHeaderTable..cub2_lmt) AND ;
857*!* !(&tcHeaderTable..crt2_lmt>0 AND &tcHeaderTable..carton> &tcHeaderTable..crt2_lmt)
858*!* lcShipper = &tcHeaderTable..shipper2
859 CASE (wgt2_lmt>0 OR crt2_lmt>0 OR cub2_lmt>0) AND ;
860 !(wgt2_lmt>0 AND weight>wgt2_lmt) AND ;
861 !(cub2_lmt>0 AND ord_volume>cub2_lmt) AND ;
862 !(crt2_lmt>0 AND carton>crt2_lmt)
863 lcShipper = shipper2
864*!* CASE (wgt3_lmt>0 OR crt3_lmt>0 OR cub3_lmt>0) AND ;
865*!* !(wgt3_lmt>0 AND weight>wgt3_lmt) AND ;
866*!* !(cub3_lmt>0 AND ord_volume>cub3_lmt) AND ;
867*!* !(crt3_lmt>0 AND carton>crt3_lmt)
868*!* lcShipper = shipper3
869 CASE (wgt3_lmt>0 OR crt3_lmt>0 OR cub3_lmt>0) AND ;
870 !(wgt3_lmt>0 AND weight>wgt3_lmt) AND ;
871 !(cub3_lmt>0 AND ord_volume>cub3_lmt) AND ;
872 !(crt3_lmt>0 AND carton>crt3_lmt)
873 lcShipper = shipper3
874*!* CASE (&tcHeaderTable..wgt4_lmt>0 OR &tcHeaderTable..crt4_lmt>0 OR &tcHeaderTable..cub4_lmt>0) AND ;
875*!* !(&tcHeaderTable..wgt4_lmt>0 AND &tcHeaderTable..weight> &tcHeaderTable..wgt4_lmt) AND ;
876*!* !(&tcHeaderTable..cub4_lmt>0 AND &tcHeaderTable..ord_volume> &tcHeaderTable..cub4_lmt) AND ;
877*!* !(&tcHeaderTable..crt4_lmt>0 AND &tcHeaderTable..carton> &tcHeaderTable..crt4_lmt)
878*!* lcShipper = &tcHeaderTable..shipper4
879 CASE (wgt4_lmt>0 OR crt4_lmt>0 OR cub4_lmt>0) AND ;
880 !(wgt4_lmt>0 AND weight> wgt4_lmt) AND ;
881 !(cub4_lmt>0 AND ord_volume> cub4_lmt) AND ;
882 !(crt4_lmt>0 AND carton> crt4_lmt)
883 lcShipper = shipper4
884 OTHERWISE
885 lcShipper = shipper5
886 ENDCASE
887
888 SELECT (lnSelect)
889 * === TR 1004686 04/23/04 JN
890 RETURN lcShipper
891ENDPROC
892
893************************************************************************************
894* Resolve ShipThru
895************************************************************************************
896PROCEDURE ResolveShipThru
897 LPARAMETERS tcHeaderTable, poPickHeader
898 LOCAL llRetVal, lnOldSelect, lcShip_dc, lcCenter_code, lcConsol_code, lcShipThru
899 LOCAL lnSelect
900 llRetVal = .T.
901 * --- TR 1004686 04/23/04 JN
902 * C5 error. Remove all macro substutions
903 * NB: This will work because each vl_ call ends with a v_sqlprep which restores
904 * the workarea so tcHeaderTable will always be the selected table
905 * until we exit this procedure.
906 lnSelect = SELECT()
907 SELECT(tcHeaderTable)
908 * get Ship_dc from zzxstorr
909*!* lcShip_dc = vl_storr( &tcHeaderTable..customer, "ship_dc", "TcXstorr", ;
910*!* &tcHeaderTable..STORE)
911 lcShip_dc = vl_storr( customer, "ship_dc", "TcXstorr", STORE)
912 * === TR 1004686 04/23/04 JN
913
914 * got store ref record
915 IF RECC("TcXstorr") > 0
916 lcShip_dc = tcXstorr.ship_dc
917 lcCenter_code = ""
918 lcConsol_code = ""
919 DO CASE
920 * distributor
921 CASE lcShip_dc = "D"
922 lcCenter_code = tcXstorr.center_code
923 * consolidator
924 CASE lcShip_dc = "C"
925 lcConsol_code = tcXstorr.consol_code
926 * blank or "B"oth distrib/consol
927
928 * PL ATS 2561- get dist/cons from store. Block resolution of OTHERWISE
929 CASE lcShip_dc = "B"
930 lcConsol_code = tcXstorr.consol_code
931 lcCenter_code = tcXstorr.center_code
932
933 OTHERWISE
934 * resolve for Ship-Thru code from zztconsr (consolidation instruction ref)
935 *--- TAN 34246 Ilya: Use vl_consol() that will account for Department field
936* Ilya--- lcShipThru = vl_consl( &tcHeaderTable..customer, &tcHeaderTable..location, ;
937* Ilya--- &tcHeaderTable..store, &tcHeaderTable..division, 'tmpConsr' )
938 * --- TR 1004686 04/23/04 JN
939*!* lcShipThru = vl_consol( &tcHeaderTable..customer, &tcHeaderTable..location, ;
940*!* &tcHeaderTable..store, &tcHeaderTable..department, ;
941*!* &tcHeaderTable..division, 'tmpConsr' )
942 lcShipThru = vl_consol( customer, location, ;
943 store, department, ;
944 division, 'tmpConsr' )
945 * === TR 1004686 04/23/04 JN
946 *=== TAN 34246 Ilya:
947 * got Ship-Thru
948 If RECC('tmpConsr') > 0
949 * check for Ship-Thru type in zzxdistr ("D","C")
950 lcShip_dc = tmpConsr.ship_dc
951 lcCenter_code = tmpConsr.center_code
952 lcConsol_code = tmpConsr.consol_code
953 Use In ('TmpConsr')
954 Endif
955
956 ENDCASE
957
958 * TAN 28852 - Remove this logic, as this overrides any user changes to these fields.
959 * write Ship-Thru info to pick header
960* IF !EMPTY(lcShip_dc)
961* poPickHeader.ship_dc = lcShip_dc
962* poPickHeader.center_code = lcCenter_code
963* poPickHeader.consol_code = lcConsol_code
964* ENDIF
965
966 *--- TAN 34246: Resolve for new records only (ack_prn ='N')
967 IF poPickHeader.ack_prn == 'N'
968 poPickHeader.ship_dc = lcShip_dc
969 poPickHeader.center_code = lcCenter_code
970 poPickHeader.consol_code = lcConsol_code
971 ENDIF
972 *=== TAN 34246 Ilya.
973 ENDIF
974 SELECT(lnSelect)
975 * === TR 1004686 04/23/04 JN
976 RETURN llRetVal
977ENDPROC
978
979************************************************************************************
980* Resolve ShipTo
981************************************************************************************
982PROCEDURE ResolveShip_To
983 LPARAMETERS tcHeaderTable
984 LOCAL lcShip_to
985 LOCAL lnSelect
986 lcShip_to = ""
987
988 * --- TR 1004686 04/23/04 JN
989 * C5 error. Remove all macro substutions
990 * NB: This will work because each vl_ call ends with a v_sqlprep which restores
991 * the workarea so tcHeaderTable will always be the selected table
992 * until we exit this procedure.
993 lnSelect = SELECT()
994 SELECT (tcHeaderTable)
995*!* lcShip_to = IIF(&tcHeaderTable..ship_dc = "D", &tcHeaderTable..center_code, ;
996*!* &tcHeaderTable..consol_code)
997 lcShip_to = IIF(ship_dc = "D", center_code, consol_code)
998 * PL ATS 4937-JSSI- Pick Process routing resolution using shipto
999 * since we no longer using ResolveRouting with store, have to default store into
1000 * lcShip_to before overwrite with either center_code or consol_code
1001*!* lcShip_to = iif(empty(lcShip_to), &tcHeaderTable..store, lcShip_to)
1002 lcShip_to = iif(empty(lcShip_to), store, lcShip_to)
1003 SELECT(lnSelect)
1004 * === TR 1004686 04/23/04 JN
1005 RETURN lcShip_to
1006ENDPROC
1007
1008************************************************************************************
1009* Resolve Routing
1010************************************************************************************
1011PROCEDURE ResolveRouting
1012 LPARAMETERS tcHeaderTable
1013 LOCAL llRetVal, lnOldSelect, lnMani_num , lcPreviousDivision , lcShipper
1014 llRetVal = .T.
1015 lnOldSelect = SELECT()
1016 * find empty Shipper consolidate by division, customer, store, department, location, ship_to
1017 * to resolve shipper using vl_route()
1018 * ATS 4937, remove store.
1019 * TAN38249 03/26/03 MP Modify the SQL to create a blank division and aggregate across it.
1020 IF goEnv.sv('CONSOL_ROUT_ACROSS_DIV', 'N') = 'Y'
1021 SELECT ' ' as division, customer, department, location, Ship_to, COUNT(*), ;
1022 SUM(carton) carton, SUM(weight) weight, SUM(ord_volume) ord_volume, ship_dc,center_code,consol_code,shipper1,;
1023 shipper2,shipper3,shipper4,shipper5,wgt1_lmt,wgt2_lmt,wgt3_lmt,wgt4_lmt,;
1024 crt1_lmt,crt2_lmt,crt3_lmt,crt4_lmt,cub1_lmt,cub2_lmt,cub3_lmt,cub4_lmt ;
1025 FROM (tcHeaderTable) WHERE EMPTY(shipper) ;
1026 INTO CURSOR __PckTmp GROUP BY 1,2,3,4,5
1027 ELSE
1028 SELECT division, customer, department, location, Ship_to, COUNT(*), ;
1029 SUM(carton) carton, SUM(weight) weight, SUM(ord_volume) ord_volume, ship_dc,center_code,consol_code,shipper1,;
1030 shipper2,shipper3,shipper4,shipper5,wgt1_lmt,wgt2_lmt,wgt3_lmt,wgt4_lmt,;
1031 crt1_lmt,crt2_lmt,crt3_lmt,crt4_lmt,cub1_lmt,cub2_lmt,cub3_lmt,cub4_lmt ;
1032 FROM (tcHeaderTable) WHERE EMPTY(shipper) ;
1033 INTO CURSOR __PckTmp GROUP BY 1,2,3,4,5
1034 ENDIF
1035
1036 * turn __PckTmp (readonly) to __PckWrk (Writable)
1037 THIS.MakeCursorWritable("__PckTmp", "__PckWrk")
1038
1039 lnMani_num = 0
1040 lcPreviousDivision = ""
1041 lcShipper = ""
1042
1043 * Init Thermometer
1044 THIS.InitThermo(RECC('__PckWrk'))
1045 l_nThermoCnt = 0
1046
1047 SELECT __PckWrk
1048 SCAN
1049 * Advance progress bar, if we're using one.
1050 l_nThermoCnt = l_nThermoCnt + 1
1051 THIS.AdvanceThermo(l_nThermoCnt)
1052 * get manifest number if division change
1053 IF !(lcPreviousDivision == division)
1054 lcPreviousDivision = division
1055 lnMani_num = v_NextControlNum("ZZOCNTRC", "MANI_NUM", division)
1056 ENDIF
1057 * resolve routing (passing proper parameter for pick process)
1058 * ATS 4937, remove store.
1059 vl_route(customer, location, division, department ,,,, ;
1060 "__PckWrk", .T., Ship_to)
1061 * resolve shipper
1062 lcShipper= THIS.ResolveShipper("__PckWrk")
1063 * Update Mani_num and Shipper in "tcOpckwH"
1064 * TAN38249 03/26/03 MP Modify the SQL to create a blank division and aggregate across it.
1065 IF goEnv.sv('CONSOL_ROUT_ACROSS_DIV', 'N') = 'Y'
1066 REPLACE Mani_num WITH lnMani_num, ;
1067 shipper WITH lcShipper ; && just resolve with info in vl_route() and ResolveShipper
1068 FOR customer = __PckWrk.customer AND ;
1069 department = __PckWrk.department AND ; && STORE = __PckWrk.STORE AND ATS 4937, remove store.
1070 location = __PckWrk.location AND Ship_to = __PckWrk.Ship_to AND ;
1071 EMPTY(shipper) ;
1072 IN (tcHeaderTable)
1073 ELSE
1074 REPLACE Mani_num WITH lnMani_num, ;
1075 shipper WITH lcShipper ; && just resolve with info in vl_route() and ResolveShipper
1076 FOR division = __PckWrk.division AND customer = __PckWrk.customer AND ;
1077 department = __PckWrk.department AND ; && STORE = __PckWrk.STORE AND ATS 4937, remove store.
1078 location = __PckWrk.location AND Ship_to = __PckWrk.Ship_to AND ;
1079 EMPTY(shipper) ;
1080 IN (tcHeaderTable)
1081 ENDIF
1082
1083 ENDSCAN
1084 * Reset Thermometer
1085 THIS.ResetThermo()
1086 SELECT(lnOldSelect)
1087 RETURN llRetVal
1088 ENDPROC
1089
1090
1091 ************************************************************************************
1092 *
1093 ************************************************************************************
1094PROCEDURE CreateAndResolvePick
1095 LPARAMETERS tcSourceHeader, tcSourceDetail, tcTargetHeader, tcTargetDetail
1096 LOCAL llRetVal, lnOldSelect, loPickHeader, lcShip_to, ;
1097 lcUpd_Pick, llUpd_Pick && Added lcUpd_Pick, llUpd_Pick in TR 1014691 09/Jan/2006 SK
1098
1099 llRetVal = .T.
1100 lnOldSelect = SELECT()
1101 * Init Thermometer
1102 THIS.InitThermo(RECC(tcSourceHeader))
1103 l_nThermoCnt = 0
1104
1105 *--- TR 1014691 09/Jan/2006 SK
1106 lcUpd_Pick = vl_compr(,"Upd_Pick")
1107 llUpd_Pick = (lcUpd_Pick = "Y")
1108 *=== TR 1014691 09/Jan/2006 SK
1109
1110 SELECT (tcSourceHeader)
1111 SCAN
1112 * 01/13/00 PL ATS 3439- Pick Process - Routing Resolution bug
1113 * Reset lcShip_to for each Pick header
1114 lcShip_to= ""
1115
1116 * Advance progress bar, if we're using one.
1117 l_nThermoCnt = l_nThermoCnt + 1
1118 THIS.AdvanceThermo(l_nThermoCnt)
1119
1120 SCATTER NAME loPickHeader
1121 WITH THIS
1122 * Only Resolve Weight if it still Empty
1123 IF EMPTY(loPickHeader.weight) AND llUpd_Pick && Added AND llUpd_Pick in TR 1014691 09/Jan/2006 SK
1124 loPickHeader.weight = .ResolveWeight("Vzzopckrh", "Vzzopckrd")
1125 ENDIF
1126 * Only Resolve Volume if it's still empty
1127 IF EMPTY(loPickHeader.ord_volume) AND llUpd_Pick && Added AND llUpd_Pick in TR 1014691 09/Jan/2006 SK
1128 loPickHeader.ord_volume = .ResolveVolume("Vzzopckrh", "Vzzopckrd") && ATS 4558
1129 ENDIF
1130 * Only Resolve Carton if it still Empty ATS# 3139 10/28/1999 Frank Longo
1131 IF EMPTY(loPickHeader.carton) AND llUpd_Pick && Added AND llUpd_Pick in TR 1014691 09/Jan/2006 SK
1132 loPickHeader.carton = .ResolveCarton("Vzzopckrh", "Vzzopckrd")
1133 ENDIF
1134 * Only Resolve Shipper if it still Empty
1135 * 01/18/01 JT ATS 4936, no shipper1-5, wgt1-4, crt1-4 and cub1-4 in header anymore.
1136*!* IF EMPTY(loPickHeader.shipper)
1137*!* loPickHeader.shipper= .ResolveShipper("Vzzopckrh")
1138*!* ENDIF
1139 * End ATS 4936
1140 * Only Resolve ShipThru if Empty(ship_dc) and HAVE store
1141
1142 *--- TR 1029331 20-DEC-2007 VKK Added If conditon This.lPickProcessSkipRout
1143* IF (EMPTY(loPickHeader.ship_dc) AND !EMPTY(loPickHeader.STORE))
1144 IF NOT .lPickProcessSkipRout AND (EMPTY(loPickHeader.ship_dc) AND !EMPTY(loPickHeader.STORE))
1145 *=== TR 1029331 20-DEC-2007 VKK
1146 .ResolveShipThru("Vzzopckrh", loPickHeader)
1147 ENDIF
1148
1149* TAN 27229 Routing Resolution is not recognizing a "Blank"
1150* location code in the Routing Ref hierachy.
1151* Was not populating Ship To for Direct To store at Divatex
1152
1153 * Only Resolve Ship_To if it still NOT (Empty ship_dc or store)
1154* IF !(EMPTY(loPickHeader.ship_dc) OR EMPTY(loPickHeader.STORE) )
1155 lcShip_to= .ResolveShip_To("Vzzopckrh")
1156* ENDIF
1157 * create work pick header
1158 SELECT (tcTargetHeader)
1159 APPEND BLANK
1160 GATHER NAME loPickHeader
1161 IF !EMPTY(lcShip_to)
1162 REPLACE Ship_to WITH lcShip_to IN (tcTargetHeader)
1163 ENDIF
1164 ENDWITH
1165 ENDSCAN
1166 * Reset Thermometer
1167 THIS.ResetThermo()
1168 SELECT(lnOldSelect)
1169 RETURN llRetVal
1170ENDPROC
1171
1172************************************************************************************
1173* Update all pick headers
1174************************************************************************************
1175PROCEDURE UpdatePick
1176 LPARAMETERS tcSourceTable, tcTargetTable
1177 LOCAL llRetVal, lnOldSelect, lnSourcePkey
1178 llRetVal = .T.
1179 lnOldSelect= SELECT()
1180 SELECT (tcSourceTable)
1181 * --- TR 1004686 04/23/04 JN
1182 LOCAL lnMani_num, lnWeigth, lnOrd_volume, lnCarton
1183 LOCAL lcShipper, lcShip_dc, lcCenter_code, lcConsol_code
1184 SCAN
1185 lnMani_num = Mani_num
1186 lnWeight = Weight
1187 lnOrd_Volume = Ord_Volume
1188 lnCarton = Carton
1189 lcShipper = Shipper
1190 lcShip_dc = Ship_dc
1191 lcCenter_code = Center_code
1192 lcConsol_code = Consol_code
1193 lnSourcePkey = Pkey
1194 SELECT (tcTargetTable)
1195*!* LOCATE FOR pkey = &tcSourceTable..pkey
1196 LOCATE FOR pkey = lnSourcePkey
1197 IF FOUND()
1198*!* REPLACE Mani_num WITH &tcSourceTable..Mani_num, ;
1199*!* weight WITH &tcSourceTable..weight, ord_volume WITH &tcSourceTable..ord_volume, ;
1200*!* shipper WITH &tcSourceTable..shipper, ship_dc WITH &tcSourceTable..ship_dc, ;
1201*!* center_code WITH &tcSourceTable..center_code, consol_code WITH &tcSourceTable..consol_code, ;
1202*!* ack_prn WITH "P", carton WITH &tcSourceTable..carton ;
1203*!* IN (tcTargetTable)
1204 REPLACE Mani_num WITH lnMani_num, ;
1205 weight WITH lnweight, ord_volume WITH lnord_volume, ;
1206 shipper WITH lcshipper, ship_dc WITH lcship_dc, ;
1207 center_code WITH lccenter_code, consol_code WITH lcconsol_code, ;
1208 ack_prn WITH "P", ;
1209 carton WITH lncarton ;
1210 IN (tcTargetTable)
1211 ENDIF
1212 * NB: This will work because in VFP 6 the scan will always return to the workarea
1213 * it started in.
1214 * === TR 1004686 04/23/04 JN
1215 ENDSCAN
1216 SELECT(lnOldSelect)
1217 RETURN llRetVal
1218ENDPROC
1219
1220************************************************************************************
1221* print pick tickets, registers and reports
1222* Parameters:
1223* 1- Pick Header table
1224* 2- Pick detail table
1225* 3- plNoScreenUI (for allocation process just pass .T. will skip PrintDialogWithFRXName()
1226************************************************************************************
1227PROCEDURE PrintPickTicketsAndReports
1228 LPARAMETERS tcPickHeaderTable, tcPickHeaderWorkTable, tcPickDetaiWorklTable, plNoScreenUI
1229 LOCAL llRetVal, lnOldSelect, lcSQLOrderString, lcDefaultSQLOrderString, lcCustomSQLOrderString, ;
1230 lcPrint_Form_Vers, lcSQLExec, lcTable, lcWhereStr, lcAndStr, lcPKeyList, lcLocation && TR 1040748
1231
1232 LOCAL lcSuppress , llSuppress && TR 1008293
1233
1234 *--- TR 1012971 02/16/06 TK
1235 LOCAL llPrintonlyPickWithComments, lcCommentsJoin
1236 lcCommentsJoin = ""
1237 *=== TR 1012971 02/16/06 TK
1238
1239 llRetVal = .T.
1240
1241 *--- TR 1025698 13-Aug-2007 Goutam
1242 LOCAL lcParmName
1243 lcParmName = .RetrieveParmName()
1244 *=== TR 1025698 13-Aug-2007 Goutam
1245
1246 *ATS# 4116 Create File Sorted Cursor Based On ZZXPARMR if it exists
1247 lcDefaultSQLOrderString = "division, location, pick_num, line_seq "
1248
1249 *--- TR 1025698 13-Aug-2007 Goutam
1250 *lcCustomSQLOrderString = ALLTRIM(vl_parmr("ZZOSRTPK", 'parm_value'))
1251 lcCustomSQLOrderString = ALLTRIM(vl_parmr("ZZOSRTPK", 'parm_value',,lcParmName))
1252
1253 IF NOT EMPTY(lcParmName) AND EMPTY(lcCustomSQLOrderString)
1254 .cMessage = "Invalid Parameter BRO. Unable to continue."
1255 llRetVal = .F.
1256 ENDIF
1257 *=== TR 1025698 13-Aug-2007 Goutam
1258
1259 *--- TR 1033483 - BD - 10/22/08 - Validate Parameter BRO WHS_PICK_TICKET_SORT_DETAIL
1260 *--- The value of the sort will not be handled in this process: the custom form will itself use the value of this sort
1261 LOCAL lcWHSDetailSort
1262 lcParmName = .RetrieveParmNameWHSSort()
1263
1264 *--- TR 1025698 13-Aug-2007 Goutam
1265 lcWHSDetailSort = ALLTRIM(vl_parmr("ZZOSRTPW", 'parm_value',,lcParmName))
1266
1267 IF NOT EMPTY(lcParmName) AND EMPTY(lcWHSDetailSort)
1268 .cMessage = "Invalid Parameter BRO. Unable to continue."
1269 llRetVal = .F.
1270 ENDIF
1271 *=== TR 1033483 - BD - 10/22/08
1272
1273 lcSQLOrderString = IIF(!Empty(lcCustomSQLOrderString), " Order By " + lcCustomSQLOrderString, " Order By " + lcDefaultSQLOrderString)
1274
1275 WITH THIS
1276 * prepare work table (ack_prn = "P" at this point in both tcPickHeaderTable, and
1277 * tcPickHeaderWorkTable)
1278 .AdvanceThermoTotal(1)
1279 .UpdateThermoCaption("Prepare work tables for Pick Tickets print...")
1280 .PreparePickWorkTable(tcPickHeaderWorkTable, tcPickDetaiWorklTable, "tcPickWk" )
1281
1282 * 38185 3/31/03 CB - remove vl calls from reports.
1283 * Above procedure combined header and detail into one cursor, 'tcPickWk'.
1284 * Modify the above cursor to contain fields we added to the cursor prior to
1285 * printing the report (see Prt_Form.PrintFormVers for more details).
1286 IF !("PRT_FORM" $ UPPER(SET("PROCEDURE")))
1287 SET PROCEDURE TO Prt_Form ADDITIVE
1288 ENDIF
1289
1290 *--- TR 1012971 02/16/06 TK
1291 llPrintonlyPickWithComments = (goenv.sv("PRT_ONLY_PICK_WITH_COMMENTS", "") == "Y")
1292
1293 lcCommentsCondition = ""
1294
1295 *--- TR 1025698 29-Aug-2007 Goutam
1296 *IF llPrintonlyPickWithComments
1297 IF llPrintonlyPickWithComments AND llRetVal
1298 *=== TR 1025698 29-Aug-2007 Goutam
1299
1300 lcCommentsCondition = " AND EXISTS " + ;
1301 "(SELECT TOP 1 cmt_code FROM zzxccmtr where customer = h.customer " + ;
1302 "AND (cmt_code = 'A' OR cmt_code = 'P') " + ;
1303 "UNION " + ;
1304 "select TOP 1 cmt_code from zzxscmtr where customer = h.customer AND store = h.store AND " +;
1305 "(cmt_code = 'A' or cmt_code = 'P') " +;
1306 "UNION " + ;
1307 "SELECT TOP 1 cmt_Code FROM zzoordcd where ord_num = h.ord_num " +;
1308 "AND (cmt_code = 'A' OR cmt_code = 'P'))"
1309
1310 ENDIF
1311 *=== TR 1012971 02/16/06 TK
1312
1313 lcPrint_Form_Vers = goenv.sv("PRT_FORM_VERSION","")
1314
1315 *--- TechRec 1040748 16-Jul-2009 MPerel --- keep records not going to be printed out of the print cursor.
1316 llRetVal = v_SQLExec("SELECT * FROM zzxlocar WHERE active_ok = 'Y' and loc_type = 'W' and supp_picktix = 'Y'", "LocarCursor")
1317 SELECT LocarCursor
1318 INDEX ON Loc_Name TAG Loc_Name
1319 *=== TechRec 1040748 16-Jul-2009 MPerel ===
1320
1321 *--- TR 1025698 29-Aug-2007 Goutam
1322 *IF ALLTRIM(lcPrint_Form_Vers) == "2.0.0"
1323 IF ALLTRIM(lcPrint_Form_Vers) == "2.0.0" AND llRetVal
1324 *=== TR 1025698 29-Aug-2007 Goutam
1325
1326 * Join tables in tcPickW2 with other tables to eliminate vl calls in report.
1327 * We're doing all work up front, before calling the report.
1328 lcWhereStr= " where h.pkey = d.fkey and d.line_status = 'P'" + " and d.total_qty > 0 "
1329 lcTable= " FROM zzoordrh h JOIN zzoordrd d ON h.pkey = d.fkey"
1330
1331 * Create comma delimited list of header pkeys to print. Can't use same criteria
1332 * sent to this process, since process has overwritten some of the fields in
1333 * that criteria (e.g. ack_prn).
1334 Select Vzzopckrh
1335 * ---- 40700 CB - Changed logic of building PKey list to account for error when no
1336 * records were returned, and it chopped off the closing parenthesis.
1337 lcPKeyList = ""
1338 SCAN
1339 *--- TechRec 1040748 16-Jul-2009 MPerel --- wrap the line within a IF NOT SEEK()
1340 lcLocation = location
1341 IF NOT SEEK(lcLocation,'LocarCursor','Loc_Name')
1342 lcPKeyList = lcPKeyList + Alltrim(Str(Vzzopckrh.pkey)) + ","
1343 ENDIF
1344 *=== TechRec 1040748 16-Jul-2009 MPerel ===
1345* lcPKeyList = lcPKeyList + Alltrim(Str(Vzzopckrh.pkey)) + ","
1346 ENDSCAN
1347
1348 *--- TAN 41275 LH 7/28/03
1349 lcPKeyList = This.RemoveLastDelimiter(lcPKeyList, ",")
1350 lcAndStr = IIF(Empty(lcPKeyList), " AND 1=2 ", " AND h.PKey in (" + lcPKeyList + ")")
1351
1352 *!*lcAndStr = IIF(Empty(lcPKeyList), " AND 1=2 ", " AND PKey in (" + lcPKeyList + ")")
1353 * ==== 40700
1354 *=== TAN 41275 LH 7/28/03
1355
1356 *--- TR 1012971 02/20/06 TK
1357 lcAndStr = lcAndStr + lcCommentsCondition
1358 *=== TR 1012971 02/20/06 TK
1359
1360 lcSQLExec = PrintFormVers(lcPrint_Form_Vers, '', '', lcTable, lcWhereStr, lcAndStr, 'P')
1361
1362 llRetVal = llRetVal AND v_SQLExec(lcSQLExec, 'tcPickW2')
1363 *--- TR 1011499 Jun-26-05 HC
1364 If !llRetVal
1365 .cMessage = "Unable to retrieve data."
1366 *--- TechRec 1035699 04-Sep-2008 MA ===
1367 This.oLog.LogEntry(.cMessage)
1368 ELSE
1369 *=== TR 1011499 Jun-26-05 HC
1370* MakeCursorWritable('tcPickW2', 'tcPickWk')
1371
1372 Public vMaxBuckets
1373 *- FormStartup() Creates some public variables used by Fmt_Sizc()
1374
1375 * --- 37471 18-April-2003 BD: Change call to FormStartup last parameter=5 instead of 3
1376 *FormStartUp(1, 2, 'PICK_FORM', 'zzocntrc', Division, 3) <-- OLD CODE
1377 FormStartUp(1, 2, 'PICK_FORM', 'zzocntrc', Division, 5)
1378 * === 37471 18-April-2003 BD
1379
1380
1381 * Do replaces on those fields which weren't determined by JOINs:
1382 Local lnPick_Num, lcShip_Name, lcFmt_Comments, lcFmt_Unit, lcFmt_Divs, ;
1383 lcSFmt_ARes, lcFmt_Sizc, lcFmt_Descs, lcTomm_Comm, lcMFmt_ARes, ;
1384 llRunningOnTomm
1385
1386 lnPick_Num = 0
1387 Select tcPickW2
1388
1389 * ---- 40700 CB 7/18/03 - Fixed "IIF("CUSTOM_TOMM" $ SET("PROCEDURE")" mistake.
1390 * Added lookup of sitecode from control.ini.
1391 llRunningOnTomm = goEnv.SV('control_global_sitecode', "") = "BAHAM"
1392 * ==== 40700
1393
1394 Scan
1395 If Pick_Num <> lnPick_Num
1396 * We only need to do the call once per pick_num, then replace
1397 * remaining lines with values obtained on first call.
1398 lnPick_Num = Pick_Num
1399
1400 lcShip_Name = ;
1401 IIF (Empty(Shipper), ;
1402 vl_Shipr(vl_Routr(Customer, 'Shipper1', '', Location, Division, ;
1403 Department, Store),;
1404 'Ship_Name'), vl_Shipr(Shipper,'Ship_Name'))
1405 lcFmt_Comments = Fmt_Comments(Ord_Num, 'I', Customer, Store)
1406 *--- TR 1006286 - 07/29/05 - BD - lcFmt_Unit is detail level; it should be recalculated for every detail record!
1407 *lcFmt_Unit = Fmt_Unit(Ord_Num, Line_Seq, 6)
1408 *=== TR 1006286
1409 lcFmt_Divs = Fmt_Divs(Division, .F.)
1410 lcSFmt_ARes = Fmt_ARes(Customer, '', '', Store, Ship_DC, ;
1411 Center_Code, Consol_Code, Ord_Num, 'S', Division, Factor, Location)
1412 lcFmt_Sizc = Fmt_Sizc(FKey, 6, 4, 'B', 4)
1413 *--- TR 1006286 - 07/29/05 - BD - lcFmt_Descs is detail level; it should be recalculated for every detail record!
1414 *lcFmt_Descs = Fmt_Descriptions(Division, Style, Color_Code, ;
1415 * Dimension, Lbl_Code, Customer)
1416 *=== TR 1006286
1417
1418 * ---- 40700 CB 7/18/03 - Fixed "IIF("CUSTOM_TOMM" $ SET("PROCEDURE")" mistake.
1419 lcTomm_Comm = IIF(llRunningOnTomm, GetCommentPK_TOMM(Customer, Store, Ord_Num), "")
1420 * ==== 40700
1421
1422 lcMFmt_ARes = Fmt_ARes(Customer, '', '', Store, Ship_DC, ;
1423 Center_Code, Consol_Code, Ord_Num, 'M', Division, Factor, Location)
1424 EndIf
1425
1426 *--- TR 1006286 - 07/29/05 - BD - lcFmt_Unit and lcFmt_Descs are detail level; they should
1427 *--- be recalculated for every detail record!
1428 lcFmt_Unit = Fmt_Unit(Ord_Num, Line_Seq, 6)
1429 lcFmt_Descs = Fmt_Descriptions(Division, Style, Color_Code,Dimension,Lbl_Code,Customer)
1430 *=== TR 1006286
1431
1432 REPLACE ;
1433 Ship_Name WITH lcShip_Name, ;
1434 Fmt_Comments WITH lcFmt_Comments, ;
1435 Fmt_Unit WITH lcFmt_Unit, ;
1436 Fmt_Divs WITH lcFmt_Divs, ;
1437 SFmt_ARes WITH lcSFmt_ARes, ;
1438 Fmt_Sizc WITH lcFmt_Sizc, ;
1439 Fmt_Descs WITH lcFmt_Descs, ;
1440 Tomm_Comm WITH lcTomm_Comm, ;
1441 MFmt_ARes WITH lcMFmt_ARes ;
1442 in tcPickW2
1443 EndScan
1444 ENDIF
1445 EndIf
1446
1447 lcTableName = IIF(ALLTRIM(lcPrint_Form_Vers) == "2.0.0", "tcPickW2", "tcPickWk")
1448
1449 * replace server pick header with "R" before printing
1450 .AdvanceThermoTotal(1)
1451 .UpdateThermoCaption("Stamping all Pick Tickets with 'R'...")
1452
1453 *--- TechRec 1035699 04-Sep-2008 MA ===
1454 This.oLog.LogEntry("Stamping all Pick Tickets with 'R'...")
1455
1456 *--- TR 1025698 29-Aug-2007 Goutam
1457 *llRetVal = .ValidateSuppressPixPrint() && --- TR 1018015 14-Jul-2006 Goutam Line added here taken from the below
1458 llRetVal = llRetVal and .ValidateSuppressPixPrint() && --- TR 1018015 14-Jul-2006 Goutam Line added here taken from the below
1459 *=== TR 1025698 29-Aug-2007 Goutam
1460
1461 If llRetVal
1462 *--- TR 1011499 Jun-26-05 HC
1463*!* .StampPickAsPrinted(tcPickHeaderTable)
1464 *--- TR 1018015 14-Jul-2006 Goutam
1465
1466 *--- TR 1057009 NSD 10/4/11 - Added new parameter to update print flag regardless. This logic to not update print flag is flawed but need to maintain for backwards functionality
1467 IF (goEnv.SV("PICKPROCESS_FORCEUPDATE_PRINTFLAG","N")=="Y") ;
1468 OR ((EMPTY(.cParamFilter) AND goEnv.SV("SUPPRESS_PICK_TIX_PRINT", "N") <> "Y") OR (.cParamFilter = "N"))
1469 llretval = .StampPickAsPrinted(tcPickHeaderTable)
1470 ENDIF
1471 *=== TR 1057009 NSD 10/4/11
1472
1473 *llretval = .StampPickAsPrinted(tcPickHeaderTable)
1474 *=== TR 1018015 14-Jul-2006 Goutam
1475
1476 *--- TR 1011499 Jun-26-05 HC
1477 IF !llretval
1478 .cMessage = "Update Conflict. Unable to continue."
1479 *--- TechRec 1035699 04-Sep-2008 MA ===
1480 This.oLog.LogEntry(.cMessage)
1481 ENDIF
1482 *=== TR 1011499 Jun-26-05 HC
1483 *=== TR 1011499 Jun-26-05 HC
1484 EndIf
1485 * print pick tickets
1486 .AdvanceThermoTotal(1)
1487 .UpdateThermoCaption("Printing Pick Tickets...")
1488 *--- TechRec 1035699 04-Sep-2008 MA ===
1489 This.oLog.LogEntry("Printing Pick Tickets...")
1490
1491 *--SAS 12/09/98 ATS 1529. Combine document print & reprint into a single process.
1492 lnOldSelect = SELECT()
1493 SELECT(lnOldSelect)
1494
1495 *--- TR 1013989 - BD - 12/21/05
1496 *- Remove form_ID from the sort order (when "ACTIVATE_FORM_BREAK_BUILDER"='Y' form_ID may exist in sort);
1497 *- at this point, form_id field does not exist yet in the cursor! Form_ID field is added in cursor
1498 *- by PrintDocument( ) (CLSSLSOP.PRG)
1499 *- Remove spaces around commas
1500 DO WHILE " ," $ lcSQLOrderString
1501 lcSQLOrderString = STRTRAN(lcSQLOrderString, " ,", ",")
1502 ENDDO
1503 DO WHILE ", " $ lcSQLOrderString
1504 lcSQLOrderString = STRTRAN(lcSQLOrderString, ", ", ",")
1505 ENDDO
1506 lcSQLOrderString=STRTRAN(UPPER(lcSQLOrderString),"FORM_ID,","")
1507 lcSQLOrderString=STRTRAN(UPPER(lcSQLOrderString),",FORM_ID","")
1508 *=== TR 1013989
1509
1510 *ATS# 4116 Create File Sorted Cursor Based On ZZXPARMR if it exists
1511 If llRetVal
1512 .ApplyCustomSort(lcTableName, "tcPickSrt", lcSQLOrderString, 'P')
1513 EndIf
1514
1515
1516 * --- TAN 40587 RLN 06/23/03 - Flag drive suppression of Print Ticket Printing (for Amerex)
1517
1518 *--- TR 1015923 23-Mar-2006 Goutam
1519
1520 *llRetVal = .ValidateSuppressPixPrint() &&--- TR 1018015 14-Jul-2006 Goutam Line delated and put in above
1521
1522 *IF llRetVal AND goEnv.SV("SUPPRESS_PICK_TIX_PRINT", "N") <> "Y"
1523 IF llRetVal AND ;
1524 ((EMPTY(.cParamFilter) AND goEnv.SV("SUPPRESS_PICK_TIX_PRINT", "N") <> "Y") OR (.cParamFilter = "N"))
1525 *=== TR 1015923 23-Mar-2006 Goutam
1526
1527 * === TAN 40587
1528
1529 *--- TR 1008293 DSK
1530 lcSuppress = VL_LOCAR(location,'Supp_picktix')
1531 llSuppress = (lcSuppress <> 'Y')
1532 *llRetVal = llRetVal AND .PrintDocument("tcPickSrt",'tcprinter', "P", .cPrintDialogResponse, .F., plNoScreenUI, lcSQLOrderString)
1533 If llSuppress
1534 llRetVal = .PrintDocument("tcPickSrt",'tcprinter', "P", .cPrintDialogResponse, .F., plNoScreenUI, lcSQLOrderString)
1535*--- TAN 1012736 08/24/05 AZ Added IF/ENDIF
1536 IF !llRetVal
1537 .cMessage = "Unable to print document."
1538 *--- TechRec 1035699 04-Sep-2008 MA ===
1539 This.oLog.LogEntry(.cMessage)
1540 ENDIF
1541*=== TAN 1012736 08/24/05 AZ
1542 EndIf
1543 *=== TR 1008293 DSK
1544
1545 ENDIF && === TAN 40587
1546
1547 ENDWITH
1548 RETURN llRetVal
1549ENDPROC
1550
1551************************************************************************************
1552* combine pick header/detail to create pick work
1553* Parameters:
1554* 1- Pick Header work table
1555* 2- Pick detail work table
1556* 3- Pick work table
1557************************************************************************************
1558 PROCEDURE PreparePickWorkTable
1559 LPARAMETERS tcHeaderTable, tcDetailTable, tcPickWorkTable
1560 LOCAL llRetVal, lnOldSelect, lnHeaderPkey, lcOrder && TR1040748 16-Jul-2009 MPerel
1561 llRetVal = .T.
1562 lnOldSelect = SELECT()
1563 *--- TechRec 1040748 16-Jul-2009 MPerel
1564 lcOrder = SET("Order")
1565 SELECT (tcDetailTable)
1566 SET ORDER TO fkey
1567 *=== TechRec 1040748 16-Jul-2009 MPerel ===
1568
1569 * create empty struc for pick work table with fields from header + detail
1570 THIS.CreateCursorStructure(tcDetailTable, tcHeaderTable, tcPickWorkTable)
1571
1572 * Init Thermometer
1573 THIS.InitThermo(RECC(tcHeaderTable))
1574 l_nThermoCnt = 0
1575 SELECT (tcHeaderTable)
1576 SCAN
1577 * Advance progress bar, if we're using one.
1578 l_nThermoCnt = l_nThermoCnt + 1
1579 THIS.AdvanceThermo(l_nThermoCnt)
1580
1581 lnHeaderPkey = pkey
1582 * get header image to Memvar
1583 SCATT MEMVAR
1584 * get all details for this header to Memvar
1585 * Notes: will overwrite same variable of header im Memvar, because
1586 * detail level fields alway more importand than header fields.
1587 SELECT (tcDetailTable)
1588 *--- TechRec 1040748 16-Jul-2009 MPerel --- create index and turn SCAN FOR to SEEK SCAN WHILE
1589 IF SEEK(lnHeaderPkey,tcDetailTable,"fkey")
1590 SCAN WHILE fkey = lnHeaderPkey
1591 *SCAN FOR fkey = lnHeaderPkey
1592 *=== TechRec 1040748 16-Jul-2009 MPerel ===
1593 * ATS# #### Remove 1 SCATT Add Scatt of Detail Memo Field Need For VANDALE Pick
1594 *!* SCATT MEMVAR
1595 SCATT MEMVAR MEMO
1596 *--SAS 12/11/98 Addition to ATS 1529. Joe (and Phu) told to take these fields from header.
1597 * We still have discrepancy: Location, Discount, Comm1, Comm2, Hold_Code, Hold_Rsn, Priority, Pri_Date,
1598 * Factor, Bulk_Num, Bulk_Type, Appv_Num, FTran_Date, Decl_Rsn, Fact_Status, Factor_Ok
1599 * are taken from detail here, but from header in prt_form.prg (printing from SOP and Document Inquiry).
1600 m.Start_Date = &tcHeaderTable..Start_Date
1601 m.End_Date = &tcHeaderTable..End_Date
1602 m.Pri_Date = &tcHeaderTable..Pri_Date
1603 *--<
1604
1605 *--- TR 1053264 25-04-2011 BNarayan update the factor and approval number from header
1606 m.appv_num = IIF(EMPTY(appv_num),&tcHeaderTable..appv_num,appv_num)
1607
1608 m.factor = IIF(EMPTY(factor),&tcHeaderTable..factor,factor)
1609
1610 m.factor_ok = IIF(EMPTY(factor_ok),&tcHeaderTable..factor_ok,factor_ok)
1611
1612 m.ftran_date = IIF(EMPTY(ftran_date),&tcHeaderTable..ftran_date ,ftran_date)
1613
1614 m.decl_rsn = IIF(EMPTY(decl_rsn),&tcHeaderTable..decl_rsn,decl_rsn)
1615
1616 m.fexpn_date = IIF(EMPTY(fexpn_date),&tcHeaderTable..fexpn_date,fexpn_date)
1617
1618 m.end_date = IIF(EMPTY(end_date),&tcHeaderTable..end_date,end_date)
1619
1620 *=== TR 1053264 25-04-2011 BNarayan
1621
1622 INSERT INTO (tcPickWorkTable) FROM MEMVAR
1623 ENDSCAN
1624 ENDIF
1625
1626 ENDSCAN
1627 *--- TechRec 1040748 16-Jul-2009 MPerel ---
1628 SET ORDER TO &lcOrder
1629 *=== TechRec 1040748 16-Jul-2009 MPerel ===
1630 * Reset Thermometer
1631 THIS.ResetThermo()
1632 SELECT(lnOldSelect)
1633 RETURN llRetVal
1634ENDPROC
1635
1636************************************************************************************
1637* Stamp pick header with "R" in transaction
1638* Parameters:
1639* 1- Pick Header table
1640************************************************************************************
1641 PROCEDURE StampPickAsPrinted
1642 LPARAMETERS tcHeaderTable
1643 LOCAL llRetVal, lcSQLString, llBeganTransaction, llUpdated
1644 llRetVal = .T.
1645 WITH THIS
1646 * Start Transaction
1647 llBeganTransaction = .BeginTransaction()
1648 * update all pick header with "R" before printing picktix
1649
1650 *--- TR 1011499 Jun-26-05 HC
1651 *--- TR 1044765 Added pick_proc_date. Do not update field if process has already run.
1652
1653*!* REPLACE ALL ack_prn WITH "R" IN (tcHeaderTable)
1654
1655 *--- TR 1054796 08-Sep-2011 Partha added condition lPickProcessStampDateOnce to stamp pick_proc_date every time process runs ---
1656 REPLACE ALL ack_prn WITH "R", ;
1657 user_id WITH goEnv.envLogin.cUserName, ;
1658 last_mod WITH DATETIME(),;
1659 pick_proc_date WITH ;
1660 IIF( (!.lPickProcessStampDateOnce) OR ; && TR 1054796 08-Sep-2011 Partha
1661 EMPTY(pick_proc_date) OR pick_proc_date = DATE(1900,1,1),DATE(),pick_proc_date) IN (tcHeaderTable)
1662
1663 *=== TR 1011499 Jun-26-05 HC
1664
1665 * Tableupdate pick header
1666 llUpdated = .TABLEUPDATE(tcHeaderTable)
1667 * Commit Transaction
1668 IF llBeganTransaction
1669 IF llUpdated
1670 .EndTransaction()
1671 ELSE
1672 .RollbackTransaction()
1673 *--- TR 1011499 Jun-26-05 HC
1674 .lErrorState = .T.
1675 .cMessage = "Update Conflict. Cannot continue."
1676 llRetVal = False
1677 *=== TR 1011499 Jun-26-05 HC
1678 ENDIF
1679 ENDIF
1680 ENDWITH
1681 RETURN llRetVal
1682ENDPROC
1683
1684*--SAS 12/09/98 ATS 1529. Combine document print & reprint into a single process.
1685*!* ************************************************************************************
1686*!* * Printing pick tickets
1687*!* * Parameters:
1688*!* * 1- Pick Work table (Header+details fields except for detail field will be in this
1689*!* * cursor if it have same name from header and detail)
1690*!* * Notes: pick work table should be in division, pick_num order
1691*!* * 2- plNoScreenUI
1692*!* ************************************************************************************
1693*!* Procedure PrintPickTickets
1694*!* Lparameters tcPickWork, plNoScreenUI
1695*!* Local llRetVal, lnOldSelect, laTable, lcFRX_Name, form_name
1696*!* Dimen laTable[1]
1697*!* llRetVal = .T.
1698*!* lnOldSelect= Select()
1699*!* * create divisional pick work cursor for printing
1700*!* * from tcPickWk from TOP
1701*!* Select (tcPickWork)
1702*!* Go Top
1703
1704*!* aField(laTable, tcPickWork)
1705*!* lcLastPick_form = ""
1706*!* Do while !Eof()
1707*!* lcCurrentDivision = division
1708*!* lcPick_form = vl_ocntr(division, "Pick_form", "")
1709*!* lcFRX_Name = vl_formr(lcPick_form, "Frx_name", "tcXFormr")
1710*!* form_name = tcXFormr.form_desc
1711*!* * create another pick work for just current division
1712*!* Create Cursor __PickWk From Array laTable
1713*!* Select (tcPickWork)
1714*!* Scan while division = lcCurrentDivision
1715*!* Scatt Memvar
1716*!* Insert Into __PickWk From Memvar
1717*!* Endscan
1718*!* If Recc('__PickWk')>0
1719*!* If !(lcLastPick_form == lcPick_form)
1720*!* lcResponse= This.cPrintDialogResponse
1721*!* * skip printing pick ticket
1722*!* If lcResponse= "CANCEL"
1723*!* Exit
1724*!* Endif
1725*!* lcLastPick_form = lcPick_form
1726*!* Endif
1727*!* This.PrintReportForm("__PickWk", lcFRX_Name, lcResponse, plNoScreenUI, form_name, ;
1728*!* "Original Pick Ticket")
1729*!* Endif
1730*!* EndDo
1731*!* Select(lnOldSelect)
1732*!* If Used('__PckWrk')
1733*!* Use In __PckWrk
1734*!* Endif
1735*!* Return llRetVal
1736*!* Endproc
1737*--<
1738
1739 PROCEDURE UnlockProcedure
1740 v_SysUnLock( lcSyslockTablePath+"SYSLOCK", "PICKPROCESS", goEnv.cCompany)
1741 * --- TR 1043545 RLN 04/30/10
1742 IF This.lUnlockBridge
1743 v_SysUnLock( lcSyslockTablePath+"SYSLOCK", "OBRPKPROCESS", goEnv.cCompany)
1744 ENDIF
1745 * === TR 1043545
1746 RETURN
1747ENDPROC
1748
1749*--- TR 1015923 23-Mar-2006 Goutam
1750 FUNCTION ValidateSuppressPixPrint
1751
1752 LOCAL llRetVal, lnSelect, lnResetFlagIndex
1753
1754 llRetVal = true
1755 lnSelect = SELECT()
1756
1757 WITH THIS
1758 lnResetFlagIndex = ASCAN(.aParamBROs,"SUPP_PICKTIX",1,ALEN(.aParamBROs,1),1,9)
1759
1760 *-- Validate parameter
1761 IF lnResetFlagIndex > 0
1762 .cParamFilter = ALLTRIM(.aParamBROs[lnResetFlagIndex, 2])
1763
1764 IF NOT EMPTY(.cParamFilter) AND NOT .cParamFilter $ 'YN'
1765 .LogWarning("Suppress Pick Ticket Print value should be blank or Y or N.")
1766 .cMessage = "Suppress Pick Ticket Print value should be blank or Y or N."
1767 llRetVal = false
1768 *--- TR 1066503 02/15/13 ATHIRUNAVU
1769 ELSE
1770 .oLog.LogEntry("Suppress Pick Ticket Print value :" + .cParamFilter )
1771 *--- TR 1066503 02/15/13 ATHIRUNAVU
1772 ENDIF
1773 ENDIF
1774 ENDWITH
1775
1776 SELECT (lnSelect)
1777 RETURN llRetVal
1778 ENDFUNC
1779 *=== TR 1015923 23-Mar-2006 Goutam
1780
1781 *--- TR 1025698 13-Aug-2007 Goutam
1782 FUNCTION RetrieveParmName
1783 LOCAL lnSelect, lnParmNameIndex, lcParmName
1784
1785 lcParmName = ""
1786 lnSelect = SELECT()
1787
1788 WITH THIS
1789 lnParmNameIndex = ASCAN(.aParamBROs,"PICK_SORT_TEMPLATE",1,ALEN(.aParamBROs,1),1,9)
1790
1791 *-- Validate parameter
1792 IF lnParmNameIndex > 0
1793 lcParmName = ALLTRIM(.aParamBROs[lnParmNameIndex, 2])
1794 *--- TR 1066503 02/15/13 ATHIRUNAVU
1795 .oLog.LogEntry("Pick Ticket Sort : " + lcParmName)
1796 *--- TR 1066503 02/15/13 ATHIRUNAVU
1797 ENDIF
1798 ENDWITH
1799
1800 SELECT (lnSelect)
1801 RETURN lcParmName
1802 ENDFUNC
1803 *=== TR 1025698 13-Aug-2007 Goutam
1804
1805 *--- TR 1033483 - BD - 10/22/28
1806 FUNCTION RetrieveParmNameWHSSort
1807 LOCAL lnSelect, lnParmNameIndex, lcParmName
1808
1809 lcParmName = ""
1810 lnSelect = SELECT()
1811
1812 WITH THIS
1813 lnParmNameIndex = ASCAN(.aParamBROs,"WHS_PICK_TICKET_SORT_DETAIL",1,ALEN(.aParamBROs,1),1,9)
1814
1815 *-- Validate parameter
1816 IF lnParmNameIndex > 0
1817 lcParmName = ALLTRIM(.aParamBROs[lnParmNameIndex, 2])
1818
1819 *--- TR 1066503 02/15/13 ATHIRUNAVU
1820 .oLog.LogEntry("WHS Pick Ticket wave detail Sort :" + lcParmName)
1821 *--- TR 1066503 02/15/13 ATHIRUNAVU
1822 ENDIF
1823 ENDWITH
1824
1825 SELECT (lnSelect)
1826 RETURN lcParmName
1827 ENDFUNC
1828 *=== TR 1033483 - BD - 10/22/28
1829
1830*--- TechRec 1031637 23-Apr-2008 T.Shenbagavalli ---
1831*===============================================================================================================
1832
1833 PROCEDURE AutoCancelOrder
1834 LPARAMETERS pcSQLFilterString
1835 LOCAL lcSourceHeader, lcSourceDetail,lcCncl_type ,lcCncl_Rsn , ;
1836 lnHeaderPkey ,lCurrentOrderLineOnly,lcConf_type,llPickMode , ;
1837 lnOrdCount ,lnCancelCount, lcCncl_BO_Pick
1838
1839
1840 llRetVal = True
1841 lCurrentOrderLineOnly = True
1842 lnCancelCount = 0
1843 llPickMode = True
1844
1845 WITH THIS
1846 llRetVal = .GetCancelOrderViews(pcSQLFilterString )
1847 IF llRetVal
1848
1849 lcSourceHeader = "Vzzoordrh_atcnl_pick"
1850 lcSourceDetail = "Vzzoordrd_atcnl_pick"
1851
1852 .cOrdHdrView = "Vzzoordrh_atcnl_pick"
1853 .cOrdDtlView = "Vzzoordrd_atcnl_pick"
1854 .cOrdCrtnView = "Vzzoordsp_atcnl_pick"
1855
1856 .lUseFRMCode = False
1857 .lAutoCancelOrder = True
1858
1859 SELECT (lcSourceHeader)
1860 lnOrdCount =RECCOUNT()
1861 FOR I = 1 TO lnOrdCount
1862
1863 SELECT (lcSourceHeader)
1864
1865 GOTO I
1866
1867 lcConf_type = Conf_type
1868 lnHeaderPkey = Pkey
1869 lcCncl_rsn = ""
1870 lcCncl_type = ""
1871 lcCncl_BO_Pick= ""
1872
1873 IF .GetAutoCancelControl(ord_type,customer,division,@lcCncl_type ,@lcCncl_Rsn, @lcCncl_BO_Pick)
1874
1875 IF lcCncl_BO_Pick = 'Y'
1876 SELECT (lcSourceDetail)
1877 GO TOP
1878 *--- TechRec 1037835 30-Dec-2008 MPerel --- cancel only if order has "Cancel B/O During Pick Process" is 'Y' from Auto Cancel Control Ref.
1879 *!* SCAN FOR fkey = lnHeaderPkey
1880 *!* .ProcessCancel(lcSourceDetail,lCurrentOrderLineOnly ,Line_Seq;
1881 *!* ,lcCncl_type ,lcCncl_Rsn,llPickMode,lcConf_type )
1882 *!*
1883 *!* ENDSCAN
1884 REPLACE pick_num WITH 0, inv_num WITH 0, line_status WITH "C", ;
1885 cncl_type WITH lcCncl_type , cncl_rsn WITH lcCncl_Rsn, cncl_date WITH DATE() FOR fkey = lnHeaderPkey
1886 *=== TechRec 1037835 30-Dec-2008 MPerel ===
1887
1888 SELECT (lcSourceDetail)
1889 LOCATE FOR fkey = lnHeaderPkey
1890
1891 .PrepareOrderEntryAndCancelForSaving()
1892
1893 lnCancelCount = lnCancelCount + 1
1894 ENDIF
1895
1896 ENDIF
1897
1898 NEXT
1899
1900 llRetVal= llRetVal AND .TABLEUPDATE(lcSourceHeader)
1901 llRetVal= llRetVal AND .TABLEUPDATE(lcSourceDetail)
1902 llRetVal= llRetVal AND .TABLEUPDATE("Vzzoordsp_atcnl_pick")
1903
1904 ENDIF
1905
1906 .TableClose("Vzzoordrh_atcnl_pick", true)
1907 .TableClose("Vzzoordrd_atcnl_pick", true)
1908 .TableClose("Vzzoordsp_atcnl_pick", true)
1909
1910 This.oLog.LogEntry("Orders Auto Canceled : " + ALLTRIM(STR(lnCancelCount)))
1911
1912 ENDWITH
1913 RETURN llRetVal
1914
1915 ENDPROC
1916
1917 PROCEDURE GetAutoCancelControl
1918 PARAMETERS tcOrd_type, tcCustomer , tcDivision , tcCncl_type, tcCncl_rsn, tcCncl_BO_Pick
1919
1920 LOCAL lnsizeCounter, lcsizeCounter, lcFieldName,l_vRetVal
1921
1922 l_vRetVal = false
1923 lcOrgAlias = ALIAS()
1924
1925 vl_oatcnlcr(tcOrd_type,'','tcAtCnlCr',tcCustomer ,tcDivision )
1926
1927 IF used('tcAtCnlCr') and reccount('tcAtCnlCr')>0
1928 tcCncl_type = tcAtCnlCr.Cncl_type
1929 tcCncl_rsn = tcAtCnlCr.Cncl_rsn
1930 tcCncl_BO_Pick = tcAtCnlCr.Cancel_BO_Pick
1931 l_vRetVal = true
1932 ENDIF
1933
1934 if used('tcAtCnlCr')
1935 use in tcAtCnlCr
1936 ENDIF
1937
1938 SELECT (lcOrgAlias)
1939 RETURN l_vRetVal
1940 ENDPROC
1941
1942 PROCEDURE GetCancelOrderViews
1943 PARAMETERS pcSQLFilterString
1944 LOCAL lcSQLSelectString ,lcDefaultSQLOrderString , lcSQLFilterString ,;
1945 lcSecureFilter ,lcSecureDetailFilter ,llRetVal , lcOrgAlias
1946 LOCAL Array laTables[3,2], laTablesDetail[1,2]
1947
1948 llRetVal = false
1949 lcOrgAlias = ALIAS()
1950
1951 *--- TechRec 1035699 04-Sep-2008 MA ===
1952 This.oLog.LogEntry("Creating Cancel Order Views...")
1953
1954 WITH THIS
1955
1956 laTables[1, 1] = "zzoordrh"
1957 laTables[1, 2] = "h"
1958 laTables[2, 1] = "zzoordrd"
1959 laTables[2, 2] = "d"
1960 laTables[3, 1] = "ZZXCUSTR"
1961 laTables[3, 2] = "R"
1962
1963 lcSecureFilter = ColumnSecurityFilter(@laTables)
1964 lcSecureFilter = IIF(EMPTY(lcSecureFilter), "", " AND " + lcSecureFilter)
1965
1966 laTablesDetail[1, 1] = "zzoordrd"
1967 laTablesDetail[1, 2] = ""
1968 lcSecureDetailFilter = ColumnSecurityFilter(@laTablesDetail)
1969 lcSecureDetailFilter = IIF(EMPTY(lcSecureDetailFilter), "", " AND " + lcSecureDetailFilter)
1970
1971 .lNoDataFound = .F.
1972
1973 lcDefaultSQLOrderString = "division, Customer, ord_type "
1974
1975 lcSQLFilterString = pcSQLFilterString + lcSecureFilter
1976
1977 lcSQLSelectString = " SELECT * FROM zzoordrh " + ;
1978 " WHERE ord_num IN ( " + ;
1979 " SELECT DISTINCT h.ord_num " + ;
1980 " FROM zzoordrd d, zzoordrh h " + ;
1981 " LEFT OUTER JOIN zzxcustr r ON (h.customer=r.customer) " +;
1982 " WHERE h.pkey = d.fkey " + ;
1983 " AND h.pick_num > 0 and h.ord_status = 'P' "+ ;
1984 pcSQLFilterString + ") " + ;
1985 " AND ord_status ='O' AND cncl_num = 0 " + ;
1986 lcSecureFilter
1987
1988
1989 .CreateSQLView("Vzzoordrh_atcnl_pick",lcSQLSelectString ,, lcDefaultSQLOrderString )
1990
1991 lcSQLSelectString = " SELECT * FROM zzoordrd " + ;
1992 " WHERE fkey IN( " +;
1993 " SELECT pkey FROM zzoordrh " + ;
1994 " WHERE ord_num IN ( " + ;
1995 " SELECT DISTINCT h.ord_num " + ;
1996 " FROM zzoordrd d, zzoordrh h " + ;
1997 " LEFT OUTER JOIN zzxcustr r ON (h.customer=r.customer) " +;
1998 " WHERE h.pkey = d.fkey " + ;
1999 " AND h.pick_num > 0 and h.ord_status = 'P' "+ ;
2000 pcSQLFilterString + " ) " + ;
2001 " AND ord_status ='O' AND cncl_num = 0 " + ;
2002 lcSecureFilter+ " ) " +;
2003 " AND line_status = 'O' " + ;
2004 lcSecureDetailFilter
2005
2006 .CreateSQLView("Vzzoordrd_atcnl_pick",lcSQLSelectString )
2007
2008 * Open all views
2009 IF !(.OPENTABLE("Vzzoordrh_atcnl_pick",,.T.) AND ;
2010 .OPENTABLE("Vzzoordrd_atcnl_pick",,.T.))
2011 .lErrorState = .T.
2012 llRetVal = .F.
2013 .cMessage = MSG_FILTER_ERROR + CRLF + MSG_TRY_AGAIN_NOW
2014 ELSE
2015
2016
2017 llRetVal = true
2018
2019 lcSQLSelectString = " SELECT s.* FROM zzoordsp s " +;
2020 " JOIN zzoordrh h" +;
2021 " ON s.Ord_Num = h.Ord_Num AND s.Pick_Num = h.Pick_Num "+;
2022 " AND s.Carton_cls = '" + CARTON_CLASS_SALES + "'"+;
2023 " AND h. ord_num IN ( " +;
2024 " SELECT DISTINCT h.ord_num " + ;
2025 " FROM zzoordrd d, zzoordrh h " + ;
2026 " LEFT OUTER JOIN zzxcustr r ON (h.customer=r.customer) " +;
2027 " WHERE h.pkey = d.fkey " + ;
2028 " AND h.pick_num > 0 and h.ord_status = 'P' "+ ;
2029 pcSQLFilterString + ") " + ;
2030 lcSecureFilter + ;
2031 " AND h.ord_status ='O' AND h.cncl_num = 0 "
2032
2033 .CreateSQLView("Vzzoordsp_atcnl_pick",lcSQLSelectString )
2034
2035 llRetVal = llRetVal AND .OPENTABLE("Vzzoordsp_atcnl_pick",,.T.)
2036
2037 ENDIF
2038 ENDWITH
2039 SELECT (lcOrgAlias)
2040 RETURN llRetVal
2041 ENDPROC
2042*=== TechRec 1031637 23-Apr-2008 T.Shenbagavalli ===
2043
2044 *--- TR 1055858 08-Aug-2011 Partha ---
2045
2046*===============================================================================================================
2047
2048 FUNCTION ValidateProcess
2049 LOCAL llRetVal, lnSelect
2050
2051 llRetVal = true
2052 lnSelect = SELECT()
2053
2054 WITH This
2055 * do required validations here.
2056 ENDWITH
2057
2058 SELECT (lnSelect)
2059 RETURN llRetVal
2060 ENDFUNC
2061
2062 *=== TR 1055858 08-Aug-2011 Partha ===
2063
2064 *----------------------------------------------------
2065 PROCEDURE GetFormFromParamBro
2066 LOCAL llRetVal,lnSelect, lnParmNameIndex, lcParmName,lcFrxName
2067
2068 llRetVal = .T.
2069 lcParmName = ""
2070 lnSelect = SELECT()
2071
2072 WITH THIS
2073 lnParmNameIndex = ASCAN(.aParamBROs,"ZZYPICKP_FRMNAME",1,ALEN(.aParamBROs,1),1,9)
2074 .cForcedPickForm = ""
2075
2076 *-- Validate parameter
2077 IF lnParmNameIndex > 0
2078 lcParmName = ALLTRIM(.aParamBROs[lnParmNameIndex, 2])
2079
2080 IF NOT EMPTY(lcParmName)
2081 lcFrxName = vl_formr(lcParmName,'frx_name')
2082 IF EMPTY(lcFrxName)
2083 .cMessage = .cMessage + "Invalid Pick Form Specified" + CRLF
2084 .oLog.LogEntry("Invalid Pick Form Specified.")
2085 ELSE
2086 .oLog.LogEntry("Using user specified for only: " + lcParmName)
2087 .cForcedPickForm = lcParmName
2088 ENDIF
2089
2090 ENDIF
2091
2092 ENDIF
2093 ENDWITH
2094
2095 SELECT (lnSelect)
2096 RETURN llRetVal
2097 ENDPROC
2098
2099 *===============================================================================================================
2100
2101ENDDEFINE